From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/baisy/2.2.1-schulis/source-disk | 1 + app/baisy/2.2.1-schulis/src/ANWENDUNG.files | 3 + app/baisy/2.2.1-schulis/src/BAISY SERVER.files | 6 + app/baisy/2.2.1-schulis/src/BASIS.files | 7 + app/baisy/2.2.1-schulis/src/DB REORG.files | 5 + app/baisy/2.2.1-schulis/src/DB.files | 16 + app/baisy/2.2.1-schulis/src/DOS.files | 22 + app/baisy/2.2.1-schulis/src/SICHERUNG.files | 8 + app/baisy/2.2.1-schulis/src/STANDARD.files | 16 + app/baisy/2.2.1-schulis/src/WERKZEUGE.files | 8 + .../2.2.1-schulis/src/allgemeine grundfunktionen | 35 + app/baisy/2.2.1-schulis/src/aufruf manager | 39 + app/baisy/2.2.1-schulis/src/auskunftsfenster | 126 + app/baisy/2.2.1-schulis/src/baisyio | 51 + app/baisy/2.2.1-schulis/src/block i-o | 52 + app/baisy/2.2.1-schulis/src/bpb ds | Bin 0 -> 2048 bytes app/baisy/2.2.1-schulis/src/db archive.sc | 7 + app/baisy/2.2.1-schulis/src/db dd.sc | 60 + app/baisy/2.2.1-schulis/src/db ddinfo.sc | 24 + app/baisy/2.2.1-schulis/src/db fetch.baisy | 28 + app/baisy/2.2.1-schulis/src/db kernel.sc | 60 + app/baisy/2.2.1-schulis/src/db parse.sc | 38 + app/baisy/2.2.1-schulis/src/db phon.sc | 17 + app/baisy/2.2.1-schulis/src/db reorg.sc | 48 + .../2.2.1-schulis/src/db reorganisation auftrag | 12 + .../2.2.1-schulis/src/db reorganisation manager | 15 + app/baisy/2.2.1-schulis/src/db scan | 245 ++ app/baisy/2.2.1-schulis/src/db utils.sc | 60 + app/baisy/2.2.1-schulis/src/dir.dos | 187 ++ app/baisy/2.2.1-schulis/src/disk descriptor.dos | 73 + app/baisy/2.2.1-schulis/src/dos hd inserter | 12 + app/baisy/2.2.1-schulis/src/dos inserter | 15 + app/baisy/2.2.1-schulis/src/dump | 12 + app/baisy/2.2.1-schulis/src/editorfunktionen | 56 + app/baisy/2.2.1-schulis/src/erf.auskuenfte | 66 + app/baisy/2.2.1-schulis/src/eu disk descriptor | 26 + app/baisy/2.2.1-schulis/src/f packet.sc | 9 + app/baisy/2.2.1-schulis/src/fat.dos | 82 + app/baisy/2.2.1-schulis/src/fetch | 108 + app/baisy/2.2.1-schulis/src/fetch save interface | 16 + app/baisy/2.2.1-schulis/src/get put interface.dos | 103 + app/baisy/2.2.1-schulis/src/insert.dos | 15 + app/baisy/2.2.1-schulis/src/isp archive.sc | 35 + app/baisy/2.2.1-schulis/src/isp.auskunftseditor | 27 + .../2.2.1-schulis/src/isp.auskunftsfunktionen | 69 + app/baisy/2.2.1-schulis/src/isp.baisy server | 80 + .../2.2.1-schulis/src/isp.benutzerberechtigungen | 87 + app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen | 67 + .../src/isp.erf.benutzerberechtigungen | 54 + app/baisy/2.2.1-schulis/src/isp.erf.meldungen | 40 + .../2.2.1-schulis/src/isp.erf.steueroperationen | 258 ++ app/baisy/2.2.1-schulis/src/isp.init baisy server | 4 + app/baisy/2.2.1-schulis/src/isp.knoten | 137 + .../2.2.1-schulis/src/isp.manager schnittstelle | 82 + app/baisy/2.2.1-schulis/src/isp.masken | 495 +++ app/baisy/2.2.1-schulis/src/isp.maskendesign | 302 ++ app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen | 64 + .../2.2.1-schulis/src/isp.monitor sicherungstask | 126 + app/baisy/2.2.1-schulis/src/isp.objektliste | 252 ++ app/baisy/2.2.1-schulis/src/isp.schulis db nummern | 225 ++ app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor | 141 + .../2.2.1-schulis/src/isp.standardmaskenbehandlung | 35 + .../2.2.1-schulis/src/isp.systembaumbearbeitung | 236 ++ app/baisy/2.2.1-schulis/src/isp.systembaumeditor | 72 + .../2.2.1-schulis/src/isp.zusatz archive packet | 13 + app/baisy/2.2.1-schulis/src/konvert | 18 + app/baisy/2.2.1-schulis/src/log.eintrag | 14 + app/baisy/2.2.1-schulis/src/log.manager | 126 + app/baisy/2.2.1-schulis/src/logbuch verwaltung | 81 + app/baisy/2.2.1-schulis/src/longrow | 38 + app/baisy/2.2.1-schulis/src/manager-M.dos | 55 + app/baisy/2.2.1-schulis/src/manager-S.dos | 67 + app/baisy/2.2.1-schulis/src/maskenerweiterung | 11 + app/baisy/2.2.1-schulis/src/maskenverarbeitung | 125 + app/baisy/2.2.1-schulis/src/name conversion.dos | 22 + app/baisy/2.2.1-schulis/src/new monitor baisy | 4 + app/baisy/2.2.1-schulis/src/open | 11 + app/baisy/2.2.1-schulis/src/plausipruefung | 88 + app/baisy/2.2.1-schulis/src/save | 61 + .../2.2.1-schulis/src/schulis kommandobehandlung | 19 + app/baisy/2.2.1-schulis/src/shard interface | 20 + app/baisy/2.2.1-schulis/src/standarddialog | 34 + app/baisy/2.2.1-schulis/src/sybifunktionen | 71 + app/baisy/2.2.1-schulis/src/systembaum | 299 ++ app/baisy/2.2.1-schulis/src/systembauminterpreter | 390 +++ app/baisy/2.2.1-schulis/src/thesaurusfunktionen | 16 + .../2.2.1-schulis/src/umgebungswechsel manager | 19 + app/conversion/1.0/source-disk | 1 + app/conversion/1.0/src/AGFA2ASC.TBL | 19 + app/conversion/1.0/src/ASKCNVRS.PAC | 349 ++ app/conversion/1.0/src/DOSCNVRS.PAC | 203 ++ app/conversion/1.0/src/EU_CNVRS.DOC | 150 + app/conversion/1.0/src/FILEUTIL.PAC | 142 + app/conversion/1.0/src/FONTANAL.PAC | 261 ++ app/conversion/1.0/src/PSEUDOWP.WPM | Bin 0 -> 1437 bytes app/conversion/1.0/src/PS_WP_DT.WPM | Bin 0 -> 1439 bytes app/conversion/1.0/src/SEQU2CUM.TBL | 1 + app/conversion/1.0/src/WP_CNVRS.PAC | 905 ++++++ app/conversion/1.0/src/WP_KNVRS.PAC | 915 ++++++ app/diskettenmonitor/3.5/source-disk | 1 + .../3.5/src/basic menu handling 3.5.quelle | 53 + app/diskettenmonitor/3.5/src/disk 3.5-m.quelle | 2192 +++++++++++++ app/diskettenmonitor/3.5/src/disk cmd 3.5.quelle | 36 + app/diskettenmonitor/3.5/src/m.rename archive^2.c | 3 + app/diskettenmonitor/3.5/src/read heap | 107 + app/diskettenmonitor/3.7/source-disk | 1 + app/diskettenmonitor/3.7/src/PAC digit conversion | 93 + .../3.7/src/basic menu handling 3.6.quelle | 53 + app/diskettenmonitor/3.7/src/disk 3.7-m.quelle | 2218 +++++++++++++ app/diskettenmonitor/3.7/src/disk cmd 3.6.quelle | 48 + app/eudas/3.4/source-disk | 1 + app/eudas/3.4/src/eudas.1 | 37 + app/eudas/3.4/src/eudas.2 | 25 + app/eudas/3.4/src/eudas.3 | 32 + app/eudas/3.4/src/eudas.4 | 31 + app/eudas/3.4/src/eudas.gen-m | 49 + app/eudas/3.4/src/eudas.gen-s | 39 + app/eudas/3.4/src/eudas.init | 1034 ++++++ app/eudas/4.3/doc/abb.1-1 | 94 + app/eudas/4.3/doc/abb.4-1 | 43 + app/eudas/4.3/doc/abb.4-2 | 46 + app/eudas/4.3/doc/abb.6-1 | 75 + app/eudas/4.3/doc/abb.6-2 | 77 + app/eudas/4.3/doc/abb.7-1 | 46 + app/eudas/4.3/doc/abb.9-1 | 41 + app/eudas/4.3/doc/abb.9-2 | 96 + app/eudas/4.3/doc/abb.9-3 | 113 + app/eudas/4.3/doc/abb.9-4 | 98 + app/eudas/4.3/doc/abb.9-5 | 51 + app/eudas/4.3/doc/bildergenerator | 25 + app/eudas/4.3/doc/eudas.hdb.1 | 267 ++ app/eudas/4.3/doc/eudas.hdb.10 | 510 +++ app/eudas/4.3/doc/eudas.hdb.11 | 674 ++++ app/eudas/4.3/doc/eudas.hdb.12 | 446 +++ app/eudas/4.3/doc/eudas.hdb.13 | 757 +++++ app/eudas/4.3/doc/eudas.hdb.14 | 724 +++++ app/eudas/4.3/doc/eudas.hdb.15 | 286 ++ app/eudas/4.3/doc/eudas.hdb.16 | 350 ++ app/eudas/4.3/doc/eudas.hdb.2 | 178 + app/eudas/4.3/doc/eudas.hdb.3 | 515 +++ app/eudas/4.3/doc/eudas.hdb.5 | 386 +++ app/eudas/4.3/doc/eudas.hdb.6 | 394 +++ app/eudas/4.3/doc/eudas.hdb.7 | 687 ++++ app/eudas/4.3/doc/eudas.hdb.8 | 211 ++ app/eudas/4.3/doc/eudas.hdb.9 | 556 ++++ app/eudas/4.3/doc/eudas.hdb.inhalt | 133 + app/eudas/4.3/doc/eudas.hdb.macros | 80 + app/eudas/4.3/doc/eudas.hdb.titel | 99 + app/eudas/4.3/doc/eudas.hdb.vorwort | 89 + app/eudas/4.3/doc/eudas.ref.1 | 326 ++ app/eudas/4.3/doc/eudas.ref.10 | 406 +++ app/eudas/4.3/doc/eudas.ref.11 | 347 ++ app/eudas/4.3/doc/eudas.ref.2 | 830 +++++ app/eudas/4.3/doc/eudas.ref.3 | 270 ++ app/eudas/4.3/doc/eudas.ref.4 | 441 +++ app/eudas/4.3/doc/eudas.ref.5 | 432 +++ app/eudas/4.3/doc/eudas.ref.6 | 399 +++ app/eudas/4.3/doc/eudas.ref.7 | 447 +++ app/eudas/4.3/doc/eudas.ref.8 | 454 +++ app/eudas/4.3/doc/eudas.ref.9 | 194 ++ app/eudas/4.3/doc/eudas.ref.fehler | 139 + app/eudas/4.3/doc/eudas.ref.inhalt | 120 + app/eudas/4.3/doc/eudas.ref.macros | 73 + app/eudas/4.3/doc/eudas.ref.proz | 205 ++ app/eudas/4.3/doc/eudas.ref.reg | 436 +++ app/eudas/4.3/doc/eudas.ref.titel | 91 + app/eudas/4.3/doc/eudas.ref.vorwort | 81 + app/eudas/4.3/doc/ref.abb.1-1 | 42 + app/eudas/4.3/doc/register | 490 +++ app/eudas/4.3/doc/uedas.hdb.4 | 686 ++++ app/eudas/4.3/src/Adressen | Bin 0 -> 3584 bytes app/eudas/4.3/src/dummy.text | 14 + app/eudas/4.3/src/eudas.1 | 52 + app/eudas/4.3/src/eudas.2 | 62 + app/eudas/4.3/src/eudas.3 | 58 + app/eudas/4.3/src/eudas.4 | 150 + app/eudas/4.3/src/eudas.generator | 86 + app/eudas/4.3/src/eudas.init | 1463 +++++++++ app/eudas/4.3/src/pos.173 | 19 + app/eudas/4.4/doc/ref-manual/abb.1-1 | 71 + app/eudas/4.4/doc/ref-manual/abb.4-1 | 43 + app/eudas/4.4/doc/ref-manual/abb.4-2 | 46 + app/eudas/4.4/doc/ref-manual/abb.6-1 | 75 + app/eudas/4.4/doc/ref-manual/abb.6-2 | 77 + app/eudas/4.4/doc/ref-manual/abb.7-1 | 46 + app/eudas/4.4/doc/ref-manual/abb.9-1 | 41 + app/eudas/4.4/doc/ref-manual/abb.9-2 | 96 + app/eudas/4.4/doc/ref-manual/abb.9-3 | 113 + app/eudas/4.4/doc/ref-manual/abb.9-4 | 98 + app/eudas/4.4/doc/ref-manual/abb.9-5 | 51 + app/eudas/4.4/doc/ref-manual/bildergenerator | 25 + app/eudas/4.4/doc/ref-manual/eudas.ref.1 | 323 ++ app/eudas/4.4/doc/ref-manual/eudas.ref.10 | 394 +++ app/eudas/4.4/doc/ref-manual/eudas.ref.11 | 327 ++ app/eudas/4.4/doc/ref-manual/eudas.ref.2 | 820 +++++ app/eudas/4.4/doc/ref-manual/eudas.ref.3 | 256 ++ app/eudas/4.4/doc/ref-manual/eudas.ref.4 | 421 +++ app/eudas/4.4/doc/ref-manual/eudas.ref.5 | 415 +++ app/eudas/4.4/doc/ref-manual/eudas.ref.6 | 466 +++ app/eudas/4.4/doc/ref-manual/eudas.ref.7 | 519 +++ app/eudas/4.4/doc/ref-manual/eudas.ref.8 | 444 +++ app/eudas/4.4/doc/ref-manual/eudas.ref.9 | 184 ++ app/eudas/4.4/doc/ref-manual/eudas.ref.fehler | 129 + app/eudas/4.4/doc/ref-manual/eudas.ref.inhalt | 137 + app/eudas/4.4/doc/ref-manual/eudas.ref.macros | 70 + app/eudas/4.4/doc/ref-manual/eudas.ref.proz | 195 ++ app/eudas/4.4/doc/ref-manual/eudas.ref.reg | 426 +++ app/eudas/4.4/doc/ref-manual/eudas.ref.titel | 68 + app/eudas/4.4/doc/ref-manual/eudas.ref.vorwort | 29 + app/eudas/4.4/doc/ref-manual/ref.abb.1-1 | 58 + app/eudas/4.4/doc/user-manual/eudas.hdb.1 | 254 ++ app/eudas/4.4/doc/user-manual/eudas.hdb.10 | 485 +++ app/eudas/4.4/doc/user-manual/eudas.hdb.11 | 645 ++++ app/eudas/4.4/doc/user-manual/eudas.hdb.12 | 431 +++ app/eudas/4.4/doc/user-manual/eudas.hdb.13 | 734 +++++ app/eudas/4.4/doc/user-manual/eudas.hdb.14 | 697 ++++ app/eudas/4.4/doc/user-manual/eudas.hdb.15 | 269 ++ app/eudas/4.4/doc/user-manual/eudas.hdb.16 | 329 ++ app/eudas/4.4/doc/user-manual/eudas.hdb.2 | 164 + app/eudas/4.4/doc/user-manual/eudas.hdb.3 | 504 +++ app/eudas/4.4/doc/user-manual/eudas.hdb.4 | 676 ++++ app/eudas/4.4/doc/user-manual/eudas.hdb.5 | 373 +++ app/eudas/4.4/doc/user-manual/eudas.hdb.6 | 382 +++ app/eudas/4.4/doc/user-manual/eudas.hdb.7 | 665 ++++ app/eudas/4.4/doc/user-manual/eudas.hdb.8 | 187 ++ app/eudas/4.4/doc/user-manual/eudas.hdb.9 | 534 +++ app/eudas/4.4/doc/user-manual/eudas.hdb.inhalt | 172 + app/eudas/4.4/doc/user-manual/eudas.hdb.macros | 66 + app/eudas/4.4/doc/user-manual/eudas.hdb.titel | 73 + app/eudas/4.4/doc/user-manual/eudas.hdb.vorwort | 59 + app/eudas/4.4/doc/user-manual/register | 482 +++ app/eudas/4.4/source-disk | 3 + app/eudas/4.4/src/eudas.dateistruktur | 1690 ++++++++++ app/eudas/4.4/src/eudas.datenverwaltung | 1989 ++++++++++++ app/eudas/4.4/src/eudas.drucken | 1891 +++++++++++ app/eudas/4.4/src/eudas.fenster | 238 ++ app/eudas/4.4/src/eudas.menues | 2616 +++++++++++++++ app/eudas/4.4/src/eudas.satzanzeige | 993 ++++++ app/eudas/4.4/src/eudas.satzzugriffe | 271 ++ app/eudas/4.4/src/eudas.steuerung | 2761 ++++++++++++++++ app/eudas/4.4/src/eudas.uebersicht | 420 +++ app/eudas/4.4/src/eudas.verarbeitung | 731 +++++ app/eudas/5.3/source-disk | 2 + app/eudas/5.3/src/Adressen | Bin 0 -> 3584 bytes app/eudas/5.3/src/boxzeichen | 3 + app/eudas/5.3/src/dummy.text | 14 + app/eudas/5.3/src/eudas.1 | 49 + app/eudas/5.3/src/eudas.2 | 73 + app/eudas/5.3/src/eudas.3 | 43 + app/eudas/5.3/src/eudas.4 | 134 + app/eudas/5.3/src/eudas.alt | 44 + app/eudas/5.3/src/eudas.dateien.05 | 1690 ++++++++++ app/eudas/5.3/src/eudas.dialoghilfen.04 | 435 +++ app/eudas/5.3/src/eudas.drucken.13 | 2001 ++++++++++++ app/eudas/5.3/src/eudas.fenster.06 | 253 ++ app/eudas/5.3/src/eudas.generator | 105 + app/eudas/5.3/src/eudas.init.14 | 1625 ++++++++++ app/eudas/5.3/src/eudas.listen.01 | 276 ++ app/eudas/5.3/src/eudas.menues.14 | 3157 ++++++++++++++++++ app/eudas/5.3/src/eudas.saetze.03 | 271 ++ app/eudas/5.3/src/eudas.satzanzeige.12 | 1007 ++++++ app/eudas/5.3/src/eudas.steuerung.14 | 2535 +++++++++++++++ app/eudas/5.3/src/eudas.uebersicht.04 | 404 +++ app/eudas/5.3/src/eudas.verarbeiten.06 | 745 +++++ app/eudas/5.3/src/eudas.verwaltung.11 | 2047 ++++++++++++ app/eudas/5.3/src/isub.replace | 19 + app/eudas/5.3/src/menues.1 | 75 + app/eudas/5.3/src/pos.173 | 19 + app/eumelbase/2.2.1-schulis/source-disk | 1 + app/eumelbase/2.2.1-schulis/src/ACCESS.files | 7 + app/eumelbase/2.2.1-schulis/src/DIALOG.files | 8 + app/eumelbase/2.2.1-schulis/src/MM BAISY.files | 3 + app/eumelbase/2.2.1-schulis/src/db access.sc | 60 + app/eumelbase/2.2.1-schulis/src/db archive.sc | 7 + app/eumelbase/2.2.1-schulis/src/db ddinfo.sc | 24 + app/eumelbase/2.2.1-schulis/src/db ersatz.sc | 9 + app/eumelbase/2.2.1-schulis/src/db kernel.sc | 60 + app/eumelbase/2.2.1-schulis/src/db manager.sc | 18 + app/eumelbase/2.2.1-schulis/src/db memory.sc | 60 + app/eumelbase/2.2.1-schulis/src/db q.sc | 100 + app/eumelbase/2.2.1-schulis/src/db ref.sc | 10 + app/eumelbase/2.2.1-schulis/src/db sel.sc | 58 + app/eumelbase/2.2.1-schulis/src/db snd query.sc | 18 + app/eumelbase/2.2.1-schulis/src/db utils.sc | 60 + .../2.2.1-schulis/src/isp archive manager.sc | 79 + app/eumelbase/2.2.1-schulis/src/isp archive.sc | 35 + app/flint/0.4/doc/Zusammenstellung | 62 + app/flint/0.4/doc/flint.kurzanleitung | 141 + app/flint/0.4/source-disk | 1 + app/flint/0.4/src/MENUE.gen | 93 + app/flint/0.4/src/OPMENUE.gen | 42 + app/flint/0.4/src/boxzeichen | 3 + app/flint/0.4/src/dummy.configurate | 6 + app/flint/0.4/src/editormenue | 1008 ++++++ app/flint/0.4/src/eudas.manager | 216 ++ app/flint/0.4/src/flint | 808 +++++ app/flint/0.4/src/flint.init | 603 ++++ app/flint/0.4/src/flint.manager | 16 + app/flint/0.4/src/isub.replace | 19 + app/flint/0.4/src/klartextbelegung | 304 ++ app/flint/0.4/src/offline.1 | 5 + app/flint/0.4/src/offline.manager | 383 +++ app/flint/0.4/src/operator | 381 +++ app/flint/0.4/src/operator.1 | 39 + app/flint/0.4/src/operator.init | 390 +++ app/flint/0.4/src/operator.manager | 34 + app/flint/0.4/src/operator.spoolcmd | 113 + app/gs.dialog/1.2/doc/gs-dialog handbuch.impressum | 89 + app/gs.dialog/1.2/doc/gs-dialog-1 | 107 + app/gs.dialog/1.2/doc/gs-dialog-2 | 215 ++ app/gs.dialog/1.2/doc/gs-dialog-3 | 683 ++++ app/gs.dialog/1.2/doc/gs-dialog-4 | 672 ++++ app/gs.dialog/1.2/doc/gs-dialog-5 | 176 + app/gs.dialog/1.2/doc/gs-dialog-Inhaltsverzeichnis | 45 + app/gs.dialog/1.2/source-disk | 1 + app/gs.dialog/1.2/src/ls-DIALOG 1 | 60 + app/gs.dialog/1.2/src/ls-DIALOG 2 | 77 + app/gs.dialog/1.2/src/ls-DIALOG 3 | 48 + app/gs.dialog/1.2/src/ls-DIALOG 4 | 71 + app/gs.dialog/1.2/src/ls-DIALOG 5 | 118 + app/gs.dialog/1.2/src/ls-DIALOG 6 | 102 + app/gs.dialog/1.2/src/ls-DIALOG 7 | 54 + app/gs.dialog/1.2/src/ls-DIALOG MENUKARTEN MANAGER | 28 + app/gs.dialog/1.2/src/ls-DIALOG MM-gen | 27 + app/gs.dialog/1.2/src/ls-DIALOG decompress | 150 + app/gs.dialog/1.2/src/ls-DIALOG-gen | 34 + app/gs.dialog/1.2/src/ls-MENUKARTE:Archiv | Bin 0 -> 40960 bytes ...Doku: gs-Herbert und Robbi - Inhaltsverzeichnis | 45 + .../A5 - Doku: gs-Herbert und Robbi - Kapitel 1 | 93 + .../A5 - Doku: gs-Herbert und Robbi - Kapitel 2 | 389 +++ .../A5 - Doku: gs-Herbert und Robbi - Kapitel 3 | 199 ++ .../A5 - Doku: gs-Herbert und Robbi - Kapitel 4 | 1312 ++++++++ .../A5 - Doku: gs-Herbert und Robbi - Kapitel 5 | 167 + .../A5 - Doku: gs-Herbert und Robbi - Kapitel 6 | 73 + .../doc/gs-Herbert und Robbi handbuch.impressum | 87 + app/gs.hamster/1.1/source-disk | 1 + app/gs.hamster/1.1/src/ls-Herbert und Robbi 1 | 84 + app/gs.hamster/1.1/src/ls-Herbert und Robbi 2 | 31 + app/gs.hamster/1.1/src/ls-Herbert und Robbi 3 | 84 + app/gs.hamster/1.1/src/ls-Herbert und Robbi-gen | 33 + .../1.1/src/ls-MENUKARTE:Herbert und Robbi | Bin 0 -> 94720 bytes .../1.0/doc/menu-generator handbuch.1 | 100 + .../1.0/doc/menu-generator handbuch.2 | 87 + .../1.0/doc/menu-generator handbuch.3 | 155 + .../1.0/doc/menu-generator handbuch.4 | 424 +++ .../1.0/doc/menu-generator handbuch.5 | 975 ++++++ .../1.0/doc/menu-generator handbuch.6 | 235 ++ .../1.0/doc/menu-generator handbuch.7 | 367 +++ .../1.0/doc/menu-generator handbuch.8 | 1676 ++++++++++ .../1.0/doc/menu-generator handbuch.impressum | 88 + .../1.0/doc/menu-generator handbuch.index | 258 ++ .../1.0/doc/menu-generator handbuch.inhalt | 72 + app/gs.menugenerator/1.0/source-disk | 1 + .../1.0/src/Generatordatei: Archivmenu | 323 ++ .../1.0/src/fonttab.ls-Menu-Generator | Bin 0 -> 2560 bytes app/gs.menugenerator/1.0/src/ls-MENUBASISTEXTE | Bin 0 -> 17408 bytes app/gs.menugenerator/1.0/src/ls-Menu-Generator 1 | 47 + app/gs.menugenerator/1.0/src/ls-Menu-Generator 2 | 72 + app/gs.menugenerator/1.0/src/ls-Menu-Generator-gen | 30 + .../doc/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis | 50 + .../1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 1 | 119 + .../1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 2 | 302 ++ .../1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 3 | 237 ++ .../1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 4 | 638 ++++ .../1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 5 | 699 ++++ .../1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 6 | 53 + app/gs.mp-bap/1.1/doc/gs-MP BAP handbuch.impressum | 104 + app/gs.mp-bap/1.1/source-disk | 1 + app/gs.mp-bap/1.1/src/ls-MENUKARTE:MP-BAP | Bin 0 -> 79872 bytes app/gs.mp-bap/1.1/src/ls-MP BAP 1 | 119 + app/gs.mp-bap/1.1/src/ls-MP BAP 2 | 126 + app/gs.mp-bap/1.1/src/ls-MP BAP-gen | 30 + app/gs.process/1.02/doc/Anhang Prozess | 92 + app/gs.process/1.02/doc/Inhalt Prozess | 84 + .../1.02/doc/gs-Prozess handbuch.impressum | 104 + app/gs.process/1.02/doc/gs-Prozess-2 | 255 ++ app/gs.process/1.02/doc/gs-Prozess-3 | 346 ++ app/gs.process/1.02/doc/gs-Prozess-4 | 173 + app/gs.process/1.02/doc/gs-prozess-1 | 99 + app/gs.process/1.02/doc/gs-prozess-5 | 819 +++++ app/gs.process/1.02/doc/gs-prozess-6 | 641 ++++ app/gs.process/1.02/doc/gs-prozess-7 | 1121 +++++++ app/gs.process/1.02/doc/gs-prozess-8 | 377 +++ app/gs.process/1.02/doc/gs-prozess-9 | 477 +++ app/gs.process/1.02/source-disk | 1 + app/gs.process/1.02/src/ls-MENUKARTE:Prozess | Bin 0 -> 62464 bytes .../src/ls-Prozess 1 f\303\274r AKTRONIC-Adapter" | 57 + ...-Prozess 1 f\303\274r MUFI als Endger\303\244t" | 57 + .../ls-Prozess 1 f\303\274r MUFI im Terminalkanal" | 55 + app/gs.process/1.02/src/ls-Prozess 2 | 39 + app/gs.process/1.02/src/ls-Prozess 3 | 26 + app/gs.process/1.02/src/ls-Prozess 4 | 61 + app/gs.process/1.02/src/ls-Prozess 5 | 84 + app/gs.process/1.02/src/ls-Prozess-gen | 146 + app/gs.warenhaus/1.01/doc/Anhang Warenhaus | 65 + app/gs.warenhaus/1.01/doc/Inhalt Warenhaus | 50 + .../1.01/doc/gs-Warenhaus handbuch.impressum | 89 + app/gs.warenhaus/1.01/doc/gs-Warenhaus-1 | 124 + app/gs.warenhaus/1.01/doc/gs-Warenhaus-2 | 72 + app/gs.warenhaus/1.01/doc/gs-Warenhaus-3 | 309 ++ app/gs.warenhaus/1.01/doc/gs-Warenhaus-4 | 378 +++ app/gs.warenhaus/1.01/doc/gs-Warenhaus-5 | 1468 +++++++++ app/gs.warenhaus/1.01/doc/gs-Warenhaus-6 | 589 ++++ app/gs.warenhaus/1.01/doc/gs-Warenhaus-7 | 235 ++ app/gs.warenhaus/1.01/source-disk | 1 + app/gs.warenhaus/1.01/src/ls-MENUKARTE:Warenhaus | Bin 0 -> 60928 bytes ...arenhaus 0: mit Kartenleser an AKTRONIC-Adapter | 36 + ...0: mit Kartenleser an MUFI als Endger\303\244t" | 36 + ...aus 0: mit Kartenleser an MUFI im Terminalkanal | 30 + .../1.01/src/ls-Warenhaus 0: ohne Kartenleser | 27 + app/gs.warenhaus/1.01/src/ls-Warenhaus 1 | 37 + app/gs.warenhaus/1.01/src/ls-Warenhaus 2 | 112 + app/gs.warenhaus/1.01/src/ls-Warenhaus 3 | 82 + app/gs.warenhaus/1.01/src/ls-Warenhaus 4 | 48 + app/gs.warenhaus/1.01/src/ls-Warenhaus 5 | 103 + app/gs.warenhaus/1.01/src/ls-Warenhaus-gen | 29 + app/mpg/2.2/doc/GRAPHIK.dok.e | 2235 +++++++++++++ app/mpg/2.2/source-disk | 4 + app/mpg/2.2/src/AMPEX 2-1-6.GCONF | 84 + app/mpg/2.2/src/AMPEX 3-1-4.GCONF | 84 + app/mpg/2.2/src/Atari 3-9.GCONF | 119 + app/mpg/2.2/src/DATAGRAPH 3-7.GCONF | 119 + app/mpg/2.2/src/ENVIRONMENT2.GCONF | 5 + app/mpg/2.2/src/ENVIRONMENT3.GCONF | 7 + app/mpg/2.2/src/FKT.help | 24 + app/mpg/2.2/src/GRAPHIK.Basis | 1574 +++++++++ app/mpg/2.2/src/GRAPHIK.Configurator | 946 ++++++ app/mpg/2.2/src/GRAPHIK.Fkt | 1379 ++++++++ app/mpg/2.2/src/GRAPHIK.Install | 84 + app/mpg/2.2/src/GRAPHIK.Manager | 925 ++++++ app/mpg/2.2/src/GRAPHIK.Plot | 1237 +++++++ app/mpg/2.2/src/GRAPHIK.Turtle | 139 + app/mpg/2.2/src/GRAPHIK.list | 28 + app/mpg/2.2/src/HERCULES XT.GCONF | 105 + app/mpg/2.2/src/Muster | 75 + app/mpg/2.2/src/NEC P-3 3-15.GCONF | 126 + app/mpg/2.2/src/NEC P-6 MD.GCONF | 221 ++ app/mpg/2.2/src/NEC P-9 2-15.HD.GCONF | 244 ++ app/mpg/2.2/src/NEC P-9 2-15.MD.GCONF | 221 ++ app/mpg/2.2/src/PUBLIC.insert | 3412 ++++++++++++++++++++ app/mpg/2.2/src/VC 404 2-7.GCONF | 93 + app/mpg/2.2/src/VIDEOSTAR 3-6.GCONF | 92 + app/mpg/2.2/src/WATANABE 3-8.GCONF | 94 + app/mpg/2.2/src/ZEICHENSATZ | Bin 0 -> 9216 bytes app/mpg/2.2/src/matrix printer | 130 + app/mpg/2.2/src/printer.targets | 3 + app/mpg/2.2/src/std primitives | 80 + app/mpg/2.2/src/terminal plot | 114 + app/schulis-mathematiksystem/1.0/source-disk | 1 + .../1.0/src/PAC element row | 3 + .../1.0/src/PAC formula analyzer | 9 + .../1.0/src/PAC formula editor-anpassung | 12 + .../1.0/src/PAC op store-anpassung | 3 + app/schulis-mathematiksystem/1.0/src/PAC text row | 3 + app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 | Bin 0 -> 11264 bytes app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 | Bin 0 -> 9216 bytes app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 | Bin 0 -> 9728 bytes app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 | Bin 0 -> 9728 bytes app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 | Bin 0 -> 11264 bytes app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 | Bin 0 -> 11264 bytes app/schulis-mathematiksystem/1.0/src/ibmoperatoren | Bin 0 -> 41984 bytes .../1.0/src/ls-DIALOG 1.mathe | 4 + .../1.0/src/ls-DIALOG 2.mathe | 7 + .../1.0/src/ls-DIALOG 3.mathe | 3 + .../1.0/src/ls-DIALOG 4.mathe | 6 + .../1.0/src/ls-DIALOG 5.mathe | 9 + .../1.0/src/ls-MENUKARTE:Mathematik | Bin 0 -> 96768 bytes app/schulis-mathematiksystem/1.0/src/mat.abbildung | 13 + app/schulis-mathematiksystem/1.0/src/mat.ausgabe | 2 + .../1.0/src/mat.basis plot | 2 + .../1.0/src/mat.binder plot | 4 + app/schulis-mathematiksystem/1.0/src/mat.cga plot | 3 + .../1.0/src/mat.dialoghilfen | 5 + .../1.0/src/mat.druckermenu | 2 + app/schulis-mathematiksystem/1.0/src/mat.ega plot | 4 + .../1.0/src/mat.epson-fx plot | 4 + .../1.0/src/mat.epson-sq plot | 4 + .../1.0/src/mat.formeleditormanager | 4 + .../1.0/src/mat.funktionsbibliothek | 2 + .../1.0/src/mat.graphicverfahren | 14 + .../1.0/src/mat.hercules plot | 3 + .../1.0/src/mat.hp72xx plot | 3 + .../1.0/src/mat.hp74xx plot | 3 + .../1.0/src/mat.integrationsverfahren | 7 + .../1.0/src/mat.iterationsverfahren | 5 + .../1.0/src/mat.kyocera plot | 3 + .../1.0/src/mat.laserjet plot | 3 + app/schulis-mathematiksystem/1.0/src/mat.masken | 4 + .../1.0/src/mat.menufunktionen | 7 + .../1.0/src/mat.nullstellen | 6 + app/schulis-mathematiksystem/1.0/src/mat.parser | 12 + app/schulis-mathematiksystem/1.0/src/mat.picture | 2 + .../1.0/src/mat.referenzobjekte | 8 + .../1.0/src/mat.specialgraphic | 4 + app/schulis-mathematiksystem/1.0/src/mat.umformung | 3 + app/schulis-mathematiksystem/1.0/src/mat.vector | 2 + .../1.0/src/mat.verwaltung | 1032 ++++++ app/schulis-mathematiksystem/1.0/src/mat.vga plot | 3 + .../1.0/src/mat.wertetabelle | 4 + .../1.0/src/mat.xerox4045 plot | 4 + .../1.0/src/mathe formulare | Bin 0 -> 56320 bytes app/schulis-mathematiksystem/1.0/src/spool cmd | 3 + .../1.0/src/standardoperatoren | Bin 0 -> 41984 bytes .../Biologie 1: Populations\303\266kologie" | Bin 0 -> 69632 bytes ...3\266kologie 1 code info ds" | Bin 0 -> 4608 bytes ...6kologie 1 originalkurve ds" | Bin 0 -> 5120 bytes ...ologie 1 vergleichskurve ds" | Bin 0 -> 5120 bytes ...\266kologie 10 code info ds" | Bin 0 -> 2560 bytes ...\266kologie 11 code info ds" | Bin 0 -> 3072 bytes ...\266kologie 12 code info ds" | Bin 0 -> 2560 bytes ...\266kologie 13 code info ds" | Bin 0 -> 2560 bytes ...\266kologie 14 code info ds" | Bin 0 -> 2560 bytes ...3\266kologie 2 code info ds" | Bin 0 -> 4608 bytes ...6kologie 2 originalkurve ds" | Bin 0 -> 3072 bytes ...ologie 2 vergleichskurve ds" | Bin 0 -> 3072 bytes ...3\266kologie 3 code info ds" | Bin 0 -> 4096 bytes ...6kologie 3 originalkurve ds" | Bin 0 -> 5120 bytes ...ologie 3 vergleichskurve ds" | Bin 0 -> 5120 bytes ...3\266kologie 4 code info ds" | Bin 0 -> 5120 bytes ...6kologie 4 originalkurve ds" | Bin 0 -> 5120 bytes ...ologie 4 vergleichskurve ds" | Bin 0 -> 5120 bytes ...3\266kologie 5 code info ds" | Bin 0 -> 3072 bytes ...6kologie 5 originalkurve ds" | Bin 0 -> 5120 bytes ...ologie 5 vergleichskurve ds" | Bin 0 -> 5120 bytes ...3\266kologie 6 code info ds" | Bin 0 -> 3584 bytes ...6kologie 6 originalkurve ds" | Bin 0 -> 5632 bytes ...ologie 6 vergleichskurve ds" | Bin 0 -> 6144 bytes ...3\266kologie 7 code info ds" | Bin 0 -> 3584 bytes ...6kologie 7 originalkurve ds" | Bin 0 -> 5632 bytes ...ologie 7 vergleichskurve ds" | Bin 0 -> 5120 bytes ...3\266kologie 8 code info ds" | Bin 0 -> 2560 bytes ...3\266kologie 9 code info ds" | Bin 0 -> 2560 bytes .../3.0/data/biology/Biologie 2: Enzymkinetik | Bin 0 -> 60928 bytes ...inetik 1 code info ds | Bin 0 -> 84480 bytes ...ik 1 originalkurve ds | Bin 0 -> 7168 bytes ... 1 vergleichskurve ds | Bin 0 -> 7168 bytes ...inetik 2 code info ds | Bin 0 -> 79360 bytes ...ik 2 originalkurve ds | Bin 0 -> 8704 bytes ... 2 vergleichskurve ds | Bin 0 -> 8704 bytes ...inetik 3 code info ds | Bin 0 -> 2560 bytes ...inetik 4 code info ds | Bin 0 -> 3072 bytes .../Chemie - Physik: Radioaktiver Zerfall | Bin 0 -> 66048 bytes ...adioaktiver Zerfall 1 code info ds | Bin 0 -> 99328 bytes ...aktiver Zerfall 1 originalkurve ds | Bin 0 -> 5120 bytes ...tiver Zerfall 1 vergleichskurve ds | Bin 0 -> 5120 bytes ...dioaktiver Zerfall 10 code info ds | Bin 0 -> 2560 bytes ...adioaktiver Zerfall 2 code info ds | Bin 0 -> 3584 bytes ...aktiver Zerfall 2 originalkurve ds | Bin 0 -> 7168 bytes ...tiver Zerfall 2 vergleichskurve ds | Bin 0 -> 7168 bytes ...adioaktiver Zerfall 3 code info ds | Bin 0 -> 3584 bytes ...aktiver Zerfall 3 originalkurve ds | Bin 0 -> 8192 bytes ...tiver Zerfall 3 vergleichskurve ds | Bin 0 -> 8192 bytes ...adioaktiver Zerfall 4 code info ds | Bin 0 -> 3584 bytes ...aktiver Zerfall 4 originalkurve ds | Bin 0 -> 8192 bytes ...tiver Zerfall 4 vergleichskurve ds | Bin 0 -> 8192 bytes ...adioaktiver Zerfall 5 code info ds | Bin 0 -> 3072 bytes ...aktiver Zerfall 5 originalkurve ds | Bin 0 -> 7168 bytes ...tiver Zerfall 5 vergleichskurve ds | Bin 0 -> 7168 bytes ...adioaktiver Zerfall 6 code info ds | Bin 0 -> 2560 bytes ...adioaktiver Zerfall 7 code info ds | Bin 0 -> 2560 bytes ...adioaktiver Zerfall 8 code info ds | Bin 0 -> 3072 bytes ...adioaktiver Zerfall 9 code info ds | Bin 0 -> 3072 bytes .../data/chemistry/Chemie 1: Reaktionskinetik I | Bin 0 -> 61952 bytes ...skinetik I 1 code info ds | Bin 0 -> 3584 bytes ...etik I 1 originalkurve ds | Bin 0 -> 6144 bytes ...ik I 1 vergleichskurve ds | Bin 0 -> 6144 bytes ...skinetik I 2 code info ds | Bin 0 -> 3072 bytes ...etik I 2 originalkurve ds | Bin 0 -> 6144 bytes ...ik I 2 vergleichskurve ds | Bin 0 -> 6144 bytes ...skinetik I 3 code info ds | Bin 0 -> 3584 bytes ...etik I 3 originalkurve ds | Bin 0 -> 7168 bytes ...ik I 3 vergleichskurve ds | Bin 0 -> 7168 bytes ...skinetik I 4 code info ds | Bin 0 -> 2560 bytes ...skinetik I 5 code info ds | Bin 0 -> 2560 bytes ...skinetik I 6 code info ds | Bin 0 -> 2560 bytes .../data/chemistry/Chemie 2: Reaktionskinetik II | Bin 0 -> 69120 bytes ...skinetik II 1 code info ds | Bin 0 -> 3072 bytes ...etik II 1 originalkurve ds | Bin 0 -> 6144 bytes ...ik II 1 vergleichskurve ds | Bin 0 -> 6144 bytes ...kinetik II 10 code info ds | Bin 0 -> 2560 bytes ...kinetik II 11 code info ds | Bin 0 -> 2560 bytes ...kinetik II 12 code info ds | Bin 0 -> 2560 bytes ...kinetik II 13 code info ds | Bin 0 -> 2560 bytes ...kinetik II 14 code info ds | Bin 0 -> 3072 bytes ...skinetik II 2 code info ds | Bin 0 -> 3584 bytes ...etik II 2 originalkurve ds | Bin 0 -> 7168 bytes ...ik II 2 vergleichskurve ds | Bin 0 -> 7680 bytes ...skinetik II 3 code info ds | Bin 0 -> 3072 bytes ...etik II 3 originalkurve ds | Bin 0 -> 6144 bytes ...ik II 3 vergleichskurve ds | Bin 0 -> 6144 bytes ...skinetik II 4 code info ds | Bin 0 -> 3072 bytes ...etik II 4 originalkurve ds | Bin 0 -> 6144 bytes ...ik II 4 vergleichskurve ds | Bin 0 -> 6144 bytes ...skinetik II 5 code info ds | Bin 0 -> 3584 bytes ...etik II 5 originalkurve ds | Bin 0 -> 6144 bytes ...ik II 5 vergleichskurve ds | Bin 0 -> 6144 bytes ...skinetik II 6 code info ds | Bin 0 -> 3584 bytes ...etik II 6 originalkurve ds | Bin 0 -> 6144 bytes ...ik II 6 vergleichskurve ds | Bin 0 -> 6144 bytes ...skinetik II 7 code info ds | Bin 0 -> 4096 bytes ...etik II 7 originalkurve ds | Bin 0 -> 7680 bytes ...ik II 7 vergleichskurve ds | Bin 0 -> 7168 bytes ...skinetik II 8 code info ds | Bin 0 -> 2560 bytes ...skinetik II 9 code info ds | Bin 0 -> 2560 bytes .../Physik 1: Bewegungen im Gravitationsfeld | Bin 0 -> 65536 bytes ...en im Gravitationsfeld 1 code info ds | Bin 0 -> 4608 bytes ...m Gravitationsfeld 1 originalkurve ds | Bin 0 -> 16896 bytes ...Gravitationsfeld 1 vergleichskurve ds | Bin 0 -> 16896 bytes ...en im Gravitationsfeld 2 code info ds | Bin 0 -> 5120 bytes ...m Gravitationsfeld 2 originalkurve ds | Bin 0 -> 8192 bytes ...Gravitationsfeld 2 vergleichskurve ds | Bin 0 -> 8192 bytes ...en im Gravitationsfeld 3 code info ds | Bin 0 -> 4096 bytes ...m Gravitationsfeld 3 originalkurve ds | Bin 0 -> 6144 bytes ...Gravitationsfeld 3 vergleichskurve ds | Bin 0 -> 6144 bytes ...en im Gravitationsfeld 4 code info ds | Bin 0 -> 4608 bytes ...m Gravitationsfeld 4 originalkurve ds | Bin 0 -> 8704 bytes ...Gravitationsfeld 4 vergleichskurve ds | Bin 0 -> 8704 bytes ...en im Gravitationsfeld 5 code info ds | Bin 0 -> 2560 bytes ...en im Gravitationsfeld 6 code info ds | Bin 0 -> 3072 bytes ...en im Gravitationsfeld 7 code info ds | Bin 0 -> 2560 bytes ...en im Gravitationsfeld 8 code info ds | Bin 0 -> 3072 bytes .../physics/Physik 2: Mechanische Schwingungen | Bin 0 -> 61952 bytes ...che Schwingungen 1 code info ds | Bin 0 -> 3584 bytes ...Schwingungen 1 originalkurve ds | Bin 0 -> 6144 bytes ...hwingungen 1 vergleichskurve ds | Bin 0 -> 7168 bytes ...che Schwingungen 2 code info ds | Bin 0 -> 3072 bytes ...Schwingungen 2 originalkurve ds | Bin 0 -> 5120 bytes ...hwingungen 2 vergleichskurve ds | Bin 0 -> 5120 bytes ...che Schwingungen 3 code info ds | Bin 0 -> 3072 bytes ...Schwingungen 3 originalkurve ds | Bin 0 -> 5120 bytes ...hwingungen 3 vergleichskurve ds | Bin 0 -> 5120 bytes ...che Schwingungen 4 code info ds | Bin 0 -> 2560 bytes ...che Schwingungen 5 code info ds | Bin 0 -> 2560 bytes ...che Schwingungen 6 code info ds | Bin 0 -> 2560 bytes ...ysik 3: Ladungen in elektr. und magnet. Feldern | Bin 0 -> 67584 bytes ... in elektr. und magnet. Feldern 1 code info ds | Bin 0 -> 3584 bytes ...elektr. und magnet. Feldern 1 originalkurve ds | Bin 0 -> 12800 bytes ...ektr. und magnet. Feldern 1 vergleichskurve ds | Bin 0 -> 8704 bytes ...in elektr. und magnet. Feldern 10 code info ds | Bin 0 -> 2560 bytes ... in elektr. und magnet. Feldern 2 code info ds | Bin 0 -> 4096 bytes ...elektr. und magnet. Feldern 2 originalkurve ds | Bin 0 -> 8192 bytes ...ektr. und magnet. Feldern 2 vergleichskurve ds | Bin 0 -> 8192 bytes ... in elektr. und magnet. Feldern 3 code info ds | Bin 0 -> 4096 bytes ...elektr. und magnet. Feldern 3 originalkurve ds | Bin 0 -> 26112 bytes ...ektr. und magnet. Feldern 3 vergleichskurve ds | Bin 0 -> 16384 bytes ... in elektr. und magnet. Feldern 4 code info ds | Bin 0 -> 4096 bytes ...elektr. und magnet. Feldern 4 originalkurve ds | Bin 0 -> 8192 bytes ...ektr. und magnet. Feldern 4 vergleichskurve ds | Bin 0 -> 7680 bytes ... in elektr. und magnet. Feldern 5 code info ds | Bin 0 -> 4608 bytes ...elektr. und magnet. Feldern 5 originalkurve ds | Bin 0 -> 8192 bytes ...ektr. und magnet. Feldern 5 vergleichskurve ds | Bin 0 -> 8704 bytes ... in elektr. und magnet. Feldern 6 code info ds | Bin 0 -> 2560 bytes ... in elektr. und magnet. Feldern 7 code info ds | Bin 0 -> 3072 bytes ... in elektr. und magnet. Feldern 8 code info ds | Bin 0 -> 3072 bytes ... in elektr. und magnet. Feldern 9 code info ds | Bin 0 -> 3072 bytes .../3.0/data/physics/Physik 4: RLC-Schaltungen | Bin 0 -> 67072 bytes ...ltungen 1 code info ds | Bin 0 -> 3584 bytes ...gen 1 originalkurve ds | Bin 0 -> 5120 bytes ...n 1 vergleichskurve ds | Bin 0 -> 5120 bytes ...tungen 10 code info ds | Bin 0 -> 2560 bytes ...tungen 11 code info ds | Bin 0 -> 2560 bytes ...tungen 12 code info ds | Bin 0 -> 3584 bytes ...tungen 13 code info ds | Bin 0 -> 2560 bytes ...tungen 14 code info ds | Bin 0 -> 3072 bytes ...ltungen 2 code info ds | Bin 0 -> 2560 bytes ...gen 2 originalkurve ds | Bin 0 -> 6144 bytes ...n 2 vergleichskurve ds | Bin 0 -> 10752 bytes ...ltungen 3 code info ds | Bin 0 -> 3584 bytes ...gen 3 originalkurve ds | Bin 0 -> 5120 bytes ...n 3 vergleichskurve ds | Bin 0 -> 5120 bytes ...ltungen 4 code info ds | Bin 0 -> 3584 bytes ...gen 4 originalkurve ds | Bin 0 -> 5120 bytes ...n 4 vergleichskurve ds | Bin 0 -> 5120 bytes ...ltungen 5 code info ds | Bin 0 -> 4608 bytes ...gen 5 originalkurve ds | Bin 0 -> 5120 bytes ...n 5 vergleichskurve ds | Bin 0 -> 5632 bytes ...ltungen 6 code info ds | Bin 0 -> 3072 bytes ...gen 6 originalkurve ds | Bin 0 -> 5120 bytes ...n 6 vergleichskurve ds | Bin 0 -> 5632 bytes ...ltungen 7 code info ds | Bin 0 -> 4096 bytes ...gen 7 originalkurve ds | Bin 0 -> 6144 bytes ...n 7 vergleichskurve ds | Bin 0 -> 6144 bytes ...ltungen 8 code info ds | Bin 0 -> 2560 bytes ...ltungen 9 code info ds | Bin 0 -> 2560 bytes .../physics/Physik 5: Relativistische Bewegungen | Bin 0 -> 62976 bytes ...stische Bewegungen 1 code info ds | Bin 0 -> 4096 bytes ...che Bewegungen 1 originalkurve ds | Bin 0 -> 8192 bytes ...e Bewegungen 1 vergleichskurve ds | Bin 0 -> 7168 bytes ...stische Bewegungen 2 code info ds | Bin 0 -> 4096 bytes ...che Bewegungen 2 originalkurve ds | Bin 0 -> 7680 bytes ...e Bewegungen 2 vergleichskurve ds | Bin 0 -> 7680 bytes ...stische Bewegungen 3 code info ds | Bin 0 -> 4096 bytes ...che Bewegungen 3 originalkurve ds | Bin 0 -> 8704 bytes ...e Bewegungen 3 vergleichskurve ds | Bin 0 -> 7168 bytes ...stische Bewegungen 4 code info ds | Bin 0 -> 3072 bytes ...stische Bewegungen 5 code info ds | Bin 0 -> 3072 bytes ...stische Bewegungen 6 code info ds | Bin 0 -> 3072 bytes app/schulis-simulationssystem/3.0/source-disk | 4 + .../3.0/src/TEXTE deutsch | Bin 0 -> 115200 bytes app/schulis-simulationssystem/3.0/src/ZEICHEN 6*10 | Bin 0 -> 11264 bytes app/schulis-simulationssystem/3.0/src/ZEICHEN 8*14 | Bin 0 -> 9216 bytes app/schulis-simulationssystem/3.0/src/ZEICHEN 8*16 | Bin 0 -> 9728 bytes app/schulis-simulationssystem/3.0/src/ZEICHEN 8*19 | Bin 0 -> 9728 bytes app/schulis-simulationssystem/3.0/src/ZEICHEN 8*8 | Bin 0 -> 8192 bytes app/schulis-simulationssystem/3.0/src/ZEICHEN 9*14 | Bin 0 -> 11264 bytes app/schulis-simulationssystem/3.0/src/bs | 2 + app/schulis-simulationssystem/3.0/src/dp2 | 10 + app/schulis-simulationssystem/3.0/src/e | 2 + app/schulis-simulationssystem/3.0/src/g | 4 + .../3.0/src/ls bildschirmeingaben | 5 + .../3.0/src/ls co routinen und co | 11 + .../3.0/src/ls dateiscroll | 5 + .../3.0/src/ls demonstration | 4 + .../3.0/src/ls dialoghilfen | 9 + app/schulis-simulationssystem/3.0/src/ls dp1 | 4 + .../3.0/src/ls kombination | 3 + .../3.0/src/ls simsel.masken | 4 + .../3.0/src/ls simselstarter | 11 + .../3.0/src/ls simulation | 5 + .../3.0/src/ls starte bearbeitung | 2 + .../3.0/src/ls zustaende parameter kurve | 6 + .../3.0/src/ls-DIALOG 1.korrektur | 4 + .../3.0/src/ls-DIALOG 2.simsel | 9 + .../3.0/src/ls-DIALOG 3.korrektur | 3 + .../3.0/src/ls-DIALOG 4.wd | 6 + .../3.0/src/ls-DIALOG 5.korrektur | 12 + .../3.0/src/ls-DIALOG 5.simsel | 12 + .../3.0/src/ls-MENUKARTE:Simsel | Bin 0 -> 97792 bytes app/schulis-simulationssystem/3.0/src/ltbearb | 8 + app/schulis-simulationssystem/3.0/src/m | 3 + .../3.0/src/mat.binder plot | 5 + .../3.0/src/mat.epson-fx plot | 4 + .../3.0/src/mat.epson-sq plot | 4 + .../3.0/src/mat.hp72xx plot | 3 + .../3.0/src/mat.hp74xx plot | 3 + .../3.0/src/mat.kyocera plot | 3 + .../3.0/src/mat.laserjet plot | 3 + .../3.0/src/mat.xerox4045 plot | 4 + .../3.0/src/modellbasis dialog | 24 + .../3.0/src/modellbasis geraet | 9 + app/schulis-simulationssystem/3.0/src/modellwerte | 3 + .../3.0/src/neue startschl | 3 + app/schulis-simulationssystem/3.0/src/o | 2 + app/schulis-simulationssystem/3.0/src/op1 | 4 + app/schulis-simulationssystem/3.0/src/op2 | 11 + app/schulis-simulationssystem/3.0/src/output | 7 + app/schulis-simulationssystem/3.0/src/output test | 5 + .../3.0/src/simsel basis plot | 4 + .../3.0/src/simsel cga plot | 3 + .../3.0/src/simsel ega plot | 3 + .../3.0/src/simsel formulare | Bin 0 -> 38912 bytes .../3.0/src/simsel hercules plot | 3 + .../3.0/src/simsel picture | 3 + .../3.0/src/simsel vga plot | 3 + .../3.0/src/simsel.druckermenu | 2 + .../3.0/src/simsel.text als row | 2 + .../3.0/src/simsel.verwaltung | 7 + app/schulis-simulationssystem/3.0/src/spool cmd | 3 + app/schulis-simulationssystem/3.0/src/steuerung | 6 + app/schulis/2.2.1/data/db/2.BAISY-0 | Bin 0 -> 225280 bytes app/schulis/2.2.1/data/db/2.BAISY-1 | Bin 0 -> 87552 bytes app/schulis/2.2.1/data/db/BAISY-2 | Bin 0 -> 16384 bytes app/schulis/2.2.1/data/db/BAISY-3 | Bin 0 -> 226304 bytes app/schulis/2.2.1/data/db/BAISY-4 | Bin 0 -> 166400 bytes app/schulis/2.2.1/data/db/EUMELbase.baisy | Bin 0 -> 5120 bytes app/schulis/2.2.1/data/db/EUMELbase.baisy.data0 | Bin 0 -> 4096 bytes app/schulis/2.2.1/data/db/EUMELbase.baisy.data1 | Bin 0 -> 184320 bytes app/schulis/2.2.1/data/db/EUMELbase.baisy.tree0 | Bin 0 -> 1536 bytes app/schulis/2.2.1/data/db/EUMELbase.baisy.tree1 | Bin 0 -> 46080 bytes .../2.2.1/data/db/EUMELbase.baisy.treedescription | Bin 0 -> 49152 bytes app/schulis/2.2.1/data/db/EUMELbase.schulis | Bin 0 -> 28160 bytes app/schulis/2.2.1/data/db/EUMELbase.schulis.data0 | Bin 0 -> 4096 bytes app/schulis/2.2.1/data/db/EUMELbase.schulis.data1 | Bin 0 -> 16384 bytes app/schulis/2.2.1/data/db/EUMELbase.schulis.tree0 | Bin 0 -> 1536 bytes app/schulis/2.2.1/data/db/EUMELbase.schulis.tree1 | Bin 0 -> 18944 bytes .../data/db/EUMELbase.schulis.treedescription | Bin 0 -> 49152 bytes app/schulis/2.2.1/data/vordrucke/VORDRUCKE.files | 49 + .../data/vordrucke/fehlerliste konsistenzpruefung | 64 + .../vordruck anmeldebestaetigung zur jgst 11 | 47 + .../vordruck anmeldebestaetigung zur jgst 5 | 38 + ...er anschreiben an herkunftsschulen fuer jgst 11 | 15 + ...uer anschreiben an herkunftsschulen fuer jgst 5 | 13 + .../2.2.1/data/vordrucke/vordruck fuer wiederholer | 44 + .../2.2.1/data/vordrucke/vordruck klassenbuchliste | 5 + .../vordruck mitteilung ueber eine abmeldung | 54 + ...druck mitteilung ueber eine anmeldung mit diffd | 44 + ...ordruck mitteilung ueber eine anmeldung mit hjd | 48 + .../vordrucke/vordruck nachpruefungsbescheinigung | 34 + .../data/vordrucke/vordruck nachpruefungszulassung | 48 + .../data/vordrucke/vordruck schulbescheinigung | 29 + .../data/vordrucke/vordruck1 auskunft betroffene | 60 + .../2.2.1/data/vordrucke/vordruck1 auskunft lehrer | 38 + .../data/vordrucke/vordruck1 einzelstdpl lehrer | 13 + .../data/vordrucke/vordruck1 einzelstdpl raeume | 13 + .../data/vordrucke/vordruck1 einzelstdpl sek1 | 14 + .../data/vordrucke/vordruck1 einzelstdpl sek2 | 14 + .../2.2.1/data/vordrucke/vordruck1 kursli kopfueb | 10 + .../data/vordrucke/vordruck1 protokoll versetzkonf | 6 + .../vordruck1 unterrichtsvertlg fuer lehrer | 21 + .../2.2.1/data/vordrucke/vordruck1 vertretungen | 14 + .../data/vordrucke/vordruck2 auskunft betroffene | 3 + .../2.2.1/data/vordrucke/vordruck2 auskunft lehrer | 7 + .../data/vordrucke/vordruck2 einzelstdpl lehrer | 9 + .../data/vordrucke/vordruck2 einzelstdpl raeume | 4 + .../data/vordrucke/vordruck2 einzelstdpl sek1 | 3 + .../data/vordrucke/vordruck2 einzelstdpl sek2 | 3 + .../2.2.1/data/vordrucke/vordruck2 kursli zeile | 3 + .../data/vordrucke/vordruck2 protokoll versetzkonf | 13 + .../vordruck2 unterrichtsvertlg fuer lehrer | 3 + .../2.2.1/data/vordrucke/vordruck2 vertretungen | 3 + .../data/vordrucke/vordruck3 auskunft betroffene | 28 + .../2.2.1/data/vordrucke/vordruck3 auskunft lehrer | 3 + .../data/vordrucke/vordruck3 einzelstdpl lehrer | 3 + .../data/vordrucke/vordruck3 einzelstdpl sek1 | 7 + .../data/vordrucke/vordruck3 protokoll versetzkonf | 9 + .../data/vordrucke/vordruck4 auskunft betroffene | 23 + .../2.2.1/data/vordrucke/vordruck4 auskunft lehrer | 7 + .../data/vordrucke/vordruck4 einzelstdpl sek1 | 3 + .../data/vordrucke/vordruck5 auskunft betroffene | 38 + .../2.2.1/data/vordrucke/vordruck5 auskunft lehrer | 20 + .../data/vordrucke/vordruck5 einzelstdpl sek1 | 9 + .../2.2.1/data/vordrucke/vordruck6 auskunft lehrer | 5 + .../data/vordrucke/vordruck6 einzelstdpl sek1 | 3 + .../2.2.1/data/vordrucke/vordruck7 auskunft lehrer | 3 + .../data/vordrucke/vordruck7 einzelstdpl sek1 | 3 + app/schulis/2.2.1/source-disk | 5 + app/schulis/2.2.1/src/0.ANSCHREIBEN.files | 14 + .../2.2.1/src/0.ANSCHRLISTWERKZEUGE TEIL2.files | 6 + app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE.files | 6 + .../2.2.1/src/0.ERFASSUNGEN EINZELN 2.files | 10 + app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN.files | 15 + .../2.2.1/src/0.ERFASSUNGEN LISTENWEISE.files | 10 + app/schulis/2.2.1/src/0.ERFASSUNGEN.files | 2 + app/schulis/2.2.1/src/0.IDA SERVER.files | 4 + app/schulis/2.2.1/src/0.IDA SICHERUNG.files | 4 + app/schulis/2.2.1/src/0.LISTEN 2.files | 18 + app/schulis/2.2.1/src/0.LISTEN.files | 15 + app/schulis/2.2.1/src/0.LOCAL.files | 4 + app/schulis/2.2.1/src/0.anschr.druckereinstellung | 69 + app/schulis/2.2.1/src/0.anschr.grundfunktionen | 193 ++ .../2.2.1/src/0.anschr.steuerfunktionen einfach | 96 + .../src/0.anschr.steuerfunktionen zusammengesetzt | 87 + app/schulis/2.2.1/src/0.erf aufsichtszeiten | 201 ++ app/schulis/2.2.1/src/0.erf zeitraster | 145 + app/schulis/2.2.1/src/0.erf.faecher | 38 + app/schulis/2.2.1/src/0.erf.schuldaten | 51 + app/schulis/2.2.1/src/0.grundfunktionen local | 132 + app/schulis/2.2.1/src/0.hjd grundfunktionen | 110 + app/schulis/2.2.1/src/0.hoeherstufen local.prog | 312 ++ app/schulis/2.2.1/src/0.ida.data | 170 + app/schulis/2.2.1/src/0.ida.form | 34 + app/schulis/2.2.1/src/0.ida.server | 51 + app/schulis/2.2.1/src/0.klassengruppen definieren | 81 + app/schulis/2.2.1/src/0.kurswahlbasis bereinigen | 34 + app/schulis/2.2.1/src/0.liste der aufsichtszeiten | 93 + app/schulis/2.2.1/src/0.liste der zeitrasterdaten | 101 + app/schulis/2.2.1/src/0.listen.benutz | 84 + app/schulis/2.2.1/src/0.listen.druckbearbeitung | 207 ++ app/schulis/2.2.1/src/0.listen.faecher | 86 + app/schulis/2.2.1/src/0.listen.klassengruppen | 104 + app/schulis/2.2.1/src/0.listen.raumgruppen | 97 + app/schulis/2.2.1/src/0.listen.schlueabku | 69 + app/schulis/2.2.1/src/0.listen.schuelergruppen | 109 + app/schulis/2.2.1/src/0.listen.schulen | 87 + app/schulis/2.2.1/src/0.listen.steuerung | 67 + app/schulis/2.2.1/src/0.listen.werkzeuge | 29 + .../2.2.1/src/0.listenweise grundfunktionen | 51 + app/schulis/2.2.1/src/0.listenweise klassen erf | 215 ++ app/schulis/2.2.1/src/0.raumgruppen bearbeiten | 54 + app/schulis/2.2.1/src/0.schulis schrifttyp | 9 + app/schulis/2.2.1/src/0.schulkenndaten bearbeiten | 109 + app/schulis/2.2.1/src/1.abgegangene aussortieren | 75 + ...1.anschr.anmeldebestaetigung fuer jgst 5 und 11 | 58 + ...chr.mitteilungen neuangemeldete und abgemeldete | 262 ++ .../2.2.1/src/1.anschr.nachpruefungsbescheinigung | 150 + .../2.2.1/src/1.anschr.nachpruefungszulassung | 146 + app/schulis/2.2.1/src/1.anschr.schulbescheinigung | 61 + app/schulis/2.2.1/src/1.anschr.wiederholer | 91 + app/schulis/2.2.1/src/1.auskunft.betroffene | 259 ++ app/schulis/2.2.1/src/1.erf.abmeldedaten | 142 + app/schulis/2.2.1/src/1.erf.schuelerdaten | 605 ++++ app/schulis/2.2.1/src/1.halbjahresdaten bearbeiten | 679 ++++ app/schulis/2.2.1/src/1.hoeherstufen anw do.prog | 43 + app/schulis/2.2.1/src/1.listen.abgem | 115 + app/schulis/2.2.1/src/1.listen.adressen | 186 ++ app/schulis/2.2.1/src/1.listen.anherk | 124 + app/schulis/2.2.1/src/1.listen.gebu | 125 + app/schulis/2.2.1/src/1.listen.gesamt | 106 + app/schulis/2.2.1/src/1.listen.klassen | 157 + app/schulis/2.2.1/src/1.listen.klassenbuch | 237 ++ app/schulis/2.2.1/src/1.listen.nachpruefung | 155 + app/schulis/2.2.1/src/1.listen.neuan | 121 + .../2.2.1/src/1.listen.prot versetzkonferenz | 162 + app/schulis/2.2.1/src/1.listen.wiederholer | 160 + app/schulis/2.2.1/src/1.listenweise dif dat erf | 255 ++ app/schulis/2.2.1/src/1.listenweise erg nachpr | 250 ++ app/schulis/2.2.1/src/1.listenweise erg vers konf | 219 ++ app/schulis/2.2.1/src/1.listenweise klassenbildung | 270 ++ app/schulis/2.2.1/src/1.schuelerjgst aendern | 161 + app/schulis/2.2.1/src/1.stat grundfunktionen | 70 + app/schulis/2.2.1/src/1.stat intern | 337 ++ .../2.2.1/src/2.AUSWERTUNGEN KURSWAHL.files | 7 + .../2.2.1/src/2.ERFASSUNGEN KURSWAHL 2.files | 5 + app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL.files | 8 + app/schulis/2.2.1/src/2.erf wahldaten | 395 +++ .../2.2.1/src/2.halbjahreswechsel fuer kursdaten | 77 + .../2.2.1/src/2.konsistenzpruefung in kursdaten | 75 + app/schulis/2.2.1/src/2.kursdaten exportieren | 226 ++ app/schulis/2.2.1/src/2.kursdaten importieren | 199 ++ .../2.2.1/src/2.kurse auf planbloecke legen | 449 +++ app/schulis/2.2.1/src/2.kurswahl schnittstelle | 664 ++++ ...uordnung und umwahl fuer einzelne schueler sek2 | 420 +++ app/schulis/2.2.1/src/2.kw anschr kurslisten sek2 | 90 + .../2.2.1/src/2.likw kurskombinationen sek2 | 166 + app/schulis/2.2.1/src/2.likw schuelerwahl sek2 | 173 + .../2.2.1/src/2.likw wahl und kursdaten sek2 | 246 ++ .../2.2.1/src/2.schueler zu kursen zuordnen | 384 +++ .../2.2.1/src/2.stand der kursbildung analysieren | 132 + app/schulis/2.2.1/src/3.anschr.betroffene lehrer | 174 + app/schulis/2.2.1/src/3.erf lehrer | 134 + .../2.2.1/src/3.listen.lehrbef faecherweise | 104 + app/schulis/2.2.1/src/3.listen.lehrbef lehrerweise | 100 + app/schulis/2.2.1/src/3.listen.paraphen | 81 + app/schulis/2.2.1/src/3.listen.sprechzeiten | 99 + app/schulis/2.2.1/src/3.listen.wochenstunden | 114 + app/schulis/2.2.1/src/3.listenweise lehrer erf | 95 + .../2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 2.files | 5 + .../2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 3.files | 6 + .../2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN.files | 11 + .../2.2.1/src/4.ERFASSUNGEN LISTENWEISE 2.files | 6 + .../2.2.1/src/4.ERFASSUNGEN LISTENWEISE 3.files | 7 + .../2.2.1/src/4.ERFASSUNGEN STUNDENPLAN.files | 11 + .../src/4.anschr.unterrichtsvertlg fuer lehrer | 137 + app/schulis/2.2.1/src/4.anschr.vertretungen | 149 + app/schulis/2.2.1/src/4.aufsichten erstellen | 194 ++ .../src/4.daten f\303\274r intega aufbereiten" | 462 +++ .../src/4.daten f\303\274r schulis aufbereiten" | 184 ++ .../2.2.1/src/4.einhaltung zeitwuensche pruefen | 195 ++ app/schulis/2.2.1/src/4.einzelstdpl.lehrer | 113 + app/schulis/2.2.1/src/4.einzelstdpl.raeume | 86 + app/schulis/2.2.1/src/4.einzelstdpl.sek1 | 233 ++ app/schulis/2.2.1/src/4.einzelstdpl.sek2 | 197 ++ app/schulis/2.2.1/src/4.faecherangebot drucken | 110 + app/schulis/2.2.1/src/4.faecherangebot planen | 369 +++ .../2.2.1/src/4.halbjahreswechsel zum stundenplan | 120 + app/schulis/2.2.1/src/4.konsistenzpruefung | 274 ++ .../2.2.1/src/4.lehrveranstaltungen benennen | 480 +++ .../src/4.liste ausgewaehlter kopplungen drucken | 72 + app/schulis/2.2.1/src/4.listen.aufsichtsplan | 78 + .../2.2.1/src/4.listen.unterrichtsverteilung | 252 ++ app/schulis/2.2.1/src/4.raumwuensche pruefen | 117 + .../2.2.1/src/4.springstunden lehrer analysieren | 122 + .../2.2.1/src/4.springstunden schueler analysieren | 137 + .../src/4.stand der stundenplanung analysieren | 98 + app/schulis/2.2.1/src/4.stdpluebersichten | 425 +++ .../2.2.1/src/4.stundenplan akt halbj uebernehmen | 141 + .../2.2.1/src/4.stundenplan im dialog erstellen | 382 +++ .../2.2.1/src/4.stundenplan nach lv erfassen | 133 + .../2.2.1/src/4.stundenplan nach zeiten erfassen | 157 + .../2.2.1/src/4.stundenplan raumweise erfassen | 135 + app/schulis/2.2.1/src/4.stundenplan schnittstelle | 692 ++++ app/schulis/2.2.1/src/4.teilstdpl fach lehrer | 124 + .../2.2.1/src/4.uv und kopplungen bearbeiten | 319 ++ app/schulis/2.2.1/src/4.vertretungen organisieren | 318 ++ .../2.2.1/src/4.vertretungsdaten bearbeiten | 279 ++ app/schulis/2.2.1/src/4.zeitwuensche bearbeiten | 243 ++ app/schulis/2.2.1/src/4.zeitwuensche drucken | 129 + app/schulis/2.2.1/src/5.STATISTIK SERVER.files | 2 + app/schulis/2.2.1/src/5.STATISTIK.files | 9 + app/schulis/2.2.1/src/5.benennen | 116 + app/schulis/2.2.1/src/5.datenbasis | 62 + app/schulis/2.2.1/src/5.drucken | 153 + app/schulis/2.2.1/src/5.erstellen | 146 + app/schulis/2.2.1/src/5.felder | 263 ++ app/schulis/2.2.1/src/5.manager | 47 + app/schulis/2.2.1/src/5.merkmale | 52 + app/schulis/2.2.1/src/5.statistik liste | 27 + app/schulis/2.2.1/src/5.thesaurus | 38 + app/schulis/2.2.1/src/6.IDA.files | 17 + app/schulis/2.2.1/src/6.db q.sc | 222 ++ app/schulis/2.2.1/src/6.db ref.sc | 20 + app/schulis/2.2.1/src/6.db sel.sc | 127 + app/schulis/2.2.1/src/6.db snd query.sc | 39 + app/schulis/2.2.1/src/6.ida.auswahl | 23 + app/schulis/2.2.1/src/6.ida.check | 162 + app/schulis/2.2.1/src/6.ida.def.druck | 64 + app/schulis/2.2.1/src/6.ida.definieren | 516 +++ app/schulis/2.2.1/src/6.ida.druck | 261 ++ app/schulis/2.2.1/src/6.ida.eingang | 87 + app/schulis/2.2.1/src/6.ida.gen | 79 + app/schulis/2.2.1/src/6.ida.grund | 182 ++ app/schulis/2.2.1/src/6.ida.plausi | 114 + app/schulis/2.2.1/src/insert schulis | 472 +++ app/tecal/1.8.7/source-disk | 1 + app/tecal/1.8.7/src/TeCal | 856 +++++ app/tecal/1.8.7/src/TeCal Auskunft | Bin 0 -> 45056 bytes app/tecal/1.8.7/src/TeCal.gen | 55 + 997 files changed, 146853 insertions(+) create mode 100644 app/baisy/2.2.1-schulis/source-disk create mode 100644 app/baisy/2.2.1-schulis/src/ANWENDUNG.files create mode 100644 app/baisy/2.2.1-schulis/src/BAISY SERVER.files create mode 100644 app/baisy/2.2.1-schulis/src/BASIS.files create mode 100644 app/baisy/2.2.1-schulis/src/DB REORG.files create mode 100644 app/baisy/2.2.1-schulis/src/DB.files create mode 100644 app/baisy/2.2.1-schulis/src/DOS.files create mode 100644 app/baisy/2.2.1-schulis/src/SICHERUNG.files create mode 100644 app/baisy/2.2.1-schulis/src/STANDARD.files create mode 100644 app/baisy/2.2.1-schulis/src/WERKZEUGE.files create mode 100644 app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/aufruf manager create mode 100644 app/baisy/2.2.1-schulis/src/auskunftsfenster create mode 100644 app/baisy/2.2.1-schulis/src/baisyio create mode 100644 app/baisy/2.2.1-schulis/src/block i-o create mode 100644 app/baisy/2.2.1-schulis/src/bpb ds create mode 100644 app/baisy/2.2.1-schulis/src/db archive.sc create mode 100644 app/baisy/2.2.1-schulis/src/db dd.sc create mode 100644 app/baisy/2.2.1-schulis/src/db ddinfo.sc create mode 100644 app/baisy/2.2.1-schulis/src/db fetch.baisy create mode 100644 app/baisy/2.2.1-schulis/src/db kernel.sc create mode 100644 app/baisy/2.2.1-schulis/src/db parse.sc create mode 100644 app/baisy/2.2.1-schulis/src/db phon.sc create mode 100644 app/baisy/2.2.1-schulis/src/db reorg.sc create mode 100644 app/baisy/2.2.1-schulis/src/db reorganisation auftrag create mode 100644 app/baisy/2.2.1-schulis/src/db reorganisation manager create mode 100644 app/baisy/2.2.1-schulis/src/db scan create mode 100644 app/baisy/2.2.1-schulis/src/db utils.sc create mode 100644 app/baisy/2.2.1-schulis/src/dir.dos create mode 100644 app/baisy/2.2.1-schulis/src/disk descriptor.dos create mode 100644 app/baisy/2.2.1-schulis/src/dos hd inserter create mode 100644 app/baisy/2.2.1-schulis/src/dos inserter create mode 100644 app/baisy/2.2.1-schulis/src/dump create mode 100644 app/baisy/2.2.1-schulis/src/editorfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/erf.auskuenfte create mode 100644 app/baisy/2.2.1-schulis/src/eu disk descriptor create mode 100644 app/baisy/2.2.1-schulis/src/f packet.sc create mode 100644 app/baisy/2.2.1-schulis/src/fat.dos create mode 100644 app/baisy/2.2.1-schulis/src/fetch create mode 100644 app/baisy/2.2.1-schulis/src/fetch save interface create mode 100644 app/baisy/2.2.1-schulis/src/get put interface.dos create mode 100644 app/baisy/2.2.1-schulis/src/insert.dos create mode 100644 app/baisy/2.2.1-schulis/src/isp archive.sc create mode 100644 app/baisy/2.2.1-schulis/src/isp.auskunftseditor create mode 100644 app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/isp.baisy server create mode 100644 app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen create mode 100644 app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen create mode 100644 app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen create mode 100644 app/baisy/2.2.1-schulis/src/isp.erf.meldungen create mode 100644 app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen create mode 100644 app/baisy/2.2.1-schulis/src/isp.init baisy server create mode 100644 app/baisy/2.2.1-schulis/src/isp.knoten create mode 100644 app/baisy/2.2.1-schulis/src/isp.manager schnittstelle create mode 100644 app/baisy/2.2.1-schulis/src/isp.masken create mode 100644 app/baisy/2.2.1-schulis/src/isp.maskendesign create mode 100644 app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask create mode 100644 app/baisy/2.2.1-schulis/src/isp.objektliste create mode 100644 app/baisy/2.2.1-schulis/src/isp.schulis db nummern create mode 100644 app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor create mode 100644 app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung create mode 100644 app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung create mode 100644 app/baisy/2.2.1-schulis/src/isp.systembaumeditor create mode 100644 app/baisy/2.2.1-schulis/src/isp.zusatz archive packet create mode 100644 app/baisy/2.2.1-schulis/src/konvert create mode 100644 app/baisy/2.2.1-schulis/src/log.eintrag create mode 100644 app/baisy/2.2.1-schulis/src/log.manager create mode 100644 app/baisy/2.2.1-schulis/src/logbuch verwaltung create mode 100644 app/baisy/2.2.1-schulis/src/longrow create mode 100644 app/baisy/2.2.1-schulis/src/manager-M.dos create mode 100644 app/baisy/2.2.1-schulis/src/manager-S.dos create mode 100644 app/baisy/2.2.1-schulis/src/maskenerweiterung create mode 100644 app/baisy/2.2.1-schulis/src/maskenverarbeitung create mode 100644 app/baisy/2.2.1-schulis/src/name conversion.dos create mode 100644 app/baisy/2.2.1-schulis/src/new monitor baisy create mode 100644 app/baisy/2.2.1-schulis/src/open create mode 100644 app/baisy/2.2.1-schulis/src/plausipruefung create mode 100644 app/baisy/2.2.1-schulis/src/save create mode 100644 app/baisy/2.2.1-schulis/src/schulis kommandobehandlung create mode 100644 app/baisy/2.2.1-schulis/src/shard interface create mode 100644 app/baisy/2.2.1-schulis/src/standarddialog create mode 100644 app/baisy/2.2.1-schulis/src/sybifunktionen create mode 100644 app/baisy/2.2.1-schulis/src/systembaum create mode 100644 app/baisy/2.2.1-schulis/src/systembauminterpreter create mode 100644 app/baisy/2.2.1-schulis/src/thesaurusfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/umgebungswechsel manager create mode 100644 app/conversion/1.0/source-disk create mode 100644 app/conversion/1.0/src/AGFA2ASC.TBL create mode 100644 app/conversion/1.0/src/ASKCNVRS.PAC create mode 100644 app/conversion/1.0/src/DOSCNVRS.PAC create mode 100644 app/conversion/1.0/src/EU_CNVRS.DOC create mode 100644 app/conversion/1.0/src/FILEUTIL.PAC create mode 100644 app/conversion/1.0/src/FONTANAL.PAC create mode 100644 app/conversion/1.0/src/PSEUDOWP.WPM create mode 100644 app/conversion/1.0/src/PS_WP_DT.WPM create mode 100644 app/conversion/1.0/src/SEQU2CUM.TBL create mode 100644 app/conversion/1.0/src/WP_CNVRS.PAC create mode 100644 app/conversion/1.0/src/WP_KNVRS.PAC create mode 100644 app/diskettenmonitor/3.5/source-disk create mode 100644 app/diskettenmonitor/3.5/src/basic menu handling 3.5.quelle create mode 100644 app/diskettenmonitor/3.5/src/disk 3.5-m.quelle create mode 100644 app/diskettenmonitor/3.5/src/disk cmd 3.5.quelle create mode 100644 app/diskettenmonitor/3.5/src/m.rename archive^2.c create mode 100644 app/diskettenmonitor/3.5/src/read heap create mode 100644 app/diskettenmonitor/3.7/source-disk create mode 100644 app/diskettenmonitor/3.7/src/PAC digit conversion create mode 100644 app/diskettenmonitor/3.7/src/basic menu handling 3.6.quelle create mode 100644 app/diskettenmonitor/3.7/src/disk 3.7-m.quelle create mode 100644 app/diskettenmonitor/3.7/src/disk cmd 3.6.quelle create mode 100644 app/eudas/3.4/source-disk create mode 100644 app/eudas/3.4/src/eudas.1 create mode 100644 app/eudas/3.4/src/eudas.2 create mode 100644 app/eudas/3.4/src/eudas.3 create mode 100644 app/eudas/3.4/src/eudas.4 create mode 100644 app/eudas/3.4/src/eudas.gen-m create mode 100644 app/eudas/3.4/src/eudas.gen-s create mode 100644 app/eudas/3.4/src/eudas.init create mode 100644 app/eudas/4.3/doc/abb.1-1 create mode 100644 app/eudas/4.3/doc/abb.4-1 create mode 100644 app/eudas/4.3/doc/abb.4-2 create mode 100644 app/eudas/4.3/doc/abb.6-1 create mode 100644 app/eudas/4.3/doc/abb.6-2 create mode 100644 app/eudas/4.3/doc/abb.7-1 create mode 100644 app/eudas/4.3/doc/abb.9-1 create mode 100644 app/eudas/4.3/doc/abb.9-2 create mode 100644 app/eudas/4.3/doc/abb.9-3 create mode 100644 app/eudas/4.3/doc/abb.9-4 create mode 100644 app/eudas/4.3/doc/abb.9-5 create mode 100644 app/eudas/4.3/doc/bildergenerator create mode 100644 app/eudas/4.3/doc/eudas.hdb.1 create mode 100644 app/eudas/4.3/doc/eudas.hdb.10 create mode 100644 app/eudas/4.3/doc/eudas.hdb.11 create mode 100644 app/eudas/4.3/doc/eudas.hdb.12 create mode 100644 app/eudas/4.3/doc/eudas.hdb.13 create mode 100644 app/eudas/4.3/doc/eudas.hdb.14 create mode 100644 app/eudas/4.3/doc/eudas.hdb.15 create mode 100644 app/eudas/4.3/doc/eudas.hdb.16 create mode 100644 app/eudas/4.3/doc/eudas.hdb.2 create mode 100644 app/eudas/4.3/doc/eudas.hdb.3 create mode 100644 app/eudas/4.3/doc/eudas.hdb.5 create mode 100644 app/eudas/4.3/doc/eudas.hdb.6 create mode 100644 app/eudas/4.3/doc/eudas.hdb.7 create mode 100644 app/eudas/4.3/doc/eudas.hdb.8 create mode 100644 app/eudas/4.3/doc/eudas.hdb.9 create mode 100644 app/eudas/4.3/doc/eudas.hdb.inhalt create mode 100644 app/eudas/4.3/doc/eudas.hdb.macros create mode 100644 app/eudas/4.3/doc/eudas.hdb.titel create mode 100644 app/eudas/4.3/doc/eudas.hdb.vorwort create mode 100644 app/eudas/4.3/doc/eudas.ref.1 create mode 100644 app/eudas/4.3/doc/eudas.ref.10 create mode 100644 app/eudas/4.3/doc/eudas.ref.11 create mode 100644 app/eudas/4.3/doc/eudas.ref.2 create mode 100644 app/eudas/4.3/doc/eudas.ref.3 create mode 100644 app/eudas/4.3/doc/eudas.ref.4 create mode 100644 app/eudas/4.3/doc/eudas.ref.5 create mode 100644 app/eudas/4.3/doc/eudas.ref.6 create mode 100644 app/eudas/4.3/doc/eudas.ref.7 create mode 100644 app/eudas/4.3/doc/eudas.ref.8 create mode 100644 app/eudas/4.3/doc/eudas.ref.9 create mode 100644 app/eudas/4.3/doc/eudas.ref.fehler create mode 100644 app/eudas/4.3/doc/eudas.ref.inhalt create mode 100644 app/eudas/4.3/doc/eudas.ref.macros create mode 100644 app/eudas/4.3/doc/eudas.ref.proz create mode 100644 app/eudas/4.3/doc/eudas.ref.reg create mode 100644 app/eudas/4.3/doc/eudas.ref.titel create mode 100644 app/eudas/4.3/doc/eudas.ref.vorwort create mode 100644 app/eudas/4.3/doc/ref.abb.1-1 create mode 100644 app/eudas/4.3/doc/register create mode 100644 app/eudas/4.3/doc/uedas.hdb.4 create mode 100644 app/eudas/4.3/src/Adressen create mode 100644 app/eudas/4.3/src/dummy.text create mode 100644 app/eudas/4.3/src/eudas.1 create mode 100644 app/eudas/4.3/src/eudas.2 create mode 100644 app/eudas/4.3/src/eudas.3 create mode 100644 app/eudas/4.3/src/eudas.4 create mode 100644 app/eudas/4.3/src/eudas.generator create mode 100644 app/eudas/4.3/src/eudas.init create mode 100644 app/eudas/4.3/src/pos.173 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.1-1 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.4-1 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.4-2 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.6-1 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.6-2 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.7-1 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.9-1 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.9-2 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.9-3 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.9-4 create mode 100644 app/eudas/4.4/doc/ref-manual/abb.9-5 create mode 100644 app/eudas/4.4/doc/ref-manual/bildergenerator create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.1 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.10 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.11 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.2 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.3 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.4 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.5 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.6 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.7 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.8 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.9 create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.fehler create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.inhalt create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.macros create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.proz create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.reg create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.titel create mode 100644 app/eudas/4.4/doc/ref-manual/eudas.ref.vorwort create mode 100644 app/eudas/4.4/doc/ref-manual/ref.abb.1-1 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.1 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.10 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.11 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.12 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.13 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.14 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.15 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.16 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.2 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.3 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.4 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.5 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.6 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.7 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.8 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.9 create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.inhalt create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.macros create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.titel create mode 100644 app/eudas/4.4/doc/user-manual/eudas.hdb.vorwort create mode 100644 app/eudas/4.4/doc/user-manual/register create mode 100644 app/eudas/4.4/source-disk create mode 100644 app/eudas/4.4/src/eudas.dateistruktur create mode 100644 app/eudas/4.4/src/eudas.datenverwaltung create mode 100644 app/eudas/4.4/src/eudas.drucken create mode 100644 app/eudas/4.4/src/eudas.fenster create mode 100644 app/eudas/4.4/src/eudas.menues create mode 100644 app/eudas/4.4/src/eudas.satzanzeige create mode 100644 app/eudas/4.4/src/eudas.satzzugriffe create mode 100644 app/eudas/4.4/src/eudas.steuerung create mode 100644 app/eudas/4.4/src/eudas.uebersicht create mode 100644 app/eudas/4.4/src/eudas.verarbeitung create mode 100644 app/eudas/5.3/source-disk create mode 100644 app/eudas/5.3/src/Adressen create mode 100644 app/eudas/5.3/src/boxzeichen create mode 100644 app/eudas/5.3/src/dummy.text create mode 100644 app/eudas/5.3/src/eudas.1 create mode 100644 app/eudas/5.3/src/eudas.2 create mode 100644 app/eudas/5.3/src/eudas.3 create mode 100644 app/eudas/5.3/src/eudas.4 create mode 100644 app/eudas/5.3/src/eudas.alt create mode 100644 app/eudas/5.3/src/eudas.dateien.05 create mode 100644 app/eudas/5.3/src/eudas.dialoghilfen.04 create mode 100644 app/eudas/5.3/src/eudas.drucken.13 create mode 100644 app/eudas/5.3/src/eudas.fenster.06 create mode 100644 app/eudas/5.3/src/eudas.generator create mode 100644 app/eudas/5.3/src/eudas.init.14 create mode 100644 app/eudas/5.3/src/eudas.listen.01 create mode 100644 app/eudas/5.3/src/eudas.menues.14 create mode 100644 app/eudas/5.3/src/eudas.saetze.03 create mode 100644 app/eudas/5.3/src/eudas.satzanzeige.12 create mode 100644 app/eudas/5.3/src/eudas.steuerung.14 create mode 100644 app/eudas/5.3/src/eudas.uebersicht.04 create mode 100644 app/eudas/5.3/src/eudas.verarbeiten.06 create mode 100644 app/eudas/5.3/src/eudas.verwaltung.11 create mode 100644 app/eudas/5.3/src/isub.replace create mode 100644 app/eudas/5.3/src/menues.1 create mode 100644 app/eudas/5.3/src/pos.173 create mode 100644 app/eumelbase/2.2.1-schulis/source-disk create mode 100644 app/eumelbase/2.2.1-schulis/src/ACCESS.files create mode 100644 app/eumelbase/2.2.1-schulis/src/DIALOG.files create mode 100644 app/eumelbase/2.2.1-schulis/src/MM BAISY.files create mode 100644 app/eumelbase/2.2.1-schulis/src/db access.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db archive.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db ddinfo.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db ersatz.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db kernel.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db manager.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db memory.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db q.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db ref.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db sel.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db snd query.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/db utils.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/isp archive manager.sc create mode 100644 app/eumelbase/2.2.1-schulis/src/isp archive.sc create mode 100644 app/flint/0.4/doc/Zusammenstellung create mode 100644 app/flint/0.4/doc/flint.kurzanleitung create mode 100644 app/flint/0.4/source-disk create mode 100644 app/flint/0.4/src/MENUE.gen create mode 100644 app/flint/0.4/src/OPMENUE.gen create mode 100644 app/flint/0.4/src/boxzeichen create mode 100644 app/flint/0.4/src/dummy.configurate create mode 100644 app/flint/0.4/src/editormenue create mode 100644 app/flint/0.4/src/eudas.manager create mode 100644 app/flint/0.4/src/flint create mode 100644 app/flint/0.4/src/flint.init create mode 100644 app/flint/0.4/src/flint.manager create mode 100644 app/flint/0.4/src/isub.replace create mode 100644 app/flint/0.4/src/klartextbelegung create mode 100644 app/flint/0.4/src/offline.1 create mode 100644 app/flint/0.4/src/offline.manager create mode 100644 app/flint/0.4/src/operator create mode 100644 app/flint/0.4/src/operator.1 create mode 100644 app/flint/0.4/src/operator.init create mode 100644 app/flint/0.4/src/operator.manager create mode 100644 app/flint/0.4/src/operator.spoolcmd create mode 100644 app/gs.dialog/1.2/doc/gs-dialog handbuch.impressum create mode 100644 app/gs.dialog/1.2/doc/gs-dialog-1 create mode 100644 app/gs.dialog/1.2/doc/gs-dialog-2 create mode 100644 app/gs.dialog/1.2/doc/gs-dialog-3 create mode 100644 app/gs.dialog/1.2/doc/gs-dialog-4 create mode 100644 app/gs.dialog/1.2/doc/gs-dialog-5 create mode 100644 app/gs.dialog/1.2/doc/gs-dialog-Inhaltsverzeichnis create mode 100644 app/gs.dialog/1.2/source-disk create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG 1 create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG 2 create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG 3 create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG 4 create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG 5 create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG 6 create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG 7 create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG MENUKARTEN MANAGER create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG MM-gen create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG decompress create mode 100644 app/gs.dialog/1.2/src/ls-DIALOG-gen create mode 100644 app/gs.dialog/1.2/src/ls-MENUKARTE:Archiv create mode 100644 app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Inhaltsverzeichnis create mode 100644 app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 1 create mode 100644 app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 2 create mode 100644 app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 3 create mode 100644 app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 4 create mode 100644 app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 5 create mode 100644 app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 6 create mode 100644 app/gs.hamster/1.1/doc/gs-Herbert und Robbi handbuch.impressum create mode 100644 app/gs.hamster/1.1/source-disk create mode 100644 app/gs.hamster/1.1/src/ls-Herbert und Robbi 1 create mode 100644 app/gs.hamster/1.1/src/ls-Herbert und Robbi 2 create mode 100644 app/gs.hamster/1.1/src/ls-Herbert und Robbi 3 create mode 100644 app/gs.hamster/1.1/src/ls-Herbert und Robbi-gen create mode 100644 app/gs.hamster/1.1/src/ls-MENUKARTE:Herbert und Robbi create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.1 create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.2 create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.3 create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.4 create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.5 create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.6 create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.7 create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.8 create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.impressum create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.index create mode 100644 app/gs.menugenerator/1.0/doc/menu-generator handbuch.inhalt create mode 100644 app/gs.menugenerator/1.0/source-disk create mode 100644 app/gs.menugenerator/1.0/src/Generatordatei: Archivmenu create mode 100644 app/gs.menugenerator/1.0/src/fonttab.ls-Menu-Generator create mode 100644 app/gs.menugenerator/1.0/src/ls-MENUBASISTEXTE create mode 100644 app/gs.menugenerator/1.0/src/ls-Menu-Generator 1 create mode 100644 app/gs.menugenerator/1.0/src/ls-Menu-Generator 2 create mode 100644 app/gs.menugenerator/1.0/src/ls-Menu-Generator-gen create mode 100644 app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis create mode 100644 app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 1 create mode 100644 app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 2 create mode 100644 app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 3 create mode 100644 app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 4 create mode 100644 app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 5 create mode 100644 app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 6 create mode 100644 app/gs.mp-bap/1.1/doc/gs-MP BAP handbuch.impressum create mode 100644 app/gs.mp-bap/1.1/source-disk create mode 100644 app/gs.mp-bap/1.1/src/ls-MENUKARTE:MP-BAP create mode 100644 app/gs.mp-bap/1.1/src/ls-MP BAP 1 create mode 100644 app/gs.mp-bap/1.1/src/ls-MP BAP 2 create mode 100644 app/gs.mp-bap/1.1/src/ls-MP BAP-gen create mode 100644 app/gs.process/1.02/doc/Anhang Prozess create mode 100644 app/gs.process/1.02/doc/Inhalt Prozess create mode 100644 app/gs.process/1.02/doc/gs-Prozess handbuch.impressum create mode 100644 app/gs.process/1.02/doc/gs-Prozess-2 create mode 100644 app/gs.process/1.02/doc/gs-Prozess-3 create mode 100644 app/gs.process/1.02/doc/gs-Prozess-4 create mode 100644 app/gs.process/1.02/doc/gs-prozess-1 create mode 100644 app/gs.process/1.02/doc/gs-prozess-5 create mode 100644 app/gs.process/1.02/doc/gs-prozess-6 create mode 100644 app/gs.process/1.02/doc/gs-prozess-7 create mode 100644 app/gs.process/1.02/doc/gs-prozess-8 create mode 100644 app/gs.process/1.02/doc/gs-prozess-9 create mode 100644 app/gs.process/1.02/source-disk create mode 100644 app/gs.process/1.02/src/ls-MENUKARTE:Prozess create mode 100644 "app/gs.process/1.02/src/ls-Prozess 1 f\303\274r AKTRONIC-Adapter" create mode 100644 "app/gs.process/1.02/src/ls-Prozess 1 f\303\274r MUFI als Endger\303\244t" create mode 100644 "app/gs.process/1.02/src/ls-Prozess 1 f\303\274r MUFI im Terminalkanal" create mode 100644 app/gs.process/1.02/src/ls-Prozess 2 create mode 100644 app/gs.process/1.02/src/ls-Prozess 3 create mode 100644 app/gs.process/1.02/src/ls-Prozess 4 create mode 100644 app/gs.process/1.02/src/ls-Prozess 5 create mode 100644 app/gs.process/1.02/src/ls-Prozess-gen create mode 100644 app/gs.warenhaus/1.01/doc/Anhang Warenhaus create mode 100644 app/gs.warenhaus/1.01/doc/Inhalt Warenhaus create mode 100644 app/gs.warenhaus/1.01/doc/gs-Warenhaus handbuch.impressum create mode 100644 app/gs.warenhaus/1.01/doc/gs-Warenhaus-1 create mode 100644 app/gs.warenhaus/1.01/doc/gs-Warenhaus-2 create mode 100644 app/gs.warenhaus/1.01/doc/gs-Warenhaus-3 create mode 100644 app/gs.warenhaus/1.01/doc/gs-Warenhaus-4 create mode 100644 app/gs.warenhaus/1.01/doc/gs-Warenhaus-5 create mode 100644 app/gs.warenhaus/1.01/doc/gs-Warenhaus-6 create mode 100644 app/gs.warenhaus/1.01/doc/gs-Warenhaus-7 create mode 100644 app/gs.warenhaus/1.01/source-disk create mode 100644 app/gs.warenhaus/1.01/src/ls-MENUKARTE:Warenhaus create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter create mode 100644 "app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus 0: ohne Kartenleser create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus 1 create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus 2 create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus 3 create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus 4 create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus 5 create mode 100644 app/gs.warenhaus/1.01/src/ls-Warenhaus-gen create mode 100644 app/mpg/2.2/doc/GRAPHIK.dok.e create mode 100644 app/mpg/2.2/source-disk create mode 100644 app/mpg/2.2/src/AMPEX 2-1-6.GCONF create mode 100644 app/mpg/2.2/src/AMPEX 3-1-4.GCONF create mode 100644 app/mpg/2.2/src/Atari 3-9.GCONF create mode 100644 app/mpg/2.2/src/DATAGRAPH 3-7.GCONF create mode 100644 app/mpg/2.2/src/ENVIRONMENT2.GCONF create mode 100644 app/mpg/2.2/src/ENVIRONMENT3.GCONF create mode 100644 app/mpg/2.2/src/FKT.help create mode 100644 app/mpg/2.2/src/GRAPHIK.Basis create mode 100644 app/mpg/2.2/src/GRAPHIK.Configurator create mode 100644 app/mpg/2.2/src/GRAPHIK.Fkt create mode 100644 app/mpg/2.2/src/GRAPHIK.Install create mode 100644 app/mpg/2.2/src/GRAPHIK.Manager create mode 100644 app/mpg/2.2/src/GRAPHIK.Plot create mode 100644 app/mpg/2.2/src/GRAPHIK.Turtle create mode 100644 app/mpg/2.2/src/GRAPHIK.list create mode 100644 app/mpg/2.2/src/HERCULES XT.GCONF create mode 100644 app/mpg/2.2/src/Muster create mode 100644 app/mpg/2.2/src/NEC P-3 3-15.GCONF create mode 100644 app/mpg/2.2/src/NEC P-6 MD.GCONF create mode 100644 app/mpg/2.2/src/NEC P-9 2-15.HD.GCONF create mode 100644 app/mpg/2.2/src/NEC P-9 2-15.MD.GCONF create mode 100644 app/mpg/2.2/src/PUBLIC.insert create mode 100644 app/mpg/2.2/src/VC 404 2-7.GCONF create mode 100644 app/mpg/2.2/src/VIDEOSTAR 3-6.GCONF create mode 100644 app/mpg/2.2/src/WATANABE 3-8.GCONF create mode 100644 app/mpg/2.2/src/ZEICHENSATZ create mode 100644 app/mpg/2.2/src/matrix printer create mode 100644 app/mpg/2.2/src/printer.targets create mode 100644 app/mpg/2.2/src/std primitives create mode 100644 app/mpg/2.2/src/terminal plot create mode 100644 app/schulis-mathematiksystem/1.0/source-disk create mode 100644 app/schulis-mathematiksystem/1.0/src/PAC element row create mode 100644 app/schulis-mathematiksystem/1.0/src/PAC formula analyzer create mode 100644 app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung create mode 100644 app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung create mode 100644 app/schulis-mathematiksystem/1.0/src/PAC text row create mode 100644 app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 create mode 100644 app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 create mode 100644 app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 create mode 100644 app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 create mode 100644 app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 create mode 100644 app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 create mode 100644 app/schulis-mathematiksystem/1.0/src/ibmoperatoren create mode 100644 app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe create mode 100644 app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe create mode 100644 app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe create mode 100644 app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe create mode 100644 app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe create mode 100644 app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.abbildung create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.ausgabe create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.basis plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.binder plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.cga plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.druckermenu create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.ega plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.epson-sq plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.formeleditormanager create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.hercules plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.kyocera plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.laserjet plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.masken create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.menufunktionen create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.nullstellen create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.parser create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.picture create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.referenzobjekte create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.specialgraphic create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.umformung create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.vector create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.verwaltung create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.vga plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.wertetabelle create mode 100644 app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot create mode 100644 app/schulis-mathematiksystem/1.0/src/mathe formulare create mode 100644 app/schulis-mathematiksystem/1.0/src/spool cmd create mode 100644 app/schulis-mathematiksystem/1.0/src/standardoperatoren create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 originalkurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 vergleichskurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 10 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 11 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 12 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 13 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 14 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 originalkurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 vergleichskurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 originalkurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 vergleichskurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 originalkurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 vergleichskurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 originalkurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 vergleichskurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 originalkurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 vergleichskurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 originalkurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 vergleichskurve ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 8 code info ds" create mode 100644 "app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 9 code info ds" create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 10 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 6 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 7 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 8 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 9 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 5 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 6 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 10 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 11 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 12 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 13 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 14 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 8 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 9 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 5 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 6 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 7 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 8 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 5 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 6 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 10 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 6 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 7 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 8 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 9 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 10 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 11 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 12 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 13 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 14 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 8 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 9 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 originalkurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 vergleichskurve ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 4 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 5 code info ds create mode 100644 app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 6 code info ds create mode 100644 app/schulis-simulationssystem/3.0/source-disk create mode 100644 app/schulis-simulationssystem/3.0/src/TEXTE deutsch create mode 100644 app/schulis-simulationssystem/3.0/src/ZEICHEN 6*10 create mode 100644 app/schulis-simulationssystem/3.0/src/ZEICHEN 8*14 create mode 100644 app/schulis-simulationssystem/3.0/src/ZEICHEN 8*16 create mode 100644 app/schulis-simulationssystem/3.0/src/ZEICHEN 8*19 create mode 100644 app/schulis-simulationssystem/3.0/src/ZEICHEN 8*8 create mode 100644 app/schulis-simulationssystem/3.0/src/ZEICHEN 9*14 create mode 100644 app/schulis-simulationssystem/3.0/src/bs create mode 100644 app/schulis-simulationssystem/3.0/src/dp2 create mode 100644 app/schulis-simulationssystem/3.0/src/e create mode 100644 app/schulis-simulationssystem/3.0/src/g create mode 100644 app/schulis-simulationssystem/3.0/src/ls bildschirmeingaben create mode 100644 app/schulis-simulationssystem/3.0/src/ls co routinen und co create mode 100644 app/schulis-simulationssystem/3.0/src/ls dateiscroll create mode 100644 app/schulis-simulationssystem/3.0/src/ls demonstration create mode 100644 app/schulis-simulationssystem/3.0/src/ls dialoghilfen create mode 100644 app/schulis-simulationssystem/3.0/src/ls dp1 create mode 100644 app/schulis-simulationssystem/3.0/src/ls kombination create mode 100644 app/schulis-simulationssystem/3.0/src/ls simsel.masken create mode 100644 app/schulis-simulationssystem/3.0/src/ls simselstarter create mode 100644 app/schulis-simulationssystem/3.0/src/ls simulation create mode 100644 app/schulis-simulationssystem/3.0/src/ls starte bearbeitung create mode 100644 app/schulis-simulationssystem/3.0/src/ls zustaende parameter kurve create mode 100644 app/schulis-simulationssystem/3.0/src/ls-DIALOG 1.korrektur create mode 100644 app/schulis-simulationssystem/3.0/src/ls-DIALOG 2.simsel create mode 100644 app/schulis-simulationssystem/3.0/src/ls-DIALOG 3.korrektur create mode 100644 app/schulis-simulationssystem/3.0/src/ls-DIALOG 4.wd create mode 100644 app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.korrektur create mode 100644 app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.simsel create mode 100644 app/schulis-simulationssystem/3.0/src/ls-MENUKARTE:Simsel create mode 100644 app/schulis-simulationssystem/3.0/src/ltbearb create mode 100644 app/schulis-simulationssystem/3.0/src/m create mode 100644 app/schulis-simulationssystem/3.0/src/mat.binder plot create mode 100644 app/schulis-simulationssystem/3.0/src/mat.epson-fx plot create mode 100644 app/schulis-simulationssystem/3.0/src/mat.epson-sq plot create mode 100644 app/schulis-simulationssystem/3.0/src/mat.hp72xx plot create mode 100644 app/schulis-simulationssystem/3.0/src/mat.hp74xx plot create mode 100644 app/schulis-simulationssystem/3.0/src/mat.kyocera plot create mode 100644 app/schulis-simulationssystem/3.0/src/mat.laserjet plot create mode 100644 app/schulis-simulationssystem/3.0/src/mat.xerox4045 plot create mode 100644 app/schulis-simulationssystem/3.0/src/modellbasis dialog create mode 100644 app/schulis-simulationssystem/3.0/src/modellbasis geraet create mode 100644 app/schulis-simulationssystem/3.0/src/modellwerte create mode 100644 app/schulis-simulationssystem/3.0/src/neue startschl create mode 100644 app/schulis-simulationssystem/3.0/src/o create mode 100644 app/schulis-simulationssystem/3.0/src/op1 create mode 100644 app/schulis-simulationssystem/3.0/src/op2 create mode 100644 app/schulis-simulationssystem/3.0/src/output create mode 100644 app/schulis-simulationssystem/3.0/src/output test create mode 100644 app/schulis-simulationssystem/3.0/src/simsel basis plot create mode 100644 app/schulis-simulationssystem/3.0/src/simsel cga plot create mode 100644 app/schulis-simulationssystem/3.0/src/simsel ega plot create mode 100644 app/schulis-simulationssystem/3.0/src/simsel formulare create mode 100644 app/schulis-simulationssystem/3.0/src/simsel hercules plot create mode 100644 app/schulis-simulationssystem/3.0/src/simsel picture create mode 100644 app/schulis-simulationssystem/3.0/src/simsel vga plot create mode 100644 app/schulis-simulationssystem/3.0/src/simsel.druckermenu create mode 100644 app/schulis-simulationssystem/3.0/src/simsel.text als row create mode 100644 app/schulis-simulationssystem/3.0/src/simsel.verwaltung create mode 100644 app/schulis-simulationssystem/3.0/src/spool cmd create mode 100644 app/schulis-simulationssystem/3.0/src/steuerung create mode 100644 app/schulis/2.2.1/data/db/2.BAISY-0 create mode 100644 app/schulis/2.2.1/data/db/2.BAISY-1 create mode 100644 app/schulis/2.2.1/data/db/BAISY-2 create mode 100644 app/schulis/2.2.1/data/db/BAISY-3 create mode 100644 app/schulis/2.2.1/data/db/BAISY-4 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.baisy create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.baisy.data0 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.baisy.data1 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.baisy.tree0 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.baisy.tree1 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.baisy.treedescription create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.schulis create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.schulis.data0 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.schulis.data1 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.schulis.tree0 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.schulis.tree1 create mode 100644 app/schulis/2.2.1/data/db/EUMELbase.schulis.treedescription create mode 100644 app/schulis/2.2.1/data/vordrucke/VORDRUCKE.files create mode 100644 app/schulis/2.2.1/data/vordrucke/fehlerliste konsistenzpruefung create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 11 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 5 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 11 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 5 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck fuer wiederholer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck klassenbuchliste create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine abmeldung create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit diffd create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit hjd create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungsbescheinigung create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungszulassung create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck schulbescheinigung create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft betroffene create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl raeume create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek1 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek2 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 kursli kopfueb create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 protokoll versetzkonf create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 unterrichtsvertlg fuer lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck1 vertretungen create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft betroffene create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl raeume create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek1 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek2 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 kursli zeile create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 protokoll versetzkonf create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 unterrichtsvertlg fuer lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck2 vertretungen create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft betroffene create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl sek1 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck3 protokoll versetzkonf create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft betroffene create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck4 einzelstdpl sek1 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft betroffene create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck5 einzelstdpl sek1 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck6 auskunft lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck6 einzelstdpl sek1 create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck7 auskunft lehrer create mode 100644 app/schulis/2.2.1/data/vordrucke/vordruck7 einzelstdpl sek1 create mode 100644 app/schulis/2.2.1/source-disk create mode 100644 app/schulis/2.2.1/src/0.ANSCHREIBEN.files create mode 100644 app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE TEIL2.files create mode 100644 app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE.files create mode 100644 app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN 2.files create mode 100644 app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN.files create mode 100644 app/schulis/2.2.1/src/0.ERFASSUNGEN LISTENWEISE.files create mode 100644 app/schulis/2.2.1/src/0.ERFASSUNGEN.files create mode 100644 app/schulis/2.2.1/src/0.IDA SERVER.files create mode 100644 app/schulis/2.2.1/src/0.IDA SICHERUNG.files create mode 100644 app/schulis/2.2.1/src/0.LISTEN 2.files create mode 100644 app/schulis/2.2.1/src/0.LISTEN.files create mode 100644 app/schulis/2.2.1/src/0.LOCAL.files create mode 100644 app/schulis/2.2.1/src/0.anschr.druckereinstellung create mode 100644 app/schulis/2.2.1/src/0.anschr.grundfunktionen create mode 100644 app/schulis/2.2.1/src/0.anschr.steuerfunktionen einfach create mode 100644 app/schulis/2.2.1/src/0.anschr.steuerfunktionen zusammengesetzt create mode 100644 app/schulis/2.2.1/src/0.erf aufsichtszeiten create mode 100644 app/schulis/2.2.1/src/0.erf zeitraster create mode 100644 app/schulis/2.2.1/src/0.erf.faecher create mode 100644 app/schulis/2.2.1/src/0.erf.schuldaten create mode 100644 app/schulis/2.2.1/src/0.grundfunktionen local create mode 100644 app/schulis/2.2.1/src/0.hjd grundfunktionen create mode 100644 app/schulis/2.2.1/src/0.hoeherstufen local.prog create mode 100644 app/schulis/2.2.1/src/0.ida.data create mode 100644 app/schulis/2.2.1/src/0.ida.form create mode 100644 app/schulis/2.2.1/src/0.ida.server create mode 100644 app/schulis/2.2.1/src/0.klassengruppen definieren create mode 100644 app/schulis/2.2.1/src/0.kurswahlbasis bereinigen create mode 100644 app/schulis/2.2.1/src/0.liste der aufsichtszeiten create mode 100644 app/schulis/2.2.1/src/0.liste der zeitrasterdaten create mode 100644 app/schulis/2.2.1/src/0.listen.benutz create mode 100644 app/schulis/2.2.1/src/0.listen.druckbearbeitung create mode 100644 app/schulis/2.2.1/src/0.listen.faecher create mode 100644 app/schulis/2.2.1/src/0.listen.klassengruppen create mode 100644 app/schulis/2.2.1/src/0.listen.raumgruppen create mode 100644 app/schulis/2.2.1/src/0.listen.schlueabku create mode 100644 app/schulis/2.2.1/src/0.listen.schuelergruppen create mode 100644 app/schulis/2.2.1/src/0.listen.schulen create mode 100644 app/schulis/2.2.1/src/0.listen.steuerung create mode 100644 app/schulis/2.2.1/src/0.listen.werkzeuge create mode 100644 app/schulis/2.2.1/src/0.listenweise grundfunktionen create mode 100644 app/schulis/2.2.1/src/0.listenweise klassen erf create mode 100644 app/schulis/2.2.1/src/0.raumgruppen bearbeiten create mode 100644 app/schulis/2.2.1/src/0.schulis schrifttyp create mode 100644 app/schulis/2.2.1/src/0.schulkenndaten bearbeiten create mode 100644 app/schulis/2.2.1/src/1.abgegangene aussortieren create mode 100644 app/schulis/2.2.1/src/1.anschr.anmeldebestaetigung fuer jgst 5 und 11 create mode 100644 app/schulis/2.2.1/src/1.anschr.mitteilungen neuangemeldete und abgemeldete create mode 100644 app/schulis/2.2.1/src/1.anschr.nachpruefungsbescheinigung create mode 100644 app/schulis/2.2.1/src/1.anschr.nachpruefungszulassung create mode 100644 app/schulis/2.2.1/src/1.anschr.schulbescheinigung create mode 100644 app/schulis/2.2.1/src/1.anschr.wiederholer create mode 100644 app/schulis/2.2.1/src/1.auskunft.betroffene create mode 100644 app/schulis/2.2.1/src/1.erf.abmeldedaten create mode 100644 app/schulis/2.2.1/src/1.erf.schuelerdaten create mode 100644 app/schulis/2.2.1/src/1.halbjahresdaten bearbeiten create mode 100644 app/schulis/2.2.1/src/1.hoeherstufen anw do.prog create mode 100644 app/schulis/2.2.1/src/1.listen.abgem create mode 100644 app/schulis/2.2.1/src/1.listen.adressen create mode 100644 app/schulis/2.2.1/src/1.listen.anherk create mode 100644 app/schulis/2.2.1/src/1.listen.gebu create mode 100644 app/schulis/2.2.1/src/1.listen.gesamt create mode 100644 app/schulis/2.2.1/src/1.listen.klassen create mode 100644 app/schulis/2.2.1/src/1.listen.klassenbuch create mode 100644 app/schulis/2.2.1/src/1.listen.nachpruefung create mode 100644 app/schulis/2.2.1/src/1.listen.neuan create mode 100644 app/schulis/2.2.1/src/1.listen.prot versetzkonferenz create mode 100644 app/schulis/2.2.1/src/1.listen.wiederholer create mode 100644 app/schulis/2.2.1/src/1.listenweise dif dat erf create mode 100644 app/schulis/2.2.1/src/1.listenweise erg nachpr create mode 100644 app/schulis/2.2.1/src/1.listenweise erg vers konf create mode 100644 app/schulis/2.2.1/src/1.listenweise klassenbildung create mode 100644 app/schulis/2.2.1/src/1.schuelerjgst aendern create mode 100644 app/schulis/2.2.1/src/1.stat grundfunktionen create mode 100644 app/schulis/2.2.1/src/1.stat intern create mode 100644 app/schulis/2.2.1/src/2.AUSWERTUNGEN KURSWAHL.files create mode 100644 app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL 2.files create mode 100644 app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL.files create mode 100644 app/schulis/2.2.1/src/2.erf wahldaten create mode 100644 app/schulis/2.2.1/src/2.halbjahreswechsel fuer kursdaten create mode 100644 app/schulis/2.2.1/src/2.konsistenzpruefung in kursdaten create mode 100644 app/schulis/2.2.1/src/2.kursdaten exportieren create mode 100644 app/schulis/2.2.1/src/2.kursdaten importieren create mode 100644 app/schulis/2.2.1/src/2.kurse auf planbloecke legen create mode 100644 app/schulis/2.2.1/src/2.kurswahl schnittstelle create mode 100644 app/schulis/2.2.1/src/2.kurszuordnung und umwahl fuer einzelne schueler sek2 create mode 100644 app/schulis/2.2.1/src/2.kw anschr kurslisten sek2 create mode 100644 app/schulis/2.2.1/src/2.likw kurskombinationen sek2 create mode 100644 app/schulis/2.2.1/src/2.likw schuelerwahl sek2 create mode 100644 app/schulis/2.2.1/src/2.likw wahl und kursdaten sek2 create mode 100644 app/schulis/2.2.1/src/2.schueler zu kursen zuordnen create mode 100644 app/schulis/2.2.1/src/2.stand der kursbildung analysieren create mode 100644 app/schulis/2.2.1/src/3.anschr.betroffene lehrer create mode 100644 app/schulis/2.2.1/src/3.erf lehrer create mode 100644 app/schulis/2.2.1/src/3.listen.lehrbef faecherweise create mode 100644 app/schulis/2.2.1/src/3.listen.lehrbef lehrerweise create mode 100644 app/schulis/2.2.1/src/3.listen.paraphen create mode 100644 app/schulis/2.2.1/src/3.listen.sprechzeiten create mode 100644 app/schulis/2.2.1/src/3.listen.wochenstunden create mode 100644 app/schulis/2.2.1/src/3.listenweise lehrer erf create mode 100644 app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 2.files create mode 100644 app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 3.files create mode 100644 app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN.files create mode 100644 app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 2.files create mode 100644 app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 3.files create mode 100644 app/schulis/2.2.1/src/4.ERFASSUNGEN STUNDENPLAN.files create mode 100644 app/schulis/2.2.1/src/4.anschr.unterrichtsvertlg fuer lehrer create mode 100644 app/schulis/2.2.1/src/4.anschr.vertretungen create mode 100644 app/schulis/2.2.1/src/4.aufsichten erstellen create mode 100644 "app/schulis/2.2.1/src/4.daten f\303\274r intega aufbereiten" create mode 100644 "app/schulis/2.2.1/src/4.daten f\303\274r schulis aufbereiten" create mode 100644 app/schulis/2.2.1/src/4.einhaltung zeitwuensche pruefen create mode 100644 app/schulis/2.2.1/src/4.einzelstdpl.lehrer create mode 100644 app/schulis/2.2.1/src/4.einzelstdpl.raeume create mode 100644 app/schulis/2.2.1/src/4.einzelstdpl.sek1 create mode 100644 app/schulis/2.2.1/src/4.einzelstdpl.sek2 create mode 100644 app/schulis/2.2.1/src/4.faecherangebot drucken create mode 100644 app/schulis/2.2.1/src/4.faecherangebot planen create mode 100644 app/schulis/2.2.1/src/4.halbjahreswechsel zum stundenplan create mode 100644 app/schulis/2.2.1/src/4.konsistenzpruefung create mode 100644 app/schulis/2.2.1/src/4.lehrveranstaltungen benennen create mode 100644 app/schulis/2.2.1/src/4.liste ausgewaehlter kopplungen drucken create mode 100644 app/schulis/2.2.1/src/4.listen.aufsichtsplan create mode 100644 app/schulis/2.2.1/src/4.listen.unterrichtsverteilung create mode 100644 app/schulis/2.2.1/src/4.raumwuensche pruefen create mode 100644 app/schulis/2.2.1/src/4.springstunden lehrer analysieren create mode 100644 app/schulis/2.2.1/src/4.springstunden schueler analysieren create mode 100644 app/schulis/2.2.1/src/4.stand der stundenplanung analysieren create mode 100644 app/schulis/2.2.1/src/4.stdpluebersichten create mode 100644 app/schulis/2.2.1/src/4.stundenplan akt halbj uebernehmen create mode 100644 app/schulis/2.2.1/src/4.stundenplan im dialog erstellen create mode 100644 app/schulis/2.2.1/src/4.stundenplan nach lv erfassen create mode 100644 app/schulis/2.2.1/src/4.stundenplan nach zeiten erfassen create mode 100644 app/schulis/2.2.1/src/4.stundenplan raumweise erfassen create mode 100644 app/schulis/2.2.1/src/4.stundenplan schnittstelle create mode 100644 app/schulis/2.2.1/src/4.teilstdpl fach lehrer create mode 100644 app/schulis/2.2.1/src/4.uv und kopplungen bearbeiten create mode 100644 app/schulis/2.2.1/src/4.vertretungen organisieren create mode 100644 app/schulis/2.2.1/src/4.vertretungsdaten bearbeiten create mode 100644 app/schulis/2.2.1/src/4.zeitwuensche bearbeiten create mode 100644 app/schulis/2.2.1/src/4.zeitwuensche drucken create mode 100644 app/schulis/2.2.1/src/5.STATISTIK SERVER.files create mode 100644 app/schulis/2.2.1/src/5.STATISTIK.files create mode 100644 app/schulis/2.2.1/src/5.benennen create mode 100644 app/schulis/2.2.1/src/5.datenbasis create mode 100644 app/schulis/2.2.1/src/5.drucken create mode 100644 app/schulis/2.2.1/src/5.erstellen create mode 100644 app/schulis/2.2.1/src/5.felder create mode 100644 app/schulis/2.2.1/src/5.manager create mode 100644 app/schulis/2.2.1/src/5.merkmale create mode 100644 app/schulis/2.2.1/src/5.statistik liste create mode 100644 app/schulis/2.2.1/src/5.thesaurus create mode 100644 app/schulis/2.2.1/src/6.IDA.files create mode 100644 app/schulis/2.2.1/src/6.db q.sc create mode 100644 app/schulis/2.2.1/src/6.db ref.sc create mode 100644 app/schulis/2.2.1/src/6.db sel.sc create mode 100644 app/schulis/2.2.1/src/6.db snd query.sc create mode 100644 app/schulis/2.2.1/src/6.ida.auswahl create mode 100644 app/schulis/2.2.1/src/6.ida.check create mode 100644 app/schulis/2.2.1/src/6.ida.def.druck create mode 100644 app/schulis/2.2.1/src/6.ida.definieren create mode 100644 app/schulis/2.2.1/src/6.ida.druck create mode 100644 app/schulis/2.2.1/src/6.ida.eingang create mode 100644 app/schulis/2.2.1/src/6.ida.gen create mode 100644 app/schulis/2.2.1/src/6.ida.grund create mode 100644 app/schulis/2.2.1/src/6.ida.plausi create mode 100644 app/schulis/2.2.1/src/insert schulis create mode 100644 app/tecal/1.8.7/source-disk create mode 100644 app/tecal/1.8.7/src/TeCal create mode 100644 app/tecal/1.8.7/src/TeCal Auskunft create mode 100644 app/tecal/1.8.7/src/TeCal.gen (limited to 'app') diff --git a/app/baisy/2.2.1-schulis/source-disk b/app/baisy/2.2.1-schulis/source-disk new file mode 100644 index 0000000..17b0588 --- /dev/null +++ b/app/baisy/2.2.1-schulis/source-disk @@ -0,0 +1 @@ +schulis-grundpaket-schulverwaltung-2.2.1/02_baisy-quellen.img diff --git a/app/baisy/2.2.1-schulis/src/ANWENDUNG.files b/app/baisy/2.2.1-schulis/src/ANWENDUNG.files new file mode 100644 index 0000000..40d187b --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/ANWENDUNG.files @@ -0,0 +1,3 @@ +db reorganisation auftrag +logbuch verwaltung + diff --git a/app/baisy/2.2.1-schulis/src/BAISY SERVER.files b/app/baisy/2.2.1-schulis/src/BAISY SERVER.files new file mode 100644 index 0000000..d1cc99f --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/BAISY SERVER.files @@ -0,0 +1,6 @@ +longrow +systembaum +isp.systembaumbearbeitung +maskenverarbeitung +isp.baisy server + diff --git a/app/baisy/2.2.1-schulis/src/BASIS.files b/app/baisy/2.2.1-schulis/src/BASIS.files new file mode 100644 index 0000000..f04fa3c --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/BASIS.files @@ -0,0 +1,7 @@ +db dd.sc +db phon.sc +db parse.sc +f packet.sc +isp.masken + + diff --git a/app/baisy/2.2.1-schulis/src/DB REORG.files b/app/baisy/2.2.1-schulis/src/DB REORG.files new file mode 100644 index 0000000..04f7bd7 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/DB REORG.files @@ -0,0 +1,5 @@ +db utils.sc +db reorg.sc +db reorganisation manager + + diff --git a/app/baisy/2.2.1-schulis/src/DB.files b/app/baisy/2.2.1-schulis/src/DB.files new file mode 100644 index 0000000..5ea703b --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/DB.files @@ -0,0 +1,16 @@ +db fetch.baisy +db kernel.sc +isp.init baisy server +isp.manager schnittstelle +isp.schulis db nummern +log.eintrag +maskenerweiterung +baisyio +isp.meldungsfunktionen +isp.knoten +sybifunktionen +editorfunktionen +auskunftsfenster +isp.auskunftsfunktionen + + diff --git a/app/baisy/2.2.1-schulis/src/DOS.files b/app/baisy/2.2.1-schulis/src/DOS.files new file mode 100644 index 0000000..ff4d45c --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/DOS.files @@ -0,0 +1,22 @@ +dump +konvert +open +eu disk descriptor +disk descriptor.dos +block i/o +name conversion.dos +fat.dos +dir.dos +get put interface.dos +fetch save interface +fetch +save +manager/M.dos +manager/S.dos +bpb ds +shard interface +insert.dos +dos hd inserter +dos inserter + + diff --git a/app/baisy/2.2.1-schulis/src/SICHERUNG.files b/app/baisy/2.2.1-schulis/src/SICHERUNG.files new file mode 100644 index 0000000..d082e14 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/SICHERUNG.files @@ -0,0 +1,8 @@ +db ddinfo.sc +isp.zusatz archive packet +db utils.sc +isp archive.sc +db archive.sc +isp.monitor sicherungstask + + diff --git a/app/baisy/2.2.1-schulis/src/STANDARD.files b/app/baisy/2.2.1-schulis/src/STANDARD.files new file mode 100644 index 0000000..0a0c982 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/STANDARD.files @@ -0,0 +1,16 @@ +plausipruefung +thesaurusfunktionen +isp.standardmaskenbehandlung +isp.benutzerberechtigungen +umgebungswechsel manager +systembauminterpreter +aufruf manager +standarddialog +isp.sicherungsmonitor +db scan +allgemeine grundfunktionen +isp.objektliste +isp.erf.steueroperationen +isp.erf.abkuerzungen +isp.erf.benutzerberechtigungen + diff --git a/app/baisy/2.2.1-schulis/src/WERKZEUGE.files b/app/baisy/2.2.1-schulis/src/WERKZEUGE.files new file mode 100644 index 0000000..cf1f4f2 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/WERKZEUGE.files @@ -0,0 +1,8 @@ +isp.systembaumeditor +schulis kommandobehandlung +isp.maskendesign +isp.erf.meldungen +erf.auskuenfte +isp.auskunftseditor +new monitor baisy + diff --git a/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen b/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen new file mode 100644 index 0000000..7d3b4c5 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen @@ -0,0 +1,35 @@ +PACKET allgemeinegrundfunktionenDEFINES statleseschleife,rechtstext, +aenderungsvermerksetzen,geplanteshjundsjberechnen,textnichtnull,jgstaufber, +eingabenummerisch:LET sgaenderung="c02 aenderungsvermerk",schlakt="aktuell", +schlgepl="geplant",blank=" ";PROC statleseschleife(INT CONST indexnummer, +TEXT CONST startschluessel1,startschluessel2,INT CONST feldnr1,feldnr2,PROC ( +BOOL VAR )stataktion):vorbereitungen;leseschleife.vorbereitungen:LET +maxleseanzahl=10;BOOL VAR vorzeitigesende:=FALSE ;INT VAR anzahltupel;. +leseschleife:putwert(feldnr1,startschluessel1);putwert(feldnr2, +startschluessel2);search(indexnummer);IF dbstatus=0THEN einleseschleifeFI . +einleseschleife:zaehlen;WHILE NOT schlussREP anzahltupel:=maxleseanzahl; +multisucc(indexnummer,anzahltupel);stackdurchlaufPER ;.stackdurchlauf:IF +anzahltupel=0THEN dbstatus(1)ELSE WHILE anzahltupel<>0REP lesen;zaehlen;IF +vorzeitigesendeTHEN dbstatus(1);anzahltupel:=0FI ;PER FI .schluss:dbstatus<>0 +.zaehlen:stataktion(vorzeitigesende).lesen:multisucc;anzahltupelDECR 1;.END +PROC statleseschleife;TEXT PROC rechtstext(TEXT CONST t,INT CONST laenge):(( +laenge-length(t))*" ")+tEND PROC rechtstext;PROC aenderungsvermerksetzen( +TEXT CONST schlwert):IF schlwert<>schlaktCAND schlwert<>schlgeplTHEN LEAVE +aenderungsvermerksetzenFI ;inittupel(dnrschluessel);putwert(fnrschlsachgebiet +,sgaenderung);putwert(fnrschlschluessel,schlwert);search(dnrschluessel,TRUE ) +;IF dbstatus=okTHEN putwert(fnrschllangtext,date+blank+timeofday);update( +dnrschluessel)ELSE putwert(fnrschlsachgebiet,sgaenderung);putwert( +fnrschlschluessel,schlwert);putwert(fnrschllangtext,date+blank+timeofday); +insert(dnrschluessel)FI END PROC aenderungsvermerksetzen;PROC +geplanteshjundsjberechnen(TEXT VAR halbjahr,schuljahr):TEXT VAR hilfe;IF +halbjahr="1"THEN halbjahr:="2";ELSE halbjahr:="1";schuljahr:=subtext( +schuljahr,3);hilfe:=text(int(schuljahr)+1);schuljahrCAT subtext("0"+hilfe, +LENGTH (hilfe))FI END PROC geplanteshjundsjberechnen;TEXT PROC textnichtnull( +TEXT CONST txt):TEXT VAR t:=txt;IF t=length(t)*"0"THEN t:=""FI ;tEND PROC +textnichtnull;TEXT PROC jgstaufber(TEXT CONST jgst):LET erstestellejgst="0", +maxsek1=10;INT VAR ijgst:=int(jgst);IF ijgst>=maxsek1THEN jgstELIF ijgst=0 +THEN ""ELSE erstestellejgst+text(ijgst)FI END PROC jgstaufber;BOOL PROC +eingabenummerisch(TEXT CONST t):INT VAR lv;FOR lvFROM 1UPTO length(t)REP IF +pos("0123456789",tSUB lv)=0THEN LEAVE eingabenummerischWITH FALSE FI PER ; +TRUE END PROC eingabenummerisch;END PACKET allgemeinegrundfunktionen + diff --git a/app/baisy/2.2.1-schulis/src/aufruf manager b/app/baisy/2.2.1-schulis/src/aufruf manager new file mode 100644 index 0000000..9577a95 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/aufruf manager @@ -0,0 +1,39 @@ +PACKET aufrufmanagerDEFINES starteaufrufmanager:LET ack=0,nak=1,naksingletask +=2;LET modussingleuser=1;PROC starteaufrufmanager:starteaufrufmanager(0)END +PROC starteaufrufmanager;PROC starteaufrufmanager(INT CONST modus):TASK VAR +sohn;initialisiere;REP warteaufdatenbankkennungundkanal;IF korrektTHEN +gruendesohntaskmitkanalnrunddatenbankkennungFI PER .initialisiere:break; +disablestop;setautonom;initsybifunktionen;.warteaufdatenbankkennungundkanal: +TASK VAR sender;INT VAR kanalnr;DATASPACE VAR datenbankkennung;clearerror; +wait(datenbankkennung,kanalnr,sender).korrekt:NOT iserror. +gruendesohntaskmitkanalnrunddatenbankkennung:IF modus=modussingleuserCAND +sohntaskschoneingerichtetTHEN quittung:=naksingletask;send(sender,quittung, +niltask)ELSE gruendesohntask;meldesohnnameansenderFI .gruendesohntask: +gruenden;IF korrektTHEN mitkanalnrunddatenbankkennungversorgenFI .gruenden: +begin(PROC stellvertreter,sohn).mitkanalnrunddatenbankkennungversorgen:BOOL +VAR erfolg;call(sohn,kanalnr,datenbankkennung,erfolg).meldesohnnameansender: +INT VAR quittung;IF erfolgTHEN quittung:=ackELSE quittung:=nakFI ;send(sender +,quittung,sohn).END PROC starteaufrufmanager;BOOL PROC +sohntaskschoneingerichtet:accesscatalogue;exists(son(myself))END PROC +sohntaskschoneingerichtet;PROC stellvertreter: +warteaufkanalnrunddatenbankkennung;geheaufkanalundsetzewerte;IF erfolgTHEN +warteaufauftrag;fuehreauftragausFI ;selbstmord.erfolg:NOT iserror.selbstmord: +end(myself).warteaufkanalnrunddatenbankkennung:disablestop;DATASPACE VAR ds; +TASK VAR vater;INT VAR kanalnr;wait(ds,kanalnr,vater). +geheaufkanalundsetzewerte:INT VAR quittung;IF erfolgTHEN #quittung:=ack; +oeffnedatenbank(ds)#datenbankeneroeffnenELSE quittung:=nakFI ;continue( +kanalnr);send(vater,quittung,ds);forget(ds);initmeldungsfunktionen. +datenbankeneroeffnen:oeffnedatenbank;fetchdd(schulisdbname);IF dbopen( +schulisdbname)THEN systemdboff;quittung:=ackELSE quittung:=nakFI . +warteaufauftrag:INT VAR knotenname;TASK VAR auftraggeber;REP wait(ds, +knotenname,auftraggeber)UNTIL korrekterauftragPER .korrekterauftrag: +knotenname>0.fuehreauftragaus:setzesystembaumundaktuellenknoten(ds,knotenname +);starteanwendung;IF erfolgTHEN quittung:=ackELSE quittung:=nakFI ;break( +quiet);send(auftraggeber,quittung,ds);forget(ds).END PROC stellvertreter; +PROC call(TASK CONST zielmanager,INT CONST kanal,DATASPACE VAR ds,BOOL VAR +erfolg):INT VAR replycode;call(zielmanager,kanal,ds,replycode);erfolg:= +replycode=ack;forget(ds)END PROC call;PROC send(TASK CONST sender,INT CONST +quittung,TASK CONST sohn):DATASPACE VAR ds:=nilspace;IF quittung=ackTHEN +BOUND TASK VAR t:=ds;t:=sohnFI ;send(sender,quittung,ds);forget(ds)END PROC +send;END PACKET aufrufmanager; + diff --git a/app/baisy/2.2.1-schulis/src/auskunftsfenster b/app/baisy/2.2.1-schulis/src/auskunftsfenster new file mode 100644 index 0000000..855f1a3 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/auskunftsfenster @@ -0,0 +1,126 @@ +PACKET auskunftsfensterDEFINES WINDOW ,:=,=,shrink,grow,open,startwindow, +auskunfterteilung,encode,subtext,textschonmalzeigen:LET zeilenlimit=200,# +maxauskfeld=6,##editorfenster=78,#eol="�",stop="�",hop="�",#cr=" ",#up="�", +down=" +",esc="�",right="�",left="�";#escape=27,frage="?",halt="h",vor="+", +zurueck="-",cleol="�";#LET cshrink=45,cgrow=43;TYPE WINDOW =STRUCT (INT lux, +luy,rox,roy);BOOL VAR fuereditor:=FALSE ;BOOL OP =(WINDOW CONST v,w):((v.lux= +w.lux)AND (v.luy=w.luy))AND ((v.rox=w.rox)AND (v.roy=w.roy))END OP =;OP :=( +WINDOW VAR v,WINDOW CONST w):CONCR (v):=CONCR (w)END OP :=;WINDOW PROC +startwindow(INT CONST u,v,w,x):WINDOW :(u,v,w,x)END PROC startwindow;PROC +grow(WINDOW VAR w):INT VAR nx1,ny1,nx2,ny2;IF (w.lux)<=2THEN nx1:=w.lux;ELSE +nx1:=w.lux-2FI ;IF (w.rox)>=77THEN nx2:=w.rox;ELSE nx2:=w.rox+2FI ;IF (w.luy) +=24THEN ny1:=w.luy;ELSE ny1:=w.luy+1FI ;IF (w.roy)=1THEN ny2:=w.roy;ELSE ny2 +:=w.roy-1FI ;WINDOW VAR v:=WINDOW :(nx1,ny1,nx2,ny2);w:=vEND PROC grow;PROC +shrink(WINDOW VAR w):INT VAR nx1,ny1,nx2,ny2;IF (w.roy+3)>=w.luyTHEN ny1:=w. +luy;ny2:=w.roy;ELSE ny1:=w.luy-1;ny2:=w.roy+1;FI ;IF (w.lux+7)>=w.roxTHEN nx1 +:=w.lux;nx2:=w.roxELSE nx1:=w.lux+2;nx2:=w.rox-2FI ;WINDOW VAR v:=WINDOW :( +nx1,ny1,nx2,ny2);erase(w);loeschespalte(w.rox-1,w);loeschespalte(w.lux+1,w); +loeschespalte(w.rox+1,w);w:=vEND PROC shrink;PROC erase(WINDOW CONST w): +loeschespalte(w.lux,w);loeschespalte(w.rox+2,w);loeschezeile(w.roy,w); +loeschezeile(w.luy,w);END PROC erase;PROC open(WINDOW CONST w):INT VAR x1:=w. +lux,y1:=w.luy,x2:=w.rox,y2:=w.roy;oeffnefenster(x1,y1,x2,y2)END PROC open; +PROC unterlegung(INT CONST i,j):TEXT VAR grund;IF fuereditorTHEN cursor(j,i); +grund:=(editorunterlegung(i)SUB j);IF grund=""THEN grund:=" "FI ;out(grund) +ELSE reorganizescreen(i,j,j)FI END PROC unterlegung;PROC loeschespalte(INT +CONST col,WINDOW CONST w):INT VAR from,to;from:=w.roy;to:=w.luy;INT VAR i; +FOR iFROM fromUPTO toREP unterlegung(i,col)PER END PROC loeschespalte;PROC +loeschezeile(INT CONST row,WINDOW CONST w):INT VAR from,to,lg,geslg;from:=w. +lux;to:=w.rox;IF fuereditorTHEN cursor(from,row);TEXT CONST grund:=subtext( +editorunterlegung(row),from,to+1);lg:=to-from+2;geslg:=length(grund);IF geslg +=lTHEN +LEAVE zeigefensterFI ;ELIF (interesse=down)THEN IF (bottom>=l)THEN LEAVE +zeigefensterFI ;seitenanfang:=aktuellezeile-zeilenzahl+2;zeigersetzen;ELSE +initialisiereseiteneu;IF seitenwechselCAND (interesse=up)THEN IF seitenanfang +=1THEN LEAVE zeigefensterFI ;seitenanfang:=max(1,seitenanfang-zeilenzahl); +zeigersetzenELIF (interesse=up)THEN IF seitenanfang=1THEN LEAVE zeigefenster +FI ;seitenanfang:=seitenanfang-1;zeigersetzenELIF (interesse=hop)THEN +seitenanfang:=1;zeigersetzenELSE bereitefenstervor;zeigersetzenFI ;FI ; +trageinfensterein;.initialisiereseiteneu:seitenanfang:=aktuellezeile- +zeilenzahl+1.trageinfensterein:FOR iFROM 1UPTO zeilenzahlREP formatierezeile; +schreibzeileinfensterPER ;cursor(posx,posy).zeigersetzen:bottom:= +zeilenanfaenge(seitenanfang);aktuellezeile:=seitenanfang-1.initialisiere: +WINDOW VAR w:=v;BOOL VAR ausbereichgeraten;INT VAR bottom:=1,top:=1, +seitenanfang:=1;INT VAR aktuellezeile:=0;ROW zeilenlimitINT VAR +zeilenanfaenge;INT VAR i;BOOL VAR seitenwechsel:=TRUE ;TEXT VAR interesse:= +down;INT VAR posy:=w.roy+1;INT VAR posx:=w.lux+3;fuereditor:=editorwunsch; +bereitefenstervor;trageinfensterein;IF nurschauTHEN LEAVE auskunfterteilung +FI .bestimmeneuecursorposition:cursor(w,interesse,seitenwechsel,posx,posy, +ausbereichgeraten).bereitefenstervor:INT VAR x1:=w.lux,y1:=w.luy,x2:=w.rox,y2 +:=w.roy;INT CONST zeilenzahl:=y1-y2-1,spaltenzahl:=x2-x1-5;INT CONST l:= +length(auskunft);TEXT CONST blankzeile:=spaltenzahl*" ";limito:=w.roy+1; +limitu:=w.luy-1;limitr:=w.rox-2;limitl:=w.lux+3;.nochinteresse:(interesse<> +esc).warteaufreaktion:seitenwechsel:=FALSE ;inchar(interesse);evtlschieben; +IF geschobenTHEN open(w)FI ;IF hopbeginnTHEN seitenwechsel:=TRUE ;REP inchar( +interesse)UNTIL erlaubtCOR hopbeginnPER ;FI .evtlschieben:BOOL VAR geschoben +:=FALSE ;REP SELECT code(interesse)OF CASE cshrink:shrink(w)CASE cgrow:grow(w +)OTHERWISE LEAVE evtlschiebenEND SELECT ;interesse:=incharety(2);geschoben:= +TRUE PER .erlaubt:(interesse=up)COR (interesse=down)COR (interesse=left)COR ( +interesse=right).hopbeginn:interesse=hop. +liefereevtlgewaehltenzeilenausschnitt:berechnezeilenincrement;IF NOT amanfang +THEN berechnerelativzeile;TEXT VAR einkopiertext:=subtext(zeile,1, +zeilenincrement);IF editorwunschTHEN type(einkopiertext)ELSE +inaktuellesmaskenfeld(einkopiertext)FI ELSE inaktuellesmaskenfeld("")FI . +berechnezeilenincrement:INT VAR zeilenincrement:=posx-limitl;.amanfang: +zeilenincrement=0.berechnerelativzeile:INT VAR relativzeile:=posy-limito+1; +initialisiereseiteneu;zeigersetzen;FOR iFROM 1UPTO relativzeileREP +formatierezeilePER ;zeile:=text(zeile,spaltenzahl).formatierezeile:TEXT VAR +zeile:="";IF NOT blankbeabsichtigtTHEN bottomsuchenFI ;IF bottom>=lTHEN zeile +:=blankzeileELSE top:=min(bottom+spaltenzahl-1,l);zeile:=subtext(auskunft, +bottom,top,eol,stop,TRUE );topINCR 1FI ;aktuellezeileINCR 1;zeilenanfaenge( +aktuellezeile):=bottom;bottom:=top.blankbeabsichtigt:subtext(auskunft,bottom- +1,bottom-1)=stop.bottomsuchen:TEXT VAR bottomvergleich;WHILE (bottom<=l)REP +bottomvergleich:=subtext(auskunft,bottom,bottom);IF (bottomvergleich=" ")COR +(bottomvergleich=eol)THEN bottomINCR 1ELSE LEAVE bottomsuchenFI PER . +schreibzeileinfenster:zeile:=text(zeile,spaltenzahl);cursor(x1+3,y2+i);out( +zeile).END PROC auskunfterteilung;INT VAR limito,limitu,limitr,limitl;PROC +cursor(WINDOW CONST w,TEXT CONST interesse,BOOL CONST seitenwechsel,INT VAR +posx,posy,BOOL VAR ausbereichgeraten):limitssetzen;neueposition.limitssetzen: +limito:=w.roy+1;limitu:=w.luy-1;limitr:=w.rox-2;limitl:=w.lux+3; +ausbereichgeraten:=FALSE .neueposition:IF seitenwechselTHEN IF (interesse= +left)THEN anzeilenanfangELSE IF (interesse=right)THEN anzeilenendeELSE IF ( +interesse=down)THEN eineseitevorELSE IF (interesse=up)THEN eineseitezurueck +FI FI FI FI ELSE IF interesse=leftTHEN nachlinksELSE IF interesse=rightTHEN +nachrechtsELSE IF (interesse=down)THEN einezeilenachuntenELSE IF (interesse= +up)THEN einezeilenachobenELSE cursornachlo;ausbereichgeraten:=TRUE FI FI FI +FI FI ;cursor(posx,posy).nachlinks:IF posx>limitlTHEN posxDECR 1FI . +nachrechts:IF posx +limitoTHEN posyDECR 1ELSE cursornachlo;ausbereichgeraten:=TRUE FI . +eineseitevor:IF posylimitoTHEN posy:=limito +ELSE cursornachlo;ausbereichgeraten:=TRUE FI .cursornachlo:posx:=limitl;posy +:=limito.cursornachlu:posx:=limitl;posy:=limitu.END PROC cursor;TEXT PROC +encode(TEXT CONST t):INT CONST max:=length(t);TEXT CONST vergleich:=subtext(t +,max,max);IF vergleich=" "THEN subtext(t,1,max-1)+stopELSE t+eolFI END PROC +encode;TEXT PROC subtext(TEXT VAR auskunft,INT CONST bottom,INT VAR top,TEXT +CONST loe,TEXT CONST stp,BOOL CONST infenster):LET b=" ";TEXT VAR oberster; +INT VAR lastblank;INT VAR i;TEXT VAR t,vergleich;konstruieret;t.konstruieret: +FOR iFROM bottomUPTO topREP vergleich:=subtext(auskunft,i,i);IF vergleich=loe +THEN IF NOT infensterTHEN t:=subtext(auskunft,bottom,i-1);top:=i;LEAVE +konstruieretFI ;replace(auskunft,i,b);lastblank:=iELIF vergleich=stpTHEN t:= +subtext(auskunft,bottom,i-1);IF NOT infensterTHEN t:=t+bFI ;top:=i;LEAVE +konstruieretELIF vergleich=bTHEN lastblank:=iFI ;PER ;oberster:=subtext( +auskunft,top+1,top+1);IF (lastblank<>top)CAND ((oberster<>b)CAND (oberster<> +loe)CAND (oberster<>stp))THEN top:=lastblankFI ;t:=subtext(auskunft,bottom, +top).END PROC subtext;PROC oeffnefenster(INT VAR x1,y1,x2,y2): +zeichnegrundseite;zeichnezwischenlinien;zeichneunterseite.zeichnegrundseite: +ermittlegrundkoordinaten;malepunkte.ermittlegrundkoordinaten:INT VAR x,y;x:= +x1;y:=y2.malepunkte:INT VAR fensterbreite;fensterbreite:=x2-x1-1;cursor(x,y); +out("");fensterbreite+2TIMESOUT " ";out("�").zeichnezwischenlinien:INT VAR +j,fensterlaenge;fensterbreiteDECR 2;fensterlaenge:=y1-y2;FOR jFROM 1UPTO +fensterlaenge-1REP yINCR 1;cursor(x,y);out(sp);fensterbreiteTIMESOUT " ";out( +ep);PER .sp:" ".ep:" �".zeichneunterseite:yINCR 1;cursor(x,y);malepunkte. +END PROC oeffnefenster;END PACKET auskunftsfenster + diff --git a/app/baisy/2.2.1-schulis/src/baisyio b/app/baisy/2.2.1-schulis/src/baisyio new file mode 100644 index 0000000..d0dd294 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/baisyio @@ -0,0 +1,51 @@ +PACKET baisyioDEFINES hardcopy,protected,protect,setzeschulisversion, +schulisversion,get,putget,inaktuellesmaskenfeld,getcursorposfuerauskunft, +bildschirmausdrucken:LET #variablenzahlklein=10,#variablenzahlgross=100, +variablenzahlganzgross=200,cesc=27,cseiterueck=15,cseitevor=14, +bildschirmausdruck="Bildschirm-Ausdruck",versilaenge=5,meldungsfeldnummer=1; +INT VAR x,y;INT VAR xauskunft,yauskunft;LET xruhepos=1,yruhepos=24;BOOL VAR +cl,pr,se,sp,le;INT VAR dummy;TEXT VAR versionsnummer:="01";TEXT VAR +untergeschobenerfeldinhalt:="";PROC getcursorposfuerauskunft(INT VAR xpos, +ypos):xpos:=xauskunft;ypos:=yauskunftEND PROC getcursorposfuerauskunft;PROC +hardcopy:FILE VAR f:=sequentialfile(output,bildschirmausdruck);screencopy(f); +print(bildschirmausdruck);forget(bildschirmausdruck,quiet)END PROC hardcopy; +PROC inaktuellesmaskenfeld(TEXT CONST auskunftsteiltext): +untergeschobenerfeldinhalt:=auskunftsteiltextEND PROC inaktuellesmaskenfeld; +BOOL PROC protected(TAG CONST t,INT CONST feld):fieldinfos(t,feld,dummy,cl,pr +,se,sp,le);clOR prEND PROC protected;PROC protect(TAG VAR t,INT CONST feld, +BOOL CONST prneu):fieldinfos(t,feld,dummy,cl,pr,se,sp,le);setfieldinfos(t, +feld,cl,prneu,se);END PROC protect;PROC setzeschulisversion(TEXT CONST versi) +:versionsnummer:=text(versi,versilaenge)END PROC setzeschulisversion;TEXT +PROC schulisversion:versionsnummerEND PROC schulisversion;PROC putget(TAG +CONST t,ROW variablenzahlgrossTEXT VAR feld,INT VAR pos):INT VAR i;FOR iFROM +posUPTO variablenzahlgrossREP IF fieldexists(t,i)THEN put(t,feld(i),i)FI PER +;get(t,feld,pos);END PROC putget;PROC get(TAG CONST t,ROW variablenzahlgross +TEXT VAR feld,INT VAR pos):einkopieren(t,feld(pos),pos); +bestimmexykoordinatendesmeldungsfelds(t);REP get(t,feld(pos),pos); +executeextendedcommandcode(t,pos);UNTIL leavingcode=cescPER ;getcursor( +xauskunft,yauskunft);cursor(xruhepos,yruhepos).END PROC get;PROC putget(TAG +CONST t,ROW variablenzahlganzgrossTEXT VAR feld,INT VAR pos):INT VAR i;FOR i +FROM posUPTO variablenzahlganzgrossREP IF fieldexists(t,i)THEN put(t,feld(i), +i)FI PER ;get(t,feld,pos);END PROC putget;PROC get(TAG CONST t,ROW +variablenzahlganzgrossTEXT VAR feld,INT VAR pos):einkopieren(t,feld(pos),pos) +;bestimmexykoordinatendesmeldungsfelds(t);REP get(t,feld(pos),pos); +executeextendedcommandcode(t,pos);UNTIL leavingcode=cescPER ;getcursor( +xauskunft,yauskunft);cursor(xruhepos,yruhepos).END PROC get;PROC einkopieren( +TAG CONST t,TEXT VAR feld,INT CONST pos):IF etwasuntergeschobenTHEN zeigees +FI .etwasuntergeschoben:untergeschobenerfeldinhalt<>"".zeigees:feld:= +untergeschobenerfeldinhalt;put(t,feld,pos);untergeschobenerfeldinhalt:="". +END PROC einkopieren;PROC bestimmexykoordinatendesmeldungsfelds(TAG CONST t): +cursor(t,meldungsfeldnummer);getcursor(x,y);END PROC +bestimmexykoordinatendesmeldungsfelds;PROC executeextendedcommandcode(TAG +CONST t,INT VAR pos):INT VAR charcode:=leavingcode;SELECT charcodeOF CASE +cseiterueck:tofirstfieldCASE cseitevor:tolastfieldOTHERWISE +executecommandcode(t,pos)END SELECT .tofirstfield:pos:=firstfield(t);WHILE +gesperrtREP pos:=nextfield(t,pos)PER .tolastfield:INT VAR oldpos;REP oldpos:= +pos;pos:=nextfield(t,pos)UNTIL warletztesPER ;pos:=oldpos;WHILE gesperrtREP +pos:=priorfield(t,pos)PER .warletztes:pos<1.gesperrt:protected(t,pos).END +PROC executeextendedcommandcode;PROC bildschirmausdrucken(PROC (INT CONST ) +return):cursor(x,y);out(" Der Bildschirminhalt wird ausgedruckt. "); +hardcopy;pause(10);cursor(x,y);out( +"===================================================");return(1)END PROC +bildschirmausdrucken;END PACKET baisyio; + diff --git a/app/baisy/2.2.1-schulis/src/block i-o b/app/baisy/2.2.1-schulis/src/block i-o new file mode 100644 index 0000000..6ac925d --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/block i-o @@ -0,0 +1,52 @@ +PACKET diskblockioDEFINES readdiskblock,readdiskblockandcloseworkiferror, +readdiskcluster,writediskblock,writediskblockandcloseworkiferror, +writediskcluster,firstnondummydspage,blocknodumpmodus:BOOL VAR +blocknodumpflag:=FALSE ;LET writenormal=0;INT CONST firstnondummydspage:=2; +INT VAR error;PROC readdiskblock(DATASPACE VAR ds,INT CONST dspageno,INT +CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun; +readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN lesefehler(error +)FI .END PROC readdiskblock;PROC readdiskblock(DATASPACE VAR ds,INT CONST +dspageno,REAL CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ; +checkrerun;readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN +lesefehler(error)FI .END PROC readdiskblock;PROC +readdiskblockandcloseworkiferror(DATASPACE VAR ds,INT CONST dspageno,INT +CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun; +readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN closework; +lesefehler(error)FI .END PROC readdiskblockandcloseworkiferror;PROC +readdiskblockandcloseworkiferror(DATASPACE VAR ds,INT CONST dspageno,REAL +CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun; +readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN closework; +lesefehler(error)FI .END PROC readdiskblockandcloseworkiferror;PROC +readdiskcluster(DATASPACE VAR ds,INT CONST firstdspageno,REAL CONST clusterno +):IF blocknodumpflagTHEN dump("CLUSTER ",clusterno)FI ;INT VAR i;FOR iFROM 0 +UPTO sectorspercluster-1REP readdiskblock(ds,firstdspageno+i,blockno+real(i)) +PER .blockno:beginofcluster(clusterno).END PROC readdiskcluster;PROC +lesefehler(INT CONST fehlercode):errorstop(fehlertext).fehlertext:SELECT +fehlercodeOF CASE 1:"Diskettenlaufwerk nicht betriebsbereit"CASE 2: +"Lesefehler"OTHERWISE "Lesefehler "+text(fehlercode)END SELECT .END PROC +lesefehler;PROC writediskblock(DATASPACE CONST ds,INT CONST dspageno,INT +CONST blockno):IF blocknodumpflagTHEN dump("WRITE",blockno)FI ;checkrerun; +writeblock(ds,dspageno,writenormal,eublock(blockno),error);IF error>0THEN +schreibfehler(error)FI .END PROC writediskblock;PROC writediskblock( +DATASPACE CONST ds,INT CONST dspageno,REAL CONST blockno):IF blocknodumpflag +THEN dump("WRITE",blockno)FI ;checkrerun;writeblock(ds,dspageno,writenormal, +eublock(blockno),error);IF error>0THEN schreibfehler(error)FI .END PROC +writediskblock;PROC writediskblockandcloseworkiferror(DATASPACE CONST ds,INT +CONST dspageno,INT CONST blockno):IF blocknodumpflagTHEN dump("WRITE",blockno +)FI ;checkrerun;writeblock(ds,dspageno,writenormal,eublock(blockno),error); +IF error>0THEN closework;schreibfehler(error)FI .END PROC +writediskblockandcloseworkiferror;PROC writediskblockandcloseworkiferror( +DATASPACE CONST ds,INT CONST dspageno,REAL CONST blockno):IF blocknodumpflag +THEN dump("WRITE",blockno)FI ;checkrerun;writeblock(ds,dspageno,writenormal, +eublock(blockno),error);IF error>0THEN closework;schreibfehler(error)FI .END +PROC writediskblockandcloseworkiferror;PROC writediskcluster(DATASPACE CONST +ds,INT CONST firstdspageno,REAL CONST clusterno):IF blocknodumpflagTHEN dump( +"CLUSTER ",clusterno)FI ;INT VAR i;FOR iFROM 0UPTO sectorspercluster-1REP +writediskblock(ds,firstdspageno+i,blockno+real(i))PER .blockno:beginofcluster +(clusterno).END PROC writediskcluster;PROC schreibfehler(INT CONST fehlercode +):errorstop(fehlertext).fehlertext:SELECT fehlercodeOF CASE 1: +"Diskettenlaufwerk nicht betriebsbereit"CASE 2:"Schreibfehler"OTHERWISE +"Schreibfehler "+text(fehlercode)END SELECT .END PROC schreibfehler;PROC +blocknodumpmodus(BOOL CONST status):blocknodumpflag:=statusEND PROC +blocknodumpmodus;END PACKET diskblockio; + diff --git a/app/baisy/2.2.1-schulis/src/bpb ds b/app/baisy/2.2.1-schulis/src/bpb ds new file mode 100644 index 0000000..dabf721 Binary files /dev/null and b/app/baisy/2.2.1-schulis/src/bpb ds differ diff --git a/app/baisy/2.2.1-schulis/src/db archive.sc b/app/baisy/2.2.1-schulis/src/db archive.sc new file mode 100644 index 0000000..e68c5ce --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db archive.sc @@ -0,0 +1,7 @@ + PACKETdbarchive DEFINESdbtoarchive,dbfromarchive: TEXT VARuuuuuv:=""; PROCdbtoarchive( TEXT CONSTuuuuux):enablestop;logonarchive;fetchdb(uuuuux);uuuuuz;savetoarchive +(db);uuuuvu;logoffarchive. ENDPROCdbtoarchive; PROCdbfromarchive( TEXT CONSTuuuuux):dbfromarchive(uuuuux,"") ENDPROCdbfromarchive; PROCdbfromarchive( TEXT CONSTuuuuux +, TEXT CONSTuuuuwx):enablestop;logonarchive;uuuuuv:=postfix;postfix(uuuuwx);fetchfromarchive;uuuuuz; IF NOTtaskda(uuuuux) THEN IFyes("Server anlegen") CANDuuuuxw THEN +restoredb(uuuuux);uuuuvu FI ELSErestoredb(uuuuux);uuuuvu FI;uuuuyv.uuuuyv:postfix("");fetchdd(uuuuux); BOOL VARuuuuyy:=dbopen(uuuuux);postfix(uuuuuv);logoffarchive +.uuuuxw: IF NOTexists(uuuuux) THENcopy(uuuuux+uuuuwx,uuuuux) FI;createdb(uuuuux). ENDPROCdbfromarchive; PROCuuuuuz: IFonline THENline; FI ENDPROCuuuuuz; PROCuuuuvu +:commanddialogue( FALSE);forget(db);commanddialogue( TRUE) ENDPROCuuuuvu; ENDPACKETdbarchive; + diff --git a/app/baisy/2.2.1-schulis/src/db dd.sc b/app/baisy/2.2.1-schulis/src/db dd.sc new file mode 100644 index 0000000..7d6d1cd --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db dd.sc @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + +� +#����# diff --git a/app/baisy/2.2.1-schulis/src/db ddinfo.sc b/app/baisy/2.2.1-schulis/src/db ddinfo.sc new file mode 100644 index 0000000..3993705 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db ddinfo.sc @@ -0,0 +1,24 @@ + PACKETddinfopacket DEFINESddinfo: REAL PROCuuuuuv( INT CONSTuuuuuw):records(uuuuuw) ENDPROCuuuuuv; PROCddinfo( TEXT CONSTuuuuvu):ddinfo(uuuuvu,"") ENDPROCddinfo; + PROCddinfo( TEXT CONSTuuuuvu,uuuuwu): INT VARuuuuwv,uuuuww:=1,uuuuwx; TEXT VARuuuuwy; IFuuuuvu="" ORuuuuvu="screen" THENpage ELSEforget(uuuuvu+".dd",quiet);sysout +(uuuuvu+".dd"); IFuuuuvu="printer" THENputline("#type("""+uuuuwu+""")#") FI FI;uuuuxz;putline(" Datenbank: <"+name(1)+">");putline(" Anzahl Dateien erster Index Max DatID 1. Freier Eintrag" +);putline(" "+text(anzdateien)+" "+text(firstindex)+" "+text(maxdatid)+" "+text(firstfree));uuuuyu;uuuuwv:=2; WHILE +uuuuwv");pause;page ELSEsysout(""); IFuuuuvu="printer" THENprint(uuuuvu+".dd");forget(uuuuvu+".dd",quiet); FI FI.uuuuyy:uuuuxz;putline +(" Datei: "+name(uuuuwv)+" (DatID: "+text(datid(uuuuwv))+")");uuuuwy:=compress(text(uuuuuv(uuuuwv),15,0));uuuuwy:=subtext(uuuuwy,1,length(uuuuwy)-1);putline(" Anzahl Schlüsselfelder: " ++text(anzkey(uuuuwv))+" Befugnis: "+text(befugnis(uuuuwv))+" Datensätze: "+uuuuwy);putline(" Feld Typ Länge XN YN XF YF Befug 1234567890123456" +);uuuuwv INCR1;uuuuwx:=1; WHILEuuuuwv23 THENwrite(text(name(uuuuwv),23)+"<") ELSEwrite +(text(name(uuuuwv),23)+" ") FI;write(code(feldtyp(uuuuwv))+" "); IFfeldtyp(uuuuwv)=realfeld THENuuuuwy:=text(einglaenge(uuuuwv))+"."+text(nachkomma(uuuuwv));write +(text("",5-length(uuuuwy)));write(uuuuwy+" ") ELSEwrite(text(einglaenge(uuuuwv),5)+" ") FI;write(text(posxname(uuuuwv),2)+" ");write(text(posyname(uuuuwv),2)+" ") +;write(text(posxfeld(uuuuwv),2)+" ");write(text(posyfeld(uuuuwv),2)+" ");write(text(befugnis(uuuuwv),5)+" ");uuuwuy;line;uuuuwv INCR1; END REP;uuuuyu.uuuwvv:3*" " +.uuuuzw:uuuuyu;line;write("INITIALISIERUNGEN");line;line;uuuuwv:=3; WHILEuuuuwv"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv ++"zu Feld "+text(text(uuuuwv),4)+": "+initialisierung(uuuuwv),76)) FI;uuuuwv INCR1 PER;line.uuuuzx:uuuuyu;line;write("PLAUSIBILITÄTEN");line;line;uuuuwv:=3; WHILE +uuuuwv"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv+"zu Feld "+text(text(uuuuwv),4)+": "+plausi(uuuuwv),76)) FI;uuuuwv INCR1 PER; +line.uuuuzy:uuuuyu;line;write("HILFSTEXTNUMMERN");line;line;uuuuwv:=3; WHILEuuuuwv0 THENputline(uuuwvv+"zu Feld "+text(text(uuuuwv +),4)+": "+text(hilfstextnr(uuuuwv))) FI;uuuuwv INCR1 PER;line.uuuuzz:uuuuyu;line;write("STANDARD-AKTIONEN");line;line;uuuuwv:=3; WHILEuuuuwv1 CANDwas(uuuyuz)<>dateieintrag CANDwas(uuuyuz)<>indexeintrag ENDPROCuuuwwv; ENDPACKETddinfopacket; + diff --git a/app/baisy/2.2.1-schulis/src/db fetch.baisy b/app/baisy/2.2.1-schulis/src/db fetch.baisy new file mode 100644 index 0000000..5f40dd1 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db fetch.baisy @@ -0,0 +1,28 @@ +PACKET fetch dd packet +DEFINES fetch dd, + server station +: + +LET save dd code = 36; + +DATASPACE VAR ds; + +INT VAR reply code, stat no:: station(myself); + +PROC server station (INT CONST server stat): + stat no:= server stat +ENDPROC server station; + +PROC fetch dd (TEXT CONST db name): (* sf 4.12.86 *) + forget(ds); ds:= nilspace; + call (stat no/db name,save dd code,ds,reply code); + IF reply code = save dd code + THEN + forget (db name,quiet); + copy (ds,db name) + FI; + forget(ds) +ENDPROC fetch dd; + +ENDPACKET fetch dd packet; + diff --git a/app/baisy/2.2.1-schulis/src/db kernel.sc b/app/baisy/2.2.1-schulis/src/db kernel.sc new file mode 100644 index 0000000..7d6d1cd --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db kernel.sc @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + +� +#����# diff --git a/app/baisy/2.2.1-schulis/src/db parse.sc b/app/baisy/2.2.1-schulis/src/db parse.sc new file mode 100644 index 0000000..38f0503 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db parse.sc @@ -0,0 +1,38 @@ + PACKETdbparse DEFINESparsetupel,buildtupel,buildkey,parsenooffields,reinitparsing,savetupel,restoretupel,istzahl: LETtextfeld=84,intfeld=73,realfeld=82,aktionsfeld +=65,datumfeld=68,editorfeld=69,pointerfeld=80,#dateieintrag=1,#indexeintrag=2;#schluessel=1,daten=2,alles=3;# TEXT VARuuuuuv:=""; INT VARuuuuuw,uuuuux,uuuuuy; INT + VARuuuuuz,uuuuvu,uuuuvv; TEXT VARuuuuvw:="00",uuuuvx:="",uuuuvy:="",uuuuvz:="",uuuuwu:=""; BOOL VARuuuuwv; BOOL PROCuuuuww( TEXT CONSTuuuuwx):(uuuuwx>"/") AND(uuuuwx +<":") END PROCuuuuww; PROCuuuuxv( INT CONSTuuuuxw):uuuuxv(uuuuxw,uuuuxz) ENDPROCuuuuxv; PROCuuuuxv( INT CONSTuuuuxw,uuuuyx): INT VARuuuuyy:=uuuuxw,uuuuzu:=4,uuuuzv +:=0,uuuuuy:=anzattr(uuuuxw)+uuuuxw; WHILE(uuuuuy>uuuuyy) CANDuuuuzv<=uuuuyx REPuuuuyy INCR1; IF NOTstandardaktion(uuuuyy) THENputzugriff(uuuuyy,uuuvvu(uuuuyy,uuuuzu +)) ELSEuuuuwv:= TRUE FI;uuuuzv INCR1 PER ENDPROCuuuuxv; INT VARuuuuxz:=maxint; PROCparsenooffields( INT CONSTuuuvww):uuuuxz:=uuuvww ENDPROCparsenooffields; INT PROC +parsenooffields:uuuuxz ENDPROCparsenooffields; PROCreinitparsing:uuuuxz:=maxint ENDPROCreinitparsing; TEXT PROCuuuvvu( INT CONSTuuuuyy, INT VARuuuuzu):uuuuuz:=0;uuuuvu +:=2;uuuuvv:=feldtyp(uuuuyy); SELECTuuuuvv OF CASEaktionsfeld,textfeld,pointerfeld,realfeld,editorfeld,datumfeld:#uuuvzw;uuuvzx;#uuuvzy;uuuuwv:=uuuuwv OR(uuuuvv=aktionsfeld +)#change(uuuwuw,1,2+uuuuuz,"")# CASEintfeld:uuuuuz:=2;uuuuvu:=0;uuuvzx;#change(uuuwuw,1,2,"")# ENDSELECT;uuuuzu:=uuuuzu+uuuuuz+uuuuvu;uuuuvx.uuuvzy:uuuuvx:=subtext +(uuuuwu,uuuuzu,uuuuzu+1);#uuuuuz:=wortnachint(uuuuvx);# IFuuuuvx<>"" THENuuuuuz:=uuuuvx ISUB1;uuuuvx:=subtext(uuuuwu,uuuuzu+uuuuvu,uuuuzu+uuuuvu+uuuuuz-1) ELSEuuuuuz +:=0;uuuuvx:="" FI.uuuvzx: IFuuuuuz<>0 THENuuuuvx:=subtext(uuuuwu,uuuuzu+uuuuvu,uuuuzu+uuuuvu+uuuuuz-1) ELSEuuuuvx:="" FI. ENDPROCuuuvvu; PROCuuuxvv( INT CONSTuuuxvw +): INT VARuuuxvx;disablestop; FORuuuxvx FROMuuuxvw+1 UPTOuuuxvw+anzattr(uuuxvw) REP IFfeldtyp(uuuxvx)=aktionsfeld CANDzugriff(uuuxvx)<>"" THEN IFactionlocked(uuuxvx +) THEN#unlockaction(uuuxvx)# ELSEdo(zugriff(uuuxvx)); IFiserror THENactionfailure(uuuxvx, TRUE);clearerror ELSEactionfailure(uuuxvx, FALSE) FI FI FI PER;enablestop + ENDPROCuuuxvv; PROCparsetupel( INT CONSTuuuxxz, TEXT CONSTuuuxyu):parsetupel(uuuxxz,uuuxyu, FALSE, TRUE) ENDPROCparsetupel; PROCparsetupel( INT CONSTuuuxxz, TEXT + CONSTuuuxyu, BOOL CONSTuuuxzw,uuuxzx): INT VARuuuxzy:=uuuxxz; IF NOTuuuxzw THENuuuuwu:=uuuxyu;uuuyux FI.uuuyux: IFwas(uuuxxz)=indexeintrag THENuuuxzy:=dateinr(primdatid +(uuuxxz)) FI;uuuuwv:= FALSE;uuuuxv(uuuxzy); IFuuuuwv CANDuuuxzx THENuuuxvv(uuuxzy) FI. ENDPROCparsetupel; PROCbuildtupel( INT CONSTuuuuxw, TEXT VARuuuxyu): INT VAR +uuuuyy:=uuuuxw,uuuuuy:=anzattr(uuuuxw)+uuuuxw;replace(uuuuvw,1,uuuuxw);uuuuwu:="";uuuuwu CAT"D";uuuuwu CATuuuuvw; WHILEuuuuuy>uuuuyy REPuuuuyy INCR1; IFfeldtyp(uuuuyy +)<>intfeld THEN IF NOTstandardaktion(uuuuyy) THENuuuyzz(zugriff(uuuuyy)) FI; ELSEuuuuwu CATzugriff(uuuuyy) FI PER;uuuxyu:=uuuuwu ENDPROCbuildtupel; PROCuuuyzz( TEXT + CONSTwert):replace(uuuuvw,1,length(wert));uuuuwu CATuuuuvw;uuuuwu CATwert ENDPROCuuuyzz; BOOL PROCistzahl( TEXT CONSTuuuzwv): INT VARuuuzww; FORuuuzww FROM1 UPTO +length(uuuzwv) REP IF NOTuuuuww(uuuzwv SUBuuuzww) THEN LEAVEistzahl WITH FALSE FI PER; TRUE ENDPROCistzahl; PROCbuildkey( INT CONSTuuuuxw, TEXT VARuuuzyu,uuuzyv, BOOL + CONSTuuuzyw,uuuzyx): INT VARuuuzyy:=1,uuuzyz,uuuuyy:=uuuuxw,uuuzzw; BOOL VARuuuzzx:=phonetic(uuuuxw),uuuzzz:=(was(uuuuxw)=indexeintrag);uuuuvy:="";uuuzyu:=""; IF +uuuzyx THENuuuzyv:="";buildkey(dateinr(primdatid(uuuuxw)),uuuzyu,uuuzyv, FALSE, FALSE);uuuzyu:="";uuuuvy:="" FI; IFuuuzzz THENuuvuwu ELSEuuvuwv FI; IFuuuzzx THENuuuzyu + CATcode(0) FI; IFuuuzzz THEN IF#uuvuwz ORuuvuxu ORuuvuxv???#uuuzyw THENuuuzyu CATuuuzyv FI ELSEuuuzyv:=uuuzyu; FI.uuvuwv:uuuuuy:=anzkey(uuuuxw)+uuuuxw; WHILEuuuuyy +0 REPuuvuzw;uuuzyz:=pos(uuuuuv,";",uuuzyy);uuuuyy:=int(subtext(uuuuuv,uuuzyy,uuuzyz-1))+uuuuuw;uuuzyy:=uuuzyz ++1 PER;.uuvuzw:uuuzzw:=feldtyp(uuuuyy); IFuuuzzw=realfeld CORuuuzzw=datumfeld THENuuuzyu CATzugriff(uuuuyy) ELSE# IFuuuzzw=textfeld ORuuuzzw=intfeld ORuuuzzw=aktionsfeld + ORuuuzzw=editorfeld ORuuuzzw=pointerfeld THEN#uuvwuu FI; IF NOTuuuzzx THENuuuzyu CATcode(0) FI.uuvwuu: IF NOTstandardaktion(uuuuyy) THEN IFuuuzzx THENuuuzyu CATphoneticcode +(zugriff(uuuuyy)) ELSEuuuuvy:=zugriff(uuuuyy); IFuuuzzw=textfeld CORuuuzzw=editorfeld THEN IFalpharechts(uuuuyy) CANDistzahl(uuuuvy) THENuuvwwx ELSEuuvwwy FI; FI; +uuuzyu CATuuuuvy FI FI.uuvwwy:changeall(uuuuvy,"ß","ss");changeall(uuuuvy,"Ä","Ae");changeall(uuuuvy,"Ü","Ue");changeall(uuuuvy,"Ö","Oe");changeall(uuuuvy,"ä","ae" +);changeall(uuuuvy,"ü","ue");changeall(uuuuvy,"ö","oe").uuvwwx:uuuuvy:=((einglaenge(uuuuyy)-length(uuuuvy))*"0")+uuuuvy. ENDPROCbuildkey; PROCsavetupel( INT CONST +uuuxzy, TEXT VARuuvwzz): INT VARuuuuyy,uuvxuv; BOOL VARuuvxuw:= FALSE; IFwas(uuuxzy)=dateieintrag THENuuvxuv:=uuuxzy ELSEuuvxuv:=dateinr(primdatid(uuuxzy)) FI;uuvwzz +:=""; FORuuuuyy FROM1 UPTOmin(anzattr(uuvxuv),uuuuxz) REPuuvxuw:=feldtyp(uuuuyy+uuvxuv)=pointerfeld; IFuuvxuw CANDlength(wert(uuuuyy+uuvxuv))<>uuvxxu THENuuvwzz CAT +(uuvxxw+uuvxxx) ELSEuuvwzz CAT(wert(uuvxuv+uuuuyy)+uuvxxx) FI PER ENDPROCsavetupel; PROCrestoretupel( INT CONSTuuuxzy, TEXT CONSTuuvwzz): INT VARuuuuyy,uuvxuv,uuvxzw +,uuuzyy:=1; BOOL VARuuvxuw:= FALSE;uuuuvz:=uuvwzz; IFwas(uuuxzy)=dateieintrag THENuuvxuv:=uuuxzy ELSEuuvxuv:=dateinr(primdatid(uuuxzy)) FI; FORuuuuyy FROMuuvxuv+1 + UPTOuuvxuv+min(anzattr(uuvxuv),uuuuxz) REPuuvxuw:=feldtyp(uuuuyy)=pointerfeld; IFuuvxuw THENuuvxzw:=uuuzyy+4 ELSEuuvxzw:=pos(uuuuvz,uuvxxx,uuuzyy) FI;uuuuvy:=subtext +(uuuuvz,uuuzyy,(uuvxzw-1));uuuzyy:=uuvxzw+1; IFuuvxuw CANDuuuuvy=uuvxxw THENuuuuvy:="" FI;putwert(uuuuyy,uuuuvy) PER ENDPROCrestoretupel; LETuuvxxx="�",uuvxxw="0000" +,uuvxxu=4; ENDPACKETdbparse; + diff --git a/app/baisy/2.2.1-schulis/src/db phon.sc b/app/baisy/2.2.1-schulis/src/db phon.sc new file mode 100644 index 0000000..b4d887a --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db phon.sc @@ -0,0 +1,17 @@ + PACKETphonpacket DEFINESphoneticcode,gross,allesgross:#$ IFmitphonetic THEN# LETa=65,uuuuuv=66,uuuuuw=67,uuuuux=68,e=69,uuuuuy=70,uuuuuz=71,uuuuvu=72,uuuuvv=73,uuuuvw +=74,uuuuvx=75,uuuuvy=76,uuuuvz=77,uuuuwu=78,uuuuwv=79,uuuuww=80,uuuuwx=81,uuuuwy=82,uuuuwz=83,uuuuxu=84,uuuuxv=85,uuuuxw=86,uuuuxx=87,uuuuxy=88,uuuuxz=89,uuuuyu=90 +,uuuuyv=214,uuuuyw=215,uuuuyx=216,uuuuyy=251; TEXT VARuuuuyz:="",uuuuzu:="";#$ FI# TEXT PROCgross( TEXT CONSTuuuuzw): IFcode(uuuuzw)>96 CANDcode(uuuuzw)<123 THENcode +(code(uuuuzw)-32) ELIFcode(uuuuzw)>216 CANDcode(uuuuzw)<220 THENcode(code(uuuuzw)-3) ELSEuuuuzw FI END PROCgross; TEXT PROCallesgross( TEXT CONSTword): TEXT VARuuuvvu +:=""; INT VARuuuuvv; FORuuuuvv FROM1 UPTOlength(word) REPuuuvvu CATgross(word SUBuuuuvv); PER;uuuvvu END PROCallesgross; PROCchange( TEXT VARuuuvww, TEXT CONSTuuuvwx +, INT CONSTpos):change(uuuvww,pos,pos,uuuvwx) ENDPROCchange; TEXT PROCphoneticcode( TEXT CONSTuuuvxv): TEXT VARuuuvxw:="";#$ IFmitphonetic THEN# INT VARuuuvxx:=1; + WHILEuuuvxx<=length(uuuvxv) REP SELECTcode(gross(uuuvxv SUBuuuvxx)) OF CASEuuuuvu:uuuvyy CASEa:uuuvxw CAT"6";uuuvzu CASEuuuuvv:uuuvxw CAT"8";uuuvzx CASEuuuuwv:uuuvxw + CAT"9";uuuwuu CASEuuuuxv:uuuvxw CAT"0";uuuwux CASEuuuuwz:uuuvxw CAT"2";uuuwvu CASEuuuuyv,uuuuyw,e:uuuvxw CAT"7" CASEuuuuvw,uuuuyx,uuuuxz:uuuvxw CAT"8" CASEuuuuuv +,uuuuuy,uuuuww,uuuuxw,uuuuxx:uuuvxw CAT"1" CASEuuuuuw,uuuuuz,uuuuvx,uuuuwx,uuuuxy,uuuuyu,uuuuyy:uuuvxw CAT"2" CASEuuuuux,uuuuxu:uuuvxw CAT"3" CASEuuuuvy,uuuuwy:uuuvxw + CAT"4" CASEuuuuvz,uuuuwu:uuuvxw CAT"5" ENDSELECT;uuuvxx INCR1; IFlength(uuuvxw)>1 CAND(uuuvxw SUBlength(uuuvxw))=(uuuvxw SUB(length(uuuvxw)-1)) THENchange(uuuvxw +,"",length(uuuvxw)) FI PER;#$ FI#uuuvxw.#$ IFmitphonetic THEN#uuuvyy:.uuuvzu: IFuuuvxx0;IF fehler +THEN standardmeldung(meldnrreorgnichtok,"");return(1)ELSE standardmeldung( +meldnrreorgerfolgreich,"");return(1)FI FI END PROC +reorganisierenderanwendungsdaten;END PACKET dbreorganisationauftrag + diff --git a/app/baisy/2.2.1-schulis/src/db reorganisation manager b/app/baisy/2.2.1-schulis/src/db reorganisation manager new file mode 100644 index 0000000..c26715d --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db reorganisation manager @@ -0,0 +1,15 @@ +PACKET dbreorganisationmanagerDEFINES dbreorganisationmanager:INT VAR order; +DATASPACE VAR ds;TASK VAR ordertask;BOOL VAR reorgok;INT VAR returncode;LET +ack=0,nak=1;LET reorganisieren=1;LET dbname="EUMELbase.schulis";PROC +dbreorganisationmanager:setautonom;disablestop;break;REP warteaufauftrag; +fuehreaus;meldezurueckPER .warteaufauftrag:wait(ds,order,ordertask).fuehreaus +:reorgok:=TRUE ;IF order=reorganisierenTHEN datenbankreorganisieren(reorgok); +IF reorgokTHEN returncode:=ackELSE returncode:=nakFI ;FI .meldezurueck:forget +(ds);ds:=nilspace;send(ordertask,returncode,ds).END PROC +dbreorganisationmanager;PROC datenbankreorganisieren(BOOL VAR ok): +commanddialogue(FALSE );forget(all);commanddialogue(TRUE );ok:=TRUE ;postfix( +"");fetchdb(dbname);BOOL VAR b:=dbopen(dbname);reorgdb;IF iserrorTHEN ok:= +FALSE ;clearerrorFI ;IF okTHEN restoredb(dbname)FI ;commanddialogue(FALSE ); +forget(all);commanddialogue(TRUE );END PROC datenbankreorganisierenEND +PACKET dbreorganisationmanager + diff --git a/app/baisy/2.2.1-schulis/src/db scan b/app/baisy/2.2.1-schulis/src/db scan new file mode 100644 index 0000000..e7cf320 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db scan @@ -0,0 +1,245 @@ +PACKET db scan + +(********************************************************************) +(* *) +(* AUTOR : Siegfried Fronzek (ISP GmbH) *) +(* ZWECK : Navigation über eine Tupelmenge *) +(* *) +(* Vor Aufruf der Prozeduren scan first/scan forward *) +(* müssen die ersten n Schlüsselwerte gesetzt werden. *) +(* Diese Schlüsselwerte bestimmen die zu durchlaufende *) +(* Tupel-Menge. *) +(* Die Prozeduren scan last/scan pred bestimmen zum *) +(* vorgegebenen Schlüssel den vorherigen Datensatz! *) +(* *) +(* Die Prozedur scan backward liefert einen Stack incl. *) +(* (eventuell nächstem !!!!) Datensatz zum vorgegebenen *) +(* Schlüssel, eignet sich also nicht zur Simulation *) +(* der Proczedur scan last im Stack-Betrieb. *) +(* *) +(* DATUM : 06.04.87 *) +(* GEÄNDERT: 20.05.87 PROCs scan backward, scan stack entry *) +(* *) +(********************************************************************) + +DEFINES scan first, scan last, scan succ, scan pred, + scan status, scan stack entry, + scan forward, scan backward, scan stack succ, scan stack pred + : + +INT VAR scan db status:: db status; + +PROC scan first (INT CONST index nr, BOOL PROC pruefung): + BOOL VAR exact sve:: exact match; + exact match (FALSE); + scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) search); + IF scan status <> ok + THEN + scan status (file empty) + FI ; + exact match (exact sve) +ENDPROC scan first; + +PROC scan last (INT CONST index nr, BOOL PROC pruefung): + change index; + scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) pred); + IF scan status <> ok + THEN + scan status (file empty) + FI +ENDPROC scan last; + +PROC scan succ (INT CONST index nr, BOOL PROC pruefung): + scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) succ); +ENDPROC scan succ; + +PROC scan pred (INT CONST index nr, BOOL PROC pruefung): + scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) pred); +ENDPROC scan pred; + +INT PROC scan status: + scan db status +ENDPROC scan status; + +PROC scan status (INT CONST stat): + scan db status:= stat +ENDPROC scan status; + +PROC scan rumpf (INT CONST index nr, BOOL PROC pruefung, + PROC (INT CONST) aktion ): + TEXT VAR sve t:: ""; + save tupel (index nr, sve t); + aktion (index nr); + IF db status <> ok + THEN + restore tupel (index nr, sve t); + change index; + scan status (db status) + ELSE + IF NOT pruefung + THEN + restore tupel (index nr, sve t); + change index; + scan status (end of file) + ELSE + scan status (ok) + FI + FI +ENDPROC scan rumpf; + +(******************************************************************) +(* *) +(* STACK ohne Datenraum *) +(* *) +(******************************************************************) +# +PROC scan forward (INT CONST index nr, BOOL PROC pruefung, + INT VAR anz tupels): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) multisearch forward, anz tupels) +ENDPROC scan forward; + +PROC scan backward (INT CONST index nr, BOOL PROC pruefung, + INT VAR anz tupels): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) multisearch backward, anz tupels) + (* !!! Vorsicht: multisearch backward liefert den naechsten zu einem + ungültigen Startwert !!!!! *) +ENDPROC scan backward; + +PROC scan succ (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) multisucc, anz tupels); +ENDPROC scan succ; + +PROC scan pred (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) multipred, anz tupels) +ENDPROC scan pred; + +PROC scan stack succ (INT CONST index nr, BOOL PROC pruefung): + scan stack rumpf (index nr, BOOL PROC pruefung, PROC multisucc); +ENDPROC scan stack succ; + +PROC scan stack pred (INT CONST index nr, BOOL PROC pruefung): + scan stack rumpf (index nr, BOOL PROC pruefung, PROC multipred); +ENDPROC scan stack pred; + +BOOL PROC scan stack entry (INT CONST entry nr, BOOL PROC pruefung): + stack entry (entry nr); + pruefung +ENDPROC scan stack entry; + +PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) aktion, INT VAR anz tupels ): + change index; + aktion (index nr, anz tupels); + scan status (end of file); + change index; + IF anz tupels = 0 COR db status <> ok + THEN + IF anz tupels <> 0 + THEN + scan status (db status) + FI + ELSE + scan status (ok) + FI +ENDPROC scan stack rumpf; + +PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung, + PROC aktion): + aktion; + change index; + IF NOT pruefung + THEN + scan status (end of file) + ELSE + scan status (ok) + FI +ENDPROC scan stack rumpf; + + # +(******************************************************************) +(* *) +(* STACK mit Datenraum *) +(* *) +(******************************************************************) + + +PROC scan forward (INT CONST index nr, BOOL PROC pruefung, + INT VAR anz tupels): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) multisearch forward, + anz tupels) +ENDPROC scan forward; + +PROC scan backward (INT CONST index nr, BOOL PROC pruefung, + INT VAR anz tupels): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) multisearch backward, + anz tupels) + (* !!! Vorsicht: multisearch backward liefert den naechsten zu einem + ungültigen Startwert !!!!! *) +ENDPROC scan backward; + +PROC scan succ (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) multisucc, + anz tupels) +ENDPROC scan succ; + +PROC scan pred (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) multipred, + anz tupels) +ENDPROC scan pred; + +PROC scan stack succ (INT CONST index nr, BOOL PROC pruefung): + scan stack rumpf (index nr, BOOL PROC pruefung, PROC multisucc) +ENDPROC scan stack succ; + +PROC scan stack pred (INT CONST index nr, BOOL PROC pruefung): + scan stack rumpf (index nr, BOOL PROC pruefung, + PROC multipred) +ENDPROC scan stack pred; + +BOOL PROC scan stack entry (INT CONST entry nr, BOOL PROC pruefung ): + stack entry (entry nr); + pruefung +ENDPROC scan stack entry; + +PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung, + PROC (INT CONST,INT VAR) aktion, + INT VAR anz tupels): + change index; + aktion (index nr, anz tupels); + scan status (end of file); + IF anz tupels = 0 COR db status <> ok + THEN + change index; + IF anz tupels <> 0 + THEN + scan status (db status) + FI + ELSE + scan status (ok) + FI +ENDPROC scan stack rumpf; + +PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung, + PROC aktion): + aktion; + IF NOT pruefung + THEN + change index; + scan status (end of file) + ELSE + scan status (ok) + FI +ENDPROC scan stack rumpf; + + +ENDPACKET db scan; + + diff --git a/app/baisy/2.2.1-schulis/src/db utils.sc b/app/baisy/2.2.1-schulis/src/db utils.sc new file mode 100644 index 0000000..7d6d1cd --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/db utils.sc @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + +� +#����# diff --git a/app/baisy/2.2.1-schulis/src/dir.dos b/app/baisy/2.2.1-schulis/src/dir.dos new file mode 100644 index 0000000..fd348a1 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/dir.dos @@ -0,0 +1,187 @@ +PACKET dirDEFINES opendir,insertdirentry,deletedirentry,initdirds,fileinfo, +formatdir,dirlist,fileexists,subdirexists,allfiles,allsubdirs:LET +maxdirentrys=1000;INITFLAG VAR dirblockdsused:=FALSE ;DATASPACE VAR +dirblockds;BOUND STRUCT (ALIGN dummy,ROW 64REAL daten)VAR dirblock;REAL VAR +lastreaddirblockno;PROC initdirblockio:lastreaddirblockno:=-1.0;IF NOT +initialized(dirblockdsused)THEN dirblockds:=nilspace;dirblock:=dirblockdsFI . +END PROC initdirblockio;PROC readdirblock(REAL CONST blocknr):IF +lastreaddirblockno<>blocknrTHEN lastreaddirblockno:=-1.0; +readdiskblockandcloseworkiferror(dirblockds,2,blocknr);lastreaddirblockno:= +blocknrFI .END PROC readdirblock;PROC writedirblock(REAL CONST blocknr): +writediskblockandcloseworkiferror(dirblockds,2,blocknr);lastreaddirblockno:= +blocknr.END PROC writedirblock;PROC writedirblock:IF lastreaddirblockno<0.0 +THEN errorstop("Lesefehler")FI ;writedirblock(lastreaddirblockno)END PROC +writedirblock;PROC getdirentry(TEXT VAR entrybuffer,INT CONST blockentryno): +entrybuffer:=32*".";INT CONST replaceoffset:=4*blockentryno;replace( +entrybuffer,1,dirblock.daten[replaceoffset+1]);replace(entrybuffer,2,dirblock +.daten[replaceoffset+2]);replace(entrybuffer,3,dirblock.daten[replaceoffset+3 +]);replace(entrybuffer,4,dirblock.daten[replaceoffset+4]).END PROC +getdirentry;PROC putdirentry(TEXT CONST entrybuffer,INT CONST blockentryno): +INT CONST offset:=4*blockentryno;dirblock.daten[offset+1]:=entrybufferRSUB 1; +dirblock.daten[offset+2]:=entrybufferRSUB 2;dirblock.daten[offset+3]:= +entrybufferRSUB 3;dirblock.daten[offset+4]:=entrybufferRSUB 4.END PROC +putdirentry;LET DIRPOS =REAL ;DIRPOS PROC dirpos(REAL CONST blocknr,INT +CONST entrynr):blocknr*16.0+real(entrynr).END PROC dirpos;REAL PROC blockno( +DIRPOS CONST p):floor(p/16.0)END PROC blockno;INT PROC entryno(DIRPOS CONST p +):int(pMOD 16.0)END PROC entryno;PROC incr(DIRPOS VAR p):pINCR 1.0.END PROC +incr;LET FREELIST =STRUCT (ROW maxdirentrysDIRPOS stack,INT stacktop,DIRPOS +beginoffreearea,endofdir,REAL dirroot);PROC initfreelist(FREELIST VAR flist, +REAL CONST root):flist.stacktop:=0;flist.beginoffreearea:=dirpos(9.0e99,0); +flist.endofdir:=dirpos(-1.0,0);flist.dirroot:=root.END PROC initfreelist; +PROC store(FREELIST VAR flist,DIRPOS CONST freepos):flist.stacktopINCR 1; +flist.stack[flist.stacktop]:=freepos.END PROC store;PROC storebeginoffreearea +(FREELIST VAR flist,DIRPOS CONST begin):flist.beginoffreearea:=beginEND PROC +storebeginoffreearea;PROC storeendofdir(FREELIST VAR flist,DIRPOS CONST end): +flist.endofdir:=endEND PROC storeendofdir;DIRPOS PROC freedirpos(FREELIST +VAR flist):enablestop;DIRPOS VAR result;IF flist.stacktop>0THEN popELIF NOT +freeareaemptyTHEN firstoffreeareaELIF expansionallowededTHEN +allocatenewdircluster;result:=freedirpos(flist)ELSE errorstop( +"Directory voll")FI ;result.pop:result:=flist.stack[flist.stacktop];flist. +stacktopDECR 1.freeareaempty:flist.beginoffreearea>flist.endofdir. +firstoffreearea:result:=flist.beginoffreearea;incr(flist.beginoffreearea). +expansionalloweded:flist.dirroot>=2.0.allocatenewdircluster:REAL CONST +newdircluster:=availablefatentry;REAL VAR lastentryno; +searchlastentrynooffatchain;fatentry(newdircluster,lastfatchainentry); +fatentry(lastentryno,newdircluster);writefat;storebeginoffreearea(flist, +dirpos(firstnewblock,0));storeendofdir(flist,dirpos(lastnewblock,15)); +initnewdircluster.searchlastentrynooffatchain:lastentryno:=flist.dirroot; +WHILE NOT islastfatchainentry(fatentry(lastentryno))REP lastentryno:=fatentry +(lastentryno)PER .firstnewblock:beginofcluster(newdircluster).lastnewblock: +beginofcluster(newdircluster)+real(sectorspercluster-1).initnewdircluster: +TEXT CONST emptydirentry:=32*"�";INT VAR i;FOR iFROM 0UPTO 15REP putdirentry( +emptydirentry,i)PER ;disablestop;REAL VAR blockno:=firstnewblock;WHILE +blockno<=lastnewblockREP writedirblock(blockno)PER .END PROC freedirpos;LET +FILEENTRY =STRUCT (TEXT dateandtime,REAL size,firstcluster,DIRPOS dirpos), +FILELIST =STRUCT (THESAURUS thes,ROW maxdirentrysFILEENTRY entry);PROC +initfilelist(FILELIST VAR flist):flist.thes:=emptythesaurus.END PROC +initfilelist;PROC storefileentry(FILELIST VAR flist,TEXT CONST entrytext, +DIRPOS CONST position):INT VAR entryindex;insert(flist.thes,filename, +entryindex);storefileentry(flist.entry[entryindex],entrytext,position). +filename:TEXT CONST namepre:=compress(subtext(entrytext,1,8)),namepost:= +compress(subtext(entrytext,9,11));IF namepost<>""THEN namepre+"."+namepost +ELSE namepreFI .END PROC storefileentry;PROC storefileentry(FILEENTRY VAR +fentry,TEXT CONST entrytext,DIRPOS CONST position):fentry.firstcluster:=real( +entrytextISUB 14);fentry.dateandtime:=dosdate+" "+dostime;fentry.size:=dint( +entrytextISUB 15,entrytextISUB 16);fentry.dirpos:=position.dosdate:day+"."+ +month+"."+year.day:text2(code(entrytextSUB 25)MOD 32).month:text2(code( +entrytextSUB 25)DIV 32+8*(code(entrytextSUB 26)MOD 2)).year:text(80+code( +entrytextSUB 26)DIV 2,2).dostime:hour+":"+minute.hour:text2(code(entrytext +SUB 24)DIV 8).minute:text2(code(entrytextSUB 23)DIV 32+8*(code(entrytextSUB +24)MOD 8)).END PROC storefileentry;TEXT PROC text2(INT CONST intvalue):IF +intvalue<10THEN "0"+text(intvalue)ELSE text(intvalue)FI .END PROC text2; +DIRPOS PROC fileentrypos(FILELIST CONST flist,TEXT CONST filename):INT CONST +linkindex:=link(flist.thes,filename);IF linkindex=0THEN errorstop( +"Die Datei """+filename+""" gibt es nicht")FI ;flist.entry[linkindex].dirpos. +END PROC fileentrypos;PROC delete(FILELIST VAR flist,TEXT CONST filename): +INT VAR dummy;delete(flist.thes,filename,dummy).END PROC delete;PROC fileinfo +(FILELIST CONST flist,TEXT CONST filename,REAL VAR firstclusterno,storage): +INT CONST linkindex:=link(flist.thes,filename);IF linkindex=0THEN errorstop( +"Die Datei """+filename+""" gibt es nicht")FI ;firstclusterno:=flist.entry[ +linkindex].firstcluster;storage:=flist.entry[linkindex].sizeEND PROC fileinfo +;BOOL PROC contains(FILELIST VAR flist,TEXT CONST filename):flist.thes +CONTAINS filenameEND PROC contains;PROC list(FILE VAR f,FILELIST CONST flist) +:INT VAR index:=0;TEXT VAR name;get(flist.thes,name,index);WHILE index>0REP +listfile;get(flist.thes,name,index)PER .listfile:write(f,centeredname);write( +f," ");write(f,text(flist.entry[index].size,11,0));write(f, +" Bytes belegt ");write(f,flist.entry[index].dateandtime);write(f, +" +++ ");write(f,text(flist.entry[index].firstcluster));line(f). +centeredname:INT VAR pointpos:=pos(name,".");IF pointpos>0THEN namepre+"."+ +namepostELSE text(name,12)FI .namepre:text(subtext(name,1,pointpos-1),8). +namepost:text(subtext(name,pointpos+1,pointpos+4),3).END PROC list;LET +DIRENTRY =REAL ,DIRLIST =STRUCT (THESAURUS thes,ROW maxdirentrysDIRENTRY +entry);PROC initdirlist(DIRLIST VAR dlist):dlist.thes:=emptythesaurus.END +PROC initdirlist;PROC storesubdirentry(DIRLIST VAR dlist,TEXT CONST entrytext +):INT VAR entryindex;insert(dlist.thes,subdirname,entryindex);dlist.entry[ +entryindex]:=real(entrytextISUB 14).subdirname:TEXT CONST namepre:=compress( +subtext(entrytext,1,8)),namepost:=compress(subtext(entrytext,9,11));IF +namepost<>""THEN namepre+"."+namepostELSE namepreFI .END PROC +storesubdirentry;REAL PROC firstclusterofsubdir(DIRLIST CONST dlist,TEXT +CONST name):INT CONST linkindex:=link(dlist.thes,name);IF linkindex=0THEN +errorstop("Das Unterverzeichnis """+name+""" gibt es nicht")FI ;dlist.entry[ +linkindex].END PROC firstclusterofsubdir;BOOL PROC contains(DIRLIST CONST +dlist,TEXT CONST subdirname):dlist.thesCONTAINS subdirnameEND PROC contains; +PROC list(FILE VAR f,DIRLIST CONST dlist):INT VAR index:=0;TEXT VAR name;get( +dlist.thes,name,index);WHILE index>0REP listdir;get(dlist.thes,name,index) +PER .listdir:write(f,centeredname);write(f," ");write(f," +++ "); +write(f,text(dlist.entry[index]));line(f).centeredname:INT VAR pointpos:=pos( +name,".");IF pointpos>0THEN namepre+"."+namepostELSE text(name,12)FI .namepre +:text(subtext(name,1,pointpos-1),8).namepost:text(subtext(name,pointpos+1, +pointpos+4),3).END PROC list;LET DIR =BOUND STRUCT (FILELIST filelist, +DIRLIST dirlist,FREELIST freelist,TEXT path);DIR VAR dir;DATASPACE VAR dirds; +INITFLAG VAR dirdsused:=FALSE ;PROC opendir(TEXT CONST pathstring): +initdirblockio;initdirds;dir.path:=pathstring;loadmaindir;TEXT VAR restpath:= +pathstring;WHILE restpath<>""REP TEXT CONST subdirname:=nextsubdirname( +restpath);loadsubdirPER .loadmaindir:initfilelist(dir.filelist);initdirlist( +dir.dirlist);initfreelist(dir.freelist,0.0);storeendofdir(dir.freelist,dirpos +(lastmaindirsector,15));BOOL VAR waslastdirsector:=FALSE ;REAL VAR blockno:= +firstmaindirsector;INT VAR i;FOR iFROM 1UPTO dirsectorsREP loaddirblock( +blockno,waslastdirsector);blocknoINCR 1.0UNTIL waslastdirsectorPER . +firstmaindirsector:real(beginofdir).lastmaindirsector:real(beginofdir+ +dirsectors-1).loadsubdir:REAL VAR clusterno:=firstclusterofsubdir(dir.dirlist +,subdirname);waslastdirsector:=FALSE ;initfilelist(dir.filelist);initdirlist( +dir.dirlist);initfreelist(dir.freelist,clusterno);WHILE NOT +islastfatchainentry(clusterno)REP loadsubdirentrysofcluster;clusterno:= +fatentry(clusterno)UNTIL waslastdirsectorPER .loadsubdirentrysofcluster: +storeendofdir(dir.freelist,dirpos(lastblocknoofcluster,15));blockno:= +beginofcluster(clusterno);FOR iFROM 1UPTO sectorsperclusterREP loaddirblock( +blockno,waslastdirsector);blocknoINCR 1.0UNTIL waslastdirsectorPER . +lastblocknoofcluster:beginofcluster(clusterno)+real(sectorspercluster-1).END +PROC opendir;PROC loaddirblock(REAL CONST blockno,BOOL VAR waslastblock): +waslastblock:=FALSE ;readdirblock(blockno);INT VAR entryno;TEXT VAR entry; +FOR entrynoFROM 0UPTO 15REP getdirentry(entry,entryno);processentryUNTIL +waslastblockPER .processentry:SELECT pos("�.�",entrySUB 1)OF CASE 1: +endofdirsearchCASE 2:CASE 3:freeentryOTHERWISE +volumelabelorfileentryorsubdirentryEND SELECT .endofdirsearch:waslastblock:= +TRUE ;storebeginoffreearea(dir.freelist,dirpos(blockno,entryno)).freeentry: +store(dir.freelist,dirpos(blockno,entryno)). +volumelabelorfileentryorsubdirentry:INT CONST byte11:=code(entrySUB 12);IF ( +byte11AND 8)>0THEN ELIF (byte11AND 16)>0THEN subdirentryELSE fileentryFI . +subdirentry:storesubdirentry(dir.dirlist,entry).fileentry:storefileentry(dir. +filelist,entry,dirpos(blockno,entryno)).END PROC loaddirblock;TEXT PROC +nextsubdirname(TEXT VAR pathstring):TEXT VAR subdirname;IF (pathstringSUB 1) +<>"\"THEN errorstop("ungültige Pfadbezeichnung")FI ;INT CONST backslashpos:= +pos(pathstring,"\",2);IF backslashpos=0THEN subdirname:=subtext(pathstring,2) +;pathstring:=""ELSE subdirname:=subtext(pathstring,2,backslashpos-1); +pathstring:=subtext(pathstring,backslashpos)FI ;dosname(subdirname,readmodus) +.END PROC nextsubdirname;PROC initdirds:IF initialized(dirdsused)THEN forget( +dirds)FI ;dirds:=nilspace;dir:=dirds.END PROC initdirds;PROC insertdirentry( +TEXT CONST name,REAL CONST startcluster,storage):DIRPOS CONST inspos:= +freedirpos(dir.freelist);TEXT CONST entrystring:=entryname+" "+(10*"�")+ +dostime+dosdate+entrystartcluster+entrystorage;writeentryondisk; +writeentryindirds.entryname:INT CONST pointpos:=pos(name,".");IF pointpos>0 +THEN subtext(name,1,pointpos-1)+(9-pointpos)*" "+subtext(name,pointpos+1)+(3- +LENGTH name+pointpos)*" "ELSE name+(11-LENGTH name)*" "FI .dostime:TEXT +CONST akttime:=timeofday(clock(1));code((minuteMOD 8)*32)+code(8*hour+minute +DIV 8).hour:int(subtext(akttime,1,2)).minute:int(subtext(akttime,4,5)). +dosdate:TEXT CONST aktdate:=date(clock(1));code(32*(monthMOD 8)+day)+code(( +year-80)*2+monthDIV 8).day:int(subtext(aktdate,1,2)).month:int(subtext( +aktdate,4,5)).year:int(subtext(aktdate,7,8)).entrystartcluster:TEXT VAR +buffer2:="12";replace(buffer2,1,lowword(startcluster));buffer2.entrystorage: +TEXT VAR buffer4:="1234";replace(buffer4,1,lowword(storage));replace(buffer4, +2,highword(storage));buffer4.writeentryondisk:readdirblock(blockno(inspos)); +putdirentry(entrystring,entryno(inspos));writedirblock.writeentryindirds: +storefileentry(dir.filelist,entrystring,inspos).END PROC insertdirentry;PROC +deletedirentry(TEXT CONST name):TEXT VAR entry;DIRPOS CONST delpos:= +fileentrypos(dir.filelist,name);readdirblock(blockno(delpos));getdirentry( +entry,entryno(delpos));putdirentry("�"+subtext(entry,2,32),entryno(delpos)); +writedirblock;delete(dir.filelist,name);store(dir.freelist,delpos).END PROC +deletedirentry;PROC formatdir:initdirblockio;initdirds;buildemptydirblock; +REAL VAR blockno:=real(beginofdir);disablestop;FOR iFROM 1UPTO dirsectorsREP +writedirblock(blockno);blocknoINCR 1.0PER ;enablestop;dir.path:=""; +initfilelist(dir.filelist);initdirlist(dir.dirlist);initfreelist(dir.freelist +,0.0);storebeginoffreearea(dir.freelist,dirpos(real(beginofdir),0)); +storeendofdir(dir.freelist,dirpos(lastmaindirsector,15)).buildemptydirblock: +INT VAR i;FOR iFROM 0UPTO 15REP putdirentry(32*"�",i)PER .lastmaindirsector: +real(beginofdir+dirsectors-1).END PROC formatdir;PROC fileinfo(TEXT CONST +filename,REAL VAR startcluster,size):fileinfo(dir.filelist,filename, +startcluster,size)END PROC fileinfo;THESAURUS PROC allfiles:THESAURUS VAR t:= +dir.filelist.thes;tEND PROC allfiles;THESAURUS PROC allsubdirs:dir.dirlist. +thesEND PROC allsubdirs;BOOL PROC fileexists(TEXT CONST filename):contains( +dir.filelist,filename)END PROC fileexists;BOOL PROC subdirexists(TEXT CONST +subdirname):contains(dir.dirlist,subdirname)END PROC subdirexists;PROC +dirlist(DATASPACE VAR ds):openlistfile;headline(listfile,listfilehead);list( +listfile,dir.filelist);list(listfile,dir.dirlist).openlistfile:forget(ds);ds +:=nilspace;FILE VAR listfile:=sequentialfile(output,ds);putline(listfile,""). +listfilehead:"DOS"+pathstring.pathstring:IF dir.path<>""THEN " PATH: "+ +dir.pathELSE ""FI .END PROC dirlist;END PACKET dir; + diff --git a/app/baisy/2.2.1-schulis/src/disk descriptor.dos b/app/baisy/2.2.1-schulis/src/disk descriptor.dos new file mode 100644 index 0000000..5fa1ce0 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/disk descriptor.dos @@ -0,0 +1,73 @@ +PACKET dosdiskDEFINES opendosdisk,sectorspercluster,fatcopies,dirsectors, +mediadescriptor,fatsectors,beginoffat,fatentrys,beginofdir,beginofcluster, +clustersize,bpbexists,writebpb,eublock,bpbdumpmodus:INITFLAG VAR +bpbdsinitialisiert:=FALSE ;DATASPACE VAR bpbds;BOUND STRUCT (ALIGN dummy,ROW +512INT daten)VAR bpb;BOOL VAR bpbdumpflag:=FALSE ;REAL VAR beginofdataarea; +INT VAR sectorspertrack,heads;IF exists("shard interface")THEN +loadshardinterfacetableFI ;TEXT CONST bpbtype254:="���"+"EUMELBPB"+"��"+"�"+ +"��"+"�"+"§�"+"§�"+"�"+"��"+"��"+"��"+"��",bpbtype255:="���"+"EUMELBPB"+"��"+ +"�"+"��"+"�"+"p�"+"��"+"�"+"��"+"��"+"��"+"��";PROC opendosdisk:enablestop; +bpbdsanboundkoppeln;bpblesen;IF bpbungueltigTHEN versuchepseudobpbzuverwenden +FI ;ueberpruefebpbaufgueltigkeit;globalevariableninitialisieren;IF +bpbdumpflagTHEN dumpschreibenFI .bpbdsanboundkoppeln:IF NOT initialized( +bpbdsinitialisiert)THEN bpbds:=nilspace;bpb:=bpbdsFI .bpblesen:INT VAR return +;checkrerun;readblock(bpbds,2,0,return);IF return<>0THEN lesefehler(return) +FI .bpbungueltig:INT VAR wordno;FOR wordnoFROM 6UPTO 10REP IF bpb.daten[ +wordno+1]<>bpb.daten[wordno+2]THEN LEAVE bpbungueltigWITH FALSE FI PER ;TRUE +.versuchepseudobpbzuverwenden:lieserstenfatsektor;IF +fatsektorgueltigundpseudobpbvorhandenTHEN pseudobpbladenELSE errorstop( +"Format unbekannt")FI .lieserstenfatsektor:checkrerun;readblock(bpbds,2,1, +return);IF return<>0THEN lesefehler(return)FI . +fatsektorgueltigundpseudobpbvorhanden:TEXT VAR fatstart:="1234";replace( +fatstart,1,bpb.daten[1]);replace(fatstart,2,bpb.daten[2]);(fatstartSUB 2)="�" +CAND (fatstartSUB 3)="�"CAND pseudobpbvorhanden.pseudobpbvorhanden:pos("��", +fatstartSUB 1)>0.pseudobpbladen:INT VAR i;FOR iFROM 1UPTO 15REP bpb.daten[i] +:=bpbpufferISUB iPER .bpbpuffer:IF pseudobpbname="�"THEN bpbtype255ELSE +bpbtype254FI .pseudobpbname:fatstartSUB 1.ueberpruefebpbaufgueltigkeit:IF +bytespersector<>512THEN errorstop( +"DOS Format nicht implementiert (unzulässige Sektorgröße)")FI ;IF (fatsectors +>64)THEN errorstop("ungültige DOS Disk (BPB)")FI . +globalevariableninitialisieren:sectorspertrack:=bpbbyte(25)*256+bpbbyte(24); +heads:=bpbbyte(27)*256+bpbbyte(26);beginofdataarea:=real(reservedsectors+ +fatcopies*fatsectors+dirsectors).dumpschreiben:dump("Sektoren pro Cluster", +sectorspercluster);dump("Fat Kopien ",fatcopies);dump( +"Dir Sektoren ",dirsectors);dump("Media Descriptor ", +mediadescriptor);dump("Sektoren pro Fat ",fatsectors);dump( +"Fat Anfang (0) ",beginoffat(0));dump("Fat Einträge ",fatentrys); +dump("Dir Anfang ",beginofdir).END PROC opendosdisk;PROC lesefehler( +INT CONST fehlercode):errorstop(fehlertext).fehlertext:SELECT fehlercodeOF +CASE 1:"Diskettenlaufwerk nicht betriebsbereit"CASE 2:"Lesefehler"OTHERWISE +"Lesefehler "+text(fehlercode)END SELECT .END PROC lesefehler;TEXT VAR +konvertierpuffer:="12";INT PROC bpbbyte(INT CONST byteno):replace( +konvertierpuffer,1,bpb.daten[bytenoDIV 2+1]);code(konvertierpufferSUB +pufferpos).pufferpos:IF evenbytenoTHEN 1ELSE 2FI .evenbyteno:(bytenoMOD 2)=0. +END PROC bpbbyte;INT PROC bytespersector:bpbbyte(12)*256+bpbbyte(11)END PROC +bytespersector;INT PROC sectorspercluster:bpbbyte(13)END PROC +sectorspercluster;INT PROC reservedsectors:bpbbyte(15)*256+bpbbyte(14)END +PROC reservedsectors;INT PROC fatcopies:bpbbyte(16)END PROC fatcopies;INT +PROC dirsectors:direntrysDIV direntryspersector.direntrys:bpbbyte(18)*256+ +bpbbyte(17).direntryspersector:16.END PROC dirsectors;REAL PROC dossectors: +real(bpbbyte(20))*256.0+real(bpbbyte(19))END PROC dossectors;INT PROC +mediadescriptor:bpbbyte(21)END PROC mediadescriptor;INT PROC fatsectors: +bpbbyte(23)*256+bpbbyte(22)END PROC fatsectors;INT PROC beginoffat(INT CONST +fatcopyno):reservedsectors+fatcopyno*fatsectorsEND PROC beginoffat;INT PROC +fatentrys:anzahldatencluster+2.anzahldatencluster:int((dossectors- +tabellensektoren)/real(sectorspercluster)).tabellensektoren:real( +reservedsectors+fatcopies*fatsectors+dirsectors).END PROC fatentrys;INT PROC +beginofdir:reservedsectors+fatcopies*fatsectors.END PROC beginofdir;REAL +PROC beginofcluster(REAL CONST clusterno):beginofdataarea+(clusterno-2.0)* +real(sectorspercluster)END PROC beginofcluster;INT PROC clustersize:512* +sectorsperclusterEND PROC clustersize;BOOL PROC bpbexists(INT CONST no): +exists("bpb ds")AND no>0AND no<4.END PROC bpbexists;PROC writebpb(INT CONST +no):INT VAR return;writeblock(old("bpb ds"),no+1,0,0,return);IF return<>0 +THEN errorstop("Schreibfehler")FI .END PROC writebpb;INT PROC eublock(INT +CONST dosblockno):IF hdversionTHEN dosblocknoELSE dosblocknofloppyformatFI . +dosblocknofloppyformat:IF pageformatTHEN head*eusectorsperhead+trac*eusectors ++sectorELSE head*eusectors+trac*abs(euheads)*eusectors+sectorFI .pageformat: +euheads<0.sector:dosblocknoMOD sectorspertrack.trac:(dosblocknoDIV +sectorspertrack)DIV heads.head:(dosblocknoDIV sectorspertrack)MOD heads. +eusectorsperhead:eusectors*eutracks.eusectors:eulastsector-eufirstsector+1. +END PROC eublock;INT PROC eublock(REAL CONST dosblockno):eublock(lowword( +dosblockno)).END PROC eublock;PROC bpbdumpmodus(BOOL CONST status): +bpbdumpflag:=statusEND PROC bpbdumpmodus;END PACKET dosdisk; + diff --git a/app/baisy/2.2.1-schulis/src/dos hd inserter b/app/baisy/2.2.1-schulis/src/dos hd inserter new file mode 100644 index 0000000..ed8da22 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/dos hd inserter @@ -0,0 +1,12 @@ +IF NOT singleuserTHEN do( +"IF name (myself) <> ""DOS HD"" THEN error stop (""Bitte der Task den Namen 'DOS HD' geben und neu starten"") FI" +);FI ;archive("dos");checkoff;commanddialogue(FALSE );fetch("insert.dos", +archive);fetch("bpb ds",archive);IF singleuserTHEN do(PROC (TEXT CONST )gens, +ALL "insert.dos");gens("manager/S.dos")ELSE fetch(ALL "insert.dos",archive); +fetch("manager/M.dos",archive);release(archive);do(PROC (TEXT CONST )genm, +ALL "insert.dos");genm("manager/M.dos");FI ;do("hd version (TRUE)");forget( +"insert.dos",quiet);forget("dos hd inserter",quiet);IF NOT singleuserTHEN do( +"dos manager (29)")FI .singleuser:(pcb(9)AND 255)=1.PROC genm(TEXT CONST name +):insert(name);forget(name,quiet)END PROC genm;PROC gens(TEXT CONST t):fetch( +t,archive);insert(t);forget(t,quiet)END PROC gens; + diff --git a/app/baisy/2.2.1-schulis/src/dos inserter b/app/baisy/2.2.1-schulis/src/dos inserter new file mode 100644 index 0000000..fcf3d05 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/dos inserter @@ -0,0 +1,15 @@ +IF NOT singleuserTHEN do( +"IF name (myself) <> ""DOS"" THEN error stop (""Bitte der Task den Namen 'DOS' geben und neu starten"") FI" +);FI ;archive("dos");checkoff;commanddialogue(FALSE );hol("shard interface"); +hol("bpb ds");hol("insert.dos");IF singleuserTHEN do(PROC (TEXT CONST )gens, +ALL "insert.dos");gens("manager/S.dos")ELSE do(PROC (TEXT CONST )hol,ALL +"insert.dos");hol("manager/M.dos");release(archive);do(PROC (TEXT CONST )genm +,ALL "insert.dos");genm("manager/M.dos");putline( +"jetzt mit 'dos manager' bzw. 'dos manager (channnel)' starten");FI ;do( +"hd version (FALSE)");do("load shard interface table");forget( +"shard interface",quiet);forget("insert.dos",quiet);forget("dos inserter", +quiet).singleuser:(pcb(9)AND 255)=1.PROC genm(TEXT CONST name):insert(name); +forget(name,quiet)END PROC genm;PROC gens(TEXT CONST t):hol(t);insert(t); +forget(t,quiet)END PROC gens;PROC hol(TEXT CONST t):IF NOT exists(t)THEN +fetch(t,archive)FI END PROC hol; + diff --git a/app/baisy/2.2.1-schulis/src/dump b/app/baisy/2.2.1-schulis/src/dump new file mode 100644 index 0000000..4eb0737 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/dump @@ -0,0 +1,12 @@ +PACKET dumpDEFINES dump:TEXT VAR ergebnis:="";PROC dump(TEXT CONST kommentar, +dumptext):ergebnis:=kommentar;ergebnisCAT ": ";INT VAR i;FOR iFROM 1UPTO +LENGTH dumptextREP zeichenschreibenPER ;ergebnisschreiben.zeichenschreiben: +INT CONST charcode:=code(dumptextSUB i);IF charcode<32THEN ergebnisCAT ("$"+ +text(charcode)+"$")ELSE ergebnisCAT code(charcode)FI .END PROC dump;PROC dump +(TEXT CONST kommentar,INT CONST dumpint):ergebnis:=kommentar;ergebnisCAT ": " +;ergebnisCAT text(dumpint);ergebnisschreiben.END PROC dump;PROC dump(TEXT +CONST kommentar,REAL CONST dumpreal):ergebnis:=kommentar;ergebnisCAT ": "; +ergebnisCAT text(dumpreal);ergebnisschreiben.END PROC dump;PROC +ergebnisschreiben:FILE VAR f:=sequentialfile(output,"logbuch");putline(f, +ergebnis);ergebnis:="".END PROC ergebnisschreiben;END PACKET dump; + diff --git a/app/baisy/2.2.1-schulis/src/editorfunktionen b/app/baisy/2.2.1-schulis/src/editorfunktionen new file mode 100644 index 0000000..495f320 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/editorfunktionen @@ -0,0 +1,56 @@ +PACKET editorfunktionenDEFINES editiere,editierewieeingestellt,zeigedatei, +zeigedateiwieeingestellt,indateivorblaettern,killundenter,andateianfang, +andateiende,aufeditstack,aufeditstackundloeschen,voneditstack, +druckendereditorhilfsdatei,editorunterlegung,loeschendereditorhilfsdatei:LET +standardtasten="�bcqhst!19h?o",maxzeilenlaenge=78,maxzeilennr=23, +erweiterungstasten="gpd";FILE VAR f;TEXT VAR editorhilfsdatei,editortasten; +LET temp="temporäre Druckdatei";INT VAR basiszeile;ROW maxzeilennrTEXT VAR +untergrundzeile;PROC zeigedateiwieeingestellt:zeigedatei(editorhilfsdatei, +editortasten)END PROC zeigedateiwieeingestellt;PROC zeigedatei(TEXT CONST +name,tasten):store(FALSE );f:=sequentialfile(modify,name);editorhilfsdatei:= +name;editortasten:=tasten;openeditor(f,FALSE );edit(groesstereditor, +standardtasten+tasten,PROC leaveeditor);INT VAR xkoord,ykoord;INT CONST +aktlineno:=lineno(f);geteditcursor(xkoord,ykoord);basiszeile:=aktlineno- +ykoord;store(TRUE )END PROC zeigedatei;PROC indateivorblaettern(BOOL CONST +vorwaerts):IF vorwaertsTHEN toline(f,min(lines(f),lineno(f)+maxzeilennr)) +ELSE toline(f,max(1,lineno(f)-maxzeilennr))FI ;return(1)END PROC +indateivorblaettern;PROC editiere(TEXT CONST name):inituntergrundzeilen; +editieren(name,standardtasten)END PROC editiere;PROC editiere(TEXT CONST name +,TEXT CONST tasten):inituntergrundzeilen;editieren(name,standardtasten+tasten +)END PROC editiere;PROC editiere(TEXT CONST name,BOOL CONST standard): +inituntergrundzeilen;IF standardTHEN editiere(name)ELSE editiere(name, +erweiterungstasten)FI END PROC editiere;PROC editiere(TEXT CONST name,TEXT +CONST tasten,BOOL CONST standard):inituntergrundzeilen;IF standardTHEN +editiere(name,tasten)ELSE editiere(name,erweiterungstasten+tasten)FI END +PROC editiere;PROC editierewieeingestellt:editieren(editorhilfsdatei, +editortasten)END PROC editierewieeingestellt;PROC editieren(TEXT CONST name, +TEXT CONST tasten):store(FALSE );f:=sequentialfile(modify,name); +editorhilfsdatei:=name;editortasten:=tasten;edit(f,tasten,PROC leaveeditor); +INT VAR xkoord,ykoord;INT CONST aktlineno:=lineno(f);geteditcursor(xkoord, +ykoord);basiszeile:=aktlineno-ykoord;store(TRUE )END PROC editieren;PROC +leaveeditor(TEXT CONST t):IF pos("19"+erweiterungstasten,t)>0THEN +stdkommandointerpreter(t)ELSE seteingabe(t);quitFI END PROC leaveeditor;PROC +killundenter(INT CONST steps):forget(editorhilfsdatei,quiet);enter(steps)END +PROC killundenter;PROC andateianfang:toline(f,1);return(1)END PROC +andateianfang;PROC andateiende:toline(f,lines(f));return(1)END PROC +andateiende;PROC aufeditstackundloeschen:type("�p"+"�q");edit(f);return(1) +END PROC aufeditstackundloeschen;PROC aufeditstack:type("�d"+"�q");edit(f); +return(1)END PROC aufeditstack;PROC voneditstack:type("�g"+"�q");edit(f); +return(1)END PROC voneditstack;PROC loeschendereditorhilfsdatei:forget( +editorhilfsdatei,quiet);enter(2)END PROC loeschendereditorhilfsdatei;PROC +druckendereditorhilfsdatei:FILE VAR datei;forget(temp,quiet);copy( +editorhilfsdatei,temp);datei:=sequentialfile(modify,temp);tofirstrecord(datei +);INT VAR i;FOR iFROM 1UPTO 5REP insertrecord(datei)PER ;tofirstrecord(datei) +;TEXT VAR satz:="Stand: "+date+" "+timeofday;writerecord(datei,satz); +satz:="Dateiname: "+editorhilfsdatei;toline(datei,2);writerecord(datei, +satz);print(temp);forget(temp,quiet);return(1)END PROC +druckendereditorhilfsdatei;PROC inituntergrundzeilen:INT VAR zeilennr;FOR +zeilennrFROM 1UPTO maxzeilennrREP untergrundzeile(zeilennr):=""PER END PROC +inituntergrundzeilen;TEXT PROC editorunterlegung(INT CONST i):IF i=1THEN +blankzeileELSE IF schondaTHEN diesezeileELSE neuezeileFI FI .blankzeile: +maxzeilenlaenge*" ".schonda:TEXT VAR diesezeile:=untergrundzeile(i-1); +diesezeile<>"".neuezeile:TEXT VAR nzeile:="";toline(f,basiszeile+i); +readrecord(f,nzeile);IF nzeile=""THEN nzeile:=blankzeileFI ;untergrundzeile(i +-1):=nzeile;toline(f,basiszeile);nzeile.END PROC editorunterlegung;END +PACKET editorfunktionen; + diff --git a/app/baisy/2.2.1-schulis/src/erf.auskuenfte b/app/baisy/2.2.1-schulis/src/erf.auskuenfte new file mode 100644 index 0000000..f838768 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/erf.auskuenfte @@ -0,0 +1,66 @@ +PACKET erfauskuenfteDEFINES erfassungauskuenfte,sicherungauskunftsname, +sicherungauskunftstext,zwischenspeicherungdestextes:LET maskenname= +"mb erf auskuenfte",fnrletztesfeld=5,fnrschluessel=2,fnrmaskenname=3, +fnrmaskenfeldnr=4,fnrschluesselverzeichnis=5,trenner=" = ",leer="";TEXT VAR +auskmaskenname,auskunftsname:="",auskunftstext:="",sicherungdestextes:=""; +INT VAR dateinummer:=0;TAG VAR auskmaske;PROC erfassungauskuenfte(INT CONST +proznr):systemdbon;SELECT proznrOF CASE 1:setzeerfassungsparameterCASE 2: +zeigeschluesselzurbearbeitungCASE 3:pruefeplausibilitaetCASE 4: +setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6: +auskunftlesenCASE 7:auskunftaendernCASE 8:auskunfteinfuegenCASE 9: +auskunftloeschenENDSELECT ;END PROC erfassungauskuenfte;PROC +setzeerfassungsparameter:dateinummer:=dnrausk;setzeerfassungsparameter( +dateinummer,maskenname,fnrletztesfeld)END PROC setzeerfassungsparameter;PROC +zeigeschluesselzurbearbeitung:setzeerfassungsfeld("",fnrmaskenname); +setzeerfassungsfeld("",fnrmaskenfeldnr);setzeerfassungsfeld(wert(fnrschlverz) +,fnrschluesselverzeichnis)END PROC zeigeschluesselzurbearbeitung;PROC +pruefeplausibilitaet:LET leer="",meldungmaskegibtsnicht=8;INT VAR +fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )erfassungswert, +fnrschluessel,1,32000,leer,fehlerstatus);IF fehlerstatus<>0THEN +setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;auskmaskenname +:=erfassungswert(fnrmaskenname);IF auskunftsmaskennameangegebenTHEN IF +maskegibtes(auskmaskenname)THEN holemaske;ELSE setzefehlerstatus( +fnrmaskenname);melde(erfassungsmaske,meldungmaskegibtsnicht);LEAVE +pruefeplausibilitaetFI ;FI .auskunftsmaskennameangegeben:auskmaskenname<>"". +holemaske:initmaske(auskmaske,auskmaskenname).END PROC pruefeplausibilitaet; +PROC setzewertefuerdbspeicherung:IF sicherungdestextes=""THEN putwert( +fnrauskunftstext,auskunftstext)ELSE restoretupel(dnrausk,sicherungdestextes); +FI ;putwert(fnrauskunftsname,erfassungswert(fnrschluessel));putwert( +fnrschlverz,erfassungswert(fnrschluesselverzeichnis));END PROC +setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET +trennsymbolfuerobli="$";TEXT VAR identizeile:="";identizeile:=wert( +fnrauskunftsname)+trenner;identizeileCAT wert(fnrauskunftstext);INT VAR +feldlaenge:=maxidentizeilenlaenge;setzeidentiwert( +identizeilemitschluesselanhang).identizeilemaxlang:subtext(identizeile,1, +feldlaenge,"�","�",TRUE ).identizeilemitschluesselanhang:identizeilemaxlang+ +trennsymbolfuerobli+wert(fnrauskunftsname).END PROC +setzeidentiobjektfuerobjektliste;PROC auskunftlesen:INT VAR fehlerstatus; +pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )erfassungswert,fnrschluessel,1 +,32000,leer,fehlerstatus);IF fehlerstatus=0THEN inittupel(dnrausk);putwert( +fnrauskunftsname,erfassungswert(fnrschluessel));search(dnrausk,TRUE );IF +dbstatus=okTHEN saveupdateposition(dnrausk)FI ;auskunftstext:=wert( +fnrauskunftstext);auskunftsname:=erfassungswert(fnrschluessel);ELSE dbstatus( +notfound)FI ENDPROC auskunftlesen;TEXT PROC sicherungauskunftsname: +auskunftsnameENDPROC sicherungauskunftsname;TEXT PROC sicherungauskunftstext: +auskunftstextENDPROC sicherungauskunftstext;PROC zwischenspeicherungdestextes +(TEXT CONST text):putwert(fnrauskunftstext,text);savetupel(dnrausk, +sicherungdestextes)ENDPROC zwischenspeicherungdestextes;PROC auskunftaendern: +restoreupdateposition(dnrausk);update(dnrausk);logbucheintrag("geändert"); +sicherungdestextes:="";IF dbstatus=okAND auskmaskenname<>""THEN +auskunftanmaskeanknuepfenFI END PROC auskunftaendern;PROC auskunfteinfuegen: +insert(dnrausk);logbucheintrag("eingefügt");IF dbstatus=okAND auskmaskenname +<>""THEN auskunftanmaskeanknuepfenFI ;sicherungdestextes:="";END PROC +auskunfteinfuegen;PROC auskunftloeschen:delete(dnrausk);logbucheintrag( +"gelöscht");sicherungdestextes:="";END PROC auskunftloeschen;PROC +logbucheintrag(TEXT CONST logergaenzung):TEXT VAR eintrag:="Auskunft "; +eintragCAT schluessel;eintragCAT " ";eintragCAT logergaenzung;logeintrag( +eintrag)END PROC logbucheintrag;TEXT PROC schluessel:erfassungswert( +fnrschluessel)END PROC schluessel;PROC auskunftanmaskeanknuepfen:INT VAR ug:= +int(subtext(erfassungswert(fnrmaskenfeldnr),1,3)),og:=int(subtext( +erfassungswert(fnrmaskenfeldnr),4,6)),ab:=int(subtext(erfassungswert( +fnrmaskenfeldnr),7,8));INT VAR ifnr;IF og=0THEN og:=ug;ab:=1ELSE IF ab=0THEN +ab:=1FI ;FI ;ifnr:=ug;WHILE ifnr<=ogREP IF fieldexists(auskmaske,ifnr)THEN +auskunftsnr(auskmaske,ifnr,int(schluessel))FI ;ifnrINCR abPER ;setzemaske( +auskmaske);maskespeichern(auskmaskenname);END PROC auskunftanmaskeanknuepfen; +END PACKET erfauskuenfte + diff --git a/app/baisy/2.2.1-schulis/src/eu disk descriptor b/app/baisy/2.2.1-schulis/src/eu disk descriptor new file mode 100644 index 0000000..50f2b7d --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/eu disk descriptor @@ -0,0 +1,26 @@ +PACKET eudiskDEFINES loadshardinterfacetable,openeudisk,eusize,euheads, +eutracks,eufirstsector,eulastsector:LET tablelength=15,sizefield=1,headfield= +2,trackfield=3,firstsectorfield=4,lastsectorfield=5;ROW tablelengthROW 5INT +VAR formattable;INT VAR tabletop:=0,tablepointer;PROC openeudisk:enablestop; +initcheckrerun;IF hdversionTHEN LEAVE openeudiskFI ;INT CONST blocks:= +archiveblocks;IF blocks<=0THEN errorstop("keine Diskette eingelegt")FI ; +searchformattableentry.searchformattableentry:IF tabletop<1THEN errorstop( +"SHard-Interfacetabelle nicht geladen")FI ;tablepointer:=1;WHILE formattable[ +tablepointer][sizefield]<>blocksREP tablepointerINCR 1;IF tablepointer> +tabletopTHEN errorstop("Diskettenformat nicht implementiert")FI PER .END +PROC openeudisk;PROC loadshardinterfacetable:FILE VAR f:=sequentialfile(input +,"shard interface");TEXT VAR line;tabletop:=0;WHILE NOT eof(f)REP getline(f, +line);IF (lineSUB 1)<>";"THEN loadlineFI PER .loadline:tabletopINCR 1;IF +tabletop>tablelengthTHEN errorstop("Shard Interface Tabelle zu groß")FI ;INT +VAR blankpos:=1;formattable[tabletop][sizefield]:=nextint;formattable[ +tabletop][headfield]:=nextint;formattable[tabletop][trackfield]:=nextint; +formattable[tabletop][firstsectorfield]:=nextint;formattable[tabletop][ +lastsectorfield]:=nextint.nextint:line:=compress(subtext(line,blankpos))+" "; +blankpos:=pos(line," ");int(subtext(line,1,blankpos-1)).END PROC +loadshardinterfacetable;INT PROC eusize:formattable[tablepointer][sizefield] +END PROC eusize;INT PROC euheads:formattable[tablepointer][headfield]END +PROC euheads;INT PROC eutracks:formattable[tablepointer][trackfield]END PROC +eutracks;INT PROC eufirstsector:formattable[tablepointer][firstsectorfield] +END PROC eufirstsector;INT PROC eulastsector:formattable[tablepointer][ +lastsectorfield]END PROC eulastsector;END PACKET eudisk; + diff --git a/app/baisy/2.2.1-schulis/src/f packet.sc b/app/baisy/2.2.1-schulis/src/f packet.sc new file mode 100644 index 0000000..b9c3e15 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/f packet.sc @@ -0,0 +1,9 @@ + PACKETfpacket DEFINESfetchfast,savefast: LETuuuuuv=50,uuuuuw=51,uuuuux=47,uuuuuy=66,uuuuuz=0,uuuuvu=1; INT VARuuuuvv; DATASPACE VARuuuuvw; BOUND TEXT VARuuuuvx; TASK + VARuuuuvy; TEXT VARuuuuvz:=""; PROCfetchfast( TEXT CONSTuuuuwv): TASK VARuuuuww;uuuuvy:=/uuuuwv;forget(uuuuvw);uuuuvw:=nilspace;call(/uuuuwv,uuuuux,uuuuvw,uuuuvv +); IFuuuuvv=uuuuuz THENuuuuyv FI.uuuuyv: REPforget(uuuuvw);wait(uuuuvw,uuuuvv,uuuuww); SELECTuuuuvv OF CASEuuuuuv:uuuuvx:=uuuuvw;uuuuvz:=uuuuvx;uuuvuv CASEuuuuuw: +forget(uuuuvz,quiet);copy(uuuuvw,uuuuvz);uuuvuv OTHERWISE:uuuvvv ENDSELECT PER.uuuvvv: IFuuuuww=uuuuvy CANDuuuuvv=uuuuuy THEN LEAVEuuuuyv ELSEuuuvww FI.uuuvww:send +(uuuuww,uuuuvu,uuuuvw).uuuvuv:send(uuuuww,uuuuuz,uuuuvw). ENDPROCfetchfast; PROCsavefast( TASK CONSTuuuvyv): THESAURUS VARuuuvyw:= ALLmyself; INT VARuuuvyx;uuuvyy +;uuuvyz;uuuvzu.uuuvyy:forget(uuuuvw);uuuuvw:=nilspace;send(uuuvyv,uuuuuz,uuuuvw).uuuvyz:uuuvyx:=0;get(uuuvyw,uuuuvz,uuuvyx); WHILEuuuvyx>0 REPuuuwvv;get(uuuvyw,uuuuvz +,uuuvyx) PER;.uuuwvv:uuuwwu;uuuwwv.uuuwwu:forget(uuuuvw);uuuuvw:=nilspace;uuuuvx:=uuuuvw;uuuuvx:=uuuuvz;call(uuuvyv,uuuuuv,uuuuvw,uuuuvv).uuuwwv:forget(uuuuvw);uuuuvw +:=old(uuuuvz);call(uuuvyv,uuuuuw,uuuuvw,uuuuvv).uuuvzu:forget(uuuuvw);uuuuvw:=nilspace;send(uuuvyv,uuuuuy,uuuuvw). ENDPROCsavefast; ENDPACKETfpacket; + diff --git a/app/baisy/2.2.1-schulis/src/fat.dos b/app/baisy/2.2.1-schulis/src/fat.dos new file mode 100644 index 0000000..79129b9 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/fat.dos @@ -0,0 +1,82 @@ +PACKET dosfatDEFINES readfat,writefat,firstfatblockok,clearfatds,formatfat, +fatentry,lastfatchainentry,islastfatchainentry,erasefatchain, +availablefatentry:LET fatsize=16384,maxanzahlfatsektoren=64;LET FAT =BOUND +STRUCT (ALIGN dummy,ROW 256INT blockrow,ROW fatsizeINT fatrow);DATASPACE VAR +fatds;INITFLAG VAR fatdsused:=FALSE ;FAT VAR fatstruktur;.fat:fatstruktur. +fatrow.REAL VAR erstermoeglicherfreiereintrag;BOOL VAR kleinesfatformat;PROC +readfat:fatdsinitialisieren;fatbloeckelesen;fatformatbestimmen; +erstermoeglicherfreiereintrag:=2.0.fatdsinitialisieren:clearfatds;fatstruktur +:=fatds.fatbloeckelesen:LET keintestblock=FALSE ;INT VAR blockno;FOR blockno +FROM 0UPTO fatsectors-1REP fatblocklesen(blockno,keintestblock)PER . +fatformatbestimmen:IF fatentrys<=4086THEN kleinesfatformat:=TRUE ELSE +kleinesfatformat:=FALSE FI .END PROC readfat;PROC writefat:disablestop;INT +VAR blocknr;FOR blocknrFROM 0UPTO fatsectors-1REP fatblockschreiben(blocknr) +PER .END PROC writefat;BOOL PROC firstfatblockok:enablestop;LET testblock= +TRUE ;fatblocklesen(0,testblock);INT VAR i;FOR iFROM 1UPTO 256REP +vergleichewoerterPER ;TRUE .vergleichewoerter:IF fat[i]<>fatstruktur.blockrow +[i]THEN LEAVE firstfatblockokWITH FALSE FI .END PROC firstfatblockok;PROC +clearfatds:IF initialized(fatdsused)THEN forget(fatds)FI ;fatds:=nilspace. +END PROC clearfatds;PROC formatfat:fatdsinitialisieren;fatformatbestimmen; +erstermoeglicherfreiereintrag:=2.0;writefirstfourfatbytes;writeotherfatbytes; +vermerkeschreibzugriffe;writefat.fatdsinitialisieren:clearfatds;fatstruktur:= +fatds.fatformatbestimmen:IF fatentrys<=4086THEN kleinesfatformat:=TRUE ELSE +kleinesfatformat:=FALSE FI .writefirstfourfatbytes:fat[1]:=word( +mediadescriptor,255);IF kleinesfatformatTHEN fat[2]:=word(255,0)ELSE fat[2]:= +word(255,255)FI .writeotherfatbytes:INT VAR i;FOR iFROM 3UPTO 256*fatsectors +REP fat[i]:=0PER .vermerkeschreibzugriffe:FOR iFROM 0UPTO fatsectors-1REP +schreibzugriff(i)PER .END PROC formatfat;REAL PROC fatentry(REAL CONST +realentryno):INT CONST entryno:=int(realentryno);IF kleinesfatformatTHEN +construct12bitvalueELSE dint(fat[entryno+1],0)FI .construct12bitvalue:INT +CONST firstbyteno:=entryno+entrynoDIV 2;IF entrynoMOD 2=0THEN real((rightbyte +MOD 16)*256+leftbyte)ELSE real(rightbyte*16+leftbyteDIV 16)FI .leftbyte: +fatbyte(firstbyteno).rightbyte:fatbyte(firstbyteno+1).END PROC fatentry;TEXT +VAR convertbuffer:="12";INT PROC fatbyte(INT CONST no):replace(convertbuffer, +1,word);IF evenbytenoTHEN code(convertbufferSUB 1)ELSE code(convertbufferSUB +2)FI .evenbyteno:noMOD 2=0.word:fat[noDIV 2+1].END PROC fatbyte;PROC fatentry +(REAL CONST realentryno,realvalue):INT CONST entryno:=int(realentryno),value +:=lowword(realvalue);IF kleinesfatformatTHEN write12bitvalueELSE fat[entryno+ +1]:=value;schreibzugriff(entrynoDIV 256)FI ;updatefirstpossibleavailableentry +.write12bitvalue:INT CONST firstbyteno:=entryno+entrynoDIV 2;schreibzugriff( +fatblockoffirstbyte);schreibzugriff(fatblockofsecondbyte);writevalue. +fatblockoffirstbyte:firstbytenoDIV 512.fatblockofsecondbyte:secondbytenoDIV +512.writevalue:IF evenentrynoTHEN writefatbyte(firstbyteno,valueMOD 256); +writefatbyte(secondbyteno,(rightbyteDIV 16)*16+valueDIV 256)ELSE writefatbyte +(firstbyteno,(leftbyteMOD 16)+16*(valueMOD 16));writefatbyte(secondbyteno, +valueDIV 16)FI .evenentryno:entrynoMOD 2=0.secondbyteno:firstbyteno+1. +leftbyte:fatbyte(firstbyteno).rightbyte:fatbyte(secondbyteno). +updatefirstpossibleavailableentry:IF value=0THEN +erstermoeglicherfreiereintrag:=min(erstermoeglicherfreiereintrag,realentryno) +FI .END PROC fatentry;PROC writefatbyte(INT CONST byteno,newvalue): +readoldword;changebyte;writenewword.readoldword:replace(convertbuffer,1,word) +.writenewword:word:=convertbufferISUB 1.word:fat[bytenoDIV 2+1].changebyte: +replace(convertbuffer,bytepos,code(newvalue)).bytepos:bytenoMOD 2+1.END PROC +writefatbyte;REAL PROC lastfatchainentry:IF kleinesfatformatTHEN 4088.0ELSE +65528.0FI .END PROC lastfatchainentry;BOOL PROC islastfatchainentry(REAL +CONST value):value>=lastfatchainentryEND PROC islastfatchainentry;PROC +erasefatchain(REAL CONST firstentryno):REAL VAR nextentryno:=firstentryno, +actentryno:=0.0;WHILE nextentryexistsREP actentryno:=nextentryno;nextentryno +:=fatentry(actentryno);fatentry(actentryno,0.0)PER .nextentryexists:NOT +islastfatchainentry(nextentryno).END PROC erasefatchain;REAL PROC +availablefatentry:INT VAR i;REAL VAR reali:=erstermoeglicherfreiereintrag; +FOR iFROM int(erstermoeglicherfreiereintrag)UPTO fatentrys-1REP IF fatentry( +reali)=0.0THEN erstermoeglicherfreiereintrag:=reali;LEAVE availablefatentry +WITH erstermoeglicherfreiereintragFI ;realiINCR 1.0PER ;closework;errorstop( +"MS-DOS Datentraeger voll");1.0e99.END PROC availablefatentry;PROC +fatblocklesen(INT CONST blocknr,BOOL CONST testblock):disablestop;IF NOT +testblockTHEN keinschreibzugriff(blocknr)FI ;INT VAR kopienr;FOR kopienrFROM +0UPTO fatcopies-1REP clearerror;readdiskblock(fatds,dsseitennr,diskblocknr) +UNTIL NOT iserrorPER ;IF iserrorTHEN closeworkFI .dsseitennr:IF testblock +THEN 2ELSE blocknr+2+1FI .diskblocknr:beginoffat(kopienr)+blocknr.END PROC +fatblocklesen;PROC fatblockschreiben(INT CONST blocknr):IF warschreibzugriff( +blocknr)THEN wirklichschreibenFI .wirklichschreiben:disablestop;INT VAR +kopienr;FOR kopienrFROM 0UPTO fatcopies-1REP +writediskblockandcloseworkiferror(fatds,dsseitennr,diskblocknr)PER ; +keinschreibzugriff(blocknr).dsseitennr:blocknr+2+1.diskblocknr:beginoffat( +kopienr)+blocknr.END PROC fatblockschreiben;ROW maxanzahlfatsektorenBOOL VAR +schreibzugrifftabelle;PROC schreibzugriff(INT CONST fatsektor): +schreibzugrifftabelle[fatsektor+1]:=TRUE END PROC schreibzugriff;PROC +keinschreibzugriff(INT CONST fatsektor):schreibzugrifftabelle[fatsektor+1]:= +FALSE END PROC keinschreibzugriff;BOOL PROC warschreibzugriff(INT CONST +fatsektor):schreibzugrifftabelle[fatsektor+1]END PROC warschreibzugriff;END +PACKET dosfat; + diff --git a/app/baisy/2.2.1-schulis/src/fetch b/app/baisy/2.2.1-schulis/src/fetch new file mode 100644 index 0000000..3b91788 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/fetch @@ -0,0 +1,108 @@ +PACKET fetchDEFINES fetch,checkfile:LET ascii=1,asciigerman=2,transparent=3, +rowtext=5,ds=6,dump=7,atarist=10,ibm=11,minlineendchar=" +",maxlineendchar=" " +,lf=" +",cr=" ",tabcode=9,lfcode=10,ffcode=12,crcode=13,ctrlz="�",pagecmd= +"#page#",rowtextlength=4000,rowtexttype=1000;BOUND STRUCT (INT size,ROW +rowtextlengthTEXT clusterrow)VAR clusterstruct;FILE VAR file;TEXT VAR buffer; +INT VAR bufferlength;PROC fetch(TEXT CONST name,DATASPACE VAR fileds,INT +CONST mode):SELECT modeOF CASE ascii,asciigerman,atarist,ibm,transparent: +fetchfilemode(fileds,name,mode)CASE rowtext:fetchrowtextmode(fileds,name) +CASE ds:fetchdsmode(fileds,name)CASE dump:fetchdumpmode(fileds,name) +OTHERWISE errorstop("Unzulässige Betriebsart")END SELECT .END PROC fetch; +PROC fetchfilemode(DATASPACE VAR filespace,TEXT CONST name,INT CONST codetype +):enablestop;initializefetchfilemode;openfetchdosfile(name);WHILE NOT +waslastfetchclusterREP gettextofcluster;writelines;IF lines(file)>3900THEN +putline(file,">>> FREMDDATEI FUER EUMEL ZU LANG. ES KÖNNEN DATEN FEHLEN <<<") +;LEAVE fetchfilemodeFI ;UNTIL fileendviactrlzPER ;writelastlineifnecessary; +closefetchdosfile.initializefetchfilemode:buffer:="";bufferlength:=0;forget( +filespace);filespace:=nilspace;file:=sequentialfile(output,filespace);BOOL +VAR fileendviactrlz:=FALSE .gettextofcluster:catnextfetchdoscluster(buffer); +IF asciicodeTHEN ctrlzisbufferendFI ;adaptcode(buffer,bufferlength+1,codetype +);bufferlength:=length(buffer).asciicode:(codetype=ascii)OR (codetype= +asciigerman).ctrlzisbufferend:INT CONST ctrlzpos:=pos(buffer,ctrlz, +bufferlength+1);fileendviactrlz:=ctrlzpos>0;IF fileendviactrlzTHEN buffer:= +subtext(buffer,1,ctrlzpos-1);bufferlength:=length(buffer)FI .writelines:INT +VAR linebeginpos:=1,lineendpos;computelineendpos;WHILE lineendpos>0REP +putline(file,subtext(buffer,linebeginpos,lineendpos));exec(PROC (TEXT CONST , +INT CONST )controlcharconversion,file,codetype);linebeginpos:=lineendpos+1; +computelineendposPER ;buffer:=subtext(buffer,linebeginpos);bufferlength:= +length(buffer);IF bufferlength>5000THEN putline(file,buffer);exec(PROC (TEXT +CONST ,INT CONST )controlcharconversion,file,codetype);buffer:=""; +bufferlength:=0FI .computelineendpos:lineendpos:=linebeginpos;REP lineendpos +:=pos(buffer,minlineendchar,maxlineendchar,lineendpos);INT CONST lineendcode +:=code(bufferSUB lineendpos);SELECT lineendcodeOF CASE lfcode:lookforcrCASE +11:lineendposINCR 1CASE crcode:lookforlfEND SELECT UNTIL lineendcode<>11PER . +lookforcr:IF lineendpos=bufferlengthTHEN lineendpos:=0ELIF (bufferSUB +lineendpos+1)=crTHEN lineendposINCR 1FI .lookforlf:IF lineendpos=bufferlength +THEN lineendpos:=0ELIF (bufferSUB lineendpos+1)=lfTHEN lineendposINCR 1FI . +writelastlineifnecessary:IF bufferlength>0THEN putline(file,buffer);exec( +PROC (TEXT CONST ,INT CONST )controlcharconversion,file,codetype);FI .END +PROC fetchfilemode;PROC adaptcode(TEXT VAR textbuffer,INT CONST startpos, +codetype):SELECT codetypeOF CASE ascii:cancelbit8CASE asciigerman:cancelbit8; +asciigermanadaptionCASE atarist:ataristadaptionCASE ibm:ibmadaptionEND +SELECT .cancelbit8:INT VAR setpos:=pos(textbuffer,"�","�",startpos);WHILE +setpos>0REP replace(textbuffer,setpos,sevenbitchar);setpos:=pos(textbuffer, +"�","�",setpos+1)PER .sevenbitchar:code(code(textbufferSUB setpos)AND 127). +asciigermanadaption:changeallbyreplace(textbuffer,startpos,"[","Ä"); +changeallbyreplace(textbuffer,startpos,"\","Ö");changeallbyreplace(textbuffer +,startpos,"]","Ü");changeallbyreplace(textbuffer,startpos,"{","ä"); +changeallbyreplace(textbuffer,startpos,"|","ö");changeallbyreplace(textbuffer +,startpos,"}","ü");changeallbyreplace(textbuffer,startpos,"~","ß"). +ataristadaption:changeallbyreplace(textbuffer,startpos,"Ξ","Ä"); +changeallbyreplace(textbuffer,startpos,"�","Ö");changeallbyreplace(textbuffer +,startpos,"�","Ü");changeallbyreplace(textbuffer,startpos,"Δ","ä"); +changeallbyreplace(textbuffer,startpos,"Υ","ö");changeallbyreplace(textbuffer +,startpos,"Α","ü");changeallbyreplace(textbuffer,startpos,"�","ß"). +ibmadaption:changeallbyreplace(textbuffer,startpos,"Ξ","Ä"); +changeallbyreplace(textbuffer,startpos,"�","Ö");changeallbyreplace(textbuffer +,startpos,"�","Ü");changeallbyreplace(textbuffer,startpos,"Δ","ä"); +changeallbyreplace(textbuffer,startpos,"Υ","ö");changeallbyreplace(textbuffer +,startpos,"Α","ü");changeallbyreplace(textbuffer,startpos,"�","ß").END PROC +adaptcode;PROC changeallbyreplace(TEXT VAR string,INT CONST beginpos,TEXT +CONST old,new):INT VAR p:=pos(string,old,beginpos);WHILE p>0REP replace( +string,p,new);p:=pos(string,old,p+1)PER .END PROC changeallbyreplace;PROC +controlcharconversion(TEXT VAR string,INT CONST codetype):IF codetype<> +transparentTHEN codeconversionFI .codeconversion:INT VAR p:=pos(string,"�", +"�",1);WHILE p>0REP convertchar;p:=pos(string,"�","�",p)PER .convertchar:INT +CONST charcode:=code(stringSUB p);SELECT charcodeOF CASE tabcode:expandtab +CASE lfcode:change(string,p,p,"")CASE ffcode:change(string,p,p,pagecmd)CASE +crcode:change(string,p,p,"")OTHERWISE ersatzdarstellungEND SELECT .expandtab: +change(string,p,p,(8-(p-1)MOD 8)*" ").ersatzdarstellung:TEXT CONST t:=text( +charcode);change(string,p,p,"#"+(3-length(t))*"0"+t+"#").END PROC +controlcharconversion;PROC fetchrowtextmode(DATASPACE VAR filespace,TEXT +CONST name):enablestop;openfetchdosfile(name);initializefetchrowtextmode; +WHILE NOT waslastfetchclusterREP clusterstruct.sizeINCR 1;clusterstruct. +clusterrow[clusterstruct.size]:="";catnextfetchdoscluster(clusterstruct. +clusterrow[clusterstruct.size])PER ;closefetchdosfile. +initializefetchrowtextmode:forget(filespace);filespace:=nilspace; +clusterstruct:=filespace;type(filespace,rowtexttype);clusterstruct.size:=0. +END PROC fetchrowtextmode;PROC fetchdsmode(DATASPACE VAR inds,TEXT CONST name +):enablestop;openfetchdosfile(name);initfetchdsmode;WHILE NOT +waslastfetchclusterREP readnextfetchdoscluster(inds,dsblockno);PER ; +closefetchdosfile.initfetchdsmode:forget(inds);inds:=nilspace;INT VAR +dsblockno:=2.END PROC fetchdsmode;PROC fetchdumpmode(DATASPACE VAR filespace, +TEXT CONST name):enablestop;openfetchdosfile(name);initializefetchdumpmode; +WHILE NOT waslastfetchclusterREP TEXT VAR clusterbuffer:=""; +catnextfetchdoscluster(clusterbuffer);dumpclusterUNTIL offset>50000.0PER ; +closefetchdosfile.initializefetchdumpmode:BOOL VAR fertig:=FALSE ;REAL VAR +offset:=0.0;forget(filespace);filespace:=nilspace;file:=sequentialfile(output +,filespace).dumpcluster:TEXT VAR dumpline;INT VAR line,column;FOR lineFROM 0 +UPTO (clustersizeDIV 16)-1REP builddumpline;putline(file,dumpline);offset +INCR 16.0UNTIL fertigPER .builddumpline:TEXT VAR charline:="";dumpline:=text( +offset,6,0);dumpline:=subtext(dumpline,1,5);dumplineCAT " ";FOR columnFROM +0UPTO 7REP convertchar;dumplineCAT " "PER ;dumplineCAT " ";FOR columnFROM 8 +UPTO 15REP convertchar;dumplineCAT " "PER ;dumplineCAT " ";dumplineCAT +charline.convertchar:TEXT CONST char:=clusterbufferSUB (line*16+column+1);IF +char=""THEN fertig:=TRUE ;dumplineCAT " ";LEAVE convertcharFI ;INT CONST +charcode:=code(char);LET hexchars="0123456789ABCDEF";dumplineCAT (hexchars +SUB (charcodeDIV 16+1));dumplineCAT (hexcharsSUB (charcodeMOD 16+1));charline +CAT showchar.showchar:IF (charcode>31AND charcode<127)THEN charELSE "."FI . +END PROC fetchdumpmode;PROC checkfile(TEXT CONST name):disablestop;DATASPACE +VAR testds:=nilspace;enablecheckfile(name,testds);forget(testds);IF iserror +THEN clearerror;errorstop("Fehler beim Prüflesen der Datei """+name+"""")FI . +END PROC checkfile;PROC enablecheckfile(TEXT CONST name,DATASPACE VAR testds) +:enablestop;openfetchdosfile(name);WHILE NOT waslastfetchclusterREP INT VAR +dummy:=2;readnextfetchdoscluster(testds,dummy)PER ;closefetchdosfile.END +PROC enablecheckfile;END PACKET fetch; + diff --git a/app/baisy/2.2.1-schulis/src/fetch save interface b/app/baisy/2.2.1-schulis/src/fetch save interface new file mode 100644 index 0000000..24abb49 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/fetch save interface @@ -0,0 +1,16 @@ +PACKET fetchsaveDEFINES savefetchmode,path:LET ascii=1,asciigerman=2, +transparent=3,rowtext=5,ds=6,dump=7,atarist=10,ibm=11;INT PROC savefetchmode( +TEXT CONST reservestring):TEXT VAR modus;INT CONST p:=pos(reservestring,":"); +IF p=0THEN modus:=reservestringELSE modus:=subtext(reservestring,1,p-1)FI ; +modusnormieren;IF modus="FILEASCII"THEN asciiELIF modus="FILEASCIIGERMAN" +THEN asciigermanELIF modus="FILEATARIST"THEN ataristELIF modus="FILEIBM"THEN +ibmELIF modus="FILETRANSPARENT"THEN transparentELIF modus="ROWTEXT"THEN +rowtextELIF modus="DS"THEN dsELIF modus="DUMP"THEN dumpELSE errorstop( +"Unzulässige Betriebsart");-1FI .modusnormieren:changeall(modus," ","");INT +VAR i;FOR iFROM 1UPTO LENGTH modusREP INT CONST charcode:=code(modusSUB i); +IF islowercaseTHEN replace(modus,i,uppercasechar)FI PER .islowercase:charcode +>96AND charcode<123.uppercasechar:code(charcode-32).END PROC savefetchmode; +TEXT PROC path(TEXT CONST reservestring):INT CONST p:=pos(reservestring,":"); +IF p=0THEN ""ELSE subtext(reservestring,p+1)FI .END PROC path;END PACKET +fetchsave; + diff --git a/app/baisy/2.2.1-schulis/src/get put interface.dos b/app/baisy/2.2.1-schulis/src/get put interface.dos new file mode 100644 index 0000000..1e80856 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/get put interface.dos @@ -0,0 +1,103 @@ +PACKET dosgetputDEFINES logmodus,opendosdisk,closedosdisk,accessdosdisk, +openfetchdosfile,closefetchdosfile,catnextfetchdoscluster, +readnextfetchdoscluster,waslastfetchcluster,opensavedosfile, +writenextsavedoscluster,closesavedosfile,erasedosfile,alldosfiles, +alldossubdirs,dosfileexists,doslist,cleardosdisk,formatdosdisk:BOOL VAR +logflag:=FALSE ;PROC logmodus(BOOL CONST status):logflag:=statusEND PROC +logmodus;LET maxclustersize=8192,realspersector=64;LET CLUSTER =BOUND STRUCT +(ALIGN dummy,ROW maxclustersizeREAL clusterrow);CLUSTER VAR cluster; +DATASPACE VAR clusterds;INITFLAG VAR clusterdsused:=FALSE ;TEXT VAR +convertbuffer;INT VAR convertbufferlength;PROC initclusterhandle:IF +initialized(clusterdsused)THEN forget(clusterds)FI ;clusterds:=nilspace; +cluster:=clusterds;convertbuffer:="";convertbufferlength:=0.END PROC +initclusterhandle;PROC catclustertext(REAL CONST clusterno,TEXT VAR +destination,INT CONST to):readdiskcluster(clusterds,2,clusterno); +initconvertbuffer;INT VAR i;FOR iFROM 1UPTO sectorspercluster*realspersector +REP replace(convertbuffer,i,cluster.clusterrow[i])PER ;destinationCAT subtext +(convertbuffer,1,to).initconvertbuffer:IF convertbufferlength5.0.diskchanged: +IF hdversionTHEN FALSE ELSE lastaccesstime:=clock(1);NOT firstfatblockokFI . +END PROC accessdosdisk;REAL VAR nextfetchcluster,fetchrest;PROC +openfetchdosfile(TEXT CONST filename):IF logflagTHEN dump( +"open fetch dos file",filename)FI ;enablestop;accessdosdisk;fileinfo(filename +,nextfetchcluster,fetchrest).END PROC openfetchdosfile;BOOL PROC +waslastfetchcluster:IF logflagTHEN dump("was last fetch cluster","")FI ; +islastfatchainentry(nextfetchcluster)OR fetchrest<=0.0.END PROC +waslastfetchcluster;PROC catnextfetchdoscluster(TEXT VAR buffer):IF logflag +THEN dump("cat next fetch dos cluster","")FI ;enablestop;IF +waslastfetchclusterTHEN errorstop("fetch nach Dateiende")FI ;IF fetchrest< +real(clustersize)THEN catclustertext(nextfetchcluster,buffer,int(fetchrest)); +fetchrest:=0.0ELSE catclustertext(nextfetchcluster,buffer,clustersize); +fetchrestDECR real(clustersize)FI ;lastaccesstime:=clock(1);nextfetchcluster +:=fatentry(nextfetchcluster).END PROC catnextfetchdoscluster;PROC +readnextfetchdoscluster(DATASPACE VAR readds,INT VAR startpage):IF logflag +THEN dump("read next fetch dos cluster",startpage)FI ;enablestop;IF +waslastfetchclusterTHEN errorstop("fetch nach Dateiende")FI ;readdiskcluster( +readds,startpage,nextfetchcluster);lastaccesstime:=clock(1);startpageINCR +sectorspercluster;nextfetchcluster:=fatentry(nextfetchcluster);IF fetchrest< +real(clustersize)THEN fetchrest:=0.0ELSE fetchrestDECR real(clustersize)FI . +END PROC readnextfetchdoscluster;PROC closefetchdosfile:IF logflagTHEN dump( +"close fetch dos file","")FI ;END PROC closefetchdosfile;TEXT VAR savename; +REAL VAR firstsavecluster,lastsavecluster,savesize;PROC opensavedosfile(TEXT +CONST filename):IF logflagTHEN dump("open save dos file",filename)FI ; +enablestop;accessdosdisk;IF fileexists(filename)OR subdirexists(filename) +THEN errorstop("die Datei """+filename+""" gibt es schon")FI ;savename:= +filename;firstsavecluster:=-1.0;savesize:=0.0.END PROC opensavedosfile;PROC +writenextsavedoscluster(TEXT CONST buffer):IF logflagTHEN dump( +"write next save dos cluster","")FI ;enablestop;REAL CONST savecluster:= +availablefatentry;writetexttocluster(savecluster,buffer);lastaccesstime:= +clock(1);savesizeINCR real(LENGTH buffer);IF firstsavecluster<2.0THEN +firstsavecluster:=saveclusterELSE fatentry(lastsavecluster,savecluster)FI ; +fatentry(savecluster,lastfatchainentry);lastsavecluster:=savecluster.END +PROC writenextsavedoscluster;PROC writenextsavedoscluster(DATASPACE CONST +saveds,INT VAR startpage):IF logflagTHEN dump("write next save dos cluster", +startpage)FI ;enablestop;REAL CONST savecluster:=availablefatentry; +writediskcluster(saveds,startpage,savecluster);lastaccesstime:=clock(1); +startpageINCR sectorspercluster;savesizeINCR real(clustersize);IF +firstsavecluster<2.0THEN firstsavecluster:=saveclusterELSE fatentry( +lastsavecluster,savecluster)FI ;fatentry(savecluster,lastfatchainentry); +lastsavecluster:=savecluster.END PROC writenextsavedoscluster;PROC +closesavedosfile:IF logflagTHEN dump("close save dos file","")FI ;enablestop; +IF firstsavecluster<2.0THEN LEAVE closesavedosfileFI ;fatentry( +lastsavecluster,lastfatchainentry);writefat;insertdirentry(savename, +firstsavecluster,savesize);lastaccesstime:=clock(1).END PROC closesavedosfile +;PROC erasedosfile(TEXT CONST filename):IF logflagTHEN dump("erase dos file", +filename)FI ;enablestop;accessdosdisk;REAL VAR firstcluster,size;fileinfo( +filename,firstcluster,size);deletedirentry(filename);erasefatchain( +firstcluster);writefat;lastaccesstime:=clock(1).END PROC erasedosfile; +THESAURUS PROC alldosfiles:IF logflagTHEN dump("all dosfile","")FI ; +enablestop;accessdosdisk;allfiles.END PROC alldosfiles;THESAURUS PROC +alldossubdirs:IF logflagTHEN dump("all subdirs","")FI ;enablestop; +accessdosdisk;allsubdirs.END PROC alldossubdirs;BOOL PROC dosfileexists(TEXT +CONST filename):IF logflagTHEN dump("dos file exists",filename)FI ;enablestop +;accessdosdisk;fileexists(filename).END PROC dosfileexists;PROC doslist( +DATASPACE VAR listds):IF logflagTHEN dump("dos list","")FI ;enablestop; +accessdosdisk;dirlist(listds).END PROC doslist;PROC cleardosdisk:IF logflag +THEN dump("clear dos disk","")FI ;enablestop;IF hdversionTHEN errorstop( +"nicht implementiert")ELSE accessdosdisk;formatdir;formatfat;lastaccesstime:= +clock(1)FI .END PROC cleardosdisk;PROC formatdosdisk(INT CONST formatcode): +IF logflagTHEN dump("format dos disk ("+text(formatcode)+")","")FI ; +enablestop;IF NOT diskopenTHEN errorstop("DOS-Arbeit nicht eröffnet")FI ;IF +hdversionTHEN errorstop("nicht implementiert")ELSE doformatFI .doformat:IF +bpbexists(formatcode)THEN closework;formatarchive(formatcode);openeudisk; +writebpb(formatcode);opendosdisk;formatdir;formatfat;openworkELSE errorstop( +"Format unzulässig")FI ;lastaccesstime:=clock(1).END PROC formatdosdisk;END +PACKET dosgetput; + diff --git a/app/baisy/2.2.1-schulis/src/insert.dos b/app/baisy/2.2.1-schulis/src/insert.dos new file mode 100644 index 0000000..6788f3f --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/insert.dos @@ -0,0 +1,15 @@ +dump +konvert +open +eu disk descriptor +disk descriptor.dos +block i/o +name conversion.dos +fat.dos +dir.dos +get put interface.dos +fetch save interface +fetch +save + + diff --git a/app/baisy/2.2.1-schulis/src/isp archive.sc b/app/baisy/2.2.1-schulis/src/isp archive.sc new file mode 100644 index 0000000..f608a95 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp archive.sc @@ -0,0 +1,35 @@ + PACKETisparchive DEFINESarchivefiles,archivesize,savetoarchive,fetchfromarchive,initarchive,cleararchive,cleararchivetask,checkarchive,listarchive,formatarchive, +channelfree,logonarchive,logoffarchive,cleareacharchive,writefactor,readafterwrite,kf: LETuuuuuv=1,uuuuuw=2,uuuuux=34,uuuuuy=35,uuuuuz=25,uuuuvu=26,uuuuvv=36,uuuuvw +=37,uuuuvx=39,uuuuvy=40,uuuuvz=41,uuuuwu=42,uuuuwv=43,uuuuww=44,uuuuwx=45,uuuuwy=46,uuuuwz=47,uuuuxu=48,uuuuxv=200,uuuuxw="�",fehlertext="ARCHIVE-Fehler: "; LET ARCHIVECONTROL += STRUCT( INTuuuuxx, BOOLuuuuxy); BOUND ARCHIVECONTROL VARuuuuxz; INT VARuuuuyu,uuuuyv,uuuuyw,uuuuyx:=1; THESAURUS VARuuuuyy; TEXT VARuuuuyz:=""; BOOL VARuuuuzu:= + FALSE,uuuuzv:= FALSE,uuuuzw:= FALSE; BOUND STRUCT( INTuuuuzx, ROWuuuuxv TEXTuuuuzz) VARuuuvuu; DATASPACE VARuuuvuv; PROCkf( BOOL CONSTuuuvux):uuuuzw:=uuuvux ENDPROC +kf; PROCreadafterwrite( BOOL CONSTuuuuxy):uuuuzv:=uuuuxy ENDPROCreadafterwrite; BOOL PROCreadafterwrite:uuuuzv ENDPROCreadafterwrite; PROCwritefactor( INT CONSTuuuuxy +):uuuuyx:=uuuuxy ENDPROCwritefactor; INT PROCwritefactor:uuuuyx ENDPROCwritefactor; BOOL PROCcleareacharchive:uuuuzu ENDPROCcleareacharchive; PROCcleareacharchive +( BOOL CONSTuuuvyx):uuuuzu:=uuuvyx ENDPROCcleareacharchive; PROCcleararchivetask:logoffarchive;logonarchive ENDPROCcleararchivetask; THESAURUS PROCarchivefiles:uuuuyy + ENDPROCarchivefiles; INT PROCarchivesize:archivesize( SOMEmyself) ENDPROCarchivesize; INT PROCarchivesize( THESAURUS CONSTuuuwvu):uuuuyy:=uuuwvu;uuuuyu:=0;uuuuyv +:=1;uuuuyw:=0;get(uuuuyy,uuuuyz,uuuuyu); WHILEuuuuyu>0 REPuuuuyw INCRstorage(old(uuuuyz));uuuuyv INCR1;get(uuuuyy,uuuuyz,uuuuyu) PER;uuuuyw ENDPROCarchivesize; TASK + PROCuuuwyu:/"isp.archive" ENDPROCuuuwyu; BOUND TEXT VARuuuwyw; BOUND INT VARuuuwyx; DATASPACE VARuuuwyy; INT VARuuuwyz; TASK VARuuuwzu:=niltask; PROCformatarchive +( TEXT CONSTuuuwzw):formatarchive(0,uuuwzw) ENDPROCformatarchive; PROCformatarchive( INT CONSTuuuxuv, TEXT CONSTuuuwzw): IFpos("0123",text(uuuxuv))>0 THENuuuxuy(uuuuvy +,code(uuuxuv)+uuuwzw, TRUE) FI ENDPROCformatarchive; PROCsavetoarchive( THESAURUS CONSTuuuwvu): IFuuuuzu THENcleararchive; FI;do( PROC( TEXT CONST)uuuxwv,uuuwvu); + ENDPROCsavetoarchive; PROCfetchfromarchive:uuuxwz;uuuxxu;uuuxxv.uuuxwz:uuuxxx;call(uuuwyu,uuuuvz,uuuwyy,uuuwyz).uuuxxu: INT VARuuuxyx:=uuuuvz; WHILEuuuwyz<>uuuuvx + REPuuuxzv; IFuuuwyz=uuuuvw THENuuuxzy ELSEuuuxxx;call(uuuwyu,uuuxyx,uuuwyy,uuuwyz) FI PER.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop( +fehlertext+uuuwyw) CASEuuuuvw: IFcommanddialogue THENuuuyvz;uuuwyw:=uuuwyy;out(uuuwyw) FI CASEuuuuvv:uuuyvz; IFuuuywz THENerrorstop("Archivieren inkonsistent abgebrochen" +) FI;uuuxyx:=uuuuwu ENDSELECT.uuuxxv: INT VARuuuyxx;forget(uuuvuv);uuuvuv:=uuuwyy;uuuvuu:=uuuvuv; FORuuuyxx FROM1 UPTOuuuvuu.uuuuzx REP#out("<"+uuuvuu.uuuuzz[uuuyxx +]+">");uuuyvz;#uuuyzy PER;forget(uuuvuv).uuuyzy:uuuxxx;uuuwyx:=uuuwyy;uuuwyx:=uuuyxx;call(uuuwyu,uuuuwv,uuuwyy,uuuwyz);forget(uuuvuu.uuuuzz[uuuyxx],quiet);copy(uuuwyy +,uuuvuu.uuuuzz[uuuyxx]). ENDPROCfetchfromarchive; BOOL PROCuuuywz: REPuuuyvz; IFonline THENout(2*uuuuxw) FI; IFyes("Nachfolgende Archive-Diskette eingelegt") THEN + LEAVEuuuywz WITH FALSE FI UNTILuuuuzw COR( NOTuuuuzw CANDyes("Sicherung wirklich abbrechen")) PER; TRUE ENDPROCuuuywz; PROCuuuxwv( TEXT CONSTuuuzyw#, BOOL PROCuuuzyx +#):save(uuuzyw,uuuwyu); IFcommanddialogue THENuuuyvz;out(""""+uuuzyw+""" wird gesichert!");#uuuyvz# FI;uuuzzx;uuuzzy.uuuzzx:uuuxxx;uuuuxz:=uuuwyy;uuuuxz.uuuuxx:=uuuuyx +;uuuuxz.uuuuxy:=uuuuzv;call(uuuwyu,uuuuux,uuuwyy,uuuwyz);uuvuwv.uuvuwv: WHILEuuuwyz<>uuuuvv REPuuuxzv;uuuxzy PER.uuuzzy: REP IFuuuwyz=uuuuvv THENuuuyvz; IFuuuywz THEN +errorstop("Sichern eventuell inkonsistent abgebrochen!"); LEAVEuuuxwv ELSE IFuuuuzu THENcleararchive; FI;out(""""+uuuzyw+""" wird gesichert!"); FI ELSEuuuxzv FI;uuuxxx +; IF NOTuuvuzu THENcall(uuuwyu,uuuuuy,uuuwyy,uuuwyz) ELSEuuuxzy FI; PER.uuvuzu:uuuwyz=uuuuvw.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop +(fehlertext+uuuwyw) CASEuuuuvx: LEAVEuuuxwv CASEuuuuvw: IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz;out(uuuwyw); FI ENDSELECT. ENDPROCuuuxwv; PROCinitarchive( TEXT + CONSTuuvvxu):uuuxuy(uuuuwz,uuvvxu, TRUE) ENDPROCinitarchive; PROCcheckarchive:uuuxuy(uuuuxu) ENDPROCcheckarchive; PROCcleararchive:uuuxuy(uuuuuz) ENDPROCcleararchive +; PROClistarchive:uuuxuy(uuuuvu);forget("ISP-Archive",quiet);type(uuuwyy,1003);copy(uuuwyy,"ISP-Archive");show("ISP-Archive");forget("ISP-Archive",quiet) ENDPROClistarchive +; PROClogonarchive:uuuxuy(uuuuwx,"", FALSE) ENDPROClogonarchive; PROClogoffarchive:uuuxuy(uuuuwy,"", FALSE) ENDPROClogoffarchive; PROCuuuxuy( INT CONSTuuvwvy):uuuxuy +(uuvwvy,"", FALSE) ENDPROCuuuxuy; PROCuuuxuy( INT CONSTuuvwvy, TEXT CONSTuuvwwy, BOOL CONSTuuvwwz):uuvwxu; WHILEuuvwxv REPuuvwxw;uuuxzy PER.uuvwxv:uuuwyz<>uuuuvx. +uuvwxu:uuuxxx; IFuuvwwz THENuuuwyw:=uuuwyy;uuuwyw:=uuvwwy FI;call(uuuwyu,uuvwvy,uuuwyy,uuuwyz).uuvwxw: IFuuuwyz=uuuuvw THEN IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz +;out(uuuwyw) FI ELIFuuuwyz=uuuuuw THENuuuwyw:=uuuwyy;enablestop;errorstop(fehlertext+uuuwyw) FI. ENDPROCuuuxuy; PROCuuuxzy: REPforget(uuuwyy);wait(uuuwyy,uuuwyz,uuuwzu +); IF NOT(uuuwzu=uuuwyu) THEN#note("IN WARTE: "+text(uuuwyz)+"/"+name(uuuwzu));noteline;#uuvxxy FI UNTILuuuwzu=uuuwyu PER ENDPROCuuuxzy; PROCuuvxxy:send(uuuwzu,uuuuuv +,uuuwyy) ENDPROCuuvxxy; PROCchannelfree: DATASPACE VARuuvxzw:=nilspace;send(uuuwyu,uuuuww,uuvxzw);forget(uuvxzw) ENDPROCchannelfree; PROCuuuxxx:forget(uuuwyy);uuuwyy +:=nilspace ENDPROCuuuxxx; PROCuuuyvz: IFonline THENline; FI ENDPROCuuuyvz; ENDPACKETisparchive; + diff --git a/app/baisy/2.2.1-schulis/src/isp.auskunftseditor b/app/baisy/2.2.1-schulis/src/isp.auskunftseditor new file mode 100644 index 0000000..abf50d4 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.auskunftseditor @@ -0,0 +1,27 @@ +PACKET ispauskunftseditorDEFINES auskunftstextaendernvp, +auskunftstextaendernnp,auskunftstextspeichern:LET dateiname= +"Auskunftstext zur Auskunft ";LET editorfenster=77,eol="�",stop="�";TEXT VAR +datnam;PROC auskunftstextaendernvp:datnam:=dateiname+sicherungauskunftsname;# +FILE VAR dat:=sequentialfile(output,datnam);#store(FALSE );IF +sicherungauskunftstext<>""THEN auskunftindatei(datnam,sicherungauskunftstext) +FI ;wordwrap(TRUE );page;editiere(datnam,"s",FALSE ).END PROC +auskunftstextaendernvp;PROC auskunftstextaendernnp:store(FALSE ); +editierewieeingestelltEND PROC auskunftstextaendernnp;PROC +auskunftstextspeichern(PROC (INT CONST )spezerfassungauskuenfte,BOOL CONST +speichern):originalsituation;IF speichernTHEN TEXT VAR t;auskunftintext( +datnam,t);#putwert(fnrauskunftstext,t);#zwischenspeicherungdestextes(t);FI ; +forget(datnam,quiet);return(1);angegebenedatenpruefenundevtlspeichern( +speichern,PROC spezerfassungauskuenfte);END PROC auskunftstextspeichern;PROC +auskunftintext(TEXT CONST datnam,TEXT VAR auskunft):FILE VAR dat:= +sequentialfile(input,datnam);TEXT VAR zeile;IF eof(dat)THEN close(dat); +auskunft:=""ELSE auskunft:="";REP getline(dat,zeile);auskunft:=auskunft+ +encode(zeile);UNTIL eof(dat)PER ;FI END PROC auskunftintext;PROC +auskunftindatei(TEXT CONST datnam,TEXT CONST te):FILE VAR dat:=sequentialfile +(output,datnam);TEXT VAR zeile,auskunft:=te;INT VAR bottom:=1,top:=1;INT VAR +l:=length(auskunft);formatierezeile;REP schreibe;formatierezeile;UNTIL (top>= +l)CAND (zeile="")PER .formatierezeile:zeile:="";IF bottom>=lTHEN zeile:="" +ELSE top:=min(bottom+editorfenster-1,l);zeile:=subtext(auskunft,bottom,top, +eol,stop,FALSE );topINCR 1;bottom:=topFI .schreibe:putline(dat,zeile).END +PROC auskunftindatei;PROC originalsituation:reorganizescreen;store(TRUE )END +PROC originalsituation;END PACKET ispauskunftseditor; + diff --git a/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen b/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen new file mode 100644 index 0000000..0f002ba --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen @@ -0,0 +1,69 @@ +PACKET auskunftsfunktionenDEFINES erteileauskunft,ergaenzeauskunft, +auskunftszeilenende,auskunftstextende,editauskunft,quadrant:LET eol="�",stop= +"�",fuereditor=TRUE ,fuermaske=FALSE ;TEXT CONST standardtext:= +"Die gewünschte Auskunft ist leider noch nicht verfügbar!"+stop;TEXT CONST +auskunftszeilenende:=eol;TEXT CONST auskunftstextende:=stop;TEXT VAR +auskunftergaenzung:="";INT VAR auskunftergaenzungsnr:=0;PROC ergaenzeauskunft +(TEXT CONST durch,INT CONST fuer):auskunftergaenzung:=durch; +auskunftergaenzungsnr:=fuerEND PROC ergaenzeauskunft;TEXT PROC atext(INT +CONST nr):TEXT VAR grundauskunft;IF wert(fnrauskunftstext)=""THEN +grundauskunft:=standardtextELSE grundauskunft:=wert(fnrauskunftstext)FI ;IF ( +auskunftergaenzung<>"")CAND (nr=auskunftergaenzungsnr)THEN grundauskunftCAT +auskunftergaenzungFI ;grundauskunftEND PROC atext;TEXT PROC astichwort: +systemdbon;wert(fnrschlverz)END PROC astichwort;WINDOW PROC altesfenster:INT +VAR i,j,k,l;quadrant(i,j,k,l);startwindow(i,j,k,l)END PROC altesfenster;PROC +quadrant(INT VAR i,j,k,l):merkeposition;fenster.merkeposition:INT VAR x,y; +getcursorposfuerauskunft(x,y).fenster:INT VAR x1,y1,x2,y2;IF vierterquadrant +THEN x1:=1;y1:=12;x2:=39;y2:=1ELIF dritterquadrantTHEN x1:=40;y1:=12;x2:=77; +y2:=1ELIF zweiterquadrantTHEN x1:=1;y1:=24;x2:=39;y2:=13ELIF ersterquadrant +THEN x1:=40;y1:=24;x2:=77;y2:=13FI ;i:=x1;j:=y1;k:=x2;l:=y2.ersterquadrant:(x +<40)CAND (y<13).zweiterquadrant:(x>39)CAND (y<13).dritterquadrant:(x<40)CAND +(y>12).vierterquadrant:(x>39)CAND (y>12).END PROC quadrant;PROC holeauskunft( +INT CONST name):putintwert(fnrauskunftsname,name);search(dnrausk,TRUE );END +PROC holeauskunft;PROC erteileauskunft(INT CONST nr):WINDOW VAR w:= +altesfenster;TEXT VAR auskunft:="";TEXT CONST st:=" = ";INT CONST suchname:= +nr;INT VAR anzahl:=5;systemdbon;erteileauskunftbody;systemdboff; +wiederaufsetzen.erteileauskunftbody:IF menuedraussenTHEN reorganizescreenFI ; +open(w);auskunftholen;zeige.auskunftholen:holeauskunft(suchname);.zeige:IF +dbstatus=okTHEN auskunft:=atext(suchname)ELSE auskunft:=standardtext;putwert( +fnrschlverz,"")FI ;stwpruefen;auskunfterteilung(auskunft,w,fuermaske);. +stwpruefen:IF astichwort<>""THEN textschonmalzeigen(auskunft,w,fuermaske);IF +pos(astichwort,"c")=1THEN schluesselverzeichnisausschluesseldateiELSE +schluesselverzeichnisnichtausschluesseldateiFI FI ;schlussstern. +schluesselverzeichnisausschluesseldatei:#INT VAR i:=1;##02.02.88dr#TEXT VAR +bestname:=astichwort;systemdboff;bestandsuchen;IF bestandvorhandenTHEN +auskunftCAT stop;ankoppelnderabkuerzung;naechstelesen;WHILE erfolgreichREP +anhaengen;naechstelesenPER ELSE meldunganhaengen(auskunft,"Bestand "+bestname ++" ist nicht vorhanden")FI .bestandsuchen:inittupel(dnrschluessel);putwert( +fnrschlsachgebiet,bestname);search(dnrschluessel,FALSE );.bestandvorhanden: +dbstatus=okCAND wert(fnrschlsachgebiet)=bestname.naechstelesen:anzahl:=18; +multisucc(dnrschluessel,anzahl);#iINCR 1##02.02.88dr#.erfolgreich:anzahl>0 +CAND wert(fnrschlsachgebiet)=bestname.anhaengen:WHILE anzahl>0REP multisucc; +IF erfolgreichTHEN ankoppelnderabkuerzung;FI ;anzahlDECR 1UNTIL NOT +erfolgreichPER .ankoppelnderabkuerzung:auskunftCAT wert(fnrschlschluessel); +auskunftCAT st;auskunftCAT wert(fnrschllangtext);auskunftCAT stop;. +schluesselverzeichnisnichtausschluesseldatei:TEXT VAR dateiname:=astichwort; +INT VAR dnr:=0;systemdboff;stopbeifalschemnamen(FALSE );dnr:=dateinr( +dateiname);IF dnr>0THEN first(dnr);IF dbstatus=okTHEN auskunftCAT stop; +anwendungsdatenkoppeln;dienaechstenanwendungsdatenlesenELSE meldunganhaengen( +auskunft,"Keine Daten zu "+dateiname+" vorhanden")FI ELSE meldunganhaengen( +auskunft,"Bestand "+dateiname+" ist nicht vorhanden")FI ;stopbeifalschemnamen +(TRUE ).dienaechstenanwendungsdatenlesen:INT VAR a:=0;anzahl:=18;multisucc( +dnr,anzahl);REP IF anzahl>0THEN WHILE a=newtreeTHEN baumbearbeitungELSE andererdienstFI . +baumbearbeitung:IF auftragsnr=newtreeTHEN schicktabelleELSE bearbeitetabelle +FI .bearbeitetabelle:TEXT VAR dateiname:=headline(sequentialfile(input,ds)); +forget(dateiname,quiet);copy(ds,dateiname);forget(ds);SELECT auftragsnrOF +CASE refinementlist:listeallerrefinementsCASE translate,reorg: +bearbeitendesbaumesCASE retranslate:ausdembaumCASE eraserefinement: +refinementloeschenOTHERWISE falscherauftragEND SELECT ;forget(dateiname,quiet +).schicktabelle:p:=ds;TEXT VAR startknotenname:=p.textkey1;forget(ds); +gibbaumtabelle(startknotenname,ds).listeallerrefinements:listederteilbaeume( +dateiname);ds:=old(dateiname).ausdembaum:BOOL VAR ok;teilbaeumeaussystembaum( +dateiname,ok);IF NOT okTHEN status:=nackFI ;ds:=old(dateiname). +refinementloeschen:loescheteilbaeume(dateiname,ok);IF NOT okTHEN status:=nack +FI ;ds:=old(dateiname).bearbeitendesbaumes:INT CONST dl:=length(dateiname); +disablestop;continue(int(subtext(dateiname,dl-1,dl)));IF auftragsnr=reorg +THEN reorganisierenELSE BOOL VAR falsch;uebersetze(dateiname,falsch)FI ; +startesystembaum;break(quiet);clearerror;enablestop;IF falschTHEN status:= +nack;ds:=old(fehldat);forget(fehldat,quiet)ELSE ds:=old(dateiname)FI . +falscherauftrag:errorstop("Ungültiger Auftrag an "+name(myself)). +andererdienst:p:=ds;SELECT auftragsnrOF CASE pruefen:maskepruefenCASE init: +maskeinitialisierenCASE loeschen:maskeloeschenCASE speichern:maskespeichern +CASE umbenennen:maskeumbenennenCASE kopieren:maskekopierenCASE liste: +maskenlisteCASE sendall:savefast(auftraggeber)CASE aktionsavebase:#savebase# +senddb(auftraggeber)CASE aktionloadbase:#fetchbase#boundthesau:=ds;thesau:= +boundthesau;restoredb(auftraggeber,thesau);startesystembaum; +startemaskenverarbeitungOTHERWISE systemaufrufEND SELECT .maskepruefen:IF +NOT tagexists(p.textkey1)THEN status:=endeFI .maskeinitialisieren:p.maske +INITBY p.textkey1.maskeloeschen:forgettag(p.textkey1).maskespeichern:storetag +(p.maske,p.textkey1).maskekopieren:copytag(p.textkey1,p.textkey2);. +maskeumbenennen:renametag(p.textkey1,p.textkey2).maskenliste:TEXT VAR +listdatei:=p.textkey1;listedermasken(listdatei);forget(ds);ds:=old(listdatei) +;forget(listdatei,quiet).meldezurueck:send(auftraggeber,status,ds). +systemaufruf:IF auftragsnr>=100THEN forget(ds);LEAVE baisyserverELSE +freemanager(ds,auftragsnr,dummy,auftraggeber)FI .#savebase:sbase(auftraggeber +).fetchbase:fbase(auftraggeber,katalog);boot.katalog:BOUND THESAURUS VAR kat +:=ds;kat.#END PROC baisyserver;PROC boot:startesystembaum; +startemaskenverarbeitungEND PROC boot;PROC sbase(TASK CONST auftraggeber): +meldezurueck;saveall(auftraggeber).meldezurueck:DATASPACE VAR ds:=nilspace; +send(auftraggeber,0,ds).END PROC sbase;PROC fbase(TASK CONST auftraggeber, +THESAURUS VAR katalog):meldezurueck;interessierendeeintraege(katalog);fetch( +katalog,auftraggeber).meldezurueck:DATASPACE VAR ds:=nilspace;send( +auftraggeber,0,ds).END PROC fbase;PROC interessierendeeintraege(THESAURUS +VAR t):LET datenraumpraefix="BAISY-";beginneliste;naechster;WHILE +nochwelchedaREP pruefen;naechsterPER .beginneliste:TEXT VAR name;INT VAR +index:=0.naechster:get(t,name,index).nochwelcheda:index>0.pruefen:IF pos(name +,datenraumpraefix)<>1THEN delete(t,index)FI .END PROC +interessierendeeintraege;ROW maxthesaurusentryDATASPACE VAR receiveddb;PROC +senddb(TASK CONST ordertask):THESAURUS VAR dbthesaurus:=ALL myself;DATASPACE +VAR ds;INT VAR tindex;forget(ds);ds:=nilspace;interessierendeeintraege( +dbthesaurus);sendthesaurus;sendfilesinthesaurus.sendthesaurus:BOUND +THESAURUS VAR thesau:=ds;thesau:=dbthesaurus;send(ordertask,savedbcode,ds);. +sendfilesinthesaurus:TEXT VAR fname;tindex:=0;get(dbthesaurus,fname,tindex); +WHILE tindex>0REP sendfile;get(dbthesaurus,fname,tindex)PER ;sendend.sendfile +:pause(10);forget(ds);ds:=old(fname);send(ordertask,savedbcode,ds);.sendend: +pause(10);ds:=nilspace;send(ordertask,endcode,ds).ENDPROC senddb;PROC +restoredb(TASK CONST ordertask,THESAURUS CONST dbthesaurus):INT VAR replycode +;#THESAURUS VAR olddb:=ALL myself;#DATASPACE VAR ds;TASK VAR sourcetask:= +niltask;INT VAR tindex;TEXT VAR fname:="";#deleteallfiles;#sendack;rcvdb; +builddb.#deleteallfiles:TEXT VAR fname;INT VAR tindex;tindex:=0;get(olddb, +fname,tindex);WHILE tindex>0REP forget(fname,quiet);get(olddb,fname,tindex) +PER .#sendack:forget(ds);ds:=nilspace;send(ordertask,restoredbcode,ds).rcvdb: +INT VAR l:=1;REP forget(receiveddb[l]);wait(receiveddb[l],replycode, +sourcetask);IF NOT (sourcetask=ordertask)THEN forget(receiveddb[l]);sendnack +ELSE IF replycode=restoredbcodeTHEN lINCR 1ELSE forget(receiveddb[l])FI FI +UNTIL replycode=endcodePER .builddb:tindex:=0;l:=1;get(dbthesaurus,fname, +tindex);WHILE tindex>0REP forget(fname,quiet);copy(receiveddb[l],fname); +forget(receiveddb[l]);lINCR 1;get(dbthesaurus,fname,tindex)PER .sendnack: +forget(ds);ds:=nilspace;send(sourcetask,nak,ds).ENDPROC restoredb;ENDPACKET +ispbaisyserver; + diff --git a/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen b/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen new file mode 100644 index 0000000..ba9f102 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen @@ -0,0 +1,87 @@ +PACKET ispbenutzerberechtigungenDEFINES erstellebenutzungsberechtigung, +identistart,aktuellebenutzerkenndatenlesen,pruefeberechtigung, +setzeanfangsknotennamefuerbenutzerbestand,benutzerbestand:LET standardanfang= +2,maskenname="mu identifikation",#benbest="cb benutzer",23.07.87#wer=47, +falsch=39,#benmeth=2,#punkt=".";BOOL VAR pruefungnoetig,gefunden,berechtigt; +INT VAR anzahlversuche;LET maxversuche=3;;TAG VAR aktuellemaske;INT VAR +aktuelleposition;TEXT VAR benutzername,geheimwort,benutzerberechtigung, +startknotenname:="schulis";PROC hinweisauflizenzfreiesoftwaregeben:TEXT VAR +testname;holeberechtigungswert(testname);IF testname=""THEN +kopierhinweiszeigenFI .kopierhinweiszeigen:page;cursor(23,3);put( +"schulis - Schulverwaltungssystem");cursor(27,8);put( +"Lizenzfreie Software der");cursor(13,10);put( +"Gesellschaft für Mathematik und Datenverarbeitung mbH");cursor(8,14);put( +"Die Nutzung der Software ist nur im Schul- und Hochschulbereich ");cursor(20 +,15);put("für nichtkommerzielle Zwecke gestattet.");cursor(16,17);put( +"Gewährleistung und Haftung werden ausgeschlossen.");cursor(26,23);put( +"Weiter mit beliebiger Taste");pause(100).END PROC +hinweisauflizenzfreiesoftwaregeben;PROC identistart: +frageentwicklernachseinemnamen;aktuellebenutzerkenndatenlesen;. +frageentwicklernachseinemnamen:hinweisauflizenzfreiesoftwaregeben;page; +benutzername:="";geheimwort:="";gefunden:=FALSE ;pruefungnoetig:=TRUE ; +anzahlversuche:=0;standardkopfmaskeinitialisieren(startknotenname); +standardkopfmaskeausgeben(text(vergleichsknoten));initmaske(aktuellemaske, +maskenname);show(aktuellemaske);aktuelleposition:=standardanfang;.END PROC +identistart;PROC aktuellebenutzerkenndatenlesen:ROW 100TEXT VAR feld; +berechtigt:=FALSE ;init(feld);feld(2):=benutzername;feld(3):=geheimwort; +putget(aktuellemaske,feld,aktuelleposition);benutzername:=feld(2);geheimwort +:=feld(3);END PROC aktuellebenutzerkenndatenlesen;PROC berechtigungholen: +systemdbon;IF gefundenTHEN gefunden:=((startknotennameSUB 1)=wert( +fnrbenutzbestand)CAND benutzername=wert(fnrbenutzname))FI ; +benutzerberechtigung:="";IF NOT gefundenTHEN putwert(fnrbenutzname, +benutzername);putwert(fnrbenutzbestand,(startknotennameSUB 1));search( +dnrbenutz,TRUE );gefunden:=(dbstatus=ok);FI ;IF gefundenTHEN IF (geheimwort= +wert(fnrbenutzgeheimwort))THEN benutzerberechtigung:=wert(fnrbenutzberecht); +berechtigt:=TRUE ELSE berechtigt:=FALSE ;aktuelleposition:=standardanfang+1 +FI ELSE aktuelleposition:=standardanfangFI ;systemdboff;END PROC +berechtigungholen;PROC pruefeberechtigung:IF pruefungnoetigTHEN +berechtigungholen;IF NOT (gefundenAND berechtigt)THEN IF anzahlversuche< +maxversucheTHEN anzahlversucheINCR 1ELSE anzahlversuche:=0; +logbucheintraganmeldversuchFI ;meldedies;return(1)ELSE +logbucheintraganmeldung;setzebenutzerberechtigung(benutzerberechtigung); +pruefungnoetig:=FALSE ;pageFI ELSE pageFI ;.meldedies:IF NOT gefundenTHEN +meldeauffaellig(aktuellemaske,wer)ELSE meldeauffaellig(aktuellemaske,falsch) +FI .END PROC pruefeberechtigung;PROC logbucheintraganmeldung:LET +loggrenzeerreicht=9,keinreplyvonlog=2,meldungloggrenzeerreicht=93;INT VAR +logreply:=0;TEXT VAR eintrag:="Identifikation ";eintragCAT """";eintragCAT +name(myself);eintragCAT """ durch """;eintragCAT benutzername;eintragCAT """" +;logeintrag(eintrag,logreply);IF logreply=loggrenzeerreichtTHEN +meldeauffaellig(aktuellemaske,meldungloggrenzeerreicht);pause(20)ELIF +logreply=keinreplyvonlogTHEN errorstop( +"Zur Benutzung des schulis-Systems bitte erst LOG-Task einrichten")FI END +PROC logbucheintraganmeldung;PROC logbucheintraganmeldversuch:TEXT VAR +eintrag:="mehrfach Identifikation durch """;eintragCAT benutzername;eintrag +CAT """ versucht";logeintrag(eintrag)END PROC logbucheintraganmeldversuch; +PROC setzeanfangsknotennamefuerbenutzerbestand(TEXT CONST knotenname): +startknotenname:=knotenname.END PROC +setzeanfangsknotennamefuerbenutzerbestand;TEXT PROC benutzerbestand: +startknotennameEND PROC benutzerbestand;PROC erstellebenutzungsberechtigung( +INT CONST felder,INT VAR fehlerin,TEXT VAR einausgabe):pruefeaufkorrektheit; +pruefeaufpraefixeigenschaft;gebeergebnisaus.pruefeaufkorrektheit:INT VAR i,j, +bottom;LET maxstring=100;ROW maxstringTEXT VAR strings;TEXT VAR string:=""; +FOR iFROM 1UPTO felderREP bottom:=(i-1)*11;string:=subtext(einausgabe,bottom+ +1,bottom+11);pruefeauffeldkorrektheit;IF korrektTHEN strings(i):= +bereinigterstringELSE fehlerin:=i;LEAVE erstellebenutzungsberechtigungFI PER +.pruefeauffeldkorrektheit:BOOL VAR korrekt:=TRUE ;TEXT VAR bereinigterstring +:="";TEXT VAR cstr:=compress(string);IF cstr=""THEN bereinigterstring:="" +ELSE korrekt:=istmenuebaumkennung(cstr,bereinigterstring)FI . +pruefeaufpraefixeigenschaft:FOR iFROM 1UPTO felderREP FOR jFROM 1UPTO felder +REP IF i<>jTHEN IF istpraefix(strings(i),strings(j))THEN strings(j):=""FI FI +PER PER .gebeergebnisaus:TEXT VAR s,t:="";FOR iFROM 1UPTO felderREP s:= +strings(i);IF s<>""THEN tCAT "/";tCAT sFI PER ;einausgabe:=t.END PROC +erstellebenutzungsberechtigung;BOOL PROC istmenuebaumkennung(TEXT CONST st, +TEXT VAR bereinigterstring):INT VAR anfang:=1;INT VAR ende:=pos(st,punkt); +INT VAR l:=length(st);IF ende=lTHEN istzahl(subtext(st,anfang,l-1), +bereinigterstring)ELIF NOT (ende>0)THEN istzahl(subtext(st,anfang,l), +bereinigterstring)ELIF istzahl(subtext(st,anfang,ende-1),bereinigterstring) +THEN bereinigterstringCAT punkt;istmenuebaumkennung(subtext(st,ende+1,l), +bereinigterstring)ELSE FALSE FI END PROC istmenuebaumkennung;BOOL PROC +istzahl(TEXT CONST t,TEXT VAR bereinigterstring):IF ((t<>"")CAND ((t<>"+") +CAND (t<>"-")))CAND (length(t)<=2)THEN INT VAR i:=int(t);IF lastconversionok +THEN bereinigterstringCAT text(i);TRUE ELSE FALSE FI ELSE FALSE FI END PROC +istzahl;BOOL PROC istpraefix(TEXT CONST s,t):IF (s="")OR (t="")THEN FALSE +ELSE pos(aufber(t),aufber(s))=1FI END PROC istpraefix;TEXT PROC aufber(TEXT +CONST t):INT CONST l:=length(t);IF (tSUB l)<>punktTHEN t+punktELSE tFI END +PROC aufber;PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR iFROM 1UPTO 100REP +feld(i):=""PER END PROC initEND PACKET ispbenutzerberechtigungen + diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen b/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen new file mode 100644 index 0000000..2283aa1 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen @@ -0,0 +1,67 @@ +PACKET isperfabkuerzungenDEFINES starterfassungallgemabkuerzungen, +erfassungallgemabkuerzungen,pruefungabkuerzungen:LET standardmaskenname= +"mu erf abkuerzungen",bestandallerbestaende="c02 bestand aller bestaende", +fnrletztesfeld=4,fnrschluessel=2,fnrlangtext=4,trenner=" = ";TEXT VAR +bestandname:="",aktmaskenname:="";TEXT VAR schluesselsicherung:="";INT VAR +maxschluessellaenge:=0,statistiknummer:=0;BOOL VAR gesamtbestand:=FALSE , +erstesmalgelesen:=TRUE ;PROC starterfassungallgemabkuerzungen(TEXT CONST +bestand):starterfassungallgemabkuerzungen(bestand,standardmaskenname)ENDPROC +starterfassungallgemabkuerzungen;PROC starterfassungallgemabkuerzungen(TEXT +CONST bestand,maskenname):reinitparsing;bestandname:=bestand;gesamtbestand:= +bestandname=bestandallerbestaende;aktmaskenname:=maskenname; +holeschluessellaengediesesbestands; +erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen(PROC (INT +CONST )erfassungallgemabkuerzungen).holeschluessellaengediesesbestands: +systemdboff;inittupel(dnrschluessel);putwert(fnrschlsachgebiet, +bestandallerbestaende);putwert(fnrschlschluessel,bestandname);search( +dnrschluessel,TRUE );IF lesenfehlerfreiTHEN maxschluessellaenge:=int(wert( +fnrschllangtext));ELSE maxschluessellaenge:=0;FI ;putwert(fnrschlsachgebiet, +bestandname);.lesenfehlerfrei:dbstatus=0.ENDPROC +starterfassungallgemabkuerzungen;PROC erfassungallgemabkuerzungen(INT CONST +proznr):systemdboff;SELECT proznrOF CASE 1:setzeerfassungsparameterCASE 2: +zeigeschluesselzurbearbeitungCASE 3:pruefeplausibilitaetCASE 4: +setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6: +abkuerzunglesenCASE 7:abkuerzungaendernCASE 8:abkuerzungeinfuegenCASE 9: +abkuerzungloeschenENDSELECT ENDPROC erfassungallgemabkuerzungen;PROC +setzeerfassungsparameter:erstesmalgelesen:=TRUE ;setzeerfassungsparameter( +dnrschluessel,maxschluessellaenge,aktmaskenname,fnrletztesfeld)END PROC +setzeerfassungsparameter;PROC zeigeschluesselzurbearbeitung: +setzeerfassungsfeld(wert(fnrschlschluessel),fnrschluessel); +setzeerfassungsfeld(wert(fnrschllangtext),fnrlangtext)END PROC +zeigeschluesselzurbearbeitung;PROC pruefeplausibilitaet:INT VAR fehlerstatus +:=0;setzefehlerstatus(fehlerstatus)ENDPROC pruefeplausibilitaet;PROC +setzewertefuerdbspeicherung:putwert(fnrschlsachgebiet,bestandname);putwert( +fnrschlschluessel,compress(erfassungswert(fnrschluessel)));putwert( +fnrschllangtext,erfassungswert(fnrlangtext))ENDPROC +setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET +trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert( +fnrschlschluessel)+trenner+wert(fnrschllangtext);identizeile:=subtext( +identizeile,1,maxidentizeilenlaenge);setzeidentiwert( +identizeilemitschluesselanhang).identizeilemitschluesselanhang:identizeile+ +trennsymbolfuerobli+wert(fnrschlschluessel).ENDPROC +setzeidentiobjektfuerobjektliste;PROC abkuerzunglesen:putwert( +fnrschlsachgebiet,bestandname);putwert(fnrschlschluessel,compress( +erfassungswert(fnrschluessel)));search(dnrschluessel,TRUE );IF dbstatus=ok +THEN saveupdateposition(dnrschluessel);IF erstesmalgelesenTHEN +schluesselsicherung:=wert(fnrschlschluessel);erstesmalgelesen:=FALSE ;FI FI +ENDPROC abkuerzunglesen;PROC abkuerzungaendern:restoreupdateposition( +dnrschluessel);update(dnrschluessel);#IF dbstatus=okCAND statistikbestand +CAND kuerzelgeaendertTHEN kuerzelnameinstatraumaendern(statistiknummer, +schluesselsicherung,schluessel)FI ;dr11.05.88#erstesmalgelesen:=dbstatus=ok.# +kuerzelgeaendert:schluesselsicherung<>schluessel.dr11.05.88#ENDPROC +abkuerzungaendern;PROC abkuerzungeinfuegen:insert(dnrschluessel);#IF dbstatus +=okCAND statistikbestandTHEN kuerzelnameinstatraumeinfuegen(statistiknummer, +wert(fnrschlschluessel))FI ;dr11.05.88#erstesmalgelesen:=dbstatus=okENDPROC +abkuerzungeinfuegen;PROC abkuerzungloeschen:delete(dnrschluessel);#IF +dbstatus=okCAND statistikbestandTHEN kuerzelnameausstatraumentfernen( +statistiknummer,wert(fnrschlschluessel))FI ;dr11.05.88#erstesmalgelesen:= +dbstatus=okEND PROC abkuerzungloeschen;TEXT PROC schluessel:erfassungswert( +fnrschluessel)END PROC schluessel;BOOL PROC pruefungabkuerzungen:wert( +fnrschlsachgebiet)=bestandnameEND PROC pruefungabkuerzungen;#dr11.05.88BOOL +PROC statistikbestand:LET anzstatistiken=8;ROW anzstatistikenTEXT CONST +statistikname:=ROW anzstatistikenTEXT :("","c02 schulart","c02 zugang", +"c02 versetzung","c02 relizugehoerigkeit","","c02 abgang","c02 abschluss"); +FOR statistiknummerFROM 1UPTO anzstatistikenREP IF statistikname[ +statistiknummer]=bestandnameTHEN LEAVE statistikbestandWITH TRUE FI PER ; +FALSE END PROC statistikbestand;#END PACKET isperfabkuerzungen; + diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen b/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen new file mode 100644 index 0000000..cab166c --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen @@ -0,0 +1,54 @@ +PACKET erfbenutzerberechtigungenDEFINES erfassungbenutzerberechtigungen:LET +maskenname="mu erf benutzerdaten",fnrschluessel=2,maxschluessellaenge=0, +fnrgeheimwort=3,fnrberechtigunganfang=4,fnrberechtigungende=43, +meldungkeineberechtigung=75,trenner=" = ";TEXT VAR felderinstring:="",bestand +:="s";INT VAR dateinummer:=0;#25.03.87#PROC erfassungbenutzerberechtigungen( +INT CONST proznr):systemdbon;SELECT proznrOF CASE 1:setzeerfassungsparameter +CASE 2:zeigeschluesselfuerbearbeitungCASE 3:pruefeplausibilitaetCASE 4: +setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6: +benutzerlesenCASE 7:benutzeraendernCASE 8:benutzereinfuegenCASE 9: +benutzerloeschenENDSELECT ;#systemdboff;##26.03.87#END PROC +erfassungbenutzerberechtigungen;PROC setzeerfassungsparameter:dateinummer:= +dnrbenutz;bestand:=benutzerbestandSUB 1;setzeerfassungsparameter(dateinummer, +maxschluessellaenge,maskenname,fnrberechtigungende)END PROC +setzeerfassungsparameter;PROC zeigeschluesselfuerbearbeitung: +setzeerfassungsfeld(wert(fnrbenutzgeheimwort),fnrgeheimwort); +berechtigungeninfeldersetzen(wert(fnrbenutzberecht),fnrberechtigunganfang) +END PROC zeigeschluesselfuerbearbeitung;PROC berechtigungeninfeldersetzen( +TEXT CONST berechtstring,INT CONST i):TEXT VAR t:=subtext(berechtstring,2); +INT VAR p:=pos(t,"/");INT VAR l:=length(t);INT VAR j;IF p>0THEN +setzeerfassungsfeld(subtext(t,1,p-1),i);berechtigungeninfeldersetzen(subtext( +t,p),i+1)ELSE setzeerfassungsfeld(subtext(t,1,l),i);FOR jFROM i+1UPTO +fnrberechtigungendeREP setzeerfassungsfeld("",j)PER FI END PROC +berechtigungeninfeldersetzen;PROC pruefeplausibilitaet:INT VAR fehlerstatus:= +0;concatenation(felderinstring);erstellebenutzungsberechtigung(anzahl, +fehlerstatus,felderinstring);IF fehlerstatus<>0THEN melde(erfassungsmaske, +meldungkeineberechtigung);setzefehlerstatus(fnrberechtigunganfang+ +fehlerstatus-1);LEAVE pruefeplausibilitaetFI .anzahl:fnrberechtigungende- +fnrberechtigunganfang+1.END PROC pruefeplausibilitaet;PROC concatenation( +TEXT VAR t):INT VAR i;INT VAR l:=length(erfassungsmaske,fnrberechtigunganfang +);t:="";FOR iFROM fnrberechtigunganfangUPTO fnrberechtigungendeREP IF +erfassungswert(i)<>""THEN tCAT text(erfassungswert(i),l)FI PER END PROC +concatenation;PROC setzewertefuerdbspeicherung:putwert(fnrbenutzbestand, +bestand);putwert(fnrbenutzname,erfassungswert(fnrschluessel));putwert( +fnrbenutzgeheimwort,erfassungswert(fnrgeheimwort));putwert(fnrbenutzberecht, +felderinstring)END PROC setzewertefuerdbspeicherung;PROC +setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR +identizeile;identizeile:=wert(fnrbenutzname)+trenner+wert(fnrbenutzberecht); +identizeile:=subtext(identizeile,1,maxidentizeilenlaenge);setzeidentiwert( +identizeilemitschluesselanhang).identizeilemitschluesselanhang:identizeile+ +trennsymbolfuerobli+wert(fnrbenutzname).END PROC +setzeidentiobjektfuerobjektliste;PROC benutzerlesen:inittupel(dnrbenutz); +putwert(fnrbenutzbestand,bestand);putwert(fnrbenutzname,erfassungswert( +fnrschluessel));search(dnrbenutz,TRUE );IF dbstatus=okTHEN saveupdateposition +(dnrbenutz)FI END PROC benutzerlesen;PROC benutzeraendern: +restoreupdateposition(dnrbenutz);update(dnrbenutz);logbucheintrag("Änderung") +END PROC benutzeraendern;PROC benutzereinfuegen:insert(dnrbenutz); +logbucheintrag("Neueinfügen")END PROC benutzereinfuegen;PROC benutzerloeschen +:delete(dnrbenutz);logbucheintrag("Entfernen")END PROC benutzerloeschen;PROC +logbucheintrag(TEXT CONST logergaenzung):TEXT VAR eintrag:="Anw. 10.5.1 "; +eintragCAT logergaenzung;eintragCAT " """;eintragCAT schluessel;eintragCAT +"""";logeintrag(eintrag)END PROC logbucheintrag;TEXT PROC schluessel: +erfassungswert(fnrschluessel)END PROC schluessel;END PACKET +erfbenutzerberechtigungen + diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.meldungen b/app/baisy/2.2.1-schulis/src/isp.erf.meldungen new file mode 100644 index 0000000..b431202 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.erf.meldungen @@ -0,0 +1,40 @@ +PACKET isperfmeldungenDEFINES erfassungmeldungen:LET maskenname= +"mu erf abkuerzungen",maxschluessellaenge=4,fnrschluessel=2,fnrletztesfeld=4, +fnrlangtext=4,trenner=" = ",leer="";INT VAR dateinummer:=0;PROC +erfassungmeldungen(INT CONST proznr):systemdbon;SELECT proznrOF CASE 1: +setzeerfassungsparameterCASE 2:zeigeschluesselzurbearbeitungCASE 3: +pruefeplausibilitaetCASE 4:setzewertefuerdbspeicherungCASE 5: +setzeidentiobjektfuerobjektlisteCASE 6:meldunglesenCASE 7:meldungaendernCASE +8:meldungeinfuegenCASE 9:meldungloeschenENDSELECT ;END PROC +erfassungmeldungen;PROC setzeerfassungsparameter:dateinummer:=dnrmeld; +setzeerfassungsparameter(dateinummer,maxschluessellaenge,maskenname, +fnrletztesfeld)END PROC setzeerfassungsparameter;PROC +zeigeschluesselzurbearbeitung:setzeerfassungsfeld(wert(fnrmeldungstext), +fnrlangtext)END PROC zeigeschluesselzurbearbeitung;PROC pruefeplausibilitaet: +INT VAR fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST ) +erfassungswert,fnrschluessel,1,9999,leer,fehlerstatus);IF fehlerstatus<>0 +THEN setzefehlerstatus(fehlerstatus);FI END PROC pruefeplausibilitaet;PROC +setzewertefuerdbspeicherung:putintwert(fnrmeldungsname,int(erfassungswert( +fnrschluessel)));search(dnrmeld,TRUE );putwert(fnrmeldungstext,erfassungswert +(fnrlangtext))END PROC setzewertefuerdbspeicherung;PROC +setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR +identizeile;identizeile:=text(intwert(fnrmeldungsname))+trenner+wert( +fnrmeldungstext);identizeile:=subtext(identizeile,1,maxidentizeilenlaenge); +setzeidentiwert(identizeilemitschluesselanhang). +identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+text(intwert( +fnrmeldungsname)).END PROC setzeidentiobjektfuerobjektliste;PROC meldunglesen +:INT VAR fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST ) +erfassungswert,fnrschluessel,1,9999,leer,fehlerstatus);IF fehlerstatus=0THEN +inittupel(dnrmeld);putintwert(fnrmeldungsname,int(schluessel));search(dnrmeld +,TRUE );IF dbstatus=okTHEN saveupdateposition(dnrmeld)FI ELSE dbstatus( +notfound)FI END PROC meldunglesen;PROC meldungaendern:restoreupdateposition( +dnrmeld);update(dnrmeld);logbucheintrag("geändert")END PROC meldungaendern; +PROC meldungeinfuegen:insert(dnrmeld);logbucheintrag("eingefügt")END PROC +meldungeinfuegen;PROC meldungloeschen:putintwert(fnrmeldungsname,int( +schluessel));search(dnrmeld,TRUE );IF dbstatus=okTHEN delete(dnrmeld); +logbucheintrag("gelöscht")FI END PROC meldungloeschen;PROC logbucheintrag( +TEXT CONST logergaenzung):TEXT VAR eintrag:="Meldung ";eintragCAT schluessel; +eintragCAT " ";eintragCAT logergaenzung;logeintrag(eintrag)END PROC +logbucheintrag;TEXT PROC schluessel:erfassungswert(fnrschluessel)END PROC +schluessel;END PACKET isperfmeldungen + diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen b/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen new file mode 100644 index 0000000..87654f0 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen @@ -0,0 +1,258 @@ +PACKET isperfsteueroperationenDEFINES +erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen, +vonerfassungsbildschirmeinlesen,maskezeigenundallefeldereinlesen, +allesvonerfassungsbildschirmeinlesen,schluesselbearbeiten, +bearbeitetenschluesseleinlesen,angegebenedatenpruefenundevtlspeichern, +schluesselloeschvorbereitung,schluesselloeschfrage,schluesselloeschen, +neuenschluesseleinfuegen,schluesselzeigen,datensatzzeigen, +ausgesuchtezurbearbeitung,ausgesuchtezumloeschen,zurueckzureinzelbearbeitung, +erfassungswert,setzeerfassungsfeld,erfassungsmaske,setzefehlerstatus, +setzeerfassungsparameter,erfassungsfelder,datumskonversion,datumrekonversion: +LET fnrschluessel=2,fnrschluessellaenge=3,fnrerstesfeld=4;LET erfparamsetzen= +1,erfwertezeigen=2,erfwertepruefen=3,erfwerteindbwerte=4,erfwertelesen=6, +erfwerteaendern=7,erfwerteeinfuegen=8,erfwerteloeschen=9;LET +meldungloeschfrage=65,meldungspeicherung=50,meldungloeschung=61, +meldungkeineloeschung=62,meldungkeineaenderung=63,meldunggibtsschon=64, +meldunggibtsnicht=66,meldungletzter=67,meldungkeineliste=68, +meldunglistenerstellung=7,pruefemeldung=57,meldungschluesselzulang=60, +meldungnichteingefuegt=70;LET dateiname="Liste zu den allgemeinen Diensten", +leer="",null=0,oblitrenner="$";LET dateinummerschluessel=137;BOOL VAR +neuerschluessel:=FALSE ;LET maxfelderzahl=100;ROW maxfelderzahlTEXT VAR +erfassungsfeld;TAG VAR maske;INT VAR startpos;FILE VAR f;TEXT VAR +programmname,aktschluessel;TEXT VAR aktmaskenname;INT VAR +aktmaxschluessellaenge,aktindex,aktdateinummer;INT VAR anzschlfelder:=1;INT +VAR fnraktletztesfeld,fnrakterstesfeld;INT VAR fnrfehlerhaftesfeld;PROC +erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen(PROC (INT +CONST )erfassungspeziell):erfassungspeziell(erfparamsetzen);startprozedur; +erfassungsbildschirmaufbauen;startpos:=fnrschluessel; +vonerfassungsbildschirmeinlesen.END PROC +erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen;PROC +maskezeigenundallefeldereinlesen(PROC (INT CONST )erfassungspeziell): +erfassungspeziell(erfparamsetzen);startprozedur; +erfassungsbildschirmganzaufbauen;allesvonerfassungsbildschirmeinlesen.END +PROC maskezeigenundallefeldereinlesen;PROC startprozedur: +programminitialisieren;bildschirminitialisieren.END PROC startprozedur;PROC +programminitialisieren:page;programmnameholen;standardkopfmaskeausgeben( +programmname).programmnameholen:programmname:=text(vergleichsknoten).END +PROC programminitialisieren;PROC bildschirminitialisieren:initmaske(maske, +aktmaskenname);erfassungsfelderzumanfanginitialisieren. +erfassungsfelderzumanfanginitialisieren:INT VAR i;FOR iFROM 1UPTO min( +maxfelderzahl,(fnraktletztesfeld+5))REP erfassungsfeld(i):=""PER .END PROC +bildschirminitialisieren;PROC erfassungsbildschirmaufbauen: +standardkopfmaskeaktualisieren(programmname);erfassungsmaskeausgeben; +felderzurausgabevorbereiten;felderausgeben.erfassungsmaskeausgeben:show(maske +).felderzurausgabevorbereiten:IF schluessellaengenichtzuberuecksichtigenTHEN +fnrakterstesfeld:=fnrschluessellaengeELSE fnrakterstesfeld:=fnrerstesfeld; +erfassungsfeld(fnrschluessellaenge):=text(aktmaxschluessellaenge)FI ;protect( +maske,fnrakterstesfeld,fnraktletztesfeld+1,TRUE );loeschfeldverdecken. +schluessellaengenichtzuberuecksichtigen:aktmaxschluessellaenge=0. +loeschfeldverdecken:LET rahmenzeichen="=";erfassungsfeld(fnraktletztesfeld+1) +:=rahmenzeichen.felderausgeben:put(maske,erfassungsfeld,1);startpos:= +fnrschluessel.END PROC erfassungsbildschirmaufbauen;PROC +erfassungsbildschirmganzaufbauen:standardkopfmaskeaktualisieren(programmname) +;erfassungsmaskeausgeben;felderzurausgabevorbereiten;loeschfeldverdecken. +erfassungsmaskeausgeben:show(maske).felderzurausgabevorbereiten: +fnrakterstesfeld:=fnrschluessel+anzschlfelder;.loeschfeldverdecken:LET +rahmenzeichen="=";erfassungsfeld(fnraktletztesfeld+1):=rahmenzeichen;protect( +maske,fnraktletztesfeld+1,TRUE ).END PROC erfassungsbildschirmganzaufbauen; +PROC vonerfassungsbildschirmeinlesen:schluesseleinlesen.schluesseleinlesen: +get(maske,erfassungsfeld,startpos).END PROC vonerfassungsbildschirmeinlesen; +PROC allesvonerfassungsbildschirmeinlesen:put(maske,erfassungsfeld,1); +startpos:=fnrschluessel;get(maske,erfassungsfeld,startpos)END PROC +allesvonerfassungsbildschirmeinlesen;PROC schluesselbearbeiten(PROC (INT +CONST )erfassungspeziell):BOOL VAR schluesselexistiert:=FALSE ;loeschemeldung +(maske);aktschluessel:=erfassungsfeld(fnrschluessel);datendirektlesen(PROC ( +INT CONST )erfassungspeziell,schluesselexistiert);IF schluesselexistiertTHEN +zeigeschluesselzurbearbeitung(PROC (INT CONST )erfassungspeziell); +bearbeitetenschluesseleinlesenELSE melde(maske,meldunggibtsnicht);return(1) +FI .END PROC schluesselbearbeiten;PROC zeigeschluesselzurbearbeitung(PROC ( +INT CONST )erfassungspeziell):neuerschluessel:=FALSE ;protect(maske, +fnrakterstesfeld,fnraktletztesfeld,FALSE );erfassungspeziell(erfwertezeigen); +aktschluessel:=erfassungsfeld(fnrschluessel);startpos:=fnrschluessel;put( +maske,erfassungsfeld,startpos);END PROC zeigeschluesselzurbearbeitung;PROC +bearbeitetenschluesseleinlesen:get(maske,erfassungsfeld,startpos);END PROC +bearbeitetenschluesseleinlesen;PROC angegebenedatenpruefenundevtlspeichern( +BOOL CONST zuspeichern,PROC (INT CONST )erfassungspeziell):INT VAR schritte; +IF zuspeichernTHEN speichernteil;ELSE nichtspeichernteil;FI . +nichtspeichernteil:meldeauffaellig(maske,meldungkeineaenderung); +vorbereitendernaechstenschluesselbehandlung(schritte,PROC erfassungspeziell); +return(schritte).speichernteil:fnrfehlerhaftesfeld:=0; +pruefeplausibilitaetallgemein(PROC (INT CONST )erfassungspeziell);IF +datenfehlerfreiTHEN erfassungspeziell(erfwertepruefen)FI ;IF datenfehlerfrei +THEN BOOL VAR satzgeschrieben;datenwegschreiben;IF NOT satzgeschriebenAND +neuerschluesselTHEN melde(maske,meldungnichteingefuegt);return(1)ELSE +vorbereitendernaechstenschluesselbehandlung(schritte,PROC erfassungspeziell); +return(schritte)FI ELSE fehlerbehandeln;return(1)FI .datenwegschreiben: +meldespeicherung;datenindatenbankspeichern.datenindatenbankspeichern: +erfassungspeziell(erfwerteindbwerte);IF neuerschluesselTHEN +neuenschluesseleinfuegenELSE bearbeitetenschluesselzurueckschreibenFI . +bearbeitetenschluesselzurueckschreiben:erfassungspeziell(erfwerteaendern);. +neuenschluesseleinfuegen:erfassungspeziell(erfwerteeinfuegen);satzgeschrieben +:=dbstatus=0.meldespeicherung:melde(maske,meldungspeicherung).datenfehlerfrei +:fnrfehlerhaftesfeld=0.fehlerbehandeln:startpos:=fnrfehlerhaftesfeld.END +PROC angegebenedatenpruefenundevtlspeichern;PROC schluesselloeschvorbereitung +(PROC (INT CONST )erfassungspeziell):BOOL VAR schluesselexistiert:=FALSE ; +loeschemeldung(maske);aktschluessel:=erfassungsfeld(fnrschluessel); +datendirektlesen(PROC (INT CONST )erfassungspeziell,schluesselexistiert);IF +schluesselexistiertTHEN loeschennachfrage(PROC (INT CONST )erfassungspeziell) +;schluesselloeschfrageELSE melde(maske,meldunggibtsnicht);return(1)FI .END +PROC schluesselloeschvorbereitung;PROC loeschennachfrage(PROC (INT CONST ) +erfassungspeziell):zeigeschluesselzurbearbeitung(PROC (INT CONST ) +erfassungspeziell);melde(maske,meldungloeschfrage);protect(maske, +fnrschluessel,TRUE );END PROC loeschennachfrage;PROC schluesselloeschfrage: +TEXT VAR xy;startpos:=fnraktletztesfeld+1;get(maske,xy,startpos).END PROC +schluesselloeschfrage;PROC schluesselloeschen(BOOL CONST zuloeschen,PROC ( +INT CONST )erfassungspeziell):INT VAR schritte;IF zuloeschenTHEN melde(maske, +meldungloeschung);erfassungspeziell(erfwerteloeschen);IF dbstatus<>0THEN put( +maske,("Löschen - Fehlerstatus: "+text(dbstatus)),1);pauseFI ELSE melde(maske +,meldungkeineloeschung)FI ;vorbereitendernaechstenschluesselbehandlung( +schritte,PROC erfassungspeziell);return(schritte).END PROC schluesselloeschen +;PROC neuenschluesseleinfuegen(PROC (INT CONST )erfassungspeziell):BOOL VAR +schluesselexistiert;loeschemeldung(maske);aktschluessel:=erfassungsfeld( +fnrschluessel);pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell, +schluesselexistiert);IF schluesselexistiertTHEN melde(maske,meldunggibtsschon +);return(1)ELSE neuerschluesselvorbereitung;bearbeitetenschluesseleinlesenFI +.neuerschluesselvorbereitung:neuerschluessel:=TRUE ;protect(maske, +fnrakterstesfeld,fnraktletztesfeld,FALSE );startpos:=fnrschluessel;put(maske, +erfassungsfeld,startpos).END PROC neuenschluesseleinfuegen;PROC +pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,BOOL VAR existiert): +TEXT VAR schluessel:=compress(erfassungsfeld(fnrschluessel));existiert:= +FALSE ;IF schluessel<>leerTHEN datendirektlesen(PROC (INT CONST ) +erfassungspeziell,existiert);existiert:=dbstatus=0;FI .END PROC +pruefeneuenschluessel;PROC vorbereitendernaechstenschluesselbehandlung(INT +VAR schritte,PROC (INT CONST )erfassungspeziell):IF exists(dateiname)THEN +holenaechstenschluesselauslisteELSE bereitenaechstebenutzereingabevor; +schritte:=2FI .holenaechstenschluesselausliste:BOOL VAR ok, +kannbearbeitetwerden:=FALSE ;TEXT VAR oblischl2:=""; +holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE okREP +erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT +CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE +ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF +kannbearbeitetwerdenTHEN zeigeschluesselzurbearbeitung(PROC (INT CONST ) +erfassungspeziell);startpos:=fnrschluessel;put(maske,erfassungsfeld,startpos) +;schritte:=1ELSE behandleendederlistenabarbeitung;schritte:=3FI . +behandleendederlistenabarbeitung:melde(maske,meldungletzter);pause(20); +bereitenaechstebenutzereingabevor.bereitenaechstebenutzereingabevor:protect( +maske,fnrschluessel,FALSE );protect(maske,fnrakterstesfeld,fnraktletztesfeld, +TRUE );erfassungsfelderinitialisieren;startpos:=fnrschluessel;put(maske, +erfassungsfeld,startpos).END PROC vorbereitendernaechstenschluesselbehandlung +;PROC schluesselzeigen(PROC (INT CONST )erfassungspeziell):schluesselzeigen( +PROC (INT CONST )erfassungspeziell,FALSE ,BOOL PROC pruefungdummy)END PROC +schluesselzeigen;PROC schluesselzeigen(PROC (INT CONST )erfassungspeziell, +BOOL CONST scanja,BOOL PROC pruefungspeziell):IF aktindex= +dateinummerschluesselTHEN systemdboff;datensatzzeigen(PROC (INT CONST ) +erfassungspeziell,scanja,BOOL PROC pruefungspeziell);LEAVE schluesselzeigen +FI ;BOOL VAR listeexistiertnicht:=FALSE ;TEXT VAR sicherungstupel;systemdbon; +savetupel(aktdateinummer,sicherungstupel);melde(maske,meldunglistenerstellung +);systemdbon;restoretupel(aktdateinummer,sicherungstupel);systemdboff; +aktschluessel:=erfassungsfeld(fnrschluessel);objektlistestarten(aktindex, +aktschluessel,FALSE ,listeexistiertnicht);IF listeexistiertnichtTHEN melde( +maske,meldungkeineliste);return(1)ELSE objektlistenausgabe(PROC (INT CONST ) +erfassungspeziell,scanja,BOOL PROC pruefungspeziell)FI END PROC +schluesselzeigen;PROC datensatzzeigen(PROC (INT CONST )erfassungspeziell): +datensatzzeigen(PROC (INT CONST )erfassungspeziell,FALSE ,BOOL PROC +pruefungdummy)END PROC datensatzzeigen;PROC datensatzzeigen(PROC (INT CONST ) +erfassungspeziell,BOOL CONST scanja,BOOL PROC pruefungspeziell):BOOL VAR +listeexistiertnicht:=FALSE ;melde(maske,meldunglistenerstellung); +aktschluessel:=erfassungsfeld(fnrschluessel);objektlistestarten(aktindex, +aktschluessel,TRUE ,#26.03.87#listeexistiertnicht);IF listeexistiertnicht +THEN melde(maske,meldungkeineliste);return(1)ELSE datensatzlistenausgabe( +PROC (INT CONST )erfassungspeziell,scanja,BOOL PROC pruefungspeziell)FI .END +PROC datensatzzeigen;PROC ausgesuchtezurbearbeitung(PROC (INT CONST ) +erfassungspeziell):BOOL VAR ok,kannbearbeitetwerden:=FALSE ; +objektlistebeenden(dateiname,TRUE );TEXT VAR oblischl2; +holeerstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE okREP +erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT +CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE +ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF +kannbearbeitetwerdenTHEN erfassungsbildschirmaufbauen; +zeigeschluesselzurbearbeitung(PROC (INT CONST )erfassungspeziell); +bearbeitetenschluesseleinlesenELSE erfassungsfelderinitialisieren; +erfassungsbildschirmaufbauen;return(2)FI .END PROC ausgesuchtezurbearbeitung; +PROC ausgesuchtezumloeschen(PROC (INT CONST )erfassungspeziell):BOOL VAR ok, +kannbearbeitetwerden:=FALSE ;objektlistebeenden(dateiname,TRUE );TEXT VAR +oblischl2;holeerstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE ok +REP erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT +CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE +ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF +kannbearbeitetwerdenTHEN erfassungsbildschirmaufbauen;loeschennachfrage(PROC +(INT CONST )erfassungspeziell);schluesselloeschfrageELSE +erfassungsfelderinitialisieren;erfassungsbildschirmaufbauen;return(2)FI .END +PROC ausgesuchtezumloeschen;PROC datendirektlesen(PROC (INT CONST ) +erfassungspeziell,BOOL VAR dirok):erfassungspeziell(erfwertelesen);dirok:= +dbstatus=0;END PROC datendirektlesen;PROC erfassungsfelderinitialisieren: +erfassungsfeld(fnrschluessel):="";INT VAR feldnr;FOR feldnrFROM +fnrakterstesfeldUPTO fnraktletztesfeldREP erfassungsfeld(feldnr):="";PER . +END PROC erfassungsfelderinitialisieren;PROC holeerstenschluesselausdatei( +TEXT VAR feld1,feld2,BOOL VAR ok):IF NOT exists(dateiname)THEN ok:=FALSE ; +LEAVE holeerstenschluesselausdateiFI ;f:=sequentialfile(input,dateiname); +holenaechstenschluesselausdatei(feld1,feld2,ok);END PROC +holeerstenschluesselausdatei;PROC holenaechstenschluesselausdatei(TEXT VAR +feld1,feld2,BOOL VAR ok):TEXT VAR thesaurustext:="";IF eof(f)THEN ok:=FALSE ; +loeschedieerstellteobjektlisteELSE getline(f,thesaurustext); +bestimmeschluesselausthesaurustext;ok:=TRUE FI . +bestimmeschluesselausthesaurustext:INT VAR schluesselbeginn:=pos( +thesaurustext,oblitrenner);INT VAR schluesseltrennung:=pos(thesaurustext, +oblitrenner,schluesselbeginn+1);IF schluesseltrennung>0THEN feld1:=subtext( +thesaurustext,schluesselbeginn+1,schluesseltrennung-1);feld2:=subtext( +thesaurustext,schluesseltrennung+1)ELSE feld1:=subtext(thesaurustext, +schluesselbeginn+1);feld2:=leerFI .END PROC holenaechstenschluesselausdatei; +PROC loeschedieerstellteobjektliste:forget(dateiname,quiet);END PROC +loeschedieerstellteobjektliste;PROC put(TAG CONST t,ROW maxfelderzahlTEXT +VAR pfeld,INT CONST pos):INT VAR i;FOR iFROM posUPTO maxfelderzahlREP IF +fieldexists(t,i)THEN put(t,pfeld(i),i)FI ;PER ;END PROC put;PROC protect(TAG +VAR maske,INT CONST anfangfeld,endefeld,BOOL CONST schreibschutz):IF endefeld +>=anfangfeldTHEN setzefeldschutzfuerdiebenanntenfelderFI . +setzefeldschutzfuerdiebenanntenfelder:INT VAR feldnr;FOR feldnrFROM +anfangfeldUPTO endefeldREP protect(maske,feldnr,schreibschutz)PER .END PROC +protect;PROC pruefeplausibilitaetallgemein(PROC (INT CONST )erfassungspeziell +):melde(maske,pruefemeldung);INT VAR fehlstatus;pruefe(1,maske,TEXT PROC ( +INT CONST )erfassungswert,fnrschluessel,null,null,leer,fehlstatus);IF +fehlstatus<>0THEN setzefehlerstatus(fehlstatus);LEAVE +pruefeplausibilitaetallgemeinFI ;IF schluessellaengemussueberprueftwerden +THEN IF eingabelaenge>aktmaxschluessellaengeTHEN melde(maske, +meldungschluesselzulang);setzefehlerstatus(fnrschluessel);LEAVE +pruefeplausibilitaetallgemeinFI FI ;BOOL VAR schluesselexistiert;IF +neuerschluesselTHEN pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell, +schluesselexistiert);IF schluesselexistiertTHEN melde(maske,meldunggibtsschon +);setzefehlerstatus(fnrschluessel)FI ELSE IF erfassungsfeld(fnrschluessel)<> +aktschluesselTHEN pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell, +schluesselexistiert);IF schluesselexistiertTHEN setzeaufaltensatzzurueck; +melde(maske,meldunggibtsschon);setzefehlerstatus(fnrschluessel);ELSE +setzefehlerstatus(0);FI ELSE setzefehlerstatus(0);FI FI . +setzeaufaltensatzzurueck:TEXT VAR falscherschluessel:=erfassungsfeld( +fnrschluessel);erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen( +PROC (INT CONST )erfassungspeziell,schluesselexistiert);erfassungsfeld( +fnrschluessel):=falscherschluessel.eingabelaenge:length(erfassungsfeld( +fnrschluessel)).schluessellaengemussueberprueftwerden:aktmaxschluessellaenge> +0.END PROC pruefeplausibilitaetallgemein;PROC zurueckzureinzelbearbeitung: +loeschedieerstellteobjektliste;standardkopfmaskeaktualisieren(programmname); +protect(maske,fnrschluessel,FALSE );protect(maske,fnrakterstesfeld,TRUE ); +erfassungsfelderinitialisieren;startpos:=fnrschluessel;put(maske, +erfassungsfeld,startpos);return(3);END PROC zurueckzureinzelbearbeitung;PROC +setzeerfassungsfeld(TEXT CONST feldinhalt,INT CONST feldnr):erfassungsfeld( +feldnr):=feldinhaltEND PROC setzeerfassungsfeld;TEXT PROC erfassungswert(INT +CONST feldnr):IF (feldnr>maxfelderzahl)OR (feldnr<1)THEN ""ELSE +erfassungsfeld(feldnr)FI .END PROC erfassungswert;ROW 100TEXT PROC +erfassungsfelder:erfassungsfeldEND PROC erfassungsfelder;TAG PROC +erfassungsmaske:maskeEND PROC erfassungsmaske;PROC setzefehlerstatus(INT +CONST feldnr):fnrfehlerhaftesfeld:=feldnr.END PROC setzefehlerstatus;PROC +setzeerfassungsparameter(INT CONST dateinummer,INT CONST schluessellaenge, +TEXT CONST maskenname,INT CONST letzteserfassungsfeld):aktindex:=dateinummer; +aktdateinummer:=dateinr(primdatid(dateinummer));aktmaxschluessellaenge:= +schluessellaenge;aktmaskenname:=maskenname;fnraktletztesfeld:= +letzteserfassungsfeld;anzschlfelder:=anzkey(dateinr(primdatid(aktdateinummer) +));END PROC setzeerfassungsparameter;PROC setzeerfassungsparameter(INT CONST +dateinummer,TEXT CONST maskenname,INT CONST letzteserfassungsfeld):LET +keineschluessellaenge=0;setzeerfassungsparameter(dateinummer, +keineschluessellaenge,maskenname,letzteserfassungsfeld).END PROC +setzeerfassungsparameter;TEXT PROC datumskonversion(TEXT CONST datum):TEXT +VAR d:=datum;IF nurblanksoderleer(datum)OR d=" . . "THEN "01.01.00"ELSE +changeall(d," ","0");IF nochnichtkonvertiertTHEN insertchar(d,".",3); +insertchar(d,".",6);FI ;dFI .nochnichtkonvertiert:pos(d,".")=0.ENDPROC +datumskonversion;BOOL PROC nurblanksoderleer(TEXT CONST t):INT VAR i;FOR i +FROM 1UPTO length(t)REP IF (tSUB i)<>" "THEN LEAVE nurblanksoderleerWITH +FALSE FI PER ;TRUE ENDPROC nurblanksoderleer;TEXT PROC datumrekonversion( +TEXT CONST datum):TEXT VAR d:=datum;changeall(d,".","");IF d="010100"THEN d:= +""FI ;dENDPROC datumrekonversion;END PACKET isperfsteueroperationen + diff --git a/app/baisy/2.2.1-schulis/src/isp.init baisy server b/app/baisy/2.2.1-schulis/src/isp.init baisy server new file mode 100644 index 0000000..98044ba --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.init baisy server @@ -0,0 +1,4 @@ +PACKET ispinitbaisyserverDEFINES initbs,baisyserver:TASK VAR bs;PROC initbs: +bs:=/"baisy server"END PROC initbs;TASK PROC baisyserver:bsEND PROC +baisyserver;initbsEND PACKET ispinitbaisyserver; + diff --git a/app/baisy/2.2.1-schulis/src/isp.knoten b/app/baisy/2.2.1-schulis/src/isp.knoten new file mode 100644 index 0000000..6af3e22 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.knoten @@ -0,0 +1,137 @@ +PACKET knotenDEFINES systembaum,setzesystembaumundaktuellenknoten, +generierebaisymonitor,KNOTEN ,STACK ,KNOTENMENGE ,leeremenge,nilknoten, +leererstack,anfangsknotenholen,einzelknotenholen,erster,weitere,naechster, +attribute,maske,task,text,nummer,vorprozedur,nachprozedur,taste,isrefinement, +isopen,knotenaufrufindex,HAT ,zahlderelemente,mengedernachfolger,:=,=,push, +pop,hoehe,voll,leer:LET maxhoehe=20,bottom=1;LET maxkn=2190;TYPE LONGROW = +TEXT ;TYPE KNOTENMENGE =INT ;TYPE KNOTEN =STRUCT (INT zeile,index);TYPE +INTKNOTEN =INT ;TYPE EINTRAG =STRUCT (TEXT attribute,INTKNOTEN vater,LONGROW +knotenmengenLONGROW knoten);TYPE SYSTAB =STRUCT (INT maxeintrag,ersterfreier, +ROW maxknEINTRAG zeile);KNOTEN CONST nilknoten:=KNOTEN :(0,0);BOUND SYSTAB +VAR sysbaum;TYPE STACK =STRUCT (ROW maxhoeheKNOTEN st,INT top);LET maxat=6, +tepos=1,mpos=2,vpos=3,npos=4,tpos=5,ppos=6;LET scanid=1;DATASPACE VAR ds; +BOOL VAR verteilteraufruf;INT VAR newkind;TEXT VAR newsymbol;TEXT VAR +pruefstack;BOOL PROC isid:(newkind=scanid)END PROC isid;PROC next:nextsymbol( +newsymbol,newkind);END PROC next;PROC next(TEXT CONST proz):scan(proz);next +END PROC next;BOOL PROC prozedurexistiert(TEXT CONST prozname):BOOL VAR da:= +false;scanstring(da,prozname);da.END PROC prozedurexistiert;PROC scanstring( +BOOL VAR da,TEXT CONST str):procpos:=1;next(str);analyse(da);WHILE NOT +schlussREP next(subtext(str,procpos+4));IF isidTHEN analyse(da)ELSE da:=false +FI ;procposINCR 1PER .schluss:INT VAR procpos:=pos(str,"PROC",procpos); +procpos=0.END PROC scanstring;PROC analyse(BOOL VAR da):IF schongeprueftTHEN +da:=trueELSE da:=analyseergebnis(newsymbol);IF daTHEN alsgeprueftvermerkenFI +FI .schongeprueft:pos(pruefstack,pruefname(newsymbol))>0.alsgeprueftvermerken +:pruefstackCAT pruefname(newsymbol).END PROC analyse;BOOL PROC +analyseergebnis(TEXT CONST prozname):pruefungvorbereiten;IF iserrorTHEN +breakabfangen;falseELSE trueFI .pruefungvorbereiten:disablestop;type("�q"); +help(prozname).breakabfangen:TEXT VAR br:="";editget(br);clearerror.END PROC +analyseergebnis;TEXT PROC pruefname(TEXT CONST name):"/"+name+"/"END PROC +pruefname;TEXT PROC prozedur(TEXT CONST pname):IF pname<>""THEN IF +prozedurexistiert(pname)THEN pnameELSE "return(1)"FI ELSE pnameFI END PROC +prozedur;PROC generierebaisymonitor(TEXT CONST teilbaumname):LET maxcase=510; +startemonitordatei;naechstezeile;WHILE NOT tabellenendeREP neuescase; +naechstezeilePER ;schlusszeilen.startemonitordatei:richtedateiein; +anfangszeile.richtedateiein:TEXT CONST monitorname:=teilbaumname+" monitor"; +forget(monitorname,quiet);FILE VAR f:=sequentialfile(output,monitorname). +anfangszeile:putline(f, +"PACKET baisymonitor DEFINES call,starten ueber monitor:");TEXT VAR anfaenge +:="";INT VAR tabind:=0;INT VAR caseproczahl:=0;INT VAR aktcasezahl:=0;INT +VAR maxtabeintrag:=sysbaum.ersterfreier-1;pruefstack:="".naechstezeile: +aktcasezahlINCR 1;tabindINCR 1;cout(tabind).tabellenende:tabind>maxtabeintrag +.neuescase:IF aktcasezahl=1THEN neuecaseprocFI ;casewennnoetig;IF aktcasezahl +=maxcaseTHEN schlusscaseprocFI .neuecaseproc:caseproczahlINCR 1;putline(f, +"PROC case"+text(caseproczahl)+"(INT CONST i,BOOL CONST vor):");putline(f, +"SELECT i OF").casewennnoetig:IF gueltigezeileTHEN KNOTEN VAR k;k.zeile:= +tabind;TEXT VAR vproc:=prozedur(vorprozedur(k));IF vproc<>""THEN vprocteil; +TEXT VAR nproc:=prozedur(nachprozedur(k));IF nproc<>""THEN nprocteilELSE put( +f,"FI");line(f)FI FI FI .gueltigezeile:CONCR (sysbaum.zeile(tabind).vater)>=0 +.vprocteil:put(f,"CASE "+text(aktcasezahl)+": ");put(f,"IF vor THEN "+vproc). +nprocteil:put(f," ELSE "+nproc+" FI");line(f).schlusszeilen:schlusscaseproc; +procanfang;ifabfragen;procundpacketende.schlusscaseproc:putline(f, +"END SELECT");putline(f,"END PROC case"+text(caseproczahl)+";");aktcasezahl:= +0;anfaengeCAT text(tabind,4).procanfang:putline(f,"PROC call"+ +"(INT CONST i,BOOL CONST vor,TEXT CONST t):").ifabfragen:INT VAR ifzahl:= +caseproczahl-1;IF ifzahl=0THEN einfacherfallELIF ifzahl=1THEN erstesif; +elseteilELSE erstesif;alleelifs;elseteilFI .caseaufruf:TEXT VAR zusatz:=""; +TEXT VAR decr:=subtext(anfaenge,basis-3,basis);IF decr<>""THEN zusatz:=" - "+ +decrFI ;put(f,"case"+text(aktcaseindex)+"(i"+zusatz+",vor)");.einfacherfall: +put(f,"case1(i,vor)");line(f).erstesif:INT VAR aktcaseindex;basis:=0;put(f, +"IF i<="+subtext(anfaenge,1,4)+" THEN");einfacherfall.alleelifs:INT VAR elif; +FOR elifFROM 1UPTO ifzahl-1REP neueselifPER .neueselif:put(f,"ELIF "); +aktcaseindex:=elif+1;INT VAR basis:=elif*4;put(f,"i <="+subtext(anfaenge, +basis+1,basis+4)+" THEN");caseaufruf;line(f).elseteil:put(f,"ELSE ");basis +INCR 4;aktcaseindex:=ifzahl+1;caseaufruf;putline(f," FI").procundpacketende: +putline(f,"END PROC call;");putline(f,"PROC starten ueber monitor:");putline( +f,"start baisy("""+teilbaumname+ +""",PROC (INT CONST,BOOL CONST,TEXT CONST) call)");putline(f, +"END PROC starten ueber monitor");putline(f,"END PACKET baisymonitor"); +pruefstack:="".END PROC generierebaisymonitor;DATASPACE PROC systembaum:ds +END PROC systembaum;KNOTEN VAR aktuellerknoten;PROC +setzesystembaumundaktuellenknoten(DATASPACE CONST d,INT CONST s):ds:=d; +aktuellerknoten.zeile:=sEND PROC setzesystembaumundaktuellenknoten;PROC +kopplesystembauman(TEXT CONST name):forget(ds);ladesystembaum(ds,name); +sysbaum:=dsEND PROC kopplesystembauman;PROC anfangsknotenholen(TEXT CONST +name,KNOTEN VAR k,BOOL VAR ok):schaltersetzen;vglkn:=nilknoten;IF NOT +verteilteraufrufTHEN kopplesystembauman(name);suche(k,ok)ELSE ok:=TRUE ; +sysbaum:=ds;k:=aktuellerknotenFI .schaltersetzen:verteilteraufruf:=name="". +END PROC anfangsknotenholen;PROC einzelknotenholen(TEXT CONST name,KNOTEN +VAR einzelknoten,BOOL VAR ok):IF NOT verteilteraufrufTHEN +holeindexvoneinzelknoten;IF okTHEN vermerkeihnanletzterstelleFI ELSE +sucheunterdenangehaengtenindizesFI .holeindexvoneinzelknoten:DATASPACE VAR +savespace:=ds;kopplesystembauman(name);INT VAR index;suche(index,ok);forget( +ds);ds:=savespace;forget(savespace);sysbaum:=ds.vermerkeihnanletzterstelle: +einzelknoten.zeile:=index;sysbaum.maxeintragINCR 1;CONCR (sysbaum.zeile( +sysbaum.maxeintrag).vater):=einzelknoten.zeile;sysbaum.zeile(sysbaum. +maxeintrag).attribute:=taste(einzelknoten).sucheunterdenangehaengtenindizes: +INT VAR i;FOR iFROM sysbaum.ersterfreierUPTO sysbaum.maxeintragREP IF sysbaum +.zeile(i).attribute=nameTHEN einzelknoten.zeile:=CONCR (sysbaum.zeile(i). +vater)FI PER .END PROC einzelknotenholen;PROC suche(KNOTEN VAR k,BOOL VAR ok) +:suche(k.zeile,ok);sysbaum.maxeintragINCR 1;sysbaum.ersterfreier:=sysbaum. +maxeintrag;CONCR (sysbaum.zeile(sysbaum.maxeintrag).vater):=k.zeileEND PROC +suche;PROC suche(INT VAR k,BOOL VAR ok):k:=CONCR (sysbaum.zeile(sysbaum. +ersterfreier).vater);ok:=(k>0)END PROC suche;KNOTENMENGE PROC leeremenge: +KNOTENMENGE :(0)END PROC leeremenge;STACK PROC leererstack:STACK VAR s;s.top +:=bottom;sEND PROC leererstack;TEXT PROC knotentexte(KNOTEN CONST k):sysbaum. +zeile(k.zeile).attributeEND PROC knotentexte;PROC knotentexte(KNOTEN VAR k, +TEXT CONST t):sysbaum.zeile(k.zeile).attribute:=tEND PROC knotentexte;TEXT +PROC maske(KNOTEN CONST k):attribut(k,mpos)END PROC maske;TEXT PROC task( +KNOTEN CONST k):attribut(k,ppos)END PROC task;INT PROC nummer(KNOTEN CONST k) +:knotenaufrufindex(k)END PROC nummer;TEXT PROC text(KNOTEN CONST k):attribut( +k,tepos)END PROC text;TEXT PROC vorprozedur(KNOTEN CONST k):attribut(k,vpos) +END PROC vorprozedur;TEXT PROC nachprozedur(KNOTEN CONST k):attribut(k,npos) +END PROC nachprozedur;TEXT PROC taste(KNOTEN CONST k):attribut(k,tpos)END +PROC taste;TEXT VAR attext;TEXT PROC attribut(KNOTEN CONST k,INT CONST i): +attribute(k);TEXT VAR amuster:="��",emuster:="��";replace(amuster,1,i); +replace(emuster,1,i+1);INT VAR ende,anfang;anfang:=pos(attext,amuster)+2;IF i +0)CAND (k.index0)END PROC weitere;BOOL OP =(KNOTEN CONST k,l):k.zeile=l.zeile +END OP =;OP :=(KNOTEN VAR ziel,KNOTEN CONST quelle):CONCR (ziel):=CONCR ( +quelle)END OP :=;OP :=(KNOTENMENGE VAR ziel,KNOTENMENGE CONST quelle):CONCR ( +ziel):=CONCR (quelle)END OP :=;OP :=(LONGROW VAR ziel,LONGROW CONST quelle): +CONCR (ziel):=CONCR (quelle)END OP :=;OP :=(STACK VAR ziel,STACK CONST quelle +):CONCR (ziel):=CONCR (quelle)END OP :=;PROC push(STACK VAR s,KNOTEN CONST k) +:IF NOT (s.top=maxhoehe)THEN s.st(s.top):=k;s.topINCR 1FI END PROC push;PROC +pop(STACK VAR s,KNOTEN VAR k):IF NOT (s.top=bottom)THEN s.topDECR 1;k:=s.st(s +.top);FI END PROC pop;INT PROC hoehe(STACK CONST s):s.top-1END PROC hoehe; +BOOL PROC voll(STACK CONST s):s.top=maxhoeheEND PROC voll;BOOL PROC leer( +STACK CONST s):s.top=bottomEND PROC leer;END PACKET knoten; + diff --git a/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle b/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle new file mode 100644 index 0000000..12ba492 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle @@ -0,0 +1,82 @@ +PACKET ispmanagerschnittstelleDEFINES gibdatenbankkennung,oeffnedatenbank, +initmaske,maskegibtes,maskeloeschen,maskespeichern,maskeumbenennen, +maskekopieren,maskenliste,setzemaske,baumverarbeitung,ladesystembaum, +schulisdbname,#08.02.88dr#baisydbname,#08.02.88dr#setzeschulisdbname,#08.02. +88dr#setzebaisydbname,#08.02.88dr##dnrausk,dnrbenutz,dnrmeld,fnrauskunftsname +,fnrschlverz,fnrauskunftstext,fnrbenutzbestand,fnrbenutzname, +fnrbenutzgeheimwort,fnrbenutzberecht,fnrmeldungsname,fnrmeldungstext#:LET +PARAM =STRUCT (TEXT textkey1,textkey2,TAG maske);LET pruefen=40,init=41, +loeschen=42,speichern=43,umbenennen=44,kopieren=45,liste=46,newtree=52;#dr06. +07.88indasPACKET "isp schulis db nummern"übernommenLET dnrauskuenfte=2, +fnrauskname=3,fnrauskverz=4,fnrausktext=5,dnrbenutzer=7,fnrbenbestand=8, +fnrbenname=9,fnrbengwort=10,fnrbenrecht=11,dnrmeldungen=12,fnrmeldname=13, +fnrmeldtext=14;#LET ack=0,error=2,ende=3,baumverarbeitungbasis=53;DATASPACE +VAR ds;BOUND PARAM VAR p;LET manager="baisy server";TASK VAR newmanager;INT +VAR replycode;TEXT VAR schulisdatenbank:="EUMELbase.schulis",baisydatenbank:= +"EUMELbase.baisy";PROC initdbsneu:neuanmelden;neuinitialisieren.neuanmelden: +newmanager:=baisyserver;.END PROC initdbsneu;PROC neuinitialisieren:forget(ds +);ds:=nilspace;p:=dsEND PROC neuinitialisieren;LET KENNUNGALT =STRUCT (TASK +managerbaisy,managerschulis,INT baisy,schulis);LET DATENBANKKENNUNG =STRUCT ( +TASK newmanager,KENNUNGALT oldmanager);PROC gibdatenbankkennung(DATASPACE +VAR ds):BOUND DATENBANKKENNUNG VAR dbkennung:=ds;dbkennung.newmanager:= +newmanager;DATASPACE VAR d:=nilspace;BOUND KENNUNGALT VAR kennung:=d; +dbkennung.oldmanager:=kennung;forget(d)END PROC gibdatenbankkennung;PROC +oeffnedatenbank(DATASPACE CONST ds):BOUND DATENBANKKENNUNG VAR dbkennung:=ds; +newmanager:=dbkennung.newmanager;DATASPACE VAR d:=nilspace;BOUND KENNUNGALT +VAR kennung:=d;kennung:=dbkennung.oldmanager;oeffneeumelbasebaisydatenbank;# +oeffnedatenbankalt(d);ersetztdurch#kennung.managerbaisy:=/"ei";kennung. +managerschulis:=/"ei";kennung.baisy:=999;kennung.schulis:=999; +neuinitialisierenEND PROC oeffnedatenbank;PROC oeffnedatenbank: +oeffneeumelbasebaisydatenbank;#oeffnedatenbankalt;#initdbsneuEND PROC +oeffnedatenbank;PROC oeffnedatenbank(TEXT CONST db):fetchdd(db);IF dbopen(db) +THEN setzeschulisdbname(db);oeffnedatenbank;systemdboffELSE errorstop( +"Datenbank der Anwendung konnte nicht geöffnet werden")FI ENDPROC +oeffnedatenbank;PROC setzebaisydbname(TEXT CONST bdbname):baisydatenbank:= +bdbnameEND PROC setzebaisydbname;PROC setzeschulisdbname(TEXT CONST sdbname): +schulisdatenbank:=sdbnameEND PROC setzeschulisdbname;TEXT PROC baisydbname: +baisydatenbankEND PROC baisydbname;TEXT PROC schulisdbname:schulisdatenbank +END PROC schulisdbname;PROC oeffneeumelbasebaisydatenbank:fetchdd(baisydbname +);IF NOT systemdbopen(baisydbname)THEN errorstop("Datenbank "+baisydbname+ +" konnte nicht geöffnet werden")FI ;ENDPROC oeffneeumelbasebaisydatenbank;# +dr06.07.88indasPACKET "isp.schulis db nummern"übernommenINT PROC dnrausk: +dnrauskuenfteENDPROC dnrausk;INT PROC fnrauskunftsname:fnrausknameENDPROC +fnrauskunftsname;INT PROC fnrschlverz:fnrauskverzENDPROC fnrschlverz;INT +PROC fnrauskunftstext:fnrausktextENDPROC fnrauskunftstext;INT PROC dnrbenutz: +dnrbenutzerENDPROC dnrbenutz;INT PROC fnrbenutzbestand:fnrbenbestandENDPROC +fnrbenutzbestand;INT PROC fnrbenutzname:fnrbennameENDPROC fnrbenutzname;INT +PROC fnrbenutzgeheimwort:fnrbengwortENDPROC fnrbenutzgeheimwort;INT PROC +fnrbenutzberecht:fnrbenrechtENDPROC fnrbenutzberecht;INT PROC dnrmeld: +dnrmeldungenENDPROC dnrmeld;INT PROC fnrmeldungsname:fnrmeldnameENDPROC +fnrmeldungsname;INT PROC fnrmeldungstext:fnrmeldtextENDPROC fnrmeldungstext;# +PROC initmaske(TAG VAR t,TEXT CONST name):p.textkey1:=name;sendeauftrag(init) +;t:=p.maskeEND PROC initmaske;BOOL PROC maskegibtes(TEXT CONST name):p. +textkey1:=name;sendeauftrag(pruefen);replycode=ackEND PROC maskegibtes;PROC +maskeloeschen(TEXT CONST name):p.textkey1:=name;sendeauftrag(loeschen)END +PROC maskeloeschen;PROC maskespeichern(TEXT CONST name):p.textkey1:=name; +sendeauftrag(speichern)END PROC maskespeichern;PROC maskeumbenennen(TEXT +CONST alt,neu):p.textkey1:=alt;p.textkey2:=neu;sendeauftrag(umbenennen)END +PROC maskeumbenennen;PROC maskekopieren(TEXT CONST alt,neu):p.textkey1:=alt;p +.textkey2:=neu;sendeauftrag(kopieren)END PROC maskekopieren;PROC maskenliste( +TEXT CONST dateiname):p.textkey1:=dateiname;sendeauftrag(liste);copy(ds, +dateiname);neuinitialisierenEND PROC maskenliste;PROC setzemaske(TAG CONST t) +:p.maske:=tEND PROC setzemaske;PROC ladesystembaum(DATASPACE VAR d,TEXT +CONST name):p.textkey1:=name;sendeauftrag(newtree);d:=ds;neuinitialisieren +END PROC ladesystembaum;PROC baumverarbeitung(TEXT VAR dateiname,INT CONST +aktion):INT VAR wastun:=baumverarbeitungbasis+aktion;IF aktion>4THEN wastun +DECR 2ELIF (aktion=2)COR (aktion=0)THEN FILE VAR f:=sequentialfile(input, +dateiname);INT CONST ch:=channel(myself);TEXT CONST cht:=dateiname+text(ch,2) +;headline(f,cht);break(quiet)FI ;DATASPACE VAR datei:=old(dateiname);INT VAR +re:=0;call(newmanager,wastun,datei,re);IF (aktion=2)COR (aktion=0)THEN +continue(ch)FI ;IF re<>ackTHEN IF re<0THEN errorstop("Keine Managertask") +ELSE IF re=errorTHEN BOUND TEXT VAR t:=datei;errorstop(t)ELSE SELECT aktion +OF CASE 2:dateiname:=headline(sequentialfile(input,datei));copy(datei, +dateiname);forget(datei)CASE 3,4:forget(dateiname,quiet);forget(datei); +dateiname:=""OTHERWISE standard;dateiname:=""END SELECT FI FI ELSE standard +FI .standard:forget(dateiname,quiet);copy(datei,dateiname);forget(datei).END +PROC baumverarbeitung;PROC sendeauftrag(INT CONST auftragsnr):call(newmanager +,auftragsnr,ds,replycode);IF (replycode<>ack)CAND (replycode<>ende)THEN IF +nomanagerTHEN errorstop(no)ELSE BOUND TEXT VAR t:=ds;TEXT VAR fehlermeldung:= +t;neuinitialisieren;errorstop(fehlermeldung)FI ELSE p:=dsFI .nomanager: +replycode<0.no:"Keine Managertask".END PROC sendeauftrag;END PACKET +ispmanagerschnittstelle; + diff --git a/app/baisy/2.2.1-schulis/src/isp.masken b/app/baisy/2.2.1-schulis/src/isp.masken new file mode 100644 index 0000000..12d5ef2 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.masken @@ -0,0 +1,495 @@ +PACKET textalsrowDEFINES ins,del,CAT ,ipos,dump,replaceiac,VSUB ,VISUB :LET +nil13byte="�������������",nil4byte="����",nilbyte="�";TEXT VAR g1,code2:="��" +;PROC ins(TEXT VAR row,INT CONST wo,was):replace(code2,1,was);g1:=subtext(row +,2*wo-1);row:=subtext(row,1,2*wo-2);rowCAT code2;rowCAT g1END PROC ins;PROC +del(TEXT VAR row,INT CONST wo):g1:=subtext(row,2*wo+1);row:=subtext(row,1,2* +wo-2);rowCAT g1END PROC del;OP CAT (TEXT VAR row,INT CONST was):replace(code2 +,1,was);rowCAT code2END OP CAT ;INT PROC ipos(TEXT CONST row,INT CONST was): +INT VAR start:=0;replace(code2,1,was);REP start:=pos(row,code2,start+1)UNTIL +startMOD 2=1OR start=0PER ;(start+1)DIV 2END PROC ipos;PROC dump(TEXT VAR row +):INT VAR i;FOR iFROM 1UPTO length(row)DIV 2REP put(rowISUB i)PER END PROC +dump;PROC replaceiac(TEXT VAR string,INT CONST wo,TEXT CONST was):IF LENGTH +string<=LENGTH was+wo-1THEN stretch(string,LENGTH was+wo-1)FI ;replace(string +,wo,was)END PROC replaceiac;PROC stretch(TEXT VAR t,INT CONST wo):WHILE +LENGTH t<=wo-13REP tCAT nil13bytePER ;WHILE LENGTH t<=wo-4REP tCAT nil4byte +PER ;WHILE LENGTH tganzrichtigTHEN reorganizescreenFI END PROC checkscreen; +screenpage;PROC screencursor(INT CONST x,y):curx:=x;cury:=yEND PROC +screencursor;PROC screenpage:FOR curyFROM 1UPTO zeilen-1REPEAT screen(cury):= +emptylinePER ;screen(zeilen):=blankline;cury:=1;curx:=1END PROC screenpage; +PROC screenbs:curxDECR 1END PROC screenbs;PROC screenline:curyINCR 1;curx:=1; +END PROC screenline;PROC screenput(TEXT CONST was):IF was>""THEN +checkworkline;getfirstparttoput;WHILE theremaybearestREP replacepart; +getnextparttoputPER ;replacerestFI .getfirstparttoput:pbegin:=pos(was," ","�" +,1);pend:=pos(was,"�","�",pbegin)-1.theremaybearest:pend>0.replacepart:buffer +:=subtext(was,pbegin,pend);replace(workline,pbegin+curx-1,buffer). +getnextparttoput:pbegin:=pos(was," ","�",pend+2);IF pbegin>0THEN pend:=pos( +was,"�","�",pbegin)-1;ELSE pend:=0FI .replacerest:IF pbegin>0THEN IF pbegin=1 +THEN replace(workline,curx,was)ELSE buffer:=subtext(was,pbegin,LENGTH was); +replace(workline,pbegin+curx-1,buffer)FI ;curxINCR LENGTH was;IF curx>spalten +THEN curyINCR 1;curxDECR spaltenFI ;FI .END PROC screenput;PROC screenout( +TEXT CONST was,INT CONST von,bis):buffer:=subtext(was,von,bis);checkscreen; +IF buffer>""THEN checkworkline;replace(workline,curx,buffer);curxINCR ((bis- +von)+1);IF curx>spaltenTHEN curyINCR 1;curxDECR spaltenFI FI .workline:screen +(cury).END PROC screenout;PROC screenout(TEXT CONST was):checkscreen;IF was> +""THEN checkworkline;replace(workline,curx,was);curxINCR LENGTH was;IF curx> +spaltenTHEN curyINCR 1;curxDECR spaltenFI FI .END PROC screenout;PROC +reorganizescreen:out("�");IF screenstatus=teilweisefalschTHEN FOR zeileFROM 1 +UPTO zeilen-1REPEAT IF lineok(zeile)THEN out(" +")ELSE out(screen(zeile))FI +PER ;IF NOT lineok(zeilen)THEN outsubtext(screen(zeilen),1,spalten-1);FI +ELSE FOR zeileFROM 1UPTO zeilen-1REPEAT out(screen(zeile))PER ;outsubtext( +screen(zeilen),1,spalten-1);FI ;cursor(curx,cury);screenok;END PROC +reorganizescreen;PROC screencopy(FILE VAR f):putline(f,"#page#");INT VAR +zeile;FOR zeileFROM 1UPTO zeilenREPEAT TEXT VAR t:=screen(zeile);changeall(t, +"�"," ");changeall(t,"�"," ");putline(f,t)PER ;END PROC screencopy;PROC +reorganizescreen(INT CONST zeile,von,bis):cursor(von,zeile);IF LENGTH screen( +zeile)0END PROC fieldexists;INT PROC xsize(TAG CONST a):a.xmaxEND PROC +xsize;INT PROC ysize(TAG CONST a):a.ymaxEND PROC ysize;TEXT PROC formline( +TAG CONST a,INT CONST l):a.formblatt(l)END PROC formline;PROC setinfo(TEXT +CONST string,INT CONST pos):workint:=stringVSUB pos;IF workint>0THEN +setallvaluesELSE normal:=TRUE FI .setallvalues:closedbit:=hbit;protectbit:= +hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit; +normal:=FALSE .hbit:workint:=workint*2;IF workint>255THEN workintDECR 256; +TRUE ELSE FALSE FI .END PROC setinfo;PROC clearfield(TAG VAR a,INT CONST feld +):sucheanfangdesfeldelementstring;sucheendedesfeldelementstring; +loeschefeldelementeintraege;korrigiereerstelverweise;loeschefeldeintraege. +sucheanfangdesfeldelementstring:INT VAR anf:=pos(a.feld,code(feld)). +sucheendedesfeldelementstring:INT VAR ende:=anf;WHILE (a.feldVSUB ende)=feld +REP endeINCR 1PER ;endeDECR 1.loeschefeldelementeintraege:change(a.feld,anf, +ende,"");change(a.x,anf,ende,"");change(a.y,anf,ende,"");change(a.len,anf, +ende,"");change(a.tab,anf,ende,"").korrigiereerstelverweise:INT VAR feldnr; +FOR feldnrFROM 1UPTO LENGTH a.erstelREP IF code(a.erstelSUB feldnr)>endeTHEN +replace(a.erstel,feldnr,code(decrementierterwert))FI ;PER . +decrementierterwert:code(a.erstelSUB feldnr)-(ende-anf+1). +loeschefeldeintraege:replace(a.erstel,feld,"�");replace(a.darst,feld,"�"); +replace(a.diainfo,feld,"�");IF LENGTH a.dbnam>=2*feldTHEN replace(a.dbnam, +feld,0)FI ;IF LENGTH a.ausknam>=2*feldTHEN replace(a.ausknam,feld,0)FI .END +PROC clearfield;PROC definefield(TAG VAR t,TEXT CONST xb,yb,lenb,tabb,INT +CONST dbnam,auskinfo,feldnr,TEXT CONST darst,diainfo):IF fieldexists(t,feldnr +)THEN clearfield(t,feldnr)FI ;elementarfeldpossuchen;elementarfeldereinfuegen +;erstelverweisekorrigieren;feldeintragen.elementarfeldpossuchen: +zumerstenelfeld;WHILE elfelddaCAND (liegtvorneuemCOR NOT isterstel)REP +oldnumber:=feld;elementarfeldposINCR 1PER .elementarfeldereinfuegen: +insertchar(t.y,yb,elementarfeldpos);insertchar(t.x,xb,elementarfeldpos); +insertchar(t.tab,tabb,elementarfeldpos);insertchar(t.len,lenb, +elementarfeldpos);insertchar(t.feld,LENGTH xb*code(feldnr),elementarfeldpos). +erstelverweisekorrigieren:INT VAR fnr;FOR fnrFROM 1UPTO LENGTH t.erstelREP +IF code(t.erstelSUB fnr)>=elementarfeldposTHEN replace(t.erstel,fnr,code( +incrementierterwert))FI ;PER .incrementierterwert:code(t.erstelSUB fnr)+ +LENGTH xb.feldeintragen:replaceiac(t.erstel,feldnr,code(elementarfeldpos)); +replaceiac(t.diainfo,feldnr,diainfo);replaceiac(t.darst,feldnr,darst);IF +dbnam<>0THEN replaceiac(t.dbnam,feldnr,dbnam)FI ;IF auskinfo<>0THEN +replaceiac(t.ausknam,feldnr,auskinfo)FI .zumerstenelfeld:INT VAR oldnumber:=0 +;INT VAR elementarfeldpos:=1.liegtvorneuem:y<(ybSUB 1)OR (y=(ybSUB 1)AND x<( +xbSUB 1)).isterstel:oldnumber<>feld.elfeldda:elementarfeldpos<=LENGTH t.x.y:t +.ySUB elementarfeldpos.x:t.xSUB elementarfeldpos.feld:code(t.feldSUB +elementarfeldpos).END PROC definefield;OP SCROLL (TAG VAR t,INT CONST lines): +cat:="";INT VAR i;FOR iFROM 1UPTO LENGTH (t.y)REP INT VAR v:=code(t.ySUB i)+ +lines;IF v<1OR v>taglinesTHEN errorstop( +"Feld ausserhalb Bildschirm durch SCROLL")FI ;catCAT code(v)PER ;t.y:=cat;IF +lines>0THEN FOR iFROM min(taglines-lines,t.ymax)DOWNTO 1REP t.formblatt(i+ +lines):=t.formblatt(i)PER ;FOR iFROM linesDOWNTO 1REP t.formblatt(i):=""PER ; +t.ymaxINCR lines;t.ymax:=min(taglines,t.ymax)ELSE FOR iFROM 1-linesUPTO min(t +.ymax-lines,taglines)REP t.formblatt(i+lines):=t.formblatt(i)PER ;FOR iFROM t +.ymax+lines+1UPTO t.ymaxREP t.formblatt(i):=""PER ;t.ymaxINCR lines;t.ymax:= +max(t.ymax,1);FI .END OP SCROLL ;INT PROC fieldwithname(TAG CONST t,INT +CONST name):ipos(t.dbnam,name)END PROC fieldwithname;INT PROC symbolicname( +TAG CONST t,INT CONST feld):t.dbnamVISUB feldEND PROC symbolicname;PROC +symbolicname(TAG VAR t,INT CONST feld,symbol):replaceiac(t.dbnam,feld,symbol) +END PROC symbolicname;INT PROC auskunftsnr(TAG CONST t,INT CONST feld):t. +ausknamVISUB feldEND PROC auskunftsnr;INT PROC auskunftsnr:ausnrEND PROC +auskunftsnr;PROC auskunftsnr(TAG VAR t,INT CONST feld,ausknr):replaceiac(t. +ausknam,feld,ausknr)END PROC auskunftsnr;PROC fieldinfos(TAG CONST t,INT +CONST feld,INT VAR geheimcode,BOOL VAR closed,protected,secret,special,left): +geheimcode:=code(t.darstSUB feld);setinfo(t.diainfo,feld);IF normalTHEN +closed:=FALSE ;protected:=FALSE ;secret:=FALSE ;special:=FALSE ;left:=FALSE ; +ELSE closed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit +;left:=leftbit;FI END PROC fieldinfos;PROC setfieldinfos(TAG VAR t,INT CONST +feld,BOOL CONST closed,protected,secret):INT VAR cd:=(t.diainfoVSUB feld)MOD +32;IF secretTHEN cdINCR 32FI ;IF protectedTHEN cdINCR 64FI ;IF closedTHEN cd +INCR 128FI ;replaceiac(t.diainfo,feld,code(cd))END PROC setfieldinfos;PROC +transform(TAG CONST t,FILE VAR o):enablestop;buffer:="";bufferCAT t.xmax; +bufferCAT t.ymax;bufferCAT t.xs;bufferCAT t.ys;bufferCAT t.dbp;bufferCAT t. +ver;bufferCAT t.durchs;bufferCAT t.art;putline(o,buffer);putline(o,t.darst); +putline(o,t.erstel);putline(o,t.diainfo);putline(o,t.dbnam);putline(o,t. +ausknam);putline(o,t.feld);putline(o,t.x);putline(o,t.y);putline(o,t.tab); +putline(o,t.len);putline(o,trtab);tTO o.END PROC transform;PROC transform( +FILE VAR i,TAG VAR t):enablestop;TEXT VAR oldtrtab:=trtab;getline(i,buffer);t +.xmax:=bufferISUB 1;IF t.xmax<>12336THEN t.ymax:=bufferISUB 2;t.xs:=buffer +ISUB 3;t.ys:=bufferISUB 4;t.dbp:=bufferISUB 5;t.ver:=bufferISUB 6;t.durchs:= +bufferISUB 7;t.art:=bufferISUB 8;getline(i,t.darst);getline(i,t.erstel); +getline(i,t.diainfo);getline(i,t.dbnam);getline(i,t.ausknam);getline(i,t.feld +);getline(i,t.x);getline(i,t.y);getline(i,t.tab);getline(i,t.len);getline(i, +trtab);ELSE nil(t);FI ;iTO t;trtab:=oldtrtab;IF t.ver<>1THEN errorstop( +"Datei enth�lt kein TAG")FI .END PROC transform;PROC filetotag(DATASPACE +CONST ei):type(ei,tagtypenr)END PROC filetotag;PROC tagtofile(DATASPACE +CONST ei):IF type(ei)=tagtypenrTHEN type(ei,filetypenr)ELSE errorstop( +"TYPE nicht TAG")FI END PROC tagtofile;PROC efill(TAG VAR ff,TEXT CONST t, +INT CONST elfeld):INT CONST abwo:=1;zumerstenelementarfeld;WHILE +nochgenugtextdaREP fuelleelementarfeld;elementarfeldweiterzaehlen;IF +gehoertzumnaechstenfeldTHEN markiereueberlauf;LEAVE efillFI ;zumelementarfeld +;PER ;gibrestaus.zumerstenelementarfeld:tlen:=LENGTH t;tout:=abwo-1;afeld:=ff +.feldVSUB elfeld;ael:=elfeld;zumelementarfeld.fuelleelementarfeld:cat:= +subtext(t,tout+1,tout+al);replace(ff.formblatt(ay),ax,cat);toutINCR al. +nochgenugtextda:tout+alafeld.gibrestaus:cat:=subtext(t, +tout+1,tlen);replace(ff.formblatt(ay),ax,cat).markiereueberlauf:replace(ff. +formblatt(ay),ax+al-1,"<").END PROC efill;PROC fill(TAG VAR t,TEXT CONST +inhalt,INT CONST feld):setinfo(t.diainfo,feld);INT VAR erstelem:=t.erstel +VSUB feld;IF erstelem>0THEN IF normalCOR NOT closedbitTHEN efill(t,inhalt, +erstelem)FI FI END PROC fill;OP CLEARBY (TAG VAR u,TAG CONST u1):INT VAR i; +FOR iFROM 1UPTO u.ymaxREP u.formblatt(i):=u1.formblatt(i)PER ;END OP CLEARBY +;INT VAR afeld,ax,ay,al,ael,tlen,tout;PROC eput(TAG CONST ff,TEXT CONST t, +INT CONST elfeld):eput(ff,t,elfeld,1)END PROC eput;PROC eput(TAG CONST ff, +TEXT CONST t,INT CONST elfeld,INT CONST abwo):zumerstenelementarfeld;WHILE +nochgenugtextdaREP fuelleelementarfeld;elementarfeldweiterzaehlen;IF +gehoertzumnaechstenfeldTHEN markiereueberlauf;LEAVE eputFI ;zumelementarfeld; +PER ;gibrestaus;REP elementarfeldweiterzaehlen;IF gehoertzumnaechstenfeld +THEN LEAVE eputFI ;zumelementarfeld;gibhintergrundausPER . +zumerstenelementarfeld:tlen:=LENGTH t;tout:=abwo-1;afeld:=ff.feldVSUB elfeld; +ael:=elfeld;positionieren(ff).fuelleelementarfeld:xoutsubtext(t,tout+1,tout+ +al);toutINCR al.nochgenugtextda:tout+alafeld.gibrestaus:xoutsubtext(t,tout+1,tlen);IF tout+al>tlenTHEN +xoutsubtext(grund,ax+tlen-tout,ax+al-1)FI .gibhintergrundaus:xoutsubtext( +grund,ax,ax+al-1).grund:ff.formblatt(ay).markiereueberlauf:IF outputallowed +THEN out("�<")FI ;IF protTHEN screenbs;screenout("<")FI .END PROC eput;PROC +positionieren(TAG CONST ff):al:=ff.lenVSUB ael;ax:=ff.xVSUB ael;ay:=ff.yVSUB +ael;IF protTHEN screencursor(ax,ay)FI ;IF outputallowedTHEN cursor(ax,ay)FI . +END PROC positionieren;PROC cursor(TAG CONST ff,INT CONST feld):ael:=ff. +erstelVSUB feld;positionieren(ff)END PROC cursor;INT PROC length(TAG CONST ff +,INT CONST feld):zumerstenelementarfeld;IF ael<1THEN LEAVE lengthWITH 0FI ; +INT VAR len:=0;REP lenINCR feldlaenge;zumnaechstenelementarfeld;UNTIL +gehoertzumnaechstenfeldPER ;len.zumerstenelementarfeld:ael:=ff.erstelVSUB +feld.zumnaechstenelementarfeld:aelINCR 1.gehoertzumnaechstenfeld:(ff.feld +VSUB ael)<>feld.feldlaenge:ff.lenVSUB ael.END PROC length;PROC show(TAG +CONST ff):INT VAR i;IF protTHEN IF screenreorganizedTHEN FOR iFROM 1UPTO ff. +ymaxREP screencursor(1,i);screenput(ff.formblatt(i))PER ;ELSE FOR iFROM 1 +UPTO ff.ymaxREP IF ff.formblatt(i)>""THEN screencursor(1,i);screenok(FALSE ,i +,i);screenput(ff.formblatt(i))FI PER ;IF outputallowedTHEN reorganizescreen +FI ;LEAVE showFI FI ;IF outputallowedTHEN out(home);out(ff.formblatt(1));FOR +iFROM 2UPTO ff.ymaxREP line;out(ff.formblatt(i))PER FI .END PROC show;INT +VAR charcode:=0,lastx,lasty;PROC translatecode:charcode:=code(char);SELECT +charcodeOF CASE chop:charcode:=chomeCASE cvor:charcode:=cfeldendeCASE crueck: +charcode:=cfeldanfCASE choch:charcode:=cseiterueckCASE crunter:charcode:= +cseitevorCASE ctab:charcode:=csettabCASE ceinf:charcode:=caufbrechCASE causf: +charcode:=cloeschendeCASE cfeldvor:charcode:=cfeldrueckCASE cmark:charcode:= +cneuCASE cesc:charcode:=clearnOTHERWISE charcode:=pos(hoptasten,char);IF +charcode=0THEN IF ischarTHEN FI ELSE char:=hopcodesSUB charcode;charcode:= +code(char)FI END SELECT END PROC translatecode;TEXT VAR char,pseudochar;BOOL +PROC ischar:inchar(char);charcode:=code(char);IF charcode>31THEN TRUE ELIF +charcode=chopTHEN inchar(char);translatecode;charcode>31ELSE FALSE FI END +PROC ischar;INT VAR aktlimit,aktbegin,aktfeld,aktline,aktlen,aktanf,aktel,wo; +PROC setfieldvalues(TAG CONST ta):aktlen:=ta.lenVSUB aktel;aktanf:=ta.xVSUB +aktel;aktline:=ta.yVSUB aktelEND PROC setfieldvalues;INT VAR nextfeld,nextel, +nextwo,nextbegin;PROC setlasteditvalues:preset:=TRUE END PROC +setlasteditvalues;PROC setneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin +;aktel:=nextel;wo:=nextwo;preset:=TRUE END PROC setneweditvalues;BOOL VAR +preset:=FALSE ,feldda;PROC searchfield(TAG CONST t,INT CONST x,y,BOOL VAR +erfolg):erfolg:=FALSE ;nextel:=0;REP sucheelementinrichtigerzeileUNTIL +keinsmehrdaCOR xposstimmtPER ;IF erfolgTHEN nextfeld:=t.feldVSUB nextel; +nextbegin:=1;INT VAR i:=t.erstelVSUB nextfeld;WHILE ix;erfolg.anfang:t.xVSUB nextel. +ende:(t.xVSUB nextel)+(t.lenVSUB nextel).END PROC searchfield;PROC editieren( +TAG CONST ff,TEXT VAR eing,INT CONST feld):IF fieldexists(ff,feld)THEN +bestimmeeinstieg;REPEAT REPEAT wertesteuerzeichenausUNTIL ischarPER ;REPEAT +schreibezeichen;UNTIL wo>aktlimitCOR NOT ischarPER PER FI .bestimmeeinstieg: +IF presetAND (feld=0COR feld=aktfeld)THEN ELSE aktfeld:=feld;aktel:=ff.erstel +VSUB aktfeld;aktbegin:=1;wo:=1FI ;charcode:=centry;preset:=FALSE ;IF NOT +normalTHEN preparespecialeditingFI .preparespecialediting:IF darstbitTHEN +pseudochar:=ff.darstSUB feldFI .schreibezeichen:IF wo<=LENGTH eingTHEN +replace(eing,wo,char)ELSE eingCAT char;IF wo>LENGTH eing+1THEN +normalizepositionFI FI ;IF normalCOR NOT darstbitTHEN out(char)ELSE out( +pseudochar)FI ;woINCR 1.wertesteuerzeichenaus:SELECT charcodeOF CASE cneu: +neuschreibenCASE centry:setfieldvalues(ff);positionieren;aktlimit:=aktbegin+ +aktlen-1CASE cvor:IF wo<=LENGTH eingTHEN woINCR 1;out(right);forwardFI CASE +cfeldende:zumfeldendeCASE crueck:woDECR 1;out(left);backwardCASE cfeldanf:wo +:=1;backwardtoendCASE ceinf:insertchar(eing," ",wo);restneuschreibenCASE +causf:IF LENGTH eing>0THEN IF wo>LENGTH eingTHEN woDECR 1;out(left);backward +FI ;deletechar(eing,wo);restneuschreibenFI ;CASE cloeschende:eing:=subtext( +eing,1,wo-1);restneuschreibenCASE choch:gouporleaveCASE crunter:godownorleave +OTHERWISE :IF charcode>31THEN forwardELSE leaveFI END SELECT .zumfeldende:wo +:=LENGTH eing+1;forward;positionieren.positionieren:cursor(aktanf+(wo- +aktbegin),aktline).forward:WHILE wo>aktlimitREPEAT aktelINCR 1;IF +gehoertzumfeldTHEN aktbegin:=aktlimit+1;decodefieldlen;aktlimitINCR aktlen +ELSE aktelDECR 1;wo:=aktlimitFI ;positionierenPER .leave:getcursor(lastx, +lasty);LEAVE editieren.godownorleave:getcursor(lastx,lasty);searchfield(ff, +lastx,lasty+1,feldda);IF felddaCAND nextfeld=aktfeldTHEN wo:=nextwo;aktel:= +nextel;setfieldvalues(ff);aktbegin:=nextbegin;aktlimit:=aktbegin-1+aktlen; +positionierenELSE LEAVE editierenFI .gouporleave:getcursor(lastx,lasty); +searchfield(ff,lastx,lasty-1,feldda);IF felddaCAND nextfeld=aktfeldTHEN wo:= +nextwo;aktel:=nextel;setfieldvalues(ff);aktbegin:=nextbegin;aktlimit:= +aktbegin-1+aktlen;positionierenELSE LEAVE editierenFI .backward:IF wo< +aktbeginTHEN IF wo<1THEN wo:=1ELSE aktelDECR 1;decodefieldlen;aktlimit:= +aktbegin-1;aktbeginDECR aktlen;FI ;positionierenFI .backwardtoend:aktel:=ff. +erstelVSUB aktfeld;decodefieldlen;aktbegin:=1;aktlimit:=aktlen;positionieren. +normalizeposition:wo:=LENGTH eing;WHILE wo0THEN IF normalCOR +NOT darstbitTHEN eput(ff,v,erstelem)ELSE eput(ff,LENGTH v*(ff.darstSUB feld), +erstelem)FI FI END PROC put;INT PROC leavingcode:charcodeEND PROC leavingcode +;PROC putget(TAG CONST ff,ROW maxfieldsTEXT VAR v,INT VAR einstieg):put(ff,v) +;get(ff,v,einstieg)END PROC putget;PROC put(TAG CONST ff,ROW maxfieldsTEXT +VAR fieldvalues):INT VAR iFOR iFROM 1UPTO LENGTH ff.erstelREP IF fieldexists( +ff,i)THEN put(ff,fieldvalues(i),i)FI PER END PROC put;PROC get(TAG CONST ff, +ROW maxfieldsTEXT VAR fieldvalues,INT VAR feld):INT VAR felder:=LENGTH ff. +erstel;IF NOT fieldexists(ff,feld)THEN errorstop("startfeld nicht im tag") +ELSE WHILE feld<=felderREPEAT get(ff,fieldvalues(feld),feld); +executecommandcode(ff,feld)UNTIL charcode=cescPER FI END PROC get;PROC +executecommandcode(TAG CONST ff,INT VAR feld):SELECT charcodeOF CASE +cfeldrueck:topriorfieldCASE cfeldvor:tonextfieldCASE choch:goupifpossible +CASE crunter:godownifpossibleCASE chome:tohomefieldCASE ctab:IF protTHEN +reorganizescreenFI ;setlasteditvaluesCASE cesc:ausnr:=auskunftsnr(ff,feld) +END SELECT .topriorfield:REPEAT feld:=priorfield(ff,feld)UNTIL warerstesCOR +nichtgesperrtPER ;IF warerstesTHEN tohomefieldFI .tonextfield:INT VAR oldfeld +:=feld;REP feld:=nextfield(ff,feld)UNTIL warletztesCOR nichtgesperrtPER ;IF +warletztesTHEN feld:=oldfeld;IF beimletztenrausfallenTHEN charcode:=cesc; +beimletztenrausfallen:=FALSE FI FI .tohomefield:feld:=firstfield(ff);WHILE +gesperrtREP feld:=nextfield(ff,feld)PER .goupifpossible:BOOL VAR erfolg; +searchfield(ff,lastx,lasty-1,erfolg);IF erfolgAND nextnichtgesperrtTHEN +setneweditvalues;feld:=nextfeldELSE setlasteditvaluesFI .godownifpossible: +searchfield(ff,lastx,lasty+1,erfolg);IF erfolgAND nextnichtgesperrtTHEN +setneweditvalues;feld:=nextfeldELSE setlasteditvaluesFI .nichtgesperrt:(ff. +diainfoVSUB feld)<64.nextnichtgesperrt:(ff.diainfoVSUB nextfeld)<64.gesperrt: +NOT nichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROC +executecommandcode;PROC setautoesc:beimletztenrausfallen:=TRUE END PROC +setautoesc;INT PROC firstfield(TAG CONST t):t.feldVSUB 1END PROC firstfield; +INT PROC nextfield(TAG CONST t,INT CONST feld):INT VAR el:=(t.erstelVSUB feld +)+1;WHILE (t.feldVSUB el)=feldREP elINCR 1PER ;t.feldVSUB elEND PROC +nextfield;INT PROC priorfield(TAG CONST t,INT CONST feld):t.feldVSUB ((t. +erstelVSUB feld)-1)END PROC priorfield;TEXT VAR buffer,blinkan,blinkaus;TEXT +VAR trtab:="!<> ",tr;TAG VAR hilfstag;nil(hilfstag);hilfstag.formblatt( +taglines):=" Feldnummer : __ "; +definefield(hilfstag,code(pos(hilfstag.formblatt(taglines),"_")),code( +taglines),"�",".",0,0,1,"�","�");OP TO (FILE VAR a,TAG VAR t):INT VAR i,j; +TEXT VAR char;t.xmax:=0;FOR jFROM 1UPTO taglinesREP IF NOT eof(a)THEN getline +(a,buffer);transform;IF length(buffer)>t.xmaxTHEN t.xmax:=length(buffer)FI ;t +.ymax:=jELSE tr:=niltext;FI ;t.formblatt(j):=tr;PER .transform:tr:=niltext; +FOR iFROM 1UPTO LENGTH bufferREP char:=bufferSUB i;SELECT pos(trtab,char)OF +CASE 2:trCAT inversCASE 3:trCAT endinversCASE 1:trCAT " "CASE 4:trCAT right +OTHERWISE :trCAT charEND SELECT PER .END OP TO ;OP TO (TAG CONST t,FILE VAR f +):INT VAR i,j;TEXT VAR pseudoblank:=trtabSUB 1,char;FOR jFROM 1UPTO t.ymax +REP buffer:=t.formblatt(j);retransform;putline(f,tr)PER .retransform:tr:= +niltext;FOR iFROM 1UPTO LENGTH bufferREP char:=bufferSUB i;SELECT code(char) +OF CASE 32:trCAT pseudoblankCASE 15:trCAT (trtabSUB 2)CASE 14:trCAT (trtab +SUB 3)CASE cvor:trCAT " "OTHERWISE :trCAT charEND SELECT PER ;buffer:=tr.END +OP TO ;PROC trans(TEXT CONST x):IF LENGTH x=3THEN trtab:=x;trtabCAT " "ELSE +errorstop("falsche Umsetztabelle")FI END PROC trans;TEXT PROC blink(TAG +CONST t,INT VAR feld):blinkan:=length(t,feld)*"#";blinkaus:=LENGTH blinkan* +"!";INT VAR i;FOR iFROM 1UPTO 20REP IF (iMOD 2)=0THEN put(t,blinkan,feld); +ELSE put(t,blinkaus,feld);FI ;buffer:=incharety(3)UNTIL buffer<>""PER ;buffer +END PROC blink;PROC findchar(TAG CONST f,TEXT CONST eingabe,INT VAR posx,posy +):INT VAR posxn:=posx,posyn:=posy;WHILE (f.formblatt(posy)SUB posxn)=eingabe +REP posxnINCR 1PER ;posxn:=pos(f.formblatt(posy),eingabe,posxn+1);WHILE posxn +=0REP posynINCR 1;IF posyn>f.ymaxTHEN LEAVE findcharFI ;posxn:=pos(f. +formblatt(posyn),eingabe)PER ;posx:=posxn;posy:=posyn.END PROC findchar;PROC +designelfield(TAG CONST t,INT CONST xm,ym,INT VAR x,y,l):cursortostartpos; +cursortoendpos.cursortostartpos:TEXT VAR storage:="_";REP cursor(x,y);IF +ischarTHEN findchar(t,char,x,y);storage:=charELSE SELECT charcodeOF CASE +chome:x:=1;y:=1CASE cvor:x:=xMOD xm;xINCR 1CASE crueck:IF x=1THEN x:=xmELSE x +DECR 1FI CASE cfeldanf:x:=1CASE cfeldende:x:=xmCASE choch:IF y=1THEN y:=ym +ELSE yDECR 1FI CASE crunter:y:=yMOD ym;yINCR 1CASE causkunft:cursor(1,24);out +("X=");put(text(x,2));out(" Y=");put(text(y,2))CASE cesc:LEAVE designelfield +CASE ctab:findchar(t,storage,x,y)CASE cfeldvor:LEAVE cursortostartpos +OTHERWISE :out("�")END SELECT FI PER .cursortoendpos:TEXT VAR aktchar:=t. +formblatt(y)SUB x;IF aktchar>" "AND (t.formblatt(y)SUB x-1)<>aktcharTHEN l:=1 +;WHILE (t.formblatt(y)SUB (x+l))=aktcharREP lINCR 1PER ;FI ;markiere;REP +WHILE ischarREP out("�")PER ;IF charcode=cvorAND x+l");out(left);ELIF charcode=crueckAND l>1THEN +originalzeichenausgeben;lDECR 1ELIF charcode=cescTHEN LEAVE designelfield +ELIF charcode=cfeldvorTHEN LEAVE cursortoendposFI PER . +originalzeichenausgeben:out(" �");out(t.formblatt(y)SUB (x+l-1));out("��"). +markiere:cursor(x,y);lTIMESOUT ">";out(left).END PROC designelfield;INT VAR +el;PROC designfield(TAG CONST t,INT CONST feld,TEXT VAR x,y,l,ta):IF NOT +varsinitializedTHEN initializeFI ;REP designelement;elINCR 1PER . +varsinitialized:LENGTH x=LENGTH yAND LENGTH y=LENGTH lAND LENGTH l=LENGTH ta +AND LENGTH x>0.initialize:IF NOT fieldexists(t,feld)THEN x:="";y:="";l:="";ta +:=""ELSE INT VAR begin:=t.erstelVSUB feld,end:=begin;WHILE (t.feldVSUB end)= +feldREP endINCR 1PER ;endDECR 1;x:=subtext(t.x,begin,end);y:=subtext(t.y, +begin,end);l:=subtext(t.len,begin,end);ta:=subtext(t.tab,begin,end);FI ;el:=1 +.designelement:INT VAR xb,yb,lb;cursor(1,24);out(text(el));out( +". Teilfeld ");IF LENGTH xcescCOR no(" �Formulardarstellung veraendern")PER END PROC +design;PROC designform(TAG VAR f):taginitialisieren;formulareditieren. +formulareditieren:DATASPACE VAR wds:=nilspace;FILE VAR in:=sequentialfile( +output,wds);fTO in;modify(in);headline(in,"Formular eingeben !");edit(in); +page;input(in);reset(in);inTO f;forget(wds).taginitialisieren:IF f.ver<>1 +THEN nil(f)FI .END PROC designform;PROC dummie(INT VAR a,b,TEXT VAR c,BOOL +VAR d,e):LEAVE dummie;a:=b;d:=e;c:="";END PROC dummie;PROC designfields(TAG +VAR f):designfields(f,PROC dummie)END PROC designfields;PROC designfields( +TAG VAR f,PROC (INT VAR ,INT VAR ,TEXT VAR ,BOOL VAR ,BOOL VAR )setparam): +show(f);INT VAR feld:=2;TEXT VAR xrow,yrow,lrow,trow;REPEAT +feldnummereinlesen;benutzerwunscherfragen;benutzerwunschauswertenEND REP . +benutzerwunscherfragen:IF fieldexists(f,feld)THEN REP cursor(1,24);out( +"a(endern) ,l(oeschen), i(rrtum) ?");TEXT VAR ein:=blink(f,feld);IF ein="�" +THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("aAäÄlLiI",ein)>0PER ; +ELSE REP cursor(1,24);out(" n(eu einrichten), (i)rrtum ?");inchar(ein); +IF ein="�"THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("nNiI",ein)>0 +PER ;FI ;cursor(1,24);out(" "). +benutzerwunschauswerten:IF pos("lL",ein)>0THEN put(f,"",feld);clearfield(f, +feld)ELSE IF fieldexists(f,feld)THEN put(f,"",feld);FI ;IF pos("iI",ein)=0 +THEN xrow:="";yrow:=" ";lrow:="";trow:="";designfield(f,feld,xrow,yrow,lrow, +trow);parametersetzen;definefield(f,xrow,yrow,lrow,trow,sym,aus,feld,dar,dia) +;feldINCR 1;FI FI .feldnummereinlesen:TEXT VAR itext:=text(feld);REPEAT +cursor(1,24);out("�");out(hilfstag.formblatt(taglines));putget(hilfstag,itext +,1);IF leavingcode=cescTHEN LEAVE designfieldsFI ;feld:=int(itext);IF feld<1 +OR leavingcode=causkunftOR NOT lastconversionokTHEN dialogueELSE LEAVE +feldnummereinlesen;FI ;PER .dialogue:REP cursor(1,24);out( +"q(uit), i(rrtum), m(aske neu zeigen), f(eldnummern) �");inchar(ein);IF ein= +"�"THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("qQiImMfF",ein)>0PER ; +SELECT (pos("qQiImMfF",ein)-1)DIV 2OF CASE 0:LEAVE designfieldsCASE 1:LEAVE +dialogueCASE 2:show(f)CASE 3:INT VAR i;FOR iFROM 1UPTO fields(f)REP TEXT VAR +buf:=text(i);bufCAT "*";put(f,((length(f,i)-1)DIV LENGTH (buf)+1)*buf,i)PER +END SELECT .parametersetzen:INT VAR aus:=auskunftsnr(f,feld),sym:= +symbolicname(f,feld);TEXT VAR dar:=f.darstSUB feld,dia;setinfo(f.diainfo,feld +);BOOL VAR a:=closedbit,b:=protectbit,c:=darstbit;setparam(sym,aus,dar,b,c); +setfieldinfos(f,feld,a,b,c);dia:=f.diainfoSUB feld;dar:=text(dar,1).END PROC +designfields;END PACKET mask;PACKET dateDEFINES monat,jahr,tag,datum,tmj, +datumjh,nildatum,jahrestag,wochentag:LET seperatorzeichen=":./ ", +seperatorzeichen1=".";INT CONST beforefirstday:=-(22*vierjahre)-1;TEXT VAR b; +BOOL VAR conversionerror:=FALSE ;INT PROC nildatum:beforefirstdayEND PROC +nildatum;#L datumslets#LET letzterjanuar=31,letzterfebruar=59,letztermaerz=90 +,letzterapril=120,letztermai=151,letzterjuni=181,letzterjuli=212, +letzteraugust=243,letzterseptember=273,letzteroktober=304,letzternovember=334 +,#letzterdezember=365,#vierjahre=1461;PROC tmj(INT CONST d,INT VAR t,m,j): +INT VAR a;IF d<=beforefirstdayTHEN t:=-1;m:=-1;j:=-1;LEAVE tmjFI ;a:=d;IF a>0 +THEN j:=88ELSE j:=0;aINCR (-(beforefirstday+1))FI ;jINCR 4*(aDIV vierjahre);a +:=aMOD vierjahre;IF a=letzterfebruarTHEN t:=29;m:=2;LEAVE tmjELIF a> +letzterfebruarTHEN aDECR 1FI ;jINCR aDIV 365;a:=(aMOD 365)+1;IF a<= +letzterjuniTHEN januarbisjuniELSE julibisdezemberFI .januarbisjuni:IF a<= +letztermaerzTHEN januarbismaerzELSE aprilbisjuniFI .julibisdezember:IF a<= +letzterseptemberTHEN julibisseptemberELSE oktoberbisdezemberFI . +januarbismaerz:IF a<=letzterjanuarTHEN m:=1;t:=aELIF a<=letzterfebruarTHEN m +:=2;t:=a-letzterjanuarELSE m:=3;t:=a-letzterfebruarFI .aprilbisjuni:IF a<= +letzteraprilTHEN m:=4;t:=a-letztermaerzELIF a<=letztermaiTHEN m:=5;t:=a- +letzteraprilELSE m:=6;t:=a-letztermaiFI .julibisseptember:IF a<=letzterjuli +THEN m:=7;t:=a-letzterjuniELIF a<=letzteraugustTHEN m:=8;t:=a-letzterjuli +ELSE m:=9;t:=a-letzteraugustFI .oktoberbisdezember:IF a<=letzteroktoberTHEN m +:=10;t:=a-letzterseptemberELIF a<=letzternovemberTHEN m:=11;t:=a- +letzteroktoberELSE m:=12;t:=a-letzternovemberFI .END PROC tmj;INT PROC datum( +TEXT CONST a):b:=a;conversionerror:=FALSE ;INT VAR seperator:=seppos,t,m,j; +IF seperator=0THEN IF length(b)=6THEN t:=z(1)*10+z(2);m:=z(3)*10+z(4);j:=z(5) +*10+z(6);INT VAR dummy:=datum(t,m,j);IF conversionerrorTHEN dummy:=nildatum +FI ;LEAVE datumWITH dummyELSE leaveFI ELIF seperator=2THEN t:=z(1);ELIF +seperator=3THEN t:=10*z(1)+z(2);ELSE leaveFI ;b:=subtext(b,seperator+1); +seperator:=seppos;IF seperator=3THEN m:=z(1)*10+z(2);ELIF seperator=2THEN m:= +z(1)ELSE leaveFI ;b:=subtext(b,seperator+1);IF length(b)=2THEN j:=z(1)*10+z(2 +)ELIF length(b)=4THEN j:=z(1)*1000+z(2)*100+z(3)*10+z(4)-1900;ELSE leaveFI ; +IF conversionerrorTHEN nildatumELSE datum(t,m,j)FI .leave:LEAVE datumWITH +nildatum.seppos:INT VAR q;FOR qFROM 2UPTO 3REP IF pos(seperatorzeichen,bSUB q +)>0THEN LEAVE sepposWITH q;FI PER ;0.END PROC datum;INT PROC z(INT CONST wo): +INT VAR e:=code(bSUB wo)-48;IF e<0OR e>9THEN conversionerror:=TRUE ;0ELSE e +FI END PROC z;INT PROC datum(INT CONST t,m,jc):INT VAR j:=jc-1900IF j<0THEN j +INCR 1900FI ;IF (j+160)DIV 160<>1THEN nildatumELIF t<0THEN nildatumELSE +SELECT mOF CASE 1,3,5,7,8,10,12:IF t>31THEN nildatumELSE erg(t,m,j)FI CASE 4, +6,9,11:IF t>30THEN nildatumELSE erg(t,m,j)FI CASE 2:IF t<29THEN erg(t,m,j) +ELIF t=29AND jMOD 4=0THEN erg(t,m,j)ELSE nildatumFI OTHERWISE nildatumEND +SELECT FI END PROC datum;INT PROC wochentag(INT CONST d):INT CONST x:=d-1;IF +x<0THEN 6-(-xMOD 7)ELSE xMOD 7FI END PROC wochentag;INT PROC jahrestag(INT +CONST d):INT VAR a;IF d<=beforefirstdayTHEN LEAVE jahrestagWITH -1FI ;a:=d; +IF a<=0THEN aINCR (-(beforefirstday+1))FI ;a:=aMOD vierjahre;IF a>365THEN a +DECR 366;a:=aMOD 365FI ;a+1END PROC jahrestag;INT PROC erg(INT CONST t,m,jc): +INT VAR j:=jc;INT VAR result:=beforefirstday,tagimzyklus;IF j>=88THEN jDECR +88;result:=-1FI ;resultINCR ((jDIV 4)*vierjahre);j:=jMOD 4;tagimzyklus:= +tagundmonat+365*j;IF tagimzyklus>erstermaerzimschaltjahrTHEN tagimzyklusINCR +1ELIF tagimzyklus=erstermaerzimschaltjahrAND m=3THEN tagimzyklusINCR 1FI ; +result+tagimzyklus.erstermaerzimschaltjahr:60.tagundmonat:SELECT mOF CASE 1:t +CASE 2:t+letzterjanuarCASE 3:t+letzterfebruarCASE 4:t+letztermaerzCASE 5:t+ +letzteraprilCASE 6:t+letztermaiCASE 7:t+letzterjuniCASE 8:t+letzterjuliCASE 9 +:t+letzteraugustCASE 10:t+letzterseptemberCASE 11:t+letzteroktoberCASE 12:t+ +letzternovemberOTHERWISE errorstop("monat > 12 oder < 0");0END SELECT .END +PROC erg;INT PROC tag(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);tEND PROC tag; +INT PROC jahr(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);j+1900END PROC jahr; +INT PROC monat(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);mEND PROC monat;TEXT +PROC datumjh(INT CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j);IF t<0THEN +LEAVE datumjhWITH ""FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);eCAT +seperatorzeichen1;eCAT code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT +seperatorzeichen1;IF j<100THEN eCAT "19"ELSE eCAT "20";jDECR 100FI ;eCAT code +(jDIV 10+48);eCAT code(jMOD 10+48);eEND PROC datumjh;TEXT PROC datum(INT +CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j);IF t<0THEN LEAVE datumWITH "" +FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);eCAT seperatorzeichen1;eCAT +code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT seperatorzeichen1;eCAT code((j +MOD 100)DIV 10+48);eCAT code(jMOD 10+48);eEND PROC datum;END PACKET date; + diff --git a/app/baisy/2.2.1-schulis/src/isp.maskendesign b/app/baisy/2.2.1-schulis/src/isp.maskendesign new file mode 100644 index 0000000..a90acca --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.maskendesign @@ -0,0 +1,302 @@ +PACKET maskendesignDEFINES maskstart,aktuellendesignnamenlesen,maskgenstart, +holestandardvorgaben,maskenattributespeichern,einlesenderattribute, +generieremaske,zeigegeneriertemaske,formularentwerfen,formularspeichern, +felderentwerfen,felddefinitionenspeichern,maskenformularzeigen, +definitionsnamenlesen,gesuchtesfeldanzeigen,feldloeschen,feldspeichern, +feldnichtspeichern,feldmalen,feldaufneuenschirmmalen,feldattributesetzen, +holeattribute,listeallermasken,loescheneinermaske,kopierenaendern, +zweitennamenlesen,kopiereneinermaske,druckeneinermaske,neuernamefuereinemaske +:LET standardanfang=2;LET z="Liste aller Masken";LET nummernmaske= +"mb maskenfeldnummern",id="mb maskenbearbeitung1",zusatz= +"mb maskenbearbeitung2",mgmatrix="mb maskgenmatrix",mg="mb maskengenerator", +b1="mb maskenfeldattribute";LET dru=49;LET maxfeldnr=200;LET praefixs= +"Formular für: ",praefixf="form.";TEXT VAR symbalphag:="#",symbalphau:="&", +symbankreuz:="^",symbgeheim:="'",symbmeldung:="%",symbfortsetzunga:="<", +symbfortsetzunge:=">",symbpseudoblank:="!",unterlegungalpha:="_", +unterlegungankreuz:="_",unterlegunggeheim:="_",unterlegungmeldung:="=", +anzeigeankreuz:="x",anzeigegeheim:="-";TEXT VAR symbolischemaske:="";TEXT +VAR formulardatei:="";TEXT VAR maskenname:="",zweitername:="";INT VAR +feldname:=standardanfang,loeschfeld;BOOL VAR da;#DBMASKE VAR dbm;nil(dbm);# +TEXT VAR eingangsname;TAG VAR maske;;TAG VAR aktuellemaske;INT VAR +aktuelleposition;TEXT VAR logtextergaenzung;PROC maskstart: +frageentwicklernachmaskennamen(id);aktuellendesignnamenlesenEND PROC +maskstart;PROC frageentwicklernachmaskennamen(TEXT CONST start):eingangsname +:=start;standardstartproc(start)END PROC frageentwicklernachmaskennamen;PROC +aktuellendesignnamenlesen:standardmaskenfeld(maskenname,2);standardnproc; +maskenname:=standardmaskenfeld(2);init(feld)END PROC +aktuellendesignnamenlesen;PROC maskgenstart:zeigemaske;holestandardvorgaben;. +zeigemaske:frageentwicklernachmaskennamen(mg).END PROC maskgenstart;PROC +holestandardvorgaben:standardmaskenfeld("",1);standardmaskenfeld(maskenname,2 +);standardmaskenfeld(unterlegungalpha,3);standardmaskenfeld(symbalphag,4); +standardmaskenfeld(symbalphau,5);standardmaskenfeld(symbankreuz,6); +standardmaskenfeld(unterlegungankreuz,7);standardmaskenfeld(anzeigeankreuz,8) +;standardmaskenfeld(symbgeheim,9);standardmaskenfeld(unterlegunggeheim,10); +standardmaskenfeld(anzeigegeheim,11);standardmaskenfeld(symbmeldung,12); +standardmaskenfeld(unterlegungmeldung,13);standardmaskenfeld(symbfortsetzunga +,14);standardmaskenfeld(symbfortsetzunge,15);standardmaskenfeld( +symbpseudoblank,16);standardnproc;maskenname:=standardmaskenfeld(2); +unterlegungalpha:=standardmaskenfeld(3);symbalphag:=standardmaskenfeld(4); +symbalphau:=standardmaskenfeld(5);symbankreuz:=standardmaskenfeld(6); +unterlegungankreuz:=standardmaskenfeld(7);anzeigeankreuz:=standardmaskenfeld( +8);symbgeheim:=standardmaskenfeld(9);unterlegunggeheim:=standardmaskenfeld(10 +);anzeigegeheim:=standardmaskenfeld(11);symbmeldung:=standardmaskenfeld(12); +unterlegungmeldung:=standardmaskenfeld(13);symbfortsetzunga:= +standardmaskenfeld(14);symbfortsetzunge:=standardmaskenfeld(15); +symbpseudoblank:=standardmaskenfeld(16);trans(symbpseudoblank+ +symbfortsetzunga+symbfortsetzunge);.END PROC holestandardvorgaben;PROC +formularentwerfen(INT CONST nummerderauskunft):IF maskenname=""THEN +keineeingabe;return(1)ELSE setzedateinamen;IF NOT exists(symbolischemaske) +THEN IF NOT maskedaTHEN logtextergaenzung:="eingefügt";neuELSE +logtextergaenzung:="geändert";aendernFI ;FI ;formularzeigen(nummerderauskunft +)FI .keineeingabe:aktuelleposition:=standardanfang;standardmeldung(26,""). +setzedateinamen:symbolischemaske:=praefixs+maskenname;formulardatei:=praefixf ++maskenname.maskeda:maskegibtes(maskenname).neu:init(feld); +erzeugeleeresymbolischemaske(maskenname).aendern:erzeugesymbolischemaske( +maskenname).END PROC formularentwerfen;PROC formularzeigen(INT CONST +nummerderauskunft):page;sagderauskunftwasaufdemeingangsschirmstand;editiere( +symbolischemaske,"a",FALSE ).sagderauskunftwasaufdemeingangsschirmstand:TEXT +VAR eingangsinfo:="";eingangsinfoCAT infozeile("geschützt",symbalphag); +eingangsinfoCAT infozeile("ungeschützt",symbalphau);eingangsinfoCAT infozeile +("Ankreuzfeld",symbankreuz);eingangsinfoCAT infozeile("sonst. Geheimfeld", +symbgeheim);eingangsinfoCAT infozeile("Meldungsfeld",symbmeldung); +eingangsinfoCAT infozeile("Beginn Fortsetzung",symbfortsetzunga);eingangsinfo +CAT infozeile("Ende Fortsetzung",symbfortsetzunge);eingangsinfoCAT infozeile( +"Überdeckungszeichen",symbpseudoblank);eingangsinfoCAT auskunftstextende; +ergaenzeauskunft(eingangsinfo,nummerderauskunft).END PROC formularzeigen; +PROC generieremaske:erzeugemaske(maskenname);page;show(maske); +zeigegeneriertemaskeEND PROC generieremaske;PROC zeigegeneriertemaske:INT +VAR feldind,maxfeld:=min(fields(maske),maxfeldnr);ROW maxfeldnrTEXT VAR +maskenfeld;INT VAR einstieg:=maxfeldnr;FOR feldindFROM 1UPTO maxfeldREP IF +fieldexists(maske,feldind)THEN maskenfeld(feldind):="";put(maske,"",feldind); +cursor(maske,feldind);out(text(feldind));IF (NOT protected(maske,feldind)) +CAND (feldindmaxfeld +THEN einstieg:=standardanfangFI ;get(maske,maskenfeld,einstieg)END PROC +zeigegeneriertemaske;ROW maxfeldnrTEXT VAR feld;INT VAR maxfeld;PROC +maskenattributesetzen:maskenholen;formularzeigen;attributezeigen; +einlesenderattribute.maskenholen:initmaske(aktuellemaske,mgmatrix). +formularzeigen:page;standardkopfmaskeausgeben(text(vergleichsknoten));show( +aktuellemaske).attributezeigen:INT VAR i;INT VAR maxfields:=fields( +aktuellemaske);feld(1):="";TEXT VAR hellername:=""+maskenname+" ";feld(2):= +hellername+(length(aktuellemaske,2)-length(hellername))*" ";INT VAR zaehler:= +3;FOR iFROM 2UPTO min(fields(maske),maxfeldnr-1)REP IF (fieldexists(maske,i)) +THEN IF feld(zaehler)=""THEN feld(zaehler):=text(i,3)+text(auskunftsnr(maske, +i),5)+text(symbolicname(maske,i),3)FI ;zaehlerINCR 1FI PER ;FOR iFROM 1UPTO +zaehler-1REP IF fieldexists(aktuellemaske,i)THEN put(aktuellemaske,feld(i),i) +FI PER ;FOR iFROM zaehlerUPTO maxfieldsREP protect(aktuellemaske,i,TRUE )PER +;maxfeld:=zaehler-1;aktuelleposition:=3.END PROC maskenattributesetzen;PROC +einlesenderattribute:get(aktuellemaske,feld,aktuelleposition)END PROC +einlesenderattribute;PROC maskenattributespeichern:INT VAR i;IF NOT +maskengeneratorTHEN gibtestag;IF NOT daTHEN meldezuerstformular;LEAVE +maskenattributespeichernFI ;FOR iFROM 1UPTO maxfeldnrREP feld(i):=""PER ;FI ; +maskenattributesetzen;FOR iFROM 3UPTO maxfeldREP INT VAR feldnr:=int(subtext( +feld(i),1,3));auskunftsnr(maske,feldnr,int(subtext(feld(i),4,8))); +symbolicname(maske,feldnr,int(subtext(feld(i),9,11)))PER .maskengenerator: +eingangsname=mg.meldezuerstformular:standardmeldung(32,"");return(1).END +PROC maskenattributespeichern;PROC formularspeichern(INT CONST zurueck): +schreibemaske(maske,maskenname);logbucheintrag(logtextergaenzung);IF exists( +formulardatei)THEN forget(formulardatei,quiet)FI ;return(zurueck); +frageentwicklernachmaskennamen(eingangsname);meldespeicherung. +meldespeicherung:standardmeldung(27,"").END PROC formularspeichern;PROC +felderentwerfen:gibtestag;IF daTHEN initialisiereELSE meldezuerstformularFI . +initialisiere:feldname:=standardanfang;maskenformularzeigen; +definitionsnamenlesen.meldezuerstformular:standardmeldung(32,"");return(1). +END PROC felderentwerfen;PROC gibtestag:initmaske(maske,maskenname);da:= +maskegibtes(maskenname)END PROC gibtestag;PROC felddefinitionenspeichern: +schreibemaske(maske,maskenname);return(2);frageentwicklernachmaskennamen(id); +meldespeicherung;.meldespeicherung:standardmeldung(28,"").END PROC +felddefinitionenspeichern;PROC maskenformularzeigen: +maskezuderfelderstelltwerdensollzeigen;entwicklernachfeldnamenfragen. +maskezuderfelderstelltwerdensollzeigen:page;show(maske).END PROC +maskenformularzeigen;PROC entwicklernachfeldnamenfragen:aktuelleposition:= +standardanfang;initmaske(aktuellemaske,nummernmaske);show(aktuellemaske).END +PROC entwicklernachfeldnamenfragen;PROC definitionsnamenlesen:TEXT VAR f:= +text(feldname);ROW maxfeldnrTEXT VAR feld;init(feld);feld(2):=f;loeschfeld:= +feldname;putget(aktuellemaske,feld,aktuelleposition);feldname:=int(feld( +aktuelleposition));loeschemeldung(aktuellemaske);END PROC +definitionsnamenlesen;PROC gesuchtesfeldanzeigen:IF NOT fieldexists(maske, +feldname)THEN meldefalschenummer;loeschenELSE TEXT CONST pointer:=(length( +maske,feldname))*"?";loeschen;put(maske,pointer,feldname);meldegesuchtesfeld +FI ;return(1).meldegesuchtesfeld:melde(aktuellemaske,10).loeschen:put(maske, +"",loeschfeld).END PROC gesuchtesfeldanzeigen;PROC meldefalschenummer:melde( +aktuellemaske,9).END PROC meldefalschenummer;LET null="�";TEXT VAR xrow,yrow, +lrow,trow;BOOL VAR a,b,c,d,e;INT VAR sym,aus;TEXT VAR geheimzeichen;PROC +feldloeschen:INT VAR x,y;IF fieldexists(maske,feldname)THEN clearfield(maske, +feldname);put(maske,"",loeschfeld);getcursor(x,y);cursor(1,y);out(formline( +maske,y));melde(aktuellemaske,42)ELSE meldefalschenummerFI ;return(1)END +PROC feldloeschen;PROC feldmalen:xrow:="";yrow:=" ";lrow:="";trow:="";IF +menuedraussenTHEN reorganizescreenFI ;designfield(maske,feldname,xrow,yrow, +lrow,trow)END PROC feldmalen;PROC feldaufneuenschirmmalen:reorganizescreen; +designfield(maske,feldname,xrow,yrow,lrow,trow)END PROC +feldaufneuenschirmmalen;PROC feldattributesetzen:INT VAR gz;fieldinfos(maske, +feldname,gz,a,b,c,d,e);geheimzeichen:=code(gz);baisymaskeholen;sym:= +symbolicname(maske,feldname);aus:=auskunftsnr(maske,feldname);show( +aktuellemaske);holeattribute;END PROC feldattributesetzen;PROC +baisymaskeholen:initmaske(aktuellemaske,b1)END PROC baisymaskeholen;PROC +holeattribute:ROW maxfeldnrTEXT VAR feld;init(feld);IF bTHEN feld(2):="X"FI ; +IF cTHEN feld(3):=geheimzeichenFI ;feld(4):=text(sym);putget(aktuellemaske, +feld,aktuelleposition);b:=feld(2)<>"";c:=feld(3)<>"";geheimzeichen:=feld(3); +sym:=int(feld(4))END PROC holeattribute;PROC feldspeichern:definefield(maske, +xrow,yrow,lrow,trow,sym,aus,feldname,geheimzeichen,null);setfieldinfos(maske, +feldname,a,b,c);maskenformularzeigen;meldevorlaeufiguebernommen;return(3). +meldevorlaeufiguebernommen:melde(aktuellemaske,41).END PROC feldspeichern; +PROC feldnichtspeichern(INT CONST schritte):maskenformularzeigen;return( +schritte)END PROC feldnichtspeichern;PROC listeallermasken: +meldezusammenstellung;listen.listen:listezusammenstellen;zeigendermaskenliste +.meldezusammenstellung:store(FALSE );standardmeldung(7,"");store(TRUE ). +listezusammenstellen:maskenliste(z).END PROC listeallermasken;PROC +zeigendermaskenliste:page;editiere(z)END PROC zeigendermaskenliste;PROC +loescheneinermaske:IF maskenname=""THEN keineeingabe;return(1)ELSE IF +maskegibtes(maskenname)THEN loeschemaske(maskenname);logbucheintrag( +"gelöscht");meldeloeschungELSE maskegibtesnichtFI ;return(1)FI . +maskegibtesnicht:standardmeldung(8,"").meldeloeschung:standardmeldung(33,""). +keineeingabe:standardmeldung(26,"").END PROC loescheneinermaske;PROC +kopierenaendern:maskekopierenoderaendern;IF NOT daTHEN maskegibtesnichtFI . +maskegibtesnicht:standardmeldung(8,"");return(1).END PROC kopierenaendern; +PROC maskekopierenoderaendern:IF NOT maskegibtes(maskenname)THEN da:=FALSE +ELSE da:=TRUE ;frageentwicklernachmaske;zweitennamenlesenFI . +frageentwicklernachmaske:aktuelleposition:=standardanfang;initmaske( +aktuellemaske,zusatz);zweitername:="";show(aktuellemaske).END PROC +maskekopierenoderaendern;PROC zweitennamenlesen:ROW maxfeldnrTEXT VAR feld; +init(feld);feld(2):=zweitername;putget(aktuellemaske,feld,aktuelleposition); +zweitername:=feld(2);loeschemeldung(aktuellemaske).END PROC zweitennamenlesen +;PROC kopiereneinermaske:IF maskegibtes(zweitername)THEN da:=TRUE ;return(1) +ELSE maskekopieren(maskenname,zweitername);da:=FALSE FI ;IF daTHEN gibtsschon +ELSE return(2);frageentwicklernachmaskennamen(id);meldekopierungFI . +gibtsschon:melde(aktuellemaske,31).meldekopierung:melde(aktuellemaske,29). +END PROC kopiereneinermaske;PROC neuernamefuereinemaske:IF maskegibtes( +zweitername)THEN da:=TRUE ;return(1)ELSE maskeumbenennen(maskenname, +zweitername);da:=FALSE ;FI ;IF daTHEN gibtsschonELSE return(2); +frageentwicklernachmaskennamen(id);meldeumbenennungFI .gibtsschon:melde( +aktuellemaske,31).meldeumbenennung:melde(aktuellemaske,30).END PROC +neuernamefuereinemaske;PROC druckeneinermaske:BOOL VAR maskeda;TAG VAR t;IF +maskenname=""THEN keineeingabe;return(1)ELSE maskeda:=maskegibtes(t, +maskenname);IF maskedaTHEN meldedrucken;fuehredurchELSE maskegibtesnichtFI ; +return(1)FI .maskegibtesnicht:standardmeldung(8,"").keineeingabe: +standardmeldung(26,"").meldedrucken:standardmeldung(dru,"").fuehredurch: +kopfindatei;formularindatei;feldinformationenindatei;drucken.kopfindatei:LET +temp="temporäre Druckdatei";FILE VAR f:=sequentialfile(output,temp);putline(f +,"Name der Maske: "+maskenname);putline(f,"Stand: "+date+" "+ +timeofday);line(f,2).drucken:print(temp);forget(temp,quiet).formularindatei: +INT VAR fz:=min(fields(t),maxfeldnr);IF fz>0THEN INT VAR i;FOR iFROM 1UPTO fz +REP IF fieldexists(t,i)THEN fill(t,text(i),i)FI PER FI ;tTO f. +feldinformationenindatei:line(f,2);IF fz>0THEN ueberschrift;FOR iFROM 1UPTO +fzREP IF fieldexists(t,i)THEN tabellenzeileFI PER FI .ueberschrift:putline(f, +"Nr...Länge...geschützt....geheim.....Symbol.....Auskunftsnr...."). +tabellenzeile:INT VAR gz;BOOL VAR a,b,c,d,e;fieldinfos(t,i,gz,a,b,c,d,e); +TEXT VAR geheim:=code(gz);INT VAR sym:=0,aus:=0;sym:=symbolicname(t,i);aus:= +auskunftsnr(t,i);put(f,text(text(i),4));put(f,text(text(length(t,i)),7));IF b +THEN put(f,text("X",13))ELSE put(f,13*" ")FI ;IF cTHEN put(f,text(geheim,11)) +ELSE put(f,11*" ")FI ;IF sym<>0THEN put(f,text(text(sym),10))ELSE put(f,10* +" ")FI ;IF aus<>0THEN put(f,text(aus))FI ;line(f,1).END PROC +druckeneinermaske;PROC schreibemaske(TAG VAR ta,TEXT CONST t):setzemaske(ta); +maskespeichern(t)END PROC schreibemaske;PROC loeschemaske(TEXT CONST t): +maskeloeschen(t)END PROC loeschemaske;BOOL PROC maskegibtes(TAG VAR t,TEXT +CONST name):initmaske(t,name);maskegibtes(name)END PROC maskegibtes;PROC +erzeugeleeresymbolischemaske(TEXT CONST maskenname):oeffneausgabedatei; +schreibemarkierungenindatei.oeffneausgabedatei:TEXT CONST dateiname:=praefixs ++maskenname;forget(dateiname,quiet);FILE VAR f:=sequentialfile(output, +dateiname).schreibemarkierungenindatei:dreileerzeilen;grundlinie; +vieleleerzeilen;endlinie.dreileerzeilen:INT VAR i;FOR iFROM 1UPTO 3REP +putline(f,"")PER .grundlinie:putline(f,78*unterlegungmeldung).vieleleerzeilen +:FOR iFROM 1UPTO 18REP putline(f,"")PER .endlinie:putline(f,3* +unterlegungmeldung+72*symbmeldung+3*unterlegungmeldung).END PROC +erzeugeleeresymbolischemaske;PROC erzeugesymbolischemaske(TEXT CONST +maskenname):holeformular;oeffneausgabedatei;setzesymbole; +zeigesymbolischemaske.holeformular:INT VAR i;INT CONST maxmaskenfeld:= +maxfeldnr-1;initmaske(maske,maskenname);FOR iFROM 2UPTO maxmaskenfeldREP IF +fieldexists(maske,i)THEN feld(i+1):=text(i,3)+text(auskunftsnr(maske,i),5)+ +text(symbolicname(maske,i),3)ELSE feld(i+1):=""FI PER .oeffneausgabedatei: +TEXT CONST dateiname:=praefixs+maskenname;forget(dateiname,quiet);FILE VAR f +:=sequentialfile(output,dateiname).zeigesymbolischemaske:maskeTO f. +setzesymbole:erstesfeld;REP symbolisierefeld;naechstesfeldUNTIL letztesfeld +PER ;abschluss.erstesfeld:INT VAR aktfeld:=firstfield(maske),zeilennr:=1;INT +VAR altesfeld:=aktfeld;INT VAR zeilenpointer:=1.naechstesfeld:altesfeld:= +aktfeld;aktfeld:=nextfield(maske,aktfeld).letztesfeld:aktfeld<0. +symbolisierefeld:setzezeile;pruefeobfortsetzung;uebernehmenbiszudiesemfeld; +holeinformationenueberdasfeld;fuelledasfeldmitdensymbolen. +fuelledasfeldmitdensymbolen:TEXT VAR alteszeichen;IF aktfeld=1THEN fill(maske +,length(maske,1)*symbmeldung,aktfeld);alteszeichen:=symbmeldungELSE IF +geschuetztTHEN fill(maske,laenge*symbalphag,aktfeld);alteszeichen:=symbalphag +ELSE IF geheimTHEN IF laenge=1THEN IF code(gz)=anzeigeankreuzTHEN fill(maske, +symbankreuz,aktfeld);alteszeichen:=symbankreuzELSE fill(maske,symbgeheim, +aktfeld);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbgeheim,aktfeld +);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbalphau,aktfeld); +alteszeichen:=symbalphauFI FI FI .holeinformationenueberdasfeld:INT VAR gz,x, +y,laenge:=length(maske,aktfeld);BOOL VAR a,geschuetzt,geheim,d,e;fieldinfos( +maske,aktfeld,gz,a,geschuetzt,geheim,d,e);.setzezeile:woliegtdasfeld; +allevorhergehendenzeilen.woliegtdasfeld:cursor(maske,aktfeld);getcursor(x,y). +allevorhergehendenzeilen:IF y>zeilennrTHEN INT VAR xalt:=x;x:=length(formline +(maske,zeilennr))+1;pruefeobfortsetzung;uebernehmenbiszudiesemfeld;x:=xalt; +zeilenpointer:=1;zeileaktualisierenFI .zeileaktualisieren:zeilennr:=y;. +abschluss:y:=ysize(maske)+1;allevorhergehendenzeilen.schoneinfeldinderzeile: +zeilenpointer<>1.pruefeobfortsetzung:BOOL VAR fortsetzung:= +schoneinfeldinderzeileCAND (pos(subtext(formline(maske,zeilennr), +zeilenpointer,x-1),alteszeichen,laenge+1)>0).uebernehmenbiszudiesemfeld:IF +fortsetzungTHEN fill(maske,symbfortsetzunga+((length(maske,altesfeld)-2)* +alteszeichen)+symbfortsetzunge,altesfeld)FI ;zeilenpointer:=x.END PROC +erzeugesymbolischemaske;PROC feldanfang(INT VAR fa,TEXT CONST zeile):INT +CONST zeilenlaenge:=length(zeile);WHILE NOT issymbol(subtext(zeile,fa,fa)) +REP faINCR 1UNTIL NOT inzeilePER .inzeile:NOT (fa>zeilenlaenge).END PROC +feldanfang;BOOL PROC issymbol(TEXT CONST s):TEXT VAR symb:=s;symbol(symb); +symb<>""END PROC issymbol;PROC symbol(TEXT VAR s):IF NOT ((s=symbalphag)OR (s +=symbalphau)OR (s=symbankreuz)OR (s=symbgeheim)OR (s=symbmeldung)OR (s= +symbfortsetzunga)OR (s=symbfortsetzunge))THEN s:=""FI END PROC symbol;PROC +felddefinition(INT VAR fa,TEXT VAR zeile,INT VAR feldnr,INT CONST znr):IF +feldmitteilfeldernTHEN teilfelderELSE einfachesfeldFI ;setzefeld. +feldmitteilfeldern:subtext(zeile,fa,fa)=symbfortsetzunga.teilfelder: +geschuetzt:=FALSE ;geheim:=FALSE ;xkoord:="";ykoord:="";laengen:=""; +geheimzeichen:=code(0);TEXT VAR gesamtunterlegung:=unterlegungalpha;BOOL VAR +gesamtgeschuetzt:=TRUE ,gesamtgeheim:=FALSE ;teilfeldbearbeitung;unterlegung +:=gesamtunterlegung;geschuetzt:=gesamtgeschuetzt;geheim:=gesamtgeheim. +teilfeldbearbeitung:REP efeld(zeile,fa,unterlegung,xkoord,ykoord,laengen, +geschuetzt,geheim,geheimzeichen,znr);IF (unterlegung=symbfortsetzunge)COR ( +unterlegung="")THEN LEAVE teilfeldbearbeitungELIF unterlegung<>""THEN +gesamtunterlegung:=unterlegung;gesamtgeschuetzt:=geschuetzt;gesamtgeheim:= +geheimFI ;faINCR 1;feldanfang(fa,zeile);PER .einfachesfeld:TEXT VAR +unterlegung;BOOL VAR geschuetzt:=FALSE ,geheim:=FALSE ;TEXT VAR xkoord:="", +ykoord:="",laengen:="",geheimzeichen:=code(0);efeld(zeile,fa,unterlegung, +xkoord,ykoord,laengen,geschuetzt,geheim,geheimzeichen,znr);.setzefeld:INT +VAR fnr;IF meldungsfeldTHEN fnr:=1;geschuetzt:=TRUE ELSE fnr:=feldnr;feldnr +INCR 1FI ;definefield(maske,xkoord,ykoord,laengen,code(0),0,0,fnr, +geheimzeichen,code(0));setfieldinfos(maske,fnr,FALSE ,geschuetzt,geheim); +ersetzedurchunterlegung(zeile,xkoord,laengen,unterlegung).meldungsfeld: +subtext(zeile,fa,fa)=symbmeldung.END PROC felddefinition;PROC +ersetzedurchunterlegung(TEXT VAR zeile,TEXT CONST xkoord,laengen,unterlegung) +:INT VAR eintragszahl:=length(xkoord),ind;FOR indFROM 1UPTO eintragszahlREP +ersetzungPER .ersetzung:INT VAR fstart,flaenge;fstart:=code(subtext(xkoord, +ind,ind));flaenge:=code(subtext(laengen,ind,ind));replace(zeile,fstart, +flaenge*unterlegung);.END PROC ersetzedurchunterlegung;PROC efeld(TEXT CONST +zeile,INT VAR fa,TEXT VAR unterlegung,xkoord,ykoord,laengen,BOOL VAR +geschuetzt,geheim,TEXT VAR geheimzeichen,INT CONST znr):INT VAR poszeile:=fa; +IF issymbol(subtext(zeile,poszeile,poszeile))THEN WHILE issymbol(subtext( +zeile,poszeile+1,poszeile+1))REP poszeileINCR 1PER ;xkoordCAT code(fa);ykoord +CAT code(znr);laengenCAT code(poszeile-fa+1);fa:=poszeile;FI ;TEXT CONST s:= +subtext(zeile,fa,fa);IF s=symbalphagTHEN geschuetzt:=TRUE ;unterlegung:= +unterlegungalphaELIF s=symbalphauTHEN geschuetzt:=FALSE ;unterlegung:= +unterlegungalphaELIF s=symbankreuzTHEN geheim:=TRUE ;unterlegung:= +unterlegungankreuz;geheimzeichen:=anzeigeankreuzELIF s=symbgeheimTHEN geheim +:=TRUE ;unterlegung:=unterlegunggeheim;geheimzeichen:=anzeigegeheimELIF s= +symbmeldungTHEN unterlegung:=unterlegungmeldungELIF s=symbfortsetzungeTHEN +unterlegung:=symbfortsetzungeELSE unterlegung:=""FI END PROC efeld;PROC +erzeugemaske(TEXT CONST maskenname):oeffnedatei; +generieremaskeausformulardatei;uebertrageformular;.oeffnedatei:forget( +formulardatei,quiet);copy(symbolischemaske,formulardatei);FILE VAR datei:= +sequentialfile(modify,formulardatei).uebertrageformular:input(datei);dateiTO +maske;forget(formulardatei,quiet).generieremaskeausformulardatei: +holeerstezeile;REP generierefelderdieserzeile;schreibeformularzeile; +holenaechstezeileUNTIL dateiendePER .holeerstezeile:ananfang;lesezeile. +holenaechstezeile:einsweiter;lesezeile.dateiende:eof(datei).einsweiter:down( +datei,1).ananfang:nil(maske);TEXT VAR zeile:="";toline(datei,1);INT VAR +feldnr:=2.lesezeile:readrecord(datei,zeile).schreibeformularzeile:writerecord +(datei,zeile).generierefelderdieserzeile:startezeile;REP +findefeldspezifikation;definierenaechstesfeldPER .startezeile:INT VAR fa:=1. +findefeldspezifikation:feldanfang(fa,zeile);IF fa>length(zeile)THEN LEAVE +generierefelderdieserzeileFI ;.definierenaechstesfeld:felddefinition(fa,zeile +,feldnr,lineno(datei));faINCR 1.END PROC erzeugemaske;TEXT PROC infozeile( +TEXT CONST t,s):auskunftstextende+t+" = "+sEND PROC infozeile;PROC init(ROW +maxfeldnrTEXT VAR feld):INT VAR i;FOR iFROM 1UPTO maxfeldnrREP feld(i):="" +PER END PROC init;PROC logbucheintrag(TEXT CONST logergaenzung):TEXT VAR +eintrag:="Maske ";eintragCAT maskenname;eintragCAT " ";eintragCAT +logergaenzung;logeintrag(eintrag)END PROC logbucheintrag;END PACKET +maskendesign + diff --git a/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen b/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen new file mode 100644 index 0000000..1e65ec3 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen @@ -0,0 +1,64 @@ +PACKET ispmeldungsfunktionenDEFINES melde,meldeauffaellig,loeschemeldung, +meldungstext,initmeldungsfunktionen:LET maxmeldungen=500, +namedesmeldungsdatenraums="Meldungsdatenraum";BOUND ROW maxmeldungenTEXT VAR +dsmeldung;INT VAR geliefert;LET anzahl=25;LET zeinfuegen="#",znormeinfuegen= +"+",zhelleinfuegen="#",normausgabe=1,hellausgabe=2;BOOL VAR meldungdraussen:= +FALSE ;PROC initmeldungsfunktionen:TASK VAR savetask;LET savetaskname= +"anwendung";savetask:=task(savetaskname);IF NOT meldungsdatenraumdaTHEN IF +exists(namedesmeldungsdatenraums,savetask)THEN fetch( +namedesmeldungsdatenraums,savetask)ELSE meldungenindatenraumschreiben;save( +namedesmeldungsdatenraums,savetask)FI ;FI ;dsmeldung:=old( +namedesmeldungsdatenraums).meldungsdatenraumda:exists( +namedesmeldungsdatenraums).END PROC initmeldungsfunktionen;PROC melde(TAG +CONST t,INT CONST i):meldung(t,i,"",TRUE ,"",TRUE ,FALSE )END PROC melde; +PROC melde(TAG CONST t,INT CONST i,TEXT CONST meldvar):meldung(t,i,"",TRUE , +meldvar,TRUE ,FALSE )END PROC melde;PROC meldeauffaellig(TAG CONST t,INT +CONST i):meldung(t,i,"",TRUE ,"",TRUE ,TRUE )END PROC meldeauffaellig;PROC +melde(TAG CONST t,TEXT CONST mtext):meldung(t,0,mtext,FALSE ,"",TRUE ,FALSE ) +END PROC melde;PROC melde(TAG CONST t,TEXT CONST mtext,TEXT CONST meldvar): +meldung(t,0,mtext,FALSE ,meldvar,TRUE ,FALSE )END PROC melde;PROC +meldeauffaellig(TAG CONST t,TEXT CONST mtext):meldung(t,0,mtext,FALSE ,"", +TRUE ,TRUE )END PROC meldeauffaellig;PROC meldung(TAG CONST t,INT CONST mnr, +TEXT CONST mt,BOOL CONST was,TEXT CONST mvartext,BOOL CONST zentriert,BOOL +CONST hell):IF fieldexists(t,1)THEN TEXT VAR me;IF wasTHEN me:=meldungstext( +mnr)ELSE me:=mtFI ;IF variablemeldungTHEN vartexteinfuegenFI ;IF hellTHEN +erhellen(t,me)FI ;IF zentriertTHEN centerFI ;put(t,me,1);meldungdraussen:= +TRUE FI .center:INT CONST lmax:=length(t,1);INT CONST lmeld:=length(me);INT +CONST dif:=lmax-lmeld;IF lmeld>=lmaxTHEN LEAVE centerFI ;INT CONST bz:=dif +DIV 2;me:=bz*" "+me+(dif-bz)*" ".variablemeldung:INT VAR einfuegepos:=pos(me, +zeinfuegen);einfuegepos<>0.vartexteinfuegen:TEXT VAR ersatztext;INT VAR +textattr,aktpos:=1,posnorm,poshell;WHILE einfuegepos<>0REP +holeersatztextundattributausersatzzeile;ersetzeeinfuegezeichendurchersatztext +;einfuegepos:=pos(me,zeinfuegen)PER .holeersatztextundattributausersatzzeile: +posnorm:=pos(mvartext,znormeinfuegen,aktpos);poshell:=pos(mvartext, +zhelleinfuegen,aktpos);IF posnorm=0THEN helloderendeELSE normoderhellFI . +helloderende:IF poshell=0THEN ersatztext:="";textattr:=normausgabeELSE +holeteiltext(ersatztext,mvartext,aktpos,poshell);textattr:=hellausgabeFI . +normoderhell:IF poshell=0THEN holeteiltext(ersatztext,mvartext,aktpos,posnorm +);textattr:=normausgabeELIF normzuerstTHEN holeteiltext(ersatztext,mvartext, +aktpos,posnorm);textattr:=normausgabeELSE holeteiltext(ersatztext,mvartext, +aktpos,poshell);textattr:=hellausgabeFI .normzuerst:posnormmaxmeldungenTHEN ""ELSE dsmeldung(meldnummer)FI END PROC +meldungstext;PROC meldungstext(INT CONST meldnr,TEXT VAR meldetext):meldetext +:=meldungstext(meldnr)END PROC meldungstext;PROC +meldungenindatenraumschreiben:INT VAR iinit;forget(namedesmeldungsdatenraums, +quiet);dsmeldung:=new(namedesmeldungsdatenraums);FOR iinitFROM 1UPTO +maxmeldungenREP dsmeldung(iinit):=""PER ;systemdbon;lieserstemeldung; +dsmeldung(meldungsnr):=mtext;geliefert:=anzahl;WHILE +meldungindatenraumaufzunehmenAND geliefert=anzahlREP geliefert:=anzahl; +multisucc(dnrmeld,geliefert);FOR iinitFROM 1UPTO geliefertREP stackentry( +iinit);dsmeldung(meldungsnr):=mtext;PER ;PER ;systemdboff.meldungsnr:intwert( +fnrmeldungsname).mtext:wert(fnrmeldungstext).lieserstemeldung:first(dnrmeld). +meldungindatenraumaufzunehmen:dbstatus=ok.END PROC +meldungenindatenraumschreiben;END PACKET ispmeldungsfunktionen; + diff --git a/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask b/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask new file mode 100644 index 0000000..2d4a7be --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask @@ -0,0 +1,126 @@ +PACKET ispmonitorsicherungstaskDEFINES ispmonitorsicherungstask,sndbaisyfiles +,rcvbaisyfiles,sndidafiles,rcvidafiles,ida,statistik,:LET initcode=25, +listcode=26,checkcode=27,formatcode=40,logonarchivecode=45,logoffarchivecode= +46,dbvomserver=47,dbzumserver=48,dbaufdisk=49,dbvondisk=50,dddrucken=51,ack=0 +,errornak=2,nak=1,continuecode=100,endcode=37,savedbcode=38,restoredbcode=39, +maxthesaurusentry=252;LET showcode=12,mlddbnichtda= +"Keine vollständige DB bei Sicherungstask!",formfilename= +"Namen der Formulare",statistikserver="statistik server",#25.09.90# +statistikbasis="STATISTIK.basis";BOOL VAR idasicherung:=FALSE , +statistiksicherung:=FALSE ;#25.09.90#FILE VAR formfile;TEXT VAR nameoftask:= +"",formname:="";LET stundenplanserver="stundenplan server";LET +stundenplanpraefix="Stundenplan-*";TASK VAR stundenplanservertask;LET +kurswahlserver="kurswahl server";LET kurswahlpraefix="Kurswahl-*";TASK VAR +kurswahlservertask;BOUND TEXT VAR message;DATASPACE VAR ds;INT VAR replycode; +PROC ispmonitorsicherungstask(TEXT CONST sicherungstask):nameoftask:= +sicherungstask;globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT CONST ,TASK +CONST )ispmonitor)ENDPROC ispmonitorsicherungstask;PROC ispmonitor(DATASPACE +VAR dsp,INT CONST orderp,phasep,TASK CONST ordertaskp):INT VAR replycode; +TASK VAR begintask;IF orderp>=continuecodeAND ordertaskp=supervisorTHEN +forget(dsp);spoolcommand(orderp)ELSE enablestop;ordertask(ordertaskp);SELECT +orderpOF CASE initcode:cleararchive;CASE listcode:listarchive;CASE +dbvomserver:forget(ALL myself-schulisdbname#17.10.88#-baisydbname);IF ida +THEN rcvidafiles#25.09.90#ELIF statistikTHEN rcvstatfilesELSE fetchdb( +nameoftask);IF baisyTHEN rcvbaisyfilesELSE receivestundenplan; +receivekurswahldatenFI ;FI CASE dbzumserver:IF idaTHEN sndidafiles#25.09.90# +ELIF statistikTHEN sndstatfilesELSE restoredb(nameoftask);IF baisyTHEN +sndbaisyfilesELSE sendstundenplan;sendkurswahldatenFI FI CASE dbaufdisk:IF +ida#25.09.90#THEN savetoarchive(all-schulisdbname)ELIF NOT statistikCAND +dbnichtkomplettTHEN errorstop(mlddbnichtda)ELSE savetoarchive(all)FI CASE +dbvondisk:forget(ALL myself-schulisdbname#17.10.88#-baisydbname); +fetchfromarchive;IF idaTHEN sndidafiles#25.09.90#ELIF statistikTHEN +sndstatfilesELSE restoredb(nameoftask);IF baisyTHEN sndbaisyfilesELSE +sendstundenplan;sendkurswahldatenFI ;FI CASE formatcode:formatarchive( +nameoftask)CASE checkcode:checkarchiveCASE logonarchivecode:logonarchiveCASE +logoffarchivecode:logoffarchiveCASE dddrucken:datadirdruckenOTHERWISE : +errorstop("Falscher Auftrag!")ENDSELECT ;endemeldungFI .dbnichtkomplett:IF +NOT exists(nameoftask)COR (nameoftask="EUMELbase.baisy"CAND (NOT exists( +"BAISY-0")COR NOT exists("BAISY-1")COR NOT exists("BAISY-2")COR NOT exists( +"BAISY-3")))THEN TRUE ELSE FALSE FI .endemeldung:send(ordertaskp,ack,dsp). +datadirdrucken:servereinrichten;out("Datenbankverzeichnis wird erstellt!"); +serverwecken.servereinrichten:begin("-",PROC servermonitor,begintask). +serverwecken:call(begintask,dddrucken,dsp,replycode);IF replycode=errornak +THEN message:=dsp;errorstop(message)ELSE send(ordertaskp,showcode,dsp)FI . +ENDPROC ispmonitor;PROC servermonitor:TASK VAR fathertask;INT VAR ordercode; +DATASPACE VAR ds;disablestop;wait(ds,ordercode,fathertask);postfix(""); +fetchdd(nameoftask);IF dbopen(nameoftask)THEN ddinfo("X")ELSE errorstop( +"Drucken nicht möglich!")FI ;IF iserrorTHEN forget(ds);ds:=nilspace;message:= +ds;message:=errormessage;ordercode:=errornakELSE forget(ds);ds:=old("X.dd") +FI ;send(fathertask,ordercode,ds);end(myself)ENDPROC servermonitor;PROC +spoolcommand(INT CONST order):TEXT VAR commandline:="";enablestop;break(quiet +);continue(order-continuecode);disablestop;REP #commanddialogue(TRUE );# +getcommand(name(myself)+"-Monitor:",commandline);do(commandline)UNTIL NOT +onlinePER ;#commanddialogue(FALSE );#break(quiet);setautonomEND PROC +spoolcommand;ROW maxthesaurusentryDATASPACE VAR receiveddb;BOUND THESAURUS +VAR thesau;THESAURUS VAR dbthesaurus:=emptythesaurus;TASK VAR sourcetask:= +niltask#,baisyserver:=/"baisy server"#;PROC rcvbaisyfiles:out( +"BAISY-Files werden übertragen!");fetchfast(name(baisyserver));ENDPROC +rcvbaisyfiles;PROC sndbaisyfiles:THESAURUS VAR theo:=ALL myself,theodb:= +emptythesaurus;LET baisyconst="BAISY-";TEXT VAR fname;INT VAR tindex:=0,l:=1; +forget(ds);ds:=nilspace;thesau:=ds;thesau:=emptythesaurus;modifytheo; +sendthesaurusandrcvok;senddb.modifytheo:get(theo,fname,tindex);WHILE tindex>0 +REP IF pos(fname,baisyconst)=1THEN insert(theodb,fname)FI ;get(theo,fname, +tindex)PER ;thesau:=theodb.sendthesaurusandrcvok:REP call(baisyserver, +restoredbcode,ds,replycode)UNTIL replycode=restoredbcodePER ;.senddb:tindex:= +0;l:=1;get(theodb,fname,tindex);WHILE tindex>0REP sendfile;get(theodb,fname, +tindex)PER ;sendend.sendfile:pause(10);forget(ds);ds:=old(fname);out(fname+ +" wird übertragen!");lINCR 1;send(baisyserver,restoredbcode,ds);.sendend: +pause(10);ds:=nilspace;send(baisyserver,endcode,ds).ENDPROC sndbaisyfiles; +PROC rcvidafiles:initformfile;first(dnrida);WHILE dbstatus=okREP IF +formexists(intwert(fnridanummer))THEN out("Formular "+wert(fnridanummer)+ +" gesichert!");getform(intwert(fnridanummer));formname:="";savetupel(dnrida, +formname);putline(formfile,formname)FI ;succ(dnrida)PER .initformfile:forget( +ALL myself-schulisdbname);formfile:=sequentialfile(output,formfilename). +ENDPROC rcvidafiles;PROC sndidafiles:IF NOT exists(formfilename)THEN +errorstop("Druckausgaben nicht vollständig!")ELSE rueckspeichernFI . +formdateienda:exists("FORMDATA."+wert(fnridanummer))CAND exists("FORMTEXT."+ +wert(fnridanummer)).rueckspeichern:formfile:=sequentialfile(input, +formfilename);IF lines(formfile)>0THEN eigentlichesrueckspeichernFI . +eigentlichesrueckspeichern:clearfile(dnrida);WHILE NOT eof(formfile)REP +getline(formfile,formname);restoretupel(dnrida,formname);IF formdateienda +THEN openformular(intwert(fnridanummer));putform;out("Formular "+wert( +fnridanummer)+" rückgesichert!");insert(dnrida)FI PER .ENDPROC sndidafiles; +PROC rcvstatfiles:TASK CONST statserver:=task(statistikserver);THESAURUS VAR +stats:=ALL statserver;TEXT VAR name;INT VAR index:=0;sicheredatenbasis;get( +stats,name,index);WHILE index>0REP out(name+" gesichert!");fetch(name, +statserver);get(stats,name,index);PER ;pause(20).sicheredatenbasis:IF stats +CONTAINS statistikbasisTHEN out("Statistik Datenbasis gesichert!");fetch( +statistikbasis,statserver);stats:=stats-statistikbasis;FI .END PROC +rcvstatfiles;PROC sndstatfiles:THESAURUS CONST alle:=ALL myself;TASK CONST +statserver:=task(statistikserver);TEXT VAR name;INT VAR index:=0;IF +highestentry(alle)=0THEN errorstop("Keine Statistiken vorhanden!");ELSE +allesloeschen;rueckspeichern;pause(20);FI .allesloeschen:BOOL VAR +dialogschalter:=commanddialogue;commanddialogue(FALSE );erase(ALL statserver, +statserver);commanddialogue(dialogschalter).rueckspeichern:get(alle,name, +index);WHILE index>0REP IF name=statistikbasisTHEN out( +"Statistik Datenbasis rückgesichert!");ELSE out(name+" rückgesichert!");FI ; +save(name,statserver);get(alle,name,index);PER .END PROC sndstatfiles;PROC +receivestundenplan:disablestop;stundenplanservertask:=task(stundenplanserver) +;IF iserrorTHEN clearerror;ELSE loeschestundenplandsintask;fetchall( +stundenplanservertask);FI ;enablestop.loeschestundenplandsintask:BOOL VAR +dialogschalter:=commanddialogue;commanddialogue(FALSE );forget(allLIKE +stundenplanpraefix);commanddialogue(dialogschalter).END PROC +receivestundenplan;PROC sendstundenplan:disablestop;stundenplanservertask:= +task(stundenplanserver);IF iserrorTHEN clearerror;ELSE +loeschestundenplandsinservertask;save(allLIKE stundenplanpraefix, +stundenplanservertask);FI ;enablestop.loeschestundenplandsinservertask:BOOL +VAR dialogschalter:=commanddialogue;commanddialogue(FALSE );erase(ALL +stundenplanservertask,stundenplanservertask);commanddialogue(dialogschalter). +END PROC sendstundenplan;PROC receivekurswahldaten:disablestop; +kurswahlservertask:=task(kurswahlserver);IF iserrorTHEN clearerror;ELSE +loeschekurswahldsintask;fetch((ALL kurswahlservertask)LIKE kurswahlpraefix, +kurswahlservertask);FI ;enablestop.loeschekurswahldsintask:BOOL VAR +dialogschalter:=commanddialogue;commanddialogue(FALSE );forget(allLIKE +kurswahlpraefix);commanddialogue(dialogschalter).END PROC +receivekurswahldaten;PROC sendkurswahldaten:disablestop;kurswahlservertask:= +task(kurswahlserver);IF iserrorTHEN clearerror;ELSE +loeschekurswahldsinservertask;save(allLIKE kurswahlpraefix,kurswahlservertask +);FI ;enablestop.loeschekurswahldsinservertask:BOOL VAR dialogschalter:= +commanddialogue;commanddialogue(FALSE );erase(ALL kurswahlservertask, +kurswahlservertask);commanddialogue(dialogschalter).END PROC +sendkurswahldaten;BOOL PROC baisy:nameoftask="EUMELbase.baisy"ENDPROC baisy; +BOOL PROC ida:idasicherungENDPROC ida;PROC ida(BOOL CONST idas):idasicherung +:=idasENDPROC ida;BOOL PROC statistik:statistiksicherungEND PROC statistik; +PROC statistik(BOOL CONST stats):statistiksicherung:=statsEND PROC statistik; +ENDPACKET ispmonitorsicherungstask + diff --git a/app/baisy/2.2.1-schulis/src/isp.objektliste b/app/baisy/2.2.1-schulis/src/isp.objektliste new file mode 100644 index 0000000..46262e1 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.objektliste @@ -0,0 +1,252 @@ +PACKET ispobjektlisteDEFINES objektlistestarten,objektlistenausgabe, +listenobjektezeigen,datensatzlistenausgabe,datensatzlistezeigen, +objektlistenmaskeeinlesen,objektlistebeenden,maxidentizeilenlaenge, +setzeidentiwert,#savetupel,17.10.88##restoretupel,17.10.88#pruefungdummy, +pruefungbenutzerbestand,satzlesen,einendatensatzlesen,bestandende, +setzebestandende,plus,minus,eineseiteeinlesen,blaettern,initobli, +inlisteblaettern,setzescanendewert,setzescanstartwert:TAG VAR aktuellemaske; +TEXT VAR identiobjekt,sicherungstupel:="";TEXT VAR scanstartwert:="", +scanendewert:="�";INT VAR posi,aktletztesfeld,dateinummer,aktindex;INT VAR +anzahltupel;LET erstesfeld=2,maxletztesfeld=36,markierung="x",keinemarkierung +="",eingabefeldnr=2,felderprozeile=2,erfwerteinobli=5,schluesseltrenner="$"; +LET delimiter="�";LET andenanfang=1,ansende=2,vorwaerts=3,rueckwaerts=4;LET +meldungnichtblaettern=72;LET satzzahl=18;TEXT VAR scanwertsicherung, +scantupelsicherung;INT VAR scanfeldsicherung,feldnummerstartwert;INT VAR +fenster,gelesen;INT VAR anzschluesselfelder:=1;LET zeilenlaenge=70;INT VAR +identizeilegesamtlaenge:=70;BOOL VAR ersterbildschirm,bestandsende;BOOL VAR +letzterbildschirm;BOOL VAR ersterdatensatz;BOOL VAR nureinedatenseiteROW +satzzahlBOOL VAR angekreuzt;ROW satzzahlTEXT VAR identitabelle;PROC +setzescanendewert(TEXT CONST endewert):scanendewert:=endewertENDPROC +setzescanendewert;PROC setzescanstartwert(TEXT CONST startwert):scanstartwert +:=startwertENDPROC setzescanstartwert;PROC objektlistestarten(INT CONST +aktdateinummer,TEXT CONST startwert,BOOL CONST anwendung,BOOL VAR +listenendeerreicht):objektlistestarten(aktdateinummer,startwert, +aktdateinummer+2,anwendung,listenendeerreicht)END PROC objektlistestarten; +PROC objektlistestarten(INT CONST aktdateinummer,TEXT CONST startwert,INT +CONST fnrstartwert,BOOL CONST anwendung,BOOL VAR listenendeerreicht):LET +indextrenner=";";INT VAR erstertrenner:=0;TEXT VAR indextext:="";IF anwendung +THEN systemdboffELSE systemdbonFI ;aktindex:=aktdateinummer;dateinummer:= +dateinr(primdatid(aktindex));anzschluesselfelder:=anzkey(dateinummer); +feldnummerstartwert:=fnrstartwert;IF scanueberdiedateinummerTHEN +scanfeldsicherung:=1;ELSE indextext:=zugriff(aktindex);erstertrenner:=pos( +indextext,indextrenner);scanfeldsicherung:=int(subtext(indextext,1, +erstertrenner-1));FI ;#IF scanueberdiedateinummerTHEN #IF +dateinummerzugelassenTHEN putwert(dateinummer+1,startwert)ELSE putwert( +dateinummer+2,startwert);IF dateinummer=dnrbenutzTHEN putwert( +fnrbenutzbestand,benutzerbestandSUB 1)FI ;FI ;#ELSE IF +uebereinenganzensekindexTHEN putwert(scanfeldsicherung,startwert)ELSE putwert +(feldnummerstartwert,startwert)FI FI ;#scanwertsicherung:=wert(dateinummer+ +scanfeldsicherung);savescanwert;search(aktindex,FALSE );IF ( +scanueberdiedateinummerCOR uebereinenganzensekindex)CAND +dateinummerzugelassen#dr11.05.88#THEN listenendeerreicht:=dbstatus<>okELSE +listenendeerreicht:=dbstatus<>okCOR (dbstatus=okAND wert(dateinummer+ +scanfeldsicherung)<>scanwertsicherung)FI ;listenendenochnichterreicht( +startwert,listenendeerreicht).dateinummerzugelassen:dateinummer<> +dnrschluesselAND dateinummer<>dnrbenutz.END PROC objektlistestarten;PROC +listenendenochnichterreicht(TEXT CONST wert,BOOL CONST ende):IF NOT endeTHEN +ersterbildschirm:=(wert="");ersterdatensatz:=(wert="");letzterbildschirm:= +FALSE ;bestandsende:=FALSE ;FI .END PROC listenendenochnichterreicht;PROC +objektlistenausgabe(PROC (INT CONST )erfassungspeziell,BOOL CONST scanja, +BOOL PROC pruefungspeziell):initobli;listenmaskeholenundausgeben; +identizeilegesamtlaenge:=zeilenlaenge;inlisteblaettern(PROC erfassungspeziell +,vorwaerts,FALSE ,scanja,BOOL PROC pruefungspeziell); +objektlistenmaskeeinlesen.END PROC objektlistenausgabe;PROC +datensatzlistenausgabe(PROC (INT CONST )erfassungspeziell,BOOL CONST scanja, +BOOL PROC pruefungspeziell):initobli;listenmaskeholenundausgeben; +identizeilegesamtlaenge:=zeilenlaenge;inlisteblaettern(PROC erfassungspeziell +,vorwaerts,TRUE ,scanja,BOOL PROC pruefungspeziell);objektlistenmaskeeinlesen +.ENDPROC datensatzlistenausgabe;PROC initobli:initobli(18)END PROC initobli; +PROC initobli(INT CONST szahl):leererthesaurus;bestandsende:=FALSE ;fenster:= +szahlEND PROC initobli;PROC listenmaskeholenundausgeben:LET listenmaskenname= +"mu objektliste";initmaske(aktuellemaske,listenmaskenname);standardstartproc( +listenmaskenname).END PROC listenmaskeholenundausgeben;PROC +listenobjektezeigen(PROC (INT CONST )erfassungspeziell,INT CONST start): +listenobjektezeigen(PROC (INT CONST )erfassungspeziell,start,FALSE ,BOOL +PROC pruefungdummy)END PROC listenobjektezeigen;PROC listenobjektezeigen( +PROC (INT CONST )erfassungspeziell,INT CONST start,BOOL CONST scanja,BOOL +PROC pruefungspeziell):IF aktindex=dnrschluesselTHEN inlisteblaettern(PROC +erfassungspeziell,start,TRUE ,scanja,BOOL PROC pruefungspeziell);ELSE +inlisteblaettern(PROC erfassungspeziell,start,FALSE ,scanja,BOOL PROC +pruefungspeziell);FI ;return(1).END PROC listenobjektezeigen;PROC +datensatzlistezeigen(PROC (INT CONST )erfassungspeziell,INT CONST start): +datensatzlistezeigen(PROC (INT CONST )erfassungspeziell,start,FALSE ,BOOL +PROC pruefungdummy)END PROC datensatzlistezeigen;PROC datensatzlistezeigen( +PROC (INT CONST )erfassungspeziell,INT CONST start,BOOL CONST scanja,BOOL +PROC pruefungspeziell):inlisteblaettern(PROC erfassungspeziell,start,TRUE , +scanja,BOOL PROC pruefungspeziell);return(1).END PROC datensatzlistezeigen; +PROC inlisteblaettern(PROC (INT CONST )erfassungspeziell,INT CONST start, +BOOL CONST anwendung,BOOL CONST scanja,BOOL PROC pruefungspeziell):IF +anwendungTHEN systemdboffELSE systemdbonFI ;IF blaetternerforderlichTHEN posi +:=eingabefeldnr;aktletztesfeld:=maxletztesfeld;blaettern(PROC +erfassungspeziell,start,scanja,BOOL PROC pruefungspeziell);IF (gelesen-1)<# +satzzahl#fensterAND gelesen>0THEN leerzeilenFI ;ELSE +meldungdasnichtgeblaettertwirdFI ;IF NOT anwendungTHEN systemdboffFI ;posi:= +eingabefeldnr.blaetternerforderlich:SELECT startOF CASE andenanfang:NOT +ersterbildschirmCASE ansende:NOT letzterbildschirmCASE vorwaerts:NOT +letzterbildschirmCASE rueckwaerts:NOT ersterbildschirmOTHERWISE FALSE END +SELECT .END PROC inlisteblaettern;PROC blaettern(PROC (INT CONST ) +erfassungspeziell,INT CONST start,BOOL CONST anwendung,BOOL CONST scanja, +BOOL PROC pruefungspeziell):IF anwendungTHEN systemdboffELSE systemdbonFI ; +IF blaetternerforderlichTHEN blaettern(PROC erfassungspeziell,start,scanja, +BOOL PROC pruefungspeziell);ELSE standardmeldung(meldungnichtblaettern,""); +FI ;IF NOT anwendungTHEN systemdboffFI ;.blaetternerforderlich:SELECT start +OF CASE andenanfang:NOT ersterbildschirmCASE ansende:NOT letzterbildschirm +CASE vorwaerts:NOT letzterbildschirmCASE rueckwaerts:NOT ersterbildschirm +OTHERWISE FALSE END SELECT .END PROC blaettern;PROC zeigenschluessel:IF +identiobjekt=""THEN LEAVE zeigenschluesselFI ;INT VAR schluesselbeginn:=pos( +identiobjekt,schluesseltrenner);identitabelle(posiDIV felderprozeile):= +subtext(identiobjekt,schluesselbeginn);identiobjekt:=subtext(identiobjekt,1, +schluesselbeginn-1);IF objektmarkiert(identitabelle(posiDIV felderprozeile)) +THEN markierungIN posi;angekreuzt(posiDIV felderprozeile):=TRUE ELSE +keinemarkierungIN posi;angekreuzt(posiDIV felderprozeile):=FALSE FI ;feldfrei +(posi);identiobjektIN (posi+1);posiINCR felderprozeile.END PROC +zeigenschluessel;INT PROC maxidentizeilenlaenge:identizeilegesamtlaengeEND +PROC maxidentizeilenlaenge;PROC setzeidentiwert(TEXT CONST identizeile): +identiobjekt:=identizeileEND PROC setzeidentiwert;PROC leerzeilen: +aktletztesfeld:=posi-felderprozeile;WHILE posi<=maxletztesfeldREP +leerzeileausgeben;posiINCR felderprozeilePER .leerzeileausgeben:""IN posi;"" +IN (posi+1);feldschutz(posi).END PROC leerzeilen;BOOL PROC objektmarkiert( +TEXT CONST suchtext):inthesaurus(suchtext).END PROC objektmarkiert;PROC +objektlistenmaskeeinlesen:infeld(eingabefeldnr);standardnproc;BOOL VAR +markneu,markalt;posi:=erstesfeld;WHILE posi<=aktletztesfeldREP markneu:= +standardmaskenfeld(posi)<>"";markalt:=angekreuzt(posiDIV felderprozeile);IF +markierungsaenderungTHEN identiobjekt:=identitabelle(posiDIV felderprozeile); +IF neuemarkierungTHEN trageinthesaurusein(identiobjekt)ELIF +markierungweggenommenTHEN loescheausthesaurus(identiobjekt)FI ;FI ;posiINCR +felderprozeile;PER .markierungsaenderung:(markaltAND NOT markneu)OR (NOT +markaltAND markneu).neuemarkierung:markneu.markierungweggenommen:markalt.END +PROC objektlistenmaskeeinlesen;PROC objektlistebeenden(TEXT CONST dateiname, +BOOL CONST uebernahme):IF uebernahmeTHEN uebertragethesaurusindatei(dateiname +);#sort(dateiname)sf18.2.87#FI ;END PROC objektlistebeenden;PROC +setzebestandende(BOOL CONST b):bestandsende:=bENDPROC setzebestandende;BOOL +PROC bestandende:bestandsendeENDPROC bestandende;PROC einendatensatzlesen( +PROC (INT CONST ,BOOL PROC )mitscanner,PROC ohnescanner,BOOL CONST scanja, +BOOL PROC pruefungspeziell):IF scanjaAND scanerlaubtTHEN mitscanner(aktindex, +BOOL PROC pruefungspeziell)ELSE ohnescannerFI ENDPROC einendatensatzlesen; +PROC satzlesen(INT CONST was,n,BOOL CONST scanja,BOOL PROC pruefungspeziell): +TEXT VAR sicherung:="";anzahltupel:=n;SELECT wasOF CASE andenanfang: +ersteseitelesenCASE ansende:letzteseitelesenCASE vorwaerts:naechsteseitelesen +CASE rueckwaerts:vorherigeseitelesenENDSELECT ;savetupel(dateinummer, +sicherung);bestandsende:=anzahltupel +dateinummerOR (scanueberdiedateinummerAND anzschluesselfelder>1)END PROC +scanerlaubt;BOOL PROC scanueberdiedateinummer:aktindex=dateinummerEND PROC +scanueberdiedateinummer;BOOL PROC uebereinenganzensekindex:was(aktindex)= +indexeintragCAND feldnummerstartwert=0END PROC uebereinenganzensekindex;PROC +vorherigeseitezeigen(PROC (INT CONST )erfassungspeziell,INT CONST anzahl, +BOOL CONST scanja,BOOL PROC pruefung):INT VAR lv,ende:=2;gelesen:=0; +stackentry(anzahl-1);savetupel(dateinummer,sicherungstupel);IF +letzterbildschirmTHEN ende:=1FI ;FOR lvFROM anzahl-1DOWNTO endeREP stackentry +(lv);erfassungspeziell(erfwerteinobli);zeigenschluessel;gelesenINCR 1PER ;IF +ende=2THEN stackentry(ende-1)FI .END PROC vorherigeseitezeigen;PROC +naechsteseitezeigen(PROC (INT CONST )erfassungspeziell,INT CONST anzahl,BOOL +CONST scanja,BOOL PROC pruefung):INT VAR lv;gelesen:=0; +sicherungfuerzurueckblaettern;IF bestandsendeTHEN letzterbildschirm:=TRUE ; +ausgabeschleifemitscanueberpruefungELSE ausgabeschleifeohnescanueberpruefung +FI .sicherungfuerzurueckblaettern:IF NOT ersterbildschirmTHEN savetupel( +dateinummer,sicherungstupel);zeigenzeile;FI . +ausgabeschleifemitscanueberpruefung:FOR lvFROM 1UPTO anzahlREP stackentry(lv) +;IF (scanjaCAND pruefung)OR NOT scanjaTHEN zeigenzeile;ELSE LEAVE +naechsteseitezeigenFI PER .ausgabeschleifeohnescanueberpruefung:FOR lvFROM 1 +UPTO (anzahl-1)REP stackentry(lv);zeigenzeilePER ;stackentry(anzahl);. +zeigenzeile:erfassungspeziell(erfwerteinobli);zeigenschluessel;gelesenINCR 1. +END PROC naechsteseitezeigen;PROC blaettern(PROC (INT CONST ) +erfassungspeziell,INT CONST aktion,BOOL CONST scanja,BOOL PROC +pruefungspeziell):SELECT aktionOF CASE andenanfang:blaettereandenanfangCASE +ansende:blaettereansendeCASE vorwaerts:blaetterevorwaertsCASE rueckwaerts: +blaettererueckwaertsEND SELECT .blaettereandenanfang:anfang(PROC +erfassungspeziell,scanja,BOOL PROC pruefungspeziell).blaettereansende: +ersterbildschirm:=FALSE ;ersterdatensatz:=FALSE ;aufbestandendepositionieren; +IF bestandsendeTHEN anfang(PROC erfassungspeziell,scanja,BOOL PROC +pruefungspeziell)ELSE vorherigeseitezeigen(PROC erfassungspeziell,anzahltupel +,scanja,BOOL PROC pruefungspeziell)FI .aufbestandendepositionieren:satzlesen( +ansende,fenster+1,scanja,BOOL PROC pruefungspeziell);.blaetterevorwaerts:plus +(fenster,PROC erfassungspeziell,scanja,BOOL PROC pruefungspeziell). +blaettererueckwaerts:restoretupel(dateinummer,sicherungstupel);changeindex; +minus(fenster+2,PROC erfassungspeziell,scanja,BOOL PROC pruefungspeziell). +END PROC blaettern;PROC meldungdasnichtgeblaettertwird:TEXT VAR +zwischensicherung:="";savetupel(dateinummer,zwischensicherung); +meldeauffaellig(aktuellemaske,meldungnichtblaettern);gelesen:=0;restoretupel( +dateinummer,zwischensicherung);changeindex.END PROC +meldungdasnichtgeblaettertwird;PROC anfang(PROC (INT CONST )erfassungspeziell +,BOOL CONST scanja,BOOL PROC pruefungspeziell):IF scanjaTHEN restorescanwert; +changeindexFI ;IF NOT ersterbildschirmTHEN ersterbildschirm:=TRUE ; +aufanfangpositionieren;naechsteseitezeigen(PROC erfassungspeziell,anzahltupel +,scanja,BOOL PROC pruefungspeziell);FI .aufanfangpositionieren: +letzterbildschirm:=FALSE ;satzlesen(andenanfang,fenster+1,scanja,BOOL PROC +pruefungspeziell).END PROC anfang;PROC plus(INT CONST saetzevor,PROC (INT +CONST )erfassungspeziell,BOOL CONST scanja,BOOL PROC pruefungspeziell): +letzterbildschirm:=FALSE ;IF NOT ersterdatensatzTHEN ersterbildschirm:=FALSE +;satzlesen(vorwaerts,saetzevor,scanja,BOOL PROC pruefungspeziell);ELSE +satzlesen(vorwaerts,saetzevor+1,scanja,BOOL PROC pruefungspeziell);FI ; +naechsteseitezeigen(PROC erfassungspeziell,anzahltupel,scanja,BOOL PROC +pruefungspeziell);IF nureinedatenseiteTHEN putwert(dateinummer+ +scanfeldsicherung,scanwertsicherung)FI ;END PROC plus;PROC minus(INT CONST +saetzezurueck,PROC (INT CONST )erfassungspeziell,BOOL CONST scanja,BOOL PROC +pruefungspeziell):#neudr30.01.87#satzlesen(rueckwaerts,saetzezurueck,scanja, +BOOL PROC pruefungspeziell);IF bestandsendeTHEN anfang(PROC erfassungspeziell +,scanja,BOOL PROC pruefungspeziell)ELSE ersterbildschirm:=FALSE ; +letzterbildschirm:=FALSE ;vorherigeseitezeigen(PROC erfassungspeziell, +saetzezurueck,scanja,BOOL PROC pruefungspeziell)FI .END PROC minus;PROC +initankreuzliste:INT VAR i;FOR iFROM 1UPTO satzzahlREP angekreuzt(i):=FALSE +PER ;END PROC initankreuzliste;#dr17.10.88PROC savetupel(INT CONST dnr,TEXT +VAR tupel):INT VAR fnr,primdat;IF was(dnr)=dateieintragTHEN primdat:=dnrELSE +primdat:=dateinr(primdatid(dnr))FI ;tupel:="";FOR fnrFROM 1UPTO anzattr( +primdat)REP tupelCAT (wert(primdat+fnr)+delimiter)PER ENDPROC savetupel;PROC +restoretupel(INT CONST dnr,TEXT VAR tupel):INT VAR fnr,primdat,p;TEXT VAR +feldwert,data:=tupel;IF was(dnr)=dateieintragTHEN primdat:=dnrELSE primdat:= +dateinr(primdatid(dnr))FI ;FOR fnrFROM primdat+1UPTO primdat+anzattr(primdat) +REP p:=pos(data,delimiter);feldwert:=subtext(data,1,(p-1));putwert(fnr, +feldwert);change(data,1,p,"")PER ENDPROC restoretupel;#BOOL PROC +pruefungdummy:TRUE END PROC pruefungdummy;BOOL PROC pruefungbenutzerbestand:( +wert(fnrbenutzbestand))=(benutzerbestandSUB 1)END PROC +pruefungbenutzerbestand;TEXT VAR savedscan:="";LET savedscansep="�",dateityp= +1;PROC savescanwert:savedscan:="";transversale(feldnummerstartwert,PROC (INT +CONST ,INT VAR )save,FALSE )ENDPROC savescanwert;PROC restorescanwert: +transversale(feldnummerstartwert,PROC (INT CONST ,INT VAR )restore,TRUE ) +ENDPROC restorescanwert;PROC transversale(INT CONST fnrsetzfeld,PROC (INT +CONST ,INT VAR )pproc,BOOL CONST rsetzen):TEXT VAR z:=zugriffaufbauen;INT +VAR p:=1,psem:=pos(z,";"),i,fnrsf:=fnrsetzfeld-dateinummer;INT VAR fnr:=int( +subtext(z,p,psem-1)),p1:=1;BOOL VAR pausf:=TRUE ;WHILE #fnr<>fnrsfCAND #fnr>0 +REP IF fnr=fnrsfTHEN pausf:=FALSE ELSE IF pausfTHEN pproc(fnr+dateinummer,p1) +;ELSE IF rsetzenTHEN putwert(fnr+dateinummer,"")FI FI FI ;p:=psem+1;psem:=pos +(z,";",p);fnr:=int(subtext(z,p,psem-1))PER .zugriffaufbauen:IF was(aktindex)= +dateitypTHEN TEXT VAR x:="";FOR iFROM 1UPTO anzkey(aktindex)REP xCAT (text(i) ++";")PER ;xELSE zugriff(aktindex)FI .ENDPROC transversale;PROC save(INT +CONST fnr,INT VAR p):savedscanCAT (wert(fnr)+savedscansep)ENDPROC save;PROC +restore(INT CONST fnr,INT VAR p):INT VAR p2:=p;p:=pos(savedscan,savedscansep, +p2)+1;putwert(fnr,subtext(savedscan,p2,p-2))ENDPROC restore;END PACKET +ispobjektliste; + diff --git a/app/baisy/2.2.1-schulis/src/isp.schulis db nummern b/app/baisy/2.2.1-schulis/src/isp.schulis db nummern new file mode 100644 index 0000000..f030559 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.schulis db nummern @@ -0,0 +1,225 @@ +PACKET ispschulisdbnummernDEFINES dnrschueler,fnrsufamnames,fnrsurufnames, +fnrsugebdatums,fnrsustatuss,fnrsusgrpjgst,fnrsusgrpzugtut,fnrsutidakthjd, +fnrsuartzugang,fnrsuneuerzugtut,fnrsugeschlechts,fnrsujgsteintr, +fnrsuskennlschule,fnrsuklasselschule,fnrsuabgdats,fnrsuabggrund, +fnrsuabschluss,fnrsuskennnschule,fnrsuvornames,fnrsunamenszusatzs, +fnrsugebnames,fnrsuwohntbei,fnrsustrnrs,fnrsuplzorts,fnrsutelnrs, +fnrsuortsteils,fnrsufamnamee,fnrsuvornamee,fnrsunamenszusatze,fnrsustrnre, +fnrsuplzorte,fnrsutelnre,fnrsuverhes,fnrsustaatsangs,fnrsureligionsz, +fnrsureligionsvz,fnrsuspaetaus,fnrsumuttersprache,fnrsugeborts,fnrsugebkreiss +,fnrsujahreinschul,fnrsueintrittsdats,fnrsueintrittinsek,fnrsuvermerk1, +fnrsuvermerk2,fnrsuvermerk3,fnrsuvermerk4,fnrsuvermerk5,fnrsuvermerk6, +fnrsudiffdatennrs,fnrsutiddiffdaten,dnrdiffdaten,fnrdddiffdatennr, +fnrdd1fremdfach,fnrdd1fremdb,fnrdd1fremde,fnrdd2fremdfach,fnrdd2fremdb, +fnrdd2fremde,fnrdd3fremdfach,fnrdd3fremdb,fnrdd3fremde,fnrdd4fremdfach, +fnrdd4fremdb,fnrdd4fremde,fnrddreliunter,fnrddabmeldedatreli, +fnrddanmeldedatreli,fnrddkunstmusik,fnrddfach091a,fnrddfach091b,fnrddfach092a +,fnrddfach092b,fnrddfach101a,fnrddfach101b,fnrddfach102a,fnrddfach102b, +fnrddagthema1,fnrddagthema1b,fnrddagthema1e,fnrddagthema2,fnrddagthema2b, +fnrddagthema2e,fnrddagthema3,fnrddagthema3b,fnrddagthema3e,dnrhalbjahresdaten +,fnrhjdfamnames,fnrhjdrufnames,fnrhjdgebdats,fnrhjdsj,fnrhjdhj,fnrhjdjgst, +fnrhjdkennung,fnrhjdversetzung,fnrhjdnachfach1,fnrhjdnachfach2, +fnrhjdnachfach3,fnrhjdnachfach,fnrhjdnacherg,fnrhjdversstdm,fnrhjdversstdo, +fnrhjdverspaet,fnrhjdbemzeug1,fnrhjdbemzeug2,fnrhjdbemzeug3,fnrhjdbemnach, +fnrhjdvermblau,fnrhjdvermnachwarn,fnrhjdbemblau,fnrhjdbemnachwarn,fnrhjdfach, +fnrhjdkursart,fnrhjdlerngrpkenn,fnrhjdklausurteiln,fnrhjdnotepunkte, +fnrhjdbemerk,fnrhjdvermwarnung,dnrschulen,fnrschkennung,fnrschname,fnrschart, +fnrschstrnr,fnrschplzort,fnrschtelnr,fnrschamtlnr,fnrschbundesland, +dnraktschuelergruppen,fnrsgrpsj,fnrsgrphj,fnrsgrpjgst,fnrsgrpkennung, +fnrsgrplehrer,fnrsgrpstellvlehrer,fnrsgrpintegabez,dnrschluessel, +fnrschlsachgebiet,fnrschlschluessel,fnrschllangtext,dnrfaecher,fnrffach, +fnrffachbez,fnrffachgrp,fnrffachbereich,dnrlehrer,fnrlparaphe,fnrlfamname, +fnrlrufname,fnrlzusatz,fnrlamtsbeztitel,fnrlgeschlecht,fnrlsollstd, +fnrlpflichtstd,fnrlerm1,fnrlermgrund1,fnrlerm2,fnrlermgrund2,fnrlerm3, +fnrlermgrund3,fnrlerm4,fnrlermgrund4,fnrlsprechzeit,fnrlstrnr,fnrlplzort, +fnrltelnr,dnrlehrbefaehigungen,fnrlbfach,fnrlbparaphe,fnrlbart, +dnrfaecherangebot,fnrfangsj,fnrfanghj,fnrfangjgst,fnrfanglfdnr,fnrfangfach, +fnrfangart,fnrfangwochenstd,fnrfanganzlv,dnrlehrveranstaltungen,fnrlvsj, +fnrlvhj,fnrlvjgst,fnrlvfachkennung,fnrlvkopplung,fnrlvparaphe,fnrlvwochenstd, +fnrlvklgrp1,fnrlvklgrp2,fnrlvklgrp3,fnrlvklgrp4,fnrlvraumgrp1,fnrlvraumgrp2, +fnrlvart,dnrzeitraster,fnrzrsj,fnrzrhj,fnrzrtagstunde,fnrzrkennungteil, +fnrzrbeginnuhr,fnrzrendeuhr,dnraufsichtszeiten,fnrazsj,fnrazhj, +fnrazaufsichtszeit,fnraztagstdvor,fnraztagstdnach,fnrazbeginnuhr,fnrazendeuhr +,fnrazbezeichnung,dnrzeitwuensche,fnrzwsj,fnrzwhj,fnrzwbezug, +fnrzwbezugsobjekt,fnrzwbestimmtewuensche,fnrzwunbestimmtewuensche, +dnrraumgruppen,fnrrgraumgrp,fnrrgraeume,dnrklassengruppen,fnrkgklassengrp, +fnrkgschuelergrp,dnraufsichtsplan,fnrapsj,fnraphj,fnrapaufsichtszeit, +fnrapaufsichtsort,fnrapparaphe,dnrvertretungen,fnrvdatum,fnrvtagstd, +fnrvparaphe,fnrvanrechnung,fnrvveranstaltung,dnrida,fnridanummer,fnridaname, +fnridastatus,fnridatyp,#ixsustat,dr05.04.88jetztüberflüssig#ixsustatschulkenn +,ixsustatfamrufgeb,ixsustatjgstzug,ixsustatabgdat,ixsustatjgst,ixsustatgeb, +ixsustatgeschlgeb,ixhjdfamrufgebjgsthj,ixhjdsjhjjgstkenn,ixhjdsjhjverjgstkenn +,ixhjdversjhjjgstkenn,ixhjdverfamsjhjrufgeb,ixhjdsjhjverjgst,ixsgrpjgstkenn, +ixlfamruf,ixlbpar,ixlbart,ixfangsjhjfach,ixlvsjhjkopp,ixlvsjhjkenn, +ixlvsjhjpar,ixappar,ixvpar,dnrausk,dnrbenutz,dnrmeld,fnrauskunftsname, +fnrschlverz,fnrauskunftstext,fnrbenutzbestand,fnrbenutzname, +fnrbenutzgeheimwort,fnrbenutzberecht,fnrmeldungsname,fnrmeldungstext:LET +dnrauskuenfte=2,fnrauskname=3,fnrauskverz=4,fnrausktext=5,dnrbenutzer=7, +fnrbenbestand=8,fnrbenname=9,fnrbengwort=10,fnrbenrecht=11,dnrmeldungen=12, +fnrmeldname=13,fnrmeldtext=14;INT PROC dnrausk:dnrauskuenfteENDPROC dnrausk; +INT PROC fnrauskunftsname:fnrausknameENDPROC fnrauskunftsname;INT PROC +fnrschlverz:fnrauskverzENDPROC fnrschlverz;INT PROC fnrauskunftstext: +fnrausktextENDPROC fnrauskunftstext;INT PROC dnrbenutz:dnrbenutzerENDPROC +dnrbenutz;INT PROC fnrbenutzbestand:fnrbenbestandENDPROC fnrbenutzbestand; +INT PROC fnrbenutzname:fnrbennameENDPROC fnrbenutzname;INT PROC +fnrbenutzgeheimwort:fnrbengwortENDPROC fnrbenutzgeheimwort;INT PROC +fnrbenutzberecht:fnrbenrechtENDPROC fnrbenutzberecht;INT PROC dnrmeld: +dnrmeldungenENDPROC dnrmeld;INT PROC fnrmeldungsname:fnrmeldnameENDPROC +fnrmeldungsname;INT PROC fnrmeldungstext:fnrmeldtextENDPROC fnrmeldungstext;# +oeffnedatenbank(schulisdbname);systemdboff;#BOOL VAR b:=dbopen(schulisdbname) +;INT CONST dnrschueler:=dateinr("Schüler"),fnrsufamnames:=feldnr( +"Familienname.S"),fnrsurufnames:=feldnr("Rufname.S"),fnrsugebdatums:=feldnr( +"Geburtsdatum.S"),fnrsustatuss:=feldnr("Status"),fnrsusgrpjgst:=feldnr( +"SchülergruppeJgst"),fnrsusgrpzugtut:=feldnr("SchülergruppeZug/Tutor"), +fnrsutidakthjd:=feldnr("Tid akt Hjd"),fnrsuartzugang:=feldnr( +"Art des Zugangs"),fnrsuneuerzugtut:=feldnr("neuer Zug/Tutor"), +fnrsugeschlechts:=feldnr("Geschlecht.S"),fnrsujgsteintr:=feldnr( +"Jahrgangsstufe Eintr"),fnrsuskennlschule:=feldnr("Schulkenn. letzt Sch"), +fnrsuklasselschule:=feldnr("Klasse letzte Schule"),fnrsuabgdats:=feldnr( +"Abgangsdatum.S"),fnrsuabggrund:=feldnr("Abgangsgrund"),fnrsuabschluss:= +feldnr("Abschluß"),fnrsuskennnschule:=feldnr("Schulkennung neue Sch"), +fnrsuvornames:=feldnr("Vorname.S"),fnrsunamenszusatzs:=feldnr( +"Namenszusatz.S"),fnrsugebnames:=feldnr("Geburtsname.S"),fnrsuwohntbei:= +feldnr("Zusatz wohnt bei"),fnrsustrnrs:=feldnr("Straße, Nr.S"),fnrsuplzorts:= +feldnr("PLZ, Ort.S"),fnrsutelnrs:=feldnr("Tel.Nr.S"),fnrsuortsteils:=feldnr( +"Ortsteil.S"),fnrsufamnamee:=feldnr("Familienname.E"),fnrsuvornamee:=feldnr( +"Vorname.E"),fnrsunamenszusatze:=feldnr("Namenszusatz.E"),fnrsustrnre:=feldnr +("Straße, Nr.E"),fnrsuplzorte:=feldnr("PLZ, Ort.E"),fnrsutelnre:=feldnr( +"Tel.Nr.E"),fnrsuverhes:=feldnr("Verhältnis.E-S"),fnrsustaatsangs:=feldnr( +"Staatsangehörigkeit.S"),fnrsureligionsz:=feldnr("Religionszugehörigkeit"), +fnrsureligionsvz:=feldnr("ReligionsvermerkZeugn"),fnrsuspaetaus:=feldnr( +"Spätaussiedler"),fnrsumuttersprache:=feldnr("Muttersprache"),fnrsugeborts:= +feldnr("Geburtsort.S"),fnrsugebkreiss:=feldnr("Geburtskreis/-land.S"), +fnrsujahreinschul:=feldnr("Jahr der Einschulung"),fnrsueintrittsdats:=feldnr( +"Eintrittsdatum.S"),fnrsueintrittinsek:=feldnr("Eintritt in Sek. II"), +fnrsuvermerk1:=feldnr("Vermerk 1"),fnrsuvermerk2:=feldnr("Vermerk 2"), +fnrsuvermerk3:=feldnr("Vermerk 3"),fnrsuvermerk4:=feldnr("Vermerk 4"), +fnrsuvermerk5:=feldnr("Vermerk 5"),fnrsuvermerk6:=feldnr("Vermerk 6"), +fnrsudiffdatennrs:=feldnr("Diffdaten Nr.S"),fnrsutiddiffdaten:=feldnr( +"Tid Diffdaten");INT CONST dnrdiffdaten:=dateinr("Differenzierungsdaten"), +fnrdddiffdatennr:=feldnr("Diffdaten Nr."),fnrdd1fremdfach:=feldnr( +"Fach.1.Fremdsprache"),fnrdd1fremdb:=feldnr("Beginn.1.Fremdsprache"), +fnrdd1fremde:=feldnr("Ende.1.Fremdsprache"),fnrdd2fremdfach:=feldnr( +"Fach.2.Fremdsprache"),fnrdd2fremdb:=feldnr("Beginn.2.Fremdsprache"), +fnrdd2fremde:=feldnr("Ende.2.Fremdsprache"),fnrdd3fremdfach:=feldnr( +"Fach.3.Fremdsprache"),fnrdd3fremdb:=feldnr("Beginn.3.Fremdsprache"), +fnrdd3fremde:=feldnr("Ende.3.Fremdsprache"),fnrdd4fremdfach:=feldnr( +"Fach.4.Fremdsprache"),fnrdd4fremdb:=feldnr("Beginn.4.Fremdsprache"), +fnrdd4fremde:=feldnr("Ende.4.Fremdsprache"),fnrddreliunter:=feldnr( +"Religionsunterricht"),fnrddabmeldedatreli:=feldnr("Abmeldedatum.Religion"), +fnrddanmeldedatreli:=feldnr("Wiederanmeld.Religion"),fnrddkunstmusik:=feldnr( +"Kunst/Musik"),fnrddfach091a:=feldnr("FächerWP09.1.a"),fnrddfach091b:=feldnr( +"FächerWP09.1.b"),fnrddfach092a:=feldnr("FächerWP09.2.a"),fnrddfach092b:= +feldnr("FächerWP09.2.b"),fnrddfach101a:=feldnr("FächerWP10.1.a"), +fnrddfach101b:=feldnr("FächerWP10.1.b"),fnrddfach102a:=feldnr( +"FächerWP10.2.a"),fnrddfach102b:=feldnr("FächerWP10.2.b"),fnrddagthema1:= +feldnr("AG.Thema1"),fnrddagthema1b:=feldnr("AG.Thema1.Beginn"),fnrddagthema1e +:=feldnr("AG.Thema1.Ende"),fnrddagthema2:=feldnr("AG.Thema2"),fnrddagthema2b +:=feldnr("AG.Thema2.Beginn"),fnrddagthema2e:=feldnr("AG.Thema2.Ende"), +fnrddagthema3:=feldnr("AG.Thema3"),fnrddagthema3b:=feldnr("AG.Thema3.Beginn") +,fnrddagthema3e:=feldnr("AG.Thema3.Ende");INT CONST dnrhalbjahresdaten:= +dateinr("Halbjahresdaten"),fnrhjdfamnames:=feldnr("Hjd.Famname.S"), +fnrhjdrufnames:=feldnr("Hjd.Rufname.S"),fnrhjdgebdats:=feldnr( +"Hjd.Gebdatum.S"),fnrhjdsj:=feldnr("Hjd.Schuljahr"),fnrhjdhj:=feldnr( +"Hjd.Halbjahr"),fnrhjdjgst:=feldnr("Hjd.Jahrgangsstufe"),fnrhjdkennung:= +feldnr("Hjd.Kennung"),fnrhjdversetzung:=feldnr("Hjd.Versetzung"), +fnrhjdnachfach1:=feldnr("Hjd.Nachprüfungsfach 1"),fnrhjdnachfach2:=feldnr( +"Hjd.Nachprüfungsfach 2"),fnrhjdnachfach3:=feldnr("Hjd.Nachprüfungsfach 3"), +fnrhjdnachfach:=feldnr("Hjd.Nachprüfungsfach"),fnrhjdnacherg:=feldnr( +"Hjd.Nachprüfungsergebnis"),fnrhjdversstdm:=feldnr( +"Hjd.versäumte Stunden mit"),fnrhjdversstdo:=feldnr( +"Hjd.versäumte Stunden ohn"),fnrhjdverspaet:=feldnr("Hjd.Verspätungen"), +fnrhjdbemzeug1:=feldnr("Hjd.Bemerk.Zeugnis 1"),fnrhjdbemzeug2:=feldnr( +"Hjd.Bemerk.Zeugnis 2"),fnrhjdbemzeug3:=feldnr("Hjd.Bemerk.Zeugnis 3"), +fnrhjdbemnach:=feldnr("Hjd.Bemerk.Nachprüfung"),fnrhjdvermblau:=feldnr( +"Hjd.Vermerk.Blauer Brief"),fnrhjdvermnachwarn:=feldnr( +"Hjd.Vermerk.Nachwarnung"),fnrhjdbemblau:=feldnr("Hjd.Bemerk.Blauer Brief"), +fnrhjdbemnachwarn:=feldnr("Hjd.Bemerk.Nachwarnung"),fnrhjdfach:=feldnr( +"Hjd.Fach"),fnrhjdkursart:=feldnr("Hjd.Kursart"),fnrhjdlerngrpkenn:=feldnr( +"Hjd.Lerngrp.Kennung"),fnrhjdklausurteiln:=feldnr("Hjd.Klausurteilnahme"), +fnrhjdnotepunkte:=feldnr("Hjd.Zeugnisnote/Punkte"),fnrhjdbemerk:=feldnr( +"Hjd.Bemerkung"),fnrhjdvermwarnung:=feldnr("Hjd.Vermerk Warnung");INT CONST +dnrschulen:=dateinr("Schulen"),fnrschkennung:=feldnr("Schulkennung"), +fnrschname:=feldnr("Schulname"),fnrschart:=feldnr("Schulart"),fnrschstrnr:= +feldnr("Straße Nr.Schule"),fnrschplzort:=feldnr("PLZ, Ort.Schule"), +fnrschtelnr:=feldnr("Tel. Nr.Schule"),fnrschamtlnr:=feldnr( +"amtl. Schulnummer"),fnrschbundesland:=feldnr("Bundesland");INT CONST +dnraktschuelergruppen:=dateinr("aktuelle Schülergruppen"),fnrsgrpsj:=feldnr( +"Schuljahr"),fnrsgrphj:=feldnr("Halbjahr"),fnrsgrpjgst:=feldnr( +"Jahrgangsstufe"),fnrsgrpkennung:=feldnr("Kennung"),fnrsgrplehrer:=feldnr( +"Klassenlehrer/Tutor"),fnrsgrpstellvlehrer:=feldnr("stellvertr. Klassenl."), +fnrsgrpintegabez:=feldnr("intega Bezeichnung");INT CONST dnrschluessel:= +dateinr("Schlüssel"),fnrschlsachgebiet:=feldnr("Sachgebiet"), +fnrschlschluessel:=feldnr("Schlüssel"),fnrschllangtext:=feldnr("Langtext"); +INT CONST dnrfaecher:=dateinr("Fächer"),fnrffach:=feldnr("Fach"),fnrffachbez +:=feldnr("Fachbezeichnung"),fnrffachgrp:=feldnr("Fachgruppe"),fnrffachbereich +:=feldnr("Fachbereich");INT CONST dnrlehrer:=dateinr("Lehrer"),fnrlparaphe:= +feldnr("Paraphe"),fnrlfamname:=feldnr("Familienname.L"),fnrlrufname:=feldnr( +"Rufname.L"),fnrlzusatz:=feldnr("Namenszusatz.L"),fnrlamtsbeztitel:=feldnr( +"Amtsbezeichnung Titel"),fnrlgeschlecht:=feldnr("Geschlecht.L"),fnrlsollstd:= +feldnr("Sollstunden"),fnrlpflichtstd:=feldnr("Pflichtstunden"),fnrlerm1:= +feldnr("Ermäßigung 1"),fnrlermgrund1:=feldnr("Ermäßigungsgrund 1"),fnrlerm2:= +feldnr("Ermäßigung 2"),fnrlermgrund2:=feldnr("Ermäßigungsgrund 2"),fnrlerm3:= +feldnr("Ermäßigung 3"),fnrlermgrund3:=feldnr("Ermäßigungsgrund 3"),fnrlerm4:= +feldnr("Ermäßigung 4"),fnrlermgrund4:=feldnr("Ermäßigungsgrund 4"), +fnrlsprechzeit:=feldnr("Sprechzeiten"),fnrlstrnr:=feldnr("Straße, Nr.L"), +fnrlplzort:=feldnr("PLZ, Ort.L"),fnrltelnr:=feldnr("Tel. Nr.L");INT CONST +dnrlehrbefaehigungen:=dateinr("Lehrbefähigungen"),fnrlbfach:=feldnr("Lb.Fach" +),fnrlbparaphe:=feldnr("Lb.Paraphe"),fnrlbart:=feldnr("Lb.Art");INT CONST +dnrfaecherangebot:=dateinr("Fächerangebot"),fnrfangsj:=feldnr("Fa.Schuljahr") +,fnrfanghj:=feldnr("Fa.Halbjahr"),fnrfangjgst:=feldnr("Fa.Jgst"),fnrfanglfdnr +:=feldnr("Fa.laufende Nr."),fnrfangfach:=feldnr("Fa.Fach"),fnrfangart:=feldnr +("Fa.Art"),fnrfangwochenstd:=feldnr("Fa.Wochenstundenzahl"),fnrfanganzlv:= +feldnr("Fa.Anzahl Lehrveranst.");INT CONST dnrlehrveranstaltungen:=dateinr( +"Lehrveranstaltungen"),fnrlvsj:=feldnr("Lv.Schuljahr"),fnrlvhj:=feldnr( +"Lv.Halbjahr"),fnrlvjgst:=feldnr("Lv.Jgst"),fnrlvfachkennung:=feldnr( +"Lv.Fach Kennung"),fnrlvkopplung:=feldnr("Lv.Kopplung"),fnrlvparaphe:=feldnr( +"Lv.Paraphe"),fnrlvwochenstd:=feldnr("Lv.Wochenstunden"),fnrlvklgrp1:=feldnr( +"Lv.Klassengruppe 1"),fnrlvklgrp2:=feldnr("Lv.Klassengruppe 2"),fnrlvklgrp3:= +feldnr("Lv.Klassengruppe 3"),fnrlvklgrp4:=feldnr("Lv.Klassengruppe 4"), +fnrlvraumgrp1:=feldnr("Lv.Raumgruppe 1"),fnrlvraumgrp2:=feldnr( +"Lv.Raumgruppe 2"),fnrlvart:=feldnr("Lv.Art");INT CONST dnrzeitraster:= +dateinr("Zeitraster"),fnrzrsj:=feldnr("Zr.Schuljahr"),fnrzrhj:=feldnr( +"Zr.Halbjahr"),fnrzrtagstunde:=feldnr("Zr.Tag Stunde"),fnrzrkennungteil:= +feldnr("Zr.Kennung Tagesteil"),fnrzrbeginnuhr:=feldnr("Zr.Beginn Uhrzeit"), +fnrzrendeuhr:=feldnr("Zr.Ende Uhrzeit");INT CONST dnraufsichtszeiten:=dateinr +("Aufsichtszeiten"),fnrazsj:=feldnr("Az.Schuljahr"),fnrazhj:=feldnr( +"Az.Halbjahr"),fnrazaufsichtszeit:=feldnr("Az.Aufsichtszeit"),fnraztagstdvor +:=feldnr("Az.Tag Stunde vorher"),fnraztagstdnach:=feldnr( +"Az.Tag Stunde nachher"),fnrazbeginnuhr:=feldnr("Az.Beginn Uhrzeit"), +fnrazendeuhr:=feldnr("Az.Ende Uhrzeit"),fnrazbezeichnung:=feldnr( +"Az.Bezeichnung");INT CONST dnrzeitwuensche:=dateinr("Zeitwünsche"),fnrzwsj:= +feldnr("Zw.Schuljahr"),fnrzwhj:=feldnr("Zw.Halbjahr"),fnrzwbezug:=feldnr( +"Zw.Bezug"),fnrzwbezugsobjekt:=feldnr("Zw.Bezugsobjekt"), +fnrzwbestimmtewuensche:=feldnr("Zw.bestimmte Wünsche"), +fnrzwunbestimmtewuensche:=feldnr("Zw.unbestimmte Wünsche");INT CONST +dnrraumgruppen:=dateinr("Raumgruppen"),fnrrgraumgrp:=feldnr("Raumgruppe"), +fnrrgraeume:=feldnr("Räume");INT CONST dnrklassengruppen:=dateinr( +"Klassengruppen"),fnrkgklassengrp:=feldnr("Klassengruppe"),fnrkgschuelergrp:= +feldnr("Schülergruppen");INT CONST dnraufsichtsplan:=dateinr("Aufsichtsplan") +,fnrapsj:=feldnr("Ap.Schuljahr"),fnraphj:=feldnr("Ap.Halbjahr"), +fnrapaufsichtszeit:=feldnr("Ap.Aufsichtszeit"),fnrapaufsichtsort:=feldnr( +"Ap.Aufsichtsort"),fnrapparaphe:=feldnr("Ap.Paraphe");INT CONST +dnrvertretungen:=dateinr("Vertretungen"),fnrvdatum:=feldnr("V.Datum"), +fnrvtagstd:=feldnr("V.Tag Stunde"),fnrvparaphe:=feldnr("V.Paraphe"), +fnrvanrechnung:=feldnr("V.Anrechnung"),fnrvveranstaltung:=feldnr( +"V.Veranstaltung");INT CONST dnrida:=dateinr("Druckausgaben"),fnridanummer:= +feldnr("Ida.Nr"),fnridaname:=feldnr("Ida.Name"),fnridastatus:=feldnr( +"Ida.Status"),fnridatyp:=feldnr("Ida.Typ");INT CONST #ixsustat:=indexnr( +"Status"),#ixsustatschulkenn:=indexnr("letzte Schule"),ixsustatfamrufgeb:= +indexnr("Schuelerbestand"),ixsustatjgstzug:=indexnr("Status Jgst Zug"), +ixsustatabgdat:=indexnr("Status Abgangsdatum"),ixsustatjgst:=indexnr( +"SchülergruppeJgst"),ixsustatgeb:=indexnr("Geburtsdatum.S"),ixsustatgeschlgeb +:=indexnr("Geschlecht, Gebdat"),ixhjdfamrufgebjgsthj:=indexnr( +"ix hjd fam ruf geb jgst hj"),ixhjdsjhjjgstkenn:=indexnr( +"hjd sj hj jgst kenn"),ixhjdsjhjverjgstkenn:=indexnr( +"hjd sj hj vers jgst kenn"),ixhjdversjhjjgstkenn:=indexnr("Hjd.Versetzung"), +ixhjdverfamsjhjrufgeb:=indexnr("Hjd.Famname der Wiederh"),ixhjdsjhjverjgst:= +indexnr("hjd sj hj vers jgst"),ixsgrpjgstkenn:=indexnr("Gruppe"),ixlfamruf:= +indexnr("Index.Lehrername"),ixlbpar:=indexnr("Index.Lb.Paraphe"),ixlbart:= +indexnr("Index.Lb.Art"),ixfangsjhjfach:=indexnr("Index.Fa.Fach"),ixlvsjhjkopp +:=indexnr("Index.Lv.Kopplung"),ixlvsjhjkenn:=indexnr("Index.Lv.Fach"), +ixlvsjhjpar:=indexnr("Index.Lv.Paraphe"),ixappar:=indexnr("Index.Ap.Paraphe") +,ixvpar:=indexnr("Index.V.Paraphe");#systemdbon#END PACKET +ispschulisdbnummern + diff --git a/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor b/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor new file mode 100644 index 0000000..67ebbfb --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor @@ -0,0 +1,141 @@ +PACKET sicherungsmonitorDEFINES ladenstarten,sichernstarten,formatieren, +endeformatieren,initialisieren,disketteueberpruefen,floppylisten, +floppylistingzeigen,endefloppylisting,meldungquittieren, +dbverzeichniserstellen,dbverzeichniszeigen,endedbverzeichnis,archiveanmelden, +archiveabmelden,bestimmendersicherungstask,sicherungsloop,beendenarchivieren: +LET initcode=25,listcode=26,checkcode=27,formatcode=40,logonarchivecode=45, +logoffarchivecode=46,dbvomserver=47,dbzumserver=48,dbaufdisk=49,dbvondisk=50, +dddrucken=51,endemeldung=0,errornak=2,nak=1,keinedaten=59,floppyzuranzeige= +180,formatkorrekt=181,initkorrekt=182,sichernkorrekt=183,ladenkorrekt=184, +opkorrekt=185,unbekanntercode=186,inkonsicherung=187,floppyzurpruefung=199; +LET yescode=10,outcode=11,showcode=12;LET meldungsfeld=1;LET +ankreuzauffloppyladen=6,ankreuzauffloppysichern=7,floppynamefeld=8, +ankreuzschulis=2,ankreuzbaisy=3,ankreuzida=4,ankreuzstatistik=5, +fragekennzeichnung=" ?";LET manager2="baisy",manager1="schulis",manager3= +"ida",manager4="statistik";LET meldpattern1="Archiv",meldpattern2="e", +meldpattern3="Diskette",patternlaenge=6;LET sicherung=" sicherung";INT VAR +quittung,stufe:=1,letzterauftragscode;TEXT VAR dbinhalt:="";TASK VAR +dbsicherungstask;DATASPACE VAR ds;BOUND TEXT VAR message;INT VAR +meldungsfeldlaenge,eingabestatus;TEXT VAR dbsicherung:="",anmeldetask:=""; +BOOL VAR endequittungda:=FALSE ,error:=FALSE ;LET logbucheintragsichern= +"Anw. 10.1.1 Sicherung von ",logbucheintragladen="Anw. 10.1.2 Laden von "; +PROC eingabepruefen:standardpruefe(5,ankreuzschulis,ankreuzstatistik,0,"", +eingabestatus);IF eingabestatus=0THEN standardpruefe(5,ankreuzauffloppyladen, +ankreuzauffloppysichern,0,"",eingabestatus);IF eingabestatus=0THEN +parametersetzenFI ;FI .END PROC eingabepruefen;PROC eingabepruefeneinfach: +standardpruefe(5,ankreuzschulis,ankreuzstatistik,0,"",eingabestatus);IF +eingabestatus=0THEN parametersetzenFI .END PROC eingabepruefeneinfach;PROC +parametersetzen:IF standardmaskenfeld(ankreuzschulis)<>""THEN dbsicherung:= +manager1;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"ELIF standardmaskenfeld( +ankreuzbaisy)<>""THEN dbsicherung:=manager2;dbinhalt:= +"EUMELbase.baisy-DB-Verzeichnis"ELIF standardmaskenfeld(ankreuzida)<>""THEN +dbsicherung:=manager3;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"ELSE #25.09 +.90#dbsicherung:=manager4;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"FI ; +dbsicherungCAT sicherung;infeld(floppynamefeld);meldungsfeldlaenge:= +standardfeldlaenge(meldungsfeld).END PROC parametersetzen;PROC +beendenarchivieren:archiveabmelden;enter(2)ENDPROC beendenarchivieren;PROC +ladenstarten:IF stufe=2THEN sicherungsloopELSE stufe1behandlungFI . +stufe1behandlung:eingabepruefen;IF eingabestatus<>0THEN infeld(eingabestatus) +;return(1)ELSE IF auffloppyTHEN archiveanmelden;IF anmeldetask=""THEN return( +1);LEAVE ladenstartenELSE stufe:=2;logeintrag(logbucheintragladen+ +logbuchbehandeltedaten);archiveoperation(dbvondisk,dbsicherung);IF +endequittungdaOR errorTHEN return(1)FI FI ELSE logeintrag(logbucheintragladen ++logbuchbehandeltedaten);archiveoperation(dbzumserver,dbsicherung);return(1) +FI FI .auffloppy:standardmaskenfeld(ankreuzauffloppyladen)<>"".END PROC +ladenstarten;PROC sichernstarten:IF stufe=2THEN sicherungsloopELSE +stufe1behandlungFI ;.stufe1behandlung:eingabepruefen;IF eingabestatus<>0THEN +infeld(eingabestatus);return(1)ELSE IF auffloppyTHEN archiveanmelden;IF +anmeldetask=""THEN return(1);LEAVE sichernstartenELSE stufe:=2; +archiveoperation(dbaufdisk,dbsicherung);IF endequittungdaOR errorTHEN return( +1)FI FI ELSE logeintrag(logbucheintragsichern+logbuchbehandeltedaten); +archiveoperation(dbvomserver,dbsicherung);return(1)FI FI .END PROC +sichernstarten;TEXT PROC logbuchbehandeltedaten:IF standardmaskenfeld( +ankreuzschulis)<>""THEN "Anwendungsdaten"ELIF standardmaskenfeld(ankreuzbaisy +)<>""THEN "Systemdaten"ELIF standardmaskenfeld(ankreuzida)<>""THEN +"Anwenderspezifischen Druckausgaben"ELSE "Amtliche Statistik"FI END PROC +logbuchbehandeltedaten;BOOL PROC auffloppy:standardmaskenfeld( +ankreuzauffloppysichern)<>""ENDPROC auffloppy;PROC formatieren: +archiveanmelden;IF anmeldetask<>""THEN archiveoperation(formatcode, +dbsicherung)FI ;infeld(2);return(2)END PROC formatieren;PROC endeformatieren: +archiveabmelden;enter(2)ENDPROC endeformatieren;PROC initialisieren: +archiveanmelden;IF anmeldetask<>""THEN archiveoperation(initcode,dbsicherung) +FI ;infeld(2);return(2)END PROC initialisieren;PROC disketteueberpruefen: +eingabepruefeneinfach;IF eingabestatus<>0THEN infeld(eingabestatus);return(1) +ELSE standardmeldung(floppyzurpruefung,"");archiveanmelden;IF anmeldetask<>"" +THEN archiveoperation(checkcode,dbsicherung)FI ;infeld(2);return(1)FI END +PROC disketteueberpruefen;PROC floppylisten:eingabepruefeneinfach;IF +eingabestatus<>0THEN infeld(eingabestatus);return(1)ELSE standardmeldung( +floppyzuranzeige,"");archiveanmelden;IF anmeldetask<>""THEN archiveoperation( +listcode,dbsicherung);IF errorTHEN return(1)FI ELSE return(1)FI FI END PROC +floppylisten;PROC dbverzeichniserstellen:eingabepruefeneinfach;IF +eingabestatus<>0THEN infeld(eingabestatus);return(1)ELIF standardmaskenfeld( +ankreuzstatistik)<>""THEN standardmeldung(keinedaten,"");return(1)ELSE +archiveoperation(dddrucken,dbsicherung);FI END PROC dbverzeichniserstellen; +PROC melde(TEXT CONST mt):TEXT CONST mtext:=""+subtext(mt,1, +meldungsfeldlaenge-5)+" ";INT VAR textl:=length(mtext);INT VAR seitenlaenge +:=meldungsfeldlaenge-textl;seitenlaenge:=seitenlaengeDIV 2;TEXT CONST fueller +:=seitenlaenge*" ";TEXT VAR meldung:=fueller+mtext+fueller; +evtlteiltextersetzen;meldungIN meldungsfeld.evtlteiltextersetzen:INT VAR +archpos:=pos(meldung,meldpattern1);IF archpos>0THEN IF NOT (pos(meldung, +meldpattern3)>0)THEN TEXT VAR ergaenztemeldung:=subtext(meldung,1,archpos-1)+ +meldpattern3;INT VAR patternpos2:=archpos+patternlaenge;IF (meldungSUB +patternpos2)=meldpattern2THEN ergaenztemeldungCAT subtext(meldung,patternpos2 ++1)ELSE ergaenztemeldungCAT subtext(meldung,patternpos2)FI ;meldung:= +ergaenztemeldungFI FI .END PROC melde;TEXT PROC frage(TEXT CONST mess):# +subtext(#mess#,textbeginn)#+fragekennzeichnungEND PROC frage;PROC +archiveoperation(INT CONST auftragscode,TEXT CONST sicherungstask):TASK VAR +sendingtask;letzterauftragscode:=auftragscode;dbsicherungstask:=/ +sicherungstask;forget(ds);ds:=nilspace;endequittungda:=FALSE ;error:=FALSE ; +call(dbsicherungstask,auftragscode,ds,quittung);loop.loop:REP SELECT quittung +OF CASE yescode:questionCASE showcode:showenCASE outcode:meldenCASE +endemeldung:beendenCASE errornak:fehlermeldenOTHERWISE :unknowncodeENDSELECT +;UNTIL endequittungdaPER .question:message:=ds;melde(frage(message));LEAVE +archiveoperation.showen:IF auftragscode=listcodeTHEN floppyELSE dbFI .floppy: +forget(dbsicherung,quiet);copy(ds,dbsicherung);floppylistingzeigen;LEAVE +archiveoperation.db:forget(dbinhalt,quiet);copy(ds,dbinhalt); +dbverzeichniszeigen;LEAVE archiveoperation.melden:message:=ds;standardmeldung +(message,"");wartenaufnaechstesendung.wartenaufnaechstesendung:REP forget(ds) +;wait(ds,quittung,sendingtask);IF NOT (sendingtask=dbsicherungstask)THEN +sendnakELSE LEAVE wartenaufnaechstesendungFI PER .beenden:IF +ungleichanmeldenundabmeldenTHEN standardmeldung(meldnr,"");archiveabmelden; +FI ;stufe:=1;endequittungda:=TRUE .meldnr:SELECT auftragscodeOF CASE +formatcode:formatkorrektCASE initcode:initkorrektCASE dbvomserver,dbaufdisk: +sichernkorrektCASE dbzumserver,dbvondisk:ladenkorrektOTHERWISE :opkorrekt +ENDSELECT .ungleichanmeldenundabmelden:auftragscode<>logonarchivecodeCAND +auftragscode<>logoffarchivecode.fehlermelden:message:=ds;standardmeldung( +message,"");IF ungleichanmeldenundabmeldenTHEN archiveabmeldenFI ;stufe:=1; +error:=TRUE ;#return(1);#LEAVE archiveoperation.unknowncode:standardmeldung( +unbekanntercode,": "+text(quittung)+"#");stufe:=1;#return(1);#LEAVE loop. +sendnak:send(sendingtask,nak,ds).ENDPROC archiveoperation;PROC +floppylistingzeigen:editiere(dbsicherung)ENDPROC floppylistingzeigen;PROC +dbverzeichniszeigen:editiere(dbinhalt,FALSE )ENDPROC dbverzeichniszeigen; +PROC endedbverzeichnis:killundenter(2)ENDPROC endedbverzeichnis;PROC +endefloppylisting:archiveabmelden;killundenter(2)ENDPROC endefloppylisting; +PROC archiveanmelden:eingabepruefeneinfach;IF eingabestatus<>0THEN infeld( +eingabestatus);return(1)ELSE archiveoperation(logonarchivecode,dbsicherung); +IF #quittung=endemeldung#endequittungdaCAND NOT errorTHEN anmeldetask:= +dbsicherungELSE anmeldetask:=""FI FI ENDPROC archiveanmelden;PROC +archiveabmelden:IF anmeldetask<>""THEN archiveoperation(logoffarchivecode, +anmeldetask);anmeldetask:=""FI ENDPROC archiveabmelden;PROC meldungquittieren +(BOOL CONST b):BOUND BOOL VAR boolds;forget(ds);ds:=nilspace;boolds:=ds; +boolds:=b;send(/dbsicherung,yescode,ds);forget(ds);IF bTHEN enter(1)ELSE +standardmeldung(inkonsicherung,"");archiveabmelden;#enter(2)#return(2)FI +ENDPROC meldungquittieren;PROC bestimmendersicherungstask: +eingabepruefeneinfach;IF eingabestatus<>0THEN infeld(eingabestatus);return(1) +FI ENDPROC bestimmendersicherungstask;PROC sicherungsloop:TASK VAR +sendingtask;endequittungda:=FALSE ;REP wartenaufnaechstesendung;SELECT +quittungOF CASE yescode:questionCASE outcode:meldenCASE endemeldung:beenden +CASE errornak:fehlermeldenOTHERWISE :unknowncodeENDSELECT ;PER .question: +message:=ds;melde(frage(message));LEAVE sicherungsloop.melden:message:=ds; +standardmeldung(message,"");#wartenaufnaechstesendung#. +wartenaufnaechstesendung:REP forget(ds);wait(ds,quittung,sendingtask);IF NOT +(sendingtask=dbsicherungstask)THEN sendnakELSE LEAVE wartenaufnaechstesendung +FI PER .beenden:standardmeldung(meldnr,"");archiveabmelden;stufe:=1;return(1) +;endequittungda:=TRUE ;LEAVE sicherungsloop.meldnr:SELECT letzterauftragscode +OF CASE dbvomserver,dbaufdisk:sichernkorrektCASE dbzumserver,dbvondisk: +ladenkorrektOTHERWISE :opkorrektENDSELECT .fehlermelden:message:=ds; +standardmeldung(message,"");archiveabmelden;error:=TRUE ;stufe:=1;return(1); +LEAVE sicherungsloop.unknowncode:standardmeldung(unbekanntercode,"");stufe:=1 +;return(1);LEAVE sicherungsloop.sendnak:send(sendingtask,nak,ds).ENDPROC +sicherungsloop;END PACKET sicherungsmonitor + diff --git a/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung b/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung new file mode 100644 index 0000000..1ebb1eb --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung @@ -0,0 +1,35 @@ +PACKET ispstandardmaskenbehandlungDEFINES schulkenndatum, +standardkopfmaskeinitialisieren,standardkopfmaskeausgeben, +standardkopfmaskeaktualisieren,setzeschulnamen,leseschulnamen:LET maskenname= +"mu standardkopf",fnrsystem=2,fnrschule=3,fnrdatum=4,fnrversion=5,fnrtitel=6, +fnrzeit=7;TAG VAR maske;#LET s2="Schulname";#TEXT VAR schuldaten:="";TEXT +VAR zeileschulname:="";TEXT VAR systemname:="";PROC +standardkopfmaskeinitialisieren(TEXT CONST system):setzeschulnamen( +zeileschulname);systemname:=system;initmaske(maske,maskenname)END PROC +standardkopfmaskeinitialisieren;PROC standardkopfmaskeausgeben(TEXT CONST +programmname):TEXT VAR hilfe;hilfe:=systemname;zentrieretext(maske,hilfe, +fnrsystem);fill(maske,hilfe,fnrsystem);fill(maske,schulisversion,fnrversion); +fill(maske,date,fnrdatum);fill(maske,timeofday,fnrzeit);hilfe:=programmname; +zentrieretext(maske,hilfe,fnrtitel);fill(maske,hilfe,fnrtitel);hilfe:= +zeileschulname;zentrieretext(maske,hilfe,fnrschule);fill(maske,hilfe, +fnrschule);show(maske).END PROC standardkopfmaskeausgeben;PROC +standardkopfmaskeaktualisieren(TEXT CONST programmname):TEXT VAR hilfe;put( +maske,timeofday,fnrzeit);hilfe:=programmname;zentrieretext(maske,hilfe, +fnrtitel);put(maske,hilfe,fnrtitel);END PROC standardkopfmaskeaktualisieren; +PROC standardkopfmaskeaktualisieren:put(maske,timeofday,fnrzeit);END PROC +standardkopfmaskeaktualisieren;TEXT PROC leseschulnamen:zeileschulname +ENDPROC leseschulnamen;PROC setzeschulnamen(TEXT CONST schulname): +zeileschulname:=schulnameENDPROC setzeschulnamen;TEXT PROC schulkenndatum( +TEXT CONST schluessel):LET schulkenndaten="c02 schulkenndaten";systemdboff; +inittupel(dnrschluessel);putwert(fnrschlsachgebiet,schulkenndaten);putwert( +fnrschlschluessel,schluessel);search(dnrschluessel,TRUE );IF dbstatus=okTHEN +schuldaten:=wert(fnrschllangtext)ELSE schuldaten:=""FI ;schuldatenENDPROC +schulkenndatum;PROC zentrieretext(TAG CONST maske,TEXT VAR text,INT CONST +feld):INT VAR leerlaenge;TEXT VAR leertext;LET leerzeichen=" ";leerlaenge:=( +length(maske,feld)-length(text));IF (leerlaenge>0)THEN leertext:=(leerlaenge +DIV 2)*leerzeichen;text:=leertext+text+leertext;IF (leerlaengeMOD 2<>0)THEN +text:=text+leerzeichenFI ;FI ;END PROC zentrieretext;END PACKET +ispstandardmaskenbehandlung;oeffnedatenbank(schulisdbname);setzeschulnamen( +schulkenndatum("Schulname"));setzeschulisversion("2.2.1"); +standardkopfmaskeinitialisieren("schulis") + diff --git a/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung b/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung new file mode 100644 index 0000000..8b2f189 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung @@ -0,0 +1,236 @@ +PACKET systembaumbearbeitungneuDEFINES loescheteilbaeume, +teilbaeumeaussystembaum,uebersetze:LET dp=":",refinementende=".";LET grenze=6 +;LET fehldat="Übersetzungsfehler:";FILE VAR quelle;KNOTENMENGE VAR ang,nach; +TEXT VAR newsymbol:="";INT VAR newkind;TEXT VAR aktzeile:="";INT VAR +zeilenindex;ROW grenzeTEXT VAR at;FILE VAR f;INT CONST maxat:=6,tepos:=1,mpos +:=2,vpos:=3,npos:=4,tpos:=5,ppos:=6;LET normkz="0",refkz="1";LET scanende=7, +scanbold=2,scantext=4,scandel=6,scannumber=3,scanid=1;TEXT PROC attribute( +KNOTEN CONST k):TEXT VAR attr;read(k,attr);attrEND PROC attribute;BOOL PROC +isrefinement(KNOTEN CONST k):(subtext(attribute(k),1,1)=refkz)END PROC +isrefinement;BOOL PROC isnormal(KNOTEN CONST k):(subtext(attribute(k),1,1)= +normkz)END PROC isnormal;BOOL PROC isopen(KNOTEN CONST k):NOT (isrefinement(k +)COR isnormal(k))END PROC isopen;PROC mengedernachfolger(KNOTEN CONST k, +KNOTENMENGE VAR m):read(k,m)END PROC mengedernachfolger;PROC +neuenachfolgermenge(KNOTEN CONST k,KNOTENMENGE CONST m):write(k,m)END PROC +neuenachfolgermenge;PROC loescheteilbaeume(TEXT CONST datnam,BOOL VAR +gefunden):bearbeiteteilbaeume(datnam,PROC (TEXT CONST ,BOOL VAR )loesche, +gefunden)END PROC loescheteilbaeume;PROC teilbaeumeaussystembaum(TEXT CONST +datnam,BOOL VAR gefunden):bearbeiteteilbaeume(datnam,PROC (TEXT CONST ,BOOL +VAR )retranslate,gefunden)END PROC teilbaeumeaussystembaum;PROC +bearbeiteteilbaeume(TEXT CONST datnam,PROC (TEXT CONST ,BOOL VAR )behandle, +BOOL VAR gefunden):ersterteilbaum;WHILE weitereteilbaeumeREP behandleteilbaum +;naechsterteilbaumPER .behandleteilbaum:behandle(teilbaumname,gefunden);IF +NOT gefundenTHEN line(f,2);putline(f,"(* Teilbaum "+teilbaumname+ +" existiert nicht *)");FI ;nextsymbol(newsymbol,typ).ersterteilbaum:f:= +sequentialfile(input,datnam);TEXT VAR liste;getline(f,liste);forget(datnam, +quiet);f:=sequentialfile(output,datnam);scan(liste);naechsterteilbaum. +naechsterteilbaum:TEXT VAR teilbaumname;INT VAR typ;nextsymbol(teilbaumname, +typ).weitereteilbaeume:typ<>scanende.END PROC bearbeiteteilbaeume;PROC +loesche(TEXT CONST teilbaumname,BOOL VAR gefunden):sucheteilbaum;IF gefunden +THEN loeschediesenFI .sucheteilbaum:KNOTEN VAR teilbaumref;gefunden:= +existiert(exporte,teilbaumref,teilbaumname).loeschediesen:#loescheunterbaum( +teilbaumref);KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);KNOTEN VAR r +:=erster(g);IF gueltig(r)THEN knotenloeschen(g,r)FI ;knotenloeschen(exporte, +teilbaumref)#KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);KNOTEN VAR r +:=erster(g);loescheunterbaum(teilbaumref);IF gueltig(r)THEN knotenloeschen(g, +r)FI ;knotenloeschen(exporte,teilbaumref).END PROC loesche;PROC retranslate( +TEXT CONST teilbaumname,BOOL VAR gefunden):sucheteilbaum;IF gefundenTHEN +schreibeteilbaumname;durchlaufeteilbaum;schreibeteilbaumendeFI .sucheteilbaum +:KNOTEN VAR teilbaumref;gefunden:=existiert(exporte,teilbaumref,teilbaumname) +.schreibeteilbaumname:putline(f,attribute(teilbaumref)+dp). +schreibeteilbaumende:putline(f,refinementende).durchlaufeteilbaum: +KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);ausbaum(erster(g),1).END +PROC retranslate;PROC ausbaum(KNOTEN CONST k,INT CONST stufe):stufennummer; +IF istnochnichtdefiniertTHEN refinementnameschreiben; +nochnichtdefiniertschreibenELIF istrefinementTHEN +refinementsuchenundschreibenELSE notierediesen;durchlaufeallesoehneFI . +istrefinement:(isrefinement(k))CAND (stufe>1).istnochnichtdefiniert:isopen(k) +.notierediesen:elemente(k,vorschub,zeile).stufennummer:TEXT VAR vorschub:= +stufe*" ";TEXT VAR zeile:=vorschub+text(stufe);vorschub:=vorschub+" ". +refinementnameschreiben:KNOTEN VAR knoten:=k;refinementname.refinementname: +put(f,zeile+" "+attribute(knoten));line(f).nochnichtdefiniertschreiben:put(f, +vorschub+" (* ist noch nicht definiert *)");line(f). +refinementsuchenundschreiben:read(k,knoten);refinementname. +durchlaufeallesoehne:KNOTENMENGE VAR soehne;mengedernachfolger(k,soehne); +KNOTEN VAR sohn:=erster(soehne);WHILE gueltig(sohn)REP ausbaum(sohn,stufe+1); +naechster(sohn,soehne)PER .END PROC ausbaum;PROC elemente(KNOTEN CONST k, +TEXT CONST vorschub,TEXT CONST zeil):TEXT VAR at,zeile:=zeil;tex;mask;vorproz +;nachproz;tast;prozess;absatz.tex:zeile:=zeile+" TEXT """+text(k)+"""";put(f, +zeile).mask:at:=maske(k);IF at<>""THEN put(f,";");line(f);zeile:=vorschub+ +"MASKE """+at+"""";put(f,zeile)FI .prozess:at:=task(k);IF at<>""THEN put(f, +";");line(f);zeile:=vorschub+"TASK """+at+"""";put(f,zeile)FI .vorproz:at:= +vorprozedur(k);IF at<>""THEN put(f,";");line(f);zeile:=vorschub+"> "+at;put(f +,zeile)FI .nachproz:at:=nachprozedur(k);IF at<>""THEN put(f,";");line(f); +zeile:=vorschub+"< "+at;put(f,zeile)FI .tast:at:=taste(k);IF at<>""THEN put(f +,";");line(f);zeile:=vorschub+"TASTE """+at+"""";put(f,zeile)FI .absatz:line( +f).END PROC elemente;TEXT PROC maske(KNOTEN CONST k):attribut(k,mpos)END +PROC maske;TEXT PROC task(KNOTEN CONST k):attribut(k,ppos)END PROC task;TEXT +PROC vorprozedur(KNOTEN CONST k):attribut(k,vpos)END PROC vorprozedur;TEXT +PROC nachprozedur(KNOTEN CONST k):attribut(k,npos)END PROC nachprozedur;TEXT +PROC taste(KNOTEN CONST k):attribut(k,tpos)END PROC taste;TEXT PROC attribut( +KNOTEN CONST k,INT CONST i):TEXT VAR attext;attext:=attribute(k);TEXT VAR +amuster:="��",emuster:="��";replace(amuster,1,i);replace(emuster,1,i+1);INT +VAR ende,anfang;anfang:=pos(attext,amuster)+2;IF i")OR is("<")OR is("MASKE")OR is("TASTE")OR is("TASK"))END +PROC iskeybold;BOOL PROC istext:(newkind=scantext)END PROC istext;BOOL PROC +isdelimiter:(newkind=scandel)END PROC isdelimiter;BOOL PROC isprocedure(TEXT +VAR t):IF NOT isidTHEN FALSE ELSE t:=newsymbol;next;IF is("(")THEN INT VAR +klammernzaehler:=0;REP IF is("(")THEN klammernzaehlerINCR 1ELIF is(")")THEN +klammernzaehlerDECR 1FI ;IF istextTHEN t:=t+""""+newsymbol+""""ELSE t:=t+ +newsymbolFI ;nextUNTIL (klammernzaehler=0)PER FI ;is(";")COR israndFI END +PROC isprocedure;BOOL PROC isnumber:(newkind=scannumber)END PROC isnumber; +BOOL PROC isid:(newkind=scanid)END PROC isid;PROC next:nextsymbol(newsymbol, +newkind);WHILE (newkind=scanende)CAND (NOT eof(quelle))REP getline(quelle, +aktzeile);continuescan(aktzeile);aktuellezeile;nextsymbol(newsymbol,newkind); +PER ;END PROC next;PROC lies(TEXT CONST t):IF NOT (t=newsymbol)THEN fehler(t) +ELSE nextFI END PROC lies;PROC fehler(TEXT CONST f):FILE VAR fd:= +sequentialfile(output,fehldat);TEXT VAR t:="Fehler bei : """;t:=t+newsymbol+ +""" in Zeile "+text(zeilenindex)+" , ";line(fd,5);putline(fd,t);t:= +"denn erwartet wurde: """;t:=t+f;t:=t+""" ";putline(fd,t);close(fd);stop +END PROC fehler;PROC initparser:initscanner;END PROC initparser;PROC +initscanner:getline(quelle,aktzeile);scan(aktzeile);page;cursor(1,3);put( +"Bearbeitet wird zur Zeit Zeile: ");zeilenindex:=1;aktuellezeile;END PROC +initscanner;PROC aktuellezeile:cursor(33,3);put(zeilenindex);zeilenindexINCR +1;END PROC aktuellezeile;PROC systembaum:enablestop;initparser; +initialisieretemporaeregruppen;next;REP benannterteilbaum;nextUNTIL dateiende +PER ;meldesyntaxkorrekt;uebernehmeindenbestand.initialisieretemporaeregruppen +:ang:=leereknotenmenge;nach:=leereknotenmenge.meldesyntaxkorrekt:line(5);put( +" * * * E i n g a b e i s t k o r r e k t * * * ");line(5);put( +" * * * Ü b e r n a h m e i n M e n ü b a u m * * * ").END PROC +systembaum;PROC benannterteilbaum:IF NOT isidTHEN fehler("Teilbaumname")FI ; +erzeugeangebotsundsystemknotenaunds;next;baum(s);sistnachfolgervona; +aistbezugsknotenvons.erzeugeangebotsundsystemknotenaunds:KNOTEN VAR a:= +neuerknoten(ang);aHAT newsymbol;KNOTEN VAR s:=neuerknoten(system). +sistnachfolgervona:sNACH a.aistbezugsknotenvons:sBEZUG a.END PROC +benannterteilbaum;PROC baum(KNOTEN VAR node):INT VAR i0;lies(":");IF NOT +isnumberTHEN fehler("Stufennummer")FI ;i0:=int(newsymbol);next; +knotenattribute(node);zeigerefinementan;unterbaum(i0,node).zeigerefinementan: +TEXT VAR t:=attribute(node);replace(t,1,"1");nodeHAT t.END PROC baum;PROC +unterbaum(INT CONST j,KNOTEN VAR node):INT CONST k:=int(newsymbol);IF NOT +isnumberTHEN IF NOT schlussTHEN fehler("Stufennummer oder Ende")ELSE LEAVE +unterbaumFI FI ;IF j>=kTHEN LEAVE unterbaumFI ;next;erzeugeneuensohns; +dieseristinsystemnachfolgervonnode;sohn(k,s,node);soehne(k,node). +erzeugeneuensohns:KNOTEN VAR s:=neuerknoten(system). +dieseristinsystemnachfolgervonnode:sNACH node.END PROC unterbaum;PROC soehne( +INT CONST j,KNOTEN VAR node):INT CONST k:=int(newsymbol);IF NOT isnumberTHEN +IF NOT schlussTHEN fehler("Stufennummer oder Ende")ELSE LEAVE soehneFI FI ; +IF j>kTHEN LEAVE soehneFI ;IF NOT (j=k)THEN fehler("gleiche Stufennummer")FI +;next;erzeugeneuensohns;dieseristinsystemnachfolgervonnode;sohn(j,s,node); +soehne(j,node).erzeugeneuensohns:KNOTEN VAR s:=neuerknoten(system). +dieseristinsystemnachfolgervonnode:sNACH node.END PROC soehne;PROC sohn(INT +CONST k,KNOTEN VAR node,vater):IF iskeyboldTHEN knotenattribute(node); +unterbaum(k,node)ELSE IF NOT isidTHEN fehler( +"ein Teilbaumname oder Schlüsselwort")ELSE erzeugeneuenachfrageninnach; +setzevateralsnachfolgervonn;next;FI FI .erzeugeneuenachfrageninnach:KNOTEN +VAR n:=neuerknoten(nach,newsymbol).setzevateralsnachfolgervonn:IF sohnvon(n, +vater)THEN fehler(newsymbol+" nur einmal als Sohn auf Level "+text(k))FI ; +vaterNACH n;nodeHAT newsymbol.END PROC sohn;PROC knotenattribute(KNOTEN VAR +node):initialisierehilfsvariablen;TEXT VAR t;attribut;WHILE iskeyboldREP +attributPER ;IF ((NOT isnumber)CAND (NOT schluss))THEN fehler( +"Attribut oder Stufennummer")ELSE abschliessendebehandlungFI . +initialisierehilfsvariablen:INT VAR i:=0;t:="0";FOR iFROM 1UPTO maxatREP at(i +):=""PER .abschliessendebehandlung:merke(t);nodeHAT t.END PROC +knotenattribute;PROC attribut:TEXT VAR procname;IF is("TEXT")THEN next;IF +NOT istextTHEN fehler("ein Menuetext")FI ;setze(newsymbol,tepos);next;IF NOT +israndTHEN lies(";")FI ELSE IF is(">")THEN next;IF NOT isprocedure(procname) +THEN fehler("ein Vor-Prozedur-Aufruf")FI ;setze(procname,vpos);IF NOT isrand +THEN nextFI ELSE IF is("<")THEN next;IF NOT isprocedure(procname)THEN fehler( +"ein Nach-Prozedur-Aufruf")FI ;setze(procname,npos);IF NOT israndTHEN nextFI +ELSE IF is("MASKE")THEN next;IF NOT istextTHEN fehler("ein Maskenname")FI ; +setze(newsymbol,mpos);next;IF NOT israndTHEN lies(";")FI ELSE IF is("TASTE") +THEN next;IF NOT istextTHEN fehler("ein Funktionstastenname")FI ;setze( +newsymbol,tpos);next;IF NOT israndTHEN lies(";")FI ELSE IF is("TASK")THEN +next;IF NOT istextTHEN fehler("ein Taskname")FI ;setze(newsymbol,ppos);next; +IF NOT israndTHEN lies(";")FI ELSE fehler("ein Schlüsselwort")FI FI FI FI FI +FI END PROC attribut;PROC setze(TEXT CONST t,INT CONST i):at(i):=tEND PROC +setze;PROC merke(TEXT VAR t):INT VAR i;TEXT VAR muster:="��";FOR iFROM 1UPTO +maxatREP replace(muster,1,i);tCAT muster;tCAT at(i)PER END PROC merke;PROC +uebersetze(TEXT CONST t,BOOL VAR fehler):quelle:=sequentialfile(input,t);INT +CONST azahl:=zahlderelemente(exporte),szahl:=zahlderelemente(system),nzahl:= +zahlderelemente(importe);clearerror;disablestop;kopieresystembaum;systembaum; +IF iserrorTHEN fehler:=TRUE ;setzesystembaumzurueck;LEAVE uebersetzeFI ; +fehler:=FALSE ;line(3);put( +" * * * Ü b e r n a h m e i s t b e e n d e t * * * ");line(2); +statistik(azahl,szahl,nzahl);line(2);put( +" * * * D a t e n b a n k b e r e i n i g u n g * * * ");loesche; +ueberschreibesystembaumEND PROC uebersetze;PROC statistik(INT CONST az,sz,nz) +:INT CONST agesz:=zahlderelemente(exporte),sgesz:=zahlderelemente(system), +ngesz:=zahlderelemente(importe);put("Zahl der Systembaumknoten insgesamt: "); +put(sgesz);INT CONST sdif:=sgesz-sz,ndif:=ngesz-nz;line;IF sdif<0THEN put( +"Entfernte Systemknoten: "+text(-sdif));ELSE put( +"Neu erzeugte Systemknoten: "+text(sdif));FI ;line;put( +"Neu definierte Teilbäume: "+text(agesz-az));line;IF ndif<0THEN put( +"Abgedeckte Teilbaumreferenzen: "+text(-ndif))ELSE put( +"Zusätzliche offene Teilbaumreferenzen: "+text(ndif))FI END PROC statistik; +PROC loesche:knotenmengeloeschen(ang);knotenmengeloeschen(nach)END PROC +loesche;OP VEREINIGT (KNOTENMENGE VAR a,KNOTENMENGE CONST b):KNOTEN VAR k:= +erster(b);WHILE gueltig(k)REP a+k;naechster(k,b)PER ;END OP VEREINIGT ;OP +( +KNOTENMENGE VAR a,KNOTEN CONST b):inknotenmenge(a,b);END OP +;PROC +uebernehmeindenbestand:startepruefungmitneu;WHILE gueltig(neu)REP +pruefenderexporte;IF schondaTHEN aenderungELSE neuanlegenFI PER ; +abgleichenvonexportenundimporten.startepruefungmitneu:KNOTEN VAR neu:=erster( +ang);KNOTEN VAR alt;BOOL VAR gleich.pruefenderexporte:gleich:=existiert( +exporte,alt,attribute(neu)).schonda:gleich.aenderung: +loeschealleknotendesaltenrefinements;neuanlegenbisaufdenursprung. +loeschealleknotendesaltenrefinements:rettebisherigenursprung; +gehevomursprungausundloescheallesausserrefinements.rettebisherigenursprung: +KNOTENMENGE VAR u;mengedernachfolger(alt,u);KNOTEN VAR ursprung:=erster(u). +gehevomursprungausundloescheallesausserrefinements:loescheunterbaum(ursprung) +.neuanlegenbisaufdenursprung:raufnachfolgervonneusetzen; +derursprungwirdueberschrieben.raufnachfolgervonneusetzen:KNOTENMENGE VAR root +;KNOTEN VAR r;mengedernachfolger(neu,root);r:=erster(root). +derursprungwirdueberschrieben:move(r,ursprung);knotenloeschen(root,r); +knotenloeschen(ang,neu).neuanlegen:inknotenmenge(exporte,neu,alt); +ausknotenmenge(ang,neu).abgleichenvonexportenundimporten:KNOTENMENGE VAR +abzudeckendenachfragen;KNOTENMENGE VAR nachfragesoehne;BOOL VAR gibtes;TEXT +VAR importname;KNOTEN VAR importeinordner,importbezug;festimport:=erster( +importe);WHILE gueltig(festimport)REP importname:=attribute(festimport); +abgleichmitimporten;abgleichabschlussPER ;KNOTEN VAR aktimport:=erster(nach); +WHILE gueltig(aktimport)REP importname:=attribute(aktimport); +versucheabgleichmitexporten;IF gelungenTHEN importbezug:=aktimport; +fuehreabgleichmitexportendurch;knotenloeschen(nach,aktimport)ELSE gibtes:= +existiert(importe,importeinordner,importname);inknotenmenge(importe,aktimport +,importeinordner);ausknotenmenge(nach,aktimport)FI ;PER .abgleichabschluss: +versucheabgleichmitexporten;IF gelungenTHEN importbezug:=festimport; +fuehreabgleichmitexportendurch;knotenloeschen(importe,festimport)ELSE +naechster(festimport,importe)FI .versucheabgleichmitexporten:KNOTEN VAR +aktexport;BOOL VAR gelungen;gelungen:=existiert(exporte,aktexport,importname) +.abgleichmitimporten:KNOTEN VAR festimport;gelungen:=existiert(nach,aktimport +,importname);IF gelungenTHEN verschmelzung;knotenloeschen(nach,aktimport)FI . +verschmelzung:KNOTENMENGE VAR nfa;mengedernachfolger(aktimport,nfa); +KNOTENMENGE VAR nfn;mengedernachfolger(festimport,nfn);nfnVEREINIGT nfa. +fuehreabgleichmitexportendurch:finderefinementwurzel; +markiererefinementalsbenutzt;sammlenachfragen;WHILE nochimbereichREP +deckenachfrageabPER .finderefinementwurzel:KNOTEN VAR refinementwurzel; +KNOTENMENGE VAR exportiertesrefinement;mengedernachfolger(aktexport, +exportiertesrefinement);refinementwurzel:=erster(exportiertesrefinement). +markiererefinementalsbenutzt:write(aktexport,markierungsknoten). +sammlenachfragen:mengedernachfolger(importbezug,abzudeckendenachfragen); +KNOTEN VAR behandelterimport:=erster(abzudeckendenachfragen).nochimbereich: +gueltig(behandelterimport).naechsterimport:naechster(behandelterimport, +abzudeckendenachfragen).deckenachfrageab:findeungesaettigtensohn;IF gueltig( +zuersetzendersohn)THEN ersetzediesendurchrefinement;naechsterimportELSE +ausknotenmenge(abzudeckendenachfragen,behandelterimport)FI . +findeungesaettigtensohn:KNOTEN VAR zuersetzendersohn;mengedernachfolger( +behandelterimport,nachfragesoehne);zuersetzendersohn:=erster(nachfragesoehne) +;WHILE gueltig(zuersetzendersohn)CAND nochnichtgefundenREP naechster( +zuersetzendersohn,nachfragesoehne)PER .nochnichtgefunden:(NOT isopen( +zuersetzendersohn))COR (NOT (attribute(zuersetzendersohn)=attribute( +importbezug))).ersetzediesendurchrefinement:knotenloeschen(nachfragesoehne, +zuersetzendersohn);inknotenmenge(nachfragesoehne,refinementwurzel, +zuersetzendersohn).END PROC uebernehmeindenbestand;PROC loescheunterbaum( +KNOTEN CONST node):KNOTENMENGE VAR m;mengedernachfolger(node,m);KNOTEN VAR k +:=erster(m);WHILE gueltig(k)REP IF NOT isrefinement(k)THEN loescheunterbaum(k +);knotenloeschen(m,k)ELSE ausknotenmenge(m,k);FI PER END PROC +loescheunterbaum;END PACKET systembaumbearbeitungneu; + diff --git a/app/baisy/2.2.1-schulis/src/isp.systembaumeditor b/app/baisy/2.2.1-schulis/src/isp.systembaumeditor new file mode 100644 index 0000000..ffd3b6c --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.systembaumeditor @@ -0,0 +1,72 @@ +PACKET systembaumeditorDEFINES startsystembaumeditor,aktuellensenamenlesen, +baumausdatei,baumausdateizeigen,baumausdateiuebersetzen, +systembaumreorganisieren,listederteilbaumdateien,listederteilbaeume, +erwartereaktion,baumaendern,baumloeschen,eingangsbildschirmherstellen, +internenbaumzeigen,internenbaumuebersetzen:LET z="Teilbaumliste",trenner=",", +praefix="b.",standardanfang=2,maxfelder=10,reorg=0,dummy="dummy",baumdatei=1, +teilbaeume=2,maskese1="mb baumdateibearbeitung",maskese2= +"mb teilbaumbearbeitung",maxnamenlaenge=32,fehldat="Übersetzungsfehler:";; +BOOL VAR fehler:=FALSE ;FILE VAR f;TEXT VAR namen:="";TEXT VAR dnam:="";;TAG +VAR aktuellemaske;INT VAR aktuelleposition;ROW 100TEXT VAR feld;INT VAR prog, +teilbaumzahl;init(feld);PROC startsystembaumeditor(INT CONST kennung): +werbinich;frageentwicklernachdemnamen;aktuellensenamenlesen.werbinich:TEXT +VAR maskenname;SELECT kennungOF CASE baumdatei:maskenname:=maskese1CASE +teilbaeume:maskenname:=maskese2END SELECT ;prog:=kennung. +frageentwicklernachdemnamen:page;IF exists(dnam)THEN forget(dnam,quiet)FI ; +IF exists(namen)THEN rename(namen,praefix+namen)FI ;aktuelleposition:= +standardanfang;standardkopfmaskeausgeben(text(vergleichsknoten));initmaske( +aktuellemaske,maskenname);show(aktuellemaske).END PROC startsystembaumeditor; +PROC aktuellensenamenlesen:putget(aktuellemaske,feld,aktuelleposition);namen +:=eingegebenenamen;loeschemeldung(aktuellemaske).END PROC +aktuellensenamenlesen;PROC baumausdatei:IF namen=""THEN melde(aktuellemaske, +43);return(1)ELSE IF istree(namen)THEN meldeohneb;return(1)ELSE f:= +sequentialfile(output,praefix+namen);close(f);baumausdateizeigenFI FI . +meldeohneb:melde(aktuellemaske,44).END PROC baumausdatei;PROC +baumausdateizeigen:store(FALSE );page;TEXT VAR t:=praefix+namen;IF exists(t) +THEN rename(t,namen)FI ;IF exists(fehldat)THEN forget(fehldat,quiet)FI ; +editiere(namen,"ae",FALSE );store(TRUE )END PROC baumausdateizeigen;PROC +systembaumreorganisieren:FILE VAR f:=sequentialfile(output,dummy);close(f); +dnam:=dummy;baumverarbeitung(dnam,reorg);eingangsbildschirmherstellen(1)END +PROC systembaumreorganisieren;PROC baumausdateiuebersetzen:translate(namen, +fehler);rename(namen,praefix+namen);IF fehlerTHEN erwartereaktionELSE +eingangsbildschirmherstellen(2)FI END PROC baumausdateiuebersetzen;PROC +baumaendern:baumbearbeiten(1)END PROC baumaendern;PROC baumloeschen: +baumbearbeiten(2)END PROC baumloeschen;PROC baumbearbeiten(INT CONST wie): +TEXT VAR t:="";meldesuche;dnam:=subtext(namen,1,maxnamenlaenge);t:= +bearbeitung(namen,wie);IF (t="")CAND teilbaumzahl=1THEN meldemisserfolg; +return(1)ELSE loeschemeldung(aktuellemaske);IF loeschenundkeinfehlerTHEN +eingangsbildschirmherstellen(1);meldeloeschungELSE internenbaumzeigenFI FI . +meldesuche:melde(aktuellemaske,24).meldemisserfolg:melde(aktuellemaske,25). +meldeloeschung:melde(aktuellemaske,51).loeschenundkeinfehler:(wie=2)AND (t<> +"").END PROC baumbearbeiten;PROC internenbaumzeigen:IF exists(fehldat)THEN +forget(fehldat,quiet)FI ;store(FALSE );page;editiere(dnam,"a",FALSE );store( +TRUE )END PROC internenbaumzeigen;PROC internenbaumuebersetzen:store(FALSE ); +translate(dnam,fehler);store(TRUE );IF fehlerTHEN erwartereaktionELSE +eingangsbildschirmherstellen(2)FI END PROC internenbaumuebersetzen;PROC +listederteilbaeume:meldezusammenstellung;transactionlistederteilbaeume; +zeigenderteilbaumliste.meldezusammenstellung:melde(aktuellemaske,7).END PROC +listederteilbaeume;PROC listederteilbaumdateien:melde(aktuellemaske,7);FILE +VAR f;f:=sequentialfile(output,z);line(f);beginlist;TEXT VAR s:="",t:=" "; +REP getlistentry(s,t);IF istree(s)THEN put(f,t);put(f,s);line(f)FI UNTIL t="" +PER ;close(f);sort(z);zeigenderteilbaumliste.END PROC listederteilbaumdateien +;BOOL PROC istree(TEXT VAR t):INT VAR i;i:=pos(t,praefix);IF i>0THEN t:=3*" " ++subtext(t,i+2,length(t))FI ;i>0END PROC istree;PROC zeigenderteilbaumliste: +page;editiere(z)END PROC zeigenderteilbaumliste;PROC erwartereaktion:store( +FALSE );page;store(TRUE );IF fehlerTHEN editiere(fehldat,"a")FI ;END PROC +erwartereaktion;PROC transactionlistederteilbaeume:f:=sequentialfile(output,z +);TEXT VAR dateiname:=z;baumverarbeitung(dateiname,1)END PROC +transactionlistederteilbaeume;PROC translate(TEXT CONST t,BOOL VAR b):TEXT +VAR dateiname:=t;baumverarbeitung(dateiname,2);b:=(dateiname<>t)END PROC +translate;TEXT PROC bearbeitung(TEXT CONST t,INT CONST wie):f:=sequentialfile +(output,dnam);putline(f,t);TEXT VAR dateiname:=dnam;INT VAR methode:=2+wie; +IF teilbaumzahl>1THEN methodeINCR 2FI ;baumverarbeitung(dateiname,methode); +dateinameEND PROC bearbeitung;PROC eingangsbildschirmherstellen(INT CONST i): +reorganizescreen;return(i);IF exists(dnam)THEN forget(dnam,quiet)FI ; +standardkopfmaskeaktualisierenEND PROC eingangsbildschirmherstellen;TEXT +PROC eingegebenenamen:IF prog=baumdateiTHEN teilbaumzahl:=1;feld( +standardanfang)ELSE teilbaumzahl:=0;INT VAR i;TEXT VAR t:="";FOR iFROM +standardanfangUPTO maxfelderREP IF feld(i)<>""THEN teilbaumzahlINCR 1;IF t<> +""THEN tCAT trennerFI ;tCAT feld(i)FI PER ;tFI END PROC eingegebenenamen; +PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR iFROM 1UPTO 100REP feld(i):="" +PER END PROC init;END PACKET systembaumeditor; + diff --git a/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet b/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet new file mode 100644 index 0000000..0e8b352 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet @@ -0,0 +1,13 @@ +PACKET zusatzarchivepacketDEFINES yes,out,show,ordertask:LET yescode=10, +outcode=11,showcode=12;TASK VAR ordert:=niltask;BOUND BOOL VAR boolds;BOUND +TEXT VAR textds;#BOUND FILE VAR fileds;#DATASPACE VAR ds;INT VAR replycode; +PROC ordertask(TASK CONST ot):ordert:=otENDPROC ordertask;TASK PROC ordertask +:ordertENDPROC ordertask;BOOL PROC yes(TEXT CONST quest):BOOL VAR b;initds; +textds:=ds;textds:=quest;call(ordertask,yescode,ds,replycode);IF replycode= +yescodeTHEN ordentlichesendungELSE FALSE FI .ordentlichesendung:boolds:=ds;b +:=CONCR (boolds);forget(ds);b.ENDPROC yes;PROC out(TEXT CONST txt):initds; +textds:=ds;textds:=txt;send(ordertask,outcode,ds,replycode)ENDPROC out;PROC +show(TEXT CONST t):forget(ds);ds:=old(t);send(ordertask,showcode,ds,replycode +)ENDPROC show;PROC initds:forget(ds);ds:=nilspaceENDPROC initds;ENDPACKET +zusatzarchivepacket; + diff --git a/app/baisy/2.2.1-schulis/src/konvert b/app/baisy/2.2.1-schulis/src/konvert new file mode 100644 index 0000000..098e253 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/konvert @@ -0,0 +1,18 @@ +PACKET konvertDEFINES highbyte,lowbyte,word,changelowbyte,changehighbyte,dint +,highword,lowword:INT PROC highbyte(INT CONST value):TEXT VAR x:=" ";replace +(x,1,value);code(xSUB 2)END PROC highbyte;INT PROC lowbyte(INT CONST value): +TEXT VAR x:=" ";replace(x,1,value);code(xSUB 1)END PROC lowbyte;INT PROC +word(INT CONST lowbyte,highbyte):TEXT CONST x:=code(lowbyte)+code(highbyte);x +ISUB 1END PROC word;PROC changelowbyte(INT VAR word,INT CONST lowbyte):TEXT +VAR x:=" ";replace(x,1,word);replace(x,1,code(lowbyte));word:=xISUB 1END +PROC changelowbyte;PROC changehighbyte(INT VAR word,INT CONST highbyte):TEXT +VAR x:=" ";replace(x,1,word);replace(x,2,code(highbyte));word:=xISUB 1END +PROC changehighbyte;REAL PROC dint(INT CONST lowword,highword):reallowword+ +65536.0*realhighword.reallowword:real(lowbyte(lowword))+256.0*real(highbyte( +lowword)).realhighword:real(lowbyte(highword))+256.0*real(highbyte(highword)) +.END PROC dint;INT PROC highword(REAL CONST doubleprecissionint):int( +doubleprecissionint/65536.0)END PROC highword;INT PROC lowword(REAL CONST +doubleprecissionint):stringoflowbytesISUB 1.stringoflowbytes:code(int( +doubleprecissionintMOD 256.0))+code(int((doubleprecissionintMOD 65536.0)/ +256.0)).END PROC lowword;END PACKET konvert; + diff --git a/app/baisy/2.2.1-schulis/src/log.eintrag b/app/baisy/2.2.1-schulis/src/log.eintrag new file mode 100644 index 0000000..27dfea2 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/log.eintrag @@ -0,0 +1,14 @@ +PACKET logeintragDEFINES logeintrag:LET eintragtextorder=201,nak=1, +logmanagername="LOG";INT VAR reply;BOUND TEXT VAR msg;PROC logeintrag(TEXT +CONST messagetext):INT VAR dummy;logeintrag(messagetext,dummy)END PROC +logeintrag;PROC logeintrag(TEXT CONST messagetext,INT VAR returncode): +DATASPACE VAR ds:=nilspace;msg:=ds;CONCR (msg):=messagetext;logauftrag( +eintragtextorder,ds,returncode);forget(ds).END PROC logeintrag;PROC +logauftrag(INT CONST opcode,DATASPACE VAR ds,INT VAR returncode): +verschickeauftrag;bearbeiteggfantwort.verschickeauftrag: +verschickeauftrageinmal;verschickeauftragggfnochmal.verschickeauftrageinmal: +call(/logmanagername,opcode,ds,reply).verschickeauftragggfnochmal:WHILE +auftragnichtangenommenREPEAT pause(10);verschickeauftrageinmalEND REPEAT . +auftragnichtangenommen:reply=nak.bearbeiteggfantwort:returncode:=reply.END +PROC logauftrag;END PACKET logeintrag + diff --git a/app/baisy/2.2.1-schulis/src/log.manager b/app/baisy/2.2.1-schulis/src/log.manager new file mode 100644 index 0000000..d49e048 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/log.manager @@ -0,0 +1,126 @@ +PACKET logmanagerDEFINES logmanager:LET zeilenwahl=10000,spaltenwahl=70;LET +maxzeilenprologdatei=4000;INT CONST logdateien:=max(2,zeilenwahlDIV +maxzeilenprologdatei+sign(zeilenwahlMOD maxzeilenprologdatei)), +zeilenprologdatei:=zeilenwahlDIV logdateien,logzeilen:=zeilenprologdatei* +logdateien,logspalten:=spaltenwahl,kritischelogzeilenanzahl:=(logzeilenDIV 5) +*4;LET eintragfileorder=200,eintragtextorder=201,readloglimitsorder=202, +logholenorder=301,gesichertvermerk=306,loeschenorder=307,ack=0,logack=7, +letzteslogack=8,kritischegrenzeerreichtack=9,dateiexistiertnichtack=10, +dateinichtgesichertack=11,meldungloggeloescht=" gelöscht", +seitenwechselanweisung="",niltext="",zeilenproseite=60,nureinzeiligereintrag= +1,maxlogdateien=8,vaterallerprivtasks="anwendung",logmanagername="LOG", +lognamepre="logbuch.",lognamedatumzeittrenner="/",vonbistrenner="-",taskpre= +", Task: ",terminalname=" Term.";BOUND TEXT VAR msg;FILE VAR logfile; +DATASPACE VAR ds;INT CONST laengeseitenwechselanweisung:=LENGTH +seitenwechselanweisung;INT VAR seitenzeile,zeiger,ersteslog,letzteslog, +benutztelogzeilen;TEXT VAR eintragssatz;INT VAR terminalnr;BOOL VAR +datumneuinlogschreiben:=TRUE ;LET LLIMITS =STRUCT (INT zeilen,zeilenbenutzt, +zeilenkritisch),LDATEN =STRUCT (REAL von,bis,BOOL gesichert,INT zeilen), +LOGBUCH =STRUCT (LDATEN daten,DATASPACE inhalt);ROW maxlogdateienLOGBUCH VAR +log;BOUND LLIMITS VAR loggrenzenmsg;PROC logmanager:enablestop;IF name(myself +)<>logmanagernameTHEN renamemyself(logmanagername)END IF ;taskpassword("-"); +benutztelogzeilen:=0;initpacket;globalmanager(PROC (DATASPACE VAR ,INT CONST +,INT CONST ,TASK CONST )logmanagerfaenger).END PROC logmanager;PROC +logmanagerfaenger(DATASPACE VAR ds,INT CONST order,phase,TASK CONST ordertask +):disablestop;logmanager(ds,order,phase,ordertask);trageggffehlermeldungein; +enablestop.trageggffehlermeldungein:IF iserrorTHEN logeintrag(fehlermeldung) +END IF .fehlermeldung:"Fehler: "+errormessage+" in Zeile "+text(errorline). +END PROC logmanagerfaenger;PROC logmanager(DATASPACE VAR ds,INT CONST order, +phase,TASK CONST ordertask):enablestop;IF order=eintragfileorderTHEN +nimmdateieintragvorELIF order=eintragtextorderTHEN nimmtexteintragvorELSE IF +istberechtigt(ordertask)THEN SELECT orderOF CASE readloglimitsorder: +leseloggrenzenCASE logholenorder:logverschicken(ordertask)CASE +gesichertvermerk:vermerkesicherungCASE loeschenorder:loeschelogOTHERWISE +logeintrag(ordertask,"Falscher Auftrag für Task ""LOG"" von Task: "+name( +ordertask))END SELECT ELSE logeintrag(ordertask, +"Unberechtigter Logbuchzugriff von Task: "+name(ordertask))FI FI . +nimmdateieintragvor:FILE VAR eintrag:=sequentialfile(input,ds);logeintrag( +eintrag,ordertask);meldeeintrag.meldeeintrag:IF logbuchgroessekritischTHEN +send(ordertask,kritischegrenzeerreichtack,ds)ELSE send(ordertask,ack,ds)END +IF .logbuchgroessekritisch:benutztelogzeilen>=kritischelogzeilenanzahl. +nimmtexteintragvor:msg:=ds;logeintrag(ordertask,CONCR (msg));meldeeintrag. +vermerkesicherung:msg:=ds;zeiger:=ersteslog;WHILE logname(log[zeiger])<> +CONCR (msg)AND zeiger<>letzteslogREP zeiger:=next(zeiger)PER ;IF logname(log[ +zeiger])<>CONCR (msg)THEN send(ordertask,dateiexistiertnichtack,ds)ELSE log[ +zeiger].daten.gesichert:=TRUE ;send(ordertask,ack,ds)FI .loeschelog:msg:=ds; +zeiger:=ersteslog;WHILE logname(log[zeiger])<>CONCR (msg)AND zeiger<> +letzteslogREP zeiger:=next(zeiger)PER ;IF logname(log[zeiger])<>CONCR (msg) +THEN send(ordertask,dateiexistiertnichtack,ds)ELIF NOT log[zeiger].daten. +gesichertTHEN send(ordertask,dateinichtgesichertack,ds)ELSE TEXT CONST +eintragstext:=logname(log[zeiger])+meldungloggeloescht;logbuchdateiloeschen( +zeiger);logeintrag(ordertask,eintragstext);send(ordertask,ack,ds)FI . +leseloggrenzen:forget(ds);ds:=nilspace;loggrenzenmsg:=ds;loggrenzenmsg.zeilen +:=logzeilen;loggrenzenmsg.zeilenbenutzt:=benutztelogzeilen;loggrenzenmsg. +zeilenkritisch:=kritischelogzeilenanzahl;send(ordertask,ack,ds).END PROC +logmanager;PROC logeintrag(FILE VAR eintrag,TASK CONST ordertask): +bereiteeintragvor;schreibeeintrag.bereiteeintragvor:logeintragvorbereiten( +ordertask,lines(eintrag));logeintragsimple(taskpre+name(ordertask),TRUE ). +schreibeeintrag:WHILE nocheintragssaetzeREPEAT schreibeeintragssatzEND +REPEAT .nocheintragssaetze:NOT eof(eintrag).schreibeeintragssatz:getline( +eintrag,eintragssatz);logeintragsimple(eintragssatz,FALSE ).END PROC +logeintrag;PROC seitenwechsel:seitenzeile:=0;putline(logfile, +seitenwechselanweisung).END PROC seitenwechsel;PROC zeilenwechsel:seitenzeile +INCR 1;line(logfile).END PROC zeilenwechsel;PROC logeintragvorbereiten(TASK +CONST task,INT CONST eintrzeilen):terminalnr:=channel(task); +wechseledateiseiteoderzeile;IF date(logb.daten.bis)<>dateOR +datumneuinlogschreibenTHEN datumneuinlogschreiben:=FALSE ;zeilenwechsel; +logeintragsimple(kennungen,FALSE )FI .wechseledateiseiteoderzeile:INT CONST +zeilen:=eintrzeilen+evtldatumszeile;IF dateiwechselerforderlichTHEN +wechseledateiELIF seitenwechselerforderlichTHEN bereiteseitenwechselvorEND +IF .dateiwechselerforderlich:zeilen+lines(logfile)>zeilenprologdatei. +evtldatumszeile:IF date(logb.daten.bis)<>dateOR datumneuinlogschreibenTHEN 1 +ELSE 0FI .wechseledatei:logdateiwechsel.seitenwechselerforderlich:INT CONST +restzeilen:=zeilenproseite-seitenzeile;(zeilen>restzeilenCAND restzeilen<=5). +bereiteseitenwechselvor:seitenwechsel.kennungen:date.END PROC +logeintragvorbereiten;PROC logeintragsimple(TEXT CONST eintragssatz,BOOL +CONST mitkennung):wechseleggfseiteoderzeile;nimmeintragvor; +bringelogdatenaufneuestenstand.wechseleggfseiteoderzeile:IF seitenzeile= +zeilenproseiteTHEN seitenwechselELIF seitenzeile>0THEN zeilenwechselELSE +seitenzeile:=1END IF .nimmeintragvor:put(logfile,subtext(ggfkennung+ +eintragssatz,1,logspalten)).ggfkennung:IF mitkennungTHEN timeofday+ +terminalname+text(terminalnr)+" "ELSE niltextEND IF . +bringelogdatenaufneuestenstand:logb.daten.gesichert:=FALSE ;logb.daten.bis:= +clock(1);logb.daten.zeilenINCR 1;benutztelogzeilenINCR 1.END PROC +logeintragsimple;PROC logeintrag(TEXT CONST zeile):logeintrag(myself,zeile). +END PROC logeintrag;PROC logeintrag(TASK CONST task,TEXT CONST zeile): +logeintragvorbereiten(task,nureinzeiligereintrag);logeintragsimple(zeile, +TRUE ).END PROC logeintrag;PROC initpacket:initlogs;initlogdaten.initlogs: +FOR zeigerFROM 1UPTO maxlogdateienREPEAT loesche(log[zeiger])END REPEAT . +initlogdaten:ersteslog:=1;letzteslog:=1;logfileoeffnen;logeintrag( +"Logbuch gestartet").END PROC initpacket;BOOL PROC istberechtigt(TASK CONST +ordertask):ordertaskletzteslogTHEN REP zeiger:=next(zeiger) +;forget(ds);ds:=log[zeiger].inhalt;f:=sequentialfile(modify,ds);headline(f, +logname(log[zeiger]));call(ordertask,letztesds,ds,reply)UNTIL zeiger= +letzteslogPER FI .letztesds:IF zeiger=letzteslogTHEN letzteslogackELSE logack +END IF .END PROC logverschicken;PROC logbuchdateiloeschen(INT CONST zeiger): +INT VAR vorgänger,nachfolger;benutztelogzeilenDECR log[zeiger].daten.zeilen; +IF zeiger=letzteslogTHEN loesche(log[zeiger]);datumneuinlogschreiben:=TRUE ; +logfileoeffnenELIF zeiger=ersteslogTHEN loesche(log[zeiger]);ersteslog:=next( +ersteslog)ELSE vorgänger:=zeiger;REP nachfolger:=vorgänger;vorgänger:=prev( +nachfolger);forget(log[nachfolger].inhalt);log[nachfolger]:=log[vorgänger]; +UNTIL vorgänger=ersteslogPER ;ersteslog:=nachfolger;forget(log[vorgänger]. +inhalt);log[vorgänger].inhalt:=nilspace;log[vorgänger].daten.von:=clock(1); +log[vorgänger].daten.bis:=clock(1);log[vorgänger].daten.gesichert:=FALSE ;log +[vorgänger].daten.zeilen:=0FI END PROC logbuchdateiloeschen;PROC loesche( +LOGBUCH VAR log):forget(log.inhalt);log.inhalt:=nilspace;log.daten.von:=clock +(1);log.daten.bis:=clock(1);log.daten.gesichert:=FALSE ;log.daten.zeilen:=0. +END PROC loesche;PROC logdateiwechsel:vervollstaendigealteslog;starteneueslog +;datumneuinlogschreiben:=TRUE .vervollstaendigealteslog:logb.daten.zeilen:= +lines(logfile).starteneueslog:letzteslog:=next(letzteslog);IF letzteslog= +ersteslogTHEN ersteslog:=next(ersteslog);benutztelogzeilenDECR logb.daten. +zeilenEND IF ;loesche(logb);logfileoeffnen.END PROC logdateiwechsel;PROC +logfileoeffnen:logfile:=sequentialfile(output,logb.inhalt);maxlinelength( +logfile,logspalten+laengeseitenwechselanweisung+1);seitenzeile:=lines(logfile +)MOD zeilenproseite.END PROC logfileoeffnen;INT PROC next(INT CONST zeiger): +zeigerMOD logdateien+1.END PROC next;INT PROC prev(INT CONST zeiger):IF +zeiger=1THEN logdateienELSE zeiger-1FI END PROC prev;TEXT PROC logname( +LOGBUCH CONST aktuelleslog):lognamepre+date(aktuelleslog.daten.von)+ +lognamedatumzeittrenner+timeofday(aktuelleslog.daten.von)+vonbistrenner+date( +aktuelleslog.daten.bis)+lognamedatumzeittrenner+timeofday(aktuelleslog.daten. +bis).END PROC logname;.logb:log[letzteslog].END PACKET logmanager + diff --git a/app/baisy/2.2.1-schulis/src/logbuch verwaltung b/app/baisy/2.2.1-schulis/src/logbuch verwaltung new file mode 100644 index 0000000..7d6577b --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/logbuch verwaltung @@ -0,0 +1,81 @@ +PACKET logbuchverwaltungDEFINES logbuchverwaltungstart,logbuchzeigen, +logbuchdrucken,logbucheditordateidrucken,logbuchloeschen, +logbuchzurueckzummenue:LET maskeeingang="ms logbuch verwaltung";LET +fnrzeilenaktuell=2,fnrzeilenmaximal=3,fnrzeilenkritisch=4,fnrauswahl1=5, +fnrlogname1=6,fnrauswahl2=7,fnrlogname2=8,fnrauswahl3=9,fnrlogname3=10, +fnrauskunftsfeld=11;LET meldnrfalscheauswahl=56,meldnrfehlerbeimloeschen=74, +meldnrlogbuchwurdegelöscht=94,meldnrnochnichtgesichert=95, +meldnrlogbuchwirdgedruckt=96;LET logbuchpraefix="logbuch.*";LET +zusätzlicherlaubtetasten="vr";LET laengelogname=45;INT VAR zeilenaktuell, +zeilenmaximal,zeilenkritisch;THESAURUS VAR thes;INT VAR thesindex;LET +maxlogdateien=3;ROW maxlogdateienTEXT VAR logname;INT VAR ilogname, +aktletzteslog;TEXT VAR dateinamezumzeigen;INT VAR ifnr,auswahl;INT VAR +replycode;LET ack=0,nak=1,dateinichtgesichertack=11,readloglimitsorder=202, +logholenorder=301,gesichertvermerk=306,loeschenorder=307,logmanagername="LOG" +;DATASPACE VAR ds;INT VAR reply;TASK VAR ordertask;BOUND TEXT VAR msgtext; +LET letzteslogack=8;PROC logfetch:FILE VAR f;forget(ds);ds:=nilspace;auftrag( +logholenorder,reply);f:=sequentialfile(input,ds);copy(ds,headline(f));forget( +ds);WHILE reply<>letzteslogackREP warteauflogmanager;f:=sequentialfile(input, +ds);copy(ds,headline(f));forget(ds);ds:=nilspace;send(ordertask,ack,ds);PER . +warteauflogmanager:wait(ds,reply,ordertask);WHILE name(ordertask)<> +logmanagernameREP forget(ds);wait(ds,reply,ordertask);PER .END PROC logfetch; +PROC loggetloglimits(INT VAR anzzeilen,anzzeilenbenutzt,anzzeilenkritisch): +LET LLIMITS =STRUCT (INT zeilen,zeilenbenutzt,zeilenkritisch);BOUND LLIMITS +VAR loggrenzenmsg;forget(ds);ds:=nilspace;loggrenzenmsg:=ds;auftrag( +readloglimitsorder,reply);anzzeilen:=CONCR (loggrenzenmsg).zeilen; +anzzeilenbenutzt:=CONCR (loggrenzenmsg).zeilenbenutzt;anzzeilenkritisch:= +CONCR (loggrenzenmsg).zeilenkritisch;forget(ds)END PROC loggetloglimits;PROC +logsetsavedmark(TEXT CONST logbuchdateiname,INT VAR reply):forget(ds);ds:= +nilspace;msgtext:=ds;msgtext:=logbuchdateiname;auftrag(gesichertvermerk,reply +);forget(ds)END PROC logsetsavedmark;PROC logerasesavedlogs(TEXT CONST +logbuchdateiname,INT VAR reply):forget(ds);ds:=nilspace;msgtext:=ds;msgtext:= +logbuchdateiname;auftrag(loeschenorder,reply);forget(ds)END PROC +logerasesavedlogs;PROC auftrag(INT CONST opcode,INT VAR reply):schickeauftrag +;WHILE auftragnichtangenommenREPEAT pause(10);schickeauftragEND REPEAT . +auftragnichtangenommen:reply=nak.schickeauftrag:call(/logmanagername,opcode, +ds,reply).END PROC auftrag;PROC logbuchverwaltungstart:loggetloglimits( +zeilenmaximal,zeilenaktuell,zeilenkritisch);vorhandenelogbuchdateienloeschen; +FOR ilognameFROM 1UPTO maxlogdateienREP logname(ilogname):=""PER ;logfetch; +thes:=allLIKE logbuchpraefix;thesindex:=0;ilogname:=0;get(thes, +dateinamezumzeigen,thesindex);WHILE thesindex>0REP IF ilogname"".auswahl2:standardmaskenfeld( +fnrauswahl2)<>"".auswahl3:standardmaskenfeld(fnrauswahl3)<>"".fehlermeldung: +standardmeldung(meldnrfalscheauswahl,"").END PROC auswahlbestimmen;PROC +logbuchzurueckzummenue:vorhandenelogbuchdateienloeschen;enter(2)END PROC +logbuchzurueckzummenue;PROC vorhandenelogbuchdateienloeschen:INT VAR kanal:= +channel;commanddialogue(FALSE );break(quiet);forget(allLIKE logbuchpraefix); +continue(kanal);commanddialogue(TRUE )END PROC +vorhandenelogbuchdateienloeschen;END PACKET logbuchverwaltung + diff --git a/app/baisy/2.2.1-schulis/src/longrow b/app/baisy/2.2.1-schulis/src/longrow new file mode 100644 index 0000000..482cb8a --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/longrow @@ -0,0 +1,38 @@ +PACKET longrowDEFINES LONGROW ,:=,newrow,insert,replace,delete,CAT ,length, +pos,binsearch,_:TYPE LONGROW =TEXT ;LET nil13bytes="�������������",nil4bytes= +"����",nilbyte="�",niltext="";TEXT VAR teil2,platzhalter:="��";OP :=(LONGROW +VAR r,LONGROW CONST s):CONCR (r):=CONCR (s)END OP :=;LONGROW PROC newrow: +LONGROW VAR r;CONCR (r):=niltext;rEND PROC newrow;PROC insert(LONGROW VAR row +,INT CONST wo,was):IF wo>0THEN replace(platzhalter,1,was);INT VAR trennpos:=2 +*wo-1;teil2:=subtext(CONCR (row),trennpos);CONCR (row):=subtext(CONCR (row),1 +,trennpos-1);CONCR (row)CAT platzhalter;CONCR (row)CAT teil2FI END PROC +insert;PROC replace(LONGROW VAR row,INT CONST wo,INT CONST was):IF length(row +)0THEN +INT VAR trennpos:=2*wo+1;teil2:=subtext(CONCR (row),trennpos);CONCR (row):= +subtext(CONCR (row),1,trennpos-3);CONCR (row)CAT teil2FI END PROC delete;OP +CAT (LONGROW VAR row,INT CONST was):replace(platzhalter,1,was);CONCR (row) +CAT platzhalterEND OP CAT ;INT OP _(LONGROW CONST row,INT CONST i):CONCR (row +)ISUB iEND OP _;INT PROC pos(LONGROW CONST row,INT CONST wert):INT VAR start +:=0;replace(platzhalter,1,wert);REP start:=pos(CONCR (row),platzhalter,start+ +1)UNTIL gefundenCOR stringendePER ;(start+1)DIV 2.gefunden:((startMOD 2)=1). +stringende:start=0.END PROC pos;INT PROC length(LONGROW CONST row):length( +CONCR (row))DIV 2END PROC length;PROC binsearch(LONGROW CONST ordnung,TEXT +CONST muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner,INT VAR indord): +starteindenvorgegebenengrenzen;setzeaufdiemitte;WHILE nichtgefundenREP IF +NOT kleineralsvergleichselementTHEN untererhinterdiemitteELSE +obereristdiemitteFI ;IF nichtgefundenTHEN setzeaufdiemitteELSE +setzeaufunterenFI PER ;gibordnungsindex.starteindenvorgegebenengrenzen:INT +VAR m,u:=1,o:=length(ordnung)+1.setzeaufdiemitte:m:=(u+o)DIV 2.nichtgefunden: +o>u.untererhinterdiemitte:u:=m+1.obereristdiemitte:o:=m.setzeaufunteren:m:=u. +kleineralsvergleichselement:kleiner(muster,vergleichselement). +vergleichselement:(ordnung_m).gibordnungsindex:indord:=m.END PROC binsearch; +PROC stretch(LONGROW VAR row,INT CONST laenge):WHILE LENGTH CONCR (row)<= +laenge-13REP CONCR (row)CAT nil13bytesPER ;WHILE LENGTH CONCR (row)<=laenge-4 +REP CONCR (row)CAT nil4bytesPER ;WHILE LENGTH CONCR (row)freecodeAND ordercode<> +reservecodeTHEN errorstop("DOS nicht angemeldet")FI ;IF ordertask=diskowner +THEN lastaccesstime:=clock(1)FI ;SELECT ordercodeOF CASE fetchcode:fetchfile +CASE savecode:savefileCASE erasecode:erasefileCASE clearcode:cleardiskCASE +existscode:existsfileCASE listcode:listdiskCASE allcode:deliverdirectoryCASE +reservecode:reserveCASE freecode:freeCASE checkreadcode:checkCASE formatcode: +formatCASE logcode:sendlogOTHERWISE errorstop( +"unbekannter Auftrag für Task: "+name(myself))END SELECT .fetchfile:fetch( +dosname(msg.name,readmodus),ds,fetchsavemodus);managerok(ds).check:checkfile( +dosname(msg.name,readmodus));managermessage(expandedname(msg.name,readmodus)+ +" ohne Fehler gelesen").format:IF phase=1THEN managerquestion( +"Diskette formatieren")ELSE formatdosdisk(int(msg.name));managerok(ds)FI . +savefile:IF phase=1THEN savefirstphaseELSE savesecondphaseFI .savefirstphase: +savefilename:=dosname(msg.name,writemodus);IF dosfileexists(savefilename) +THEN managerquestion(expandedname(msg.name,writemodus)+ +" auf der MS-DOS Disk ueberschreiben")ELSE send(ordertask,secondphaseack,ds) +FI .savesecondphase:IF dosfileexists(savefilename)THEN erasedosfile( +savefilename)FI ;save(savefilename,ds,fetchsavemodus);forget(ds);ds:=nilspace +;managerok(ds).cleardisk:IF phase=1THEN managerquestion("Diskette loeschen") +ELSE cleardosdisk;managerok(ds)FI .erasefile:IF dosfileexists(dosname(msg. +name,readmodus))THEN IF phase=1THEN managerquestion(expandedname(msg.name, +TRUE )+" auf der MS-DOS Disk loeschen")ELSE erasedosfile(dosname(msg.name, +readmodus));managerok(ds)FI ELSE managermessage("die Datei "+expandedname(msg +.name,TRUE )+" gibt es nicht auf der MS-DOS Disk")FI .existsfile:IF +dosfileexists(dosname(msg.name,readmodus))THEN managerok(ds)ELSE send( +ordertask,falsecode,ds)FI .listdisk:doslist(ds);managerok(ds).sendlog:forget( +ds);ds:=old("logbuch");managerok(ds).deliverdirectory:forget(ds);ds:=nilspace +;BOUND THESAURUS VAR allnames:=ds;allnames:=alldosfiles;managerok(ds).reserve +:IF reserveorfreepermittedTHEN continuechannel(doschannel);diskowner:= +fromtask;fetchsavemodus:=savefetchmode(msg.name);opendosdisk(path(msg.name)); +forget("logbuch",quiet);managerok(ds)ELSE errorstop( +"Archivlaufwerk wird von Task """+name(diskowner)+""" benutzt")FI . +reserveorfreepermitted:fromtask=diskownerOR lastaccessmorethanfiveminutesago +OR diskowner=niltaskOR NOT (exists(diskowner)OR station(diskowner)<>station( +myself)).lastaccessmorethanfiveminutesago:abs(lastaccesstime-clock(1))>300.0. +free:IF reserveorfreepermittedTHEN closedosdisk;diskowner:=niltask;break( +quiet);managerok(ds)ELSE managermessage("DOS nicht angemeldet")FI .END PROC +dosmanager;PROC managerok(DATASPACE VAR ds):send(ordertask,ack,ds); +lastaccesstime:=clock(1).END PROC managerok;TEXT PROC expandedname(TEXT +CONST name,BOOL CONST status):text(quote+dosname(name,status)+quote,14)END +PROC expandedname;END PACKET dosmanagermulti; + diff --git a/app/baisy/2.2.1-schulis/src/manager-S.dos b/app/baisy/2.2.1-schulis/src/manager-S.dos new file mode 100644 index 0000000..2bbfc16 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/manager-S.dos @@ -0,0 +1,67 @@ +PACKET dossingleDEFINES /,dos,providedoschannel,archive,reserve,release,save, +fetch,erase,check,exists,ALL ,SOME ,clear,list,format:LET stdarchivechannel= +31,mainchannel=1;INT VAR doschannel:=stdarchivechannel;INT VAR fetchsavemodus +;TYPE DOSTASK =TEXT ;DOSTASK CONST dos:="DOS";OP :=(DOSTASK VAR d,TEXT CONST +t):CONCR (d):=tEND OP :=;DOSTASK OP /(TEXT CONST text):DOSTASK VAR d;CONCR (d +):=text;dEND OP /;BOOL PROC isdostask(DOSTASK CONST d):CONCR (d)="DOS"END +PROC isdostask;PROC providedoschannel(INT CONST channelno):doschannel:= +channelnoEND PROC providedoschannel;DATASPACE VAR space:=nilspace;forget( +space);PROC reserve(TEXT CONST string,DOSTASK CONST task):IF isdostask(task) +THEN fetchsavemodus:=savefetchmode(string);opendosdisk(path(string))ELSE +errorstop("die angesprochene Task existiert nicht")FI .END PROC reserve;PROC +archive(TEXT CONST string,DOSTASK CONST task):reserve(string,task)END PROC +archive;PROC release(DOSTASK CONST task):IF isdostask(task)THEN closedosdisk +ELSE errorstop("die angesprochene Task existiert nicht")FI .END PROC release; +PROC fetch(TEXT CONST name,DOSTASK CONST from):IF isdostask(from)THEN +fetchfromdosdiskELSE errorstop("die angesprochene Task existiert nicht")FI . +fetchfromdosdisk:IF NOT exists(name)COR overwritepermittedTHEN dofetchFI . +overwritepermitted:say("eigene Datei """);say(name);yes( +""" auf der Diskette ueberschreiben").dofetch:lastparam(name);disablestop; +continue(doschannel);fetch(dosname(name,readmodus),space,fetchsavemodus); +continue(mainchannel);IF NOT iserrorTHEN forget(name,quiet);copy(space,name) +FI ;forget(space).END PROC fetch;PROC erase(TEXT CONST name,DOSTASK CONST +task):IF isdostask(task)THEN doerasedosfileELSE errorstop( +"die angesprochene Task existiert nicht")FI .doerasedosfile:IF NOT exists( +name,/"DOS")THEN errorstop("die Datei """+name+""" gibt es nicht")ELIF yes( +""""+dosname(name,readmodus)+""" auf Der Diskette loeschen")THEN disablestop; +continue(doschannel);erasedosfile(dosname(name,readmodus));continue( +mainchannel)FI .END PROC erase;PROC save(TEXT CONST name,DOSTASK CONST task): +IF isdostask(task)THEN savetodosdiskELSE errorstop( +"die angesprochene Task existiert nicht")FI .savetodosdisk:TEXT CONST +savefilename:=dosname(name,writemodus);disablestop;continue(doschannel);IF +NOT dosfileexists(savefilename)COR overwritepermittedTHEN IF dosfileexists( +savefilename)THEN erasedosfile(savefilename)FI ;save(savefilename,old(name), +fetchsavemodus);FI ;continue(mainchannel).overwritepermitted:continue( +mainchannel);BOOL CONST result:=yes(""""+savefilename+ +""" auf der Diskette ueberschreiben");continue(doschannel);result.END PROC +save;PROC check(TEXT CONST name,DOSTASK CONST from):IF isdostask(from)THEN +disablestop;continue(doschannel);checkfile(dosname(name,readmodus));continue( +mainchannel)ELSE errorstop("die angesprochene Task existiert nicht")FI .END +PROC check;BOOL PROC exists(TEXT CONST name,DOSTASK CONST task):IF isdostask( +task)THEN disablestop;continue(doschannel);BOOL VAR dummy:=dosfileexists( +dosname(name,readmodus));continue(mainchannel);enablestop;dummyELSE errorstop +("die angesprochene Task existiert nicht");FALSE FI .END PROC exists;PROC +list(DOSTASK CONST from):forget(space);space:=nilspace;FILE VAR listfile:= +sequentialfile(output,space);list(listfile,from);modify(listfile);show( +listfile);forget(space).ENDPROC list;PROC list(FILE VAR listfile,DOSTASK +CONST from):IF isdostask(from)THEN listdosdiskELSE errorstop( +"die angesprochene Task existiert nicht")FI .listdosdisk:disablestop;continue +(doschannel);doslist(space);continue(mainchannel);enablestop;output(listfile) +;FILE VAR listsource:=sequentialfile(output,space);TEXT VAR line;WHILE NOT +eof(listsource)REP getline(listsource,line);putline(listfile,line)PER .END +PROC list;THESAURUS OP ALL (DOSTASK CONST task):IF isdostask(task)THEN +disablestop;continue(doschannel);THESAURUS VAR dummy:=alldosfiles;continue( +mainchannel);enablestop;dummyELSE errorstop( +"die angesprochene Task existiert nicht");emptythesaurusFI .END OP ALL ; +THESAURUS OP SOME (DOSTASK CONST task):IF isdostask(task)THEN disablestop; +continue(doschannel);THESAURUS VAR dummy:=alldosfiles;continue(mainchannel); +enablestop;SOME dummyELSE errorstop("die angesprochene Task existiert nicht") +;emptythesaurusFI .END OP SOME ;PROC clear(DOSTASK CONST task):IF isdostask( +task)THEN cleardiskELSE errorstop("die angesprochene Task existiert nicht") +FI .cleardisk:disablestop;IF yes("Diskette loeschen")THEN continue(doschannel +);cleardosdisk;continue(mainchannel)FI .END PROC clear;PROC format(INT CONST +formatcode,DOSTASK CONST task):IF isdostask(task)THEN formatdiskELSE +errorstop("die angesprochene Task existiert nicht")FI .formatdisk:disablestop +;IF yes("Diskette formatieren")THEN continue(doschannel);formatdosdisk( +formatcode);continue(mainchannel)FI .END PROC format;END PACKET dossingle; + diff --git a/app/baisy/2.2.1-schulis/src/maskenerweiterung b/app/baisy/2.2.1-schulis/src/maskenerweiterung new file mode 100644 index 0000000..a61d7f0 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/maskenerweiterung @@ -0,0 +1,11 @@ +#-S tand: 04.11.8714:46'1238216893388-2761274802888164125853-15453-2245822115 +#PACKET maskenerweiterungDEFINES put,get,putget:LET maxfields=200;PROC putget +(TAG CONST ff,ROW maxfieldsTEXT VAR v,INT VAR einstieg):put(ff,v);get(ff,v, +einstieg)END PROC putget;PROC put(TAG CONST ff,ROW maxfieldsTEXT VAR +fieldvalues):INT VAR iFOR iFROM 1UPTO fields(ff)REP IF fieldexists(ff,i)THEN +put(ff,fieldvalues(i),i)FI PER END PROC put;PROC get(TAG CONST ff,ROW +maxfieldsTEXT VAR fieldvalues,INT VAR feld):INT VAR felder:=fields(ff);IF +NOT fieldexists(ff,feld)THEN errorstop("startfeld nicht im tag")ELSE WHILE +feld<=felderREPEAT get(ff,fieldvalues(feld),feld);executecommandcode(ff,feld) +UNTIL leavingcode=27PER FI END PROC get;END PACKET maskenerweiterung; + diff --git a/app/baisy/2.2.1-schulis/src/maskenverarbeitung b/app/baisy/2.2.1-schulis/src/maskenverarbeitung new file mode 100644 index 0000000..a640f2c --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/maskenverarbeitung @@ -0,0 +1,125 @@ +PACKET maskenverarbeitungDEFINES INITBY ,tagexists,storetag,renametag,copytag +,forgettag,listedermasken,startemaskenverarbeitung:LET datenraumpraefix= +"BAISY-",datenraumbasis=2;LET maxtag=100,maxtab=20,maxinhalt=2000;LET niltext +="",null=0;TYPE EINTRAG =STRUCT (TEXT name,INT dr,tagnr);TYPE INHALT =STRUCT +(LONGROW ordnung,INT maxeintrag,ersterfreier,ROW maxinhaltEINTRAG eintrag); +TYPE ZEILE =STRUCT (BOOL gueltig,TAG maske);TYPE TAGTAB =STRUCT (INT +maxeintrag,zahldereintraege,ersterfreier,ROW maxtagZEILE zeile);BOUND INHALT +VAR inhaltsverzeichnis;ROW maxtabBOUND TAGTAB VAR tagtable;INT VAR maxeintrag +,ersterfreier;OP INITBY (TAG VAR maske,TEXT CONST name):BOOL VAR gefunden; +INT VAR eintragsnr,dr,tagnr;suchen(name,eintragsnr,dr,tagnr,gefunden);IF +gefundenTHEN maske:=tagtable(dr).zeile(tagnr).maskeELSE nil(maske)FI END OP +INITBY ;BOOL PROC tagexists(TEXT CONST name):tagindex(name)>nullEND PROC +tagexists;PROC storetag(TAG CONST maske,TEXT CONST name):BOOL VAR gefunden; +INT VAR katalognr,inhaltnr,dr,tagnr;suchen(name,katalognr,dr,tagnr,gefunden); +IF NOT gefundenTHEN neueinrichtenELSE ueberschreibenFI .neueinrichten: +freieplaetzesuchen;einfuegen.freieplaetzesuchen:naechstenfreiensuchen( +inhaltnr,dr,tagnr).einfuegen:intagtable;inkatalog.intagtable:tagtable(dr). +zeile(tagnr).maske:=maske;tagtable(dr).zeile(tagnr).gueltig:=true.inkatalog: +eintragmachen;inordnungaufnehmen.eintragmachen:EINTRAG VAR e;e.name:=name;e. +dr:=dr;e.tagnr:=tagnr;inhaltsverzeichnis.eintrag(inhaltnr):=e. +inordnungaufnehmen:IF katalognr=nullTHEN anhaengenELSE einkettenFI .anhaengen +:inhaltsverzeichnis.ordnungCAT inhaltnr.einketten:insert(inhaltsverzeichnis. +ordnung,pos(inhaltsverzeichnis.ordnung,katalognr),inhaltnr).ueberschreiben: +tagtable(dr).zeile(tagnr).maske:=maske.END PROC storetag;PROC renametag(TEXT +CONST alt,neu):BOOL VAR gefunden;INT VAR alterindex,neuerindex,dr,tagnr; +alterindex:=tagindex(alt);IF alterindex<>nullTHEN umbenennenFI .umbenennen: +suchen(neu,neuerindex,dr,tagnr,gefunden);IF NOT gefundenTHEN +alterindexausordnung;neuerindexinordnung;nameueberschreibenFI . +alterindexausordnung:delete(inhaltsverzeichnis.ordnung,pos(inhaltsverzeichnis +.ordnung,alterindex)).neuerindexinordnung:suchen(neu,neuerindex,dr,tagnr, +gefunden);insert(inhaltsverzeichnis.ordnung,pos(inhaltsverzeichnis.ordnung, +neuerindex),alterindex).nameueberschreiben:inhaltsverzeichnis.eintrag( +alterindex).name:=neu.END PROC renametag;PROC copytag(TEXT CONST alt,neu): +TAG VAR maske;maskeINITBY alt;storetag(maske,neu)END PROC copytag;PROC +forgettag(TEXT CONST name):ungueltigmachen(tagindex(name))END PROC forgettag; +PROC begintaglist:taglistindex:=0;taglistlaenge:=length(inhaltsverzeichnis. +ordnung)END PROC begintaglist;INT VAR taglistindex,taglistlaenge;PROC +nexttaglistentry(TEXT VAR name):taglistindexINCR 1;name:=naechstereintrag. +naechstereintrag:IF taglistindex>taglistlaengeTHEN niltextELSE +inhaltsverzeichnis.eintrag(eintragindex).nameFI .eintragindex: +inhaltsverzeichnis.ordnung_taglistindex.END PROC nexttaglistentry;PROC +listedermasken:LET listname="Masken";listedermasken(listname);show(listname); +forget(listname,quiet)END PROC listedermasken;PROC listedermasken(TEXT CONST +dateiname):LONGROW VAR refinements;FILE VAR f:=sequentialfile(output, +dateiname);refinements:=inhaltsverzeichnis.ordnung;INT VAR i;FOR iFROM 1UPTO +length(refinements)REP put(f,inhaltsverzeichnis.eintrag(refinements_i).name); +line(f)PER ;close(f)END PROC listedermasken;INT PROC tagindex(TEXT CONST name +):BOOL VAR gefunden;INT VAR eintragsnr,dr,tagnr;suchen(name,eintragsnr,dr, +tagnr,gefunden);IF gefundenTHEN eintragsnrELSE nullFI END PROC tagindex;PROC +suchen(TEXT CONST muster,INT VAR eintragsnr,dr,tagnr,BOOL VAR gefunden): +LONGROW CONST ordnung:=inhaltsverzeichnis.ordnung;INT CONST l:=length(ordnung +);eintragsnr:=null;IF l=nullTHEN gefunden:=falseELSE INT VAR ordnungsindex; +binsearch(ordnung,muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner, +ordnungsindex);IF ordnungsindex>lTHEN gefunden:=falseELSE eintragsnr:=ordnung +_ordnungsindex;EINTRAG VAR e;e:=inhaltsverzeichnis.eintrag(eintragsnr);dr:=e. +dr;tagnr:=e.tagnr;gefunden:=(muster=e.name)FI FI .END PROC suchen;BOOL PROC +kleiner(TEXT CONST muster,INT CONST verzeichnispos):muster<= +inhaltsverzeichnis.eintrag(verzeichnispos).nameEND PROC kleiner;OP :=( +EINTRAG VAR e,EINTRAG CONST f):CONCR (e):=CONCR (f)END OP :=;PROC +naechstenfreiensuchen(INT VAR index,dr,tagnr): +naechstenfreienininhaltsverzeichnis(index);dr:=ersterfreier; +naechstefreiezeile(dr,tagnr)END PROC naechstenfreiensuchen;PROC +naechstenfreienininhaltsverzeichnis(INT VAR index):index:=inhaltsverzeichnis. +ersterfreier;IF index>inhaltsverzeichnis.maxeintragTHEN inhaltsverzeichnis. +maxeintrag:=inhaltsverzeichnis.ersterfreier;inhaltsverzeichnis.ersterfreier +INCR 1ELSE INT VAR i;FOR iFROM index+1UPTO inhaltsverzeichnis.maxeintragREP +IF NOT istgueltigTHEN inhaltsverzeichnis.ersterfreier:=i;LEAVE +naechstenfreienininhaltsverzeichnisFI PER ;inhaltsverzeichnis.ersterfreier:= +inhaltsverzeichnis.maxeintrag+1FI .istgueltig:inhaltsverzeichnis.eintrag(i). +name<>niltext.END PROC naechstenfreienininhaltsverzeichnis;PROC +naechstenfreiendatenraum:IF ersterfreier>maxeintragTHEN neuerdatenraumansende +ELSE INT VAR i;FOR iFROM ersterfreier+1UPTO maxeintragREP IF NOT +datenraumvollTHEN ersterfreier:=i;LEAVE naechstenfreiendatenraumFI PER ; +ersterfreier:=maxeintrag+1;neuerdatenraumansendeFI .neuerdatenraumansende: +datenraumneuankoppeln(ersterfreier);maxeintrag:=ersterfreier.datenraumvoll: +tagtable(i).zahldereintraege>=maxtag.END PROC naechstenfreiendatenraum;PROC +naechstefreiezeile(INT VAR dr,INT VAR tagnr):IF tagtable(dr).zahldereintraege +=maxtagTHEN naechstenfreiendatenraum;dr:=ersterfreierFI ;tagnr:=tagtable(dr). +ersterfreier;tagtable(dr).zahldereintraegeINCR 1;IF tagtable(dr).ersterfreier +>tagtable(dr).maxeintragTHEN tagtable(dr).maxeintrag:=tagtable(dr). +ersterfreier;tagtable(dr).ersterfreierINCR 1ELSE INT VAR i;FOR iFROM tagtable +(dr).ersterfreier+1UPTO tagtable(dr).maxeintragREP IF NOT istgueltigTHEN +tagtable(dr).ersterfreier:=i;LEAVE naechstefreiezeileFI PER ;tagtable(dr). +ersterfreier:=tagtable(dr).maxeintrag+1FI .istgueltig:tagtable(dr).zeile(i). +gueltig.END PROC naechstefreiezeile;PROC ungueltigmachen(INT CONST index):IF +gueltigerindexTHEN tagungueltigmachen;eintragungueltigmachen; +inordnungungueltigmachenFI .gueltigerindex:index>0.tagungueltigmachen: +EINTRAG VAR e:=inhaltsverzeichnis.eintrag(index);ungueltigmachen(e.dr,e.tagnr +).eintragungueltigmachen:e.name:=niltext;inhaltsverzeichnis.eintrag(index):=e +;IF inhaltsverzeichnis.ersterfreier>indexTHEN inhaltsverzeichnis.ersterfreier +:=indexFI .inordnungungueltigmachen:delete(inhaltsverzeichnis.ordnung,pos( +inhaltsverzeichnis.ordnung,index)).END PROC ungueltigmachen;PROC +ungueltigmachen(INT CONST dr,tagnr):eintragungueltigmachen;IF letztereintrag +THEN datenraumungueltigmachenFI .eintragungueltigmachen:INT VAR eintragszahl +:=tagtable(dr).zahldereintraege;eintragszahlDECR 1;IF NOT letztereintragTHEN +tagtable(dr).zahldereintraege:=eintragszahl;INT VAR ef:=tagtable(dr). +ersterfreier;IF tagnr1).weglassen: +maxeintragDECR 1;ersterfreier:=min(ersterfreier,maxeintrag).neuanlegen: +datenraumneuankoppeln(dr);ersterfreier:=min(ersterfreier,dr).END PROC +ungueltigmachen;PROC datenraumneuankoppeln(INT CONST dr):tagtable(dr):=new( +datenraumname(dr));tagtable(dr).zahldereintraege:=null;tagtable(dr). +maxeintrag:=null;tagtable(dr).ersterfreier:=1END PROC datenraumneuankoppeln; +PROC startemaskenverarbeitung:IF daTHEN nurankoppelnELSE neuerzeugenFI .da: +TEXT CONST verwaltungsname:=datenraumpraefix+text(datenraumbasis);exists( +verwaltungsname).neuerzeugen:inhaltsverzeichnis:=new(verwaltungsname); +inhaltsverzeichnis.maxeintrag:=0;inhaltsverzeichnis.ersterfreier:=1; +inhaltsverzeichnis.ordnung:=newrow;maxeintrag:=0;ersterfreier:=1; +naechstenfreiendatenraum.nurankoppeln:verwaltungankoppeln;restankoppeln. +verwaltungankoppeln:inhaltsverzeichnis:=old(verwaltungsname).restankoppeln: +beginneliste;naechster;WHILE nochwelchedaREP anbinden;naechsterPER ;abschluss +.beginneliste:beginlist;maxeintrag:=null.abschluss:ersterfreier:=null; +naechstenfreiendatenraum.naechster:TEXT VAR name,datum;getlistentry(name, +datum).nochwelcheda:name<>niltext.anbinden:INT VAR index:=datenraumnummer( +name)-datenraumbasis;IF index>nullTHEN tagtable(index):=old(name);maxeintrag +:=max(maxeintrag,index)FI .END PROC startemaskenverarbeitung;INT PROC +datenraumnummer(TEXT CONST name):IF pos(name,datenraumpraefix)<>1THEN null +ELSE int(name-datenraumpraefix)FI END PROC datenraumnummer;TEXT PROC +datenraumname(INT CONST nr):datenraumpraefix+text(nr+datenraumbasis)END PROC +datenraumname;TEXT OP -(TEXT CONST s,t):TEXT VAR kurz:=s;change(kurz,t, +niltext);kurzEND OP -;END PACKET maskenverarbeitung; + diff --git a/app/baisy/2.2.1-schulis/src/name conversion.dos b/app/baisy/2.2.1-schulis/src/name conversion.dos new file mode 100644 index 0000000..01113b9 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/name conversion.dos @@ -0,0 +1,22 @@ +PACKET nameconversionDEFINES dosname,readmodus,writemodus:BOOL CONST +readmodus:=TRUE ,writemodus:=NOT readmodus;LET uppercasechars= +"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&§!()-{}`_",lowercasechars= +"abcdefghijklmnopqrstuvwxyz";TEXT PROC dosname(TEXT CONST euname,BOOL CONST +readwritemodus):enablestop;INT CONST pointpos:=pos(euname,".");IF +nameextensionexistsTHEN changednamewithextensionELSE +changednamewithoutextensionFI .nameextensionexists:pointpos>0. +changednamewithextension:TEXT CONST namepre:=compress(subtext(euname,1, +pointpos-1)),namepost:=compress(subtext(euname,pointpos+1));IF LENGTH namepre +=0OR LENGTH namepre>8OR LENGTH namepost>3THEN errorFI ;IF LENGTH namepost=0 +THEN newname(namepre,readwritemodus)ELSE newname(namepre,readwritemodus)+"."+ +newname(namepost,readwritemodus)FI .changednamewithoutextension:IF LENGTH +euname>8OR LENGTH euname<1THEN errorFI ;newname(euname,readwritemodus).error: +errorstop("Unzulässiger Name").END PROC dosname;TEXT PROC newname(TEXT CONST +oldname,BOOL CONST readwritemodus):TEXT VAR new:="";INT VAR count;FOR count +FROM 1UPTO LENGTH oldnameREP convertcharPER ;new.convertchar:TEXT CONST char +:=oldnameSUB count;IF islowercasecharTHEN newCAT (uppercasecharsSUB stringpos +)ELIF isuppercasecharOR readwritemodusTHEN newCAT charELSE errorstop( +"Unzulässiger Name")FI .islowercasechar:pos(lowercasechars,char)>0. +isuppercasechar:pos(uppercasechars,char)>0.stringpos:pos(lowercasechars,char) +.END PROC newname;END PACKET nameconversion; + diff --git a/app/baisy/2.2.1-schulis/src/new monitor baisy b/app/baisy/2.2.1-schulis/src/new monitor baisy new file mode 100644 index 0000000..f446230 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/new monitor baisy @@ -0,0 +1,4 @@ +PACKET newmonitorbaisyDEFINES monitor:PROC monitor:commanddialogue(TRUE ); +disablestop;REP oeffnedatenbank(schulisdbname);startebaisy;clearerrorEND REP +.END PROC monitor;END PACKET newmonitorbaisy; + diff --git a/app/baisy/2.2.1-schulis/src/open b/app/baisy/2.2.1-schulis/src/open new file mode 100644 index 0000000..28836c4 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/open @@ -0,0 +1,11 @@ +PACKET openDEFINES openwork,closework,workopened,workclosed,initcheckrerun, +checkrerun,hdversion:BOOL VAR open;INT VAR oldsession;BOOL VAR hdflag:=FALSE +;INITFLAG VAR packet:=FALSE ;PROC openwork:open:=TRUE END PROC openwork;PROC +closework:open:=FALSE END PROC closework;BOOL PROC workopened:IF NOT +initialized(packet)THEN closeworkFI ;openEND PROC workopened;BOOL PROC +workclosed:NOT workopenedEND PROC workclosed;PROC initcheckrerun:oldsession:= +sessionEND PROC initcheckrerun;PROC checkrerun:IF session<>oldsessionTHEN +closework;errorstop("Diskettenzugriff im RERUN")FI .END PROC checkrerun;PROC +hdversion(BOOL CONST status):hdflag:=statusEND PROC hdversion;BOOL PROC +hdversion:hdflagEND PROC hdversion;END PACKET open; + diff --git a/app/baisy/2.2.1-schulis/src/plausipruefung b/app/baisy/2.2.1-schulis/src/plausipruefung new file mode 100644 index 0000000..4b08653 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/plausipruefung @@ -0,0 +1,88 @@ +PACKET plausipruefungDEFINES pruefe,imschlbestand,imbestand:LET +trennerfuerfeldwerte="�",dateinameschluessel="Schlüssel";PROC pruefe(INT +CONST pruefart,TAG CONST maske,TEXT PROC (INT CONST )prueftext,INT CONST +feldnummer,ug,og,TEXT CONST bestand,INT VAR fstatus):fstatus:=0;SELECT +pruefartOF CASE 1:pruefefeldgefuellt(maske,PROC prueftext,feldnummer,fstatus) +CASE 2:pruefenumerisch(maske,PROC prueftext,feldnummer,fstatus)CASE 3: +pruefenumgrenzen(maske,PROC prueftext,feldnummer,ug,og,fstatus)CASE 4: +pruefeimbestand(maske,PROC prueftext,feldnummer,bestand,fstatus)CASE 5: +pruefealternativen(maske,PROC prueftext,feldnummer,ug,fstatus)CASE 6: +pruefedatum(maske,PROC prueftext,feldnummer,fstatus)END SELECT .END PROC +pruefe;PROC pruefefeldgefuellt(TAG CONST maske,TEXT PROC (INT CONST )eingabe, +INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=52;IF eingabe(fnr)="" +THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;END PROC +pruefefeldgefuellt;PROC pruefenumerisch(TAG CONST maske,TEXT PROC (INT CONST +)eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=53;INT VAR type; +TEXT VAR teiltext;scan(eingabe(fnr));nextsymbol(teiltext,type);IF type<>3 +THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrELSE nextsymbol( +teiltext,type);IF type<>7THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus +:=fnrFI ;FI ;END PROC pruefenumerisch;PROC pruefenumgrenzen(TAG CONST maske, +TEXT PROC (INT CONST )eingabe,INT CONST fnr,ug,og,INT VAR fstatus):LET +fehlermeldungsnr=54;INT VAR inteingabe:=int(eingabe(fnr));IF inteingabeogTHEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ; +END PROC pruefenumgrenzen;PROC pruefeimbestand(TAG CONST maske,TEXT PROC ( +INT CONST )eingabe,INT CONST fnr,TEXT CONST bestand,INT VAR fstatus):LET +fehlermeldungsnr=55;BOOL VAR nichtimbestandgefunden;IF (bestandSUB 1)="c" +THEN nichtimbestandgefunden:=NOT (imbestand(bestand+trennerfuerfeldwerte+ +eingabe(fnr),dateinameschluessel))ELSE nichtimbestandgefunden:=NOT (imbestand +(eingabe(fnr),bestand))FI ;IF nichtimbestandgefundenTHEN meldeauffaellig( +maske,fehlermeldungsnr);fstatus:=fnrFI .END PROC pruefeimbestand;PROC +pruefealternativen(TAG CONST maske,TEXT PROC (INT CONST )eingabe,INT CONST +fnr1,fnr2,INT VAR fstatus):LET fehlermeldungsnr=56;IF fnr2<=fnr1THEN LEAVE +pruefealternativenFI ;INT VAR nr:=fnr1,treffer:=0;REP IF eingabe(nr)<>""THEN +trefferINCR 1FI ;nrINCR 1UNTIL (nr>fnr2)OR (treffer>1)PER ;IF treffer<>1THEN +meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnr1FI .END PROC +pruefealternativen;PROC pruefedatum(TAG CONST maske,TEXT PROC (INT CONST ) +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=157,falschertag= +"00";TEXT VAR pruefdatum:=eingabe(fnr);IF datum(pruefdatum)=nildatumCOR +subtext(pruefdatum,1,2)=falschertagTHEN meldeauffaellig(maske, +fehlermeldungsnr);fstatus:=fnrFI ;END PROC pruefedatum;PROC pruefe(INT CONST +pruefart,TAG CONST maske,ROW 100TEXT CONST prueftext,INT CONST feldnummer,ug, +og,TEXT CONST bestand,INT VAR fstatus):fstatus:=0;SELECT pruefartOF CASE 1: +pruefefeldgefuellt(maske,prueftext,feldnummer,fstatus)CASE 2:pruefenumerisch( +maske,prueftext,feldnummer,fstatus)CASE 3:pruefenumgrenzen(maske,prueftext, +feldnummer,ug,og,fstatus)CASE 4:pruefeimbestand(maske,prueftext,feldnummer, +bestand,fstatus)CASE 5:pruefealternativen(maske,prueftext,feldnummer,ug, +fstatus)CASE 6:pruefedatum(maske,prueftext,feldnummer,fstatus)END SELECT . +END PROC pruefe;PROC pruefefeldgefuellt(TAG CONST maske,ROW 100TEXT CONST +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=52;IF eingabe(fnr +)=""THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;END PROC +pruefefeldgefuellt;PROC pruefenumerisch(TAG CONST maske,ROW 100TEXT CONST +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=53;INT VAR type; +TEXT VAR teiltext;scan(eingabe(fnr));nextsymbol(teiltext,type);IF type<>3 +THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrELSE nextsymbol( +teiltext,type);IF type<>7THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus +:=fnrFI ;FI ;END PROC pruefenumerisch;PROC pruefenumgrenzen(TAG CONST maske, +ROW 100TEXT CONST eingabe,INT CONST fnr,ug,og,INT VAR fstatus):LET +fehlermeldungsnr=54;INT VAR inteingabe:=int(eingabe(fnr));IF inteingabeogTHEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ; +END PROC pruefenumgrenzen;PROC pruefeimbestand(TAG CONST maske,ROW 100TEXT +CONST eingabe,INT CONST fnr,TEXT CONST bestand,INT VAR fstatus):LET +fehlermeldungsnr=55;BOOL VAR nichtimbestandgefunden;IF (bestandSUB 1)="c" +THEN nichtimbestandgefunden:=NOT (imbestand(bestand+trennerfuerfeldwerte+ +eingabe(fnr),dateinameschluessel))ELSE nichtimbestandgefunden:=NOT (imbestand +(eingabe(fnr),bestand))FI ;IF nichtimbestandgefundenTHEN meldeauffaellig( +maske,fehlermeldungsnr);fstatus:=fnrFI .END PROC pruefeimbestand;PROC +pruefealternativen(TAG CONST maske,ROW 100TEXT CONST eingabe,INT CONST fnr1, +fnr2,INT VAR fstatus):LET fehlermeldungsnr=56;IF fnr2<=fnr1THEN LEAVE +pruefealternativenFI ;INT VAR nr:=fnr1,treffer:=0;REP IF eingabe(nr)<>""THEN +trefferINCR 1FI ;nrINCR 1UNTIL (nr>fnr2)OR (treffer>1)PER ;IF treffer<>1THEN +meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnr1FI .END PROC +pruefealternativen;PROC pruefedatum(TAG CONST maske,ROW 100TEXT CONST eingabe +,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=157,falschertag="00"; +TEXT VAR pruefdatum:=eingabe(fnr);IF datum(pruefdatum)=nildatumCOR subtext( +pruefdatum,1,2)=falschertagTHEN meldeauffaellig(maske,fehlermeldungsnr); +fstatus:=fnrFI ;END PROC pruefedatum;BOOL PROC imschlbestand(TEXT CONST +schlwert,bestand):imbestand(bestand+trennerfuerfeldwerte+schlwert, +dateinameschluessel)END PROC imschlbestand;BOOL PROC imbestand(TEXT CONST +schlwerte,bestandname):INT VAR dateinummer,status,position,i;TEXT VAR suchkey +:=schlwerte;systemdboff;stopbeifalschemnamen(FALSE );dateinummer:=dateinr( +bestandname);IF dateinummer>0THEN parsenooffields(0);suchwertesetzen;search( +dateinummer,TRUE );status:=dbstatus;reinitparsingELSE status:=1FI ; +stopbeifalschemnamen(TRUE );status=0.suchwertesetzen:FOR iFROM 1UPTO anzkey( +dateinummer)REP ermittleposition;putwert(dateinummer+i,suchwert);suchkey:= +subtext(suchkey,position+2)UNTIL suchkey=""PER .ermittleposition:position:= +pos(suchkey,trennerfuerfeldwerte);IF position=0THEN position:=length(suchkey) +ELSE positionDECR 1FI .suchwert:subtext(suchkey,1,position).END PROC +imbestand;END PACKET plausipruefung; + diff --git a/app/baisy/2.2.1-schulis/src/save b/app/baisy/2.2.1-schulis/src/save new file mode 100644 index 0000000..e634acd --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/save @@ -0,0 +1,61 @@ +PACKET saveDEFINES save:LET ascii=1,asciigerman=2,transparent=3,rowtext=5,ds= +6,atarist=10,ibm=11,ff="�",ctrlz="�",crlf=" +",rowtextmodelength=4000;TEXT +VAR buffer;BOUND STRUCT (INT size,ROW rowtextmodelengthTEXT clusterrow)VAR +clusterstruct;PROC save(TEXT CONST filename,DATASPACE CONST fileds,INT CONST +mode):SELECT modeOF CASE ascii,asciigerman,atarist,ibm,transparent: +savefilemode(fileds,filename,mode)CASE rowtext:saverowtextmode(fileds, +filename)CASE ds:savedsmode(fileds,filename)OTHERWISE errorstop( +"Unzulässige Betriebsart")END SELECT .END PROC save;PROC savefilemode( +DATASPACE CONST filespace,TEXT CONST name,INT CONST codetype):enablestop; +opensavedosfile(name);FILE VAR file:=sequentialfile(modify,filespace);buffer +:="";INT VAR lineno;FOR linenoFROM 1UPTO lines(file)REP toline(file,lineno); +buffercatfileline;WHILE length(buffer)>=clustersizeREP +writenextsavedoscluster(subtext(buffer,1,clustersize));buffer:=subtext(buffer +,clustersize+1)PER PER ;IF asciicodeTHEN bufferCAT ctrlzFI ;writerest; +closesavedosfile;buffer:="".buffercatfileline:exec(PROC (TEXT CONST ,INT +CONST )catadaptedline,file,codetype).asciicode:(codetype=ascii)OR (codetype= +asciigerman).writerest:WHILE buffer<>""REP writenextsavedoscluster(subtext( +buffer,1,clustersize));buffer:=subtext(buffer,clustersize+1)PER .END PROC +savefilemode;PROC catadaptedline(TEXT VAR line,INT CONST codetype):IF +codetype=transparentTHEN bufferCAT lineELSE changeescsequences; +changeeumelprintchars;SELECT codetypeOF CASE ascii:asciichangeCASE +asciigerman:asciigermanchangeCASE atarist:ataristchangeCASE ibm:ibmchangeEND +SELECT ;bufferCAT line;IF (lineSUB length(line))<>ffTHEN bufferCAT crlfFI FI +.changeescsequences:changeall(line,"#page#",ff);INT VAR p:=pos(line,"#"); +WHILE p>0REP IF isescsequenceTHEN change(line,p,p+4,codedchar)FI ;p:=pos(line +,"#",p+1)PER .isescsequence:LET digits="0123456789";(lineSUB (p+4))="#"CAND +pos(digits,lineSUB p+1)>0CAND pos(digits,lineSUB p+2)>0CAND pos(digits,line +SUB p+3)>0.codedchar:code(int(subtext(line,p+1,p+3))).changeeumelprintchars:p +:=pos(line,"k"," ",1);WHILE p>0REP replace(line,p,stdchar);p:=pos(line,"k", +" ",p+1)PER .stdchar:"k-# "SUB (code(lineSUB p)-219).asciichange:changeall( +line,"ß","#251#");p:=pos(line,"Ä","ü",1);WHILE p>0REP change(line,p,p, +ersatzdarstellung(lineSUB p));p:=pos(line,"Ä","ü",p+1)PER .asciigermanchange: +changeall(line,"[","#091#");changeall(line,"\","#092#");changeall(line,"]", +"#093#");changeall(line,"{","#123#");changeall(line,"|","#124#");changeall( +line,"}","#125#");changeall(line,"~","#126#");changeall(line,"ß","~");p:=pos( +line,"Ä","ü",1);WHILE p>0REP replace(line,p,umlautinasciigerman);p:=pos(line, +"Ä","ü",p+1)PER .umlautinasciigerman:"[\]{|}"SUB (code(lineSUB p)-213). +ibmchange:changeall(line,"ß","�");p:=pos(line,"Ä","ü",1);WHILE p>0REP replace +(line,p,umlautinibm);p:=pos(line,"Ä","ü",p+1)PER .ataristchange:changeall( +line,"ß","�");p:=pos(line,"Ä","ü",1);WHILE p>0REP replace(line,p,umlautinibm) +;p:=pos(line,"Ä","ü",p+1)PER .umlautinibm:"Ξ��ΔΥΑ"SUB (code(lineSUB p)-213). +END PROC catadaptedline;TEXT PROC ersatzdarstellung(TEXT CONST char):TEXT +CONST t:=text(code(charSUB 1));"#"+(3-length(t))*"0"+t+"#"END PROC +ersatzdarstellung;PROC saverowtextmode(DATASPACE CONST space,TEXT CONST name) +:enablestop;opensavedosfile(name);initsaverowtextmode;WHILE lineno< +clusterstruct.sizeREP fillbuffer;writenextsavedoscluster(subtext(buffer,1, +clustersize));rememberrestPER ;writerest;closesavedosfile;buffer:="". +initsaverowtextmode:clusterstruct:=space;buffer:="";INT VAR lineno:=0. +fillbuffer:WHILE lineno= +clustersize.rememberrest:buffer:=subtext(buffer,clustersize+1).writerest: +WHILE buffer<>""REP writenextsavedoscluster(subtext(buffer,1,clustersize)); +rememberrestPER .END PROC saverowtextmode;PROC savedsmode(DATASPACE CONST +outds,TEXT CONST name):enablestop;opensavedosfile(name);INT VAR pageno:= +firstnondummydspage;getlastallocateddspage;WHILE pageno<=lastallocateddspage +REP writenextsavedoscluster(outds,pageno);PER ;closesavedosfile. +getlastallocateddspage:INT VAR lastallocateddspage:=-1,i;FOR iFROM 1UPTO +dspages(outds)REP lastallocateddspage:=nextdspage(outds,lastallocateddspage) +PER .END PROC savedsmode;END PACKET save; + diff --git a/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung b/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung new file mode 100644 index 0000000..51fbcac --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung @@ -0,0 +1,19 @@ +PACKET schuliskommandobehandlungDEFINES bsstart,aktuelleskommandolesen, +kommandoausfuehren:LET standardanfang=2,id="mb kommandobearbeitung";TEXT VAR +name:="",fehl:="";#TEXT VAR titel:="";#BOOL VAR fehler:=FALSE ;;TAG VAR +aktuellemaske;INT VAR aktuelleposition;PROC bsstart: +frageentwicklernachkommando;aktuelleskommandolesen.END PROC bsstart;PROC +frageentwicklernachkommando:page;fehl:="";standardkopfmaskeausgeben(text( +vergleichsknoten));aktuelleposition:=standardanfang;initmaske(aktuellemaske, +id);show(aktuellemaske).END PROC frageentwicklernachkommando;PROC +aktuelleskommandolesen:ROW 100TEXT VAR feld;init(feld);feld(2):=name;feld(4) +:=fehl;putget(aktuellemaske,feld,aktuelleposition);name:=feld(2);IF fehler +THEN loeschemeldung(aktuellemaske);put(aktuellemaske,"",4)FI .END PROC +aktuelleskommandolesen;PROC kommandoausfuehren:disablestop;melde( +aktuellemaske,46);store(FALSE );do(name);store(TRUE );IF iserrorTHEN +clearerror;meldefehler;ELSE fehler:=FALSE ;fehl:="";reorganizescreenFI ; +return(1);enablestop.meldefehler:meldeauffaellig(aktuellemaske,45);fehl:= +errormessage.END PROC kommandoausfuehren;PROC init(ROW 100TEXT VAR feld):INT +VAR i;FOR iFROM 1UPTO 100REP feld(i):=""PER END PROC init;END PACKET +schuliskommandobehandlung; + diff --git a/app/baisy/2.2.1-schulis/src/shard interface b/app/baisy/2.2.1-schulis/src/shard interface new file mode 100644 index 0000000..20d9b76 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/shard interface @@ -0,0 +1,20 @@ +; ';' in Spalte 1 kennzeichnet eine Kommentarzeile +; alle Werte müssen durch Blanks getrennt werden +; +;heads: Anzahl der Köpfe, positiv für cylinderorientiertes Lesen +; negativ für seitenorientiertes Lesen +; +;size heads tracks first sectors last sector +;===================================================== +320 1 40 1 8 +360 1 40 1 9 +640 -2 40 1 8 +720 -2 40 1 9 +800 2 40 1 10 +1440 -2 80 1 9 +1600 2 80 1 10 +2400 -2 80 1 15 +1232 1 77 0 15 +2464 -2 77 0 15 +; END OF FILE + diff --git a/app/baisy/2.2.1-schulis/src/standarddialog b/app/baisy/2.2.1-schulis/src/standarddialog new file mode 100644 index 0000000..7e498cb --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/standarddialog @@ -0,0 +1,34 @@ +PACKET standarddialogDEFINES standardstartproc,standardvproc,standardnproc, +standardfelderausgeben,standardmaskenfeld,standardfeldlaenge,standardfeldname +,standardmeldung,standardpruefe,infeld,IN ,feldschutz,feldfrei:LET maxfelder= +200;TAG VAR maske;INT VAR einstieg;ROW maxfelderTEXT VAR feld;BOOL VAR +feldausgeben;LET xruhepos=1,yruhepos=24;INT PROC infeld:einstiegEND PROC +infeld;PROC standardstartproc(TEXT CONST maskenname):initmaske(maske, +maskenname);page;initfeld;einstieg:=2;standardkopfmaskeausgeben(text( +vergleichsknoten));feldausgeben:=FALSE ;show(maske)END PROC standardstartproc +;PROC standardvproc(TEXT CONST maskenname):standardstartproc(maskenname); +standardnprocEND PROC standardvproc;PROC standardnproc:IF feldausgebenTHEN +standardfelderausgebenFI ;get(maske,feld,einstieg);loeschemeldung(maske); +cursor(xruhepos,yruhepos)END PROC standardnproc;PROC standardfelderausgeben: +INT VAR fnr;INT VAR maxnr:=fields(maske);FOR fnrFROM einstiegUPTO maxnrREP +IF fieldexists(maske,fnr)THEN put(maske,feld(fnr),fnr)FI PER ;feldausgeben:= +falseEND PROC standardfelderausgeben;PROC standardpruefe(INT CONST pruefart, +INT CONST feldnummer,ug,og,TEXT CONST bestand,INT VAR status):pruefe(pruefart +,maske,TEXT PROC (INT CONST )standardmaskenfeld,feldnummer,ug,og,bestand, +status)END PROC standardpruefe;PROC feldschutz(INT CONST feldnr):protect( +maske,feldnr,TRUE )END PROC feldschutz;PROC feldfrei(INT CONST feldnr): +protect(maske,feldnr,FALSE )END PROC feldfrei;INT PROC standardfeldlaenge( +INT CONST i):length(maske,i)END PROC standardfeldlaenge;INT PROC +standardfeldname(INT CONST i):symbolicname(maske,i)END PROC standardfeldname; +TEXT PROC standardmaskenfeld(INT CONST i):feld(i)END PROC standardmaskenfeld; +PROC standardmaskenfeld(TEXT CONST t,INT CONST i):feld(i):=t;feldausgeben:= +TRUE END PROC standardmaskenfeld;PROC infeld(INT CONST i):einstieg:=i;cursor( +maske,i)END PROC infeld;OP IN (TEXT CONST t,INT CONST feldnr):put(maske,t, +feldnr);feld(feldnr):=tEND OP IN ;PROC standardmeldung(INT CONST mnr,TEXT +CONST ergaenzung):IF ergaenzung=""THEN meldeauffaellig(maske,mnr)ELSE melde( +maske,mnr,ergaenzung)FI END PROC standardmeldung;PROC standardmeldung(TEXT +CONST meldungstext,TEXT CONST ergaenzung):IF ergaenzung=""THEN +meldeauffaellig(maske,meldungstext)ELSE melde(maske,meldungstext,ergaenzung) +FI END PROC standardmeldung;PROC initfeld:INT VAR i;FOR iFROM 1UPTO maxfelder +REP feld(i):=""PER END PROC initfeld;END PACKET standarddialog; + diff --git a/app/baisy/2.2.1-schulis/src/sybifunktionen b/app/baisy/2.2.1-schulis/src/sybifunktionen new file mode 100644 index 0000000..ebe62ea --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/sybifunktionen @@ -0,0 +1,71 @@ +PACKET sybifunktionenDEFINES initsybifunktionen,setzebenutzerberechtigung, +holeberechtigungswert,setzeprogrammende,programmende, +setzeeditorschalterzurueck,gesetztdurcheditor,setzeschalterfuermenueausgabe, +loeschetastendruck,tastendruck,setzetastendruck,bittedasmenuezeigen, +menuedraussen,seteingabe,vpwunsch,npwunsch,vpgewaehlt,npgewaehlt,enter,return +,reenter,leave,setzevergleichsknoten,vergleichsknoten,knotenaufstackablegen, +legehistorieknotenab,holehistorietext,stopbaisy,setzeverteilteanwendung, +beendendessystembauminterpreters:TEXT VAR gedruecktetaste;BOOL VAR +programmendeschalter:=FALSE ,editorschalter:=FALSE ,schalterfuermenueausgabe +:=FALSE ,vornachschalter,verteilteanwendung:=FALSE ;KNOTEN VAR k;STACK VAR s; +INT VAR zurueckknotenanz;LET schaltervorprozedur=TRUE ,schalternachprozedur= +FALSE ;TEXT VAR benutzerberechtigung:="";LET maxmenueebenen=4;LET +HISTORIEKNOTEN =STRUCT (TEXT knotentext,INT anwahlpos);ROW maxmenueebenen +HISTORIEKNOTEN VAR hk;INT VAR aktebene;PROC setzeverteilteanwendung: +verteilteanwendung:=TRUE END PROC setzeverteilteanwendung;PROC seteingabe( +TEXT CONST t):gedruecktetaste:=t;editorschalter:=TRUE END PROC seteingabe; +PROC setzeeditorschalterzurueck:editorschalter:=FALSE END PROC +setzeeditorschalterzurueck;BOOL PROC gesetztdurcheditor:editorschalterEND +PROC gesetztdurcheditor;PROC setzebenutzerberechtigung(TEXT CONST t): +benutzerberechtigung:=tEND PROC setzebenutzerberechtigung;PROC +holeberechtigungswert(TEXT VAR t):t:=benutzerberechtigungEND PROC +holeberechtigungswert;PROC setzeprogrammende(BOOL CONST wahrwert): +programmendeschalter:=wahrwertEND PROC setzeprogrammende;BOOL PROC +programmende:programmendeschalterEND PROC programmende;PROC +setzeschalterfuermenueausgabe(BOOL CONST sfma):schalterfuermenueausgabe:=sfma +END PROC setzeschalterfuermenueausgabe;BOOL PROC menuedraussen: +schalterfuermenueausgabeEND PROC menuedraussen;BOOL PROC bittedasmenuezeigen: +schalterfuermenueausgabeEND PROC bittedasmenuezeigen;PROC loeschetastendruck: +gedruecktetaste:=""END PROC loeschetastendruck;TEXT PROC tastendruck: +gedruecktetasteEND PROC tastendruck;PROC setzetastendruck(TEXT CONST taste): +gedruecktetaste:=tasteEND PROC setzetastendruck;PROC vpwunsch:vornachschalter +:=schaltervorprozedurEND PROC vpwunsch;PROC npwunsch:vornachschalter:= +schalternachprozedurEND PROC npwunsch;BOOL PROC vpgewaehlt:vornachschalter +END PROC vpgewaehlt;BOOL PROC npgewaehlt:NOT vornachschalterEND PROC +npgewaehlt;PROC return(INT CONST zurueckknotenanzahl):zurueckknotenanz:= +zurueckknotenanzahl;INT VAR knotenstackhoehe;knotenstackhoehe:=hoehe(s); +npwunsch;IF knotenstackhoehe0THEN IF text( +k)=hk(aktebene).knotentextTHEN aktebeneDECR 1FI ;FI ;zurueckknotenzaehler +INCR 1PER ;END PROC holenaechstenstackknoten;PROC knotenaufstackablegen( +KNOTEN VAR stackknoten):push(s,k)END PROC knotenaufstackablegen;PROC +setzevergleichsknoten(KNOTEN CONST vglknoten):k:=vglknotenEND PROC +setzevergleichsknoten;KNOTEN PROC vergleichsknoten:kEND PROC vergleichsknoten +;PROC beendendessystembauminterpreters:setzeprogrammende(TRUE );return(1)END +PROC beendendessystembauminterpreters;PROC initsybifunktionen: +programmendeschalter:=FALSE ;verteilteanwendung:=FALSE ;s:=leererstack; +aktebene:=0;store(TRUE );INT VAR ind;FOR indFROM 1UPTO maxmenueebenenREP hk( +ind).knotentext:="";hk(ind).anwahlpos:=0;PER END PROC initsybifunktionen; +PROC legehistorieknotenab(TEXT CONST ktext,INT CONST mpkt):IF aktebene< +maxmenueebenenTHEN aktebeneINCR 1;hk(aktebene).knotentext:=ktext;hk(aktebene) +.anwahlpos:=mpktFI END PROC legehistorieknotenab;PROC holehistorietext(TEXT +VAR ktext,INT VAR kpos,INT CONST nletzter):INT VAR hkzeiger;hkzeiger:= +aktebene-nletzter+1;IF hkzeiger<1THEN ktext:=""ELSE ktext:=hk(hkzeiger). +knotentext;kpos:=hk(hkzeiger).anwahlposFI END PROC holehistorietext;PROC +stopbaisy:logbucheintragabmeldung;benutzerberechtigung:="";enter(1);breakEND +PROC stopbaisy;PROC logbucheintragabmeldung:TEXT VAR eintrag:="Abmeldung """; +eintragCAT name(myself);eintragCAT """";logeintrag(eintrag)END PROC +logbucheintragabmeldung;END PACKET sybifunktionen + diff --git a/app/baisy/2.2.1-schulis/src/systembaum b/app/baisy/2.2.1-schulis/src/systembaum new file mode 100644 index 0000000..2497398 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/systembaum @@ -0,0 +1,299 @@ +PACKET systembaumDEFINES sohnvon,reorganisieren,gibbaumtabelle,KNOTEN ,=, +neuerknoten,nilknoten,markierungsknoten,erster,naechster,gueltig,suche, +existiert,read,write,inknotenmenge,ausknotenmenge,knotenloeschen,move, +KNOTENMENGE ,:=,zahlderelemente,leereknotenmenge,knotenmengeloeschen,exporte, +importe,system,listederteilbaeume,startesystembaum,kopieresystembaum, +ueberschreibesystembaum,setzesystembaumzurueck:BOOL PROC sohnvon(KNOTEN +CONST vater,sohn):pos(kmknoten,CONCR (sohn))>0.kmknoten:IF CONCR (vater)<= +maxknTHEN systembaum.tabzeile(CONCR (vater)).knotenELSE verwaltung.tabzeile( +CONCR (vater)-maxkn).knotenFI .ENDPROC sohnvon;LET maxkn=2190,niltext="",null +=0,knindex=1;LET kn1=2191,kn2=2192,kn3=2193;LET systembaumname="BAISY-0", +systembaumkopie="SBKOP",verwaltungsname="BAISY-1",verwaltungskopie="VWKOP"; +LET maxhoehe=100,bottom=1,refkz="1",erreichtkz="2";LET reorgincr=7000;TYPE +TUPEL =STRUCT (KNOTEN kn,INT index,BOOL markiert);TYPE STACK =STRUCT (ROW +maxhoeheTUPEL st,INT top);TYPE KNOTENMENGE =INT ;TYPE KNOTEN =INT ;TYPE +EINTRAG =STRUCT (TEXT attribute,KNOTEN vater,LONGROW knotenmengenLONGROW +knoten);TYPE SYSTAB =STRUCT (INT maxeintrag,ersterfreier,ROW maxknEINTRAG +tabzeile);KNOTEN CONST nilknoten:=KNOTEN :(null);KNOTEN CONST +markierungsknoten:=KNOTEN :(4711);BOUND SYSTAB VAR systembaum;BOUND SYSTAB +VAR verwaltung;BOUND SYSTAB VAR reorg;KNOTENMENGE VAR exp,imp,sys;PROC +gibbaumtabelle(TEXT CONST startknotenname,DATASPACE VAR ds):CONCR (systembaum +.tabzeile(systembaum.ersterfreier).vater):=zeilennr(startknotenname);ds:=old( +systembaumname)END PROC gibbaumtabelle;INT PROC zeilennr(TEXT CONST +startknotenname):KNOTEN VAR k;IF existiert(exporte,k,startknotenname)THEN +KNOTENMENGE VAR soehne;read(k,soehne);CONCR (erster(soehne))ELSE nullFI END +PROC zeilennr;OP :=(KNOTEN VAR k,KNOTEN CONST l):CONCR (k):=CONCR (l)END OP +:=;BOOL OP =(KNOTEN CONST k,KNOTEN CONST l):CONCR (k)=CONCR (l)END OP =; +KNOTEN PROC neuerknoten(KNOTENMENGE CONST m):KNOTEN VAR k;CONCR (k):= +neuereintrag(CONCR (m)<>CONCR (sys),true);inknotenmenge(m,k);kEND PROC +neuerknoten;KNOTEN PROC neuerknoten(KNOTENMENGE CONST m,TEXT CONST schluessel +):KNOTEN VAR k;IF existiert(m,k,schluessel)THEN LEAVE neuerknotenWITH kFI ; +KNOTEN VAR l;CONCR (l):=neuereintrag(CONCR (m)<>CONCR (sys),true);write(l, +schluessel);inknotenmenge(m,l,k);lEND PROC neuerknoten;BOOL PROC existiert( +KNOTENMENGE CONST a,KNOTEN VAR r,TEXT CONST muster):BOOL VAR gefunden;suche(a +,muster,r,gefunden);gefundenEND PROC existiert;PROC read(KNOTEN CONST k, +KNOTEN VAR vater):vater:=kvater.kvater:IF CONCR (k)<=maxknTHEN systembaum. +tabzeile(CONCR (k)).vaterELSE verwaltung.tabzeile(CONCR (k)-maxkn).vaterFI . +END PROC read;PROC read(KNOTEN CONST k,KNOTENMENGE VAR soehne):CONCR (soehne) +:=CONCR (k)END PROC read;PROC read(KNOTEN CONST k,TEXT VAR attribute): +attribute:=kattribute.kattribute:IF CONCR (k)<=maxknTHEN systembaum.tabzeile( +CONCR (k)).attributeELSE verwaltung.tabzeile(CONCR (k)-maxkn).attributeFI . +END PROC read;PROC read(KNOTEN CONST k,EINTRAG VAR attribute):attribute:= +keintrag.keintrag:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k))ELSE +verwaltung.tabzeile(CONCR (k)-maxkn)FI .END PROC read;PROC write(KNOTEN +CONST k,KNOTEN CONST vater):kvater:=vater.kvater:IF CONCR (k)<=maxknTHEN +systembaum.tabzeile(CONCR (k)).vaterELSE verwaltung.tabzeile(CONCR (k)-maxkn) +.vaterFI .END PROC write;PROC write(KNOTEN CONST k,KNOTENMENGE CONST soehne): +kknoten:=sohnknoten.kknoten:IF CONCR (k)<=maxknTHEN systembaum.tabzeile( +CONCR (k)).knotenELSE verwaltung.tabzeile(CONCR (k)-maxkn).knotenFI . +sohnknoten:IF CONCR (soehne)<=maxknTHEN systembaum.tabzeile(CONCR (soehne)). +knotenELSE verwaltung.tabzeile(CONCR (soehne)-maxkn).knotenFI .END PROC write +;PROC write(KNOTEN CONST k,TEXT CONST attribute):kattribute:=attribute. +kattribute:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k)).attribute +ELSE verwaltung.tabzeile(CONCR (k)-maxkn).attributeFI .END PROC write;PROC +write(KNOTEN CONST k,EINTRAG CONST attribute):keintrag:=attribute.keintrag: +IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k))ELSE verwaltung. +tabzeile(CONCR (k)-maxkn)FI .END PROC write;PROC inknotenmenge(KNOTENMENGE +CONST km,KNOTEN CONST k):kmknotenCAT kindex;kknotenmengenCAT kmindex.kmknoten +:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR (km)).knotenELSE +verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .kknotenmengen:IF CONCR (k)<= +maxknTHEN systembaum.tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile +(CONCR (k)-maxkn).knotenmengenFI .kindex:CONCR (k).kmindex:CONCR (km).END +PROC inknotenmenge;PROC inknotenmenge(KNOTENMENGE CONST km,KNOTEN CONST k,l): +IF l=nilknotenTHEN inknotenmenge(km,k)ELSE insert(kmknoten,posl,kindex); +kknotenmengenCAT kmindexFI .posl:pos(kmknoten,lindex).kmknoten:IF CONCR (km) +<=maxknTHEN systembaum.tabzeile(CONCR (km)).knotenELSE verwaltung.tabzeile( +CONCR (km)-maxkn).knotenFI .kknotenmengen:IF CONCR (k)<=maxknTHEN systembaum. +tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile(CONCR (k)-maxkn). +knotenmengenFI .kindex:CONCR (k).lindex:CONCR (l).kmindex:CONCR (km).END +PROC inknotenmenge;PROC ausknotenmenge(KNOTENMENGE CONST km,KNOTEN VAR k): +KNOTEN VAR l:=k;naechster(l,km);delete(kmknoten,kindex);delete(kknotenmengen, +kmindex);k:=l.kmknoten:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR (km +)).knotenELSE verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .kknotenmengen: +IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k)).knotenmengenELSE +verwaltung.tabzeile(CONCR (k)-maxkn).knotenmengenFI .kindex:pos(kmknoten, +CONCR (k)).kmindex:pos(kknotenmengen,CONCR (km)).END PROC ausknotenmenge; +PROC knotenloeschen(KNOTENMENGE CONST km,KNOTEN VAR k):IF +knotenundknotenmengeexistierenTHEN ausallenmengen;sohnknotenmengeloeschen; +ungueltigmachen(CONCR (l))FI .knotenundknotenmengeexistieren:(CONCR (km)<>0) +CAND (CONCR (k)<>0).ausallenmengen:KNOTEN VAR nachf:=k;KNOTEN CONST l:=k; +LONGROW VAR mengen:=kknotenmengen;INT VAR i,mindex;KNOTENMENGE VAR m;FOR i +FROM 1UPTO length(mengen)REP mindex:=mengen_i;CONCR (m):=mindex; +ausknotenmenge(m,k);IF mindex=CONCR (km)THEN nachf:=kFI ;k:=lPER ;k:=nachf. +sohnknotenmengeloeschen:KNOTENMENGE VAR soehne;CONCR (soehne):=CONCR (l); +knotenmengeloeschen(soehne).kknotenmengen:IF CONCR (k)<=maxknTHEN systembaum. +tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile(CONCR (k)-maxkn). +knotenmengenFI .END PROC knotenloeschen;PROC move(KNOTEN CONST k,KNOTEN +CONST l):eigenschaftenuebertragen;pointerpflegen.eigenschaftenuebertragen: +systembaum.tabzeile(CONCR (l)).knoten:=systembaum.tabzeile(CONCR (k)).knoten; +systembaum.tabzeile(CONCR (l)).attribute:=systembaum.tabzeile(CONCR (k)). +attribute.pointerpflegen:soehnevonkumsetzen;vaetervonkumsetzen. +soehnevonkumsetzen:soehneumsetzen(systembaum.tabzeile(CONCR (k)).knoten,k,l). +vaetervonkumsetzen:vaeterumsetzen(systembaum.tabzeile(CONCR (k)).knotenmengen +,k,l).END PROC move;PROC soehneumsetzen(LONGROW CONST soehne,KNOTEN CONST von +,nach):INT VAR i;FOR iFROM 1UPTO length(soehne)REP INT VAR sohni:=soehne_i; +replace(beisohni,posvon,CONCR (nach))PER .beisohni:systembaum.tabzeile(sohni) +.knotenmengen.posvon:pos(beisohni,CONCR (von)).END PROC soehneumsetzen;PROC +vaeterumsetzen(LONGROW CONST vaeter,KNOTEN CONST von,nach):INT VAR i,refindex +;refindex:=CONCR (systembaum.tabzeile(CONCR (von)).vater);FOR iFROM 1UPTO +length(vaeter)REP INT VAR vateri:=vaeter_i;vaterumsetzen(vateri,refindex,nach +)PER END PROC vaeterumsetzen;PROC vaterumsetzen(INT CONST vaterindex,refindex +,KNOTEN CONST nach):IF (vaterindex<>CONCR (system))CAND (vaterindex<>refindex +)THEN KNOTENMENGE VAR vater;CONCR (vater):=vaterindex;inknotenmenge(vater, +nach)FI END PROC vaterumsetzen;KNOTEN PROC erster(KNOTENMENGE CONST m): +LONGROW CONST ordnung:=mknoten;ersternach(null,ordnung).mknoten:IF CONCR (m) +<=maxknTHEN systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile( +CONCR (m)-maxkn).knotenFI .END PROC erster;PROC naechster(KNOTEN VAR k, +KNOTENMENGE CONST m):LONGROW CONST ordnung:=mknoten;k:=ersternach(indexvonk, +ordnung).indexvonk:pos(ordnung,CONCR (k)).mknoten:IF CONCR (m)<=maxknTHEN +systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile(CONCR (m)-maxkn +).knotenFI .END PROC naechster;BOOL PROC gueltig(KNOTEN CONST k):CONCR (k)<> +nullEND PROC gueltig;PROC suche(KNOTENMENGE CONST m,TEXT CONST muster,KNOTEN +VAR k,BOOL VAR gefunden):LONGROW CONST ordnung:=mknoten;INT CONST l:=length( +ordnung);IF l=nullTHEN gefunden:=false;k:=nilknotenELSE INT VAR ordnungsindex +;binsearch(ordnung,muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner, +ordnungsindex);IF ordnungsindex>lTHEN gefunden:=false;k:=nilknotenELSE CONCR +(k):=ordnung_ordnungsindex;TEXT VAR gefundenesmuster;read(k,gefundenesmuster) +;gefunden:=(muster=gefundenesmuster)FI FI .mknoten:IF CONCR (m)<=maxknTHEN +systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile(CONCR (m)-maxkn +).knotenFI .END PROC suche;OP :=(KNOTENMENGE VAR k,KNOTENMENGE CONST l): +CONCR (k):=CONCR (l)END OP :=;INT PROC zahlderelemente(KNOTENMENGE CONST km): +length(kmknoten).kmknoten:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR +(km)).knotenELSE verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .END PROC +zahlderelemente;KNOTENMENGE PROC leereknotenmenge:KNOTENMENGE VAR k;CONCR (k) +:=neuereintrag(true,false);kEND PROC leereknotenmenge;PROC +knotenmengeloeschen(KNOTENMENGE VAR km):IF knotenmengeexistiertTHEN +allezeigerloeschen;alsungueltigkennzeichnenFI .knotenmengeexistiert:CONCR (km +)<>0.allezeigerloeschen:INT CONST kmind:=CONCR (km);LONGROW VAR knoten:= +kmindknoten;INT VAR i,kindex;LONGROW VAR row;FOR iFROM 1UPTO length(knoten) +REP kindex:=knoten_i;row:=kindexknotenmengen;delete(kindexknotenmengen,pos( +row,kmind))PER ;.kmindknoten:IF kmind<=maxknTHEN systembaum.tabzeile(kmind). +knotenELSE verwaltung.tabzeile(kmind-maxkn).knotenFI .kindexknotenmengen:IF +kindex<=maxknTHEN systembaum.tabzeile(kindex).knotenmengenELSE verwaltung. +tabzeile(kindex-maxkn).knotenmengenFI .alsungueltigkennzeichnen:IF +nichtinknotenTHEN ungueltigmachen(kmind);ELSE kmindknoten:=newrowFI ;CONCR ( +km):=null.nichtinknoten:KNOTEN VAR vglknoten,kmknoten;CONCR (kmknoten):=kmind +;read(kmknoten,vglknoten);CONCR (vglknoten)=knindex.END PROC +knotenmengeloeschen;KNOTENMENGE PROC exporte:expEND PROC exporte;KNOTENMENGE +PROC importe:impEND PROC importe;KNOTENMENGE PROC system:sysEND PROC system; +PROC startesystembaum:IF verwaltungdaTHEN nurankoppelnELSE +ankoppelnundpermanenteknotenmengenerzeugenFI ;systembaumbehandeln. +verwaltungda:exists(verwaltungsname).nurankoppeln:verwaltung:=old( +verwaltungsname);CONCR (exp):=kn1;CONCR (imp):=kn2;CONCR (sys):=kn3. +ankoppelnundpermanenteknotenmengenerzeugen:verwaltung:=new(verwaltungsname); +verwaltung.maxeintrag:=0;verwaltung.ersterfreier:=1;exp:=leereknotenmenge;imp +:=leereknotenmenge;sys:=leereknotenmenge.systembaumbehandeln:IF exists( +systembaumname)THEN systembaum:=old(systembaumname)ELSE systembaum:=new( +systembaumname);systembaum.maxeintrag:=0;systembaum.ersterfreier:=1;FI .END +PROC startesystembaum;PROC listederteilbaeume(TEXT CONST dateiname):LONGROW +VAR refinements;FILE VAR f:=sequentialfile(output,dateiname);refinements:= +verwaltung.tabzeile(CONCR (exporte)-maxkn).knoten;INT VAR i;FOR iFROM 1UPTO +length(refinements)REP put(f,verwaltung.tabzeile((refinements_i)-maxkn). +attribute);line(f)PER ;close(f)END PROC listederteilbaeume;PROC +kopieresystembaum:copy(systembaumname,systembaumkopie);systembaum:=old( +systembaumkopie);copy(verwaltungsname,verwaltungskopie);verwaltung:=old( +verwaltungskopie)END PROC kopieresystembaum;PROC ueberschreibesystembaum: +forget(systembaumname,quiet);rename(systembaumkopie,systembaumname);forget( +verwaltungsname,quiet);rename(verwaltungskopie,verwaltungsname)END PROC +ueberschreibesystembaum;PROC setzesystembaumzurueck:systembaum:=old( +systembaumname);forget(systembaumkopie,quiet);verwaltung:=old(verwaltungsname +);forget(verwaltungskopie,quiet)END PROC setzesystembaumzurueck;INT PROC +neuereintrag(BOOL CONST istverwaltung,istknoten):EINTRAG VAR e;e.attribute:= +niltext;IF istknotenTHEN CONCR (e.vater):=null;ELSE CONCR (e.vater):=knindex +FI ;e.knotenmengen:=newrow;e.knoten:=newrow;INT VAR eintragsnr; +naechstenfreiensuchen(istverwaltung,eintragsnr);KNOTEN VAR k;CONCR (k):= +eintragsnr;write(k,e);eintragsnrEND PROC neuereintrag;OP :=(EINTRAG VAR e, +EINTRAG CONST f):CONCR (e):=CONCR (f)END OP :=;PROC naechstenfreiensuchen( +BOOL CONST istverwaltung,INT VAR eintragsnr):IF istverwaltungTHEN +naechstenfreieninverwaltungsuchen(eintragsnr)ELSE +naechstenfreieninsystembaumsuchen(eintragsnr)FI END PROC +naechstenfreiensuchen;PROC naechstenfreieninsystembaumsuchen(INT VAR +eintragsnr):eintragsnr:=systembaum.ersterfreier;IF systembaum.ersterfreier> +systembaum.maxeintragTHEN systembaum.maxeintrag:=systembaum.ersterfreier; +systembaum.ersterfreierINCR 1ELSE INT VAR i;FOR iFROM systembaum.ersterfreier ++1UPTO systembaum.maxeintragREP IF NOT istgueltigTHEN systembaum.ersterfreier +:=i;LEAVE naechstenfreieninsystembaumsuchenFI PER ;systembaum.ersterfreier:= +systembaum.maxeintrag+1FI .istgueltig:CONCR (systembaum.tabzeile(i).vater)>= +null.END PROC naechstenfreieninsystembaumsuchen;PROC +naechstenfreieninverwaltungsuchen(INT VAR eintragsnr):eintragsnr:=verwaltung. +ersterfreier+maxkn;IF verwaltung.ersterfreier>verwaltung.maxeintragTHEN +verwaltung.maxeintrag:=verwaltung.ersterfreier;verwaltung.ersterfreierINCR 1 +ELSE INT VAR i;FOR iFROM verwaltung.ersterfreier+1UPTO verwaltung.maxeintrag +REP IF NOT istgueltigTHEN verwaltung.ersterfreier:=i;LEAVE +naechstenfreieninverwaltungsuchenFI PER ;verwaltung.ersterfreier:=verwaltung. +maxeintrag+1FI .istgueltig:CONCR (verwaltung.tabzeile(i).vater)>=null.END +PROC naechstenfreieninverwaltungsuchen;KNOTEN PROC ersternach(INT CONST +knindex,LONGROW CONST ordnung):KNOTEN VAR k:=nilknoten;INT CONST l:=length( +ordnung);IF (l>0)CAND (knindex=0.uebertrage:EINTRAG VAR e;e.attribute +:=verwaltung.tabzeile(i).attribute;e.knotenmengen:=verwaltung.tabzeile(i). +knotenmengen;e.vater:=verwaltung.tabzeile(i).vater;e.knoten:=decr(verwaltung. +tabzeile(i).knoten);reorg.tabzeile(i):=e.markiere:CONCR (reorg.tabzeile(i). +vater):=-1.vorbereitung:DATASPACE VAR ds:=nilspace;reorg:=ds;reorg.maxeintrag +:=verwaltung.maxeintrag;reorg.ersterfreier:=verwaltung.ersterfreier.abschluss +:forget(verwaltungsname,quiet);copy(ds,verwaltungsname);forget(ds); +startesystembaum.END PROC reorganisiereverwaltung;PROC reorganisiere(LONGROW +CONST unbenutzte,startknoten):INT VAR i;FOR iFROM 1UPTO length(unbenutzte) +REP reorganisiere(knoten,name)PER .knoten:KNOTEN :(startknoten_i).name:TEXT +VAR na;read(KNOTEN :(unbenutzte_i),na);na.END PROC reorganisiere;PROC +reorganisiere(KNOTEN CONST k,TEXT CONST teilbaumname):line;put("Teilbaum "+ +teilbaumname+" wird reorganisiert");reorganisiere(k)END PROC reorganisiere; +PROC reorganisiere(KNOTEN CONST k):vorbereitung;erstenaufstack;REP +stackbearbeitungUNTIL stackleerPER .stackbearbeitung:nimmoberstenvomstack;IF +(NOT oberstermarkiert)CAND hatsoehneTHEN markiertzurueck; +allesoehneaufdenstackELSE oberstenuebertragenFI .vorbereitung:STACK VAR s:= +leererstack.erstenaufstack:TUPEL VAR tup;IF schonmalerreicht(k)THEN LEAVE +reorganisiereELSE tup.kn:=k;tup.index:=naechsterindex;tup.markiert:=false; +alserreichtkennzeichnen(k);vater.kn:=systembaum.tabzeile(CONCR (k)).vater; +vater.index:=CONCR (vater.kn);hauptindexaendern(tup,vater);push(s,tup)FI . +stackleer:leer(s).nimmoberstenvomstack:TUPEL VAR vater;pop(s,vater). +oberstermarkiert:vater.markiert.markiertzurueck:vater.markiert:=true;push(s, +vater).hatsoehne:KNOTENMENGE VAR soehne;read(vater.kn,soehne);INT VAR +sohnzahl:=zahlderelemente(soehne);sohnzahl>0.oberstenuebertragen:uebertrage( +vater).allesoehneaufdenstack:INT VAR i;LONGROW VAR sohnverzeichnis:= +systembaum.tabzeile(CONCR (soehne)).knoten;tup.markiert:=false;FOR iFROM 1 +UPTO sohnzahlREP holesohn;IF NOT (schonmalerreicht(sohn))THEN +itersohnaufstackELSE indexaendern(s,vater,sohn)FI PER .holesohn:KNOTEN VAR +sohn;CONCR (sohn):=sohnverzeichnis_i.itersohnaufstack:tup.kn:=sohn;tup.index +:=naechsterindex;IF isrefinement(sohn)THEN alserreichtkennzeichnen(sohn)FI ; +hauptindexaendern(tup,vater);push(s,tup).END PROC reorganisiere;BOOL PROC +schonmalerreicht(KNOTEN CONST k):is(k,erreichtkz)END PROC schonmalerreicht; +BOOL PROC isrefinement(KNOTEN CONST k):is(k,refkz)END PROC isrefinement;BOOL +PROC is(KNOTEN CONST k,TEXT CONST muster):is(attribute(k),muster)END PROC is; +BOOL PROC is(TEXT CONST k,TEXT CONST muster):(subtext(k,1,1)=muster)END PROC +is;PROC alserreichtkennzeichnen(KNOTEN CONST k):replace(systembaum.tabzeile( +CONCR (k)).attribute,1,erreichtkz)END PROC alserreichtkennzeichnen;TEXT PROC +attribute(KNOTEN CONST k):systembaum.tabzeile(CONCR (k)).attributeEND PROC +attribute;INT PROC naechsterindex:reorg.maxeintragINCR 1;reorg.ersterfreier +INCR 1;cout(reorg.maxeintrag);reorg.maxeintragEND PROC naechsterindex;PROC +uebertrage(TUPEL CONST tup):EINTRAG VAR e;INT VAR knummer:=CONCR (tup.kn);e. +attribute:=systembaum.tabzeile(knummer).attribute;e.vater:=systembaum. +tabzeile(knummer).vater;e.knotenmengen:=decr(systembaum.tabzeile(knummer). +knotenmengen);e.knoten:=decr(systembaum.tabzeile(knummer).knoten);IF +schonmalerreichtTHEN replace(e.attribute,1,refkz)FI ;reorg.tabzeile(tup.index +):=e;CONCR (systembaum.tabzeile(knummer).vater):=tup.index.schonmalerreicht: +is(e.attribute,erreichtkz).END PROC uebertrage;PROC hauptindexaendern(TUPEL +CONST tup,TUPEL CONST vater):INT VAR knummer:=CONCR (tup.kn);LONGROW VAR +knotenmengen:=systembaum.tabzeile(knummer).knotenmengen;INT VAR i;FOR iFROM 1 +UPTO length(knotenmengen)REP IF verwaltungodervaterTHEN indexaendern(knummer, +tup.index,iteknotenmenge,vater.index)FI PER .verwaltungodervater:INT VAR +iteknotenmenge:=knotenmengen_i;(iteknotenmenge>maxkn)COR (iteknotenmenge= +CONCR (vater.kn)).END PROC hauptindexaendern;PROC indexaendern(STACK CONST s, +TUPEL CONST vater,KNOTEN CONST sohn):INT VAR neuersohnindex:=CONCR ( +systembaum.tabzeile(CONCR (sohn)).vater);IF nochaufstackTHEN +sucheneuensohnindexFI ;indexaendern(CONCR (sohn),neuersohnindex,CONCR (vater. +kn),vater.index);reorg.tabzeile(neuersohnindex).knotenmengen:=decr(systembaum +.tabzeile(CONCR (sohn)).knotenmengen).nochaufstack:(neuersohnindex>maxkn). +sucheneuensohnindex:search(s,CONCR (sohn),neuersohnindex);.END PROC +indexaendern;PROC indexaendern(INT CONST alterindex,nind,knalt,kneu):INT VAR +neuerindex:=nind+reorgincr,knneu:=kneu+reorgincr;IF knalt<=maxknTHEN +possystemELSE errechneposition;posverwaltung;FI .possystem:INT VAR ps:=pos( +systemknoten,alterindex);replace(systemknoten,ps,neuerindex);replace( +systemknotenmengen,knpos,knneu).systemknoten:systembaum.tabzeile(knalt). +knoten.systemknotenmengen:systembaum.tabzeile(alterindex).knotenmengen.knpos: +pos(systemknotenmengen,knalt).errechneposition:INT CONST position:=knalt- +maxkn.posverwaltung:INT VAR pv:=pos(verwaltungsknoten,alterindex);replace( +verwaltungsknoten,pv,neuerindex).verwaltungsknoten:verwaltung.tabzeile( +position).knoten.END PROC indexaendern;LONGROW PROC decr(LONGROW CONST l): +LONGROW VAR row:=newrow;INT VAR i;FOR iFROM 1UPTO length(l)REP rowCAT ((l_i) +MOD reorgincr)PER ;rowEND PROC decr;STACK PROC leererstack:STACK VAR s;s.top +:=bottom;sEND PROC leererstack;OP :=(TUPEL VAR ziel,TUPEL CONST quelle): +CONCR (ziel):=CONCR (quelle)END OP :=;OP :=(STACK VAR ziel,STACK CONST quelle +):CONCR (ziel):=CONCR (quelle)END OP :=;PROC push(STACK VAR s,TUPEL CONST k): +IF NOT (s.top=maxhoehe)THEN s.st(s.top):=k;s.topINCR 1ELSE errorstop( +"Stacküberlauf")FI END PROC push;PROC pop(STACK VAR s,TUPEL VAR k):IF NOT (s. +top=bottom)THEN s.topDECR 1;k:=s.st(s.top)ELSE errorstop("Stackunterlauf")FI +END PROC pop;PROC search(STACK CONST s,INT CONST index,INT VAR neuersohnindex +):INT VAR i:=0;REP iINCR 1;IF i>s.topTHEN errorstop("Rekursionsauflösung: "+ +text(index)+" nicht auf stack")FI UNTIL CONCR (s.st(i).kn)=indexPER ; +neuersohnindex:=s.st(i).indexEND PROC search;INT PROC hoehe(STACK CONST s):s. +top-1END PROC hoehe;BOOL PROC voll(STACK CONST s):s.top=maxhoeheEND PROC voll +;BOOL PROC leer(STACK CONST s):s.top=bottomEND PROC leer;END PACKET +systembaum; + diff --git a/app/baisy/2.2.1-schulis/src/systembauminterpreter b/app/baisy/2.2.1-schulis/src/systembauminterpreter new file mode 100644 index 0000000..222cdfe --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/systembauminterpreter @@ -0,0 +1,390 @@ +PACKET systembauminterpreterDEFINES startebaisy,starteschulis,starteanwendung +,startbaisy:LET esctaste="�",#crtaste=" ",#obentaste="�",untentaste=" +", +rechtstaste="�",hoptaste="�",ausrufezeichen="!",#leertaste=" ",#stufentrenner +=".",berechttrenner="/",codefuerziffernull=48,codefuerzifferneun=57, +titelfeldnr=2,felderanzahlbishistoriebeginn=2,historiebeginn=3,maxhknoten=4, +felderanzahlbismenuebeginn=6,historieende=6,menuebeginn=7,maxmenuepunkte=20, +felderpromenuepunkt=1,felderimanwahlmenue=18,fcursor=">",fcursorweg=" ", +laengedescursors=2,offenermenuepunkt="noch nicht realisiert",menuemaskenname= +"mb anwahlmenue",wartezeit=30,wegtext=" Ihr Weg durch das Menü:",stern="*", +strich="-",if="Systemfehler ",zeile=" Zeile: ",fortsetzung= +"Weiterarbeiten ist möglich. Fehlermeldung wird gedruckt!",POINTER =STRUCT ( +INT xpointer,ypointer);KNOTEN VAR k;ROW maxmenuepunkteKNOTEN VAR ktab;ROW +maxmenuepunkteBOOL VAR menuepunktanwaehlbar;ROW maxmenuepunktePOINTER VAR +pointer;TEXT VAR benutzerberechtigung:="";INT VAR aktfeldnr:=menuebeginn; +TEXT VAR vpname,npname;BOOL VAR menuemaske:=FALSE ,cursorbewegungmithop:= +FALSE ;LET zeilenzahlbildschirm=24,spaltenzahlbildschirm=79, +rahmenzusatzzeilen=4,spaltendesmenuerands=10,maxmenuetextlaenge=60, +tastenlaenge=4,zeichenblankstern=" *";TEXT VAR ueberschrift:="";INT VAR x1:=1 +,y1:=1,aktuellezeile,spaltendesmenuerahmens,zeilenzahldesfktmenues, +anzblankstern,textlaenge,cursorx,cursory;KNOTEN VAR +knotenfuerbildschirmausdruck,knotenfuerauskunftserteilung;LET +knotennamefuerbildschirmausdruck="hardcopy",knotennamefuerauskunftserteilung= +"auskunft",tastefuerbildschirmausdruck="o",tastefuerauskunftserteilung="?"; +PROC vpausfuehren(PROC (INT CONST ,BOOL CONST ,TEXT CONST )call):INT VAR +prozedurindex;prozedurindex:=knotenaufrufindex(k);enablestop;call( +prozedurindex,TRUE ,vpname)END PROC vpausfuehren;PROC npausfuehren(PROC (INT +CONST ,BOOL CONST ,TEXT CONST )call):INT VAR prozedurindex;prozedurindex:= +knotenaufrufindex(k);enablestop;call(prozedurindex,FALSE ,npname)END PROC +npausfuehren;BOOL PROC vpvorhanden:NOT ((vpname)="")END PROC vpvorhanden; +BOOL PROC npvorhanden:NOT ((npname)="")END PROC npvorhanden;PROC +bereitemenuemaskenausgabevor:page;loeschetastendruckEND PROC +bereitemenuemaskenausgabevor;PROC tasteholen:TEXT VAR zwischentaste;inchar( +zwischentaste);setzetastendruck(zwischentaste)END PROC tasteholen;PROC +gedaechtnisloeschen:TEXT VAR t:=" ";WHILE t<>""REP t:=incharetyPER END PROC +gedaechtnisloeschen;PROC setzeschalterfuermenueausgabenachfunktionstaste:IF ( +tastendruck=ausrufezeichen)OR (tastendruck="")THEN +setzeschalterfuermenueausgabe(TRUE )ELSE setzeschalterfuermenueausgabe(FALSE +)FI .END PROC setzeschalterfuermenueausgabenachfunktionstaste;BOOL PROC +anderermenuepunkt:IF nachobenoderuntenTHEN cursorbewegungmithop:=FALSE ;TRUE +ELIF tastendruck=hoptasteTHEN tasteholen;IF nachobenoderuntenTHEN +cursorbewegungmithop:=TRUE ;TRUE ELIF tastendruck=hoptasteTHEN +cursorbewegungmithop:=TRUE ;setzetastendruck(obentaste);TRUE ELSE FALSE FI +ELSE FALSE FI .nachobenoderunten:(tastendruck=obentaste)OR (tastendruck= +untentaste).END PROC anderermenuepunkt;BOOL PROC +knotenwechselbeiprozedurausfuehrung:NOT (k=vergleichsknoten)END PROC +knotenwechselbeiprozedurausfuehrung;PROC menuetextzusammensetzen(INT CONST +mpkt,TEXT CONST stufennum,TEXT VAR menuetext):TEXT VAR kts,ktx;BOOL VAR +berechtigt:=FALSE ;IF ktab(mpkt)=nilknotenTHEN ktx:=offenermenuepunkt; +behandlemenuepunkt(menuetext,mpkt,kts,ktx,FALSE )ELSE ktx:=text(ktab(mpkt)); +berechtigungspruefung(stufennum,mpkt,berechtigt);behandlemenuepunkt(menuetext +,mpkt,kts,ktx,berechtigt)FI .END PROC menuetextzusammensetzen;PROC +behandlemenuepunkt(TEXT VAR menuetextaufber,INT CONST menuepunkt,TEXT CONST +ktaste,ktext,BOOL CONST berechtigt):IF berechtigtTHEN menuetextaufber:=""+ +text(menuepunktMOD 10,1)+" "+ktextELSE menuetextaufber:=" "+ktextFI ; +setzemenuepunktzugang(menuepunkt+maxhknoten,berechtigt).END PROC +behandlemenuepunkt;PROC setzemenuepunktzugang(INT CONST feldnr,BOOL CONST +wahrwert):menuepunktanwaehlbar(feldnr):=wahrwertEND PROC +setzemenuepunktzugang;BOOL PROC zugangerlaubt(INT CONST feldnr): +menuepunktanwaehlbar(feldnr)END PROC zugangerlaubt;PROC fehlerbehandeln: +cursor(1,23);TEXT VAR fehlerzeile:=if+errormessage+zeile+text(errorline);put( +""+fehlerzeile+"�");line;put(fortsetzung+"�");clearerror;#FILE VAR f:= +sequentialfile(output,if);line(f);putline(f,date+" "+timeofday);line(f); +putline(f,text(vergleichsknoten));line(f);putline(f,fehlerzeile);print(if); +forget(if,quiet)#END PROC fehlerbehandeln;PROC zeige(TEXT VAR te,INT CONST +start1,start2,schluss):INT VAR zeile2:=start1+1;cursor(1,start1);out(te);INT +CONST ende:=length(te),anfang:=pos(te,stern);INT CONST stellen:=ende-anfang+2 +;historiemalen;trennungslinie;restmalen.historiemalen:cursor(anfang,zeile2); +out(stern);out(wegtext);cursor(ende,zeile2);out(stern);INT VAR i;FOR iFROM +zeile2+1UPTO start2-2REP zeilerausPER .trennungslinie:cursor(anfang,start2-1) +;out(stern);(stellen-3)TIMESOUT strich;out(stern).restmalen:FOR iFROM start2 +UPTO schluss-1REP zeilerausPER ;cursor(1,schluss);out(te).zeileraus:cursor( +anfang,i);out(stern);cursor(ende,i);out(stern).END PROC zeige;PROC +getposition(INT VAR x,y,INT CONST feldnr):POINTER CONST p:=pointer(feldnr);x +:=p.xpointer;y:=p.ypointer;END PROC getposition;PROC putposition(TAG VAR t, +INT CONST feldnr):POINTER VAR p;INT VAR x,y;getcursor(x,y);p.xpointer:=x- +length(t,feldnr)-laengedescursors;p.ypointer:=y;pointer(feldnr):=pEND PROC +putposition;PROC ermittlegrenzwertedesmenuerahmens(INT CONST sohnanz,BOOL +CONST nichtvorhandenetaste):INT CONST mindestlaengewegenfehlermeldung:=31; +ueberschrift:=text(k);spaltendesmenuerahmens:=maxtextlaenge+ +spaltendesmenuerands;IF geradespaltenanzahlTHEN spaltendesmenuerahmensINCR 1; +textlaengeINCR 1FI ;bestimmezeilenzahldesfktmenues;legeeckpunktefest. +geradespaltenanzahl:(spaltendesmenuerahmensMOD 2)=0.maxtextlaenge:INT VAR +menuepkt;IF nichtvorhandenetasteTHEN textlaenge:= +mindestlaengewegenfehlermeldungELSE textlaenge:=0FI ;textlaenge:=max( +textlaenge,length(ueberschrift));FOR menuepktFROM 1UPTO sohnanzREP textlaenge +:=max(textlaenge,length(text(ktab(menuepkt))))PER ;textlaenge:=min(textlaenge +,maxmenuetextlaenge);textlaenge.bestimmezeilenzahldesfktmenues:IF +nichtvorhandenetasteTHEN zeilenzahldesfktmenues:=sohnanz+rahmenzusatzzeilen+1 +ELSE zeilenzahldesfktmenues:=sohnanz+rahmenzusatzzeilenFI .legeeckpunktefest: +bestimmepositionfuerfktmenueauscursorpos(x1,y1); +veraenderex1fallshaelftedesbsnichtausreicht; +veraenderey1fallshaelftedesbsnichtausreicht;aktuellezeile:=y1;anzblankstern:= +spaltendesmenuerahmensDIV 2.veraenderex1fallshaelftedesbsnichtausreicht:IF ( +x1+spaltendesmenuerahmens)>spaltenzahlbildschirmTHEN x1:= +spaltenzahlbildschirm-spaltendesmenuerahmensFI . +veraenderey1fallshaelftedesbsnichtausreicht:IF (y1+zeilenzahldesfktmenues)> +zeilenzahlbildschirmTHEN y1:=zeilenzahlbildschirm-zeilenzahldesfktmenuesFI . +END PROC ermittlegrenzwertedesmenuerahmens;PROC +bestimmepositionfuerfktmenueauscursorpos(INT VAR xwert,ywert): +bestimmecursorposition;bestimmeeckpunktlinksoben.bestimmecursorposition: +getcursor(cursorx,cursory).bestimmeeckpunktlinksoben:IF vierterquadrantTHEN +xwert:=1;ywert:=1;ELIF dritterquadrantTHEN xwert:=40;ywert:=1;ELIF +zweiterquadrantTHEN xwert:=1;ywert:=13;ELIF ersterquadrantTHEN xwert:=40; +ywert:=13;FI .ersterquadrant:(cursorx<40)CAND (cursory<13).zweiterquadrant:( +cursorx>39)CAND (cursory<13).dritterquadrant:(cursorx<40)CAND (cursory>12). +vierterquadrant:(cursorx>39)CAND (cursory>12).END PROC +bestimmepositionfuerfktmenueauscursorpos;PROC +zeigefunktionenmenueaufdembildschirm(INT CONST sohnanz,BOOL VAR +nichtvorhandenetaste):TEXT CONST meldungungueltigefkttaste:= +"Diese Funktion gibt es nicht. ";zeigemenuekopfzeile;zeigeueberschriftzeile +;zeigemenueteil;zeigemenueabschlusszeile.zeigemenuekopfzeile: +setzecursoraufausgabeanfangsposition;zeichnesternzeile. +setzecursoraufausgabeanfangsposition:cursor(x1,aktuellezeile). +zeichnesternzeile:put("*"+(anzblankstern*zeichenblankstern)). +zeigeueberschriftzeile:setzecursoraufnaechstenzeilenanfang;put("* "+ +zentrierteueberschrift+" *").zentrierteueberschrift:TEXT VAR zwtext:= +zentriert(ueberschrift,textlaenge+tastenlaenge);IF length(zwtext)<(textlaenge ++tastenlaenge)THEN zwtextCAT " "FI ;zwtext.zeigemenueabschlusszeile: +setzecursoraufnaechstenzeilenanfang;IF nichtvorhandenetasteTHEN +gebehinweisaufungueltigefkttaste;setzeschalterzurueck; +setzecursoraufnaechstenzeilenanfangFI ;zeichnesternzeile. +gebehinweisaufungueltigefkttaste:put("* "+eingepasstemeldung+" *"). +eingepasstemeldung:zwtext:=zentriert(meldungungueltigefkttaste,textlaenge+ +tastenlaenge);IF length(zwtext)<(textlaenge+tastenlaenge)THEN zwtextCAT " " +FI ;zwtext.setzeschalterzurueck:nichtvorhandenetaste:=FALSE . +setzecursoraufnaechstenzeilenanfang:aktuellezeileINCR 1;cursor(x1, +aktuellezeile).zeigemenueteil:zeigeleerzeile;zeigemenuezeilen;zeigeleerzeile. +zeigeleerzeile:setzecursoraufnaechstenzeilenanfang;leerzeile.leerzeile:put( +"*"+((spaltendesmenuerahmens-2)*" ")+"*").zeigemenuezeilen:INT VAR menuepkt:= +0;FOR menuepktFROM 1UPTO sohnanzREP zeigemenuezeilePER .zeigemenuezeile: +setzecursoraufnaechstenzeilenanfang;put(anfangundfkttaste+aufbereitetertext+ +zeichenblankstern).anfangundfkttaste:"* "+fkttaste+" ".fkttaste:TEXT VAR +aufbertaste:=taste(ktab(menuepkt));IF aufbertaste<>""THEN aufbertasteELSE " " +FI .aufbereitetertext:IF menuetextzulangTHEN subtext(text(ktab(menuepkt)),1, +textlaenge)ELSE text(ktab(menuepkt))+restblanksFI .menuetextzulang:length( +text(ktab(menuepkt)))>textlaenge.restblanks:(textlaenge-length(text(ktab( +menuepkt))))*" ".END PROC zeigefunktionenmenueaufdembildschirm;TEXT PROC +zentriert(TEXT CONST text,INT CONST breite):TEXT CONST blank:=" ";TEXT CONST +blanks:=blankausgleich;blanks+text+blanks.blankausgleich:((breite-length(text +))DIV 2)*blank.END PROC zentriert;PROC einzelknotenfuerfunktionenmenueholen( +BOOL CONST verteilteanwendung):BOOL VAR ok;IF verteilteanwendungTHEN +einzelknotenholen(tastefuerbildschirmausdruck,knotenfuerbildschirmausdruck,ok +);einzelknotenholen(tastefuerauskunftserteilung,knotenfuerauskunftserteilung, +ok)ELSE einzelknotenholen(knotennamefuerbildschirmausdruck, +knotenfuerbildschirmausdruck,ok);einzelknotenholen( +knotennamefuerauskunftserteilung,knotenfuerauskunftserteilung,ok)FI .END +PROC einzelknotenfuerfunktionenmenueholen;PROC startbaisy(TEXT CONST kn,PROC +(INT CONST ,BOOL CONST ,TEXT CONST )call):BOOL VAR menuepunktgefunden, +anwahleineshistoriepunktes:=FALSE ,gueltigetasteimmenue:=FALSE , +anderemenueebene:=FALSE ,zurueckuebercursortaste:=FALSE ,nichtvorhandenetaste +:=FALSE ,ebenenwechsel:=FALSE ,programmeinstiegnachmenueanwahl,# +benutzerberechtigt:=FALSE ,#druckenkommtimfktmenuevor:=FALSE , +auskunftkommtimfktmenuevor:=FALSE ;TAG VAR t,men;TEXT VAR te,stufennummer:="" +;INT VAR start1,start2,schluss,koordx;TEXT VAR anfangsknotenname;ROW +maxhknotenTEXT VAR histtexttab;ROW maxhknotenINT VAR histanwahlpos;INT VAR +sohnanzahl,mpkt,letztemenueanwahlpos:=menuebeginn,aktmaxmenuepunkte,x,y; +KNOTEN VAR sk;KNOTENMENGE VAR ksoehne;initialisierenzumanfang; +holenamedesanfangsknotens;fortlaufendeknotenbehandlung. +fortlaufendeknotenbehandlung:REP behandleknotenPER .initialisierenzumanfang: +IF kn<>""THEN initmaske(men,menuemaskenname);schluss:=ysize(men)FI ;ksoehne:= +leeremenge;bildschirmwiederholspeichereinschalten.holenamedesanfangsknotens: +anfangsknotenname:=text(k);.behandleknoten:setzevergleichsknoten(k); +programmeinstiegnachmenueanwahl:=menuemaske;schaueobmaskediemenuemaskeist;IF +vpgewaehltTHEN vpname:=vorprozedur(k);IF vpvorhandenTHEN clearerror; +disablestop;vpausfuehren(PROC (INT CONST ,BOOL CONST ,TEXT CONST )call);IF +programmendeTHEN LEAVE fortlaufendeknotenbehandlungFI ;IF iserrorTHEN +fehlerbehandeln;clearerrorFI ;enablestop;IF +knotenwechselbeiprozedurausfuehrungTHEN vaterknotenalsneuenknotennehmen; +ebenenwechsel:=TRUE ;LEAVE behandleknotenFI ;holefunktionstaste;ELSE +bereitemenuemaskenausgabevorFI ;ELSE IF npgewaehltTHEN npname:=nachprozedur(k +);IF npvorhandenTHEN clearerror;disablestop;npausfuehren(PROC (INT CONST , +BOOL CONST ,TEXT CONST )call);IF programmendeTHEN LEAVE +fortlaufendeknotenbehandlungFI ;IF iserrorTHEN fehlerbehandeln;clearerrorFI ; +enablestop;IF knotenwechselbeiprozedurausfuehrungTHEN +vaterknotenalsneuenknotennehmen;ebenenwechsel:=TRUE ;LEAVE behandleknotenFI ; +holefunktionstaste;ELSE bereitemenuemaskenausgabevorFI ;ELSE +bereitemenuemaskenausgabevorFI FI ;holeberechtigungswert(benutzerberechtigung +);holeallesohnknoten;setzeschalterfuermenueausgabenachfunktionstaste;IF +bittedasmenuezeigenTHEN anwahluebermenueELSE direktefunktionstaste;IF +nichtvorhandenetasteTHEN setzeschalterfuermenueausgabe(TRUE ); +anwahluebermenueFI ;FI ;holenaechstenknoten.schaueobmaskediemenuemaskeist: +menuemaske:=nachprozedur(k)="".direktefunktionstaste:menuepunktgefunden:= +FALSE ;IF sohnanzahl>0THEN +pruefetasteundliefereknotenodermenuepunktnichtgefundenFI ;IF NOT +menuepunktgefundenTHEN IF tastendruck=tastefuerbildschirmausdruckTHEN sk:= +knotenfuerbildschirmausdruck;merkeknotenalsgefundenenmenuepunktELIF +tastendruck=tastefuerauskunftserteilungTHEN sk:=knotenfuerauskunftserteilung; +merkeknotenalsgefundenenmenuepunktELSE nichtvorhandenetaste:=TRUE FI FI . +pruefetasteundliefereknotenodermenuepunktnichtgefunden:menuepunkt:=0;sk:= +erster(ksoehne);WHILE weitere(sk,ksoehne)AND NOT menuepunktgefundenREP IF ( +NOT isopen(sk))CAND gesuchtetastegefundenTHEN +merkeknotenalsgefundenenmenuepunktFI ;naechster(sk)PER . +merkeknotenalsgefundenenmenuepunkt:menuepunktgefunden:=TRUE ;menuepunktINCR 1 +;ktab(menuepunkt):=sk.gesuchtetastegefunden:taste(sk)=tastendruck. +holeallesohnknoten:mengedernachfolger(k,ksoehne);sohnanzahl:=zahlderelemente( +ksoehne).holefunktionstaste:IF NOT gesetztdurcheditorTHEN IF menuemaskeTHEN +loeschetastendruckELSE setzetastendruck(incharety(wartezeit))FI FI . +anwahluebermenue:bildschirmwiederholspeicherausschalten;IF menuemaskeTHEN +maskeaufbauen;maskekomplettausgeben;menueanwahlbestimmen; +setzeschalterfuermenueausgabe(FALSE )ELSE fktmenueaufbauenundausgeben; +fktmenueanwahlbestimmenFI .fktmenueaufbauenundausgeben: +holeallesohnknotenfuerfktmenue;ermittlegrenzwertedesmenuerahmens(sohnanzahl, +nichtvorhandenetaste);zeigefunktionenmenueaufdembildschirm(sohnanzahl, +nichtvorhandenetaste).holeallesohnknotenfuerfktmenue:menuepunkt:=0; +druckenkommtimfktmenuevor:=FALSE ;auskunftkommtimfktmenuevor:=FALSE ;sk:= +erster(ksoehne);REP knotentabfuellenUNTIL (menuepunkt>=sohnanzahl)OR ( +menuepunkt>=maxmenuepunkte)PER ;IF (NOT druckenkommtimfktmenuevor)CAND +sohnanzahl");cursor(x,y).pruefefkttastezudiesemmenue: +IF tastendruck=rechtstasteTHEN anderemenueebene:=TRUE ; +wandleypositioninmenuepunktnummerum;fktcursorloeschenELIF tastendruck= +esctasteTHEN anderemenueebene:=TRUE ;funktionenmenueloeschenELSE +vergleichetastemitgueltigenfkttasten;IF gueltigetasteimmenueTHEN +anderemenueebene:=TRUE ;fktcursorloeschen;wandlemenuepunktnummerinypositionum +;fktcursorzeigen;fktcursorloeschenFI FI .wandleypositioninmenuepunktnummerum: +getcursor(x,y);menuepunkt:=y-yanfang+1.wandlemenuepunktnummerinypositionum:y +:=yanfang+menuepunkt-1.funktionenmenueloeschen: +schalterzurueckuebercursortasteein;IF vpvorhandenTHEN IF NOT +gesetztdurcheditorTHEN reorganizescreen;cursor(cursorx,cursory); +setlasteditvalues;setzeschalterfuermenueausgabe(FALSE )FI ;return(0)ELSE +enter(1)FI .vergleichetastemitgueltigenfkttasten:gueltigetasteimmenue:=FALSE +;menuepunkt:=0;WHILE (NOT gueltigetasteimmenue)AND menuepunkt< +aktmaxmenuepunkteREP menuepunktINCR 1;IF tastendruck=taste(ktab(menuepunkt)) +THEN gueltigetasteimmenue:=TRUE FI PER .neuenfktmenuepunktbestimmen:IF +cursorbewegungmithopTHEN aktuellerstenoderletztenfktmenuepunktbestimmenELSE +naechstenfktmenuepunktbestimmenFI . +aktuellerstenoderletztenfktmenuepunktbestimmen:cursorbewegungmithop:=FALSE ; +IF tastendruck=obentasteTHEN y:=yanfangELSE y:=yendeFI . +naechstenfktmenuepunktbestimmen:IF tastendruck=obentasteTHEN IF y>yanfang +THEN yDECR 1ELIF y=yanfangTHEN y:=yendeFI ELIF tastendruck=untentasteTHEN IF +ysohnanzahlTHEN keinenmenuetext;ELSE IF isopen(sk)THEN +ktab(menuepunkt):=nilknotenELSE ktab(menuepunkt):=skFI ; +menuetextzusammensetzen(menuepunkt,stufennummer,menuetext);naechster(sk);put( +t,menuetext,menuefeldnr);putposition(t,menuefeldnr)FI ;menuefeldnrINCR 1PER ; +aktmaxmenuepunkte:=menuepunkt.keinenmenuetext:menuetext:=" ";mpkt:=menuepunkt ++maxhknoten;setzemenuepunktzugang(mpkt,FALSE ).maskekomplettausgeben: +eventuellefehlermeldungausgeben;erstenmenuepunktbestimmen; +cursorpositionerrechnen;cursorzeigen;tasteholen;anderemenueebene:=FALSE ;REP +tastendruckindiesemmenueUNTIL anderemenueebenePER ;cursorloeschen; +bildschirmwiederholspeichereinschalten.eventuellefehlermeldungausgeben:. +erstenmenuepunktbestimmen:IF ebenenwechselTHEN ebenenwechsel:=FALSE ; +aktfeldnr:=letztemenueanwahlposFI ;mpkt:=aktfeldnr- +felderanzahlbishistoriebeginn;IF NOT zugangerlaubt(mpkt)THEN setzetastendruck +(untentaste);neuenmenuepunktbestimmenFI ;mpkt:=aktfeldnr- +felderanzahlbishistoriebeginn;IF (NOT zugangerlaubt(mpkt))AND menuemaskeTHEN +aktfeldnr:=historieendeFI .cursorpositionerrechnen:getposition(x,y,aktfeldnr) +.cursorzeigen:cursor(x,y);out(fcursor);xDECR 1;cursor(x,y);out(" "). +cursorloeschen:cursorvormenuepunktloeschen.cursorvormenuepunktloeschen: +getcursor(x,y);cursor(x,y);out(fcursorweg).tastendruckindiesemmenue:IF +anderermenuepunktTHEN cursorloeschen;neuenmenuepunktbestimmen; +cursorpositionerrechnen;cursorzeigen;tasteholenELSE +pruefetastendruckzudiesemmenue;IF NOT anderemenueebeneTHEN tasteholenFI FI . +pruefetastendruckzudiesemmenue:IF tastendruck=rechtstasteTHEN +anderemenueebene:=TRUE ELIF code(tastendruck)>=codefuerziffernullAND code( +tastendruck)<=codefuerzifferneunTHEN IF code(tastendruck)=codefuerziffernull +THEN mpkt:=10ELSE mpkt:=code(tastendruck)-codefuerziffernullFI ;IF sohnanzahl + +felderimanwahlmenueTHEN aktfeldnr:=savefeldnr;neuenmenuepunktgefunden:=TRUE ; +LEAVE sucheneuenmenuepunktFI ELSE IF aktfeldnrfields(t)THEN aktfeldnr:= +historiebeginnFI FI ;IF feldvorhandenTHEN mpkt:=aktfeldnr- +felderanzahlbishistoriebeginn;IF zugangerlaubt(mpkt)THEN +neuenmenuepunktgefunden:=TRUE FI ;FI .feldvorhanden:fieldexists(t,aktfeldnr). +bildschirmwiederholspeicherausschalten:store(FALSE ). +bildschirmwiederholspeichereinschalten:store(TRUE ).menueanwahlbestimmen:IF +menuemaskeTHEN IF aktfeldnr= +menuebeginnTHEN aktfeldnrDECR felderanzahlbismenuebeginnELSE aktfeldnrDECR +felderanzahlbishistoriebeginn;anwahleineshistoriepunktes:=TRUE FI ;menuepunkt +:=aktfeldnr.holenaechstenknoten:setzeeditorschalterzurueck;IF +zurueckuebercursortasteTHEN schalterzurueckuebercursortasteaus; +vaterknotenalsneuenknotennehmenELIF historiepunktangewaehltTHEN +anwahleineshistoriepunktes:=FALSE ;textdeshistoriepunktesbestimmen; +historieknotenalsneuenknotennehmenELSE knotenaufstackablegen(k);IF +aktuellerhistorieknotenTHEN legehistorieknotenab(text(k),menuepunkt)FI ; +sohnknotenalsneuenknotennehmenFI .historiepunktangewaehlt: +anwahleineshistoriepunktes.textdeshistoriepunktesbestimmen:TEXT VAR histtext; +hknr:=maxhknoten+1-menuepunkt;histtext:=histtexttab(hknr);aktfeldnr:= +historieende+histanwahlpos(hknr).historieknotenalsneuenknotennehmen:REP enter +(1);vaterknotenalsneuenknotennehmenUNTIL text(k)=histtextPER . +reduzierestufennummer:INT VAR lstufnr:=length(stufennummer);IF lstufnr<=3 +THEN stufennummer:=""ELSE IF subtext(stufennummer,lstufnr-1,lstufnr-1)= +stufentrennerTHEN stufennummer:=subtext(stufennummer,1,lstufnr-2)ELSE +stufennummer:=subtext(stufennummer,1,lstufnr-3)FI ;FI . +aktuellerhistorieknoten:menuemaskeOR (text(k)=anfangsknotenname). +vaterknotenalsneuenknotennehmen:k:=vergleichsknoten;IF nachprozedur(k)="" +THEN reduzierestufennummerFI .sohnknotenalsneuenknotennehmen:KNOTEN VAR +tabknoten:=ktab(menuepunkt);IF reinlokaleoperationTHEN k:=tabknoten;IF +menuemaskeTHEN erweiterestufennummerFI ;aktfeldnr:=menuebeginnELSE +fuehreknotenwechselmittaskwechseldurch;ebenenwechsel:=TRUE FI ;vpwunsch. +reinlokaleoperation:TEXT CONST knotentask:=task(tabknoten);knotentask="". +fuehreknotenwechselmittaskwechseldurch:INT VAR statustaskwechsel:=0; +umgebungswechsel(tabknoten,knotentask,statustaskwechsel);k:= +altermenueknotenaufstack;IF statustaskwechsel=1THEN cursor(1,23);put( +"Verzweigung ist nicht möglich");pauseELIF statustaskwechsel=2THEN cursor(1, +23);put("es wird bereits innerhalb dieser Anwendungen gearbeitet");pauseFI . +altermenueknotenaufstack:enter(1);vergleichsknoten.erweiterestufennummer:IF +stufennummer=""THEN stufennummer:=berechttrenner+text(menuepunkt)ELSE +stufennummer:=stufennummer+stufentrenner+text(menuepunkt)FI . +schalterzurueckuebercursortasteein:zurueckuebercursortaste:=TRUE . +schalterzurueckuebercursortasteaus:zurueckuebercursortaste:=FALSE .END PROC +startbaisy;PROC berechtigungspruefung(TEXT CONST altnr,INT CONST neunr,BOOL +VAR berechtigt):IF NOT menuemaskeTHEN berechtigt:=TRUE ;LEAVE +berechtigungspruefungFI ;TEXT VAR berechtstring:=benutzerberechtigung;IF +keineberechtigungzugeteiltTHEN berechtigt:=FALSE ;LEAVE berechtigungspruefung +FI ;berechtigt:=FALSE ;zupruefendestufennummeraufbauen;berechtigungholen; +WHILE NOT berechtigtAND nocheineberechtigungdaREP IF +berechtistpraefixvonpruefnrOR pruefnristpraefixvonberechtTHEN berechtigt:= +TRUE FI ;berechtigungholenPER .keineberechtigungzugeteilt:berechtstring="". +nocheineberechtigungda:berecht<>"".zupruefendestufennummeraufbauen:TEXT VAR +pruefnr;IF altnr=""THEN pruefnr:=berechttrenner+text(neunr)ELSE pruefnr:= +altnr+stufentrenner+text(neunr)FI ;pruefnrCAT stufentrenner.berechtigungholen +:TEXT VAR berecht;IF berechtstringabgearbeitetTHEN berecht:=""ELSE +imberechtstringweitereberechtsuchen;IF nurnocheineberechtigungTHEN berecht:= +berechtstring;berechtstring:=""ELSE berecht:=subtext(berechtstring,1, +postrennz-1);berechtstring:=subtext(berechtstring,postrennz)FI ;berechtCAT +stufentrenner;FI .imberechtstringweitereberechtsuchen:INT VAR postrennz:=pos( +berechtstring,berechttrenner,2).nurnocheineberechtigung:postrennz=0. +berechtstringabgearbeitet:berechtstring="".berechtistpraefixvonpruefnr:pos( +pruefnr,berecht)<>0.pruefnristpraefixvonberecht:pos(berecht,pruefnr)<>0.END +PROC berechtigungspruefung;PROC dummycall(INT CONST i,BOOL CONST b,TEXT +CONST knotenproc):do(knotenproc)END PROC dummycall;PROC startebaisy(TEXT +CONST kn):initsybifunktionen;BOOL VAR knotenda;anfangsknotenholen(kn,k, +knotenda);holenamedesanfangsknotens;vpwunsch;IF NOT knotendaTHEN put( +"kein knoten da");pause(50);setzeprogrammende(TRUE )ELIF isopen(k)THEN put( +"knoten da, aber offen");pause(50);setzeprogrammende(TRUE )FI ; +setzeanfangsknotennamefuerbenutzerbestand(kn); +einzelknotenfuerfunktionenmenueholen(verteilt);monitorbehandlungundstart. +holenamedesanfangsknotens:TEXT VAR anfangsknotenname;anfangsknotenname:=text( +k);page.verteilt:anfangsknotenname="".monitorbehandlungundstart:putline( +"Das System "+kn+" wird gestartet.");initmeldungsfunktionen;startbaisy(kn, +PROC dummycall)END PROC startebaisy;PROC starteanwendung:BOOL VAR knotenda; +anfangsknotenholen("",k,knotenda);vpwunsch; +einzelknotenfuerfunktionenmenueholen(TRUE );setzeverteilteanwendung; +startbaisy("",PROC dummycall)END PROC starteanwendung;PROC startebaisy: +startebaisy("baisy")END PROC startebaisy;PROC starteschulis:startebaisy( +"schulis")END PROC starteschulis;END PACKET systembauminterpreter; + diff --git a/app/baisy/2.2.1-schulis/src/thesaurusfunktionen b/app/baisy/2.2.1-schulis/src/thesaurusfunktionen new file mode 100644 index 0000000..d003dc9 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/thesaurusfunktionen @@ -0,0 +1,16 @@ +PACKET thesaurusfunktionenDEFINES leererthesaurus,trageinthesaurusein, +loescheausthesaurus,inthesaurus,zeigethesaurus,uebertragethesaurusindatei: +THESAURUS VAR saurus;PROC leererthesaurus:saurus:=emptythesaurus;END PROC +leererthesaurus;PROC trageinthesaurusein(TEXT CONST objekt):INT VAR index;IF +NOT inthesaurus(objekt)THEN insert(saurus,objekt,index)FI ;END PROC +trageinthesaurusein;PROC loescheausthesaurus(TEXT CONST loeschtext):INT VAR +index;delete(saurus,loeschtext,index);END PROC loescheausthesaurus;BOOL PROC +inthesaurus(TEXT CONST objekt):saurusCONTAINS objektEND PROC inthesaurus; +PROC uebertragethesaurusindatei(TEXT CONST dateiname):IF exists(dateiname) +THEN forget(dateiname,quiet)FI ;FILE VAR f:=sequentialfile(output,dateiname); +TEXT VAR zeile;INT VAR index:=0;get(saurus,zeile,index);WHILE index>0REP +putline(f,zeile);get(saurus,zeile,index)PER ;END PROC +uebertragethesaurusindatei;PROC zeigethesaurus:TEXT VAR zeile;INT VAR index:= +0;get(saurus,zeile,index);WHILE index>0REP putline(zeile);get(saurus,zeile, +index)PER ;END PROC zeigethesaurus;END PACKET thesaurusfunktionen; + diff --git a/app/baisy/2.2.1-schulis/src/umgebungswechsel manager b/app/baisy/2.2.1-schulis/src/umgebungswechsel manager new file mode 100644 index 0000000..3b4debb --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/umgebungswechsel manager @@ -0,0 +1,19 @@ +PACKET umgebungswechselmanagerDEFINES umgebungswechsel:LET ack=0,nak=1, +manager=" manager";PROC umgebungswechsel(KNOTEN CONST k,TEXT CONST zieltask, +INT VAR fstatus):INT VAR kanal;pruefezieltask;IF fstatus=ackTHEN gibkanalfrei +;sendedatenbankkennungundkanalanmanager;IF fstatus=ackTHEN +sendesystembaumundaktuellenknotenansohntaskFI ;belegekanalwiederFI . +pruefezieltask:disablestop;TASK VAR zielmanager:=/(zieltask+manager), +stellvertreter;IF iserrorTHEN fstatus:=nakELSE fstatus:=ackFI ;clearerror. +sendedatenbankkennungundkanalanmanager:DATASPACE VAR dsvar:=nilspace;call( +zielmanager,kanal,dsvar,stellvertreter,fstatus);forget(dsvar). +sendesystembaumundaktuellenknotenansohntask:holesystembaumundanfangsknoten; +call(stellvertreter,anfangsknoten,systembaumds,fstatus);forget(systembaumds). +gibkanalfrei:kanal:=channel(myself);break(quiet).belegekanalwieder:continue( +kanal).holesystembaumundanfangsknoten:DATASPACE VAR systembaumds:=systembaum; +INT CONST anfangsknoten:=nummer(k).END PROC umgebungswechsel;PROC call(TASK +CONST zielmanager,INT CONST kanal,DATASPACE VAR ds,TASK VAR stellvertreter, +INT VAR fstatus):call(zielmanager,kanal,ds,fstatus);IF fstatus=ackTHEN BOUND +TASK VAR t:=ds;stellvertreter:=tFI ;forget(ds);break(quiet);END PROC call; +END PACKET umgebungswechselmanager + diff --git a/app/conversion/1.0/source-disk b/app/conversion/1.0/source-disk new file mode 100644 index 0000000..a14606d --- /dev/null +++ b/app/conversion/1.0/source-disk @@ -0,0 +1 @@ +conversion/eumel-dos-konversion-1.0_1993-02-04.img diff --git a/app/conversion/1.0/src/AGFA2ASC.TBL b/app/conversion/1.0/src/AGFA2ASC.TBL new file mode 100644 index 0000000..4e171a5 --- /dev/null +++ b/app/conversion/1.0/src/AGFA2ASC.TBL @@ -0,0 +1,19 @@ +"" = "`" { linker Apostroph } +"" = """" { linke Anfhrungszeichen } + +"" = "" +"" = "" +"" = "~a" +"" = "" +"" = "" +"" = "" +"" = "" +"" = "" +"" = "" +"" = "" +"" = "" +"" = "" +"" = "" +"" = "" +"" = "" + diff --git a/app/conversion/1.0/src/ASKCNVRS.PAC b/app/conversion/1.0/src/ASKCNVRS.PAC new file mode 100644 index 0000000..7d9dddd --- /dev/null +++ b/app/conversion/1.0/src/ASKCNVRS.PAC @@ -0,0 +1,349 @@ +PACKET asksam conversion DEFINES append asksam field, + append asksam record, + convert to asksam : +LET card prefix = " +--", + bo field = "[ ", + eo field = " ]", + eo line = ""13""10"", + eo record = ""0"", + eo doc = ""0""0"", + dummy fn = "@"; +LET max fields = 50; +TEXT VAR in l, out l, appended l, asksam record, buffer; +INT VAR card no, in line no, out line no, last named field, + start pos, end pos, card lines, first line; +FILE VAR f in, f out; +THESAURUS VAR field names; +ROW max fields BOOL VAR complex fields, + to be copied; +PROC convert to asksam (TEXT CONST input file) : + IF NOT exists (input file) THEN errorstop ("") FI; + TEXT CONST output file := dos file name (input file, "sam"); + forget (output file); + f out := sequential file (output, output file); + field names := empty thesaurus; + IF input is eudas + THEN convert eudas to asksam (input file) + ELIF input is cardbox + THEN convert cardbox to asksam + ELSE stop process + FI +. +input is eudas : + type (old (input file)) = 3243 +. +input is cardbox : + IF type (old (input file)) = 1003 + THEN f in := sequential file (modify, input file); + toline (f in, 1); + down (f in, ""26""26""); + pattern found + ELSE FALSE + FI +. +stop process : + forget (output file, quiet); + errorstop ("Konversion nur f"219"r EUDAS- und Cardbox-Dateien m"218"glich.") +END PROC convert to asksam; +PROC convert eudas to asksam (TEXT CONST file name) : + oeffne (file name, FALSE); + get field names; + WHILE NOT dateiende REP + transfer one record; + weiter (1) + PER; + dateien loeschen (FALSE) +. +get field names : + asksam record := ""; + last named field := anzahl felder; + auf satz (1); + FOR in line no FROM 1 UPTO last named field REP + feld lesen (in line no, in l); + IF in l <> "" + THEN to be copied [in line no] := TRUE; + complex fields [in line no] := is complex field; + append field name (in l); + feldnamen lesen (in line no, in l); + append asksam field (in l) + ELSE to be copied [in line no] := FALSE; + append field name (dummy fn) + FI + PER; + append asksam record; + weiter (1) +. +is complex field : + end pos := pos (in l, "{"); + IF end pos <> 0 + THEN end pos DECR 1; + WHILE (in l SUB end pos) = " " REP + end pos DECR 1 + PER; + in l := subtext (in l, 1, end pos); + TRUE + ELSE FALSE + FI +. +transfer one record : + cout (satznummer); + asksam record := ""; + out line no := 0; + transfer fields; + append asksam record +. +transfer fields : + FOR in line no FROM 1 UPTO last named field REP + IF to be copied [in line no] + THEN feld lesen (in line no, in l); + IF in l <> "" + THEN IF complex fields [in line no] + THEN transfer complex field (in l) + ELSE append asksam field (in l) + FI + FI + FI + PER +END PROC convert eudas to asksam; +PROC transfer complex field (TEXT CONST l) : + TEXT VAR transfer buffer; + start pos := 1; + REP + start pos INCR 1; + end pos := pos (l, "{", start pos + 1); + IF end pos = 0 + THEN end pos := LENGTH l + ELSE end pos DECR 1 + FI; + WHILE (l SUB end pos) = " " REP + end pos DECR 1 + PER; + transfer buffer := subtext (l, start pos, end pos); + change (transfer buffer, "}", ""); + append asksam field (transfer buffer); + start pos := pos (l, "{", end pos) + UNTIL start pos = 0 PER +END PROC transfer complex field; +PROC convert cardbox to asksam : + BOOL VAR line end; + ascertain number lines per card; + convert file; +. +ascertain number lines per card : + toline (f in, 1); + col (f in, 1); + downety (f in, card prefix); + first line := line no (f in); + down (f in, card prefix); + card lines := line no (f in) - first line +. +convert file : + line; + input (f in); + get field names; + card no := 0; + WHILE NOT eof (f in) REP + transfer one card + UNTIL asksam record = "" PER +. +get field names : + last named field := 0; + getline (f in, in l); + get names from first lines; + get names from bulk; +. +get names from first lines : + FOR in line no FROM 1 UPTO card lines - 2 REP + get cardbox line (in l); + in l := compress (in l); + IF in l > "" + THEN append field name (in l); + last named field := in line no + ELSE append field name (dummy fn) + FI + PER; +. +get names from bulk : + in line no := card lines - 2; + get cardbox line (in l); + end pos := 0; + REP + get card line (appended l, line end); + IF line end + THEN LEAVE get names from bulk + ELIF appended l <> "" + THEN in line no INCR 1; + append field name (compress (appended l)); + last named field INCR 1 + FI; + PER +END PROC convert cardbox to asksam; +PROC transfer one card : + BOOL VAR line end; + card no INCR 1; + cout (card no); + asksam record := ""; + transfer first lines; + transfer bulk line; + append asksam record +. +transfer first lines : + getline (f in, in l); + IF pos (in l, card prefix) <> 2 + THEN errorstop ("Programmfehler 1") + ELIF pos (in l, "LAST CARD") <> 0 + THEN LEAVE transfer one card + FI; + out line no := 0; + FOR in line no FROM 1 UPTO card lines - 2 REP + get cardbox line (in l); + IF pos (in l, ""25""25"") = 1 + THEN process hypertext + ELSE append asksam field (in l) + FI; + PER +. +process hypertext : + asksam record CAT ":"13""10""9""; + end pos := pos (in l, ".card") - 1; + appended l := subtext (in l, 55, end pos); + asksam record CAT appended l; + asksam record CAT ""255""13""10""13""10""; + asksam record CAT "(Datei zum Thema `"; + asksam record CAT appended l; + asksam record CAT "')"13""10""; + out line no := 4 +. +transfer bulk line : + get cardbox line (in l); + end pos := 0; + first line := 0; + in line no DECR 1; + REP + get card line (appended l, line end); + IF line end + THEN LEAVE transfer bulk line + FI; + in line no INCR 1; + cout (in line no); + append asksam field (appended l) + PER +END PROC transfer one card; +PROC get cardbox line (TEXT VAR t) : + getline (f in, t); + start pos := pos (t, "|"); + IF start pos = 0 + THEN errorstop ("Programmfehler 2") + FI; + t := subtext (t, start pos + 1) +END PROC get cardbox line; +PROC get card line (TEXT VAR t, BOOL VAR end) : + start pos := pos (in l, ""32"", ""255"", endpos + 1); + IF start pos = 0 + THEN end := TRUE; + LEAVE get card line + FI; + end pos := pos (in l, ""26"", start pos); + IF end pos = 0 + THEN end := TRUE; + LEAVE get card line + FI; + end pos DECR 1; + t := subtext (in l, start pos, end pos); + end := FALSE +END PROC get card line; +PROC append asksam line (TEXT CONST t) : + asksam record CAT t; + out line no INCR 1; + IF out line no MOD 20 = 0 + THEN asksam record CAT eo record + ELSE asksam record CAT eo line + FI +END PROC append asksam line; +PROC append asksam field (TEXT CONST t) : + BOOL VAR named field; + INT VAR s pos, e pos, length l; + IF t > " " CAND in line no <= last named field + THEN get field name (in line no, out l); + IF out l <> dummy fn + THEN out l CAT bo field; + named field := TRUE + ELSE out l := ""; + named field := FALSE + FI + ELSE out l := ""; + named field := FALSE + FI; + buffer := t; + prepare line for asksam (buffer); + out l CAT buffer; + transfer line +. +transfer line : + length l := LENGTH out l; + e pos := -1; + REP + s pos := e pos + 2; + IF (length l - s pos) > 79 + THEN determine e pos; + transfer chunk + ELSE transfer rest + FI + PER +. +determine e pos : + e pos := s pos + 79; + move before last blank +. +move before last blank : + WHILE (out l SUB e pos) <> " " REP + e pos DECR 1 + UNTIL e pos = s pos PER; + IF e pos = s pos + THEN e pos := s pos + 79 + ELSE e pos DECR 1 + FI +. +transfer chunk : + append asksam line (subtext (out l, s pos, e pos)); +. +transfer rest : + buffer := subtext (out l, s pos); + IF named field + THEN buffer CAT eo field + FI; + append asksam line (buffer); + LEAVE transfer line +END PROC append asksam field; +PROC append asksam record : + IF was eo record + THEN asksam record CAT eo record + ELSE buffer := subtext (asksam record, 1, LENGTH asksam record - 2); + buffer CAT eo doc; + asksam record := buffer + FI; + putline (f out, asksam record) +. +was eo record : + out line no MOD 20 = 0 +END PROC append asksam record; +PROC prepare line for asksam (TEXT VAR t) : + IF (t SUB LENGTH t) = " " + THEN t := subtext (t, 1, LENGTH t - 1) + FI; + replace eumel special characters (t); + change all (t, "[", ""174""); + change all (t, "]", ""175""); + change all (t, "#on(""i"")#", ""); + change all (t, "#off(""i"")#", "") +END PROC prepare line for asksam; +PROC append field name (TEXT CONST fn) : + INT VAR index; + buffer := fn; + prepare line for asksam (buffer); + insert (field names, buffer, index) +END PROC append field name; +PROC get field name (INT CONST index, TEXT VAR fn) : + fn := name (field names, index) +END PROC get field name; +END PACKET asksam conversion; diff --git a/app/conversion/1.0/src/DOSCNVRS.PAC b/app/conversion/1.0/src/DOSCNVRS.PAC new file mode 100644 index 0000000..e9ac2d4 --- /dev/null +++ b/app/conversion/1.0/src/DOSCNVRS.PAC @@ -0,0 +1,203 @@ +PACKET dos conversion DEFINES + convert to dos file, + dos file name, + replace eumel special characters, + replace multiple blanks by tab stops, + trim end of line, + refuse nonwrapped file + : +LET eumel line display pos = 1, + dos line display pos = 10; +TEXT VAR in l, out l, next l, last char, buffer; +INT VAR act l no, cursor x, cursor y, + this line indentation, next line indentation; +PROC replace inadmissible characters (TEXT VAR t) : + LET inadmissible chars = """*+,./:;<=>?| "; + INT VAR i; + FOR i FROM 1 UPTO LENGTH inadmissible chars REP + last char := inadmissible chars SUB i; + change all (t, last char, "_") + PER +END PROC replace inadmissible characters; +TEXT PROC dos file name (TEXT CONST eumel file name) : + INT VAR p := rpos (eumel file name, "."); + IF p <> 0 + THEN in l := subtext (eumel file name, p+1, p+3); + p := min (p, 9); + out l := subtext (eumel file name, 1, p-1); + ELSE in l := "dos"; + out l := subtext (eumel file name, 1, 8) + FI; + dos fn (out l, in l) +END PROC dos file name; +TEXT PROC dos file name (TEXT CONST eumel name, extension) : + INT VAR p := rpos (eumel name, "."); + IF p <> 0 + THEN p := min (p, 9); + out l := subtext (eumel name, 1, p-1); + ELSE out l := subtext (eumel name, 1, 8) + FI; + dos fn (out l, extension) +END PROC dos file name; +TEXT PROC dos fn (TEXT CONST name, extension) : + buffer := name; + replace inadmissible characters (buffer); + buffer CAT "."; + buffer CAT extension; + buffer +END PROC dos fn; +PROC convert to dos file (TEXT CONST eumel file name) : + LET tab char = ""9""; + TEXT CONST dfn := dos file name (eumel file name); + BOOL VAR is last line of paragraph, + in table := FALSE; + get cursor (cursor x, cursor y); + FILE VAR f := sequential file (input, eumel file name); + IF word wrap (f) + THEN input (f) + ELSE refuse nonwrapped file + FI; + forget (dfn, quiet); + FILE VAR g := sequential file (output, dfn); + max line length (g, max text length); + INT CONST file lines := lines (f); + act l no := 0; + out l := ""; + getline (f, next l); + next line indentation := pos (next l, ""33"", ""255"", 1); + REP + in l := next l; + act l no INCR 1; + cursor (eumel line display pos, cursor y); + cout (act l no); + this line indentation := next line indentation; + IF act l no >= file lines + THEN next l := ""; + next line indentation := 1 + ELSE getline (f, next l); + next line indentation := pos (next l, ""33"", ""255"", 1) + FI; + trim act line; + out l CAT in l; + IF is last line of paragraph CAND + NOT only command line (in l) + THEN putline (g, out l); + out l := ""; + cursor (dos line display pos, cursor y); + cout (line no (g)) + FI + UNTIL act l no >= file lines PER +. + trim act line : + IF pos (in l, "#table#") <> 0 + THEN in table := TRUE + ELIF pos (in l, "#table end") <> 0 COR + pos (in l, "#tableend") <> 0 + THEN in table := FALSE + FI; + trim end of line (in l, is last line of paragraph, in table); + replace eumel special characters (in l); + trim start of line; + replace multiple blanks by tab stops (in l, tab char) +. + trim start of line : + IF this line indentation > 2 + THEN IF is first line of paragraph + THEN change (in l, 1, this line indentation - 1, tab char) + ELSE in l := subtext (in l, this line indentation) + FI + FI +. + is first line of paragraph : out l = "" +END PROC convert to dos file; +PROC replace eumel special characters (TEXT VAR l) : + LET eumel chars = ""217""218""219""214""215""216""251""221""220""222""223""252"", + dos chars = ""132""148""129""142""153""154""225"-k# "21""; + INT VAR p; + FOR p FROM 1 UPTO LENGTH eumel chars REP + change all (l, eumel chars SUB p, dos chars SUB p) + PER +END PROC replace eumel special characters; +PROC replace eumel special characters (TEXT VAR l, + BOOL VAR contains number sign) : + LET eumel chars = ""217""218""219""214""215""216""251""221""220""223""252"", + dos chars = ""132""148""129""142""153""154""225"-k "21""; + INT VAR p; + FOR p FROM 1 UPTO LENGTH eumel chars REP + change all (l, eumel chars SUB p, dos chars SUB p) + PER; + contains number sign := pos (l, ""222"") <> 0 +END PROC replace eumel special characters; +PROC replace multiple blanks by tab stops (TEXT VAR line, TEXT CONST tab char) : + TEXT VAR new line := ""; + INT VAR double blank pos, transfer start pos := 1, + blank length; + line loop; + line := new line +. + line loop : + WHILE transfer start pos <> 0 REP + double blank pos := pos (line, " ", transfer start pos); + IF double blank pos = 0 + THEN transfer rest of line + ELSE transfer text; + transfer tab + FI + UNTIL double blank pos = 0 PER +. + transfer rest of line : + buffer := subtext (line, transfer start pos); + new line CAT buffer +. + transfer text : + buffer := subtext (line, transfer start pos, double blank pos - 1); + new line CAT buffer +. + transfer tab : + transfer start pos := pos (line, ""33"", ""255"", double blank pos); + IF transfer start pos = 0 + THEN new line CAT ""13""10"" + ELSE blank length := transfer start pos - double blank pos; + new line CAT (blank length DIV 2) * tab char + FI +END PROC replace multiple blanks by tab stops; +PROC replace multiple blanks by tab stops (TEXT VAR l) : + replace multiple blanks by tab stops (l, ""9"") +END PROC replace multiple blanks by tab stops; +PROC trim end of line (TEXT VAR l, BOOL VAR last paragraph line, + BOOL CONST in table) : + LET syllabication hyphen = ""221"", + syllabication k = ""220"", + protected blank = ""223""; + INT CONST line end := LENGTH l; + last paragraph line := FALSE; + last char := l SUB line end; + IF last char = syllabication hyphen + THEN IF (l SUB (line end - 1)) = syllabication k + THEN l := subtext (l, 1, line end - 2); + l CAT "c" + ELSE l := subtext (l, 1, line end - 1) + FI + ELIF last char = " " COR + (in table CAND last char = protected blank) COR + line end = 0 + THEN l := subtext (l, 1, line end - 1); + IF NOT only command line (l) + THEN l CAT ""13""10""; + last paragraph line := TRUE + FI + ELIF last char <> "-" CAND + NOT only command line (l) CAND + no footnote start at end of line + THEN l CAT " " + FI +. +no footnote start at end of line : + pos (l, "#foot#", line end - 5) <> line end - 5 +END PROC trim end of line; +PROC refuse nonwrapped file : + putline (""13""10"F"219"r Dateien ohne `word wrap' (kein Leerzeichen am Absatzende)"); + putline ("ist Konversion weder m"218"glich noch n"218"tig."); + errorstop ("Datei bitte direkt nach DOS schreiben.") +END PROC refuse nonwrapped file; +END PACKET dos conversion; diff --git a/app/conversion/1.0/src/EU_CNVRS.DOC b/app/conversion/1.0/src/EU_CNVRS.DOC new file mode 100644 index 0000000..fb71f95 --- /dev/null +++ b/app/conversion/1.0/src/EU_CNVRS.DOC @@ -0,0 +1,150 @@ +#type ("prop")##limit (16.0)# +#pagelength (26.5)##pageblock##linefeed (1.15)# +#head# +#right#%#free(1.0)# +#end# +#type("10")##on("b")##center#EUMEL-DOS-Konversion +#center#Konversion von Dateien des EUMEL-Systems nach DOS +#type("prop")# + +Version 1.0, 06.02.93 + +Copyright: Miquel Aguado + Christian Lehmann + + +1. Leistungen +EUMEL-Textdateien werden samt Textkosmetik nach WordPerfect konvertiert. +EUDAS- und Cardboxdateien werden samt Feldstruktur nach AskSam konver- +tiert. + +2. Installation +2.1. EUMEL +- DOS-Task im Ibm-Modus reservieren (`reserve ("file ibm", dostask)', wo + dostask = /"DOS" oder = /"DOS HD"). +- Die Pakete (mit *.pac-Extension) von der Diskette lesen und in folgender + Reihenfolge insertieren: + fileutil.pac + doscnvrs.pac + askcnvrs.pac + fontanal.pac + wp_knvrs.pac (fr die deutsche WordPerfect-Version) bzw. + wp_cnvrs.pac (fr die englische WordPerfect-Version). +- Das Paket `askcnvrs.pac' kann nur unter EUDAS insertiert werden, wird + aber auch nur bentigt, wenn EUDAS- oder Cardbox-Dateien konvertiert + werden sollen. In dem Falle wren dann zuvor `fileutil.pac' und + `doscnvrs.pac' in derselben Task zu insertieren. +- Alle Dateien mit *.pac-Extension wieder aus dem System lschen. +- Datei `agfa2asc.tbl' von der Diskette kopieren. + +2.2. DOS +Die Datei + ps_wp_dt.wpm (fr die deutsche WordPerfect-Version) bzw. + pseudowp.wpm (fr die englische WordPerfect-Version) +von der Diskette in das WordPerfect-Unterverzeichnis kopieren, in dem die +Makros sind. + +3. Benutzung +3.1. Text-Dateien +3.1.1. EUMEL +3.1.1.1. Vorbereitung +- In der zu konvertierenden Datei enthaltene Makros und selbstdefinierte + Textkosmetikanweisungen auflsen. +- Schrifttypen verschiedener Familien (z.B. `trium' und `modern') auf eine + Familie reduzieren, also z.B. `modern10' durch `trium12' ersetzen (vgl. + 3.1.1.3). +- Sicherstellen, da die letzte Zeile der Datei ein Absatzzeichen hat. +- Datei mit `lineform' formatieren. (Die Konversion nach WordPerfect fngt + keine Textkosmetikfehler ab!) +- Solche Sonderzeichen, die nicht zum EUMEL-Standard gehren, in der zu + konvertierenden Datei an den Ascii-Code anpassen. Das geht z.B. mit + `filechange (TEXT CONST dateiname, umsetzungstabelle)'. Dazu ist die + Tabelle `agfa2asc.tbl' da. Sie mu gegebenenfalls erweitert werden. +- Sicherstellen, da die in der Datei benutzte Fonttabelle in der Task + `configurator' ist. + +3.1.1.2. Konversion +- Datei mit + konvertiere nach wp (TEXT CONST dateiname) + (fr die deutsche WordPerfect-Version) bzw. + convert to wp (TEXT CONST dateiname) + (fr die englische WordPerfect-Version) + konvertieren. +- DOS-Task im Transparent-Modus reservieren (`reserve ("file transparent", + dostask)'). +- Prkonvertierte Datei (mit *.wpf-Extension) nach DOS schreiben. + +3.1.1.3. Bei der bertragung geht Information verloren: +- Makros und selbstdefinierte Textkosmetikanweisungen werden nicht + bertragen. +- Einrckungen werden ungenau bertragen. +- Schrifttypen verschiedener Familien (z.B. Times und Modern) werden + nicht auseinandergehalten, sondern zu einer Familie zusammengefat. + Qualittsunterschiede werden dabei auf Grenunterschiede reduziert. + Dabei entstehen sehr eng besetzte Grenskalen, die spter nach den + Standards von WordPerfect wieder auseinandergezogen werden. +- Folgende Textkosmetik-Anweisungen werden in der aktuellen Version + ignoriert: + page nr + material + skip, skip end + head on + fillchar + mark cmd, mark end + pageblock + bsp + counter1/2 + setcounter + putcounter0/1 + storecounter + fb + fe + Die meisten davon haben kein Gegenstck in WordPerfect. + +3.1.2. DOS +3.1.2.1. Vorbereitung +- WordPerfect aufrufen. +- Folgende Einstellungen machen: + - Drucker (SHIFT F7, d [deutsche Version] bzw. s [englische Version]); + - gewnschte Basis-Schrifttype (CTRL F8, 4); + - Maeinheit: cm (SHIFT F1, 3, 8, 1, c); + - Standard-Tastatur (SHIFT F1, 5, 6) oder jedenfalls keine mit einer + anderen Funktionstastenbelegung. + +3.1.2.2. Konversion +- Prkonvertierte Datei laden. +- Makro aufrufen (ALT F10), und zwar + ps_wp_dt.wpm (fr die deutsche WordPerfect-Version) bzw. + pseudowp.wpm (fr die englische WordPerfect-Version). + Geduld! + +3.1.2.3. Besonderheiten +Alle in EUMEL mit `count()' und `value()' durchnumerierten Zhler sind in +der WP-Datei in solche von (leeren) `Endnotes' gewandelt. Letztere befin- +den sich am Ende der Datei und brauchen erst beim Drucken unterdrckt +zu werden. Zustzliche wirkliche Endnotes (im Gegensatz zu Funoten) sind +dann natrlich nicht mglich. + +3.2. Ascii-Dateien +EUMEL-Dateien, die in einem gewhnlichen Ascii-Editor weiterverarbeitet +werden sollen (z.B. Programmdateien), werden mit + convert to dos file (TEXT CONST dateiname) +konvertiert und im Transparent-Modus nach DOS geschrieben. + +3.3. Datenbank-Dateien +3.3.1. EUMEL +EUDAS- und Cardbox-Dateien werden nach AskSam konvertiert. +- Solche Sonderzeichen, die nicht zum EUMEL-Standard gehren, in zu + konvertierenden Dateien an den Ascii-Code anpassen. +- In den ersten Datensatz die neuen Feldnamen schreiben (in EUDAS neben + die zugehrigen alten Feldnamen, in Cardbox untereinander an den linken + Rand). +- Datei mit `convert to asksam (TEXT CONST dateiname)' konvertieren. +- DOS-Task im Transparent-Modus reservieren. +- Datei nach DOS schreiben. + +3.3.2. DOS +- AskSam aufrufen. +- Neue Datei kreieren. +- Sam-Modus, Flietext (`free mode') und `Formatiert' (`stream') einstellen. +- Konvertierte Datei importieren. diff --git a/app/conversion/1.0/src/FILEUTIL.PAC b/app/conversion/1.0/src/FILEUTIL.PAC new file mode 100644 index 0000000..f772a38 --- /dev/null +++ b/app/conversion/1.0/src/FILEUTIL.PAC @@ -0,0 +1,142 @@ +PACKET eumel file utilities + DEFINES sort, + in denoter, + even number of command delimiters, + extract command, + next text command pos, + word wrap, + enumerator, + enumeration offset : +PROC sort (THESAURUS VAR th) : + disable stop; + FILE VAR d := sequential file (output, "dummy"); + d FILLBY th; + sort ("dummy"); + th := empty thesaurus; + input (d); + th FILLBY d; + forget ("dummy", quiet); + enable stop +END PROC sort; +BOOL PROC in denoter (TEXT CONST l, INT CONST p) : + INT VAR number of quotes := 0, + last quote pos, + quote pos := 0; + quote count loop; + number of quotes MOD 2 = 1 +. +quote count loop : + REP + last quote pos := quote pos; + quote pos := pos (l, """", last quote pos + 1, p - 1); + IF quote pos <> 0 + THEN number of quotes INCR 1 + ELSE LEAVE quote count loop + FI + PER +END PROC in denoter; +BOOL PROC even number of command delimiters (TEXT CONST l, INT CONST end pos) : + INT VAR number := 0, current pos := 1, cross pos; + counting loop; + number MOD 2 = 0 +. + counting loop : + REP + cross pos := pos (l, "#", current pos, end pos); + IF cross pos <> 0 + THEN number INCR 1; + current pos := cross pos + 1 + FI + UNTIL cross pos = 0 PER +END PROC even number of command delimiters; +BOOL PROC even number of command delimiters (TEXT CONST l) : + even number of command delimiters (l, LENGTH l) +END PROC even number of command delimiters; +PROC extract command (TEXT CONST l, INT CONST start pos, INT VAR next pos, + TEXT VAR cmd) : + next pos := pos (l, "#", start pos + 1); + IF next pos = 0 + THEN errorstop ("unkorrekte Textanweisung") + FI; + cmd := subtext (l, start pos + 1, next pos - 1); + next pos INCR 1 +END PROC extract command; +PROC next text command pos (TEXT CONST t, INT CONST start pos, + INT VAR start cross pos, end cross pos) : + start cross pos := pos (t, "#", start pos); + IF start cross pos <> 0 + THEN end cross pos := pos (t, "#", start cross pos + 1) + FI +END PROC next text command pos; +BOOL PROC word wrap (TEXT CONST file name) : + FILE VAR f := sequential file (input, file name); + word wrap (f) +END PROC word wrap; +BOOL PROC word wrap (FILE VAR f) : + TEXT VAR l; + modify (f); + toline (f, lines (f)); + WHILE line no (f) > 1 REP + read record (f, l); + IF l <> "" + THEN LEAVE word wrap WITH (l SUB LENGTH l) = " " + ELSE up (f, 1) + FI + PER; + FALSE +END PROC word wrap; +INT PROC enumeration offset (TEXT CONST this line, next line, + BOOL CONST in enumeration, INT CONST start pos) : + TEXT VAR initial chunk, next line initial chunk; + INT VAR blank pos, next line blank pos, + text start pos := 0, next line text start pos; + IF NOT only command line (this line) + THEN ascertain text start pos + FI; + text start pos +. +ascertain text start pos : + blank pos := pos (this line, " ", start pos); + IF blank pos > 1 CAND blank pos < LENGTH this line + THEN text start pos := pos (this line, ""33"", ""255"", blank pos); + IF is enumeration + THEN text start pos DECR 1 + ELSE text start pos := 0 + FI + FI +. +is enumeration : + neighboring lines correspond CAND this line is enumerated +. +neighboring lines correspond : + in enumeration COR next line corresponds +. +next line corresponds : + next line blank pos := pos (next line, " ", start pos); + next line text start pos := + pos (next line, ""33"", ""255"", next line blank pos); + text start pos = next line text start pos CAND + (next line indented COR also enumerated) +. +next line indented : + pos (next line, ""33"", ""255"", 1) = next line text start pos +. +also enumerated : + next line initial chunk + := subtext (next line, start pos, next line blank pos - 1); + enumerator (next line initial chunk) +. +this line is enumerated : + initial chunk := subtext (this line, start pos, blank pos - 1); + enumerator (initial chunk) +END PROC enumeration offset; +BOOL PROC enumerator (TEXT CONST t) : + t = "-" COR substantial enumerator +. +substantial enumerator : + INT CONST l := LENGTH t; + TEXT CONST last char := t SUB l; + l < 20 CAND last char = ":" COR + l < 7 CAND pos (".)", last char) <> 0 +END PROC enumerator; +END PACKET eumel file utilities; diff --git a/app/conversion/1.0/src/FONTANAL.PAC b/app/conversion/1.0/src/FONTANAL.PAC new file mode 100644 index 0000000..c1dc502 --- /dev/null +++ b/app/conversion/1.0/src/FONTANAL.PAC @@ -0,0 +1,261 @@ +PACKET font analysis DEFINES find fonttable, + analyze fonts, + analyze indent levels : +INT VAR th index, cmd index, no of params; +TEXT VAR buffer line; +TEXT PROC next type command (FILE VAR f, INT VAR line number, cont pos) : + INT VAR start pos; + TEXT VAR type cmd := ""; + search loop; + line number := line no (f); + type cmd +. + search loop : + REP + downety (f, "#type"); + IF pattern found + THEN start pos := col (f); + read record (f, buffer line); + IF even number of command delimiters (buffer line, start pos - 1) + THEN extract command (buffer line, start pos, cont pos, type cmd); + col (f, cont pos); + LEAVE search loop + ELSE col (f, start pos + 1) + FI + FI + UNTIL NOT pattern found PER; + cont pos := col (f) +END PROC next type command; +PROC find fonttable (THESAURUS CONST used fonts th, TEXT VAR table name) : + LET old table type = 3009, + new table type = 3100; + TEXT VAR font name; + TEXT CONST users fonttable := fonttable; + INT VAR ds type, fonttable th index; + disable stop; + command dialogue (FALSE); + THESAURUS CONST fonttable th := ALL /"configurator"; + try all fonttables; + fonttable (users fonttable); + command dialogue (TRUE); + enable stop; + IF table name = "" + THEN errorstop ("Keine zur Datei passende Fonttabelle gefunden") + FI +. +try all fonttables : + fonttable th index := 0; + get (fonttable th, table name, fonttable th index); + WHILE fonttable th index > 0 REP + fetch (table name, /"configurator"); + ds type := type (old (table name)); + forget (table name); + IF ds type = old table type COR ds type = new table type + THEN fonttable (table name); + IF is error + THEN put error; + putline ("Fonttabelle `" + table name + "' kann nicht eingestellt werden."); + IF yes ("Abbrechen") + THEN enable stop + ELSE clear error + FI + ELSE IF all used fonts present + THEN LEAVE try all fonttables + FI + FI + FI; + get (fonttable th, table name, fonttable th index) + PER; + table name := "" +. +all used fonts present : + th index := 0; + get (used fonts th, font name, th index); + WHILE th index > 0 REP + IF NOT font exists (font name) + THEN LEAVE all used fonts present WITH FALSE + FI; + get (used fonts th, font name, th index) + PER; + TRUE +END PROC find fonttable; +PROC analyze fonts (FILE VAR f, TEXT VAR fonttable name, + font numbers, INT VAR base font index) : + THESAURUS VAR font th; + TEXT VAR usage, base font; + fonttable name := ""; + font numbers := ""; + base font index := 0; + collect fonts (f, font th, usage); + IF highest entry (font th) <> 0 + THEN analyze users fonts + FI; +. +analyze users fonts : + find fonttable (font th, fonttable name); + TEXT CONST users fonttable := fonttable; + fonttable (fonttable name); + provide font numbers (font th, font numbers, usage, base font); + sort fonts (font numbers); + base font index := pos (font numbers, base font); + IF users fonttable <> "" + THEN fonttable (users fonttable) + FI +END PROC analyze fonts; +PROC analyze fonts (TEXT CONST file name, TEXT VAR fonttable name, + font numbers, INT VAR base font index) : + FILE VAR f := sequential file (modify, file name); + analyze fonts (f, fonttable name, font numbers, base font index) +END PROC analyze fonts; +PROC collect fonts (FILE VAR f, THESAURUS VAR th, TEXT VAR line numbers) : + TEXT VAR cmd, font name, param2; + INT VAR current ln, last ln := 0, + act distance, current font lines, + next pos; + th := empty thesaurus; + line numbers := ""; + toline (f, 1); + col (f, 1); + WHILE NOT eof (f) REP + cmd := next type command (f, current ln, next pos); + cout (current ln); + note text lines for last font; + process font cmd + PER +. + note text lines for last font : + IF last ln <> 0 + THEN act distance := current ln - last ln; + current font lines := line numbers ISUB th index; + current font lines INCR act distance; + replace (line numbers, th index, current font lines) + FI +. +process font cmd : + analyze command ("type:1.1", cmd, 0, cmd index, no of params, + font name, param2); + IF cmd index = 1 + THEN th index := link (th, font name); + IF th index = 0 + THEN add new font + FI; + last ln := current ln + FI +. + add new font : + insert (th, font name, th index); + line numbers CAT ""0""0"" +END PROC collect fonts; +PROC provide font numbers (THESAURUS CONST fonts th, TEXT VAR font numbers, + line numbers, base font name) : + TEXT VAR font name, font no, old line numbers := line numbers; + font numbers := ""; + line numbers := ""; + INT VAR font index, line number, last greatest; + th index := 0; + get (fonts th, font name, th index); + WHILE th index > 0 REP + font no := code (font (font name)); + font index := pos (font numbers, font no); + IF font index = 0 + THEN transfer font + ELSE sum text line number + FI; + get (fonts th, font name, th index) + PER; + determine font with most text +. + transfer font : + font numbers CAT font no; + line numbers CAT (old line numbers ISUB th index) +. + sum text line number : + line number := line numbers ISUB font index; + line number INCR (old line numbers ISUB th index); + replace (line numbers, font index, line number) +. + determine font with most text : + last greatest := 0; + FOR font index FROM 1 UPTO (LENGTH line numbers) DIV 2 REP + line number := line numbers ISUB font index; + IF line number > last greatest + THEN last greatest := line number; + base font name := font numbers SUB font index + FI + PER; +END PROC provide font numbers; +PROC sort fonts (TEXT VAR fonts) : + TEXT VAR font name, spec font; + INT VAR font no, size; + th index := 0; + disable stop; + FILE VAR f := sequential file (output, "fonts"); + get font sizes; + sort ("fonts"); + restore fonts text; + forget ("fonts", quiet); + enable stop +. + get font sizes : + FOR th index FROM 1 UPTO LENGTH fonts REP + font name := fonts SUB th index; + font no := code (font name); + specify size + PER +. + specify size : + size := (indentation pitch (font no) DIV 2) + * (font height (font no) DIV 2); + rotate (size, 8); + spec font := ""223""223""; + replace (spec font, 1, size); + spec font CAT font name; + putline (f, spec font) +. + restore fonts text : + fonts := ""; + input (f); + WHILE NOT eof (f) REP + getline (f, spec font); + font name := spec font SUB 3; + fonts CAT font name + PER +END PROC sort fonts; +PROC analyze indent levels (TEXT CONST file name, TEXT VAR levels string) : + FILE VAR f := sequential file (input, file name); + analyze indent levels (f, levels string); + modify (f) +END PROC analyze indent levels; +PROC analyze indent levels (FILE VAR f, TEXT VAR levels string) : + INT VAR i; + TEXT VAR l, act blanks, current item; + levels string := ""; + WHILE NOT eof (f) REP + getline (f, l); + i := pos (l, ""33"", ""255"", 1) - 1; + IF i > 0 + THEN act blanks := code (i); + i := 1; + IF not yet remembered + THEN insert act blanks + FI + FI + PER; + modify (f) +. +not yet remembered : + WHILE i <= LENGTH levels string REP + current item := levels string SUB i; + IF current item < act blanks + THEN i INCR 1 + ELIF current item = act blanks + THEN LEAVE not yet remembered WITH FALSE + ELSE LEAVE not yet remembered WITH TRUE + FI + PER; + TRUE +. +insert act blanks : + insert char (levels string, act blanks, i) +END PROC analyze indent levels; +END PACKET font analysis; diff --git a/app/conversion/1.0/src/PSEUDOWP.WPM b/app/conversion/1.0/src/PSEUDOWP.WPM new file mode 100644 index 0000000..8c83ed6 Binary files /dev/null and b/app/conversion/1.0/src/PSEUDOWP.WPM differ diff --git a/app/conversion/1.0/src/PS_WP_DT.WPM b/app/conversion/1.0/src/PS_WP_DT.WPM new file mode 100644 index 0000000..14fd586 Binary files /dev/null and b/app/conversion/1.0/src/PS_WP_DT.WPM differ diff --git a/app/conversion/1.0/src/SEQU2CUM.TBL b/app/conversion/1.0/src/SEQU2CUM.TBL new file mode 100644 index 0000000..616b76c --- /dev/null +++ b/app/conversion/1.0/src/SEQU2CUM.TBL @@ -0,0 +1 @@ +"" = """" = "" { Aufwrtspfeil }"" = "" { Abwrtspfeil }"a" = """a" = """^a" = """e" = """e" = """^e" = """i" = """i" = """^i" = """o" = """o" = """^o" = """u" = """u" = """^u" = """~n" = """~N" = """c" = """C" = """@" = """" = """|" = """" = "" \ No newline at end of file diff --git a/app/conversion/1.0/src/WP_CNVRS.PAC b/app/conversion/1.0/src/WP_CNVRS.PAC new file mode 100644 index 0000000..c057a2e --- /dev/null +++ b/app/conversion/1.0/src/WP_CNVRS.PAC @@ -0,0 +1,905 @@ +PACKET wordperfect conversion DEFINES convert to wp : +LET type1 = 1, + linefeed = 3, + limit = 4, + free = 5, + page cmd0 = 6, + page cmd1 = 7, + on = 8, + off = 9, + page nr = 10, + pagelength = 11, + start = 12, + foot = 13, + end = 14, + head = 15, + headeven = 16, + headodd = 17, + bottom = 18, + bottomeven = 19, + bottomodd = 20, + block = 21, + material = 22, + columns = 23, + columnsend = 24, + ib0 = 25, + ib1 = 26, + ib2 = 27, + ie0 = 28, + ie1 = 29, + ie2 = 30, + topage = 31, + goalpage = 32, + count0 = 33, + count1 = 34, + setcount = 35, + value0 = 36, + value1 = 37, + table = 38, + table end = 39, + r pos = 40, + l pos = 41, + c pos = 42, + d pos = 43, + b pos = 44, + clear pos0 = 45, + clear pos1 = 46, + right = 47, + center = 48, + skip = 49, + skip end = 50, + u cmd = 51, + d cmd = 52, + e cmd = 53, + head on = 54, + head off = 55, + bottom on = 56, + bottom off = 57, + count per page=58, + fillchar = 59, + mark cmd = 60, + mark end = 61, + pageblock = 62, + bsp = 63, + counter1 = 64, + counter2 = 65, + setcounter = 66, + putcounter0 = 67, + putcounter1 = 68, + storecounter = 69, + ub = 70, + ue = 71, + fb = 72, + fe = 73, + region = 74, + region end = 75; +LET eumel line display pos = 1, + dos line display pos = 10, + default tab insert pos = 21; +LET cont paper width = 20.88, + cont paper length = 30.48, + minimal margin = 0.5; +LET eumel modifications = "ibur"; +LET wp cmd start = "<|", + wp cmd end = "|>"; +ROW 6 TEXT VAR wp types on off := ROW 6 TEXT : + ("p\K13", + "p\K14", + "", + "p\K15", + "p\K16", + "p\K17"); +ROW 4 TEXT CONST wp mods on off := ROW 4 TEXT : + ("p\K24", + "p\%", + "p\'", + "p\K28"); +ROW 2 TEXT CONST wp scripts on off := ROW 2 TEXT : + ("p\K11", "p\K12"); +TEXT VAR cosmetic cmds := + "type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2 + pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0 + headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0"; +cosmetic cmds CAT + "material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1 + goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0 + rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0"; +cosmetic cmds CAT + "center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0 + bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2 + markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01 + storecounter:69.1"; +cosmetic cmds CAT + "ub:70.0ue:71.0fb:72.0fe:73.0region:74.0regionend:75.0"; +TEXT VAR font number string, + users tabs cmd, no users tabs cmd, + param1, param2, + act l, next l, dos l, + eumel chunk, + wp cmd, buffer, index buffer, paired move cmd; +TEXT CONST wp enter tab menu := wp cmd start + "s\318", + wp clear tabs := "0\\rt\\ri\\el", + wp quit tab menu := "\&00" + wp cmd end, + wp return := "\\rt", + global tabs cmd := wp enter tab menu + wp clear tabs + + "0,0.5c" + wp return + wp quit tab menu, + page no cmd := wp cmd start + "s\3263" + wp cmd end; +INT VAR cmd index, no of params, + base font index, base font offset, + current wp size, current script value, + mod flags, + current index number, + act l no, + dos l length, + first cross pos, second cross pos, + act text start, next text start, + act indent level, next indent level, + current tab insert pos, + current font, + cursor x, cursor y; +REAL VAR paper width, + paper length, + current top margin, + current bottom margin, + current left margin, + current right margin, + current limit, + current pagelength, + current indent pitch; +BOOL VAR in footnote, + in table, + in index, + in header, + in bottom, + in enum, + is last line of paragraph, + text in dos l, + line contains number sign + ; +PROC convert to wp (TEXT CONST eumel file name) : + TEXT VAR wp file name, file fonttable, users fonttable := ""; + BOOL VAR errors found := FALSE; + IF word wrap (eumel file name) + THEN + ELSE refuse nonwrapped file + FI; + IF NOT errors found + THEN line; + say ("Schrifttypen werden analysiert ..."); + analyze fonts (eumel file name, file fonttable, + font number string, base font index); + line; + say ("Fu"251"noten werden plaziert ..."); + move footnotes (eumel file name); + wp file name := dos file name (eumel file name, "wpf"); + forget (wp file name, quiet); + line; + say ("Datei wird konvertiert ..."); + line; + IF file fonttable <> "" + THEN users fonttable := fonttable; + fonttable (file fonttable) + FI; + convert to wp file (eumel file name, wp file name); + forget (eumel file name, quiet); + rename (eumel file name + ".orig", eumel file name); + IF users fonttable <> "" + THEN fonttable (users fonttable) + FI + FI +END PROC convert to wp; +PROC convert to wp (THESAURUS CONST th) : + do (PROC (TEXT CONST) convert to wp, th) +END PROC convert to wp; +PROC convert to wp : + convert to wp (std) +END PROC convert to wp; +PROC move footnotes (TEXT CONST file name) : + copy (file name, file name + ".orig"); + FILE VAR f := sequential file (modify, file name); + INT VAR count line no, count col no, + foot line no, foot col no, + end line no, end col no, + value line no, value col no, + footnote lines, line length; + TEXT VAR count line tail; + toline (f, 1); + WHILE NOT eof (f) REP + cout (line no (f)); + down (f, "#count#"); + IF pattern found + THEN process note + FI + PER +. +process note : + count line no := line no (f); + count col no := col (f); + down (f, "#foot#"); + IF pattern found + THEN foot line no := line no (f); + foot col no := col (f); + IF foot line no - count line no > 20 + THEN LEAVE process note + FI; + isolate foot cmd if necessary; + down (f, "#end#"); + IF pattern found + THEN end line no := line no (f); + check for value; + isolate end cmd if necessary; + remove note; + split count line; + replace count by note + ELSE LEAVE process note + FI + ELSE LEAVE process note + FI +. +check for value : + toline (f, foot line no); + col (f, foot col no); + down (f, "#value#"); + IF pattern found + THEN value line no := line no (f); + value col no := col (f); + IF value line no >= end line no + THEN LEAVE process note + ELSE delete value cmd + FI + ELSE LEAVE process note + FI; + toline (f, end line no) +. +delete value cmd : + read record (f, act l); + change (act l, "#u##value##e#", ""); + change (act l, "#value#", ""); + write record (f, act l) +. +isolate foot cmd if necessary : + read record (f, act l); + IF foot col no > 1 + THEN next l := subtext (act l, foot col no); + IF (act l SUB (foot col no - 1)) = " " + THEN act l := subtext (act l, 1, foot col no - 2) + ELSE act l := subtext (act l, 1, foot col no - 1) + FI; + write record (f, act l); + down (f, 1); + insert record (f); + write record (f, next l) + FI +. +isolate end cmd if necessary : + read record (f, act l); + end col no INCR 5; + next l := subtext (act l, end col no); + IF next l > " " + THEN act l := subtext (act l, 1, end col no - 1); + write record (f, act l); + down (f, 1); + insert record (f); + write record (f, next l); + up (f, 1) + FI +. +remove note : + footnote lines := end line no - foot line no + 1; + remove (f, footnote lines) +. +split count line : + toline (f, count line no); + read record (f, act l); + cmd start := pos (act l, "#u##count##e#", count col no - 3); + IF cmd start = count col no - 3 + THEN cmd end := cmd start + 12 + ELSE cmd start := count col no; + cmd end := cmd start + 7 + FI; + count line tail := subtext (act l, cmd end + 1); + IF (count line tail SUB LENGTH count line tail) = " " + CAND (only command line (count line tail) COR + LENGTH count line tail = 1) + THEN count line tail CAT " " + FI; + act l := subtext (act l, 1, cmd start - 1); + write record (f, act l) +. +replace count by note : + toline (f, count line no + 1); + reinsert (f); + append count line tail; + toline (f, count line no + 1); + read record (f, next l); + delete record (f); + up (f, 1); + read record (f, act l); + act l CAT next l; + line length := LENGTH act l; + IF pos (act l, "#foot#") = line length - 6 CAND + (act l SUB line length) = " " + THEN act l := subtext (act l, 1, line length - 1) + FI; + write record (f, act l) +. +append count line tail : + read record (f, act l); + end col no := pos (act l, "#end#"); + act l := subtext (act l, 1, end col no + 4); + IF count line tail <> "" + THEN act l CAT count line tail + ELSE append next line + FI; + write record (f, act l) +. +append next line : + down (f, 1); + read record (f, next l); + IF next l > " " + THEN delete record (f); + up (f, 1); + act l CAT " "; + act l CAT next l; + write record (f, act l) + ELSE up (f, 1) + FI +. +cmd start : first cross pos +. +cmd end : second cross pos +END PROC move footnotes; +PROC initialize values : + act l no := 0; + current wp size := 3; + current script value := 0; + mod flags := 0; + current index number := 0; + current tab insert pos:= default tab insert pos; + paper length := cont paper length; + paper width := cont paper width; + current top margin := 2.5; + current bottom margin := 2.5; + current left margin := 3.0; + current right margin := 2.0; + current pagelength := paper length - current top margin - current bottom margin; + current limit := paper width - current left margin - current right margin; + current font := 1; + current indent pitch := xstep conversion (indentation pitch (current font)); + in enum := FALSE; + in table := FALSE; + in footnote := FALSE; + in header := FALSE; + in bottom := FALSE; + in index := FALSE; + text in dos l := FALSE; + base font offset := base font index - 3; + wp cmd := ""; + dos l := ""; + dos l length := 0; + next indent level := 0; + no users tabs cmd := no users tabs command; + users tabs cmd := no users tabs cmd +END PROC initialize values; +TEXT PROC no users tabs command : + TEXT VAR t := wp enter tab menu; + t CAT wp clear tabs; + t CAT text (current limit - 2.0); + t CAT ",0.2c\\rt"; + t CAT wp quit tab menu; + t +END PROC no users tabs command; +INT PROC indent level (INT CONST text start pos) : + LET tab distance = 0.5; + IF text start pos < 3 + THEN 0 + ELSE positive indent level + FI +. +positive indent level : + REAL VAR left margin distance + := real (text start pos - 1) * current indent pitch; + INT VAR ind level := int (round (left margin distance / tab distance, 0)); + IF ind level = 0 + THEN 1 + ELSE ind level + FI +END PROC indent level; +PROC convert to wp file (TEXT CONST eumel file name, wp file name) : + get cursor (cursor x, cursor y); + FILE VAR eumel f := sequential file (input, eumel file name), + dos f := sequential file (output, wp file name); + max line length (dos f, max text length); + INT CONST file lines := lines (eumel f); + BOOL VAR is last file line := FALSE; + set file defaults; + getline (eumel f, next l); + next text start := pos (next l, ""33"", ""255"", 1); + REP + act l := next l; + act l no INCR 1; + cursor (eumel line display pos, cursor y); + cout (act l no); + act text start := next text start; + IF act l no >= file lines + THEN next l := ""; + next text start := 1; + is last file line := TRUE + ELSE getline (eumel f, next l); + get next text start + FI; + act indent level := next indent level; + next indent level := indent level (next text start); + process act line; + IF is last line of paragraph + THEN IF is last file line + THEN complement pending paired commands + FI; + putline (dos f, dos l); + dos l := ""; + dos l length := 0; + text in dos l := FALSE; + cursor (dos line display pos, cursor y); + cout (line no (dos f)) + FI + UNTIL act l no >= file lines PER +END PROC convert to wp file; +PROC set file defaults : + initialize values; + set endnote options; + no pagination; + wp cmd CAT global tabs cmd +. +set endnote options : + cat to wp command ("s\J243\J22\\rt\&") +. +no pagination : + cat to wp command ("s\32649\&") +END PROC set file defaults; +PROC get next text start : + next text start := pos (next l, ""33"", ""255"", 1); + IF next text start = 2 + THEN next text start := 1 + FI +END PROC get next text start; +PROC process act line : + LET tab code = "<|s\\tb|>", + indent code = "<|s\\in|>", + margin rel code = "<|s\^|>"; + INT VAR enum blanks, past enumerator pos; + trim end of line (act l, is last line of paragraph, in table); + replace eumel special characters (act l, line contains number sign); + trim start of line; + IF in table CAND NOT text in dos l + THEN replace multiple blanks by tab stops (act l, tab code) + FI; + transfer line in chunks +. +trim start of line : + IF NOT (text in dos l COR only command line (act l)) + THEN IF NOT is last line of paragraph CAND + next indent level < act indent level + THEN cat to dos l (next indent level * indent code); + cat to dos l ((act indent level - next indent level) * tab code) + ELSE cat to dos l (act indent level * indent code) + FI; + enum blanks := enumeration offset (act l, next l, in enum, act text start); + IF enum blanks <> 0 + THEN in enum := TRUE; + past enumerator pos := pos (act l, " ", act text start); + change (act l, past enumerator pos, enum blanks, indent code) + ELSE in enum := FALSE; + IF NOT is last line of paragraph CAND + next indent level > act indent level + THEN cat to dos l (indent code); + cat to dos l (margin rel code) + FI + FI + FI +END PROC process act line; +PROC complement pending paired commands : + reset modifications; + IF current wp size <> 3 + THEN cat to wp command (wp types on off [current wp size]); + cat to dos l (wp cmd) + FI; +END PROC complement pending paired commands; +PROC transfer line in chunks : + WHILE act text start <= LENGTH act l REP + next text command pos (act l, act text start, first cross pos, second cross pos); + IF first cross pos <> 0 + THEN IF first cross pos <> act text start + THEN process text chunk (act text start, first cross pos - 1) + FI; + process eumel command (first cross pos, second cross pos); + act text start := second cross pos + 1 + ELSE process text chunk (act text start, LENGTH act l); + LEAVE transfer line in chunks + FI; + PER +END PROC transfer line in chunks; +PROC process text chunk (INT CONST start pos, end pos) : + eumel chunk := subtext (act l, start pos, end pos); + IF in header COR in bottom + THEN change all (eumel chunk, "%", page no cmd) + FI; + IF line contains number sign + THEN change all (eumel chunk, ""222"", "#") + FI; + cat to dos l (eumel chunk); + text in dos l := TRUE; + IF in index + THEN index buffer CAT eumel chunk + FI +END PROC process text chunk; +PROC process eumel command (INT CONST start pos, end pos) : + eumel chunk := subtext (act l, start pos + 1, end pos - 1); + IF (eumel chunk SUB 1) = "-" + THEN process comment (eumel chunk) + ELSE process command + FI; + cat to dos l (wp cmd); + wp cmd := "" +. + process command : + analyze command (cosmetic cmds, eumel chunk, 3, cmd index, no of params, + param1, param2); + customized command processing; + IF in index + THEN index buffer CAT wp cmd + FI +. + customized command processing : + SELECT cmd index OF + CASE type1 : process type cmd (param1) + CASE linefeed : cat to wp command ("s\316" + param1 + "\\rt\&") + CASE limit : process limit (param1) + CASE free : process free (param1) + CASE page cmd0 : cat to wp command ("s\_") + CASE page cmd1 : cat to wp command ("s\_\3261" + param1 + "\\rt\&") + CASE on : process mod on (param1) + CASE off : process mod off (param1) + CASE page nr : + CASE pagelength : process pagelength (param1) + CASE start : process start (param1, param2) + CASE foot : process footnote + CASE end : process end + CASE head, + headeven, + headodd : process head (cmd index) + CASE bottom, + bottomeven, + bottomodd : process bottom (cmd index) + CASE block : cat to wp command ("s\3134\&") + CASE material : + CASE columns : process columns + CASE columnsend : cat to wp command ("s\>12") + CASE ib0, + ib1, + ib2 : process index on (param1, param2) + CASE ie0, ie1, ie2 : process index off (param 1) + CASE topage : cat to wp command ("s\<111" + param1 + wp return) + CASE goalpage : cat to wp command ("s\<12" + param1 + wp return) + CASE count0 : cat to wp command ("s\051\\rt") + CASE count1 : process reference target (param1) + CASE setcount : cat to wp command ("s\J13" + param1 + wp return) + CASE value0 : + CASE value1 : cat to wp command ("s\<114" + param1 + wp return) + CASE table : process table + CASE table end : process table end + CASE r pos, l pos, c pos, d pos, + b pos : process tab stop (eumel chunk SUB 1, param1) + CASE clear pos0 : process clear all tabs + CASE clear pos1 : process clear tab (param1) + CASE right : cat to wp command ("s\=") + CASE center : cat to wp command ("s\1") + CASE skip : + CASE skip end : + CASE u cmd : process script cmd (1) + CASE d cmd : process script cmd (2) + CASE e cmd : process e cmd + CASE head on : + CASE head off : cat to wp command ("s\32311\&") + CASE bottom on : + CASE bottom off : cat to wp command ("s\32411\&") + CASE count per page : cat to wp command ("s\J146y\&") + CASE fillchar : + CASE mark cmd : + CASE mark end : + CASE pageblock : + CASE bsp : + CASE counter1 : + CASE counter2 : + CASE setcounter : + CASE putcounter0: + CASE putcounter1: + CASE storecounter: + CASE ub : process mod on ("u") + CASE ue : process mod off ("u") + CASE fb : + CASE fe : + CASE region, region end : cat to wp command ("p\3y") + END SELECT +END PROC process eumel command; +PROC process comment (TEXT CONST t) : + buffer := "p\Hy"; + cat to wp command (buffer); + wp cmd CAT subtext (t, 2); + cat to wp command (buffer) +END PROC process comment; +PROC cat to dos l (TEXT CONST t) : + LET mtl = 32000; + INT CONST t length := LENGTH t; + IF mtl - t length < dos l length + THEN report ("Absatz ist zu lang") + ELSE dos l CAT t; + dos l length INCR t length + FI +END PROC cat to dos l; +PROC cat to wp command (TEXT CONST t) : + IF t <> "" + THEN wp cmd CAT wp cmd start; + wp cmd CAT t; + wp cmd CAT wp cmd end + FI +END PROC cat to wp command; +PROC process mod on (TEXT CONST kind of mod) : + TEXT CONST mod char := kind of mod SUB 1; + INT CONST mod no := pos (eumel modifications, mod char); + cat to wp command (wp mods on off [mod no]); + set bit (mod flags, mod no) +END PROC process mod on; +PROC process mod off (TEXT CONST kind of mod) : + TEXT CONST mod char := kind of mod SUB 1; + INT CONST mod no := pos (eumel modifications, mod char); + process mod off (mod no) +END PROC process mod off; +PROC process mod off (INT CONST mod no) : + cat to wp command (wp mods on off [mod no]); + reset bit (mod flags, mod no) +END PROC process mod off; +PROC reset modifications : + INT VAR mod no; + IF mod flags > 0 + THEN FOR mod no FROM 1 UPTO 4 REP + IF bit (mod flags, mod no) + THEN process mod off (mod no) + FI + PER + FI +END PROC reset modifications; +PROC process type cmd (TEXT CONST wanted type) : + reset modifications; + current wp size off; + process type change (wanted type) +. + current wp size off : + cat to wp command (wp types on off [current wp size]) +END PROC process type cmd; +PROC process type change (TEXT CONST eumel type) : + current font := font (eumel type); + current indent pitch := xstep conversion (indentation pitch (current font)); + TEXT CONST eumel type no := code (current font); + INT CONST eumel size := pos (font number string, eumel type no); + current wp size := eumel size - base font offset; + IF current wp size < 1 + THEN current wp size := 1 + ELIF current wp size > 6 + THEN current wp size := 6 + FI; + cat to wp command (wp types on off [current wp size]) +END PROC process type change; +PROC process script cmd (INT CONST script value) : + current script value := script value; + cat to wp command (wp scripts on off [script value]) +END PROC process script cmd; +PROC process e cmd : + cat to wp command (wp scripts on off [current script value]); + current script value := 0 +END PROC process e cmd; +PROC process free (TEXT CONST cm) : + IF NOT in header COR in bottom + THEN buffer := "s\3412"; + buffer CAT cm; + buffer CAT "c\\rt\&"; + cat to wp command (buffer) + FI +END PROC process free; +PROC process limit (TEXT CONST t limit) : + current limit := real (t limit); + current limit := min (current limit, paper width - 2.0 * minimal margin); + process horizontal margins +END PROC process limit; +PROC process horizontal margins : + current right margin := paper width - current limit - current left margin; + IF current right margin - minimal margin < 0.0 + THEN current right margin := minimal margin; + current left margin := paper width - current limit - current right margin + FI; + wp cmd := wp cmd start; + wp cmd CAT "s\317"; + wp cmd CAT text (current left margin); + wp cmd CAT "c\\rt"; + wp cmd CAT text (current right margin); + wp cmd CAT "c\\rt\&"; + wp cmd CAT wp cmd end; +END PROC process horizontal margins; +PROC process pagelength (TEXT CONST t length) : + current pagelength := real (t length); + current pagelength + := min (current pagelength, paper length - 2.0 * minimal margin); + process vertical margins +END PROC process pagelength; +PROC process vertical margins : + current bottom margin := paper length - current pagelength - current top margin; + IF current bottom margin - minimal margin < 0.0 + THEN current bottom margin := minimal margin; + current top margin + := paper length - current pagelength - current bottom margin + FI; + wp cmd := wp cmd start; + wp cmd CAT "s\325"; + wp cmd CAT text (current top margin); + wp cmd CAT "c\\rt"; + wp cmd CAT text (current bottom margin); + wp cmd CAT "c\\rt\&"; + wp cmd CAT wp cmd end; +END PROC process vertical margins; +PROC process start (TEXT CONST t x, t y) : + current left margin := real (t x); + process horizontal margins; + current top margin := real (t y); + process vertical margins +END PROC process start; +PROC process footnote : + IF in footnote + THEN report ("Fu"251"notenschachtelung") + FI; + paired move cmd := "f\J11 \\rt\&"; + cat to wp command (paired move cmd); + in footnote := TRUE +END PROC process footnote; +PROC process head (INT CONST index) : + IF in header + THEN report ("Header-Schachtelung") + FI; + paired move cmd := "f\323"; + IF index <= headeven + THEN paired move cmd CAT "1"; + IF index = head + THEN paired move cmd CAT "2" + ELSE paired move cmd CAT "4" + FI + ELSE paired move cmd CAT "23" + FI; + paired move cmd CAT "\\rt\&00"; + cat to wp command (paired move cmd); + in header := TRUE +END PROC process head; +PROC process bottom (INT CONST index) : + IF in bottom + THEN report ("Bottom-Schachtelung") + FI; + paired move cmd := "f\324"; + IF index <= bottomeven + THEN paired move cmd CAT "1"; + IF index = bottom + THEN paired move cmd CAT "2" + ELSE paired move cmd CAT "4" + FI + ELSE paired move cmd CAT "23" + FI; + paired move cmd CAT "\\rt\&00"; + cat to wp command (paired move cmd); + in bottom := TRUE +END PROC process bottom; +PROC process end : + reset types and mods; + cat to wp command (paired move cmd); + IF in header + THEN in header := FALSE + ELIF in bottom + THEN in bottom := FALSE + ELIF in footnote + THEN in footnote := FALSE + ELSE report ("Unmotivierte End-Anweisung") + FI +. +reset types and mods : + reset modifications; + IF current wp size <> 3 + THEN cat to wp command (wp types on off [current wp size]); + current wp size := 3; + FI +END PROC process end; +PROC process columns : + INT VAR fcp, scp; + cat to wp command ("s\>1301"); + next text command pos (act l, act text start, fcp, scp); + IF fcp = second cross pos + 1 + THEN eumel chunk := subtext (act l, fcp + 1, scp - 1); + analyze command (cosmetic cmds, eumel chunk, 3, cmd index, + no of params, param1, param2); + IF cmd index = limit + THEN second cross pos := scp + FI + FI +END PROC process columns; +PROC process index on (TEXT CONST index number, registered text) : + IF in index + THEN report ("Kann Indexschachtelung nicht verarbeiten") + FI; + current index number := int (index number); + index buffer := "<|s\<3"; + IF registered text <> "" + THEN index buffer CAT registered text + ELSE in index := TRUE + FI +END PROC process index on; +PROC process index off (TEXT CONST index number) : + INT CONST index off number := int (index number); + IF current index number = index off number + THEN current index number := 0 + ELSE report ("Kann Indexschachtelung nicht verarbeiten") + FI; + wp cmd := index buffer; + wp cmd CAT "\\rt\ |>"; + in index := FALSE +END PROC process index off; +PROC process reference target (TEXT CONST marker) : + buffer := "s\J21\&\<12"; + buffer CAT marker; + buffer CAT wp return; + cat to wp command (buffer) +END PROC process reference target; +PROC process table : + IF users tabs cmd <> no users tabs cmd + THEN wp cmd := users tabs cmd + FI; + in table := TRUE +END PROC process table; +PROC process table end : + wp cmd := global tabs cmd; + in table := FALSE +END PROC process table end; +PROC process tab stop (TEXT CONST tab type, tab pos) : + buffer := tab pos; + buffer CAT wp return; + IF pos ("rcd", tab type) <> 0 + THEN buffer CAT tab type + FI; + insert new tab stop; + IF in table + THEN wp cmd CAT users tabs cmd + FI +. +insert new tab stop : + insert char (users tabs cmd, buffer, current tab insert pos); + current tab insert pos INCR LENGTH buffer +END PROC process tab stop; +PROC process clear all tabs : + users tabs cmd := no users tabs cmd; + current tab insert pos := default tab insert pos; +END PROC process clear all tabs; +PROC process clear tab (TEXT CONST tab pos) : + INT VAR del start, del end; + del start := pos (users tabs cmd, tab pos); + IF del start <> 0 + THEN clear pos + FI +. +clear pos : + del end := pos (users tabs cmd, wp return, del start) + 4; + buffer := users tabs cmd SUB del end + 1; + IF pos ("rcd", buffer) <> 0 + THEN del end INCR 1 + FI; + change (users tabs cmd, del start, del end, ""); + IF in table + THEN wp cmd CAT users tabs cmd + FI +END PROC process clear tab; +PROC report (TEXT CONST t) : + errorstop ("Zeile " + text (act l no) + ": " + t) +END PROC report; +END PACKET wordperfect conversion; diff --git a/app/conversion/1.0/src/WP_KNVRS.PAC b/app/conversion/1.0/src/WP_KNVRS.PAC new file mode 100644 index 0000000..993221c --- /dev/null +++ b/app/conversion/1.0/src/WP_KNVRS.PAC @@ -0,0 +1,915 @@ +PACKET wordperfect conversion DEFINES konvertiere nach wp : +LET type1 = 1, + linefeed = 3, + limit = 4, + free = 5, + page cmd0 = 6, + page cmd1 = 7, + on = 8, + off = 9, + page nr = 10, + pagelength = 11, + start = 12, + foot = 13, + end = 14, + head = 15, + headeven = 16, + headodd = 17, + bottom = 18, + bottomeven = 19, + bottomodd = 20, + block = 21, + material = 22, + columns = 23, + columnsend = 24, + ib0 = 25, + ib1 = 26, + ib2 = 27, + ie0 = 28, + ie1 = 29, + ie2 = 30, + topage = 31, + goalpage = 32, + count0 = 33, + count1 = 34, + setcount = 35, + value0 = 36, + value1 = 37, + table = 38, + table end = 39, + r pos = 40, + l pos = 41, + c pos = 42, + d pos = 43, + b pos = 44, + clear pos0 = 45, + clear pos1 = 46, + right = 47, + center = 48, + skip = 49, + skip end = 50, + u cmd = 51, + d cmd = 52, + e cmd = 53, + head on = 54, + head off = 55, + bottom on = 56, + bottom off = 57, + count per page=58, + fillchar = 59, + mark cmd = 60, + mark end = 61, + pageblock = 62, + bsp = 63, + counter1 = 64, + counter2 = 65, + setcounter = 66, + putcounter0 = 67, + putcounter1 = 68, + storecounter = 69, + ub = 70, + ue = 71, + fb = 72, + fe = 73, + region = 74, + region end = 75; +LET eumel line display pos = 1, + dos line display pos = 10, + default tab insert pos = 21; +LET cont paper width = 20.88, + cont paper length = 30.48, + minimal margin = 0.5; +LET eumel modifications = "ibur"; +LET wp cmd start = "<|", + wp cmd end = "|>"; +ROW 6 TEXT VAR wp types on off := ROW 6 TEXT : + ("p\K13", + "p\K14", + "", + "p\K15", + "p\K16", + "p\K17"); +ROW 4 TEXT CONST wp mods on off := ROW 4 TEXT : + ("p\K24", + "p\%", + "p\'", + "p\K28"); +ROW 2 TEXT CONST wp scripts on off := ROW 2 TEXT : + ("p\K11", "p\K12"); +TEXT VAR cosmetic cmds := + "type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2 + pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0 + headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0"; +cosmetic cmds CAT + "material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1 + goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0 + rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0"; +cosmetic cmds CAT + "center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0 + bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2 + markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01 + storecounter:69.1"; +cosmetic cmds CAT + "ub:70.0ue:71.0fb:72.0fe:73.0region:74.0regionend:75.0"; +TEXT VAR font number string, + users tabs cmd, no users tabs cmd, + param1, param2, + act l, next l, dos l, + eumel chunk, + wp cmd, buffer, index buffer, paired move cmd; +TEXT CONST wp enter tab menu := wp cmd start + "s\318", + wp clear tabs := "0\\rt\\ri\\el", + wp quit tab menu := "\&00" + wp cmd end, + wp return := "\\rt", + global tabs cmd := wp enter tab menu + wp clear tabs + + "0.0,5c" + wp return + wp quit tab menu, + page no cmd := wp cmd start + "s\3263" + wp cmd end; +INT VAR cmd index, no of params, + base font index, base font offset, + current wp size, current script value, + mod flags, + current index number, + act l no, + dos l length, + first cross pos, second cross pos, + act text start, next text start, + act indent level, next indent level, + current tab insert pos, + current font, + cursor x, cursor y; +REAL VAR paper width, + paper length, + current top margin, + current bottom margin, + current left margin, + current right margin, + current limit, + current pagelength, + current indent pitch; +BOOL VAR in footnote, + in table, + in index, + in header, + in bottom, + in enum, + is last line of paragraph, + text in dos l, + line contains number sign + ; +PROC konvertiere nach wp (TEXT CONST eumel file name) : + TEXT VAR wp file name, file fonttable, users fonttable := ""; + BOOL VAR errors found := FALSE; + IF word wrap (eumel file name) + THEN + ELSE refuse nonwrapped file + FI; + IF NOT errors found + THEN line; + say ("Schrifttypen werden analysiert ..."); + analyze fonts (eumel file name, file fonttable, + font number string, base font index); + line; + say ("Fu"251"noten werden plaziert ..."); + move footnotes (eumel file name); + wp file name := dos file name (eumel file name, "wpf"); + forget (wp file name, quiet); + line; + say ("Datei wird konvertiert ..."); + line; + IF file fonttable <> "" + THEN users fonttable := fonttable; + fonttable (file fonttable) + FI; + convert to wp file (eumel file name, wp file name); + forget (eumel file name, quiet); + rename (eumel file name + ".orig", eumel file name); + IF users fonttable <> "" + THEN fonttable (users fonttable) + FI + FI +END PROC konvertiere nach wp; +PROC konvertiere nach wp (THESAURUS CONST th) : + do (PROC (TEXT CONST) konvertiere nach wp, th) +END PROC konvertiere nach wp; +PROC konvertiere nach wp : + konvertiere nach wp (std) +END PROC konvertiere nach wp; +PROC move footnotes (TEXT CONST file name) : + copy (file name, file name + ".orig"); + FILE VAR f := sequential file (modify, file name); + INT VAR count line no, count col no, + foot line no, foot col no, + end line no, end col no, + value line no, value col no, + footnote lines, line length; + TEXT VAR count line tail; + toline (f, 1); + WHILE NOT eof (f) REP + cout (line no (f)); + down (f, "#count#"); + IF pattern found + THEN process note + FI + PER +. +process note : + count line no := line no (f); + count col no := col (f); + down (f, "#foot#"); + IF pattern found + THEN foot line no := line no (f); + foot col no := col (f); + IF foot line no - count line no > 20 + THEN LEAVE process note + FI; + isolate foot cmd if necessary; + down (f, "#end#"); + IF pattern found + THEN end line no := line no (f); + check for value; + isolate end cmd if necessary; + remove note; + split count line; + replace count by note + ELSE LEAVE process note + FI + ELSE LEAVE process note + FI +. +check for value : + toline (f, foot line no); + col (f, foot col no); + down (f, "#value#"); + IF pattern found + THEN value line no := line no (f); + value col no := col (f); + IF value line no >= end line no + THEN LEAVE process note + ELSE delete value cmd + FI + ELSE LEAVE process note + FI; + toline (f, end line no) +. +delete value cmd : + read record (f, act l); + change (act l, "#u##value##e#", ""); + change (act l, "#value#", ""); + write record (f, act l) +. +isolate foot cmd if necessary : + read record (f, act l); + IF foot col no > 1 + THEN next l := subtext (act l, foot col no); + IF (act l SUB (foot col no - 1)) = " " + THEN act l := subtext (act l, 1, foot col no - 2) + ELSE act l := subtext (act l, 1, foot col no - 1) + FI; + write record (f, act l); + down (f, 1); + insert record (f); + write record (f, next l) + FI +. +isolate end cmd if necessary : + read record (f, act l); + end col no INCR 5; + next l := subtext (act l, end col no); + IF next l > " " + THEN act l := subtext (act l, 1, end col no - 1); + write record (f, act l); + down (f, 1); + insert record (f); + write record (f, next l); + up (f, 1) + FI +. +remove note : + footnote lines := end line no - foot line no + 1; + remove (f, footnote lines) +. +split count line : + toline (f, count line no); + read record (f, act l); + cmd start := pos (act l, "#u##count##e#", count col no - 3); + IF cmd start = count col no - 3 + THEN cmd end := cmd start + 12 + ELSE cmd start := count col no; + cmd end := cmd start + 7 + FI; + count line tail := subtext (act l, cmd end + 1); + IF (count line tail SUB LENGTH count line tail) = " " + CAND (only command line (count line tail) COR + LENGTH count line tail = 1) + THEN count line tail CAT " " + FI; + act l := subtext (act l, 1, cmd start - 1); + write record (f, act l) +. +replace count by note : + toline (f, count line no + 1); + reinsert (f); + append count line tail; + toline (f, count line no + 1); + read record (f, next l); + delete record (f); + up (f, 1); + read record (f, act l); + act l CAT next l; + line length := LENGTH act l; + IF pos (act l, "#foot#") = line length - 6 CAND + (act l SUB line length) = " " + THEN act l := subtext (act l, 1, line length - 1) + FI; + write record (f, act l) +. +append count line tail : + read record (f, act l); + end col no := pos (act l, "#end#"); + act l := subtext (act l, 1, end col no + 4); + IF count line tail <> "" + THEN act l CAT count line tail + ELSE append next line + FI; + write record (f, act l) +. +append next line : + down (f, 1); + read record (f, next l); + IF next l > " " + THEN delete record (f); + up (f, 1); + act l CAT " "; + act l CAT next l; + write record (f, act l) + ELSE up (f, 1) + FI +. +cmd start : first cross pos +. +cmd end : second cross pos +END PROC move footnotes; +PROC initialize values : + act l no := 0; + current wp size := 3; + current script value := 0; + mod flags := 0; + current index number := 0; + current tab insert pos:= default tab insert pos; + paper length := cont paper length; + paper width := cont paper width; + current top margin := 2.5; + current bottom margin := 2.5; + current left margin := 3.0; + current right margin := 2.0; + current pagelength := paper length - current top margin - current bottom margin; + current limit := paper width - current left margin - current right margin; + current font := 1; + current indent pitch := xstep conversion (indentation pitch (current font)); + in enum := FALSE; + in table := FALSE; + in footnote := FALSE; + in header := FALSE; + in bottom := FALSE; + in index := FALSE; + text in dos l := FALSE; + base font offset := base font index - 3; + wp cmd := ""; + dos l := ""; + dos l length := 0; + next indent level := 0; + no users tabs cmd := no users tabs command; + users tabs cmd := no users tabs cmd +END PROC initialize values; +TEXT PROC no users tabs command : + TEXT VAR t := wp enter tab menu; + t CAT wp clear tabs; + t CAT german real (current limit - 2.0); + t CAT ".0,2c\\rt"; + t CAT wp quit tab menu; + t +END PROC no users tabs command; +INT PROC indent level (INT CONST text start pos) : + LET tab distance = 0.5; + IF text start pos < 3 + THEN 0 + ELSE positive indent level + FI +. +positive indent level : + REAL VAR left margin distance + := real (text start pos - 1) * current indent pitch; + INT VAR ind level := int (round (left margin distance / tab distance, 0)); + IF ind level = 0 + THEN 1 + ELSE ind level + FI +END PROC indent level; +PROC convert to wp file (TEXT CONST eumel file name, wp file name) : + get cursor (cursor x, cursor y); + FILE VAR eumel f := sequential file (input, eumel file name), + dos f := sequential file (output, wp file name); + max line length (dos f, max text length); + INT CONST file lines := lines (eumel f); + BOOL VAR is last file line := FALSE; + set file defaults; + getline (eumel f, next l); + next text start := pos (next l, ""33"", ""255"", 1); + REP + act l := next l; + act l no INCR 1; + cursor (eumel line display pos, cursor y); + cout (act l no); + act text start := next text start; + IF act l no >= file lines + THEN next l := ""; + next text start := 1; + is last file line := TRUE + ELSE getline (eumel f, next l); + get next text start + FI; + act indent level := next indent level; + next indent level := indent level (next text start); + process act line; + IF is last line of paragraph + THEN IF is last file line + THEN complement pending paired commands + FI; + putline (dos f, dos l); + dos l := ""; + dos l length := 0; + text in dos l := FALSE; + cursor (dos line display pos, cursor y); + cout (line no (dos f)) + FI + UNTIL act l no >= file lines PER +END PROC convert to wp file; +PROC set file defaults : + initialize values; + set endnote options; + no pagination; + wp cmd CAT global tabs cmd +. +set endnote options : + cat to wp command ("s\J243\J22\\rt\&") +. +no pagination : + cat to wp command ("s\32649\&") +END PROC set file defaults; +PROC get next text start : + next text start := pos (next l, ""33"", ""255"", 1); + IF next text start = 2 + THEN next text start := 1 + FI +END PROC get next text start; +PROC process act line : + LET tab code = "<|s\\tb|>", + indent code = "<|s\\in|>", + margin rel code = "<|s\^|>"; + INT VAR enum blanks, past enumerator pos; + trim end of line (act l, is last line of paragraph, in table); + replace eumel special characters (act l, line contains number sign); + trim start of line; + IF in table CAND NOT text in dos l + THEN replace multiple blanks by tab stops (act l, tab code) + FI; + transfer line in chunks +. +trim start of line : + IF NOT (text in dos l COR only command line (act l)) + THEN IF NOT is last line of paragraph CAND + next indent level < act indent level + THEN cat to dos l (next indent level * indent code); + cat to dos l ((act indent level - next indent level) * tab code) + ELSE cat to dos l (act indent level * indent code) + FI; + enum blanks := enumeration offset (act l, next l, in enum, act text start); + IF enum blanks <> 0 + THEN in enum := TRUE; + past enumerator pos := pos (act l, " ", act text start); + change (act l, past enumerator pos, enum blanks, indent code) + ELSE in enum := FALSE; + IF NOT is last line of paragraph CAND + next indent level > act indent level + THEN cat to dos l (indent code); + cat to dos l (margin rel code) + FI + FI + FI +END PROC process act line; +PROC complement pending paired commands : + reset modifications; + IF current wp size <> 3 + THEN cat to wp command (wp types on off [current wp size]); + cat to dos l (wp cmd) + FI; +END PROC complement pending paired commands; +PROC transfer line in chunks : + WHILE act text start <= LENGTH act l REP + next text command pos (act l, act text start, first cross pos, second cross pos); + IF first cross pos <> 0 + THEN IF first cross pos <> act text start + THEN process text chunk (act text start, first cross pos - 1) + FI; + process eumel command (first cross pos, second cross pos); + act text start := second cross pos + 1 + ELSE process text chunk (act text start, LENGTH act l); + LEAVE transfer line in chunks + FI; + PER +END PROC transfer line in chunks; +PROC process text chunk (INT CONST start pos, end pos) : + eumel chunk := subtext (act l, start pos, end pos); + IF in header COR in bottom + THEN change all (eumel chunk, "%", page no cmd) + FI; + IF line contains number sign + THEN change all (eumel chunk, ""222"", "#") + FI; + cat to dos l (eumel chunk); + text in dos l := TRUE; + IF in index + THEN index buffer CAT eumel chunk + FI +END PROC process text chunk; +PROC process eumel command (INT CONST start pos, end pos) : + eumel chunk := subtext (act l, start pos + 1, end pos - 1); + IF (eumel chunk SUB 1) = "-" + THEN process comment (eumel chunk) + ELSE process command + FI; + cat to dos l (wp cmd); + wp cmd := "" +. + process command : + analyze command (cosmetic cmds, eumel chunk, 3, cmd index, no of params, + param1, param2); + customized command processing; + IF in index + THEN index buffer CAT wp cmd + FI +. + customized command processing : + SELECT cmd index OF + CASE type1 : process type cmd (param1) + CASE linefeed : cat to wp command ("s\316" + + german real (param1) + "\\rt\&") + CASE limit : process limit (param1) + CASE free : process free (param1) + CASE page cmd0 : cat to wp command ("s\_") + CASE page cmd1 : cat to wp command ("s\_\3261" + param1 + "\\rt\&") + CASE on : process mod on (param1) + CASE off : process mod off (param1) + CASE page nr : + CASE pagelength : process pagelength (param1) + CASE start : process start (param1, param2) + CASE foot : process footnote + CASE end : process end + CASE head, + headeven, + headodd : process head (cmd index) + CASE bottom, + bottomeven, + bottomodd : process bottom (cmd index) + CASE block : cat to wp command ("s\3134\&") + CASE material : + CASE columns : process columns + CASE columnsend : cat to wp command ("s\>12") + CASE ib0, + ib1, + ib2 : process index on (param1, param2) + CASE ie0, ie1, ie2 : process index off (param 1) + CASE topage : cat to wp command ("s\<111" + param1 + wp return) + CASE goalpage : cat to wp command ("s\<12" + param1 + wp return) + CASE count0 : cat to wp command ("s\051\\rt") + CASE count1 : process reference target (param1) + CASE setcount : cat to wp command ("s\J13" + param1 + wp return) + CASE value0 : + CASE value1 : cat to wp command ("s\<114" + param1 + wp return) + CASE table : process table + CASE table end : process table end + CASE r pos, l pos, c pos, d pos, + b pos : process tab stop (eumel chunk SUB 1, param1) + CASE clear pos0 : process clear all tabs + CASE clear pos1 : process clear tab (param1) + CASE right : cat to wp command ("s\=") + CASE center : cat to wp command ("s\1") + CASE skip : + CASE skip end : + CASE u cmd : process script cmd (1) + CASE d cmd : process script cmd (2) + CASE e cmd : process e cmd + CASE head on : + CASE head off : cat to wp command ("s\32311\&") + CASE bottom on : + CASE bottom off : cat to wp command ("s\32411\&") + CASE count per page : cat to wp command ("s\J146y\&") + CASE fillchar : + CASE mark cmd : + CASE mark end : + CASE pageblock : + CASE bsp : + CASE counter1 : + CASE counter2 : + CASE setcounter : + CASE putcounter0: + CASE putcounter1: + CASE storecounter: + CASE ub : process mod on ("u") + CASE ue : process mod off ("u") + CASE fb : + CASE fe : + CASE region, region end : cat to wp command ("p\3y") + END SELECT +END PROC process eumel command; +PROC process comment (TEXT CONST t) : + buffer := "p\Hy"; + cat to wp command (buffer); + wp cmd CAT subtext (t, 2); + cat to wp command (buffer) +END PROC process comment; +PROC cat to dos l (TEXT CONST t) : + LET mtl = 32000; + INT CONST t length := LENGTH t; + IF mtl - t length < dos l length + THEN report ("Absatz ist zu lang") + ELSE dos l CAT t; + dos l length INCR t length + FI +END PROC cat to dos l; +PROC cat to wp command (TEXT CONST t) : + IF t <> "" + THEN wp cmd CAT wp cmd start; + wp cmd CAT t; + wp cmd CAT wp cmd end + FI +END PROC cat to wp command; +PROC process mod on (TEXT CONST kind of mod) : + TEXT CONST mod char := kind of mod SUB 1; + INT CONST mod no := pos (eumel modifications, mod char); + cat to wp command (wp mods on off [mod no]); + set bit (mod flags, mod no) +END PROC process mod on; +PROC process mod off (TEXT CONST kind of mod) : + TEXT CONST mod char := kind of mod SUB 1; + INT CONST mod no := pos (eumel modifications, mod char); + process mod off (mod no) +END PROC process mod off; +PROC process mod off (INT CONST mod no) : + cat to wp command (wp mods on off [mod no]); + reset bit (mod flags, mod no) +END PROC process mod off; +PROC reset modifications : + INT VAR mod no; + IF mod flags > 0 + THEN FOR mod no FROM 1 UPTO 4 REP + IF bit (mod flags, mod no) + THEN process mod off (mod no) + FI + PER + FI +END PROC reset modifications; +PROC process type cmd (TEXT CONST wanted type) : + reset modifications; + current wp size off; + process type change (wanted type) +. + current wp size off : + cat to wp command (wp types on off [current wp size]) +END PROC process type cmd; +PROC process type change (TEXT CONST eumel type) : + current font := font (eumel type); + current indent pitch := xstep conversion (indentation pitch (current font)); + TEXT CONST eumel type no := code (current font); + INT CONST eumel size := pos (font number string, eumel type no); + current wp size := eumel size - base font offset; + IF current wp size < 1 + THEN current wp size := 1 + ELIF current wp size > 6 + THEN current wp size := 6 + FI; + cat to wp command (wp types on off [current wp size]) +END PROC process type change; +PROC process script cmd (INT CONST script value) : + current script value := script value; + cat to wp command (wp scripts on off [script value]) +END PROC process script cmd; +PROC process e cmd : + cat to wp command (wp scripts on off [current script value]); + current script value := 0 +END PROC process e cmd; +PROC process free (TEXT CONST cm) : + IF NOT in header COR in bottom + THEN buffer := "s\3412"; + buffer CAT german real (cm); + buffer CAT "c\\rt\&"; + cat to wp command (buffer) + FI +END PROC process free; +PROC process limit (TEXT CONST t limit) : + current limit := real (t limit); + current limit := min (current limit, paper width - 2.0 * minimal margin); + process horizontal margins +END PROC process limit; +PROC process horizontal margins : + current right margin := paper width - current limit - current left margin; + IF current right margin - minimal margin < 0.0 + THEN current right margin := minimal margin; + current left margin := paper width - current limit - current right margin + FI; + wp cmd := wp cmd start; + wp cmd CAT "s\317"; + wp cmd CAT german real (current left margin); + wp cmd CAT "c\\rt"; + wp cmd CAT german real (current right margin); + wp cmd CAT "c\\rt\&"; + wp cmd CAT wp cmd end; +END PROC process horizontal margins; +PROC process pagelength (TEXT CONST t length) : + current pagelength := real (t length); + current pagelength + := min (current pagelength, paper length - 2.0 * minimal margin); + process vertical margins +END PROC process pagelength; +PROC process vertical margins : + current bottom margin := paper length - current pagelength - current top margin; + IF current bottom margin - minimal margin < 0.0 + THEN current bottom margin := minimal margin; + current top margin + := paper length - current pagelength - current bottom margin + FI; + wp cmd := wp cmd start; + wp cmd CAT "s\325"; + wp cmd CAT german real (current top margin); + wp cmd CAT "c\\rt"; + wp cmd CAT german real (current bottom margin); + wp cmd CAT "c\\rt\&"; + wp cmd CAT wp cmd end; +END PROC process vertical margins; +PROC process start (TEXT CONST t x, t y) : + current left margin := real (t x); + process horizontal margins; + current top margin := real (t y); + process vertical margins +END PROC process start; +PROC process footnote : + IF in footnote + THEN report ("Fu"251"notenschachtelung") + FI; + paired move cmd := "f\J11 \\rt\&"; + cat to wp command (paired move cmd); + in footnote := TRUE +END PROC process footnote; +PROC process head (INT CONST index) : + IF in header + THEN report ("Header-Schachtelung") + FI; + paired move cmd := "f\323"; + IF index <= headeven + THEN paired move cmd CAT "1"; + IF index = head + THEN paired move cmd CAT "2" + ELSE paired move cmd CAT "4" + FI + ELSE paired move cmd CAT "23" + FI; + paired move cmd CAT "\\rt\&00"; + cat to wp command (paired move cmd); + in header := TRUE +END PROC process head; +PROC process bottom (INT CONST index) : + IF in bottom + THEN report ("Bottom-Schachtelung") + FI; + paired move cmd := "f\324"; + IF index <= bottomeven + THEN paired move cmd CAT "1"; + IF index = bottom + THEN paired move cmd CAT "2" + ELSE paired move cmd CAT "4" + FI + ELSE paired move cmd CAT "23" + FI; + paired move cmd CAT "\\rt\&00"; + cat to wp command (paired move cmd); + in bottom := TRUE +END PROC process bottom; +PROC process end : + reset types and mods; + cat to wp command (paired move cmd); + IF in header + THEN in header := FALSE + ELIF in bottom + THEN in bottom := FALSE + ELIF in footnote + THEN in footnote := FALSE + ELSE report ("Unmotivierte End-Anweisung") + FI +. +reset types and mods : + reset modifications; + IF current wp size <> 3 + THEN cat to wp command (wp types on off [current wp size]); + current wp size := 3; + FI +END PROC process end; +PROC process columns : + INT VAR fcp, scp; + cat to wp command ("s\>1301"); + next text command pos (act l, act text start, fcp, scp); + IF fcp = second cross pos + 1 + THEN eumel chunk := subtext (act l, fcp + 1, scp - 1); + analyze command (cosmetic cmds, eumel chunk, 3, cmd index, + no of params, param1, param2); + IF cmd index = limit + THEN second cross pos := scp + FI + FI +END PROC process columns; +PROC process index on (TEXT CONST index number, registered text) : + IF in index + THEN report ("Kann Indexschachtelung nicht verarbeiten") + FI; + current index number := int (index number); + index buffer := "<|s\<3"; + IF registered text <> "" + THEN index buffer CAT registered text + ELSE in index := TRUE + FI +END PROC process index on; +PROC process index off (TEXT CONST index number) : + INT CONST index off number := int (index number); + IF current index number = index off number + THEN current index number := 0 + ELSE report ("Kann Indexschachtelung nicht verarbeiten") + FI; + wp cmd := index buffer; + wp cmd CAT "\\rt\ |>"; + in index := FALSE +END PROC process index off; +PROC process reference target (TEXT CONST marker) : + buffer := "s\J21\&\<12"; + buffer CAT marker; + buffer CAT wp return; + cat to wp command (buffer) +END PROC process reference target; +PROC process table : + IF users tabs cmd <> no users tabs cmd + THEN wp cmd := users tabs cmd + FI; + in table := TRUE +END PROC process table; +PROC process table end : + wp cmd := global tabs cmd; + in table := FALSE +END PROC process table end; +PROC process tab stop (TEXT CONST tab type, tab pos) : + buffer := german real (tab pos); + buffer CAT wp return; + IF pos ("rcd", tab type) <> 0 + THEN buffer CAT tab type + FI; + insert new tab stop; + IF in table + THEN wp cmd CAT users tabs cmd + FI +. +insert new tab stop : + insert char (users tabs cmd, buffer, current tab insert pos); + current tab insert pos INCR LENGTH buffer +END PROC process tab stop; +PROC process clear all tabs : + users tabs cmd := no users tabs cmd; + current tab insert pos := default tab insert pos; +END PROC process clear all tabs; +PROC process clear tab (TEXT CONST tab pos) : + INT VAR del start, del end; + del start := pos (users tabs cmd, tab pos); + IF del start <> 0 + THEN clear pos + FI +. +clear pos : + del end := pos (users tabs cmd, wp return, del start) + 4; + buffer := users tabs cmd SUB del end + 1; + IF pos ("rcd", buffer) <> 0 + THEN del end INCR 1 + FI; + change (users tabs cmd, del start, del end, ""); + IF in table + THEN wp cmd CAT users tabs cmd + FI +END PROC process clear tab; +PROC report (TEXT CONST t) : + errorstop ("Zeile " + text (act l no) + ": " + t) +END PROC report; +TEXT PROC german real (TEXT CONST t) : + TEXT VAR t1 := t; + change (t1, ".", ","); + t1 +END PROC german real; +TEXT PROC german real (REAL CONST r) : + TEXT VAR t := text (r); + german real (t) +END PROC german real; +END PACKET wordperfect conversion; diff --git a/app/diskettenmonitor/3.5/source-disk b/app/diskettenmonitor/3.5/source-disk new file mode 100644 index 0000000..10203de --- /dev/null +++ b/app/diskettenmonitor/3.5/source-disk @@ -0,0 +1 @@ +debug/diskettenmonitor-3.5_1986-11-16.img diff --git a/app/diskettenmonitor/3.5/src/basic menu handling 3.5.quelle b/app/diskettenmonitor/3.5/src/basic menu handling 3.5.quelle new file mode 100644 index 0000000..f60101d --- /dev/null +++ b/app/diskettenmonitor/3.5/src/basic menu handling 3.5.quelle @@ -0,0 +1,53 @@ + +PACKET basic menu handling + +(************************************************************************) +(* *) +(* Basic Menu Handling Version 1.0 *) +(* *) +(* *) +(* Autor : Ingo Siekmann *) +(* Stand : Donnerstag, den 12. Juni 1986 *) +(* *) +(* Lauffähig ab EUMEL Version 1.7.3 *) +(* *) +(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert *) +(* *) +(************************************************************************) + + DEFINES menue monitor : + + + +LET info line x pos = 1 , + info line y pos = 20 , + command line x pos = 1 , + command line y pos = 21 ; + +LET first mon line = "----------------------------------------------------------------------------" , + command line = ">__________________________________________________________________________<" ; + + +TEXT VAR char ; + +PROCEDURE menue monitor (TEXT CONST info line, chars, (* I. Siekmann *) + INT VAR command index) : (* 12.06.1986 *) + enable stop ; + cursor (1, 17) ; + command index := 0 ; + out (first mon line) ; + cursor (info line x pos, info line y pos) ; + out (info line) ; + cursor (command line x pos, command line y pos) ; + out (command line) ; + cursor (command line x pos + 1, command line y pos) ; + REPEAT + (* inchar (char) ; *) + get char (char) ; + command index := pos (chars, char) + UNTIL command index > 0 COR is error END REPEAT ; + out (char) . +END PROCEDURE menue monitor ; + +ENDPACKET basic menu handling ; + diff --git a/app/diskettenmonitor/3.5/src/disk 3.5-m.quelle b/app/diskettenmonitor/3.5/src/disk 3.5-m.quelle new file mode 100644 index 0000000..d081c8e --- /dev/null +++ b/app/diskettenmonitor/3.5/src/disk 3.5-m.quelle @@ -0,0 +1,2192 @@ +(************************************************************************) +(* *) +(* DDDD IIIII SSSS K K 3333 55555 / M M *) +(* D D I S K K 3 5 / MM MM *) +(* D D I SSS KK 333 5555 / M M M M *) +(* D D I S K K 3 5 / M M M *) +(* DDDD IIIII SSSS K K 3333 O 5555 / M M *) +(* *) +(************************************************************************) +(* *) +(* Diskettenmonitor Version 3.5 Multi *) +(* *) +(* Autor : Ingo Siekmann unter freundlicher Mithilfe von Stefan Haase, *) +(* Nils Ehnert, APu und Frank Lenniger *) +(* *) +(* Stand : Sonntag, den 16. November 1986 *) +(* *) +(* Lauffähig ab EUMEL Version 1.7.3 /M in Systemtasks *) +(* *) +(* *) +(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert *) +(* *) +(************************************************************************) +(************************************************************************) +(* *) +(* Softwareaenderungen und Softwareneuerungen : *) +(* *) +(* 03.01.1986 3.3.2.8 : Block- Asciieditor ueberarbeitet, neuer Header- *) +(* editor (V1.3), Helpfunktion, gib kommando, *) +(* Fileaccess auch fuer 16-Files *) +(* 15.01.1986 3.3.2.9 : Vorbereitung fuer den Suchmodus in 3.3.3.0, *) +(* Notbremse ins globalmenue mit ctrl g, byte ops *) +(* ueberarbeitet, pic dienste in vorbereitung *) +(* Headereditor (V1.4) *) +(* 16.01.1986 : halt from terminal --> ctrl g := true *) +(* 16.01.1886 3.3.3.0 : Suchmodus ins Blockmenue (TEST), Blockeditor *) +(* Byteposops fuer Suchmodus einbauen *) +(* 21.01.1986 : inchar in get char umgewandelt *) +(* 28.01.1986 : lernmodus eingebaut (???) *) +(* 31.01.1986 3.3.3.1 : Suchmodus und Lernmodus wieder ausgebaut *) +(* beim Datenraumschreiben nur belegte Bloecke raus*) +(* 14.02.1986 3.3.3.2 : Fehler Überarbeitet *) +(* 20.02.1986 : Suchmodus vorbereitet (2. Versuch ?) *) +(* 06.03.1986 3.3.3.3 : Suchmodus eingebaut (Test) *) +(* 10.03.1986 : Softwaretrennung zwischen Single und Multi *) +(* 12.03.1986 : read next block cmd ins blockmenu eingebaut *) +(* Fehler überarbeitet, Vorbereitung für besseren *) +(* Suchmodus *) +(* 17.03.1986 3.3.3.4 : configurator menü -> einstellen von disk type, *) +(* i/o channel, disk info. TEXT/HEX search . *) +(* 02.04.1986 : urflop ops mit versatzops *) +(* 08.04.1986 : urflop menue mit versatz *) +(* 30.04.1986 3.3.3.5 : Fehler ueberarbeitet *) +(* 30.04.1986 3.3.3.6 : lab read/write ins space menue *) +(* 05.05.1986 3.3.3.7 : hex / dez - get für alles, block editor über- *) +(* arbeitet, fehler überarbeitet. auslieferung für *) +(* HRZ ! *) +(* 06.06.1986 3.4 : Fehler im search und menue monitor behoben *) +(* 12.06.1986 : Fehler im Space/Header-Menue behoben *) +(* 16.11.1986 3.5 : Fehler im Urflopmenue behoben *) +(* *) +(* A C H T U N G : Keine weitere Entwicklung von Version 3 !! *) +(* *) +(* Bielefeld, den 16.11.1986 ULES *) +(* *) +(* Ingo Siekmann *) +(* *) +(* *) +(************************************************************************) + +PACKET byte operations and disk monitor version 35 multi + + DEFINES BYTE , + HEX , + ASCII , + DECRL , + DECRH , + INCRL , + INCRH , + := , + - , + + , + $ , + hint , + zu byte , + lower byte , + higher byte , + set lower byte , + set higher byte , + nil byte , + put , + get , + + block in , + block out , + + HEADER , + header , + nil header , + is start header , + is end header , + is file header , + name , + date , + type , + pass , + header edit , + + show first , + show second , + block edit , + ascii edit , + + set ctrl g , + reset ctrl g , + + set channel , + read block , + write block , + seek space , + seek block , + read space , + write space , + check archive error , + + space nr , + header nr , + + urlader lesen , + urlader schreiben , + urlader lesen auf seite , + urlader schreiben von seite , + + search , + + io control , + + central disk monitor process : + + + +LET start of volume = 1000 , + end of volume = 1 , + file header = 3 ; + +LET global info line = "** GLOBAL : b / s / a / c / u / k / q # stop --> ctrl g, help --> ""?"" **" , + block info line = "** BLOCK : r / w / e / k / s / n / q # stop --> ctrl g, help --> ""?"" **" , + search info line = "** SEARCH : a -> ascii / h -> hex / q -> quit / ctrl g -> stop **" , + editor info line = "** EDITOR : f / s / d / e / k / p / q # stop --> ctrl g, help --> ""?"" **" , + space info line = "** SPACE : r, R, w, W, e, E, s, l, k, q # stop --> ctrl g, help --> ""?"" **" , + space header info = "** SPACE / HEADER : s -> read space / h -> read header / q -> quit **" , + archiv info line = "** ARCHIV : a / r / l / f / s / k / q # stop --> ctrl g, help --> ""?"" **" , + urflop info line = "** URFLOP : r / R / w / W / l / k / q # stop --> ctrl g, help --> ""?"" **" , + conf info line = "** CONFIGURATOR : c / t / i / k / q # stop --> ctrl g, help --> ""?"" **" , + first mon line = "----------------------------------------------------------------------------" , + command line = ">__________________________________________________________________________<" ; + +LET global chars = "bsacuqk?"7"" , + block chars = "rweqksn?"7"" , + search chars = "ahdq"7"" , + editor chars = "fsdeqk?"7"p" , + space chars = "rRwWesqEkl?"7"" , + archiv chars = "arlfsqk?"7"" , + urflop chars = "rRwWlqk?"7"" , + conf chars = "ctikq?"7"" ; + +LET info line x pos = 1 , + info line y pos = 20 , + info line x pos 2 = 1 , + info line y pos 2 = 24 , + command line x pos = 1 , + command line y pos = 21 , + error line x pos = 1 , + error line y pos = 22 , + + file type = 1003 , + file type 16 = 1002 , + + block 0 = 0 , + + std archive channel = 31 , + + type mode = 1 , + size mode = 5 , + std disk type = 0 ; + +LET software stand = "Sonntag, den 16.11.1986" , + software version = "Version 3.5 /Multi" , + software bemerkung = "*** Ende der Entwicklung der Version 3 ! ***" , + software bemerkung1 = "" ; + +LET eumel 0 start block = 10 , + eumel 0 end block = 65 , + eumel 0 end block pic = 62 , + eumel 0 end block 1758 = 67 , + pic char table start block = 63 , + pic char table end block = 65 , + pic shard start block = 0 , + pic shard end block = 79 , + + read write impossible error = 101 , + read error = 102 , + write error = 103 , + block number error = 104 , + undef archive error = 105 ; + +LET ibm 720 format 5 = 1440 , + ibm 360 format 5 = 720 , + pic 400 format 5 = 1600 , + soft sd 8 = 1232 , + soft dd 8 = 2464 , + hard ss sd = 616 , + hard ds sd = 1232 ; + +LET home = ""1"" , + left = ""8"" , + right = ""2"" , + up = ""3"" , + down = ""10"" , + return = ""13"" , + tab = ""9"" , + esc = ""27"" , + cl eol = ""5"" , + cl eop = ""4"" ; + +LET hex chars = "0123456789ABCDEF" , + hex marker = "h" ; + +LET start pos = 479 , + heap page nr = 2 ; + + +TYPE HEADER = STRUCT (TEXT name, date, INT type, TEXT pass) ; + +TYPE BYTE = STRUCT (INT lower byte , higher byte) ; + + +HEADER CONST nil header := HEADER : ("", "", 0, "") ; +BOUND HEADER VAR bound header ; +BOUND TEXT VAR bound text ; + +INITFLAG VAR this packet := false ; + +ROW 256 BYTE VAR block ; +ROW 32 TEXT VAR text block ; +ROW 256 INT VAR block int ; + +DATASPACE VAR ds :: nilspace ; forget (ds) ; +DATASPACE VAR afds :: nilspace ; forget (afds) ; +DATASPACE VAR lds :: nilspace ; forget (lds) ; +DATASPACE VAR uds :: nilspace ; forget (uds) ; +DATASPACE VAR blkinds :: nilspace ; forget (blkinds) ; + +FILE VAR af, f, lf ; + +INT VAR command index, block nummer, space nummer, x, y, i, i1, xx, yy, + archive channel := std archive channel, user channel, error answer, + header nummer, first sp block, integer, archiv size, error, block nr, + stpos, s, e, fb, fp, cx, cy, disk type := std disk type, ver ; + +TEXT VAR c, hex line :: "", tc, char, t, archive name, dummy, + stb1, stb2, own command line ; + +REAL VAR po ; + +BOOL VAR first := true, ende, list file ok, block shown, ctrl g, result ; + + +(********************** PACKET bytes ok : ****************************) + + +BYTE PROC nil byte : + BYTE : (0,0) +END PROC nil byte ; + +OP := (BYTE VAR byte , BYTE CONST old byte) : + byte.lower byte := old byte.lower byte ; + byte.higher byte := old byte.higher byte. +END OP := ; + +OP := (BYTE VAR byte , INT CONST int byte) : + byte.lower byte := int byte MOD 256 ; + byte.higher byte := (int byte AND -256) DIV 256 AND 255 . +END OP := ; + +OP := (ROW 256 BYTE VAR byte, ROW 256 INT CONST int byte) : + INT VAR i ; + FOR i FROM 1 UPTO 256 REPEAT + byte (i) := int byte (i) + END REPEAT . +END OP := ; + +OP := (ROW 256 INT VAR int byte, ROW 256 BYTE CONST byte) : + INT VAR i ; + FOR i FROM 1 UPTO 256 REPEAT + int byte (i) := byte (i) + END REPEAT . +END OP := ; + +BYTE OP + (BYTE VAR byte , INT CONST int byte) : + byte.lower byte := byte.lower byte + lower byte (int byte) ; + byte.higher byte := byte.higher byte + higher byte (int byte) ; + byte . +END OP + ; + +BYTE OP - (BYTE VAR byte, INT CONST int byte) : + byte.lower byte := byte.lower byte - lower byte (int byte) ; + byte.higher byte := byte.higher byte - higher byte (int byte) ; + byte . +END OP - ; + +OP := (INT VAR int byte, BYTE CONST byte) : + IF byte.higher byte > 127 + THEN int byte := minus * 255 + minus + byte.lower byte + ELSE int byte := byte.higher byte * 256 + byte.lower byte + END IF + +.minus : byte.higher byte - 256 . +END OP := ; + +OP INCRL (BYTE VAR byte, INT CONST lower) : + byte.lower byte INCR lower +END OP INCRL ; + +OP INCRH (BYTE VAR byte, INT CONST high) : + byte.higher byte INCR high +END OP INCRH ; + +OP DECRL (BYTE VAR byte, INT CONST lower) : + byte.higher byte DECR lower +END OP DECRL ; + +OP DECRH (BYTE VAR byte, INT CONST high) : + byte.higher byte DECR high +END OP DECRH ; + +INT PROC lower byte (BYTE CONST byte) : + byte.lower byte . +END PROC lower byte ; + +INT PROC higher byte (BYTE CONST byte) : + byte.higher byte . +END PROC higher byte ; + +INT PROC lower byte (INT CONST int byte) : + int byte MOD 256 . +END PROC lower byte ; + +INT PROC higher byte (INT CONST int byte) : + (int byte AND -256) DIV 256 AND 255 . +END PROC higher byte ; + +PROC set lower byte (BYTE VAR byte, INT CONST lower byte) : + byte.lower byte := lower byte +END PROC set lower byte ; + +PROC set higher byte (BYTE VAR byte, INT CONST higher byte) : + byte.higher byte := higher byte +END PROC set higher byte ; + +OP HEX (TEXT VAR insert line , BYTE CONST byte) : + insert line CAT (hex chars SUB (byte.lower byte DIV 16 + 1)) ; + insert line CAT (hex chars SUB (byte.lower byte MOD 16 + 1)) ; + insert line CAT " " ; + insert line CAT (hex chars SUB (byte.higher byte DIV 16 + 1)) ; + insert line CAT (hex chars SUB (byte.higher byte MOD 16 + 1)) ; + insert line CAT " " . +END OP HEX ; + +OP ASCII (TEXT VAR insert line , BYTE CONST byte) : + insert line CAT ascii (byte.lower byte ) ; + insert line CAT ascii (byte.higher byte) . +END OP ASCII ; + +TEXT PROC ascii (INT CONST half byte) : + IF half byte > 31 AND half byte < 127 COR + half byte > 213 AND half byte < 219 COR + half byte = 251 + THEN code (half byte) + ELSE "." + END IF . +END PROC ascii ; + +PROC block in (ROW 256 BYTE VAR block bytes, INT CONST type , block nr) : + ROW 256 INT VAR block ; + reset block io ; + block in (block, type, block nr, error answer) ; + block bytes := block ; + check archive error (error answer, true) . +END PROC block in ; + +PROC block out (ROW 256 BYTE CONST bytes , INT CONST disk type, block nr) : + ROW 256 INT VAR int bytes := bytes ; + reset block io ; + block out (int bytes, disk type, block nr, error answer) ; + check archive error (error answer, true) . +END PROC block out ; + +PROC put (BYTE CONST byte) : + put ("LOW : " + text (byte.lower byte) + " HIGH : " + text (byte.higher byte)) . +END PROC put ; + +PROC get (BYTE VAR byte) : + get (integer) ; + byte := integer . +END PROC get ; + +PROC zu byte (ROW 256 BYTE VAR bytes, TEXT CONST byte kette, INT CONST stelle) : + INT VAR lower, higher ; + lower := pos (hex chars, (byte kette SUB 1)) * 16 + + pos (hex chars, (byte kette SUB 2)) - 17 ; + higher:= pos (hex chars, (byte kette SUB 4)) * 16 + + pos (hex chars, (byte kette SUB 5)) - 17 ; + IF higher > 127 + THEN bytes (stelle) := minus * 255 + minus + lower + ELSE bytes (stelle) := higher * 256 + lower + END IF . + +minus : higher - 256 . +END PROC zu byte ; + +BYTE OPERATOR $ (TEXT CONST hex) : + TEXT VAR byte kette :: ""; + FOR i FROM 1 UPTO 4 REPEAT + IF (hex SUB i) = "" + THEN byte kette CAT "0" + ELIF (hex SUB i) = " " + THEN (* Nix *) + ELSE byte kette CAT (hex SUB i) + END IF ; + END REPEAT ; + BYTE VAR byte ; + INT VAR lower, higher, i; + lower := pos (hex chars, (byte kette SUB 1)) * 16 + + pos (hex chars, (byte kette SUB 2)) - 17 ; + higher:= pos (hex chars, (byte kette SUB 3)) * 16 + + pos (hex chars, (byte kette SUB 4)) - 17 ; + IF higher > 127 + THEN byte := minus * 255 + minus + lower + ELSE byte := higher * 256 + lower + END IF ; + byte . + +minus : higher - 256 . +END OPERATOR $ ; + +INT PROCEDURE hint (TEXT CONST he) : + INT VAR laenge :: length (he) , + stelle , + ziffer , + ergebnis :: 0 ; + + TEXT VAR h :: he ; + + FOR stelle FROM 65 UPTO 70 REPEAT + change all (h, code (stelle + 32), code (stelle)) + END REPEAT ; + + FOR stelle FROM laenge DOWNTO 1 REP + ziffer := pos ("0123456789ABCDEF", h SUB stelle) - 1 ; + IF ziffer < 0 + THEN errorstop ("Unerlaubtes Zeichen in Hexadezimalzahl") + END IF ; + ergebnis := ergebnis + ziffer * 16 ** (laenge - stelle) + END REP ; + ergebnis +END PROCEDURE hint ; + + +(********************** PACKET header operations ***************************) + + +OPERATOR := (HEADER VAR dest, HEADER CONST source) : + CONCR (dest) := CONCR (source) . +END OPERATOR := ; + +HEADER PROCEDURE header (TEXT CONST name, date, INT CONST type, + TEXT CONST pass) : + HEADER : (name, date, type, pass) . +END PROCEDURE header ; + +BOOL PROCEDURE is start header (HEADER CONST header) : + CONCR (header).type = start of volume . +END PROCEDURE is start header ; + +BOOL PROCEDURE is end header (HEADER CONST header) : + CONCR (header).type = end of volume . +END PROCEDURE is end header ; + +BOOL PROCEDURE is file header (HEADER CONST header) : + CONCR (header).type = file header . +END PROCEDURE is file header ; + +PROCEDURE name (HEADER VAR header, TEXT CONST new name) : + CONCR (header).name := new name . +END PROCEDURE name ; + +TEXT PROCEDURE name (HEADER CONST header) : + CONCR (header).name . +END PROCEDURE name ; + +PROCEDURE date (HEADER VAR header, TEXT CONST new date) : + CONCR (header).date := new date . +END PROCEDURE date ; + +TEXT PROCEDURE date (HEADER CONST header) : + CONCR (header).date . +END PROCEDURE date ; + +PROCEDURE type (HEADER VAR header, INT CONST new type) : + CONCR (header).type := new type . +END PROCEDURE type ; + +INT PROCEDURE type (HEADER CONST header) : + CONCR (header).type . +END PROCEDURE type ; + +PROCEDURE pass (HEADER VAR header, TEXT CONST new pass) : + CONCR (header).pass := new pass . +END PROCEDURE pass ; + +TEXT PROCEDURE pass (HEADER CONST header) : + CONCR (header).pass . +END PROCEDURE pass ; + + +(********************** Header-Editor V1.4 ****************************) + + +PROCEDURE header edit (HEADER VAR header, TEXT CONST msg) : + TEXT VAR head :: ""15"HEADER - EDITOR V1.4" + (25 - LENGTH msg) * "." + msg + + 5 * "." + " "14"" ; + disable stop ; + REPEAT + out (home) ; + out (16 * (cl eol + down)) ; + cursor (6, 6) ; + putline (head) ; + cursor (6, 7) ; + put (""15"TEXT name : "14"") ; + edit get (CONCR (header).name, max text length, 38) ; + IF is error + THEN clear error ; + CONCR (header).name := "" ; + cursor (6, 7) ; + put (""15"TEXT name : "14"") ; + edit get (CONCR (header).name, max text length, 38) + END IF ; + cursor (6, 8) ; + put (""15"TEXT date : "14"") ; + edit get (CONCR (header).date, max text length, 38) ; + IF is error + THEN clear error ; + CONCR (header).date := "" ; + cursor (6, 8) ; + put (""15"TEXT date : "14"") ; + edit get (CONCR (header).date, max text length, 38) + END IF ; + cursor (6, 9) ; + put (""15"INT type : "14"") ; + TEXT VAR d :: text (CONCR (header).type) ; + edit get (d, max text length, 38) ; + CONCR (header).type := int (d) ; + cursor (6, 10) ; + put (""15"TEXT pass : "14"") ; + edit get (CONCR (header).pass, max text length, 38) ; + IF is error + THEN clear error ; + CONCR (header).pass := "" ; + cursor (6, 10) ; + put (""15"TEXT pass : "14"") ; + edit get (CONCR (header).pass, max text length, 38) + END IF ; + cursor (6, 13) ; + UNTIL NOT no (""15"header ok. "14"") END REPEAT +END PROCEDURE header edit ; + + +(********************** PACKET block editor ****************************) + + +PROCEDURE show first (ROW 256 BYTE CONST block) : + out (home) ; + po := 1.0 ; + first := true ; + FOR i FROM 1 UPTO 16 REPEAT + text block (i) := text ((i - 1) * 16, 4) ; + text block (i) CAT " : " ; + get cursor (x, y) ; + FOR i1 FROM 1 UPTO 8 REPEAT + text block (i) HEX block ((i-1) * 8 + i1) + END REPEAT ; + text block (i) CAT " *" ; + FOR i1 FROM 1 UPTO 8 REPEAT + text block (i) ASCII block ((i - 1) * 8 + i1) + END REPEAT ; + text block (i) CAT "*" ; + cursor (x, y) ; + putline (text block (i)) + END REPEAT . +END PROCEDURE show first ; + +PROCEDURE show second (ROW 256 BYTE CONST block) : + out (home) ; + po := 129.0 ; + first := false ; + FOR i FROM 17 UPTO 32 REPEAT + text block (i) := text ((i - 1) * 16, 4) ; + text block (i) CAT " : " ; + get cursor (x,y) ; + FOR i1 FROM 1 UPTO 8 REPEAT + text block (i) HEX block ((i - 1) * 8 + i1) + END REPEAT ; + text block (i) CAT " *" ; + FOR i1 FROM 1 UPTO 8 REPEAT + text block (i) ASCII block ((i - 1) * 8 + i1) + END REPEAT ; + text block (i) CAT "*" ; + cursor (x, y); + putline (text block (i)) + END REPEAT . +END PROCEDURE show second ; + +PROCEDURE block edit (ROW 256 BYTE VAR block, INT CONST st) : + IF st > 0 + THEN IF st > 255 + THEN push (255 * right) + ELSE push (st * right) + END IF + END IF ; + BOOL VAR low :: TRUE ; + edit info ; + cursor (8, 1) ; + get cursor (x, y) ; + po := 1.0 ; + REPEAT + get cursor (x, y) ; + cursor (x, y) ; + (* inchar (t) ; *) + get char (t) ; + IF (t = right OR t = " ") AND x < 53 + THEN cursor (x + 3, y) ; po INCR 0.5 + ELIF (t = right OR t = " ") AND x > 52 AND y < 16 + THEN cursor (8, y + 1) ; po INCR 0.5 + ELIF t = up AND y > 1 + THEN cursor (x, y - 1) ; po DECR 8.0 + ELIF t = left AND x > 8 + THEN cursor (x - 3, y) ; po DECR 0.5 + ELIF t = left AND x = 8 AND y <> 1 + THEN cursor (53, y - 1) ; po DECR 0.5 + ELIF t = down AND y < 16 + THEN cursor (x, y + 1) ; po INCR 8.0 + ELIF t = tab + THEN IF first + THEN show first (block) + ELSE show second (block) + END IF ; + ascii edit (block, first) ; + IF first + THEN show first (block) + ELSE show second (block) + END IF ; + IF t <> return + THEN edit info ; + cursor (8, 1) ; + END IF + ELIF t = ""7"" + THEN set ctrl g + END IF ; + get cursor (x, y) ; + cursor (x, y); + IF code (t) > 47 AND code (t) < 58 OR + code (t) > 96 AND code (t) < 103 + THEN IF code (t) > 96 CAND code (t) < 103 + THEN t := code (code (t) - 32) + END IF ; + out (left + "-" + 2 * right + "-" + 3 * left + t) ; + REPEAT + (* inchar (tc) ; *) + get char (tc) ; + UNTIL code (tc) > 47 AND code (tc) < 58 OR + code (tc) > 96 AND code (tc) < 103 END REPEAT ; + IF code (tc) > 96 CAND code (tc) < 103 + THEN tc := code (code (tc) - 32) + END IF ; + out (tc + " " + 4 * left + " ") ; + cursor (x, y) ; + t CAT tc ; + INT VAR bp :: int (po) ; + IF po MOD real (bp) = 0.0 + THEN low := TRUE + ELSE low := FALSE + END IF ; + IF NOT first (* ONE : 17.06.85 *) + THEN bp INCR 128 + END IF ; + IF low + THEN set lower byte (block (bp), hint (t)) + ELSE set higher byte (block (bp), hint (t)) + END IF ; + END IF ; + info ; + UNTIL t = return COR ctrl g END REPEAT ; + IF first + THEN show first (block) + ELSE show second (block) + END IF ; + cursor (1, 17) . + +info : + get cursor (x, y) ; + cursor (xx, yy) ; + IF po MOD real (int(po)) = 0.0 + THEN put ("LOW") + ELSE put ("HIGH") + END IF ; + cursor (x,y) . + +edit info : + cursor (1, 23) ; + put (cl eol + "Block-Editor : Hexmodus,") ; + IF first + THEN put ("First Block") + ELSE put ("Second Block") + END IF ; + put (",") ; + get cursor (xx, yy) . +END PROCEDURE block edit ; + +PROCEDURE block edit (ROW 256 BYTE VAR block, BOOL CONST first, + INT CONST st) : + + IF st > 0 + THEN IF st > 255 + THEN push (255 * right) + ELSE push (st * right) + END IF + END IF ; + BOOL VAR low :: TRUE ; + edit info ; + cursor (8, 1) ; + get cursor (x, y) ; + po := 1.0 ; + REPEAT + get cursor (x, y) ; + cursor (x, y) ; + (* inchar (t) ; *) + get char (t) ; + IF (t = right OR t = " ") AND x < 53 + THEN cursor (x + 3, y) ; po INCR 0.5 + ELIF (t = right OR t = " ") AND x > 52 AND y < 16 + THEN cursor (8, y + 1) ; po INCR 0.5 + ELIF t = up AND y > 1 + THEN cursor (x, y - 1) ; po DECR 8.0 + ELIF t = left AND x > 8 + THEN cursor (x - 3, y) ; po DECR 0.5 + ELIF t = left AND x = 8 AND y <> 1 + THEN cursor (53, y - 1) ; po DECR 0.5 + ELIF t = down AND y < 16 + THEN cursor (x, y + 1) ; po INCR 8.0 + ELIF t = tab + THEN IF first + THEN show first (block) + ELSE show second (block) + END IF ; + ascii edit (block, first) ; + IF first + THEN show first (block) + ELSE show second (block) + END IF ; + IF t <> return + THEN edit info ; + cursor (8, 1) ; + END IF + ELIF t = ""7"" + THEN set ctrl g + END IF ; + get cursor (x, y) ; + cursor (x, y); + IF code (t) > 47 AND code (t) < 58 OR + code (t) > 96 AND code (t) < 103 + THEN IF code (t) > 96 CAND code (t) < 103 + THEN t := code (code (t) - 32) + END IF ; + out (left + "-" + 2 * right + "-" + 3 * left + t) ; + REPEAT + (* inchar (tc) ; *) + get char (tc) ; + UNTIL code (tc) > 47 AND code (tc) < 58 OR + code (tc) > 96 AND code (tc) < 103 END REPEAT ; + IF code (tc) > 96 CAND code (tc) < 103 + THEN tc := code (code (tc) - 32) + END IF ; + out (tc + " " + 4 * left + " ") ; + cursor (x, y) ; + t CAT tc ; + INT VAR bp :: int (po) ; + IF po MOD real (bp) = 0.0 + THEN low := TRUE + ELSE low := FALSE + END IF ; + IF NOT first (* ONE : 17.06.85 *) + THEN bp INCR 128 + END IF ; + IF low + THEN set lower byte (block (bp), hint (t)) + ELSE set higher byte (block (bp), hint (t)) + END IF ; + END IF ; + info ; + UNTIL t = return COR ctrl g END REPEAT ; + IF first + THEN show first (block) + ELSE show second (block) + END IF ; + cursor (1, 17) . + +info : + get cursor (x, y) ; + cursor (xx, yy) ; + IF po MOD real (int(po)) = 0.0 + THEN put ("LOW") + ELSE put ("HIGH") + END IF ; + cursor (x,y) . + +edit info : + cursor (1, 23) ; + put (cl eol + "Block-Editor : Hexmodus,") ; + IF first + THEN put ("First Block") + ELSE put ("Second Block") + END IF ; + put (",") ; + get cursor (xx, yy) . +END PROCEDURE block edit ; + +PROCEDURE ascii edit (ROW 256 BYTE VAR block, BOOL CONST first) : + BOOL VAR low ; + edit info ; + cursor (59, 1) ; + x := 1 ; + y := 1 ; + po := 1.0 ; + REPEAT + get char (t) ; + IF po < 1.0 AND first + THEN po := 1.0 + END IF ; + IF po < 129.0 AND NOT first + THEN po := 129.0 + END IF ; + IF po > 128.5 AND first + THEN po := 128.5 + END IF ; + IF po > 256.5 AND NOT first + THEN po := 256.5 + END IF ; + SELECT pos (""9""8""2""3""10""13""7"", t) OF + CASE 1, 6 : quit ascii edit + CASE 2 : IF x > 1 COR (x = 1 AND y > 1) + THEN x DECR 1; po DECR 0.5 + END IF + CASE 3 : IF x < 16 COR (x = 16 AND y <> 16) + THEN x INCR 1; po INCR 0.5 + END IF + CASE 4 : IF y > 1 + THEN y DECR 1 ; + po DECR 8.0 + END IF + CASE 5 : IF y < 16 + THEN y INCR 1 ; + po INCR 8.0 + END IF + CASE 7 : set ctrl g + OTHERWISE IF code (t) >= 32 AND code (t) <= 126 + THEN set char ; push (""2"") + END IF + END SELECT ; + IF x < 1 AND y = 1 + THEN x := 1 + ELIF x < 1 AND y > 1 + THEN x := 16 ; + y DECR 1 + ELIF x > 16 AND y = 16 + THEN x := 16 ; + ELIF x > 16 AND y < 16 + THEN x := 1 ; + y INCR 1 + ELIF y < 1 + THEN y := 1 + ELIF y > 16 + THEN y := 16 + END IF ; + info ; + UNTIL ctrl g END REPEAT . + +quit ascii edit : + x := 8 ; + y := 1 ; + cursor (x, y) ; + po := 1.0 ; + LEAVE ascii edit . + +set char : + out (t) ; + INT VAR bp :: int (po) ; + IF x MOD 2 = 0 + THEN set higher byte (block (bp), code (t)) + ELSE set lower byte (block (bp), code (t)) + END IF. + +info : + cursor (xx, yy) ; + IF po MOD real (int (po)) = 0.0 + THEN put ("LOW") + ELSE put ("HIGH") + END IF ; + cursor (58 + x, y) . + +edit info : + cursor (1, 23) ; + put (""5"Block-Editor : Asciimodus,") ; + IF first + THEN put ("First Block") + ELSE put ("Second Block") + END IF ; + put (",") ; + get cursor (xx, yy) . +END PROCEDURE ascii edit ; + + +(********************** PACKET block i/o : ****************************) + + +PROCEDURE set channel (INT CONST channel) : + archive channel := channel . +END PROCEDURE set channel ; + +PROCEDURE read block (ROW 256 BYTE VAR block byte, INT CONST block nummer) : + user channel := channel ; + enable stop ; + continue (archive channel) ; + disable stop ; + block in (block int, disk type, block nummer, error answer) ; + IF is error + THEN clear error + END IF ; + break (quiet) ; + continue (user channel) ; + enable stop ; + check archive error (error answer, true) ; + block byte := block int . +END PROCEDURE read block ; + +PROCEDURE write block (ROW 256 BYTE VAR block byte, INT CONST block nummer) : + user channel := channel ; + enable stop ; + block int := block byte ; + continue (archive channel) ; + disable stop ; + block out (block int, disk type, block nummer, error answer) ; + IF is error + THEN clear error + END IF ; + break (quiet) ; + continue (user channel) ; + enable stop ; + check archive error (error answer, false) . +END PROCEDURE write block; + +PROCEDURE read block (ROW 256 INT VAR block int, INT CONST block nummer) : + user channel := channel ; + enable stop ; + continue (archive channel) ; + disable stop ; + block in (block int, disk type, block nummer, error answer) ; + IF is error + THEN clear error + END IF ; + break (quiet) ; + continue (user channel) ; + enable stop ; + check archive error (error answer, true) . +END PROCEDURE read block ; + +PROC write block (ROW 256 INT VAR block int, INT CONST block nummer) : + user channel := channel ; + enable stop ; + continue (archive channel) ; + disable stop ; + block out (block int, disk type, block nummer, error answer) ; + IF is error + THEN clear error + END IF ; + break (quiet) ; + continue (user channel) ; + enable stop ; + check archive error (error answer, false) . +END PROCEDURE write block ; + + +(********************** PACKET space i/o : ****************************) + + +PROCEDURE seek space (INT CONST space) : + user channel := channel ; + enable stop ; + rewind ; + INT VAR i ; + continue (archive channel) ; + disable stop ; + FOR i FROM 1 UPTO space REPEAT + skip dataspace + UNTIL is error END REPEAT ; + break (quiet) ; + continue (user channel) . +END PROCEDURE seek space ; + +PROCEDURE seek block (INT CONST block nr) : + seek (block nr) . +END PROCEDURE seek block ; + +PROCEDURE read space (DATASPACE VAR ds) : + user channel := channel ; + enable stop ; + continue (archive channel) ; + disable stop ; + read (ds) ; + break (quiet) ; + continue (user channel) . +END PROCEDURE read space ; + +PROCEDURE read space (DATASPACE VAR ds, INT VAR max pages, + BOOL CONST errors) : + user channel := channel ; + enable stop ; + continue (archive channel) ; + disable stop ; + read (ds, max pages, errors) ; + break (quiet) ; + continue (user channel) . +END PROCEDURE read space ; + +PROCEDURE write space (DATASPACE CONST ds) : + user channel := channel ; + enable stop ; + continue (archive channel) ; + disable stop ; + write (ds) ; + break (quiet) ; + continue (user channel) . +END PROCEDURE write space ; + +PROCEDURE check archive error (INT CONST code, BOOL CONST read) : + enable stop ; + IF read + THEN SELECT code OF + CASE 0 : + CASE 1 : error stop (read write impossible error, + "Lesen unmoeglich (1)") + CASE 2 : error stop (read error, + "Lesefehler (2)") + CASE 3 : error stop (block number error, + "Blocknummer zu hoch (3)") + OTHERWISE error stop (undef archive error, + "Archivfehler unbekannt ("+ text (code) +")") + END SELECT + ELSE SELECT code OF + CASE 0 : + CASE 1 : error stop (read write impossible error, + "Schreiben unmoeglich (1)") + CASE 2 : error stop (write error, + "Schreibfehler (2)") + CASE 3 : error stop (block number error, + "Blocknummer zu hoch (3)") + OTHERWISE error stop (undef archive error, + "Archivfehler unbekannt ("+ text (code) +")") + END SELECT + END IF . +END PROCEDURE check archive error ; + + +(********************** PACKET menue monitor : ****************************) + + +PROCEDURE fehler behandeln : + IF is error CAND error message <> "" + THEN IF is halt from terminal + THEN set ctrl g + ELSE cursor (error line x pos, error line y pos) ; + clear error ; + put (cl eol +"Fehler : "+ error message) + END IF + END IF . +END PROCEDURE fehler behandeln ; + +PROCEDURE set ctrl g : + ctrl g := true . +END PROCEDURE set ctrl g ; + +PROCEDURE reset ctrl g : + ctrl g := false . +END PROCEDURE reset ctrl g ; + +PROCEDURE fehler loeschen : + INT VAR x, y ; + get cursor (x, y) ; + cursor (1, 22) ; + out (cl eol) ; + cursor (1, 18) ; + out (cl eol) ; + cursor (1, 23) ; + out (cl eol) ; + cursor (x, y) . +END PROCEDURE fehler loeschen ; + + +(********************** Global-Menue ****************************) + + +PROCEDURE global menue : + ende := false ; + user channel := channel ; + disable stop ; + REPEAT + menue monitor (global info line, global chars, command index) ; + fehler loeschen ; + SELECT command index OF + CASE 1 : block menue + CASE 2 : space menue + CASE 3 : archive menue + CASE 4 : configurator menue + CASE 5 : urflop menue + CASE 6 : out ("uit");ende := true ; + CASE 7 : get and do one command ; block shown := false + CASE 8 : global menue help ; block shown := false + CASE 9 : set ctrl g + END SELECT ; + fehler behandeln ; + UNTIL ende COR ctrl g END REPEAT ; + reset ctrl g ; + ende := false . +END PROCEDURE global menue ; + + +(********************** Block-Menue ****************************) + + +PROCEDURE block menue : + disable stop ; + REPEAT + menue monitor (block info line, block chars, command index) ; + fehler loeschen ; + SELECT command index OF + CASE 1 : read one block + CASE 2 : write one block + CASE 3 : edit block menue + CASE 4 : LEAVE block menue + CASE 5 : get and do one command + CASE 6 : search menue + CASE 7 : push ("r"+ text (block nummer + 1) +" ") + CASE 8 : block menue help ; block shown := false + CASE 9 : set ctrl g + END SELECT ; + show first three ints ; + display info line ; + fehler behandeln + UNTIL ctrl g END REPEAT . + +read one block : + out ("ead Block : ") ; + x get (block nummer) ; + IF NOT is error + THEN reset block io ; + read block (block, block nummer) + END IF ; + IF NOT is error + THEN show first (block) ; block shown := true + END IF . + +write one block : + out ("rite") ; + IF yes ("write auf Block "+ text (block nummer)) + THEN reset block io ; + write block (block, block nummer) + ELIF yes ("write auf einen anderen Block") + THEN out (" auf Block : ") ; + x get (block nummer) ; + IF NOT is error + THEN reset block io ; + write block (block, block nummer) + END IF + END IF . + +show first three ints : + cursor (1, 18) ; + put (""5"1.INT : ") ; + TEXT VAR h :: "" ; h HEX block (1) ; + INT VAR ih := block (1) ; + h CAT ("/ " + text (ih)) ; + put (h) ; + put (", 2.INT : ") ; + h := "" ; h HEX block (2) ; + ih := block (2) ; + h CAT ("/ " + text (ih)) ; + put (h) ; + put (", 3.INT : ") ; + h := "" ; h HEX block (3) ; + ih := block (3) ; + h CAT ("/ " + text (ih)) ; + put (h) . +END PROCEDURE block menue ; + + +(********************** Search-Menue ****************************) + + +PROCEDURE search menue : + disable stop ; + menue monitor (search info line, search chars, command index) ; + fehler loeschen ; + SELECT command index OF + CASE 1 : ascii search + CASE 2 : hex search + CASE 3 : dez search + CASE 4 : LEAVE search menue + CASE 5 : set ctrl g + END SELECT ; + display info line ; + fehler behandeln . + +ascii search : + cursor (command line x pos + 1, command line y pos) ; + put ("Suchtext :") ; getline (t) ; + cursor (command line x pos + 1, command line y pos) ; + put ("suchen nach """+ t +""" von Block :") ; + x get (s) ; + cursor (command line x pos + 1, command line y pos) ; + put ("suchen nach """+ t +""" von Block") ; + put (s) ; put ("bis Block :") ; x get (e) ; + search (t, s, e, fb, fp) ; + out (""13"") ; + IF fp > 0 + THEN put (cl eol +"Gefunden auf Block") ; put (fb) ; + put (", Position") ; put (fp) ; + read block (block, fb) ; + IF fp < 256 + THEN show first (block) + ELSE show second (block) + END IF ; + block shown := true ; + st pos := (fp MOD 256) - 1 ; + block nummer := fb ; + ELSE put ("Nicht gefunden !!"); + FI . + +hex search : + cursor (command line x pos + 1, command line y pos) ; + put ("Suchhex :") ; getline (t) ; + cursor (command line x pos + 1, command line y pos) ; + put ("suchen nach """+ t +""" von Block :") ; + x get (s) ; + cursor (command line x pos + 1, command line y pos) ; + put ("suchen nach """+ t +""" von Block") ; + put (s) ; put ("bis Block :") ; x get (e) ; + change all (t, " ", "") ; + TEXT VAR such hex := "" ; + i := 1 ; + REPEAT + such hex CAT code (hint (subtext (t, i, i + 1))) ; + i INCR 2 + UNTIL i >= length (t) END REPEAT ; + search (such hex, s, e, fb, fp) ; + out (""13"") ; + IF fp > 0 + THEN put (cl eol +"Gefunden auf Block") ; put (fb) ; + put (", Position") ; put (fp) ; + read block (block, fb) ; + IF fp < 256 + THEN show first (block) + ELSE show second (block) + END IF ; + block shown := true ; + st pos := (fp MOD 256) - 1 ; + block nummer := fb ; + ELSE put ("Nicht gefunden !!"); + FI . + +dez search : + error stop ("gibt es noch nicht !") . +END PROCEDURE search menue ; + + +(********************** Block-Editor-Menue ****************************) + + +PROCEDURE edit block menue : + INT VAR command index ; + disable stop ; + REPEAT + fehler loeschen ; + show first three ints ; + menue monitor (editor info line, editor chars, command index) ; + SELECT command index OF + CASE 1 : out ("irst") ; + show first (block) ; + block shown := true + CASE 2 : out ("econd") ; + show second (block) ; + block shown := true + CASE 3 : out ("ump") ; + show first (block) ; block edit (block, stpos) ; + show second (block) ; block edit (block, stpos) ; + block shown := true ; + CASE 4 : IF NOT block shown + THEN IF first + THEN show first (block) + ELSE show second (block) + END IF ; + block shown := true + END IF ; + (* IF first AND stpos >= 256 + THEN show second (block) ; + block shown := true + ELIF NOT first AND stpos <= 256 + THEN show first (block) ; + block shown := true + END IF ; *) (* ??? *) + block edit (block, stpos) + CASE 5 : LEAVE edit block menue + CASE 6 : get and do one command ; block shown := false + CASE 7 : block editor menue help ; block shown := false + CASE 8 : set ctrl g + CASE 9 : INT VAR old st pos := st pos ; + out ("os auf Byte : ") ; + x get (st pos) ; + IF st pos < 0 OR st pos > 513 + THEN st pos := old st pos ; + error stop ("Zahl nicht ok") + END IF + END SELECT ; + fehler behandeln + UNTIL ctrl g END REPEAT . + +show first three ints : + cursor (1, 18) ; + put (""5"1.INT : ") ; + TEXT VAR h :: "" ; h HEX block (1) ; + INT VAR ih := block (1) ; + h CAT ("/ " + text (ih)) ; + put (h) ; + put (", 2.INT : ") ; + h := "" ; h HEX block (2) ; + ih := block (2) ; + h CAT ("/ " + text (ih)) ; + put (h) ; + put (", 3.INT : ") ; + h := "" ; h HEX block (3) ; + ih := block (3) ; + h CAT ("/ " + text (ih)) ; + put (h) . +END PROCEDURE edit block menue ; + + +(********************** Space-Menue ****************************) + + +PROCEDURE space menue : + disable stop ; + REPEAT + menue monitor (space info line, space chars, command index) ; + fehler loeschen ; + rewind ; + SELECT command index OF + CASE 1 : read one space + CASE 2 : bit map read + CASE 3 : write one space + CASE 4 : bit map write + CASE 5 : edit one space + CASE 6 : copy one space + CASE 7 : LEAVE space menue + CASE 8 : new edit + CASE 9 : get and do one command + CASE 10 : load one space + CASE 11 : space menue help + CASE 12 : set ctrl g + END SELECT ; + fehler behandeln ; + display info line ; + UNTIL ctrl g END REPEAT . + +load one space : + out ("aden aus Datei : ") ; + getline (dummy) ; + forget (ds) ; + ds := nilspace ; + ds := old (dummy) . + +read one space : + cursor (info line x pos, info line y pos) ; + out (space header info) ; + cursor (command line x pos + 2, command line y pos) ; + out ("ead ") ; + REPEAT + get char (dummy) + UNTIL pos ("shq"7"", dummy) > 0 END REPEAT ; + IF dummy = "s" + THEN out ("Space : ") ; read one s + ELIF dummy = "h" + THEN out ("Header : ") ; read one h + ELIF dummy = ""7"" + THEN set ctrl g + END IF . + +read one s : + x get (space nummer) ; + IF NOT is error + THEN seek space (space nummer) ; + first sp block := block number + 1 ; + forget (ds) ; + ds := nilspace ; + read space (ds) + END IF . + +read one h : + x get (header nummer) ; + space nummer := space nr (header nummer) ; + IF NOT is error + THEN seek space (space nummer) ; + first sp block := block number + 1 ; + forget (ds) ; + ds := nilspace ; + read space (ds) + END IF . + +bit map read : + out ("ead Space ab Block : ") ; + x get (s) ; + cursor (command line x pos + 1, command line y pos) ; + out ("Read Space ab Block "+ text (s) +" Max. Bloecke : ") ; + x get (e) ; + seek block (s) ; + IF e = 0 + THEN e := 32000 + END IF ; + forget (ds) ; + ds := nilspace ; + IF yes ("bei Lesefehlern abbrechen") + THEN read space (ds, e, true) + ELSE read space (ds, e, false) + END IF . + +write one space : + out ("rite") ; + IF yes ("write auf Space "+ text (space nummer)) + THEN seek space (space nummer) ; + write space (ds) + ELIF yes ("write auf einen anderen Space") + THEN out (" auf Space : ") ; + x get (space nummer) ; + IF NOT is error + THEN seek space (space nummer) ; + write space (ds) + END IF + END IF . + +bit map write : + out ("rite Space ab Block : ") ; + x get (s) ; + seek block (s) ; + write space (ds) . + +edit one space : + IF type (ds) = file type 16 + THEN change to 17 ; + f := sequential file (modify, ds) ; + edit (f, 1, 1, x size - 2, 16) ; + block shown := false + ELIF type (ds) = file type + THEN f := sequential file (modify, ds) ; + edit (f, 1, 1, x size - 2, 16) ; + block shown := false + ELIF ds pages (ds) = 1 CAND type (ds) = 0 + THEN edit header ; + block shown := false + END IF . + +change to 17 : + TEXT VAR t := "" ; + REPEAT + t CAT "­" + UNTIL NOT exists (t) END REPEAT ; + copy (ds, t) ; + reorganize (t) ; + forget (ds) ; + ds := nilspace ; + ds := old (t) ; + forget (t, quiet) . + +copy one space : + put ("ave in Datei : ") ; + getline (t) ; + copy (ds, t) . + +edit header : + bound header := ds ; + cursor (1, 23) ; + out (cl eol +"Header-Editor : ") ; + IF is start header (bound header) + THEN out ("Header ist ein Archiv-Startheader.") + ELIF is file header (bound header) + THEN out ("Header ist ein File-Header.") + ELIF is end header (bound header) + THEN out ("Header ist ein Archiv-Endheader.") + ELSE out ("Header ist unbekannt (Headertype = "+ text (type (bound header)) +").") + END IF ; + header edit (bound header, "Headernummer : "+ text (header nr) + " ") . + +new edit : + out (left +"new edit ") ; + block shown := false ; + IF yes ("Neuen Headerspace erstellen") + THEN create new header + ELSE create new file + END IF . + +create new header : + forget (ds) ; + ds := nilspace ; + bound header := ds ; + bound header := nil header ; + cursor (1, 23) ; + out (cl eol +"Header-Editor : ") ; + put ("Neuen Header erstellen") ; + header edit (bound header, "Neuen Header erstellen") . + +create new file : + forget (ds) ; + ds := nilspace ; + f := sequential file (modify, ds) ; + edit (f, 1, 1, x size - 2, 16) . +END PROCEDURE space menue ; + + +(********************** Configurator-Menu ****************************) + + +PROCEDURE configurator menue : + disable stop ; + REPEAT + display conf info ; + menue monitor (conf info line, conf chars, command index) ; + fehler loeschen ; + SELECT command index OF + CASE 1 : put ("hannel :") ; x get (archive channel) ; + CASE 2 : put (left +"disktype :") ; x get (disk type) ; + CASE 3 : disk info + CASE 4 : get and do one command + CASE 5 : LEAVE configurator menue + CASE 6 : conf menue help + CASE 7 : set ctrl g + END SELECT ; + fehler behandeln ; + display info line ; + UNTIL ctrl g END REPEAT . + +display conf info : + cursor (1, 19) ; + put (cl eol +"I/O Channel :") ; put (archive channel) ; put (",") ; + put ("Disktype :") ; put (disk type) ; put (",") ; + put ("Operatorchannel :") ; put (channel) ; + cursor (1, 18) ; + put ("Zeit :") ; put (time of day) ; put (", Datum :") ; put (date) ; + INT VAR x size, x used ; + storage (x size, x used) ; + put (",") ; put (x used) ; put ("K von") ; + put (int (real (x size + 24) * 64.0 / 63.0)) ; + put ("K sind belegt !") . + +disk info : + INT VAR size, io, error ; + io control (archive channel, io, size, error) ; + out (home + 16 * (cl eol + down)) ; + out (home + down) ; + putline ("Diskinfo :") ; + putline (first mon line) ; + put ("Disksize :") ; put (size) ; put ("Blocks,") ; + put (size DIV 2) ; put ("kB.") ; + line ; + put ("Disktype :") ; + IF size = ibm 720 format 5 + THEN putline ("5 1/4 Zoll, IBM-720 kB Format, 80 Tracks,") ; + putline (" double sided/double density, softsectored") + ELIF size = ibm 360 format 5 + THEN putline ("5 1/4 Zoll, IBM-360 kB Format, 40 Tracks,") ; + putline (" single sided/double density, softsectored") + ELIF size = pic 400 format 5 + THEN putline ("5 1/4 Zoll, PIC400 Format, 80 Tracks,") ; + putline (" double sided/double density, softsectored") + ELIF size = soft sd 8 + THEN putline ("8 Zoll, EUMEL-Format, 77 Tracks,") ; + putline (" single sided/double density, softsectored") + ELIF size = soft dd 8 + THEN putline ("8 Zoll, EUMEL-Format, 77 Tracks,") ; + putline (" double sided/double density, softsectored") + ELIF size = hard ss sd + THEN putline ("8 Zoll, EUMEL-Format, 32 Tracks,") ; + putline (" single sided/single density, hardsectored") + ELIF size = hard ds sd + THEN putline ("8 Zoll, EUMEL-Format, 32 Tracks,") ; + putline (" double sided/single density, hardsectored") + ELSE putline ("Unbekannter Disktype") ; line + END IF ; + putline (first mon line) . +END PROCEDURE configurator menue ; + + + +(********************** Header/Space Ops. ****************************) + + +INT PROCEDURE header nr : + IF space nummer = 0 + THEN 0 + ELSE (space nummer + 1) DIV 2 + END IF . +END PROCEDURE header nr ; + +INT PROCEDURE space nr (INT CONST header nummer) : + IF header nummer = 0 COR header nummer = 1 + THEN header nummer + ELSE header nummer * 2 - 1 + END IF +END PROCEDURE space nr ; + + +(********************** Archiv-Menue ****************************) + + +PROCEDURE archive menue : + archive (archive name) ; + disable stop ; + REPEAT + menue monitor (archiv info line, archiv chars, command index) ; + fehler loeschen ; + SELECT command index OF + CASE 1 : archive anmelden + CASE 2 : out ("elease (archive)") ; + release (archive) ; archivename := "" + CASE 3 : out ("ist (archive)") ; + list archive ; + block shown := false + CASE 4 : out ("etch (SOME archive, archive)") ; + fetch (SOME archive, archive) ; + block shown := false + CASE 5 : out ("ave (SOME all, archive)") ; + save (SOME all, archive) ; + block shown := false + CASE 6 : release (archive) ; + LEAVE archive menue + CASE 7 : get and do one command ; + block shown := false + CASE 8 : archiv menue help ; + block shown := false + CASE 9 : set ctrl g + END SELECT ; + fehler behandeln + UNTIL ctrl g END REPEAT . + +archive anmelden : + put ("rchivename : ") ; + getline (archivename) ; + archive (archivename) . + +list archive : + IF NOT (list file ok) COR no (""13"Alte Archiveliste zeigen") + THEN forget (af ds) ; + af ds := nilspace ; + af := sequential file (output, af ds) ; + list (af, archive) ; + list file ok := true + END IF ; + edit (af, 1, 1, xsize - 2, 16) . +END PROCEDURE archive menue ; + + +(********************** Urflop-Menue ****************************) + + +PROCEDURE urflop menue : + INT VAR s, e ; + disable stop ; + REPEAT + menue monitor (urflop info line, urflop chars, command index) ; + fehler loeschen ; + SELECT command index OF + CASE 1 : read + CASE 2 : x read + CASE 3 : write + CASE 4 : x write + CASE 5 : list task ; + block shown := false + CASE 6 : LEAVE urflop menue + CASE 7 : get and do one command ; + block shown := false + CASE 8 : urflop menue help ; + block shown := false + CASE 9 : set ctrl g + END SELECT ; + fehler behandeln + UNTIL ctrl g END REPEAT . + +list task : + forget (l ds) ; + l ds := nilspace ; + lf := sequential file (output, l ds) ; + list (lf) ; + edit (lf, 1, 1, xsize - 2, 16) . + +write : + out ("rite Datenraumname : ") ; + getline (t) ; + IF yes ("Urlader schreiben wie gelesen") + THEN urlader schreiben (t, eumel 0 start block, + -1) + ELIF yes ("Urlader für PIC 400 (Shard 6.xx) schreiben") + THEN urlader schreiben (t, eumel 0 start block, + eumel 0 end block pic) + ELIF yes ("Urlader für PIC 400 (Shard 7.xx, u. Bicos Masch.) schreiben") + THEN urlader schreiben (t, eumel 0 start block, + eumel 0 end block) + ELIF yes ("Urlader für PIC 400 (ab Shard 7.13 für EUMEL Ver. 1758) schreiben") + THEN urlader schreiben (t, eumel 0 start block, + eumel 0 end block 1758) + END IF . + +x write : + out ("rite Datenraumname : ") ; + getline (t) ; + cursor (command line x pos, command line y pos) ; + out (">Write Datenraum """+ t +""" von Block : ") ; + x get (s) ; + cursor (command line x pos, command line y pos) ; + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis : ") ; + x get (e) ; + cursor (command line x pos, command line y pos) ; + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e)) ; + IF yes ("mit Versatz") + THEN cursor (command line x pos, command line y pos) ; + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" Versatz : ") ; + x get (ver) ; + cursor (command line x pos, command line y pos) ; + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" Ver. "+ text (ver) + " --> ") ; + urlader schreiben (t, s, e, ver) + ELSE cursor (command line x pos, command line y pos) ; + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" --> ") ; + urlader schreiben (t, s, e) + END IF . + +read : + out ("ead Datenraumname : ") ; + getline (t) ; + IF yes ("Urlader für PIC 400 (Shard 6.xx) lesen") + THEN urlader lesen (t, eumel 0 start block, + eumel 0 end block pic) + ELIF yes ("Urlader für PIC 400 (Shard 7.xx, u. Bicos Masch.) lesen") + THEN urlader lesen (t, eumel 0 start block, + eumel 0 end block) + ELIF yes ("Urlader für PIC 400 (Shard 7.xx für EUMEL Ver. 1758) lesen") + THEN urlader lesen (t, eumel 0 start block, + eumel 0 end block 1758) + END IF . + +x read : + out ("ead Datenraumname : ") ; + getline (t) ; + cursor (command line x pos, command line y pos) ; + out (">Read Datenraum """+ t +""" von Block : ") ; + x get (s) ; + cursor (command line x pos, command line y pos) ; + out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis : ") ; + x get (e) ; + IF yes ("mit Versatz") + THEN cursor (command line x pos, command line y pos) ; + out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" Versatz : ") ; + x get (ver) ; + cursor (command line x pos, command line y pos) ; + out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" Ver. "+ text (ver) + " --> ") ; + urlader lesen (t, s, e, ver) + ELSE cursor (command line x pos, command line y pos) ; + out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" --> ") ; + urlader lesen (t, s, e) + END IF . +END PROCEDURE urflop menue ; + + +(********************** Disk - Monitor Call ****************************) + + +PROCEDURE central disk monitor process : + archive ("disk") ; + release (archive) ; + space nummer := -1 ; + block nummer := -1 ; + header nummer := -1 ; + first sp block := -1 ; + st pos := 0 ; + archive name := "" ; + list file ok := false ; + block shown := false ; + reset ctrl g ; + page ; + line (3) ; + putline ("D I S K - M O N I T O R") ; + putline ("=========================") ; + line ; + putline ("Autor : Ingo Siekmann") ; + putline ("Stand : "+ software stand) ; + putline (software version) ; + putline ("Bem. : "+ software bemerkung) ; + putline (" "+ software bemerkung1) ; + line ; + putline ("(c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert") ; + line ; + initialize if necessary ; + global menue ; + line ; + unblock (archive) ; + IF archive name <> "" CAND NOT ctrl g + THEN archive (archive name) + END IF . +END PROCEDURE central disk monitor process ; + + +(********************** Unterprogramme ****************************) + + +THESAURUS OPERATOR SOME (THESAURUS CONST thesaurus) : + DATASPACE VAR edit space :: nilspace ; + THESAURUS VAR result := empty thesaurus ; + FILE VAR file := sequential file (output, edit space) ; + file FILLBY thesaurus ; + modify (file) ; + edit (file, 1, 1, xsize - 2, 16) ; + input (file) ; + result FILLBY file ; + forget (edit space) ; + result . +END OPERATOR SOME ; + +THESAURUS OPERATOR SOME (TASK CONST dest task) : + SOME ALL dest task . +END OPERATOR SOME ; + +PROCEDURE display info line : + INT VAR x, y ; + get cursor (x, y) ; + cursor (1, 24) ; + put (cl eol +"Block : ") ; put (block nummer) ; + put (", Space : ") ; put (space nummer) ; + put (", First Sp Block : ") ; put (first sp block) ; + put (", Header : ") ; put (header nummer) ; + cursor (x, y) . +END PROCEDURE display info line ; + +PROCEDURE x get (INT VAR i) : + enable stop ; + get (dummy) ; + IF (dummy SUB length (dummy)) = hex marker + THEN i := hint (text (dummy, length (dummy) - 1)) + ELSE i := int (dummy) + END IF ; + IF NOT last conversion ok + THEN error stop ("Zahl ist nicht korrekt") + END IF . +END PROCEDURE x get ; + + +(********************** Urflop - Ops. ****************************) + + +PROCEDURE urlader lesen (TEXT CONST urname, INT CONST start, end) : + urlader lesen (urname, start, end, 0) . +END PROCEDURE urlader lesen ; + +PROCEDURE urlader schreiben (TEXT CONST urname, INT CONST start, end) : + urlader schreiben (urname, start, end, 0) . +END PROCEDURE urlader schreiben ; + +PROCEDURE urlader lesen auf seite (TEXT CONST urname, INT CONST start, end, + auf) : + urlader lesen (urname, start, end, auf - start) . +END PROCEDURE urlader lesen auf seite ; + +PROCEDURE urlader schreiben von seite (TEXT CONST urname, INT CONST start, + end, von) : + urlader schreiben (urname, start, end, von - start) . +END PROCEDURE urlader schreiben von seite ; + +PROCEDURE urlader lesen (TEXT CONST urname, INT CONST start, end, ver) : + IF exists (urname) + THEN error stop (""""+ urname +""" gibt es schon") + END IF ; + forget (uds) ; + uds := nilspace ; + reset block io ; + reset ctrl g ; + FOR block nr FROM start UPTO end REPEAT + continue (archive channel) ; + disable stop ; + block in (uds, block nr + ver, disk type, block nr, error) ; + continue (user channel) ; + enable stop ; + check archive error (error, true) ; + cout (block nr) ; + dummy := incharety ; + IF dummy = ""7"" + THEN set ctrl g + END IF + UNTIL dummy = esc COR ctrl g END REPEAT ; + IF NOT ctrl g + THEN copy (uds, urname) ; + END IF ; + forget (uds) . +END PROCEDURE urlader lesen ; + +PROCEDURE urlader schreiben (TEXT CONST urname, INT CONST start, end, ver) : + forget (uds) ; + uds := old (urname) ; + reset ctrl g ; + reset block io ; + block nr := start; + IF block nr = -1 + THEN block nr := next ds page (uds, block nr) + END IF ; + WHILE block nr <> -1 REPEAT + continue (archive channel) ; + disable stop ; + block out (uds, block nr + ver, disk type, block nr, error) ; + break (quiet); + continue (user channel) ; + enable stop ; + check archive error (error, false) ; + cout (block nr) ; + dummy := incharety ; + IF dummy = ""7"" + THEN set ctrl g + END IF ; + IF end = -1 COR start = -1 + THEN block nr := next ds page (uds, block nr) + ELIF block nr = end + THEN block nr := -1 + ELSE block nr INCR 1 + END IF + UNTIL dummy = esc COR ctrl g END REPEAT ; + forget (uds) . +END PROCEDURE urlader schreiben ; + + +(********************** Unterprogramme ****************************) + + +PROCEDURE reset block io : + user channel := channel ; + INT VAR i, s, e ; + io control (archive channel, i, s, e) ; + check archive error (e, true) . +END PROCEDURE reset block io ; + +PROCEDURE get and do one command : + initialize if necessary ; + cursor (1, 21) ; + out (cl eop) ; + get command ("gib ein EUMEL-Kommando : ", own command line) ; + do (own command line) . +END PROCEDURE get and do one command ; + +PROCEDURE io control (INT VAR io, size, error) : + ROW 256 INT VAR block ; + control (type mode, 0, 0, io) ; + control (size mode, 0, 0, size) ; + block in (block, std disk type, block 0, error) . +END PROCEDURE io control ; + +PROCEDURE io control (INT CONST io channel, INT VAR io, size, error) : + INT VAR op channel :: channel ; + continue (io channel) ; + io control (io, size, error) ; + break (quiet) ; + continue (op channel) . +END PROCEDURE io control ; + + +(********************** Menue - Help Ops ****************************) + + +PROCEDURE global menue help : + out (home + cl eop) ; + line ; + putline ("Help für das Global-Menue : ") ; + line ; + putline ("b --> Aufruf des Block-Menüs (direkter Block i/o)") ; + putline ("s --> Aufruf des Space-Menüs (direkter Space- und Header i/o)") ; + putline ("a --> Aufruf des Archiv-Menüs (normale Archivoperationen)") ; + putline ("u --> Aufruf des Urflop-Menüs (Urlader/Datenraum <-> Floppy)") ; + putline ("c --> Aufruf des Konfigurator-Menüs") ; + line ; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ; + line ; + putline ("q --> Verlassen des Diskettenmonitors (quit wie im Editor)") ; +END PROCEDURE global menue help ; + +PROCEDURE block menue help : + out (home + cl eop) ; + line ; + putline ("Help für das Block-Menü : ") ; + line ; + putline ("r --> Lesen eines Blockes (block in)") ; + putline ("n --> Lesen des nächsten Blockes") ; + putline ("w --> Schreiben eines Blockes (block out)") ; + line ; + putline ("s --> Suchen nach einem Text") ; + line ; + putline ("e --> Aufruf des Blockeditor-Menüs") ; + line ; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ; + line ; + putline ("q --> Verlassen des Block-Menüs (Rückkehr ins Global-Menü)") ; +END PROCEDURE block menue help ; + +PROCEDURE block editor menue help : + out (home + cl eop) ; + line ; + putline ("Help für das Blockeditor-Menü : ") ; + line ; + putline ("f --> Zeigen der ersten 256 Bytes des aktuellen Blockes") ; + putline ("s --> Zeigen der zweiten 256 Bytes des aktuellen Blockes") ; + line ; + putline ("e --> Editieren des aktullen Teilblockes") ; + putline ("d --> Editieren des ersten und zweiten Teilblockes") ; + line ; + putline ("p --> Position setzen, auf der der Editor beginnen soll.") ; + line ; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ; + line ; + putline ("q --> Verlassen des Blockeditor-Menüs (Rückkehr ins Block-Menü)") ; +END PROCEDURE block editor menue help ; + +PROCEDURE space menue help : + out (home + cl eop) ; + line ; + putline ("Help für das Space-Menü : ") ; + line ; + putline ("r --> Lesen eines Datenraums bzw. eines Headers") ; + putline ("R --> Lesen eines Datenraums ab Block x") ; + putline ("w --> Schreiben eines Datenraums bzw. eines Headers") ; + putline ("W --> Schreiben eines Datenraums ab Block x") ; + line ; + putline ("e --> Editieren des aktullen Datenraums (Datei o. Header)") ; + putline ("E --> Editieren einer neuen Datei oder eines Header") ; + line ; + putline ("s --> Kopieren des aktuellen Datenraums in eine benannten Datenraum") ; + putline ("l --> Kopieren eines benannten Datenraums in den aktuellen Datenraum") ; + line ; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ; + putline ("q --> Verlassen des Space-Menüs (Rückkehr ins Global-Menü)") ; +END PROCEDURE space menue help ; + +PROCEDURE archiv menue help : + out (home + cl eop) ; + line ; + putline ("Help für das Archiv-Menü : ") ; + line ; + putline ("a --> Archiv anmelden") ; + putline ("r --> Archiv abmelden") ; + line ; + putline ("f --> Einige Dateien vom Archiv in die Task laden") ; + putline ("s --> Einige Dateien der Task auf das Archiv schreiben") ; + putline ("l --> Dateiliste des Archives zeigen") ; + line ; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ; + line ; + putline ("q --> Verlassen des Archiv-Menüs (Rückkehr ins Global-Menü)") ; +END PROCEDURE archiv menue help ; + +PROCEDURE urflop menue help : + out (home + cl eop) ; + line ; + putline ("Help für das Urflop-Menü : ") ; + line ; + putline ("r --> Lesen der Blöcke 10 bis 62 in einen benannten Datenraum") ; + putline ("R --> Lesen der Blöcke x bis y in einen benannten Datenraum") ; + line ; + putline ("w --> Schreiben der Blöcke 10 bis 62 aus einem benannten Datenraum") ; + putline ("W --> Schreiben der Blöcke x bis y aus einem benannten Datenraum") ; + line ; + putline ("l --> Dateiliste der Task zeigen (list)") ; + line ; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ; + line ; + putline ("q --> Verlassen des Urflop-Menüs (Rückkehr ins Global-Menü)") ; +END PROCEDURE urflop menue help ; + +PROCEDURE conf menue help : + out (home + cl eop) ; + line ; + putline ("Help für das Configurator-Menü :") ; + line ; + putline ("c --> Einstellen des Kanals, auf dem der Block i/o abläuft") ; + putline ("t --> Einstellen des Diskettentypes (EUMEL, CPM etc)") ; + line ; + putline ("i --> Disketteninfo") ; + line ; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ; + line ; + putline ("q --> Verlassen des Archiv-Menüs (Rückkehr ins Global-Menü)") ; +END PROCEDURE conf menue help ; + +BOOL PROCEDURE is halt from terminal : + is error CAND error code = 1 +END PROCEDURE is halt from terminal ; + +PROCEDURE block in (TEXT VAR block, INT CONST block nr, disk type, + INT VAR error) : + initialize if necessary ; + block in (blkinds, heap page nr, disk type, block nr, error) ; + block := subtext (bound text, start pos, LENGTH bound text) ; +END PROCEDURE block in ; + +PROCEDURE initialize if necessary : + IF NOT initialized (this packet) + THEN forget (blkinds) ; + blkinds := nilspace ; + bound text := blkinds ; + bound text := (start pos + 511) * " " ; + own command line := "" ; + archive channel := std archive channel ; + disk type := std disk type + END IF . +END PROCEDURE initialize if necessary ; + +BOOL PROCEDURE yes (TEXT CONST msg) : + get cursor (cx, cy) ; + cursor (command line x pos + 1, command line y pos + 1) ; + result := NOT no (msg) ; + cursor (cx, cy) ; + result . +END PROCEDURE yes ; +(* +INT OPERATOR $ (TEXT CONST hex) : + INT VAR laenge := length (hex), stelle, ziffer, ergebnis := 0 ; + FOR stelle FROM laenge DOWNTO 1 REPEAT + ziffer := pos ("0123456789ABCDEF", hex SUB stelle) - 1 ; + IF ziffer < 0 + THEN error stop ("Ist keine Hexzahl") + END IF ; + ergebnis INCR ziffer * 16 ** (laenge - stelle) + END REPEAT ; + ergebnis . +END OPERATOR $ ; +*) +PROCEDURE search (TEXT CONST st, INT CONST start block, end block, + INT VAR fbnr, fpos) : + enable stop ; + INT CONST l := LENGTH st - 1 ; + reset ctrl g ; + reset block io ; + FOR fbnr FROM start block UPTO end block REPEAT + cout (fbnr) ; + continue (archive channel) ; + block in (stb1, fbnr, disk type, error) ; + IF error = 0 + THEN block in (stb2, fbnr + 1, disk type, error) + END IF ; + break (quiet) ; + continue (user channel) ; + check archive error (error, true) ; + stb1 CAT text (stb2, l) ; + UNTIL pos (stb1, st) > 0 COR incharety = ""27"" END REPEAT ; + fpos := pos (stb1, st) +END PROCEDURE search ; + +END PACKET byte operations and disk monitor version 35 multi ; + diff --git a/app/diskettenmonitor/3.5/src/disk cmd 3.5.quelle b/app/diskettenmonitor/3.5/src/disk cmd 3.5.quelle new file mode 100644 index 0000000..68de7f5 --- /dev/null +++ b/app/diskettenmonitor/3.5/src/disk cmd 3.5.quelle @@ -0,0 +1,36 @@ + +PACKET disk cmd + +(************************************************************************) +(* *) +(* Disk - Menuecall Version 3.5 *) +(* *) +(* *) +(* Autor : Ingo Siekmann *) +(* Stand : Sonntag, den 16.11.1986 *) +(* *) +(* Lauffähig ab EUMEL Version 1.7.3 /M und insertiertem *) +(* Diskmonitor ab Version 3.4 *) +(* *) +(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert *) +(* *) +(************************************************************************) + + DEFINES disk , + disk monitor : + + + +lernsequenz auf taste legen ("d", "disk"13"") ; + + +PROCEDURE disk : + central disk monitor process . +END PROCEDURE disk ; + +PROCEDURE disk monitor : + central disk monitor process . +END PROCEDURE disk monitor ; + +END PACKET disk cmd ; + diff --git a/app/diskettenmonitor/3.5/src/m.rename archive^2.c b/app/diskettenmonitor/3.5/src/m.rename archive^2.c new file mode 100644 index 0000000..445fba5 --- /dev/null +++ b/app/diskettenmonitor/3.5/src/m.rename archive^2.c @@ -0,0 +1,3 @@ +PACKETrenamearchivecmdDEFINESrenamearchive:DATASPACE VARds:=nilspace;forget(ds);LET HEADER = STRUCT(TEXTname,date,INTtype,TEXTpass);BOUND HEADER VARheader;INT VARopc;PROCrenamearchive(TEXT CONSTnewname):archive(newname);release(archive);opc:=channel;forget(ds);ds:=nilspace;continue(31);disablestop;rewind;read(ds);break(quiet);enablestop;continue(opc);header:=ds;IFyes("archiv """+header.name+""" in """+newname+""" umbenennen")THENheader.name:=newname;continue(31);disablestop;rewind;write(ds);brea +k(quiet);enablestop;continue(opc);archive(newname)FI;forget(ds).ENDPROCrenamearchive;ENDPACKETrenamearchivecmd; + diff --git a/app/diskettenmonitor/3.5/src/read heap b/app/diskettenmonitor/3.5/src/read heap new file mode 100644 index 0000000..533e78c --- /dev/null +++ b/app/diskettenmonitor/3.5/src/read heap @@ -0,0 +1,107 @@ +DATASPACE VARd:=nilspace; forget(d); +BOUND TEXT VAR t; +INT CONST c := channel; +LET a = 31; +INT VAR block, anfang, ende, weiter; +disablestop; +exec; +forget(d); +break (quiet); +continue (c); + +PROC blockin : + block INCR 1; + INT VAR error; + replace (t, anfang, subtext (t, weiter)); + blockin (d, 3, 0, block, error); + IF error <> 0 THEN + errorstop ("Fehlercode "+text (error)+" auf Block "+text(block)) + FI; +END PROC blockin; + +PROC exec : +enable stop; +TEXT VAR zeile := "datei"; +editget (zeile); +IF exists (zeile) THEN forget (zeile) FI; +FILE VAR f := sequential file (output, new (zeile)); +forget (d); d := nilspace; +t := d; +t := ""; +REP + t CAT ""255""; + anfang := LENGTH t; +UNTIL dspages (d) = 2 PER; +REP + ende := LENGTH t; + t CAT ""255""; +UNTIL dspages (d) > 2 PER; +weiter := LENGTH t; +t := subtext (t, 1, ende); +t CAT subtext (t, anfang); +put (anfang); put (ende); put (weiter); put (LENGTH t); +put (weiter - anfang); put (LENGTH t - ende); line; +continue (a); +control (5, 0, 0, block); +block := -1; +blockin; +block := 406; +blockin; (* 407 lesen (ans ende) *) +replace (t, LENGTH t DIV 2, 12352); +INT VAR p := LENGTH t - 1, o; +(* +INT VAR p := pos (t, ""255"", weiter), o; +IF p <> 0 THEN p := pos (t, ""0"", ""254"", p); +FI; +*) +zeile := ""; +REP + naechsten block verarbeiten; + blockin; + p DECR weiter; + p INCR anfang; +UNTIL block > 1170 PER; +errorstop ("kein ende gefunden") . + +naechsten block verarbeiten : + REP + IF p < anfang COR p MOD 2 = 0 THEN + errorstop ("Fehler bei "+text(block)+", "+text (p - anfang)); + FI; + IF p > ende THEN LEAVE naechsten block verarbeiten FI; + continue (c); + put (block - 1); + put (p -anfang); + INT VAR l := t ISUB p DIV 2 + 1; + put (l); + IF l <= 0 THEN (* continue (c); + put (block); put (p - anfang); put (l); *) LEAVE exec + FI; + put (""); + continue (a); + p INCR 2; + IF p + l - 1 > LENGTH t THEN + l INCR LENGTH zeile; + zeile CAT subtext (t, p); + l DECR LENGTH zeile; + replace (t, LENGTH t DIV 2, l); + p := LENGTH t - 1; + ELSE + o := LENGTH zeile; + zeile CAT subtext (t, p, p + l - 1); + p INCR l; + l INCR o; + IF LENGTH zeile <> l THEN + errorstop ("Laengenfehler bei "+text(block)+", "+text (p - anfang) + +", "+text(LENGTH zeile)); + FI; + WHILE (zeile SUB l) = ""255"" REP l DECR 1 PER; + zeile := subtext (zeile, 1, l); + putline (f, zeile); + zeile := ""; + FI; + PER . + +END PROC exec; + + diff --git a/app/diskettenmonitor/3.7/source-disk b/app/diskettenmonitor/3.7/source-disk new file mode 100644 index 0000000..d79c6a7 --- /dev/null +++ b/app/diskettenmonitor/3.7/source-disk @@ -0,0 +1 @@ +debug/diskettenmonitor-3.7_1990-04-28.img diff --git a/app/diskettenmonitor/3.7/src/PAC digit conversion b/app/diskettenmonitor/3.7/src/PAC digit conversion new file mode 100644 index 0000000..034eccf --- /dev/null +++ b/app/diskettenmonitor/3.7/src/PAC digit conversion @@ -0,0 +1,93 @@ +PACKET digit conversion DEFINES bin, + dec, + hex : + +{ Rechnet Dezimalzahlen in Hexadezimalzahlen um und umgekehrt, + sowie Dezimalzahlen in Binärzahlen. + + Autor Version Datum + Christian Lehmann 2 07.09.90 } + +LET hex letters = "123456789abcdef"; + +TEXT CONST empty binary digit := 16 * "0", + empty hex digit := "0000"; + +ROW 4 INT CONST sedecimal powers := ROW 4 INT : (1, 16, 256, 4096); +ROW 16 INT CONST binary powers := ROW 16 INT : + ( 1, 2, 4, 8, 16, 32, 64, 128, + 256, 512, 1024, 2048, 4096, 8192, 16384, -32767-1); + +INT PROC dec (TEXT CONST hex text): + INT VAR stellen := LENGTH hex text; + IF stellen > 4 COR hex text > "7fff" + THEN errorstop ("Zahl zu groß") + FI; + INT VAR dec result := 0, stelle, hex digit; + TEXT VAR hex letter; + FOR stelle FROM 1 UPTO stellen REP + hex letter := hex text SUB (stellen - stelle + 1); + hex digit := pos (hex letters, hex letter); + IF hex digit <> 0 + THEN dec result INCR hex digit * sedecimal powers [stelle] + ELIF hex letter <> "0" + THEN errorstop ("Hexadezimalzahl fehlerhaft") + FI + PER; + dec result +END PROC dec; +{ kann nicht durch `replace' zu Beginn verkleinert werden } + +TEXT PROC hex (INT CONST decimal int) : + INT VAR nibble no, nibble bit no, bit no := 16, hex digit; + TEXT VAR hex result := empty hex digit; + FOR nibble no FROM 4 DOWNTO 1 REP + hex digit := 0; + FOR nibble bit no FROM 4 DOWNTO 1 REP + IF (decimal int AND binary powers [bit no]) = binary powers [bit no] + THEN hex digit INCR binary powers [nibble bit no] + FI; + bit no DECR 1 + PER; + IF hex digit <> 0 + THEN replace (hex result, 5 - nibble no, (hex letters SUB hex digit)) + FI + PER; + hex result +END PROC hex; + +TEXT PROC bin (INT CONST dez) : + TEXT VAR bin result := empty binary digit; + INT VAR bit no; + FOR bit no FROM 16 DOWNTO 1 REP + IF (dez AND binary powers [bit no]) = binary powers [bit no] + THEN replace (bin result, 17 - bit no, "1") + FI + PER; + bin result +END PROC bin; + +END PACKET digit conversion; + +(* Test *) +(* + +INT VAR x, y; +TEXT VAR z; +page; +putline ("Dezimalzahl oder Hexadezimalzahl (mit Kleinbuchstaben und `h' am Schluß)"); +putline ("Abbruch durch `0'"); +REP + line; + get cursor (x, y); + put ("Zahl:"); + get (z); + cursor (x + 14, y); + put (":"); + IF (z SUB LENGTH z) = "h" + THEN put (dec (subtext (z, 1, LENGTH z - 1))) + ELSE put (hex (z)) + FI +UNTIL z = "0" PER +*) + diff --git a/app/diskettenmonitor/3.7/src/basic menu handling 3.6.quelle b/app/diskettenmonitor/3.7/src/basic menu handling 3.6.quelle new file mode 100644 index 0000000..6a02811 --- /dev/null +++ b/app/diskettenmonitor/3.7/src/basic menu handling 3.6.quelle @@ -0,0 +1,53 @@ + +PACKET basic menu handling + +(************************************************************************) +(* *) +(* Basic Menu Handling Version 1.0 *) +(* *) +(* *) +(* Autor : Ingo Siekmann *) +(* Stand : Donnerstag, den 12. Juni 1986 *) +(* *) +(* Lauffähig ab EUMEL Version 1.7.3 *) +(* *) +(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert *) +(* *) +(************************************************************************) + + DEFINES menue monitor : + + + +LET info line x pos = 1 , + info line y pos = 20 , + command line x pos = 1 , + command line y pos = 21 ; + +LET first mon line = "----------------------------------------------------------------------------" , + command line = ">__________________________________________________________________________<" ; + + +TEXT VAR char ; + +PROCEDURE menue monitor (TEXT CONST info line, chars, (* I. Siekmann *) + INT VAR command index) : (* 12.06.1986 *) + enable stop ; + cursor (1, 17) ; + command index := 0 ; + out (first mon line) ; + cursor (info line x pos, info line y pos) ; + out (info line) ; + cursor (command line x pos, command line y pos) ; + out (command line) ; + cursor (command line x pos + 1, command line y pos) ; + REPEAT + (* inchar (char) ; *) + get char (char) ; + command index := pos (chars, char) + UNTIL command index > 0 COR is error END REPEAT ; + out (char) . +END PROCEDURE menue monitor ; + +ENDPACKET basic menu handling ; + diff --git a/app/diskettenmonitor/3.7/src/disk 3.7-m.quelle b/app/diskettenmonitor/3.7/src/disk 3.7-m.quelle new file mode 100644 index 0000000..b4471a6 --- /dev/null +++ b/app/diskettenmonitor/3.7/src/disk 3.7-m.quelle @@ -0,0 +1,2218 @@ +(************************************************************************) +(* *) +(* DDDD IIIII SSSS K K 3333 666 / M M *) +(* D D I S K K 3 6 / MM MM *) +(* D D I SSS KK 333 6666 / M M M M *) +(* D D I S K K 3 6 6 / M M M *) +(* DDDD IIIII SSSS K K 3333 O 666 / M M *) +(* *) +(************************************************************************) +(* *) +(* Diskettenmonitor Version 3.6 Multi *) +(* *) +(* Autor : Ingo Siekmann unter freundlicher Mithilfe von Stefan Haase, *) +(* Nils Ehnert, APu und Frank Lenniger *) +(* *) +(* Stand : Montag, den 09. Februar 1987 *) +(* *) +(* Lauffähig ab EUMEL Version 1.8.1 /M in Systemtasks *) +(* *) +(* *) +(* (c) 1987 by ULES c/o Ingo Siekmann & Nils Ehnert *) +(* *) +(************************************************************************) +(* *) +(* Softwareaenderungen und Softwareneuerungen : *) +(* *) +(* 03.01.1986 3.3.2.8 : Block- Asciieditor ueberarbeitet, neuer Header- *) +(* editor (V1.3), Helpfunktion, gib kommando, *) +(* Fileaccess auch fuer 16-Files *) +(* 15.01.1986 3.3.2.9 : Vorbereitung fuer den Suchmodus in 3.3.3.0, *) +(* Notbremse ins globalmenue mit ctrl g, byte ops *) +(* ueberarbeitet, pic dienste in vorbereitung *) +(* Headereditor (V1.4) *) +(* 16.01.1986 : halt from terminal --> ctrl g := true *) +(* 16.01.1886 3.3.3.0 : Suchmodus ins Blockmenue (TEST), Blockeditor *) +(* Byteposops fuer Suchmodus einbauen *) +(* 21.01.1986 : inchar in get char umgewandelt *) +(* 28.01.1986 : lernmodus eingebaut (???) *) +(* 31.01.1986 3.3.3.1 : Suchmodus und Lernmodus wieder ausgebaut *) +(* beim Datenraumschreiben nur belegte Bloecke raus*) +(* 14.02.1986 3.3.3.2 : Fehler Überarbeitet *) +(* 20.02.1986 : Suchmodus vorbereitet (2. Versuch ?) *) +(* 06.03.1986 3.3.3.3 : Suchmodus eingebaut (Test) *) +(* 10.03.1986 : Softwaretrennung zwischen Single und Multi *) +(* 12.03.1986 : read next block cmd ins blockmenu eingebaut *) +(* Fehler überarbeitet, Vorbereitung für besseren *) +(* Suchmodus *) +(* 17.03.1986 3.3.3.4 : configurator menü -> einstellen von disk type, *) +(* i/o channel, disk info. TEXT/HEX search. *) +(* 02.04.1986 : urflop ops mit versatzops *) +(* 08.04.1986 : urflop menue mit versatz *) +(* 30.04.1986 3.3.3.5 : Fehler ueberarbeitet *) +(* 30.04.1986 3.3.3.6 : lab read/write ins space menue *) +(* 05.05.1986 3.3.3.7 : hex / dez - get für alles, block editor über- *) +(* arbeitet, fehler überarbeitet. auslieferung für *) +(* HRZ ! *) +(* 06.06.1986 3.4 : Fehler im search und menue monitor behoben *) +(* 12.06.1986 : Fehler im Space/Header-Menue behoben *) +(* 16.11.1986 3.5 : Fehler im Urflopmenue behoben *) +(* 09.02.1987 3.6 : Doktormenu eingebaut *) +(* 28.04.90 3.7 : Optimierungen CL *) +(* *) +(* A C H T U N G : Keine weitere Entwicklung von Version 3 !! *) +(* *) +(* Bielefeld, den 08.02.1987 ULES *) +(* *) +(* Ingo Siekmann *) +(* *) +(* Version disk 3.6/s teilt nur mit, daß es sie nicht gibt ! *) +(************************************************************************) + +PACKET byte operations and disk monitor version 36 multi + + DEFINES WORD, { BYTE in WORD umbenannt cl 8.2.89 } + CATHEX, { HEX in CATHEX } + CATASCII, { ASCII in CATASCII umbenannt cl 28.04.90 } + DECRL, + DECRH, + INCRL, + INCRH, + :=, + -, + +, + $, + hint, + zu byte, + lower byte, + higher byte, + set lower byte, + set higher byte, + nil byte, + put, + get, + + block in, + block out, + + HEADER, + header, + nil header, + is start header, + is end header, + is file header, + name, + date, + type, + pass, + header edit, + + show first, + show second, + block edit, + ascii edit, + + set ctrl g, + reset ctrl g, + + set channel, + read block, + write block, + seek space, + seek block, + read space, + write space, + check archive error, + + space nr, + header nr, + + urlader lesen, + urlader schreiben, + urlader lesen auf seite, + urlader schreiben von seite, + + heap lesen, + search, + io control, + + central disk monitor process : + + +LET start of volume = 1000, + end of volume = 1, + file header = 3; + +LET global info line = "** GLOBAL : b / s / a / c / u / d / q # stop --> ctrl g, help --> ""?"" **", + block info line = "** BLOCK : r / w / e / k / s / n / q # stop --> ctrl g, help --> ""?"" **", + search info line = "** SEARCH : a -> ascii / h -> hex / q -> quit / ctrl g -> stop **", + editor info line = "** EDITOR : f / s / d / e / k / p / q # stop --> ctrl g, help --> ""?"" **", + space info line = "** SPACE : r, R, w, W, e, E, s, l, k, q # stop --> ctrl g, help --> ""?"" **", + space header info = "** SPACE / HEADER : s -> read space / h -> read header / q -> quit **", + archiv info line = "** ARCHIV : a / r / l / f / s / k / q # stop --> ctrl g, help --> ""?"" **", + urflop info line = "** URFLOP : r / R / w / W / l / k / q # stop --> ctrl g, help --> ""?"" **", + conf info line = "** CONFIGURATOR : c / t / i / k / q # stop --> ctrl g, help --> ""?"" **", + doctor info line = "** DOCTOR : a / e / r / h / k / q # stop --> ctrl g, help --> ""?"" **", + first mon line = "̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊"; + +LET global chars = "bsacuqk?d"7"", + block chars = "rweqksn?"7"", + search chars = "ahdq"7"", + editor chars = "fsdeqk?"7"p", + space chars = "rRwWesqEkl?"7"", + archiv chars = "arlfsqk?"7"", + urflop chars = "rRwWlqk?"7"", + conf chars = "ctikq?"7"", + doctor chars = "aerhkq?"7""; + +LET info line x pos = 1, + info line y pos = 20, + command line x pos = 1, + command line y pos = 21, + error line x pos = 1, + error line y pos = 22, + + file type = 1003, + file type 16 = 1002, + + block 0 = 0, + + std archive channel = 31, + + type mode = 1, + size mode = 5, + std disk type = 0; + +LET software stand = "Montag, den 09.02.1987", + software version = "Version 3.6 /Multi", + software bemerkung = "Doktormenue eingebaut,", + software bemerkung1 = "*** Ende der Entwicklung der Version 3 ! ***"; + +LET eumel 0 start block = 10, + eumel 0 end block = 65, + eumel 0 end block pic = 62, + eumel 0 end block 1758 = 67, + +(* pic char table start block = 63, + pic char table end block = 65, + pic shard start block = 0, + pic shard end block = 79, *) + + read write impossible error = 101, + read error = 102, + write error = 103, + block number error = 104, + undef archive error = 105; + +LET ibm 720 format 5 = 1440, + ibm 360 format 5 = 720, + pic 400 format 5 = 1600, + soft sd 8 = 1232, + soft dd 8 = 2464, + hard ss sd = 616, + hard ds sd = 1232; + +LET home = ""1"", + left = ""8"", + right = ""2"", + up = ""3"", + down = ""10"", + return = ""13"", + tab = ""9"", + esc = ""27"", + cl eol = ""5"", + cl eop = ""4""; + +LET hex chars = "0123456789ABCDEF", + hex marker = "h"; + +LET start pos = 479, + heap page nr = 2; + +TYPE HEADER = STRUCT (TEXT name, date, INT type, TEXT pass); +TYPE WORD = STRUCT (INT lower byte, higher byte); + +HEADER CONST nil header := HEADER : ("", "", 0, ""); +BOUND HEADER VAR bound header; +BOUND TEXT VAR bound text; + +INITFLAG VAR this packet := false; + +ROW 256 WORD VAR block; +ROW 32 TEXT VAR text block; +ROW 256 INT VAR block int; + +DATASPACE VAR ds :: nilspace; forget (ds); +DATASPACE VAR afds :: nilspace; forget (afds); +DATASPACE VAR lds :: nilspace; forget (lds); +DATASPACE VAR uds :: nilspace; forget (uds); +DATASPACE VAR blkinds :: nilspace; forget (blkinds); + +FILE VAR af, f, lf; + +INT VAR command index, block nummer, space nummer, x, y, i, i1, xx, yy, + archive channel := std archive channel, user channel, error answer, + header nummer, first sp block, integer, error, block nr, + stpos, s, e, fb, fp, cx, cy, disk type := std disk type, ver, last file; + +TEXT VAR tc, t, archive name, dummy, + stb1, stb2, own command line; + +REAL VAR po; + +BOOL VAR first := true, ende, list file ok, block shown, ctrl g, result; + + +(********************** PACKET bytes ok : ****************************) + +WORD PROC nil byte : + WORD : (0,0) +END PROC nil byte; + +OP := (WORD VAR byte, WORD CONST old byte) : + byte.lower byte := old byte.lower byte; + byte.higher byte := old byte.higher byte. +END OP :=; + +OP := (WORD VAR byte, INT CONST int byte) : + byte.lower byte := int byte MOD 256; + byte.higher byte := (int byte AND -256) DIV 256 AND 255. +END OP :=; + +OP := (ROW 256 WORD VAR byte, ROW 256 INT CONST int byte) : + INT VAR i; + FOR i FROM 1 UPTO 256 REP + byte [i] := int byte [i] + PER. +END OP :=; + +OP := (ROW 256 INT VAR int byte, ROW 256 WORD CONST byte) : + INT VAR i; + FOR i FROM 1 UPTO 256 REP + int byte [i] := byte [i] + PER. +END OP :=; + +WORD OP + (WORD VAR byte, INT CONST int byte) : + byte.lower byte := byte.lower byte + lower byte (int byte); + byte.higher byte := byte.higher byte + higher byte (int byte); + byte. +END OP +; + +WORD OP - (WORD VAR byte, INT CONST int byte) : + byte.lower byte := byte.lower byte - lower byte (int byte); + byte.higher byte := byte.higher byte - higher byte (int byte); + byte. +END OP -; + +OP := (INT VAR int byte, WORD CONST byte) : + IF byte.higher byte > 127 + THEN int byte := minus * 255 + minus + byte.lower byte + ELSE int byte := byte.higher byte * 256 + byte.lower byte + FI + +.minus : byte.higher byte - 256. +END OP :=; + +OP INCRL (WORD VAR byte, INT CONST lower) : + byte.lower byte INCR lower +END OP INCRL; + +OP INCRH (WORD VAR byte, INT CONST high) : + byte.higher byte INCR high +END OP INCRH; + +OP DECRL (WORD VAR byte, INT CONST lower) : + byte.higher byte DECR lower +END OP DECRL; + +OP DECRH (WORD VAR byte, INT CONST high) : + byte.higher byte DECR high +END OP DECRH; + +INT PROC lower byte (WORD CONST byte) : + byte.lower byte. +END PROC lower byte; + +INT PROC higher byte (WORD CONST byte) : + byte.higher byte. +END PROC higher byte; + +INT PROC lower byte (INT CONST int byte) : + int byte MOD 256. +END PROC lower byte; + +INT PROC higher byte (INT CONST int byte) : + (int byte AND -256) DIV 256 AND 255. +END PROC higher byte; + +PROC set lower byte (WORD VAR byte, INT CONST lower byte) : + byte.lower byte := lower byte +END PROC set lower byte; + +PROC set higher byte (WORD VAR byte, INT CONST higher byte) : + byte.higher byte := higher byte +END PROC set higher byte; + +OP CATHEX (TEXT VAR insert line, WORD CONST byte) : + insert line CAT (hex chars SUB (byte.lower byte DIV 16 + 1)); + insert line CAT (hex chars SUB (byte.lower byte MOD 16 + 1)); + insert line CAT " "; + insert line CAT (hex chars SUB (byte.higher byte DIV 16 + 1)); + insert line CAT (hex chars SUB (byte.higher byte MOD 16 + 1)); + insert line CAT " ". +END OP CATHEX; + +OP CATASCII (TEXT VAR insert line, WORD CONST byte) : + insert line CAT ascii (byte.lower byte ); + insert line CAT ascii (byte.higher byte). +END OP CATASCII; + +TEXT PROC ascii (INT CONST half byte) : +(*IF half byte > 31 AND half byte < 127 COR + half byte > 213 AND half byte < 219 COR + half byte = 251 8.2.89 cl *) + IF half byte > 18 CAND half byte < 255 + THEN code (half byte) + ELSE "." + FI. +END PROC ascii; + +PROC block in (ROW 256 WORD VAR block bytes, INT CONST type, block nr) : + ROW 256 INT VAR block; + reset block io; + block in (block, type, block nr, error answer); + block bytes := block; + check archive error (error answer, true). +END PROC block in; + +PROC block out (ROW 256 WORD CONST bytes, INT CONST disk type, block nr) : + ROW 256 INT VAR int bytes := bytes; + reset block io; + block out (int bytes, disk type, block nr, error answer); + check archive error (error answer, true). +END PROC block out; + +PROC put (WORD CONST byte) : + put ("LOW :"); + put (text (byte.lower byte)); + put ("HIGH :"); + put (text (byte.higher byte)) +END PROC put; + +PROC get (WORD VAR byte) : + get (integer); + byte := integer. +END PROC get; + +PROC zu byte (ROW 256 WORD VAR bytes, TEXT CONST byte kette, INT CONST stelle) : + INT VAR lower, higher; + lower := pos (hex chars, (byte kette SUB 1)) * 16 + + pos (hex chars, (byte kette SUB 2)) - 17; + higher:= pos (hex chars, (byte kette SUB 4)) * 16 + + pos (hex chars, (byte kette SUB 5)) - 17; + IF higher > 127 + THEN bytes [stelle] := minus * 255 + minus + lower + ELSE bytes [stelle] := higher * 256 + lower + FI. + +minus : higher - 256. +END PROC zu byte; + +WORD OP $ (TEXT CONST hex) : + TEXT VAR byte kette :: ""; + FOR i FROM 1 UPTO 4 REP + IF (hex SUB i) = "" + THEN byte kette CAT "0" + ELIF (hex SUB i) <> " " + THEN byte kette CAT (hex SUB i) + FI; + PER; + WORD VAR byte; + INT VAR lower, higher, i; + lower := pos (hex chars, (byte kette SUB 1)) * 16 + + pos (hex chars, (byte kette SUB 2)) - 17; + higher:= pos (hex chars, (byte kette SUB 3)) * 16 + + pos (hex chars, (byte kette SUB 4)) - 17; + IF higher > 127 + THEN byte := minus * 255 + minus + lower + ELSE byte := higher * 256 + lower + FI; + byte. + +minus : higher - 256. +END OP $; + +INT PROC hint (TEXT CONST he) : + INT VAR laenge :: length (he), + stelle, + ziffer, + ergebnis :: 0; + + TEXT VAR h :: he; + + FOR stelle FROM 65 UPTO 70 REP + change all (h, code (stelle + 32), code (stelle)) + PER; + + FOR stelle FROM laenge DOWNTO 1 REP + ziffer := pos ("0123456789ABCDEF", h SUB stelle) - 1; + IF ziffer < 0 + THEN errorstop ("Unerlaubtes Zeichen in Hexadezimalzahl") + FI; + ergebnis INCR ziffer * 16 ** (laenge - stelle) + PER; + ergebnis +END PROC hint; + + +(********************** PACKET header operations ***************************) + +OP := (HEADER VAR dest, HEADER CONST source) : + CONCR (dest) := CONCR (source). +END OP :=; + +HEADER PROC header (TEXT CONST name, date, INT CONST type, TEXT CONST pass) : + HEADER : (name, date, type, pass). +END PROC header; + +BOOL PROC is start header (HEADER CONST header) : + CONCR (header).type = start of volume. +END PROC is start header; + +BOOL PROC is end header (HEADER CONST header) : + CONCR (header).type = end of volume. +END PROC is end header; + +BOOL PROC is file header (HEADER CONST header) : + CONCR (header).type = file header. +END PROC is file header; + +PROC name (HEADER VAR header, TEXT CONST new name) : + CONCR (header).name := new name. +END PROC name; + +TEXT PROC name (HEADER CONST header) : + CONCR (header).name. +END PROC name; + +PROC date (HEADER VAR header, TEXT CONST new date) : + CONCR (header).date := new date. +END PROC date; + +TEXT PROC date (HEADER CONST header) : + CONCR (header).date. +END PROC date; + +PROC type (HEADER VAR header, INT CONST new type) : + CONCR (header).type := new type. +END PROC type; + +INT PROC type (HEADER CONST header) : + CONCR (header).type. +END PROC type; + +PROC pass (HEADER VAR header, TEXT CONST new pass) : + CONCR (header).pass := new pass. +END PROC pass; + +TEXT PROC pass (HEADER CONST header) : + CONCR (header).pass. +END PROC pass; + + +(********************** Header-Editor V1.4 ****************************) + +PROC header edit (HEADER VAR header, TEXT CONST msg) : + TEXT VAR head :: ""15"HEADER - EDITOR V1.4" + (25 - LENGTH msg) * "." + msg + + 5 * "." + " "14""; + disable stop; + REP + out (home); + out (16 * (cl eol + down)); + cursor (6, 6); + putline (head); + cursor (6, 7); + put (""15"TEXT name : "14""); + edit get (CONCR (header).name, max text length, 38); + IF is error + THEN clear error; + CONCR (header).name := ""; + cursor (6, 7); + put (""15"TEXT name : "14""); + edit get (CONCR (header).name, max text length, 38) + FI; + cursor (6, 8); + put (""15"TEXT date : "14""); + edit get (CONCR (header).date, max text length, 38); + IF is error + THEN clear error; + CONCR (header).date := ""; + cursor (6, 8); + put (""15"TEXT date : "14""); + edit get (CONCR (header).date, max text length, 38) + FI; + cursor (6, 9); + put (""15"INT type : "14""); + TEXT VAR d :: text (CONCR (header).type); + edit get (d, max text length, 38); + CONCR (header).type := int (d); + cursor (6, 10); + put (""15"TEXT pass : "14""); + edit get (CONCR (header).pass, max text length, 38); + IF is error + THEN clear error; + CONCR (header).pass := ""; + cursor (6, 10); + put (""15"TEXT pass : "14""); + edit get (CONCR (header).pass, max text length, 38) + FI; + cursor (6, 13); + UNTIL NOT no (""15"header ok. "14"") PER +END PROC header edit; + + +(********************** PACKET block editor ****************************) + +PROC show first (ROW 256 WORD CONST block) : + out (home); + po := 1.0; + first := true; + FOR i FROM 1 UPTO 16 REP + text block [i] := text ((i - 1) * 16, 4); + text block [i] CAT " � "; +(* get cursor (x, y); *) + FOR i1 FROM 1 UPTO 8 REP + text block [i] CATHEX block [(i-1) * 8 + i1] + PER; + text block [i] CAT " �"; + FOR i1 FROM 1 UPTO 8 REP + text block [i] CATASCII block [(i - 1) * 8 + i1] + PER; + text block [i] CAT "�"; +(* cursor (x, y); *) + putline (text block [i]) + PER. +END PROC show first; + +PROC show second (ROW 256 WORD CONST block) : + out (home); + po := 129.0; + first := false; + FOR i FROM 17 UPTO 32 REP + text block [i] := text ((i - 1) * 16, 4); + text block [i] CAT " � "; +(* get cursor (x,y); *) + FOR i1 FROM 1 UPTO 8 REP + text block [i] CATHEX block [(i - 1) * 8 + i1] + PER; + text block [i] CAT " �"; + FOR i1 FROM 1 UPTO 8 REP + text block [i] CATASCII block [(i - 1) * 8 + i1] + PER; + text block [i] CAT "�"; +(* cursor (x, y); *) + putline (text block [i]) + PER. +END PROC show second; + +PROC block edit (ROW 256 WORD VAR block, INT CONST st) : + IF st > 0 + THEN IF st > 255 + THEN push (255 * right) + ELSE push (st * right) + FI + FI; + BOOL VAR low :: TRUE; + edit info; + cursor (8, 1); +(* get cursor (x, y); *) + po := 1.0; + REP + get cursor (x, y); + cursor (x, y); + (* inchar (t); *) + get char (t); + IF (t = right OR t = " ") AND x < 53 + THEN cursor (x + 3, y); po INCR 0.5 + ELIF (t = right OR t = " ") AND x > 52 AND y < 16 + THEN cursor (8, y + 1); po INCR 0.5 + ELIF t = up AND y > 1 + THEN cursor (x, y - 1); po DECR 8.0 + ELIF t = left AND x > 8 + THEN cursor (x - 3, y); po DECR 0.5 + ELIF t = left AND x = 8 AND y <> 1 + THEN cursor (53, y - 1); po DECR 0.5 + ELIF t = down AND y < 16 + THEN cursor (x, y + 1); po INCR 8.0 + ELIF t = tab + THEN IF first + THEN show first (block) + ELSE show second (block) + FI; + ascii edit (block, first); + IF first + THEN show first (block) + ELSE show second (block) + FI; + IF t <> return + THEN edit info; + cursor (8, 1); + FI + ELIF t = ""7"" + THEN set ctrl g + FI; + get cursor (x, y); + cursor (x, y); + IF code (t) > 47 AND code (t) < 58 OR + code (t) > 96 AND code (t) < 103 + THEN IF code (t) > 96 CAND code (t) < 103 + THEN t := code (code (t) - 32) + FI; + out (left + "-" + 2 * right + "-" + 3 * left + t); + REP + (* inchar (tc); *) + get char (tc); + UNTIL code (tc) > 47 AND code (tc) < 58 OR + code (tc) > 96 AND code (tc) < 103 PER; + IF code (tc) > 96 CAND code (tc) < 103 + THEN tc := code (code (tc) - 32) + FI; + out (tc + " " + 4 * left + " "); + cursor (x, y); + t CAT tc; + INT VAR bp :: int (po); + IF po MOD real (bp) = 0.0 + THEN low := TRUE + ELSE low := FALSE + FI; + IF NOT first (* ONE : 17.06.85 *) + THEN bp INCR 128 + FI; + IF low + THEN set lower byte (block [bp], hint (t)) + ELSE set higher byte (block [bp], hint (t)) + FI; + FI; + info; + UNTIL t = return COR ctrl g PER; + IF first + THEN show first (block) + ELSE show second (block) + FI; + cursor (1, 17). + +info : + get cursor (x, y); + cursor (xx, yy); + IF po MOD real (int(po)) = 0.0 + THEN put ("LOW") + ELSE put ("HIGH") + FI; + cursor (x,y). + +edit info : + cursor (1, 23); + put (cl eol + "Block-Editor : Hexmodus,"); + IF first + THEN put ("First Block") + ELSE put ("Second Block") + FI; + put (","); + get cursor (xx, yy). +END PROC block edit; + +PROC ascii edit (ROW 256 WORD VAR block, BOOL CONST first) : + edit info; + cursor (59, 1); + x := 1; + y := 1; + po := 1.0; + REP + get char (t); + IF po < 1.0 AND first + THEN po := 1.0 + FI; + IF po < 129.0 AND NOT first + THEN po := 129.0 + FI; + IF po > 128.5 AND first + THEN po := 128.5 + FI; + IF po > 256.5 AND NOT first + THEN po := 256.5 + FI; + SELECT pos (""9""8""2""3""10""13""7"", t) OF + CASE 1, 6 : quit ascii edit + CASE 2 : IF x > 1 COR (x = 1 AND y > 1) + THEN x DECR 1; po DECR 0.5 + FI + CASE 3 : IF x < 16 COR (x = 16 AND y <> 16) + THEN x INCR 1; po INCR 0.5 + FI + CASE 4 : IF y > 1 + THEN y DECR 1; + po DECR 8.0 + FI + CASE 5 : IF y < 16 + THEN y INCR 1; + po INCR 8.0 + FI + CASE 7 : set ctrl g + OTHERWISE IF code (t) >= 32 AND code (t) <= 126 + THEN set char; push (""2"") + FI + END SELECT; + IF x < 1 AND y = 1 + THEN x := 1 + ELIF x < 1 AND y > 1 + THEN x := 16; + y DECR 1 + ELIF x > 16 AND y = 16 + THEN x := 16; + ELIF x > 16 AND y < 16 + THEN x := 1; + y INCR 1 + ELIF y < 1 + THEN y := 1 + ELIF y > 16 + THEN y := 16 + FI; + info; + UNTIL ctrl g PER. + +quit ascii edit : + x := 8; + y := 1; + cursor (x, y); + po := 1.0; + LEAVE ascii edit. + +set char : + out (t); + INT VAR bp :: int (po); + IF x MOD 2 = 0 + THEN set higher byte (block [bp], code (t)) + ELSE set lower byte (block [bp], code (t)) + FI. + +info : + cursor (xx, yy); + IF po MOD real (int (po)) = 0.0 + THEN put ("LOW") + ELSE put ("HIGH") + FI; + cursor (58 + x, y). + +edit info : + cursor (1, 23); + put (""5"Block-Editor : Asciimodus,"); + IF first + THEN put ("First Block") + ELSE put ("Second Block") + FI; + put (","); + get cursor (xx, yy). +END PROC ascii edit; + + +(********************** PACKET block i/o : ****************************) + +PROC set channel (INT CONST channel) : + archive channel := channel. +END PROC set channel; + +PROC read block (ROW 256 WORD VAR block byte, INT CONST block nummer) : + user channel := channel; + enable stop; + continue (archive channel); + disable stop; + block in (block int, disk type, block nummer, error answer); + IF is error + THEN clear error + FI; + break (quiet); + continue (user channel); + enable stop; + check archive error (error answer, true); + block byte := block int. +END PROC read block; + +PROC write block (ROW 256 WORD VAR block byte, INT CONST block nummer) : + user channel := channel; + enable stop; + block int := block byte; + continue (archive channel); + disable stop; + block out (block int, disk type, block nummer, error answer); + IF is error + THEN clear error + FI; + break (quiet); + continue (user channel); + enable stop; + check archive error (error answer, false). +END PROC write block; + +PROC read block (ROW 256 INT VAR block int, INT CONST block nummer) : + user channel := channel; + enable stop; + continue (archive channel); + disable stop; + block in (block int, disk type, block nummer, error answer); + IF is error + THEN clear error + FI; + break (quiet); + continue (user channel); + enable stop; + check archive error (error answer, true). +END PROC read block; + +PROC write block (ROW 256 INT VAR block int, INT CONST block nummer) : + user channel := channel; + enable stop; + continue (archive channel); + disable stop; + block out (block int, disk type, block nummer, error answer); + IF is error + THEN clear error + FI; + break (quiet); + continue (user channel); + enable stop; + check archive error (error answer, false). +END PROC write block; + + +(********************** PACKET space i/o : ****************************) + +PROC seek space (INT CONST space) : + user channel := channel; + enable stop; + rewind; + INT VAR i; + continue (archive channel); + disable stop; + FOR i FROM 1 UPTO space REP + skip dataspace + UNTIL is error PER; + break (quiet); + continue (user channel). +END PROC seek space; + +PROC seek block (INT CONST block nr) : + seek (block nr). +END PROC seek block; + +PROC read space (DATASPACE VAR ds) : + user channel := channel; + enable stop; + continue (archive channel); + disable stop; + read (ds); + break (quiet); + continue (user channel). +END PROC read space; + +PROC read space (DATASPACE VAR ds, INT VAR max pages, + BOOL CONST errors) : + user channel := channel; + enable stop; + continue (archive channel); + disable stop; + read (ds, max pages, errors); + break (quiet); + continue (user channel). +END PROC read space; + +PROC write space (DATASPACE CONST ds) : + user channel := channel; + enable stop; + continue (archive channel); + disable stop; + write (ds); + break (quiet); + continue (user channel). +END PROC write space; + +PROC check archive error (INT CONST code, BOOL CONST read) : + enable stop; + IF read + THEN SELECT code OF + CASE 0 : + CASE 1 : error stop (read write impossible error, + "Lesen unmoeglich (1)") + CASE 2 : error stop (read error, + "Lesefehler (2)") + CASE 3 : error stop (block number error, + "Blocknummer zu hoch (3)") + OTHERWISE error stop (undef archive error, + "Archivfehler unbekannt ("+ text (code) +")") + END SELECT + ELSE SELECT code OF + CASE 0 : + CASE 1 : error stop (read write impossible error, + "Schreiben unmoeglich (1)") + CASE 2 : error stop (write error, + "Schreibfehler (2)") + CASE 3 : error stop (block number error, + "Blocknummer zu hoch (3)") + OTHERWISE error stop (undef archive error, + "Archivfehler unbekannt ("+ text (code) +")") + END SELECT + FI. +END PROC check archive error; + + +(********************** PACKET menue monitor : ****************************) + +PROC fehler behandeln : + IF is error CAND error message <> "" + THEN IF is halt from terminal + THEN set ctrl g + ELSE cursor (error line x pos, error line y pos); + clear error; + put (cl eol +"Fehler : "+ error message) + FI + FI. +END PROC fehler behandeln; + +PROC set ctrl g : + ctrl g := true. +END PROC set ctrl g; + +PROC reset ctrl g : + ctrl g := false. +END PROC reset ctrl g; + +PROC fehler loeschen : + INT VAR x, y; + get cursor (x, y); + cursor (1, 22); + out (cl eol); + cursor (1, 18); + out (cl eol); + cursor (1, 23); + out (cl eol); + cursor (x, y). +END PROC fehler loeschen; + + +(********************** Global-Menue ****************************) + +PROC global menue : + ende := false; + user channel := channel; + disable stop; + REP + menue monitor (global info line, global chars, command index); + fehler loeschen; + SELECT command index OF + CASE 1 : block menue + CASE 2 : space menue + CASE 3 : archive menue + CASE 4 : configurator menue + CASE 5 : urflop menue + CASE 6 : out ("uit");ende := true; + CASE 7 : get and do one command; block shown := false + CASE 8 : global menue help; block shown := false + CASE 9 : doctor menue + CASE 10 : set ctrl g + END SELECT; + fehler behandeln; + UNTIL ende COR ctrl g PER; + reset ctrl g; + ende := false. +END PROC global menue; + +PROC doctor menue : + DATASPACE VAR head ds := nilspace; forget (head ds); + BOUND HEADER VAR head; + TEXT VAR new archive name; + disable stop; + REP + menue monitor (doctor info line, doctor chars, command index); + fehler loeschen; + SELECT command index OF + CASE 1 : neuer archiv start header + CASE 2 : neuer archiv end header + CASE 3 : rette eine datei + CASE 4 : heap auslutschen + CASE 5 : get and do one command; block shown := false + CASE 6 : LEAVE doctor menue + CASE 7 : doctor menue help; block shown := false + CASE 8 : set ctrl g + END SELECT; + fehler behandeln; + UNTIL ende COR ctrl g PER. + +neuer archiv start header : + cursor (2, 21); + forget (head ds); + head ds := nilspace; + head := head ds; + out ("gib neuen Archivnamen : "); + getline (new archive name); + head := nil header; + name (head, new archive name); + type (head, 1000); + date (head, "0.0"); + seek space (0); + write space (head ds). + +neuer archiv end header : + cursor (2, 21); + forget (head ds); + head ds := nilspace; + head := head ds; + out ("Nach der wievielten Datei soll das Ende geschrieben werden : "); + get (last file); + name (head, ""); + date (head, ""); + type (head, 1); + pass (head, ""); + cursor (1, 22); out (""5""); + IF yes ("Neues Archivende nach der "+ text (last file) + + " Datei schreiben") + THEN seek space ((last file * 2) + 1); + write space (head ds) + FI. + +rette eine datei : + cursor (2, 21); + out ("Die wievielte Datei soll gerettet werden : "); + get (filenr); + seek space (file nr * 2); + forget (head ds); + head ds := nilspace; + read space (head ds); + rename file. + +rename file : + TEXT VAR new name := ""; + IF type (head ds) = 1003 + THEN f := sequential file (input, head ds); + new name := head line (f); + close (f); + IF no ("soll die gerettete Datei """+ new name +""" heissen") + THEN get command ("gib Dateinamen :", new name) + FI; + ELSE IF yes ("soll die Datei einen bestimmten Namen bekommen") + THEN get command ("gib Dateinamen :", new name) + FI + FI; + copy (head ds, new name). + +heap auslutschen : + INT VAR h start, h end, file nr; + TEXT VAR h dat; + cursor (2, 21); + out ("Heap lesen ab Block : "); + get (h start); + cursor (2, 21); + out ("Heap lesen ab Block "); put (h start); put ("bis Block :"); + get (h end); + cursor (1, 22); + out ("in Datei : "); + getline (h dat); + cursor (60, 22); + out ("Block : "); + heap lesen (h start, h end, archive channel, h dat). + +END PROC doctor menue; + + +(********************** Block-Menue ****************************) + +PROC block menue : + disable stop; + REP + menue monitor (block info line, block chars, command index); + fehler loeschen; + SELECT command index OF + CASE 1 : read one block + CASE 2 : write one block + CASE 3 : edit block menue + CASE 4 : LEAVE block menue + CASE 5 : get and do one command + CASE 6 : search menue + CASE 7 : read next block + CASE 8 : block menue help; block shown := false + CASE 9 : set ctrl g + END SELECT; + show first three ints; + display info line; + fehler behandeln + UNTIL ctrl g PER. + +read one block : + out ("ead Block : "); + x get (block nummer); + IF NOT is error + THEN reset block io; + read block (block, block nummer) + FI; + IF NOT is error + THEN show first (block); block shown := true + FI. + +write one block : + out ("rite"); + IF yes ("write auf Block "+ text (block nummer)) + THEN reset block io; + write block (block, block nummer) + ELIF yes ("write auf einen anderen Block") + THEN out (" auf Block : "); + x get (block nummer); + IF NOT is error + THEN reset block io; + write block (block, block nummer) + FI + FI. + +read next block : + put (""8"read Block :"); + block nummer INCR 1; + out (text (block nummer)); + reset block io; + read block (block, block nummer); + IF NOT is error + THEN show first (block); block shown := true + FI. + +END PROC block menue; + + +(********************** Search-Menue ****************************) + +PROC search menue : + disable stop; + menue monitor (search info line, search chars, command index); + fehler loeschen; + SELECT command index OF + CASE 1 : ascii search + CASE 2 : hex search + CASE 3 : dez search + CASE 4 : LEAVE search menue + CASE 5 : set ctrl g + END SELECT; + display info line; + fehler behandeln. + +ascii search : + cursor (command line x pos + 1, command line y pos); + put ("Suchtext :"); getline (t); + cursor (command line x pos + 1, command line y pos); + put ("suchen nach """+ t +""" von Block :"); + x get (s); + cursor (command line x pos + 1, command line y pos); + put ("suchen nach """+ t +""" von Block"); + put (s); put ("bis Block :"); x get (e); + search (t, s, e, fb, fp); + out (""13""); + IF fp > 0 + THEN put (cl eol +"Gefunden auf Block"); put (fb); + put (", Position"); put (fp); + read block (block, fb); + IF fp < 256 + THEN show first (block) + ELSE show second (block) + FI; + block shown := true; + st pos := (fp MOD 256) - 1; + block nummer := fb; + ELSE put ("Nicht gefunden !!"); + FI. + +hex search : + cursor (command line x pos + 1, command line y pos); + put ("Suchhex :"); getline (t); + cursor (command line x pos + 1, command line y pos); + put ("suchen nach """+ t +""" von Block :"); + x get (s); + cursor (command line x pos + 1, command line y pos); + put ("suchen nach """+ t +""" von Block"); + put (s); put ("bis Block :"); x get (e); + change all (t, " ", ""); + TEXT VAR such hex := ""; + i := 1; + REP + such hex CAT code (hint (subtext (t, i, i + 1))); + i INCR 2 + UNTIL i >= length (t) PER; + search (such hex, s, e, fb, fp); + out (""13""); + IF fp > 0 + THEN put (cl eol +"Gefunden auf Block"); put (fb); + put (", Position"); put (fp); + read block (block, fb); + IF fp < 256 + THEN show first (block) + ELSE show second (block) + FI; + block shown := true; + st pos := (fp MOD 256) - 1; + block nummer := fb; + ELSE put ("Nicht gefunden !!"); + FI. + +dez search : + error stop ("gibt es noch nicht !"). +END PROC search menue; + + +(********************** Block-Editor-Menue ****************************) + +PROC edit block menue : + INT VAR command index; + disable stop; + REP + fehler loeschen; + show first three ints; + menue monitor (editor info line, editor chars, command index); + SELECT command index OF + CASE 1 : out ("irst"); + show first (block); + block shown := true + CASE 2 : out ("econd"); + show second (block); + block shown := true + CASE 3 : out ("ump"); + show first (block); block edit (block, stpos); + show second (block); block edit (block, stpos); + block shown := true; + CASE 4 : IF NOT block shown + THEN IF first + THEN show first (block) + ELSE show second (block) + FI; + block shown := true + FI; + (* IF first AND stpos >= 256 + THEN show second (block); + block shown := true + ELIF NOT first AND stpos <= 256 + THEN show first (block); + block shown := true + FI; *) (* ??? *) + block edit (block, stpos) + CASE 5 : LEAVE edit block menue + CASE 6 : get and do one command; block shown := false + CASE 7 : block editor menue help; block shown := false + CASE 8 : set ctrl g + CASE 9 : INT VAR old st pos := st pos; + out ("os auf Byte : "); + x get (st pos); + IF st pos < 0 OR st pos > 513 + THEN st pos := old st pos; + error stop ("Zahl nicht ok") + FI + END SELECT; + fehler behandeln + UNTIL ctrl g PER. + +END PROC edit block menue; + + +(********************** Space-Menue ****************************) + +PROC space menue : + disable stop; + REP + menue monitor (space info line, space chars, command index); + fehler loeschen; + rewind; + SELECT command index OF + CASE 1 : read one space + CASE 2 : bit map read + CASE 3 : write one space + CASE 4 : bit map write + CASE 5 : edit one space + CASE 6 : copy one space + CASE 7 : LEAVE space menue + CASE 8 : new edit + CASE 9 : get and do one command + CASE 10 : load one space + CASE 11 : space menue help + CASE 12 : set ctrl g + END SELECT; + fehler behandeln; + display info line; + UNTIL ctrl g PER. + +load one space : + out ("aden aus Datei : "); + getline (dummy); + forget (ds); + ds := nilspace; + ds := old (dummy). + +read one space : + cursor (info line x pos, info line y pos); + out (space header info); + cursor (command line x pos + 2, command line y pos); + out ("ead "); + REP + get char (dummy) + UNTIL pos ("shq"7"", dummy) > 0 PER; + IF dummy = "s" + THEN out ("Space : "); read one s + ELIF dummy = "h" + THEN out ("Header : "); read one h + ELIF dummy = ""7"" + THEN set ctrl g + FI. + +read one s : + x get (space nummer); + IF NOT is error + THEN seek space (space nummer); + first sp block := block number + 1; + forget (ds); + ds := nilspace; + read space (ds) + FI. + +read one h : + x get (header nummer); + space nummer := space nr (header nummer); + IF NOT is error + THEN seek space (space nummer); + first sp block := block number + 1; + forget (ds); + ds := nilspace; + read space (ds) + FI. + +bit map read : + out ("ead Space ab Block : "); + x get (s); + cursor (command line x pos + 1, command line y pos); + out ("Read Space ab Block "+ text (s) +" Max. Bloecke : "); + x get (e); + seek block (s); + IF e = 0 + THEN e := 32000 + FI; + forget (ds); + ds := nilspace; + IF yes ("bei Lesefehlern abbrechen") + THEN read space (ds, e, true) + ELSE read space (ds, e, false) + FI. + +write one space : + out ("rite"); + IF yes ("write auf Space "+ text (space nummer)) + THEN seek space (space nummer); + write space (ds) + ELIF yes ("write auf einen anderen Space") + THEN out (" auf Space : "); + x get (space nummer); + IF NOT is error + THEN seek space (space nummer); + write space (ds) + FI + FI. + +bit map write : + out ("rite Space ab Block : "); + x get (s); + seek block (s); + write space (ds). + +edit one space : + IF type (ds) = file type 16 + THEN change to 17; + f := sequential file (modify, ds); + edit (f, 1, 1, x size - 2, 16); + block shown := false + ELIF type (ds) = file type + THEN f := sequential file (modify, ds); + edit (f, 1, 1, x size - 2, 16); + block shown := false + ELIF ds pages (ds) = 1 CAND type (ds) = 0 + THEN edit header; + block shown := false + FI. + +change to 17 : + TEXT VAR t := ""; + REP + t CAT "­" + UNTIL NOT exists (t) PER; + copy (ds, t); + reorganize (t); + forget (ds); + ds := nilspace; + ds := old (t); + forget (t, quiet). + +copy one space : + put ("ave in Datei : "); + getline (t); + copy (ds, t). + +edit header : + bound header := ds; + cursor (1, 23); + out (cl eol +"Header-Editor : "); + IF is start header (bound header) + THEN out ("Header ist ein Archiv-Startheader.") + ELIF is file header (bound header) + THEN out ("Header ist ein File-Header.") + ELIF is end header (bound header) + THEN out ("Header ist ein Archiv-Endheader.") + ELSE out ("Header ist unbekannt (Headertype = "+ text (type (bound header)) +").") + FI; + header edit (bound header, "Headernummer : "+ text (header nr) + " "). + +new edit : + out (left +"new edit "); + block shown := false; + IF yes ("Neuen Headerspace erstellen") + THEN create new header + ELSE create new file + FI. + +create new header : + forget (ds); + ds := nilspace; + bound header := ds; + bound header := nil header; + cursor (1, 23); + out (cl eol +"Header-Editor : "); + put ("Neuen Header erstellen"); + header edit (bound header, "Neuen Header erstellen"). + +create new file : + forget (ds); + ds := nilspace; + f := sequential file (modify, ds); + edit (f, 1, 1, x size - 2, 16). +END PROC space menue; + + +(********************** Configurator-Menu ****************************) + +PROC configurator menue : + disable stop; + REP + display conf info; + menue monitor (conf info line, conf chars, command index); + fehler loeschen; + SELECT command index OF + CASE 1 : put ("hannel :"); x get (archive channel); + CASE 2 : put (left +"disktype :"); x get (disk type); + CASE 3 : disk info + CASE 4 : get and do one command + CASE 5 : LEAVE configurator menue + CASE 6 : conf menue help + CASE 7 : set ctrl g + END SELECT; + fehler behandeln; + display info line; + UNTIL ctrl g PER. + +display conf info : + cursor (1, 19); + put (cl eol +"I/O Channel :"); put (archive channel); put (","); + put ("Disktype :"); put (disk type); put (","); + put ("Operatorchannel :"); put (channel); + cursor (1, 18); + put ("Zeit :"); put (time of day); put (", Datum :"); put (date); + INT VAR x size, x used; + storage (x size, x used); + put (","); put (x used); put ("K von"); + put (int (real (x size + 24) * 64.0 / 63.0)); + put ("K sind belegt !"). + +disk info : + INT VAR size, io, error; + io control (archive channel, io, size, error); + out (home + 16 * (cl eol + down)); + out (home + down); + putline ("Diskinfo :"); + putline (first mon line); + put ("Disksize :"); put (size); put ("Blocks,"); + put (size DIV 2); put ("kB."); + line; + put ("Disktype :"); + IF size = ibm 720 format 5 + THEN putline ("5 1/4 Zoll, IBM-720 kB Format, 80 Tracks,"); + putline (" double sided/double density, softsectored") + ELIF size = ibm 360 format 5 + THEN putline ("5 1/4 Zoll, IBM-360 kB Format, 40 Tracks,"); + putline (" single sided/double density, softsectored") + ELIF size = pic 400 format 5 + THEN putline ("5 1/4 Zoll, PIC400 Format, 80 Tracks,"); + putline (" double sided/double density, softsectored") + ELIF size = soft sd 8 + THEN putline ("8 Zoll, EUMEL-Format, 77 Tracks,"); + putline (" single sided/double density, softsectored") + ELIF size = soft dd 8 + THEN putline ("8 Zoll, EUMEL-Format, 77 Tracks,"); + putline (" double sided/double density, softsectored") + ELIF size = hard ss sd + THEN putline ("8 Zoll, EUMEL-Format, 32 Tracks,"); + putline (" single sided/single density, hardsectored") + ELIF size = hard ds sd + THEN putline ("8 Zoll, EUMEL-Format, 32 Tracks,"); + putline (" double sided/single density, hardsectored") + ELSE putline ("Unbekannter Disktype"); line + FI; + putline (first mon line). +END PROC configurator menue; + + +(********************** Header/Space Ops. ****************************) + +INT PROC header nr : + IF space nummer = 0 + THEN 0 + ELSE (space nummer + 1) DIV 2 + FI. +END PROC header nr; + +INT PROC space nr (INT CONST header nummer) : + IF header nummer = 0 COR header nummer = 1 + THEN header nummer + ELSE header nummer * 2 - 1 + FI +END PROC space nr; + + +(********************** Archiv-Menue ****************************) + +PROC archive menue : + archive (archive name); + disable stop; + REP + menue monitor (archiv info line, archiv chars, command index); + fehler loeschen; + SELECT command index OF + CASE 1 : archive anmelden + CASE 2 : out ("elease (archive)"); + release (archive); archivename := "" + CASE 3 : out ("ist (archive)"); + list archive; + block shown := false + CASE 4 : out ("etch (SOME archive, archive)"); + fetch (SOME archive, archive); + block shown := false + CASE 5 : out ("ave (SOME all, archive)"); + save (SOME all, archive); + block shown := false + CASE 6 : release (archive); + LEAVE archive menue + CASE 7 : get and do one command; + block shown := false + CASE 8 : archiv menue help; + block shown := false + CASE 9 : set ctrl g + END SELECT; + fehler behandeln + UNTIL ctrl g PER. + +archive anmelden : + put ("rchivename : "); + getline (archivename); + archive (archivename). + +list archive : + IF NOT (list file ok) COR no (""13"Alte Archiveliste zeigen") + THEN forget (af ds); + af ds := nilspace; + af := sequential file (output, af ds); + list (af, archive); + list file ok := true + FI; + edit (af, 1, 1, xsize - 2, 16). +END PROC archive menue; + + +(********************** Urflop-Menue ****************************) + +PROC urflop menue : + INT VAR s, e; + disable stop; + REP + menue monitor (urflop info line, urflop chars, command index); + fehler loeschen; + SELECT command index OF + CASE 1 : read + CASE 2 : x read + CASE 3 : write + CASE 4 : x write + CASE 5 : list task; + block shown := false + CASE 6 : LEAVE urflop menue + CASE 7 : get and do one command; + block shown := false + CASE 8 : urflop menue help; + block shown := false + CASE 9 : set ctrl g + END SELECT; + fehler behandeln + UNTIL ctrl g PER. + +list task : + forget (l ds); + l ds := nilspace; + lf := sequential file (output, l ds); + list (lf); + edit (lf, 1, 1, xsize - 2, 16). + +write : + out ("rite Datenraumname : "); + getline (t); + IF yes ("Urlader schreiben wie gelesen") + THEN urlader schreiben (t, eumel 0 start block, + -1) + ELIF yes ("Urlader für PIC 400 (Shard 6.xx) schreiben") + THEN urlader schreiben (t, eumel 0 start block, + eumel 0 end block pic) + ELIF yes ("Urlader für PIC 400 (Shard 7.xx, u. Bicos Masch.) schreiben") + THEN urlader schreiben (t, eumel 0 start block, + eumel 0 end block) + ELIF yes ("Urlader für PIC 400 (ab Shard 7.13 für EUMEL Ver. 1758) schreiben") + THEN urlader schreiben (t, eumel 0 start block, + eumel 0 end block 1758) + FI. + +x write : + out ("rite Datenraumname : "); + getline (t); + cursor (command line x pos, command line y pos); + out (">Write Datenraum """+ t +""" von Block : "); + x get (s); + cursor (command line x pos, command line y pos); + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis : "); + x get (e); + cursor (command line x pos, command line y pos); + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e)); + IF yes ("mit Versatz") + THEN cursor (command line x pos, command line y pos); + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" Versatz : "); + x get (ver); + cursor (command line x pos, command line y pos); + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" Ver. "+ text (ver) + " --> "); + urlader schreiben (t, s, e, ver) + ELSE cursor (command line x pos, command line y pos); + out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" --> "); + urlader schreiben (t, s, e) + FI. + +read : + out ("ead Datenraumname : "); + getline (t); + IF yes ("Urlader für PIC 400 (Shard 6.xx) lesen") + THEN urlader lesen (t, eumel 0 start block, + eumel 0 end block pic) + ELIF yes ("Urlader für PIC 400 (Shard 7.xx, u. Bicos Masch.) lesen") + THEN urlader lesen (t, eumel 0 start block, + eumel 0 end block) + ELIF yes ("Urlader für PIC 400 (Shard 7.xx für EUMEL Ver. 1758) lesen") + THEN urlader lesen (t, eumel 0 start block, + eumel 0 end block 1758) + FI. + +x read : + out ("ead Datenraumname : "); + getline (t); + cursor (command line x pos, command line y pos); + out (">Read Datenraum """+ t +""" von Block : "); + x get (s); + cursor (command line x pos, command line y pos); + out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis : "); + x get (e); + IF yes ("mit Versatz") + THEN cursor (command line x pos, command line y pos); + out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" Versatz : "); + x get (ver); + cursor (command line x pos, command line y pos); + out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" Ver. "+ text (ver) + " --> "); + urlader lesen (t, s, e, ver) + ELSE cursor (command line x pos, command line y pos); + out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+ + " Block "+ text (e) +" --> "); + urlader lesen (t, s, e) + FI. +END PROC urflop menue; + + +(********************** Disk - Monitor Call ****************************) + +PROC central disk monitor process : + archive ("disk"); + release (archive); + space nummer := -1; + block nummer := -1; + header nummer := -1; + first sp block := -1; + st pos := 0; + archive name := ""; + list file ok := false; + block shown := false; + reset ctrl g; + page; + line (3); + putline ("D I S K - M O N I T O R"); + putline ("========================="); + line; + putline ("Autor : Ingo Siekmann"); + putline ("Stand : "+ software stand); + putline (software version); + putline ("Bem. : "+ software bemerkung); + putline (" "+ software bemerkung1); + line; + putline ("(c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert"); + line; + initialize if necessary; + global menue; + line; + unblock (archive); + IF archive name <> "" CAND NOT ctrl g + THEN archive (archive name) + FI. +END PROC central disk monitor process; + + +(********************** Unterprogramme ****************************) + +THESAURUS OP SOME (THESAURUS CONST thesaurus) : + DATASPACE VAR edit space :: nilspace; + THESAURUS VAR result := empty thesaurus; + FILE VAR file := sequential file (output, edit space); + file FILLBY thesaurus; + modify (file); + edit (file, 1, 1, xsize - 2, 16); + input (file); + result FILLBY file; + forget (edit space); + result. +END OP SOME; + +THESAURUS OP SOME (TASK CONST dest task) : + SOME ALL dest task. +END OP SOME; + +PROC display info line : + INT VAR x, y; + get cursor (x, y); + cursor (1, 24); + put (cl eol +"Block : "); put (block nummer); + put (", Space : "); put (space nummer); + put (", First Sp Block : "); put (first sp block); + put (", Header : "); put (header nummer); + cursor (x, y). +END PROC display info line; + +PROC show first three ints : + INT VAR i, ih; + cursor (1, 18); + out (cleol); + FOR i FROM 1 UPTO 3 REP + out (text (i)); + put (". INT:"); + dummy := ""; dummy CATHEX block [i]; + put (dummy); + put ("/"); + ih := block [i]; + out (text (ih)); + out (", ") + PER +END PROC show first three ints; + +PROC x get (INT VAR i) : + enable stop; + get (dummy); + IF (dummy SUB length (dummy)) = hex marker + THEN i := hint (text (dummy, length (dummy) - 1)) + ELSE i := int (dummy) + FI; + IF NOT last conversion ok + THEN error stop ("Zahl ist nicht korrekt") + FI. +END PROC x get; + + +(********************** Urflop - Ops. ****************************) + +PROC urlader lesen (TEXT CONST urname, INT CONST start, end) : + urlader lesen (urname, start, end, 0). +END PROC urlader lesen; + +PROC urlader schreiben (TEXT CONST urname, INT CONST start, end) : + urlader schreiben (urname, start, end, 0). +END PROC urlader schreiben; + +PROC urlader lesen auf seite (TEXT CONST urname, INT CONST start, end, + auf) : + urlader lesen (urname, start, end, auf - start). +END PROC urlader lesen auf seite; + +PROC urlader schreiben von seite (TEXT CONST urname, INT CONST start, + end, von) : + urlader schreiben (urname, start, end, von - start). +END PROC urlader schreiben von seite; + +PROC urlader lesen (TEXT CONST urname, INT CONST start, end, ver) : + IF exists (urname) + THEN error stop (""""+ urname +""" gibt es schon") + FI; + forget (uds); + uds := nilspace; + reset block io; + reset ctrl g; + FOR block nr FROM start UPTO end REP + continue (archive channel); + disable stop; + block in (uds, block nr + ver, disk type, block nr, error); + continue (user channel); + enable stop; + check archive error (error, true); + cout (block nr); + dummy := incharety; + IF dummy = ""7"" + THEN set ctrl g + FI + UNTIL dummy = esc COR ctrl g PER; + IF NOT ctrl g + THEN copy (uds, urname); + FI; + forget (uds). +END PROC urlader lesen; + +PROC urlader schreiben (TEXT CONST urname, INT CONST start, end, ver) : + forget (uds); + uds := old (urname); + reset ctrl g; + reset block io; + block nr := start; + IF block nr = -1 + THEN block nr := next ds page (uds, block nr) + FI; + WHILE block nr <> -1 REP + continue (archive channel); + disable stop; + block out (uds, block nr + ver, disk type, block nr, error); + break (quiet); + continue (user channel); + enable stop; + check archive error (error, false); + cout (block nr); + dummy := incharety; + IF dummy = ""7"" + THEN set ctrl g + FI; + IF end = -1 COR start = -1 + THEN block nr := next ds page (uds, block nr) + ELIF block nr = end + THEN block nr := -1 + ELSE block nr INCR 1 + FI + UNTIL dummy = esc COR ctrl g PER; + forget (uds). +END PROC urlader schreiben; + + +(********************** Unterprogramme ****************************) + +PROC reset block io : + user channel := channel; + INT VAR i, s, e; + io control (archive channel, i, s, e); + check archive error (e, true). +END PROC reset block io; + +PROC get and do one command : + initialize if necessary; + cursor (1, 21); + out (cl eop); + get command ("gib ein EUMEL-Kommando : ", own command line); + do (own command line). +END PROC get and do one command ; + +PROC io control (INT VAR io, size, error) : + ROW 256 INT VAR block; + control (type mode, 0, 0, io); + control (size mode, 0, 0, size); + block in (block, std disk type, block 0, error). +END PROC io control; + +PROC io control (INT CONST io channel, INT VAR io, size, error) : + INT VAR op channel :: channel; + continue (io channel); + io control (io, size, error); + break (quiet); + continue (op channel). +END PROC io control; + + +(********************** Menue - Help Ops ****************************) + +PROC doctor menue help : + out (home + cl eop); + line; + putline ("Help für das Doktor-Menue : "); + line; + putline ("a --> Neuen Archivnamen (Archivanfang) schreiben"); + putline ("e --> Neues Archivende schreiben"); + line; + putline ("r --> Eine Datei von der Archiv-Diskette retten"); + line; + putline ("h --> Heapteil einer Datei auf der Diskette lesen"); + line; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)"); + line; + putline ("q --> Verlassen des Diskettenmonitors (quit wie im Editor)"); +END PROC doctor menue help; + +PROC global menue help : + out (home + cl eop); + line; + putline ("Help für das Global-Menue : "); + line; + putline ("b --> Aufruf des Block-Menüs (direkter Block i/o)"); + putline ("s --> Aufruf des Space-Menüs (direkter Space- und Header i/o)"); + putline ("a --> Aufruf des Archiv-Menüs (normale Archivoperationen)"); + putline ("u --> Aufruf des Urflop-Menüs (Urlader/Datenraum <-> Floppy)"); + putline ("c --> Aufruf des Konfigurator-Menüs"); + putline ("d --> Aufruf des Doktor-Menüs"); + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)"); + line; + putline ("q --> Verlassen des Diskettenmonitors (quit wie im Editor)"); +END PROC global menue help; + +PROC block menue help : + out (home + cl eop); + line; + putline ("Help für das Block-Menü : "); + line; + putline ("r --> Lesen eines Blockes (block in)"); + putline ("n --> Lesen des nächsten Blockes"); + putline ("w --> Schreiben eines Blockes (block out)"); + line; + putline ("s --> Suchen nach einem Text"); + line; + putline ("e --> Aufruf des Blockeditor-Menüs"); + line; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)"); + line; + putline ("q --> Verlassen des Block-Menüs (Rückkehr ins Global-Menü)"); +END PROC block menue help; + +PROC block editor menue help : + out (home + cl eop); + line; + putline ("Help für das Blockeditor-Menü : "); + line; + putline ("f --> Zeigen der ersten 256 Bytes des aktuellen Blockes"); + putline ("s --> Zeigen der zweiten 256 Bytes des aktuellen Blockes"); + line; + putline ("e --> Editieren des aktuellen Teilblockes"); + putline ("d --> Editieren des ersten und zweiten Teilblockes"); + line; + putline ("p --> Position setzen, auf der der Editor beginnen soll"); + line; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)"); + line; + putline ("q --> Verlassen des Blockeditor-Menüs (Rückkehr ins Block-Menü)"); +END PROC block editor menue help; + +PROC space menue help : + out (home + cl eop); + line; + putline ("Help für das Space-Menü : "); + line; + putline ("r --> Lesen eines Datenraums bzw. eines Headers"); + putline ("R --> Lesen eines Datenraums ab Block x"); + putline ("w --> Schreiben eines Datenraums bzw. eines Headers"); + putline ("W --> Schreiben eines Datenraums ab Block x"); + line; + putline ("e --> Editieren des aktuellen Datenraums (Datei o. Header)"); + putline ("E --> Editieren einer neuen Datei oder eines Header"); + line; + putline ("s --> Kopieren des aktuellen Datenraums in einen benannten Datenraum"); + putline ("l --> Kopieren eines benannten Datenraums in den aktuellen Datenraum"); + line; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)"); + putline ("q --> Verlassen des Space-Menüs (Rückkehr ins Global-Menü)"); +END PROC space menue help; + +PROC archiv menue help : + out (home + cl eop); + line; + putline ("Help für das Archiv-Menü : "); + line; + putline ("a --> Archiv anmelden"); + putline ("r --> Archiv abmelden"); + line; + putline ("f --> Einige Dateien vom Archiv in die Task laden"); + putline ("s --> Einige Dateien der Task auf das Archiv schreiben"); + putline ("l --> Dateiliste des Archives zeigen"); + line; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)"); + line; + putline ("q --> Verlassen des Archiv-Menüs (Rückkehr ins Global-Menü)"); +END PROC archiv menue help; + +PROC urflop menue help : + out (home + cl eop); + line; + putline ("Help für das Urflop-Menü : "); + line; + putline ("r --> Lesen der Blöcke 10 bis 62 in einen benannten Datenraum"); + putline ("R --> Lesen der Blöcke x bis y in einen benannten Datenraum"); + line; + putline ("w --> Schreiben der Blöcke 10 bis 62 aus einem benannten Datenraum"); + putline ("W --> Schreiben der Blöcke x bis y aus einem benannten Datenraum"); + line; + putline ("l --> Dateiliste der Task zeigen (list)"); + line; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)"); + line; + putline ("q --> Verlassen des Urflop-Menüs (Rückkehr ins Global-Menü)"); +END PROC urflop menue help; + +PROC conf menue help : + out (home + cl eop); + line; + putline ("Help für das Configurator-Menü :"); + line; + putline ("c --> Einstellen des Kanals, auf dem der Block i/o abläuft"); + putline ("t --> Einstellen des Diskettentypes (EUMEL, CPM etc)"); + line; + putline ("i --> Disketteninfo"); + line; + putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)"); + line; + putline ("q --> Verlassen des Konfigurator-Menüs (Rückkehr ins Global-Menü)"); +END PROC conf menue help; + +BOOL PROC is halt from terminal : + is error CAND error code = 1 +END PROC is halt from terminal; + +PROC block in (TEXT VAR block, INT CONST block nr, disk type, + INT VAR error) : + initialize if necessary; + block in (blkinds, heap page nr, disk type, block nr, error); + block := subtext (bound text, start pos, LENGTH bound text); +END PROC block in; + +PROC initialize if necessary : + IF NOT initialized (this packet) + THEN forget (blkinds); + blkinds := nilspace; + bound text := blkinds; + bound text := (start pos + 511) * " "; + own command line := ""; + archive channel := std archive channel; + disk type := std disk type + FI. +END PROC initialize if necessary; + +BOOL PROC yes (TEXT CONST msg) : + get cursor (cx, cy); + cursor (command line x pos + 1, command line y pos + 1); + result := NOT no (msg); + cursor (cx, cy); + result. +END PROC yes; +(* +INT OP $ (TEXT CONST hex) : + INT VAR laenge := length (hex), stelle, ziffer, ergebnis := 0; + FOR stelle FROM laenge DOWNTO 1 REP + ziffer := pos ("0123456789ABCDEF", hex SUB stelle) - 1; + IF ziffer < 0 + THEN error stop ("Ist keine Hexzahl") + FI; + ergebnis INCR ziffer * 16 ** (laenge - stelle) + PER; + ergebnis. +END OP $; +*) +PROC search (TEXT CONST st, INT CONST start block, end block, + INT VAR fbnr, fpos) : + enable stop; + INT CONST l := LENGTH st - 1; + reset ctrl g; + reset block io; + FOR fbnr FROM start block UPTO end block REP + cout (fbnr); + continue (archive channel); + block in (stb1, fbnr, disk type, error); + IF error = 0 + THEN block in (stb2, fbnr + 1, disk type, error) + FI; + break (quiet); + continue (user channel); + check archive error (error, true); + stb1 CAT text (stb2, l); + UNTIL pos (stb1, st) > 0 COR incharety = ""27"" PER; + fpos := pos (stb1, st) +END PROC search; + +PROC heap lesen (INT CONST start block, end block, channel nr, + TEXT CONST output filename) : + + FILE VAR f; + ROW 256 INT VAR block; + INT VAR i, j; + TEXT VAR t; + IF exists (output filename) + THEN error stop (""""+ output filename +""" gibt es schon") + FI; + f := sequential file (output, output filename); + max line length (f, 100); + t := ""; + reset ctrl g; + set channel (channel nr); + FOR i FROM start block UPTO end block REP + c out (i); + read block (block, i); + j := 1; + REP + IF lower byte (block [j]) = 255 COR higher byte (block [j]) = 255 + THEN putline (f, t); + t := ""; hihi; + j INCR 1 + FI; + IF j < 257 + THEN IF lower byte (block [j]) = 220 COR + lower byte (block [j]) = 221 + THEN t CAT code (lower byte (block [j])) + ELSE t CAT ascii (lower byte (block [j])); + FI; + IF higher byte (block [j]) = 220 COR + higher byte (block [j]) = 221 + THEN t CAT code (higher byte (block [j])) + ELSE t CAT ascii (higher byte (block [j])); + FI + FI; + j INCR 1; + UNTIL j >= 255 PER; + UNTIL incharety = ""27"" PER. + +hihi : + REP + j INCR 1; + IF j > 256 + THEN LEAVE hihi + FI + UNTIL lower byte (block [j]) <> 255 CAND + higher byte (block [j]) <> 255 PER. + +END PROC heap lesen; + +END PACKET byte operations and disk monitor version 36 multi; + diff --git a/app/diskettenmonitor/3.7/src/disk cmd 3.6.quelle b/app/diskettenmonitor/3.7/src/disk cmd 3.6.quelle new file mode 100644 index 0000000..8660a67 --- /dev/null +++ b/app/diskettenmonitor/3.7/src/disk cmd 3.6.quelle @@ -0,0 +1,48 @@ + +PACKET disk cmd + +(************************************************************************) +(* *) +(* Disk - Menuecall Version 3.6 *) +(* *) +(* *) +(* Autor : Ingo Siekmann *) +(* Stand : Montag, den 09.02.1987 *) +(* *) +(* Lauffähig ab EUMEL Version 1.8.1 /M und insertiertem *) +(* Diskmonitor ab Version 3.6 *) +(* *) +(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert *) +(* *) +(************************************************************************) + + DEFINES disk , + disk monitor , + disk doctor : + + +lernsequenz auf taste legen ("d", "disk monitor"13"") ; +lernsequenz auf taste legen ("D", "disk doctor"13"") ; + + +PROCEDURE disk : + + central disk monitor process . + +END PROCEDURE disk ; + +PROCEDURE disk monitor : + + central disk monitor process . + +END PROCEDURE disk monitor ; + +PROCEDURE disk doctor : + + push ("d") ; + disk monitor . + +END PROCEDURE disk doctor ; + +END PACKET disk cmd ; + diff --git a/app/eudas/3.4/source-disk b/app/eudas/3.4/source-disk new file mode 100644 index 0000000..309d823 --- /dev/null +++ b/app/eudas/3.4/source-disk @@ -0,0 +1 @@ +eudas/eudas-3.4.img diff --git a/app/eudas/3.4/src/eudas.1 b/app/eudas/3.4/src/eudas.1 new file mode 100644 index 0000000..5c8bb63 --- /dev/null +++ b/app/eudas/3.4/src/eudas.1 @@ -0,0 +1,37 @@ +PACKETeudassatzzugriffeDEFINES SATZ,:=,satzinitialisieren,felderzahl,feldlesen,feldbearbeiten,feldaendern,feldindex:LETb0=256,c0=2;LETd0=" ",e0="";LETf0=" ist keine Feldnummer";TEXT VARg0:=c0*d0;TYPE SATZ=TEXT;OP:=(SATZ VARh0,SATZ CONSTi0):CONCR(h0):=CONCR(i0)END OP:=;PROCsatzinitialisieren(SATZ VARj0):satzinitialisieren(j0,0)END PROCsatzinitialisieren;PROCsatzinitialisieren(SATZ VARj0,INT CONSTk0):replace(g0,1,2*k0+3);INT VARl0;CONCR(j0):=e0;FORl0FROM1UPTOk0+1REP CONCR(j0)CATg0END REP END PROCsatzinitialisieren;INT PROCfelderzahl(SATZ CONSTj0):INT VARm0:=(CONCR(j0)ISUB1)DIV2;INT CONSTn0:=CONCR(j0)ISUBm0;REPm0DECR1UNTILm0<=0CORo0END REP;m0.o0:(CONCR(j0)ISUBm0)<>n0.END PROCfelderzahl;PROCfeldlesen(SATZ CONSTj0,INT CONSTp0,TEXT VARq0):r0(CONCR(j0),p0);IF NOTiserrorTHENq0:=subtext(CONCR(j0),s0,t0)END IF END PROCfeldlesen;PROCfeldbearbeiten(SATZ CONSTj0,INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):r0(CONCR(j0),p0);IF NOTiserrorTHENu0(CONCR(j0),s0,t0)END IF END PROCfeldbearbeiten;INT + VARs0,t0;PROCr0(TEXT CONSTj0,INT CONSTp0):IFv0THENerrorstop(text(p0)+f0)ELIFw0THENs0:=j0ISUBp0;t0:=(j0ISUBp0+1)-1ELSEs0:=1;t0:=0END IF.v0:p0<=0ORp0>b0.w0:p0+p0<(j0ISUB1)-1.END PROCr0;TEXT VARx0;PROCfeldaendern(SATZ VARj0,INT CONSTp0,TEXT CONSTq0):INT VARy0;INT CONSTz0:=((CONCR(j0)ISUB1)-2)DIV2;IFa1THENb1ELSEerrorstop(text(p0)+f0)END IF.a1:p0>0ANDp0<=b0.b1:INT CONSTc1:=p0-z0;IFc1<=0THENd1ELIFq0<>e0THENe1END IF.e1:INT CONSTf1:=CONCR(j0)ISUB(z0+1);x0:=subtext(CONCR(j0),g1,f1-1);CONCR(j0):=subtext(CONCR(j0),1,z0+z0);h1(CONCR(j0),1,z0,i1);j1;k1;CONCR(j0)CATx0;CONCR(j0)CATq0.i1:c1+c1.j1:INT CONSTl1:=f1+i1;FORy0FROMz0+1UPTOp0REPm1(CONCR(j0),l1)END REP.k1:m1(CONCR(j0),l1+length(q0)).g1:CONCR(j0)ISUB1.d1:INT CONSTs0:=CONCR(j0)ISUBp0,n1:=CONCR(j0)ISUB(p0+1);IFs0>length(CONCR(j0))THENo1ELSEp1END IF.o1:h1(CONCR(j0),p0+1,z0+1,length(q0));CONCR(j0)CATq0.p1:x0:=subtext(CONCR(j0),n1);CONCR(j0):=subtext(CONCR(j0),1,s0-1);h1(CONCR(j0),p0+1,z0+1,q1);CONCR(j0)CATq0;CONCR(j0)CATx0.q1:length(q0)-r1.r1:n1- +s0.END PROCfeldaendern;PROCm1(TEXT VARj0,INT CONSTs1):replace(g0,1,s1);j0CATg0END PROCm1;PROCh1(TEXT VARj0,INT CONSTt1,u1,v1):INT VARy0;FORy0FROMt1UPTOu1REPreplace(j0,y0,w1+v1)END REP.w1:j0ISUBy0.END PROCh1;INT PROCfeldindex(SATZ CONSTj0,TEXT CONSTx1):INT VARt1:=(CONCR(j0)ISUB1)-1,y0:=1;REPt1:=pos(CONCR(j0),x1,t1+1);IFt1=0THEN LEAVEfeldindexWITH0END IF;y1UNTILz1CANDa2END REP;y0.y1:WHILE(CONCR(j0)ISUBy0)length(p3)+1THENr3ELSEreplace(j3,1,o3);n3:=subtext(p3,begin);p3:=subtext(p3,1,begin-1);p3CATj3;p3CATn3END IF END PROCinsert;PROCdelete(INTVEC VARp3,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENq3ELIFbegin>=length(p3)THENr3ELSEn3:=subtext(p3,begin+2);p3:=subtext(p3,1,begin-1);p3CATn3END IF END PROCdelete;INT PROCpos(INTVEC CONSTp3,INT CONSTo3):replace(j3,1,o3);INT VARbegin:=1;REPbegin:=pos(p3,j3,begin)+1UNTIL(beginAND1)=0ORbegin=1END REP;beginDIV2END PROCpos;PROCs3(INTVEC VARt3,u3,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENq3ELIFbegin>length(t3)+1THENr3ELSEu3:=subtext(t3,begin);t3:=subtext(t3,1,begin-1)END IF END PROCs3;PROCv3(INTVEC VARt3,u3,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENq3ELIFbegin>length(t3)+1THENr3ELSEu3:=subtext(t3,1,begin-1);t3:=subtext(t3,begin)END IF END PROCv3;.r3:errorstop(9,e0).q3:errorstop(10,e0).PROCw3(DATEI VARx3):x3.felderzahl:=0;x3.feldinfo:=m3;satzinitialisieren(x3.o2);x3.p2:=e0;x3.q2:=1;x3.r2:= +1;x3.t2:=0;x3.s2:=0;x3.v2:=0;x3.u2:=1;x3.z2:=0;x3.b3(1):=e0;x3.b3(2):=e0;x3.b3(3):=e0;x3.satznr:=1;x3.w2:=1;x3.x2:=1;x3.y2:=1;x3.index(1).l2:=k3;x3.index(1):=INDEX:(0,0,1,1,l3(1,1));INT VARl0;FORl0FROM1UPTOb2REPx3.c3(l0):=0END REP;x3.d3(1):=EINTRAG:(0,0,1,0,y3).y3:x3.o2.END PROCw3;PROCoeffne(EUDAT VARx3,TEXT CONSTz3):enablestop;IF NOTexists(z3)THEN CONCR(x3):=new(z3);w3(CONCR(x3));type(old(z3),e2)ELIFtype(old(z3))=e2THEN CONCR(x3):=old(z3)ELSEerrorstop(e3)ENDIF END PROCoeffne;PROCoeffne(EUDAT VARx3,DATASPACE CONSTa4):IFtype(a4)<0THEN CONCR(x3):=a4;w3(CONCR(x3));type(a4,e2)ELIFtype(a4)=e2THEN CONCR(x3):=a4ELSEerrorstop(e3)END IF END PROCoeffne;PROCfeldlesen(EUDAT CONSTx3,INT CONSTp0,TEXT VARq0):feldlesen(b4,p0,q0).b4:x3.d3(x3.y2).j0.END PROCfeldlesen;PROCfeldaendern(EUDAT VARx3,INT CONSTp0,TEXT CONSTc4):IFd4THENe4(CONCR(x3));f4;feldaendern(b4,p0,c4)END IF.d4:x3.y2<>1.f4:IFp0=1THENdisablestop;g4(CONCR(x3),h4(c4))END IF.b4:x3.d3(x3.y2).j0.END PROCfeldaendern;INT PROCfelderzahl(EUDAT CONST +x3):x3.felderzahlEND PROCfelderzahl;PROCfeldbearbeiten(EUDAT CONSTx3,INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):feldbearbeiten(b4,p0,PROC(TEXT CONST,INT CONST,INT CONST)u0).b4:x3.d3(x3.y2).j0.END PROCfeldbearbeiten;PROCfeldnamenlesen(EUDAT CONSTx3,SATZ VARi4):i4:=x3.o2END PROCfeldnamenlesen;PROCfeldnamenaendern(EUDAT VARx3,SATZ CONSTj4):x3.o2:=j4;INT CONSTk4:=felderzahl(j4);IFk4>x3.felderzahlTHENl4;x3.felderzahl:=k4END IF.l4:x3.feldinfoCATl3(m4,-1).m4:k4-length(x3.feldinfo)DIV2.END PROCfeldnamenaendern;INT PROCfeldinfo(EUDAT CONSTx3,INT CONSTp0):x3.feldinfoISUBp0END PROCfeldinfo;PROCfeldinfo(EUDAT VARx3,INT CONSTp0,n4):replace(x3.feldinfo,p0,n4);IFpos(x3.p2,code(p0))>0THENx3.z2:=x3.v2END IF END PROCfeldinfo;INT PROCsatznr(EUDAT CONSTx3):x3.satznrEND PROCsatznr;BOOL PROCdateiende(EUDAT CONSTx3):x3.satznr>x3.v2END PROCdateiende;INT PROCsaetze(EUDAT CONSTx3):x3.v2END PROCsaetze;PROCo4(DATEI VARx3,INT CONSTw2,k2,satznr):IFw2<1ORw2>x3.r2CORk2<1ORk2>x3.index(w2).j2THENerrorstop(f3) +END IF;disablestop;x3.w2:=w2;x3.x2:=k2;x3.satznr:=satznr;x3.y2:=x3.index(w2).l2ISUBk2END PROCo4;PROCaufsatz(EUDAT VARx3,INT CONSTp4):INT VARsatznr;IFp4<1THENsatznr:=1ELIFp4>x3.v2THENsatznr:=x3.v2+1ELSEsatznr:=p4END IF;q4(CONCR(x3),satznr)END PROCaufsatz;PROCaufsatz(EUDAT VARx3,TEXT CONSTx1):aufsatz(x3,1);IFr4THENweiter(x3,x1)END IF.r4:feldlesen(x3,1,i3);i3<>x1.END PROCaufsatz;PROCq4(DATEI VARx3,INT CONSTsatznr):IFs4THENo4(x3,1,1,1)END IF;INT VARw2:=x3.w2,t4:=x3.satznr-x3.x2;IFsatznr>x3.satznrTHENu4ELSEv4END IF;o4(x3,w2,k2,satznr).s4:satznr+satznr=satznr.k2:satznr-t4.END PROCq4;PROCweiter(EUDAT VARx3):y4(CONCR(x3))END PROCweiter;PROCy4(DATEI VARx3):IFz4THENa5END IF.z4:x3.y2<>1.a5:INT VARw2:=x3.w2,k2:=x3.x2;IFk2=index.j2THENw2:=index.i2;k2:=1ELSEk2INCR1END IF;o4(x3,w2,k2,x3.satznr+1).index:x3.index(w2).END PROCy4;PROC +zurueck(EUDAT VARx3):b5(CONCR(x3))END PROCzurueck;PROCb5(DATEI VARx3):IFc5THENd5END IF.c5:x3.satznr<>1.d5:INT VARw2:=x3.w2,k2:=x3.x2;IFk2=1THENw2:=m2.h2;k2:=m2.j2ELSEk2DECR1END IF;o4(x3,w2,k2,x3.satznr-1).m2:x3.index(w2).END PROCb5;PROCweiter(EUDAT VARx3,TEXT CONSTx1):y4(CONCR(x3),x1)END PROCweiter;PROCy4(DATEI VARx3,TEXT CONSTx1):e5;WHILEf5CANDg5REPh5END REP;IFf5THENi5(x3,k2)ELSEq4(x3,x3.v2+1)END IF.e5:INT VARj5,k2:=x3.y2;IFg5THENk5(x3,h4(x1),k2,j5)ELSEh5END IF.f5:k2<>0.g5:feldlesen(b4,1,i3);i3<>x1.b4:x3.d3(k2).j0.h5:k2:=x3.d3(k2).i2.END PROCy4;PROCzurueck(EUDAT VARx3,TEXT CONSTx1):b5(CONCR(x3),x1)END PROCzurueck;PROCb5(DATEI VARx3,TEXT CONSTx1):e5;WHILEf5CANDg5REPl5END REP;IFf5THENi5(x3,k2)ELSEq4(x3,1)END IF.e5:INT VARk2:=x3.y2,j5;IFk2=1ORm5THENk5(x3,h4(x1),j5,k2)END IF.f5:k2<>0.g5:k2=x3.y2ORm5.m5:feldlesen(b4,1,i3);i3<>x1.b4:x3.d3(k2).j0.l5:k2:=x3.d3(k2).h2.END PROCb5;PROCi5(DATEI VARx3,INT CONSTk2):INT CONSTn5:=x3.d3(k2).m2;INT VARx2:=1,satznr:=0;WHILEx2<>n5REPsatznrINCRx3.index(x2 +).j2;x2:=x3.index(x2).i2END REP;x2:=pos(x3.index(n5).l2,k2);satznrINCRx2;o4(x3,n5,x2,satznr).END PROCi5;INT VARindex;PROCo5(TEXT CONSTp5,INT CONSTq5,r5):INT VARs5:=q5;index:=0;IFr5-q5<4THENt5ELSEu5END IF;index:=indexMODb2+1.t5:WHILEs5<=r5REPindex:=index*4;indexINCRcode(p5SUBs5);s5INCR1END REP.u5:WHILEs5<=r5REPindexINCRindex;indexINCRcode(p5SUBs5);IFindex>16000THENindex:=indexMODb2END IF;s5INCR1END REP.END PROCo5;INT PROCh4(TEXT CONSTp5):o5(p5,1,length(p5));indexEND PROCh4;INT PROCh4(SATZ CONSTj0):feldbearbeiten(j0,1,PROC(TEXT CONST,INT CONST,INT CONST)o5);indexEND PROCh4;PROCk5(DATEI CONSTx3,INT CONSTh4,INT VARk2,v5):INT VARw2:=x3.q2;v5:=x3.c3(h4);k2:=0;BOOL VARw5:=TRUE;WHILEw5ANDv5<>0REPx5;h5END REP.x5:IFy5THENz5ELSEa6END IF.y5:x3.d3(v5).m2=x3.w2.z5:w2:=x3.w2;INT CONSTb6:=pos(l2,v5);IFb6=0THENerrorstop(f3)ELIFb6<=c6THENw5:=FALSE END IF.l2:x3.index(w2).l2.c6:x3.x2.a6:WHILEw2<>x3.d3(v5).m2REP IFw2=x3.w2THENw5:=FALSE;LEAVEx5ELSEw2:=x3.index(w2).h2END IF END REP.h5:IFw5THENk2:=v5;v5:=x3. +d3(k2).h2END IF.END PROCk5;PROCd6(DATEI VARx3,INT CONSTh4):disablestop;INT CONSTk2:=x3.y2,h2:=x3.d3(k2).h2,i2:=x3.d3(k2).i2;IFi2<>0THENx3.d3(i2).h2:=h2ELSEx3.c3(h4):=h2END IF;IFh2<>0THENx3.d3(h2).i2:=i2END IF.END PROCd6;PROCe6(DATEI VARx3,INT CONSTh4,i2,h2):disablestop;INT CONSTk2:=x3.y2;x3.d3(k2).h2:=h2;x3.d3(k2).i2:=i2;IFh2<>0THENx3.d3(h2).i2:=k2END IF;IFi2<>0THENx3.d3(i2).h2:=k2ELSEx3.c3(h4):=k2END IF END PROCe6;PROCsatzlesen(EUDAT CONSTx3,SATZ VARj0):j0:=x3.d3(x3.y2).j0END PROCsatzlesen;PROCsatzaendern(EUDAT VARx3,SATZ CONSTf6):IF NOTdateiende(x3)THENg6END IF.g6:e4(CONCR(x3));disablestop;g4(CONCR(x3),h4(f6));b4:=f6.b4:x3.d3(x3.y2).j0.END PROCsatzaendern;PROCg4(DATEI VARx3,INT CONSTh6):IFi6THENj6END IF.i6:INT CONSTk6:=h4(b4);k6<>h6.j6:l6;m6.l6:d6(x3,k6).m6:INT VARh2,i2;k5(x3,h6,h2,i2);e6(x3,h6,h2,i2).b4:x3.d3(x3.y2).j0.END PROCg4;PROCsatzloeschen(EUDAT VARx3):IF NOTdateiende(x3)THENn6END IF.n6:disablestop;o6(CONCR(x3));p6(CONCR(x3));x3.v2DECR1.END PROCsatzloeschen;PROCo6(DATEI VARx3 +):q6(x3);INT CONSTk2:=x3.y2;d6(x3,h4(b4));x3.d3(k2).i2:=x3.t2;x3.t2:=k2.b4:x3.d3(k2).j0.END PROCo6;PROCsatzeinfuegen(EUDAT VARx3,SATZ CONSTf6):r6(CONCR(x3),f6)END PROCsatzeinfuegen;PROCr6(DATEI VARx3,SATZ CONSTf6):INT VARk2,h2,i2;enablestop;s6;disablestop;x3.v2INCR1;t6(x3,k2);INT CONSTu6:=h4(f6);k5(x3,u6,i2,h2);e6(x3,u6,i2,h2);e4(x3).s6:IFx3.t2<>0THENk2:=x3.t2;x3.t2:=x3.d3(k2).i2ELIFx3.u2=d2THENerrorstop(g3)ELSEx3.u2INCR1;k2:=x3.u2END IF;x3.d3(k2).n2:=0;x3.d3(k2).j0:=f6.END PROCr6;INTVEC VARv6;PROCp6(DATEI VARx3):INT CONSTw2:=x3.w2,h2:=index.h2,i2:=index.i2;BOOL VARw6;delete(index.l2,x3.x2);index.j2DECR1;x6(x3,w2,i2,w6);IF NOTw6THENx6(x3,h2,w2,w6)END IF;y6(x3).index:x3.index(w2).END PROCp6;PROCx6(DATEI VARx3,INT CONSTs5,z6,BOOL VARw6):w6:=FALSE;IFs5<>0ANDz6<>0THENa7END IF.a7:INT CONSTb7:=index.j2,c7:=d7.j2;IFe7THENf7;w6:=TRUE END IF.e7:b7+c7<=g2ORb7=0ORc7=0.f7:index.j2INCRd7.j2;g7(x3,d7.l2,s5);index.l2CATd7.l2;h7.h7:index.i2:=d7.i2;IFindex.i2<>0THENx3.index(index.i2).h2:=s5ELSEx3.q2:= +s5END IF;d7.i2:=x3.s2;x3.s2:=z6.index:x3.index(s5).d7:x3.index(z6).END PROCx6;PROCy6(DATEI VARx3):INT CONSTb4:=x3.satznr;o4(x3,1,1,1);q4(x3,b4)END PROCy6;PROCg7(DATEI VARx3,INTVEC CONSTl2,INT CONSTs5):INT VARl0;FORl0FROM1UPTOlength(l2)DIV2REPx3.d3(l2ISUBl0).m2:=s5END REP END PROCg7;PROCt6(DATEI VARx3,INT CONSTi7):INT VARw2:=x3.w2;IFindex.j2>=f2THENj7END IF;index.j2INCR1;insert(index.l2,x3.x2,i7);x3.y2:=i7;x3.d3(i7).m2:=w2.j7:INT VARu6:=0;k7;IFu6<>0THENl7ELSEm7(x3)END IF;y6(x3);w2:=x3.w2.k7:IFx3.s2<>0THENu6:=x3.s2;x3.s2:=d7.i2ELIFx3.r20THENx3.index(q7).h2:=u6ELSEx3.q2:=u6END IF;d7.i2:=q7;d7.h2:=w2;index.i2:=u6.o7:INT VARp7;IFr7THENp7:=g2ELSEp7:=index.j2DIV2+1END IF.r7:q7=0.index:x3.index(w2).d7:x3.index(u6).END PROCt6;PROCm7(DATEI VARx3):INT VARw2:=1;REPs7;t7END REP.s7:BOOL VARw6;REP INT CONSTi2:=index.i2;x6(x3,w2,i2,w6)UNTIL NOTw6 +END REP;IFi2=0THEN LEAVEm7ELIFu7THENv7END IF.u7:INT CONSTw7:=g2-index.j2;w7>0.v7:v3(d7.l2,v6,w7+1);d7.j2DECRw7;g7(x3,v6,w2);index.l2CATv6;index.j2:=g2.t7:w2:=i2.index:x3.index(w2).d7:x3.index(i2).END PROCm7;TEXT VARx7:=",";LETy7=1;TEXT PROCdezimalkomma:x7END PROCdezimalkomma;PROCdezimalkomma(TEXT CONSTz7):IFlength(z7)<>1THENerrorstop(h3)ELSEx7:=z7ENDIF END PROCdezimalkomma;INT PROCunsortiertesaetze(EUDAT CONSTx3):x3.z2END PROCunsortiertesaetze;TEXT PROCsortierreihenfolge(EUDAT CONSTx3):x3.p2END PROCsortierreihenfolge;PROCe4(DATEI VARx3):IFa8(x3)THENdisablestop;x3.d3(x3.y2).n2INCRy7;x3.z2INCR1END IF END PROCe4;PROCq6(DATEI VARx3):IF NOTa8(x3)THENdisablestop;x3.d3(x3.y2).n2DECRy7;x3.z2DECR1END IF END PROCq6;BOOL PROCa8(DATEI CONSTx3,INT CONSTk2):(x3.d3(k2).n2ANDy7)=0END PROCa8;BOOL PROCa8(DATEI CONSTx3):a8(x3,x3.y2)END PROCa8;INTVEC VARb8;TEXT VARp2;TEXT VARc8,d8;PROCsortiere(EUDAT VARx3):p2:=x3.p2;IFp2=e0THENe8END IF;f8(CONCR(x3)).e8:INT VARl0;FORl0FROM1UPTOx3.felderzahlREPp2CATcode(l0) +END REP.END PROCsortiere;PROCsortiere(EUDAT VARx3,TEXT CONSTk0):p2:=k0;f8(CONCR(x3))END PROCsortiere;PROCf8(DATEI VARx3):IFx3.p2<>p2THENx3.p2:=p2;x3.z2:=x3.v2+1ELIFx3.z2=0THEN LEAVEf8END IF;b8:=x3.feldinfo;IFg8THENh8(x3)ELSEi8(x3)END IF;q4(x3,1).g8:x3.v2DIVx3.z2<3.END PROCf8;PROCh8(DATEI VARx3):INT VARy2,j0:=1,j8;q4(x3,1);q6(x3);y2:=x3.y2;WHILEk8REPl8;m8;cout(j0)END REP;disablestop;m7(x3);o4(x3,1,1,1).k8:j0t1REPb5(x3);IFx8THEN LEAVEw8END IF END REP;LEAVEp8.x8:a8(x3).u8:IF +y8GROESSERx3.d3(y2).j0THENu1:=r8-1ELSEt1:=r8+1END IF.y8:x3.d3(v8).j0.q8:i5(x3,y2);IFx3.satznrj9THEN LEAVEz8END IF.f9:IF NOT(c8LEXEQUALd8)THEN LEAVEz8END IF.h9:IFc8<>d8THEN LEAVEz8END IF.c9:i9>j9.b9:c8LEXGREATERd8.d9:k9(c8);k9(d8);c8>d8.e9:c8>d8.END OP GROESSER;PROCwertberechnen(TEXT CONSTl9,REAL VARwert):LETm9="0123456789";TEXT VARn9:=x7,text;INT VARk2;INT CONSTo9:=length(l9);p9;WHILEk2<=o9REPq9;k2INCR1END REP;wert:=real(text).p9:k2:=pos(l9,"0","9",1);IFk2=0THENwert:=0.0;LEAVEwertberechnenELIFpos(l9,"-",1,k2)>0THENtext:="-"ELSEtext:=e0END IF;.q9:TEXT +CONSTr9:=l9SUBk2;IFpos(m9,r9)>0THENtextCATr9ELIFr9=n9THENtextCAT".";n9:=e0END IF.END PROCwertberechnen;PROCk9(TEXT VARs9):IFlength(s9)<>8THENs9:=e0ELSEs9:=subtext(s9,7)+subtext(s9,4,5)+subtext(s9,1,2)END IF END PROCk9;PROCreorganisiere(TEXT CONSTz3):EUDAT VARt9,u9;oeffne(t9,z3);disablestop;DATASPACE VARa4:=nilspace;oeffne(u9,a4);v9(CONCR(t9),u9);IF NOTiserrorTHENforget(z3,quiet);copy(a4,z3)END IF;forget(a4)END PROCreorganisiere;PROCv9(DATEI VARt9,EUDAT VARu9):enablestop;w9;x9(t9,CONCR(u9)).w9:q4(t9,1);aufsatz(u9,1);WHILE NOTdateiendeREPsatzeinfuegen(u9,y9);cout(t9.satznr);y4(t9);weiter(u9)END REP.dateiende:t9.satznr>t9.v2.y9:t9.d3(t9.y2).j0.END PROCv9;PROCx9(DATEI VARt9,u9):u9.felderzahl:=t9.felderzahl;u9.o2:=t9.o2;u9.feldinfo:=t9.feldinfo;u9.p2:=t9.p2;u9.b3(1):=t9.b3(1);u9.b3(2):=t9.b3(2);u9.b3(3):=t9.b3(3)END PROCx9;PROCnotizenlesen(EUDAT CONSTx3,INT CONSTp4,TEXT VARz9):z9:=x3.b3(p4)END PROCnotizenlesen;PROCnotizenaendern(EUDAT VARx3,INT CONSTp4,TEXT CONSTz9):x3.b3(p4):=z9END PROC +notizenaendern;END PACKETeudasdateien; +PACKETdatenverwaltungDEFINESoeffne,kopple,kette,zugriff,sichere,dateienloeschen,anzahlkoppeldateien,anzahldateien,aendernerlaubt,inhaltveraendert,eudasdateiname,dateiversion,anzahlfelder,feldnamenlesen,feldnamenbearbeiten,feldnummer,feldinfo,feldlesen,feldbearbeiten,feldaendern,satznummer,satzkombination,dateiende,weiter,zurueck,aufsatz,satzeinfuegen,satzloeschen,aenderungeneintragen,suchbedingung,suchbedingungloeschen,suchversion,satzausgewaehlt,markierungaendern,satzmarkiert,markierungenloeschen,markiertesaetze:LET INTVEC=TEXT,DATEI=STRUCT(TEXTname,SATZo2,INTVECa10,INTb10,INTc10,DATASPACEa4,EUDATd10,SATZe10,BOOLf10,BOOLg10,h10,i10,TEXTx1,INTVECj10,INTk10),VERWEIS=STRUCT(INTx3,p5);LETe0="",m3="";LETmaxint=32767,l10=10,m10=256,n10=32;ROWl10DATEI VARo10;INT VARp10:=0,q10:=0,r10,s10:=0,t10,u10:=0,v10,w10,x10,y10:=0;BOOL VARz10:=TRUE,a11,b11;TEXT VARc11;ROWm10VERWEIS VARd11;ROWn10VERWEIS VARe11;INT VARf11;LETg11="Zuviel Dateien geoeffnet",h11="Datei existiert nicht",i11="Zu viele Felder", +j11="Zu viele Koppelfelder",k11="keine Koppelfelder vorhanden",l11="kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien",m11="keine Datei geoeffnet",n11="Datei nicht gesichert",o11="Suchmuster zu umfangreich";TEXT VARi3;TEXT VARg0:=" ";INTVEC VARx0;OP CAT(INTVEC VARtext,INT CONSTwert):replace(g0,1,wert);textCATg0END OP CAT;PROCinsert(INTVEC VARp3,INT CONSTk2,wert):INT CONSTp11:=k2+k2-2;x0:=subtext(p3,p11+1);p3:=subtext(p3,1,p11);p3CATwert;p3CATx0END PROCinsert;PROCdelete(INTVEC VARp3,INT CONSTk2):INT CONSTp11:=k2+k2-2;x0:=subtext(p3,p11+3);p3:=subtext(p3,1,p11);p3CATx0END PROCdelete;PROCq11(INTVEC VARp3,INT CONSTr11,s11):INT VARl0;FORl0FROMr11UPTOlength(p3)DIV2-1REPreplace(p3,l0,(p3ISUBl0)+s11)END REP END PROCq11;EUDAT VARt11;SATZ VARi4;PROCu11(TEXT CONSTz3):IFp10=l10THENerrorstop(g11)END IF;IF NOTexists(z3)THENerrorstop(h11)END IF;oeffne(t11,z3)END PROCu11;PROCv11(DATEI VARx3,TEXT CONSTz3):IFa11THENx3.a4:=old(z3);oeffne(x3.d10,x3.a4)ELSEoeffne(x3.d10,z3)END IF;x3.c10:= +0;x3.g10:=FALSE;x3.h10:=FALSE;x3.name:=z3;w11(x3)END PROCv11;PROCx11(INT CONSTt1):INT VARy11:=t1;WHILEo10(y11).c10<>0REPy11:=o10(y11).c10END REP;o10(y11).c10:=p10END PROCx11;PROCz11:IFdateiende(o10(1).d10)THENaufsatz(1)ELSEaufsatz(satznr(o10(1).d10))END IF END PROCz11;PROCa12:t10:=felderzahl(o10(1).d10);u10:=t10;feldnamenlesen(o10(1).d10,o10(1).o2);f11:=0;INT VARl0;FORl0FROM1UPTOu10REPd11(l0).x3:=0END REP END PROCa12;PROCb12:y10INCR1;IFy10>32000THENy10:=-32000END IF END PROCb12;PROCoeffne(TEXT CONSTz3,BOOL CONSTc12):enablestop;suchbedingungloeschen;dateienloeschen(FALSE);u11(z3);a11:=c12;d12;v11(o10(p10),z3);z11;a12.d12:p10:=1;b12;x10:=0.END PROCoeffne;PROCkopple(TEXT CONSTz3):enablestop;IFp10=0THENerrorstop(m11)END IF;u11(z3);e12;f12;g12;v11(o10(p10),z3);h12.e12:feldnamenlesen(t11,i4);INT VARa10:=0;INTVEC VARi12:=m3;WHILEa100THENa10INCR1;i12CATindexEND IF UNTILindex=0END REP.f12:IFu10+felderzahl( +t11)-a10>m10THENerrorstop(i11)ELIFf11+a10>n10THENerrorstop(j11)ELIFa10=0THENerrorstop(k11)END IF;p10INCR1;o10(p10).o2:=i4;o10(p10).a10:=i12;o10(p10).b10:=a10;INT VARp0:=a10;WHILEp0=n12THENd11(i7).x3INCR1END IF END REP.g12:q10INCR1;IFs10=0THENs10:=p10ELSEx11(s10)END IF.h12:b12;o10(p10).f10:=FALSE;o10(p10).i10:=FALSE;p12(o10(p10)).END PROCkopple;PROCkette(TEXT CONSTz3):enablestop;IFp10=0THENerrorstop(m11)END IF;u11(z3);p10INCR1;v11(o10(p10),z3);x11(1);IFz10THENaufsatz(satznummer)END IF END PROCkette;PROCzugriff(PROC(EUDAT VAR)q12):IFp10>1THEN +errorstop(l11)ELSEaenderungeneintragen;q12(o10(1).d10);z11;a12;o10(1).h10:=TRUE ENDIF END PROCzugriff;PROCsichere(INT CONSTr12,TEXT CONSTz3):aenderungeneintragen;notizenaendern(o10(r12).d10,2,date);IFa11THENforget(z3,quiet);copy(o10(r12).a4,z3)END IF;o10(r12).h10:=FALSE END PROCsichere;PROCdateienloeschen(BOOL CONSTs12):aenderungeneintragen;t12;u12.t12:q10:=0;s10:=0;o10(1).c10:=0;u10:=0;z10:=TRUE.u12:WHILEp10>0REP IFv12AND NOTs12THENerrorstop(n11);LEAVEdateienloeschenEND IF;forget(o10(p10).a4);p10DECR1END REP.v12:a11ANDo10(p10).h10.END PROCdateienloeschen;INT PROCanzahlkoppeldateien:q10END PROCanzahlkoppeldateien;INT PROCanzahldateien:p10END PROCanzahldateien;BOOL PROCaendernerlaubt:a11END PROCaendernerlaubt;BOOL PROCinhaltveraendert(INT CONSTw12):aenderungeneintragen;o10(w12).h10END PROCinhaltveraendert;TEXT PROCeudasdateiname(INT CONSTw12):o10(w12).nameEND PROCeudasdateiname;INT PROCdateiversion:y10END PROCdateiversion;INT PROCanzahlfelder:u10END PROCanzahlfelder;PROCfeldnamenlesen( +INT CONSTp0,TEXT VARname):IFp0<=t10THENfeldlesen(o10(1).o2,p0,name)ELSEfeldlesen(x12,y12,name)END IF.x12:o10(d11(p0).x3).o2.y12:d11(p0).p5.END PROCfeldnamenlesen;PROCfeldnamenbearbeiten(INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):IFp0<=t10THENfeldbearbeiten(o10(1).o2,p0,PROC(TEXT CONST,INT CONST,INT CONST)u0)ELSEfeldbearbeiten(x12,y12,PROC(TEXT CONST,INT CONST,INT CONST)u0)END IF.x12:o10(d11(p0).x3).o2.y12:d11(p0).p5.END PROCfeldnamenbearbeiten;INT PROCfeldnummer(TEXT CONSTz12):INT VARa13:=t10,p4:=feldindex(o10(1).o2,z12),y11:=s10;WHILEp4=0ANDy11<>0REPp4:=feldindex(o10(y11).o2,z12);b13;y11:=o10(y11).c10END REP;p4.b13:INT CONSTc13:=o10(y11).b10;IFp4=0THENa13INCRfelderzahl(o10(y11).d10);a13DECRc13ELSEp4INCRa13;p4DECRc13END IF.END PROCfeldnummer;INT PROCfeldinfo(INT CONSTp0):IFp0<=t10THENfeldinfo(o10(1).d10,p0)ELSEfeldinfo(o10(x12).d10,y12)END IF.x12:d11(p0).x3.y12:d11(p0).p5.END PROCfeldinfo;PROCfeldlesen(INT CONSTp0,TEXT VARq0):IFp0<=t10THENfeldlesen(o10(r10).d10,p0,q0)ELSEd13 +END IF.d13:INT CONSTx12:=d11(p0).x3;IFo10(x12).f10THENfeldlesen(o10(x12).e10,y12,q0)ELSEfeldlesen(o10(x12).d10,y12,q0)END IF.y12:d11(p0).p5.END PROCfeldlesen;PROCfeldbearbeiten(INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):IFp0<=t10THENfeldbearbeiten(o10(r10).d10,p0,PROC(TEXT CONST,INT CONST,INT CONST)u0)ELSEe13END IF.e13:INT CONSTx12:=d11(p0).x3;IFo10(x12).f10THENfeldbearbeiten(o10(x12).e10,y12,PROC(TEXT CONST,INT CONST,INT CONST)u0)ELSEfeldbearbeiten(o10(x12).d10,y12,PROC(TEXT CONST,INT CONST,INT CONST)u0)END IF.y12:d11(p0).p5.END PROCfeldbearbeiten;PROCfeldaendern(INT CONSTp0,TEXT CONSTq0):INT CONSTx12:=d11(p0).x3;IFp0<=t10THENf13ELSEg13END IF.f13:o10(r10).h10:=TRUE;IFh13CANDi13THENj13END IF;feldaendern(o10(r10).d10,p0,q0).h13:x12>0.i13:feldlesen(o10(r10).d10,p0,i3);i3<>q0.j13:INT VARk13:=y12,l13:=x12;REPm13(o10(n13));o10(n13).i10:=TRUE;feldaendern(o10(n13).e10,k12,q0);l13INCR1;k13DECR1UNTILk13=0END REP.g13:m13(o10(x12));IFo13THENo10(x12).g10:=TRUE;feldaendern(o10(x12).e10,y12 +,q0)END IF.o13:feldlesen(o10(x12).e10,y12,i3);i3<>q0.y12:d11(p0).p5.n13:e11(l13).x3.k12:e11(l13).p5.END PROCfeldaendern;PROCm13(DATEI VARx3):IF NOTx3.f10THENx3.f10:=TRUE;p13END IF.p13:IFdateiende(x3.d10)THENsatzinitialisieren(x3.e10,x3.b10);q13ELSEsatzlesen(x3.d10,x3.e10)END IF.q13:INT VARl0;FORl0FROM1UPTOx3.b10REPfeldlesen(x3.a10ISUBl0,i3);feldaendern(x3.e10,l0,i3)END REP.END PROCm13;PROCp12(DATEI VARx3):r13;s13.r13:feldlesen(o10(r10).d10,t13,x1).t13:x3.a10ISUB1.x1:x3.x1.s13:aufsatz(x3.d10,x1);WHILE NOTu13(x3)REPweiter(x3.d10,x1)END REP;IFdateiende(x3.d10)THENm13(x3)ELSEx3.f10:=FALSE END IF.END PROCp12;PROCv13:INT VARy11:=s10;WHILEy11<>0REPp12(o10(y11));y11:=o10(y11).c10END REP;w10:=1END PROCv13;BOOL PROCu13(DATEI CONSTx3):IF NOTdateiende(x3.d10)THENw13END IF;TRUE.w13:INT VARx13;FORx13FROM2UPTOx3.b10REPfeldlesen(o10(r10).d10,a10ISUBx13,i3);feldbearbeiten(x3.d10,x13,PROC(TEXT CONST,INT CONST,INT CONST)y13);IF NOTz13THEN LEAVEu13WITH FALSE END IF END REP.a10:x3.a10.END PROCu13;BOOL VAR +z13;PROCy13(TEXT CONSTj0,INT CONSTt1,u1):z13:=length(i3)+t1=u1+1CANDpos(j0,i3,t1,u1+1)=t1END PROCy13;LETa14=22101,b14="h",c14=""27"";BOOL VARd14;PROCe14:TEXT VARf14;d14:=FALSE;REPf14:=incharety;type(f14)UNTILf14=e0END REP END PROCe14;PROCg14:IFd14THENtype(c14)END IF END PROCg14;BOOL PROCh14:TEXT VARf14;REPf14:=incharety;IFf14=e0THEN LEAVEh14WITH FALSE ELSEi14END IF END REP;FALSE.i14:IFd14THENd14:=FALSE;j14ELSEk14END IF.j14:IFf14=b14THENl14;errorstop(a14,e0);LEAVEh14WITH TRUE ELSEtype(c14);type(f14)END IF.k14:IFf14=c14THENd14:=TRUE ELSEtype(f14)END IF.l14:REP UNTILgetcharety=e0END REP.END PROCh14;PROCweiter(INT CONSTm14):IF NOTz10THENaenderungeneintragen;n14END IF.n14:SELECTm14OF CASE1:o14CASE2:p14CASE3:q14END SELECT.o14:r14(FALSE).p14:e14;REPr14(b11);cout(satznummer)UNTILsatzausgewaehltORz10ORh14END REP;g14.q14:INT VARs14:=satznr(o10(r10).d10);WHILEt14ANDc10<>0REPu14;s14:=1END REP;aufsatz(o10(r10).d10,v14);cout(satznummer);v13;z10:=dateiende(o10(r10).d10);w14.t14:x14(o10(r10),s14+1); +INT CONSTv14:=o10(r10).j10ISUBo10(r10).k10;v14<>maxint.c10:o10(r10).c10.END PROCweiter;PROCzurueck(INT CONSTm14):IFsatznummer>1THENaenderungeneintragen;y14END IF.y14:SELECTm14OF CASE1:z14CASE2:a15CASE3:b15END SELECT.z14:c15(FALSE).a15:e14;REPc15(b11);cout(satznummer)UNTILsatzausgewaehltORsatznummer=1ORh14END REP;g14.b15:INT VARs14:=satznr(o10(r10).d10);WHILEt14ANDr10<>1REPd15;s14:=maxint-1END REP;aufsatz(o10(r10).d10,f6);cout(satznummer);v13;z10:=FALSE;w14.t14:INT VARf6;x14(o10(r10),s14);IFo10(r10).k10=1THENf6:=1;TRUE ELSEf6:=o10(r10).j10ISUB(o10(r10).k10-1);FALSE END IF.END PROCzurueck;PROCr14(BOOL CONSTe15):f15;IFg15THENo14;v13ELSEw10INCR1END IF;w14.f15:INT VARy11:=s10;WHILEy11>0REPh15;y11:=o10(y11).c10END REP.h15:BOOL VARi15;j15(o10(y11),i15);IFi15THEN LEAVEf15END IF.g15:y11=0.o14:IFe15THENweiter(o10(r10).d10,c11)ELSEweiter(o10(r10).d10)END IF;WHILEdateiende(o10(r10).d10)REPk15UNTILz10END REP.k15:IFo10(r10).c10<>0THENu14;l15ELSEz10:=TRUE END IF.l15:aufsatz(o10(r10).d10,1).END PROC +r14;PROCj15(DATEI VARx3,BOOL VARi15):IFdateiende(x3.d10)THENi15:=FALSE ELSEm15END IF.m15:i15:=TRUE;REPweiter(x3.d10,x3.x1);IFdateiende(x3.d10)THENi15:=FALSE;aufsatz(x3.d10,x3.x1)END IF UNTILu13(x3)END REP.END PROCj15;PROCc15(BOOL CONSTe15):WHILEsatznr(o10(r10).d10)=1CANDsatznummer>1REPd15;n15(o10(r10).d10)END REP;IFe15THENzurueck(o10(r10).d10,c11)ELSEzurueck(o10(r10).d10)END IF;z10:=FALSE;v13;w14END PROCc15;PROCu14:v10INCRsaetze(o10(r10).d10);r10:=o10(r10).c10END PROCu14;PROCd15:INT VARu6:=1;WHILEo10(u6).c10<>r10REPu6:=o10(u6).c10END REP;v10DECRsaetze(o10(u6).d10);r10:=u6END PROCd15;PROCaenderungeneintragen:INT VARy11:=s10;WHILEy11<>0REPo15;y11:=o10(y11).c10END REP.o15:IFo10(y11).f10THENp15(o10(y11))END IF.END PROCaenderungeneintragen;PROCp15(DATEI VARx3):IFq15AND NOTr15THENs15ELIFt15ANDu15THENv15ELIFr15THENp12(x3)END IF;w15;g10:=FALSE;r15:=FALSE.q15:NOTdateiende(x3.d10)ANDg10.t15:felderzahl(e10)>x3.b10.u15:r15ORg10.v15:h10:=TRUE;feldlesen(e10,1,x3.x1);satzeinfuegen(x3.d10,e10).w15:x3. +f10:=FALSE.s15:h10:=TRUE;satzaendern(x3.d10,e10).g10:x3.g10.r15:x3.i10.e10:x3.e10.h10:x3.h10.END PROCp15;PROCn15(EUDAT VARd10):aufsatz(d10,saetze(d10)+1)END PROCn15;PROCaufsatz(INT CONSTsatznr):aenderungeneintragen;r10:=1;v10:=0;WHILEx15ANDy15REPu14END REP;aufsatz(o10(r10).d10,satznr-v10);v13;z10:=dateiende(o10(r10).d10);w14.x15:satznr-v10>saetze(o10(r10).d10).y15:o10(r10).c10<>0.END PROCaufsatz;INT PROCsatznummer:v10+satznr(o10(r10).d10)END PROCsatznummer;INT PROCsatzkombination:w10END PROCsatzkombination;BOOL PROCdateiende:z10END PROCdateiende;SATZ VARy3;satzinitialisieren(y3);PROCsatzeinfuegen:aenderungeneintragen;z15;satzeinfuegen(o10(r10).d10,y3);o10(r10).h10:=TRUE;a16;z10:=FALSE;w14.z15:x14(o10(r10),satznr(o10(r10).d10));q11(o10(r10).j10,o10(r10).k10,1).a16:w10:=1;INT VARy11:=s10;WHILEy11<>0REPn15(o10(y11).d10);y11:=o10(y11).c10END REP.END PROCsatzeinfuegen;PROCsatzloeschen:IF NOTz10THENaenderungeneintragen;b16;satzloeschen(o10(r10).d10);o10(r10).h10:=TRUE;aufsatz(satznummer)END +IF.b16:IFsatzmarkiertTHENdelete(o10(r10).j10,o10(r10).k10);x10DECR1END IF;q11(o10(r10).j10,o10(r10).k10,-1).END PROCsatzloeschen;LETc16=100;ROWc16STRUCT(INTp5,d16,e16,f16,TEXTx1)VARg16;INT VARh16,i16,j16:=1;BOOL VARk16,l16;suchbedingungloeschen;INT VARm16;LETn16=1,o16=2,p16=3,q16=4,r16=5,s16=6,t16=7,u16=8,v16=9;PROCw14:IFz10THENl16:=FALSE ELSEw16;l16:=x16END IF.w16:m16:=i16;WHILEm16>0REPfeldbearbeiten(y16,PROC(TEXT CONST,INT CONST,INT CONST)z16)END REP.y16:g16(m16).p5.x16:m16<0.END PROCw14;PROCz16(TEXT CONSTj0,INT CONSTq5,r5):IFa17THENm16:=g16(m16).e16ELSEm16:=g16(m16).f16END IF.a17:SELECTg16(m16).d16OF CASEn16:b17CASEo16:c17CASEp16:d17CASEq16:e17CASEr16:f17CASEs16:g17CASEt16:h17CASEu16:i17CASEv16:j17OTHERWISE FALSE END SELECT.b17:SELECTk17OF CASE0:l17;i3LEXEQUALx1CASE1:l17;m17=n17OTHERWISElength(x1)=r5-q5+1ANDc17END SELECT.c17:pos(j0,x1,q5,r5+1)=q5.d17:pos(j0,x1,r5+1-length(x1),r5+1)>0.e17:pos(j0,x1,q5,r5+1)>0.f17:l17;SELECTk17OF CASE0:x1LEXGREATERi3CASE1:m17=n17CASE2:o17;i3>=x1OTHERWISEi3>=x1END SELECT.h17:q5<=r5.i17:satzmarkiert.j17:TRUE.l17:i3:=subtext(j0,q5,r5).END PROCz16;TEXT PROCx1:g16(m16).x1END PROCx1;PROCo17:IFlength(i3)=8THEN TEXT CONSTp17:=subtext(i3,7,8);replace(i3,7,subtext(i3,1,2));replace(i3,1,p17)ELSEi3:=e0END IF END PROCo17;INT PROCk17:feldinfo(g16(m16).p5)END PROCk17;REAL PROCm17:REAL VARd8;wertberechnen(i3,d8);d8END PROCm17;REAL PROCn17:REAL VARd8;wertberechnen(x1,d8);d8END PROCn17;LETq17=";",r17=",",s17="..",t17="++",u17="--",v17="*";BOOL VARw17,x17,y17;INT VARz17,a18,b18,c18,d18;INTVEC VARe18;PROCsuchbedingung(INT CONSTp0,TEXT CONSTg16):INT VARt1:=1,f18:=0;INT CONSTg18:=length(g16)+1;a18:=0;d18:=p0;z17:=h16+1;WHILEt11THENb11:=FALSE END IF;f18:=pos(g16,q17,t1);IFf18=0THENf18 +:=g18END IF.i18:l18;x17:=TRUE;INT CONSTm18:=pos(g16,s17,t1,u1+1);IFn18THENo18(e0,v16,-a18)ELIFm18=0THENe9ELSEp18END IF.l18:IFsubtext(g16,t1,t1+1)=u17THENt1INCR2;y17:=TRUE ELSEy17:=FALSE END IF.n18:t1>u1.e9:IFq18THENr18ELSEs18END IF.q18:t1+1=u1CANDsubtext(g16,t1,u1)=t17.r18:o18(e0,u16,-a18).s18:INT VARt18:=pos(g16,v17,t1,u1+1);IFt18=0THENu18ELIFt1=u1THENv18ELSEw18;REPx18END REP END IF.u18:IFy18AND NOTb11THENb11:=TRUE;c11:=g16END IF;o18(subtext(g16,t1,u1),n16,-a18).y18:p0=1ANDt1=1ANDu1=g18-1.v18:o18(e0,t16,-a18).w18:INT VARd16;IFt18=t1THENd16:=n16ELSEd16:=o16END IF.x18:IFd16<>n16THENz18END IF;t1:=t18+1;t18:=pos(g16,v17,t1,u1+1);IFt18=0THENt18:=u1+1;d16:=p16ELSEd16:=q16END IF.z18:TEXT CONSTx1:=subtext(g16,t1,t18-1);IFy17ORa19THEN IFy17THENx17:=TRUE END IF;o18(x1,d16,-a18);IFa19THEN LEAVEs18END IF ELSEo18(x1,d16,h16+2)END IF.a19:t18>=u1.p18:TEXT CONSTb19:=subtext(g16,t1,m18-1),c19:=subtext(g16,m18+2,u1);IFm18=t1THENo18(c19,r16,-a18)ELIFm18=u1-1THENo18(b19,s16,-a18)ELSEd19END IF.d19:IFy17 +THENo18(b19,s16,-a18);x17:=TRUE ELSEo18(b19,s16,h16+2)END IF;o18(c19,r16,-a18).END PROCsuchbedingung;PROCo18(TEXT CONSTe19,INT CONSTd16,e16):f19;g19;IFw17THENh19;i19;c18:=h16ELIFx17THENj19END IF;k19;l19.f19:k16:=FALSE;IFh16=0THENj16INCR1;IFj16>32000THENj16:=1END IF END IF.g19:IFh16=c16THENsuchbedingungloeschen;errorstop(o11)ELSEh16INCR1;i16:=1END IF.h19:IFa18>length(e18)DIV2THENe18CATh16;m19(1,0,h16)END IF;IFa18=length(e18)DIV2THENb18:=0ELSEb18:=e18ISUB(a18+1)END IF.i19:m19(1,-a18,h16);w17:=FALSE;x17:=FALSE.j19:m19(c18,b18,h16);c18:=h16;x17:=FALSE.k19:g16(h16).x1:=e19;INT CONSTn19:=feldinfo(d18);IFn19=2AND(d16=r16ORd16=s16)THENi3:=g16(h16).x1;o17;g16(h16).x1:=i3END IF.l19:g16(h16).d16:=d16;g16(h16).p5:=d18;IFy17THENg16(h16).e16:=b18;g16(h16).f16:=e16ELSEg16(h16).e16:=e16;g16(h16).f16:=b18END IF.END PROCo18;PROCm19(INT CONSTq5,wert,o19):INT VARl0;FORl0FROMq5UPTOh16-1REP IFg16(l0).e16=wertTHENg16(l0).e16:=o19ELIFg16(l0).f16=wertTHENg16(l0).f16:=o19END IF END REP END PROCm19;PROC +suchbedingungloeschen:disablestop;h16:=0;i16:=-1;e18:=m3;b11:=FALSE;k16:=TRUE;l16:=NOTz10END PROCsuchbedingungloeschen;BOOL PROCsatzausgewaehlt:IF NOTk16THENw14;k16:=TRUE END IF;l16END PROCsatzausgewaehlt;INT PROCsuchversion:IFh16=0THEN0ELSEj16END IF END PROCsuchversion;PROCx14(DATEI VARx3,INT CONSTj0):IF(x3.j10ISUBx3.k10)=j0END REP.v4:WHILEx3.k10>1CAND(x3.j10ISUB(x3.k10-1))>=j0REPx3.k10DECR1END REP.END PROCx14;PROCmarkierungaendern:disablestop;IFsatzmarkiertTHENdelete(o10(r10).j10,o10(r10).k10);x10DECR1ELSEinsert(o10(r10).j10,o10(r10).k10,satznr(o10(r10).d10));x10INCR1END IF END PROCmarkierungaendern;BOOL PROCsatzmarkiert:INT CONSTj0:=satznr(o10(r10).d10);x14(o10(r10),j0);j0=(o10(r10).j10ISUBo10(r10).k10)END PROCsatzmarkiert;INT PROCmarkiertesaetze:x10END PROCmarkiertesaetze;PROCmarkierungenloeschen:disablestop;INT VARy11:=1;REPw11(o10(y11));y11:=o10(y11).c10UNTILy11=0END REP;x10:=0END PROCmarkierungenloeschen;PROCw11( +DATEI VARx3):x3.j10:=e0;x3.j10CATmaxint;x3.k10:=1END PROCw11;END PACKETdatenverwaltung; + diff --git a/app/eudas/3.4/src/eudas.2 b/app/eudas/3.4/src/eudas.2 new file mode 100644 index 0000000..427b4f8 --- /dev/null +++ b/app/eudas/3.4/src/eudas.2 @@ -0,0 +1,25 @@ +PACKETeudasdruckenDEFINESdrucke,interpretiere,gruppentest,druckdatei,direktdrucken,maxdruckzeilen,gruppenwechsel,lfdnr:LETb0=25,SPEICHER=STRUCT(INTc0,d0,e0,f0,TEXTg0);ROWb0SPEICHER VARh0;INT VARi0;LETj0="",k0=" ",l0=" ";TEXT VARm0;PROCinterpretiere(INT CONSTn0,o0,PROC(INT CONST,TEXT VAR)p0):INT VARq0,r0:=0,s0:=0,t0:=o0;u0(n0);WHILE NOTv0REPw0;IFx0THENr0INCR1ELSEy0;z0END IF END REP.z0:IFa1(q0)THENb1ELSEc1;s0:=0END IF.b1:SELECTq0OF CASEd1:e1CASEf1:g1OTHERWISE LEAVEinterpretiereEND SELECT.y0:WHILEr0>0REPh1(k0);r0DECR1END REP.e1:i1(i0).g1:i1(s0).x0:j1=j0ORj1=k0.c1:INT VARk1:=0,l1:=0;BOOL VARm1:=FALSE;REPn1;k1INCR1;IFi0=3THENm1:=TRUE END IF UNTILo1END REP.o1:IFi0<=2THEN TRUE ELIFs0<>0THENk1=s0ELSEl1=0END IF.n1:INT VARp1:=1,q1:=0,r1:=0,s1:=1,t1:=1;m0:=j0;REP IFu1THENv1END IF;IFw1THENx1END IF;y1;s1INCR1END REP.u1:k1=0.v1:z1(a2.c0,a2.d0,a2.e0);IF NOTb2THENc2END IF.b2:a2.c0>length(j1).c2:INT CONSTd2:=e2(t0);IFd2>0THENfeldlesen(d2,a2.g0)ELSEp0(-d2,a2.g0)END IF;t0INCR1;a2.f0:=0;IFa2.g0<>j0THENl1 +INCR1END IF.w1:a2.e0>=4.a2:h0(s1).y1:INT CONSTf2:=g2(a2);IFf2>0THENh2ELSEr1DECRf2END IF.h2:q1INCRf2;IFi2ANDq1>r1THENq1:=r1END IF;IFj2ANDk2THENl2END IF.i2:i0=2ORi0=4.j2:f2=a2.d0.k2:(a2.e0AND1)=0.l2:IF(j1SUB(a2.c0-1))=k0THEN INT VARm2:=n2(s1);WHILE(j1SUBm2)=k0REPm2INCR1;a2.d0INCR1;q1INCR1END REP END IF.x1:IFs1=1THEN IFb2THENo2END IF ELSEp2END IF.o2:IFm1THENh1(k0)ELSEh1(j1)END IF;LEAVEn1.p2:INT VARq2:=0,r2:=a2.c0;INT CONSTs2:=r2-length(j1);t2;u2;v2;w2.t2:IFs2>0THENq1INCRs2;r2DECR(s2-1)END IF;x2.x2:INT CONSTy2:=n2(s1-1),z2:=pos(j1,l0,y2,r2);IFz2>0THENr2:=z2;a3ELIFs2<0AND(j1SUB(r2-1))<>k0THENr2:=y2END IF.a3:INT VARb3:=r2+1;REPq2INCR1;b3INCR1UNTIL(j1SUBb3)<>k0END REP;q1INCRq2.u2:INT VARc3:=0;WHILEt1=3.z3:NOTb4.d4:IFr3THENq3(w3)END IF;f4(g3.g0,x3,y3);IFg4THENq3(w3)END IF.g4:NOTr3.c4:IFpos(g3.g0,k0,x3,y3+1)>0THENh4END IF;INT CONSTi4:=pos(g3.g0,"!","�",y3+1);IFi4=0THENg3.f0:=length(g3.g0);l1DECR1ELSEg3.f0:=i4-1END IF.h4:y3INCR1;w3DECR1;WHILE(g3.g0SUBy3)<>k0REPy3DECR1;w3INCR1END REP;WHILE(g3.g0SUBy3)=k0REPy3DECR1;w3INCR1UNTILm20THENj4;k4;LEAVEn1ELSEl4END IF.j4:IF NOTm1THENf4(j1,p1,length(j1))END IF.k4:INT VARm4:=length(m0);IF(m0SUBm4)=k0THEN REPm4DECR1UNTIL(m0SUBm4)<>k0END REP;m0:=subtext(m0,1,m4)END IF;IFn4 +THENm0CATk0END IF;h1(m0).n4:(j1SUB LENGTHj1)=k0AND(i0<3ORl1=0).l4:q1:=0;r1:=0.END PROCinterpretiere;INT PROCn2(INT CONSTo4):h0(o4).c0+h0(o4).d0END PROCn2;INT PROCg2(SPEICHER CONSTp4):p4.d0-length(p4.g0)+p4.f0END PROCg2;LETq4=" ";PROCq3(INT CONSTr4):INT VARs4:=r4;WHILEs4>=10REPm0CATq4;s4DECR10END REP;WHILEs4>0REPm0CATk0;s4DECR1END REP END PROCq3;PROCs3(SPEICHER VARp4):IFp4.f0=0THENm0CATp4.g0ELSEf4(p4.g0,p4.f0+1,length(p4.g0))END IF;p4.f0:=length(p4.g0)END PROCs3;PROCh3(INT CONSTt4,u4,BOOL CONSTm1):IFm1THENq3(u4-t4)ELSEf4(j1,t4,u4-1)END IF END PROCh3;TEXT VARv4;PROCf4(TEXT CONSTw4,INT CONSTt4,u4):v4:=subtext(w4,t4,u4);m0CATv4END PROCf4;FILE VARx4;TEXT VARj1;INT VARy4;LETz4="keine schliessende Klammer in Feldmuster",a5="kein Kommando in Kommandozeile",b5="unbekanntes Kommando";LETc5="&",d5="%",e5="%",f5="<",g5=">";LETh5=" "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR "LETi5=1,j5=2,k5=3,l5=4,m5=5,d1=6,f1=7,n5=100; +INT VARo5,p5,q5;BOOL VARv0,r5;.s5:lineno(x4).t5:o5:=maxlinelength(x4).PROCu5(TEXT CONSTv5):REPy4INCR1UNTIL(j1SUBy4)<>v5END REP END PROCu5;PROCz1(INT VARx3,w5,e0):x5;IFb2THENx3:=max(o5,length(j1))+1;w5:=0;e0:=5ELSEx3:=y4;y5END IF.x5:z5(c5,d5).b2:y4>length(j1).y5:TEXT CONSTa6:=j1SUBy4;IFa6=d5THENe0:=0ELSEe0:=4END IF;b6;feldnamenlesen;c6.b6:u5(a6);IFy4-1>x3THENd6END IF.d6:e0INCR3.feldnamenlesen:IF(j1SUBy4)=f5THENe6ELSEf6END IF;IFg6THENz1(x3,w5,e0);LEAVEz1END IF.g6:p5>q5.e6:p5:=y4+1;q5:=pos(j1,g5,p5);IFq5=0THENh6(z4,subtext(j1,y4));q5:=length(j1)ELSEq5DECR1END IF;y4:=q5+2.f6:p5:=y4;z5(k0,d5);INT CONSTi6:=pos(j1,c5,p5,y4);IFi6>0THENy4:=i6END IF;q5:=y4-1.c6:IFj6THENk6;u5(a6)END IF;w5:=y4-x3.j6:(j1SUBy4)=a6.k6:e0:=e0OR1.END PROCz1;PROCz1(TEXT VARname):INT VARl6,w5,m6;z1(l6,w5,m6);IFw5>0THENname:=subtext(j1,p5,q5)ELSEname:=j0END IF END PROCz1;PROCz5(TEXT CONSTn6,o6):INT CONSTp6:=pos(j1,n6,y4),q6:=pos(j1,o6,y4);y4:=length(j1)+1;IFp6>0THENy4:=p6END IF;IFq6>0ANDq6=lines(x4)END PROCw0;BOOL PROCa1(INT VARq0):y4:=1;IF(j1SUB1)<>e5THEN FALSE ELIF(j1SUB2)<>e5THENs6;t6;TRUE ELSEq0:=n5;TRUE END IF.s6:TEXT VARu6;u5(k0);IFy4>length(j1)THENh6(a5,j1);q0:=0;LEAVEa1WITH TRUE END IF;INT CONSTv6:=pos(j1,k0,y4);IFv6=0THENu6:=subtext(j1,y4);u6CATk0;y4:=length(j1)+1ELSEu6:=subtext(j1,y4,v6);y4:=v6END IF.t6:INT CONSTw6:=pos(h5,u6);IFw6>0CAND(h5SUB(w6-2))=k0THENq0:=code(h5SUB(w6-1))ELSEq0:=0;h6(b5,u6);END IF.END PROCa1;PROCi1(INT VARx6):u5(k0);INT CONSTy6:=y4;WHILEz6REPy4INCR1END REP;IFy4>y6THENx6:=int(subtext(j1,y6,y4-1))ELSEx6:=-1END IF.z6:pos("0123456789",j1SUBy4)>0.END PROCi1;FILE VARa7;TEXT VARb7;BOOL VARc7;PROCd7(TEXT CONSTname):b7:=name;e7("PROC ",name," :")END PROCd7;PROCf7:e7("END PROC ",b7,";")END PROCf7;PROCg7(TEXT CONSTh7):c7:=TRUE;putline(a7,h7)END PROCg7;PROCg7(TEXT CONSTi7,j7,k7):c7:=TRUE;e7(i7,j7,k7)END +PROCg7;PROCe7(TEXT CONSTi7,j7,k7):write(a7,i7);write(a7,j7);write(a7,k7);line(a7)END PROCe7;TEXT VARl7;PROCg7(TEXT CONSTi7,INT CONSTm7,TEXT CONSTk7):l7:=subtext(j1,m7);g7(i7,l7,k7)END PROCg7;PROCn7(INT CONSTr6,o7):e7("; interpretiere (",text(r6)+", "+text(o7),", PROC (INT CONST, TEXT VAR) abk);")END PROCn7;LETp7="kein % WIEDERHOLUNG gefunden",q7="Nur GRUPPE-Anweisung erlaubt",r7="keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition",s7="illegale Gruppennummer",t7="diese Gruppe wurde schon definiert",u7="diese Abkuerzung ist nicht definiert",v7="dieser Abschnitt wurde schon einmal definiert",w7="falscher Modus",x7="diese Anweisung darf im Musterteil nicht vorkommen",y7="im Abkuerzungsteil darf keine Anweisung auftreten",z7="in dieser Zeile stehen zu viele Feldmuster",a8="das Druckmuster enthaelt zu viele Feldmuster",b8="nach dem ""&"" soll direkt der Name einer Abkuerzung folgen",c8="kein Doppelpunkt nach Abkuerzung",d8="Abkuerzung mehrfach definiert",e8= +"das Druckmuster enthaelt zu viele Abkuerzungen";LETf8=200,g8=4,h8=250,GRUPPE=STRUCT(BOOLi8,j8,TEXTg0),ABSCHNITT=STRUCT(INTo0,n0,TEXTd7);ROWf8INT VARe2;INT VARk8;ROWg8GRUPPE VARl8;ROW3ABSCHNITT VARm8;SATZ VARp0;TEXT VARn8;INT VARo8;OP CAT(TEXT VARp8,INT CONSTwert):TEXT VARq8:=" ";replace(q8,1,wert);p8CATq8END OP CAT;PROCr8:enablestop;u0(1);s8;t8;WHILE NOTv0REPu8END REP;v8.s8:INT VARq0;INT VARw8;o8:=0;satzinitialisieren(p0);n8:=j0;k8:=0;c7:=FALSE;m8(1):=ABSCHNITT:(0,0,"vorspann");m8(2):=ABSCHNITT:(0,0,"wdh");m8(3):=ABSCHNITT:(0,0,"nachspann");FORw8FROM1UPTOg8REPl8(w8).j8:=FALSE END REP.t8:BOOL VARx8:=FALSE;REP IFv0THENh6(p7);LEAVEr8END IF;w0;IFa1(q0)THENy8END IF END REP.y8:SELECTq0OF CASEn5:z8CASEm5:a9CASEi5,j5,k5:IF NOTx8THENd7("gruppen")END IF;f7;LEAVEt8OTHERWISE IFq0>0THENh6(q7)END IF END SELECT.z8:IFx8THENh6(r7,j1)ELSEreplace(j1,1," ");g7(j1)END IF.a9:IF NOTx8THENd7("gruppen");x8:=TRUE END IF;INT VARb9;i1(b9);IFb9<1ORb9>g8THENh6(s7,"GRUPPE")ELIFl8(b9).j8THENh6(t7,"GRUPPE")ELSEl8( +b9).j8:=TRUE;c9END IF.c9:g7("gruppentest (",text(b9),", ");g7(" ",y4,");").u8:SELECTq0OF CASEi5:d9CASEj5:e9CASEk5:f9END SELECT.d9:g9(m8(1),q0).e9:i1(h9);i1(i9);g9(m8(2),q0).f9:g9(m8(3),q0).v8:IFc7THENj9;k9END IF;l9;IFc7THENm9;n9END IF.l9:FORw8FROM1UPTOo8REP IF(n8ISUBw8)>0THENh6(u7,o9,n8ISUBw8)ELSEp9END IF END REP.o9:TEXT VARq9;feldlesen(p0,w8,q9);q9.j9:FORw8FROM1UPTO3REP IFm8(w8).n0=0THENr9END IF END REP.r9:d7(m8(w8).d7);f7.k9:g7("PROC abk (INT CONST nr, TEXT VAR inhalt) :");IFo8>0THENg7("SELECT nr OF")END IF.p9:TEXT CONSTs9:=text(w8);g7("CASE "+s9," : inhalt := abk",s9).m9:IFo8>0THENg7("END SELECT")END IF;g7("END PROC abk;").n9:g7("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)").END PROCr8;PROCg9(ABSCHNITT VARt9,INT VARq0):BOOL VARu9:=TRUE;d7(t9.d7);v9;w9;x9.v9:IFt9.n0<>0THENh6(v7,j1)END IF;t9.n0:=s5+1;t9.o0:=k8+1.w9:WHILE NOTv0REPw0;IFa1(q0)THENy9ELSEz9;a10END IF END REP;b10;LEAVEg9.y9:SELECTq0OF CASEn5:replace(j1,1," ");g7(j1);u9:=TRUE CASEi5,j5,k5:b10; +LEAVEg9CASEl5:b10;LEAVEw9CASEd1:z9;INT VARc10;i1(c10);IFc10<1ORc10>4THENh6(w7,j1)END IF CASEf1:z9OTHERWISE IFq0>0THENh6(x7)END IF END SELECT.z9:IFu9THENn7(s5,k8+1);u9:=FALSE END IF.b10:f7.a10:TEXT VARname;INT VARd10:=0;REPz1(name);IFname=j0THEN LEAVEa10END IF;d10INCR1;e10END REP.e10:IFd10>=b0THENh6(z7)END IF;IFk8=f8THENh6(a8)ELSEk8INCR1END IF;f10.f10:INT VARg10:=feldnummer(name);IFg10=0THENg10:=feldindex(p0,name);IFg10=0THENh10(name,s5);e2(k8):=-o8ELSEe2(k8):=-g10END IF ELSEe2(k8):=g10END IF.x9:BOOL VARi10:=TRUE;WHILE NOTv0REPw0;IFa1(q0)THENj10ELIFk10THENl10END IF END REP.j10:SELECTq0OF CASEi5,j5,k5:LEAVEx9OTHERWISE IFq0>0THENh6(y7)END IF END SELECT.l10:IFi10THENg7(".");i10:=FALSE END IF;IFm10THENn10ELSEg7(j1)END IF.m10:(j1SUB1)=c5.n10:TEXT VARo10;z1(o10);IFo10=j0THENh6(b8,j1);LEAVEn10END IF;p10;q10.p10:LETr10=":";y4DECR1;u5(k0);IF(j1SUBy4)=r10THENy4INCR1ELSEh6(c8,j1)END IF.q10:h10(o10,0);g7(s10,y4-1,"").s10:"abk"+text(feldindex(p0,o10)).k10:j1<>j0ANDj1<>k0.END PROCg9;PROCh10(TEXT +CONSTname,INT CONSTr6):INT CONSTt10:=feldindex(p0,name);IFt10>0THENu10ELSEv10END IF.u10:IF(n8ISUBt10)>0THENreplace(n8,t10,r6)ELIFr6=0THENh6(d8,name)END IF.v10:IFo8=h8THENh6(e8)ELSEo8INCR1END IF;n8CATr6;feldaendern(p0,o8,name).END PROCh10;PROCh6(TEXT CONSTw10,x10,INT CONSTr6):LETy10=" ";TEXT VARz10:="FEHLER in Zeile ";z10CATtext(r6);IFx10<>j0THENz10CAT" bei >>";z10CATx10;z10CAT"<<"END IF;note(z10);noteline;note(y10);note(w10);noteline;IFonlineANDcommanddialogueTHENline;putline(z10);put(y10);putline(w10)END IF END PROCh6;PROCh6(TEXT CONSTw10):h6(w10,j0,s5)END PROCh6;PROCh6(TEXT CONSTw10,x10):h6(w10,x10,s5)END PROCh6;LETa11="keine Datei geoeffnet",b11="interner Fehler",c11="direkt Drucken nicht moeglich";TEXT VARd11,e11;BOOL VARf11,g11,h11,i11;FILE VARj11;INT VARh9,i9,k11,l11,m11,n11:=4000,o11;PROCdrucke:drucke(lastparam)END PROCdrucke;PROCdrucke(TEXT CONSTp11):enablestop;lastparam(p11);x4:=sequentialfile(input,p11);modify(x4);IFanzahldateien=0THENerrorstop(a11)END IF;disablestop;q11;r8 +;IFanythingnotedTHENnoteedit(x4)ELIFc7THENr11ELSEdrucke(PROCs11,PROCt11,PROCu11,PROCv11)END IF;forget(w11,quiet).q11:TEXT VARw11;INT VARw8:=0;REPw8INCR1;w11:=text(w8)UNTIL NOTexists(w11)END REP;a7:=sequentialfile(output,w11);headline(a7,"erzeugtes Programm").r11:run(w11);lastparam(p11).END PROCdrucke;PROCs11:END PROCs11;PROCt11:x11(1)END PROCt11;PROCu11:x11(2)END PROCu11;PROCv11:x11(3)END PROCv11;PROCx11(INT CONSTy11):IFm8(y11).n0>0THENinterpretiere(m8(y11).n0,m8(y11).o0,PROC(INT CONST,TEXT VAR)z11)END IF END PROCx11;PROCz11(INT CONSTy11,TEXT VARg0):errorstop(b11);g0:=code(y11)END PROCz11;PROCdrucke(PROCa12,PROCb12,PROCc12,PROCd12):INT VARe12,f12,g12;enablestop;h12;i12;j12;o11:=1;WHILE NOTdateiendeREPk12;cout(satznummer);l12;weiter(e12);m12END REP;n12;o12;aufsatz(1).i12:f12:=0;aufsatz(1);IFmarkiertesaetze>0THENe12:=3;IF NOTsatzmarkiertTHENweiter(e12)END IF ELSEe12:=2;IF NOTsatzausgewaehltTHENweiter(e12)END IF END IF.j12:INT VARw8;FORw8FROM1UPTOg8REPl8(w8).g0:=j0END REP.k12:IFf12=0THEN +a12;p12;q12(PROCb12)ELSEg11:=FALSE;r12;s12END IF;f12:=satznummer;g12:=satzkombination.r12:f11:=FALSE;a12.s12:IFf11THENt12(f12,g12,PROCd12)END IF;o11INCR1;IFf11THENq12(PROCb12)END IF.l12:IFi9<1THENt5ELSEo5:=i9END IF;IFk11n11THENo12;h12END IF.n12:p12;IFf12=0THENq12(PROCd12)ELSEt12(f12,g12,PROCd12)END IF;u0(1).END PROCdrucke;PROCp12:INT VARw8;FORw8FROM1UPTOg8REPl8(w8).i8:=TRUE END REP;g11:=TRUE;f11:=TRUE END PROCp12;PROCq12(PROCt9):k11:=h9;toeof(j11);t5;i0:=1;t9END PROCq12;PROCt12(INT CONSTf12,g12,PROCd12):INT CONSTu12:=satznummer,v12:=satzkombination;aufsatz(f12);WHILEsatzkombination<>g12REPweiter(1)END REP;q12(PROCd12);aufsatz(u12);WHILEsatzkombination<>v12REPweiter(1)END REP END PROCt12;PROCh12:IF NOTh11THENw12END IF;j11:=sequentialfile(modify,e11);maxlinelength(j11,maxlinelength(x4));m11:=lines(j11);x12.w12:INT VARs4:=0;REPs4INCR1;e11:="EUDAS-Ausgabe."+text(s4);UNTIL NOTexists(e11)END REP. +x12:u0(1);WHILE NOTv0REPy12END REP.y12:w0;INT VARq0;IFa1(q0)THENz12ELSEh1(j1)END IF.z12:IFq0<>n5ANDq0<>m5THEN LEAVEx12END IF.END PROCh12;PROCo12:IFh11THENh11:=FALSE ELIFi11THENdisablestop;a13END IF.a13:TEXT CONSTx6:=std;lastparam(e11);do("print (std)");IFiserrorTHENclearerror;errorstop(c11)ELSEforget(e11,quiet)END IF;lastparam(x6).END PROCo12;PROCh1(TEXT CONSTr6):IFk11>=h9ORk11=0THENinsertrecord(j11);writerecord(j11,r6);m11INCR1ELSEb13END IF;down(j11).b13:IFeof(j11)THENd11:=j0;insertrecord(j11);m11INCR1ELSEreadrecord(j11,d11)END IF;c13;writerecord(j11,d11).c13:INT CONSTd13:=o5*k11;WHILElength(d11)l8(b9).g0THENl8(b9).g0:=f13;l8(b9).i8:=TRUE;f11:=TRUE ELSEl8 +(b9).i8:=FALSE END IF END PROCgruppentest;BOOL PROCgruppenwechsel(INT CONSTb9):IFb9>0THENl8(b9).i8ELSEg11END IF END PROCgruppenwechsel;TEXT PROClfdnr:text(o11)END PROClfdnr;END PACKETeudasdrucken; +PACKETverarbeitungDEFINESkopiere,stdkopiermuster,verarbeite,trage,eindeutigefelder,pruefe,wertemenge,feldmaske,tragesatz,holesatz,K,V,f,wert,zahltext,textdarstellung:SATZ VARg13,h13,i13;INT VARj13;BOOL VARk13;LETj0="",INTVEC=TEXT;INTVEC VARl13;TEXT VARm13:=" ";OP CAT(INTVEC VARp8,INT CONSTn13):replace(m13,1,n13);p8CATm13END OP CAT;PROCstdkopiermuster(TEXT CONSTp11,FILE VARo13):p13;INT VARq13;r13;s13;INT VARg10;FORg10FROM1UPTOq13REPt13;IFu13THENv13ELSEw13END IF END REP.r13:output(o13);EUDAT VARx13;IFexists(p11)THENoeffne(x13,p11)END IF.s13:IFexists(p11)CANDfelderzahl(x13)>0THENfeldnamenlesen(x13,g13);q13:=felderzahl(x13)ELSEy13;q13:=anzahlfelderEND IF.y13:TEXT VARz13;satzinitialisieren(g13);FORg10FROM1UPTOanzahlfelderREPfeldnamenlesen(g10,z13);feldaendern(g13,g10,z13)END REP.u13:feldnummer(z13)>0.t13:feldlesen(g13,g10,z13);put(o13,textdarstellung(z13)).v13:write(o13,"K f(");write(o13,textdarstellung(z13));putline(o13,");").w13:putline(o13,"K """";").END PROCstdkopiermuster;PROCkopiere( +TEXT CONSTp11,FILE VARo13):a14(b14,o13).b14:"kopiere ("+textdarstellung(p11)+", ".END PROCkopiere;PROCa14(TEXT CONSTc14,FILE VARo7):q11;write(a7,c14);putline(a7,"PROC programmfunktion);");putline(a7,"PROC programmfunktion:");d14;putline(a7,"END PROC programmfunktion");e14;forget(w11,quiet).q11:TEXT VARw11;INT VARw8:=0;REPw8INCR1;w11:=text(w8)UNTIL NOTexists(w11)END REP;disablestop;FILE VARa7:=sequentialfile(output,w11);headline(a7,f14).d14:TEXT VARr6;input(o7);WHILE NOTeof(o7)REPgetline(o7,r6);putline(a7,r6)END REP.e14:TEXT CONSTg14:=std;run(w11);lastparam(g14).END PROCa14;PROCkopiere(TEXT CONSTp11,PROCh14):p13;k13:=TRUE;EUDAT VARx13;oeffne(x13,p11);aufsatz(x13,saetze(x13)+1);feldnamenlesen(x13,h13);l13:=j0;INT VARe12;aufsatz(1);IFmarkiertesaetze>0THENe12:=3;IF NOTsatzmarkiertTHENweiter(e12)END IF ELSEe12:=2;IF NOTsatzausgewaehltTHENweiter(e12)END IF END IF;WHILE NOTdateiendeREPsatzinitialisieren(i13);j13:=1;h14;i14;satzeinfuegen(x13,i13);weiter(x13);weiter(e12)END REP;aufsatz(1).i14: +IFk13THENfeldnamenaendern(x13,h13);k13:=FALSE END IF END PROCkopiere;OP K(TEXT CONSTz13,j14):IFk13THENk14;END IF;feldaendern(i13,l13ISUBj13,j14);j13INCR1.k14:INT VARl14:=feldindex(h13,z13);IFl14=0THENl14:=felderzahl(h13)+1;feldaendern(h13,l14,z13);END IF;l13CATl14.END OP K;PROCverarbeite(FILE VARm14):a14("verarbeite (",m14)END PROCverarbeite;PROCverarbeite(PROCn14):p13;INT VARe12;aufsatz(1);IFmarkiertesaetze>0THENe12:=3;IF NOTsatzmarkiertTHENweiter(e12)END IF ELSEe12:=2;IF NOTsatzausgewaehltTHENweiter(e12)END IF END IF;WHILE NOTdateiendeREPn14;weiter(e12)END REP;aufsatz(1)END PROCverarbeite;OP V(TEXT CONSTz13,j14):INT CONSTy11:=feldnummer(z13);IFy11=0THENo14(z13)ELSEfeldaendern(y11,j14)END IF END OP V;TEXT VARp14,q14;LETr14="""";TEXT PROCf(TEXT CONSTz13):INT CONSTy11:=feldnummer(z13);IFy11=0THENo14(z13);p14:=j0ELSEfeldlesen(y11,p14)END IF;p14END PROCf;REAL PROCwert(TEXT CONSTz13):INT CONSTy11:=feldnummer(z13);IFy11=0THENo14(z13);0.0ELSEfeldlesen(y11,p14);REAL VARs14;wertberechnen(p14, +s14);s14END IF END PROCwert;REAL PROCwert(TEXT CONSTz13,INT CONSTt14):round(wert(z13),t14)END PROCwert;TEXT PROCzahltext(REAL CONSTu14,INT CONSTt14):REAL CONSTv14:=round(abs(u14),t14);INT CONSTw14:=decimalexponent(v14)+t14+2;IFu14<0.0THENq14:="-"ELSEq14:=j0END IF;IFv14<1.0THENq14CAT"0"ENDIF;q14CATtext(v14,w14,t14);IFt14>0THENchange(q14,".",dezimalkomma)ELSEchange(q14,".",j0)END IF;q14END PROCzahltext;TEXT PROCzahltext(TEXT CONSTz13,INT CONSTt14):zahltext(wert(z13),t14)END PROCzahltext;TEXT PROCtextdarstellung(TEXT CONSTx14):p14:=x14;y14;changeall(p14,r14,r14+r14);insertchar(p14,r14,1);p14CATr14;p14.y14:INT VARz14:=1;WHILEa15REPchange(p14,z14,z14,b15)END REP.a15:z14:=pos(p14,""0"",""31"",z14);z14>0.b15:r14+text(code(p14SUBz14))+r14.END PROCtextdarstellung;PROCo14(TEXT CONSTz13):errorstop(c15+textdarstellung(z13)+d15)END PROCo14;PROCp13:IFanzahldateien=0THENerrorstop(a11)END IF END PROCp13;SATZ VARe15;EUDAT VARf15;LETf14="erzeugtes Programm",a11="keine Datei geoeffnet",g15= +"Kein Satz zum Tragen vorhanden",h15="Zieldatei hat falsche Felderzahl",i15=" existiert nicht",j15=" verletzt die Pruefbedingung.",k15=" ist in der Zieldatei bereits vorhanden.",d15=" ist nicht definiert.",l15=" ist nicht in der Wertemenge.",m15=" stimmt nicht mit der Maske ueberein.";LETn15="Satz",c15="Das Feld ";INT VARo15;FILE VARp15;BOOL VARq15:=FALSE,r15,s15;TEXT VARt15;PROCtrage(TEXT CONSTp11,FILE VARu15,BOOL CONSTv15):disablestop;q15:=v15;IFq15THENp15:=u15;output(p15)END IF;w15(p11);q15:=FALSE END PROCtrage;PROCw15(TEXT CONSTp11):enablestop;IFanzahldateien>0THENaufsatz(1)END IF;x15(p11);INT VARe12;IFmarkiertesaetze>0THENe12:=3ELSEe12:=2END IF;INT VARo11:=0;REP IF NOTy15THENweiter(e12)ELSEcout(satznummer+o11)END IF;IFdateiendeTHENaufsatz(1);LEAVEw15END IF;z15END REP.y15:IFe12=3THENsatzmarkiertELSEsatzausgewaehltEND IF.z15:r15:=TRUE;IFq15THENnotizenlesen(f15,1,t15);do(t15)END IF;IFr15THENa16;IFr15THENsatzloeschen;o11INCR1END IF END IF;IF NOTr15THENweiter(e12)END IF.END PROCw15; +PROCx15(TEXT CONSTp11):IFdateiendeTHENerrorstop(g15)END IF;oeffne(f15,p11);o15:=0;IFfelderzahl(f15)=0THENb16ELIFfelderzahl(f15)<>anzahlfelderTHENerrorstop(h15)END IF;aufsatz(f15,saetze(f15)+1).b16:satzinitialisieren(e15,anzahlfelder);INT VARg10;FORg10FROM1UPTOanzahlfelderREPfeldnamenlesen(g10,p14);feldaendern(e15,g10,p14)END REP;feldnamenaendern(f15,e15).END PROCx15;PROCa16:IFo15>0CANDc16THENd16("",k15)ELSEe16;satzeinfuegen(f15,e15);weiter(f15)END IF.e16:satzinitialisieren(e15,anzahlfelder);INT VARg10;FORg10FROM1UPTOanzahlfelderREPfeldlesen(g10,p14);feldaendern(e15,g10,p14)END REP.c16:TEXT VARo7;INT CONSTf16:=satznr(f15);feldlesen(1,o7);s15:=FALSE;aufsatz(f15,o7);WHILE NOTdateiende(f15)REPg16;weiter(f15,o7)UNTILs15END REP;aufsatz(f15,f16);s15.g16:INT VARw8;s15:=TRUE;FORw8FROM2UPTOo15REPfeldlesen(f15,w8,p14);feldbearbeiten(w8,PROC(TEXT CONST,INT CONST,INT CONST)h16);IF NOTs15THEN LEAVEg16END IF END REP.END PROCa16;PROCh16(TEXT CONSTi16,INT CONSTt4,u4):IFj16COR(length(p14)>0CANDk16)THEN +s15:=FALSE END IF.j16:(u4-t4+1)<>length(p14).k16:pos(i16,p14,t4,u4+1)<>t4.END PROCh16;PROCd16(TEXT CONSTl16,z10):IFq15THENm16ELSEerrorstop(z10)END IF.m16:put(p15,n15);put(p15,satznummer);IFl16<>""THENwrite(p15,c15);write(p15,textdarstellung(l16))END IF;putline(p15,z10);r15:=FALSE.END PROCd16;PROCeindeutigefelder(INT CONSTr4):o15:=r4END PROCeindeutigefelder;PROCpruefe(TEXT CONSTl16,BOOL CONSTn16):IF NOTn16THENd16(l16,j15)END IF END PROCpruefe;PROCwertemenge(TEXT CONSTl16,o16):INT CONSTy11:=feldnummer(l16);IFy11=0THENd16(l16,d15)ELSEp16END IF.p16:INT VARz14:=0;LETq16=",";feldlesen(y11,p14);IFr16THEN LEAVEp16END IF;p14CATq16;REPz14:=pos(o16,p14,z14+1);IFz14=1ORz14>1CAND(o16SUBz14-1)=q16THEN LEAVEp16END IF UNTILz14=0END REP;d16(l16,l15).r16:INT CONSTs16:=length(o16)-length(p14);(o16SUBs16)=q16ANDpos(o16,p14,s16+1)>0.END PROCwertemenge;PROCfeldmaske(TEXT CONSTl16,t16):INT CONSTy11:=feldnummer(l16);IFy11=0THENd16(l16,d15)ELSEfeldlesen(y11,p14);u16END IF.u16:INT VARz14;TEXT CONSTm2:=code( +length(t16)+1);TEXT VARv16:=""1"";FORz14FROM1UPTOlength(p14)REP TEXT CONSTv5:=p14SUBz14;w16UNTILv16=""END REP;IFx16THENd16(l16,m15)END IF.w16:INT VARy16:=1;WHILEy16<=length(v16)REP INT CONSTz16:=code(v16SUBy16);IF(t16SUBz16)="*"THENa17ELIFb17THENreplace(v16,y16,code(z16+1));y16INCR1ELSEdeletechar(v16,y16)END IF END REP.a17:IFz16=length(t16)THEN LEAVEfeldmaskeEND IF;y16INCR1;IFpos(v16,code(z16+1))=0THENinsertchar(v16,code(z16+1),y16)END IF.b17:SELECTpos("9XAa",t16SUBz16)OF CASE1:pos("0123456789",v5)>0CASE2:TRUE CASE3:pos("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",v5)>0CASE4:pos("abcdefghijklmnopqrstuvwxyzäöüß",v5)>0OTHERWISE(t16SUBz16)=v5END SELECT.x16:(v16=""CORpos(v16,m2)=0)ANDc17.c17:(t16SUBlength(t16))<>"*"ORpos(v16,code(length(t16)))=0.END PROCfeldmaske;PROCtragesatz(TEXT CONSTp11):x15(p11);INT CONSTd17:=satznr(f15);a16;satzloeschen;aufsatz(f15,d17)END PROCtragesatz;PROCholesatz(TEXT CONSTp11):p13;IF NOTexists(p11)THENerrorstop(textdarstellung(p11)+i15)END IF;oeffne(f15,p11);IFfelderzahl(f15) +<>anzahlfelderTHENerrorstop(h15)ELIFsaetze(f15)=0THENerrorstop(g15)END IF;aufsatz(f15,saetze(f15));satzlesen(f15,e15);e17;satzloeschen(f15).e17:satzeinfuegen;INT VARg10;FORg10FROM1UPTOfelderzahl(e15)REPfeldlesen(e15,g10,p14);feldaendern(g10,p14)END REP.END PROCholesatz;END PACKETverarbeitung; + diff --git a/app/eudas/3.4/src/eudas.3 b/app/eudas/3.4/src/eudas.3 new file mode 100644 index 0000000..f0218aa --- /dev/null +++ b/app/eudas/3.4/src/eudas.3 @@ -0,0 +1,32 @@ +PACKETfensterDEFINES FENSTER,fensterinitialisieren,fenstergroessesetzen,fenstergroesse,fensterveraendert,fensterzugriff,bildschirmneu:TYPE FENSTER=STRUCT(INTb0,c0);LETd0=16,BITVEKTOR=INT,GROESSE=STRUCT(INTe0,f0,g0,h0);ROWd0STRUCT(INTi0,j0,BITVEKTORk0,GROESSEl0)VARm0;INT VARn0:=1;BITVEKTOR VARo0;INT VARp0;FORp0FROM2UPTOd0REPm0(p0).i0:=0END REP;m0(1).i0:=1;m0(1).j0:=0;m0(1).k0:=0;m0(1).l0:=GROESSE:(1,1,79,24);PROCfensterinitialisieren(FENSTER VARf):f.b0:=1;m0(1).i0INCR1;f.c0:=n0;n0INCR1;IFn0>=32000THENn0:=-32000END IF END PROCfensterinitialisieren;PROCfenstergroessesetzen(FENSTER VARf,INT CONSTe0,f0,g0,h0):INT VARq0;r0;IFq0>d0THENs0;t0;u0END IF;v0.r0:q0:=1;WHILEq0<=d0REP IFw0THEN LEAVEr0END IF;q0INCR1END REP.w0:x0.e0=e0ANDx0.f0=f0ANDx0.g0=g0ANDx0.h0=h0.x0:m0(q0).l0.s0:q0:=1;WHILEq0<=d0REP IFm0(q0).i0=0THEN LEAVEs0END IF;q0INCR1END REP;errorstop("zu viele Fenstergroessen");LEAVEfenstergroessesetzen.t0:m0(q0).i0:=0;m0(q0).j0:=0;m0(q0).l0:=GROESSE:(e0,f0,g0,h0);m0(q0).k0:=0.u0:INT VARy0;FOR +y0FROM1UPTOd0REP IFm0(y0).i0>0THENz0END IF END REP.z0:IFa1(b1,c1)THENsetbit(m0(q0).k0,y0);setbit(m0(y0).k0,q0)ELSEresetbit(m0(y0).k0,q0)END IF.b1:m0(q0).l0.c1:m0(y0).l0.v0:m0(f.b0).i0DECR1;f.b0:=q0;m0(q0).i0INCR1.END PROCfenstergroessesetzen;BOOL PROCa1(GROESSE CONSTa,d1):e1ANDf1.e1:IFa.e0<=d1.e0THENd1.e0<=a.e0+a.g0ELSEa.e0<=d1.e0+d1.g0END IF.f1:IFa.f0<=d1.f0THENd1.f0<=a.f0+a.h0ELSEa.f0<=d1.f0+d1.h0END IF.END PROCa1;PROCfenstergroesse(FENSTER CONSTf,INT VARe0,f0,g0,h0):e0:=x0.e0;f0:=x0.f0;g0:=x0.g0;h0:=x0.h0.x0:m0(f.b0).l0.END PROCfenstergroesse;PROCfensterveraendert(FENSTER CONSTf):m0(f.b0).j0:=0;o0:=o0ORg1.g1:m0(f.b0).k0.END PROCfensterveraendert;PROCfensterzugriff(FENSTER CONSTf,BOOL VARh1):h1:=bit(o0,f.b0);IFm0(f.b0).j0<>f.c0THENm0(f.b0).j0:=f.c0;h1:=TRUE END IF;o0:=o0ORg1;resetbit(o0,f.b0).g1:m0(f.b0).k0.END PROCfensterzugriff;PROCbildschirmneu:o0:=-1END PROCbildschirmneu;ROW16INT VARi1:=ROW16INT:(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1);PROCsetbit( +BITVEKTOR VARj1,INT CONSTq0):j1:=j1ORi1(q0)END PROCsetbit;PROCresetbit(BITVEKTOR VARj1,INT CONSTq0):j1:=j1AND(-1-i1(q0))END PROCresetbit;BOOL PROCbit(BITVEKTOR CONSTj1,INT CONSTq0):(j1ANDi1(q0))<>0END PROCbit;END PACKETfenster; +PACKETeudasmenuesDEFINESersetzungstext, +##globalmanager,menuemanager, +##menuedateneinlesen,menuenamen,menueloeschen,menueanbieten,auswahlanbieten,wahl,eschopausfuehren,hilfeanbieten,statuszeile,statusanzeigen,dialogfenster,dialog,neuerdialog,ja,editget,fehlerausgeben:ROW9TEXT VARk1;PROCersetzungstext(INT CONSTl1,TEXT CONSTm1):k1(l1):=m1END PROCersetzungstext;PROCn1(INT CONSTl1,TEXT VARm1):SELECTl1OF CASE1:m1:=timeofdayCASE2:m1:=date +##CASE3:m1:=name(myself) +##OTHERWISEm1:=k1(l1)END SELECT END PROCn1;ROW10TEXT VARo1:=ROW10TEXT:("MENUE","BILD","FELD","ERSETZE","ENDE","AUSWAHL","VORSPANN","HILFE","SEITE","");LETp1=1,q1=2,r1=3,s1=4,t1=5,u1=6,v1=7,w1=8,x1=9;LETy1=2,integer=3,z1=4,a2=7;LETb2="FEHLER in Zeile ";FILE VARc2;TEXT VARd2,e2;PROCf2:IFeof(c2)THENd2:="%DUMMY"ELSEreadrecord(c2,d2);IFd2=g2THENd2:=h2END IF;cout(lineno(c2));down(c2)END IF END PROCf2;BOOL PROCi2:IF(d2SUB1)=j2THENk2ELSE FALSE END IF.k2:INT VARl2;replace(d2,1,h2);scan(d2);replace(d2,1,j2);nextsymbol(e2,l2);IFl2<>y1THENm2(n2);FALSE ELSE TRUE END IF.END PROCi2;BOOL PROCo2(INT CONSTp2):o1(p2)=e2END PROCo2;INT PROCq2:TEXT VARr2;INT VARl2;nextsymbol(r2,l2);IFl2=integerTHENint(r2)ELSE IFl2<>a2THENm2(s2)END IF;-1END IF END PROCq2;TEXT PROCt2:TEXT VARr2;INT VARl2;nextsymbol(r2,l2);IFl2=z1THENr2ELSE IFl2<>a2THENm2(u2)END IF;g2END IF END PROCt2;PROCm2(TEXT CONSTv2):note(b2);note(lineno(c2)-1);noteline;note(v2);noteline;line;putline(v2)END PROCm2;INT VARh0,g0,w2,x2;PROCy2(INT CONSTz2,a3) +:cursor(w2+z2-1,x2+a3-1)END PROCy2;LETb3="Zeile ist ohne Zusammenhang",c3="K Menuedaten im Speicher";PROCmenuedateneinlesen(FILE VARf):d3;modify(f);toline(f,1);c2:=f;WHILE NOTeof(c2)REPf2;IFi2THENe3ELIF NOTanythingnotedTHENm2(b3)END IF END REP;f3.e3:IFo2(p1)THENg3ELIFo2(u1)THENh3ELIFo2(w1)THENi3ELIF NOTanythingnotedTHENm2(b3)END IF.f3:IFonlineTHENline;put(j3DIV2);putline(c3)END IF.j3:dspages(k3(1))+dspages(k3(2))+dspages(k3(3)).END PROCmenuedateneinlesen;TYPE MENUE=STRUCT(SATZl3,m3,n3,o3,TEXTp3,q3,r3);BOUND ROW200MENUE VARs3;INT VARt3;TEXT VARu3,v3;LETg2="",h2=" ",w3="­",j2="%",x3="&",y3=""7"",z3=""27"",a4=""5"",b4="-"8"",c4="+";LETd4="% BILD erwartet",e4="Feldnummer beim %FELD-Kommando fehlt",f4="% ENDE erwartet",g4="Zeile muss mit '&' beginnen",h4="ein Parameter fehlt",i4="Ersetzungstexte gehen nur von 1 bis 9",j4="Name fehlt",n2="Kommandozeile enthaelt kein Kommando",s2="Parameter soll eine Zahl sein",u2="Parameter soll ein TEXT sein",k4="Wiederholungszeile fehlt";PROCg3:TEXT VAR +name:=t2;IFname=g2THENm2(j4)ELSE INT VARindex;l4;g3(s3(index))END IF.l4:index:=link(m4(2),name);IFindex=0THENinsert(m4(2),name,index)END IF.END PROCg3;PROCg3(MENUE VARn4):o4;p4;q4;r4.o4:satzinitialisieren(n4.l3);satzinitialisieren(n4.m3);satzinitialisieren(n4.n3);satzinitialisieren(n4.o3);n4.p3:=g2;n4.q3:=g2;n4.r3:=g2.p4:s4;INT VARt4:=1;REPf2;IFi2THEN LEAVEp4ELSEu4;t4INCR1END IF END REP.s4:f2;IF NOT(i2CANDo2(q1))THENm2(d4)END IF.u4:INT VARv4:=0;REPv4:=pos(d2,w3,v4+1);IFv4>0THENn4.q3CATcode(v4);n4.r3CATcode(t4)END IF UNTILv4=0END REP;feldaendern(n4.l3,t4,d2).q4:WHILEo2(r1)REPw4END REP.w4:INT VARx4:=q2;IFx4=-1THENm2(e4);x4:=100END IF;y4;z4;a5.y4:feldaendern(n4.m3,x4,t2).z4:TEXT CONSTb5:=t2;INT VARc5;FORc5FROM1UPTOlength(b5)REPn4.p3CATcode(x4);n4.p3CAT(b5SUBc5)END REP.a5:TEXT VARd5:=g2;f2;WHILE NOTi2REPd5CATd2;f2END REP;feldaendern(n4.n3,x4,d5).r4:IFo2(s1)THENe5END IF;IF NOTo2(t1)THENm2(f4)END IF.e5:f2;WHILE NOTi2REPf5;f2END REP.f5:g5(n4.o3);h5(n4.l3).END PROCg3;PROCg5(SATZ VARo3):IF(d2 +SUB1)<>x3THENm2(g4);u3:=g2ELSEi5;j5END IF.i5:INT CONSTk5:=pos(d2,h2);IFk5=0THENm2(h4);u3:=g2ELSEu3:=subtext(d2,2,k5-1);scan(subtext(d2,k5))END IF.j5:t3:=q2;IFt3<1ORt3>9THENm2(i4)ELSE TEXT CONSTl5:=t2;feldaendern(o3,t3,l5);feldaendern(o3,t3+10,u3)END IF.END PROCg5;PROCh5(SATZ VARl3):IFu3=g2THEN LEAVEh5END IF;INT VARt4;FORt4FROM1UPTOfelderzahl(l3)REPfeldlesen(l3,t4,v3);m5;n5END REP.m5:INT VARq0;BOOL VARo5:=FALSE;REPq0:=pos(v3,x3+u3);IFq0>0THENo5:=TRUE;replace(v3,q0+1,text(t3))END IF UNTILq0=0END REP.n5:IFo5THENfeldaendern(l3,t4,v3)END IF.END PROCh5;LETp5="Auswaehlen: PFEILE Ausfuehren: LEER Zurueck: ESC q Hilfe: ESC ?",q5="Eingabe beenden: RETURN Eingabe abbrechen: ESC h Hilfe: ESC ?",r5="Kommando wird ausgefuehrt ..",s5=""15"gib kommando: ",t5=""14"",u5=" existiert nicht.";TEXT VARv5,w5:=g2;PROCmenueanbieten(TEXT CONSTname,FENSTER VARf,BOOL CONSTx5,PROC(INT CONST)y5):d3;INT CONSTindex:=link(m4(2),name);IFindex=0THENz5(name)ELSEa6(s3(index),f,x5,PROC(INT CONST)y5)END IF +END PROCmenueanbieten;PROCa6(MENUE CONSTn4,FENSTER VARf,BOOL CONSTx5,PROC(INT CONST)y5):disablestop;INT VARwahl,b6:=1,c6:=0;fensterveraendert(f);REPd6;IFwahl>0THENy5(wahl)END IF;b6:=abs(wahl)UNTILwahl=0END REP;fensterveraendert(f).d6:INT VARe6:=0;f6;g6(f,c6);neuerdialog;statusanzeigen(p5);h6;REPi6;j6END REP.f6:wahl:=1;IFiserrorTHENfehlerausgeben;k6END IF.h6:IFc6>=code(n4.r3SUBb6)THENy2(code(n4.q3SUBb6),code(n4.r3SUBb6));out(b4)END IF.i6:REPl6;IFiserrorTHENclearerror;c6:=0ELSE LEAVEi6END IF END REP.l6:TEXT VARm6;WHILEc60THENwahl:=r6END IF.w6:r6:=m7(n4.q3,n4.q3SUBwahl,wahl-1);IFr6>0THENwahl:=r6END IF.x6:r6:=pos(n4.r3,n4.r3SUBwahl);IFr60THENwahl:=r6END IF.a7:r6:=m7(n4.r3,n4.r3SUBwahl);IFr60.o7:wahl:=code(n4.p3SUBr6-1);o6;p7(n4,wahl,c6);LEAVEd6.d7:wahl:=1.e7:wahl:=m7(n4.r3,n4.r3SUBwahl).f7:wahl:=pos(n4.q3,n4.q3SUBwahl).g7:wahl:=pos(n4.r3,n4.r3SUBwahl).h7:wahl:=m7(n4.q3,n4.q3SUBwahl).l7:push(lernsequenzauftaste(m6)).i7:IFx5THENq7;REPy2(1,r7);s7;t7;u7UNTILv7END REP;statusanzeigen(p5)END IF.t7:IFc6>0THENy2(1,r7);q6(n4.l3,n4.o3,r7)END IF.q7:INT VARr7;IFc60THENstatusanzeigen(r5);dialog;do(v5);w7;g6(f,c6);neuerdialogEND IF.w7:INT VARz2,a3;getcursor(z2,a3);IFa3=24THENbildschirmneuEND IF.v7:NOTiserror.j7:TEXT VARx7;feldlesen(n4.m3,wahl,x7);hilfeanbieten(x7,f);IFiserrorTHENfehlerausgebenEND IF;g6(f,c6);statusanzeigen(p5).k6:wahl:=b6.k7:wahl:=0;LEAVEd6.b7:p7(n4,wahl,c6);LEAVEd6.END PROCa6;PROCg6(FENSTER CONSTf,INT VARc6):BOOL VARh1;fensterzugriff(f,h1);fenstergroesse(f,w2,x2,g0,h0);IFh1THENc6:=0;y2(1,1)END IF END PROCg6;PROCp6(TEXT VARy7):enablestop;getchar(y7)END PROCp6;PROCp7(MENUE CONSTn4,INT VARwahl,INT CONSTc6):IFz7THENout(c4)END IF;TEXT VARd5;feldlesen(n4.n3,wahl,d5);IFd5<>g2ANDd5<>h2THENdo(d5);wahl:=-wahlEND IF.z7:c6>=code(n4.r3SUBwahl).END PROCp7;INT PROCm7(TEXT CONSTa8,b8,INT CONSTc8):INT VARc5:=c8;WHILEc5>0CAND(a8SUBc5)<>b8REPc5DECR1END REP;c5END PROCm7;INT PROCm7(TEXT CONSTa8,b8):m7(a8,b8,length(a8))END PROCm7;PROCeschopausfuehren:TEXT VARd8:=g2,e8;lernsequenzauftastelegen(""0"",g2);push(""27""1""0""0"");editget( +d8,32000,0,""0"","",e8);d8:=lernsequenzauftaste(""0"");IFd8<>g2THENf8ELSEg8END IF.f8:REPgetchar(e8)UNTILpos(""1""2""8""11""12"",e8)=0END REP;lernsequenzauftastelegen(e8,d8).g8:getchar(e8).END PROCeschopausfuehren;INT VARh8,k5,i8;PROCq6(SATZ CONSTl3,o3,INT CONSTt4):h8:=1;IFt4<=felderzahl(l3)THENj8END IF;k8.j8:REPfeldbearbeiten(l3,t4,PROC(TEXT CONST,INT CONST,INT CONST)l8);IFi8>0THENm8END IF;h8:=k5+1UNTILi8=0END REP.m8:TEXT VARn8,o8;n1(i8,n8);feldlesen(o3,i8,o8);n8CATo8;p8;outsubtext(n8,1,q8);k5INCRq8.p8:INT VARq8:=length(o8);IFq8=0THEN IFn8=g2THENn8:=h2;q8:=1ELSEq8:=length(n8)END IF END IF;IFk5+q8>g0THENq8DECRg0-k5END IF.k8:IFw2+g0>=80THENout(a4)ELSEg0-h8TIMESOUTh2END IF.END PROCq6;PROCl8(TEXT CONSTm1,INT CONSTr8,s8):INT CONSTt8:=r8-1;h8INCRt8;k5:=pos(m1,x3,h8,s8+1);IFk5=0THENk5:=s8;i8:=0ELSEk5DECR1;i8:=int(m1SUBk5+2)END IF;IFk5>g0+t8THENk5:=g0+t8;i8:=0END IF;outsubtext(m1,h8,k5);k5DECRt8END PROCl8;PROCs7:LETu8=""27"k";TEXT VARv8;INT VARz2,a3;getcursor(z2,a3);IFiserrorTHENfehlerausgeben +;v5:=w5ELSEv5:=g2END IF;statusanzeigen(q5);w8;REPx8UNTILv8<>u8END REP;IFpos(v5,"!","�",1)>0THENw5:=v5END IF;cursor(z2,a3).w8:cursor(w2,a3);out(s5);g0-15TIMESOUTh2;out(t5).x8:cursor(w2+15,a3);editget(v5,32000,g0-17,"","kh",v8);IFiserrorTHENclearerrorELIFv8=u8THENv5:=w5ELIFv8=y8THENv5:=g2END IF.END PROCs7;PROCz5(TEXT CONSTz8):errorstop(textdarstellung(z8)+u5)END PROCz5;TYPE AUSWAHL=STRUCT(SATZa9,b9,c9,o3,TEXTd9,q3,e9);BOUND ROW200AUSWAHL VARf9;PROCh3:TEXT VARname:=t2;IFname=g2THENm2(j4)ELSE INT VARindex:=link(m4(3),name);IFindex=0THENinsert(m4(3),name,index)END IF;h3(f9(index))END IF END PROCh3;PROCh3(AUSWAHL VARa):o4;IFg9THENh9END IF;p4;r4.o4:satzinitialisieren(a.a9);satzinitialisieren(a.b9);satzinitialisieren(a.c9);satzinitialisieren(a.o3);a.d9:=g2;a.q3:=g2;a.e9:=g2.g9:f2;i2CANDo2(v1).h9:INT VARt4:=1;REPf2;IFi2THEN LEAVEh9ELSEi9;t4INCR1END IF END REP.i9:feldaendern(a.a9,t4,d2).p4:s4;t4:=1;BOOL VARj9:=TRUE;REPf2;IFi2THENk9;LEAVEp4ELSEu4;t4INCR1END IF END REP.s4:IF NOT(i2CANDo2(q1))THEN +m2(d4)END IF.k9:IFj9THENm2(k4)END IF.u4:IFj9THENl9ELSEm9END IF.l9:IFpos(d2,w3)>0THENn9;t4:=0;j9:=FALSE ELSEfeldaendern(a.b9,t4,d2)END IF.n9:o9;a.d9:=d2;p9.o9:INT VARv4:=0;REPv4:=pos(d2,w3,v4+1);IFv4>0THENa.q3CATcode(v4)END IF UNTILv4=0END REP.p9:FORv4FROM1UPTOlength(a.q3)-1REPa.e9CATcode(q9-4)END REP;a.e9CAT""0"".q9:code(a.q3SUBv4+1)-code(a.q3SUBv4).m9:feldaendern(a.c9,t4,d2).r4:IFo2(s1)THENe5END IF;IF NOTo2(t1)THENm2(f4)END IF.e5:f2;WHILE NOTi2REPf5;f2END REP.f5:g5(a.o3);h5(a.a9);h5(a.b9);h5(a.c9).END PROCh3;LETr9=""1""8""10"",s9="+"27"q",t9="Fenster zu klein",u9="Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ?";INT VARv9,w9,x9,y9,z9,a10,b10,c10;LET INTVEC=TEXT;INTVEC VARd10;TEXT VARe10;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,TEXT CONSTf10,PROC(TEXT VAR,INT CONST)g10):d3;INT CONSTindex:=link(m4(3),name);IFindex=0THENz5(name)ELSEa6(f9(index),f,f10,PROC(TEXT VAR,INT CONST)g10)END IF END PROCauswahlanbieten;PROCa6(AUSWAHL CONSTa,FENSTER CONSTf,TEXT CONST +f10,PROC(TEXT VAR,INT CONST)g10):INT VARc6:=0,e6:=0;enablestop;h10;statusanzeigen(u9);i10;j10;k10;REPi6;l10END REP.h10:BOOL VARm10;fensterzugriff(f,m10);fenstergroesse(f,w2,x2,g0,h0).i10:INT VARn10:=1024;v9:=n10;REPn10:=n10DIV2;g10(d2,v9);IFd2=g2THENv9DECRn10ELSEv9INCRn10END IF UNTILn10=1END REP;g10(d2,v9);IFd2=g2THENv9DECR1END IF.k10:INT VARo10:=y9+1,p10:=1,q10:=1;d10:=g2;e10:=a.q3.j10:x9:=felderzahl(a.a9);y9:=x9+felderzahl(a.b9);w9:=length(a.q3);z9:=(v9+w9-1)DIVw9;a10:=y9+z9;b10:=a10+felderzahl(a.c9);c10:=0;IFy9>=h0THENerrorstop(t9)END IF.i6:REPl6;IFiserrorTHENclearerror;c6:=0ELSE LEAVEi6END IF END REP.l6:TEXT VARm6;WHILEc6w9THENo10DECR1;q10DECRw9;IFo10<=x9THENo10INCR1;c10DECR1;c6:=x9END IF END IF.x6:IFp10>1THENp10DECR1;q10DECR1END IF.y6:IFp10=w9THENpush(""13"")ELSEpush(""1""2"")END IF.z6:IFq10+w9<=v9THENo10INCR1;q10INCRw9;IFo10>h0THENo10DECR1;c10INCR1;c6:=x9END IF END IF.a7:IFo10+c100THENh11;i11END IF.h11:change(d10,2*g11-1 +,2*g11,g2).c7:IFm60THENc6:=x9END IF.n11:max(0,y9-x9-c10).j11:WHILEq10>w9ANDo10>x9+1REPo10DECR1;q10DECRw9END REP.g7:q10DECR(p10-1);p10:=1.h7:IFo10=h0THENo11ELSEp11END IF.o11:l11:=min(h0-x9,b10-o10-c10);c10INCRl11;INT CONSTq11:=max(0,o10+c10-a10+r11);o10DECRq11;q10INCR(l11-q11)*w9;IFl11>0THENc6:=x9END IF.r11:IFp10>v9MODw9THEN1ELSE0END IF.p11:WHILEo10=80THENout(a4)ELSEg0-max(c5,length(a.d9))TIMESOUTh2END IF.END PROCu10;PROCf11(INT CONSTd2,f12,wert): +y2(code(e10SUBf12)-4,d2);IFwert=0THENout(" o ")ELSEout(text(wert,3));out(" x ")END IF END PROCf11;INT PROCwahl(INT CONSTq0):IFq0+q0<=length(d10)THENd10ISUBq0ELSE0END IF END PROCwahl;LETg12=200,h12=5000;LET HILFE=STRUCT(INTi12,ROWg12THESAURUSj12,ROWg12SATZk12,ROWh12SATZl12);BOUND HILFE VARm12;INT VARn12,o12,p12,q12;LETr12="Das Hilfsgebiet existiert bereits",s12="Diese Seite ist in der anderen Hilfe nicht vorhanden";PROCi3:TEXT VARname:=t2;IFname=g2THENm2(j4)ELSEt12;u12;v12END IF.t12:INT CONSTw12:=pos(name,"/");TEXT VARx12;IFw12=0THENx12:=nameELSEx12:=subtext(name,1,w12-1)END IF;y12;z12.y12:INT VARa13:=link(m4(1),x12);IFa13=0THENinsert(m4(1),x12,a13);m12.j12(a13):=emptythesaurus;satzinitialisieren(m12.k12(a13))ELIFw12=0THENm2(r12);LEAVEi3END IF.z12:INT VARb13;TEXT VARc13:=subtext(name,w12+1);IFw12=0THENb13:=1ELSEb13:=link(m12.j12(a13),c13);IFb13=0THENinsert(m12.j12(a13),c13,b13)END IF END IF.u12:INT VARd13:=m12.i12;IFd13<0THENd13:=0END IF;TEXT VARe13:=g2;f2;WHILEi2CANDo2(x1)REPf13END +REP.f13:INT CONSTg13:=q2;TEXT CONSTh13:=t2;IFh13<>g2THENi13;f2ELSEj13END IF.i13:TEXT VARk13;l13(h13,k13);IFg13+g13<=length(k13)THENe13CAT(k13ISUBg13)ELSEm2(s12)END IF.j13:INT VARt4:=1;d13INCR1;e13CATd13;satzinitialisieren(m12.l12(d13));REPf2;IFi2THEN LEAVEj13ELSEfeldaendern(m12.l12(d13),t4,d2);t4INCR1END IF END REP.v12:IF NOTo2(t1)THENm2(f4)END IF;IF NOTanythingnotedTHENfeldaendern(m12.k12(a13),b13,e13);m12.i12:=d13END IF.END PROCi3;PROCl13(TEXT CONSTname,TEXT VARe13):INT CONSTw12:=pos(name,"/");INT VARx12,b13:=0;IFw12=0THENx12:=link(m4(1),name)ELSEx12:=link(m4(1),subtext(name,1,w12-1));m13END IF;IFb13=0THENb13:=1END IF;IFx12=0THENerrorstop(n13)ELSEfeldlesen(m12.k12(x12),b13,e13)END IF.m13:IFx12>0THENb13:=link(m12.j12(x12),subtext(name,w12+1))END IF.END PROCl13;LETn13="Hilfe existiert nicht",o13="Hilfe ist leer",p13="Zurueck: ESC q Seite weiter: ESC w Seite zurueck: ESC z";PROChilfeanbieten(TEXT CONSTname,FENSTER CONSTf):enablestop;d3;TEXT VARe13;q13;l13(name,e13);IFe13=g2 +THENerrorstop(o13)ELSEr13END IF.q13:fensterveraendert(f);fenstergroesse(f,n12,o12,p12,q12).r13:s13;statusanzeigen(p13);INT VARk12:=1;REPt13;u13END REP.t13:INT CONSTv13:=e13ISUBk12;w13(m12.l12(v13)).u13:TEXT VARm6;REPgetchar(m6);IFm6=z3THENgetchar(m6);u7;LEAVEu13ELSEout(y3)END IF END REP.u7:SELECTpos("qwz?"1"",m6)OF CASE1:LEAVEhilfeanbietenCASE2:x13CASE3:y13CASE4:z13CASE5:eschopausfuehrenOTHERWISEout(y3)END SELECT.x13:IF2*k121THENk12DECR1END IF.z13:k12:=1.END PROChilfeanbieten;PROCw13(SATZ CONSTa14):INT VARt4;FORt4FROM1UPTOq12REPcursor(n12,o12+t4-1);feldbearbeiten(a14,t4,PROC(TEXT CONST,INT CONST,INT CONST)b14)END REP;cursor(n12,o12+q12-1)END PROCw13;PROCb14(TEXT CONSTl3,INT CONSTr8,s8):IFs8-r8+1>p12THENk5:=r8+p12-1ELSEk5:=s8END IF;outsubtext(l3,r8,k5);IFn12+p12>=80THENout(a4)ELSEp12+r8-k5-1TIMESOUTh2END IF END PROCb14;TEXT VARc14:=g2,d14;PROCstatuszeile(TEXT CONSTe14,f14):c14:=e14;d14:=f14END PROCstatuszeile;PROCstatusanzeigen(TEXT CONSTstatus): +IFc14<>g2THENout(c14);out(status);out(d14)END IF END PROCstatusanzeigen;LETg14=""4"",h14=""27"?",i14=""27"q",y8=""27"h",j14="Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ?",k14="Eingabe beenden: RETURN Abbrechen: ESC h Hilfe: ESC ?",l14="Eingabe beenden: RETURN Zeigen: ESC z Abbrechen: ESC h Hilfe: ESC ?",m14=" Fehler quittieren ESC q Informationen zur Fehlermeldung: ESC ?",n14=""15" !!! FEHLER !!! "14"";FENSTER VARo14;fensterinitialisieren(o14);INT VARp14,q14,r14,s14,t14;TEXT VARu14;PROCdialogfenster(INT CONSTz2,a3,v14,w14):fenstergroessesetzen(o14,z2,a3,v14,w14);q14:=z2;r14:=a3;s14:=v14;t14:=w14;u14:=g2END PROCdialogfenster;PROCneuerdialog:p14:=t14END PROCneuerdialog;PROCneuerdialog(TEXT CONSTx14):p14:=t14;u14:=x14END PROCneuerdialog;PROCdialog:BOOL VARh1;fensterzugriff(o14,h1);p14INCR1;IFp14>t14ORh1THENy14;p14:=1END IF;cursor(q14,r14+p14-1).y14:BOOL CONSTz14:=q14+s14>=80;IFz14ANDr14+t14>24ANDq14=1THENcursor(q14,r14);out(g14)ELSEa15END IF;out( +u14).a15:p14:=0;REPcursor(q14,r14+p14);IFz14THENout(a4)ELSEs14TIMESOUTh2END IF;p14INCR1UNTILp14>=t14END REP.END PROCdialog;BOOL PROCja(TEXT CONSTb15,f10):REPstatusanzeigen(j14);dialog;out(b15);out(" ? (j/n) ");s13;c15END REP;FALSE.c15:TEXT VARm6;REPgetchar(m6);IFm6="j"ORm6="J"THENout(m6);LEAVEjaWITH TRUE ELIFm6="n"ORm6="N"THENout(m6);LEAVEjaWITH FALSE ELIFm6=z3THENd15ELSEout(y3)END IF END REP.d15:getchar(m6);IFm6="?"THENhilfeanbieten(f10,o14);neuerdialog;LEAVEc15ELIFm6="h"THENerrorstop(g2);LEAVEjaWITH FALSE ELIFm6=""1""THENeschopausfuehrenELSEout(y3)END IF.END PROCja;PROCeditget(TEXT CONSTe15,TEXT VARm6,TEXT CONSTf15,f10):TEXT VARv8;g15;dialog;out(e15);out(h2);editget(m6,1000,h15,"","?hq"+f15,v8);IFv8=h14THENhilfeanbieten(f10,o14);neuerdialog;editget(e15,m6,"",f10)ELIFv8=y8ORv8=i14THENerrorstop(g2)ELIFlength(v8)=2THENm6:=v8END IF.g15:IFpos(f15,"z")>0THENstatusanzeigen(l14)ELSEstatusanzeigen(k14)END IF.h15:s14-length(e15)-1.END PROCeditget;PROCfehlerausgeben:TEXT CONSTv2:=errormessage; +IFerrorcode=1THENpage;bildschirmneuEND IF;clearerror;s13;IFv2<>g2THENstatusanzeigen(m14);i15;j15;neuerdialogEND IF.i15:dialog;IFp14=t14THENneuerdialog;dialogEND IF;out(y3);out(n14);dialog;outsubtext(errormessage,1,s14).j15:TEXT VARm6;getchar(m6);IFm6=z3THENd15END IF.d15:getchar(m6);IFm6="?"THENhilfeanbieten("FEHLER/"+text(errorcode),o14)ELIFm6=""1""THENeschopausfuehrenEND IF.END PROCfehlerausgeben;PROCs13:WHILEgetcharety<>g2REP END REP END PROCs13;LETk15=3,l15=1070,m15=0,n15=2;ROWk15DATASPACE VARk3;ROWk15THESAURUS VARm4;BOOL VARo15:=FALSE;INITFLAG VARp15;PROCd3:IF NOTinitialized(p15)THENq15END IF.q15:BOOL VARv7:=o15;r15;IFv7THENs15ELSEmenueloeschenEND IF.r15:INT VARl1;FORl1FROM1UPTOk15WHILEv7REPt15END REP.t15: +##INT VARu15,v15;FORv15FROM1UPTO10REPforget(k3(l1));k3(l1):=nilspace;pingpong(father,l15+l1,k3(l1),u15);IFu15=m15THEN LEAVEt15ELIFu15<>n15THENpause(15)END IF UNTILu15=n15END REP;forget(k3(l1));k3(l1):=nilspace; +##v7:=FALSE.END PROCd3;THESAURUS PROCmenuenamen(INT CONSTl1):d3;IFl1<0THENm12.j12(-l1)ELSEm4(l1)END IF END PROCmenuenamen;PROCmenueloeschen(TEXT CONSTname,INT CONSTl1):d3;IFl1<0THENw15(name,m12.j12(-l1))ELSEw15(name,m4(l1))END IF END PROCmenueloeschen;PROCw15(TEXT CONSTname,THESAURUS VARm1):INT CONSTindex:=link(m1,name);IFindex>0THENdelete(m1,index)END IF END PROCw15;PROCmenueloeschen:INT VARl1;FORl1FROM1UPTOk15REPforget(k3(l1));k3(l1):=nilspace;m4(l1):=emptythesaurusEND REP;s15END PROCmenueloeschen;PROCs15:m12:=k3(1);s3:=k3(2);f9:=k3(3)END PROCs15; +##PROCmenuemanager(DATASPACE VARx15,INT CONSTy15,z15,TASK CONSTa16):o15:=TRUE;IFy15>l15ANDy15<=l15+k15THENb16ELSEfreemanager(x15,y15,z15,a16)END IF.b16:IFa16=39THENfenstergroessesetzen(fenster,n1,o1,p1,q1);g1:=n1+p1>=80;s0:=p1;r0:=q1;u0:=n1;t0:=o1;f1:=TRUE ELSEerrorstop(m1)END IF END PROCanzeigefenster;PROCuebersichtsanzeige(BOOL CONSTja):e1:=ja;x0:=0;z0:=suchversion;h1:=TRUE END PROCuebersichtsanzeige;BOOL PROCuebersichtsanzeige:e1END PROCuebersichtsanzeige;PROCr1:BOOL VARfensterveraendert;fensterzugriff(fenster,fensterveraendert);IFfensterveraendertTHENh1:=TRUE END +IF END PROCr1;PROCs1:IFt1ORf1THENu1;v1;w1;x1;y1;z1END IF.t1:c1<>dateiversionORd1<>anzahldateien.u1:p0:=0;j1:=d0;WHILEp0h2THENq0:=max(h2,1)END IF;h1:=TRUE.h2:p0-r0+3.END PROCrollen;PROCfeldauswahl(TEXT CONSTi2):s1;IFe1THENj1:=i2ELSEj2END IF;h1:=TRUE.j2:p0:=length(i2);INT VARk2;FORk2FROM1UPTOp0REPm0(k2).k0:=code(i2SUBk2)END REP;q0:=1.END PROCfeldauswahl;INT VARl2;PROCm2:type(i1,-1);editfile:=sequentialfile(modify,i1);editinfo(editfile,-1);toline(editfile,1);col(editfile,1);l2:=1END PROCm2;.n2:l2<=p0. +PROCo2(PROC(TEXT CONST,INT CONST)p2):q2;IFeof(editfile)THENp2("",k0)ELIFr2THENs2;t2;p2(l1,k0)ELIFu2THENreadrecord(editfile,l1);t2;p2(l1,k0);down(editfile)ELSEexec(PROC(TEXT CONST,INT CONST)p2,editfile,k0);down(editfile)END IF.q2:INT CONSTc2:=l2,k0:=m0(c2).k0;REPl2INCR1UNTILl2>p0CORv2END REP.v2:m0(l2).k0<>k0.r2:l2-c2>1.s2:l1:="";REPexec(PROC(TEXT CONST,INT CONST)w2,editfile,length(l1));down(editfile)UNTILeof(editfile)ORlineno(editfile)=l2END REP.u2:INT CONSTx2:=len(editfile);subtext(editfile,x2,x2)=c0.END PROCo2;PROCw2(TEXT CONSTy2,INT CONSTz2):IFz2>0CAND(l1SUBz2)<>c0THENl1CATc0END IF;l1CATy2END PROCw2;PROCt2:INT VARx2:=length(l1);WHILE(l1SUBx2)=c0REPx2DECR1END REP;l1:=subtext(l1,1,x2)END PROCt2;LETa3="Satz einfuegen",b3="Satz aendern",c3="Suchmuster eingeben";PROCeinfuegen(PROCd3):enablestop;s1;IFp0>0THENm2;headline(editfile,a3);r1;e3(PROCd3);satzeinfuegen;f3END IF END PROCeinfuegen;PROCf3:WHILEn2REPo2(PROC(TEXT CONST,INT CONST)g3)END REP;aenderungeneintragenEND PROCf3;PROCg3(TEXT +CONSTh3,INT CONSTk0):feldaendern(k0,h3)END PROCg3;PROCaendern(PROCd3):enablestop;IFdateiendeTHENeinfuegen(PROCd3)ELSEi3END IF.i3:s1;IFp0>0THENm2;headline(editfile,b3);r1;j3(h1);k3;e3(PROCd3);f3END IF.k3:l3:=1;WHILEl3<=p0REPfeldbearbeiten(m0(l3).k0,PROC(TEXT CONST,INT CONST,INT CONST)m3);insertrecord(editfile);writerecord(editfile,l1);down(editfile);l3INCR1END REP;toline(editfile,1).END PROCaendern;INT VARl3;PROCm3(TEXT CONSTb2,INT CONSTc2,d2):l1:=subtext(b2,n3,o3).n3:c2+m0(l3).l0.o3:IFp3THENd2ELSEc2+m0(l3+1).l0-1END IF.p3:l3=p0CORm0(l3+1).k0<>m0(l3).k0.END PROCm3;PROCsuchen(PROCd3):enablestop;s1;suchbedingungloeschen;IFp0>0THENm2;headline(editfile,c3);r1;e3(PROCd3);q3END IF.q3:WHILEn2REPo2(PROC(TEXT CONST,INT CONST)r3)END REP.END PROCsuchen;PROCr3(TEXT CONSTs3,INT CONSTk0):suchbedingung(k0,s3)END PROCr3;PROCbildausgeben(BOOL CONSTt3):enablestop;s1;r1;IFe1THENu3(t3)ELIFt3ORh1ORv3ORz0<>suchversionTHENj3(h1);a1:=satznummer;b1:=satzkombination;z0:=suchversion;w3(TRUE)ELSEx3(TRUE)END IF.v3: +satznummer<>a1ORb1<>satzkombination.END PROCbildausgeben;INT VARl0;BOOL VARy3;PROCj3(BOOL CONSTz3):INT VARk2:=1,a4:=0;y3:=TRUE;WHILEk2<=p0OR NOTy3REPb4END REP.b4:IFy3CANDm0(k2).k0=a4THENc4ELSE IFd4THENe4END IF;m0(k2).l0:=l0;feldbearbeiten(m0(k2).k0,PROC(TEXT CONST,INT CONST,INT CONST)f4);k2INCR1END IF.c4:IFz3THENg4(k2)ELSEm0(k2).l0:=l0;k2INCR1END IF.d4:k2>p0CORm0(k2).k0<>a4.e4:IFy3THENh4ELSEi4(k2);m0(k2).k0:=a4END IF.h4:a4:=m0(k2).k0;l0:=0.END PROCj3;PROCf4(TEXT CONSTb2,INT CONSTc2,d2):INT CONSTj4:=d2-c2-l0+1;IFj4>w0-2THENl0INCRw0-2;k4;y3:=FALSE ELSEl0INCRj4;y3:=TRUE END IF.k4:INT VARl4:=c2+l0;IFm4ANDn4THENl4DECR1;WHILE(b2SUBl4)<>c0REPl4DECR1;l0DECR1END REP END IF.m4:(b2SUBl4)<>c0.n4:pos(b2,c0,l4-w0,l4)>0.END PROCf4;PROCi4(INT CONSTk2):INT VARo4;FORo4FROMp0DOWNTOk2REPm0(o4+1):=m0(o4)END REP;p0INCR1;h1:=TRUE END PROCi4;PROCg4(INT CONSTk2):INT VARo4;FORo4FROMk2+1UPTOp0REPm0(o4-1):=m0(o4)END REP;p0DECR1;h1:=TRUE END PROCg4;INT VARp4;TEXT VARq4,r4,s4,t4:="",u4;LETv4= +""15" Bild verschoben ! ESC 1 druecken ! "14"",w4=""3""10"19"11""12"q?h";LETx4=1,y4=2,z4=3,a5=4,b5=5,c5=6,d5=7,e5=8,f5=9;PROCe3(PROCd3):INT VARg5:=q0;h5;REPw3(FALSE);i5;j5;k5;l5UNTILm5END REP;n5;toline(editfile,1);col(editfile,1).h5:BOOL CONSTo5:=e1;IFe1THENuebersichtsanzeige(FALSE)END IF.i5:IFlines(editfile)1THENp5(q0-1,r4)END IF;p5(q5,s4);toline(editfile,g5).q5:min(p0+1,q0+r0-1).k5:openeditor(groesstereditor+1,editfile,TRUE,u0+v0+3,t0,w0,r5);edit(groesstereditor,w4+t4,PROC(TEXT CONST)s5).r5:min(p0-q0+2,r0).l5:g5:=lineno(editfile);t5;SELECTp4OF CASEx4:u5CASEy4:v5CASEz4:w5CASEa5:x5CASEb5:y5CASEc5:z5CASEe5:d3;h1:=TRUE CASEf5:n5;errorstop(d0)END SELECT.t5:INT CONSTa6:=col(editfile);col(editfile,1);IFq0<>1THENb6(q0-1,r4)END IF;b6(q5,s4);col(editfile,a6).u5:INT VARc6;c6:=g5-q0;rollen(-r0+1);g5:=q0+c6.v5:c6:=g5-q0;rollen(r0-1);g5:=min(q0+c6,p0).w5:rollen(-999);g5:=1.x5:c6:=g5-q0;rollen(999);g5:=min +(q0+c6,p0).y5:toline(editfile,g5);d6;i4(g5).d6:readrecord(editfile,l1);q4:=subtext(l1,a6);l1:=subtext(l1,1,a6-1);writerecord(editfile,l1);down(editfile);insertrecord(editfile);writerecord(editfile,q4).z5:toline(editfile,g5);IFa6=1AND(e6CANDf6ORg6CANDh6)THENi6ELSEj6END IF.e6:g5<>p0.f6:m0(g5+1).k0=m0(g5).k0.g6:g5<>1.h6:m0(g5-1).k0=m0(g5).k0.i6:deleterecord(editfile);g4(g5).j6:readrecord(editfile,l1);l1:=subtext(l1,1,a6-1);writerecord(editfile,l1).m5:p4=d5.n5:IFo5THENuebersichtsanzeige(TRUE)END IF.END PROCe3;PROCs5(TEXT CONSTk6):enablestop;setbusyindicator;p4:=pos(w4,k6);IFp4>0THENu4:=k6;quitELIFpos(t4,k6)>0THENp4:=d5;u4:=k6;quitELIFkommandoauftaste(k6)<>d0THENstdkommandointerpreter(k6)ELSEnichtsneuEND IF END PROCs5;PROCp5(INT CONSTk2,TEXT VARl6):toline(editfile,k2);readrecord(editfile,l6);writerecord(editfile,v4)END PROCp5;PROCb6(INT CONSTk2,TEXT CONSTl6):toline(editfile,k2);IFeof(editfile)CORpos(editfile,v4,1)=0THENtoline(editfile,1);down(editfile,v4);IFeof(editfile)THENtoline(editfile, +k2);insertrecord(editfile)END IF END IF;writerecord(editfile,l6)END PROCb6;PROCexitzeichen(TEXT CONSTm6):t4:=m6END PROCexitzeichen;TEXT PROCexitdurch:u4END PROCexitdurch;INT VARn6;LETo6="ENDE",p6="SUCH+",q6="SUCH-",r6="MARK+",s6="MARK-",t6=".....",u6=" ",v6=" Feld "14" ",w6=" Satz ";PROCw3(BOOL CONSTx6):INT VARy6:=t0+1,z6:=0;INT CONSTa7:=q0+r0-2;x3(x6);n6:=q0;WHILEn6<=a7REPb7;c7;d7;y6INCR1;n6INCR1END REP;h1:=FALSE.b7:IFh1THENcursor(u0,y6);IFn6<=p0THENe7ELIFn6=p0+1THENf7ELSEg7END IF END IF.e7:out(g0);IFm0(n6).k0=z6THENv0TIMESOUTc0ELSEz6:=m0(n6).k0;feldnamenbearbeiten(z6,PROC(TEXT CONST,INT CONST,INT CONST)h7)END IF;out(i0).f7:out(g0);s0-4TIMESOUT".";out(j0).g7:IFg1THEN IFt0+r0=25THENout(f0);h1:=FALSE;LEAVEw3ELSEout(e0)END IF ELSEs0TIMESOUTc0END IF.c7:IFx6ANDn6<=p0THENcursor(u0+v0+3,y6);feldbearbeiten(m0(n6).k0,PROC(TEXT CONST,INT CONST,INT CONST)i7)END IF.d7:IF NOTh1THEN TEXT CONSTinput:=getcharety;IFinput<>d0THENpush(input);IFpos(t4,input)>0THENa1:=0;LEAVEw3END IF END IF END + IF.END PROCw3;PROCx3(BOOL CONSTx6):j7;k7;cursor(u0,t0);IF NOTx6THENoutsubtext(k1,1,v0+3);LEAVEx3END IF;replace(k1,v0+7,l7);replace(k1,v0+14,m7);out(k1);cursor(u0+s0-5,t0);out(text(q0)).j7:TEXT VARsatznr;IFdateiendeTHENsatznr:=o6ELSEsatznr:=text(satznummer);IFanzahlkoppeldateien>0THENsatznrCAT"-";satznrCATtext(satzkombination)END IF END IF.k7:replace(k1,7,u6);replace(k1,7,satznr).l7:IFsuchversion=0THENt6ELIFsatzausgewaehltTHENp6ELSEq6END IF.m7:IFmarkiertesaetze=0THENt6ELIFsatzmarkiertTHENr6ELSEs6END IF.END PROCx3;PROCh7(TEXT CONSTb2,INT CONSTc2,d2):IFd2-c2>=v0THENoutsubtext(b2,c2,c2+v0-1)ELSEoutsubtext(b2,c2,d2);v0-d2+c2-1TIMESOUTc0END IF END PROCh7;PROCi7(TEXT CONSTb2,INT CONSTc2,d2):INT VARx2;IFn6=p0CORn7THENx2:=d2ELSEx2:=c2+m0(n6+1).l0-1END IF;outsubtext(b2,c2+m0(n6).l0,x2);IFg1THENout(e0)ELSEo7TIMESOUTc0END IF.n7:m0(n6+1).k0<>m0(n6).k0.o7:w0-x2+c2+m0(n6).l0-1.END PROCi7;PROCw1:k1:=text(w6,v0+3);k1CATg0;INT VARo4;INT CONSTp7:=s0-length(k1)-11;FORo4FROM1UPTOp7REPk1CAT"."END REP;k1CAT +v6;q7.q7:TEXT VARr7:=eudasdateiname(1);r7:=subtext(r7,1,p7-20);r7CATc0;replace(k1,v0+21,c0);replace(k1,v0+22,r7).END PROCw1;INT VARs7;BOOL VARt7;LETu7=""15"Satznr. ",v7=" << DATEIENDE >>";PROCu3(BOOL CONSTt3):BOOL VARw7:=TRUE;INT VARo4;INT CONSTx7:=x0;y7;t7:=FALSE;IFh1ORw7THENz7;h1:=FALSE ELSEa8END IF;y0:=0;b8.y7:IFsuchversion<>z0ORc8THENd8;z0:=suchversionELIFx0>0CANDy0<>0THENe8ELIFf8THENg8;x0:=1ELIF NOTt3THENw7:=FALSE END IF.c8:satznummer+y0<0.d8:aufsatz(1);IF NOTsatzausgewaehltTHENweiter(2)END IF;g8;x0:=1.f8:x0=0CORh8.h8:IFi8(x0)THEN FALSE ELSEj8END IF.j8:FORo4FROM1UPTOr0-1REP IFi8(o4)THENx0:=o4;LEAVEj8WITH FALSE END IF END REP;TRUE.e8:IFy0<0THENu5ELSEv5END IF.u5:IF-y01REPzurueck(2)END REP;g8END IF.v5:IFy0+x00THENm8END IF.l8:INT CONSTn8:=y0+1;IFn0(n8)<>0THENn0(1):=n0(n8);o0(1):=o0(n8)END IF.m8:k8(r0-1);FORo4FROM1UPTOy0-r0+2WHILE NOTdateiendeREPweiter(2)END +REP;g8.z7:o8;p8;INT VARq8;FORq8FROM2UPTOr0-1REPr8END REP.o8:cursor(u0,t0);out(u7);s7:=s0-10;INT VARfeldindex;FORfeldindexFROM1UPTOlength(j1)WHILEs7>0REPfeldnamenbearbeiten(code(j1SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)s8)END REP;t8;cursor(u0+s0-1,t0);out(h0).p8:k8(1);u8(1);v8.r8:cursor(u0,t0+q8);IFdateiendeTHENn0(q8):=0;s7:=s0;t8ELSEw8;u8(q8);v8END IF.w8:IFw7THENweiter(2);x8;n0(q8):=satznummer;o0(q8):=satzkombinationELSEk8(q8)END IF.x8:IF NOT(satzausgewaehltORdateiende)THENh1:=TRUE;LEAVEu3END IF.a8:u8(x7).b8:t7:=TRUE;WHILEn0(x0)=0REPx0DECR1END REP;u8(x0);k8(x0);y8.END PROCu3;PROCk8(INT CONSTs3):aufsatz(n0(s3));WHILEsatzkombination<>o0(s3)REPweiter(1)END REP END PROCk8;PROCg8:n0(1):=satznummer;o0(1):=satzkombinationEND PROCg8;BOOL PROCi8(INT CONSTs3):satznummer=n0(s3)CANDsatzkombination=o0(s3)END PROCi8;PROCs8(TEXT CONSTb2,INT CONSTc2,d2):INT CONSTr0:=min(s7,d2-c2+1);outsubtext(b2,c2,c2+r0-1);s7DECRr0;IFs7>=2THENout(", ");s7DECR2ELIFs7=1THENout(",");s7:=0END IF END PROCs8; +PROCu8(INT CONSTs3):cursor(u0,t0+s3);IFt7THENout(g0)ELSEout(c0)END IF;outtext(text(n0(s3)),1,5);IFt7THENout(h0)ELSEout(c0)END IF;s7:=s0-7END PROCu8;PROCt8:IFg1THENout(e0)ELSEs7TIMESOUTc0END IF END PROCt8;PROCv8:IFsatzausgewaehltTHENy8;z8ELIFdateiendeTHENout(v7);s7DECR17ELSEy8;out("<< >>");s7DECR5END IF;t8.z8:INT VARfeldindex;FORfeldindexFROM1UPTOlength(j1)WHILEs7>0REPfeldbearbeiten(code(j1SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)s8)END REP.END PROCv8;PROCy8:IFsatzmarkiertTHENout("+ ")ELSEout("- ")END IF;s7DECR2END PROCy8;END PACKETsatzanzeige; +PACKETeudassteuerungDEFINESeudas,dateiverwaltung,edit,dateinamenanfordern,ausfuehrung,einzelausfuehrung:LETa9=1003,b9=3243;LETd0="",c0=" ",c9=""7"",d9=""27"z",e0=""5"",e9=""27"qa",f9=""27"qb";FILE VARg9;DATASPACE VARh9;INT VARi9,j9:=dateiversion-1;FENSTER VARx4,y4;TEXT VARk9;fensterinitialisieren(x4);fensterinitialisieren(y4);fenstergroessesetzen(x4,1,1,79,6);fenstergroessesetzen(y4,1,8,79,17);dialogfenster(1,9,79,16);neuerdialog(""6""7""0":"+75*"-"+":"5"");anzeigefenster(1,8,79,17);statuszeile(""6""6""0" ",""5"");LETl9="Bitte erst eine Datei oeffnen !",m9="Bei geketteten oder gekoppelten Dateien nicht moeglich",n9="Keine Sicherung noetig.",o9="Interne Arbeitskopien loeschen",p9="Arbeitskopie ",q9=" unveraendert.",r9=" veraendert! Sichern",s9="Alte Version ueberschreiben",t9="Sondern unter dem Namen:",u9=" ueberschreiben",v9="Datei wieder sortieren",w9="Wollen Sie etwas veraendern (eine Arbeitskopie anlegen)",x9="Pruefbedingungen aendern",y9="Feldnamen anfuegen",z9="Neuer Feldname:", +a10="Neuer Typ (TEXT,DIN,ZAHL,DATUM):",b10="Neue Feldnamen eingeben",c10="TEXT",d10="DIN",e10="ZAHL",f10="DATUM",g10="Alte Feldreihenfolge aendern",h10=""7"ACHTUNG: System voll, Dateien loeschen!";PROCeudas:page;bildschirmneu;dialog;i9:=heapsize;menueanbieten("EUDAS-Hauptmenue",x4,TRUE,PROC(INT CONST)i10);j10;page;bildschirmneuEND PROCeudas;PROCi10(INT CONSTk10):enablestop;SELECTk10OF CASE1:l10CASE2:m10CASE3:n10CASE4:o10CASE5:p10CASE6:q10CASE7:r10CASE8:dateiverwaltungEND SELECT;s10;t10.l10:u10;exitzeichen("wz");bildausgeben(TRUE);menueanbieten("EUDAS-Ansehen",x4,TRUE,PROC(INT CONST)v10);dialog.m10:neuerdialog;dialog;menueanbieten("EUDAS-Bearbeiten",x4,TRUE,PROC(INT CONST)w10).u10:IFanzahldateien=0OR NOTexists(eudasdateiname(1))THENerrorstop(l9)END IF.n10:j10;dateienloeschen(TRUE);forget(h9);x10:=TRUE;ausfuehrung(PROC(TEXT CONST)y10,b9).o10:u10;IFanzahldateien>1THENerrorstop(m9)ELSEzugriff(PROC(EUDAT VAR)z10)END IF.p10:ausfuehrung(PROC(TEXT CONST)kopple,b9).q10:u10;IFanzahldateien>1THEN +errorstop(m9)ELSEzugriff(PROC(EUDAT VAR)a11)END IF.r10:IFaendernerlaubtTHENb11ELSEdialog;out(n9)END IF.b11:INT VARc11;FORc11FROM1UPTOanzahldateienREPd11(c11)END REP;IFja(o9,"JA/Dateien loeschen")THENdateienloeschen(TRUE)ELSEerrorstop(d0)END IF.t10:IFheapsize-i9>4THENcollectheapgarbage;i9:=heapsizeEND IF.END PROCi10;PROCj10:INT VARc11;FORc11FROM1UPTOanzahldateienREP IFinhaltveraendert(c11)THENd11(c11)END IF END REP END PROCj10;PROCd11(INT CONSTc11):e11;IFinhaltveraendert(c11)THEN IFja(e5,"JA/sichere")THENf11END IF ELSEdialog;out(e5)END IF.e11:TEXT VARe5:=p9;e5CATtextdarstellung(eudasdateiname(c11));IFinhaltveraendert(c11)THENe5CATr9ELSEe5CATq9END IF.f11:TEXT VARname:=eudasdateiname(c11);IFja(s9,"JA/alte version")THENforget(name,quiet)ELSEg11END IF;sichere(c11,name);h11.g11:editget(t9,name,"","GET/Sicherungsname");IFexists(name)THENi11END IF.i11:IFja(textdarstellung(name)+u9,"JA/ueber")THENforget(name,quiet)ELSEd11(c11);LEAVEd11END IF.h11:EUDAT VARj11;oeffne(j11,name);IFk11CANDl11THENm11 +;sortiere(j11)END IF.k11:sortierreihenfolge(j11)<>d0CANDunsortiertesaetze(j11)>0.l11:ja(v9,"JA/Sicherungssortierung").END PROCd11;BOOL VARx10;PROCy10(TEXT CONSTr7):BOOL VARn11;IFx10THENo11;oeffne(r7,n11);x10:=FALSE ELSEkette(r7)END IF.o11:IF NOTexists(r7)THENp11(r7);EUDAT VARj11;oeffne(j11,r7);z10(j11);n11:=TRUE ELSEn11:=ja(w9,"JA/oeffne")END IF.END PROCy10;PROCz10(EUDAT VARj11):SATZ VARb2;feldnamenlesen(j11,b2);IFq11THENr11END IF;s11;IFja(x9,"JA/Pruefbed")THENt11END IF.q11:IFfelderzahl(b2)>0THENja(y9,"JA/feldnamen")ELSE TRUE END IF.r11:DATASPACE VARu11:=nilspace;FILE VARf:=sequentialfile(output,u11);disablestop;v11(f,b2);forget(u11);enablestop;feldnamenaendern(j11,b2).s11:w11;auswahlanbieten("EUDAS-Felder",y4,"AUSWAHL/Felder",PROC(TEXT VAR,INT CONST)x11);INT VARk0:=1;WHILEwahl(k0)>0REPg3;k0INCR1END REP;feldnamenaendern(j11,b2).w11:satzinitialisieren(y11);FORk0FROM1UPTOfelderzahl(b2)REPfeldlesen(b2,k0,k9);feldaendern(y11,k0,z11+textdarstellung(k9))END REP.z11:"("+a12(feldinfo(j11,k0))+ +") ".g3:TEXT VARb12;feldlesen(b2,wahl(k0),b12);editget(z9,b12,"","GET/feldname");feldaendern(b2,wahl(k0),b12);TEXT VARc12:=a12(feldinfo(j11,wahl(k0)));REPeditget(a10,c12,"","GET/feldtyp")UNTILd12(c12)>=-1END REP;feldinfo(j11,wahl(k0),d12(c12)).t11:u11:=nilspace;f:=sequentialfile(output,u11);notizenlesen(j11,1,k9);disablestop;e12(f,k9);forget(u11);enablestop;notizenaendern(j11,1,k9).END PROCz10;PROCv11(FILE VARf,SATZ VARb2):enablestop;f12;g12.f12:modify(f);headline(f,b10);edit(f,y4,"EDIT/Feldnamen").g12:INT VARk0:=felderzahl(b2);input(f);WHILE NOTeof(f)REPgetline(f,k9);h12;k0INCR1;feldaendern(b2,k0,k9)END REP.h12:IF(k9SUBlength(k9))=c0THENk9:=subtext(k9,1,length(k9)-1)END IF.END PROCv11;TEXT PROCa12(INT CONSTc12):SELECTc12+1OF CASE0:c10CASE1:d10CASE2:e10CASE3:f10OTHERWISEd0END SELECT END PROCa12;INT PROCd12(TEXT CONSTi12):IFi12=c10THEN-1ELIFi12=d10THEN0ELIFi12=e10THEN1ELIFi12=f10THEN2ELSE-2END IF END PROCd12;PROCe12(FILE VARf,TEXT VARj12):LETk12="#-#";enablestop;l12;m12;n12.l12:INT VAR +c2:=1,d2;REPd2:=pos(j12,k12,c2);IFd2=0THENputline(f,subtext(j12,c2))ELSEputline(f,subtext(j12,c2,d2-1))END IF;c2:=d2+3UNTILd2=0ORc2>length(j12)END REP.m12:modify(f);headline(f,x9);edit(f,y4,"EDIT/Pruefbed").n12:TEXT VARs3;j12:=d0;input(f);WHILE NOTeof(f)REPgetline(f,s3);h12;j12CATs3;j12CATk12END REP.h12:IF(s3SUBlength(s3))=c0THENs3:=subtext(s3,1,length(s3)-1)END IF.END PROCe12;PROCa11(EUDAT VARj11):TEXT VARo12:=sortierreihenfolge(j11);IFo12=d0CORp12THENq12;m11;sortiere(j11,o12)ELSEm11;sortiere(j11)END IF.p12:ja(g10,"JA/Sortierfelder").q12:feldnamenlesen(j11,y11);auswahlanbieten("EUDAS-Sortierfelder",y4,"AUSWAHL/Sortierfelder",PROC(TEXT VAR,INT CONST)x11);INT VARk0:=1;o12:=d0;WHILEwahl(k0)<>0REPo12CATcode(wahl(k0));k0INCR1END REP.END PROCa11;PROCs10:INT VARr12,s12;storage(r12,s12);IFs12>r12THENneuerdialog;dialog;out(h10)END IF END PROCs10;LETt12=" Rollen: ESC OBEN / ESC UNTEN Zurueck: ESC q Hilfe: ESC ?",u12= +"Zeile loeschen: ESC RUBOUT Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",v12="Ungueltige Satznummer",w12="Neue Satznummer:",x12=" Bitte warten.. ";PROCv10(INT CONSTk10):y12(k10);IFiserrorTHENfehlerausgeben;bildausgeben(TRUE);errorstop(d0)END IF END PROCv10;PROCy12(INT CONSTk10):enablestop;SELECTk10OF CASE1:z12CASE2:a13CASE3:b13CASE4:c13CASE5:d13CASE6:e13CASE7:f13CASE8:m10END SELECT;s10.z12:m11;weiter(2);IFuebersichtsanzeigeTHENrollen(1)END IF;bildausgeben(FALSE).a13:m11;zurueck(2);bildausgeben(FALSE).b13:disablestop;exitzeichen("");statusanzeigen(u12);suchen(PROCg13);exitzeichen("wz");enablestop;bildausgeben(TRUE).c13:suchbedingungloeschen;bildausgeben(FALSE).d13:TEXT VARh13:=d0;editget(w12,h13,"","GET/auf satz");INT CONSTi13:=int(h13);IFlastconversionokTHENaufsatz(i13);bildausgeben(FALSE)ELSEerrorstop(v12)END IF.e13:statusanzeigen(t12);TEXT VARj13;REPcursor(1,7);getchar(j13);k13END REP.k13:SELECTpos(""3""10""27"",j13)OF CASE1:rollen(-1)CASE2:rollen(1)CASE3:l13OTHERWISEout(c9)END +SELECT;bildausgeben(FALSE).l13:getchar(j13);SELECTpos(""3""10"19q?"1"",j13)OF CASE1:rollen(-16)CASE2:rollen(16)CASE3:rollen(-9999)CASE4:rollen(9999)CASE5:LEAVEe13CASE6:m13CASE7:eschopausfuehrenOTHERWISEout(c9)END SELECT.m13:hilfeanbieten("EUDAS/rollen",y4);statusanzeigen(t12).f13:menueanbieten("EUDAS-Einzelsatz",x4,TRUE,PROC(INT CONST)n13).m10:push(f9).END PROCy12;PROCg13:hilfeanbieten("EDIT/Suchen",y4)END PROCg13;PROCm11:cursor(1,7);out(x12);out(e0)END PROCm11;BOOL VARo13;LETp13="Aenderungen sind nicht erlaubt",w6="Satz ";PROCn13(INT CONSTk10):q13(k10);IFiserrorTHENfehlerausgeben;bildausgeben(TRUE);errorstop(d0)END IF END PROCn13;PROCq13(INT CONSTk10):enablestop;BOOL VARt3:=TRUE;SELECTk10OF CASE1:r13CASE2:s13CASE3:t13CASE4:u13CASE5:v13CASE6:w13CASE7:x13CASE8:y13END SELECT;s10;bildausgeben(t3).r13:z13;exitzeichen("wz");REPstatusanzeigen(u12);einfuegen(PROCa14);b14;IFo13THENsatzloeschenEND IF;c14END REP.c14:SELECTpos("wz",exitdurch)OF CASE0:LEAVEr13CASE1:IF NOTo13THENm11;weiter(2)END IF + CASE2:IF NOTo13THENm11;zurueck(2)END IF END SELECT.s13:z13;exitzeichen("wz");REPd14;statusanzeigen(u12);aendern(PROCe14);b14;IFo13THENsatzloeschenEND IF;f14END REP.f14:SELECTpos("wz",exitdurch)OF CASE0:LEAVEs13CASE1:IF NOTo13THENm11;weiter(2)END IF CASE2:IF NOTo13THENm11;zurueck(2)END IF END SELECT.d14:IFj9=dateiversionTHENmodify(g9);toline(g9,1);col(g9,1);g14END IF.g14:TEXT CONSTi13:=w6+text(satznummer);downety(g9,i13);IF NOTeof(g9)THENh14END IF.h14:INT VARk2:=1;fensterveraendert(x4);REPcursor(1,k2);IFeof(g9)THENout(e0)ELSEexec(PROC(TEXT CONST,INT CONST)i14,g9,0);down(g9,i13)END IF;k2INCR1UNTILk2>6END REP.t13:markierungaendern;t3:=FALSE.u13:markierungenloeschen.v13:z13;dateinamenanfordern(j14);einzelausfuehrung(PROC(TEXT CONST)k14,b9).w13:z13;dateinamenanfordern(l14);einzelausfuehrung(PROC(TEXT CONST)holesatz,b9).x13:uebersichtsanzeige(NOTuebersichtsanzeige).y13:auswahlanbieten("EUDAS-Anzeigefelder",y4,"AUSWAHL/Anzeigefelder",PROC(TEXT VAR,INT CONST)m14);TEXT VARi2:=d0;INT VARh13:=1; +WHILEwahl(h13)>0REPi2CATcode(wahl(h13));h13INCR1END REP;feldauswahl(i2);t3:=FALSE.END PROCq13;PROCz13:IF NOTaendernerlaubtTHENerrorstop(p13)END IF END PROCz13;PROCa14:hilfeanbieten("EDIT/Einfuegen",y4)END PROCa14;PROCe14:hilfeanbieten("EDIT/Aendern",y4)END PROCe14;PROCi14(TEXT CONSTs3,INT CONSTe2):INT CONSTn14:=e2;outsubtext(s3,l0);out(e0).l0:pos(s3,c0,6)+1.END PROCi14;PROCb14:feldbearbeiten(1,PROC(TEXT CONST,INT CONST,INT CONST)o14)END PROCb14;PROCo14(TEXT CONSTb2,INT CONSTc2,d2):INT CONSTn14:=d2;o13:=c2<3ORc2>length(b2)END PROCo14;PROCm14(TEXT VARname,INT CONSTh13):IFh13<=anzahlfelderTHENfeldnamenlesen(h13,name)ELSEname:=d0END IF END PROCm14;PROCk14(TEXT CONSTr7):IFexists(r7)THENp14ELSEp11(r7)END IF;m11;tragesatz(r7).p14:IFq14(r7)<>0THENerrorstop(r14)END IF.END PROCk14;LETs14="Zieldatei anschliessend sortieren",t14="Pruefbedingungen testen",u14="Prueffehler festgestellt",r14="Zieldatei darf nicht geoeffnet sein",v14="Kopiermuster aendern";PROCw10(INT CONSTk10):enablestop;SELECTk10OF +CASE1:w14CASE2:x14CASE3:y14CASE4:z14CASE5:a15CASE6:b15CASE7:l10CASE8:dateiverwaltungEND SELECT;c15;s10.w14:dateinamenanfordern(d15);ausfuehrung(PROC(TEXT CONST)e15,a9).x14:z13;dateinamenanfordern(j14);einzelausfuehrung(PROC(TEXT CONST)f15,b9).y14:ausfuehrung(PROC(TEXT CONST)g15,a9).z14:dateinamenanfordern(j14);einzelausfuehrung(PROC(TEXT CONST)h15,b9).a15:ausfuehrung(PROC(TEXT CONST)print,a9).b15:z13;dateinamenanfordern(i15);ausfuehrung(PROC(TEXT CONST)j15,a9).l10:push(e9).END PROCw10;PROCk15:IFl15THENclearerrorEND IF.l15:iserrorCANDerrormessage=d0.END PROCk15;PROCe15(TEXT CONSTr7):IF NOTexists(r7)THENg15(r7)END IF;m11;dialog;disablestop;drucke(r7);k15END PROCe15;PROCf15(TEXT CONSTr7):BOOL VARm15;IFexists(r7)THENp14;n15ELSEp11(r7);m15:=FALSE END IF;BOOL CONSTo15:=ja(s14,"JA/sortieren");m11;p15;trage(r7,g9,m15);q15;IFo15THEN EUDAT VARj11;oeffne(j11,r7);sortiere(j11)END IF.p14:IFq14(r7)<>0THENerrorstop(r14)END IF.n15:m15:=ja(t14,"JA/testen").p15:IFm15THENforget(h9);h9:=nilspace;g9:= +sequentialfile(output,h9);j9:=dateiversionELSEforget(h9);j9:=dateiversion-1END IF.q15:IFm15CANDlines(g9)>0THENdialog;put(lines(g9));put(u14)END IF.END PROCf15;PROCg15(TEXT CONSTr7):r15(r7,"EDIT/Druckmuster")END PROCg15;PROCj15(TEXT CONSTr7):IF NOTexists(r7)THENr15(r7,"EDIT/Verarbeite")END IF;m11;dialog;FILE VARf:=sequentialfile(input,r7);disablestop;verarbeite(f);k15.END PROCj15;PROCh15(TEXT CONSTr7):IFexists(r7)THENp14ELSEp11(r7)END IF;BOOL CONSTo15:=ja(s14,"JA/sortieren");disablestop;DATASPACE VARu11:=nilspace;FILE VARf:=sequentialfile(output,u11);s15(f,r7);forget(u11);enablestop;IFo15THEN EUDAT VARj11;oeffne(j11,r7);sortiere(j11)END IF.p14:IFq14(r7)<>0THENerrorstop(r14)END IF.END PROCh15;PROCs15(FILE VARf,TEXT CONSTr7):enablestop;stdkopiermuster(r7,f);headline(f,v14);REPclearerror;enablestop;edit(f,y4,"EDIT/Kopiermuster");m11;dialog;disablestop;kopiere(r7,f);IFiserrorTHENbildschirmneuEND IF UNTIL NOTt15END REP.t15:iserrorCANDerrormessage=d0CANDerrorcode=0.END PROCs15;INT PROCq14(TEXT + CONSTr7):INT VARc11;FORc11FROM1UPTOanzahldateienREP IFeudasdateiname(c11)=r7THEN LEAVEq14WITHc11END IF END REP;0END PROCq14;PROCr15(TEXT CONSTr7,d3):IF NOTexists(r7)THENp11(r7)END IF;FILE VARf:=sequentialfile(modify,r7);edit(f,y4,d3)END PROCr15;PROCprint(TEXT CONSTr7):do("print ("+textdarstellung(r7)+")")END PROCprint;PROCc15:INT VARu15,v15;getcursor(u15,v15);IFv15=24THENbildschirmneu;dialogEND IF END PROCc15;TEXT VARw15:=d0;THESAURUS VARx15;BOOL VARy15,z15;LETa16="Name des Archivs:",b16=" auf Archiv ueberschreiben",c16="Neuer Name:",d16=" im System ueberschreiben",e16=" auf Archiv loeschen",f16=" im System loeschen",g16=" neu einrichten";PROCdateiverwaltung:neuerdialog;dialog;disablestop;y15:=FALSE;menueanbieten("EUDAS-Dateiverwaltung",x4,TRUE,PROC(INT CONST)h16);IFy15THENrelease(archive)END IF END PROCdateiverwaltung;PROCh16(INT CONSTk10):enablestop;SELECTk10OF CASE1:i16CASE2:j16CASE3:k16CASE4:l16CASE5:m16CASE6:n16CASE7:o16CASE8:p16END SELECT;s10.i16:q16;archive(w15);y15:=TRUE;m11; +x15:=ALLarchive;ausfuehrung(PROC(TEXT CONST)r16,0).j16:ausfuehrung(PROC(TEXT CONST)s16,0).k16:disablestop;t16;m11;x15:=ALLarchive;IFu16THENx15:=ALLarchiveEND IF;enablestop;v16(PROC(TEXT CONST)w16).l16:ausfuehrung(PROC(TEXT CONST)x16,0).m16:q16;archive(w15);y15:=TRUE;m11;x15:=ALLarchive;v16(PROC(TEXT CONST)m16).n16:ausfuehrung(PROC(TEXT CONST)y16,0).o16:t16;disablestop;m11;list(archive);IFu16THENlist(archive)END IF;z16;enablestop;bildschirmneu;dialog.p16:list;z16;bildschirmneu;dialog.END PROCh16;PROCz16:WHILEgetcharety<>d0REP END REP END PROCz16;PROCq16:editget(a16,w15,"","GET/Archivname")END PROCq16;PROCt16:IF NOTy15THENarchive(w15);y15:=TRUE END IF END PROCt16;BOOL PROCu16:IFiserrorTHEN TEXT CONSTa17:=errormessage;IFsubtext(a17,1,14)="Archiv heisst "CANDsubtext(a17,16,20)<>"?????"THENclearerror;b17;LEAVEu16WITH TRUE END IF END IF;FALSE.b17:w15:=subtext(a17,16,length(a17)-1);archive(w15).END PROCu16;PROCr16(TEXT CONSTr7):disablestop;IF NOT(x15CONTAINSr7)CORc17THENd17;m11;e17;save(r7, +archive);f17END IF.c17:ja(textdarstellung(r7)+b16,"JA/save").d17:INT CONSTh13:=q14(r7);IFh13>0CANDinhaltveraendert(h13)THENd11(h13)END IF.END PROCr16;PROCs16(TEXT CONSTr7):m11;IFtype(old(r7))=b9THENreorganisiere(r7)ELSEreorganize(r7)END IF END PROCs16;PROCx16(TEXT CONSTr7):TEXT VARg17:=r7;IFexists(r7)THENeditget(c16,g17,"","GET/rename")END IF;rename(r7,g17)END PROCx16;PROCw16(TEXT CONSTr7):disablestop;IF NOTexists(r7)CORh17THENm11;e17;fetch(r7,archive);f17END IF.h17:ja(textdarstellung(r7)+d16,"JA/fetch").END PROCw16;PROCm16(TEXT CONSTr7):disablestop;IF NOT(x15CONTAINSr7)CORm16THENm11;e17;erase(r7,archive);f17END IF.m16:ja(textdarstellung(r7)+e16,"JA/erase").END PROCm16;PROCy16(TEXT CONSTr7):IFexists(r7)CANDi17THENforget(r7,quiet)END IF.i17:ja(textdarstellung(r7)+f16,"JA/forget").END PROCy16;PROCe17:z15:=commanddialogue;commanddialogue(FALSE)END PROCe17;PROCf17:commanddialogue(z15)END PROCf17;PROCv16(PROC(TEXT CONST)j17):TEXT VARr7:=d0;editget(k17,r7,"z","GET/Dateiname");IFr7=d9THENl17 +ELSElastparam(r7);j17(r7)END IF.l17:m17(x15,0);auswahlanbieten("EUDAS-Archivauswahl",y4,"AUSWAHL/Archiv",PROC(TEXT VAR,INT CONST)x11);n17(PROC(TEXT CONST)j17).END PROCv16;SATZ VARy11;LETk17="Name der Datei:",j14="Name der Zieldatei:",i15="Name der Verarbeitungsvorschrift:",d15="Name des Druckmusters:",l14="Name der Quelldatei:";TEXT VARo17:=k17;PROCm17(THESAURUS CONSTi12,INT CONSTc12):INT VARl4:=1,c2:=0;satzinitialisieren(y11);REPget(i12,k9,c2);IFk9=d0THEN LEAVEm17ELIFc12=0CORtype(old(k9))=c12THENfeldaendern(y11,l4,k9);l4INCR1END IF END REP END PROCm17;PROCp17(TEXT VARh3,INT CONSTl4):IFl4<=256THENfeldlesen(y11,l4,h3);IFh3<>d0THENh3:=textdarstellung(h3)END IF ELSEh3:=d0END IF END PROCp17;PROCn17(PROC(TEXT CONST)j17):INT VARl4:=1;REP IFwahl(l4)=0THEN LEAVEn17ELSEfeldlesen(y11,wahl(l4),k9);dialog;out(text(l4,3));out(". ");out(textdarstellung(k9));lastparam(k9);j17(k9)END IF;l4INCR1END REP END PROCn17;PROCausfuehrung(PROC(TEXT CONST)j17,INT CONSTc12):TEXT VARr7;dateinamenanfordern(r7,c12); +IFr7=d9THENn17(PROC(TEXT CONST)j17)ELSElastparam(r7);j17(r7)END IF END PROCausfuehrung;PROCeinzelausfuehrung(PROC(TEXT CONST)j17,INT CONSTc12):TEXT VARr7;dateinamenanfordern(r7,c12);IFr7=d9THEN IFwahl(1)=0THENerrorstop(d0)ELSEfeldlesen(y11,wahl(1),r7)END IF END IF;lastparam(r7);j17(r7)END PROCeinzelausfuehrung;PROCdateinamenanfordern(TEXT CONSTq17):o17:=q17END PROCdateinamenanfordern;PROCdateinamenanfordern(TEXT VARr7,INT CONSTc12):IFexists(std)AND(c12=0CORtype(old(std))=c12)THENr7:=stdELSEr7:=d0END IF;disablestop;editget(o17,r7,"z","GET/Dateiname");o17:=k17;enablestop;IFr7=d0THENerrorstop(d0)ELIFr7=d9THENm17(all,c12);auswahlanbieten("EUDAS-Dateiauswahl",y4,"AUSWAHL/Datei",PROC(TEXT VAR,INT CONST)p17)END IF END PROCdateinamenanfordern;PROCx11(TEXT VARh3,INT CONSTl4):IFl4<=256THENfeldlesen(y11,l4,h3)ELSEh3:=d0END IF END PROCx11;PROCp11(TEXT CONSTr7):IF NOTja(textdarstellung(r7)+g16,"JA/einrichten")THENerrorstop(d0)END IF END PROCp11;LETr17= +"Editieren ESC h - Abbruch ESC q - Verlassen ESC ? - Hilfe";PROCedit(FILE VARf,FENSTER CONSTfenster,TEXT CONSTd3):INT VARu15,v15,s17,t17;fenstergroesse(fenster,u15,v15,s17,t17);fensterveraendert(fenster);enablestop;REPstatusanzeigen(r17);openeditor(groesstereditor+1,f,TRUE,u15,v15,s17,t17);edit(groesstereditor,"eqvw19dpgn"9"?h",PROC(TEXT CONST)u17);SELECTv17OF CASE0:LEAVEeditCASE1:hilfeanbieten(d3,fenster)CASE2:errorstop(d0)END SELECT END REP END PROCedit;INT VARv17;PROCu17(TEXT CONSTk6):v17:=pos("?h",k6);IFv17>0THENquitELSEstdkommandointerpreter(k6)END IF END PROCu17;END PACKETeudassteuerung; + diff --git a/app/eudas/3.4/src/eudas.gen-m b/app/eudas/3.4/src/eudas.gen-m new file mode 100644 index 0000000..4a4dc5d --- /dev/null +++ b/app/eudas/3.4/src/eudas.gen-m @@ -0,0 +1,49 @@ +INT VAR size, used; +BOOL VAR einzeln; +storage (size, used); +einzeln := size - used < 500; +forget ("eudas.gen/m", quiet); +page; +putline ("EUDAS - automatische Generierung"); +line; +IF NOT einzeln THEN + holen ("eudas.1"); + holen ("eudas.2"); + holen ("eudas.3"); + holen ("eudas.4"); + holen ("eudas.init"); + release (archive) +END IF; +check off; +gen ("eudas.1"); +gen ("eudas.2"); +gen ("eudas.3"); +gen ("eudas.4"); +IF anything noted THEN + push (""27"q"); note edit; pause (100) +END IF; +holen ("eudas.init"); +IF einzeln THEN + release (archive) +END IF; +do("FILE VARf:=sequentialfile(modify,""eudas.init"");menuedateneinlesen(f)"); +forget ("eudas.init", quiet); +check on; +do ("global manager"); + +PROC vom archiv (TEXT CONST datei): + out (""""); out (datei); putline (""" wird geholt."); + fetch (datei, archive) +END PROC vom archiv; + +PROC holen (TEXT CONST datei) : + IF NOT exists (datei) THEN vom archiv (datei) END IF +END PROC holen; + +PROC gen (TEXT CONST datei) : + holen (datei); + out (""""); out (datei); out (""" wird uebersetzt: "); + insert (datei); + forget (datei, quiet) +END PROC gen; + diff --git a/app/eudas/3.4/src/eudas.gen-s b/app/eudas/3.4/src/eudas.gen-s new file mode 100644 index 0000000..b9541ff --- /dev/null +++ b/app/eudas/3.4/src/eudas.gen-s @@ -0,0 +1,39 @@ +forget ("eudas.gen/s", quiet); +page; +putline ("EUDAS - automatische Generierung"); +line; +check off; +gen ("eudas.1"); +gen ("eudas.2"); +holen ("eudas.3"); +FILE VAR f := sequential file (modify, "eudas.3"); +to line (f, 30); delete record (f); +to line (f, 28); delete record (f); +to line (f, 7); delete record (f); +to line (f, 5); delete record (f); +gen ("eudas.3"); +gen ("eudas.4"); +IF anything noted THEN + push (""27"q"); note edit; pause (100) +END IF; +holen ("eudas.init"); +do("FILE VARf:=sequentialfile(modify,""eudas.init"");menuedateneinlesen(f)"); +forget ("eudas.init", quiet); +check on; + +PROC vom archiv (TEXT CONST datei): + out (""""); out (datei); putline (""" wird geholt."); + fetch (datei, archive) +END PROC vom archiv; + +PROC holen (TEXT CONST datei) : + IF NOT exists (datei) THEN vom archiv (datei) END IF +END PROC holen; + +PROC gen (TEXT CONST datei) : + holen (datei); + out (""""); out (datei); out (""" wird uebersetzt: "); + insert (datei); + forget (datei, quiet) +END PROC gen; + diff --git a/app/eudas/3.4/src/eudas.init b/app/eudas/3.4/src/eudas.init new file mode 100644 index 0000000..ab9bcbb --- /dev/null +++ b/app/eudas/3.4/src/eudas.init @@ -0,0 +1,1034 @@ +% MENUE "EUDAS-Hauptmenue" +% BILD +:---------------------- < EUDAS - Hauptmenue > -----------------------------: +: a ­ aktuelle Datei ansehen (M) b ­ aktuelle Datei bearbeiten (M) : +: o ­ Datei zum Bearbeiten oeffnen f ­ Feldstruktur aendern : +: k ­ Dateien koppeln r ­ EUDAS-Datei sortieren : +: s ­ aktuelle Dateien sichern v ­ Dateiverwaltung (M) : +:---------------------------------------------------------------------------: +% FELD 1 "EUDAS/11" "aA" +% FELD 2 "EUDAS/12" "bB" +% FELD 3 "EUDAS/13" "oO" +% FELD 4 "EUDAS/14" "fF" +% FELD 5 "EUDAS/15" "kK" +% FELD 6 "EUDAS/16" "rR" +% FELD 7 "EUDAS/17" "sS" +% FELD 8 "EUDAS/18" "vV" +% ENDE +% MENUE "EUDAS-Ansehen" +% BILD +:-------------------------- << Ansehen >> ----------------------------------: +: w ­ Satz weiter z ­ Satz zurueck : +: s ­ Selektion einstellen l ­ Selektion loeschen : +: d ­ direkt auf Satz v ­ Bild vertikal verschieben : +: e ­ Einzelsatz bearbeiten (M) b ­ aktuelle Datei bearbeiten (M) : +:---------------------------------------------------------------------------: +% FELD 1 "EUDAS/21" "wW" +% FELD 2 "EUDAS/22" "zZ" +% FELD 3 "EUDAS/23" "sS" +% FELD 4 "EUDAS/24" "lL" +% FELD 5 "EUDAS/25" "dD" +% FELD 6 "EUDAS/26" "vV" +% FELD 7 "EUDAS/27" "eE" +% FELD 8 "EUDAS/28" "bB" +% ENDE +% MENUE "EUDAS-Einzelsatz" +% BILD +:------------------- <<< Einzelsatz bearbeiten >>> -------------------------: +: e ­ neuen Satz einfuegen a ­ Satz aendern : +: m ­ Markierung aendern l ­ alle Markierungen loeschen : +: t ­ Satz tragen h ­ Satz holen : +: d ­ Darstellung umschalten f ­ Feldauswahl : +:---------------------------------------------------------------------------: +% FELD 1 "EUDAS/31" "eE" +% FELD 2 "EUDAS/32" "aA" +% FELD 3 "EUDAS/33" "mM" +% FELD 4 "EUDAS/34" "lL" +% FELD 5 "EUDAS/35" "tT" +% FELD 6 "EUDAS/36" "hH" +% FELD 7 "EUDAS/37" "dD" +% FELD 8 "EUDAS/38" "fF" +% ENDE +% MENUE "EUDAS-Bearbeiten" +% BILD +:-------------------- << aktuelle Datei bearbeiten >> ----------------------: +: d ­ nach Muster drucken t ­ Saetze tragen : +: e ­ Textdatei erstellen/aendern k ­ Saetze kopieren : +: u ­ Textdatei drucken n ­ nach Vorschrift aendern : +: a ­ aktuelle Datei ansehen (M) v ­ Dateiverwaltung (M) : +:---------------------------------------------------------------------------: +% FELD 1 "EUDAS/41" "dD" +% FELD 2 "EUDAS/42" "tT" +% FELD 3 "EUDAS/43" "eE" +% FELD 4 "EUDAS/44" "kK" +% FELD 5 "EUDAS/45" "uU" +% FELD 6 "EUDAS/46" "nN" +% FELD 7 "EUDAS/47" "aA" +% FELD 8 "EUDAS/48" "vV" +% ENDE +% MENUE "EUDAS-Dateiverwaltung" +% BILD +:---------------------- << Dateiverwaltung >> ------------------------------: +: s ­ Datei auf Archiv sichern r ­ Datei reorganisieren : +: h ­ Datei von Archiv holen n ­ Datei umbenennen : +: o ­ Datei auf Archiv loeschen l ­ Datei loeschen : +: a ­ Archivuebersicht u ­ Dateiuebersicht : +:---------------------------------------------------------------------------: +% FELD 1 "EUDAS/51" "sS" +% FELD 2 "EUDAS/52" "rR" +% FELD 3 "EUDAS/53" "hH" +% FELD 4 "EUDAS/54" "nN" +% FELD 5 "EUDAS/55" "oO" +% FELD 6 "EUDAS/56" "lL" +% FELD 7 "EUDAS/57" "aA" +% FELD 8 "EUDAS/58" "uU" +% ENDE +% AUSWAHL "EUDAS-Felder" +% VORSPANN +:---------------------------------------------------------------------------: + Bitte die Felder, die geaendert werden sollen, ankreuzen: +% BILD +:---------------------------------------------------------------------------: + ­ +:---------------------------------------------------------------------------: +% ENDE +% AUSWAHL "EUDAS-Sortierfelder" +% VORSPANN +:---------------------------------------------------------------------------: + Bitte die Felder, nach denen sortiert werden soll, in Reihenfolge ankreuzen: +% BILD +:---------------------------------------------------------------------------: + ­ +:---------------------------------------------------------------------------: +% ENDE +% AUSWAHL "EUDAS-Anzeigefelder" +% VORSPANN +:---------------------------------------------------------------------------: + Bitte die Felder, die angezeigt werden sollen, in Reihenfolge ankreuzen: +% BILD +:---------------------------------------------------------------------------: + ­ +:---------------------------------------------------------------------------: +% ENDE +% AUSWAHL "EUDAS-Archivauswahl" +% VORSPANN +:---------------------------------------------------------------------------: + Auswahl der Dateien auf dem Archiv. Gewuenschte Datei(en) bitte ankreuzen: +% BILD +:---------------------------------------------------------------------------: + ­ +:---------------------------------------------------------------------------: +% ENDE +% AUSWAHL "EUDAS-Dateiauswahl" +% VORSPANN +:---------------------------------------------------------------------------: + Auswahl der vorhandenen Dateien. Gewuenschte Datei(en) bitte ankreuzen: +% BILD +:---------------------------------------------------------------------------: + ­ +:---------------------------------------------------------------------------: +% ENDE +% HILFE "EUDAS/Allgemein" +% SEITE 1 +:--- MENÜBEDIENUNG --- +: Das Menü dient zur Auswahl von Funktionen. Die Funktionen sind durch ein +: vorangestelltes Minuszeichen gekennzeichnet. Mit den Pfeiltasten können +: Sie die Schreibmarke zu einer beliebigen Position bewegen. Diese Funktion +: können Sie dann durch Drücken der Leertaste ausführen. +:--- +% ENDE +% HILFE "EUDAS/rollen" +% SEITE 1 +:--- +: Sie können mit verschiedenen Tasten(kombinationen) den Bildausschnitt +: vertikal verschieben. Möglichkeiten: +: OBEN, UNTEN eine Zeile rauf oder runter +: ESC OBEN, ESC UNTEN eine Seite rauf oder runter +: ESC '1', ESC '9' auf erste oder letzte Zeile +: ESC 'q' zurück ins Menü +:--- +% ENDE +% HILFE "EUDAS/11" +% SEITE 1 +:--- aktuelle Datei ansehen --- +: Mit dieser Funktion schalten Sie in ein Untermenü, in dem Sie sich die +: Dateiinhalte der geöffneten Datei ansehen können. Ist keine Datei ge- +: öffnet, können Sie diese Funktion nicht ausführen. +: => Informationen zur Menübedienung auf der nächsten Seite (ESC 'w') +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/12" +% SEITE 1 +:--- aktuelle Datei bearbeiten --- +: Diese Auswahl führt in ein Untermenü, in dem Sie die geöffnete Datei als +: Ganzes bearbeiten können (Drucken, Kopieren usw.). Es muß dazu eine Datei +: geöffnet sein. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/13" +% SEITE 1 +:--- Datei zum Bearbeiten öffnen --- +: Diese Funktion öffnet eine neue Datei. Sie können angeben, ob Sie die Datei +: nur ansehen oder auch ändern wollen. Die vorher geöffnete Datei wird ggf. +: gesichert. Wenn Sie eine neue Datei angeben, wird diese eingerichtet. Dabei +: müssen Sie die Feldnamen eingeben. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/14" +% SEITE 1 +:--- Feldstruktur aendern --- +: Mit dieser Funktion können Sie +: 1. neue Feldnamen anfügen +: 2. Feldnamen und Feldtypen ändern +: 3. Prüfbedingungen eingeben +:--- +% SEITE 2 +:--- 1. neue Feldnamen anfügen +: Sie können neue Feldnamen der Datei am Ende anfügen. Sie müssen die Namen +: untereinander im Editor in der gewünschten Reihenfolge angeben. Vorher +: werden Sie jedoch gefragt, ob Sie diese Funktion überhaupt ausführen wol- +: len. +:--- +% SEITE 3 +:--- 2. Feldnamen und Feldtypen ändern +: In diesem Teil wird Ihnen eine Auswahl aller vorhandenen Felder angeboten, +: in der jeweils auch der Typ angegeben ist. Wenn Sie diese Funktion nicht +: ausführen wollen, beenden Sie die Auswahl einfach mit ESC q. Sonst wählen +: Sie die Felder aus, deren Namen oder Typ Sie ändern wollen. +:--- +% SEITE 4 +:--- 3. Prüfbedingungen eingeben +: Vor dieser Funktion werden Sie ebenfalls gefragt, ob Sie sie ausführen +: wollen. Wenn ja, können Sie im Editor ein Prüfprogramm eingeben, das mit +: der Datei gespeichert wird und beim Reintragen neuer Sätze ausgeführt wird. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/15" +% SEITE 1 +:--- Dateien koppeln --- +: Mit dieser Funktion können Sie eine Datei angeben, die zu den bisher ge- +: öffneten Dateien dazugekoppelt wird. Anschließend werden zu jedem Satz der +: existierenden Datei die in den Koppelfeldern übereinstimmenden Sätze der +: Koppeldatei gezeigt. +:--- +% SEITE 2 +:--- Koppelfelder +: Als Koppelfelder werden dabei die ersten Felder der Koppeldatei betrachtet, +: die auch in der geöffneten Datei vorhanden sind. +: +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/16" +% SEITE 1 +:--- EUDAS-Datei sortieren --- +: Mit dieser Funktion kann die aktuell geöffnete EUDAS-Datei sortiert werden. +: Die Reihenfolge, in der die Felder berücksichtigt werden, kann vorher ange- +: geben werden. Eventuell müssen zum richtigen Sortieren Feldtypen vergeben +: werden (s. "Feldstruktur aendern"). +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/17" +% SEITE 1 +:--- aktuelle Dateien sichern --- +: EUDAS arbeitet bei Änderungen immer auf Sicherheitskopien der Dateien. +: Wenn Ändern erlaubt ist, müssen geänderte Arbeitskopien mit dieser Funktion +: gesichert werden. Für eine veränderte Datei kann dabei auch ein neuer Name +: angegeben werden, damit die alte Version erhalten bleibt. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/18" +% SEITE 1 +:--- Dateiverwaltung --- +: Diese Auswahl führt in ein Untermenü, in dem Dateien auf dem Archiv und im +: System verwaltet werden können. Dateien können umbenannt, gelöscht oder +: reorganisiert, sowie zwischen Archivdiskette und System hin- und her- +: transportiert werden. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/21" +% SEITE 1 +:--- Satz weiter --- +: Diese Funktion geht zum nächsten Satz und zeigt ihn an. Wenn eine Such- +: bedingung eingestellt ist, werden nicht ausgewählte Sätze übersprungen. +: +: => Hinweise zur Menübedienung auf der zweiten Seite (ESC 'w') +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/22" +% SEITE 1 +:--- Satz zurueck --- +: Diese Funktion geht zum vorigen Satz. Wenn eine Suchbedingung eingestellt +: ist, werden nicht ausgewählte Sätze übersprungen. +: +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/23" +% SEITE 1 +:--- Selektion einstellen --- +: Mit dieser Funktion kann eine Suchbedingung als Suchmuster eingegeben +: werden, die angibt, welche Sätze bearbeitet werden sollen. Die vorher +: eingestellte Suchbedingung wird automatisch gelöscht. Die Bedingungen für +: die einzelnen Felder können im Editor eingegeben werden. +:--- +% SEITE 2 +:--- mögliche Bedingungen +: Text identisch mit Text.. größergleich +: *Text endet mit ..Text kleiner +: Text* beginnt mit Text..Text zwischen +: *Text* enthält * nicht leer +:--- +% SEITE 3 +:--- Kombination von Bedingungen +: --Bed Verneinung +: Bedingungen für verschiedene Felder: UND +: Komma zwischen Bed.: lokales ODER (Prio höher als UND) +: Semikolon zwischen Bed.: globales ODER (Prio niedriger als UND) +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/24" +% SEITE 1 +:--- Selektion löschen --- +: Mit dieser Funktion kann eine eingestellte Suchbedingung wieder gelöscht +: werden, so daß wieder alle Sätze sichtbar sind. +: +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/25" +% SEITE 1 +:--- direkt auf Satz --- +: Mit dieser Funktion kann ein bestimmter Satz direkt angewählt werden. Dazu +: müssen Sie lediglich dessen Satznummer angeben. +: +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/26" +% SEITE 1 +:--- Bild vertikal verschieben --- +: In dieser Funktion kann mit verschiedenen Tasten(kombinationen) die Anzeige +: vertikal verschoben werden, wenn nicht alle Daten auf den Bildschirm +: passen. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/27" +% SEITE 1 +:--- Einzelsatz bearbeiten --- +: Diese Auswahl führt in ein Untermenü, in dem der aktuelle Satz bearbeitet +: werden kann. Außerdem können dort neue Sätze eingegeben und Einstellungen +: der Anzeige verändert werden. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/28" +% SEITE 1 +:--- aktuelle Datei bearbeiten --- +: Diese Auswahl führt in das Nebenmenü zum Bearbeiten der aktuellen Datei +: als Ganzes. Hier werden Funktionen zum Drucken, Tragen, Kopieren und +: Verarbeiten angeboten. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/31" +% SEITE 1 +:--- neuen Satz einfügen --- +: Mit dieser Funktion wird vor dem aktuellen Satz ein neuer Satz eingefügt. +: Die Inhalte dieses zunächst leeren Satzes können Sie mit Hilfe des +: Editors neben die einzelnen Feldnamen schreiben. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/32" +% SEITE 1 +:--- Satz aendern --- +: Mit dieser Funktion können Sie die Inhalte des aktuellen Satzes verändern. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/33" +% SEITE 1 +:--- Markierung ändern --- +: Mit dieser Funktion können Sie einen Satz markieren, damit später nur die +: markierten Sätze bearbeitet werden. Ist der Satz schon markiert, wird die +: Markierung wieder gelöscht. Wenn mindestens ein Satz markiert ist, er- +: scheint die Markierungsinformation in der Überschrift. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/34" +% SEITE 1 +:--- Markierungen loeschen --- +: Mit dieser Funktion werden alle Markierungen in der Datei gelöscht. +: Die Markierungsinformation wird nicht mehr angezeigt. Die Markierungen +: werden auch beim neuen Öffnen gelöscht, da sie nicht permanent in der +: Datei gespeichert sind. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/35" +% SEITE 1 +:--- Satz tragen --- +: Mit dieser Funktion kann der aktuelle Satz in eine andere Datei trans- +: portiert werden. Anschließend wird er gelöscht. Der Satz wird am Ende der +: Zieldatei angefügt, wobei diese gegebenenfalls eingerichtet wird. Den +: Namen der Zieldatei können Sie eingeben. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/36" +% SEITE 1 +:--- Satz holen --- +: Diese Funktion holt den letzten Satz einer anderen Datei und fügt ihn vor +: dem aktuellen Satz ein. Damit wird das letzte 'Tragen' wieder rückgängig +: gemacht. Die Dateien müssen gleiche Felderzahl haben. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/37" +% SEITE 1 +:--- Darstellung umschalten --- +: Diese Funktion schaltet zwischen Normaldarstellung und Übersichtsanzeige +: um. In der Normaldarstellung wird immer nur ein Satz angezeigt, in der +: Übersichtsanzeige werden mehrere Sätze dargestellt, wobei jeder Satz eine +: Zeile in Anspruch nimmt. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/38" +% SEITE 1 +:--- Feldauswahl --- +: Mit dieser Funktion kann gewählt werden, welche Felder in welcher Reihen- +: folge angezeigt werden sollen. Die Auswahl kann für Übersichts- und +: Normalanzeige unterschiedlich gewählt werden. Alle Felder werden zum +: Ankreuzen angeboten. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/41" +% SEITE 1 +:--- nach Muster drucken --- +: Mit dieser Funktion können die Inhalte der Datei nach einem Druckmuster +: ausgedruckt werden. Das Druckmuster ist eine Textdatei und muß vorher er- +: stellt werden. Es gibt die Form des Ausdrucks an. Über den Aufbau eines +: Druckmusters lesen Sie am besten das Benutzerhandbuch. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/42" +% SEITE 1 +:--- Saetze tragen --- +: Diese Funktion trägt alle Sätze in eine andere Datei und löscht sie danach. +: Die Zieldatei muß gleiche Felderzahl haben, damit keine Information ver- +: lorengeht. Beim Tragen können auch die Prüfbedingungen der Zieldatei ge- +: prüft werden, wenn Sie die entsprechende Frage bejahen. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/43" +% SEITE 1 +:--- Textdatei erstellen/aendern --- +: Mit dieser Funktion kann eine Textdatei erstellt, geändert oder angesehen +: werden. Es wird der normale Editor verwendet. +: +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/44" +% SEITE 1 +:--- Saetze kopieren --- +: Diese Funktion kopiert die ausgewählten Sätze in eine andere Datei. Welche +: Felder in welcher Reihenfolge kopiert werden sollen, wird durch ein Kopier- +: muster bestimmt, das nach der Struktur der Zieldatei bestimmt wird und +: dann von Ihnen noch geändert werden kann. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/45" +% SEITE 1 +:--- Textdatei drucken --- +: Mit dieser Funktion wird eine Textdatei direkt ausgedruckt. Die Datei kann +: Anweisungen zur Druckersteuerung enthalten, die Sie dem EUMEL-Benutzer- +: handbuch entnehmen können. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/46" +% SEITE 1 +:--- nach Vorschrift aendern --- +: Diese Funktion ermöglicht es, die geöffnete Datei nach einer Vorschrift +: automatisch zu ändern. Die Art der Änderungen wird dabei durch ein +: Verarbeitungsmuster festgelegt, das vorher als Textdatei erstellt werden +: muß. Über die Form des Verarbeitungsmusters s. Benutzerhandbuch. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/47" +% SEITE 1 +:--- aktuelle Datei ansehen --- +: Diese Funktion führt in ein Nebenmenü, in dem Sie die Inhalte der geöff- +: neten Datei ansehen können. +: +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/48" +% SEITE 1 +:--- Dateiverwaltung --- +: Diese Auswahl führt in ein Nebenmenü, in dem Dateien auf dem Archiv und im +: System verwaltet werden können. Dateien können umbenannt, gelöscht oder +: reorganisiert, sowie zwischen Archivdiskette und System hin- und her- +: transportiert werden. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/51" +% SEITE 1 +:--- Datei auf Archiv sichern --- +: Diese Funktion schreibt eine oder mehrere Dateien auf das Archiv. Der +: Archivname muß vorher eingegeben werden. Dann kann entweder der Name der +: gewünschten Datei eingegeben werden oder mit ESC 'z' eine Auswahl von +: Dateien angekreuzt werden. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/52" +% SEITE 1 +:--- Datei reorganisieren --- +: Diese Funktion reorganisiert eine Datei, an der viel geändert wurde, zur +: Platz- und Zeitersparnis. Es können sowohl Textdateien als auch EUDAS- +: Dateien angegeben werden. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/53" +% SEITE 1 +:--- Datei von Archiv holen --- +: Diese Funktion holt eine Datei vom Archiv ins System. Der Archivname wird +: automatisch bestimmt. Sie können dann entweder den gewünschten Dateinamen +: angeben oder mit ESC 'z' eine Auswahl aller Dateien auf dem Archiv abrufen. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/54" +% SEITE 1 +:--- Datei umbenennen --- +: Mit dieser Funktion können Sie für eine Datei auf dem System einen neuen +: Namen vergeben. Wenn Sie den neuen Namen eingeben, wird Ihnen der alte Name +: angeboten. Sie können ihn ändern oder ganz überschreiben. Dadurch ersparen +: Sie sich bei kleinen Änderungen das Neutippen. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/55" +% SEITE 1 +:--- Datei auf Archiv loeschen --- +: Diese Funktion ermöglicht es, eine Datei auf dem Archiv zu löschen. Der +: Platz dieser Datei wird jedoch nur dann wiederverwendet, wenn keine Dateien +: mehr dahinter stehen. Der Archivname muß eingegeben werden. Sie können bei +: der Eingabe des Dateinamens mit ESC 'z' eine Dateiauswahl abrufen. +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/56" +% SEITE 1 +:--- Datei loeschen --- +: Diese Funktion löscht eine Datei auf dem System nach Anfrage. Sie können +: den Dateinamen eingeben oder mit ESC 'z' eine Auswahl aller vorhandenen +: Dateien abrufen. +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/57" +% SEITE 1 +:--- Archivuebersicht --- +: Diese Funktion liefert eine Übersicht der Dateien auf dem Archiv. Ver- +: lassen Sie diese Übersicht mit ESC 'q'. +: +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/58" +% SEITE 1 +:--- Dateiuebersicht --- +: Diese Funktion liefert eine Übersicht über alle im System vorhandenen +: Dateien. Verlassen Sie diese Übersicht mit ESC 'q'. +: +: +:--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "AUSWAHL/Allgemein" +% SEITE 1 +:--- AUSWAHL --- +: Mit Hilfe der Auswahl ist es möglich, aus einem Angebot einen Teil auszu- +: wählen. Die gewünschten Namen werden einfach in beliebiger Reihenfolge +: angekreuzt und anschließend in dieser Reihenfolge verwendet. +: Die Schreibmarke (Cursor) gibt an, welcher Name gerade angekreuzt werden +: kann. Mit den Pfeiltasten kann der Cursor auf den Kreisen bewegt werden. +: 'x' kreuzt einen Namen an, 'o' loescht die Ankreuzung wieder. +: Mit ESC 'q' wird die Auswahl verlassen. ESC 'a' bricht die Auswahl und +: die folgende Funktion ab. Falls das Angebot nicht auf den Bildschirm paßt, +: wird es gerollt. ESC '1' positioniert immer auf den Anfang und ESC '9' +: auf das Ende der Auswahl. Mit HOP 'x' werden alle noch nicht angekreuzten +: Namen angekreuzt, mit HOP 'o' werden alle Ankreuzungen geloescht. +:--- +% ENDE +% HILFE "AUSWAHL/Felder" +% SEITE 1 +:--- +: Sie können hier alle Felder ankreuzen, die Sie ändern wollen. Ändern können +: Sie den Feldnamen und den Feldtyp. Wollen Sie keine Felder ändern, drücken +: Sie einfach ESC 'q'. +:--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Sortierfelder" +% SEITE 1 +:--- +: Kreuzen Sie hier die Felder an, die bei der Sortierung berücksichtigt +: werden sollen. Die Reihenfolge des Ankreuzens ist wichtig. Beim Vergleich +: zweier Sätze wird erst das als erstes angekreuzte Feld verglichen und +: danach die Einordnung der Sätze bestimmt. Ist dieses Feld bei beiden +: gleich, wird das nächste angekreuzte Feld untersucht usw. +:--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Anzeigefelder" +% SEITE 1 +:--- +: Kreuzen Sie hier alle Felder an, die Sie angezeigt haben möchten. Die +: Felder erscheinen in der angekreuzten Reihenfolge. Für beide Arten der +: Anzeige können Sie eine separate Feldauswahl einstellen. +:--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Archiv" +% SEITE 1 +:--- +: Diese Auswahl zeigt alle auf dem Archiv vorhandenen Dateien an. Kreuzen +: Sie die Dateien an, die Sie bearbeiten möchten. Die Dateien werden in +: der angekreuzten Reihenfolge verwendet. +:--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Datei" +% SEITE 1 +:--- +: Diese Auswahl zeigt alle Dateien auf dem System, die Sie verwenden können. +: Kreuzen Sie die gewünschte(n) Datei(en) an. +:--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "FEHLER/Allgemein" +% SEITE 1 +:--- FEHLERMELDUNGEN --- +: Fehlermeldungen werden von einem Programm abgesetzt, wenn es seine Funktion +: nicht durchführen kann. Der Text der Meldung identifiziert die Ursache des +: Problems. Zur Zeit liegen noch keine meldungsspezifischen Informationen +: vor, schauen Sie ggf. in das Benutzerhandbuch. +:--- +% ENDE +% HILFE "FEHLER/9" +% SEITE 1 +:--- +: Diese Fehlermeldung deutet auf einen internen Programmfehler (wenn Sie +: nicht selber ein Programm geschrieben haben). Melden Sie diesen Fehler +: bitte, damit eine Korrektur vorgenommen werden kann. Schreiben Sie sich +: dazu die Begleitumstände auf (welche Datei haben Sie benutzt, welche +: Funktion). Versuchen Sie gegebenenfalls, den Fehler zu wiederholen. Es +: ist nämlich z.B. wichtig, ob der Fehler nur bei einer bestimmten Datei +: auftritt oder ganz "zufällig". Wenn Sie vermuten, daß der Fehler an einer +: bestimmten Datei liegt, sichern Sie diese Datei bitte auf einer Diskette, +: um sie eventuell einschicken zu können. +:--- +% ENDE +% HILFE "FEHLER/10" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "FEHLER/11" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "FEHLER/14" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "GET/Allgemein" +% SEITE 1 +:--- EINGABE --- +: Die Eingabe erwartet von Ihnen eine bestimmte Information, die Sie eingeben +: sollen. Die Art der Information wird durch den Anforderungstext angegeben. +: Wenn Sie sich beim Eintippen verschrieben haben, können Sie mit den Pfeil- +: tasten zurückgehen und den Text korrigieren. Eine bereits dastehende +: Information können Sie überschreiben. RUBOUT löscht ein Zeichen, RUBIN +: schaltet in den Einfügemodus (Zeichen werden nicht mehr überschrieben). +: Beenden Sie die Eingabe mit RETURN. ESC 'h' bricht die Eingabe und die +: folgende Funktion ab. Wenn in der Statuszeile angegeben, können Sie mit +: ESC 'z' eine Auswahl verfügbarer Namen abrufen, die Sie dann Ankreuzen +: können. +:--- +% ENDE +% HILFE "GET/Sicherungsname" +% SEITE 1 +:--- +: Sie können jetzt den Namen angeben, unter dem die Arbeitskopie gespeichert +: werden soll. Ihnen wird der alte Name zum Überschreiben angeboten. Drücken +: Sie nur RETURN, wird der alte Name genommen und die alte Version über- +: schrieben. +:--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Dateiname" +% SEITE 1 +:--- +: Bitte geben Sie den Namen der Datei ein, mit dem die Operation ausgeführt +: werden soll. Mit ESC 'z' können Sie sich die zur Verfügung stehenden Namen +: auch als Auswahl zeigen lassen. +:--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/feldname" +% SEITE 1 +:--- +: Sie können den Namen des angegebenen Feldes ändern, indem Sie den alten +: Namen überschreiben bzw. korrigieren. +:--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/feldtyp" +% SEITE 1 +:--- +: Sie können hier einen von vier möglichen Typen eingeben: +: TEXT normaler Text mit Vergleich nach EUMEL-Code. +: DIN Text, der nach DIN 5007 verglichen wird (Umlaute richtig, +: Groß-/Kleinschreibung und Sonderzeichen ignoriert). +: ZAHL Alle nichtnumerischen Zeichen außer Minus und Dezimalkomma werden +: beim Vergleichen ignoriert. +: DATUM Datum der Form "tt.mm.jj" +: Die Feldtypen werden beim Sortieren und Suchen beachtet. +:--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/auf Satz" +% SEITE 1 +:--- +: Sie können hier die Satznummer des Satzes eingeben, den Sie sehen wollen. +:--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Archivname" +% SEITE 1 +:--- +: Geben Sie den Namen des eingelegten Archivs ein (zur Sicherheit). Der +: zuletzt verwendete Name wird zum Ändern angeboten. +:--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/rename" +% SEITE 1 +:--- +: Sie können den alten Namen der Datei durch Überschreiben und Korrigieren +: ändern. +:--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "JA/Allgemein" +% SEITE 1 +:--- FRAGEN --- +: Das Programm stellt Ihnen eine Frage, die Sie bejahen oder verneinen kön- +: nen. Sie bejahen die Frage, indem Sie 'j' drücken und verneinen Sie mit 'n' +: (beides groß oder klein). Mit ESC 'h' können Sie die Funktion abbrechen. +:--- +% ENDE +% HILFE "JA/oeffne" +% SEITE 1 +:--- +: Beantworten Sie die Frage mit 'n', wenn Sie die Datei nur ansehen wollen. +: In diesem Fall wird keine Sicherheitskopie erstellt. Verneinen Sie die +: Frage, wird eine interen Kopie angelegt, die Sie dann verändern können. +: Die Kopie muß nach dem Ändern gesichert werden. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/alte version" +% SEITE 1 +:--- +: Wenn Sie diese Frage bejahen, wird die Arbeitskopie unter dem angegebenen +: Namen gesichert. Die alte Version geht dadurch verloren. Wenn Sie die Frage +: verneinen, haben Sie Gelegenheit, einen neuen Namen anzugeben, damit die +: alte Version erhalten bleiben kann. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Datei loeschen" +% SEITE 1 +:--- +: Beim Sichern hatten Sie Gelegenheit, alle veränderten Dateien zu sichern. +: Die Sicherheitskopien können damit gelöscht werden. Dazu bejahen Sie die +: Frage. Wenn die Dateien jedoch noch geöffnet bleiben sollen, oder Sie eine +: Datei aus Versehen nicht gesichert haben, müssen Sie diese Frage verneinen. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/sichere" +% SEITE 1 +:--- +: Die interne Arbeitskopie der angegebenen Datei wurde gegenüber dem Original +: verändert. Wenn Sie diese Änderungen behalten wollen, müssen Sie die Frage +: bejahen. Sie haben dann noch die Möglichkeit, die geänderte Version unter +: neuem Namen zu sichern, um die alte Version zu behalten. Wenn Sie die Frage +: verneinen, gehen die Änderungen verloren und das Original bleibt erhalten. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/ueber" +% SEITE 1 +:--- +: Sie haben für die Arbeitskopie einen Namen angegeben, der noch existiert. +: Bejahen Sie die Frage, wird die alte Datei dieses Namens überschrieben. +: Anderenfalls erhalten Sie eine neue Gelegenheit, einen Namen einzugeben. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sicherungssortierung" +% SEITE 1 +:--- +: Die angegebene Datei war früher schon einmal sortiert worden. Die Sor- +: tierung wurde jedoch durch nachfolgende Änderungen zerstört. Wenn Sie die +: Datei wieder sortiert haben wollen, beantworten Sie die Frage mit 'j'. +: Die Sortierung dauert nicht lange, wenn nur wenige Sätze verändert wurden. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Pruefbed" +% SEITE 1 +:--- +: Die Prüfbedingungen einer Datei sind nur für die Funktion "Saetze tragen" +: relevant. In der Regel können Sie diese Frage verneinen. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/feldnamen" +% SEITE 1 +:--- +: Falls Sie neue Felder zu den existierenden anfügen wollen, müssen Sie diese +: Frage bejahen. Sie erhalten dann Gelegenheit, die neuen Namen im Editor +: einzugeben. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sortierfelder" +% SEITE 1 +:--- +: Die Reihenfolge, in der die Felder bei der Sortierung berücksichtigt wer- +: den, ist in der EUDAS-Datei intern gespeichert. Wenn Sie diese Reihenfolge, +: die beim letzten Sortieren angegeben wurde, ändern möchten, müssen Sie die +: Frage bejahen. Sie können dann die neue Feldreihenfolge auswählen. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/sortieren" +% SEITE 1 +:--- +: Wenn Sie diese Frage bejahen, wird die Zieldatei nach Ausführung der +: Funktion in ihrer eingestellten Feldreihenfolge sortiert. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/forget" +% SEITE 1 +:--- +: Wenn Sie diese Frage bejahen, wird die Datei wirklich gelöscht. Wenn Sie +: die Datei irrtümlich gewählt haben, müssen Sie die Frage verneinen. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/einrichten" +% SEITE 1 +:--- +: Sie haben eine Datei angegeben, die noch nicht existiert. Wenn Sie die +: Frage bejahen, wird die Datei neu eingerichtet. Anderenfalls wird die +: Funktion abgebrochen, so daß Sie Gelegenheit haben, die Funktion mit einem +: neuen Namen zu wiederholen. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/testen" +% SEITE 1 +:--- +: Wenn Sie diese Frage bejahen, werden beim Tragen die Prüfbedingungen der +: Zieldatei abgefragt. Sätze, die diese Bedingungen nicht erfüllen, werden +: nicht getragen und können danach geändert werden. Beim Ändern wird dann +: jeweils die den Satz betreffende Meldung ausgegeben. Die Prüfbedingungen +: der Zieldatei können Sie mit der Funktion "Feldstruktur aendern" angeben +: oder ändern. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/save" +% SEITE 1 +:--- +: Die angegebene Datei befindet sich bereits auf dem Archiv. Wenn Sie die +: Datei überschreiben wollen, müssen Sie die Frage bejahen. Ansonsten wird +: die Datei nicht auf das Archiv geschrieben (keine Wirkung). +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/fetch" +% SEITE 1 +:--- +: Die angegebene Datei ist bereits im System vorhanden. Wenn Sie diese Datei +: überschreiben wollen, müssen Sie die Frage bejahen. Anderenfalls wird keine +: Aktion vorgenommen. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/erase" +% SEITE 1 +:--- +: Zur Sicherheit wird gefragt, ob Sie die angegebene Datei wirklich auf dem +: Archiv löschen wollen. Wenn Sie die Frage verneinen, wird keine Aktion +: durchgeführt. +:--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "EDIT/Allgemein" +% SEITE 1 +:--- EDITOR --- +: Mit dem Editor können Sie einen Text zeilenweise eingeben. Dabei können +: Sie den Cursor mit den Pfeiltasten bewegen. RUBOUT löscht ein Zeichen, +: RUBIN schaltet in den Einfügemodus um. Für weitere Informationen zum Editor +: s. EUMEL-Benutzerhandbuch. ESC 'q' verläßt den Editor normal. Mit ESC 'h' +: wird die Funktion abgebrochen. +:--- +% ENDE +% HILFE "EDIT/Feldnamen" +% SEITE 1 +:--- +: Sie können hier die neuen Feldnamen in der gewünschten Reihenfolge unter- +: einander eingeben. Jeder Feldname muß in einer Zeile stehen und ohne +: Anführungsstriche geschrieben sein. +:--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Pruefbed" +% SEITE 1 +:--- +: Sie können hier die Prüfbedingungen der Datei eingeben bzw. ändern. Die +: Prüfbedingungen sind ein ELAN-Programm. Da ELAN-Programme formatfrei sind, +: kann es sein, daß Ihr Programm beim nächsten Mal anders erscheint, als Sie +: es eingegeben haben. +:--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Suchen" +% SEITE 1 +:--- +: Sie können jetzt eine Selektionsbedingung einstellen. Dazu müssen Sie +: jeweils neben den Feldnamen eine Bedingung schreiben. Mögliche Bedingungen +: sind: +: Text muß gleich sein +: Text* muß mit Text anfangen +: *Text muß mit Text enden +: *Text* enthält Text +: Text.. muß größer oder gleich Text sein +: ..Text muß kleiner als Text sein oder mit Text anfangen +: Text1..Text2 liegt zwischen den beiden Texten +: "--" verneint eine Bedingung. Weitere Bedingungen und Kombination von +: Bedingungen s. EUDAS-Benutzerhandbuch. +:--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Einfuegen" +% SEITE 1 +:--- +: Sie können hier die Inhalte eines neuen Satzes eingeben, der vor dem +: aktuellen Satz eingefügt wird. +: Spezielle Tastenkombinationen: +: ESC RUBOUT Rest der Zeile löschen +: ESC RUBIN Zeile aufbrechen +: ESC OBEN nach oben blättern +: ESC UNTEN nach unten blättern +: ESC '1' auf erste Zeile +: ESC '9' auf letzte Zeile +: ESC 'h' Abbruch, der Satz wird nicht eingefügt +: ESC 'w' Beenden und gleich den nächsten Satz einfügen +:--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Aendern" +% SEITE 1 +:--- +: Sie können die Inhalte des aktuellen Satzes hier abändern. +: Spezielle Tastenkombinationen: +: ESC RUBOUT Rest der Zeile löschen +: ESC RUBIN Zeile aufbrechen +: ESC OBEN nach oben blättern +: ESC UNTEN nach unten blättern +: ESC '1' auf erste Zeile +: ESC '9' auf letzte Zeile +: ESC 'h' Abbruch, der Satz bleibt unverändert +: ESC 'w' Beenden und gleich den nächsten Satz ändern +:--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Druckmuster" +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Verarbeite" +% SEITE 1 +:--- +: Sie können hier eine Verarbeitungsvorschrift eingeben. Die Verarbeitungs- +: vorschrift ist ein ELAN-Programm. Ein Feld wird geändert durch den +: Operator "V": +: "Feldname" V "neuer Feldinhalt"; +: Statt des neuen Feldinhalts kann auch ein beliebiger ELAN-Ausdruck ange- +: geben werden. Mit +: f ("Feldname") +: wird der Inhalt eines Feldes als Text geliefert. +:--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Kopiermuster" +% SEITE 1 +:--- +: Sie können das hier angegebene Kopiermuster verändern. Sollen Felder nicht +: kopiert werden, brauchen Sie nur die entsprechenden Zeilen zu löschen. +: Soll eine Feld andere Inhalte bekommen, geben Sie in dem Ausdruck +: "Feldname" K f ("Feldname"); +: hinter dem K einen anderen ELAN-Ausdruck ein. Die Reihenfolge der K-Aus- +: drücke bestimmt die Reihenfolge der Feldnamen in der Zieldatei, wenn die +: Zieldatei noch nicht existierte. +:--- +% SEITE 1 "EDIT/Allgemein" +% ENDE + + diff --git a/app/eudas/4.3/doc/abb.1-1 b/app/eudas/4.3/doc/abb.1-1 new file mode 100644 index 0000000..06c27fd --- /dev/null +++ b/app/eudas/4.3/doc/abb.1-1 @@ -0,0 +1,94 @@ +init dgs; +window (0.0, 0.0, 13.5, 7.1); (*viewport (0.0,0.0,13.5,7.1); *) +scale (1.0,1.0,0.0,0.0); +(*clear pixels;*) + +karteikasten (1.0, 3.5, "Kartei A", "Wegner", "Herbert"); +karteikasten (5.0, 0.5, "Kartei B", "Regmann", "Karin"); + +LET myname = "abb.1-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (10000); +*) +PROC karteikasten (REAL CONST x, y, TEXT CONST name, t name, t vorname) : + + move (x - 0.1, y); + draw (x + 3.6, y); + draw (x + 3.6, y + 1.0); + draw (x - 0.1, y + 1.0); + draw (x - 0.1, y); + + move (x + 0.1, y + 1.1); + draw (x + 0.5, y + 1.5); + move (x + 0.1, y + 1.1); + draw (x + 3.6, y + 1.1); + move (x - 0.1, y + 1.0); + draw (x + 0.5, y + 1.6); + + move (x + 3.6, y); + draw (x + 5.2, y + 1.6); + draw (x + 5.2, y + 2.6); + draw (x + 3.6, y + 1.0); + move (x + 3.6, y + 1.1); draw (x + 5.0, y + 2.5); + move (x + 5.2, y + 2.6); draw (x + 5.0, y + 2.6); + + move (x + 0.5, y + 1.1); + draw (x + 0.5, y + 2.5); + draw (x + 4.0, y + 2.5); + draw (x + 4.0, y + 1.5); + move (x + 0.5, y + 2.5); + draw (x + 1.5, y + 3.5); + draw (x + 5.0, y + 3.5); + draw (x + 5.0, y + 2.5); + move (x + 5.0, y + 3.5); + draw (x + 4.0, y + 2.5); + REAL VAR x off := 0.1; + WHILE x off < 1.0 REP + move (x + 0.5 + xoff, y + 2.5 + x off); + draw (x + 4.0 + xoff, y + 2.5 + xoff); + draw (x + 4.0 + xoff, y + 1.5 + xoff); + x off INCR 0.1 + END REP; + font size (0.5); + font expansion (1.5); + move (x + 0.5, y + 0.2); draw (name); + font size (0.25); + move (x + 0.7, y + 2.10); draw ("Name"); + move (x + 0.7, y + 1.65); draw ("Vorname"); + move (x + 0.7, y + 1.20); draw ("Strasse"); + move (x + 2.1, y + 2.10); draw (": " + t name); + move (x + 2.1, y + 1.65); draw (": " + t vorname); + move (x + 2.1, y + 1.20); draw (":"); + +END PROC karteikasten; + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/app/eudas/4.3/doc/abb.4-1 b/app/eudas/4.3/doc/abb.4-1 new file mode 100644 index 0000000..439e052 --- /dev/null +++ b/app/eudas/4.3/doc/abb.4-1 @@ -0,0 +1,43 @@ +init dgs; +window (0.0, 0.0, 13.5, 3.2); viewport (0.0,0.0,13.5,3.2); +(* scale (2.0,2.0,0.0,0.0); *) +(*clear pixels;*) + +font size (0.25); +font expansion (1.5); + +INT VAR i; +FOR i FROM 0 UPTO 4 REP + move (2.0, real (i) * 0.5); + draw (10.0, real (i) * 0.5); + move (2.1, real (i) * 0.5 + 0.1); + draw ("Feld " + code (code ("E") - i)); +END REP; +move (2.0, 2.5); +draw (10.0, 2.5); +move (2.0, 2.5); +draw (2.0, 0.0); +move (3.5, 3.0); +draw (10.0, 3.0); +FOR i FROM 1 UPTO 4 REP + move (2.0 + real (i) * 1.5, 3.0); + draw (2.0 + real (i) * 1.5, 0.0); + move (2.2 + real (i) * 1.5, 2.6); + draw ("Satz " + text (i)) +END REP; +move (9.5, 3.0); +draw (9.5, 0.0); +(* +pause (1000); +*) + +LET myname = "abb.4-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); + + diff --git a/app/eudas/4.3/doc/abb.4-2 b/app/eudas/4.3/doc/abb.4-2 new file mode 100644 index 0000000..a836def --- /dev/null +++ b/app/eudas/4.3/doc/abb.4-2 @@ -0,0 +1,46 @@ +init dgs; +window (0.0, 0.0, 13.5, 2.0); viewport (0.0,0.0,13.5,2.0); +(*scale (1.7,1.7,-1.6,0.0);*) +(* +clear pixels; +*) + +kasten (1.0, 0.0, 3.0, 1.5); +kasten (7.0, 0.0, 3.0, 1.5); +font size (0.4); font expansion (1.5); +move (1.8, 0.6); draw ("Menü"); +move (7.9, 0.6); draw ("Hilfe"); +move (4.5, 1.0); draw (6.5, 1.0); + draw (6.25, 1.25); move (6.5, 1.0); draw (6.25, 0.75); +move (6.5, 0.5); draw (4.5, 0.5); + draw (4.75, 0.75); move (4.5, 0.5); draw (4.75, 0.25); +font size (0.25); +move (5.0, 1.1); draw ("ESC '?'"); +move (5.0, 0.6); draw ("ESC 'q'"); +move (10.5, 1.0); draw (11.5, 1.0); draw (11.5, 0.5); draw (10.5, 0.5); + draw (10.75, 0.75); move (10.5, 0.5); draw (10.75, 0.25); +move (11.8, 0.9); draw ("ESC 'w'"); +move (11.8, 0.4); draw ("ESC 'z'"); + + +LET myname = "abb.4-2"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000); +*) +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + diff --git a/app/eudas/4.3/doc/abb.6-1 b/app/eudas/4.3/doc/abb.6-1 new file mode 100644 index 0000000..fb83242 --- /dev/null +++ b/app/eudas/4.3/doc/abb.6-1 @@ -0,0 +1,75 @@ +init dgs; +window (0.0, 0.0, 13.5, 4.0); viewport (0.0,0.0,13.5,4.0); +(*scale (1.0,1.0, 0.0,0.0);*) +(* +clear pixels; +*) + +move (2.25, 1.0); draw (4.75, 1.0); +move (2.25, 3.0); draw (4.75, 3.0); + move (2.5, 1.0); draw (2.5, 3.3); + move (3.0, 1.0); draw (3.0, 3.3); + move (3.5, 1.0); draw (3.5, 3.3); + move (4.0, 1.0); draw (4.0, 3.3); + move (4.5, 1.0); draw (4.5, 3.3); +font size (0.30); font expansion (1.5); +move (2.6, 3.1); draw ("4"); +move (2.6, 2.0); draw ("M"); +move (3.1, 3.1); draw ("5"); +move (3.1, 2.0); draw ("N"); +move (3.6, 3.1); draw ("6"); +move (3.6, 2.0); draw ("O"); +move (4.1, 3.1); draw ("7"); +move (4.1, 2.0); draw ("P"); + pfeil (3.75, 0.75); + +move (5.0, 2.0); draw (7.0, 2.0); draw (6.75, 2.25); + move (7.0, 2.0); draw (6.75, 1.75); +move (5.0, 2.1); draw ("Einfügen"); + +move (7.25, 1.0); draw (8.5, 1.0); move (9.0, 1.0); draw (10.25, 1.0); +move (7.25, 3.0); draw (8.5, 3.0); move (9.0, 3.0); draw (10.25, 3.0); + move (7.5, 1.0); draw (7.5, 3.3); + move (8.0, 1.0); draw (8.0, 3.3); + move (8.5, 1.0); draw (8.5, 3.3); + move (9.0, 1.0); draw (9.0, 3.3); + move (9.5, 1.0); draw (9.5, 3.3); + move (10.0, 1.0); draw (10.0, 3.3); +move (7.6, 3.1); draw ("4"); +move (7.6, 2.0); draw ("M"); +move (8.1, 3.1); draw ("5"); +move (8.1, 2.0); draw ("N"); +move (8.6, 3.1); draw ("6"); +move (9.1, 3.1); draw ("7"); +move (9.1, 2.0); draw ("O"); +move (9.6, 3.1); draw ("8"); +move (9.6, 2.0); draw ("P"); + +pfeil (8.75, 0.75); + +PROC pfeil (REAL CONST x spitze, y spitze) : + + move (x spitze, y spitze); + draw (x spitze + 0.25, y spitze - 0.25); + draw (x spitze + 0.1, y spitze - 0.25); + draw (x spitze + 0.1, y spitze - 0.5); + draw (x spitze - 0.1, y spitze - 0.5); + draw (x spitze - 0.1, y spitze - 0.25); + draw (x spitze - 0.25, y spitze - 0.25); + draw (x spitze, y spitze) + +END PROC pfeil; + + +LET myname = "abb.6-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.3/doc/abb.6-2 b/app/eudas/4.3/doc/abb.6-2 new file mode 100644 index 0000000..7771a29 --- /dev/null +++ b/app/eudas/4.3/doc/abb.6-2 @@ -0,0 +1,77 @@ +init dgs; +window (0.0, 0.0, 13.5, 5.0); viewport (0.0,0.0,13.5,5.0); +(*scale (1.4,1.4, 0.0,0.0);*) +(*clear pixels;*) + +move (2.5, 4.5); draw (12.4, 4.5); draw (12.4, 4.0); draw (11.0, 4.0); + draw (11.0, 3.5); move (10.5, 3.5); draw (10.5, 4.0); draw (2.5, 4.0); +move (13.5, 4.5); draw (12.5, 4.5); draw (12.5, 3.5); move (13.0, 3.5); + draw (13.0, 4.0); draw (13.5, 4.0); +move (2.5, 3.5); draw (13.5, 3.5); move (13.5, 3.0); draw (10.0, 3.0); + draw (10.0, 2.5); move (9.5, 2.5); draw (9.5, 3.0); draw (2.5, 3.0); +move (10.5, 3.0); draw (10.5, 2.5); move (11.0, 2.5); draw (11.0, 3.0); +move (12.5, 2.5); draw (12.5, 3.0); move (13.0, 3.0); draw (13.0, 2.5); +move (2.5, 2.5); draw (6.4, 2.5); draw (6.4, 2.0); draw (4.0, 2.0); + draw (4.0, 1.5); draw (6.5, 1.5); draw (6.5, 2.5); draw (13.5, 2.5); + move (13.5, 2.0); draw (7.0, 2.0); draw (7.0, 1.5); draw (9.0, 1.5); + draw (9.0, 1.0); draw (3.5, 1.0); draw (3.5, 2.0); draw (2.5, 2.0); +move (9.5, 2.0); draw (9.5, 1.0); draw (10.4, 1.0); draw (10.4, 1.5); + draw (10.0, 1.5); draw (10.0, 2.0); +move (10.5, 2.0); draw (10.5, 1.0); draw (13.0, 1.0); draw (13.0, 2.0); + move (11.0, 2.0); draw (11.0, 1.5); draw (12.5, 1.5); draw (12.5, 2.0); +move (4.5, 1.5); draw (4.75, 1.25); draw (4.5, 1.0); +move (5.5, 1.5); draw (5.75, 1.25); draw (5.5, 1.0); +move (7.5, 1.5); draw (7.75, 1.25); draw (7.5, 1.0); +move (11.5, 1.5); draw (11.75, 1.25); draw (11.5, 1.0); + +font size (0.25); font expansion (1.4); +move (2.5, 4.1); draw ("K0"); +move (2.5, 3.1); draw ("N0"); +move (2.5, 2.1); draw ("A0"); + +move (0.0, 4.1); draw ("'Kalender'"); +move (0.0, 3.1); draw ("'Namen'"); +move (0.0, 2.1); draw ("'Adressen'"); +move (0.0, 1.1); draw ("Arbeitskopie"); + +move (4.9, 1.1); draw ("A1"); +move (5.9, 1.1); draw ("A2"); +move (7.9, 1.1); draw ("A3"); +move (11.9, 1.1); draw ("K1"); + +x alignment (right); +move (13.5, 4.1); draw ("K1"); +move (13.5, 3.1); draw ("N0"); +move (13.5, 2.1); draw ("A2"); + +x alignment (normal); +font size (0.2); +INT VAR i; +FOR i FROM 0 UPTO 10 REP + time (2.5 + real (i) * 1.0, i) +END REP; + +PROC time (REAL CONST x pos, INT CONST nr) : + + move (x pos, 4.9); draw (x pos, 4.6); + move (x pos, 3.9); draw (x pos, 3.6); + move (x pos, 2.9); draw (x pos, 2.6); + move (x pos, 1.9); draw (x pos, 1.6); + move (x pos, 0.9); draw (x pos, 0.6); + move (x pos + 0.1, 0.6); draw (text (nr)) + +END PROC time; + + +LET myname = "abb.6-2"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000); +*) + diff --git a/app/eudas/4.3/doc/abb.7-1 b/app/eudas/4.3/doc/abb.7-1 new file mode 100644 index 0000000..3536ad9 --- /dev/null +++ b/app/eudas/4.3/doc/abb.7-1 @@ -0,0 +1,46 @@ +init dgs; +window (0.0, 0.0, 13.5, 6.0); viewport (0.0,0.0,13.5,6.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +kasten (5.0, 4.5, 3.0, 1.0); +kasten (5.0, 1.5, 3.0, 1.0); +kasten (1.5, 3.0, 3.0, 1.0); +font size (0.35); font expansion (1.5); +x alignment (center); +move (6.5, 4.8); draw ("Druckmuster"); +move (6.5, 1.8); draw ("Druckdatei"); +move (3.0, 3.3); draw ("EUDAS-Datei"); +move (6.5, 0.0); draw ("Drucker"); + +move (6.5, 4.25); draw (6.5, 2.75); draw (6.25, 3.0); + move (6.5, 2.75); draw (6.75, 3.0); +move (4.75, 3.5); draw (6.25, 3.5); draw (6.0, 3.75); + move (6.25, 3.5); draw (6.0, 3.25); +move (6.5, 1.25); draw (6.5, 0.5); draw (6.75, 0.75); + move (6.5, 0.5); draw (6.25, 0.75); + + +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + + +LET myname = "abb.7-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000); +*) + diff --git a/app/eudas/4.3/doc/abb.9-1 b/app/eudas/4.3/doc/abb.9-1 new file mode 100644 index 0000000..774b78b --- /dev/null +++ b/app/eudas/4.3/doc/abb.9-1 @@ -0,0 +1,41 @@ +init dgs; +window (0.0, 0.0, 13.5, 4.0); viewport (0.0,0.0,13.5,4.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +move (1.5, 1.0); draw (8.75, 1.0); +move (1.5, 3.5); draw (8.75, 3.5); +INT VAR i; +FOR i FROM 0 UPTO 9 REP + move (1.75 + real (i) * 0.75, 3.7); + draw (1.75 + real (i) * 0.75, 1.0); +END REP; + +move (4.7, 3.7); draw (4.7, 1.0); + +font size (0.25); font expansion (1.5); +x alignment (center); +FOR i FROM 0 UPTO 8 REP + move (2.125 + real (i) * 0.75, 3.6); draw (text (i + 110)) +END REP; +FOR i FROM 1 UPTO 5 REP + move (2.125 + real (i + 3) * 0.75, 0.6); draw ("(" + text (i) + ")") +END REP; + +font size (0.35); x alignment (left); +move (2.0, 0.0); draw ("Datei A"); +move (5.0, 0.0); draw ("Datei B"); + + +LET myname = "abb.9-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.3/doc/abb.9-2 b/app/eudas/4.3/doc/abb.9-2 new file mode 100644 index 0000000..4e9444d --- /dev/null +++ b/app/eudas/4.3/doc/abb.9-2 @@ -0,0 +1,96 @@ +init dgs; +window (0.0, 0.0, 13.5, 6.5); viewport (0.0,0.0,13.5,6.5); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +INT VAR i; +move (4.0, 0.0); draw (4.0, 2.0); +move (5.5, 0.0); draw (5.5, 2.0); +FOR i FROM 0 UPTO 4 REP + move (4.0, real (i) * 0.5); + draw (5.5, real (i) * 0.5) +END REP; + +move (4.0, 3.0); draw (4.0, 6.0); +move (5.5, 3.0); draw (5.5, 6.0); +FOR i FROM 0 UPTO 6 REP + move (4.0, real (i) * 0.5 + 3.0); + draw (5.5, real (i) * 0.5 + 3.0) +END REP; + +move (7.5, 2.0); draw (7.5, 6.0); +move (9.0, 2.0); draw (9.0, 6.0); +FOR i FROM 0 UPTO 8 REP + move (7.5, real (i) * 0.5 + 2.0); + draw (9.0, real (i) * 0.5 + 2.0) +END REP; + +strichel (5.5, 6.0, 7.5, 6.0); +strichel (5.5, 3.0, 7.5, 3.0); +strichel (5.5, 1.0, 7.5, 3.0); +strichel (5.5, 0.0, 7.5, 2.0); + +move (5.5, 4.75); draw (6.0, 4.75); + draw (6.0, 1.75); draw (5.5, 1.75); +move (4.0, 3.75); draw (3.5, 3.75); + draw (3.5, 1.25); draw (4.0, 1.25); + +font size (0.4); font expansion (1.5); +move (0.0, 0.8); draw ("Koppeldatei"); +move (0.0, 4.3); draw ("Hauptdatei"); +move (10.0, 4.3); draw ("virtuelle"); +move (10.0, 3.4); draw ("Datei"); + +font size (0.3); +move (4.5, 0.1); draw ("H2"); +move (4.5, 0.6); draw ("H1"); +move (4.5, 1.1); draw ("B"); +move (4.5, 1.6); draw ("A"); +move (4.5, 3.1); draw ("F4"); +move (4.5, 3.6); draw ("B"); +move (4.5, 4.1); draw ("F3"); +move (4.5, 4.6); draw ("A"); +move (4.5, 5.1); draw ("F2"); +move (4.5, 5.6); draw ("F1"); +move (8.0, 5.6); draw ("F1"); +move (8.0, 5.1); draw ("F2"); +move (8.0, 4.6); draw ("A"); +move (8.0, 4.1); draw ("F3"); +move (8.0, 3.6); draw ("B"); +move (8.0, 3.1); draw ("F4"); +move (8.0, 2.6); draw ("H1"); +move (8.0, 2.1); draw ("H2"); + +PROC strichel (REAL CONST x anf, y anf, x end, y end) : + + REAL VAR laenge := x end - x anf; + INT VAR teile := int (abstand/ 0.4); + REAL VAR verhaeltnis := (y end - y anf) / laenge; + laenge := laenge / (real (2 * teile + 1)); + INT VAR i; + FOR i FROM 0 UPTO teile REP + move (x anf + real (i + i) * laenge, + y anf + verhaeltnis * real (i + i) * laenge); + draw (x anf + real (i + i + 1) * laenge, + y anf + verhaeltnis * real (i + i + 1) * laenge) + END REP . + +abstand : + sqrt ((y end - y anf) + (y end - y anf) + + (x end - x anf) * (x end - x anf)) . + +END PROC strichel; + + +LET myname = "abb.9-2"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000); +*) + diff --git a/app/eudas/4.3/doc/abb.9-3 b/app/eudas/4.3/doc/abb.9-3 new file mode 100644 index 0000000..9b190ab --- /dev/null +++ b/app/eudas/4.3/doc/abb.9-3 @@ -0,0 +1,113 @@ +init dgs; +window (0.0, 0.0, 13.5, 7.0); viewport (0.0,0.0,13.5,7.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +x alignment (center); +font size (0.3); font expansion (1.2); +kasten (1.5, 5.0, 2.0, 1.5); +move (2.5, 5.9); draw ("EUDAS-"); +move (2.5, 5.3); draw ("Datei 1"); +move (3.5, 5.75); draw (4.0, 5.75); +kasten (4.0, 5.0, 2.0, 1.5); +move (5.0, 5.9); draw ("gekettete"); +move (5.0, 5.3); draw ("Datei A"); +move (6.0, 5.75); draw (6.5, 5.75); +kasten (6.5, 5.0, 2.0, 1.5); +move (7.5, 5.9); draw ("gekettete"); +move (7.5, 5.3); draw ("Datei B"); +kasten (1.5, 2.0, 2.0, 1.5); +move (2.5, 2.9); draw ("gekoppelte"); +move (2.5, 2.3); draw ("Datei C"); +kasten (4.0, 0.0, 2.0, 1.5); +move (5.0, 0.9); draw ("gekoppelte"); +move (5.0, 0.3); draw ("Datei D"); + +punkt (9.0, 5.75); +punkt (9.25, 5.75); +punkt (9.5, 5.75); + +strichel (1.0, 4.5, 10.0, 4.5); +strichel (1.0, 7.0, 10.0, 7.0); +strichel (1.0, 4.5, 1.0, 7.0); +x alignment (right); font size (0.4); +move (10.0, 3.9); +draw ("Hauptdatei"); + +punkt (2.5, 3.75); +punkt (2.5, 4.0); +punkt (2.5, 4.25); + +punkt (5.0, 1.75); +punkt (5.0, 2.0); +punkt (5.0, 2.25); +punkt (5.0, 2.5); +punkt (5.0, 2.75); +punkt (5.0, 3.0); +punkt (5.0, 3.25); +punkt (5.0, 3.5); +punkt (5.0, 3.75); +punkt (5.0, 4.0); +punkt (5.0, 4.25); + +PROC punkt (REAL CONST x pos, y pos) : + + LET p size = 0.025; + move (x pos, y pos + p size); + draw (x pos + p size, y pos); + draw (x pos, y pos - p size); + draw (x pos - p size, y pos); + draw (x pos, y pos + p size) + +END PROC punkt; + + +PROC strichel (REAL CONST x anf, y anf, x end, y end) : + + REAL VAR laenge := x end - x anf; + INT VAR teile := int (abstand/ 0.4); + REAL VAR senkrecht, verhaeltnis; + IF laenge <> 0.0 THEN + verhaeltnis := (y end - y anf) / laenge; senkrecht := 1.0 + ELSE + verhaeltnis := 1.0; senkrecht := 0.0 ; + laenge := y end - y anf + END IF; + laenge := laenge / (real (2 * teile + 1)); + INT VAR i; + FOR i FROM 0 UPTO teile REP + move (x anf + real (i + i) * laenge * senkrecht, + y anf + verhaeltnis * real (i + i) * laenge); + draw (x anf + real (i + i + 1) * laenge * senkrecht, + y anf + verhaeltnis * real (i + i + 1) * laenge) + END REP . + +abstand : + sqrt ((y end - y anf) * (y end - y anf) + + (x end - x anf) * (x end - x anf)) . + +END PROC strichel; + +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + + +LET myname = "abb.9-3"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.3/doc/abb.9-4 b/app/eudas/4.3/doc/abb.9-4 new file mode 100644 index 0000000..e243265 --- /dev/null +++ b/app/eudas/4.3/doc/abb.9-4 @@ -0,0 +1,98 @@ +init dgs; +window (0.0, 0.0, 13.5, 6.0); viewport (0.0,0.0,13.5,6.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +kasten (2.0, 1.0, 1.4, 2.0); +kasten (3.5, 1.0, 1.4, 2.0); +kasten (6.5, 1.0, 1.4, 2.0); +kasten (2.0, 3.4, 1.4, 2.0); +kasten (5.0, 3.4, 1.4, 2.0); +kasten (6.5, 3.4, 1.4, 2.0); + strichel (3.5, 3.4, 3.5, 5.4); + strichel (3.5, 5.4, 4.9, 5.4); + strichel (4.9, 5.4, 4.9, 3.4); + strichel (4.9, 3.4, 3.5, 3.4); +move (1.9, 2.7); draw (1.5, 2.7); +draw (1.5, 4.6); draw (1.9, 4.6); + +x alignment (center); +font size (0.3); font expansion (1.4); + +move (2.7, 5.6); draw ("22-1"); +move (2.7, 4.9); draw ("X"); +move (2.7, 4.4); draw ("K"); +move (2.7, 2.5); draw ("K"); +move (2.7, 2.0); draw ("N1"); +move (2.7, 0.4); draw ("(114)"); + +move (4.2, 5.6); draw ("22-2"); +move (4.2, 4.9); draw ("X"); +move (4.2, 4.4); draw ("K"); +move (4.2, 2.5); draw ("K"); +move (4.2, 2.0); draw ("N2"); +move (4.2, 0.4); draw ("(209)"); + +move (5.7, 5.6); draw ("23-1"); +move (5.7, 4.9); draw ("Y"); +move (5.7, 4.4); draw ("L"); + +move (7.2, 5.6); draw ("24-1"); +move (7.2, 4.9); draw ("Z"); +move (7.2, 4.4); draw ("M"); +move (7.2, 2.5); draw ("M"); +move (7.2, 0.4); draw ("(17)"); + +font size (0.4); x alignment (normal); +move (8.5, 2.0); draw ("Koppeldatei"); +move (8.5, 4.4); draw ("Hauptdatei"); + +PROC strichel (REAL CONST x anf, y anf, x end, y end) : + + REAL VAR laenge := x end - x anf; + INT VAR teile := int (abstand/ 0.4); + REAL VAR senkrecht, verhaeltnis; + IF laenge <> 0.0 THEN + verhaeltnis := (y end - y anf) / laenge; senkrecht := 1.0 + ELSE + verhaeltnis := 1.0; senkrecht := 0.0 ; + laenge := y end - y anf + END IF; + laenge := laenge / (real (2 * teile + 1)); + INT VAR i; + FOR i FROM 0 UPTO teile REP + move (x anf + real (i + i) * laenge * senkrecht, + y anf + verhaeltnis * real (i + i) * laenge); + draw (x anf + real (i + i + 1) * laenge * senkrecht, + y anf + verhaeltnis * real (i + i + 1) * laenge) + END REP . + +abstand : + sqrt ((y end - y anf) * (y end - y anf) + + (x end - x anf) * (x end - x anf)) . + +END PROC strichel; + +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + + +LET myname = "abb.9-4"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.3/doc/abb.9-5 b/app/eudas/4.3/doc/abb.9-5 new file mode 100644 index 0000000..c00655c --- /dev/null +++ b/app/eudas/4.3/doc/abb.9-5 @@ -0,0 +1,51 @@ +init dgs; +window (0.0, 0.0, 13.5, 7.0); viewport (0.0,0.0,13.5,7.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +kasten (1.5, 0.0, 3.5, 2.0); +kasten (7.0, 0.0, 3.5, 2.0); +kasten (4.0, 4.0, 4.0, 3.0); + kasten (5.0, 5.5, 2.0, 1.0); + +move (3.25, 2.25); draw (4.75, 3.75); + draw (4.5, 3.75); move (4.75, 3.75); draw (4.75, 3.5); + move (3.25, 2.25); draw (3.5, 2.25); + move (3.25, 2.25); draw (3.25, 2.5); +move (8.75, 2.25); draw (7.25, 3.75); + draw (7.5, 3.75); move (7.25, 3.75); draw (7.25, 3.5); + move (8.75, 2.25); draw (8.5, 2.25); + move (8.75, 2.25); draw (8.75, 2.5); + +x alignment (center); +font size (0.4); font expansion (1.4); + +move (3.25, 0.2); draw ("Benutzer A"); +move (8.75, 0.2); draw ("Benutzer B"); +move (6.0, 4.3); draw ("Manager"); +font size (0.3); +move (6.0, 5.6); draw ("Kunden"); + +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + + +LET myname = "abb.9-5"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.3/doc/bildergenerator b/app/eudas/4.3/doc/bildergenerator new file mode 100644 index 0000000..8129476 --- /dev/null +++ b/app/eudas/4.3/doc/bildergenerator @@ -0,0 +1,25 @@ +PROC starten : + + command dialogue (FALSE); + disable stop; + fetch (name, /"DGS NEC"); + run (name); + save (name + ".p", /"DGS NEC"); + end (myself) + +END PROC starten; + +TEXT VAR name; + +PROC gen (TEXT CONST t) : + + name := t; + begin ("p", PROC starten, a); + TASK VAR a; + WHILE exists (a) REP pause (100) END REP + +END PROC gen; + +gen ("abb.4-2"); +gen ("abb.6-1"); + diff --git a/app/eudas/4.3/doc/eudas.hdb.1 b/app/eudas/4.3/doc/eudas.hdb.1 new file mode 100644 index 0000000..40b5a84 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.1 @@ -0,0 +1,267 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (3)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +#center##on("b")#"Was kann EUDAS ? + + + +In diesem Kapitel wollen wir Ihnen erklären, was EUDAS Ihnen ei­ +gentlich bringen soll. Sie arbeiten sicher nicht nur aus Spaß am +Computer, sondern wollen ihn für bestimmte Aufgaben einsetzen. Ein +Computer kann bestimmte Aufgaben nur dann bearbeiten, wenn er +dafür programmiert worden ist. + EUDAS ist nun ein Programm, das allgemein Aufgaben der Da­ +tenverwaltung lösen kann. Zunächst wollen wir Ihnen erläutern, +wodurch dieses Anwendungsgebiet genau charakterisiert wird. + + +1.1 Textverarbeitung und Datenverwaltung + +Es gibt zwei Einsatzbereiche des Computers, die von fast jedem An­ +wender benötigt werden, egal auf welchem Spezialgebiet er tätig ist: +nämlich die #on("i")#Textverarbeitung#off("i")# und die #on("i")#Datenverwaltung#off("i")#. Durch die +Unterscheidung dieser beiden Bereiche werden die charakteristi­ +schen Merkmale der Datenverwaltung abgegrenzt. + +#on("b")#Textverarbeitung#off("b")# Die Textverarbeitung befaßt sich damit, +einen beliebigen Text auf einem Rechner zu erfassen und anschließend +über einen Drucker wieder auszugeben. Der Sinn dieser Arbeit liegt +darin, daß man einen einmal eingegebenen Text sehr einfach ändern +kann. Außerdem kann der Computer einige unangenehme Aufgaben +übernehmen, die beim Schreiben von Texten auftreten: die Auftei­ +lung auf Zeilen und Seiten, die Seitennumerierung und vieles mehr. + Charakteristisch für die Textverarbeitung ist, daß der Einfluß +des Computers sich auf kosmetische Details beschränkt. Die Spei­ +cherung und eventuelle Aufbereitung zum Drucken haben praktisch +nichts mit dem Inhalt des Textes zu tun. Dies wäre für den Rechner +auch sehr schwierig, da die im Text enthaltenen Informationen in +menschlicher Sprache vorliegen, die für einen Rechner nicht ver­ +ständlich ist. + +#on("b")#Datenverwaltung#off("b")# Bei der Datenverwaltung werden ebenfalls +textuelle Informationen gespeichert, diese liegen aber in einer aufberei­ +teten Form vor, die einen Teil des Inhalts für den Computer ver­ +ständlich macht. Bei der Datenverwaltung werden Objekte betrach­ +tet, die verschiedene Eigenschaften haben können. Ein solches +Objekt kann z.B. eine Person sein. Als Eigenschaften werden mit +dieser Person zusammenhängende Informationen betrachetet, die für +die jeweilige Anwendung wichtig sind. + Ein Beispiel für eine solche Betrachtungsweise ist der Arbeit­ +nehmer im Betrieb. Einige der typischerweise erfaßten Daten sind +Name, Adresse, Telefon, Geburtsdatum und Geschlecht. Alle diese +Daten sind Eigenschaften oder #on("i")#Attribute#off("i")#, die einem bestimmten +Menschen mehr oder weniger fest zugeordnet sind. + Die Betonung inhaltlicher Beziehungen erleichtert es dem Com­ +puter, die gespeicherten Daten in verschiedenen Variationen aus­ +zuwerten. + +#on("b")#Beispiel#off("b")# Um die Unterscheidung zwischen Textverarbeitung +und +Datenverwaltung deutlicher zu machen, werden im folgenden Bei­ +spiel die Informationen über eine Person in zwei unterschiedlichen +Formen dargeboten, die für den Menschen die gleiche Aussagekraft +haben: + + 1. Frau Magdalene Kant, geb. Hagedorn, wurde am 12. Januar + 1946 geboren. Sie wohnt in Bonn in der Meckenheimer Allee + 112. Seit 1977 arbeitet sie in unserer Firma. Sie ist tele­ + fonisch erreichbar unter der Nummer 0228/356782. + + 2. Name: Magdalene + Vorname: Kant + Geburtsname: Hagedorn + Geburtsdatum: 12.01.46 + Geschlecht: weiblich + Strasse: Meckenheimer Allee 112 + PLZ: 5200 + Wohnort: Bonn 1 + Vorwahl: 0228 + Telefon: 356782 + beschäftigt seit: 1977 + +Die Form der Darstellung wie in der ersten Alternative eignet sich +nur für den Menschen, da die gleiche Information auf viele ver­ +schiedene Weisen ausgedrückt werden könnte (z.B. unterschiedlicher +Satzbau). Die zweite Alternative beschränkt sich auf die für die +bestimmte Anwendung wesentlichen Zusammenhänge; der Computer +kann die Aufteilung der Information in einzelne Attribute ausnut­ +zen. + In dieser zweiten Form können Sie Daten mit EUDAS erfassen +und auch auswerten. Die Attribute können Sie jeweils passend zu +den erfaßten Daten selbst bestimmen. + Für Daten in der ersten Form steht Ihnen die EUMEL-Textver­ +arbeitung zur Verfügung. EUDAS wurde so entwickelt, daß Sie auch +Daten an die Textverarbeitung übergeben können. + Es ist nämlich möglich, einen freien Text aus der Attributdar­ +stellung automatisch zu erzeugen, indem Sie dem Computer den +Satzbau mit entsprechenden Platzhaltern vorgeben. Der Rechner +setzt die einzelnen Attribute dann an die angegebenen Stellen. +Diese Funktion ist ein Kernstück von EUDAS und wird in Abschnitt +1.3 näher erläutert. + + +1.2 EUDAS als Karteikasten + +Wie Sie vielleicht schon bemerkt haben, ähnelt die zweite Form der +Darstellung einer Karteikarte, auf der Platz für bestimmte Einträge +freigehalten wird. Anhand dieses Modells können Sie sich in vielen +Fällen die Arbeitsweise von EUDAS veranschaulichen. Sie sollten die +Analogie allerdings nicht zu weit treiben: EUDAS schaufelt ja nicht +wirklich mit Karteikarten herum. Manche Funktionen sind eben +computerspezifisch und ließen sich mit Karteikarten gar nicht +durchführen. + Mit EUDAS können Sie die möglichen Einträge auf den Karteikar­ +ten (also die Attribute) völlig frei bestimmen; die einzige Beschrän­ +kung besteht darin, daß Sie in einem Karteikasten nur Karten mit +völlig gleichem Aufbau verwenden können. Wenn Sie eine neue Kar­ +teikarte entwerfen wollen, brauchen Sie nur Namen für die einzel­ +nen Einträge anzugeben. EUDAS zeigt Ihnen dann quasi eine Karte +am Bildschirm, in der diese Einträge aufgeführt sind. + Sie können nun am Bildschirm Daten auf diese Karteikarten +schreiben. Dabei dürfen die Einträge fast beliebig lang sein; wenn +der Platz auf dem Bildschirm nicht reicht, können Sie sich Ihre +überdimensionale Karteikarte in Ausschnitten ansehen. + Die einmal eingegebenen Daten bleiben nun so lange gespei­ +chert, wie Sie wollen (bzw. bis Ihr Rechner zusammenfällt). Haben +Sie beim Eintragen Fehler gemacht, können Sie diese jederzeit kor­ +rigieren oder später noch weitere Informationen ergänzen. + +#free (7.5)# + +#center#Abb. 1-1 EUDAS als Karteikasten + + +#on("b")#Anwendungen#off("b")# Mit den gespeicherten Daten können Sie nun +ver­ +schiedene Dinge anstellen (bzw. vom Rechner anstellen lassen). Das +Einfachste ist natürlich das, was Sie mit einer Kartei auch machen +würden, sich nämlich einzelne Karteikarten anzuschauen. + Um eine bestimmte Karteikarte herauszufinden, geben Sie +EUDAS einfach den Inhalt vor, nach dem gesucht werden soll. Hier +zeigt sich bereits der erste Vorteil eines Computers: Die Suche in +der EUDAS-Kartei ist viel schneller, als Sie es von Hand könnten. +Außerdem kann der Rechner keine Karte zufällig übersehen. + EUDAS zeigt sich auch dann überlegen, wenn Sie einen ganz +bestimmten Teil der Kartei durchforsten müssen. Eine Bücherei muß +z.B. regelmäßig alle Bücher heraussuchen, deren Leihfrist über­ +schritten ist. Der Computer durchsucht in solchen Fällen ermü­ +dungsfrei auch große Datenmengen. + Wenn Sie die Karteikarten in einer bestimmten Reihenfolge +haben wollen, kann EUDAS auch das Sortieren übernehmen. Weitere +automatische Vorgänge betreffen z.B. das Rauswerfen überflüssiger +oder veralteter Karten. Die Einträge können auch nach einer be­ +stimmten Vorschrift alle geändert werden. Solche Aufgaben treten +z.B. in der Schule auf, wo die Schüler jedes Jahr versetzt werden +müssen (natürlich bis auf Ausnahmen). + Auch Beziehungen zwischen verschiedenen Karteien kann +EUDAS herstellen. Dies kann man noch einmal an dem Beispiel der +Bücherei illustrieren. Wenn ein Buch gefunden wurde, dessen Leih­ +frist überschritten ist, muß der zugehörige Ausleiher gefunden und +angeschrieben werden. Das Heraussuchen beider Karten kann EUDAS +in einem Arbeitsgang durchführen. + + +1.3 Drucken + +Eine besondere Stärke von EUDAS ist die Möglichkeit, die gespei­ +cherten Daten in schriftlicher Form auszuwerten. Dadurch, daß die +Daten in einer Form gespeichert sind, die den Inhalt widerspiegelt, +können die gleichen Daten in vielen verschiedenen Formen auf +Papier ausgegeben werden. + + + + + Karl Eudas + An Poltersdorf + XXXXXXXXXXX + XXXXXXXXXXX + + XXXX XXXXXXXXXXXX + + Lieber XXXXXXX ! + + Dies ist ein Beispiel für ein + Druckmuster. + + Viele Grüße + + + +#center#Abb. 1-2 Muster für die Druckausgabe + + +Zu diesem Zweck geben Sie EUDAS ein Muster des gewünschten Aus­ +drucks vor. Der Rechner setzt dann an entsprechend markierten +Leerstellen die gespeicherten Informationen ein und druckt das +Ergebnis aus. Auf diese Weise ersparen Sie sich die umfangreiche +Schreibarbeit, die anfällt, wenn die Informationen auf den Kartei­ +karten in anderer Form benötigt werden. + Natürlich müssen Sie zum Entwerfen des Formulars kein ge­ +wiefter Programmierer sein. Wenn Sie einen Rundbrief verschicken +wollen, schreiben Sie den Brief, als wollten Sie Ihn nur einmal +schicken. Lediglich im Adressfeld müssen Sie Platzhalter an den +Stellen vorsehen, an denen später die wirklichen Adressen stehen +sollen. + +#on("b")#Verwendungsmöglichkeiten#off("b")# Die Möglichkeiten für solche +Formulare +sind unbegrenzt. Beispiele sind Briefe, Adreßaufkleber, Überwei­ +sungsaufträge und sortierte Listen. Mit den Inhalten einer Kartei +können Sie beliebig viele verschiedene Ausgaben erzeugen. Bei dem +obigen Beispiel der Leihbücherei könnten Sie EUDAS dazu einsetzen, +nicht nur die säumigen Ausleiher herauszufinden, sondern die Mah­ +nung gleich fertig für einen Fensterbriefumschlag herzustellen. Für +den Bediener bliebe die einzige Tätigkeit, diesen Vorgang anzuwer­ +fen. + Wie weiter oben schon erwähnt, können Sie diese Ausgaben von +EUDAS auch zur Textverarbeitung übernehmen. So können Sie zum +Beispiel die Literaturliste für ein Buch mit EUDAS führen und Aus­ +züge später jeweils an die passenden Stellen einfügen. + +#on("b")#Berechnungen#off("b")# Die Druckfunktion von EUDAS kann jedoch nicht +nur +zum Ausfüllen von Formularen verwendet werden. Wenn Sie Berech­ +nungen anstellen oder Auswertungen vornehmen wollen, können Sie +im Druckmuster auch Anweisungen der Sprache ELAN verwenden. +Damit haben Sie eine komplette Programmiersprache für Ihre Muster +zur Verfügung. + Ehe Sie einen Schreck bekommen: Selbst für komplizierte Muster +brauchen Sie nur einen ganz kleinen Teil von ELAN zu beherrschen, +da die meiste Arbeit immer von EUDAS übernommen wird (Sie müssen +also nicht etwa selber ein ganzes Programm schreiben). + Anwendungen für diese Möglichkeit gibt es genug. Angefangen +von einfachen Zählungen bis hin zu statistischen Auswertungen, +von einfachen Summen bis zum kompletten Rechnungsschreiben. +Immer nimmt Ihnen EUDAS alles das ab, was automatisch ablaufen +kann. Sie versorgen EUDAS nur noch mit den passenden Formeln für +Ihre Anwendung. + + +1.4 Grenzen + +Natürlich können Sie nicht alle Probleme mit EUDAS gleichermaßen +gut lösen. EUDAS verwendet ein einfaches Modell (Karteikasten) und +versucht, mit möglichst wenig Informationen von Ihrer Seite auszu­ +kommen. Kompliziertere Sachverhalte verlangen auch kompliziertere +Strukturen, die Sie dann selbst entwerfen müssen. Eine einfache +Lösung mit EUDAS kann in solchen Fällen zu langsam oder zu um­ +ständlich sein. + Wenn Sie jedoch die wenigen Strukturprinzipien von EUDAS +verstanden haben, werden Sie sehr schnell viele Probleme mit +EUDAS lösen können. Zuerst erfassen Sie einfach alle Daten, die Sie +brauchen und überlegen sich erst dann, in welcher Form Sie diese +Daten haben wollen. Auch nachträglich können Sie jederzeit noch +neue Daten und Formulare hinzufügen, so daß Sie mit der Zeit +EUDAS gewinnbringend für viele Routineaufgaben benutzen werden. + diff --git a/app/eudas/4.3/doc/eudas.hdb.10 b/app/eudas/4.3/doc/eudas.hdb.10 new file mode 100644 index 0000000..442f575 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.10 @@ -0,0 +1,510 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (97)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +10 Datenabfrage am Bildschirm + + + +10.1 Feldauswahl + +Da die Anzahl der möglichen Felder bei EUDAS-Dateien viel größer +ist als die Anzahl der zur Verfügung stehenden Zeilen auf dem +Bildschirm (255 gegenüber 22), muß es eine Möglichkeit geben, auch +die übrigen Felder anzusehen. + +#on("b")#Rollen#off("b")# Dazu kann man den Bildschirmausschnitt in +vertikaler +Richtung #on("i")#rollen#off("i")#. Sie müssen sich die Bildschirmanzeige als einen +Ausschnitt des wirklichen Satzes vorstellen. Um weitere Inhalte des +Satzes zu sehen, verschieben Sie den Ausschnitt einfach. + Dazu dienen die beiden Tastenkombinationen ESC OBEN und ESC +UNTEN. Diese Kombinationen wirken nur im Menü "Einzelsatz". An +der Bildschirmanzeige ändert sich natürlich nur dann etwas, wenn +es noch weitere Felder zum Anzeigen gibt. + Ob dies der Fall ist, können Sie an zwei Indikatoren ablesen. +Zum einen wird hinter dem letzten Feld eine markierte Abschluß­ +zeile ausgegeben. Ist diese nicht sichtbar, gibt es noch Felder, die +Sie mit ESC UNTEN hochholen können. Zum anderen steht die Num­ +mer der ersten Zeile in der Überschrift. Ist diese Nummer größer als +1, können Sie mit ESC OBEN noch Felder sichtbar machen. + Das Rollen ist oft auch dann notwendig, wenn sich ein Feld +über mehrere Zeilen erstreckt. In diesem Fall kann es passieren, +daß die erste Zeile des Feldes nicht mehr sichtbar ist, da sie ober­ +halb des Anzeigebereichs liegen würde. + +#on("b")#Feldauswahl#off("b")# Eine weitere Möglichkeit bei zu vielen Feldern +be­ +steht darin, nur die interessanten Felder zur Anzeige auszuwählen. +Dies geschieht mit der Funktion +#free (0.2)# + + F Feldauswahl + +#free (0.2)# +Ihnen werden alle Felder zur Auswahl angeboten. Kreuzen Sie die +Felder an, die Sie sehen wollen und denken Sie daran, daß die Rei­ +henfolge des Ankreuzens beachtet wird. Anschließend werden Ihnen +nur die ausgewählten Felder angezeigt. Falls Sie kein Feld ankreu­ +zen, bleibt die alte Feldauswahl bestehen. + Wollen Sie wieder alle Felder sehen, müssen Sie diese nicht alle +einzeln ankreuzen. Mit HOP 'x' in der Auswahl werden alle Felder +angekreuzt (die noch nicht angekreuzt waren). Diese Tastenkombi­ +nation können Sie allgemein bei einer Auswahl verwenden. Sie +können die Kreuzchen mit 'o' auch wieder löschen, um zum Beispiel +"alle außer einem" auszuwählen. + Beachten Sie, daß die Auswahl der anzuzeigenden Felder nichts +mit der eigentlichen Dateistruktur zu tun hat, sondern nur für die +Anzeige gilt. Den Verarbeitungsfunktionen (zum Beispiel Drucken) +stehen natürlich nach wie vor alle Felder zur Verfügung. + Unvermutete Effekte können dann entstehen, wenn Sie bei +einer eingestellten Feldauswahl ändern oder einfügen. Die nicht +ausgewählten Felder werden beim Ändern natürlich nicht geändert +und beim Einfügen einfach leer gelassen. + + +10.2 Satzeditor + +An dieser Stelle sollen noch einige weitere Funktionen des Satz­ +editors vorgestellt werden, die Sie noch nicht kennengelernt haben. + +#on("b")#Rollen im Satzeditor#off("b")# Sie können auch rollen, wenn Sie sich +im +Satzeditor befinden (also beim Suchen, Einfügen und Ändern). Den­ +ken Sie daran, daß Sie die Einzelsatzanzeige immer mit ESC OBEN +und ESC UNTEN rollen, während sonst (Editor, Auswahl von Datei­ +namen) immer mit HOP OBEN und HOP UNTEN gerollt wird. + Diese Diskrepanz hat technische Gründe und läßt sich leider +nicht vermeiden. Wie Sie sich vielleicht erinnern, führt das Blättern +mit HOP OBEN und HOP UNTEN im Satzeditor dazu, daß die Korre­ +spondenz zwischen Feldnamen und Feldinhalt verlorengeht. Daher +muß an dieser Stelle mit ESC statt HOP gearbeitet werden. + +#on("b")#Ähnliche Sätze#off("b")# Wenn Sie mehrere ähnliche Sätze eintragen +müssen, +bietet Ihnen EUDAS eine Erleichterung an. Sie können nämlich beim +Einfügen die Daten eines anderen Satzes übernehmen. + Dazu müssen Sie beim Ändern oder Einfügen des anderen Satzes +ESC 'p' drücken. Der Inhalt des Satzes wird dann in einen Zwischen­ +speicher gebracht. Beachten Sie, daß im Gegensatz zum EUMEL- +Editor kein Text markiert sein muß, sondern immer der ganze Satz +transportiert wird. + Beim Einfügen eines neuen Satzes können Sie diesen Satz dann +mit ESC 'g' in den Satzeditor übernehmen. Alle vorherigen Inhalte +werden überschrieben. Anschließend können Sie die Daten nach +Wunsch abändern. + Der Inhalt des Zwischenspeichers kann beliebig oft auf diese +Weise kopiert werden. Der Inhalt des Zwischenspeichers wird bei +Ändern der Feldauswahl oder beim Öffnen einer neuen Datei ge­ +löscht. + +#on("b")#Tagesdatum#off("b")# Im Satzeditor können Sie mit ESC 'D' das +aktuelle +Tagesdatum abfragen. Es wird an der aktuellen Cursorposition ein­ +getragen, als ob Sie es selbst getippt hätten. + Auf diese Weise können Sie Sätze einfach mit Datum versehen +oder nach Sätzen suchen, die mit dem Tagesdatum in Beziehung +stehen (zum Beispiel 'Fälligkeit = Heute'). + + +10.3 Suchmuster + +Die bisher genannten Möglichkeiten des Suchmusters sind noch +etwas beschränkt. Eine Bedingung in unserer Adressendatei, die wir +im Suchmuster noch nicht ausdrücken können, wäre zum Beispiel: +Suche alle Adressen der Personen, die Wegner oder Simmern heißen. + Diese Alternative, Wegner ODER Simmern, kann nun in EUDAS +durch ein Komma ausgedrückt werden: + + + Name Wegner,Simmern + Vorname + + +Beachten Sie, daß hinter dem Komma kein Leerzeichen folgen darf, +wie Sie es vielleicht gewohnt sind, in einem Text zu schreiben. +EUDAS kann nämlich nicht unterscheiden, ob Sie das Leerzeichen +nur aus optischen Gründen geschrieben haben, oder ob Sie danach +suchen wollen. + +#on("b")#Lokale Alternative#off("b")# Die eben beschriebene +Konstruktionsmethode +heißt #on("i")#lokale Alternative#off("i")#. Lokal deshalb, weil Sie nur innerhalb +eines Feldes gilt. Was das bedeuten soll, sehen Sie, wenn Sie die +Bedingung mit einer weiteren Bedingung für ein anderes Feld kom­ +binieren: + + + Name Wegner,Simmern + Vorname + Strasse + PLZ 5* + Ort + + +Dieses Muster hat die Bedeutung: Wähle alle Personen namens Weg­ +ner oder Simmern aus, die im PLZ-Bereich 5 wohnen. Die beiden +Bedingungen für den Namen sind mit der Bedingung für die PLZ mit +UND verknüpft - das heißt, eine der beiden ersten Bedingungen muß +zutreffen #on("i")#und#off("i")# die untere Bedingung. Dieses UND ist global, da es +Bedingungen für verschiedene Felder miteinander verbindet. + Natürlich können Sie für mehrere Felder gleichzeitig lokale +Alternativen angeben. Eine anderes Suchmuster könnte zum Beispiel +so aussehen: + + + Name Wegner,Simmern + Vorname + Strasse + PLZ 5,5000 + Ort + + +In diesem Fall muß eine ausgewählte Person Wegner oder Simmern +heißen und in Köln wohnen. + +#on("b")#Globale Alternative#off("b")# Es wird nun aber für bestimmte +Situationen +noch eine andere Art von Alternativen benötigt. Als Beispiel soll +ein Suchmuster dienen, das folgende Bedingung ausdrückt. Gesucht +ist eine weibliche Person mit Namen Simmern oder eine männliche +Person mit Namen Wegner. + Dieser Fall läßt sich mit unseren bisherigen Mitteln nicht lö­ +sen. Es wird nämlich eine Alternative zwischen zwei zusammen­ +gesetzten Bedingungen gefordert. Als Ausweg bietet sich an, prak­ +tisch mehrere Suchmuster anzugeben, die dann mit ODER verknüpft +werden. + Um diese verschiedenen Suchmuster optisch am Bildschirm zu +kennzeichnen, wird ein Semikolon als sogenannte #on("i")#globale Alternati­ +ve#off("i")# verwendet. Das Semikolon trennt das Suchmuster quasi in ver­ +schiedene Spalten auf, die jeweils eine eigene Bedingung enthalten +können. Unser gewünschtes Suchmuster würde also so aussehen: + + + Name Wegner;Simmern + Vorname + Strasse + PLZ + Ort + m/w m;w + + +Ebenso wie bei lokalen Alternativen darf hinter dem Semikolon kein +Leerzeichen folgen. Daher kann das zweite Semikolon auch nicht +direkt unter dem ersten stehen. Die Spalten werden also einfach nur +durchgezählt: nach dem ersten Semikolon beginnt die zweite Spal­ +te, nach dem zweiten Semikolon die dritte usw. + In Zeilen, in denen keine Bedingungen stehen, kann auch das +Semikolon weggelassen werden. Es kann ebenfalls weggelassen wer­ +den, wenn die weiteren Spalten leer sind. Steht ein Semikolon direkt +am Anfang der Zeile, so ist die erste Spalte leer. + Um dies zu illustrieren, sei hier noch ein weiteres Beispiel +angegeben: + + + Name Wegner + Vorname ;Anna-Maria + Strasse + + +In diesem Fall muß eine ausgewählte Person mit Nachnamen Wegner +oder mit Vornamen Anna-Maria heißen. + +#on("b")#Stern#off("b")# Bis jetzt haben Sie hauptsächlich Bedingungen +betrachtet, +die exakt zutreffen mußten. Sie wissen aber bereits, daß man auch +Bedingungen angeben kann, bei denen nur ein Teil des zu suchen­ +den Feldes bekannt ist, nämlich indem der unbekannte Teil mit +einem Stern markiert wird. + In Kapitel 5 haben Sie gelernt, daß der Stern nur am Anfang +und Ende des Musters stehen kann. Dies trifft nicht ganz zu, denn +Sie können den Stern auch inmitten eines Textes anwenden. So +trifft die Bedingung 'Si*n' auf alle Namen zu, die mit 'Si' beginnen +und mit 'n' enden. + Beachten Sie hier das "und" in der Formulierung der Bedingung. +Das Muster ist eigentlich eine Schreibweise für zwei Bedingungen +für ein Feld, die mit UND verknüpft sind. + Sie können auch noch weitere Sterne in das Muster aufnehmen. +Dabei gibt es jedoch eine Kleinigkeit zu beachten. Das Muster +'*x*y*' bedeutet: das Feld muß ein 'x' und ein 'y' enthalten. Über +die Reihenfolge der beiden Zeichen ist jedoch in dieser Bedingung +nichts gesagt, obwohl es vielleicht vom Aussehen suggeriert wird. + Denken Sie daran, keine zwei Sterne nebeneinander zu schrei­ +ben - eine solche Bedingung hätte keinen Sinn. + Es gibt eine weitere spezielle Bedingung, die mit Hilfe des +Sterns formuliert wird. Ein einzelner Stern bedeutet nämlich: Das +Feld ist nicht leer. Beachten Sie den kleinen Unterschied: ein Stern +in einem Muster kann für einen beliebigen Text stehen, der auch +leer sein kann. Ein einzelner Stern jedoch steht für einen beliebigen +Text, der nicht leer ist. + Damit Sie ein Gefühl für die Verwendung des Sterns bekommen, +hier noch ein paar Beispiele: + + +Mei*r* + + Der Name beginnt mit 'Mei' und enthält ein 'r'. Trifft zu auf + 'Meier', 'Meiring', aber nicht auf 'Meiling' oder 'Merzei'. + + +Donau*dampf*schiff*schaft + + Feld beginnt mit 'Donau', endet mit 'schaft' und enthält + 'dampf' und 'schiff'. Trifft zu auf 'Donaudampfschiffahrtsge­ + sellschaft', aber auch auf 'Donaugesellschiffdampffahrtschaft'. + + +Roller*erfahren + + Dieses Muster muß man ganz genau interpretieren. Es bedeutet: + der Inhalt beginnt mit 'Roller' und endet mit 'erfahren'. Das + Muster trifft nicht nur auf 'Roller erfahren' sondern auch auf + 'Rollerfahren' zu. Der Stern verliert also in diesem Fall seine + symbolische Bedeutung als Platzhalter für einen bestimmten + Text. + +#on("b")#Vergleiche#off("b")# Es gibt in EUDAS noch weitere Muster, die +einen gan­ +zen Bereich von Werten auswählen. Diese betreffen Bedingungen der +Art "größer als" und "kleiner als". Solche Vergleichsbeziehungen +werden durch zwei Punkte dargestellt. + So wählt das Muster 'K..' alle Felder aus, die in der alphabe­ +tischen Reihenfolge hinter 'K' liegen, wobei das 'K' selbst mit ein­ +geschlossen ist. Umgekehrt trifft '..K' auf alle Felder zu, die davor +liegen. + Sie können beide Bedingungen auch kombinieren. So trifft die +Bedingung 'A..K' auf alle Felder zu, die im Lexikon unter 'A' bis +'J' erscheinen (die Felder mit 'K' sind hier ausgeschlossen). Beach­ +ten Sie, daß die direkte Kombination wieder die Verknüpfung zweier +einzelner Bedingungen mit UND darstellt. + +#on("b")#Negation#off("b")# Um den Bereich möglicher Suchmuster noch zu +erweitern, +können Sie einzelne Bedingungen auch noch verneinen. Dies ge­ +schieht durch Voranstellen zweier Minuszeichen. So bedeutet das +Muster '--Meier', daß alle Personen ausgewählt werden, die nicht +Meier heißen. + Die Verneinung bezieht sich immer auf das unmittelbar folgende +Muster (bis zum nächsten Komma, Semikolon oder dem Zeilenende) +und nicht etwa auf eine ganze Zeile. Sie umfaßt jedoch die UND- +Verknüpfung der kombinierten Bedingungen. So sind zum Beispiel die +Muster '--E..M', '--E..,--..M' und '..E,M..' völlig gleichbedeu­ +tend. + +#on("b")#Feldvergleich#off("b")# Als letztes haben Sie im Suchmuster auch +noch die +Möglichkeit, ein Feld mit anderen Feldern des gleichen Satzes zu +vergleichen. Bisher hatten Sie ein Feld ja immer nur mit konstanten +Texten verglichen. + Um dies zu erreichen, geben Sie statt eines Vergleichstextes +den Feldnamen des Feldes an, mit dem Sie vergleichen wollen. Zur +Kennzeichnung müssen Sie dem Namen noch ein '&' voranstellen. +Diese Konstruktion funktioniert mit allen bisher besprochenen Ver­ +gleichen. Beispielsweise trifft + + + Feld1 ..&Feld2 + + +auf alle Sätze zu, in denen der Inhalt von Feld1 kleiner ist als der +Inhalt von Feld2. + Im Gegensatz zum Druckmuster dürfen in den Feldnamen zwar +Leerzeichen enthalten sein, nicht jedoch +#free (0.2)# + + .. * , ; + +#free (0.2)# +da diese Zeichen als reservierte Zeichen gelten und jeweils als +Begrenzer wirken. Die gleiche Beschränkung gilt dementsprechend +auch für konstante Vergleichstexte. + Beachten Sie, daß hinter dem '&' bis zum nächsten Begrenzer­ +zeichen ein gültiger (vorhandener) Feldname stehen muß. Anderen­ +falls wird der Text als konstantes Muster betrachtet. + Wie schon oben gesagt, kann der Feldvergleich mit allen Ver­ +gleichen verwendet werden. Auch gemischte Konstruktionen sind +zulässig, beispielsweise + + + Feld1 A..&Feld3,*&Feld9* + + +Diese Bedingung trifft zu, wenn Feld1 größer oder gleich 'A', aber +kleiner als der Inhalt von Feld3 ist, oder wenn der Inhalt von Feld9 +darin vorkommt. + +#on("b")#Optimierung#off("b")# Hier noch eine Bemerkung zur Geschwindigkeit +des +Suchens. Je mehr Bedingungen Sie angeben, desto mehr Vergleiche +müssen beim Suchen angestellt werden und desto länger dauert es. + Das erste Feld einer Datei erfährt jedoch eine Sonderbehand­ +lung. Wenn Sie für dieses Feld ein Muster für Übereinstimmung +angeben, kann der Suchvorgang enorm beschleunigt werden, da das +erste Feld einer Datei intern speziell verwaltet wird. Damit das +Verfahren funktioniert, dürfen keine globalen Alternativen oder +lokale Alternativen für das erste Feld verwendet werden. + Diese Suchoptimierung sollten Sie bereits beim Einrichten einer +Datei berücksichtigen. Geben Sie als erstes Feld das an, nach dem +am ehesten direkt gesucht wird. Typisches Beispiel hierfür ist der +Nachname, aber auch Artikelnummern sind sinnvoll. Wichtig ist, daß +das erste Feld nicht zu oft identisch ist und auch mehr als zwei +Buchstaben enthält, damit die Optimierung ihre volle Wirksamkeit +entfaltet. + Denken Sie daran, daß durch die Feldauswahl ein beliebiges +Feld als erstes auf dem Bildschirm stehen kann. Für die Optimierung +wird jedoch immer das Feld betrachtet, das beim Einrichten der +Datei als erstes angegeben wurde. + + +10.4 Markieren + +Manchmal entsteht die Situation, daß Sie eine Reihe von Sätzen +bearbeiten wollen, aber keine Suchbedingung formulieren können, +die auf alle diese Sätze zutrifft. In diesem Fall bietet EUDAS Ihnen +die Möglichkeit, solche Sätze von Hand zu markieren. + Ein Beispiel: Sie haben eine ganze Reihe von Sätzen geändert +und wollen diese Änderungen als Protokoll ausdrucken. Es läßt sich +aber nicht mit Hilfe eines Suchmusters feststellen, welche Sätze +geändert wurden. + Als Abhilfe wählen Sie bei jedem geänderten Satz die Funktion +#free (0.2)# + + M Markierung + +#free (0.2)# +Dadurch wird der bisher unmarkierte Satz markiert. Dies wird +kenntlich an der Anzeige 'MARK+' in der Überschrift. Sobald Sie den +ersten Satz markiert haben, erscheint bei jedem Satz, ob er markiert +ist oder nicht. + Haben Sie einen Satz irrtümlich markiert, können Sie die Mar­ +kierung mit der gleichen Funktion auch wieder entfernen. + Alle Funktionen, die bisher die durch das Suchmuster ausge­ +wählten Sätze bearbeitet haben, arbeiten nun nur noch auf den +markierten Sätzen. Somit können Sie anschließend mit der Druck­ +funktion die gewünschten Sätze drucken. Die Markierung hat also +Priorität über die eingestellte Suchbedingung. Lediglich die Bewe­ +gung am Bildschirm beachtet immer nur die Suchbedingung. + Sie können alle Markierungen der Datei mit der Funktion +#free (0.2)# + + Alle Markier. + L Löschen + +#free (0.2)# +im Menü 'Gesamtdatei' wieder entfernen. Anschließend wird beim +Drucken wieder das Suchmuster beachtet. Die Markierungen ver­ +schwinden auch, wenn eine neue Datei geöffnet wird. Die Markie­ +rungen sind also nicht permanent in einer Datei gespeichert, son­ +dern existieren nur, während die Datei geöffnet ist. + Bei Koppeldateien können Sie aus technischen Gründen immer +nur alle Kombinationen auf einmal markieren. Die Markierung einer +Kombination markiert auch alle anderen Kombinationen des gleichen +Satzes. + + +10.5 Übersicht + +Wie Sie bisher gesehen haben, zeigte EUDAS immer einen einzigen +Satz in dem Standardformular auf dem Bildschirm. Es gibt jedoch +auch eine Möglichkeit, mehrere Sätze gleichzeitig zu betrachten. +Dazu dient die Funktion +#free (0.2)# + + U Übersicht + +#free (0.2)# +im Menü 'Gesamtdatei'. + In der Übersicht nimmt jeder Satz nur eine Bildschirmzeile in +Anspruch. Die Feldinhalte werden, durch Komma getrennt, in der +Zeile nacheinander aufgezählt, bis kein Platz mehr vorhanden ist. +Am Anfang jeder Zeile steht die Satznummer und ob der jeweilige +Satz markiert ist (entweder '+' für markiert oder '-'). In der Über­ +schrift stehen in gleicher Weise die Feldnamen angegeben. + Der aktuelle Satz wird innerhalb der Übersichtsanzeige immer +durch eine inverse Satznummer dargestellt. Es werden nur die durch +das eingestellte Suchmuster ausgewählten Sätze gezeigt. Trifft die +Selektionsbedingung nicht auf den aktuellen Satz zu, wird an seiner +Stelle zur Information ein leerer Platzhalter angezeigt. Hinter dem +letzten Satz wird auch das Dateiende als besonders gekennzeichne­ +ter Satz angegeben. + +___________________________________________________________________________________________ + + ÜBERSICHT: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ? + Satznr. Name, Vorname, PLZ, Ort, Strasse, m/w, + 1 - Wegner, Herbert, Krämergasse 12, 5000, Köln, m, + 2 - Sandmann, Helga, Willicher Weg 109, 5300, Bonn 1, w, + 3 - Katani, Albert, Lindenstr. 3, 5210, Troisdorf, m, + 4 - Ulmen, Peter, Mozartstraße 17, 5, Köln 60, m, + 5 - Regmann, Karin, Grengelweg 44, 5000, Köln 90, w, + 6 - Arken, Hubert, Talweg 12, 5200, Siegburg, m, + 7 - Simmern, Anna-Maria, Platanenweg 67, 5, Köln 3, w, + 8 - Kaufmann-Drescher, Angelika, Hauptstr. 123, 53, Bonn 2, w, + 9 - Fuhrmann, Harald, Glockengasse 44, 5000, Köln 1, m, + 10 - Seefeld, Friedrich, Kabelgasse, 5000, Köln-Ehrenfeld, m, + 11 - << DATEIENDE >> + +___________________________________________________________________________________________ + + +#center#Abb. 10-1 Übersicht + + +#on("b")#Feldauswahl#off("b")# Wenn Sie die Funktion aufrufen, haben Sie +zuerst +noch die Möglichkeit, nur einen Teil der vorhandenen Felder zur +Anzeige auszuwählen. Dazu bejahen Sie die Frage und können dann +die Felder in der gewünschten Reihenfolge ankreuzen. Analog zur +Funktion 'Feldauswahl' wird auch hier die zuletzt für die Übersicht +verwendete Feldauswahl beibehalten, wenn Sie die Frage verneinen +oder kein Feld ankreuzen. Die Feldauswahl für die Übersicht ist +unabhängig von der Feldauswahl für die normale Satzanzeige. + Von der Möglichkeit zur Feldauswahl sollten Sie Gebrauch ma­ +chen, denn durch die komprimierte Darstellung der Übersicht kann +meistens nur ein kleiner Teil eines Satzes dargestellt werden. + +#on("b")#Rollen#off("b")# Nachdem die Sätze auf dem Bildschirm erschienen +sind, +haben Sie wieder die Möglichkeit, die Darstellung zu rollen. Dazu +können Sie die Pfeiltasten OBEN und UNTEN sowie die Tastenkombi­ +nationen HOP OBEN und HOP UNTEN verwenden. Diese Funktionen +verschieben den invers dargestellten aktuellen Satz und funktio­ +nieren wie im Editor. Beachten Sie auch hier wieder den Unterschied +zum Rollen in der Einzelsatzanzeige. + Das Rollen wirkt wie ein Positionieren mit 'Weiter' oder 'Zu­ +rück'. Nach der Rückkehr aus der Übersicht können Sie sich also an +einer ganz anderen Stelle in der Datei befinden. + Es stehen Ihnen zum Rollen auch noch die folgenden Tasten­ +kombinationen zur Verfügung (wie im Editor): HOP RETURN macht +den aktuellen Satz zum ersten auf der Seite. ESC '1' zeigt den er­ +sten Satz der Datei, ESC '9' analog dazu den letzten. + Wenn Sie eine komplizierte Suchbedingung eingestellt haben +und EUDAS viele Sätze erfolglos überprüfen muß, dauert der Bild­ +aufbau natürlich entsprechend lange. EUDAS gibt zu Ihrer Informa­ +tion aber immer die Nummer des Satzes aus, der gerade überprüft +wird. Außerdem werden Tastenbefehle nach jeder Zeile angenommen, +so daß Sie schon weiterblättern können, wenn Sie den ersten Satz +gesehen haben. + +#on("b")#Markieren#off("b")# In der Übersicht können Sie auch Sätze +markieren. Mit +'+' markieren Sie den aktuellen Satz; mit '-' entfernen Sie die Mar­ +kierung wieder. So können Sie einfach die Sätze ankreuzen, die Sie +später bearbeiten wollen. + +#on("b")#Verlassen#off("b")# Mit ESC 'q' können Sie die Übersicht wieder +verlassen, +auch mitten beim Aufbau des Bildes. Haben Sie erkannt, daß EUDAS +sinnlos mit einer falschen Suchbedingung sucht, können Sie die +Funktion auch mit ESC 'h' (Halt) abbrechen und gegebenenfalls ein +neues Suchmuster einstellen. + diff --git a/app/eudas/4.3/doc/eudas.hdb.11 b/app/eudas/4.3/doc/eudas.hdb.11 new file mode 100644 index 0000000..6a59847 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.11 @@ -0,0 +1,674 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (109)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +11 Funktionen zur Bearbeitung + + + +11.1 Sortieren + +Wenn Sie die Sätze in Ihrer EUDAS-Datei in einer bestimmten Rei­ +henfolge haben wollen (dies wird in vielen Fällen zum Drucken +verlangt), müssen Sie die Datei sortieren. Sie können EUDAS ange­ +ben, in welcher Reihenfolge die Sortierung erfolgen soll. Um die +aktuelle Datei zu sortieren, rufen Sie die Funktion +#free (0.2)# + + Akt. Datei + S Sortieren + +#free (0.2)# +auf. Falls die Datei noch nie sortiert wurde, wird Ihnen auf jeden +Fall die Sortierreihenfolge zum Auswählen angeboten. Anderenfalls +werden Sie gefragt, ob Sie die vorherige Sortierreihenfolge ändern +wollen. + Das Sortieren wird als Veränderung betrachtet und nur auf der +Arbeitskopie durchgeführt! + +#on("b")#Sortierreihenfolge#off("b")# Die Sortierreihenfolge gibt an, welche +Felder in +welcher Reihenfolge beim Vergleichen zweier Sätze benutzt werden +sollen. Zuerst wird das an erster Stelle angegebene Feld verglichen. +Sind die Inhalte hier unterschiedlich, wird die Einordnung der Sätze +nach diesem Feld bestimmt. + Sind die Inhalte in diesem Feld aber gleich, so wird nach dem +nächsten Feld verglichen. Ist kein weiteres Feld in der Sortierrei­ +henfolge angegeben, wird der Vergleich an dieser Stelle mit einem +zufälligen Ergebnis abgebrochen, das heißt, es kann nicht vorher­ +gesagt werden, welcher der beiden Sätze zuerst kommt. + Die Sortierreihenfolge können Sie in einer Menüauswahl einge­ +ben. Kreuzen Sie die Felder an, die Sie vergleichen wollen und ach­ +ten Sie auf die richtige Reihenfolge. Die eingegebene Reihenfolge +wird in der Datei gespeichert, um beim nächsten Sortiervorgang +wiederverwendet zu werden. + Nachdem Sie alle bei der Sortierung zu berücksichtigenden +angekreuzt haben, werden Sie für jedes dieser Felder gefragt, ob +nach dem Feld aufsteigend oder absteigend sortiert werden soll. + +#on("b")#Ablauf#off("b")# Der Ablauf des Sortierens wird durch Ausgabe von +Satz­ +nummern dargestellt. Bis zur ausgegebenen Satznummer sind alle +Sätze richtig sortiert. Bei Bedarf kann der Vorgang durch SV und +dann 'halt' abgebrochen werden. Die Datei bleibt dabei auf jeden +Fall intakt. + +#on("b")#Optimierung#off("b")# Die gespeicherte Sortierreihenfolge wird auch +noch zu +einer weiteren Optimierung benutzt. Wenn eine Datei sortiert war +und nur wenige Änderungen stattgefunden haben, brauchen beim +nächsten Sortiervorgang nur die wenigen veränderten Sätze einzeln +einsortiert zu werden. Das funktioniert natürlich nur unter der +Voraussetzung, daß die gleiche Sortierreihenfolge gewählt wird. Das +Sortieren braucht in diesem Fall erheblich weniger Zeit. + +#on("b")#Probleme#off("b")# Normalerweise werden die einzelnen Felder nach +dem +EUMEL-Zeichencode verglichen. Das bedeutet, daß sich die Reihen­ +folge der Zeichen nach dem EUMEL-Zeichencode richtet. Ein Zeichen +mit einem höheren Code wird also vor einem Zeichen mit einem +niedrigeren Code einsortiert. + In manchen Fällen ergeben sich mit diesem Vergleichsverfahren +aber auch Schwierigkeiten. Wenn in einem Feld Zahlen oder DM- +Beträge stehen, führt die Methode zu falschen Ergebnissen. Die '10' +wird zum Beispiel vor der '2' einsortiert. Warum? Texte werden +immer linksbündig geschrieben und verglichen. Bei Zahlen richtet +sich die Wertigkeit jedoch nach dem Abstand vom Komma. + Da bei Texten zuerst das erste Zeichen verglichen wird, ent­ +steht hier durch Vergleich von '1' und '2' der Eindruck, die '10' +käme vor der '2'. Korrigieren könnte man dies, indem man ein Leer­ +zeichen vor die '2' schreibt. Wenn also die (nicht geschriebenen) +Dezimalkommata direkt untereinanderstehen, werden Zahlen richtig +verglichen. + +#on("b")#Typ ZAHL#off("b")# EUDAS hat jedoch eine bequemere Art, dieses +Problem zu +behandeln. Ein Feld, das Zahlen enthalten soll, bekommt einen spe­ +ziellen Typ ZAHL zugewiesen, der zu einer richtigen Sortierung +führt. + Bei Feldern vom Typ ZAHL ignoriert EUDAS bei Vergleichen alle +nichtnumerischen Zeichen und vergleicht den Wert der Zahl. So +können Sie zum Beispiel in einem Satz '2,50 DM' und im anderen +Satz '10 DM' eintragen - EUDAS kann jetzt die richtige Reihenfolge +feststellen. + Übrigens: falls Sie numerische Werte lieber mit einem Dezi­ +malpunkt statt einem Dezimalkomma schreiben, können Sie EUDAS +das mit dem ELAN-Kommando + + + dezimalkomma (".") + + +mitteilen. Wenn Sie ein solches Kommando eingeben wollen, können +Sie im EUDAS-Menü ESC ESC drücken. In der Statuszeile erscheint +dann die Aufforderung: + + + Gib Kommando: + + +Hier können Sie wie im Editor oder im EUMEL-Monitor ein beliebiges +Kommando eingeben und ausführen. + Die Normaleinstellung für das Dezimalkomma erreichen Sie +wieder durch das Kommando + + + dezimalkomma (",") + + + +#on("b")#Typ ändern#off("b")# Die Feldtypen sind eine permanente Eigenschaft +einer +EUDAS-Datei. Beim Einrichten einer neuen Datei wird zunächst der +Standardtyp für alle Felder genommen. Sie erhalten jedoch Gelegen­ +heit, abweichende Feldtypen zu vergeben, wenn Sie die Frage + +___________________________________________________________________________________________ + + Feldnamen oder Feldtypen ändern (j/n) ? +___________________________________________________________________________________________ + + +bejahen. + Auch nachträglich können Sie die Feldtypen noch ändern. Dies +geschieht mit der Funktion +#free (0.2)# + + F Feldstrukt. + +#free (0.2)# +im Menü 'Öffnen'. Zunächst werden Sie gefragt, ob Sie noch weitere +Feldnamen anfügen wollen. So könnten Sie die Datei um weitere +Felder ergänzen, die bei allen Sätzen zunächst leer sind. Die neuen +Felder müssen Sie wie beim Einrichten der Datei untereinander im +Editor schreiben. + Als zweites erscheint dann die gleiche Frage wie oben. Wenn +Sie diese bejahen, wird Ihnen eine Auswahl der zu ändernden Fel­ +der mit Feldnamen und den zugehörigen Feldtypen angeboten. Kreu­ +zen Sie hier die Felder an, deren Feldtypen Sie ändern möchten. + Da Sie mit dieser Funktion sowohl Feldnamen als auch Feld­ +typen verändern können, wird Ihnen für jedes Feld zunächst der +Name zum Ändern angeboten. Sie können den Namen korrigieren oder +überschreiben. Die Namensänderung hat jedoch keine Auswirkung +auf den Feldinhalt! + Wenn Sie den Namen nicht ändern wollen, drücken Sie einfach +RETURN. Anschließend können Sie für das Feld den neuen Feldtyp +angeben. Tippen Sie einen der vier Feldtypen als Text ein und +drücken Sie RETURN. Anschließend hat das Feld einen neuen Typ. +Die verschiedenen möglichen Typen werden jetzt genau erklärt. + +#on("b")#Feldtypen#off("b")# TEXT ist der Standardtyp, der die Feldinhalte +nach +EUMEL-Zeichencode vergleicht. Den Typ ZAHL hatten wir schon +weiter oben kennengelernt. Daneben gibt es noch den Typ DATUM. + Dieser Typ vergleicht Daten der Form 'tt.mm.jj'. Soll ein sol­ +ches Datum richtig einsortiert werden, müßte es anderenfalls in der +Reihenfolge umgedreht werden (also 'jj.mm.tt'). Dies ist aber nicht +nötig, wenn das Feld den Typ DATUM bekommt. Beachten Sie, daß +alle Inhalte, die nicht die beschriebene Form haben, als gleich be­ +trachtet werden. + Der letzte Typ ist DIN. Dabei werden Texte nach DIN 5007 ver­ +glichen. Das bedeutet, daß Groß- und Kleinbuchstaben als gleich +angesehen werden, daß alle nichtalphabetischen Zeichen ignoriert +werden und die Umlaute ihren richtigen Platz bekommen (Umlaute +werden in normalen Texten hinter allen anderen Zeichen einsor­ +tiert). Da hierfür ein relativ großer Zeitaufwand notwendig ist, +sollte dieser Typ nur dann gewählt werden, wenn er erforderlich ist. +Den schnellsten Vergleich ermöglicht der Typ TEXT. + +#on("b")#Hinweis#off("b")# Beachten Sie, daß mit der Vergabe von Feldtypen +keine +Überprüfung der Eingabe verbunden ist. Insbesondere beim Datum +wird nicht geprüft, ob die Form 'tt.mm.jj' eingehalten wurde. Wollen +Sie solche Überprüfungen vornehmen, lesen Sie bitte Abschnitt 11.3. + + +11.2 Kopieren + +In diesem Abschnitt sollen Sie erfahren, wie Sie eine EUDAS-Datei +#on("i")#kopieren#off("i")# können. Diese Funktion kann nicht nur ein inhaltsgleiches +Duplikat einer EUDAS-Datei herstellen (dies könnten Sie einfacher +durch eine logische Kopie bewerkstelligen, s. 16.1), sondern auch +komplizierte Umstrukturierungen vornehmen. + +#on("b")#Kopiermuster#off("b")# Der Schlüssel zu dieser Leistungsfähigkeit +ist das +#on("i")#Kopiermuster#off("i")#. Wie beim Druckmuster legen Sie dadurch die genauen +Auswirkungen der Funktion fest. + Für jedes Feld in der Zieldatei, in die kopiert werden soll, +enthält das Kopiermuster die Angabe, woraus der Inhalt dieses +Feldes entstehen soll. Durch Auswahl und Reihenfolge dieser Anga­ +ben bestimmen Sie die Struktur der Zieldatei. + Im einfachsten Fall sieht die Kopieranweisung für ein Feld wie +folgt aus: + + + "Feldname" K f ("Feldname"); + + +Das 'K' dient zur Festlegung der Kopierfunktion. Auf der linken +Seite steht in Anführungsstrichen der Name des Zielfeldes. Der +Ausdruck auf der rechten Seite gibt den zukünftigen Inhalt des +Feldes an. Der Ausdruck im obigen Beispiel steht einfach für den +Inhalt des Feldes 'Feldname' in der aktuellen Datei. Das Semikolon +am Ende dient zur Abgrenzung, da der ganze Ausdruck auch mehrere +Zeilen lang sein darf. + In der oben genannten Form würde das Feld 'Feldname' iden­ +tisch in die Zieldatei kopiert. Weitere Möglichkeiten besprechen wir +später. + +#on("b")#Feldreihenfolge#off("b")# Zunächst wollen wir uns damit befassen, +wie Sie +die Feldreihenfolge in der Zieldatei beeinflussen können. Dies ge­ +schieht einfach dadurch, daß Sie die Kopieranweisungen in der ge­ +wünschten Reihenfolge aufschreiben. Damit können wir bereits ein +erstes komplettes Beispiel betrachten: + + + "Name" K f ("Name"); + "Vorname" K f ("Vorname"); + "PLZ" K f ("PLZ"); + "Ort" K f ("Ort"); + "Strasse" K f ("Strasse"); + "m/w" K f ("m/w"); + + +Dieses Kopiermuster würde die bereits beschriebene Adressendatei +identisch kopieren, da alle Felder in der gleichen Reihenfolge vor­ +kommen. + Wenn Sie jedoch die Feldreihenfolge ändern wollen (um zum +Beispiel ein anderes Feld als erstes zu optimieren), brauchen Sie +bloß die Reihenfolge im Kopiermuster zu verändern: + + + "Ort" K f ("Ort"); + "Name" K f ("Name"); + "Vorname" K f ("Vorname"); + "PLZ" K f ("PLZ"); + "Strasse" K f ("Strasse"); + "m/w" K f ("m/w"); + + +Im Gegensatz zur Auswahl der Feldreihenfolge für die Anzeige än­ +dern Sie so die Feldreihenfolge für die Zieldatei permanent. + +#on("b")#Felder anfügen#off("b")# Die beiden angegebenen Kopiermuster haben +jedoch +nur dann die beschriebene Wirkung, wenn die Zieldatei noch nicht +existert. Bei einer existierenden Datei kann die Feldreihenfolge +nicht mehr geändert werden; daher hat die Reihenfolge der Kopier­ +anweisungen dann keine Wirkung. + Sie können jedoch zu einer existierenden Zieldatei noch Felder +hinzufügen. EUDAS verwendet nämlich folgende einfache Vorschrift: + +#limit (12.0)# + Wenn als Zielfeld in einer Kopieranweisung ein Feld + genannt wird, das in der Zieldatei noch nicht vorkommt, + wird es als weiteres Feld der Zieldatei hinzugefügt. +#limit (13.5)# + +Diese Strategie hat im Fall der nicht existierenden Datei zur Folge, +daß alle Felder neu sind und in der Reihenfolge ihres Auftretens +eingerichtet werden. Existiert die Datei schon, werden zusätzliche +Felder am Ende angefügt. + Beachten Sie, daß zusätzliche Felder für eine existierende +Datei nur in den neu hinzukopierten Sätzen gefüllt sind. In den +alten Sätzen bleiben alle neuen Felder einfach leer. + +#on("b")#Satzauswahl#off("b")# An dieser Stelle sollte erwähnt werden, daß +wie bei +allen Funktionen, die die gesamte Datei betreffen, nur die durch die +Suchbedingung ausgewählten Sätze kopiert werden. Ist mindestens +ein Satz markiert, werden nur die markierten Sätze kopiert und die +Suchbedingung ignoriert. + +#on("b")#Teildatei#off("b")# Jetzt können Sie auch die zweite wichtige +Aufgabe des +Kopierens verstehen. Sie können aus einer Datei einen Teil der +Sätze und einen Teil der Felder #on("i")#herausziehen#off("i")#. Danach haben Sie +unter Umständen eine wesentlich kleinere Datei, die sich auch +schneller bearbeiten läßt. Gerade wenn Sie nicht den allerneuesten +64-Bit-Supercomputer haben, können Sie so viel Zeit sparen, wenn +Sie wiederholt nur mit einem Teil der Datei arbeiten müssen. + Die Auswahl der Sätze für einen solchen Zweck erfolgt über ein +Suchmuster; im Kopiermuster geben Sie dann nur die gewünschten +Felder an. + +#on("b")#Aufruf#off("b")# An dieser Stelle wollen wir jetzt endlich +behandeln, wie +Sie die Kopierfunktion aufrufen. Dazu gibt es die Auswahl +#free (0.2)# + + Satzauswahl + K Kopieren + +#free (0.2)# +im Menü "Gesamtdatei". Als erstes werden Sie nach dem Namen der +Zieldatei gefragt. Existiert die Zieldatei schon und war sie vorher +sortiert, werden Sie gefragt, ob Sie die Datei zum Schluß wieder +sortieren wollen. Wie immer beim Sortieren werden auch hier gege­ +benenfalls nur die neu hinzugekommenen Sätze einsortiert. + Als nächstes müssen Sie den Namen des Kopiermusters angeben. +Da das Kopiermuster eine normale Textdatei ist, können Sie sich +einen beliebigen Namen ausdenken, unter dem das Muster dann +gespeichert wird. + Wollen Sie das Kopiermuster nicht aufbewahren, sondern nur +einmal verwenden, brauchen Sie keinen Namen anzugeben. Drücken +Sie einfach RETURN und für die Dauer des Kopierens wird das +Kopiermuster als unbenannte Datei eingerichtet. + Nachdem Sie den Namen des Kopiermusters eingegeben haben, +gelangen Sie in den Editor, wo Sie das Muster ändern können. Damit +Sie beim ersten Mal nicht so viel tippen müssen, bietet EUDAS Ihnen +bei einer neuen Musterdatei ein #on("i")#Standard-Kopiermuster#off("i")# zum Ändern +an. Das Aussehen des Standard-Kopiermusters richtet sich danach, +ob die Zieldatei schon existiert oder nicht. + Existiert die Zieldatei noch nicht, so werden im Standard- +Kopiermuster alle Felder der Ausgangsdatei in ihrer originalen Rei­ +henfolge angegeben. Wenn Sie dieses Muster nicht noch ändern, wird +die aktuelle Datei identisch kopiert. + Sie können jedoch die Feldreihenfolge verändern oder Felder +weglassen, indem Sie einfach die entsprechenden Zeilen vertauschen +oder löschen. Für Umbenennungen überschreiben Sie einfach den +Namen auf der linken Seite der Kopieranweisung. So können Sie das +Kopiermuster mit geringstem Aufwand erstellen. + Existiert die Zieldatei jedoch schon, werden Ihnen im Kopier­ +muster alle Felder der Zieldatei angeboten. Bei Feldern, die in der +aktuellen Datei nicht vorkommen, erscheint folgende Anweisung: + + + "Anrede" K ""; + + +Obwohl die Anweisung in diesem Fall keine Wirkung hat (wenn man +sie wegließe, würde das Feld ebenfalls leer bleiben), ist sie dennoch +aufgeführt, damit Sie auf der rechten Seite einen entsprechenden +Ausdruck einsetzen können. + Bei den angebotenen Anweisungen hat eine Änderung der Rei­ +henfolge oder eines Feldnamens keinen Sinn, da diese Felder ja alle +bereits existieren. Jedoch können Sie die Ausdrücke auf der rechten +Seite variieren und neue Anweisungen (Felder) hinzufügen. + +#on("b")#Ablauf#off("b")# Wenn Sie die Eingabe des Kopiermusters mit ESC 'q' +verlas­ +sen, wird das Kopiermuster übersetzt. Dabei können Fehlermeldun­ +gen auftreten. Sie können dann die Fehler korrigieren, wobei Sie die +Fehlermeldungen gleichzeitig auf dem Bildschirm sehen können. War +das Kopiermuster korrekt, werden alle ausgewählten (bzw. markier­ +ten) Sätze der aktuellen Datei in die Zieldatei kopiert und diese +anschließend gegebenenfalls noch sortiert. + Die kopierten Sätze werden jeweils am Ende der Zieldatei ange­ +fügt. War die Zieldatei vorher schon sortiert, können Sie angeben, +daß die neuen Sätze zum Schluß noch einsortiert werden. Anderen­ +falls können Sie die Datei anschließend mit der Funktion 'Sortieren' +sortieren. + +#on("b")#ELAN-Ausdrücke#off("b")# Wenn Sie schon einmal programmiert haben, +wird +Ihnen vielleicht aufgefallen sein, daß ein Kopiermuster einem +ELAN-Programm verdächtig ähnlich sieht. Diese Vermutung trügt Sie +nicht. Dies läßt den Schluß zu, daß Sie noch mehr ELAN hier an­ +bringen können. + Haben Sie noch nie programmiert, sollten Sie jetzt nicht in +Panik geraten, denn das Wichtigste dieses Abschnitts haben Sie +bereits gelernt. Vielleicht sind Ihnen die folgenden Beispiele bereits +ganz nützlich. Um alle Möglichkeiten auszunutzen, sollten Sie sich +aber irgendwann (später!) mit den Kapiteln 14 und 15 befassen, in +denen Sie Genaueres erfahren. + Zunächst sei festgestellt, daß der rechte Teil einer Kopieran­ +weisung ein beliebiger ELAN-Ausdruck sein kann, der einen TEXT +liefert. Den wichtigsten Ausdruck kennen Sie bereits: + + + f ("Feldname") + + +liefert den Inhalt des Feldes 'Feldname' des aktuellen Satzes der +aktuellen Datei. Gibt es das Feld nicht, erscheint eine Fehlermel­ +dung bei der Ausführung. + Sie können jedoch auch einen konstanten Text angeben, der +dann für alle Sätze gleich ist. Dazu schließen Sie den Text einfach +in Anführungsstriche ein. Die folgende Kopieranweisung dient dazu, +ein neues Feld einzurichten, das aber vorläufig noch leer bleiben +soll: + + + "Feldname" K ""; + + +Ebenso können Sie mehrere Felder zu einem neuen verbinden, zum +Beispiel: + + + "Wohnort" K f ("PLZ") + " " + f ("Ort"); + + +Das Pluszeichen kennzeichnet die Aneinanderreihung von zwei Tex­ +ten. Denken Sie auch immer an das Semikolon am Ende. In gleicher +Weise können Sie viele andere Textfunktionen verwenden, die in +Kapitel 14 beschrieben sind. + Prinzipiell können Sie auch Bedingungen mit IF abfragen, wie +zum Beispiel in der folgenden Übersetzung: + + + IF f ("m/w") = "w" THEN + "Anrede" K "Frau" + ELSE + "Anrede" K "Herr" + END IF; + + +Auf diese Weise können Sie Kodierungen verschiedenster Art auto­ +matisch umsetzen. Sie müssen hierbei jedoch unbedingt darauf ach­ +ten, daß innerhalb der IF-Konstruktion immer eine Kopieranweisung +ausgeführt wird. Falls nämlich kein Fall zutrifft und für ein Feld +keine Kopieranweisung ausgeführt wird, wird das Feld bei einer +neuen Datei auch nicht richtig eingerichtet. + + +11.3 Tragen + +In Kapitel 6 hatten Sie gesehen, wie man einzelne Sätze aus der +aktuellen Datei in eine andere trägt, und auch, wie man sie wieder +zurückholen kann. Diese Funktion diente im wesentlichen dazu, +nicht mehr benötigte Sätze zu entfernen. + Sie haben aber auch die Möglichkeit, eine ganze Reihe von +Sätzen in einem Arbeitsgang zu tragen, nämlich alle durch das +Suchmuster ausgewählten beziehungsweise alle markierten Sätze. +Diese Funktion dient ebenfalls dazu, Sätze zu entfernen, beispiels­ +weise alle Sätze, die vor einem gewissen Stichtag liegen. Als wei­ +tere Anwendung können Sie beim Tragen aber auch Bedingungen +überprüfen. + Diese #on("i")#Prüfbedingungen#off("i")# sollen sicherstellen, daß die Daten in +einer Datei ganz bestimmten Richtlinien entsprechen. Zum Beispiel +kann geprüft werden, ob ein eingegebenen Datum stimmen kann, ob +ein Satz doppelt aufgenommen wurde oder ob eine Artikelnummer die +richtige Anzahl von Stellen hat. + Die Prüfbedingungen werden einer Datei fest zugeordnet. Sie +können mit der Funktion +#free (0.2)# + + P Prüfbed. + +#free (0.2)# +im Menü 'Öffnen' eingegeben oder geändert werden. Die Prüfbedin­ +gungen werden als Text im Editor geschrieben. + +#on("b")#Ablauf#off("b")# Das ganze Verfahren läuft nun so ab: Sie fügen neue +Sätze +immer erst in eine Zwischendatei ein, die die gleiche Struktur wie +die eigentliche Datei hat. Wenn Sie alle Sätze fertig eingegeben +haben, tragen Sie diese Datei komplett in die gewünschte Datei. +Dabei werden die Prüfbedingungen getestet. + Erfüllt ein Satz die Bedingungen, wird er anstandslos getragen. +Trifft eine Bedingung aber nicht zu, bleibt der Satz in der Zwi­ +schendatei und eine entsprechende Meldung wird ausgegeben. Die +Meldungen werden gespeichert, um Sie später nochmal abrufen zu +können. + Sie müssen jetzt in der Zwischendatei die notwendigen Ände­ +rungen durchführen, damit die Prüfbedingungen erfüllt werden. Beim +Aufruf der Funktion +#free (0.2)# + + A Ändern + +#free (0.2)# +können Sie mit Hilfe der Tastenkombination ESC 'P' (großes P) die +Datei mit den Fehlermeldungen in einem kleinen Teilfenster editie­ +ren. Anhand dieser Hinweise können Sie dann den Satz korrigieren. +Die Meldungen bleiben bis zum nächsten Öffnen oder Tragen erhal­ +ten. + Nach der Korrektur können Sie den gleichen Vorgang erneut +aufrufen - es sind ja nur noch die zuerst fehlerhaften Sätze in der +Zwischendatei. Bei Bedarf können Sie diesen Vorgang wiederholen, +bis alle Sätze korrekt übernommen worden sind. + +#on("b")#Aufruf#off("b")# Das Tragen wird aufgerufen durch die Funktion +#free (0.2)# + + Satzauswahl + T Tragen + +#free (0.2)# +Nach Eingabe des Zieldateinamens müssen Sie noch angeben, ob Sie +die Prüfbedingungen testen wollen. + +#on("b")#Prüfbedingungen#off("b")# Zu diskutieren bleibt noch die Form der +Prüfbe­ +dingungen. Diese stellen ein kleines ELAN-Programm dar, in dem +einige spezielle Prozeduren zum Prüfen enthalten sind. Wenn Sie +nicht ELAN programmieren können, sollte Sie diese Bemerkung nicht +erschrecken: die Prüfbedingungen sind einfach genug. + Sie schreiben also die Prüfbedingungen jeweils untereinander. +Eine mögliche Bedingung ist + + + wertemenge ("Feldname", "Wert1,Wert2,Wert3,Wert4"); + + +Diese Bedingung gibt an, daß das Feld einen der angegebenen Werte +haben muß. Die Werte werden untereinander durch Komma getrennt. +Es gibt jedoch keine Möglichkeit, Werte mit Komma darzustellen, da +das Komma immer als Trennung wirkt. Leerzeichen dürfen in den +Werten vorkommen, sie müssen dann aber auch genau so im Feld +stehen. + Wir könnten zum Beispiel eine Bedingung für unser Feld 'm/w' +wie folgt formulieren + + + wertemenge ("m/w", "m,w"); + + +EUDAS würde sich dann beschweren, wenn das Feld leer wäre (ir­ +gendein Geschlecht muß die Person ja wohl haben). Wenn das Feld +auch leer sein darf, geben Sie einfach zwei Kommata hintereinander +oder ein Komma am Anfang an: + + + wertemenge ("m/w", ",m,w"); + + +Eine andere Möglichkeit der Prüfbedingung besteht darin, eine +Maske für ein Feld zu definieren. Diese Maske gibt an, daß an be­ +stimmten Stellen des Feldes nur bestimmte Zeichen stehen dürfen. +So könnte man zum Beispiel folgende Maske für ein Datumsfeld +angeben: + + + feldmaske ("Datum", "99.99.99"); + + +Die Neunen haben hier eine spezielle Bedeutung und und stehen für +eine beliebige Ziffer. Es gibt noch einige weitere Zeichen, die eine +reservierte Bedeutung haben, nämlich: + + + '9' für jede Ziffer (wie schon erwähnt) + 'X' für jedes Zeichen + 'A' für jeden Großbuchstaben + 'a' für jeden Kleinbuchstaben + '*' für eine Folge beliebiger Zeichen + + +Alle anderen Zeichen im Muster stehen für sich selbst. Eine Sonder­ +stellung besitzt der Stern; er sollte sparsam verwendet werden, da +seine Benutzung etwas aufwendiger ist. Der Stern kann auch für +eine leere Zeichenfolge stehen. Als weiteres Beispiel könnte man +definieren + + + feldmaske ("Name", "A*"); + + +damit immer ein Name angegeben ist, der noch dazu mit einem Groß­ +buchstaben beginnt. + Für Bedingungen, die sich nicht mit diesen beiden Prozeduren +formulieren lassen, gibt es noch + + + pruefe ("Feldname", Bedingung); + + +Diese Prozedur erhält einen logischen (booleschen) Wert als Parame­ +ter, der einen Vergleich darstellt. Ist dieser Parameter falsch +(FALSE), wird eine entsprechende Fehlermeldung protokolliert. So +könnte man folgende Bedingung angeben: + + + pruefe ("Alter", wert ("Alter") > 18.0); + + +Diese Bedingung würde sicherstellen, daß alle Personen in der Datei +volljährig sind ('wert' ist eine von EUDAS definierte Funktion, die +den Inhalt eines Feldes als REAL-Zahl liefert - denken Sie auch +daran, daß der ELAN-Compiler Zahlen mit Dezimalpunkt geschrieben +haben möchte). + Da die Prüfbedingungen ein ELAN-Programm sind, können Sie +natürlich sämtliche ELAN-Anweisungen verwenden. + Weiterhin haben Sie die Möglichkeit, Doppeleinträge zu verhin­ +dern. Dazu geben Sie mit Hilfe der Prozedur + + + eindeutige felder (n); + + +wieviele Felder vom ersten an eindeutig sein sollen. Ein zu tragen­ +der Satz, der mit irgendeinem anderen Satz in diesen Feldern über­ +einstimmt, wird als fehlerhaft zurückgewiesen. In unserer Adressen­ +datei könnte man + + + eindeutige felder (2); + + +angeben. Damit würde ein neuer Satz mit bereits vorhandenem Na­ +men und Vornamen abgelehnt. + +#on("b")#Limit#off("b")# Aus technischen Gründen können die Prüfbedingungen +einer +Datei nur 2000 Zeichen umfassen. Wollen Sie aufwendigere Bedin­ +gungen konstruieren, sollten Sie sich diese als Prozedur definieren +und insertieren. In den Prüfbedingungen müssen Sie dann nur diese +Prozedur aufrufen. + + +11.4 Automatische Änderungen + +Mit EUDAS können Sie die geöffnete Datei nicht nur satzweise von +Hand ändern, sondern auch automatisch die ganze Datei. Dazu müs­ +sen Sie dem Rechner eine Vorschrift geben, nach der er handeln +kann. Ein solches #on("i")#Änderungsmuster#off("i")# stellt im Prinzip schon ein klei­ +nes Programm dar. Der Änderungsvorgang wird durch die Auswahl +#free (0.2)# + + V Verändern + +#free (0.2)# +aufgerufen. Dabei wird der Name des Änderungsmusters erfragt. Dies +ist eine normale Textdatei. Existiert das Muster noch nicht, können +Sie den Inhalt an dieser Stelle im Editor angeben. Anschließend +werden alle ausgewählten Sätze nach der Vorschrift bearbeitet. +Dabei wird jeweils die aktuelle Satznummer ausgegeben. + +#on("b")#Änderungsmuster#off("b")# Da auch ein Kopiermuster ein Programm ist, +ist +es nicht erstaunlich, daß Änderungsmuster ganz ähnlich aussehen. +Eine typische Zeile sieht etwa so aus: + + + "Feldname" V "neuer Inhalt"; + + +Diese Zeile bedeutet: Ersetze den Inhalt des Feldes 'Feldname' +durch den Text 'neuer Inhalt'. Anstelle des neuen Textes kann +wieder ein beliebiger ELAN-Ausdruck stehen. Ein Beispiel, in dem +ein Feld einen Stern angehängt bekommt, sieht dann so aus: + + + "Feldname" V f ("Feldname") + "*"; + + +Beachten Sie, daß Sie den Ausdruck auf der rechten Seite eventuell +in Klammern setzen müssen (obwohl der Operator 'V' die niedrigste +Priorität hat). Wenn Sie sich nicht sicher sind, können Sie den Aus­ +druck immer in Klammern einschließen. + Ebenso wie im Kopiermuster können Sie hier beliebige ELAN- +Ausdrücke verwenden. Auch IF-Abfragen und ähnliche Konstruktio­ +nen sind möglich, im Gegensatz zum Kopiermuster sogar ohne Be­ +schränkungen. + Im Vergleich zu einem separat geschriebenen ELAN-Programm +hat das Änderungsmuster den Vorteil, daß Sie nur die eigentlichen +Veränderungsanweisungen kodieren müssen. Die wiederholte Anwen­ +dung auf die ausgewählten Sätze erledigt EUDAS automatisch. Wol­ +len Sie eine solche Änderungsanweisung fest insertieren, so brau­ +chen Sie das Muster nur in eine Prozedur zu verpacken und EUDAS +zu übergeben (Näheres s. Referenzhandbuch). + diff --git a/app/eudas/4.3/doc/eudas.hdb.12 b/app/eudas/4.3/doc/eudas.hdb.12 new file mode 100644 index 0000000..fba5ca5 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.12 @@ -0,0 +1,446 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (123)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +12 Weitere Möglichkeiten zum Drucken + + + +12.1 Anschluß an die Textverarbeitung + +Auf zweierlei Art und Weise kann der EUDAS-Druckgenerator mit +den Programmen der EUMEL-Textverarbeitung zusammenarbeiten. +Zum ersten können Ausgabedateien des Druckprozesses anschließend +mit den Textkosmetik-Werkzeugen bearbeitet werden. Zum anderen +kann EUDAS im Editor direkt Daten aus einer EUDAS-Datei in die +editierte Datei importieren. + +#on("b")#Druckrichtung#off("b")# Wie Sie schon in Kapitel 7 gesehen haben, +kann +man die Ausgabe des Druckgenerators statt auf den Drucker in eine +Datei umleiten. Die Datei erhält dann einen automatisch generierten +Namen. Sie können jedoch auch festlegen, daß die Ausgabe in eine +ganz bestimmte Datei geschrieben werden soll. Dazu wählen Sie die +Funktion + + + Ausgabe + R Richtung + + +im Druckmenü. Es erscheint die Frage + +___________________________________________________________________________________________ + + Ausgabe automatisch zum Drucker (j/n) ? +___________________________________________________________________________________________ + + +Verneinen Sie die Frage und es erscheint + +___________________________________________________________________________________________ + + Ausgabe in bestimmte Datei (j/n) ? +___________________________________________________________________________________________ + + +Wenn Sie diese Frage auch verneinen, erhält die Ausgabedatei einen +automatisch generierten Namen. Wenn Sie die Frage aber bejahen, +können Sie anschließend den Namen der Ausgabedatei angeben. + Existiert die angegebene Datei schon, wird der Ausdruck am +Ende der Datei angefügt. Anderenfalls wird die Datei neu eingerich­ +tet. + Die Angabe der Ausgabedatei gilt jedoch nur für den folgenden +Druckvorgang. Wenn Sie mehrmals in die gleiche Datei drucken wol­ +len, müssen Sie den Namen immer wieder neu angeben. Falls Sie dies +vergessen, wird die folgenden Male wieder ein Name automatisch +generiert. + +#on("b")#Begrenzung der Dateigröße#off("b")# Für kleinere Systeme ist es +vorteilhaft, +wenn die Druckausgabe nicht in einer großen Datei gesammelt wird, +sondern sich auf mehrere kleine Dateien verteilt. Da die Ausgabe­ +datei nach dem Drucken gelöscht wird, kann man auf diese Weise +einen Hintergrundengpaß vermeiden. Es besteht die Möglichkeit, die +maximale Größe der Ausgabedatei mit dem ELAN-Kommando + + + maxdruckzeilen (1000) + + +auf eine bestimmte Zeilenzahl (maximal 4000) zu beschränken. Wenn +der Druckgenerator nach der Bearbeitung eines Satzes feststellt, +daß diese Maximalzahl überschritten wurde, wird die Ausgabedatei +direkt gedruckt (falls durch 'Richtung' eingestellt) und eine neue +Ausgabedatei eröffnet. + +#on("b")#Initialisierungsteil#off("b")# Dabei ist jedoch zu beachten, daß +Drucker­ +steuerungsanweisungen, die im Vorspann eingestellt wurden, jetzt in +der neuen Datei nicht mehr vorhanden sind. In einem solchen Fall +würden die folgenden Teile der Ausgabe mit einer anderen Einstel­ +lung gedruckt. + Um dies zu vermeiden, können Sie solche Anweisungen in den +#on("i")#Initialisierungsteil#off("i")# schreiben. Der Initialisierungsteil umfaßt alle +Zeilen des Druckmusters bis zum ersten Abschnitt, also bis zur +ersten Anweisung. Zeilen im Initialisierungsteil werden beim Eröff­ +nen einer neuen Ausgabedatei an den Anfang dieser Datei ge­ +schrieben. + Druckersteuerungsanweisungen, die ein bestimmtes Schriftbild +der Ausgabe erzeugen ('type', 'limit', 'linefeed', 'start' usw.), sollten +also in den Initialisierungsteil vor Beginn aller Abschnitte ge­ +schrieben werden. + +#on("b")#Nachbearbeitung#off("b")# Wenn Sie in der Druckausgabe verschiedene +Schriften oder Proportionalschrift verwenden wollen, sollten Sie die +folgenden Hinweise beachten. Da EUDAS keine Informationen über +die Schriftbreiten und -größen hat, werden alle Schrifttypen gleich +behandelt. Dies gilt insbesondere für die Zeilenbreite, die ja durch +das Dateilimit des Druckmusters festgelegt ist. + So kann es passieren, daß Zeilen mit kleinen Schrifttypen zu +früh abgeschnitten werden, während Zeilen mit großen Schriften +nicht mehr auf das Blatt passen. Für diesen Fall sollten Sie das +größte benötigte Limit einstellen (zum Beispiel 135 bei Schmal­ +schrift auf DIN A 4) und die Ausgabedatei anschließend mit 'line­ +form' bearbeiten. + 'lineform' verteilt zu langen Text auf mehrere Zeilen. Außerdem +werden gegebenenfalls Trennungen durchgeführt. + 'lineform' benötigt zur Information Absatzmarken. Fehlt an +einer Zeile die Absatzmarke, wird die nächste Zeile so weit wie +möglich direkt angehängt. Die Absatzmarken in der Ausgabedatei +werden direkt aus dem Druckmuster übernommen (es ist nicht mög­ +lich, Absatzzeilen durch eingesetzte Leerzeichen zu erzeugen). Im +Normalfall sollten alle Zeilen im Druckmuster eine Absatzmarke +haben. + Wenn Sie seitenorientierte Überschriften haben möchten, kön­ +nen Sie auch 'pageform' einsetzen. Die gewünschten Überschrift­ +anweisungen können Sie im Initialisierungsteil angeben. + Die beiden Funktionen wählen Sie über den Menüpunkt + + + N Nachbearb. + + +im Druckmenü. Dort können Sie den Namen der Ausgabedatei ange­ +ben, die Sie bearbeiten möchten. Es wird jeweils gefragt, ob Sie +'lineform' und 'pageform' anwenden wollen. Das Ergebnis der Bear­ +beitung können Sie danach ausdrucken. + +#on("b")#EUDAS im Editor#off("b")# Wenn Sie sich im Editor zum Zweck der +Textver­ +arbeitung befinden, können Sie Daten aus einer EUDAS-Datei direkt +in die editierte Datei übernehmen. Dazu wählen Sie zunächst die +gewünschten Sätze aus - danach geben Sie den Namen eines Druck­ +musters an. EUDAS druckt die gewählten Sätze unter Beachtung des +Druckmusters direkt in die editierte Datei. + Wenn Sie das Kommando + + + eudas + + +im Editor geben (nach ESC ESC), gelangen Sie in ein spezielles +Kurzprogramm, das alle notwendigen Information von Ihnen erfragt. + Zunächst müssen Sie den Namen der gewünschten EUDAS-Datei +angeben. Diese Datei wird dann automatisch geöffnet. Vorher geöff­ +nete Dateien werden nach Anfrage gesichert. Beachten Sie, daß +keine Datei mehr geöffnet ist, wenn Sie später EUDAS wieder normal +aufrufen. + Danach wird Ihnen eine Übersicht aller Sätze gezeigt - in einer +Form, die Sie aus der Funktion 'Übersicht' bereits kennen. Wie dort +wird Ihnen zunächst eine Auswahl der Felder angeboten, um die +Anzeige übersichtlich zu halten. Anschließend können Sie noch ein +Suchmuster angeben. + In der Übersicht können Sie sich dann zu einem bestimmten +Satz bewegen oder mehrere Sätze markieren. Nach dem Verlassen der +Übersicht können Sie den aktuellen Satz oder alle ausgewählten +(bzw. markierten) Sätze drucken. Natürlich können Sie auch beide +Fragen verneinen. + Zum Drucken wird der Name des Druckmusters erfragt. Dieses +muß bereits existieren. Die Ausgabe wird an der Stelle eingefügt, an +der der Cursor in der editierten Datei steht - die Zeile wird bei +Bedarf aufgesplittet. + Nach dem Drucken können Sie den Vorgang wiederholen, wenn +Sie zum Beispiel einen weiteren Satz drucken wollen. Dazu können +Sie auch ein neues Suchmuster angeben. Markierungen von Sätzen +werden nach dem Drucken gelöscht. + + +12.2 Spaltendruck + +Für manche Anwendungen reicht es nicht aus, wenn die bearbeite­ +ten Sätze jeweils untereinander in der Ausgabe erscheinen. Häufig­ +stes Beispiel dafür ist der Etikettendruck. Hierfür werden vielfach +mehrbahnige Formulare eingesetzt. + In diesem Fall müssen die Sätze bis zur gewünschten Anzahl +von Spalten nebeneinander gesetzt werden - erst danach wird die +nächste Reihe angefangen. + EUDAS unterstützt diese Anwendung. Dazu wird hinter der +'%WIEDERHOLUNG'-Anweisung die Anzahl der Spalten als Parameter +geschrieben (durch Leerzeichen getrennt). Der Wiederholungsteil +wird dann mit der angegebenen Anzahl von Spalten gedruckt. Zu +beachten ist, daß Vorspann und Nachspann diese Spaltenanordnung +durchbrechen, also immer hinter dem bisher Gedruckten beginnen. + Die Spaltenbreite wird vom Dateilimit des Druckmusters be­ +stimmt. Die Zeilen eines Wiederholungsteils werden bis zum Limit +mit Leerzeichen aufgefüllt, wenn der nächste Wiederholungsteil +danebengesetzt wird. + Alternativ kann die Spaltenbreite in Zeichen auch als zweiter +Parameter angegeben werden. Der Wert gilt jedoch nur für den Wie­ +derholungsteil - Vor- und Nachspann richten sich immer nur nach +dem Dateilimit. + Es spielt keine Rolle, ob die nebeneinandergesetzten Wieder­ +holungsteile unterschiedliche Längen haben. Die kürzeren Teile +werden einfach bei Bedarf durch Leerzeilen ergänzt. Es ist jedoch zu +beachten, daß sich auf diese Weise unterschiedliche Längen für die +einzelnen Reihen ergeben können. + Beispiel: Das Ergebnis für Satz 1, 3, 4 und 5 sei vier Zeilen +lang, für Satz 2 aber fünf Zeilen. Bei zweispaltigem Druck wird die +erste Reihe eine Zeile länger als die folgenden (s. dazu Abb. 12-1). + + + Satz 1 Satz 2 + braucht braucht + vier Zeilen. ausnahmsweise + ---------------- fünf Zeilen. + ---------------- + Satz 3 Satz 4 + braucht braucht + vier Zeilen. vier Zeilen. + ---------------- ---------------- + Satz 5 + braucht + vier Zeilen. + ---------------- + +#center#Abb. 12-1 Seitenaufteilung beim Spaltendruck + + +#on("b")#Beispiel#off("b")# Zum Abschluß noch als Beispiel ein Druckmuster +für ein +dreibahniges Etikettenformular. Die Spaltenbreite und die Länge des +Wiederholungsteils richten sich natürlich nach dem verwendeten +Formular und müssen im Einzelfall ausprobiert werden. + + + % VORSPANN + \#start (1.0, 0.8)\# + % WIEDERHOLUNG 3 40 + + &Vorname %Name + &Strasse + + &PLZ %Ort + \#free (1.693)\# + + + +12.3 Modi + +Gesetzt der Fall, Sie wollen eine Tabelle drucken, deren Einträge +auf jeden Fall in voller Länge erscheinen sollen, auch wenn sie die +Spaltenbreite überschreiten. Dies würde bedeuten, daß Tabellenein­ +träge nach rechts geschoben werden, wenn vorhergehende Einträge +länger sind. Für diesen Fall können also nur Feldmuster variabler +Position (mit '%') eingesetzt werden. Diese werden jedoch auch nach +links geschoben, wenn vorher kürzere Inhalte auftreten. + +#on("b")#Tabellenmodus#off("b")# Um dieses Linksschieben zu unterdrücken, +können +Sie mit folgender Anweisung im Musterteil in den #on("i")#Tabellenmodus#off("i")# +umschalten: + + + % MODUS 2 + + +Der so eingestellte Modus gilt bis zum Ende des jeweiligen Ab­ +schnitts. Zu Beginn eines Abschnitts ist der Modus 1 (Normalmodus) +eingestellt. + +#on("b")#Beispiel#off("b")# Um diese Anweisung auszuprobieren, sollten Sie +folgendes Druckmuster auf unsere Beispieldatei anwenden: + + + % WIEDERHOLUNG + % MODUS 2 + &Vorname %Name + + +In der Ausgabe können Sie sehen, daß der Nachname nicht nach +links geschoben wird, so daß eine Tabelle entsteht. Ist der Vorname +jedoch zu lang, wird die Tabelleneinteilung durchbrochen und der +Nachname nach rechts geschoben, um den Vornamen nicht abschnei­ +den zu müssen: + + + Herbert Wegner + Helga Sandmann + Albert Katani + Peter Ulmen + Karin Regmann + Hubert Arken + Anna-Maria Simmern + Angelika Kaufmann-Drescher + Harald Fuhrmann + Friedrich Seefeld + + +#on("b")#Zeilenfortsetzung#off("b")# Eine weitere Möglichkeit, überlange +Feldinhalte +einzusetzen, besteht darin, daß der Rest des Inhaltes, der nicht +mehr in den reservierten Raum paßt, in der nächsten Zeile fortge­ +setzt wird. Dies wird im Modus 3 erreicht. Falls ein Feldinhalt ab­ +geschnitten werden müßte, wird in diesem Modus die gleiche Mu­ +sterzeile nochmal mit den restlichen Inhalten gedruckt. Dies wird +fortgesetzt, bis alle Inhalte abgearbeitet sind. + Damit die Fortsetzung sinnvoll ist, wird das letzte Wort ganz in +die nächste Zeile übernommen, falls es zerschnitten würde (ähnlich +wie im Editor). Der dadurch freiwerdende Raum in der vorigen Zeile +wird mit Leerzeichen gefüllt. Ist rechtsbündiges Einsetzen verlangt, +werden die einzelnen Teile jeweils rechtsbündig in ihrem reservier­ +ten Platz justiert. + Dieser Modus ist besonders interessant, wenn Sie längere Kom­ +mentare in eine EUDAS-Datei eintragen, die Sie dann natürlich auch +wieder drucken wollen. Den Text tragen Sie bereits in mehreren +Zeilen in die EUDAS-Datei ein. Beachten Sie, daß der Umbruch des +Textes im Druck nicht mit dem Umbruch des Textes am Bildschirm +übereinstimmt. Wollen Sie dies verhindern, müssen Sie jeden Absatz +des Textes in ein eigenes Feld schreiben. + Wie zu Anfang des Kapitels bereits angedeutet, kann der Um­ +bruch bei Proportionalschrift nicht korrekt sein, da EUDAS die Zei­ +chenbreiten nicht kennt. Um die nachfolgende Bearbeitung mit +'lineform' zu ermöglichen, werden bei fortgesetzten Feldern grund­ +sätzlich keine Absatzmarken an die Zeilen geschrieben. Lediglich die +letzte Fortsetzungszeile erhält eine Absatzmarke. + In den Fortsetzungszeilen, werden die Feldmuster, deren Inhalte +bereits abgearbeitet sind, leer eingesetzt. Die Mustertexte zwischen +den Feldmustern werden in den Fortsetzungszeilen durch Leerzei­ +chen ersetzt. + Die Anzahl der Fortsetzungszeilen kann durch die Anweisung + + + % MEHR n + + +auf eine bestimmte Zahl 'n' festgelegt werden. Wenn alle Inhalte +abgearbeitet wurden, aber die Anzahl der Zeilen noch nicht erreicht +ist, werden entsprechend viele Zeilen mit leeren Inhalten erzeugt. + Die Zeilenwiederholung kann auch mit dem Tabellenmodus kom­ +biniert werden. Dies wird im Modus 4 erreicht. Felder variabler +Position werden auch in diesem Modus nicht nach links geschoben. +Außerdem werden aber in Fortsetzungszeilen die Mustertexte zwi­ +schen den Feldmustern wiederholt, um z.B. Tabellenbegrenzungen zu +erzeugen. + +#on("b")#Beispiele#off("b")# Zur Verdeutlichung hier noch einige Beispiele. +Das folgende Druckmuster: + + + % WIEDERHOLUNG + % MODUS 3 + Kommentar: &Kommentar + ---------- + + +könnte folgende Ausgabe bewirken: + + + Kommentar: Dies ist ein längerer Kommentar aus + einer EUDAS-Datei, der zum Drucken + auf eine Breite von 48 Zeichen + umbrochen worden ist. Nur die letzte + Zeile hat eine Absatzmarke. + ---------- + + +Soll die Anzahl der Zeilen immer gleich bleiben, könnte man folgen­ +des Druckmuster verwenden: + + + % WIEDERHOLUNG + % MODUS 3 + % MEHR 5 + Kommentar: &Kommentar + ---------- + + +Mit einem kürzeren Text ergäbe sich folgendes Bild: + + + Kommentar: Nur ein kurzer Text. + + + + + ---------- + + +Für eine Tabelle würde man den Modus 4 benutzen: + + + % VORSPANN + -------------------------------------------------------- + ! Abk. ! Kommentar ! + !---------+--------------------------------------------! + % WIEDERHOLUNG + % MODUS 4 + ! &abk ! &Kommentar&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! + ----------+--------------------------------------------- + + +Als Ausgabe könnte folgender Text erscheinen: + + + -------------------------------------------------------- + ! Abk. ! Kommentar ! + !---------+--------------------------------------------! + ! MA11 ! Dieser Kurs hat eine Menge an besonderen ! + ! ! Eigenschaften, die ihn für jüngere ! + ! ! Teilnehmer geeignet erscheinen lassen. ! + !---------+--------------------------------------------! + ! TD04 ! Stellt keine besonderen Anforderungen. ! + !---------+--------------------------------------------! + ! PM01 ! Seit dem 01.01. eingerichtet und noch ! + ! ! nicht voll besetzt. ! + ----------+--------------------------------------------- + + +Beachten Sie hier, daß Tabelleneinträge hier nicht wie im Modus 2 +geschoben, sondern auf weitere Zeilen verteilt werden, wenn sie zu +lang sind. Außerdem werden die Tabellenbegrenzungen mit wieder­ +holt. Das Feldmuster für Kommentar muß jedoch mit fester Länge +angegeben werden, da sonst die rechte Tabellenbegrenzung bis zum +Dateilimit geschoben würde. + +#on("b")#Zusammenfassung#off("b")# Zum Abschluß dieses Abschnitts eine +Zusammenfassung aller möglichen Modi: + + Modus Effekt + + 1 Normalmodus. + '%'-Feldmuster werden auch nach links geschoben. + Keine Zeilenwiederholung. + + 2 Tabellenmodus. + '%'-Feldmuster werden nicht nach links geschoben. + Keine Zeilenwiederholung. + + 3 Normalmodus mit Zeilenwiederholung. + '%'-Feldmuster werden auch nach links geschoben. + Zeilenwiederholung ohne Zwischentexte. + + 4 Tabellenmodus mit Zeilenwiederholung. + '%'-Feldmuster werden nicht nach links geschoben. + Zeilenwiederholung mit Zwischentexten. + + diff --git a/app/eudas/4.3/doc/eudas.hdb.13 b/app/eudas/4.3/doc/eudas.hdb.13 new file mode 100644 index 0000000..435fbfc --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.13 @@ -0,0 +1,757 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (133)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +13 Programmierung von Druckmustern + + + +13.1 Abkürzungen + +In den vorigen Kapiteln haben Sie erfahren, daß man Feldmuster +von ganz bestimmter Länge definieren kann, deren Inhalt in genau +dieser Länge eingesetzt und bei Bedarf abgeschnitten wird. Bei der +Angabe dieser Länge spielt jedoch die Länge des Feldnamens eine +ganz entscheidende Rolle. Das kürzeste Feldmuster fester Länge, das +Sie definieren können, ist nämlich zwei Zeichen länger als der Feld­ +name (ein Musterzeichen vorher und eins nachher). + Hätte das Feld 'PLZ' den Namen 'Postleitzahl' bekommen, so +müßte ein solches Feldmuster mindestens eine Länge von 14 Zeichen +haben. Damit Sie mit diesem Feldnamen auch ein Feldmuster der +Länge 4 bekommen können (Postleitzahlen haben in den seltensten +Fällen mehr als 4 Stellen), haben Sie die Möglichkeit, den Namen +'Postleitzahl' für die Verwendung im Druckmuster geeignet abzu­ +kürzen. + Abkürzungen haben jedoch noch eine viel weitreichendere +Bedeutung. Mit ihnen ist es möglich, nicht nur die Feldinhalte einer +EUDAS-Datei einzusetzen, sondern auch jeden anderen Text, den Sie +mit einem ELAN-Programm erzeugen können. + Die einfachsten zusätzlichen Daten, die Sie verwenden können, +sind z.B. Datum und Uhrzeit. Für weitergehende Zwecke können Sie +die Inhalte der EUDAS-Datei auch für Berechnungen verwenden und +damit so umfangreiche Probleme wie das Schreiben von Rechnungen +oder statistische Auswertungen unter Verwendung eines Druck­ +musters lösen. + +#on("b")#Abkürzungsteil#off("b")# Abkürzungen werden in einem speziellen +Abkür­ +zungsteil am Ende eines Abschnittes angegeben. Der Abkürzungsteil +wird durch die Anweisung + + + % ABKUERZUNGEN + + +eingeleitet. Eine Abkürzungsdefinition hat eine ähnliche Form wie +ein Refinement (Falls Sie nicht wissen, was das ist, vergessen Sie +es). Zu Beginn steht der Name der Abkürzung in Form eines Feld­ +musters, beginnend in der ersten Spalte. Danach folgt, durch Leer­ +zeichen getrennt, ein Doppelpunkt in der gleichen Zeile. Daran +schließt sich ein beliebiger ELAN-Ausdruck an, der sich in freiem +Format über beliebig viele Zeilen erstrecken kann und mit einem +Punkt abgeschlossen werden muß. Dieser ELAN-Ausdruck muß ein +TEXT-Objekt liefern. + +#on("b")#Feldinhalt#off("b")# Für die Abfrage von Inhalten aus einer +EUDAS-Datei ist der Ausdruck + + + f ("Feldname") + + +vordefiniert. Die Abkürzung des Feldes 'Postleitzahl' würde also als +Ausschnitt folgendermaßen aussehen: + + + % ABKUERZUNGEN + &p : f ("Postleitzahl") . + + +Mit dieser Definition kann man im Muster so verfahren, als ob das +Feld 'Postleitzahl' auch 'p' hieße. Diese einfachste Form der Ab­ +kürzung können Sie natürlich variieren, indem Sie für 'p' und +'Postleitzahl' Ihre eigenen Namen einsetzen. + +#on("b")#Übersetzung#off("b")# Beachten Sie, daß das Druckmuster in ein +ELAN-Pro­ +gramm umgeformt werden muß, da ELAN-Ausdrücke in ihm vorkom­ +men. Das automatisch erzeugte ELAN-Programm wird dann vom +ELAN-Compiler übersetzt und ausgeführt. Fehler in den ELAN-Aus­ +drücken im Abkürzungsteil können erst vom ELAN-Compiler ent­ +deckt werden. Dieser kennt jedoch das Druckmuster nicht und mel­ +det die Fehler anhand des generierten Programms. Sie müssen in +einem solchen Fall aufpassen, daß Sie die Fehlerquelle an der rich­ +tigen Stelle im Druckmuster lokalisieren (Hilfestellungen dazu sind +im Kapitel über die Übersetzung von Druckmustern zu finden). + +#on("b")#Beispiel#off("b")# Um die Verwendung von Abkürzungen zu +demonstrieren, wollen wir folgendes Druckmuster betrachten: + + + % VORSPANN + Adressenliste als Beispiel für Abkürzungen + Stand: &Datum + ------------------------------------------ + % ABKUERZUNGEN + &Datum : date . + + % WIEDERHOLUNG + &&l : &Vorname %Name + &Strasse + &&p& &Ort + ------------------------------------------ + % ABKUERZUNGEN + &l : lfd nr . + &p : f ("PLZ") . + + % NACHSPANN + &l Adressen gedruckt. + + +Dieses Beispiel enthält eine ganze Reihe interessanter Details. Als +erstes sollten Sie registrieren, daß auch im Vorspann oder Nach­ +spann Feldmuster verwendet werden können. Soll in diesem Fall ein +Feldinhalt aus der EUDAS-Datei eingesetzt werden, so werden beim +Vorspann die Inhalte des ersten und beim Nachspann die Inhalte des +letzten durch Suchmuster ausgewählten Satzes verwendet. Daher +kann auch jeder Abschnitt einen Abkürzungsteil haben. Abkürzun­ +gen gelten jedoch für alle Abschnitte (s. '&l'); die Aufteilung in +mehrere Abkürzungsteile fördert im wesentlichen die Übersichtlich­ +keit. + Versuchen Sie, an diesem Beispiel die wichtigsten Unterschiede +zwischen dem #on("i")#Musterteil#off("i")# und dem #on("i")#Abkürzungsteil#off("i")# eines Abschnittes +zu verstehen. Das Format des Musterteiles soll in die Ausgabe +übernommen werden; daher ist dort die Stellung jedes Wortes wich­ +tig. Im Abkürzungsteil definieren Sie Abkürzungen ohne bestimm­ +tes Format - mit der einzigen Ausnahme, daß eine Abkürzungs­ +definition mit einem '&' in der ersten Spalte anfangen und ein +Leerzeichen vor dem Doppelpunkt haben muß. Wie Sie sehen, dürfen +dort Leerzeilen zur besseren Lesbarkeit eingefügt werden. +Sie sollten bei unserem Beispiel folgende Ausgabe erhalten: + + + Adressenliste als Beispiel für Abkürzungen + Stand: 28.12.84 + ------------------------------------------ + 1 : Herbert Wegner + Krämergasse 12 + 5000 Köln + ------------------------------------------ + 2 : Helga Sandmann + Willicher Weg 109 + 5300 Bonn 1 + ------------------------------------------ + 3 : Albert Katani + Lindenstr. 3 + 5210 Troisdorf + ------------------------------------------ + 4 : Peter Ulmen + Mozartstraße 17 + 5 Köln 60 + ------------------------------------------ + 5 : Karin Regmann + Grengelweg 44 + 5000 Köln 90 + ------------------------------------------ + 6 : Hubert Arken + Talweg 12 + 5200 Siegburg + ------------------------------------------ + 7 : Anna-Maria Simmern + Platanenweg 67 + 5 Köln 3 + ------------------------------------------ + 8 : Angelika Kaufmann-Drescher + Hauptstr. 123 + 53 Bonn 2 + ------------------------------------------ + 9 : Harald Fuhrmann + Glockengasse 44 + 5000 Köln 1 + ------------------------------------------ + 10 : Friedrich Seefeld + Kabelgasse + 5000 Köln-Ehrenfeld + ------------------------------------------ + 10 Adressen gedruckt. + + +Nun zu den Abkürzungen im einzelnen. Das Feld 'PLZ' muß abge­ +kürzt werden, damit es rechtsbündig vor den Ort gedruckt werden +kann. Die Abkürzung 'p' benutzt die im vorigen Kapitel beschriebe­ +ne Form zur Abfrage des Feldinhaltes. + 'Datum' wird als Abkürzung für das aktuelle Datum definiert, +ein häufig benötigter Fall. 'date' ist der ELAN-Ausdruck, der das +Datum liefert. (Bemerkung für ELAN-Programmierer: der Name der +Abkürzung gehorcht nicht der ELAN-Syntax für Bezeichner). + Eine für Tabellen sinnvolle Funktion wird bei der Definition +von 'l' verwendet. Der von EUDAS definierte Ausdruck 'lfd nr' lie­ +fert die laufende Nummer des gerade gedruckten Satzes als Text. +Dabei ist zu beachten, daß die laufende Nummer nicht mit der Satz­ +nummer übereinstimmt, sondern nur während des Druckvorganges +von 1 an bei jedem gedruckten Satz hochgezählt wird. Diese Funk­ +tion dient dazu, die Sätze in der Liste durchzunumerieren. + Die laufende Nummer soll in der Liste rechtsbündig mit Doppel­ +punkt vor dem Namen stehen. Dazu wird das Feldmuster '&&l' be­ +nutzt, eine Form, die eigentlich keinen Sinn hat (die Kombination +'variable Länge' und 'rechtsbündig' gibt es nicht). Um ein möglichst +kurzes Feldmuster schreiben zu können, wird in diesem Fall jedoch +feste Länge unterstellt (auch ohne folgendes '&'). Damit hat das +kürzeste Feldmuster fester Länge drei Zeichen sowohl im linksbün­ +digen ('&l&') wie auch im rechtsbündigen Fall ('&&l'). + +#on("b")#Auswertungen#off("b")# Die Verwendung der Abkürzung 'l' im Nachspann +kann als erstes Beispiel für eine Auswertungsfunktion gelten. Da +für den Nachspann die Daten des letzten Satzes verwendet werden, +erscheint hier die laufende Nummer des letzten Satzes und somit die +Anzahl der Sätze, die gedruckt wurden. Das kann dazu benutzt +werden, die Sätze zu zählen, die eine bestimmte Suchbedingung +erfüllen. Folgendes Druckmuster zählt die Anzahl der Frauen oder +Männer in der Datei: + + + % NACHSPANN + &l Personen mit dem Geschlecht '%' vorhanden. + % ABKUERZUNGEN + &l : lfd nr . + + +Wenn Sie vor dem Drucken jetzt die Suchbedingung 'm' für das Feld +'m/w' einstellen, werden alle Männer ausgewählt. Das Drucken be­ +steht in diesem Fall nur aus dem Hochzählen der laufenden Nummer +für jeden Mann. Im Nachspann kann das Ergebnis dann ausgegeben +werden; zugleich soll der aktuelle Wert des Feldes 'm/w' gedruckt +werden, damit das Druckmuster auch für das Zählen der Frauen +verwendet werden kann. + Die beiden möglichen Ausgaben würden dann so aussehen: + + + 6 Personen mit dem Geschlecht 'm' vorhanden. + + 4 Personen mit dem Geschlecht 'w' vorhanden. + + +#on("b")#Zusammenfassung#off("b")# Wir können die Erkenntnisse dieses +Abschnittes wie folgt zusammenfassen: + +* Feldmuster können auch im Vorspann und Nachspann verwendet + werden. Im Vorspann werden die Daten des ersten, im Nachspann + die Daten des letzten ausgewählten Satzes verwendet. + +* Der Musterteil eines Abschnittes definiert ein Format; der Ab­ + kürzungsteil ist formatfrei. + +* 'lfd nr' dient zum Durchnumerieren aller gedruckten Sätze. + +* Ein rechtsbündiges Feldmuster hat immer auch feste Länge. + +#on("b")#Komplexe Abkürzungen#off("b")# Mit Hilfe von Abkürzungen können wir +jetzt auch bessere Musterbriefe schreiben. Ein Problem, das bereits +angesprochen wurde, besteht darin, daß in der Anrede je nach Ge­ +schlecht 'Herr' oder 'Frau' stehen soll. Um dieses Problem zu lösen, +wird der Inhalt des Feldes 'm/w' benötigt. + Da in einer Abkürzung jede ELAN-Anweisung erlaubt ist, die +einen Text liefert, können natürlich auch #on("i")#IF-Anweisungen#off("i")# verwen­ +det werden. Mit diesen Informationen können wir jetzt die Abkür­ +zung 'Anrede' definieren: + + + % ABKUERZUNGEN + &Anrede : + IF f ("m/w") = "w" THEN + "Frau" + ELSE + "Herr" + END IF . + + +Für Nicht-Programmierer: Die IF-Anweisung besteht aus einer Ab­ +frage und zwei Alternativen. Die Abfrage steht zwischen dem IF und +dem THEN und besteht in der Regel aus einer Abfrage, ob zwei +Dinge gleich oder ungleich (<>), größer oder kleiner sind. Außerdem +können mehrere Abfragen mit AND (und) und OR (oder) kombiniert +werden. Näheres dazu im Kapitel 14. + Die Alternative hinter dem THEN wird ausgewählt, wenn die +Abfrage zutrifft. An dieser Stelle sind wieder beliebige Ausdrücke +erlaubt, die einen Text liefern, einschließlich erneuter IF-Anwei­ +sungen (Schachtelung). Die Alternative zwischen ELSE und END IF +wird ausgewählt, wenn die Abfrage nicht zutrifft. + +#on("b")#Textkonstanten#off("b")# Bisher wurden nur ELAN-Funktionen als +Textlie­ +feranten betrachtet ('date', 'lfd nr', 'f'). In unserem Fall werden +aber #on("i")#Textkonstanten#off("i")# in den Alternativen der IF-Anweisung benö­ +tigt. Textkonstanten werden in ELAN in Anführungsstriche einge­ +schlossen, die aber nicht zum Text gehören. Innerhalb einer Text­ +konstanten werden Leerzeichen wie alle anderen Zeichen angesehen +(erscheinen also auch nachher in der Ausgabe). + Bei solchen Abkürzungen, die längere Anweisungen umfassen, +sollten Sie das freie Format ausnutzen und eine möglichst über­ +sichtliche Darstellung wählen. Wie Sie sehen, muß nur der Doppel­ +punkt noch in der ersten Zeile stehen, der Rest kann sich beliebig +auf die folgenden Zeilen erstrecken. + +#on("b")#Beispiel#off("b")# Ein typischer Einsatz einer IF-Anweisung für die +Anrede sieht so aus: + + + % WIEDERHOLUNG + + Sehr geehrte&Anrede %! + + ... + % ABKUERZUNGEN + &Anrede : + IF f ("m/w") = "m" THEN + "r Herr" + ELSE + " Frau" + END IF . + + +Sie sollten jetzt diese Konstruktion in einen Musterbrief einfügen +können. Probieren Sie ihn dann als Beispiel aus ! + +#on("b")#Weitere Möglichkeiten#off("b")# Durch Verwendung von Abkürzungen ist +es +auch möglich, rechtsbündige Felder mit einer Länge von weniger als +3 Zeichen zu simulieren. Dies geschieht mit Hilfe der Textoperatio­ +nen von ELAN. Ohne ELAN-Vorkenntnisse können Sie dieses Bei­ +spiel überlesen. In unserer Liste im obigen Beispiel sind die laufen­ +den Nummern höchstens zweistellig und sollten deshalb auch nur +zwei Stellen belegen. Dies würde folgende Abkürzung ermöglichen: + + + % ABKUERZUNGEN + &l : text (lfd nr als zahl, 2) . + lfd nr als zahl : int (lfd nr) . + + +Die Prozedur 'text' wird dazu benutzt, eine Zahl rechtsbündig auf +zwei Stellen zu formatieren (s. EUMEL-Benutzerhandbuch). Da die +Abkürzung immer eine Länge von zwei Zeichen hat, kann sie auch in +einem Feldmuster variabler Länge eingesetzt werden. Die Attribute +'feste Länge' und 'rechtsbündig' werden in diesem Fall also nicht +durch das Feldmuster, sondern durch die Abkürzung selbst erzeugt. + Um die Prozedur 'text' anwenden zu können, muß die laufende +Nummer als Zahl (sprich: INT-Objekt) vorliegen. Diese Umwandlung +wird mit der Prozedur 'int' vorgenommen, die einen Text in eine +Zahl umwandelt. Obwohl man 'int (lfd nr)' direkt in den Aufruf von +'text' hätte schreiben können, wird hier als Demonstration dafür ein +Refinement verwendet. + Refinements können in einem Abkürzungsteil neben Abkürzun­ +gen stehen und von allen Abkürzungen benutzt werden. Sie werden +ähnlich geschrieben wie Abkürzungen, nur ihr Name muß in Klein­ +buchstaben geschrieben werden, dafür muß er nicht in der ersten +Spalte anfangen und kann Leerzeichen enthalten. Bei komplizierte­ +ren Ausdrücken sollten Refinements zur besseren Lesbarkeit einge­ +setzt werden. + Sie können die IF-Anweisung auch mit beliebig vielen ELIF- +Teilen versehen. Achten Sie jedoch darauf, daß die IF-Anweisung +#on("i")#immer#off("i")# irgendeinen Wert liefern muß. Sie dürfen also den ELSE-Teil +nicht weglassen. Statt einer IF-Anweisung können Sie natürlich +auch eine SELECT-Anweisung verwenden. Es stehen Ihnen im Prin­ +zip alle werteliefernden Anweisungen von ELAN zur Verfügung. + Die Programmiersprache ELAN bietet Ihnen noch weit mehr +Möglichkeiten, als hier beschrieben werden können. So können Sie +sich eigene Prozeduren definieren und diese dann in Abkürzungen +verwenden. In Kapitel 14 und 15 finden Sie eine Einführung in die +wichtigsten Konstrukte, die für EUDAS gebraucht werden. + + +13.2 Bedingte Musterteile + +Wenn größere Teile des Druckmusters in Abhängigkeit von bestimm­ +ten Daten unterschiedlich ausfallen sollen, werden die dazu benö­ +tigten Abkürzungen sehr umfangreich. Für solche Fälle kann man +IF-Anweisungen auch im Musterteil eines Abschnitts verwenden. In +diesem Fall werden die Alternativen der IF-Anweisung durch +Musterzeilen dargestellt. + Im Musterteil müssen jedoch die Zeilen, die Teil der IF-An­ +weisung sind, von den Musterzeilen unterschieden werden. Deshalb +werden die Anweisungszeilen durch ein '%'-Zeichen in der ersten +#on("i")#und#off("i")# zweiten Spalte gekennzeichnet. Das zweite '%'-Zeichen dient +zur Unterscheidung von Anweisungen an den Druckgenerator, die +nicht an den ELAN-Compiler übergeben werden sollen. + Mit einer IF-Anweisung im Musterteil kann man das Anredepro­ +blem auch folgendermaßen lösen: + + + % WIEDERHOLUNG + %% IF f ("m/w") = "w" THEN + Sehr geehrte Frau &! + %% ELSE + Sehr geehrter Herr &! + %% END IF; + + +Beachten Sie den Unterschied, daß die IF-Anweisung hier mit einem +Semikolon abgeschlossen werden muß - in Abkürzungen mußte ja ein +Punkt danach folgen. Außerdem darf hier der ELSE-Teil (die zweite +Alternative) fehlen, während in einer Abkürzung in jeder Alternati­ +ve etwas stehen muß (zumindest der leere Text ""). + Falls sich der IF-THEN-Teil über mehr als eine Zeile erstrek­ +ken soll, muß jede dieser Zeilen mit '%%' beginnen, da die Folgezei­ +len sonst als Musterzeilen gedruckt würden. Benutzen Sie in einem +solchen Fall jedoch besser ein Refinement, das Sie im Abkürzungs­ +teil definieren müssen. + Sie können im Musterteil auch andere ELAN-Anweisungen +verwenden. Der Unterschied zu Abkürzungen liegt darin, daß die +Musterzeilen nicht als Werte angesehen werden, die die Anweisung +liefern muß, sondern als Anweisungen, die dort aufgeführten Mu­ +sterzeilen einzusetzen und zu drucken. Daher kann im Musterteil +auch eine FOR-Schleife sinnvoll sein, wenn in Abhängigkeit eines +Wertes eine bestimmte Anzahl von Zeilen gedruckt werden soll. + + +13.3 Übersetzung + +Wenn Sie bis jetzt auch als ELAN-Programmierer immer noch nicht +ganz durchblicken, wie Sie welche ELAN-Anweisungen verwenden +können, dann ist das noch kein Anlaß zur Sorge. Es ist kaum mög­ +lich, die genauen Auswirkungen beliebiger Anweisungen zu be­ +schreiben, ohne den Übersetzungsprozeß zu schildern, der diese +Anweisungen zu einem ELAN-Programm zusammenbindet. Daher soll +diese Übersetzung jetzt genauer erklärt werden. + +#on("b")#Übersetzungsmechanismus#off("b")# Alle Zeilen eines Abkürzungsteils +wer­ +den direkt in das Programm übernommen, wobei der Name einer Ab­ +kürzung durch einen beliebig gewählten Refinementnamen ersetzt +wird ('abk' + eine laufende Nummer). Alle Abkürzungen und Re­ +finements werden als globale Refinements definiert, also außerhalb +von Prozeduren. Dadurch wird erreicht, daß sie an jeder Stelle +verwendet werden können. + Damit eine Abkürzung richtig als Refinement übersetzt wird, +muß sie ein TEXT-Objekt als Wert liefern. Die anderen Refinements +sind beliebig, da Sie nur in selbstdefinierten Anweisungen verwen­ +det werden. Die Refinements der Abkürzungen werden in einer Zu­ +weisung an eine TEXT-Variable verwendet, damit der Druckgenera­ +tor auf den entsprechenden Wert zugreifen kann. + Jeder Abschnitt wird dagegen als eine Prozedur übersetzt. Jede +Folge von Musterzeilen wird in eine Anweisung übersetzt, diese +Musterzeilen einzusetzen und zu drucken. Jede '%%'-Anweisung +wird einfach unverändert dazwischen geschrieben. Die Vorspann- +Prozedur wird einmal zu Anfang aufgerufen, die Prozedur für den +Wiederholungsteil einmal für jeden ausgewählten Satz und die Nach­ +spann-Prozedur einmal am Schluß. + Bei Fehlern im ELAN-Teil zeigt der Compiler das erzeugte Pro­ +gramm zusammen mit seinen Fehlermeldungen im Paralleleditor. Sie +müssen nun die Fehlermeldung lokalisieren und anhand der eben +gegebenen Hinweise in das ursprüngliche Druckmuster zurücküber­ +setzen, damit Sie dort den Fehler korrigieren können. + +#on("b")#Beispiel#off("b")# Nun müßten Sie genug Informationen haben, um +beliebige +ELAN-Anweisungen in das Druckmuster einfügen zu können. Als +Beispiel wollen wir versuchen, alle Männer und Frauen in der +Adressendatei zu zählen, ohne ein Suchmuster einstellen zu müssen +und ohne den Druckvorgang zweimal ablaufen zu lassen (wie dies +bei dem obigen Beispiel der Fall war). Ein erster Versuch könnte so +aussehen: + + + % VORSPANN + %% INT VAR maenner, frauen; + %% maenner := 0; + %% frauen := 0; + % WIEDERHOLUNG + %% IF f ("m/w") = "m" THEN + %% maenner INCR 1 + %% ELSE + %% frauen INCR 1 + %% END IF + % NACHSPANN + &maenner Männer und %frauen Frauen vorhanden. + + +Aber Vorsicht! In diesem Beispiel sind mehrere Fehler eingebaut. +Finden Sie sie! + +#on("b")#Fehler im Beispiel#off("b")# Der erste Fehler befindet sich im +Nachspann. +Hier wird versucht, die Namen der beiden Variablen 'maenner' und +'frauen' direkt in einem Feldmuster zu verwenden. Diese beiden +Namen sind dem Druckgenerator nicht bekannt, sondern nur dem +ELAN-Compiler. Um die Werte der beiden Variablen einsetzen zu +können, müssen Sie also zwei geeignete Abkürzungen definieren. + Der zweite Fehler ist schwieriger zu finden. Wie oben gesagt, +wird jeder Abschnitt in eine Prozedur übersetzt. Die in einem Ab­ +schnitt definierten Variablen können also nur in diesem Abschnitt +verwendet werden (sie sind lokal) und auch nicht im Abkürzungs­ +teil, da dieser wieder global vereinbart wird. Die beiden im Vor­ +spann definierten Variablen stehen also im Wiederholungsteil und im +Nachspann nicht zur Verfügung. + +#on("b")#Anweisungen im Initialisierungsteil#off("b")# Für diesen Fall gibt +es die +Möglichkeit, ELAN-Anweisungen vor allen Abschnitten im Initiali­ +sierungsteil zu definieren. Diese Anweisungen sind dann ebenfalls +global. Das richtige Druckmuster finden Sie auf der nächsten Seite. + Natürlich könnten Sie die Initialisierung der beiden Variablen +auch noch aus dem Vorspann herausnehmen. Denken Sie daran, daß +Sie aus INT-Variablen erst einen Text machen müssen, ehe Sie sie +in eine Musterzeile einsetzen können. Beachten Sie Schreibweise der +Variablen: in ELAN können die Umlaute nicht in Bezeichnern ver­ +wendet werden, daher muß die Variable mit 'ae' geschrieben wer­ +den. Im Mustertext und in Abkürzungs- und Feldnamen können die +Umlaute jedoch frei verwendet werden. + + + %% INT VAR maenner, frauen; + % VORSPANN + %% maenner := 0; + %% frauen := 0; + % WIEDERHOLUNG + %% IF f ("m/w") = "m" THEN + %% maenner INCR 1 + %% ELSE + %% frauen INCR 1 + %% END IF + % NACHSPANN + &m Männer und %f Frauen vorhanden . + % ABKUERZUNGEN + &m : text (maenner) . + &f : text (frauen) . + + + +13.4 Gruppen + +Der Druckgenerator bietet die Möglichkeit, Vorspann und Nachspann +nicht nur am Anfang und am Ende, sondern auch an bestimmten +Stellen zwischen Sätzen zu drucken. Diese Stellen sind dadurch +bestimmt, daß ein bestimmtes Merkmal (z.B. ein Feldinhalt) seinen +Wert ändert. Ein solches Merkmal wird im Druckmuster #on("i")#Gruppe#off("i")# ge­ +nannt. + Ein Beispiel für die Verwendung von Gruppen ist eine Schüler­ +datei, die nach Klassen geordnet ist. Definiert man das Feld 'Klas­ +se' als Gruppe, so wird jeweils am Ende einer Klasse ein Nachspann +und am Beginn einer Klasse ein Vorspann gedruckt. + Dieses Verfahren ist eine Erweiterung der bisher beschriebenen +Methode, indem eine Datei quasi in mehrere Dateien untergliedert +wird, die jedoch in einem Arbeitsgang gedruckt werden können. +Voraussetzung dafür ist jedoch, daß die Datei nach dem Gruppen­ +merkmal geordnet ist - der Druckgenerator sammelt nicht erst alle +Schüler einer Klasse aus der Datei, sondern erwartet sie hinter­ +einander. + +#on("b")#Gruppendefinition#off("b")# Eine Gruppe wird im Initialisierungsteil +des +Druckmusters (also vor allen Abschnitten) definiert. Notwendige +Daten sind eine Nummer zur Identifizierung und das Merkmal. Die +Nummer sollte am sinnvollsten von 1 an vergeben werden; die mög­ +lichen Werte sind nach oben hin beschränkt. Das Merkmal ist ein +beliebiger ELAN-Ausdruck, der einen Text liefert. Sinnvollerweise +wird er den Inhalt eines Feldes enthalten. + Gruppendefinitionen müssen nach allen ELAN-Anweisungen im +Initialisierungsteil folgen, und zwar, weil die Gruppendefinitionen +alle in einer Prozedur zusammengefaßt werden, die bei jedem neuen +Satz auf Gruppenwechsel testet. + Unter der Annahme, daß die oben erwähnte Schülerdatei ein +Feld 'Klasse' besitzt, würde die Gruppe wie folgt definiert: + + + % GRUPPE 1 f ("Klasse") + + +Nach der Anweisung 'GRUPPE' folgt die Gruppennummer und dann +ein ELAN-Ausdruck. Die ganze Definition muß in einer Zeile stehen; +reicht der Platz nicht aus, müssen Sie in einem Abkürzungsteil ein +Refinement definieren. + +#on("b")#Klassenliste#off("b")# Das komplette Druckmuster für die +Klassenliste könn­ +te folgendes Aussehen haben, wenn außer 'Klasse' auch noch die +Felder 'Name' und 'Vorname' vorhanden sind: + + + % GRUPPE 1 f ("Klasse") + % VORSPANN + Klassenliste für Klasse &Klasse + ---------------------------- + % WIEDERHOLUNG + &Vorname %Name + % NACHSPANN + \#page\# + + +Wenn eine Gruppe definiert ist, werden im Nachspann immer die +Feldinhalte des letzten Satzes vor dem Gruppenwechsel gedruckt, im +Vorspann die Inhalte des ersten Satzes nach dem Wechsel. Daher +kann hier im Vorspann die Klasse gedruckt werden, da sie sich erst +ändert, wenn schon wieder der nächste Vorspann gedruckt wird. + +#on("b")#Mehrere Gruppen#off("b")# Wie die Identifikation über eine +Gruppennummer +vermuten läßt, können Sie mehrere Gruppen definieren. Nachspann +und Vorspann werden jeweils gedruckt, wenn sich das Merkmal ir­ +gendeiner Gruppe ändert. Ob eine bestimmte Gruppe gewechselt hat, +kann mit der Abfrage + + + BOOL PROC gruppenwechsel (INT CONST gruppennummer) + + +in einer IF-Anweisung ermittelt werden. Vor dem ersten und nach +dem letzten Satz wechseln automatisch alle Gruppen. + Die ganze Datei bildet eine Quasi-Gruppe mit der Nummer 0. +Sie ist immer definiert und wechselt nur vor dem ersten und nach +dem letzten Satz. Sie ist es, die bewirkt, daß Vorspann und Nach­ +spann in ihrer normalen Weise gedruckt werden. + +#on("b")#Anwendungsbeispiel#off("b")# Um einige der Möglichkeiten zu +illustrieren, +die durch Gruppen geschaffen werden, wollen wir als Beispiel eine +Anwendung betrachten, die neue Wege für die Benutzung von EUDAS +aufzeigt. + Aus einer Datei, in der für jede Bestellung der Kunde, der Ar­ +tikel, die bestellte Menge und der Einzelpreis des Artikels einge­ +tragen werden, sollen anschließend Rechnungen gedruckt werden. +Die Datei soll folgende Felder haben: + + + 'Kundennummer' + 'Artikelnummer' + 'Einzelpreis' + 'Menge' + + +Als Voraussetzung müssen die Bestellungen in der Datei jeweils +nach Kunden geordnet vorliegen. Die Kundennummer wird als Gruppe +definiert, so daß die Bestellungen eines Kunden zu einer Rechnung +zusammengefaßt werden können. Das Druckmuster rechnet dann die +einzelnen Preise zusammen und gibt eine Endsumme aus. + Damit in der Rechnung Name und Adresse des Kunden auftau­ +chen können, wird zu der Bestellungsdatei die Kundendatei gekop­ +pelt, die folgende Felder haben soll: + + + 'Kundennummer' + 'Name' + 'Vorname' + 'Strasse' + 'PLZ' + 'Ort' + + +Stellen Sie sich zum Ausprobieren des folgenden Druckmusters ge­ +gebenenfalls eigene Daten zusammen. Hier nun das Druckmuster: + + + %% REAL VAR gesamtpreis, summe; + % GRUPPE 1 f ("Kundennummer") + % VORSPANN + %% summe := 0.0; + Fa. Kraus & Sohn + Schotterstr. 10 + + 5000 Köln 1 + &Vorname %Name + &Strasse + + &PLZ &Ort &Datum + + R E C H N U N G + =============== + + Menge Artikelnr. Einzelpreis Gesamtpreis + ------------------------------------------------ + % ABKUERZUNGEN + &Datum : date . + + % WIEDERHOLUNG + %% gesamtpreis := round + %% (wert ("Einzelpreis") * wert ("Menge"), 2); + %% summe INCR gesamtpreis; + &Menge &Artikelnummer &&&&epr&& &&&&gpr&& + % ABKUERZUNGEN + &epr : f ("Einzelpreis") . + &gpr : zahltext (gesamtpreis, 2) . + + % NACHSPANN + ------------------------------------------------ + Summe: &&&&sum&& + + 14% MWSt. &&&Mwst&& + ========= + Endbetrag &&&&end&& + \#page\# + % ABKUERZUNGEN + &sum : zahltext (summe, 2) . + &Mwst : zahltext (mwst, 2) . + &end : zahltext (summe + mwst, 2) . + mwst : round (summe * 0.14, 2) . + + +Im Initialisierungsteil dieses Druckmusters wird die Kundennummer +als Gruppe definiert. Dies hat zur Folge, daß für jeden neuen Kun­ +den eine neue Rechnung begonnen wird, nachdem vorher im Nach­ +spann die Rechnungssumme des vorherigen Kunden berechnet und +ausgedruckt wurde. Vor dieser Gruppendefinition sind 'gesamtpreis' +und 'summe' definiert, die später als globale Variablen zur Verfü­ +gung stehen sollen. Diese Zeile darf nicht nach der Gruppendefini­ +tion stehen. + Im Vorspann wird der Kopf der Rechnung angegeben. Dieser +enthält neben den Daten des Kunden (aus der gekoppelten Kun­ +dendatei) noch das Datum. Die Kundennummer wird nur zum Kop­ +peln und als Gruppenmerkmal benötigt, erscheint also nicht auf der +Rechnung. + Es fällt auf, daß im Firmennamen ein '&'-Zeichen auftaucht, +das doch für die Markierung von Feldmustern reserviert ist. Die +beiden Musterzeichen können jedoch im normalen Text auftauchen, +wenn ihnen direkt ein Leerzeichen folgt. In diesem Fall werden Sie +nicht als Beginn eines Feldmusters interpretiert, sondern unverän­ +dert gedruckt. Der gleiche Fall taucht noch mit '%' im Nachspann +auf. + Im Wiederholungsteil wird zunächst aus dem Einzelpreis und der +Menge des jeweiligen Artikels der Gesamtpreis für diesen Artikel +berechnet. Für die Abfrage der Feldinhalte wird die Funktion 'wert' +verwendet, die wie 'f' funktioniert, jedoch gleich einen REAL-Wert +liefert. + Zu beachten ist, daß 'wert' wie beim Sortieren von Zahl alle +Sonderzeichen ignoriert. Weiterhin müssen die Zahlen mit dem ein­ +gestellten Dezimalkomma geschrieben werden (also normalerweise +mit Komma), damit ihr Wert richtig erkannt wird. Anderenfalls soll­ +ten Sie den Dezimalpunkt einstellen (s. 11.1). + Damit kaufmännisch richtig gerechnet wird, wird der Gesamt­ +preis auf 2 Nachkommastellen gerundet und erst dann aufsummiert. +Würde der Gesamtpreis nur zum Einsetzen gerundet, könnten bei der +anschließenden Addition der nicht gerundeten Werte eine falsche +Gesamtsumme entstehen. + Erst nach diesen Berechnungen kann die Musterzeile folgen, in +die die Werte dann eingesetzt werden. Um eine Ausgabe mit zwei +Nachkommastellen zu erzeugen, wird die von EUDAS definierte +Funktion 'zahltext' benutzt. Diese erzeugt aus einem REAL-Wert +einen Text mit der angegebenen Anzahl von Kommastellen und setzt +das korrekte Dezimalkomma ein. Das Ergebnis dieser Funktion wird +dann rechtsbündig eingesetzt. + Im Nachspann wird dann der summierte Wert mit aufgeschlage­ +ner Mehrwertsteuer gedruckt. Die Mehrwertsteuer muß ebenfalls auf +zwei Nachkommastellen gerundet werden. + +#on("b")#Erweiterung#off("b")# Zur Erweiterung könnten Sie die Bestelldatei +noch mit +einer Artikeldatei koppeln, die etwa folgende Struktur haben würde: + + + 'Artikelnummer' + 'Bezeichnung' + 'Einzelpreis' + + +In diesem Fall könnten Sie noch jeweils die Artikelbezeichnung in +eine Rechnungszeile drucken. Außerdem würde der Preis zentral +gespeichert. Eine entsprechende Änderung des Druckmusters sollte +Ihnen keine Schwierigkeiten bereiten. + + + diff --git a/app/eudas/4.3/doc/eudas.hdb.14 b/app/eudas/4.3/doc/eudas.hdb.14 new file mode 100644 index 0000000..1aa3c87 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.14 @@ -0,0 +1,724 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (151)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +14 Ausdrücke in ELAN + + + +14.1 Was sind Ausdrücke ? + +In diesem Kapitel wollen wir uns mit ELAN-Ausdrücken beschäfti­ +gen, wie sie für EUDAS gebraucht werden. Natürlich kann dies keine +ernsthafte Einführung für ELAN-Programmierer sein - mit solchen +Ambitionen halten Sie sich am besten an die entsprechende ELAN- +Literatur. + Dieser Text richtet sich eher an den Benutzer, der kaum Erfah­ +rung mit ELAN hat, aber die Möglichkeiten von EUDAS optimal nut­ +zen will. Viele fortgeschrittene Fähigkeiten von EUDAS laufen ja +über ELAN-Programme. + +#on("b")#Vorkommen#off("b")# Sie haben ELAN-Ausdrücke bereits an +verschiedenen +Stellen eingesetzt, wenn Sie sich mit den vorhergehenden Kapiteln +befaßt haben. ELAN-Ausdrücke werden in nahezu allen Verarbei­ +tungsfunktionen benötigt. + Im Druckmuster dienen sie dazu, den Inhalt eines Feldmusters +festzulegen. Die Definition einer Abkürzung besteht immer aus dem +Namen der Abkürzung und einem Ausdruck. Ebenso wird in einer +Gruppendefinition ein Ausdruck angegeben. + Beim Kopiermuster und beim Änderungsmuster besteht jeweils +die rechte Seite einer Anweisung aus einem Ausdruck. Weiterhin +werden Ausdrücke auch in anderen ELAN-Konstruktionen benötigt, +wie zum Beispiel direkt am Anfang einer IF-Anweisung. + +#on("b")#Bedeutung#off("b")# Ein Ausdruck steht allgemein für einen Wert. Im +ein­ +fachsten Fall kann dies eine Konstante sein, der Wert des Aus­ +drucks ändert sich also nicht. Anderenfalls spricht man von einem +zusammengesetzten Ausdruck. Dessen Wert ergibt sich dann durch +die Ausführung der im Ausdruck angegebenen Operationen. Dieser +Wert kann je nach dem aktuellen Zustand des Systems verschieden +sein, da er jedes Mal neu berechnet wird, wenn er gebraucht wird. + Ein Beispiel für einen zusammengesetzten Ausdruck ist 2+2 +Dieser Ausdruck steht für den Wert 4. + Der Wert eines Ausdrucks ist das, was uns eigentlich interes­ +siert. Beim Druckvorgang wird dieser Wert dann gedruckt, beim +Kopieren und Verändern in ein Feld eingetragen. + +#on("b")#Zusammensetzung#off("b")# Ausdrücke lassen sich aus verschiedenen +Ele­ +menten zusammensetzen. Grundlage bilden die Konstanten. Konstan­ +ten können durch #on("i")#Operatoren#off("i")# miteinander verknüpft werden. So ist +in dem Ausdruck 2+3 das '+' ein Operator, der die Konstanten 2 +und 3 verknüpft. Das Ergebnis der Verknüpfung hängt natürlich vom +jeweiligen Operator ab. + Wie Sie schon in der Schule gelernt haben ("Punktrechnung vor +Strichrechnung"), muß man die Reihenfolge der Operatoren festlegen, +wenn mehrere Operatoren im Spiel sind. Ähnliche Regeln gibt es für +alle Operatoren in ELAN. + Wenn eine andere Reihenfolge der Operatoren erwünscht ist, +können Sie diese durch Einsatz von Klammern verändern. Auch dies +dürfte Ihnen aus der Schule noch in Erinnerung sein. Der Unter­ +schied in ELAN ist lediglich, daß es dort einige zusätzliche Opera­ +toren gibt, die Ihnen nicht aus der Mathematik vertraut sind. + Ein weiteres Konstruktionselement von Ausdrücken sind #on("i")#Funk­ +tionen#off("i")#. Auch diese kennen Sie aus der Schule. Lediglich die +Schreibweise muß für den "dummen" Computer etwas ausführlicher +gehalten werden (Beispiel: sin (3.14 * x)). + Die Argumente der Funktion hinter dem Funktionsnamen müssen +auf jeden Fall in Klammern stehen. In der Terminologie der Pro­ +grammiersprachen spricht man von #on("i")#Parametern#off("i")#. Parameter können +wieder komplexe Ausdrücke sein. Bei Funktionen mit mehreren +Parametern werden diese durch Komma getrennt: + + + min (2.5 * x, x + 1.25) + + + +14.2 Datentypen + +Bevor wir beginnen, konkrete Ausdrücke zu behandeln, müssen wir +erst das Konzept der #on("i")#Datentypen#off("i")# einführen. Grundidee dabei ist, +daß es verschiedene Klassen von Werten gibt, die nicht einfach +untereinander gemischt werden können. + So gibt es in ELAN einen grundlegenden Unterschied zwischen +#on("i")#Zahlen#off("i")# und #on("i")#Texten#off("i")#. Texte bestehen aus einer beliebigen Aneinan­ +derreihung von Zeichen, die im Normalfall nur für den betrachten­ +den Menschen eine Bedeutung haben. Mit Zahlen kann man dagegen +Berechnungen anstellen. + Der tiefere Grund für die Trennung in verschiedene Typen ist +also, daß für jeden Typ gewisse Operationen definiert snd, die nur +für diesen Typ sinnvoll sind. So ist zum Beispiel die Addition der +beiden Texte "abc" und "-/-" völlig sinnlos. + Aber nicht nur die Operationen sind verschieden, sondern auch +die interne Darstellung im Rechner. So werden der Text "1234" und +die Zahl 1234 völlig anders gespeichert, obwohl man ihnen die glei­ +che Bedeutung beimessen könnte. + +#on("b")#Grundtypen#off("b")# In ELAN gibt es vier verschiedene Grundtypen, +die für +uns wichtig sind. Sie können sich in ELAN auch eigene Typen +schaffen, dies geht jedoch weit über unsere Bedürfnisse hinaus. + Der in EUDAS am meisten verwendete Typ heißt #on("i")#TEXT#off("i")#. TEXT- +Objekte bestehen aus einer Folge von 0 bis 32000 Zeichen. Die Zei­ +chen entstammen einem Satz von 256 verschiedenen Symbolen, die +jeweils eine andere Darstellung haben. Einige der Zeichen lassen +sich überhaupt nicht darstellen, sondern führen bestimmte Funktio­ +nen aus (zum Beispiel Bildschirm löschen). + Sämtliche Feldinhalte einer EUDAS-Datei sind TEXTe, ebenso +die Zeilen von Textdateien. Auch Datei- und Feldnamen sind +TEXTe. Von daher besteht eigentlich kein Grund, warum Sie sich +außer zur Programmierung noch mit anderen Datentypen beschäfti­ +gen sollten. + Neben den Texten gibt es noch die Zahlen. Diese sind in ihrer +internen Darstellung so beschaffen, daß ein effizientes Rechnen mit +ihnen möglich ist. Andererseits können sie nicht mehr beliebige +Informationen darstellen, sondern haben eine sehr eingeschränkte +Bedeutung. + Um unterschiedichen Bedürfnissen gerecht zu werden, gibt es in +ELAN zwei verschiedene Zahltypen. Der Typ #on("i")#INT#off("i")# umfaßt nur ganze +Zahlen ohne Kommastellen. Damit die Zahl möglichst wenig Spei­ +cherplatz belegt, ist der Wertebereich bei den meisten Rechnern auf +-32768..32767 beschränkt (die krummen Zahlen ergeben sich wegen +der Binärarithmetik des Rechners). Dieser Typ eignet sich am besten +zum Abzählen und zum Auswählen aus einer festen Anzahl von +Objekten (zum Beispiel Feld 1 bis Feld 255). + Zum eigentlichen Rechnen gibt es den Typ #on("i")#REAL#off("i")#. Dieser umfaßt +auch Kommazahlen. Genauigkeit, Wertebereich und Darstellung sind +nahezu identisch mit den Möglichkeiten eines Taschenrechners. der +Typ REAL wird immer dann verwendet, wenn mit realen Größen +(Geldbeträge, physikalische Werte) gerechnet werden muß. + Zuletzt gibt es noch den Typ #on("i")#BOOL#off("i")#. Er hat nur zwei mögliche +Werte, nämlich TRUE (wahr) und FALSE (falsch). Er wird dazu benö­ +tigt, Ausdrücke zu schreiben, die den Zweig einer IF-Anweisung +bestimmen. + +#on("b")#Denotation#off("b")# ELAN verfügt über einen strengen Typenschutz; +das +heißt, Objekte verschiedenen Typs dürfen nicht gemischt werden. +Daher muß schon bei der Schreibweise der Konstanten festgelegt +sein, welchen Typ die Konstante hat. + Bei Texten geschieht dies durch den Einschluß in Anführungs­ +striche. Die Anführungsstriche sorgen gleichzeitig auch für eine +Abgrenzung der Zeichen des Textes und des umgebenden Programms. +Sie kennen diese Schreibweise bereits von vielen Stellen in EUDAS. + Ebenfalls keine Probleme bereitet der Typ BOOL, da die +Schreibweise der beiden möglichen Werte TRUE und FALSE eindeutig +ist. + Problematisch wird es bei den Zahlen. Da die ganzen Zahlen in +den rationalen Zahlen enthalten sind, muß für die ganzen Zahlen +durch die Schreibweise festgelegt werden, zu welchem der beiden +Typen sie gehören. Man hat festgelegt, daß REAL-Zahlen immer mit +Komma geschrieben werden müssen, während Zahlen ohne Komma den +Typ INT haben (das Komma wird in ELAN bei den REAL-Zahlen in +internationaler Schreibweise als Punkt notiert). + So ist 4 eine INT-Zahl, während 4.0 den Typ REAL besitzt. +Denken Sie in Zukunft immer daran, welcher Zahltyp jeweils ver­ +langt wird und richten Sie die Schreibweise danach. + +#on("b")#Unterschied zu Feldtypen#off("b")# Verwechseln Sie die hier +vorgestellten +Datentypen nicht mit den Feldtypen einer EUDAS-Datei. Die Feld­ +typen beziehen sich immer auf den gleichen Datentyp, nämlich +TEXT. Die Feldtypen bestimmen lediglich die spezielle Behandlung +des Feldes beim Suchen und Sortieren, während Datentypen tat­ +sächlich Unterschiede in der Speicherung und den anwendbaren +Operationen bedeuten. + Daher können Sie Feldtypen auch nach Bedarf ändern, während +der Datentyp eines Objekts ein für alle Mal feststeht. Merken Sie +sich, daß Feldinhalte in EUDAS immer den Typ TEXT haben. + +#on("b")#Umwandlungen#off("b")# Obwohl verschiedene Datentypen nicht +miteinander +gemischt werden dürfen, können sie mit speziellen Funktionen in­ +einander umgewandelt werden. So ist zum Beispiel die Addition von +1 und 1.5 verboten, aber der folgende Ausdruck + + + real (1) + 1.5 + + +liefert den Wert 2.5 mit dem Typ REAL. Umgekehrt geht die Um­ +wandlung mit der Funktion 'int', dabei werden jedoch die Nachkom­ +mastellen abgeschnitten. Weitere Hinweise dazu erhalten Sie im +Abschnitt 14.4. + Wichtiger jedoch ist die Umwandlung von Zahlen in TEXT-Ob­ +jekte. Was Sie auf Ihrem Bildschirm oder Ausdruck sehen, sind ja +immer nur Zeichenfolgen und damit Texte. Zahlen (INT oder REAL) +in ihrer internen Darstellung können Sie prinzipiell nicht sehen. Sie +müssen zur Darstellung immer in Texte umgewandelt werden. + Auch beim Rechnen mit Werten aus EUDAS-Dateien müssen +mehrere Umwandlungen stattfinden. Der Feldinhalt, der ja ein TEXT +ist, muß zunächst in eine Zahl umgewandelt werden. Dann wird mit +dieser Zahl gerechnet. Wenn das Ergebnis wieder in ein Feld einge­ +tragen oder gedruckt werden soll, muß eine Rückumwandlung in +einen Text vorgenommen werden. + Die zum Umwandeln benötigten Funktionen werden ebenfalls im +Abschnitt 14.4 besprochen. + +#on("b")#Funktionsbeschreibung#off("b")# In den zwei folgenden Abschnitten +sollen +die wichtigsten Funktionen und Operatoren anhand von Beispielen +beschrieben werden. Da jede Funktion nur auf bestimmte Datentypen +angewendet werden kann, gibt es eine Notation, die genau die Form +eines Funktionsaufrufs festlegt. + + + INT PROC min (INT CONST a, b) + + +Die obige Schreibweise hat folgende Bedeutung: Spezifiziert wird die +Funktion 'min', die als Ergebnis einen INT-Wert liefert (das INT +ganz links). Die Bezeichnung PROC gibt an, daß es sich um eine +Funktion handelt. In Klammern ist dann angegeben, welche Parame­ +ter verwendet werden müssen. Die Funktion hat zwei Parameter, +beide vom Typ INT. Die Bezeichnung CONST gibt an, daß auch Kon­ +stanten verwendet werden dürfen (Normalfall). + Zu beachten ist, daß bei jedem Aufruf beide Parameter vorhan­ +den und vom Typ INT sein müssen. Anderenfalls gibt es eine Feh­ +lermeldung. + Die gleiche Schreibweise wird auch zur Spezifikation von Ope­ +ratoren verwendet: + + + INT OP + (INT CONST a, b) + + +Jedoch dürfen Operatoren nicht mit Parametern in Klammern ge­ +schrieben werden, sondern der Operator wird zwischen die Parameter +geschrieben. + Eine Besonderheit von ELAN ist es, daß es verschiedene Opera­ +toren und Funktionen mit gleichem Namen geben kann. Die Funktio­ +nen werden nur unterschieden nach dem Typ ihrer Parameter. So +gibt es nicht nur den oben genannten Operator '+', sondern auch +den folgenden: + + + REAL OP + (REAL CONST a, b) + + +Obwohl im Aussehen gleich, handelt es sich doch um verschiedene +Operatoren mit möglicherweise völlig verschiedener Wirkung. Dies +sieht man an diesem Beispiel: + + + TEXT OP + (TEXT CONST a, b) + + +Dieser Operator führt nun keine Addition aus, sondern eine #on("i")#Verket­ +tung#off("i")# zweier Texte. Je nach Typ der Parameter wird der entspre­ +chende Operator ausgesucht. + + +14.3 TEXT-Funktionen + +In diesem Abschnitt wollen wir die wichtigsten Funktionen und +Operatoren zur Behandlung von Texten beschreiben. Wie Sie noch +sehen werden, spielt dabei aber auch der Typ INT eine gewisse +Rolle. + +#on("b")#EUDAS-Abfragen#off("b")# Die wichtigste Funktion zur Abfrage von +Inhal­ +ten der aktuellen Datei sollten Sie bereits kennen: + + + TEXT PROC f (TEXT CONST feldname) + + +Neu ist eigentlich nur die Schreibweise der Spezifikation. Sie sollten +aber in der Lage sein, daraus einen konkreten Ausdruck zu kon­ +struieren. Bisher haben wir immer die Schreibweise + + + f ("Feldname") + + +verwendet. Dies ist jedoch nur ein Beispiel. Die korrekte Angabe +finden Sie oben. + Die Funktion 'f' darf natürlich nicht angewendet werden, wenn +keine Datei geöffnet ist. In die Verlegenheit kommen Sie aber nur +beim Ausprobieren, denn alle gefährlichen EUDAS-Funktionen sind +sonst gesperrt. + Falls das angegebene Feld nicht existiert, wird mit einer Feh­ +lermeldung abgebrochen. Beachten Sie, daß dies immer erst bei der +Ausführung festgestellt werden kann. Bei der Eingabe, zum Beispiel +eines Druckmusters, kann dies noch nicht überprüft werden. + Eine weitere Abfrage, die EUDAS während des Druckens ermög­ +licht, ist die Funktion + + + TEXT PROC lfd nr + + +Diese hat keine Parameter und liefert die laufende Nummer des +gedruckten Satzes. + Diese beiden Funktionen können als Ausgangsbasis dienen zur +Manipulation mit weiteren Funktionen. + +#on("b")#Verkettung#off("b")# Zur Verkettung von Teiltexten gibt es den oben +schon +beschriebenen Operator '+'. Wenn Sie mehr als zwei Texte verketten +wollen, können Sie den Operator beliebig hintereinander verwenden: + + + f ("PLZ") + " " + f ("Ort") + + +Wie in diesem Beispiel können Sie sowohl Konstanten als auch Tex­ +te, die von anderen Funktionen geliefert werden, verketten. Beach­ +ten Sie, daß die Texte immer ohne Zwischenraum aneinandergehängt +werden; daher wird im obigen Beispiel ein Leerzeichen extra ange­ +geben. + Wenn Sie eine bestimmte Anzahl von gleichen Zeichen haben +möchten (zum Beispiel für horizontale Linien oder große Zwischen­ +räume), können Sie dafür folgenden Operator verwenden: + + + TEXT OP * (INT CONST anzahl, TEXT CONST einzeltext) + + +Hier sehen Sie als Beispiel einen Operator, der mit verschiedenen +Datentypen arbeitet. Sie müssen die Parameter jedoch immer in der +angegebenen Reihenfolge benutzen. Das folgende Beispiel ist kor­ +rekt: + + + 20 * "-" + + +während dies nicht erlaubt ist: + + + "-" * 20 + + +Wieder können Sie diesen Operator mit anderen Funktionen verknü­ +pfen: + + + "!" + 10 * " " + "!" + 5 * "-" + "!" + + +Da der Multiplikationsoperator Vorrang vor der Addition hat, kom­ +men Sie hier sogar ohne Klammern aus (überlegen Sie sich, wo ein +Fehler auftreten würde, wenn dies nicht so wäre). Als Ergebnis +dieses komplexen Ausdrucks ergäbe sich der folgende Text: + + + "! !-----!" + + +#on("b")#Teiltexte#off("b")# Um auch Teile von Texten bearbeiten zu können, +werden +die Zeichen eines Textes von 1 an (mit INT-Zahlen) durchnumeriert. +Anhand dieser Positionen können Sie Teiltexte extrahieren. + Damit Sie die Position des letztes Zeichens (und damit die An­ +zahl der Zeichen) erfragen können, gibt es die Funktion + + + INT PROC length (TEXT CONST text) + + +Wieviel Zeichen in einem Feld stehen, können Sie also mit + + + length (f ("Feldname")) + + +erfahren. + Einen Teiltext bekommen Sie mit der Funktion 'subtext'. Diese +gibt es in zwei Ausführungen. + + + TEXT PROC subtext (TEXT CONST text, INT CONST anfang) + + +liefert den Teiltext von einer bestimmten Position an (einschließ­ +lich) bis zum Textende. Mit + + + TEXT PROC subtext (TEXT CONST t, INT CONST anf, ende) + + +können Sie auch die Position des letzten Zeichens (einschließlich) +angeben. Daher würden die beiden folgenden Aufrufe + + + subtext (f ("Feldname"), 1) + subtext (f ("Feldname"), 1, length (f ("Feldname"))) + + +den Feldinhalt unverändert liefern. Ein weiteres Beispiel: + + + subtext ("Ein Text als Beispiel", 5, 8) + + +liefert als Ergebnis "Text". + Es gibt noch den Operator 'SUB', der jeweils nur ein Zeichen +aus dem Text liefert: + + + TEXT OP SUB (TEXT CONST text, INT CONST stelle) + + +Der Aufruf ist gleichwertig zu einem Aufruf von 'subtext', in dem +beide Stellen gleich sind. + Bei beiden Funktionen wird nicht vorhandener Text einfach +ignoriert. So liefert + + + subtext ("Hallo", 4, 8) + + +das Ergebnis "lo" und + + + "Hallo" SUB 10 + + +den leeren Text "". + +#on("b")#Verschachtelte Ausdrücke#off("b")# Wie Sie bereits gesehen haben, +kann +man Ausdrücke ineinander verschachteln. Dies ist in unserem Fall +sehr nützlich, wenn Teiltexte bestimmt werden sollen, deren Posi­ +tion nicht konstant ist. Ein Beispiel, in dem 'length' bei der Fest­ +legung der Endposition verwendet wird, haben Sie weiter oben +bereits gesehen. + Als weitere Möglichkeit können Sie mit Positionen, die ja INT- +Zahlen sind, ganz normal rechnen. Folgender Ausdruck liefert zum +Beispiel die letzten drei Zeichen eines Feldes: + + + subtext (f ("Feldname"), length (f ("Feldname")) - 2) + + +Wichtig ist, daß ein Ausdruck, der wieder als Parameter für einen +anderen Ausdruck verwendet werden soll, den richtigen Typ hat, +der von dem anderen Ausdruck verlangt wird. + In dem obigen Beispiel muß als Position ein INT verwendet +werden. Diese Position wird vom Operator '-' berechnet. Es gibt +aber nur einen Subtraktionsoperator, der einen INT liefert, nämlich +den, der wiederum zwei INTs subtrahiert. Glücklicherweise sind +sowohl 'length' als auch die 2 vom Typ INT, anderenfalls wäre der +Ausdruck fehlerhaft. 'length' wiederum benötigt einen TEXT als +Parameter, der von der Funktion 'f' stammt, die als Parameter eben­ +falls einen TEXT verlangt. + Wie Sie sehen, kann es durchaus verwickelt zugehen, wenn ein +Ausdruck aus den verschiedensten Teilausdrücken unterschiedlichen +Typs zusammengesetzt ist. Die gleiche Überprüfung wie eben ge­ +schildert sollten Sie bei jedem Ausdruck vornehmen, damit keine +Fehlermeldung erscheint. + +#on("b")#Variable Positionen#off("b")# Zur Berechnung von Positionen gibt es +noch eine weitere nützliche Prozedur, nämlich + + + INT PROC pos (TEXT CONST text, teiltext) + + +Sie liefert die Position, an der der angegebene Teiltext zum ersten +Mal in dem Text vorkommt, oder 0, wenn der Teiltext nicht darin +vorkommt. So ist + + + pos ("Hallo", "l") = 3 + + +und + + + pos ("Hallo", "lo") = 4 + + +und + + + pos ("Hallo", "xx") = 0 + + +Diese Funktion kann zum Beispiel dazu verwendet werden, ein Feld +in mehrere Teile aufzuspalten. Sind zum Beispiel Name und Vorname +in einem Feld durch Leerzeichen getrennt hintereinandergeschrie­ +ben, liefert + + + subtext (f ("Name"), 1, pos (f ("Name"), " ") - 1) + + +den Vornamen und entsprechend + + + subtext (f ("Name"), pos (f ("Name"), " ") + 1) + + +den Nachnamen. Soll die Position erst ab einer gewissen Stelle ge­ +sucht werden, gibt es noch die folgende Variation der Funktion: + + + INT PROC pos (TEXT CONST text, teiltext, INT CONST ab) + + +Bei dieser Funktion wird erst ab der angegebenen Stelle einschließ­ +lich gesucht. + + +14.4 Rechenfunktionen + +#on("b")#Umwandlungen#off("b")# Bevor mit dem Inhalt eines Feldes gerechnet +wer­ +den kann (auch wenn das Feld den Feldtyp ZAHL hat), muß der Wert +des Feldinhaltes als REAL-Zahl berechnet werden. Dazu gibt es die +Funktion + + + REAL PROC wert (TEXT CONST feldname) + + +Die Funktion 'wert' ignoriert alle Sonderzeichen in dem Feld außer +dem Minuszeichen (als Vorzeichen) und dem eingestellten Dezimal­ +komma. Wenn das Feld 'Summe' beispielsweise "-***20,09 DM" ent­ +hält, ergibt sich + + + wert ("Summe") = 20.09 + + +Zum kaufmännischen Rechnen ist es manchmal erforderlich, den Wert +auf eine bestimmte Anzahl von Nachkommastellen zu runden. Diese +Anzahl kann man bei einer Variante von 'wert' als Parameter ange­ +ben: + + + REAL PROC wert (TEXT CONST feldname, + INT CONST kommastellen) + + +Mit den so erhaltenen Werten können Sie dann die weiter unten +beschriebenen Berechnungen durchführen. Bevor Sie das Ergebnis +jedoch drucken oder in ein Feld eintragen können, müssen Sie den +REAL-Wert wieder in einen TEXT verwandeln. Dazu dient die Funk­ +tion + + + TEXT PROC zahltext (REAL CONST wert, + INT CONST kommastellen) + + +Der übergebene Wert wird mit der gewünschten Anzahl von Komma­ +stellen als Text formatiert. Dazu wird der Wert gerundet. Außerdem +wird statt eines Punktes das eingestellte Dezimalkomma eingesetzt. +Die Länge des Textes richtet sich nach der Anzahl von benötigten +Stellen, es werden also keine führenden Nullen oder Leerzeichen +eingesetzt (dafür kann man den Text beim Drucken ja rechtsbündig +einsetzen). + Wird 0 als Kommastellen angegeben, wird auch kein Dezimal­ +komma erzeugt (Darstellung wie ein INT). Als Abkürzung können Sie +auch + + + TEXT PROC zahltext (TEXT CONST feldname, + INT CONST kommastellen) + + +als Ersatz für + + + zahltext (wert ("Feldname"), kommastellen) + + +verwenden. So kann ein Feld einheitlich zum Drucken formatiert +werden. + +#on("b")#Arithmetik#off("b")# Sowohl mit INT- als auch mit REAL-Zahlen +(jedoch +nicht gemischt) können Sie die üblichen Rechenoperatoren '+', '-' +und '*' verwenden. Auch Minimum ('min') und Maximum ('max') sind +für zwei Parameter dieser Typen definiert. + Lediglich die Division wird bei beiden Typen unterschiedlich +gehandhabt. Für REAL-Zahlen gibt es den Operator '/' für die +übliche Division. Da die ganzzahlige Division eine andere Bedeutung +hat, wird dafür der Operator 'DIV' verwendet. Den Rest der ganz­ +zahligen Division liefert 'MOD'. + 'abs' liefert den Wert eines REAL oder INT ohne das Vorzeichen. +Die Umwandlungsfunktionen 'int' und 'real' hatten wir ja bereits +weiter oben erwähnt. + Für REAL-Zahlen gibt es noch weitere mathematische Funktio­ +nen (Exponentialfunktion, Trigonometrie), die Sie am besten im +EUMEL-Benutzerhandbuch nachschlagen, wenn Bedarf dafür besteht. + + +14.5 Abfragen + +#on("b")#IF-Abfragen#off("b")# Wie Sie schon im vorigen Kapitel gesehen +haben, +kann man in Druckmustern auch IF-Abfragen als Ausdrücke ver­ +wenden. Die IF-Abfragen können zwar auch ineinander verschach­ +telt werden, sie dürfen jedoch nicht mehr innerhalb eines normalen +Ausdrucks angewendet werden. + Eine IF-Abfrage enthält 3 Teilausdrücke in folgender Form: + + + IF 'BOOL-Ausdruck' THEN + 'Ausdruck1' + ELSE + 'Ausdruck2' + END IF + + +Der erste Ausdruck muß einen Wert vom Typ BOOL liefern, der ent­ +scheidet, welcher der beiden Teilausdrücke ausgewertet wird. Wir +werden gleich noch sehen, was für Möglichkeiten es da gibt. + Die beiden Teilausdrücke dürfen auch wieder IF-Abfragen sein, +sind sie es jedoch nicht, dürfen in ihnen dann keine IF-Abfragen +mehr vorkommen. Die IF-Abfragen liegen also immer auf der äußer­ +sten Ebene. + Die beiden Teilausdrücke dürfen einen beliebigen Typ haben, er +muß jedoch für beide gleich sein. + Als Ergebnis der IF-Abfrage wird 'Ausdruck1' geliefert, wenn +der BOOL-Ausdruck wahr ist, sonst 'Ausdruck2'. + +#on("b")#Vergleiche#off("b")# Die wesentlichen Operationen, die boolesche +Ausdrücke +zur Verwendung in IF-Abfragen bilden, sind die Vergleichsoperato­ +ren: + + + = <> <= >= < > + + +Sie vergleichen jeweils zwei Elemente vom Typ TEXT, INT oder REAL +und liefern TRUE (wahr) oder FALSE (falsch). Selbstverständlich +können auch sie zwei zusammengesetzte Teilausdrücke vergleichen. + Eine Anwendung ist zum Beispiel der Test, ob ein Text in einem +anderen enthalten ist: + + + IF pos (f ("Betrag"), "DM") > 0 THEN + "deutsches Geld" + ELSE + "ausländisches Geld" + END IF + + +Die Funktion 'pos' wird hier dazu benutzt, festzustellen, ob es sich +um deutsches oder ausländisches Geld handelt. + Oft müssen jedoch mehrere Vergleiche miteinander kombiniert +werden. Zu diesem Zweck gibt es die beiden Operatoren AND (und) +und OR (oder). Damit AND das Ergebnis TRUE liefert, müssen beide +Vergleiche wahr sein, bei OR muß mindestens einer der beiden wahl +sein. + Die Reihenfolge aller dieser Operatoren ist so gewählt, daß +normalerweise keine Klammern benötigt werden. Funktionen haben +immer Vorrang vor Operatoren, bei den Operatoren kommt die Multi­ +plikation vor der Addition, dann kommen die Vergleiche, danach das +AND und danach das OR. Alle anderen Operatoren (#on("i")#insbesondere +SUB#off("i")#) teilen sich den letzten Rang. + Wenn Sie also in einem Ausdruck mehrere Vergleiche mit AND +und OR verknüpfen, und das OR soll stärker binden als das AND, +müssen Sie dies durch Klammern ausdrücken. + Den oben besprochenen Operator SUB sollten Sie immer in +Klammern setzen, wenn Sie ihn in einem Vergleich benutzen. Da er +die niedrigste Priorität hat, gäbe es sonst mit Sicherheit Fehler: + + + IF (f ("Name") SUB 1) = "M" THEN + "vielleicht Müller" + ELSE + "bestimmt nicht" + END IF + + +#on("b")#Refinements#off("b")# Bisher hatten wir gesagt, daß IF-Abfragen +nicht +innerhalb von anderen Ausdrücken verwendet werden dürfen. Diese +Einschränkung kann man umgehen, indem man #on("i")#Refinements#off("i")# verwen­ +det. + Ein Refinement hat im Druckmuster eine ähnliche Wirkung wie +eine Abkürzung, lediglich der Name darf nur mit Kleinbuchstaben +und Ziffern geschrieben sein und kann nicht als Feldmuster ver­ +wendet werden. + + + &abk : + subtext (f ("Name"), namensanfang) . + namensanfang : + IF pos (f ("Name"), " ") > 0 THEN + pos (f ("Name"), " ") + 1 + ELSE + length (f ("Name")) + END IF . + + +Innerhalb von Refinements dürfen auch wieder andere Refinements +verwendet werden. + Auch in Kopier- und Änderungsmustern können Sie Refinements +verwenden. Hier müssen Sie jedoch darauf achten, daß alle Refine­ +ments am Ende gesammelt werden und vor dem ersten Refinement +ein Punkt stehen muß. Ebenso müssen die Refinements wie im +Druckmuster durch Punkte voneinander getrennt sein: + + + "Anrede" K anrede; + . + anrede : + IF f ("m/w") = "w" THEN + "Frau" + ELSE + "Herr" + END IF . + + + diff --git a/app/eudas/4.3/doc/eudas.hdb.15 b/app/eudas/4.3/doc/eudas.hdb.15 new file mode 100644 index 0000000..c0a22cf --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.15 @@ -0,0 +1,286 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (165)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +15 Anweisungen in ELAN + + + +15.1 Variablen und Zuweisungen + +Im vorigen Kapitel haben wir Ausdrücke in ELAN kennengelernt. Der +Wert eines Ausdrucks wird bei jeder Verwendung erneut berechnet. +Wenn wir den Wert eines Ausdrucks aufbewahren wollen, müssen wir +ihn schon in eine EUDAS-Datei schreiben. + Oft tritt jedoch die Notwendigkeit auf, Werte zu merken, ohne +sie in einer Datei zu speichern. Beispiel dafür ist ein Zählvorgang im +Druckmuster. In jedem Wiederholungsteil muß der dazukommende +Wert zum bisherigen, aufsummierten und aufbewahrten Wert addiert +werden. Das Zwischenergebnis der Zählung muß also irgendwo ge­ +speichert werden. + +#on("b")#Variablen#off("b")# Zu diesem Zweck gibt es Variablen. Sie sind +ähnlich wie +Felder in einer Datei. Ihre Existenz ist jedoch unabhängig von einer +Datei. Außerdem sind sie zu Anfang nicht einfach leer, sondern +haben einen undefinierten Wert. + Variablen müssen im Programm definiert werden. Sie existieren +dann während der Ausführung dieses Programms und gehen an­ +schließend verloren. Zu Beginn des Programms sind sie, wie schon +gesagt, undefiniert. + Eine Variable muß immer einen Typ haben. Dieser Typ ist für +die Lebensdauer der Variable unveränderlich. Die Variable kann +natürlich nur Werte dieses Typs annehmen. + Eine Variablendefinition (oder auch -deklaration) besteht aus +der Angabe eines Typs, dem Schlüsselwort VAR und einem freige­ +wählten Namen. Wie schon bei den Refinements darf ein solcher +Name nur aus Kleinbuchstaben (keine Umlaute) und eventuell Zif­ +fern bestehen. Dagegen darf der Name Leerzeichen enthalten. +Beispiel: + + + INT VAR zaehler; + TEXT VAR feldname; + REAL VAR mein ergebnis 1; + + +Das Semikolon am Ende beschließt die Definition. + Die Lebensdauer einer Variablen hängt davon ab, an welcher +Stelle sie definiert ist. Eine Variable, die im Druckmuster im Initia­ +lisierungsteil definiert ist, behält ihren Wert für die gesamte Dauer +des Druckvorgangs. Eine Variable in einem Abschnitt lebt dagegen +nur für eine Abarbeitung dieses Abschnitts. Bei der nächsten Abar­ +beitung ist sie wieder undefiniert. + Das gleiche gilt für Kopier- und Änderungsmuster. Auch hier +sind Variablen nur für die Dauer der Bearbeitung eines Satzes +gültig. + +#on("b")#Zuweisung#off("b")# Um einer Variablen einen Wert zu geben, führt +man eine +#on ("i")#Zuweisung#off("i")# aus. Die Zuweisung wird durch Doppelpunkt und Gleich­ +heitszeichen aneinandergeschrieben gekennzeichnet. Auf der linken +Seite steht die Variable, auf der rechten Seite eine Ausdruck: + + + zaehler := 1; + + +Wie oben schließt das Semikolon die Anweisung ab. Nach der Aus­ +führung hat die Variable den Wert 1. Der Wert vorher ist für die +Zuweisung egal, er kann definiert oder undefiniert sein. + Eine Variable kann in einem Ausdruck verwendet werden, indem +man einfach den Namen hinschreibt. Der Ausdruck + + + zaehler + 1 + + +hat nach der obigen Zuweisung den Wert 2. Eine Variable muß bei +der Verwendung definiert sein, sonst können beliebige Fehler ent­ +stehen. Es muß also vor der ersten Verwendung ausdrücklich eine +Zuweisung erfolgt sein. + Da Variablen in Ausdrücken verwendet werden können und +Ausdrücke auf der rechten Seite einer Zuweisung stehen, ist folgen­ +de Konstruktion möglich: + + + zaehler := zaehler + 1; + + +Diese Zeile bewirkt, daß der Wert der Variable um 1 erhöht wird. +Zuerst wird bei der Zuweisung der Wert des Ausdrucks auf der rech­ +ten Seite bestimmt. Zu diesem Zeitpunkt habe die Variable bei­ +spielsweise den Wert 1. Der Ausdruck hat dann den Wert 2 (1+1). +Dieser Wert wird der neue Wert der Variablen. + Bei der nächsten Ausführung würde sich der gleiche Vorgang +wiederholen, so daß die Variable anschließend den Wert 3 hat. + Auch bei der Zuweisung gilt natürlich, daß die Variable auf der +linken Seite den gleichen Datentyp haben muß wie der Ausdruck auf +der rechten Seite. + +#on("b")#Initialisierung#off("b")# Sie können Variablendeklaration und +Zuweisung +auch miteinander verknüpfen, so daß die Variable gleich zu Anfang +einen Wert erhält: + + + INT VAR zaehler := 0; + + +Dieses Verfahren ist eine gute Vorsichtsmaßregel, damit Sie keine +undefinierten Variablen verwenden. + +#on("b")#Inkrement#off("b")# Da der Fall so häufig auftritt, daß der Wert +einer Vari­ +ablen um einen bestimmten Wert erhöht wird (bei allen Zählvorgän­ +gen), gibt es auch dafür eine Abkürzung, und zwar die beiden Ope­ +ratoren INCR und DECR. + + + zaehler INCR 1; + mein ergebnis 1 DECR 24.4; + + +Die Operatoren sind für REALs und INTs definiert. INCR erhöht um +einen Betrag, DECR erniedrigt. Auf der rechten Seite darf wieder ein +beliebiger Ausdruck stehen. + Für TEXTe gibt es eine ähnliche Abkürzung, allerdings nur für +die Addition (Verkettung). Hier heißt der Operator CAT. Die beiden +folgenden Zeilen haben die gleiche Bedeutung: + + + feldname := feldname + "."; + feldname CAT "."; + + + +15.2 Weitere Konstruktionen + +#on("b")#IF#off("b")# Die Ihnen bereits bekannte IF-Konstruktion dient nicht +nur +dazu, Werte zu liefern, sondern steuert auch die Abarbeitung von +beliebigen Anweisungen. Diese Anweisungen können Kopier- und +Änderungsanweisungen sein (s. Kapitel 11), oder die oben beschrie­ +benen Zuweisungen. + In einem Teil der IF-Konstruktion können auch mehrere Anwei­ +sungen stehen. Diese müssen dann jedoch unbedingt durch Semiko­ +lon getrennt sein. Mehrere Anweisungen hintereinander haben ein­ +fach die Bedeutung der Ausführung in der notierten Reihenfolge. + Als drittes kann auch der ELSE-Teil weggelassen, da nicht in +jedem Fall ein Ergebnis erwartet wird. Falls die Bedingung nicht +zutrifft, muß nicht unbedingt etwas ausgeführt werden. + + + IF zaehler > 0 THEN + zaehler DECR 1; + mein ergebnis 1 INCR wert ("zaehlfeld") + END IF; + + +Auch diese IF-Konstruktion kann wieder geschachtelt werden. Für +viele Fälle gibt es jedoch einen ELIF-Teil, der die Verschachtelung +erspart: + + + IF f ("m/w") = "m" THEN + maenner INCR 1 + ELIF f ("m/w") = "w" THEN + frauen INCR 1 + ELSE + zweifelhaft INCR 1 + END IF; + + +Der ELIF-Teil beinhaltet noch einmal einen Test. Dieser Test wird +jedoch nur dann durchgeführt, wenn die erste Bedingung falsch war. +Gibt es noch mehr Wahlmöglichkeiten, können Sie beliebig viele +ELIF-Teile benutzen. + Beachten Sie, daß die letzte Anweisung in einem Teil der IF- +Konstruktion nicht unbedingt ein folgendes Semikolon haben muß +(das Semikolon soll nur trennen). Ein Semikolon an dieser Stelle +kann aber auch nicht schaden. + +#on("b")#Werteliefernde Programme#off("b")# Nicht nur Ausdrücke können Werte +lie­ +fern, sondern auch ganze Anweisungsfolgen. Dies ist eine Erweite­ +rung der werteliefernden IF-Konstruktion. Sie können dies für Ab­ +kürzungen oder Refinements ausnutzen. + + + endergebnis : + gesammelte zeichen CAT "."; + gesammelte zeichen . + + +In diesem Beispiel werden in einer Textvariable bestimmte Zeichen +gesammelt. Zum Schluß soll ein Punkt angefügt werden und dieser +Text dann als Ergebnis des Refinements geliefert werden. + Damit eine Anweisungsfolge einen Wert liefert, muß am Ende +der Anweisungsfolge ein Ausdruck stehen. Der Wert des Ausdrucks +nach Abarbeitung der Anweisungen ist dann der Wert der Anwei­ +sungsfolge. + Allerdings kann man den gleichen Wert oft verschieden aus­ +drücken. Folgendes Refinement hat die gleiche Wirkung wie oben: + + + endergebnis : + gesammelte zeichen + "." . + + +In manchen Fällen ist eine Formulierung als werteliefernde Anwei­ +sungsfolge jedoch übersichtlicher. + +#on("b")#Beispiel#off("b")# Zum Abschluß dieses Kapitels wollen wir als +Beispiel eine +statistische Auswertung einer Zahlenreihe als Druckmuster formu­ +lieren. + Gegeben sei eine Datei mit folgenden Feldern: + + + "Meßwert 1" + "Meßwert 2" + + +Wir wollen als Ergebnis Mittelwert und Standardabweichung der +beiden Meßwerte ausdrucken. Dazu dient das Druckmuster auf der +folgenden Seite. + Im Initialisierungsteil des Druckmusters werden die notwendi­ +gen Variablen definiert und initialisiert. Beachten Sie hier, daß in +einer Definition mehrere Variablen durch Komma getrennt aufgeführt +werden können, wenn sie den gleichen Typ haben. + Im Wiederholungsteil müssen dann jeweils die Zwischensummen +aktualisiert werden. Da mit der Funktion 'wert' eine relativ auf­ +wendige Umwandlung verbunden ist, wird der Wert des jeweiligen +Feldes erst einmal in einer Variable zwischengespeichert, da er +mehrmals benötigt wird. Diese Zwischenspeicherungsvariable muß +nicht initialisiert werden + Im Nachspann werden dann die Ergebnisse gedruckt. Die Formeln +sind jeweils als Abkürzungen definiert. Die Funktion 'zahltext' sorgt +dafür, daß die Werte mit drei Nachkommastellen (gerundet) aufge­ +führt werden. + Da die Formeln relativ komplex sind, werden sie auf mehrere +Zeilen verteilt (in ELAN hat das Zeilenende keine Bedeutung). + + + %% REAL VAR + %% messwert, + %% summe 1 := 0.0, quadratsumme 1 := 0.0, + %% summe 2 := 0.0, quadratsumme 2 := 0.0; + %% INT VAR anzahl := 0; + % WIEDERHOLUNG + %% anzahl INCR 1; + %% messwert := wert ("Meßwert 1"); + %% summe 1 INCR messwert; + %% quadratsumme 1 INCR messwert * messwert; + %% messwert := wert ("Meßwert 2"); + %% summe 2 INCR messwert; + %% quadratsumme 2 INCR messwert * messwert; + % NACHSPANN + &anz Meßwerte. + Meßwert 1 Meßwert 2 + Mittelwert &&mw1&&&& &&mw2&&&& + Standardabweichung &&st1&&&& &&st2&&&& + % ABKUERZUNGEN + &mw1 : zahltext (summe 1 / real (anzahl), 3) . + &mw2 : zahltext (summe 2 / real (anzahl), 3) . + &st1 : zahltext + (sqrt ((quadratsumme 1 - summe 1 * summe 1 / + real (anzahl)) / real (anzahl - 1)), 3) . + &st2 : zahltext + (sqrt ((quadratsumme 2 - summe 2 * summe 2 / + real (anzahl)) / real (anzahl - 1)), 3) . + + +Mit entsprechenden Formeln können Sie dieses Beispiel für Ihre +eigenen Statistiken erweitern. Die Beispiele der letzten beiden Ka­ +pitel sollten Ihnen genügend Anregungen dafür gegeben haben. + diff --git a/app/eudas/4.3/doc/eudas.hdb.16 b/app/eudas/4.3/doc/eudas.hdb.16 new file mode 100644 index 0000000..5f5d575 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.16 @@ -0,0 +1,350 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (171)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +16 Dateiverwaltung mit EUDAS + + + +16.1 Dateien im System + +Zum Bearbeiten von Dateien innerhalb des Systems gibt es das Menü +'Dateien', das Sie bereits in Kapitel 4 kurz kennengelernt haben. +An dieser Stelle sollen die übrigen Funktionen dieses Menüs be­ +sprochen werden. + + + -------------- + Dateien System + U Übersicht + -------------- + Datei + L Löschen + N Umbenennen + K Kopieren + P Platzbedarf + A Aufräumen + -------------- + +#center#Abb. 16-1 Menü 'Dateien' + + +Beachten Sie, daß alle Funktionen in diesem Menü mit Dateien +beliebiger Struktur arbeiten können, also sowohl mit Textdateien +als auch EUDAS-Dateien (und anderen). Dies liegt daran, daß +Dateien an dieser Stelle einfach als "schwarze Kästen" mit beliebi­ +gem Inhalt betrachtet werden. + +#on("b")#Übersicht#off("b")# Die Funktion 'Übersicht' haben Sie bereits +ausprobiert. +Sie zeigt in einem Editorfenster an der rechten Seite alle Dateien, +die sich in Ihrer Task befinden. Falls nicht alle Dateien auf den +Bildschirm passen, können Sie das Fenster mit HOP OBEN und HOP +UNTEN rollen. Sie verlassen die Übersicht wie üblich mit ESC 'q'. + +#on("b")#Löschen#off("b")# Auch die Funktion 'Löschen' sollten Sie schon +kennen. +Mit dieser Funktion verschwindet eine Datei auf Nimmerwieder­ +sehen. Daher werden Sie sicherheitshalber immer gefragt, ob Sie die +Datei wirklich löschen wollen. Sie können in einer Auswahl auch +alle zu löschenden Dateien ankreuzen (dann wird trotzdem nochmal +gefragt). + Eine EUDAS-Datei, die gerade geöffnet ist, können Sie nicht +löschen (sonst würde EUDAS zumindest durcheinanderkommen). Sie +müssen die Datei zuerst sichern - oder nicht sichern, aber die +Arbeitskopien löschen. + +#on("b")#Umbenennen#off("b")# Mit der Funktion 'Umbenennen' können Sie einer +Datei +einen neuen Namen geben. Sie werden zuerst aufgefordert, den alten +Namen der Datei einzugeben. Alternativ können Sie hier wieder die +umzubenennenden Dateien auswählen. Danach wird Ihnen (für jede +ausgewählte Datei) der alte Dateiname zum Überschreiben angebo­ +ten. + Sie können diesen Namen mit den üblichen Editierfunktionen +verändern oder mit HOP RUBOUT löschen und ganz neu eingeben. +Auf diese Weise sparen Sie sich erheblichen Tippaufwand, wenn Sie +einen langen Dateinamen an nur einer Stelle verändern wollen. + +#on("b")#Kopieren#off("b")# Wie in Abschnitt 11.2 bereits angedeutet, gibt es +eine +Funktion zum logischen Kopieren von Dateien. Dies ist eine Funk­ +tion, die sich auf spezielle Eigenschaften des EUMEL-Systems +stützt. Wenn Sie eine Datei #on("i")#logisch#off("i")# kopieren, wird lediglich ein +Verweis kopiert. Die Daten werden zunächst nur einmal für beide +Dateien gespeichert. + Natürlich hätte das Ganze wenig Sinn, wenn danach bei Ände­ +rungen immer beide Dateien geändert würden. Bei Änderungen an +einer Datei werden jedoch nur die geänderten Daten getrennt ange­ +legt, der Rest wird weiterhin gemeinsam benutzt. Die beiden Dateien +sind also nach außen hin komplett unabhängig, intern werden je­ +doch gemeinsame Daten so weit wie möglich geteilt. Auf diese Weise +wird sowohl Zeit als auch Speicherplatz gespart. + Dieses Verfahren ist besonders dann sinnvoll, wenn Sie sich +einen bestimmten Stand einer Datei aufbewahren wollen. In diesem +Fall stellen Sie sich eine logische Kopie her und arbeiten mit dem +Original weiter. Es werden dann nur die Daten zusätzlich angelegt, +die Sie seit der Kopie verändert haben. + EUDAS benutzt die gleiche Funktion auch für die Arbeitskopie. +Die Arbeitskopie teilt ebenfalls ihre Daten mit dem Original. Ande­ +renfalls wäre es ja auch zeitlich gar nicht möglich, beim Öffnen eine +Arbeitskopie anzufertigen. + Beim Aufruf der Funktion 'Kopieren' werden Sie zunächst nach +dem Namen der Datei gefragt (wie üblich mit Auswahlmöglichkeit). +Dann können Sie einen neuen Namen für die Kopie angeben. Dieser +neue Name darf jedoch nicht für eine andere Datei vergeben sein. +Wollen Sie eine andere Datei überkopieren, müssen Sie diese zu­ +nächst löschen. + Denken Sie daran, daß die hier beschriebene Funktion sich +wesentlich vom Kopieren im Menü 'Gesamtdatei' unterscheidet. Dort +wird nämlich eine tatsächliche Kopie durchgeführt, dafür können Sie +sich dann auch selektiv bestimmte Daten herausgreifen. Außerdem +gilt die dortige Funktion nur für EUDAS-Dateien. + +#on("b")#Platzbedarf#off("b")# Zu Ihrer Information können Sie sich auch den +Platz­ +bedarf anzeigen lassen, den eine Datei auf dem Speichermedium hat. +Wenn Sie den Namen der Datei angegeben haben, wird Ihnen die +Größe in "Kilobyte" (KB) angegeben. Ein KB entspricht etwa 1000 +Zeichen, also einer halben vollgeschriebenen Bildschirmseite. + Bei logisch kopierten Dateien wird für jede Datei der benötigte +Platz separat angegeben. Sie können die Zahlen also nicht einfach +addieren, um den Gesamtspeicherbedarf zu ermitteln, da Sie dann +die gemeinsam benutzten Bereiche doppelt zählen würden. + +#on("b")#Aufräumen#off("b")# Wenn eine Datei viel geändert wurde, führen zwei +Effekte zu einer langsameren Verarbeitung dieser Datei. Zum einen +wird durch Textleichen der Platzbedarf größer. Dies tritt vor allem +dann auf, wenn zu einzelnen Sätzen immer etwas hinzugefügt wurde +(eine Folge der Flexibilität, mit variablen Textlängen operieren zu +dürfen). + Da der Platzbedarf der Datei also wächst, sind mehr Speicher­ +zugriffe notwendig, als es dem Inhalt entspricht. Doch nicht nur der +Platz, sondern auch die Verteilung der Sätze machen sich unange­ +nehm bemerkbar. Da vergrößerte Sätze intern am Ende der Datei +gespeichert werden, werden logisch aufeinanderfolgende Sätze phy­ +sikalisch weit verstreut. + Der gleiche Effekt ensteht auch durch Umsortieren oder Ein­ +fügen von Sätzen. Um die Datei sequentiell zu bearbeiten, sind also +ständig wechselnde Speicherzugriffe erforderlich. + Die beiden beschriebenen Effekte führen zur Geschwindigkeits­ +verringerung. Dies kann verhindert werden, indem die Datei in eine +frische Datei umkopiert wird. Diesen Vorgang nennt man #on("i")#Reorgani­ +sieren#off("i")#. Dafür gibt es die Funktion 'Aufräumen'. + Während des Umkopierens werden die Satznummern ausgegeben. +Achten Sie darauf, daß zum Reorganisieren genügend Platz auf dem +System vorhanden ist, um eine komplette Kopie der zu reorganisie­ +renden Datei aufzunehmen. + Zum Reorganisieren muß nämlich tatsächlich eine physikalische +Kopie angefertigt werden. Eine logische Kopie oder das Schreiben +auf das Archiv reorganisieren eine Datei dagegen nicht, wohl aber +die Funktion 'Kopieren' im Menü 'Gesamtdatei'. + Da der Inhalt gelesen werden muß, funktioniert die Funktion +'Aufräumen' im Gegensatz zu den oben gemachten Versprechungen +nur für Textdateien oder EUDAS-Dateien, nicht aber für andere +Dateitypen. Die Unterscheidung der Dateitypen wird automatisch +vorgenommen. + + +16.2 Dateien auf dem Archiv + +Mit den Funktionen im Menü 'Archiv' können Sie nicht nur Dateien +auf dem Archiv behandeln, sondern auch in anderen Tasks oder per +EUMEL-Netz sogar auf anderen Rechnern. + + + -------------- + Dateien Archiv + U Übersicht + D Üb. Drucken + -------------- + Datei + K Kopieren + vom Archiv + S Schreiben + auf Archiv + L Löschen + auf Archiv + -------------- + Archivdiskette + I Init + -------------- + Z Zielarchiv + P Paßwort + R Reservieren + -------------- + +#center#Abb. 16-2 Menue 'Archiv' + + +#on("b")#Zielarchiv#off("b")# Dazu können Sie die Task einstellen, mit der +Sie arbei­ +ten möchten. Normaleinstellung ist die Task 'ARCHIVE', die Ihre +Archivdiskette bedient. Dies wird auch in der untersten Bildschirm­ +zeile angezeigt. + Die Task stellen Sie mit der Funktion 'Zielarchiv' ein. Sie +werden dann nach dem Namen der Task gefragt. Diese Task muß +eine Managertask sein (also unabhängig vom Bildschirm arbeiten) +und sie muß bereits existieren. + Wenn Sie auf Ihrem Rechner das EUMEL-Netz installiert haben, +werden Sie auch nach der Nummer der Zielstation gefragt, also der +Nummer des Rechners, auf dem die gewünschte Task arbeitet. Durch +Drücken von RETURN wird automatisch Ihre eigene Stationsnummer +verwendet. + Nun gibt es zwei Arten von Managertasks, mit denen EUDAS +zusammenarbeiten kann, #on("i")#Archivmanager#off("i")# und normale Dateimanager. +Der Unterschied besteht darin, daß ein Archivmanager für einen +Benutzer reserviert werden muß, damit man nicht auf Disketten +eines anderen Benutzers zugreifen kann. Normale Dateimanager +können und sollen dagegen von mehreren Benutzern in beliebiger +Reihenfolge angesprochen werden. + Manche Rechner haben mehrere Archivmanager für mehrere +Diskettenlaufwerke. Durch das Einstellen des Zielarchivs können Sie +auf verschiedenen Laufwerken archivieren. Ein Archivmanager kann +sich natürlich auch auf einem anderen Rechner befinden. Sie benut­ +zen dann dessen Diskettenlaufwerk. + Beim Einstellen des Zielarchivs wird als letztes gefragt, ob die +Zieltask ein Archivmanager ist oder nicht. Im Normalfall sollten Sie +die Frage bejahen, wenn Sie 'ARCHIVE' einstellen, und ansonsten +verneinen (s. die obigen Ausnahmefälle). + Das eingestellte Zielarchiv wird jeweils in der untersten Bild­ +schirmzeile angezeigt. + Die Reservierung eines Archivmanagers findet beim ersten Zu­ +griff statt. Beim Umschalten des Zielarchivs oder Verlassen des +Menüs wird die Reservierung automatisch wieder aufgehoben. + +#on("b")#Übersicht#off("b")# Mit der Funktion 'Übersicht' können Sie eine +Auflistung +aller Dateien abrufen, die sich auf der Archivdiskette (bzw. in dem +eingestellten Manager) befinden. Wie die Dateiübersicht im System +können Sie die Darstellung wie im Editor rollen und mit ESC 'q' +verlassen. + Wollen Sie die Übersicht gedruckt haben, rufen Sie die Funktion +'Übersicht drucken' auf. Die Übersicht wird dann nochmals zusam­ +mengestellt und gleich gedruckt. + +#on("b")#Schreiben und Lesen#off("b")# Mit den Funktionen 'Kopieren vom +Archiv' +und 'Schreiben auf Archiv' können Sie Dateien zwischen dem Archiv +und Ihrer Task hin und her transportieren. Es wird jeweils eine +Kopie angefertigt, das heißt das Original auf der Diskette oder in +Ihrer Task wird nicht verändert. + Wenn die transportierte Datei an ihrem Ziel schon existiert, +wird gefragt, ob die vorher existierende Datei gelöscht (überschrie­ +ben) werden soll. Überschreiben aus Versehen ist nicht möglich, +wenn Sie die Frage sorgfältig beantworten. + Beim Aufruf der Funktionen können Sie den gewünschten Da­ +teinamen angeben oder in der Auswahl ankreuzen. Die Auswahl ist +hier besonders sinnvoll, wenn Sie mehrere Dateien (eventuell sogar +in einer bestimmten Reihenfolge) sichern müssen. Außerdem können +Sie ja keine Datei transportieren, die nicht existiert; alle Möglich­ +keiten werden Ihnen also durch Ankreuzen angeboten. + Beachten Sie, daß beim Überschreiben einer Datei auf einer +Archivdiskette der Speicherplatz der alten (überschriebenen) Ver­ +sion im allgemeinen nicht wiederverwendet werden kann. In diesem +Fall kann das Archiv voll werden, obwohl eigentlich genügend Platz +da wäre. + +#on("b")#Löschen#off("b")# Das gleiche Problem tritt auf beim Löschen einer +Datei +auf dem Archiv. Mit der Funktion 'Löschen auf Archiv' können Sie +zwar die Datei auf der Diskette ungültig machen, der Platz wird +jedoch nur dann wiederverwendet, wenn es die letzte Datei auf der +Diskette war. Anderenfalls bleiben "Leichen" übrig, die Sie in der +Archivübersicht als Striche erkennen können. + Diese Probleme treten jedoch mit anderen Managern nicht auf, +da diese Ihren Speicherplatz intelligenter verwalten können. + +#on("b")#Initialisieren#off("b")# Als Abhilfe bei einem übergelaufenen Archiv +müssen +Sie das ganze Archiv initialisieren und neu beschreiben. Dazu gibt +es die Funktion 'Init'. + Diese Funktion müssen Sie auch dann verwenden, wenn Sie eine +Archivdiskette zum ersten Mal verwenden. Auf dem Archiv muß +nämlich als erstes der Archivname eingetragen werden, ehe es be­ +nutzt werden kann. Diesen Namen müssen Sie hier angeben. + Alle alten Daten des Archivs werden komplett gelöscht. Daher +müssen Sie vorher die noch gültigen Daten vom Archiv ins System +kopiert haben. Wenn das Archiv vorher schon beschrieben war, +werden Sie anhand des Namens gefragt, ob Sie die richtige Diskette +zum Überschreiben eingelegt haben. + Wenn Sie eine fabrikneue Diskette aus der Verpackung nehmen, +müssen Sie diese vor der Initialisierung #on("i")#formatieren#off("i")#. Dabei wird die +Diskette auf ein bestimmtes physikalisches Format eingestellt. Ohne +diese Operation ist weder Schreiben noch Lesen überhaupt möglich. + In der Regel muß eine Diskette nur einmal formatiert werden. +Sie können sie jedoch jederzeit wieder formatieren (wenn Sie zum +Beispiel nicht wissen, was Ihnen da für eine alte Diskette in die +Finger geraten ist). + Am Anfang des Initialisierens werden Sie gefragt, ob Sie die +Diskette formatieren wollen. Manche Rechner unterstützen diese +Operation innerhalb des EUMEL-Systems nicht. In diesem Fall (und +natürlich auch sonst normalerweise) müssen Sie die Frage vernei­ +nen. Das Formatieren muß dann vorher irgendwie außerhalb des +Systems geschehen sein. + Das Initialisieren funktioniert natürlich nur bei Archivmana­ +gern. Bei einer anderen Zieltask ist diese Funktion gesperrt. + +#on("b")#Paßwort#off("b")# Dateien in einem allgemeinen Dateimanager (nicht +jedoch +auf dem Archiv) können Sie mit einem Paßwort gegen unbefugten +Zugriff sichern. Sinnvolle Voraussetzung dafür ist, daß der Datei­ +manager selbst mit einem anderen Paßwort gegen Betreten gesichert +ist. + Das von Ihnen verwendete Paßwort geben Sie mit der Funktion +'Paßwort' ein. Damit Ihnen niemand über die Schulter schauen +kann, werden alle Zeichen auf dem Bildschirm als Punkte darge­ +stellt. Anschließend müssen Sie das Paßwort noch einmal eingeben, +damit sich kein unbemerkter Schreibfehler eingeschlichen hat. + Das Paßwort wird dann bei allen Transport- und Löschopera­ +tionen abgefragt. Eine Datei im Manager erhält Ihr Paßwort zuge­ +wiesen, wenn Sie sie das erste Mal im Manager ablegen. Bei allen +folgenden Zugriffen muß das gleiche Paßwort eingestellt sein, sonst +wird der Zugriff verweigert. + Natürlich können Sie für verschiedene Dateien verschiedene +Paßwörter einstellen. Trotz Einstellung eines Paßworts können auch +andere Benutzer ihre Dateien im gleichen Manager ablegen. + Sie können auch für Schreiben (und Löschen) sowie Lesen +unterschiedliche Paßwörter einstellen. Dazu benutzen Sie einfach +einen Trennstrich in der Form + + + Schreibpaßwort/Lesepaßwort + + +Soll eine Datei überhaupt nicht überschrieben oder gelöscht werden +können, können Sie '-' als Schreibpaßwort verwenden: + + + -/Lesepaßwort + + +Die Datei kann dann nur beim direkten Betreten der Managertask +verändert werden. + Wollen Sie die Paßworteinstellung wieder aufheben, drücken Sie +bei der Paßworteingabe nur RETURN, da der leere Text als "kein +Paßwort" interpretiert wird. + +#on("b")#Reservieren#off("b")# Wollen Sie eine Task als Zieltask verwenden, +die zwar +kein Archivmanager ist, aber reserviert werden muß (zum Beispiel +'DOS' zum Ansprechen fremder Diskettenformate) müssen Sie die +Reservierung mit der Funktion 'Reservieren' selbst vornehmen. Die +Zieltask darf nicht als Archivmanager gekennzeichnet sein (dann ist +die Funktion 'Reservieren' nämlich gesperrt). + Bei der Reservierung müssen Sie den Reservierungsparameter +(abhängig von der Art der Zieltask - bei 'DOS' beispielsweise den +Modus) als Text eingeben. Nach der Reservierung können Sie die +anderen Funktionen des Archivmenüs verwenden. + Die Freigabe der Zieltask erfolgt automatisch beim Verlassen +des Menüs oder beim Einstellen einer neuen Zieltask. + diff --git a/app/eudas/4.3/doc/eudas.hdb.2 b/app/eudas/4.3/doc/eudas.hdb.2 new file mode 100644 index 0000000..f3f14e1 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.2 @@ -0,0 +1,178 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (11)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +2 Installation des Programms + + + +Bevor Sie EUDAS auf Ihrem System benutzen können, müssen Sie das +Programm zuvor installieren. Wenn EUDAS schon auf Ihrem System +zur Verfügung steht, können Sie dieses Kapitel getrost überlesen. + + +2.1 Lieferumfang + +EUDAS wird auf einer Diskette geliefert, die alle notwendigen Pro­ +gramme enthält. Um den Inhalt der Diskette feststellen zu können, +starten Sie Ihr System und bringen es dazu, daß 'gib kommando:' +erscheint. Dann legen Sie die Diskette ein und geben das Kommando + + + archive ("EUDAS"); list (archive); release (archive) + + +Anschließend erscheint eine Übersicht der auf dem Archiv vorhan­ +denen Programmteile. Folgende Namen sollten sich in dieser Über­ +sicht wiederfinden: + + + "eudas.1" + "eudas.2" + "eudas.3" + "eudas.4" + "eudas.init" + "eudas.generator" + "Adressen" + + +Eventuell können noch weitere Namen in der Übersicht auftauchen. +Sollte einer der angegebenen Namen nicht vorhanden sein, rekla­ +mieren Sie die Diskette. Falls Sie statt der Übersicht eine Fehler­ +meldung erhalten, sollten Sie überprüfen, ob die Diskette das rich­ +tige Format besitzt oder Ihr Diskettenlaufwerk Probleme bereitet. + Wenn Sie so den Inhalt der Diskette kontrolliert haben, können +Sie EUDAS installieren. Je nachdem, ob Sie ein Single-User oder ein +Multi-User System benutzen, sind die Anweisungen unterschiedlich. +Sie brauchen nur den Sie betreffenden der beiden folgenden Ab­ +schnitte zu lesen. Falls Sie nicht wissen, welches System Sie benut­ +zen: ein Multi-User System wird auf der Systemdiskette und am +Bildschirm durch die Kennzeichnung 'EUMEL x.y.z/M' identifiziert, +bei einem Single-User System steht als letztes Zeichen ein 'S'. + + +2.2 Single-User + +Dieser Abschnitt betrifft Sie nur, wenn Sie EUDAS auf einem +Single-User System installieren wollen. + Sie können EUDAS immer nur auf einer bestimmten Hinter­ +grunddiskette installieren. Auf dieser Diskette sollten noch min­ +destens 250 KB frei sein (stellen Sie dies durch das Kommando +'storage info' sicher). EUDAS kann anschließend auch nur auf dieser +Diskette verwendet werden. + Starten Sie nun die gewünschte Diskette. Dann legen Sie die +Diskette, auf der EUDAS sich befindet, in das Archivlaufwerk. Geben +Sie dann das Kommando + + + archive ("EUDAS"); fetch ("eudas.generator", archive); run + + +Sie haben damit das Generatorprogramm gestartet, das die Installa­ +tion automatisch durchführt. Lassen Sie während dieses Vorganges +das EUDAS-Archiv eingelegt. Sie werden benachrichtigt, wenn die +Generierung abgeschlossen ist. + Wenn Sie EUDAS auf allen Ihren Hintergrunddisketten haben +möchten, können Sie das so erzeugte System als Muttersystem +sichern. Mit dem Kommando 'save system' können Sie den Hinter­ +grund komprimiert auf eine leere Archivdiskette schreiben. Mit +dieser Sicherung können Sie dann jederzeit neue Systemdisketten +wie von Ihrem Originalsystem herstellen. + +#on("b")#Einschränkungen#off("b")# Aus Platzgründen hat die +Single-User-Version von EUDAS folgende Einschränkungen: +#free (0.2)# + Sie können die Funktionen Ketten und Koppeln nicht verwenden. +#free (0.2)# + Sie können im Druckmuster keine ELAN-Anweisungen und -Aus­ + drücke verwenden. +#free (0.2)# + Es stehen nur einige allgemeine Hilfstexte zur Verfügung. +#free (0.2)# + Funktionen, die mehrere Tasks vorausssetzen, sind ebenfalls + gesperrt. +#free (0.2)# +Die betreffenden Funktionen sind zwar gegebenenfalls im Menü +enthalten, lassen sich aber nicht aufrufen. + + +2.3 Multi-User + +Dieser Abschnitt betrifft Sie nur, wenn Sie EUDAS auf einem Mul­ +ti-User System installieren wollen. + EUDAS muß in einer bestimmten Task installiert werden. Alle +neuen Söhne und Enkel dieser Task können dann EUDAS aufrufen. +Im Normalfall wird diese Task 'PUBLIC' sein. + Zum Installieren müssen Sie in diese Task gehen (in diesem +Beispiel 'PUBLIC'). Dazu rufen Sie durch Tippen der SV-Taste den +Supervisor und geben das Kommando + + + continue ("PUBLIC") + + +Stelle Sie mit Hilfe des 'storage info'-Kommandos fest, ob auf Ihrem +Hintergrund noch mindestens 300 KB frei sind (dieser Platz wird zur +Generierung benötigt). Dann legen Sie die EUDAS-Archivdiskette ein +und geben folgendes Kommando + + + archive ("EUDAS"); fetch ("eudas.generator", archive); run + + +Falls die Task 'PUBLIC' Söhne besitzt, werden Sie gefragt, ob Sie +diese löschen wollen. EUDAS steht nämlich nur in den Söhnen zur +Verfügung, die #on("i")#nach#off("i")# der Installation eingerichtet wurden. Antworten +Sie auf die Frage durch einfaches Tippen von 'j' oder 'n'. wenn Sie +die Frage verneinen, können Sie die Generierung zu diesem Zeit­ +punkt auch noch abbrechen und zunächst die Söhne aufräumen. + Es erscheint die Frage + + + Ausführliche Hilfstexte installieren ? (j/n) + + +Verneinen Sie die Frage, wenn in Ihrem System der Speicherplatz +kritisch ist (zum Beispiel wenn Sie keine Festplatte haben). Es +werden dann nur die wichtigsten allgemeinen Hilfstexte installiert +(Ersparnis etwa 40 KByte). + Anschließend wird die automatische Generierung gestartet. +Lassen Sie die EUDAS-Archivdiskette eingelegt. Die Generierung ist +beendet, wenn das EUMEL-Bild erscheint. Die Task, in der die +Generierung stattfindet, wird automatisch zu einer Managertask, das +heißt, daß man von ihr Söhne einrichten kann. + Sie können das so erweiterte System auch mit 'save system' auf +einer oder mehreren Archivdiskette sichern. Lesen Sie dazu die +Hinweise zur Systemsicherung im EUMEL-Systemhandbuch. + +#on("b")#Korrekturversionen#off("b")# Falls Sie später einmal eine +Korrekturversion +von EUDAS bekommen, sollten Sie vor der neuen Generierung die +Task, in der EUDAS vorher generiert war, löschen (Vorsicht: alle +Söhne werden mitgelöscht) und wieder neu einrichten. Anderenfalls +bleibt die alte Version als unzugängliche "Leiche" auf Ihrem System +liegen. + In diesem Fall und auch, wenn Sie mehrere Programme in der +gleichen Task installieren, kann es zum Überlauf der internen Über­ +setzertabellen kommen. Für größere Installationen oder wenn Sie +viele verschiedene Programme benutzen, empfiehlt es sich, zur +Generierung eine eigene Task 'EUDAS' als Sohn von 'PUBLIC' zu +verwenden. Sie dürfen dann aber in 'PUBLIC' nicht zu viel insertie­ +ren, da 'EUDAS' ja alle Programme von 'PUBLIC' erbt. Denken Sie +daran, daß Sie EUDAS nur in Tasks benutzen können, die unter der +Task 'EUDAS' eingerichtet wurden. + + + + + + diff --git a/app/eudas/4.3/doc/eudas.hdb.3 b/app/eudas/4.3/doc/eudas.hdb.3 new file mode 100644 index 0000000..e89ff4f --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.3 @@ -0,0 +1,515 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (15)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +3 Ein Beispiel zum Ausprobieren + + + +Bevor Sie in die tieferen Geheimnisse von EUDAS einsteigen, sollen +Sie in diesem Kapitel erst einige Erfahrungen mit der Bedienung +sammeln. Dadurch erhalten Sie Sicherheit im Umgang mit dem Pro­ +gramm und haben bereits einen Eindruck dessen, was Sie anschlie­ +ßend erwartet. + Das Durchlesen dieses Kapitels ist nur dann sinnvoll, wenn Sie +die Anweisungen selbst am Rechner ausprobieren. Anderenfalls +beginnen Sie besser mit dem nächsten Kapitel. + Im folgenden sind die Eingaben, die Sie machen sollen, kursiv +gedruckt, während Ausgaben des Rechners normal erscheinen. +Außerdem erscheinen spezielle Tasten in spitzen Klammern: + + + + + +Bitte tippen Sie nicht die eckigen Klammern oder Großbuchstaben, +sondern die entsprechende Taste. Oft haben die Sondertasten auch +etwas andere Bezeichnungen (die obige zum Beispiel 'CR', 'Carriage +Return', 'RETURN', 'ENTER'). Bitte fragen Sie bei Unklarheiten Ihren +Systemlieferanten oder -betreuer. + + +3.1 Start + +Die Anweisungen zum Starten von EUDAS sind unterschiedlich, je +nachdem wie Ihr System eingerichtet ist. Bitte beachten Sie daher +die verschiedenen Fälle. + +1. Falls Sie EUDAS nicht selbst installiert haben, fragen Sie am + besten Ihren Systembetreuer. Ansonsten verhalten Sie sich wie + unter 2. + +2. Falls Sie EUDAS nach den Anweisungen von Kapitel 2 in einem + Multi-User-System eingerichtet haben, müssen Sie zunächst eine + Arbeitstask (Arbeitsbereich) einrichten. Dazu tippen Sie die + SV-Taste (diese trägt häufig die unterschiedlichsten Bezeich­ + nungen). Es erscheint + + + EUMEL x.y.z/M + + gib supervisor kommando : + + + Sie tippen nun folgendes Kommando: + + + #on("i")#begin ("arbeit")#off("i")# + + + Vergessen Sie nicht die RETURN-Taste am Schluß. Machen Sie + jetzt weiter bei Punkt 4. + +3. Falls Sie ein Single-User-System besitzen, starten Sie die + Systemdiskette und geben das Datum ein. Dann machen Sie wei­ + ter mit Punkt 4. + +4. Danach erscheint: + + + gib kommando : + + + und Sie tippen: + + + #on("i")#eudas#off("i")# + + + Als Ergebnis wird das EUDAS-Eingangsmenü angezeigt (s. Abb. + 3-1 auf der nächsten Seite). + + +3.2 Daten eintragen + +Als Beispiel sollen Sie eine kleine Adressenkartei einrichten. Der +Fachausdruck für eine elektronische Kartei ist #on("i")#Datei#off("i")#. + +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + EUDAS-Datei : + O Öffnen : + - Ketten : + - Koppeln : EEEEE U U DDDD A SSSS + --------------: E U U D D A A S + Arbeitskopie : EEE U U D D AAAAA SSS + - Sichern : E U U D D A A S + --------------: EEEEE UUU DDDD A A SSSS + Aktuelle Datei: + - Notizen : Version 4.3 + - Feldstrukt. : Stand: 14.07.87 + - Prüfbeding. : + --------------: (C) Copyright + Mehrbenutzer : Thomas Berlage + M Manager : Software-Systeme + --------------: + : + : + : + : + : + Akt.Datei: Manager: Datum: 22.07.87 +___________________________________________________________________________________________ + + +#center#Abb. 3-1 EUDAS-Eingangsmenü + + + Zunächst müssen Sie eine neue Datei einrichten. Dazu tippen +Sie die Leertaste. Dadurch wird die invers dargestellte Funktion +'Öffnen' ausgeführt. Folgen Sie bitte dem nachstehenden Dialog auf +der rechten Bildschirmseite: + + + Name der Datei: #on ("i")#Mitglieder#off("i")# + "Mitglieder" neu einrichten ? (j/n) #on("i")#j#off("i")# + + +Unter der Überschrift 'Neue Feldnamen' tippen Sie jetzt folgendes +(bitte keine Leerstellen vor den Namen tippen): + + + #on("i")#Name#off("i")# + #on("i")#Vorname#off("i")# + #on("i")#PLZ#off("i")# + #on("i")#Ort#off("i")# + #on("i")#Strasse#off("i")# + #on("i")#m/w#off("i")##on("i")#q#off("i")# + + +Zum Schluß beantworten Sie noch eine Frage: + + + Feldnamen oder Feldtypen aendern ? (j/n) #on("i")#n#off("i")# + + +Damit ist die neue Datei eingerichtet. + Nun tippen Sie die Pfeiltaste . Es erscheint ein neues +Menübild (s. Abb. 3-2). + +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: Satz 1 .........ENDE... Mitglieder .......... Feld 1 + Positionieren : Name + W Weiter : Vorname + Z Zurück : PLZ + N Satz.Nr : Ort + --------------: Strasse + Suchbedingung : m/w + S Setzen : ........................................................... + L Löschen : + M Markierung : + --------------: + Datensatz : + E Einfügen : + A Ändern : + T Tragen : + H Holen : + --------------: + F Feldauswahl : + --------------: + : + : + : + +___________________________________________________________________________________________ + + +#center#Abb. 3-2 Menü 'Einzelsatz' + + +Nun tippen Sie so lange die Pfeiltaste , bis die Funktion +'Einfügen' invers markiert ist. Dann tippen Sie die Leertaste zum Aus­ +führen dieser Funktion. Die Schreibmarke springt nach rechts ins +Datenfeld zum Eingeben. Geben Sie jetzt den ersten Datensatz wie +folgt ein: + + + #on("i")#Wegner#off("i")# + #on("i")#Herbert#off("i")# + #on("i")#5000#off("i")# + #on("i")#Köln#off("i")# + #on("i")#Krämergasse 12#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# + + +Anschließend wird das Datenfeld wieder freigemacht, so daß Sie +gleich den zweiten Datensatz eingeben können. Dies tun Sie auf die +gleiche Weise, nur mit anderen Daten: + + + #on("i")#Sandmann#off("i")# + #on("i")#Helga#off("i")# + #on("i")#5300#off("i")# + #on("i")#Bonn 1#off("i")# + #on("i")#Willicher Weg 109#off("i")# + #on("i")#w#off("i")##on("i")#w#off("i")# + + +Ebenso verfahren Sie dann weiter mit den folgenden Daten. Falls Sie +sich vertippt haben, können Sie mit den vier Pfeiltasten an die +entsprechende Stelle gehen und die falschen Buchstaben über­ +schreiben. + + + #on("i")#Katani#off("i")# + #on("i")#Albert#off("i")# + #on("i")#5210#off("i")# + #on("i")#Troisdorf#off("i")# + #on("i")#Lindenstr. 3#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# + + #on("i")#Ulmen#off("i")# + #on("i")#Peter#off("i")# + #on("i")#5#off("i")# + #on("i")#Köln 60#off("i")# + #on("i")#Mozartstraße 17#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# + + #on("i")#Regmann#off("i")# + #on("i")#Karin#off("i")# + #on("i")#5000#off("i")# + #on("i")#Köln 90#off("i")# + #on("i")#Grengelweg 44#off("i")# + #on("i")#w#off("i")##on("i")#w#off("i")# + + #on("i")#Arken#off("i")# + #on("i")#Hubert#off("i")# + #on("i")#5200#off("i")# + #on("i")#Siegburg#off("i")# + #on("i")#Talweg 12#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# + + #on("i")#Simmern#off("i")# + #on("i")#Anna-Maria#off("i")# + #on("i")#5#off("i")# + #on("i")#Köln 3#off("i")# + #on("i")#Platanenweg 67#off("i")# + #on("i")#w#off("i")##on("i")#w#off("i")# + + #on("i")#Kaufmann-Drescher#off("i")# + #on("i")#Angelika#off("i")# + #on("i")#53#off("i")# + #on("i")#Bonn#off("i")# + #on("i")#Hauptstr. 123#off("i")# + #on("i")#w#off("i")##on("i")#w#off("i")# + + #on("i")#Fuhrmann#off("i")# + #on("i")#Harald#off("i")# + #on("i")#5000#off("i")# + #on("i")#Köln 1#off("i")# + #on("i")#Glockengasse 44#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# + + +Bei der letzten Adresse ist die letzte Taste unterschiedlich, da Sie +keine weiteren Daten mehr eintragen wollen. Bitte beachten Sie dies. + + + #on("i")#Seefeld#off("i")# + #on("i")#Friedrich#off("i")# + #on("i")#5000#off("i")# + #on("i")#Köln-Ehrenfeld#off("i")# + #on("i")#Kabelgasse#off("i")# + #on("i")#m#off("i")##on("i")#q#off("i")# + + +Damit die neu eingetragenen Daten permanent gespeichert sind, +müssen Sie sie #on("i")#sichern#off("i")#. Dazu kehren Sie durch Tippen von +in das erste Menü zurück. Dort tippen Sie wieder so lange , +bis die Funktion 'Sichern' markiert ist. Tippen Sie dann die Leer­ +taste zum Ausführen und folgen dem nachstehenden Dialog: + + + Arbeitskopie "Mitglieder" veraendert! Sichern ? (j/n) #on("i")#j#off("i")# + Alte Version ueberschreiben ? (j/n) #on("i")#j#off("i")# + Interne Arbeitskopien loeschen ? (j/n) #on("i")#j#off("i")# + + +Damit steht Ihnen nun eine Mitgliederdatei mit 10 Einträgen zur +weiteren Verfügung. + + +3.3 Daten abfragen + +Um Daten abzufragen, müssen Sie die Datei zunächst wieder öffnen. +Dazu bewegen Sie die inverse Markierung durch mehrmaliges Tippen +von nach oben bis zur Funktion 'Öffnen' und tippen Sie die +Leertaste. Danach ergibt sich folgender Dialog: + + + Name der Datei: #on("i")#Mitglieder#off("i")# + Wollen Sie etwas aendern (eine Arbeitskopie einrichten) + ? (j/n) #on("i")#n#off("i")# + + +Danach gehen Sie durch Tippen von in das zweite Menü. +Dort erscheint jetzt die zehnte Adresse. + Zunächst sollen Sie an den Anfang gehen. Dazu schieben Sie +die Markierung auf die Funktion 'Satz.Nr' mit Hilfe der Pfeiltasten +und tippen dann die Leertaste. Nach folgender Angabe + + + Neue Satznummer: #on("i")#1#off("i")# + + +erscheint die erste Adresse. Nun sollen Sie nach der Adresse von +Harald Fuhrmann suchen. Dazu bringen Sie die Markierung auf die +Funktion 'Suchbedingung Setzen' und tippen die Leertaste. Die +Schreibmarke springt wieder in das Datenfeld. Dort geben Sie ein: + + + #on("i")#Fuhrmann#off("i")##on("i")#q#off("i")# + + +In der markierten Überschrift erscheint 'SUCH-' zum Zeichen, daß +eine Suchbedingung eingestellt ist. Dann schieben Sie die Markie­ +rung auf die Funktion 'Weiter' und tippen die Leertaste. Kurz da­ +nach erscheint die Adresse von Herrn Fuhrmann mit dem Hinweis +'SUCH+' (gefunden). + Führen Sie dann die Funktion 'Zurück' aus (Verschieben der +Markierung und Tippen der Leertaste). Es erscheint wieder die erste +Adresse mit dem Hinweis 'SUCH-' (kein weiterer Fuhrmann gefun­ +den). Führen Sie dann die Funktion `Suchbedingung Löschen' aus. +Der 'SUCH'-Hinweis verschwindet wieder. + Als nächstes sollen Sie die Daten nach allen weiblichen Mit­ +gliedern durchsuchen. Dazu führen Sie wieder die Funktion 'Such­ +bedingung Setzen' aus. Diesmal tippen Sie im Datenfeld fünfmal die +Pfeiltaste , bis die Schreibmarke neben der Bezeichnung +'m/w' steht. Dort tippen Sie + + + #on("i")#w#off("i")##on("i")#q#off("i")# + + +Wenn Sie jetzt die Funktion 'Weiter' ausführen, erscheint das erste +weibliche Mitglied, Frau Sandmann. Da aber noch weitere Frauen in +der Datei vorkommen, führen Sie erneut 'Weiter' aus und es erschei­ +nen die nächsten weiblichen Mitglieder. + Wenn kein gesuchtes Mitglied mehr gefunden wurde, erscheint +ein leeres Datenfeld mit den Bezeichnungen 'ENDE' und 'SUCH-' in +der Überschrift. Durch mehrmaliges Ausführen von 'Zurück' können +Sie die weiblichen Mitglieder wieder in der umgekehrten Reihenfolge +ansehen, bis Sie an den Anfang der Datei kommen. + Bitte lassen Sie die Suchbedingung eingestellt, denn im näch­ +sten Abschnitt wollen wir alle weiblichen Mitglieder ausdrucken. + + +3.4 Drucken + +Zuerst begeben Sie sich durch zweimaliges Tippen von in +das Druckmenü, das in Abb. 3-3 gezeigt wird. + +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + Satzauswahl : + D Drucken : + --------------: + Druckausgabe : + R Richtung : + --------------: + Textdatei : + E Editieren : + A Ausdrucken : + N Nachbearb. : + --------------: + : + : + : + : + : + : + : + : + : + : + Akt.Datei: "Mitglieder" Datum: 22.07.87 +___________________________________________________________________________________________ + + +#center#Abb. 3-3 Menü 'Drucken' + + +Zunächst müssen Sie ein Druckmuster erstellen, das angibt, wie der +Druck aussehen soll. Dazu führen Sie die Funktion 'Textdatei Edi­ +tieren' aus. Es erscheint die Aufforderung: + + + Name der Datei: #on("i")#liste#off("i")# + + +Dann wird der Bildschirm gelöscht und Sie können folgendes einge­ +ben: + + + #on("i")#% VORSPANN#off ("i")# + #on("i")#Liste der weiblichen Mitglieder#off ("i")# + #on("i")#-------------------------------#off ("i")# + #on("i")#% WIEDERHOLUNG#off ("i")# + #on("i")#&Vorname %Name#off ("i")##on("i")#q#off("i")# + + +Ebenso wie beim Eingeben von Daten können Sie hier mit den Pfeil­ +tasten auf fehlerhafte Stellen zurückgehen und dort korrigieren. + Nun sollten Sie sich vergewissern, ob Ihr Drucker eingeschaltet +und bereit (Ready) ist. Falls Sie keinen Drucker haben, folgen Sie +bitte den Anweisungen unter 2. Anderenfalls gehen Sie wie folgt +vor. + +1. Rufen Sie die Funktion 'Richtung' auf und beantworten Sie + folgende Frage: + + + Ausgabe automatisch zum Drucker ? (j/n) #on("i")#j#off("i")# + + + Dann rufen Sie die Funktion 'Drucken' auf und geben den Namen + des Druckmusters an: + + + Name des Druckmusters: #on("i")#liste#off ("i")# + + + Als Ergebnis sollte folgende Liste auf Ihrem Drucker erscheinen: + + + Liste der weiblichen Mitglieder + ------------------------------- + Helga Sandmann + Karin Regmann + Anna-Maria Simmern + Angelika Kaufmann-Drescher + + +2. Rufen Sie die Funktion 'Richtung' auf und beantworten Sie + folgende Fragen: + + + Ausgabe automatisch zum Drucker ? (j/n) #on("i")#n#off("i")# + Ausgabe in bestimmte Datei ? (j/n) #on("i")#n#off("i")# + + + Dann rufen Sie die Funktion 'Drucken' auf und geben den Namen + des Druckmusters an: + + + Name des Druckmusters: #on("i")#liste#off ("i")# + + + Nach dem Ende des Druckprozesses (wenn das Sternchen vor + 'Drucken' wieder durch ein 'D' ersetzt worden ist), rufen Sie + wieder die Funktion 'Textdatei Editieren' auf und geben folgen­ + den Namen an: + + + Name der Datei: #on("i")#liste.a$1#off("i")# + + + Es erscheint die gleiche Ausgabe wie unter 1 beschrieben auf + dem Bildschirm. Wenn Sie die Ausgabe genug gesehen haben, + kehren Sie durch + + + #on("i")#q#off("i")# + + + wieder in das Menü zurück. + + +3.5 Ergebnis + +Da Sie sich wieder im Menü befinden, könne Sie EUDAS durch + + #on("i")#q#off("i")# + +wieder verlassen. Danach können Sie Ihre Sitzung beenden, etwas +Anderes tun oder EUDAS erneut aufrufen. + + Sie haben nun selbst ausprobiert, wie Sie unter EUDAS Daten +eingeben können, wie Sie diese Daten abrufen und in ihnen suchen +können. Sie haben die Daten auch schon ausgedruckt. + Damit Sie besser verstehen, was Sie soeben gemacht haben, +werden Sie in den folgenden vier Kapiteln die Grundfunktionen von +EUDAS mit den dazugehörigen Erläuterungen kennenlernen. + Danach können Sie dann selber Ihre eigene Anwendung entwer­ +fen und EUDAS zu Ihrer Arbeitserleichterung einsetzen. + + + + + + diff --git a/app/eudas/4.3/doc/eudas.hdb.5 b/app/eudas/4.3/doc/eudas.hdb.5 new file mode 100644 index 0000000..b5927ea --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.5 @@ -0,0 +1,386 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (43)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +5 Gespeicherte Daten abfragen + + + +5.1 Öffnen + +Als letzte Vorbereitung, bevor Sie mit der Adreßdatei spielen kön­ +nen, müssen Sie die Datei wie einen Karteikasten #on("i")#öffnen#off("i")#. Nach dem +Öffnen beziehen sich alle weiteren Funktionen auf die gerade ge­ +öffnete Datei. Aus diesem Grund darf auch immer nur eine einzige +Datei geöffnet sein - als hätte auf Ihrem Schreibtisch nur ein Kar­ +teikasten Platz. + Dazu wählen Sie jetzt wieder das erste Menü an. Dort finden +Sie die Funktion +#free (0.2)# + + O Öffnen + +#free (0.2)# +Wählen Sie diese Funktion aus. Dann drücken Sie die Leertaste, um +die Funktion auszuführen. Als erstes erscheint im unteren Teil des +Bildschirms eine Frage: + +___________________________________________________________________________________________ + + Wollen Sie etwas aendern (eine Arbeitskopie anlegen) (j/n) ? +___________________________________________________________________________________________ + + +Der Cursor bleibt hinter der Frage stehen. Sie kennen diesen Frage­ +zustand ja schon. + In diesem Fall wollen Sie an der Spieldatei nichts verändern, +Sie beantworten die Frage also mit einem 'n'. Als nächstes werden +Sie nach dem Namen gefragt (Beachten Sie auch hier wieder die +Statuszeile). + Tippen Sie nun 'Adressen' und beenden Sie die Eingabe mit +RETURN. EUDAS öffnet die Datei und kehrt zum Menü zurück. Alter­ +nativ können Sie die Datei auch in einer Auswahl ankreuzen, wenn +Sie ESC 'z' tippen. + +#on("b")#Fußzeile#off("b")# Nach der Ausführung dieser Funktion sollten Sie +Ihre +Aufmerksamkeit auf die letzte Zeile des Bildschirms richten. Hier +finden Sie jetzt folgendes vor: + +___________________________________________________________________________________________ + + Akt.Datei: "Adressen" Manager: Datum: 22.07.87 +___________________________________________________________________________________________ + + +Neben dem Datum und dem eingestellten Manager (dies kommt viel +später) sehen Sie hier, welche Datei Sie geöffnet haben und nun +bearbeiten können. Diese Fußzeile finden Sie auch in den ande­ +ren Menüs. Lediglich die mittlere Angabe ändert sich bei den ande­ +ren Menüs (eine Erläuterung dazu finden Sie in späteren Kapiteln). + +#on("b")#Anzeige#off("b")# Zum Anzeigen der Daten in der Adreßdatei müssen Sie +das +zweite Menü 'Einzelsatz' anwählen (durch Drücken der Pfeiltaste +RECHTS). Am linken Rand erscheint das neue Menü mit den Anzei­ +gefunktionen. Der Rest des Bildschirms enthält das Formular für die +Adreßdatei mit den Daten des ersten Satzes. Abbildung 5-1 zeigt +das Bild, das sich dann ergibt. + +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: Satz 1 ................... Adressen ....... Zeile 1 + Positionieren : Name Wegner + W Weiter : Vorname Herbert + Z Zurück : PLZ 5000 + N Satz.Nr : Ort Köln + --------------: Strasse Krämergasse 12 + Suchbedingung : m/w m + S Setzen : ........................................................... + L Löschen : + M Markierung : + --------------: + Datensatz : + - Einfügen : + - Ändern : + - Tragen : + - Holen : + --------------: + F Feldauswahl : + --------------: + : + : + : + +___________________________________________________________________________________________ + + +#center#Abb. 5-1 Menü 'Einzelsatz' + + +Das automatisch generierte Formular zeigt immer genau einen Satz. +Das Formular besteht aus drei Teilen: der Überschrift, dem Feldteil +und der Abschlußzeile. In der #on("i")#Überschrift#off("i")# steht der Name der Datei +("Adressen"), die Satznummer (1) und die Nummer der ersten ange­ +zeigten Zeile (immer 1, außer wenn die Datei mehr Felder hat, als +auf den Bildschirm passen). In manchen Fällen können auch noch +weitere Informationen dort auftauchen, wie wir später sehen wer­ +den. + Im #on("i")#Feldteil#off("i")# befindet sich der eigentliche Inhalt, und zwar sind +links markiert die Feldnamen zu sehen, während rechts die zugehö­ +rigen Inhalte des betreffenden Satzes stehen. Dieses Bild ähnelt +einer Karteikarte mit einem festen Format. + Die #on("i")#Abschlußzeile#off("i")# am Ende gibt an, daß für diesen Satz keine +weiteren Informationen mehr vorhanden sind. Wir werden aber spä­ +ter noch sehen, wie man anderenfalls die restlichen Informatio­ +nen sichtbar machen kann. + + +5.2 Bewegen + +Nun wollen Sie nicht immer nur einen Satz betrachten (das wäre ja +furchtbar langweilig). Daher müssen Sie die Möglichkeit haben, sich +in der Datei zu "bewegen". Dies geschieht mit Hilfe der beiden +Funktionen +#free (0.2)# + + W Weiter + +#free (0.2)# +und +#free (0.2)# + + Z Zurück + +#free (0.2)# +Sie haben die Wirkung, daß der Satz mit der nächsthöheren bzw. +nächstniedrigeren Satznummer angezeigt wird. Natürlich funktioniert +dies nur, wenn noch ein Satz vorhanden ist: am Anfang (Satz 1) +können Sie nicht zurückgehen. In diesem Fall ignoriert EUDAS Ihren +Befehl einfach. + Wenn Sie bis zum Ende der Datei gehen (keine Angst - diese +Datei enthält nur 10 Sätze), werden Sie feststellen, daß zum Schluß +ein ganz leerer Satz erscheint. Dieser Satz ist eine Art Endemarkie­ +rung; er informiert Sie, daß keine weiteren Sätze vorhanden sind. +Dieser Satz ist aber kein richtiger Satz, daher wird in der Über­ +schrift 'ENDE' angezeigt. (Wenn Ihnen diese Art Endemarkierung +merkwürdig erscheint: sie hat schon einen triftigen Grund, s.6.2). + Um einen Satz mit bekannter Satznummer gezielt anzuwählen, +können Sie die Funktion +#free (0.2)# + + N Satz.Nr + +#free (0.2)# +verwenden. Sie müssen anschließend die Satznummer eingeben (Bitte +mit RETURN beenden). Ist der Satz vorhanden, erscheint dieser, +ansonsten stehen Sie am Ende der Datei. + +#on("b")#Aufruf über Buchstaben#off("b")# Vielleicht ist Ihnen inzwischen +schon +aufgefallen, daß vor jeder Funktion in einem Menü ein Buchstabe +steht. Damit hat es folgendes auf sich: da das Positionieren des +Cursors zum Auswählen einer Funktion mehrere Tastendrücke erfor­ +dern kann, haben Sie die Möglichkeit, jede Funktion auch über +einen Buchstaben auszuführen. + Dies ist besonders dann sinnvoll, wenn Sie mit den eben be­ +sprochenen Funktionen schnell in der Datei "blättern" wollen. An­ +dererseits müssen Sie sich aber für eine schnelle Reaktion auch +einige der Tasten merken. Für die Praxis empfiehlt sich folgender +Kompromiß: die meistgebrauchten Funktionen über Buchstaben und +der Rest durch Positionieren im Menü. + + +5.3 Suchen + +Stellen Sie sich vor, die Datei wäre größer und Sie müßten eine +bestimmte Adresse heraussuchen. Dazu würden Sie durch die ganze +Datei durchgehen, bis die gewünschte Adresse erscheint. Das wäre +natürlich bei vielen Adressen eine ungeheuer mühselige Arbeit, die +mit einem Karteikasten wahrscheinlich schneller zu erledigen wäre. + EUDAS bietet Ihnen jedoch die Möglichkeit, nach bestimmten +Sätzen zu suchen. Dazu müssen Sie angeben, wonach gesucht werden +soll. Als Beispiel wollen wir die Adresse von Frau Simmern su­ +chen. Bewegen Sie sich zunächst zurück bis auf den ersten Satz. +Dann wählen Sie die Funktion +#free (0.2)# + + Suchbedingung + S Setzen + +#free (0.2)# +Auf dem Bildschirm verschwinden die Feldinhalte und der Cursor +steht hinter dem ersten Feldnamen. Dies bedeutet, daß Sie neben +die Feldnamen etwas schreiben können. Auch in der Statuszeile +erscheint statt der Anzeige der Menünamen ein Hinweis auf die +Eingabemöglichkeit (s. Abb. 5-2). Sie befinden sich jetzt in einem +Zustand, in dem Sie hinter die Feldnamen etwas schreiben können +(dem sogenannten #on("i")#Satzeditor#off("i")#). + Als Angabe, was gesucht werden soll, schreiben Sie jetzt in der +ersten Zeile neben 'Name' die Bedingung 'Simmern'. Sie haben jetzt +ein einfaches #on("i")#Suchmuster#off("i")# angegeben. Ein Suchmuster besteht aus +Bedingungen, die neben die Feldnamen geschrieben werden. Unser +einfaches Suchmuster lautet übersetzt: + + Wähle alle Sätze aus, bei denen 'Simmern' im Feld 'Name' + steht. + +Beenden Sie die Eingabe des Suchmusters mit ESC 'q'. Es erscheint +wieder das vorherige Bild, mit dem Unterschied, daß jetzt in der +Überschrift ein 'SUCH-' auftaucht. EUDAS steht immer noch auf dem +ersten Satz. + Die Anzeige 'SUCH' gibt an, daß ein Suchmuster eingestellt +wurde. Das Minuszeichen bedeutet, daß der aktuelle Satz die Such­ +bedingung jedoch #on("i")#nicht#off("i")# erfüllt. + +___________________________________________________________________________________________ + + SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? + --------------: Satz 1 .................... ............... Zeile 1 + Positionieren : Name Simmern + W Weiter : Vorname + Z Zurück : PLZ + N Satz.Nr : Ort + --------------: Strasse + Suchbedingung : m/w + * Setzen : ........................................................... + L Löschen : + M Markierung : + --------------: + Datensatz : + - Einfügen : + - Ändern : + - Tragen : + - Holen : + --------------: + F Feldauswahl : + --------------: + : + : +___________________________________________________________________________________________ + + +#center#Abb. 5-2 Eingabe eines Suchmusters + + +#on("b")#Positionierung#off("b")# Das Suchen beginnt erst, wenn Sie sich in +der Datei +bewegen. In diesem Fall erhalten die Funktionen 'Satz weiter' und +'Satz zurück' eine etwas geänderte Bedeutung. Sie gehen nämlich +nicht einfach zum nächsten bzw. vorigen Satz, sondern zum näch­ +sten bzw. vorigen Satz. + Als Indikator, daß Sie sich auf dem gesuchten Satz befinden, +dient die Anzeige 'SUCH+'. Probieren Sie dies jetzt aus, indem Sie +weitergehen. Als nächster Satz erscheint der gewünschte Satz 7. Die +nicht ausgewählten Sätze wurden also übersprungen. Das gleiche +passiert, wenn Sie noch weiter gehen. Da kein passender Satz mehr +vorhanden ist, erscheint der leere Endesatz. + +#limit (12.0)# + Denken Sie daran, daß das Einstellen der Suchbedingung + noch keine Suche bewirkt. Diese müssen Sie selbst + durch Positionieren mit 'Weiter' oder 'Zurück' auslösen. +#limit (13.5)# + +Sollten Sie sich nicht am Anfang der Datei befinden, wenn Sie eine +Suchbedingung einstellen, kann es sein, daß sich der gesuchte Satz +vor oder hinter der aktuellen Position befindet. In diesem Fall +müssen Sie entscheiden, ob Sie vorwärts oder rückwärts gehen. +Wenn Sie rückwärts gehen und der Satz ist nicht in diesem Ab­ +schnitt, erscheint der erste Satz mit der Anzeige 'SUCH-'. Gehen Sie +dann wieder vorwärts, finden Sie den Satz auf jeden Fall. + Die Funktion 'Satz.Nr' richtet sich natürlich nicht nach der +eingestellten Bedingung, da Sie ja eine bestimmte Satznummer wün­ +schen. Aus der 'SUCH'-Anzeige können Sie jedoch entnehmen, ob +die Suchbedingung auf diesen Satz zutrifft. + +#on("b")#Suchbedingung löschen#off("b")# Wollen Sie wieder alle Sätze sehen, +müssen Sie die Funktion +#free (0.2)# + + Suchbedingung + L Löschen + +#free (0.2)# +auswählen. Die Anzeige 'SUCH' verschwindet wieder, um anzudeu­ +ten, daß keine Suchbedingung mehr eingestellt ist. + +#on("b")#Beispiel#off("b")# Um den Charakter einer Selektion nochmal deutlich +zu +machen, sollen Sie jetzt eine Bedingung einstellen, die auf mehrere +Sätze zutrifft. Dies hätte uns auch eben passieren können, wenn es +mehrere Simmern gegeben hätte. Wir können zum Beispiel alle weib­ +lichen Personen auswählen. + Als erstes löschen Sie die alte Suchbedingung. Tun Sie dies +nicht, wird Ihnen beim nächsten Eingeben das alte Suchmuster zum +Ändern angeboten. Dies ist praktisch, wenn ein Suchmuster nicht +den erhofften Erfolg brachte und Sie es modifizieren wollen. + Danach wählen Sie erneut die Funktion 'Suchbedingung setzen'. +Nun bewegen Sie den Cursor mit der Pfeiltaste UNTEN neben den +Feldnamen 'm/w'. Dort tragen Sie die Bedingung 'w' ein. Verlassen +Sie die Eingabe mit ESC 'q'. + Wenn Sie sich jetzt in der Datei bewegen, sehen Sie, daß immer +nur weibliche Personen angezeigt werden - die männlichen werden +unterdrückt (in Umkehrung der Realität). + + + ! 1 ! ! 3 ! 4 ! ! 6 ! + +-----+-----+-----+-----+-----+-----+-----+ + !Name ! .. ! ! .. ! .. ! ! .. ! + ! ! ! ! ! ! ! ! + : : : : : + ! ! ! ! ! ! ! ! + !m/w ! w ! ! w ! w ! ! w ! + +-----+-----+ +-----+-----+ +-----+ + +#center#Abb. 5-3 Wirkung einer Selektion + + + +5.4 Suchbedingungen + +Im letzten Abschnitt haben Sie gesehen, wie das Einstellen einer +Suchbedingung funktioniert. In diesem Abschnitt sollen Sie weitere +Möglichkeiten zur Formulierung von Suchmustern kennenlernen. + Die erste Möglichkeit kennen Sie schon. Wenn neben einen +Feldnamen ein Text geschrieben wird, bedeutet dies, daß ausge­ +wählte Sätze im Inhalt dieses Feldes mit dem Text übereinstimmen +müssen. + +#on("b")#Kombination#off("b")# Nun kann es sein, daß mehrere Bedingungen +gelten +müssen. Im ersten Beispiel des vorigen Abschnitts hätten wir zum +Beispiel auch noch den Vornamen 'Anna-Maria' angeben können, um +bei mehreren Simmern die richtige auszuwählen. Wird also in mehre­ +re Felder eine Bedingung geschrieben, müssen alle diese Bedingun­ +gen gleichzeitig zutreffen. + Würden Sie in unserem Beispiel noch als dritte Bedingung 'm' +für das Feld 'm/w' angeben, würde gar kein Satz mehr ausgewählt, +da Anna-Maria Simmern natürlich nicht männlich ist. Auch das +kann also passieren. + + + Name Simmern + Vorname Anna-Maria + .. + .. + m/w m + +#center#Abb. 5-4 Kombination von Bedingungen + + +#on("b")#Stern#off("b")# Die Bedingungen, die wir bis jetzt kennengelernt +haben, +müssen alle ganz exakt zutreffen. Häufig tritt aber der Fall auf, +daß der gesuchte Name nicht genau bekannt ist. In diesem Fall +kann der Name im Suchmuster auch teilweise eingegeben werden. +Der unbekannte Teil am Anfang oder am Ende wird einfach durch +einen Stern markiert. + Wenn Sie also als Bedingung 'Sim*' für den Namen angeben, so +würde dies auf den Namen Simmern zutreffen, aber zum Beispiel +auch auf Simmerath oder Simon. Die Bedingung '*mern' würde nicht +nur auf Simmern zutreffen, sondern auch auf Pommern. + Der Stern kann aber auch für einen leeren Text stehen. So +trifft 'Simmern*' auf Simmern zu, aber auch auf Doppelnamen. die +mit Simmern beginnen. Wissen Sie jetzt nicht, ob Simmern in dem +Doppelnamen vorne oder hinten erscheint, können Sie auch an bei­ +den Seiten einen Stern machen. Die Bedingung '*Simmern*' trifft +nicht nur auf Simmern, sondern sowohl auf Deckerath-Simmern als +auch auf Simmern-Jakob zu. + Es gibt noch eine Reihe von weiteren Möglichkeiten, Bedingun­ +gen im Suchmuster zu formulieren. Auch komplexe Kombinationen +von Bedingungen sind möglich. Mit dem bisher Besprochenen sollten +Sie aber in vielen Fällen auskommen. Die übrigen Möglichkeiten +werden in Abschnitt 10.2 erklärt. Schauen Sie bei Bedarf dort nach. + + diff --git a/app/eudas/4.3/doc/eudas.hdb.6 b/app/eudas/4.3/doc/eudas.hdb.6 new file mode 100644 index 0000000..e617881 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.6 @@ -0,0 +1,394 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (51)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +6 Daten eingeben und ändern + + + +6.1 Neue Datei einrichten + +Nachdem Sie sich bis jetzt an einer existierenden Datei erprobt +haben, können Sie nun dazu übergehen, eine eigene neue Datei +einzurichten. Als Beispiel sollen Sie ein kleines Telefonregister +erstellen. + Dazu gehen Sie wieder in das Menü 'Öffnen' zurück und wäh­ +len erneut die Funktion +#free (0.2)# + + O Öffnen + +#free (0.2)# +indem Sie mehrmals OBEN tippen, bis die Funktion markiert. Dann +tippen Sie die Lerrtaste zum Ausführen. Als Dateinamen geben Sie +'Telefonnummern' an. + Da die Datei 'Telefonnummern' noch nicht existiert, werden Sie +gefragt: + + + "Telefonnummern" neu einrichten ? (j/n) #on("i")#j#off("i")# + + +Es kann ja sein, daß Sie sich vertippt haben und eine andere, +existierende Datei meinten. In unserem Fall wird die Datei aber +wirklich neu eingerichtet, daher bejahen Sie die Frage. + +#on("b")#Feldnamen eingeben#off("b")# Wenn Sie beim Öffnen eine Datei neu +einrich­ +ten, müssen Sie zuerst die Feldnamen festlegen, zum Beispiel diese: + + + 'Name' + 'Vorname' + 'Strasse' + 'PLZ' + 'Ort' + 'Telefon' + 'Bemerkungen' + + +Ihnen wird jetzt Gelegenheit gegeben, die Feldnamen untereinander +einzugeben. Zur Korrektur können Sie die gleichen Tasten verwen­ +den wie im Editor (beachten Sie dazu die Statuszeile am oberen +Bildschirmrand. + Geben Sie die Namen in dieser Reihenfolge ein. Tippen Sie nach +jedem Namen die RETURN-Taste, damit der nächste Name in eine +neue Zeile kommt. Beenden Sie die Eingabe mit ESC 'q'. + Die folgende Frage ermöglicht es Ihnen, noch weitere Eigen­ +schaften der Felder festzulegen. Dies ist jedoch im Normalfall nicht +nötig. Beantworten Sie also die Frage mit 'n'. Ihre Datei ist nun +eingerichtet. + Wie Sie sehen, besteht das Einrichten einer Datei eigentlich +nur aus der Eingabe der Feldnamen. Wenn Sie später noch Felder +anfügen wollen, ist dies ohne weiteres möglich. + + +6.2 Sätze Einfügen + +Nachdem die Datei nun eingerichtet worden ist, sollen Sie zunächst +einige Sätze eingeben. Wenn Sie wieder das Menü 'Einzelsatz' an­ +wählen, sehen Sie nur den leeren Satz mit der Anzeige 'ENDE', der +das Dateiende markiert. Um neue Sätze aufzunehmen, gibt es die +Funktion +#free (0.2)# + + E Einfügen + +#free (0.2)# +Wenn Sie diese Funktion aufrufen, geschieht etwas Ähnliches wie +beim Eingeben des Suchmusters. Der Cursor wandert wieder hinter +den ersten Feldnamen und in der Statuszeile erscheint die Auffor­ +derung + +___________________________________________________________________________________________ + + SATZ EINFUEGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? +___________________________________________________________________________________________ + + +Sie können nun die Feldinhalte der einzelnen Felder neben die +entsprechenden Feldnamen schreiben. Mit der RETURN-Taste schlie­ +ßen Sie eine Zeile ab und gelangen in die nächste. + Um eventuelle falsche Eingaben zu korrigieren, können Sie +ähnlich wie im Editor mit den Pfeiltasten herumfahren und falsche +Eingaben überschreiben. Die Taste RUBOUT löscht falsche Zeichen. +Sie beenden die Eingabe mit ESC 'q'. Anschließend ist der neue Satz +vorhanden. + + +#free (4.5)# + +#center#Abb. 6-1 Einfügen + + +#on("b")#Wirkung#off("b")# Die Wirkungsweise der Funktion 'Einfügen' +verdeutlicht +die Abb. 6-1. Dargestellt ist ein Ausschnitt aus einer Datei mit den +Sätzen 4 bis 7 und durch Buchstaben dargestellten, beliebigen In­ +halten. Satz 6 sei der aktuelle Satz. + Beim Einfügen wird nun vor dem aktuellen Satz eine Lücke für +den neuen Satz geschaffen, die zunächst noch leer ist und dann von +Ihnen ausgefüllt werden muß. Die Satznummern aller folgenden Sätze +erhöhen sich um 1. + Die Leerstelle bleibt nur dann erhalten, wenn Sie Daten für den +neuen Satz eingeben. Anderenfalls wird nach ESC 'q' wieder der alte +Zustand hergestellt. + Dieses Verfahren erklärt auch, warum das Ende der Datei ein +leerer Pseudosatz ist. Um nämlich am Ende der Datei einen neuen +Satz anzufügen, muß man vor dem Endesatz einen Satz einfügen. + Nachdem Sie also jetzt den ersten Satz eingegeben haben, +müssen Sie sich wieder zum Ende bewegen, damit der nächste Satz +hinter dem ersten steht. Für diesen häufig benötigten Vorgang gibt +es eine Abkürzung: Wenn Sie die Eingabe mit ESC 'w' (Weiter) statt +ESC 'q' beenden, geht EUDAS nach dem Einfügen des Satzes weiter +zum nächsten und fügt dort wieder einen Satz ein. + Auf diese Weise können Sie also schnell eine ganze Reihe von +Sätzen nacheinander eingeben. Nachdem Sie einen Satz eingegeben +haben, tippen Sie ESC 'w' und können gleich anschließend schon mit +der Eingabe des nächsten Satzes beginnen. Alle so eingegebenen +Sätze erscheinen nachher in der Reihenfolge der Eingabe. + +#on("b")#Satzeditor#off("b")# Bei der Eingabe eines neuen Satzes haben Sie +nahezu +alle Möglichkeiten, die auch der EUMEL-Editor bietet. Der be­ +schreibbare Bereich ist jedoch kleiner. Er umfaßt das ganze Gebiet, +in dem sonst die Feldinhalte erscheinen. + Wie beim Editor können Sie den Cursor mit den Cursortasten +(Pfeiltasten) bewegen. Mit der Taste RUBOUT können Sie ein Zeichen +löschen. Die restlichen Zeichen der Zeile rücken dann nach. Mit +RUBIN dagegen schalten Sie in einen Einfügemodus um. Alle einge­ +gebenen Zeichen werden dann eingefügt - der Rest der Zeile rückt +entsprechend nach rechts. Nochmaliges Tippen von RUBIN schaltet +wieder in den alten Modus. Welcher Modus eingeschaltet ist, steht +in der Überschriftzeile. + Mit der Kombination ESC RUBOUT können Sie den Rest einer +Zeile ab der Cursorposition löschen. Steht der Cursor in der ersten +Spalte, wird dementsprechend die ganze Zeile gelöscht. Im Unter­ +schied zum EUMEL-Editor rücken die folgenden Zeilen jedoch nicht +herauf. + Entsprechend fügen Sie mit der Funktion ESC RUBIN eine neue +Zeile ein. Dies ist immer dann erforderlich, wenn ein Feldinhalt +nicht auf eine Zeile paßt. Der Teil der Zeile, der hinter dem Cursor +steht, wird bei ESC RUBIN in die neue Zeile mitgenommen. + Normalerweise tippen Sie ESC RUBIN, wenn Sie an das Ende +einer Zeile kommen. Wenn Sie aber weiterschreiben, wird die Zeile +einfach gerollt. Dies ist nicht weiter schlimm, aber Sie können den +ganzen Feldinhalt nicht auf einmal sehen. + In der normalen Anzeige wird ein überlanger Inhalt auf jeden +Fall auf mehrere Zeilen verteilt. + +#on("b")#Warnung#off("b")# Ein Hinweis für alle, die sich mit der +Editorbedienung +schon auskennen: EUDAS benutzt den Editor als Unterprogramm. +Jedoch haben einige Editorfunktionen unliebsame Auswirkungen. +Besonders gefährlich sind hier HOP RUBOUT und HOP RUBIN. Diese +Funktion zerstören die Korrespondenz zwischen Feldnamen und +Feldinhalten, das heißt der Feldinhalt steht nicht mehr neben dem +Feldnamen. + Weiterhin können Sie das Editorbild rollen, ohne daß die Feld­ +namen mitrollen (zum Beispiel wenn Sie in der untersten Zeile +RETURN drücken). In diesem Fall ist die Korrespondenz auch nicht +erhalten, das heißt die Inhalte stehen falsch, sind aber eigentlich +richtig. + In solchen Fällen erscheint am oberen oder unteren Rand der +Hinweis "Bitte ESC '1' druecken". Wenn das Editorbild nur gerollt +wurde, verschwindet durch ESC '1' der Hinweis wieder und das Bild +ist in Ordnung. Wenn jedoch Zeilen gelöscht oder eingefügt wurden, +müssen Sie diese Änderungen von Hand wieder rückgängig machen, +bis der Hinweis verschwindet. Sie sollten also HOP RUBOUT und HOP +RUBIN im Satzeditor nicht verwenden. + Im Zweifelsfall, wenn Sie meinen, den Satz durcheinanderge­ +bracht zu haben, können Sie immer mit ESC 'h' abbrechen. Es steht +dann der vorherige Zustand für einen neuen Versuch zur Verfügung. + + +6.3 Daten ändern + +Wenn Sie nachträglich noch eingegebene Daten ändern wollen, kön­ +nen Sie die Funktion +#free (0.2)# + + A Ändern + +#free (0.2)# +verwenden. Sie haben anschließend wie beim Einfügen Gelegenheit, +neue Daten einzugeben. Allerdings werden Ihnen die bisherigen +Daten gleich mit angeboten, so daß Sie nur die Änderungen ein­ +geben müssen. Alles andere kann unverändert bleiben. Auch diese +Funktion wird mit ESC 'q' verlassen. ESC 'w' funktioniert beim +Ändern ebenfalls (der nächste Satz wird zum Ändern angeboten). + Stellen Sie beim Ändern oder Einfügen fest, daß Sie irgendeinen +krassen Fehler gemacht haben, können Sie die Operation mit ESC 'h' +abbrechen. Beim Ändern bleibt dann der alte Zustand unverändert, +beim Einfügen wird kein Satz eingefügt. + +#on("b")#Löschen#off("b")# Für den Fall, daß Sie einen Satz wieder ganz aus +der +Datei löschen wollen, hat EUDAS eine besondere Vorsichtsmaßnahme +vorgesehen. Damit der Satz nicht gleich unwiederbringlich verloren­ +geht, müssen Sie ihn zunächst in eine andere Datei #on("i")#tragen#off("i")#. Falls +das Löschen ein Irrtum war, können Sie den Satz von dort noch +wiederholen. In vielen Fällen besteht ohnehin die Anforderung, daß +auch die nicht mehr aktuellen Daten noch eine gewisse Zeit aufge­ +hoben werden müssen. + Zum Tragen gibt es die Funktion + + + Datensatz + T Tragen + + +Sie werden nach einem Dateinamen gefragt. Geben Sie hier zum +Beispiel 'müll' an. Da diese Datei noch nicht existiert, werden Sie +gefragt, ob Sie sie neu einrichten wollen (falls Sie sich vielleicht +verschrieben haben). Danach wird der aktuelle Satz in die Datei +'müll' transportiert. Am Bildschirm erscheint der nächste Satz. Der +getragene Satz kommt an das Ende der Zieldatei. + Eine Bedingung beim Tragen ist, daß die Zieldatei immer die +gleichen Felder haben muß wie die aktuelle Datei. Sie können also +nicht aus verschieden strukturierten Dateien in die gleiche Datei +tragen. + Zum Zurückholen eines Satzes benutzen Sie die Funktion + + + Datensatz + H Holen + + +Der letzte Satz der Datei, die Sie angeben, wird vor dem aktuellen +Satz eingefügt. Dadurch wird der Effekt des letzten Tragens wieder +aufgehoben. + Um die getragenen Sätze endgültig zu vernichten, müssen Sie +die Zieldatei als Ganzes löschen. Die dazu notwendige Funktion aus +dem Menü 'Dateien' haben Sie bereits in Abschnitt 4.4 kennenge­ +lernt. + + +6.4 Arbeitskopie sichern + +Wenn Sie eine Datei zum Ändern öffnen oder sie gerade neu einge­ +richtet haben, wird von dieser Datei intern eine Arbeitskopie ange­ +legt, die dann geändert wird. Sie müssen diese Arbeitskopie nach +den Änderungen sichern, damit die Änderungen wirksam werden. + In unserem Beispiel ist die Datei "Telefonnummern" immer noch +leer. Die Änderungen sind momentan nur in der internen Kopie +vorhanden. Wenn Sie die Datei zum Beispiel auf eine Archivdiskette +schreiben wollten, würden Sie eine leere Datei auf der Diskette +haben. + Zum Sichern rufen Sie die Funktion +#free (0.2)# + + S Sichern + +#free (0.2)# +im ersten Menü auf. Es erscheint dann folgende Frage: + +___________________________________________________________________________________________ + + Arbeitskopie "Telefonnummern" veraendert! Sichern (j/n) ? +___________________________________________________________________________________________ + + +Beantworten Sie diese Frage mit 'j'. Als nächstes wird gefragt: + +___________________________________________________________________________________________ + + Alte Version überschreiben (j/n) ? +___________________________________________________________________________________________ + + +Beantworten Sie auch diese Frage mit 'j'. Die Arbeitskopie über­ +schreibt dann die (leere) Version vor dem Ändern. + Wenn Sie die Frage verneint hätten, könnten Sie anschließend +einen neuen Namen für die Arbeitskopie angeben. Dies wäre dann +sinnvoll, wenn Sie den Stand vor den Änderungen noch aufbewahren +wollen. In diesem Fall ist es jedoch nutzlos, die alte leere Datei +noch behalten zu wollen. + Abschließend wird gefragt, ob Sie die Arbeitskopien löschen +wollen. Wenn Sie noch weiter mit der Datei arbeiten wollen, vernei­ +nen Sie diese Frage. Die Datei bleibt dann geöffnet. Anderenfalls +müßten Sie die Datei neu öffnen, wenn Sie sie wieder ansehen wol­ +len. + +#on("b")#Arbeitskopien#off("b")# Es ist sehr wichtig, daß Sie sich die +Funktionsweise +mit der Arbeitskopie immer vor Augen halten, damit Sie später bei +der Arbeit mit EUDAS nicht überrascht werden. + Eine Arbeitskopie wird immer dann angelegt, wenn Sie beim +Öffnen einer EUDAS-Datei angeben, daß Sie diese Datei ändern +wollen. In dem Beispiel haben Sie eine neue Datei eingerichtet. +EUDAS nimmt dann automatisch an, daß Sie ändern wollen. Öffnen +Sie eine existierende Datei, werden Sie gefragt + +___________________________________________________________________________________________ + + Wollen Sie etwas ändern (Arbeitskopie anlegen) (j/n) ? +___________________________________________________________________________________________ + + +Wenn Sie diese Frage verneinen, wird keine Arbeitskopie angelegt; +alle Änderungsfunktionen werden jedoch gesperrt. Daran können Sie +auch erkennen, daß keine Arbeitskopie vorliegt. + Die Arbeitskopie, die EUDAS sich anlegt, ist anonym. Wenn Sie +sich also im Menü 'Dateien' eine Übersicht zeigen lassen, erscheint +nur das Original. Bevor Sie mit diesem Original etwas anstellen +(zum Beispiel auf Archiv schreiben), sollten Sie sich vergewissern, +daß Sie die Arbeitskopie gesichert haben, da das Original sonst +nicht auf dem neuesten Stand ist. + Um Sie in diesem Fall zu warnen, erscheint vor einer geöffneten +Datei in einer Dateiauswahl das Symbol , zum Beispiel: + + + o "Telefonnummern" + o "Mitglieder" + + +Wenn Sie dieses Symbol sehen, sollten Sie die Datei lieber erst +sichern, bevor Sie etwas mit ihr anstellen. + +#on("b")#Beispiel#off("b")# Um die Arbeitsweise von EUDAS noch besser zu +verstehen, +betrachten Sie das Beispiel in Abb. 6-2. Nehmen Sie an, Sie haben +drei EUDAS-Dateien 'Kalender', 'Namen' und 'Adressen' mit ihren +Anfangsinhalten K0, N0 und A0 (symbolisch). In dem Diagramm sind +die Vorgänge zu den Zeitpunkten 0 bis 10 mit ihren Auswirkungen +auf die Inhalte der Dateien und der Arbeitskopie dargestellt. + + +#free (5.5)# +#center#Abb. 6-2 Beispiel zur Arbeitskopie + + +Zu den einzelnen Zeitpunkten passiere folgendes: + +0: Anfangszustand. Es wurde noch keine Datei geöffnet, also ist + keine Arbeitskopie vorhanden. Es könnte aber auch eine + beliebige Datei ohne Änderungserlaubnis geöffnet sein. +#free (0.2)# +1: Die Datei 'Adressen' wird geöffnet zum Ändern. Der momen­ + tane Zustand der Datei wird als Arbeitskopie übernommen. +#free (0.2)# +2: Es wird eine Änderung vorgenommen (zum Beispiel) ein Satz + eingefügt). Diese Änderung betrifft aber nur die Kopie - die + Datei 'Adressen' als Original bleibt unverändert. +#free (0.2)# +3: Eine weitere Änderung führt zum Inhalt A2 der Arbeitsko­ + pie. +#free (0.2)# +4: Aufruf von 'Sichern'. Die alte Version von 'Adressen' wird + überschrieben und durch den Inhalt A2 ersetzt. Die Frage + nach dem Löschen der Arbeitskopie wird verneint; daher bleibt + die Kopie auch erhalten. +#free (0.2)# +5: Die Kopie wird erneut verändert. +#free (0.2)# +6: Aufruf von 'Sichern'. Die Frage, ob die Kopie gesichert wer­ + den soll, wird verneint. Die Arbeitskopie soll jedoch gelöscht + werden. Als Ergebnis geht die Änderung A3 verloren (viel­ + leicht war diese Änderung ein Irrtum). Die Datei 'Adressen' + wird nicht verändert. Es ist keine Arbeitskopie mehr vor­ + handen. +#free (0.2)# +7: Die Datei 'Namen' wird zum Ändern geöffnet. +#free (0.2)# +8: Die Datei 'Kalender' wird zum Ändern geöffnet. Da an der + vorigen Arbeitskopie keine Änderungen vorgenommen wurden, + kann die Kopie einfach überschrieben werden. Anderenfalls + wäre an dieser Stelle die Möglichkeit zum Sichern angeboten + worden. +#free (0.2)# +9: Es wird eine Änderung durchgeführt. +#free (0.2)# +10: Die geänderte Arbeitskopie wird gesichert, das Original über­ + schrieben und die Arbeitskopie gelöscht (Normalfall). + + diff --git a/app/eudas/4.3/doc/eudas.hdb.7 b/app/eudas/4.3/doc/eudas.hdb.7 new file mode 100644 index 0000000..d6f1bf3 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.7 @@ -0,0 +1,687 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (61)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +7 Ausdrucken der Daten + + + +7.1 Druckmuster + +Nachdem Sie sich die Inhalte der EUDAS-Datei ausgiebig am Bild­ +schirm angesehen haben, möchten Sie die gespeicherten Daten sicher +auch in gedruckter Form auf Papier sehen. Sie können eine +EUDAS-Datei jedoch nicht ohne weiteres ausdrucken, da sie eine +andere Struktur als normale Textdateien hat. + Vor dem Drucken müssen also die Inhalte der EUDAS-Datei +zunächst in lesbarer Form in eine Textdatei geschrieben werden. +EUDAS kann diese Aufgabe jedoch ohne Ihre Hilfe nicht alleine be­ +wältigen. + Es taucht nämlich das Problem auf, daß die Dateiinhalte in +vielen verschiedenen Formen dargestellt werden können (Sie erin­ +nern sich sicher noch an das erste Kapitel). Vielleicht wollen Sie +bestimmte Überschriften haben oder die Daten müssen auf ein be­ +stimmtes Formular passen. + Um die Ausgabe nach Ihren Wünschen zu gestalten, müssen Sie +also dem Rechner genau angeben, an welcher Stelle welche Felder +gedruckt werden sollen usw. Dies geht am einfachsten, indem Sie +dem Rechner ein Muster vorsetzen, nach dem er dann die richtigen +Ausdrucke erstellen kann. Dieses Muster schreiben Sie in eine eige­ +ne Textdatei, die #on("i")#Druckmuster#off("i")# genannt wird. Aus den Daten der +EUDAS-Datei und der Form, die im Druckmuster angegeben ist, wird +dann eine weitere Textdatei erzeugt, die die Daten in der ge­ +wünschten Form enthält und die anschließend automatisch gedruckt +werden kann. + Durch ein Druckmuster erhalten Sie fast völlige Freiheit in der +Gestaltung Ihrer Ausdrucke. Zum Beispiel können aus einer einzigen +Adressendatei einfache Listen, Einladungskarten oder Rundbriefe +erzeugt werden. Für eine einfache Adressenliste entspricht das +Druckmuster einer Zeile der Liste, wobei angegeben wird, in welche +Spalten die Inhalte gedruckt werden. Zum Drucken von Einladungs­ +karten wird als Druckmuster eine Einladungskarte verwendet, in der +die Stellen markiert sind, an denen die Adresse erscheinen soll. Das +gleiche kann man mit einem Brief machen, der dann mit jeder +Adresse einmal ausgedruckt wird. + +#on("b")#Druckverfahren#off("b")# Man kann sich diesen Druckprozeß wie folgt +vorstellen: + + +#free (6.5)# + +#center#Abb. 7-1 Druckverfahren + + +Vereinfacht gesagt (das genaue Verfahren wird später beschrieben) +wird für jeden Satz der EUDAS-Datei das Druckmuster einmal in die +Druckdatei übernommen. Dabei werden die Inhalte aus der EUDAS- +Datei in einer noch anzugebenden Weise an den gewünschten Stellen +eingefügt. + Im weiteren sollen Sie erfahren, wie ein Druckmuster genau +aussieht und wie daraus ein Ausdruck entsteht. + +#on("b")#Beispiel#off("b")# Im folgenden sollen Sie zur Demonstration die +bereits in +Kapitel 3 und 4 beschriebene Beispieldatei verwenden. Nach Mög­ +lichkeit sollten Sie die angegebenen Beispiele mit dieser Datei +selbst am Rechner ausprobieren. + +Folgende Sätze befinden sich in der Datei: + + + Vorname Name, Strasse, PLZ Ort, m/w + ------------------------------------------------------- + Herbert Wegner, Krämergasse 12, 5000 Köln, m + Helga Sandmann, Willicher Weg 109, 5300 Bonn 1, w + Albert Katani, Lindenstr. 3, 5210 Troisdorf, m + Peter Ulmen, Mozartstraße 17, 5 Köln 60, m + Karin Regmann, Grengelweg 44, 5000 Köln 90, w + Hubert Arken, Talweg 12, 5200 Siegburg, m + Anna-Maria Simmern, Platanenweg 67, 5 Köln 3, w + Angelika Kaufmann-Drescher, Hauptstr. 123, 53 Bonn 2, w + Harald Fuhrmann, Glockengasse 44, 5000 Köln 1, m + Friedrich Seefeld, Kabelgasse, 5000 Köln-Ehrenfeld, m + + +Wie Sie sehen, wurde die Reihenfolge der Felder gegenüber der Datei +teilweise verändert und Name und Vorname ohne Komma hinterein­ +andergeschrieben, während die anderen Feldinhalte durch Komma +getrennt sind. Diese Liste wurde unter Verwendung eines Druck­ +musters erzeugt. + Da dieses Druckmuster jedoch vorerst noch zu kompliziert ist, +sollen Sie erst einmal ein einfacheres Druckmuster erstellen und +versuchen, nur die Namen aus der Datei in Tabellenform auszuge­ +ben. + Das dafür nötige Druckmuster hat folgendes Aussehen: + + + % WIEDERHOLUNG + ! &Name ! &Vorname ! + + +Das Druckmuster besteht nur aus zwei Zeilen, von der die zwei­ +te das eigentliche Muster darstellt. Die erste Zeile ist eine #on("i")# Anwei­ +sung#off("i")# an den Druckgenerator. 'WIEDERHOLUNG' gibt an, daß die +folgenden Zeilen für jeden Satz wiederholt werden sollen (warum +diese Angabe notwendig ist, werden Sie später einsehen). Das Pro­ +zentzeichen kennzeichnet eine Anweisung und muß unbedingt in der +ersten Spalte des Druckmusters stehen, also ganz am linken Rand. + In der zweiten Zeile ist zu sehen, daß das Zeichen '&' dazu +benutzt wird, die Stellen zu markieren, an denen nachher Feldin­ +halte eingesetzt werden sollen. Hinter dem '&'-Zeichen folgt der +Name des Feldes, das an dieser Stelle eingesetzt werden soll. Eine +solche Konstruktion wird #on("i")#Feldmuster#off("i")# genannt. Beachten Sie, daß +Feldnamen hier immer ohne Anführungsstriche geschrieben werden +müssen. Die Ausrufungszeichen bilden den eigentlichen Mustertext +und werden unverändert als Tabellenbegrenzung in die Ausgabe +übernommen. + Als Ergebnis des Druckprozesses sollte folgende Ausgabe auf +dem Drucker erscheinen: + + + ! Wegner ! Herbert ! + ! Sandmann ! Helga ! + ! Katani ! Albert ! + ! Ulmen ! Peter ! + ! Regmann ! Karin ! + ! Arken ! Hubert ! + ! Simmern ! Anna-Maria ! + ! Kaufmann-Drescher ! Angelika ! + ! Fuhrmann ! Harald ! + ! Seefeld ! Friedrich ! + + +Sie können erkennen, daß die Feldmuster in der Ausgabe jeweils +durch den Inhalt des zugehörigen Feldes ersetzt worden sind. Der +übrige Text in der Musterzeile ist unverändert geblieben. Beachten +Sie, daß das '&' ein reserviertes Zeichen ist, das ein Feldmuster im +umgebenden Text kennzeichnet und daher (vorerst) nicht gedruckt +werden kann. + + +7.2 Aufruf + +In diesem Abschnitt sollen Sie erfahren, wie Sie diese Ausgabe +selbst erzeugen können. Damit der Druckgenerator arbeiten kann, +müssen Sie die Datei 'Adressen' erst einmal öffnen. Anschließend +wählen Sie das Menü 'Drucken' an. + +#on("b")#Druckmuster erstellen#off("b")# Als nächstes müssen Sie das +Druckmuster erstellen. Hierfür gibt es die Funktion +#free (0.2)# + + Textdatei + E Editieren + +#free (0.2)# +da das Druckmuster eine normale Textdatei ist. + Wählen Sie diese Funktion. Sie werden dann nach einem Namen +für das Druckmuster gefragt. Wir wollen das Druckmuster 'Namens­ +liste' nennen - Sie können aber auch einen beliebigen anderen +Namen wählen. Denken Sie daran, die Anführungsstriche nicht mit +einzugeben. + Es erscheint anschließend das gewohnte Editorbild mit einer +entsprechenden Statuszeile. Geben Sie die zwei Zeilen des Druck­ +musters ein und beenden Sie den Editor mit ESC 'q'. Damit ist das +Druckmuster fertig. + + Die hier beschriebene Funktion können Sie nicht nur zum Er­ +stellen, sondern auch zum Ändern und einfachen Ansehen eines +Druckmusters bzw. einer Textdatei allgemein verwenden. Es wird +Ihnen immer der jeweilige Inhalt präsentiert, den Sie dann nach +Belieben abändern können oder nicht. + +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + Satzauswahl : + D Drucken : + --------------: + Druckausgabe : + R Richtung : + --------------: + Textdatei : + E Editieren : + A Ausdrucken : + N Nachbearb. : + --------------: + +___________________________________________________________________________________________ + +#center#Abb. 7-2 Menü "Drucken" + + +#on("b")#Ausgaberichtung#off("b")# Bevor Sie jetzt weitermachen, sollten Sie +über­ +prüfen, ob an Ihrem System ein Drucker angeschlossen ist. Der +Drucker sollte bei den folgenden Versuchen betriebsbereit sein. + Ist kein Drucker angeschlossen oder wollen Sie kein Papier +verschwenden, haben Sie die Möglichkeit, den Ausdruck als Text­ +datei zu erhalten. Dazu wählen Sie die Funktion +#free (0.2)# + + Ausgabe + R Richtung + +#free (0.2)# +an. Beantworten Sie beide Fragen, die Ihnen gestellt werden, mit +'n'. Die Ausgaben stehen dann nachher in Dateien mit einem Namen +der Form +#free (0.2)# + + Namensliste.a$n + +#free (0.2)# +die Sie sich mit der oben beschriebenen Funktion dann genau wie +ein Druckmuster anschauen können. Der Name besteht also aus dem +Namen des Druckmusters, dem ein '.a$' angehängt wird. Die Nummer +'n' dient zur Unterscheidung bei mehreren aufeinanderfolgenden +Ausgaben. Um Verwirrung zu vermeiden, sollten Sie die Datei nach +dem Anschauen löschen (im Menü 'Dateien'). + +#on("b")#Druckaufruf#off("b")# Wenn Sie diese Hinweise beachtet haben, können +Sie den Druckvorgang mit der Auswahl +#free (0.2)# + + Satzauswahl + D Drucken + +#free (0.2)# +starten. Sie werden hier nach dem Namen des Druckmusters gefragt, +das Sie verwenden wollen (Sie können ja durchaus eine ganze Reihe +von verschiedenen Druckmustern haben). + Sie können den Ablauf des Druckvorganges daran verfolgen, +daß jeweils die Nummer des Satzes ausgegeben wird, der gerade +bearbeitet wird. Probieren Sie eventuell auch kleine Abwandlungen +des Druckmusters aus, indem Sie die Tabellenspalten schmaler oder +breiter machen oder die Ausrufungszeichen durch ein anderes Zei­ +chen ersetzen (je nach Geschmack). + +#on("b")#Ausgabedatei#off("b")# Wollen Sie die erzeugte Ausgabe (die in der +Datei +'Namensliste.a$1' steht) irgendwann tatsächlich ausdrucken, ver­ +wenden Sie die Funktion +#free (0.2)# + + A Ausdrucken + +#free (0.2)# +Sie werden dann nach dem Namen der Textdatei gefragt. Beachten +Sie, daß Sie diese Funktion #on("i")#nicht#off("i")# zum Drucken von EUDAS-Dateien +verwenden können, da aus einer EUDAS-Datei erst eine Druckdatei +erzeugt werden muß. + Auch wenn Sie angegeben haben, daß die Ausgabe des Druck­ +prozesses direkt ausgedruckt werden soll, startet Ihr Drucker erst, +wenn EUDAS die ganze Datei durchgegangen ist und der Vorgang für +Sie beendet ist. Dies liegt am EUMEL-System, das nur vollständige +Druckaufträge entgegennimmt, damit sich mehrere Benutzer nicht in +die Quere kommen können. In einem Multi-User-System können Sie +weiterarbeiten, während der Drucker beschäftig ist. + +#on("b")#Fehler#off("b")# Bevor der eigentliche Druckprozeß gestartet wird, +wird das +Druckmuster auf unsinnige oder unverständliche Konstruktionen +überprüft. Ist dem Druckgenerator etwas suspekt, gibt er eine Feh­ +lermeldung aus, in der die fragliche Situation von seiner Seite aus +beschrieben wird. Er kann natürlich nicht Ihren Fehler "verstehen". +Daher müssen Sie unter Umständen eine Fehlermeldung erst inter­ +pretieren, ehe Sie die wahre Ursache erkennen können. + Damit Sie einen aufgetretenen Fehler gleich korrigieren können, +werden Ihnen das Druckmuster und die Fehlermeldungen parallel auf +dem Bildschirm zum Ändern und Anschauen angeboten. Sie können +mit dem Editor das Druckmuster ändern und in den Fehlermeldungen +blättern. Diese Konfiguration wird Paralleleditor genannt. Mit ESC +'w' wechseln Sie zwischen den beiden Bildschirmhälften. + +#on("b")#Suchbedingung#off("b")# Wollen Sie nicht alle Namen ausdrucken, so +können +Sie vorher ein Suchmuster einstellen, das nur auf die gewünschten +Namen zutrifft (wie im Kapitel 5 beschrieben). Der Druckgenerator +richtet sich immer nach dem aktuell eingestellten Suchmuster und +druckt nur die ausgewählten Sätze. Wenn Sie zum Beispiel die Na­ +men aller Frauen ausdrucken wollen, stellen Sie im Tastenmodus ein +Suchmuster ein (das sollten Sie können), das für das Feld 'm/w' die +Bedingung 'w' enthält. Danach können Sie den Druckgenerator auf­ +rufen. Vergessen Sie nicht, das Suchmuster anschließend wieder zu +löschen. + +#on("b")#Feldnamen abfragen#off("b")# Wenn Sie selber ein Druckmuster +erstellen, +wird es häufiger vorkommen, daß Sie die genaue Schreibweise der +Feldnamen nicht im Kopf haben. Für diesen Zweck definiert EUDAS +im Editor eine spezielle Tastenkombination. + Wenn Sie dort ESC 'F' tippen (großes 'F'), erhalten Sie eine +Auswahl aller Felder der gerade geöffneten Datei. Sie können sich +die Namen einfach ansehen, aber auch direkt in den Text des +Druckmusters übernehmen. + Wenn Sie nämlich vor dem Verlassen der Auswahl mit ESC 'q' +ein Feld ankreuzen, wird anschließend der Name in Anführungs­ +strichen an die Position geschrieben, an der vor dem Aufruf der +Cursor stand. Auf diese Weise können Sie sich auch das Tippen +langer Feldnamen vereinfachen. + Beachten Sie, daß Sie im Normalfall im Druckmuster die Anfüh­ +rungsstriche wieder entfernen müssen. Die Anführungsstriche dienen +zur Abgrenzung, wie weit der Feldname geht. Falls der Name Leer­ +zeichen enthält, beachten Sie bitte den Absatz 'Abgrenzung der +Feldnamen' in Abschnitt 7.4. + + +7.3 Abschnitte + +Die Tabellen, die Sie bis jetzt erzeugen können, sehen optisch noch +nicht sehr gut aus. Es fehlt auf jeden Fall eine vernünftige Über­ +schrift. Um eine Überschrift zu erzeugen, können Sie im Druckmuster +einen #on("i")#Vorspann#off("i")# definieren, der ganz zu Anfang einmal gedruckt +wird. + Dieser Vorspann wird durch die Anweisung + + + % VORSPANN + + +eingeleitet (bitte nicht vergessen, daß das '%'-Zeichen für eine +Anweisung in der ersten Spalte stehen muß). Die folgenden Zeilen +bis zur 'WIEDERHOLUNG'-Anweisung gehören zum Vorspann. Ein +Druckmuster für unsere Namensliste mit Überschrift könnte dann so +aussehen: + + + % VORSPANN + Alle Namen aus der EUDAS-Datei 'adressen' + ----------------------------------------- + % WIEDERHOLUNG + ! &Name ! &Vorname ! + + +Der Druckgenerator erzeugt mit diesem Druckmuster die gewünschte +Liste mit Überschrift. Sie können als Vorspann natürlich auch einen +beliebigen anderen Text verwenden. + In einer analogen Weise können Sie die Liste noch durch eine +waagerechte Linie abschließen, indem Sie einen #on("i")#Nachspann#off("i")# definie­ +ren. Die dafür notwendige Anweisung heißt + + + % NACHSPANN + + +Die Zeilen nach dieser Anweisung werden gedruckt, nachdem alle +Sätze bearbeitet worden sind. Das folgende Druckmuster erzeugt +schon eine sehr schöne Liste: + + + % VORSPANN + Alle Namen aus der EUDAS-Datei 'adressen' + ----------------------------------------- + % WIEDERHOLUNG + ! &Name ! &Vorname ! + % NACHSPANN + ----------------------------------------- + + +nämlich: + + + Alle Namen aus der EUDAS-Datei 'adressen' + ----------------------------------------- + ! Wegner ! Herbert ! + ! Sandmann ! Helga ! + ! Katani ! Albert ! + ! Ulmen ! Peter ! + ! Regmann ! Karin ! + ! Arken ! Hubert ! + ! Simmern ! Anna-Maria ! + ! Kaufmann-Drescher ! Angelika ! + ! Fuhrmann ! Harald ! + ! Seefeld ! Friedrich ! + ----------------------------------------- + + +Die drei Teile, aus denen ein Druckmuster bestehen kann (Vorspann, +Nachspann und Wiederholungsteil), werden #on("i")#Abschnitte#off("i")# genannt. Wie +Sie später noch sehen werden, haben Abschnitte eine Reihe von +gemeinsamen Eigenschaften. Ein Abschnitt wird durch eine eigene +Anweisung eingeleitet und endet, wenn ein anderer Abschnitt be­ +ginnt oder das Druckmuster zu Ende ist. Alle Abschnitte können +auch weggelassen werden, irgendein Abschnitt muß aber immer +vorhanden sein. So ist es zum Beispiel möglich, ein Druckmuster zu +bauen, das nur aus einem Nachspann besteht (Sie werden allerdings +jetzt noch nicht verstehen können, warum so etwas sinnvoll sein +kann). + Zum Abschluß dieses Kapitels hier noch einmal eine Übersicht +der bisher vorgestellten Anweisungen: + + + Anweisung ! Bedeutung + ---------------+---------------------------------- + % VORSPANN ! leitet Vorspann ein + % WIEDERHOLUNG ! leitet Wiederholungsteil ein + % NACHSPANN ! leitet Nachspann ein + + + +7.4 Feldmuster + +Mit den bis jetzt beschriebenen Möglichkeiten des Druckgenerators +können Sie schon sehr viel anfangen. Es fehlt aber noch die Mög­ +lichkeit, mehrere Feldinhalte direkt hintereinander zu schreiben, +egal wie lang diese Inhalte sind. Diese Fähigkeit wird zum Beispiel +für die anfangs vorgestellte Liste benötigt. + +#on("b")#Variable Position#off("b")# Die Feldmuster, die Sie bis jetzt +kennen, begin­ +nen mit einem '&'-Zeichen und werden immer genau an der Stelle +gedruckt, an der sie stehen (feste Position). Sie können ein Feld­ +muster aber auch mit '%' beginnen lassen. In diesem Fall kann der +Inhalt verschoben werden (variable Position), je nachdem, ob vorhe­ +rige Inhalte kürzer oder länger sind. + '%' ist wie '&' ein reserviertes Zeichen, kann also nicht direkt +gedruckt werden. Da '&' und '%' Feldmuster einleiten, heißen sie +#on("i")#Musterzeichen#off("i")#. + Um Feldmuster variabler Position einmal auszuprobieren, soll­ +ten Sie unser bisheriges Druckmuster in der folgenden Weise um­ +schreiben: + + + % WIEDERHOLUNG + &Vorname %Name + + +(Vorspann und Nachspann der Einfachheit halber mal weggelassen). +Als Ergebnis erhalten wir: + + + Herbert Wegner + Helga Sandmann + Albert Katani + Peter Ulmen + Karin Regmann + Hubert Arken + Anna-Maria Simmern + Angelika Kaufmann-Drescher + Harald Fuhrmann + Friedrich Seefeld + + +Das Feldmuster '%Name' ist also entsprechend der Länge des Vor­ +namens nach links oder nach rechts gerutscht. Zu beachten ist, daß +ein Feldmuster mit '%' nicht in der ersten Spalte stehen darf, denn +dann würde die Zeile als Anweisung angesehen. Ein Feldmuster +variabler Position wäre ja auch in der ersten Spalte wenig sinnvoll. + +#on("b")#Feste Länge#off("b")# Außer den beiden bisher besprochenen einfachen +Arten (mit '&' oder '%') gibt es noch weitere Ausprägungen von +Feldmustern für besondere Fälle. Wird ein Feldmuster noch von +weiteren Musterzeichen gefolgt, dann wird dieses Feldmuster immer +in der reservierten Länge eingesetzt. Die reservierte Länge reicht +vom ersten bis zum letzten Musterzeichen. Durch die zusätzlichen +Musterzeichen wird also ein bestimmter Platz freigehalten. + Ersetzt man im obigen Druckmuster '&Vorname' durch +'&Vorname&&', wird der Effekt des folgenden '%'-Feldes wieder +aufgehoben, da jetzt für alle Vornamen die gleiche Länge verwendet +wird (Probieren Sie dies aus). + Bei einem solchen Feldmuster mit fester Länge wird der Inhalt +abgeschnitten, falls er diese Länge überschreitet; ist der Inhalt +kürzer, wird rechts mit Leerstellen aufgefüllt. Aber auch bei Feld­ +mustern mit variabler Länge (also ohne folgende Musterzeichen) +kann abgeschnitten werden, nämlich genau dann, wenn der Inhalt so +lang ist, daß ein folgendes Feld mit fester Position (mit '&' anfan­ +gend) überschrieben würde. Hätten wir also in unserem ersten +Druckmuster nicht genügend Platz für die Spalten vorgesehen, +wären einige Namen abgeschnitten worden (probieren Sie es nochmal +aus, falls es Ihnen nicht schon passiert ist). + In einem weiteren Fall werden Feldmuster variabler Länge +abgeschnitten, nämlich wenn die generierte Zeile die maximale +Zeilenlänge überschreitet. Die maximale Zeilenlänge richtet sich +nach dem Dateilimit, das für das Druckmuster eingestellt ist. Nor­ +malerweise ist dies 77, so daß Sie in Normalschrift die Zeilenbreite +auf einem DIN A4-Blatt nicht überschreiten. + Benutzen Sie jedoch breites Papier oder eine schmale Schrift, +sollten Sie während der Eingabe des Druckmusters ESC ESC tippen +und das Kommando + + + limit (135) + + +eingeben. EUDAS nutzt dann die volle Zeilenbreite aus. + +#on("b")#Rechtsbündig#off("b")# Sie sind jetzt aber noch nicht zu Ende mit +den +Feldmustervariationen. Eine letzte Möglichkeit besteht darin, den +Inhalt rechtsbündig in ein Feldmuster einzusetzen. Dies hat natür­ +lich nur Sinn bei fester Länge. Man erreicht dies dadurch, daß man +das Feldmuster mit mehreren Musterzeichen beginnen läßt. So ist + + + %%Vorname% + + +die rechtsbündige Version von + + + %Vorname%% + + +Beide Feldmuster sind gleich lang, beim ersten wird jedoch am lin­ +ken Rand aufgefüllt oder abgeschnitten, beim zweiten dagegen am +rechten Rand. + +#on("b")#Zusammenfassung#off("b")# Hier noch einmal eine Zusammenstellung +aller möglichen Feldmustertypen: + + + Typ ! Beispiel ! Position ! Länge ! bündig + ----+-----------+------------------------------ + 1 ! &Name ! fest ! variabel ! links + 2 ! %Name ! variabel ! variabel ! links + 3 ! &Name&&& ! fest ! fest ! links + 4 ! %Name%%% ! variabel ! fest ! links + 5 ! &&&Name& ! fest ! fest ! rechts + 6 ! %%%Name% ! variabel ! fest ! rechts + + +Wir können zusammenfassen: +#free (0.2)# +* Feldmuster dienen im Druckmuster dazu, Stellen zu markieren, an + denen Inhalte eingesetzt werden sollen. +#free (0.2)# +* Feldmuster beginnen mit einem Musterzeichen ('&' oder '%'); + darauf folgt der Feldname. +#free (0.2)# +* Durch '&' wird feste und durch '%' variable Position festgelegt. +#free (0.2)# +* Durch zusätzliche Musterzeichen kann eine feste Länge angege­ + ben werden; mehrere Musterzeichen am Anfang führen zu rechts­ + bündigem Einsetzen. + +#on("b")#Abgrenzung der Feldnamen#off("b")# Als nächstes sollen Sie den Fall +be­ +trachten, daß Sie einen Namen in der oft auftretenden Form + + + Name, Vorname + + +schreiben wollen. Die Schwierigkeit liegt in dem Komma, das direkt +hinter dem Namen folgen soll. Sie könnten versuchen, diese Situa­ +tion im Druckmuster folgendermaßen darzustellen: + + + % WIEDERHOLUNG + &Name, %Vorname + + +In diesem Fall erhalten Sie aber die Fehlermeldung + + + FEHLER in Zeile 2 bei >>Name,<< + diese Abkuerzung ist nicht definiert + + +Wenn Sie sich nicht genau vorstellen können, wie der Druckgenera­ +tor ein Feldmuster liest, wird Ihnen dieser Fehler mysteriös er­ +scheinen, denn 'Name' ist doch als Feld definiert (was eine Abkür­ +zung ist, werden Sie in Kapitel 13 lernen). Den entscheidenden +Hinweis liefert jedoch das Komma. Offensichtlich hat der Druck­ +generator das Komma als Teil des Feldnamens angesehen. + Dies liegt daran, daß ja irgendwann der Feldname in einem +Feldmuster beendet sein muß. Normalerweise interpretiert der +Druckgenerator ein Leerzeichen oder Musterzeichen als Ende des +Namens, alle vorherigen Zeichen gehören mit zum Feldnamen. Wenn +nun aber nach dem Feldmuster kein Leerzeichen folgen soll (wie in +unserem Beispiel) oder der Feldname selbst Leerzeichen enthält +(dies ist ja erlaubt, könnte aber im Druckmuster nie erkannt wer­ +den), muß noch eine zusätzliche Angabe erfolgen. + In solchen Fällen kann der Feldname in spitze Klammern einge­ +schlossen werden. Der Druckgenerator sieht den Feldnamen dann bei +der ersten schließenden Klammer als beendet an, wobei die Klam­ +mern natürlich nicht zum Feldnamen gehören, aber auch nicht ge­ +druckt werden. + Das obige Beispiel müßte also richtig so formuliert werden: + + + % WIEDERHOLUNG + &, %Vorname + + +Wenn Sie dieses Druckmuster ausprobieren, werden Sie sehen, daß +die Namen tatsächlich in der gewünschten Form erscheinen. + +#on("b")#Leerautomatik#off("b")# Es gibt noch eine trickreiche Automatik in +EUDAS, +die in manchen Fällen ganz nützlich ist - und zwar in Fällen, in +denen Sie mehrere Felder als Aufzählung durch Leerzeichen ge­ +trennt drucken wollen. Nehmen wir an, unsere Adreßdatei hätte +noch ein Feld 'Titel', in das Sie bei Bedarf 'Dr.' oder 'Prof. Dr.' +eintragen. In der Adresse würden Sie dann angeben: + + + &Titel %Vorname %Name + + +Wenn der Titel jedoch leer ist, würde ein störendes Leerzeichen vor +dem Namen bleiben. In einem solchen Fall entfernt EUDAS das Leer­ +zeichen automatisch. Vorbedingung für diese Automatik ist, daß es +sich um ein Feld variabler Länge handelt und vor dem Feld noch ein +Leerzeichen steht (außer in Spalte 1). + +#on("b")#Aufgabe#off("b")# Sie sollten jetzt die Möglichkeiten des +Druckgenerators +soweit kennengelernt haben, daß Sie ein Druckmuster für die zu +Anfang des Kapitels erwähnte Liste aller Dateiinhalte erstellen +können. Versuchen Sie dies zunächst allein, ehe Sie die Lösung +nachschauen. + + +Hier nun die Lösung: + + + % VORSPANN + Vorname Name, Strasse, PLZ Ort, m/w + ------------------------------------------------------- + % WIEDERHOLUNG + &Vorname %, %, %PLZ %, %m/w + + +Beachten Sie die spitzen Klammern, die nötig sind, um das Kom­ +ma ohne Zwischenraum anzuschließen. + +#on("b")#Beispiel#off("b")# Als letztes Beispiel sollen Sie einen Fall +betrachten, bei +dem pro Satz mehr als eine einzelne Listenzeile gedruckt werden +soll, und zwar sollen Sie einen Brief schreiben, in den der Druck­ +generator die Adressen verschiedener Leute einfügen soll. Die Er­ +stellung von Formbriefen ist eine sehr häufige Anwendung von +EUDAS. Mit den bisher beschriebenen Konstrukten kann man etwa +folgendes Druckmuster schreiben: + + + % WIEDERHOLUNG + &Vorname %Name + &Strasse + &PLZ %Ort + + Lieber &Vorname ! + + Ich lade Dich mit diesem Brief zu + meiner nächsten Party ein. + Bring gute Laune und was zu Essen mit. + + Viele Grüße + \#page\# + + +Die letzte Zeile zeigt eine Möglichkeit, von der Sie wahrscheinlich +öfter Gebrauch machen werden, nämlich Druckersteuerungsanwei­ +sungen in das Druckmuster einzufügen. Die Anweisung '\#page\#' +wird an den Drucker weitergereicht und bewirkt, daß nach jedem +Brief eine neue Seite angefangen wird (Sie wollen sicher nicht +mehrere Briefe auf ein Blatt drucken). Sie können auch andere An­ +weisungen verwenden, z.B. neue Schrifttypen einstellen. Informieren +Sie sich gegebenenfalls, welche Anweisungen die Textkosmetik zur +Verfügung stellt. + +#on("b")#Ausblick#off("b")# Sie kennen jetzt bereits einen großen Teil der +Möglich­ +keiten des Druckgenerators. Einige wünschenswerte Fähigkeiten +fehlen jedoch noch. So wäre es vorteilhaft, wenn abhängig vom +Inhalt des Feldes 'm/w' die Anrede 'Sehr geehrter Herr' oder 'Sehr +geehrte Frau' erzeugt werden könnte. Außerdem könnte das im +Rechner vorhandene Datum automatisch in den Brief übernommen +werden. Diese Möglichkeiten werden den Kapiteln 12 und 13 be­ +schrieben. + Sie sollten diese jedoch erst dann durchlesen, wenn Sie eine +gewisse Sicherheit im Umgang mit Druckmustern erlangt haben. +Zuvor sollten Sie die Inhalte dieses Kapitels beherrschen, damit Sie +EUDAS gut nutzen können. + diff --git a/app/eudas/4.3/doc/eudas.hdb.8 b/app/eudas/4.3/doc/eudas.hdb.8 new file mode 100644 index 0000000..83246e9 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.8 @@ -0,0 +1,211 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (75)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +8 Was war und was noch kommt + + + +8.1 Rückblick + +So! Wenn Sie bis hierhin gut mitgearbeitet haben, haben Sie die +erste und wichtigste Etappe beim Erlernen von EUDAS schon ge­ +schafft. Bevor Sie kennenlernen, was für Möglichkeiten Ihnen EUDAS +sonst noch bietet, wollen wir die wichtigsten Dinge rekapitulieren, +die Sie gelernt haben sollten. + +#on("b")#EUDAS-Dateien#off("b")# Sie sollten wissen, wie EUDAS-Dateien +aussehen, +und daß sie sich von normalen Textdateien unterscheiden. Diese +Unterscheidung sollten Sie immer beachten, denn es gibt Funktio­ +nen, die nur EUDAS-Dateien annehmen (zum Beispiel 'Öffnen'), +andere, die nur Textdateien annehmen (zum Beispiel 'Textdatei +erstellen') und solche, die mit beliebigen Arten von Dateien "ohne +Ansehen der Person" funktionieren (zum Beispiel 'Kopieren vom +Archiv'). + +#on("b")#Bedienung#off("b")# Sie sollten wissen, wie man eine Funktion im +Menü +aufruft; wie Sie EUDAS die notwendigen Informationen (zum Beispiel +Dateinamen) mitgeben und wie Sie in besonderen Situationen (Feh­ +ler, Abbruch) reagieren können. Zur problemlosen Bedienung sollten +Sie auch die jeweilige Statuszeile interpretieren können. + +#on("b")#Dateiverwaltung#off("b")# Sie sollten wissen, wie Sie Dateien von +Archiv­ +disketten holen und dort auch wieder abspeichern können. Dazu ist +die Dateiauswahl durch Ankreuzen sehr hilfreich. Sie sollten von +Anfang an darauf achten, daß Sie Ihre Dateien regelmäßig auf dem +Archiv sichern, damit Sie bei etwaigen Problemen mit Ihrem Rechner +die Daten nicht verlieren. + +#on("b")#Öffnen#off("b")# Sie sollten wissen, daß Sie eine EUDAS-Datei vor +dem +Bearbeiten erst öffnen müssen. Weiterhin sollten Sie mit der Ar­ +beitskopie umgehen können, die EUDAS bei Änderungen anlegt. +Denken Sie daran, Ihre Datei nach Änderungen zu sichern. Sie soll­ +ten auch neue EUDAS-Dateien mit eigener Struktur anlegen können. + +#on("b")#Ansehen und Ändern#off("b")# Sie sollten wissen, wie Sie die Daten +Ihrer +EUDAS-Dateien am Bildschirm abrufen können - entweder manuell +oder mit Hilfe eines Suchmusters. Sie sollten Änderungen und Ein­ +fügungen durchführen können. + +#on("b")#Drucken#off("b")# Sie sollten wissen, wie Sie die Daten einer +EUDAS-Datei +mit Hilfe eines Druckmusters ausdrucken können. Denken Sie daran, +daß dies ein zweistufiger Vorgang ist (Generierung der Druckdatei - +Ausgeben an Drucker), den Sie an verschiedenen Stellen beeinflus­ +sen können. + +Lesen Sie das entsprechende Kapitel erneut durch, wenn Sie sich bei +einem Punkt dieser Aufzählung nicht sicher sind. Wichtig ist auch, +daß Sie die bschriebenen Funktionen selbst am Rechner ausprobiert +haben. + Wenn Sie dies alles geduldig absolviert haben, sind Sie in der +Lage, EUDAS sinnvoll für Ihre eigenen Probleme einzusetzen. Sie +sollten jetzt ruhig versuchen, eigene Lösungen zu realisieren. Sicher +werden Sie dabei erkennen, daß Ihnen noch einige Möglichkeiten +fehlen. Die Chancen sind aber gut, daß EUDAS Ihnen diese Möglich­ +keiten bietet. + Im nächsten Abschnitt erhalten Sie einen Überblick darüber, +was EUDAS noch zur Verfügung stellt. Dort können Sie sich orien­ +tieren, welche Kapitel Sie lesen sollten, wenn Sie bestimmte Fragen +haben. + + +8.2 Ausblick + +Im zweiten Teil dieses Handbuchs erwarten Sie eine ganze Reihe +interessanter Themen. Dort werden Erweiterungen und Verallgemei­ +nerungen von Funktionen beschreiben, die Sie bereits kennen. Viele +Funktionen sind jedoch ganz neu und manchmal auch nicht ganz +einfach zu beherrschen. + +#on("b")#Kapitel 9#off("b")# Das neunte Kapitel befaßt sich mit der +grundsätzlichen +Struktur der geöffneten Datei. Sie erfahren, daß Sie mehr als eine +Datei gleichzeitig öffnen und bearbeiten können. Zum einen können +Sie gleichartige Dateien verketten oder Dateien über Beziehungen +koppeln. Insbesondere das Koppeln ist eine wichtige Grundlage für +viele fortgeschrittene Anwendungen von EUDAS. + In diesem Kapitel wird auch beschrieben, wie Sie auf einem +Mehrplatzsystem von mehreren Plätzen aus auf die gleichen EUDAS- +Dateien zugreifen können. Die Fähigkeiten von EUDAS auf diesem +Gebiet erreichen nicht das Niveau von großen Datenbanksystemen, +sind jedoch einfach anzuwenden und in vielen Fällen nützlich. + +#on("b")#Kapitel 10#off("b")# Im zehnten Kapitel erfahren Sie, wie Sie den +Bildschirm +übersichtlicher gestalten können, wenn Sie Dateien mit zahlreichen +Feldern benötigen. Sie können bestimmte Felder auswählen, aber +auch die Sätze einfach ausschnittweise ansehen. + Das Suchmuster besitzt noch viele Fähigkeiten, die im ersten +Teil nicht zur Sprache gekommen sind. Sie können mehrere Bedin­ +gungen auf verschiedene Weisen miteinander kombinieren. Auch +einige neue Vergleiche treten auf. Außerdem können Sie mehrere +Felder eines Satzes miteinander vergleichen. + Zum schnellen Überblick steht Ihnen eine Funktion bereit, die +jeweils einen Satz pro Bildschirmzeile anzeigt. In dieser Übersicht +können Sie blättern und auch Sätze markieren (ankreuzen), um Sie +später zu bearbeiten. + +#on("b")#Kapitel 11#off("b")# Das elfte Kapitel ist den Funktionen zur +Bearbeitung +gewidmet. Dort erfahren Sie, wie Sie eine Datei sortieren können. +Außerdem können Sie eine Datei ausschnittweise kopieren, wobei Sie +noch eine Vielzahl von Manipulationsmöglichkeiten haben. + Auch das Tragen von mehreren Sätzen in einem Arbeitsgang ist +möglich. Dabei können Konsistenzbedingungen einer Datei überprüft +werden. + Als letztes erfahren Sie, wie man eine EUDAS-Datei automa­ +tisch nach einer beliebigen Vorschrift ändern kann. Hier, wie bei +den vorherigen Funktionen, werden Sie zum ersten Mal erkennen, +wieviel man mit der Programmiersprache ELAN innerhalb von EUDAS +ohne viel Aufwand machen kann. + +#on("b")#Kapitel 12#off("b")# Das nächste Kapitel zeigt Ihnen weitere +Möglichkeiten +zum Drucken. Sie können die Druckausgabe vor dem Drucken noch +mit den Programmen der EUMEL-Textverarbeitung aufbereiten. Auch +innerhalb der EUMEL-Textverarbeitung können Sie EUDAS aufrufen, +um Daten aus einer EUDAS-Datei in den Text einzufügen. + EUDAS kann auch in mehreren Spalten drucken (zum Beispiel +für Etiketten). Schließlich wird noch beschrieben, wie Sie lange +Felder auf mehrere Zeilen aufteilen können und welche speziellen +Möglichkeiten Sie zur Erzeugung von Tabellen haben. + +#on("b")#Kapitel 13#off("b")# Ab hier beginnt die Beschreibung dessen, was +die +Ausgabe des Druckgenerators so ungeheuer anpassungsfähig macht: +die Verwendung der Programmiersprache ELAN. + Mit einfachsten ELAN-Elementen können Sie komplizierte For­ +matierungswünsche erfüllen. Dazu können Sie den Inhalt von Feld­ +mustern durch vorherige Bearbeitung und durch die Abfrage von +Bedingungen manipulieren. Ganze Musterteile können in Abhängig­ +keit von Bedingungen variabel gestaltet werden. + Auch der Ablauf von Druckvorgängen kann von Bedingungen +abhängig gemacht werden. So lassen sich gesteuert Vorspann und +Nachspann innerhalb des Ausdrucks einfügen und Zwischenüber­ +schriften oder -summen bilden (Gruppenverarbeitung). + +#on("b")#Kapitel 14 und 15#off("b")# Für denjenigen, der noch nie mit ELAN zu +tun +hatte, werden diese Möglichkeiten sicher nicht ganz einfach zu +verstehen sein. Obwohl die vorherigen Kapitel viele benutzbare +Beispiele enthalten, ist zur vollen Ausnutzung ein gewisses Ver­ +ständnis von ELAN notwendig. + Dies soll in den Kapitel 14 und 15 vermittelt werden, und zwar +in dem Umfang, in dem es in EUDAS nötig ist (Sie sollen hier nicht +zum ELAN-Programmierer ausgebildet werden). Für den ELAN- +Kenner bieten diese Kapitel sicher nichts Neues, aber sie enthalten +viele Beispiele und Beschreibungen der Funktionen, die für EUDAS +wichtig sind. + Dabei geht Kapitel 15 weiter auf die Sprachmittel für Zählvor­ +gänge, Auswertungen und statistische Anwendungen ein, während in +Kapitel 14 die grundlegenden Ausdrücke zur Formulierung von +Manipulationen besprochen werden. + +#on("b")#Kapitel 16#off("b")# Im letzten Kapitel geht es dann wieder +harmloser zu. +Hier werden die Funktionen beschrieben, die unter EUDAS zur +allgemeinen Dateiverwaltung zur Verfügung stehen. Im Grunde sind +dies alles Funktionen, die vom EUMEL-System zur Verfügung ge­ +stellt werden. EUDAS integriert sie lediglich in ein Menüsystem, +damit Sie als Benutzer die Funktionen möglichst einfach aufrufen +können. + Aber auch dem erfahrenen EUMEL-Benutzer bieten die Funktio­ +nen einen zusätzlichen Komfort, da auch hier die praktische Aus­ +wahl durch Ankreuzen in allen Funktionen vertreten ist. Außerdem +wird die Anzahl von Tastendrücken zum Erreichen eines Ziels ver­ +ringert. Daher besteht auch für den "Profi" keine Notwendigkeit, +grundsätzlich mit einer Kommandoschnittstelle weiterzuarbeiten. + +#on("b")#Referenzhandbuch#off("b")# Im Referenzhandbuch sind alle hier +besproche­ +nen Funktionen noch einmal in einer sehr kurzen, zusammenfassen­ +den und abstrakten Form aufgeführt. Dort sollen Sie nachschlagen, +wenn Sie eine ganz bestimmte Information suchen und sich mit +EUDAS bereits auskennen. + Sie können jedoch auch ohne das Referenzhandbuch auskommen, +denn alles, was Sie wissen müssen, steht auch hier im Benutzer­ +handbuch. + Das Referenzhandbuch enthält auch einen Teil, der sich spe­ +ziell an den ELAN-Programmierer wendet, der besondere Anwendun­ +gen mit EUDAS realisieren will. Allerdings sollten alle dort be­ +schriebenen Möglichkeiten mit Vorsicht betrachtet werden, da sie im +Normalfall nicht so abgesichert sind, wie die hier beschriebenen +Fähigkeiten. Auch sollten Sie mit den Einsatzmöglichkeiten von +ELAN, wie sie in den Kapitel 11 und 13 beschrieben sind, wirklich +alle praktischen Probleme erledigen können. + diff --git a/app/eudas/4.3/doc/eudas.hdb.9 b/app/eudas/4.3/doc/eudas.hdb.9 new file mode 100644 index 0000000..341feca --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.9 @@ -0,0 +1,556 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (83)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +9 Das virtuelle Dateikonzept + + + +9.1 Konzept + +Bisher haben Sie zu einem Zeitpunkt immer nur eine EUDAS-Datei +bearbeiten können. Wenn Sie zu einer anderen Datei wechseln woll­ +ten, mußten Sie die eine Datei sichern und die andere Datei wieder +öffnen. Es gibt jedoch Fälle, in denen Beziehungen zwischen mehre­ +ren Dateien bestehen. Daher kann EUDAS auch mit mehreren Dateien +gleichzeitig umgehen. + Es hat jedoch Vorteile, wenn man nur mit einer Datei arbeitet. +Sie müssen dann nicht immer den Namen der gewünschten Datei +angeben, wenn Sie eine Funktion ausführen. Dies brauchen Sie nur +einmal beim Öffnen zu tun - danach ist eindeutig festgelegt, wel­ +che Datei gemeint ist. + EUDAS versucht diese Vorteile auch bei mehreren Dateien zu +erhalten. Die verschiedenen Dateien werden so kombiniert, daß eine +neue Datei entsteht. Sie arbeiten dann nur mit dieser Datei, die alle +Daten der Einzeldateien enthält. + Damit Sie aber nicht so lange warten müssen, geschieht dieser +Kombinationsvorgang erst beim Ansehen. Die kombinierte Datei ist +also nicht wirklich vorhanden, sondern ihre Einzelsätze werden nur +bei Bedarf erzeugt. Daher heißt diese Gesamtdatei auch #on("i")#virtuelle#off("i")# +(scheinbare) Datei. + Eine Kombination von Dateien ist auf zwei Arten möglich. Sie +können gleichartige Dateien hintereinander#on("i")#ketten#off("i")#, oder Sie können +Dateien über gemeinsame Felder #on("i")#koppeln#off("i")#. Beide Methoden können +auch kombiniert werden. + +#on("b")#Änderungen#off("b")# Die virtuelle Datei kann auch verändert werden. +Die +Veränderungen werden dann in den entsprechenden Ursprungsda­ +teien vorgenommen. Es ist jedoch nicht immer eindeutig, wie diese +Änderungen aussehen sollen. Achten Sie daher auf die speziellen +Regeln, die bei solchen Änderungen gelten, damit Sie die Auswir­ +kungen einer Änderung abschätzen können. + Wenn Sie Veränderungen vorgenommen haben, müssen Sie die +Arbeitskopien anschließend wieder sichern. Denken Sie daran, daß +EUDAS immer auf unbenannten Kopien arbeitet, wenn Sie ändern +wollen. Beim Sichern von mehreren Dateien wird Ihnen zu jeder +Datei einzeln angezeigt, ob sie tatsächlich verändert wurde. Sie +können dann ebenfalls einzeln entscheiden, ob Sie die Datei sichern +wollen oder nicht. + + +9.2 Ketten + +Wenn Sie einmal EUDAS-Dateien mit mehreren tausend Sätzen er­ +stellen, werden Sie feststellen, daß deren Handhabung recht um­ +ständlich sein kann. Da die Datei sehr groß ist, dauern zum Beispiel +Kopiervorgänge aufs Archiv viel länger als bei kleinen Dateien. + Wenn Sie nun auch noch für jede kleine Änderung die Datei +vom Archiv holen und anschließend wieder zurückschreiben müssen, +werden Sie einen Weg suchen, diese Arbeit zu erleichtern. Die ein­ +fachste Möglichkeit wäre, einen schnelleren Rechner zu kaufen. Dies +ist gleichzeitig aber auch die teuerste. + + +#free (4.5)# + +#center#Abb. 9-1 Verkettung von A und B + + +EUDAS ermöglicht es Ihnen nun, die große Datei in mehrere kleine +aufzuspalten. In der Regel gibt es bei solch großen Dateien ein +Kriterium, nach dem die Sätze in verschiedene Dateien verteilt +werden können. Jede einzelne Datei kann nun bequem geändert +werden. + Ein Problem entsteht jedoch, wenn alle Dateien zusammen ver­ +arbeitet werden müssen (zum Beispiel beim Drucken). Für einen +solchen Vorgang können Sie die kleineren Dateien logisch aneinan­ +derketten. + Dies bedeutet für Sie, daß alle kleinen Dateien wie eine große +Datei wirken. Wenn Sie beim Bewegen in der Datei das Ende einer +einzelnen Datei erreichen, kommen Sie automatisch an den Anfang +der nächsten Datei. + +#on("b")#Aufruf#off("b")# Damit dies funktioniert, müssen die Dateien +natürlich +gleiche Feldstruktur haben. Außerdem ist die Zahl der verkettbaren +Dateien aus technischen Gründen auf 10 beschränkt. + Sie können die Dateien verketten, indem Sie die Funktion +#free (0.2)# + + K Ketten + +#free (0.2)# +im Menü 'Öffnen' aufrufen. + +#on("b")#Änderungen#off("b")# In der virtuellen Datei ist sowohl Einfügen als +auch +Ändern erlaubt. Beim Einfügen ist jedoch zu beachten, daß am Ende +einer Datei nicht angefügt werden kann. Dies liegt daran, daß Sie +entweder vor dem letzten Satz der einen Datei oder vor dem ersten +Satz der anderen Datei einfügen. Der Endesatz der einen Datei, der +normalerweise sichtbar wäre, wird übersprungen. + Am Ende der letzten Datei können Sie natürlich anfügen, da +deren Endemarkierung als Ende der ganzen Datei ja wieder sichtbar +ist. + + +9.3 Koppeln + +Nachdem das Verketten von Dateien noch ganz einfach zu verstehen +war, kommt jetzt eine Funktion auf Sie zu, die kompliziertere Mög­ +lichkeiten in sich birgt: nämlich das Koppeln. + Es kommt häufiger vor, daß sich ein Feld einer Datei auf einen +bestimmten Satz in einer anderen Datei bezieht. So könnten zum +Beispiel die Ausleihen einer Bücherei in folgender Datei gespeichert +sein: + + + 'Name' + 'Vorname' + 'Datum' + 'Buch-Nr.' + + +Wenn jetzt ein Ausleiher sein Rückgabedatum überschritten hat, +möchte die Bücherei dem Kunden ein Mahnschreiben schicken. Auf +diesem Schreiben soll aber nicht die Buch-Nr. erscheinen, sondern +Autor und Titel des Buches. + Diese Sekundärinformationen sind in einer anderen Datei ge­ +speichert, der Bestandskartei: + + + 'Buch-Nr.' + 'Autor' + 'Titel' + 'Verlag' + + +Alle Dateistrukturen hier sind natürlich zwecks größerer Übersicht­ +lichkeit vereinfacht. Um jetzt dem Kunden das Mahnschreiben zu +schicken, müssen die Informationen in den beiden Dateien korreliert +werden. + +#on("b")#Aufruf#off("b")# Zuerst wird die Ausleihdatei normal geöffnet. Dazu +wird dann die Bestandsdatei mit Hilfe der Funktion +#free (0.2)# + + K Koppeln + +#free (0.2)# +gekoppelt. Dies hat folgenden Effekt: + Die Sätze erscheinen normal so, wie sie in der Ausleihdatei +auftauchen, also für jede Ausleihe genau ein Satz. Dazu erscheint +aber jeweils die Beschreibung des ausgeliehenen Buches aus der +Bestandsdatei: die beiden Dateien wurden über das Feld "Buch-Nr." +gekoppelt. + Als Struktur ergibt sich für die kombinierte Datei: + + + 'Name' + 'Vorname' + 'Datum' + 'Buch-Nr.' + 'Titel' + 'Autor' + 'Verlag' + + +Die Felder der Koppeldatei wurden also noch hinzugefügt. + +#on("b")#Koppelfelder#off("b")# Zwei Dinge sind in diesem Zusammenhang +wichtig: +Damit der Koppelvorgang ohne allzuviele Vorgaben auskommen kann, +müssen Felder, über die gekoppelt wird, den gleichen Namen haben +- und zwar exakt Zeichen für Zeichen. Zum zweiten muß ein solches +#on("i")#Koppelfeld#off("i")# am Anfang der gekoppelten Datei (in unserem Fall der +Bestandsdatei) stehen. Dies ist aus technischen Gründen notwendig, +damit der Koppelvorgang in vernünftiger Geschwindigkeit ablaufen +kann. + + +#free (7.0)# + +#center#Abb. 9-2 Schema des Koppelvorgangs + + +#on("b")#Mehrere Dateien#off("b")# Genau wie beim Ketten ist die Kombination +der +Dateien nicht physikalisch, sondern nur scheinbar vollzogen worden. +Bis zum Limit der maximal geöffneten Dateien (10) können Sie auch +weitere Dateien dazukoppeln. Die Koppelfelder dieser Dateien kön­ +nen sich jedoch immer nur auf die erste Datei beziehen, also nicht +auf eine andere Koppeldatei. + Dies könnte man in unserem Beispiel ausnutzen. Die Bücherei +hat sicher auch eine Datei ihrer Mitglieder. Diese könnte etwa so +aussehen: + + + 'Name' + 'Vorname' + 'm/w' + 'Strasse' + 'PLZ' + 'Ort' + + +Diese Datei können wir ebenfalls zur Ausleihdatei dazukoppeln. +Damit haben wir auch gleich die Quelle gewonnen, aus der wir die +Anschrift für das Mahnschreiben gewinnen können. + Die Kopplung geschieht in diesem Fall über zwei Felder, näm­ +lich 'Name' und 'Vorname'. Damit ein Mitglied eindeutig identifi­ +ziert wird, werden beide Namen gebraucht. Dies berücksichtigt auch +das Koppelverfahren. Wiederum müssen die Namen exakt mit Namen +der ersten Datei übereinstimmen. + Wenn mehrere Koppelfelder für eine Koppeldatei notwendig sind, +müssen Sie alle hintereinander stehen. Wäre die Struktur der Mit­ +gliederdatei etwa + + + 'Name' + 'Titel' + 'Vorname' + 'm/w' + 'Strasse' + 'PLZ' + 'Ort' + + +würde nur über 'Name' gekoppelt, da 'Titel' in der ersten Datei +nicht vorkommt. Alle weiteren Felder können dann keine Koppelfel­ +der mehr werden. Durch Umstellen der Feldreihenfolge der Koppel­ +datei (durch Umkopieren) oder durch entsprechende Benennung von +Feldern können Sie immer den gewünschten Effekt erzielen. + + +#free (8.0)# + +#center#Abb. 9-3 Aufbau der virtuellen Datei + + +#on("b")#Zusammenfassung#off("b")# An dieser Stelle wollen wir die Ergebnisse +dieses Abschnitts als Regel zusammenfassen: + +#limit (12.0)# + Die ersten Felder der Koppeldatei, die wörtlich an be­ + liebiger Stelle auch in der ersten Datei auftauchen, + werden Koppelfelder genannt. Zu einem Satz der ersten + Datei wird ein Satz der Koppeldatei gezeigt, der im In­ + halt der Koppelfelder übereinstimmt. +#limit (13.5)# + +Übersetzt in unser Beispiel heißt dies: 'Buch-Nr.' bzw. 'Name' und +'Vorname' sind Koppelfelder. Zu einer bestimmten Ausleihe erschei­ +nen die Daten des Buches mit der angegebenen Buch-Nr. bzw. die +Adresse des Mitgliedes mit den angegebenen Namen. + + +9.4 Auswirkungen des Koppelns + +Nachdem Sie nun das Grundprinzip des Koppelns kennen, sollen Sie +einige Auswirkungen dieses Verfahrens kennenlernen. + Ein Beispiel dazu finden Sie in Abb. 9-4. Dargestellt sind je­ +weils die Satznummern und einige Inhalte. Die zweite Zeile in der +Hauptdatei und die erste in der Koppeldatei stellen das Koppelfeld +dar. + + +#free (6.5)# + +#center#Abb. 9-4 Kombinationen + + +#on("b")#Kombinationen#off("b")# Zuerst muß geklärt werden, was passiert, +wenn es +keinen passenden Satz in der Koppeldatei gibt. Zum Beispiel könnte +eine Buchnummer eingegeben worden sein, die in der Bestandsdatei +nicht existiert. In diesem Fall zeigt EUDAS für die Felder der Kop­ +peldatei einfach einen leeren Inhalt an (siehe Satz 23 der Haupt­ +datei, es gibt keinen Satz mit 'L' in der Koppeldatei). + Wenn umgekehrt zu einem bestimmten Buch keine Ausleihe +existiert, macht das natürlich nichts - das Buch erscheint nur +dann, wenn Sie die Bestandsdatei alleine öffnen. + Weiterhin kann es passieren, daß es zwei passende Sätze in der +Koppeldatei gibt. Dies kommt dann vor, wenn zwei Mitglieder glei­ +chen Namen und gleichen Vornamen haben (was gar nicht so selten +ist). In diesem Fall zeigt EUDAS beide Kombinationen an (siehe +Satz 23 der Hauptdatei). Die Ausleihe erscheint also zweimal, je­ +weils mit einem anderen Mitglied. + Damit man diesen Fall ohne weiteres erkennen kann, führt +EUDAS bei Kopplungen zwei Nummern: zum einen die normale Satz­ +nummer und zum anderen eine Kombinationsnummer. In dem eben +besprochenen Fall würde die Satznummer gleichbleiben, die Kombi­ +nationsnummer aber hochgezählt werden. Am Bildschirm wird die +Kombinationsnummer durch Bindestrich getrennt hinter die Satz­ +nummer geschrieben, wenn Sie Dateien koppeln. + Das Durchgehen aller Kombinationen zu einem Satz der Haupt­ +datei passiert aber nur dann, wenn Sie sich mit der Funktion 'Satz +weiter' in der Datei bewegen. Wenn Sie rückwärts gehen oder auf +einen bestimmten Satz positionieren, wird immer nur die erste Kom­ +bination angezeigt (Dies hat zum Teil technische Gründe). Beim +Zurückgehen von Satz 23-1 in dem Beispiel würde also auf Satz +22-1 positioniert und die Kombination 22-2 übersprungen. + +#on("b")#Änderungen#off("b")# Auch wenn Sie Dateien gekoppelt haben, können +Sie +immer noch Sätze ändern und einfügen (wenn Sie dies beim Öffnen +erlaubt haben). Die Auswirkungen der Veränderungen sind jedoch +nicht mehr ganz so einfach wie bei geketteten Dateien, wo sich die +Änderungen ja einfach auf den aktuellen Satz bezogen. + Als Grundregel gilt, daß Änderungen möglichst wenig Auswir­ +kungen auf die Koppeldateien haben sollen. Das führt dazu, daß +beim Einfügen eines neuen Satzes oder beim Entfernen eines Satzes +durch Tragen keine Aktion in der Koppeldatei durchgeführt wird. +Dies ist auch nicht nötig, denn wenn zum Beispiel ein neuer (zu­ +nächst leerer) Satz eingefügt wird, existiert sowieso noch kein +passender Satz in der Koppeldatei und die entsprechenden Felder +bleiben leer. Hingegen darf beim Entfernen eines Satzes der Satz in +der Koppeldatei nicht entfernt werden, da er ja noch zu einem an­ +deren Satz gehören könnte. + Änderungen an den Koppelfeldern können nun zu drei verschie­ +denen Reaktionen führen: + +1. Es wird kein Satz der Koppeldatei geändert, sondern nur ein + neuer passender Satz gesucht. Dies geschieht immer dann, wenn + außer den Koppelfeldern nur leere Inhalte für die Felder der + Koppeldatei angegeben sind. Nach dem Ändern oder Einfügen + werden dann die Inhalte des neuen Koppelsatzes angezeigt. + + Beispiel: Bei einer Ausleihe geben Sie Name und Vorname des + Ausleihers an, nicht aber seine Adresse. Wenn Sie den Satzedi­ + tor beim Einfügen mit ESC 'q' verlassen, wird die zugehörige + Adresse angezeigt (falls der entsprechende Name in der Kop­ + peldatei vorhanden ist). + +2. Es wird ein neuer Satz in der Koppeldatei angefügt. Dies ge­ + schieht immer dann, wenn die Koppelfelder verändert wurden + und die anderen Felder der Koppeldatei nicht leer sind. Da­ + durch soll verhindert werden, daß die Koppelfelder in einem + Satz verändert werden, der vielleicht noch zu einem anderen + Satz paßt. + + Beispiel: Sie geben bei einer Ausleihe auch die Adresse mit + an. Wenn eine Person mit gleichem Namen und Vornamen bereits + existiert, wird die dort gespeicherte Adresse nicht überschrie­ + ben. Stattdessen wird die zweite Adresse auch in die Koppel­ + datei eingetragen. Beim nächsten Ansehen bekommen Sie dann + zwei Adressen angezeigt. So wird verhindert, daß Sie ungewollt + die erste Adresse vernichten. + +3. Der Satz in der Koppeldatei wird verändert. Dies geschieht nur + dann, wenn die Koppelfelder unverändert geblieben sind, der + Rest sich aber geändert hat. + + Beispiel: Sie ändern eine Ausleihe mit der zugehörigen + Adresse. Sie geben nur eine neue Straße an und lassen Name + und Vorname unverändert. Der Satz in der Koppeldatei enthält + anschließend die neue Straße. + +Da Koppeldateien keine Sortierung besitzen müssen, werden neue +Sätze der Koppeldatei immer am Ende angefügt. Dies ist zu beach­ +ten, wenn die Koppeldatei auch allein verwendet werden soll. Ge­ +gebenenfalls müssen Sie die Koppeldatei dann erst sortieren. + + +9.5 Umschalten auf Koppeldatei + +Häufig kommt es vor, daß Sie beim Einfügen eines neuen Satzes mit +gekoppelten Dateien die Verbindung mit einem existierenden Satz +der Koppeldatei erreichen wollen, aber den notwendigen Inhalt der +Koppelfelder nicht auswendig wissen. + So wollen Sie beim Eingeben einer Ausleihe Name und Vorname +des Entleihers nicht immer wieder abtippen. Dabei ist auch die +Gefahr von Eingabefehlern sehr groß. Stattdessen wollen Sie lieber +erst den Entleiher in der Mitgliederdatei suchen und dessen Namen +dann automatisch in den Entleihsatz übernehmen. + Hierfür bietet Ihnen EUDAS eine Unterstützung an. + +#on("b")#Ausführung#off("b")# Während Sie sich in der virtuellen Datei +befinden, +können Sie auf eine bestimmte Koppeldatei umschalten, die Sie dann +wie eine Einzeldatei bearbeiten können. Beim Zurückschalten haben +Sie dann die Möglichkeit, die Koppelfelder des gefundenen Satzes zu +übernehmen. + Das Umschalten bewirken Sie durch die Tastenkombination ESC +'K' (großes K) nur im Menü 'Einzelsatz' sowie im Satzeditor beim +Einfügen und Ändern. An anderen Stellen hat dieser Befehl keine +Wirkung. Bei mehreren Koppeldateien werden Ihnen die Dateien der +Reihenfolge nach angeboten. Durch Verneinung aller Fragen können +Sie die Funktion ohne Wirkung beenden. + Haben Sie nun umgeschaltet, wird Ihnen die Koppeldatei dar­ +geboten, als hätten Sie sie allein geöffnet. Sie können die Datei +auch beliebig ändern (wenn Sie dies beim Öffnen angegeben haben). +Nur die Anzeige in der Bildüberschrift zeigt an, daß Sie +sich in einer Koppeldatei befinden. Sie können auch Funktionen in +anderen Menüs aufrufen. + Das Zurückschalten geschieht im Menü 'Einzelsatz' mit der +gleichen Tastenkombination. Alle Einstellungen der virtuellen Datei +von vorher bis auf die Feldauswahl bleiben erhalten. + Wenn Sie nicht im Menü, sondern im Satzeditor (also beim +Ändern oder Einfügen) umschalten, werden Sie zunächst wieder aus +dem Satzeditor rausgeworfen. Sie können dann in der Koppeldatei +den gewünschten Satz aufsuchen (oder neu eintragen). Beim Zurück­ +schalten werden Sie gefragt, ob Sie die Koppelfelder übernehmen +wollen oder nicht. Danach kehren Sie automatisch wieder in den +Satzeditor zurück, wobei jetzt die Koppelfelder gegebenenfalls aus­ +gefüllt oder überschrieben sind. + Durch erneutes Umschalten können Sie den Vorgang auch für +weitere Koppeldateien wiederholen. + Die Position, die Sie beim Umschalten in der Koppeldatei einge­ +nommen haben, wird bis zum nächsten Umschalten gespeichert. Sie +kommen dann zunächst wieder auf den gleichen Satz. So können Sie +die gleichen Koppelfelder wie beim letzten Mal übernehmen, indem +Sie einfach zweimal ESC 'K' tippen. + +#on("b")#Beispiel#off("b")# Der typische Vorgang beim Entleihen würde dann +wie folgt +aussehen. Zunächst öffnen Sie die Entleihdatei mit Änderungser­ +laubnis; dann koppeln Sie die Mitgliederdatei und die Bestandsdatei +dazu. + Für eine neue Ausleihe rufen Sie zunächst die Funktion 'Ein­ +fügen' auf. Dann tippen Sie ESC 'K' und schalten auf die Mitglie­ +derdatei um. Dort suchen Sie das Mitglied und schalten wieder zu­ +rück. Existierte das Mitglied noch nicht, können Sie es gleich ein­ +tragen. Beim Zurückschalten übernehmen Sie den Namen des Mit­ +glieds. + Dann tragen Sie die Nummer des Buches ein (die müssen Sie nur +dann suchen, wenn Sie nicht auf dem Buch steht). Das Entleihdatum +erhalten Sie mit Hilfe der Tastenkombination ESC 'D' (wird im näch­ +sten Kapitel beschrieben). + Wollen Sie mehrere Ausleihen für ein Mitglied eintragen, so +tippen Sie beim nächsten Einfügen einfach zweimal ESC 'K', ohne +dazwischen eine Positionierung vorzunehmen. + + +9.6 Mehrfachbenutzung + +EUDAS ermöglicht es mehreren Benutzern an einem Rechner, mit den +gleichen Dateien zu arbeiten. Dies ist eigentlich nichts Besonderes, +denn das EUMEL-System ist ja bereits von Haus aus dazu geeignet. +Es müssen jedoch einige Schutzvorkehrungen getroffen werden, +damit dadurch keine Probleme entstehen. + Als Grundvoraussetzung für die Mehrfachbenutzung müssen +EUDAS-Dateien in einer unabhängigen #on("i")#Managertask#off("i")# gespeichert +sein. Eine Managertask kann man sich durch das Kommando 'global +manager' einrichten. In dieser Task sollte dann nicht mehr gearbei­ +tet werden. + Stattdessen kann sich der Benutzer Dateien aus dieser Mana­ +gertask kopieren und auch wieder dorthin zurückschreiben. Wie Sie +dies im EUDAS-Menü bewerkstelligen können, wird im Kapitel 16 +beschrieben. Es sei nochmal betont, daß dies eine Methode ist, die +Sie für beliebige Dateien verwenden können. + Im Kapitel 16 ist weiterhin auch beschrieben, wie Sie solche +Dateien mit #on("i")#Passworten#off("i")# schützen können, so daß sie nicht jeder +benutzen kann. Schauen Sie bei Bedarf dort nach. + + +#free (7.7)# + +#center#Abb. 9-5 Mehrfachbenutzung + + +#on("b")#Konflikte#off("b")# Wir wollen uns jedoch jetzt um ein Problem +kümmern, das +bei dieser Art von Mehrfachbenutzung auftritt. Nehmen wir an, +unsere Bücherei habe zwei Plätze, an denen Entleihen durchgeführt +werden können. Beide Plätze sollen mit der gleichen Entleihdatei +arbeiten (wie Sie gleich noch sehen werden und aus anderen Grün­ +den würde man EUDAS für eine solche Bücherei nicht einsetzen - +wir wollen hier nur das Prinzip illustrieren). + Der Ablauf wäre dann folgendermaßen. Jeder Platz kopiert sich +für eine Entleihe die gemeinsame Datei aus der Managertask, öffnet +sie, trägt die Entleihe ein und sichert die Datei wieder. Dann wird +die Datei in die Managertask zurückgeschrieben, wo sie die alte +Entleihdatei ersetzt. + Abgesehen von dem viel zu hohen manuellen Aufwand kann der +Fall eintreten, daß beide gleichzeitig eine Entleihe bearbeiten. +Nehmen wir an, beide benutzen die Entleihdatei mit dem symboli­ +schen Inhalt A. Auf Platz 1 kommt noch die Entleihe B, auf Platz 2 +die Entleihe C dazu. Platz 1 will anschließend den Inhalt AB zu­ +rückschreiben, Platz 2 den Inhalt AC. + Je nach der zeitlichen Reihenfolge wird nur eine der beiden +Versionen übrigbleiben, da derjenige, der später zurücksichert, die +vorherige Version überschreibt. Richtig sollte die endgültige Version +ABC herauskommen. Unser Beispiel führt jedoch auf jeden Fall zu +einer fehlerhaften Datei. + Grund dafür ist, daß beim Zurückschreiben der ganzen Datei ein +Platz gesperrt werden muß, während der andere Platz eine Datei +zum Ändern angefordert hat. Man könnte auch dazu übergehen, nur +einzelne Sätze zu übertragen; diese Methode wird jedoch von EUDAS +wegen des hohen Aufwandes nicht unterstützt (daher würde man +EUDAS eben auch nicht für eine Mehrplatz-Bücherei nehmen). + In vielen Fällen reicht das Sperren ganzer Dateien jedoch aus, +besonders, wenn nicht ganz so häufig an einzelnen Sätzen geändert +wird. EUDAS bietet dafür neben der notwendigen Sperre auch noch +eine automatische Versendung der Dateien an. + +#on("b")#Manager#off("b")# Es bietet sich an, dieses Kopieren der Dateien +beim Öff­ +nen (auch Koppeln und Ketten) und Sichern automatisch durchzu­ +führen. Als Voraussetzung dafür müssen Sie EUDAS angeben, mit +welcher Managertask Sie arbeiten wollen. Dazu dient die Funktion +#free (0.2)# + + M Manager + +#free (0.2)# +im Menü 'Öffnen'. Sie werden dann nach dem Namen der Task ge­ +fragt. Geben Sie keinen Namen an, wird der Managermodus wieder +ausgeschaltet. Welche Task als Manager eingestellt ist, sehen Sie in +der untersten Bildschirmzeile. + In der Task, die Sie angeben, muß EUDAS insertiert sein (oder +in einem Vater), da sonst die Sperre nicht funktioniert. + Wenn Sie nun einen solchen Manager angegeben haben, können +Sie beim Öffnen Dateinamen aus dieser Task angeben. Auch bei ESC +'z' werden Ihnen alle Namen aus dem Manager mit angeboten. Wenn +Sie einen solchen Namen angeben, der nicht aus Ihrer eigenen Task +stammt, wird die Datei vor dem Öffnen automatisch kopiert. Wenn +Sie angegeben haben, daß Sie die Datei verändern wollen, wird in +der Managertask eine entsprechende Sperre gesetzt. + Wenn Sie die Datei nach Änderungen dann sichern, wird die +geänderte Kopie zurückgeschrieben. Die Sperre wird jedoch erst +dann aufgehoben, wenn Sie die Arbeitskopien endgültig löschen. + Möchte nun ein anderer Benutzer diese Datei öffnen, während +Sie sie ändern, kann er dies nur, wenn er sie nicht ändern will. +Natürlich wird die Datei dann auch nicht wieder zurückgeschickt. +Will er sie ändern, erhält er eine Fehlermeldung und kann den +Versuch später wiederholen. + +#on("b")#Vorsichtsmaßregeln#off("b")# Bedenken Sie, daß der Schutz nur +wirksam sein +kann, wenn Sie diesen Vorgang nicht unter Umgehung der Menü­ +steuerung ausführen. Würden Sie sich zum Beispiel eine Datei vom +Manager holen (s. Kapitel 16), ohne daß Sie ein Änderungsvorhaben +anmelden können, können Sie diese Datei ja trotzdem ändern und +wieder zurückschicken. In diesem Fall hat EUDAS keine Kontrolle +mehr über die Datei. + Aus dem gleichen Grund sollten Sie sich die Managertask auch +nicht an Ihren Bildschirm holen, denn auch dann könnten Sie ohne +Kontrolle Änderungen durchführen (zudem kann der Manager wäh­ +rend dieser Zeit nicht auf andere Benutzer reagieren). + Nur wenn Sie eine neue Datei im Manager anlegen, müssen Sie +dies von Hand tun. Dazu erstellen Sie die Datei ganz normal und +schreiben Sie mit der in Kapitel 16 beschriebenen Funktion zum +Manager. Sie sollten jedoch darauf achten, daß dort nicht schon +eine Datei gleichen Namens liegt (EUDAS fragt ja dann, ob über­ +schrieben werden soll). + diff --git a/app/eudas/4.3/doc/eudas.hdb.inhalt b/app/eudas/4.3/doc/eudas.hdb.inhalt new file mode 100644 index 0000000..62134f8 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.inhalt @@ -0,0 +1,133 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +Inhalt + + + + Vorwort . . . . . . . . . . . . . . . . . . . i + Inhalt . . . . . . . . . . . . . . . . . . . . iii + + +I. Die ersten Schritte + +#on("b")#1 Was kann EUDAS ?#off("b")# +#free (0.2)# +1.1 Textverarbeitung und Datenverwaltung . . . . . 3 +1.2 EUDAS als Karteikasten . . . . . . . . . . . . 5 +1.3 Drucken . . . . . . . . . . . . . . . . . . . 7 +1.4 Grenzen . . . . . . . . . . . . . . . . . . . 9 + +#on("b")#2 Installation#off("b")# +#free (0.2)# +2.1 Lieferumfang . . . . . . . . . . . . . . . . . 11 +2.2 Single-User . . . . . . . . . . . . . . . . . 12 +2.3 Multi-User . . . . . . . . . . . . . . . . . . 13 + +#on("b")#3 Ein Beispiel zum Ausprobieren#off("b")# +#free (0.2)# +3.1 Start . . . . . . . . . . . . . . . . . . . . 15 +3.2 Daten eintragen . . . . . . . . . . . . . . . 16 +3.3 Daten abfragen . . . . . . . . . . . . . . . . 21 +3.4 Drucken . . . . . . . . . . . . . . . . . . . 22 +3.5 Ergebnis . . . . . . . . . . . . . . . . . . . 24 + + +II. Einführung in die Benutzung + +#on("b")#4 Umgang mit Dateien und Menüs#off("b")# +#free (0.2)# +4.1 EUDAS-Dateien . . . . . . . . . . . . . . . . 27 +4.2 EUDAS-Menüs . . . . . . . . . . . . . . . . . 29 +4.3 Archivmenü . . . . . . . . . . . . . . . . . . 32 +4.4 Dateiverwaltung . . . . . . . . . . . . . . . 37 +4.5 Bedienungsregeln . . . . . . . . . . . . . . . 39 + +#on("b")#5 Gespeicherte Daten abfragen#off("b")# +#free (0.2)# +5.1 Öffnen . . . . . . . . . . . . . . . . . . . . 43 +5.2 Bewegen . . . . . . . . . . . . . . . . . . . 45 +5.3 Suchen . . . . . . . . . . . . . . . . . . . . 46 +5.4 Suchbedingungen . . . . . . . . . . . . . . . 49 + +#on("b")#6 Daten eingeben und ändern#off("b")# +#free (0.2)# +6.1 Neue Datei einrichten . . . . . . . . . . . . 51 +6.2 Sätze einfügen . . . . . . . . . . . . . . . . 52 +6.3 Daten ändern . . . . . . . . . . . . . . . . . 55 +6.4 Arbeitskopie sichern . . . . . . . . . . . . . 56 + +#on("b")#7 Ausdrucken der Daten#off("b")# +#free (0.2)# +7.1 Druckmuster . . . . . . . . . . . . . . . . . 61 +7.2 Aufruf . . . . . . . . . . . . . . . . . . . . 64 +7.3 Abschnitte . . . . . . . . . . . . . . . . . . 67 +7.4 Feldmuster . . . . . . . . . . . . . . . . . . 69 + +#on("b")#8 Was war und was noch kommt#off("b")# +#free (0.2)# +8.1 Rückblick . . . . . . . . . . . . . . . . . . 75 +8.2 Ausblick . . . . . . . . . . . . . . . . . . . 76 + + +III. Weitere Möglichkeiten + +#on("b")#9 Das virtuelle Dateikonzept#off("b")# +#free (0.2)# +9.1 Konzept . . . . . . . . . . . . . . . . . . . 83 +9.2 Ketten . . . . . . . . . . . . . . . . . . . . 84 +9.3 Koppeln . . . . . . . . . . . . . . . . . . . 85 +9.4 Auswirkungen des Koppelns . . . . . . . . . . 89 +9.5 Umschalten auf Koppeldatei . . . . . . . . . . 92 +9.6 Mehrfachbenutzung . . . . . . . . . . . . . . 93 + +#on("b")#10 Datenabfrage am Bildschirm#off("b")# +#free (0.2)# +10.1 Feldauswahl . . . . . . . . . . . . . . . . . 97 +10.2 Satzeditor . . . . . . . . . . . . . . . . . . 98 +10.3 Suchmuster . . . . . . . . . . . . . . . . . . 99 +10.4 Markieren . . . . . . . . . . . . . . . . . . 104 +10.5 Übersicht . . . . . . . . . . . . . . . . . . 105 + +#on("b")#11 Funktionen zur Bearbeitung#off("b")# +#free (0.2)# +11.1 Sortieren . . . . . . . . . . . . . . . . . . 109 +11.2 Kopieren . . . . . . . . . . . . . . . . . . . 112 +11.3 Tragen . . . . . . . . . . . . . . . . . . . . 118 +11.4 Automatische Änderungen . . . . . . . . . . . 121 + +#on("b")#12 Weitere Möglichkeiten zum Drucken#off("b")# +#free (0.2)# +12.1 Anschluß an die Textverarbeitung . . . . . . . 123 +12.2 Spaltendruck . . . . . . . . . . . . . . . . . 126 +12.3 Modi . . . . . . . . . . . . . . . . . . . . . 128 + +#on("b")#13 Programmierung von Druckmustern#off("b")# +#free (0.2)# +13.1 Abkürzungen . . . . . . . . . . . . . . . . . 133 +13.2 Bedingte Musterteile . . . . . . . . . . . . . 141 +13.3 Übersetzung . . . . . . . . . . . . . . . . . 142 +13.4 Gruppen . . . . . . . . . . . . . . . . . . . 144 + +#on("b")#14 Ausdrücke in ELAN#off("b")# +#free (0.2)# +14.1 Was sind Ausdrücke ? . . . . . . . . . . . . . 151 +14.2 Datentypen . . . . . . . . . . . . . . . . . . 152 +14.3 TEXT-Funktionen . . . . . . . . . . . . . . . 156 +14.4 Rechenfunktionen . . . . . . . . . . . . . . . 160 +14.5 Abfragen . . . . . . . . . . . . . . . . . . . 161 + +#on("b")#15 Anweisungen in ELAN#off("b")# +#free (0.2)# +15.1 Variablen und Zuweisungen . . . . . . . . . . 165 +15.2 Weitere Konstruktionen . . . . . . . . . . . . 168 + +#on("b")#16 Dateiverwaltung mit EUDAS#off("b")# +#free (0.2)# +16.1 Dateien im System . . . . . . . . . . . . . . 171 +16.2 Dateien auf dem Archiv . . . . . . . . . . . . 174 + + +IV. Anhang + + Register . . . . . . . . . . . . . . . . . . . 181 + diff --git a/app/eudas/4.3/doc/eudas.hdb.macros b/app/eudas/4.3/doc/eudas.hdb.macros new file mode 100644 index 0000000..d06e6d1 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.macros @@ -0,0 +1,80 @@ +#*format# +#limit (13.5)##start (3.5,2.5)##pagelength (21.0)##block# +#:firsthead (false)# +#linefeed (1.07)# +#*macro end# +#*text# +#type ("prop10")# +#linefeed (1.07)# +#*macro end# +#*beispiel# +#type ("12")# +#linefeed (0.97)# +#*macro end# +#*bildschirm# +#type ("17")# +#linefeed(0.83)# +#*macro end# +#*proc# +#type ("12")# +#*macro end# +#*endproc# +#free (0.1)# +#type ("prop10")# +#linefeed (1.0)# +#*macro end# +#*abschnitt ($1,$2,$3)# +#headodd# +#on("b")#$1#right#$3 %#off("b")# +#free (1.0)# +#end# +#on("b")##ib(9)#$1#ie(9,"   $3")# $2#off("b")# +#*macro end# +#*char($1)# +$1 +#*macro end# +#*kapitel ($1,$2,$3,$4)# +#free (1.3)# +#"nlq"# +#type("roman.24")# +#on("b")##center#$1#off("b")# +#free (0.2)# +#type ("roman.18")# +#on("b")##center#$2 #off("b")# +#on("b")##center# $3#off("b")# +#on("b")##center#$4#off("b")# +#type ("prop10")# +#free (0.6)# +#headeven# +#on("b")#% $2 $3 $4#off("b")# +#free (1.0)# +#end# +#headodd# +#right##on("b")#%#off("b")# +#free (1.0)# +#end# +#*macro end# +#*f2# +#free (0.2)# +#*macro end# +#*a ($1)# +#on("b")#$1.#off("b")#  +#*macro end# +#*bsp ($1)# +#type("12")#$1#type("prop")# +#*macro end# + + + + + + + + + + + + + + + diff --git a/app/eudas/4.3/doc/eudas.hdb.titel b/app/eudas/4.3/doc/eudas.hdb.titel new file mode 100644 index 0000000..b8cc805 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.titel @@ -0,0 +1,99 @@ +#limit (14.0)# +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#E U D A S + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# + +#free (6.0)# +#on("b")#EUDAS#off("b")# +#free (1.0)# +#on("b")#Anwender-#off("b")# +#on("b")#Datenverwaltungssystem#off("b")# +#free (2.0)# +#on ("b")#VERSION 4#off("b")# +#free(1.0)# +#on("u")#                                                    #off("u")# +#free (0.5)# +#on("b")#BENUTZERHANDBUCH#off("b")# +#block# +#page# +#free (12.0)# +Ausgabe Juli 1987 + +Dieses Handbuch und das zugehörige Programm sind urheberrechtlich +geschützt. Die dadurch begründeten Rechte, insbesondere der Ver­ +vielfältigung in irgendeiner Form, bleiben dem Autor vorbehalten. + +Es kann keine Garantie dafür übernommen werden, daß das Pro­ +gramm für eine bestimmte Anwendung geeignet ist. Die Verantwor­ +tung dafür liegt beim Kunden. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrekt­ +heit und Vollständigkeit der Angaben wird aber keine Gewähr über­ +nommen. Das Handbuch kann jederzeit ohne Ankündigung geändert +werden. + +(c) Copyright 1987 Thomas Berlage + Software-Systeme + Im alten Keller 3 +#free (0.1)# + D-5205 Sankt Augustin 1 +#page# +#free (7.0)# +#center##on("b")#I.#off("b")# +#free (1.0)# +#center##on("b")#DIE#off("b")# +#center##on("b")#ERSTEN#off ("b")# +#center##on("b")#SCHRITTE#off("b")# +#page# +#free (7.0)# +#center##on("b")#II.#off("b")# +#free (1.0)# +#center##on("b")#EINFÜHRUNG#off("b")# +#center##on("b")#IN DIE#off ("b")# +#center##on("b")#BENUTZUNG#off("b")# +#page# +#free (7.0)# +#center##on("b")#III.#off("b")# +#free (1.0)# +#center##on("b")#WEITERE#off("b")# +#center##on("b")#MÖGLICHKEITEN#off("b")# +#page# +#free (7.0)# +#center##on("b")#IV.#off("b")# +#free (1.0)# +#center##on("b")#ANHANG#off("b")# + + + + + + + + diff --git a/app/eudas/4.3/doc/eudas.hdb.vorwort b/app/eudas/4.3/doc/eudas.hdb.vorwort new file mode 100644 index 0000000..6f7f17c --- /dev/null +++ b/app/eudas/4.3/doc/eudas.hdb.vorwort @@ -0,0 +1,89 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#EUDAS + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# +Vorwort + + + +Lieber EUDAS-Benutzer ! + +Dieses Handbuch soll Sie bei Ihrer Arbeit mit EUDAS begleiten. Ob­ +wohl EUDAS nicht schwierig zu bedienen ist, gibt es doch eine Reihe +von Dingen zu lernen, ehe Sie ein EUDAS-Spezialist geworden sind. + Um Ihnen diesen Weg möglichst einfach zu machen, ist die +EUDAS-Dokumentation in zwei Handbücher aufgeteilt. Dies ist das +#on("b")#Benutzerhandbuch#off("b")#, das Ihnen eine gut lesbare Einführung in alle +Fähigkeiten von EUDAS bieten soll. Außerdem gibt es noch das +#on("b")#Referenzhandbuch#off("b")#, das Ihnen zum Nachschlagen und als Hilfe beim +Programmieren dienen soll. + + Bis Sie EUDAS gut beherrschen, sollten Sie sich also mit dem +Benutzerhandbuch beschäftigen. Das Benutzerhandbuch ist nochmal +in drei Teile aufgeteilt, um Ihnen das Lernen zu erleichtern. In +jedem Teil werden die vorher behandelten Dinge zyklisch wieder +aufgenommen und auf höherem Niveau erweitert. + Der allererste Teil des Handbuchs umfaßt nur drei Kapitel und +soll Ihnen über den ersten Tag mit EUDAS hinweghelfen. Dort finden +Sie eine Übersicht, was Sie mit EUDAS anfangen können, wie Sie das +Programm auf Ihrem Rechner installieren und ein kurzes Beispiel +zum Ausprobieren. + Im zweiten Teil lernen Sie dann die Grundkonzepte von EUDAS +anhand von zahlreichen Beispielen kennen. Sie sollten die Beispiele +am Rechner ausprobieren und ihre Bedeutung verstehen. Nach dem +Durcharbeiten dieses Teils (was höchstens wenige Tage in Anspruch +nimmt) sind Sie dann in der Lage, EUDAS für eigene Zwecke anzu­ +wenden. + Wenn Ihre Ansprüche dann wachsen, sollten Sie sich mit dem +dritten Teil befassen. Hier erhalten Sie Einblick in weitergehende +Möglichkeiten von EUDAS. Die einzelnen Kapitel sind relativ unab­ +hängig voneinander, so daß Sie nur die für Sie interessanten +genauer durchlesen müssen. + In Kapitel 8 finden Sie als Orientierung nicht nur eine Wieder­ +holung dessen, was Sie im zweiten Teil gelernt haben sollten, son­ +dern auch eine Übersicht, welche weiteren Möglichkeiten im dritten +Teil noch beschrieben werden. + + Im Referenzhandbuch finden Sie später, wenn Sie einige Erfah­ +rung gesammelt haben, eine genaue Beschreibung der Wirkungsweise +aller Funktionen. Um diese zu verstehen, sollten Sie jedoch bereits +eine grobe Ahnung der Wirkungsweise haben. + Als zweites finden Sie im Referenzhandbuch Informationen für +Programmierer, die EUDAS-Funktionen in eigenen Programmen ver­ +wenden wollen. Dies sollte jedoch in den meisten Fällen nicht not­ +wendig sein, so daß dieser Teil für Spezialisten reserviert bleibt. + + Trotz größter Bemühungen kann das Handbuch natürlich nicht +frei von Unklarheiten und Fehlern sein. Anregungen und Kritik sind +daher dringend erwünscht, um diese Dokumentation zu verbessern. + +Und nun viel Spaß bei Ihrer Arbeit mit EUDAS ! + diff --git a/app/eudas/4.3/doc/eudas.ref.1 b/app/eudas/4.3/doc/eudas.ref.1 new file mode 100644 index 0000000..7c66368 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.1 @@ -0,0 +1,326 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (3)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +Zustände und Bedienung + + + +1.1 Zustände + +EUDAS befindet sich zu jeder Zeit in einem von 11 verschiedenen +Zuständen. Für jeden Zustand ist festgelegt, welche Eingabetasten +benutzt werden können und welche Wirkung sie haben. Bestimmte +Tastenfunktionen führen in einen anderen Zustand. Obwohl für +jeden Zustand andere Tastenkombinationen gültig sind, wird für die +gleiche Funktion in jedem Zustand auch die gleiche Taste oder +Tastenkombination verwendet. + Die wichtigsten Tastenfunktionen eines Zustandes werden in +der #on("i")#Statuszeile#off("i")# am oberen Bildschirmrand angezeigt. + Im folgenden sind alle möglichen Zustände als Übersicht be­ +schrieben. Eine Übersicht der Zustandsübergänge enthält Abb. 1-1. + Zu jedem Zustand wird die entsprechende Statuszeile darge­ +stellt sowie alle möglichen Tastenfunktionen und ihre Bedeutung. + +EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + +_____________________________________________________ + +OBEN Anwahl der nächsthöheren Funktion +UNTEN Anwahl der nächsttieferen Funktion +RECHTS Anwahl des nächsten Menüs zur Rechten +LINKS Anwahl des nächsten Menüs zur Linken +HOP OBEN Anwahl der ersten Funktion +HOP UNTEN Anwahl der letzten Funktion +'1' .. '6' Anwahl des entsprechenden Menüs +LEER Ausführen der gewählten Funktion +'Buchstabe' Ausführen der Funktion mit 'Buchstabe' davor +ESC '?' Hilfestellung zur gewählten Funktion +ESC ESC Eingabe von ELAN-Kommandos + + +HILFE: Beenden: ESC q Seite weiter: ESC w Seite zurueck: ESC z + +_____________________________________________________ + +ESC 'w' Blättern zur nächsten Seite +ESC 'z' Blättern zur vorigen Seite +ESC 'q' Verlassen (Rückkehr in alten Zustand) + + +AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ? + +_____________________________________________________ + +'x' Auswahl ankreuzen +'o' Ankreuzen rückgängig machen +LEER Ankreuzen und Auswahl sofort verlassen +OBEN Zur nächsten Auswahl nach oben +UNTEN Zur nächsten Auswahl nach unten +HOP OBEN Zur obersten Auswahl bzw. eine Seite zurück +HOP UNTEN Zur untersten Auswahl bzw. eine Seite weiter +HOP RETURN Aktuelle Auswahl wird erste auf der Seite +ESC '1' zur ersten Auswahl +ESC '9' zur letzten Auswahl +ESC 'q' Auswahl verlassen und weitermachen +ESC '?' Hilfe zur Auswahl +HOP 'x' alle freien Wahlen ankreuzen +HOP 'o' alle Kreuze entfernen +ESC 'h' Auswahl und Funktion abbrechen + + +EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbrechen: ESC h Hilfe: ESC ? + +_____________________________________________________ + +RECHTS zum nächsten Zeichen +LINKS zum vorigen Zeichen +HOP RECHTS zum letzten Zeichen +HOP LINKS zum ersten Zeichen +RUBOUT Zeichen löschen +RUBIN Einfügemodus umschalten +HOP RUBOUT Rest der Zeile löschen +'Zeichen' Zeichen überschreiben oder einfügen +RETURN Eingabe abschließen und weitermachen +ESC '?' Hilfe zur Eingabe +ESC 'h' Eingabe und Funktion abbrechen +ESC 'z' Auswahl zeigen (falls in Statuszeile aufgeführt) + + +FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ? + +_____________________________________________________ + +'j', 'J' Frage bejahen +'n', 'N' Frage verneinen +ESC '?' Hilfe zur Frage +ESC 'h' Frage und Funktion abbrechen + + +!!! FEHLER !!! Quittieren: ESC q Hilfe zur Meldung: ESC ? + +_____________________________________________________ + +ESC '?' Hilfe zum Fehler +ESC 'Taste' Fehler quittieren +'Taste' Fehler quittieren + + +SATZ ÄNDERN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? +SATZ EINFÜGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? +SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? + +_____________________________________________________ + +ESC OBEN eine Seite zurück blättern +ESC UNTEN eine Seite vor blättern +ESC '?' Hilfe zum Satzeditor +ESC 'p' ganzen Satz merken (nicht bei Suchmuster) +ESC 'g' Satz durch gemerkten ersetzen (nicht bei Such­ + muster) +ESC 'h' Abbruch der Funktion +ESC 'D' Tagesdatum schreiben +ESC 'F' Prüffehler nach Tragen editieren +ESC 'w' Verlassen und mit nächstem Satz erneut aufrufen + (nicht im Suchmuster) +ESC 'z' Verlassen und mit vorigem Satz erneut aufrufen + (nicht im Suchmuster) +ESC RUBIN Rest der Zeile in neue Zeile umbrechen +ESC RUBOUT Rest der Zeile löschen +HOP RUBIN nicht verwenden! +HOP RUBOUT nicht verwenden! + +Weitere Tasten siehe EUMEL-Benutzerhandbuch (Editor). + + +Bitte warten.. + +_____________________________________________________ + +keine Tasten erlaubt (außer SV) + + +ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ? + +_____________________________________________________ + +HOP OBEN auf erste Zeile bzw. eine Seite zurück +HOP UNTEN auf letzte Zeile bzw. eine Seite vor +ESC '?' Hilfe zur Übersicht +ESC 'h' Abbruch der Funktion +ESC 'q' Verlassen + + +EDITIEREN: Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ? + +_____________________________________________________ + +ESC 'F' Feldnamen anzeigen und auswählen +ESC 'h' Abbruch der Funktion + +Weitere Tasten siehe EUMEL-Benutzerhandbuch (Editor). + + +Gib Kommando: + +_____________________________________________________ + +Tasten siehe EINGABE. + + +#free (18.5)# + +#center#Abb. 1-1 Zustandsübergänge + + + + +1.2 Menüs + +Menüs dienen zur Auswahl von Funktionen. Sie werden am linken +Rand des Bildschirms angezeigt. Welches Menü aktiv ist, wird durch +Markierung des Menünamens in der obersten Bildschirmzeile unter +allen zur Verfügung stehenden Menüs angezeigt. In jedem Menü ist +die zuletzt ausgeführte Funktion ebenfalls markiert. + +#on("b")#Ausführen von Funktionen#off("b")# Zum Ausführen einer bestimmten +Funk­ +tion wird mit Hilfe der Cursortasten ein bestimmtes Menü und die +gewünschte Funktion angewählt. Die Funktion wird dann durch +Drücken der Leertaste ausgeführt. Alternativ kann auch der vor der +Funktion stehende Buchstabe gedrückt werden. + Die einzelnen Menüs können auch durch Nummern (1 bis 6) +angewählt werden (absolute Positionierung). + Soll eine andere Taste als die Leertaste zum Ausführen ver­ +wendet werden, so kann dies durch die Prozedur 'ausfuehrtaste' +angegeben werden (s. Abschnitt 10.3). + Funktionen, deren Ausführung augenblicklich nicht möglich +oder nicht sinnvoll ist, werden durch ein vorangestelltes Minuszei­ +chen gekennzeichnet. Sie können zwar angewählt, nicht aber ausge­ +führt werden. + Durch ESC '?' wird ein erläuternder Hilfstext zur gerade ange­ +wählten Funktion angezeigt. Näheres dazu s. Abschnitt 1.4. + Durch ESC ESC kann ein beliebiges ELAN-Kommando eingegeben +und ausgeführt werden. Die Eingabe des Kommandos erfolgt in der +Statuszeile. + + +1.3 Auswahl + +Die Auswahlfunktion dient dazu, aus vorhandenen Datei- oder +Feldnamen in bestimmter Reihenfolge auszuwählen. Die einzelnen +Namen werden untereinander aufgelistet. + Vor jedem Namen ist ein 'o' zum Ankreuzen angegeben. Mit den +Cursortasten kann der Cursor vor einen bestimmten Namen positio­ +niert werden. Mit 'x' kann dieser Name dann angekreuzt werden. Das +Ankreuzen kann durch 'o' wieder rückgängig gemacht werden. + Die Reihenfolge des Ankreuzens wird durch vorangestellte +Nummern gekennzeichnet. Die Namen werden von der entsprechenden +Funktion später in genau dieser Reihenfolge verwendet. + Wenn nicht alle Namen auf den Bildschirm passen, kann die +Darstellung gerollt werden. Ein Teil der Überschrift bleibt dabei +stehen; am Anfang und am Ende wird jeweils eine Abschlußzeile zur +Kennzeichnung mitgerollt. + Mit ESC '?' kann eine Hilfestellung abgerufen werden. Mit ESC +'q' wird die Auswahl beendet. Mit ESC 'h' können die Auswahl und +die in Ausführung befindliche Operation abgebrochen werden. + + +1.4 Hilfe und Dialog + +In den meisten Situationen kann durch ESC '?' eine spezifische +Hilfestellung abgerufen werden. Die Anzeige der Hilfsinformation +geschieht im rechten Bildschirmteil. + Die Texte sind seitenweise aufgebaut. Es wird immer eine Seite +angezeigt. Mit ESC 'w' bzw. ESC 'z' kann auf die nächste bzw, vorige +Seite umgeblättert werden. Mit ESC 'q' wird die Hilfestellung wieder +verlassen und die Situation wiederhergestellt, in der die Hilfe auf­ +gerufen wurde. + +#on("b")#Fragen#off("b")# Die meisten Funktionen wickeln zur Eingabe von +zusätz­ +lichen Parametern oder zum Stellen von Fragen einen Dialog in der +unteren Schirmhälfte ab. Es gibt zwei Möglichkeiten des Dialogs: +eine Frage oder die Eingabe eines Textes. + Bei einer Frage kann man mit 'j' oder 'n' antworten. Sowohl +große als auch kleine Buchstaben werden akzeptiert. Mit ESC '?' +kann eine Hilfsinformation zu der Frage abgerufen werden. ESC 'h' +bricht die fragende Funktion ab. + +#on("b")#Eingabe#off("b")# Bei der Eingabe eines Textes können die üblichen +Opera­ +tionen zum Editieren in einer Zeile verwendet werden. Die Eingabe +wird durch RETURN beendet. Auch hier kann durch ESC '?' eine +Hilfsinformation abgerufen werden. ESC 'h' bricht ebenfalls die fra­ +gende Funktion ab. In einigen Fällen (ersichtlich aus der Statuszei­ +le) kann durch ESC 'z' eine Auswahl der verfügbaren Namen abgeru­ +fen werden. + + +1.5 Editor + +Der EUMEL-Editor wird in EUDAS auf zweierlei Weise aufgerufen. +Zum einen dient er im Satzformular zum Eingeben von Daten und +Suchmustern. Dort wird er als #on("i")#Satzeditor#off("i")# bezeichnet. Da hier die +Feldnamen mit berücksichtigt werden müssen, gibt es einige Unter­ +schiede zum normalen Editor. + An anderen Stellen wird der Editor ohne Änderungen eingesetzt +zum Eingeben von Feldnamen oder Mustern. In diesem Fall finden +Sie die Bedienungshinweise im EUMEL-Benutzerhandbuch. + +#on("b")#Satzeditor#off("b")# Beim Ändern, Einfügen und Eingeben des +Suchmusters +wird im EUDAS-Formular der Editor aufgerufen. Das Editorfenster +beschränkt sich auf den rechten Teil des Formulars, der einen Teil +der Überschrift und die Feldinhalte umfaßt. Im Satzeditor können +dann die entsprechenden Inhalte eingegeben bzw. verändert werden. + Rollen unter Beibehaltung der Korrespondenz ist durch ESC +OBEN und ESC UNTEN möglich. Diese Funktionen wirken wie bei der +Anzeige - das Editorfenster wird ebenfalls entsprechend mitgerollt. +Mit ESC '1' kann wie üblich auf die erste, mit ESC '9' auf die letzte +Zeile gesprungen werden. Auch diese Funktionen passen die Feld­ +namen entsprechend an. + Falls die für ein Feld vorgesehenen Zeilen nicht für den Inhalt +ausreichen, kann durch ESC RUBIN eine weitere Zeile für dieses Feld +bereitgestellt werden. ESC RUBIN wirkt wie zweimal HOP RUBIN, die +Korrespondenz mit den Feldnamen bleibt jedoch gewahrt. + Zum Löschen steht ESC RUBOUT zur Verfügung. Es löscht eine +ganze Zeile, aber nur, wenn für dieses Feld noch andere Zeilen zur +Verfügung stehen, wird die Zeile tatsächlich vom Bildschirm ent­ +fernt. Im Normalfall bleibt sonst eine Leerzeile für dieses Feld ste­ +hen. + Ist die Information für ein Feld auf mehrere Zeilen verteilt, so +werden diese Zeilen zur Verarbeitung aneinandergehängt. Gegebe­ +nenfalls wird zwischen zwei Zeilen noch ein Leerzeichen eingefügt. + Der Editor kann wie üblich mit ESC 'q' verlassen werden. ESC +'h' bricht die Funktion ab, ohne die erfolgten Änderungen und Ein­ +gaben zu berücksichtigen. Mit ESC 'w' und ESC 'z' kann das Bearbei­ +ten von mehreren Sätzen beschleunigt werden. Durch diese Tasten­ +kombinationen wird der Editor verlassen und die gleiche Operation +(Ändern/Einfügen) beim nächsten bzw. vorigen Satz wiederholt. + +#on("b")#Hinweis#off("b")# Aus technischen Gründen kann das Editorfenster +gegen­ +über den Feldnamen verschoben werden (durch Rollen mit HOP +UNTEN zum Beispiel). Dabei geht die sichtbare Korrespondenz zwi­ +schen Feldnamen und Feldinhalten verloren. Ein solcher Fall wird +durch einen markierten Balken mit entsprechender Meldung ange­ +zeigt. Durch ESC '1' wird das Fenster aber wieder zurechtgerückt. + Aus diesem Grund sollte im Satzeditor auf HOP OBEN und HOP +UNTEN sowie auf RETURN am Ende des Fensters verzichtet werden. +Auch HOP RUBIN und HOP RUBOUT sollten nicht verwendet werden, +weil auf diese Weise die Anzahl der Zeilen verändert wird. Eine +solche Störung kann nicht durch ESC '1' beseitigt werden. Von Hand +müssen die entsprechenden Zeilen wieder gelöscht oder eingefügt +werden. + + diff --git a/app/eudas/4.3/doc/eudas.ref.10 b/app/eudas/4.3/doc/eudas.ref.10 new file mode 100644 index 0000000..fbfcf7e --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.10 @@ -0,0 +1,406 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (97)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +10 Programmierung der Menüs + + + +10.1 Menüformat + +EUDAS verwendet drei verschiedene Strukturen zur Benutzerunter­ +stützung: Menü, Auswahl und Hilfestellung. Ein Menü dient zur +Auswahl von Funktionen, eine Auswahl bietet Feld- oder Datei­ +namen an und eine Hilfestellung zeigt einen Informationstext. + Alle diese Strukturen werden aus einer Initialisierungsdatei +eingelesen. Die Initialisierungsdatei ist eine normale Textdatei. Ihr +Format soll in diesem Abschnitt beschrieben werden. + Die Strukturen können in beliebiger Reihenfolge in der Initiali­ +sierungsdatei stehen. Jede Struktur wird durch eine spezielle +Anweisung eingeleitet. Anweisungen beginnen ähnlich wie im +Druckmuster mit einem Prozentzeichen. Dementsprechend gibt es die +drei Anweisungen + + + % MENUE "Name" + % AUSWAHL "Name" + % HILFE "Gebiet/Name" + + +die jeweils eine Struktur einleiten. Beendet wird eine Definition +immer mit + + + % ENDE + + +#on("b")#Menü#off("b")# Für ein Menü wird noch der Text angegeben, der auf +dem +Bildschirm erscheinen soll. Er wird durch die Anweisung + + + % BILD + + +eingeleitet. Danach folgen Zeilen mit dem Bildschirminhalt in der +gewünschten Größe (die tatsächliche Anzeigegröße wird erst beim +Aufruf angegeben). Dabei werden die Auswahlpositionen, auf denen +der Cursor sich bewegen kann, durch ein geschütztes Leerzeichen in +Spalte 2 festgelegt. + Nach der Angabe des Bildes muß für jede mögliche Auswahl­ +position noch eine weitere Angabe gemacht werden. Die Auswahl­ +positionen (oder Felder) werden dabei von oben nach unten durch­ +gezählt. Begonnen wird mit der Nummer 1. + Eine Felddefinition hat das Format + + + % FELD nr "Hilfstext" "Tasten" + + +Die Nummer identifiziert das Feld. Der Hilfstext gibt den Namen der +Hilfestellung an, die gezeigt werden soll, wenn auf diesem Feld ESC +'?' gedrückt wird. Die Tasten sind alle Zeichen, die gedrückt werden +können, um dieses Feld direkt auszuführen. + Anschließend an die Felddefinition kann in weiteren Zeilen +noch ein ELAN-Programm folgen, das bei Auswahl des Feldes aus­ +geführt wird. + +#on("b")#Auswahl#off("b")# Für eine Auswahl muß zuerst ein Vorspann angegeben +werden, der immer in den ersten Bildschirmzeilen der Auswahl an­ +gezeigt wird. Dieser wird durch + + + % VORSPANN + + +eingeleitet. Danach folgt das Bild. Das Bild setzt sich aus drei Tei­ +len zusammen. Die erste Zeile, in der ein geschütztes Leerzeichen +vorkommt, bildet den Wiederholungsteil. Diese Zeile wird nachher so +oft wie nötig mit entsprechenden Inhalten wiederholt, wobei das +geschützte Leerzeichen als Bindestrich dargestellt wird, auf dem +sich der Cursor bewegen kann. Die Teile davor und danach werden +jeweils bei Bedarf mitgerollt. + Die Wiederholungszeile darf mehrere geschützte Leerzeichen +enthalten. Die Inhalte werden dann in mehreren Spalten angezeigt. +Zu beachten ist, daß vor einem Trennstrich noch mindestens fünf +Zeichen Platz für eine laufende Nummer bleiben müssen. + +#on("b")#Hilfe#off("b")# Der Name einer Hilfestellung setzt sich aus zwei +Teilen +zusammen, die durch einen Schrägstrich getrennt werden. Der erste +Name gibt die Kategorie der Hilfestellung an, der zweite Name den +Einzeltext. Dies dient dazu, die relativ große Zahl der Hilfstexte +überschaubar zu machen. Als Beispiel + + + % HILFE "JA/Allgemein" + + +Eine Hilfestellung besteht einfach aus mehreren Seiten Text. Jede +Seite wird durch die AnweisungQ + + +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q + + +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈ +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈ +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈ +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈ +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q + + +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q + + +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q +Q̈Q̈Q̈Q̈Q̈Q̈Q̈estellung, wobei die Seiten einfach von 1 an durch­ +gezählt werden. Anschließend darf für diese Seite natürlich kein +Text folgen. + + +10.2 Verwaltung der Menüs + +Alle Menüdaten werden intern in Datenräumen gehalten. Dabei sind +die einzelnen Strukturen getrennt. Mit 'menuedaten einlesen' kön­ +nen Menüdaten aus einer Struktur gelesen und abgespeichert wer­ +den. Existierende Strukturen werden dabei überschrieben, neue +hinzugefügt. + Mit 'menuenamen' können die vorhandenen Strukturen abgefragt +werden. Mit 'menue loeschen' werden einzelne Strukturen oder alle +Menüdaten gelöscht. Damit die Datenräume mit den Menüdaten auch +an Söhne übergeben werden, ist der 'global manager' entsprechend +geändert. Dies wird im einzelnen durch 'menue manager' bewirkt. +Der neue Global Manager akzeptiert auch Anfragen von Tasks, die +nicht Söhne oder Enkel sind. + + +PROC menuedaten einlesen (TEXT CONST dateiname) + + Die in der Datei enthaltenen Strukturen werden eingelesen und + abgespeichert. Treten bei diesem Prozeß Fehler auf, so wird + eine entsprechende Meldung ins EUMEL-Notizbuch geschrieben + und nachher im Paralleleditor angezeigt. + + +THESAURUS PROC menuenamen (INT CONST index) + + Liefert die Namen der Strukturen. Der Index hat folgende Be­ + deutung: + 1: Hilfskategorien + 2: Menüs + 3: Auswahlen + Ist der Index negativ, so werden die Hilfsnamen der entspre­ + chenden Hilfskategorie geliefert, die im Thesaurus den Index + mit umgekehrtem Vorzeichen hat. + + +PROC menue loeschen (TEXT CONST name, INT CONST index) + + Löscht den Namen in dem Thesaurus mit dem angegebenen In­ + dex, falls dort der Name vorhanden ist. + + +PROC menue loeschen (BOOL CONST hilfen reduzieren) + + Löscht alle Menüdaten. Ist 'hilfen reduzieren' verlangt, wird + beim späteren Einlesen der Hilfstexte jeweils nur der erste + Text einer Kategorie gespeichert, um Platz zu sparen. + + +PROC global manager + + Geänderter Manager, der die Menüdatenräume in Söhne trans­ + portiert und Sperren setzen kann. Ersetzt den normalen 'free + global manager'. Nur im Multi-User-System vorhanden. + + +PROC menue manager (DATASPACE VAR ds, + INT CONST order, phase, + TASK CONST order task) + + Eigentliche Manager-Routine. Kann dazu dienen, Managererwei­ + terungen vorzunehmen. Nur im Multi-User-System vorhanden. + Beispiel: der Manager soll nur Aufträge von Söhnen annehmen. + + + PROC new manager (DATASPACE VAR ds, + INT CONST order, phase, + TASK CONST order task): + + LET begin code = 4; + IF order task < myself OR order = begin code OR + order task = supervisor THEN + menue manager (ds, order, phase, order task) + ELSE + errorstop ("kein Sohn") + END IF + + END PROC new manager; + + global manager (PROC new manager) + (* startet den Manager *) + + + +10.3 Aufruf + +Menüs werden mit der Prozedur 'menue anbieten' aufgerufen. Dabei +muß neben den Namen ein Fenster übergeben werden, in dem die +Menüs dann angezeigt werden. Es ist darauf zu achten, daß das +Fenster groß genug ist, um wenigstens die Auswahlpositionen im +Bild zu haben. + Außerdem muß eine Prozedur übergeben werden, die die einzel­ +nen Funktionen ausführt. Diese Prozedur erhält als Parameter die +Nummer der ausgewählten Funktion. + Mit 'waehlbar' können Auswahlen gesperrt werden. Diese Anga­ +be kann jedoch nicht vor Aufruf von 'menue anbieten' erfolgen, da +dann alle Sperren erstmal gelöscht werden. Zum Setzen der Sperren +beim Betreten eines Menüs dient ein besonderer Code, mit dem die +übergebene Prozedur aufgerufen wird. + Eine Auswahl wird mit der Prozedur 'auswahl anbieten' aufge­ +rufen. Diese bekommt ebenfalls ein Fenster übergeben, außerdem +den Namen einer Hilfestellung, die bei Bedarf aufgerufen werden +kann. Weiterhin muß eine Prozedur übergeben werden, die die aus­ +zuwählenden Texte erzeugt. Die gewählten Texte können anschlie­ +ßend mit der Prozedur 'wahl' abgefragt werden. + Eine Hilfestellung wird durch die Prozedur 'hilfe anbieten' +ausgegeben. Dabei muß außer dem Namen auch noch ein Fenster +übergeben werden. + Mit 'status anzeigen' kann ein Text in der Statuszeile ausge­ +geben werden. Die Menüprogramme tun dies für ihren Bereich jedoch +selbst. + + +PROC menue anbieten (ROW 6 TEXT CONST menuenamen, + FENSTER VAR f, + BOOL CONST esc erlaubt, + PROC (INT CONST, INT CONST) interpreter) + + Die angegebenen Menüs werden in dem Fenster 'f' angezeigt. + Das Fenster wird nach Beendigung des Menüs als verändert + gekennzeichnet. Die Namen der 6 Menüs werden in die Titelzeile + aufgenommen. Die Menünamen sollten mit einer Menüidentifika­ + tion versehen sein, zum Beispiel "EUDAS.Öffnen". Der Text vor + dem Punkt wird an den Anfang der Titelzeile gestellt und bei + den einzelnen Menünamen unterdrückt. Nicht benötigte Menüs + müssen als "" angegeben werden. + + 'esc erlaubt' gibt an, ob mit ESC ESC ein Kommandodialog ge­ + führt werden kann. Die übergebene Prozedur muß die einzelnen + Funktionen ausführen, die als Zahl übergeben werden. Der + Interpreter wird im 'disable stop' aufgerufen, daher ist in der + Regel ein 'enable stop' erforderlich. + + Die Parameter für 'interpreter' haben folgende Bedeutung: + Par. 1: 0 Aufruf zur Initialisierung der Sperren + oder anderen Initialisierungen zu Beginn + 1..6 Angabe des aktuellen Menüs + Par. 2: 1..23 Aufruf der entsprechenden Funktion + 0 Eintritt in ein neues Menü (wird vor der + Ausgabe dieses Menüs aufgerufen) + -1 Verlassen des Menüs + -2 Bildschirmupdate (nach Eintritt in das + Menü, wenn das Menü ganz ausgegeben ist, + oder wenn der Bildschirm nach 'Gib + Kommando:' zerstört worden ist) + + FEHLER: + + #on("i")#"Name" existiert nicht.#off("i")# + Das angegebene Menü ist nicht vorhanden. + + +PROC waehlbar (INT CONST menuenr, funktionsnr + BOOL CONST moeglich) + + Setzt die Funktionssperre der angegebenen Funktion. Muß in­ + nerhalb von 'menue anbieten' aufgerufen werden. Zu Beginn von + 'menue anbieten' sind jeweils alle Funktionen erlaubt. + + +PROC ausfuehrtaste (TEXT CONST taste) + + Setzt die Taste, die Funktionen ausführt. Ist standardmäßig die + Leertaste. + + FEHLER: + + #on("i")#falsche Ausfuehrtaste#off("i")# + Es muß ein einzelnes Zeichen angegeben werden, das nicht + bereits anderweitig verwendet wird. + + +PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, + TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) + + Ruft die Auswahl in dem angegebenen Fenster auf. 'hilfe' wird + als Hilfestellung verwendet. Die Prozedur 'inhalt' liefert den + Text, der an der n-ten Position stehen soll. Wenn keine wei­ + teren Texte vorhanden sind, muß für alle weiteren Positionen + "" geliefert werden. + + FEHLER: + + #on("i")#"Name" existiert nicht.#off("i")# + Die angegebene Auswahl ist nicht vorhanden. + + +INT PROC wahl (INT CONST stelle) + + Liefert die Nummer des Textes, der an der n-ten Stelle ausge­ + wählt wurde. Wurde kein weiterer Text mehr gewählt, so wird 0 + geliefert. + + +PROC hilfe anbieten (TEXT CONST name, FENSTER CONST f) + + Bietet den Hilfstext in dem angegebenen Fenster an. Existiert + die Hilfe innerhalb der angegebenen Kategorie nicht, wird die + erste Hilfe der Kategorie angezeigt. + + FEHLER: + + #on("i")#Hilfe existiert nicht#off("i")# + Die angegebene Hilfskategorie ist nicht vorhanden. + + +PROC status anzeigen (TEXT CONST zeile) + + Zeigt den angegebenen Text in der obersten Bildschirmzeile an. + + +10.4 Dialog + +EUDAS führt den Benutzerdialog in einem Fenster, dessen Größe +durch 'dialogfenster' eingestellt wird. Das Dialogfenster wird zei­ +lenweise belegt. 'dialog' reserviert eine neue Zeile für eine beliebi­ +ge Ausgabe. Wenn das Fenster voll ist oder überschrieben wurde, +wird in der ersten Zeile wieder angefangen. Den gleichen Effekt +kann man mit 'neuer dialog' erreichen. + Mit 'ja' kann man im Dialogfenster eine Frage stellen. Als Ant­ +wort kann auch eine Hilfestellung angefordert werden oder die +Funktion abgebrochen werden. Mit 'editget' kann man nach Auffor­ +derung einen Text eingeben lassen. Dabei stehen die gleichen +zusätzlichen Möglichkeiten zur Verfügung. + Mit 'fehler ausgeben' kann eine durch 'errorstop' erzeugte Feh­ +lermeldung im Dialogfenster angezeigt werden. Der Benutzer muß +erst eine Taste drücken, ehe er weitermachen kann. Auch hier kann +eine Hilfestellung zu der Fehlermeldung abgerufen werden. + + +PROC dialogfenster (INT CONST x, y, xl, yl) + + Gibt die Fenstergröße und -position des Dialogfensters an. Für + den ganzen Bildschirm müßte (1, 1, 79, 24) angegeben werden. + + +PROC dialog + + Positioniert den Cursor auf die nächste Dialogzeile im Dialog­ + fenster. Wurde das Fenster verändert, wird das Fenster ge­ + löscht und auf die erste Zeile positioniert. + + +PROC neuer dialog + + Sorgt dafür, daß der nächste Aufruf von 'dialog' wieder in + einem leeren Fenster beginnt. + + +BOOL PROC ja (TEXT CONST frage, hilfe) + + Stellt die angegebene Frage. Es kann die angegebene Hilfsin­ + formation abgerufen werden. Außerdem wird durch ESC 'h' ein + Abbruch (errorstop ("")) erzeugt. + + +PROC editget (TEXT CONST prompt, TEXT VAR eingabe, + TEXT CONST res, hilfe) + + Gibt den Text 'prompt' aus und editiert dahinter 'eingabe'. Es + kann die angegebene Hilfsinformation abgerufen werden. 'res' + gibt an, bei welchen ESC-Folgetasten das Editieren beendet + werden soll. In einem solchen Fall wird als Eingabe (ESC + die + gedrückte Taste) zurückgeliefert. + + +PROC fehler ausgeben + + Im Dialogfenster wird die letzte Fehlermeldung ausgegeben. + Gleichzeitig wird der Fehlerzustand gelöscht. Der Benutzer muß + eine Taste drücken, um weiterzumachen. Alternativ kann die + Hilfsinformation "FEHLER/" + text (errorcode) abgerufen wer­ + den. + + diff --git a/app/eudas/4.3/doc/eudas.ref.11 b/app/eudas/4.3/doc/eudas.ref.11 new file mode 100644 index 0000000..48d36c3 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.11 @@ -0,0 +1,347 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (105)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +11 Programmierung von Anwendungen + + + +Zur Realisierung eigener EUDAS-Anwendungen mit Hilfe von ELAN- +Programmen gibt es mehrere Möglichkeiten mit zunehmender Lei­ +stungsfähigkeit, aber auch steigender Komplexität und Fehleranfäl­ +ligkeit. In den folgenden Abschnitten werden die drei wesentlichen +Methoden vorgestellt. Sie sollten erst dann eine kompliziertere +Methode in Angriff nehmen, wenn Sie die einfachere beherrschen. + + +11.1 Musterprogramme + +Die bevorzugte Methode zur Erstellung eigener Anwendungen unter +EUDAS ist die Programmierung von Mustern. EUDAS läßt dies bei +Druckmustern, Kopiermustern und Änderungsmustern zu. + In diesem Fall steuert EUDAS den Ablauf des Programms im +groben automatisch. Die jeweils unterschiedlichen Anweisungen, was +im einzelnen zu tun ist, werden in ELAN programmiert. Aus dem +Muster mit diesen zusätzlichen Anweisungen generiert EUDAS dann +das Programm und führt es mit Hilfe des ELAN-Compilers aus. + +#on("b")#Vorteile#off("b")# Diese Methode hat den Vorteil, daß nur die +minimal not­ +wendigen Anweisungen tatsächlich selbst programmiert werden +müssen. Dafür reichen bereits geringe ELAN-Kenntnisse vollkommen +aus. Ein Muster kann relativ schnell erstellt und getestet werden. +Durch den einfachen Aufbau ist auch die Fehlerwahrscheinlichkeit +beim Entwickeln geringer als bei anderen Methoden. + Daneben lassen sich die Musterprogramme jeweils bequem im +Menü durch Angabe des Namens oder durch Ankreuzen ausführen, +also auch durch unbedarfte Benutzer. + +#on("b")#Nachteile#off("b")# Nachteil dieser Methode ist, daß jeweils beim +Aufruf das +Programm nochmal neu erzeugt und übersetzt werden muß, da die +Übersetzung auch von der gerade geöffneten Datei abhängt. Dies +stört besonders bei umfangreichen Druckmustern (auf langsamen +Rechnern). + Zum zweiten wird ein umfangreiches Druckmuster auch bald +unübersichtlich, da Strukturierungshilfen für größere Programme +fehlen. Der eigentliche Mustertext ist dann schwer von den zahlrei­ +chen Abkürzungen zu trennen. + Als Abhilfe für diese beiden Nachteile bietet es sich an, um­ +fangreichere Abkürzungen bzw. Ausdrücke eingebettet in ein +ELAN-Paket aus dem Muster herauszunehmen und vorher zu in­ +sertieren. + Dadurch fällt zum einen die ständige Neuübersetzung dieser +Ausdrücke weg, zum anderen ist das eigentliche Muster wieder +überschaubar. Voraussetzung zur Anwendung eines solchen Musters +ist dann jedoch, daß das zugehörige Paket in der jeweiligen Task +bereits vorher übersetzt wurde. + Die nachfolgenden Beispiele zeigen, wie dieses Verfahren in der +Realität aussehen kann. + +#on("b")#Beispiel 1#off("b")# In der Schulverwaltung soll ein Kopier- oder +Ände­ +rungsmuster erstellt werden, das die Versetzung am Schuljahresende +realisiert. Angenommen wird eine Datei, die alle Schüler enthält. +Schüler, die nicht versetzt werden, sind vorher im Feld 'Versetzung' +mit einem beliebigen Text gekennzeichnet worden (zum Beispiel +'Nachprüfung' o.ä.). + Die Versetzung kann auf zweierlei Weise erfolgen: zum einen +durch automatische Änderung, wenn die alte Version noch auf einer +Archivdiskette aufgehoben wird, oder durch Kopieren in eine neue +Datei. + Bei beiden Mustern ist die einzige Änderung die Angabe der +neuen Klasse. Daher bietet es sich an, eine Prozedur 'neue klasse' +zu definieren, die als Ergebnis die neue Klasse eines Schülers lie­ +fert. Diese Prozedur kann dann im Änderungsmuster wie folgt ver­ +wendet werden: + + + "Klasse" V neue klasse; + + +Entsprechend läuft die Verwendung im Kopiermuster: + + + "Name" K f ("Name"); + "Vorname" K f ("Vorname"); + "Klasse" K neue klasse; + ... + + +Die Prozedur 'neue klasse' muß dann in einem Paket definiert wer­ +den, das etwa folgendes Aussehen haben könnte (spezifische Ände­ +rungen natürlich möglich): + + + PACKET klassenwechsel DEFINES neue klasse: + + TEXT PROC neue klasse : + + IF f ("Versetzung") = "" THEN + klasse um 1 erhoeht + ELSE + alte klasse ohne zusatz + END IF . + + klasse um 1 erhoeht : + INT CONST alte klasse := int (f ("Klasse")); + IF alte klasse < 9 THEN + "0" + text (alte klasse + 1) + zusatz + ELSE + text (alte klasse + 1) + zusatz + END IF . + + zusatz : + f ("Klasse") SUB 3. + + alte klasse ohne zusatz : + subtext (f ("Klasse"), 1, 2) . + + END PROC neue klasse; + + END PACKET klassenwechsel; + + +Schüler, die versetzt werden, erhalten ihre neue Jahrgangsstufe mit +dem alten Klassenzusatz zugeteilt. Dabei ist darauf zu achten, daß +die Klassen 5 bis 9 eine '0' vorangestellt bekommen, damit die +Sortierung funktioniert. + Schüler, die nicht versetzt werden, behalten ihre alte Jahr­ +gangsstufe, allerdings ohne einen Klassenzusatz, der ihnen an­ +schließend manuell zugewiesen werden muß. + Zur Benutzung muß das oben angegebene Paket in eine Text­ +datei geschrieben und mit dem Kommando 'insert' fest insertiert +werden. + +#on("b")#Beispiel 2#off("b")# Aus einer Datei mit bibliographischen Einträgen +sollen +bestimmte Literaturhinweise gedruckt werden. Der Literaturhinweis +soll jeweils als Endlostext umbrochen werden. Dafür müssen in einer +Abkürzung alle Daten verkettet werden. Es sei das folgende ein­ +fache Druckmuster vorgegeben: + + + % WIEDERHOLUNG + % MODUS 3 + [&] &titel + + % ABKUERZUNGEN + &krz : f ("Kurzbez") . (* z.B. "Lew84" *) + &titel : titel lang . + + +Die Prozedur 'titel lang' wird in folgendem Paket definiert: + + + PACKET bibliographie DEFINES titel lang : + + TEXT VAR puffer; (* verringert Heap-Belastung *) + + TEXT PROC titel lang : + + puffer := f ("Name 1"); + puffer CAT ", "; + puffer CAT f ("Vorname 1"); + ggf weitere namen; + titel kursiv; + enthalten in; + erscheinungsort und jahr; + puffer . + + ggf weitere namen: + IF f ("Name 2") <> "" THEN + puffer CAT "; "; + puffer CAT f ("Name 2") + END IF . + + titel kursiv : + puffer CAT " \#on (""i"")\#"; + puffer CAT f ("Titel"); + puffer CAT "\#off (""i"")\#, " . + + enthalten in : + IF f ("in") <> "" THEN + puffer CAT " in: "; + puffer CAT f ("in"); + puffer CAT ", " + END IF . + + erscheinungsort und jahr : + puffer CAT f ("Ort"); + puffer CAT ", "; + puffer CAT f ("Jahr") . + + END PROC titel lang; + + END PACKET bibliographie; + + +Die Puffervariable wird verwendet, um die bei Verwendung des +Operators '+' entstehende Heapbelastung zu verringern. An diese +Variable werden nacheinander alle notwendigen Daten mit den ent­ +sprechenden Trennzeichen angehängt. + Im Druckmuster wird dieser lange Text dann im Modus 3 auf +mehrere Zeilen umbrochen, wobei die Einrückung erhalten bleibt. Die +Druckausgabe kann dann bei Bedarf noch mit 'lineform' bearbeitet +werden, um einen noch besseren Umbruch zu erzielen. + + +11.2 Dateianwendungen + +Die zweite Möglichkeit der Programmierung unter EUDAS besteht +darin, ELAN-Programme zu schreiben, die EUDAS-Dateien mit Hilfe +des in Kapitel 6 beschriebenen Datentyps EUDAT manipulieren. Die +Programmierung gestaltet sich ähnlich wie mit FILEs. + +#on("b")#Vorteile#off("b")# Durch dieses Verfahren haben Sie volle Freiheit +der Pro­ +grammierung. Da lediglich die Struktur der EUDAS-Dateien als +Datenspeicher verwendet wird, sind sehr viele Anwendungen denk­ +bar. + Außerdem können so beliebig viele Dateien gleichzeitig bear­ +beitet werden. Da die Programme nicht auf die virtuelle Datei zu­ +greifen, ist ein Konflikt mit dem aktuellen Zustand von EUDAS +nahezu ausgeschlossen. + +#on("b")#Nachteile#off("b")# Der Nachteil dieses Verfahrens ist, daß viele +Dinge +selbst programmiert werden müssen, so zum Beispiel das Durchgehen +einer Datei. Auch die Hilfsmittel der virtuellen Datei wie Such­ +muster, Koppeln und alle Anwendungen, die auf die virtuelle Datei +zugreifen, stehen nicht zur Verfügung. + +#on("b")#Beispiel 1#off("b")# Die in Abschnitt 6.6 vorgestellte Anwendung als +Asso­ +ziativspeicher kann als Beispiel für diese Methode dienen. + +#on("b")#Beispiel 2#off("b")# Eine EUDAS-Datei (zum Beispiel eine +Schülerdatei) soll +in mehrere Dateien aufgespalten werden (zum Beispiel klassen­ +weise). Dies kann durch das folgende Beispielprogramm bewirkt +werden: + + + LET + klassenfeld = 3, + quellname = "Schüler", + zielname = "Jahrgang "; + ROW 9 EUDAT VAR ziel; + EUDAT VAR quelle; + SATZ VAR feldnamen; + + quelle oeffnen; + zieldateien einrichten; + auf satz (quelle, 1); + WHILE NOT dateiende (quelle) REP + aktuellen satz kopieren; + weiter (quelle) + END REP . + + quelle oeffnen : + oeffne (quelle, quellname); + feldnamen lesen (quelle, feldnamen) . + + zieldateien einrichten : + INT VAR i; + FOR i FROM 1 UPTO 9 REP + oeffne (ziel (i), zielname + text (i + 4)); + feldnamen aendern (ziel (i), feldnamen) + END REP . + + aktuellen satz kopieren : + SATZ VAR satz; + satz lesen (quelle, satz); + satz einfuegen (ziel (stufe), satz); + weiter (ziel (stufe)) . + + stufe : + TEXT VAR klasse; + feld lesen (satz, klassenfeld, klasse); + int (klasse) - 4 . + + + +11.3 Integrierte Anwendungen + +Die schwierigste Möglichkeit, Anwendungen unter EUDAS zu reali­ +sieren, ist ihre Integration. Ein solches Programm greift selbst auf +die virtuelle Datei zu, nutzt die Funktionen von EUDAS so weit wie +möglich und definiert vielleicht sogar ein eigenes Menü. + +#on("b")#Vorteile#off("b")# Auf diese Weise können natürlich alle +Möglichkeiten +ausgeschöpft werden. Sie können Programme erstellen, die als eine +natürliche Erweiterung von EUDAS wirken oder EUDAS ganz erset­ +zen. + +#on("b")#Nachteile#off("b")# Eine solche Integration ist aber besonders +schwierig, +wenn EUDAS und die Erweiterung nebeneinander benutzt werden +sollen. In diesem Fall hat EUDAS keine komplette Kontrolle der +Interaktion, so daß leicht undefinierte Zustände möglich sind. + Weniger Probleme treten auf, wenn sichergestellt ist, daß nur +die Anwendung selbst verwendet wird. Auch in diesem Fall ist zu +beachten, daß EUDAS nicht als Programmierumgebung für Anwen­ +dungssysteme konzipiert wurde und daher nicht immer leicht zu +benutzen ist. + Am einfachsten ist es noch, nur eigene Menüs für eine andere +Anwendung zu verwenden, da die Menüprozeduren relativ unabhän­ +gig vom Rest sind. + +#on("b")#Richtlinien#off("b")# Bei Erweiterungen von EUDAS sind folgende +Richtlinien zu beachten: + +1. Ein Programm, das selber Dateien für die virtuelle Datei öffnen + will, sollte vorher prüfen, ob noch eine Datei geöffnet ist und in + diesem Fall abbrechen. Beim Multi-User-Betrieb ist nämlich + sonst nicht gewährleistet, daß alle Sperren wieder entfernt + werden. + +2. Ein solches Programm sollte seine eigenen Dateien vor dem + Wechsel zu EUDAS selbst wieder sichern und die Arbeitskopien + löschen, damit der Ausgangszustand zu Beginn des Programms + wiederhergestellt wird. + +3. Programme, die Menüs benutzen, sollten nicht unter EUDAS auf­ + gerufen werden, da sonst eine Beeinflussung der EUDAS-Menüs + möglich ist. + +An dieser Stelle soll noch einmal von der Erstellung integrierter +Anwendungen abgeraten werden, wenn es auch andere Möglichkeiten +gibt, das gegebene Problem mit EUDAS zu lösen. Der hohe Aufwand +dieser Methode rechtfertigt sich nur in wenigen Fällen. + Experimentierfreudige Anwender werden sich durch diese War­ +nung sowieso nicht abhalten lassen. Ihnen sollte aber bewußt sein, +daß ein solches Vorgehen auf eigene Gefahr stattfindet und kein +Anspruch auf Beratung oder Fehlerbeseitigung in einem solchen Fall +besteht. + diff --git a/app/eudas/4.3/doc/eudas.ref.2 b/app/eudas/4.3/doc/eudas.ref.2 new file mode 100644 index 0000000..2447897 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.2 @@ -0,0 +1,830 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (13)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +2 Zusammenstellung der Funktionen + + + +Im folgenden finden Sie eine Übersicht über alle Menüfunktionen. Zu +jeder Funktion ist aufgeführt, welche Parameter angegeben werden +müssen. Die Parameter werden als Text erfragt. Bei einigen Funk­ +tionen können alle möglichen Parameterwerte mit ESC 'z' (Zeigen) +als Auswahl abgerufen werden. Bei manchen können in der Auswahl +mehrere Werte angekreuzt werden, die dann nacheinander abgear­ +beitet werden. Welcher Fall zutrifft, ist jeweils aufgeführt. + + +2.1 Menü 'Öffnen' + + +#linefeed (0.5)# +#on ("b")#O EUDAS-Datei Öffnen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl + +Zweck: Stellt eine EUDAS-Datei als aktuelle Arbeitsdatei ein. + Falls eine vorher geöffnete Datei verändert wurde, + wird sie nach Anfrage gesichert. Falls die zu öffnende + Datei noch nicht existiert, kann sie nach Anfrage + eingerichtet werden. Dabei müssen dann die Feld­ + namen angegeben werden. + + Es wird gefragt, ob die Datei geändert werden soll. In + diesem Fall wird eine Arbeitskopie hergestellt. Fast + alle EUDAS-Funktionen beziehen sich nachher auf die + so eingestellte Datei. + + Ist ein Mehrbenutzer-Manager eingestellt, kann auch + eine Datei aus dieser Managertask als Parameter + angegeben werden. Die Datei wird dann automatisch + von dort kopiert und eine Sperre im Manager gesetzt, + falls Änderungen vorgenommen werden sollen. + +Verweise: Abschnitt 3.2 + Benutzerhandbuch Abschnitt 5.1 und 9.1 + + +#linefeed (0.5)# +#on("b")#E EUDAS-Datei Ketten#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, mehrfache Wahl + +Zweck: Falls bereits eine EUDAS-Datei geöffnet ist, kann eine + weitere Datei gleicher Struktur logisch angekettet + werden. Bei der Bearbeitung werden dann beide Datei­ + en wie eine zusammenhängende Datei behandelt. + + Die gekettete Datei kann ebenfalls verändert werden, + wenn dies beim Öffnen der ersten Datei angegeben + wurde. Die angegebene Datei kann auch aus einem + Manager stammen. + +Verweise: Abschnitt 3.2 + Benutzerhandbuch Abschnitt 9.2 + + +#linefeed (0.5)# +#on("b")#K EUDAS-Datei Koppeln#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, mehrfache Wahl + +Zweck: Falls bereits eine Datei geöffnet ist, kann eine andere + EUDAS-Datei dazugekoppelt werden. Dazu muß min­ + destens das erste Feld der zu koppelnden Datei in der + bereits geöffneten Datei vorkommen. + + Nach dem Koppeln erscheinen beide Dateien wie eine + Datei. Zu jedem Satz der ersten Datei erscheinen je­ + weils alle Sätze der Koppeldatei, die in dem Koppelfeld + übereinstimmen. + + Die gekoppelte Datei kann ebenfalls verändert werden, + wenn dies beim Öffnen der ersten Datei angegeben + wurde. Die angegebene Datei kann auch aus einem + Manager stammen. + +Verweise: Abschnitt 3.3 + Benutzerhandbuch Abschnitt 9.3 und 9.4 + + +#linefeed (0.5)# +#on("b")#S Arbeitskopie Sichern#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Wurde eine EUDAS-Datei geöffnet und verändert, muß + zum Schluß die veränderte Arbeitskopie wieder ge­ + sichert werden. Die Arbeitskopie kann entweder ge­ + löscht werden, die alte Version ersetzen oder unter + einem neuen Namen registriert werden. + + Für jede veränderte Datei wird zunächst erfragt, ob + die alte Version überschrieben werden soll. Dies ist + der Normalfall. Bei Verneinung dieser Frage muß ein + neuer Name für die Arbeitskopie angegeben werden. + + Zum Schluß wird erfragt, ob alle Arbeitskopien ge­ + löscht werden sollen (Normalfall: ja). Anderenfalls + bleiben die Dateien weiter geöffnet. + +Verweise: Abschnitt 3.5 + Benutzerhandbuch Abschnitt 6.4 + + +#linefeed (0.5)# +#on("b")#N Notizen ansehen/ändern#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Zu jeder EUDAS-Datei kann als Notiz ein beliebiger + Text gespeichert werden. Dieser Text der aktuellen + Datei wird mit dieser Funktion im Editor angezeigt + und kann verändert werden, wenn eine Arbeitskopie + angelegt wurde. Anderenfalls werden etwaige Verän­ + derungen einfach ignoriert. + +Verweise: Abschnitt 3.1 + + +#linefeed (0.5)# +#on("b")#F Feldstruktur ändern#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Mit dieser Funktion können neue Felder an die aktu­ + elle Datei angefügt werden. Außerdem lassen sich + Feldnamen und Feldtypen ändern. Die Feldtypen be­ + stimmen die Behandlung eines Feldes beim Suchen oder + Sortieren (z.B. von Zahlen). + + Zunächst wird erfragt, ob neue Feldnamen angefügt + werden sollen. Diese können dann im Editor eingege­ + ben werden. Danach wird gefragt, ob Feldnamen oder + Feldtypen geändert werden sollen (neu angefügte + Felder erhalten erst einmal den Typ TEXT). Falls die + Frage bejaht wird, können in einer Auswahl die zu + ändernden Felder angekreuzt werden. Für jedes ange­ + kreuzte Feld werden dann der Name und der Typ zum + Überschreiben angeboten. + +Verweise: Abschnitt 3.1 + Benutzerhandbuch Abschnitt 11.1 + + +#linefeed (0.5)# +#on("b")#P Prüfbedingungen ansehen/ändern#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Beim Tragen in eine EUDAS-Datei können Bedingungen + für die zu tragenden Sätze überprüft werden. Diese + Bedingungen für die aktuelle Datei können mit dieser + Funktion angezeigt und, falls erlaubt, auch geändert + werden. + +Verweise: Abschnitt 3.1 und 4.4 + Benutzerhandbuch Abschnitt 11.3 + + +#linefeed (0.5)# +#on("b")#M Mehrbenutzer Manager einstellen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Managertaskname, kein Zeigen + +Zweck: EUDAS kann beim Öffnen eine Datei von einer anderen + Task des Systems kopieren. Dadurch können mehrere + Benutzer kontrolliert auf die gleiche Datei zugreifen. + Wenn diese Möglichkeit verwendet werden soll, muß + mit dieser Funktion zunächst die in Frage kommende + Managertask angegeben werden. + +Verweise: Abschnitt 3.7 + Benutzerhandbuch Abschnitt 9.6 + + +2.2 Menü 'Einzelsatz' + + +#linefeed (0.5)# +#on("b")#W Weiter#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Geht einen Satz weiter in der aktuellen Datei - falls + eine Suchbedingung eingestellt ist, weiter zum näch­ + sten ausgewählten Satz. + +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 5.2 + + +#linefeed (0.5)# +#on("b")#Z Zurück#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Geht einen Satz zurück in der aktuellen Datei - falls + eine Suchbedingung eingestellt ist, zurück zum vori­ + gen ausgewählten Satz. + +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 5.2 + + +#linefeed (0.5)# +#on("b")#N Auf Satz Nr. ..#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Positioniert auf einen bestimmten Satz der aktuellen + Datei, dessen Satznummer eingegeben werden muß, und + zwar unabhängig, ob der Satz durch die Suchbedingung + ausgewählt wird oder nicht. Trifft die eingestellte + Suchbedingung nicht auf den Satz zu, erscheint + 'SUCH-' in der Überschrift. Existiert die eingegebene + Satznummer nicht, positioniert EUDAS hinter den + letzten Satz der Datei. + +Verweise: Benutzerhandbuch Abschnitt 5.2 + + +#linefeed (0.5)# +#on("b")#S Suchbedingung Setzen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Es kann eine neue Suchbedingung für die aktuelle + Datei eingegeben werden, bzw. eine vorher eingestellte + Suchbedingung wird zum Ändern angeboten. Die Such­ + bedingung wird in Form eines Suchmusters in das + Satzformular geschrieben. + + Die eingestellte Suchbedingung wird beim Positionieren + und bei allen Bearbeitungsfunktionen beachtet. + +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 5.3, 5.4 und 10.3 + + +#linefeed (0.5)# +#on("b")#L Suchbedingung Löschen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Die eingestellte Suchbedingung wird wieder gelöscht. + +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 5.3 + + +#linefeed (0.5)# +#on ("b")#M Markierung umkehren#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Mit dieser Funktion können einzelne Sätze zur späte­ + ren Bearbeitung markiert werden. Falls der aktuelle + Satz bereits markiert ist, wird die Markierung wieder + entfernt, ansonsten wird er markiert. + + Wenn mindestens ein Satz markiert ist, beachten die + Bearbeitungsfunktionen nur die markierten Sätze. So + kann eine manuelle Auswahl durchgeführt werden. Die + Markierung bleibt nur bis zum Sichern bestehen. Sie + ist keine permanente Eigenschaft einer EUDAS-Datei. + +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 10.4 + + +#linefeed (0.5)# +#on ("b")#E Datensatz Einfügen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Mit dieser Funktion wird vor dem aktuellen Satz ein + leerer Satz eingefügt, für den anschließend die Feld­ + inhalte im Satzformular eingetragen werden können. + +Verweise: Abschnitt 3.4 + Benutzerhandbuch Abschnitt 6.2 und 10.2 + + +#linefeed (0.5)# +#on ("b")#A Datensatz Ändern#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Die Inhalte des aktuellen Satzes werden im Satzformu­ + lar zum Ändern angeboten. + +Verweise: Abschnitt 3.4 + Benutzerhandbuch Abschnitt 6.3 und 10.2 + + +#linefeed (0.5)# +#on ("b")#T Datensatz Tragen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl + +Zweck: Mit dieser Funktion kann der aktuelle Satz in eine + anderen EUDAS-Datei gleicher Struktur transportiert + werden. In der Zieldatei wird er am Ende angefügt. + +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 6.3 + + +#linefeed (0.5)# +#on ("b")#H Datensatz Holen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl + +Zweck: Mit dieser Funktion kann der letzte Satz einer ande­ + ren Datei vor dem aktuellen Satz eingefügt werden, + sofern die Struktur gleich ist. Damit kann ein vorher­ + gegangenes Tragen rückgängig gemacht werden. + +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 6.3 + + +#linefeed (0.5)# +#on ("b")#F Feldauswahl#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Die Felder der aktuellen Datei werden in einer Aus­ + wahl angeboten. Am Bildschirm werden danach nur die + ausgewählten Felder in der gewählten Reihenfolge + dargestellt. Die Auswahl hat jedoch nur Auswirkung + auf die Darstellung am Bildschirm, anderen Funktionen + stehen nach wie vor alle Felder zur Verfügung. Die + Auswahl gilt bis zum Sichern, sie wird also nicht mit + der Datei abgespeichert. + +Verweise: Abschnitt 4.1 + Benutzerhandbuch Abschnitt 10.1 + + +2.3 Menü 'Gesamtdatei' + + +#linefeed (0.5)# +#on ("b")#K Satzauswahl Kopieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl + Name Kopiermuster, ohne Zeigen + +Zweck: Mit dieser Funktion werden die ausgewählten bzw. + markierten Sätze der aktuellen Datei in eine andere + Datei kopiert. Welche Felder kopiert werden sollen und + in welcher Reihenfolge, wird durch ein Kopiermuster + festgelegt. Dieses Kopiermuster kann benannt werden + oder unbenannt nur für ein Mal erstellt werden. Wird + das Kopiermuster neu erstellt, wird ein Standard- + Kopiermuster zum Ändern angeboten. + +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 11.2 + + +#linefeed (0.5)# +#on ("b")#T Satzauswahl Tragen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl + +Zweck: Transportieren der ausgewählten bzw. markierten + Sätze in eine andere Datei gleicher Struktur. Die Sätze + werden in der Zieldatei am Ende eingefügt. + +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 11.3 + + +#linefeed (0.5)# +#on ("b")#V Satzauswahl Verändern#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Änderungsmuster, mit Zeigen, mehrfache Wahl + +Zweck: Bearbeiten der ausgewählten bzw. markierten Sätze + der aktuellen Datei nach Vorgabe einer Änderungs­ + vorschrift. + +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 11.4 + + +#linefeed (0.5)# +#on ("b")#U Übersicht Satzauswahl#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Anzeige aller ausgewählten Sätze in einem Über­ + sichtsformat mit einem Satz pro Bildschirmzeile. Die + Felder, die in der Übersicht angezeigt werden sollen, + können vorher ausgewählt werden. In der Übersicht ist + Blättern und Markieren von Sätzen möglich. + +Verweise: Abschnitt 4.1 + Benutzerhandbuch Abschnitt 10.5 + + +#linefeed (0.5)# +#on ("b")#S Aktuelle Datei Sortieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Sortieren der aktuellen Datei in beliebiger Reihenfolge + auf- oder absteigend. Zum Sortieren muß eine Ar­ + beitskopie angelegt sein. Die Feldreihenfolge, in der + sortiert werden soll, wird vorher erfragt. + +Verweise: Abschnitt 4.3 + Benutzerhandbuch Abschnitt 11.1 + + +#linefeed (0.5)# +#on ("b")#L Alle Markierungen Löschen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Löschen aller Markierungen der aktuellen Datei. + +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 10.4 + + +2.4 Menü 'Drucken' + + +#linefeed (0.5)# +#on ("b")#D Satzauswahl Drucken#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Druckmuster, mit Zeigen, mehrfache Wahl + +Zweck: Ausdruck des Inhalts der ausgewählten oder markier­ + ten Sätze in druckbarer Form nach Vorgabe eines + Druckmusters. Die Ausgabe kann automatisch zum + Drucker geschickt werden oder erst in einer Datei + zwischengespeichert werden. + +Verweise: Kapitel 5 + Benutzerhandbuch Abschnitt 7.1 und 7.2 + + +#linefeed (0.5)# +#on ("b")#R Richtung Druckausgabe#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Mit dieser Funktion kann festgelegt werden, ob die + Druckausgabe automatisch zum Drucker geschickt wird, + in eine bestimmte Datei oder in eine automatisch + eingerichtete Datei geschrieben wird. + + Die Angabe einer bestimmten Datei gilt nur für den + nächsten Druckvorgang. Sie muß also gegebenenfalls + wieder neu eingestellt werden. + +Verweise: Abschnitt 5.2 + Benutzerhandbuch Abschnitt 7.2 und 12.1 + + +#linefeed (0.5)# +#on ("b")#E Textdatei Editieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Textdatei, mit Zeigen, mehrfache Wahl + +Zweck: Aufruf des EUMEL-Editors zum Erstellen und Ändern + von Druckmustern und Änderungsmustern sowie zum + Ansehen der Druckausgabe. + +Verweise: Benutzerhandbuch Abschnitt 7.2 + + +#linefeed (0.5)# +#on ("b")#A Textdatei Ausdrucken#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Textdatei, mit Zeigen, mehrfache Wahl + +Zweck: Mit dieser Funktion kann eine Textdatei oder die + zwischengespeicherte Ausgabe des Druckens einer + EUDAS-Datei zum Drucker geschickt werden. + +Verweise: Benutzerhandbuch Abschnitt 7.2 + + +#linefeed (0.5)# +#on ("b")#N Textdatei Nachbearbeiten#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Textdatei, mit Zeigen, mehrfache Wahl + +Zweck: Mit dieser Funktion kann die zwischengespeicherte + Ausgabe des Druckens einer EUDAS-Datei mit den + Textkosmetikprogrammen 'lineform' und 'pageform' + bearbeitet werden. + +Verweise: Benutzerhandbuch Abschnitt 12.1 + + +2.5 Menü 'Dateien' + + +#linefeed (0.5)# +#on ("b")#U Übersicht Dateien System#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Übersicht über die Dateien im System in der aktuellen + Benutzertask. + +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#L Datei Löschen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl + +Zweck: Löschen einer beliebigen Datei in der aktuellen Be­ + nutzertask nach Anfrage. + +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#N Datei Umbenennen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl + Neuer Name, ohne Zeigen + +Zweck: Umbenennen einer beliebigen Datei in der aktuellen + Benutzertask. + +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#K Datei Kopieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl + Zieldateiname, ohne Zeigen + +Zweck: Anfertigen einer logischen Kopie einer beliebigen + Datei in der aktuellen Benutzertask. + +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#P Platzbedarf einer Datei#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl + +Zweck: Zeigt den belegten Speicherplatz einer beliebigen + Datei in der aktuellen Benutzertask. + +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#A Datei Aufräumen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl + +Zweck: Reorganisieren einer Textdatei oder einer EUDAS- + Datei, um Platz zu sparen oder den Zugriff zu be­ + schleunigen. Empfiehlt sich bei stark veränderten + oder umsortierten Dateien. + +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +2.6 Menü 'Archiv' + + +#linefeed (0.5)# +#on ("b")#U Übersicht Dateien Archiv#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Übersicht aller Dateien auf der eingelegten Archivdis­ + kette. + +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#D Archivübersicht Drucken#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Die Archivübersicht wird direkt zum Drucker ge­ + schickt. + +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#K Datei Kopieren vom Archiv#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl + +Zweck: Eine Datei auf der Archivdiskette wird in die aktuelle + Benutzertask kopiert. + +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#S Datei Schreiben auf Archiv#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Archivname + Dateiname, mit Zeigen, mehrfache Wahl + +Zweck: Eine Datei aus der aktuellen Benutzertask wird auf + die eingelegte Archivdiskette geschrieben. + +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#L Datei Löschen auf Archiv#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Archivname + Dateiname, mit Zeigen, mehrfache Wahl + +Zweck: Löschen einer Datei auf der eingelegten Archivdisket­ + te. Der Platz kann jedoch nicht immer wiederverwendet + werden. + +Verweis: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#I Archivdiskette Initialisieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine + +Zweck: Mit dieser Funktion kann eine Archivdiskette komplett + gelöscht werden. Die Diskette kann dabei auch gleich­ + zeitig formatiert werden, falls der Rechner dies zu­ + läßt. Das Initialisieren ist notwendig, bevor eine neue + Diskette als Archiv verwendet werden kann. + +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#Z Zielarchiv einstellen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Managertaskname, ohne Zeigen + +Zweck: Mit dieser Funktion kann eine Managertask angegeben + werden, die als Ziel der Archivoperationen dient. + Damit können Dateien auch in beliebigen Managertasks + oder über das EUMEL-Netz gesichert werden. + + Es wird erfragt, ob die angegebene Task ein Archiv­ + manager oder ein gewöhnlicher Dateimanager ist. + +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#P Paßwort einstellen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Paßwort + +Zweck: Mit dieser Funktion kann ein Paßwort eingestellt + werden, das bei der Kommunikation mit allgemeinen + Managertasks überprüft wird. + +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#R Archivmanager Reservieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Reservierungstext + +Zweck: Falls als Zielarchiv eine Managertask eingestellt ist, + die zwar kein Archivmanager ist, aber reserviert + werden muß (z.B. 'DOS'), kann die Reservierung mit + dieser Funktion ausgeführt werden. Die Freigabe + erfolgt automatisch beim Verlassen des Menüs. + +Verweise: Benutzerhandbuch Abschnitt 16.2 + + + +2.7 Kurzabfrage + +Wird 'eudas' innerhalb des EUMEL-Editors aufgerufen, so wird eine +spezielle Kurzabfrage gestartet. Diese ermöglicht die Übernahme von +Druckdaten direkt in die editierte Datei. + Zunächst wird der Dateiname der zu verwendenden EUDAS- +Datei erfragt. Diese Datei wird dann geöffnet. Vorher geöffnete und +veränderte Dateien werden nach Anfrage gesichert. + Als nächstes kann für die folgende Übersicht eine Feldauswahl +eingestellt werden, damit die relevanten Felder auch auf dem Bild­ +schirm erscheinen. + Danach beginnt ein wiederholbarer Prozeß mit der Eingabe +eines Suchmusters nach Anfrage. Die ausgewählten Sätze werden +dann in einer Übersicht gezeigt. In der Übersicht können auch Sätze +markiert werden. + Nach Verlassen der Übersicht bestehen drei Möglichkeiten zum +Drucken: Falls mindestens ein Satz markiert wurde, können nach +Anfrage alle markierten Sätze gedruckt werden. Wurde kein Satz +markiert, können nach Anfrage alle ausgewählten (bzw. vorher +angezeigten) Sätze gedruckt werden. Wird diese Frage jeweils ver­ +neint, kann nach Anfrage auch der aktuelle Satz als einziger ge­ +druckt werden. + Wurde eine der Fragen bejaht, wird der Name des Druckmusters +erfragt, das bereits existieren muß. Das Ergebnis der Druckausgabe +wird dann an der aktuellen Cursorposition in der editierten Datei +eingefügt. + Der Prozeß kann danach mit einem anderen Suchmuster wieder­ +holt werden. Dabei werden alle Markierungen wieder gelöscht. + diff --git a/app/eudas/4.3/doc/eudas.ref.3 b/app/eudas/4.3/doc/eudas.ref.3 new file mode 100644 index 0000000..9b58b9b --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.3 @@ -0,0 +1,270 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (31)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +3 Das virtuelle Dateimodell + + + +3.1 Dateistruktur + +Eine EUDAS-Datei hat folgende Bestandteile: + +- 0 bis 5000 #on("i")#Sätze#off("i")#, von 1 an durchnumeriert. Jeder Satz enthält für + jedes Feld einen variabel langen Text als Inhalt, der standard­ + mäßig leer ist. + +- 1 bis 256 #on("i")#Felder#off("i")#, die die Sätze aufteilen. Jedes Feld besitzt einen + #on("i")#Feldnamen#off("i")# als Text und einen von vier #on("i")#Feldtypen#off("i")# (TEXT, ZAHL, + DATUM oder DIN). Der Feldname dient zur Identifizierung des + Feldes, der Feldtyp spezifiziert die Art der Behandlung beim Ver­ + gleichen von Feldern. + +- Drei Zusatztexte. Der erste nimmt die #on("i")#Prüfbedingungen#off("i")# auf, der + zweite speichert das Datum der letzten Veränderung und der + dritte kann allgemeine #on("i")#Notizen#off("i")# aufnehmen. + +- Einen #on("i")#Satzzeiger#off("i")#, der einen bestimmten Satz als aktuellen Satz + auszeichnet. Der Satzzeiger kann durch Positionierungsoperatio­ + nen verändert werden. + +- Eine #on("i")#Sortierreihenfolge#off("i")#, die angibt, in welcher Feldreihenfolge die + Datei zuletzt sortiert worden ist. Dazu für jeden Satz eine Anga­ + be, ob er entsprechend dieser Reihenfolge an der richtigen Posi­ + tion steht. + +- Eine interne Datenstruktur, die beschleunigten Zugriff auf eine + Satz nach dem Inhalt des ersten Feldes ermöglicht. Diese Struktur + steht ganz unter Kontrolle von EUDAS und kann nicht von außen + manipuliert werden. + + +3.2 Öffnen + +#on("b")#Virtuelle Datei#off("b")# Die meisten EUDAS-Funktionen arbeiten +nicht +direkt auf einer EUDAS-Datei, sondern auf der sogenannten #on("i")#vir­ +tuellen Datei#off("i")#, die aus mehreren realen Dateien bestehen kann. Die +virtuelle Datei erscheint nach außen hin wie eine einzelne +EUDAS-Datei. Die Operationen auf der virtuellen Datei werden je­ +weils auf die einzelnen Bestandteile abgebildet. + Damit eine EUDAS-Datei Bestandteil der virtuellen Datei wird, +muß sie geöffnet werden. Dieses Öffnen kann auf dreierlei Art und +Weise geschehen. + Das Öffnen der ersten Datei stellt eine neue virtuelle Datei +her. Die Feldnamen und Feldeigenschaften der ersten Datei werden +in der virtuellen Datei übernommen. Dies ist der Normalfall, in dem +sich die virtuelle Datei noch nicht von der zugrundeliegenden Datei +unterscheidet. + Bei diesem ersten Öffnen muß angegeben werden, ob die vir­ +tuelle Datei verändert werden soll oder nicht. Falls die virtuelle +Datei verändert werden soll, wird eine Arbeitskopie aller geöffneten +Dateien angelegt. Die Ursprungsdateien können erst am Ende der +Arbeit mit den geänderten Kopien überschrieben werden. + +#on("b")#Weitere Dateien#off("b")# Weitere Dateien können gekettet oder +gekoppelt +werden. Gekettete Dateien werden logisch an die zuerst geöffnete +Datei angehängt. Ihre Dateistruktur wird ignoriert, sollte aber mit +der ersten Datei übereinstimmen. Die Folge aneinander geketteter +EUDAS-Dateien wird als #on("i")#Hauptdatei#off("i")# bezeichnet. + In der Hauptdatei werden die Sätze von 1 an durchnumeriert; +die Aufeinanderfolge der Sätze wird durch die Anordnung der Sätze +in den einzelnen Dateien und die Reihenfolge bestimmt, in der die +Dateien gekettet wurden. + Die gekoppelten Dateien werden der Hauptdatei untergeordnet. +Die in ihnen enthaltenen Informationen werden nur angezeigt, wenn +sie mit einem Satzinhalt der Hauptdatei korrespondieren. Der +Mechanismus dieser Satzkopplung wird im nächsten Abschnitt +beschrieben. + + +#free (8.0)# + +#center#Abb. 3-1 Schematischer Aufbau der virtuellen Datei + + + +3.3 Koppeln + + Die Sätze der gekoppelten Dateien werden in Relation zu den +Sätzen in der Hauptdatei gesetzt. Zu jedem Satz in der Hauptdatei +kann eine Anzahl von Sätzen aus jeder Koppeldatei gehören. Diese +Sätze müssen in den Inhalten der sogenannten #on("i")#Koppelfelder#off("i")# über­ +einstimmen. + Welche Felder Koppelfelder sind, richtet sich nach den Feld­ +namen. Die ersten Felder der Koppeldatei, die auch in der Haupt­ +datei vorhanden sind, werden als Koppelfelder betrachtet. Die Kop­ +pelfelder müssen also bei der Koppeldatei am Anfang stehen - in +der Hauptdatei kann jedes beliebige Feld ein Koppelfeld sein. + Wenn eine Datei zur virtuellen Datei gekoppelt wird, werden +alle Felder, die nicht Koppelfelder sind, in die virtuelle Datei auf­ +genommen. Die Koppelfelder brauchen nicht noch mal wiederholt zu +werden, da ihr Inhalt ja immer identisch ist. + Zu beachten ist, daß bei diesem Verfahren auch Namenskonflik­ +te entstehen können, wenn nach den Koppelfeldern später wieder +ein Feldname vorkommt, der auch in der Hauptdatei vorhanden ist. +In den Fällen, in denen Felder durch ihren Namen angesprochen +werden, ist dann das zweite Feld gleichen Namens nicht verfügbar. + + +#free (7.0)# + +#center#Abb. 3-2 Schema des Koppelvorgangs + + +#on("b")#Kombinationen#off("b")# Beim Vorwärtsgehen in der virtuellen Datei +werden +zu jedem Satz der Hauptdatei nacheinander alle möglichen Kombina­ +tionen der zugehörigen Koppelsätze angezeigt, denn es können +mehrere passende Koppelsätze vorhanden sein. Die Satznummer +bleibt dabei gleich; die einzelnen Kombinationen werden von 1 an +durchgezählt. Beim Rückwärtsgehen wird aus technischen Gründen +immer nur die erste Kombination angezeigt. + Existiert zu einem Satz kein passender Koppelsatz, so bleiben +die entsprechenden Felder leer. Die Koppelsätze müssen in der +ganzen Koppeldatei gesucht werden, daher ist bei großen Koppel­ +dateien die Suchzeit zu berücksichtigen. + + +3.4 Änderungen + +In der virtuellen Datei kann auch geändert werden. Dabei ist jedoch +Vorsicht angebracht. Es muß festgelegt sein, wie Änderungen der +einzelnen Felder auf die beteiligten Dateien abgebildet werden. + Falls die virtuelle Datei keine Koppeldateien enthält, werden +Änderungen am aktuellen Satz an der zugehörigen Datei durchge­ +führt. Das Löschen eines Satzes wird auch direkt in der Datei +durchgeführt. Ein neuer Satz wird immer in der Datei eingefügt, zu +der der aktuelle Satz gehört - am Ende der ersten Datei kann also +kein Satz eingefügt werden, wenn noch weitere Dateien folgen. + Enthält die virtuelle Datei Koppeldateien, werden die Änderun­ +gen in der Hauptdatei wie oben beschrieben durchgeführt. Änderun­ +gen, die Felder in den Koppeldateien betreffen, werden nach folgen­ +der Entscheidungstabelle behandelt: + + 1 2 3 4 5 + --------------- + Koppelfelder verändert N J J N N + Übrige Felder verändert N - - J J + Übrige Felder leer - J N - N + Vorher Koppelsatz vorhanden - - - J N + --------------- + Neuen Satz einfügen x x + Koppelsatz ändern x + Kopplung aktualisieren x + +Fall 1: Es wurden keine Veränderungen an den Feldern des Kop­ + pelsatzes vorgenommen, daher ist auch keine Aktion not­ + wendig. + +Fall 2: Eines der Koppelfelder wurde verändert. Die Änderung wird + in der Hauptdatei durchgeführt. Die übrigen Felder des + Koppelsatzes sind jedoch als leer angegeben. In diesem Fall + wird der Koppelsatz nicht verändert, sondern nur eine + neue Korrespondenz gesucht. + +Fall 3: Eines der Koppelfelder wurde verändert, gleichzeitig ent­ + halten aber auch die anderen Felder Informationen. In + diesem Fall wird ein neuer Satz in der Koppeldatei ange­ + fügt, der die neuen Inhalte enthält. So wird vermieden, + daß an anderer Stelle plötzlich kein passender Koppelsatz + mehr vorhanden ist. + +Fall 4: Nur Felder der Koppeldatei, die nicht Koppelfelder sind, + wurden verändert, außerdem existierte ein korrespondie­ + render Satz in der Koppeldatei. In diesem Fall werden die + Informationen im Koppelsatz abgeändert. + +Fall 5: Wie 4, nur war vorher noch kein Koppelsatz vorhanden + (Felder waren leer). In diesem Fall muß ein neuer Satz in + die Koppeldatei eingefügt werden. Einfügungen in die + Koppeldatei geschehen immer am Dateiende. + +#on("b")#Einfügen/Löschen#off("b")# Beim Löschen eines Satzes der virtuellen +Datei +durch Tragen bleiben die Koppeldateien unverändert. Nach dem +Einfügen eines neuen Satzes wird nur dann ein Satz in einer Kop­ +peldatei eingefügt, wenn dieser Satz nicht nur Koppelfelder enthal­ +ten würde. Falls beim Einfügen nur die Koppelfelder angegeben +werden, wird ein korrespondierender Satz in der Koppeldatei ge­ +sucht. Vergleichen Sie hierzu die Regeln beim Ändern. + + +3.5 Sichern + +Falls Änderungen der virtuellen Datei erlaubt sind, arbeitet EUDAS +immer auf Sicherheitskopien der beteiligten Dateien. Eine Datei, die +wirklich verändert wurde, muß vor dem Aufbau einer neuen virtuel­ +len Datei gesichert oder explizit gelöscht werden. + Für jede einzelne Datei kann festgelegt werden, ob sie gesi­ +chert werden soll oder nicht. Als Hilfe wird dazu für jede Datei +angegeben, ob sie tatsächlich verändert wurde oder nicht. Die +Arbeitskopie kann beim Sichern die alte Version überschreiben oder +unter einem neuen Namen gesichert werden. + Am Ende des Sicherns können die Arbeitskopien gelöscht wer­ +den. Anderenfalls werden die Dateien so betrachtet, als ob sie di­ +rekt nach dem Sichern wieder geöffnet worden wären und stehen +weiterhin zur Verfügung. + Falls alle Dateien entweder gesichert oder nicht verändert +sind, werden beim nächsten Öffnen einer neuen virtuellen Datei die +vorherigen Arbeitskopien gelöscht. + + +3.6 Umschalten auf Koppeldatei + +Falls eine Datei gekoppelt ist, kann man die virtuelle Datei auf +diese Koppeldatei umschalten. Dadurch verhält sich die virtuelle +Datei so, als ob nur diese Koppeldatei geöffnet wäre. Die Einstel­ +lungen der Hauptdatei wie Markierungen und Suchbedingung bleiben +jedoch erhalten und stehen beim Zurückschalten wieder zur Verfü­ +gung. + Die Satzposition der Koppeldatei beim letzten Umschalten wird +ebenfalls gespeichert und wird beim nächsten Umschalten wieder +eingenommen, unabhängig von der tatsächlichen Satzposition der +Koppeldatei zu diesem Zeitpunkt. + Für die Koppeldatei können eigene Markierungen vergeben +werden, die auch nach dem Umschalten gespeichert bleiben. Auch +ein Suchmuster kann für die Koppeldatei eingestellt werden, dies +geht jedoch beim Zurückschalten wieder verloren. Die eingestellte +Feldauswahl für die Bildschirmanzeige geht leider bei jedem Um­ +schalten verloren. + Das Umschalten kann entweder im Menü 'Einzelsatz' oder beim +Einfügen und Ändern durch ESC 'K' bewirkt werden, ebenso das +Zurückschalten nur im Menü 'Einzelsatz'. Beim Umschalten aus Ein­ +fügen oder Ändern erfolgt beim Zurückschalten eine Rückkehr in +diesen Zustand. Dabei können nach Anfrage die Koppelfelder des +aktuellen Satzes der Koppeldatei in die Hauptdatei übernommen und +damit eine bestimmte Kopplung bewirkt werden. + + +3.7 Mehrbenutzerbetrieb + +Durch Einstellen einer Managertask für den Mehrbenutzerbetrieb +können auch Dateien dieser Managertask beim Öffnen direkt ver­ +wendet werden. Die Datei wird automatisch aus der Managertask +kopiert und geöffnet. + Falls die Datei geändert werden soll, wird eine Sperre in der +Managertask gesetzt, die verhindert, daß auch ein anderer Benutzer +diese Datei zum Ändern öffnet. Beim Sichern erfolgt dann ein Rück­ +schreiben der Arbeitskopie. Die Sperre wird jedoch erst dann zu­ +rückgesetzt, wenn alle Arbeitskopien gelöscht werden, da erst dann +keine Möglichkeit des Rückschreibens mehr besteht. + Alle Dateien der Managertask werden bei der Dateiauswahl zum +Öffnen mit angeboten. Falls eine Datei in beiden Tasks existiert, +wird die Datei in der Managertask genommen, die Datei der eigenen +Task jedoch erst nach Anfrage überschrieben. + Damit die Sperre funktionieren kann, muß EUDAS in der Mana­ +gertask zur Verfügung stehen und die Task muß #on("i")#nach#off("i")# dem Insertie­ +ren von EUDAS als 'global manager' definiert werden (nicht 'free +global manager' verwenden). + diff --git a/app/eudas/4.3/doc/eudas.ref.4 b/app/eudas/4.3/doc/eudas.ref.4 new file mode 100644 index 0000000..cfd6daf --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.4 @@ -0,0 +1,441 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (39)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +4 Ansehen und Bearbeiten + + + +4.1 Anzeige + +Die Anzeige und Eingabe von Einzelsätzen sowie die Eingabe von +Suchmustern geschieht in einem Standardformular in einem recht­ +eckigen Fenster. Dieses Fenster befindet sich in der rechten Bild­ +schirmhälfte. + Das Formular besteht aus vier Teilen: der Überschrift, den +Feldnamen, den Feldinhalten und der Abschlußzeile (s. Abbildung). + + Überschrift +#free (0.3)# + Satz 33 ..SUCH+..MARK-... datei ............... Feld 1 + Feld 1 + Feld 2 + Feld 3 Feldinhalte + + Feld 4 + .............................................................. +#free (0.3)# + Feldnamen Abschlußzeile + + + +#on("b")#Überschrift#off("b")# Die Überschrift zeigt folgende Informationen +an: + + Satz n[-m] + Die Satznummer des aktuellen Satzes, bei gekoppelten Dateien + auch die Satzkombination. + + SUCH+/- + Zeigt an, ob der aktuelle Satz die eingestellte Suchbedingung + erfüllt oder nicht (wird während Eintragungen nicht angezeigt). + Wenn keine Suchbedingung eingestellt ist, erscheint diese An­ + zeige nicht. + + MARK+/- + Zeigt an, ob der aktuelle Satz markiert ist oder nicht (Wird + während Eintragungen nicht angezeigt). Wenn kein Satz mar­ + kiert ist, erscheint diese Anzeige nicht. + + ENDE + Wird hinter dem letzten Satz der Datei als Kennzeichnung des + Endesatzes ausgegeben. + + 'Dateiname' + Gibt den Namen der ersten geöffneten Datei an. + + + Erscheint statt des Dateinamens, wenn auf eine Koppeldatei + umgeschaltet wurde. + + Feld n/Zeile n + Zeilennummer des obersten angezeigten Feldes (bei Anzeige) + bzw. der aktuellen Cursorzeile (während Eintragungen). + +#on("b")#Feldteil#off("b")# Die Feldnamen sind zur Unterscheidung von den +Feld­ +inhalten invers dargestellt. Die Breite der Feldnamen richtet sich +nach der Länge des längsten Feldnamens. Ist dieser zu lang, um +noch eine ordentliche Anzeige zu ermöglichen, wird bei einer be­ +stimmten Länge der Rest des Namens abgeschnitten. + Zwischen dem Feldnamen an der linken Seite und dem dane­ +benstehenden Feldinhalt besteht immer eine Korrespondenz, d.h. der +Inhalt eines Feldes wird direkt neben dem Namen dargestellt. In der +Regel wird pro Feld eine Bildschirmzeile reserviert. Kann der Feld­ +inhalt jedoch nicht mehr in einer Zeile untergebracht werden, wer­ +den weitere Zeilen zur Darstellung dieses Feldes herangezogen. In +diesen Zeilen steht statt des Feldnamens nur ein markierter Leer­ +raum. + Alle folgenden Zeilen ohne Namen gehören zu dem gleichen +Feld. Der Inhalt wird auf diese Zeilen umbrochen, d.h. wenn ein +Wort nicht mehr auf die Zeile paßt, wird es komplett in die nächste +Zeile geschrieben (wie beim Editor). Wörter werden nur dann zer­ +schnitten, wenn sie nicht als Ganzes auf eine Zeile passen. Wörter +werden untereinander durch Leerzeichen getrennt. + Aus Effizienzgründen werden in bestimmten Fällen auch mehr +Folgezeilen als nötig angezeigt. Hat nämlich ein neuer Satz einen +kürzeren Inhalt als der vorige, so werden die Feldnamen nur dann +wieder zusammengerückt, wenn das ganze Bild neugeschrieben wer­ +den muß. Anderenfalls werden nur die Feldinhalte aktualisiert. + Die Bildausgabe wird unterbrochen, wenn 'w' oder 'z' gedrückt +wurde, da dann die Inhalte des aktuellen Satzes nicht mehr inter­ +essieren. + +#on("b")#Rollen#off("b")# Da nicht alle Felder auf den Bildschirm passen +müssen, kann das Bild gerollt werden. + Mit ESC UNTEN wird um eine Seite nach unten geblättert, mit +ESC OBEN wieder zurück. Hinter dem letzten Feld erscheint ein +markierter Balken als Abschlußzeile. Weiter als bis zum Erscheinen +dieses Balken kann nicht gerollt werden. Mit ESC '1' wird ganz an +den Anfang gerollt, mit ESC '9' ganz ans Ende. + Bei Feldern, die sich über mehrere Zeilen erstrecken, kann es +passieren, daß nach dem Rollen die erste Bildschirmzeile nicht die +erste Zeile eines Feldes ist, also der erste Teil eines Feldes nicht +dargestellt wird. Trotzdem wird in diesem Fall in der ersten Anzei­ +gezeile der Feldname angezeigt. + +#on("b")#Feldauswahl#off("b")# Man kann auswählen, welche Felder in welcher +Rei­ +henfolge angezeigt werden sollen. Dies dient der besseren Übersicht. +Von der Anzeige werden nur die ausgewählten Felder behandelt, die +anderen Felder bleiben leer, werden nicht verändert oder berück­ +sichtigt. Die Anzeigeauswahl ändert jedoch nichts an der Datei­ +struktur. + Die Feldauswahl ist keine permanente Eigenschaft einer +EUDAS-Datei. Sie geht daher bei einem neuen Öffnen oder beim +Umschalten auf eine Koppeldatei verloren. + +#on("b")#Übersicht#off("b")# Im Gegensatz zur normalen Anzeige, bei der ein +Satz pro +Bildschirm dargestellt wird, können in der Übersicht mehrere Sätze +gleichzeitig überschaut werden. Dabei wird jeder Satz in einer Zeile +untergebracht. Die Auswahl der Felder, die in der Übersicht er­ +scheinen sollen, wird vor Beginn der Funktion erfragt. + In jeder Zeile steht die Nummer des jeweiligen Satzes, eine +Anzeige, ob er markiert ist (+) oder nicht (-) und die Feldinhalte +in der gewählten Reihenfolge und Auswahl, jeweils duch Komma und +Leerzeichen getrennt. Inhalte, die nicht mehr auf die Zeile passen, +werden abgeschnitten. + Es werden nur durch das Suchmuster ausgewählte Sätze ange­ +zeigt. Ist der aktuelle Satz nicht ausgewählt, so erscheint an seiner +Stelle '<< >>' als Hinweis. In der Überschrift sind die Feldnamen +angegeben - durch Komma getrennt, so viele wie hinpassen. + Die Satznummer des aktuellen Satzes ist jeweils markiert. In +der Übersicht kann geblättert werden. HOP OBEN und HOP UNTEN, +OBEN und UNTEN wirken wie im Editor. + Durch '+' oder '-' kann auch die Markierung des aktuellen +Satzes verändert werden. + + +4.2 Satzauswahl + +Die Auswahl der Sätze, die gedruckt oder mit den Funktionen aus +Abschnitt 4.4 bearbeitet werden sollen, kann entweder durch eine +Suchbedingung oder durch Markierung vorgenommen werden. Wenn +mindestens ein Satz markiert ist, werden von den Bearbeitungs­ +funktionen nur die markierten Sätze behandelt. Anderenfalls wird +die eingestellte Suchbedingung beachtet. + Die Bildschirmanzeige richtet sich immer nur nach der einge­ +stellten Suchbedingung. + +#on("b")#Suchmuster#off("b")# Ein Suchmuster gibt für jedes Feld bestimmte +Bedin­ +gungen an. Es wird im Standardformular mit Hilfe des Satzeditors +eingegeben. Dabei stehen neben jedem Feld die Bedingungen für +dieses Feld in einer intuitiv verständlichen Form. Folgende Einzel­ +bedingungen sind möglich: + + Muster Inhalt ist gleich Muster + Muster.. Inhalt ist größergleich Muster + ..Muster Inhalt ist kleiner Muster + Muster1..Muster2 Inhalt liegt dazwischen + *Muster Inhalt endet mit Muster + Muster* Inhalt beginnt mit Muster + *Muster* Inhalt enthält Muster + * Inhalt ist nicht leer + ++ Satz markiert (unabhängig vom Feldinhalt) + +Die ersten vier Einzelbedingungen beachten auch den Typ eines +Feldes (wie er bei der Feldstruktur eingegeben werden kann und +beim Sortieren beachtet wird). So werden z.B. bei der Gleichheit von +Zahlen alle nicht-numerischen Zeichen ignoriert (s. Sortieren). + Die drei Bedingungen mit Stern können auch miteinander ver­ +knüpft werden. Die Einzelbedingungen müssen dann alle zutreffen, +damit der Satz ausgewählt wird. So bedeutet zum Beispiel das +Muster 'M1*M2*M3*M4', daß das Feld mit 'M1' beginnen und mit 'M4' +enden muß. Außerdem muß es 'M2' und 'M3' enthalten, jedoch nicht +unbedingt in der angegebenen Reihenfolge. + Wird der Mustertext durch '&' und einen gültigen Feldnamen der +aktuellen Datei ersetzt, findet der Vergleich nicht mit einem +Mustertext, sondern mit dem Inhalt des angegebenen Feldes statt. +Als Feldtyp für den Vergleich wird in diesem Fall der Typ des Fel­ +des genommen, in dem der Vergleich steht. + +#on("b")#Verknüpfung#off("b")# Einzelbedingungen können durch Voranstellen +von +'--' verneint werden. Einzelbedingungen für verschiedene Felder +werden mit UND verknüpft. + Es gibt zwei Arten der ODER-Verknüpfung: die lokale und die +globale. Die lokale ODER-Verknüpfung wird durch ein Komma zwi­ +schen Einzelbedingungen realisiert. Sie hat eine höhere Priorität als +das UND zwischen verschiedenen Feldern. So hat folgendes Such­ +muster + + + Feld1 Bed1,Bed2 + Feld2 Bed3 + + +die Bedeutung + + + ( Bed1 (Feld1) ODER Bed2 (Feld2) ) UND Bed3 (Feld3) + + +Die globale ODER-Verknüpfung wird durch ein Semikolon repräsen­ +tiert. Alle Einzelbedingungen nach dem n-ten Semikolon aller Zeilen +werden zu einer Alternative zusammengefaßt. Damit hat das Such­ +muster + + + Feld1 Bed1;Bed2 + Feld2 Bed3 + + +die Bedeutung + + + ( Bed1 (Feld1) UND Bed3 (Feld2) ) ODER Bed2 (Feld1) + + +Damit ergibt sich für die Priorität der einzelnen Konstruktionen +folgende Reihenfolge: + + höchste Einzelbedingung + Verkettung von Einzelbedingungen (UND) + Verneinung + lokales ODER + UND zwischen Feldern + niedrigste globales ODER + +#on("b")#Optimierung#off("b")# Wenn für das erste Feld einer Datei eine +Gleich- +Bedingung angegeben wurde und keine globale Alternative vorhan­ +den ist, kann der Suchvorgang wegen der Dateistruktur optimiert +werden, indem nur Sätze untersucht werden müssen, die im ersten +Feld den gesuchten Text enthalten. + +#on("b")#Reservierte Zeichen#off("b")# Im Rahmen der Analyse einer +Musterzeile +wirken folgende Zeichenfolgen als unbeschränkt reservierte Zeichen: + + + , ; .. * + + +Sie dürfen daher in keinem Mustertext oder Feldnamen vorkommen, +da sie als Separator wirken. Die beiden folgenden Zeichenfolgen +werden nur zu Anfang eines durch die vorstehenden Separatoren +gebildeten Abschnitts erkannt: + + + -- & ++ + + +Sie dürfen daher prinzipiell an weiterer Stelle vorkommen, ohne als +Sonderzeichen erkannt zu werden. Alle anderen Zeichen in der Zeile +werden dem Mustertext bzw. Feldnamen ohne weitere Interpretation +zugeordnet. + + +4.3 Sortieren und Reorganisieren + +Eine EUDAS-Datei kann in einer beliebigen Feldreihenfolge sortiert +werden. Mit dieser Angabe kann man bestimmen, welche Felder beim +Vergleich zweier Sätze berücksichtigt werden sollen und in welcher +Reihenfolge. + Die Sortierreihenfolge wird in der Datei gespeichert und wird +anschließend immer wieder verwendet, wenn keine anderen Angaben +gemacht wurden. + Der Sortierzustand einer Datei wird ebenfalls gespeichert. Wenn +nur wenige Sätze seit der letzten Sortierung verändert wurden, +müssen auch nur diese Sätze einsortiert werden. + +#on("b")#Feldtypen#off("b")# Um eine korrekte Sortierung auch von Zahlen oder +Daten sicherzustellen, wird jedem Feld einer EUDAS-Datei ein Feld­ +typ zugeordnet, der beim Sortieren (und auch beim Suchen) berück­ +sichtigt wird. + Es gibt folgende Feldtypen (als Standard wird der Typ TEXT +verwendet): + + TEXT Vergleich von Texten nach dem EUMEL-Code der einzel­ + nen Zeichen. Dies ist Standard und sorgt für schnellst­ + möglichen Vergleich. Die weiteren Typen brauchen erheb­ + lich mehr Zeit. + + DIN Vergleich nach DIN 5007 (s. EUMEL-Benutzerhandbuch). + Umlaute werden korrekt eingeordnet, Groß- und Klein­ + buchstaben werden gleichbehandelt, Sonderzeichen werden + ignoriert. + + ZAHL Der Wert einer Zahl wird verglichen. Außer den Ziffern, + dem Dezimalkomma und dem Minuszeichen vor der ersten + Ziffer werden alle anderen Zeichen ignoriert. Das Dezi­ + malkomma ist standardmäßig auf ',' eingestellt, kann aber + verändert werden (s. Abschnitt 6.5). Die nicht ignorierten + Zeichen werden in eine REAL-Zahl umgewandelt und dann + verglichen. + + DATUM Es werden Daten der Form 'tt.mm.jj' verglichen. In diesem + Fall werden Tag und Jahr vertauscht und dann vergli­ + chen. Texte mit einer anderen Länge als 8 werden alle + als gleich betrachtet. + +#on("b")#Reorganisieren#off("b")# Wenn viele Änderungen an einer EUDAS-Datei +vorgenommen worden sind, steigt ihr Platzbedarf durch viele Text­ +leichen an. In diesem Fall empfiehlt es sich, die Datei zu reorgani­ +sieren. Auch wenn beim Sortieren viele Sätze vertauscht wurden, +sollte die Datei reorganisiert werden, da beim Sortieren die physi­ +kalische Reihenfolge der Sätze nicht verändert wird. In diesem Fall +ergibt sich nach dem Reorganisieren ein Geschwindigkeitsvorteil. + + +4.4 Bearbeiten + +#on("b")#Kopieren#off("b")# Durch Kopieren kann ein Ausschnitt aus der +virtuellen +Datei in eine andere EUDAS-Datei kopiert werden. Es werden alle +ausgewählten Sätze kopiert. Wenn mindestens ein Satz markiert ist, +werden alle markierten Sätze als ausgewählt betrachtet, ansonsten +alle, die durch die Suchbedingung angegeben sind. Die kopierten +Sätze werden am Ende der Zieldatei angefügt. + Welche Felder kopiert werden sollen, wird durch das Kopier­ +muster angegeben. Hierbei können auch mehrere Felder zu einem +verschmolzen werden. Allgemein ergeben sich die Felder der Ziel­ +datei aus einem beliebigen ELAN-Ausdruck. + Das Kopiermuster ist ein ELAN-Programm und enthält im we­ +sentlichen Ausdrücke der Form + + + "Feldname" K Ausdruck ; + + +Durch diese Anweisung wird der Ausdruck in das Feld der Zieldatei +mit dem angegebenen Namen kopiert. Existiert dieses Feld in der +Zieldatei noch nicht, so wird es als letztes angefügt. Falls die +Zieldatei noch nicht existiert, wird sie eingerichtet. In diesem Fall +bestimmt also die Reihenfolge der 'K'-Ausdrücke die Reihenfolge der +Feldnamen in der Zieldatei. + Da die Reihenfolge der 'K'-Ausdrücke wichtig ist, dürfen diese +nicht in einer IF-Anweisung stehen, sondern müssen für jeden Satz +komplett in der gleichen Reihenfolge ausgeführt werden. + +#on("b")#Standard-Kopiermuster#off("b")# Vor dem Kopieren wird ein Standard- +Kopiermuster zum Editieren angeboten, das sich nach der Zieldatei +richtet. Existiert die Zieldatei noch nicht, wird das Muster so kon­ +struiert, daß alle Felder der virtuellen Datei unverändert kopiert +werden. Wollen Sie einige Felder nicht kopieren, brauchen Sie nur +die entsprechenden Zeilen zu löschen; wollen Sie die Felder in eine +andere Reihenfolge bringen, müssen Sie die Zeilen umordnen. + Existiert die Zieldatei bereits, gibt das Standard-Kopiermuster +an, daß alle Felder der Zieldatei einen Wert erhalten. Ist ein Feld +der Zieldatei in der virtuellen Datei enthalten, so wird dieses ko­ +piert, ansonsten erhält das Feld einen leeren Inhalt. Sie können in +diesem Fall weitere Felder angeben oder für die leeren Felder Aus­ +drücke formulieren. + +#on("b")#Tragen#off("b")# Durch Tragen werden alle ausgewählten Sätze der +virtuel­ +len Datei in eine andere Datei transportiert. Sie sind in der vir­ +tuellen Datei dann nicht mehr vorhanden. Damit bei diesem Vorgang +keine Informationen verlorengehen können, muß die Zieldatei so +viele Felder haben wie die virtuelle Datei. Normalerweise sollte sie +in der Feldstruktur mit der virtuellen Datei übereinstimmen. + Die getragenen Sätze werden jeweils am Ende der Datei ange­ +fügt. + Beim Tragen können zusätzlich noch Konsistenzbedingungen +überprüft werden. Die Prüfbedingungen sind in der Zieldatei gespei­ +chert und können beim Ändern der Feldstruktur angegeben werden. + Die Prüfbedingung ist ein ELAN-Programm, das vor dem Tragen +des jeweiligen Satzes ausgeführt wird. Durch spezielle Testprozedu­ +ren kann das Tragen des Satzes verhindert werden, wenn diese +Prozeduren ein negatives Ergebnis liefern. Gleichzeitig wird eine +Meldung in eine Protokolldatei geschrieben, die dann zur Identifi­ +zierung der fehlerhaften Sätze dienen kann. + Folgende Prüfprozeduren stehen zur Verfügung (siehe auch +Abschnitt 8.3): + + + pruefe ("Feldname", Bedingung) + + Hiermit kann eine beliebige Bedingung (BOOL-Ausdruck in + ELAN) überprüft werden. + + + wertemenge ("Feldname", "Wert1,Wert2,...,Wertn") + + Das Feld muß einen in der angegebenen Liste enthaltenen + Werte annehmen. + + + feldmaske ("Feldname", "Maske") + + Das Feld wird auf Übereinstimmung mit der Maske geprüft. + Fünf spezielle Zeichen in der Maske können dabei auf + mehrere Zeichen zutreffen: + '9' alle Ziffern + 'a' alle Kleinbuchstaben, Umlaute, 'ß' + 'A' alle Großbuchstaben, Umlaute + 'X' alle Zeichen + '*' Folge von beliebigen Zeichen + Der Stern sollte sparsam angewendet werden, da er verar­ + beitungsaufwendig ist. + + + eindeutige felder (n) + + Die Zahl 'n' gibt an, die wieviel ersten Felder der Zieldatei + eindeutig sein müssen. Stimmt der zu tragende Satz mit + einem Satz der Zieldatei in diesen Feldern überein, wird + eine Fehlermeldung erzeugt. + +Es können auch einzelne Sätze manuell getragen werden. In diesem +Fall wird die Prüfbedingung nicht getestet. Ebenso kann der Satz +wieder zurückgeholt und in der aktuellen Datei eingefügt werden. + +#on("b")#Nach Vorschrift ändern#off("b")# Die ausgewählten Sätze der +virtuellen +Datei können automatisch nach einer Verarbeitungsvorchrift geän­ +dert werden. Die Verarbeitungsvorschrift ist ein ELAN-Programm, in +dem mit Hilfe des Operators 'V' Änderungen angegeben werden: + + + "Feldname" V TEXT-Ausdruck ; + + +Das angegebene Feld erhält den Inhalt, der durch den Ausdruck +angegeben ist. Änderungen an Koppeldateien werden wie im Dialog +behandelt (s. Abschnitt 3.4). + + + + diff --git a/app/eudas/4.3/doc/eudas.ref.5 b/app/eudas/4.3/doc/eudas.ref.5 new file mode 100644 index 0000000..02971ea --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.5 @@ -0,0 +1,432 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (49)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +5 Drucken und Druckmuster + + + +5.1 Druckmustersyntax + +Ein Druckmuster ist eine Beschreibung für die Form, in der die In­ +halte einer EUDAS-Datei ausgedruckt werden sollen. Der syntakti­ +sche Aufbau des Druckmusters ist zeilenorientiert und gehorcht +folgender Syntax: + + Druckmuster : + [ Initialisierungsteil ] + [ Vorspann ] + [ Wiederholungsteil ] + [ Nachspann ] + + Initialisierungsteil : + ( Kommandozeile #char (""124"")# Textzeile )* + ( GRUPPE-Anweisung #char(""124"")# Textzeile )* + + Vorspann : + VORSPANN-Anweisung Abschnitt + + Wiederholungsteil : + WIEDERHOLUNG-Anweisung Abschnitt + + Nachspann : + NACHSPANN-Anweisung Abschnitt + + Abschnitt : + Musterteil + [ ABKUERZUNGEN-Anweisung Abkürzungsteil ] + + Musterteil : + ( Musterzeile #char(""124"")# Kommandozeile #char(""124"")# + MODUS-Anweisung #char (""124"")# MEHR-Anweisung )* + +Zur Notation: [] bedeutet optional, ()* beliebig häufige Wiederho­ +lung, #char(""124"")# Alternative und keine Angabe einfache Aneinanderreihung. +Die verschiedenen Zeilentypen werden weiter unten beschrieben. + Zusätzlich gilt die Bedingung, daß von Vorspann, Wiederho­ +lungsteil und Nachspann mindestens einer vorhanden sein muß. + +#on("b")#Zeilentypen#off("b")# Im Druckmuster gibt es 6 verschiedene +Zeilentypen: + +#on("i")#Kommandozeilen#off("i")# + Eine Kommandozeile beginnt mit '%%' in der ersten und zweiten + Spalte. Der Inhalt der Zeile ab Spalte 3 wird dem ELAN-Compi­ + ler übergeben. Die Bedeutung dieser Zeilen ergibt sich aus dem + in 5.4 beschriebenen Übersetzungsmechanismus. + +#on("i")#Anweisungen#off("i")# + Anweisungen beginnen mit '%' in der ersten Spalte und dienen + zur Steuerung des Druckgenerators. Der Name der Anweisung + muß in Großbuchstaben und ohne Leerzeichen geschrieben + werden. Davor dürfen sich noch Leerzeichen befinden. An­ + schließend können noch Parameter folgen, die nur durch Leer­ + zeichen getrennt aneinander gereiht werden. Die Syntax einer + Anweisung ähnelt der eines Operators in ELAN. + +#on("i")#Textzeilen#off("i")# + Textzeilen sind die nicht anderweitig markierten Zeilen im + Initialisierungsteil. Sie werden unverändert an den Anfang + jeder Druckdatei gestellt. + +#on("i")#Musterzeilen#off("i")# + Musterzeilen sind nicht besonders gekennzeichnete Zeilen im + Musterteil. Sie enthalten Feldmuster und werden nach dem + Einsetzen von Inhalten in die Ausgabedatei übernommen. Die + Interpretation der Musterzeilen wird in Abschnitt 5.3 beschrie­ + ben. + +#on("i")#Abkürzungszeilen#off("i")# + Abkürzungszeilen markieren den Beginn einer Abkürzung im + Abkürzungsteil eines Abschnittes. Sie werden durch '&' in der + ersten Spalte gekennzeichnet. Darauf folgt ohne Zwischenraum + der Name einer Abkürzung (ohne Leerzeichen) und danach + durch Leerzeichen getrennt ein Semikolon. Der Name der Ab­ + kürzung wird bei der Übersetzung durch einen Refinementnamen + ersetzt und die Zeile dem ELAN-Compiler übergeben. Der Rest + der Zeile kann also den Beginn eines werteliefernden Refine­ + ments enthalten. + +#on("i")#Programmzeilen#off("i")# + Programmzeilen sind die nicht durch '&' markierten Zeilen im + Abkürzungsteil. Sie werden unverändert an den ELAN-Compiler + übergeben. Der erlaubte Inhalt richtet sich nach dem Überset­ + zungsmechanismus (5.4). + + +5.2 Der Druckvorgang + +Der Druckvorgang besteht im wesentlichen darin, daß für alle zu +bearbeitenden Sätze der Wiederholungsteil einmal interpretiert wird +und das Ergebnis in eine Ausgabedatei geschrieben wird, die dann +gedruckt werden kann. Wenn mindestens ein Satz markiert ist, wer­ +den alle markierten Sätze der virtuellen Datei bearbeitet, ansonsten +alle durch die Suchbedingung erfaßten. + +#on("b")#Gruppen#off("b")# Eine #on("i")#Gruppe#off("i")# ist eine Folge von Sätzen, die in einem be­ +stimmten Merkmal übereinstimmen. Durch eine GRUPPE-Anweisung +der Form + + + % GRUPPE n Ausdruck + + +werden aufeinanderfolgende Sätze mit gleichem Wert des angegebe­ +nen Ausdrucks gruppiert. Über die Nummer 'n' kann festgestellt +werden, ob sich das angegebene Merkmal verändert hat. Dies ge­ +schieht mit der Prozedur + + + BOOL PROC gruppenwechsel (INT CONST gruppennr) + + +Immer wenn zwischen zwei Sätzen ein Gruppenwechsel stattfindet, +wird beim vorigen Satz der Nachspann und beim folgenden Satz der +Vorspann einmal interpretiert. Dies führt dazu, daß entsprechende +Vorspann- bzw. Nachspannzeilen gedruckt werden. + Vor dem ersten und nach dem letzten zu bearbeitenden Satz +wechseln alle Gruppen, d.h. dort wird immer ein Vorspann bzw. +Nachspann erzeugt. + Ist ein zu interpretierender Abschnitt nicht vorhanden, so wird +an dieser Stelle keine Ausgabe erzeugt. Die Textzeilen des Initali­ +sierungsteils werden auf jeden Fall bei Beginn des Druckvorganges +in die Ausgabedatei geschrieben. Falls die Ausgabedatei voll ist, +wird eine neue Datei angefangen und die Zeilen des Initialisie­ +rungsteils erneut an den Anfang gestellt. + + + Satz- Gruppen- Ausgabe + nummer merkmal +#free (0.1)# + Initialisierungsteil + ------------------------------------------------- + 1 x Vorspann + WDH-Teil + 2 x WDH-Teil + Nachspann + ------------------------------------------------- + 3 y Vorspann + WDH-Teil + 4 y WDH-Teil + 5 y WDH-Teil + Nachspann + ------------------------------------------------- + ENDE + +#center#Abb. 5-1 Ablauf des Druckvorganges mit Gruppen + + +#on("b")#Spaltendruck#off("b")# Normalerweise werden die Ausgaben der +einzelnen +Abschnitte hintereinander in der Ausgabedatei plaziert. Durch An­ +gabe einer Nummer als Parameter in der WIEDERHOLUNG-Anweisung +können auch soviel Spalten wie angegeben nebeneinander gedruckt +werden. Die Spaltenbreite wird dabei durch das Dateilimit (Komman­ +do 'limit' im Editor) festgelegt. Alternativ kann die Spaltenbreite +auch als zweiter Parameter durch Leerzeichen getrennt angegeben +werden. + Vorspann und Nachspann werden jedoch auf jeden Fall wieder +in eine eigene Zeile geschrieben, der Spaltendruck also unterbro­ +chen. + + +5.3 Interpretation von Musterzeilen + +Musterzeilen können Feldmuster enthalten, die bei der Interpreta­ +tion durch entsprechende Inhalte ersetzt werden, ehe die Muster­ +zeile in die Ausgabedatei übernommen wird. Der Beginn eines Feld­ +musters wird durch ein Musterzeichen ('&' oder '%') markiert. Wo +und wie der Inhalt eingesetzt wird, kann durch folgende Variationen +angegeben werden: + + + Typ ! Beispiel ! Position ! Länge ! bündig + ----+-----------+------------------------------ + 1 ! &Name ! fest ! variabel ! links + 2 ! %Name ! variabel ! variabel ! links + 3 ! &Name&&& ! fest ! fest ! links + 4 ! %Name%%% ! variabel ! fest ! links + 5 ! &&&Name& ! fest ! fest ! rechts + 6 ! %%%Name% ! variabel ! fest ! rechts + + +Der in dem Feldmuster angegebene Name muß Name einer Abkür­ +zung in irgendeinem Abkürzungsteil oder eines Feldes sein. Der +Name darf kein Leerzeichen oder Musterzeichen enthalten. Falls dies +doch der Fall ist, muß der Name in spitze Klammern eingeschlossen +werden. + Bei fester Länge wird bei zu kurzem Inhalt mit Leerzeichen +aufgefüllt, bei zu langem Inhalt abgeschnitten. Bei linksbündigem +Einsetzen geschieht dies an der rechten, sonst an der linken Seite. + Feldmuster variabler Länge können je nach Inhalt dazu führen, +daß der folgende Teil der Musterzeile verschoben wird. Für diesen +Einsetzprozeß gelten die folgenden Regeln: + +#on("b")#Position#off("b")# Feldmuster fester Position (mit '&' beginnend) +werden +immer in der Position eingesetzt, in der sie stehen. Feldmuster +variabler Position (mit '%' beginnen) können nach rechts verschoben +werden, wenn vorherige Inhalte länger als ihre Muster sind, und +nach links, wenn Modus 1 oder 3 eingestellt ist und vorherige In­ +halte kürzer sind. + +#on("b")#Länge#off("b")# Feldmuster variabler Länge erhalten auf jeden Fall +den +Platz, der durch die Länge des Feldmusters reserviert ist. Sind die +Inhalte kürzer, kann der gewonnene Platz als Reserve für andere +Feldmuster verwendet werden; sind die Inhalte länger, so wird der +Inhalt so weit eingesetzt, wie noch Reserve vorhanden ist und der +Rest abgeschnitten. + Muß in ein Feldmuster variabler Länge ein leerer Inhalt einge­ +setzt werden, so werden beim Drucken auch die auf das Feldmuster +folgenden Leerzeichen unterdrückt, falls vor dem Feldmuster noch +ein Leerzeichen steht oder das Feldmuster in Spalte 1 beginnt. + Feldmuster fester Länge werden immer in ihrer reservierten +Länge eingesetzt. Sie werden im folgenden behandelt wie Feldmuster +variabler Länge, deren Inhalt so lang ist wie das Feldmuster. + +#on("b")#Verteilung#off("b")# Die Verteilung der verschiebbaren Feldmuster +auf der +Zeile geschieht jeweils in dem Abschnitt zwischen zwei Feldmustern +fester Position bzw. Zeilenanfang oder Zeilenende. Für jeden Ab­ +schnitt wird festgestellt, wieviel Stellen die Inhalte insgesamt mehr +oder weniger als ihre Muster benötigen. + Der Längenausgleich geschieht zwischen dem letzten Feldmuster +und dem Ende des Abschnitts. Dort wird ein Pufferplatz bestimmt, +der bei Überlänge bis auf ein Leerzeichen verkleinert werden kann +und an dem bei Unterlänge zusätzliche Leerzeichen eingefügt wer­ +den. + Außer am Pufferplatz wird an keinem Mustertext des Abschnitts +etwas geändert. Zwischentexte zwischen den Feldmustern werden +unverändert übertragen und mit den umgebenden Feldmustern ver­ +schoben. + Als Pufferplatz wird die erste Lücke hinter dem letzten Feld­ +muster eines Abschnittes verwendet, die mehr als ein Leerzeichen +enthält. Ist keine solche Lücke vorhanden, wird das Ende des Ab­ +schnitts verwendet, falls dort ein Leerzeichen steht, und sonst das +Ende des letzten Feldmusters. + Die durch den Pufferplatz und kürzere Inhalte gewonnene Re­ +serve wird von links an die Feldmuster mit Überlänge verteilt, bis +die Reserve verbraucht ist. + +#on("b")#Zeilende#off("b")# Das Zeilenende wird als ein Quasi-Feldmuster mit +fester +Position aufgefaßt, das am Limit der Druckmusterdatei steht. Es +sind also keine Einsetzungen möglich, die über das Limit der Datei +hinausgehen. Als Pufferplatz wird hier jedoch die erste Blanklücke +vom Zeilenende her verwendet, damit Mustertexte am Zeilenende +gegebenenfalls stehenbleiben. Ist keine solche Lücke vorhanden, so +wird das Zeilenende als Pufferplatz verwendet. + Obwohl nicht als Pufferplatz ausgewiesen, kann der Raum zwi­ +schen Zeilenende und Dateilimit als Reserve verwendet werden. + +#on("b")#Modi#off("b")# Der Einsetzmechanismus kann durch die MODUS-Anweisung +mit einem Parameter verändert werden. Folgende Modi stehen zur +Verfügung: + + + Modus ! Effekt + ------+---------------------------------------- + 1 ! Normalmodus. + ! '%'-Feldmuster werden auch + ! nach links geschoben. + ! Keine Zeilenwiederholung. + ------+---------------------------------------- + 2 ! Tabellenmodus. + ! '%'-Feldmuster werden nicht + ! nach links geschoben. + ! Keine Zeilenwiederholung. + ------+---------------------------------------- + 3 ! Normalmodus mit Zeilenwiederholung. + ! '%'-Feldmuster werden auch + ! nach links geschoben. + ! Zeilenwiederholung ohne Zwischentexte. + ------+---------------------------------------- + 4 ! Tabellenmodus mit Zeilenwiederholung. + ! '%'-Feldmuster werden nicht + ! nach links geschoben. + ! Zeilenwiederholung mit Zwischentexten. + ------+---------------------------------------- + + +Bei Zeilenwiederholung werden Inhalte in einer folgenden Zeile +fortgesetzt, falls sie in der ersten Zeile nicht untergebracht werden +konnten. Dazu wird die Musterzeile mit den Restinhalten erneut +interpretiert. Je nach Modus werden auch die Zwischentexte noch +wiederholt. Der Restinhalt umfaßt immer noch das ganze letzte Wort, +das nicht mehr auf die vorige Zeile paßte. Es findet also ein Um­ +bruch statt. Die Positionen, die in der vorigen Zeile vom Anfang des +Wortes eingenommen würden, werden durch Leerzeichen ersetzt. + Durch die MEHR-Anweisung mit einem Parameter kann die Zahl +der Zeilenwiederholungen für die nächste Musterzeile festgesetzt +werden. Dies hat jedoch nur eine Auswirkung, falls Zeilenwieder­ +holung zugelassen ist. Stehen zur Interpretation keine Restinhalte +mehr zur Verfügung, wird mit leeren Inhalten weitergearbeitet. Kann +ein Inhalt bei der vorgegebenen Anzahl von Zeilen nicht ganz dar­ +gestellt werden, wird der Rest nicht ausgegeben. + + +5.4 Anschluß zum ELAN-Compiler + +Falls in einem Druckmuster Abkürzungen, Kommandozeilen oder +Gruppendefinitionen vorkommen, wird das Druckmuster in ein +ELAN-Programm umgewandelt, das dann vom ELAN-Compiler über­ +setzt wird. + Alle Zeilen eines Abkürzungsteils werden direkt in das Pro­ +gramm übernommen, wobei der Name einer Abkürzung durch einen +beliebig gewählten Refinementnamen ersetzt wird ('abk' + eine lau­ +fende Nummer). Alle Abkürzungen und Refinements werden als glo­ +bale Refinements definiert, also außerhalb von Prozeduren. Dadurch +wird erreicht, daß sie an jeder Stelle verwendet werden können. + Damit eine Abkürzung richtig als Refinement übersetzt wird, +muß sie ein TEXT-Objekt als Wert liefern. Die anderen Refinements +sind beliebig, da sie nur in selbstdefinierten Anweisungen verwen­ +det werden. Die Refinements der Abkürzungen werden in einer Zu­ +weisung an eine TEXT-Variable verwendet, damit der Druckgenera­ +tor auf den entsprechenden Wert zugreifen kann. + Jeder Abschnitt wird dagegen als eine Prozedur übersetzt. Eine +Folge von Musterzeilen wird in eine Anweisung übersetzt, diese +Musterzeilen einzusetzen und zu drucken. Eine '%%'-Anweisung wird +einfach unverändert dazwischengeschrieben. Die Prozedur für den +Wiederholungsteil wird einmal für jeden ausgewählten Satz aufgeru­ +fen, die Vorspann- und die Nachspann-Prozedur einmal bei jedem +Gruppenwechsel. + Anweisungen im Initialisierungsteil werden an den Anfang des +Programms als globale Definitionen gestellt. + +#on("b")#Fehler#off("b")# Findet sich in dem erzeugten ELAN-Programm ein +Fehler, +der durch den Druckgenerator nicht erkannt werden konnte (z.B. +eine Abkürzung liefert keinen Wert), so muß der ELAN-Compiler +diesen Fehler erkennen. Anschließend zeigt er das erzeugte Pro­ +gramm zusammen mit seinen Fehlermeldungen im Paralleleditor. Sie +müssen nun die Fehlermeldung lokalisieren und anhand der eben +gegebenen Hinweise in das ursprüngliche Druckmuster zurücküber­ +setzen, damit Sie dort den Fehler korrigieren können. + + +5.5 Fehlermeldungen + +Folgende Fehlermeldungen können bei der Übersetzung eines Druck­ +musters auftreten: + +#on("i")#keine schliessende Klammer in Feldmuster#off("i")# + Wenn der Name in einem Feldmuster in spitze Klammern einge­ + schlossen werden soll, muß noch in der gleichen Zeile eine + schließende Klammer vorhanden sein. + +#on("i")#kein Kommando in Kommandozeile#off("i")# + Eine Zeile, die mit '%' beginnt, enthält keinen weiteren Text. + +#on("i")#unbekanntes Kommando#off("i")# + Das erste Wort in einer Kommandozeile ist kein bekanntes Kom­ + mando. + +#on("i")#kein % WIEDERHOLUNG gefunden#off("i")# + Das Druckmuster enthält keine Anweisung, die den Beginn eines + Abschnittes markiert. Es muß aber mindestens ein Abschnitt + vorhanden sein. + +#on("i")#nur GRUPPE-Anweisung erlaubt#off("i")# + Im Initialisierungsteil ist nur die GRUPPE-Anweisung erlaubt. + +#on("i")#keine ELAN-Anweisung im Initialisierungsteil nach Gruppen­ +definition#off("i")# + Sobald im Initialisierungsteil eine GRUPPE-Anweisung aufgetreten + ist, ist keine Kommandozeile mehr möglich. + +#on("i")#illegale Gruppennummer#off("i")# + In einer GRUPPE-Anweisung wurde eine zu große Nummer angege­ + ben. Gruppen sollten von 1 an durchnumeriert werden. + +#on("i")#diese Gruppe wurde schon definiert#off("i")# + Eine Gruppennummer wurde mehrfach verwendet. + +#on("i")#diese Abkürzung ist nicht definiert#off("i")# + Ein Name in einem Feldmuster tritt nicht als Feld-oder Abkür­ + zungsname auf. Eventuell enthält er ein Leerzeichen! + +#on("i")#dieser Abschnitt wurde schon einmal definiert#off("i")# + Kein Abschnitt kann mehrmals angegeben werden. + +#on("i")#falscher Modus#off("i")# + In einer MODUS-Anweisung wurde ein nicht definierter Modus als + Parameter angegeben. + +#on("i")#diese Anweisung darf im Musterteil nicht vorkommen#off("i")# + +#on("i")#im Abkürzungsteil darf keine Anweisung auftreten#off("i")# + +#on("i")#in dieser Zeile stehen zu viele Feldmuster#off("i")# + Es können maximal 24 Feldmuster in einer Zeile stehen. Abhilfe: + mehrere Feldmuster durch eine Abkürzung zusammenfassen. + +#on("i")#das Druckmuster enthält zu viele Feldmuster#off("i")# + Die Gesamtanzahl der Feldmuster ist begrenzt. Abhilfe: mehrere + Feldmuster durch eine Abkürzung zusammenfassen. + +#on("i")#nach dem "&" soll direkt der Name einer Abkürzung folgen#off("i")# + In einer Abkürzungszeile stehen Leerzeichen hinter dem '&'. + +#on("i")#kein Doppelpunkt nach Abkürzung#off("i")# + Nach dem Abkürzungsnamen in einer Abkürzungszeile muß durch + ein Leerzeichen getrennt ein Doppelpunkt folgen. + +#on("i")#Abkürzung mehrfach definiert#off("i")# + Die Abkürzung wurde unter dem gleichen Namen schon einmal, + vielleicht in einem anderen Abschnitt, definiert. + +#on("i")#das Druckmuster enthält zu viele Abkürzungen#off("i")# + Abhilfe: mehrere Abkürzungen zu einem Ausdruck zusammenfas­ + sen. + + diff --git a/app/eudas/4.3/doc/eudas.ref.6 b/app/eudas/4.3/doc/eudas.ref.6 new file mode 100644 index 0000000..7c8ada6 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.6 @@ -0,0 +1,399 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (61)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +6 Struktur von EUDAS-Dateien + + + +EUDAS-Dateien können unabhängig von EUDAS über den Daten­ +typ EUDAT manipuliert werden. Die zur Verfügung stehenden Zu­ +griffsoperationen sind in diesem Kapitel beschrieben. + Der Datentyp EUDAT ist analog zum Datentyp FILE. Jede +EUDAT-Variable kann an eine EUDAS-Datei angekoppelt werden. +Dadurch lassen sich beliebig viele EUDAS-Dateien gleichzeitig be­ +arbeiten. Wie der Abschnitt 6.6 zeigt, sind so auch ganz andere +Anwendungen realisierbar. + Die wesentlichen EUDAS-Funktionen (Ansehen, Suchen, Druk­ +ken) können jedoch nicht direkt auf EUDAT-Variablen angewendet +werden, sondern greifen auf die virtuelle Datei zu, die im nächsten +Kapitel beschreiben wird. + + +6.1 Der Datentyp SATZ + +Der Datentyp SATZ stellt einen einzelnen EUDAS-Satz dar, der +intern als TEXT realisiert ist. Ein SATZ besteht aus bis zu 256 +Feldern, die jeweils einen TEXT enthalten können. Nach dem Initi­ +alisieren sind alle Felder mit "" vorbelegt. Die Felder können über +Nummern von 1 bis 256 angesprochen werden. + Damit kann man sich einen SATZ als dynamisches ROW n TEXT +vorstellen, das bis zu 256 Elemente haben kann. Anders als ein +entsprechendes ROW belegt ein leerer SATZ praktisch keinen Spei­ +cherplatz. + Folgende Zugriffsprozeduren stehen zur Verfügung: + +TYPE SATZ + +OP := (SATZ VAR, SATZ CONST) + +PROC satz initialisieren (SATZ VAR) + Jeder SATZ muß vor Benutzung initialisiert werden. + +INT PROC felderzahl (SATZ CONST) + Liefert die Nummer des höchsten belegten Feldes. + +PROC feld lesen (SATZ CONST, INT CONST feldnr, + TEXT VAR inhalt) + Liest den Inhalt des Feldes 'feldnr' in 'inhalt'. + + FEHLER: + + #on("i")#n ist keine Feldnummer#off("i")# + 'n' liegt außerhalb des Bereiches 1..256. + +PROC feld bearbeiten (SATZ CONST, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + Ruft 'bearbeite' auf, wobei 'bearbeite' ein Text und zwei Posi­ + tionen in diesem Text übergeben werden. Die Positionen geben + das erste und das letzte Zeichen des durch 'feldnr' ausgewähl­ + ten Feldes an. Ist der Anfang größer als das Ende, so ist das + Feld leer. + + FEHLER: + + #on("i")#n ist keine Feldnummer#off("i")# + 'n' liegt außerhalb des Bereiches 1..256. + +PROC feld aendern (SATZ VAR, INT CONST feldnr, + TEXT CONST inhalt) + Schreibt 'inhalt' in das Feld mit der Nummer 'feldnr' + + FEHLER: + + #on("i")#n ist keine Feldnummer#off("i")# + 'n' liegt außerhalb des Bereiches 1..256. + +INT PROC feldindex (SATZ CONST, TEXT CONST muster) + Falls eines der Felder 'muster' enthält, wird die Nummer dieses + Feldes geliefert, sonst 0. + + +6.2 Der Datentyp EUDAT + +Der Datentyp EUDAT muß ähnlich wie ein FILE an einen benann­ +ten oder unbenannten Datenraum angekoppelt werden. Der Daten­ +raum hat anschließend den Typ 3243. Weitere Zugriffe auf eine +EUDAT-Variable sind erst nach erfolgtem Ankoppeln zulässig. An­ +derenfalls können undefinierte Fehler entstehen. + +TYPE EUDAT + +PROC oeffne (EUDAT VAR, TEXT CONST dateiname) + Koppelt die EUDAT-Variable an die EUDAS-Datei mit dem + Namen 'dateiname' an. Die Datei wird eingerichtet, falls sie + noch nicht existiert. + + FEHLER: + + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Die angegebene Datei hat nicht den Typ 3243. + +PROC oeffne (EUDAT VAR, DATASPACE CONST ds) + Koppelt die EUDAT-Variable an den Datenraum 'ds'. + + FEHLER: + + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Der Datenraum wurde bereits verwendet und hat nicht den Typ + 3243. + +Eine EUDAS-Datei ist in Felder und Sätze unterteilt. Die Felder +werden beim Zugriff über Nummern angesprochen. Jedem Feld ist +jedoch zur Identifikation ein TEXT als Feldname zugeordnet. Die +Feldnamen werden als SATZ gespeichert, wobei jedes Feld seinen +zugeordneten Namen enthält. + +INT PROC felderzahl (EUDAT CONST) + Liefert Anzahl der benannten Felder. Ist zu Anfang 0. + +PROC feldnamen aendern (EUDAT VAR, + SATZ CONST neue namen) + Setzt die Feldnamen einer Datei. Ist 'felderzahl (neue namen)' + größer als die Felderzahl der Datei, so wird die Felderzahl der + Datei entsprechend heraufgesetzt. + +PROC feldnamen lesen (EUDAT CONST, SATZ VAR namen) + Liefert alle Feldnamen in einer SATZ-Variablen. + +Eine EUDAS-Datei enthält drei zusätzliche Notiztexte. Zwei davon +sind bereits reserviert, und zwar: +#free (0.2)# + 1: Prüfbedingungen + 2: Datum der letzten Änderung + +Der dritte kann für freie Notizen verwendet werden. + +PROC notizen lesen (EUDAT CONST, INT CONST notiz nr, + TEXT VAR notizen) + Schreibt die Notizen der EUDAS-Datei in 'notizen' ('notiz nr' = + 1,2,3). + +PROC notizen aendern (EUDAT VAR, INT CONST notiz nr, + TEXT CONST notizen) + Ändert die Notizen. Alte Notizen werden dabei überschrieben + ('notiz nr' = 1,2,3). + + +6.3 Satzposition + +Eine EUDAS-Datei läßt sich sequentiell vorwärts und rückwärts +bearbeiten. Dazu gibt es eine aktuelle Satzposition. Ein bestimmter +Satz kann auch direkt angesprungen werden. Die Prozeduren, die +nach dem Inhalt des ersten Feldes suchen, arbeiten besonders +schnell, da die entsprechenden Sätze über eine Hashmethode gefun­ +den werden. + +INT PROC satznr (EUDAT CONST) + Liefert aktuelle Satzposition. + +INT PROC saetze (EUDAT CONST) + Liefert Anzahl der Sätze. + +BOOL PROC dateiende (EUDAT CONST) + Liefert TRUE, wenn 'satznr' groesser als 'saetze' ist. Die letzte + erreichbare Satzposition liegt um eins hinter dem letzten Satz + (um auch am Ende anfügen zu können). + +PROC auf satz (EUDAT VAR, INT CONST satznr) + Positioniert auf den gewünschten Satz. Bei nicht existierenden + Sätzen wird auf den ersten bzw. hinter den letzten Satz ge­ + sprungen. + +PROC weiter (EUDAT VAR) + Geht einen Satz weiter, jedoch nicht über das Dateiende hinaus. + +PROC zurueck (EUDAT VAR) + Geht einen Satz zurück, falls der erste Satz noch nicht erreicht + ist. + +PROC auf satz (EUDAT VAR, TEXT CONST muster) + Positioniert auf den ersten Satz, der als erstes Feld 'muster' + enthält, anderenfalls hinter den letzten Satz. + +PROC weiter (EUDAT VAR, TEXT CONST muster) + Geht weiter, bis das erste Feld 'muster' enthält, bzw. bis hinter + den letzten Satz. + +PROC zurueck (EUDAT VAR, TEXT CONST muster) + Geht zurück, bis das erste Feld 'muster' enthält, bzw. auf den + ersten Satz der EUDAS-Datei. + + +6.4 Satzzugriffe + +Der aktuelle Satz ist ein SATZ-Objekt. Auf die Felder des aktuellen +Satzes kann direkt zugegriffen werden. + +PROC feld lesen (EUDAT CONST, INT CONST feldnr, + TEXT VAR inhalt) + Wirkt wie 'feld lesen' auf den aktuellen Satz. + +PROC feld aendern (EUDAT VAR, INT CONST feldnr, + TEXT CONST inhalt) + Wirkt wie 'feld aendern' auf den aktuellen Satz. + +PROC feld bearbeiten (EUDAT CONST, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + Wirkt wie 'feld bearbeiten' auf den aktuellen Satz. + +Der aktuelle Satz kann auch als Ganzes bearbeitet werden. + +PROC satz lesen (EUDAT CONST, SATZ VAR satz) + Liefert den aktuellen Satz. + +PROC satz aendern (EUDAT VAR, SATZ CONST satz) + Ersetzt den aktuellen Satz durch 'satz'. + +PROC satz einfuegen (EUDAT VAR, SATZ CONST satz) + Fügt 'satz' vor dem aktuellen Satz ein. + + FEHLER: + + #on("i")#EUDAS-Datei voll#off("i")# + Eine EUDAS-Datei faßt mindestens 5000 Sätze. + +PROC satz loeschen (EUDAT VAR) + Löscht den aktuellen Satz. + + +6.5 Sortieren und Reorganisieren + +Zum Sortieren können für die einzelnen Felder Typen angegeben +werden, damit auch Zahlen und Daten richtig sortiert werden kön­ +nen. Außerdem kann die Feldreihenfolge angegeben werden, nach +der sortiert werden soll. + +PROC feldinfo (EUDAT VAR, INT CONST feldnr, info) + Setzt den Feldtyp des Feldes 'feldnr'. Es bedeuten + -1 : normaler Text (Standard) + 0 : Text nach DIN. Ziffern und Sonderzeichen werden igno­ + riert. Groß-und Kleinbuchstaben gelten gleich. Umlaute + werden beachtet. + 1 : Zahl (beim Vergleich werden alle Zeichen außer Zif­ + fern ignoriert). + 2 : Datum. Es werden Daten der Form "tt.mm.jj" vergli­ + chen. + +INT PROC feldinfo (EUDAT CONST, INT CONST feldnr) + Der Feldtyp des angegebenen Feldes wird geliefert. Zu Anfang + ist -1 voreingestellt. + +INT PROC unsortierte saetze (EUDAT CONST) + Liefert die Anzahl von Sätzen, die seit dem letzten Sortiervor­ + gang geändert wurden. Bei einer neuen Datei, die noch nie + sortiert wurde, wird immer 0 geliefert. + +PROC dezimalkomma (TEXT CONST komma) + Stellt das Dezimalkomma ein, das beim Vergleich von Zahlen + gelten soll. + + FEHLER: + + #on("i")#Nicht erlaubtes Dezimalkomma#off("i")# + Nur Texte der Länge 1 sind zugelassen. + +TEXT PROC dezimalkomma + Liefert das eingestellte Dezimalkomma ("," ist voreingestellt). + +PROC sortiere (EUDAT VAR, TEXT CONST reihenfolge) + Sortiert die Datei in der von 'reihenfolge' angegebenen Reihen­ + folge. Dabei enthält 'reihenfolge' an der Stelle 2*i+1 den Code + der Feldnummer, die als i-te in der Sortierung berücksichtigt + werden soll. Das Zeichen an der Stelle 2*i gibt an, ob das Feld + mit der davorstehenden Feldnummer aufsteigend ('+') oder + absteigend ('-') sortiert werden soll. + +PROC sortiere (EUDAT VAR) + Sortiert die Datei in der zuletzt eingestellten Reihenfolge. + Wurde noch keine Reihenfolge angegeben, wird die Datei in der + Feldreihenfolge sortiert. + +TEXT PROC sortierreihenfolge (EUDAT CONST) + Liefert die zuletzt eingestellte Reihenfolge. Wurde noch nicht + sortiert, so wird "" geliefert. + +Nach umfangreichen Änderungen an einer EUDAS-Datei ist eine +Reorganisation sinnvoll, um "Textleichen" zu beseitigen. + +PROC reorganisiere (TEXT CONST dateiname) + Die EUDAS-Datei mit dem Namen 'dateiname' wird reorgani­ + siert. + + +6.6 EUDAS-Dateien als Assoziativspeicher + +In diesem Abschnitt soll ein Beispiel erläutert werden, in dem +EUDAS-Dateien unabhängig von EUDAS für einen ganz anderen +Zweck benutzt werden. Das folgende kurze Paket soll ein Abkür­ +zungsverzeichnis realisieren, das auf einer EUDAS-Datei basiert. + + + PACKET abkuerzungsverzeichnis + DEFINES + verzeichnis laden, + abkuerzung einfuegen, + abkuerzung aendern, + abkuerzung loeschen, + langform : + + EUDAT VAR verz; + SATZ VAR satz; + TEXT VAR inhalt; + + PROC verzeichnis laden (TEXT CONST dateiname) : + + oeffne (verz, dateiname) + + END PROC verzeichnis laden; + + PROC abkuerzung einfuegen (TEXT CONST abk, lang) : + + auf satz (verz, abk); + IF NOT dateiende (verz) THEN + errorstop ("Abkürzung existiert bereits") + ELSE + satz initialisieren (satz); + feld aendern (satz, 1, abk); + feld aendern (satz, 2, lang); + satz einfuegen (satz) + END IF + + END PROC abkuerzung einfuegen; + + PROC abkuerzung aendern (TEXT CONST abk, lang) : + + auf satz (verz, abk); + IF dateiende (verz) THEN + errorstop ("Abkürzung existiert nicht") + ELSE + feld aendern (verz, 2, lang) + END IF + + END PROC abkuerzung aendern; + + PROC abkuerzung loeschen (TEXT CONST abk) : + + auf satz (verz, abk); + IF NOT dateiende (verz) THEN + satz loeschen (verz) + END IF + + END PROC abkuerzung loeschen; + + TEXT PROC langform (TEXT CONST abk) : + + auf satz (verz, abk); + IF dateiende (verz) THEN + inhalt := ""; + errorstop ("Abkürzung nicht vorhanden") + ELSE + feld lesen (verz, 2, inhalt) + END IF; + inhalt + + END PROC langform; + + END PACKET abkuerzungsverzeichnis; + + +Die Prozedur 'verzeichnis laden' koppelt die interne EUDAT-Vari­ +able 'verz' an eine benannte EUDAS-Datei, die eventuell vorher mit +EUDAS erstellt wurde. In diesem Beispiel sind die Feldnamen egal; +falls die übergebene EUDAS-Datei noch nicht existiert, wird sie mit +0 Feldern eingerichtet, was aber nur für eine spätere Anzeige mit +EUDAS störend wäre. + Grundlage für das Aufsuchen einer bestimmten Abkürzung bil­ +det immer die Prozedur 'auf satz', die nach dem Inhalt des ersten +Feldes optimiert sucht. Falls die Abkürzung nicht gefunden wurde, +wird auf das Dateiende positioniert, daher wird jeweils 'dateiende' +abgefragt. + Beim Einfügen eines neuen Satzes muß eine komplette Satz­ +variable angegeben werden, die bereits mit den Inhalten gefüllt ist. +Beim späteren Ändern kann jedoch direkt auf ein Feld zugegriffen +werden, ohne die Satzvariable explizit rauszuholen. + Die Abfrage einer bestimmten Abkürzung bereitet dann keine +Schwierigkeiten mehr. + Für die Verwendung von EUDAS-Dateien in diesem Beispiel +spricht zum einen die einfache Programmierung, zum anderen aber +auch die Möglichkeit, das erstellte Verzeichnis mit den Hilfsmitteln + diff --git a/app/eudas/4.3/doc/eudas.ref.7 b/app/eudas/4.3/doc/eudas.ref.7 new file mode 100644 index 0000000..31b3031 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.7 @@ -0,0 +1,447 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (71)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +7 Verwaltung der offenen Dateien + + +Die in diesem Kapitel beschriebene Schnittstelle verbindet mehrere +EUDAS-Dateien zu einem großen Dateimodell. Diese virtuelle Datei +dient als Grundlage für die meisten EUDAS-Funktionen. Zuerst muß +eine Datei als Bestandteil der virtuellen Datei geöffnet werden, ehe +sie bearbeitet werden kann. Es ist so bei den Funktionen keine +Angabe mehr nötig, welche Datei gemeint ist. + Diese Schnittstelle ist in vielen Teilen für die interne +EUDAS-Anwendung ausgelegt. Bei einigen Prozeduren werden aus +Effizienzgründen keinerlei Überprüfungen auf illegale Aufrufe oder +Parameter durchgeführt. Wollen Sie eine solche Prozedur dennoch +verwenden, sollten Sie die Einhaltung der angegebenen Bedingungen +sorgfältig überprüfen. + + +7.1 Dateiverwaltung + +Mit 'oeffne' wird eine Datei zum Bearbeiten geöffnet. Mit 'kette' und +'kopple' können weitere Dateien dazugekettet bzw. dazugekoppelt +werden. Durch 'sichere' können veränderte Kopien zurückgeschrie­ +ben werden. Durch 'dateien loeschen' werden die internen Kopien +gelöscht. + Mit 'anzahl dateien' kann die Anzahl der vorhandenen Dateien +erfragt werden. 'anzahl koppeldateien' gibt Auskunft darüber, wie­ +viel Dateien davon gekoppelt sind. 'aendern erlaubt' gibt den Status +wieder, der beim Öffnen der ersten Datei angegeben wurde. 'inhalt +veraendert' gibt an, ob die angegebene Datei verändert wurde. Mit +'eudas dateiname' können die Namen der geöffneten Dateien erfragt +werden. Bei jedem 'oeffne' wird 'dateiversion' um 1 erhöht. Dies +dient dazu, ein erfolgtes neues Öffnen von anderen Stellen aus zu +entdecken. + Mit 'auf koppeldatei' kann die virtuelle Datei auf eine Koppel­ +datei umgeschaltet werden, so daß der Eindruck entsteht, nur diese +Datei wäre geöffnet worden. + +PROC oeffne (TEXT CONST dateiname, + BOOL CONST aendern erlaubt) + Falls Ändern erlaubt sein soll, wird eine Kopie der angegebenen + Datei zur Bearbeitung für EUDAS angelegt. Vorher geöffnete + Dateien werden gelöscht. Die Änderungserlaubnis wird entspre­ + chend gesetzt. Es wird die Satzposition der EUDAS-Datei ange­ + nommen (Ausnahme: steht die EUDAS-Datei hinter dem letzten + Satz, wird auf Satz 1 positioniert). 'dateiversion' sowie 'anzahl + dateien' werden um 1 erhöht. + + FEHLER: +#f1# + #on("i")#Datei nicht gesichert#off("i")# + Eine vorher geöffnete Datei war verändert, aber nicht gesi­ + chert. +#f1# + #on("i")#Datei existiert nicht#off("i")# + Die angegebene Datei ist nicht vorhanden. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Die angegebene Datei hat nicht den für EUDAS-Dateien festge­ + legten Typ. + +PROC kopple (TEXT CONST dateiname) + Die angegebene Datei wird zu den bereits geöffneten Dateien + dazugekoppelt. Falls Ändern erlaubt ist, wird eine Kopie dieser + Datei verwendet. Dabei werden die ersten Felder der Datei, die + bereits in der Hauptdatei vorhanden sind, als Koppelfelder + festgelegt. Alle weiteren Felder werden zusätzlich zu den bis­ + herigen angelegt. 'dateiversion', 'anzahl dateien' und 'anzahl  + koppeldateien' werden um 1 erhöht. + + FEHLER: +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß vorher eine Datei geöffnet werden. +#f1# + #on("i")#Zuviel Dateien geoeffnet#off("i")# + Die Anzahl der gleichzeitig geöffneten Dateien ist begrenzt. +#f1# + #on("i")#Datei existiert nicht#off("i")# + Die angegebene Datei ist nicht vorhanden. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Die angegebene Datei hat nicht den für EUDAS-Dateien festge­ + legten Typ. +#f1# + #on("i")#Zu viele Felder#off("i")# + Die Anzahl der Felder insgesamt ist begrenzt. +#f1# + #on("i")#Zu viele Koppelfelder#off("i")# + Die Anzahl der Koppelfelder ist begrenzt. +#f1# + #on("i")#keine Koppelfelder vorhanden#off("i")# + Das erste Feld der zu koppelnden Datei ist in der Hauptdatei + nicht vorhanden (unterschiedliche Feldnamen). + +PROC kette (TEXT CONST dateiname) + Die angegebene Datei wird an die Hauptdatei angekettet, d.h. + die Sätze der neuen Datei werden am bisherigen Dateiende + angefügt. Falls Ändern erlaubt ist, wird eine Kopie dieser Datei + verwendet. Die zu kettende Datei muß in der Feldstruktur nicht + mit der Hauptdatei übereinstimmen. Die aktuelle Satzposition + wird beibehalten. 'dateiversion' und 'anzahl dateien' werden um + 1 erhöht. + + FEHLER: +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß vorher eine Datei geöffnet werden. +#f1# + #on("i")#Zuviel Dateien geoeffnet#off("i")# + Die Anzahl der gleichzeitig geöffneten Dateien ist begrenzt. +#f1# + #on("i")#Datei existiert nicht#off("i")# + Die angegebene Datei ist nicht vorhanden. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Die angegebene Datei hat nicht den für EUDAS-Dateien festge­ + legten Typ. + +PROC sichere (INT CONST dateinr, TEXT CONST dateiname) + Die geöffneten Dateien werden in der Reihenfolge ihres Öffnens + durchnumeriert (von 1 an). Die Arbeitskopie mit der angegebe­ + nen Nummer wird unter dem angegebenen Namen gesichert, aber + selbst nicht verändert. Die vorher unter diesem Namen vorhan­ + dene Datei wird gelöscht. War die zu sichernde Arbeitskopie + verändert worden, so wird sie anschließend als nicht verändert + angesehen. + Bedingungen: + 1 <= dateinr <= anzahl dateien + +PROC dateien loeschen (BOOL CONST auch geaenderte) + Es werden alle geöffneten Arbeitskopien gelöscht. EUDAS wird + wieder in den Anfangszustand versetzt. Wird 'auch geaenderte' + angegeben, wird bei geänderten, aber nicht gesicherten Dateien + die Fehlermeldung unterdrückt. + + FEHLER: +#f1# + #on("i")#Datei nicht gesichert#off("i")# + Eine vorher geöffnete Datei war verändert, aber nicht gesi­ + chert. + +BOOL PROC auf koppeldatei + Liefert TRUE, wenn auf eine Koppeldatei umgeschaltet wurde. + +PROC auf koppeldatei (INT CONST nr) + Umschalten auf Koppeldatei 'nr'. Ist bereits umgeschaltet, wird + wieder zurückgeschaltet. In diesem Fall werden bei 'nr' = 1 die + Koppelfelder übernommen, anderenfalls nicht. Beim Umschalten + bleiben Satzposition, Markierungen und Suchmuster gespeichert. + In der Koppeldatei wird die beim letzten Umschalten eingestell­ + te Position wieder eingenommen. 'dateiversion' wird um 1 er­ + höht. + +INT PROC anzahl dateien + Gibt die Anzahl der insgesamt geöffneten Dateien an. + +INT PROC anzahl koppeldateien + Gibt die Anzahl der gekoppelten Dateien an. + +BOOL PROC aendern erlaubt + Reflektiert den Status, der bei 'oeffne' gesetzt wurde. + +BOOL PROC inhalt veraendert (INT CONST dateinr) + Gibt an, ob die geöffnete Datei mit der angegebenen Nummer + verändert wurde. Wird ggf. von 'sichere' zurückgesetzt. + Bedingung: + 1 <= dateinr <= anzahl dateien + +TEXT PROC eudas dateiname (INT CONST dateinr) + Liefert den Namen, unter dem die entsprechende Datei geöffnet + wurde. + Bedingung: + 1 <= dateinr <= anzahl dateien + +INT PROC dateiversion + Wird bei jedem 'oeffne', 'kette' und 'kopple' zyklisch erhöht. + +INT PROC folgedatei (INT CONST dateinr) + Eine geöffnete EUDAS-Datei wird in eine von zwei Listen auf­ + genommen, die der geketteten Dateien und die der gekoppelten. + Diese Prozedur liefert jeweils die Nummer der nächsten Datei in + der Liste, am Ende aber 0. Die Liste der geketteten Dateien + beginnt immer mit 1, mit 'folgedatei (0)' erhält man die erste + gekoppelte Datei. + Bedingung: + 0 <= dateinr <= anzahl dateien + + +7.2 Feldstruktur + +Die einzelnen Sätze der kombinierten EUDAS-Datei sind in Felder +unterteilt. Diese setzen sich zusammen aus den Feldern der Haupt­ +datei und der einzelnen Koppeldateien, wobei die Koppelfelder je­ +weils nur einmal auftauchen. + 'anzahl felder' liefert die Anzahl der vorhanden Felder. Mit +'feldnamen lesen' und 'feldnamen bearbeiten' können die Feldnamen +abgefragt werden. 'feldnummer' liefert einen Index für einen vor­ +gegebenen Feldnamen, da die Felder immer über Nummern angespro­ +chen werden. + Die Prozeduren 'feld lesen' und 'feld bearbeiten' ermöglichen +den Zugriff auf den Feldinhalt des aktuellen Satzes; durch 'feld +aendern' kann dieser Inhalt abgeändert werden. + +INT PROC anzahl felder + Liefert die Anzahl der vorhanden Felder. + +PROC feldnamen lesen (INT CONST feldnr, + TEXT VAR feldname) + Liefert in 'feldname' den Namen des Feldes mit der Nummer + 'feldnr'. + Bedingung: + 1 <= feldnr <= anzahl felder + +PROC feldnamen bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + Die Prozedur 'bearbeite' wird aufgerufen. Als Parameter werden + ein Text und Anfangs- und Endposition des gewünschten Feld­ + namens in diesem Text übergeben. Verhindert unnötiges Kopie­ + ren des Feldnamens in eine TEXT-Variable. Der übergebene + Text darf nicht verändert werden! + Bedingung: + 1 <= feldnr <= anzahl felder + +INT PROC feldnummer (TEXT CONST feldname) + Liefert den index zu dem angegebenen Feldnamen. Falls ein + solcher Name nicht existiert, wird 0 geliefert. + +PROC feld lesen (INT CONST feldnr, TEXT VAR inhalt) + Liefert den Inhalt des angegebenen Feldes. + Bedingung: + 1 <= feldnr <= anzahl felder + +PROC feld bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + Die Prozedur 'bearbeite' wird aufgerufen. Der Feldinhalt des + angegebenen Feldes steht im übergebenen Text innerhalb der + Grenzen. Ist die Obergrenze kleiner als die Untergrenze, so ist + das Feld leer. + Bedingung: + 1 <= feldnr <= anzahl felder + +PROC feld aendern (INT CONST feldnr, TEXT CONST inhalt) + Ändert den Inhalt des angegebenen Feldes. + Bedingung: + NOT ende der datei + 1 <= feldnr <= anzahl felder + +INT PROC feldinfo (INT CONST feldnummer) + Liefert den Typ des angegebenen Feldes. + Bedingung: + 1 <= feldnummer <= anzahl felder + +PROC notizen lesen (INT CONST nr, TEXT VAR inhalt) + Liest die angegebenen Notizen ('nr' = 1,2,3) aus der ersten + Datei oder der umgeschalteten Koppeldatei. + +PROC notizen aendern (INT CONST nr, TEXT CONST inhalt) + Ändert die Notizen ('nr' = 1,2,3) der ersten Datei oder der um­ + geschalteten Koppeldatei. + + +7.3 Positionierung + +Das virtuelle Dateimodell von EUDAS verfügt ebenfalls über eine +Satzposition, die verändert werden kann. + Durch 'satznummer' wird die aktuelle Satznummer geliefert, +beim Koppeln kann über 'satzkombination' die Reihenfolge der Kop­ +pelkombinationen bestimmt werden. 'dateiende' zeigt an, ob die +Satzposition hinter dem letzten Satz liegt. Mit 'weiter' und 'zurueck' +erfolgt die eigentliche Positionierung. Hier kann außer der Positio­ +nierung um Einzelsätze auch die Positionierung auf den nächsten +ausgewählten oder markierten Satz angefordert werden. Mit 'auf  +satz' schließlich kann ein bestimmter Satz angesprungen werden. + +INT PROC satznummer + Liefert die Nummer des aktuellen Satzes. Die Sätze werden von + 1 an durchnumeriert, wobei über die geketteten Dateien wei­ + tergezählt wird. + Bedingung: + anzahl dateien > 0 + +INT PROC satzkombination + Liefert die laufende Nummer der Koppelkombination des aktuel­ + len Satzes. Wird nur durch 'weiter' im Einzelsatzmodus erhöht. + Normalerweise 1. + Bedingung: + anzahl dateien > 0 + +BOOL PROC dateiende + Gibt an, ob die Satzposition hinter dem letzten Satz liegt. + +PROC weiter (INT CONST modus) + Erhöht die aktuelle Satzposition. Für 'modus' gibt es 3 Möglich­ + keiten: + 1: Falls eine weitere Satzkombination besteht, wird diese ein­ + genommen, sonst zum nächsten Satz. + 2: Zum nächsten durch Suchbedingung ausgewählten Satz. Wird + optimiert. + 3: Zum nächsten markierten Satz. Wird optimiert. + Ist kein Satz mehr vorhanden, wird die Satzposition hinter dem + letzten Satz eingenommen. + Bedingung: + anzahl dateien > 0 + +PROC zurueck (INT CONST modus) + Geht um einen Satz zurück. Die Modusangabe ist wie bei 'wei­ + ter', jedoch wird im Modus 1 keine weitere Satzkombination + ausprobiert. Die Positionierung endet bei Satz 1. + Bedingung: + anzahl dateien > 0 + +PROC auf satz (INT CONST satznr) + Geht auf den angegebenen Satz. Ist 'satznr' < 1, wird auf Satz 1 + positioniert, ist der angegebene Satz nicht vorhanden, wird + hinter den letzten Satz positioniert. Es wird jeweils die erste + Satzkombination eingenommen. + Bedingung: + anzahl dateien > 0 + + +7.4 Änderungen + +Sätze des Dateimodells können eingefügt oder gelöscht werden. +Durch das Einfügen entsteht ein leerer Satz vor dem aktuellen Satz; +alle weiteren Sätze rücken eine Stelle weiter. Beim Löschen wird +dieser Vorgang wieder rückgängig gemacht. + Durch 'satz einfuegen' wird ein Leersatz eingefügt; durch +'satz loeschen' wird der aktuelle Satz gelöscht. + Sätze in gekoppelten Dateien werden grundsätzlich nicht ge­ +löscht; auch beim Einfügen entsteht nicht automatisch ein Leersatz +in den gekoppelten Dateien. Änderungen in den Koppeldateien +(durch 'feld aendern') werden gepuffert. Durch 'aenderungen ein­ +tragen' werden die Änderungen dann in die Koppeldateien eingetra­ +gen. Dabei kann auch ein neuer Satz in die Koppeldatei eingefügt +werden. Bei Positionierungen wird diese Prozedur automatisch auf­ +gerufen. + +PROC satz einfuegen + Fügt vor dem aktuellen Satz einen Leersatz ein. + Bedingung: + anzahl dateien > 0 + +PROC satz loeschen + Löscht den aktuellen Satz. Hat hinter dem letzten Satz keine + Wirkung. + Bedingung: + anzahl dateien > 0 + +PROC aenderungen eintragen + Trägt die gepufferten Änderungen in die Koppeldateien ein. + Dabei können die folgenden Fälle auftreten: + 1. Der Satz in der Koppeldatei wird geändert. + Dies geschieht dann, wenn vorher ein passender Satz in der + Koppeldatei vorhanden war und die Koppelfelder nicht ver­ + ändert wurden. + 2. In der Koppeldatei wird ein neuer Satz eingefügt. + Wenn die Koppelfelder und noch andere Felder einer Datei + geändert wurden, wird in dieser Datei ein neuer Satz einge­ + fügt. + 3. Es wird neu gekoppelt. + Wurden nur die Koppelfelder einer Datei geändert, wird ein + neuer, zu diesen Feldern passender Satz gesucht. Nach + 'aenderungen eintragen' erscheinen unter den Feldern der + Datei die neuen Inhalte. + + +7.5 Suchbedingungen + +Über 'suchbedingung' kann eine Suchbedingung eingetragen werden, +die für jeden Satz geprüft werden soll. Mit 'satz ausgewaehlt' wird +erfragt, ob der aktuelle Satz die Suchbedingung erfüllt. Die Such­ +bedingung kann mit 'suchbedingung loeschen' wieder ausgeschaltet +werden. + Einzelne Sätze können auch markiert werden. Nach einem Öff­ +nen ist zunächst kein Satz markiert. Durch 'markierung  aendern' +kann die Markierung eines Satzes geändert werden. 'satz markiert' +fragt ab, ob der aktuelle Satz markiert ist. 'markierte saetze' liefert +die Anzahl der markierten Sätze. Mit 'markierungen loeschen' wer­ +den alle Markierungen entfernt. + +PROC suchbedingung (INT CONST feldnr, + TEXT CONST bedingung) + Stellt für das angegebene Feld die im Text als Muster angege­ + bene Suchbedingung ein. Weitere Aufrufe verknüpfen die Be­ + dingungen mit UND (auch wenn das gleiche Feld erneut angege­ + ben wird). + Bedingung: + anzahl dateien > 0 + 1 <= feldnr <= anzahl felder + + FEHLER: +#f1# + #on("i")#Suchmuster zu umfangreich#off("i")# + Es wurden zu viele Vergleiche gefordert. + +BOOL PROC satz ausgewaehlt + Gibt an, ob die Suchbedingung auf den aktuellen Satz zutrifft. + Hinter dem letzten Satz wird immer FALSE geliefert. + Bedingung: + anzahl dateien > 0 + +PROC suchbedingung lesen (INT CONST feldnr, TEXT VAR bedingung) + Liefert die zuletzt für das angegebene Feld eingestellte Bedin­ + gung, falls die Suchbedingung nicht gelöscht und keine Datei + neu geöffnet wurde. + Bedingung: + 1 <= feldnr <= anzahl felder + +PROC suchbedingung loeschen + Löscht die eingestellte Suchbedingung wieder. Anschließend + sind alle Sätze ausgewählt. + Bedingung: + anzahl dateien > 0 + +PROC markierung aendern + Ändert die Markierung des aktuellen Satzes ins Gegenteil. + Bedingung: + anzahl dateien > 0 + +BOOL PROC satz markiert + Gibt an, ob der aktuelle Satz markiert ist. + Bedingung: + anzahl dateien > 0 + +INT PROC markierte saetze + Gibt an, wieviel Sätze insgesamt markiert sind. + Bedingung: + anzahl dateien > 0 + +PROC markierungen loeschen + Löscht alle Markierungen. + Bedingung: + anzahl dateien > 0 + diff --git a/app/eudas/4.3/doc/eudas.ref.8 b/app/eudas/4.3/doc/eudas.ref.8 new file mode 100644 index 0000000..fc2b3bc --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.8 @@ -0,0 +1,454 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (83)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +8 Funktionen zur Bearbeitung + + + +Die Verarbeitungsfunktionen arbeiten jeweils auf der aktuell geöff­ +neten Datei. Falls mindestens ein Satz markiert ist, werden nur +markierte Sätze bearbeitet, anderenfalls die durch die Suchbedin­ +gung ausgewählten Sätze. + + +8.1 Drucken + +Zum Drucken wird ein Druckmuster als Textdatei benötigt. Dessen +Name muß beim Aufruf der Prozedur 'drucke' angegeben werden. +Werden beim Übersetzen des Druckmusters Fehler entdeckt, so wird +der Paralleleditor aufgerufen und kein Druckvorgang durchgeführt. + Normalerweise sendet der Druckgenerator die Ausgabe direkt +zum Drucker. Alternativ kann die Ausgabe auch in eine Datei ge­ +schrieben werden. Dieses Verfahren kann mit 'direkt drucken' umge­ +stellt werden. Der Aufruf + + + direkt drucken (TRUE) + + +sendet alle Dateien direkt zum Drucker, mit + + + direkt drucken (FALSE) + + +wird die Ausgabe in Dateien abgelegt. Diese Dateien erhalten Namen +der Form + + + "Druckmustername.a$n" + + +wobei 'n' eine laufende Nummer zur Unterscheidung ist. + Soll die Druckausgabe in eine ganz bestimmte Datei geleitet +werden, so kann vor dem Aufruf von 'drucke' die Prozedur 'druck­ +datei' aufgerufen werden, die als Parameter den Namen der Ausga­ +bedatei erhält. Existiert die Datei noch nicht, wird sie eingerichtet, +ansonsten wird die Ausgabe am Ende angehängt. + Die Einstellung der Ausgabedatei gilt nur für einen Druckvor­ +gang und überschreibt für diesen Druckvorgang 'direkt drucken'. +Beim nächsten Druckvorgang wird wieder die durch 'direkt drucken' +festgelegte Einstellung verwendet. + Wenn beim Drucken ein großes Ausgabevolumen anfällt, kann es +sinnvoll sein, die Ausgabe in mehrere kleine Dateien aufzuteilen. +Dies gilt auch, wenn direkt gedruckt werden soll, da auch in diesem +Fall eine Zwischendatei erzeugt werden muß. Die maximale Anzahl +von Zeilen pro Datei wird durch 'max druckzeilen' angegeben. + Der dort angegeben Wert gilt nur ungefähr - ein Wechsel der +Ausgabedatei findet dann statt, wenn die Ausgabedatei nach Bear­ +beitung eines Satzes die Maximalanzahl überschritten hat. In die +neue Datei wird anschließend zuerst der Initialisierungsteil des +Druckmusters kopiert, ehe mit der Ausgabe des nächsten Satzes +fortgefahren wird. + +Die Prozeduren im einzelnen: + + +PROC drucke (TEXT CONST druckmuster) + + Die aktuell geöffnete Datei wird nach dem angegebenen Druck­ + muster gedruckt. + + FEHLER: +#f1# + #on("i")#Datei "druckmuster" existiert nicht#off("i")# + Das angegebene Druckmuster ist nicht vorhanden. +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Zum Drucken muß eine Datei geöffnet sein. +#f1# + #on("i")#direkt Drucken nicht möglich#off("i")# + Es ist kein Druckprogramm installiert oder der Spooler läßt sich + mit 'print' nicht ansprechen. Der Druck wird abgebrochen, die + Ausgabedatei ist noch vorhanden. + + +PROC direkt drucken (BOOL CONST ja) + + Gibt an, ob die Druckausgaben direkt gedruckt oder in einer + Datei gesammelt werden sollen. + + +PROC druckdatei (TEXT CONST ausgabedatei) + + Leitet die Druckausgabe des nächsten Druckvorgangs in die + Datei 'ausgabedatei'. Die Einstellung von 'direkt drucken' wird + für diesen Druckvorgang überschrieben. Die Ausgabe wird am + Ende der Datei angehängt, falls nötig, wird die Ausgabedatei + vorher eingerichtet. + + +PROC maxdruckzeilen (INT CONST zeilen) + + Stellt die maximale Anzahl von Zeilen für die Ausgabedatei ein. + Beim Überschreiten dieses Wertes wird eine neue Datei ange­ + fangen. Standardwert ist 4000. + + +TEXT PROC lfd nr + + Liefert während des Druckens die laufende Nummer des gerade + gedruckten Satzes als Text. + + +BOOL PROC gruppenwechsel (INT CONST gruppennr) + + Kann innerhalb eines Vor- oder Nachspanns beim Drucken ab­ + gefragt werden, um festzustellen, ob die angegebene Gruppe + gewechselt und damit den Vor- bzw. Nachspann mitverursacht + hat (es können zu einem Zeitpunkt mehrere Gruppen wechseln). + Die Gruppennummer 0 gibt die Standardgruppe an, die nur vor + dem ersten und nach dem letzten Satz wechselt. + + +8.2 Kopieren + +Zum selektiven Kopieren von EUDAS-Dateien wird ein Kopiermuster +benötigt. Dieses gibt die Zuordnung zwischen Feldern der Ziel- und +der Quelldatei an. Die Quelldatei ist immer die aktuell geöffnete +Datei. + Die Kopierfunktion wird durch 'kopiere' aufgerufen. Parameter +sind der Name der Zieldatei und das Kopiermuster als FILE. Alter­ +nativ kann statt des Kopiermusters eine Prozedur übergeben wer­ +den, die die Kopieranweisungen erhält. + Der eigentliche Kopiervorgang wird durch den Operator 'K' +bewirkt. Dieser erhält den Zielfeldnamen und einen TEXT-Aus­ +druck als Parameter. Der Wert des TEXT-Ausdrucks wird in das +jeweilige Feld der Zieldatei geschrieben. + Existiert die Zieldatei noch nicht, so wird sie mit den Feldern +eingerichtet, die in den einzelnen 'K'-Ausdrücken angegeben sind +und zwar in der angeführten Reihenfolge. Existiert die Zieldatei, so +werden gegebenenfalls noch nicht vorhandene Felder am Ende ange­ +fügt. + Die Prozedur 'std kopiermuster' liefert zu einer gegebenen +Zieldatei ein Standard-Muster, das als Auswahlgrundlage dienen +kann. Existiert die Zieldatei nicht, werden alle Felder der Quell­ +datei 1 : 1 kopiert, anderenfalls wird zu jedem Feld der Zieldatei +ein passendes Feld der Quelldatei gesucht - die Feldreihenfolge +richtet sich in diesem Fall nach der Zieldatei. + + +PROC kopiere (TEXT CONST dateiname, + FILE VAR kopiermuster) + + Die aktuell geöffnete Datei wird nach den Angaben in 'kopier­ + muster' in die Datei 'dateiname' kopiert. Das Kopiermuster wird + dem ELAN-Compiler übergeben. Tritt bei der Übersetzung ein + Fehler auf, wird der Paralleleditor aufgerufen. + + FEHLER: +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + + +PROC kopiere (TEXT CONST dateiname, PROC kopierfunktion) + + Wie oben, nur ist die Kopierfunktion gleich als Prozedur vor­ + handen. + + FEHLER: +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + + +OP K (TEXT CONST feldname, ausdruck) + + Kopiert den Ausdruck in das Feld 'feldname' der Zieldatei. + Dieses Feld wird eingerichtet, falls es noch nicht existiert. + Dieser Operator ist nur während eines Kopiervorganges de­ + finiert (also in einem Kopiermuster oder einer Kopierfunktion). + Er darf nicht in einer IF-Klausel stehen, sondern muß bei + jedem Satz mit gleichem Feldnamen an der gleichen Stelle auf­ + gerufen werden. + + +PROC std kopiermuster (TEXT CONST dateiname, + FILE VAR kopiermuster) + + Liefert ein Standard-Kopiermuster, abhängig von der Zieldatei + 'dateiname'. Existiert diese nicht, wird die Quelldatei unverän­ + dert kopiert, ansonsten richtet sich das Kopiermuster nach der + Zieldatei. + + +8.3 Tragen + +Durch Tragen können Sätze komplett in eine Zieldatei transportiert +werden. In der Quelldatei sind sie anschließend nicht mehr vorhan­ +den. Eine ganze Auswahl von Sätzen kann mit 'trage' transportiert +werden. 'trage satz' transportiert nur den aktuellen Satz. Mit +'hole satz' kann der letzte Satz der Zieldatei wieder zurückgeholt +werden, so daß eine EUDAS-Datei auch als Zwischenspeicher für +Einzelsätze verwendet werden kann. + Existiert die Zieldatei bereits, muß sie mindestens so viele +Felder wie die Quelldatei besitzen, damit keine Informationen ver­ +lorengehen können. Die Feldnamen müssen nicht übereinstimmen. +Existiert die Zieldatei noch nicht, wird sie mit den Feldern der +Quelldatei eingerichtet. + Die Tragefunktion kann um eine gleichzeitige Prüfung erweitert +werden. Dabei werden Bedingungen überprüft, die bei der Zieldatei +gespeichert sind. Sätze, die diese Bedingungen verletzen, werden +nicht getragen. Eine entsprechende Meldung wird in eine Protokoll­ +datei geschrieben, die als Parameter übergeben werden muß. + Die Prüfbedingungen stehen als ausführbares Programm in den +Notizen der Zieldatei. Prüfbedingungen können mit mehreren Proze­ +duren formuliert werden. 'pruefe' nimmt eine beliebige Bedingung als +Parameter und gibt bei Mißerfolg eine Meldung aus. 'wertemenge' +prüft auf Übereinstimmung mit einem der angegebenen Werte. 'feld­ +maske' legt eine Maske für ein Feld fest, die auf den Inhalt zutref­ +fen muß. + Mit Hilfe der Prozedur 'eindeutige felder' können Satzduplikate +erkannt werden. Auch diese werden nicht getragen. + Die bei den Prüfbedingungen angegebenen Feldnamen müssen in +der Quelldatei vorhanden sein. Falls eine Prüfprozedur außerhalb +von 'trage' aufgerufen wird, führt eine Verletzung der Prüfbedin­ +gung zu einem 'errorstop'. + + +PROC trage (TEXT CONST dateiname, + FILE VAR protokoll, BOOL CONST test) + + Alle ausgewählten Sätze werden in die Datei 'dateiname' getra­ + gen. Diese wird gegebenenfalls eingerichtet. Falls 'test' ange­ + geben ist, werden die in den Notizen der Zieldatei enthaltenen + Bedingungen geprüft. Nur in diesem Fall muß 'protokoll' initial­ + isiert sein. + + FEHLER: +#f1# + #on("i")#kein Satz zum Tragen vorhanden#off("i")# + Die Quelldatei ist leer oder es ist keine Datei geöffnet. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#Zieldatei hat falsche Felderzahl#off("i")# + Zu wenig Felder in der Zieldatei. + + +PROC trage satz (TEXT CONST dateiname) + + Der aktuelle Satz wird in die Datei 'dateiname' getragen. + + FEHLER: +#f1# + #on("i")#kein Satz zum Tragen vorhanden#off("i")# + Keine Datei geöffnet oder Datei ist am Ende. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#Zieldatei hat falsche Felderzahl#off("i")# + Zu wenig Felder in der Zieldatei. + + +PROC pruefe (TEXT CONST feldname, BOOL CONST bedingung) + + Wenn die angegebene Bedingung FALSE liefert, wird eine Mel­ + dung in die Protokolldatei geschrieben und der jeweilige Satz + nicht getragen. + + +PROC wertemenge (TEXT CONST feldname. menge) + + Es wird geprüft, ob das angegebene Feld in der Wertemenge + enthalten ist. Die einzelnen Werte in der Wertemenge werden + dabei durch Komma getrennt. Leerzeichen sind signifikant. + + +PROC feldmaske (TEXT CONST feldname, maske) + + Es wird geprüft, ob das angegebene Feld zu der Maske paßt. Die + Zeichen in der Maske haben dabei folgende Bedeutung: + '9' trifft auf jede Ziffer zu + 'X' trifft auf jedes Zeichen zu + 'A' trifft auf jeden Großbuchstaben zu (einschließlich + Umlaute) + 'a' trifft auf jeden Kleinbuchstaben zu (einschließlich + Umlaute und 'ß') + '*' trifft auf eine Folge beliebiger Zeichen zu (auch die + leere Folge). Eine sparsame Verwendung wird empfoh­ + len, da die Bearbeitung sehr aufwendig ist. + Alle anderen Zeichen treffen nur auf ein gleiches Zeichen zu. + + +PROC eindeutige felder (INT CONST anzahl) + + Gibt an, die wieviel ersten Felder einen Satz eindeutig identifi­ + zieren sollen. Ein Satz, der mit einem Satz der Datei in diesen + Feldern übereinstimmt, wird nicht getragen. Ohne diese Angabe + wird keine derartige Prüfung vorgenommen. + + +PROC hole satz (TEXT CONST dateiname) + + Holt den letzten Satz der angegebenen Datei und fügt ihn vor + dem aktuellen Satz ein. + + FEHLER: +#f1# + #on("i")#"dateiname" existiert nicht#off("i")# +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#Zieldatei hat falsche Felderzahl#off("i")# + Zu viele Felder in der angegebenen Datei. +#f1# + #on("i")#Kein Satz zum Tragen vorhanden#off("i")# + Die angegebene Datei ist leer. +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + + +8.4 Verarbeitung + +Die ausgewählten Sätze der aktuellen Datei können nach einer +Verarbeitungsvorschrift verändert oder geprüft werden. Dies ge­ +schieht durch die Prozedur 'verarbeite'. Als Parameter kann ent­ +weder ein Verarbeitungsmuster als FILE oder die Verarbeitungs­ +funktion direkt als Prozedur übergeben werden. + Die Vorschrift wird durch den Operator 'V' realisiert. + + +PROC verarbeite (FILE VAR verarbeitungsmuster) + + Die aktuelle Datei wird nach dem angegebenen Muster bearbei­ + tet. Enthält die Vorschrift, die dem ELAN-Compiler übergeben + wird, einen Fehler, wird der Paralleleditor aufgerufen. + + FEHLER: +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + + +PROC verarbeite (PROC verarbeitungsfunktion) + + Wie oben, nur wird die Vorschrift direkt als Prozedur überge­ + ben. + + FEHLER: +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + + +OP V (TEXT CONST feldname, ausdruck) + + Das angegebene Feld des aktuellen Satzes wird durch den Aus­ + druck ersetzt. + + FEHLER: +#f1# + #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# + Das angegebene Feld ist nicht vorhanden. + + +8.5 Funktionen in Ausdrücken + +Für Ausdrücke bei den in diesem Kapitel beschriebenen Prozeduren +sind einfache Funktionen zur Abfrage von Feldinhalten vorhanden. +Mit 'f' kann der Inhalt eines benannten Feldes erfragt werden, bei +'wert' wird der Inhalt erst in eine REAL-Zahl umgewandelt, wobei +nichtnumerische Zeichen ignoriert werden. + Die Prozedur 'textdarstellung' kann dazu verwendet werden, +den Wert einer TEXT-Variablen als TEXT-Denoter in ELAN-Syntax +darzustellen. + Die Prozedur 'zahltext' kann dazu verwendet werden, aus einer +REAL-Zahl einen mit der richtigen Zahl von Nachkommastellen ver­ +sehenen, variabel langen Text zu machen. + + +TEXT PROC f (TEXT CONST feldname) + + Liefert den Inhalt des angegebenen Feldes. + + FEHLER: +#f1# + #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# + + +REAL PROC wert (TEXT CONST feldname) + + Liefert den Inhalt des angegebenen Feldes als REAL. Dabei + werden nichtnumerische Zeichen ignoriert, ausgenommen das + Minuszeichen und das eingestellte Dezimalkomma (s. 'dezimal­ + komma'). Tritt kein numerisches Zeichen auf, wird der Wert 0.0 + geliefert. + + FEHLER: +#f1# + #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# + + +REAL PROC wert (TEXT CONST feldname, INT CONST kommastellen) + + Wie 'wert' mit einem Parameter, nur daß das Ergebnis auf die + angegebene Anzahl von Nachkommastellen gerundet wird. + + FEHLER: +#f1# + #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# + + +TEXT PROC textdarstellung (TEXT CONST anzeigetext) + + Liefert 'anzeigetext' als TEXT-Denoter, also in Anführungs­ + strichen. Anführungsstriche im Text werden dabei verdoppelt. + Steuerzeichen von 0 bis 31 werden in lesbare Form gebracht. + + +TEXT PROC zahltext (REAL CONST wert, INT CONST kommastellen) + + Liefert den Text des angegebenen Werts mit dem eingestellten + Dezimalkomma und mit der angegebenen Zahl von Nachkomma­ + stellen. Sind die Kommastellen 0, wird auch das Komma unter­ + drückt. Der Text erhält soviel Stellen, wie zur Darstellung + benötigt werden. + + +TEXT PROC zahltext (TEXT CONST feldname, + INT CONST kommastellen) + + Wirkt wie 'zahltext (wert (feldname), kommastellen)'. + diff --git a/app/eudas/4.3/doc/eudas.ref.9 b/app/eudas/4.3/doc/eudas.ref.9 new file mode 100644 index 0000000..dc2dd0d --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.9 @@ -0,0 +1,194 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (93)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +9 Anzeige + + + +9.1 Fensterverwalter + +Funktionen, die einen Teil des Bildschirms in einem rechteckigen +Fenster beschreiben, werden über den Fensterverwalter untereinan­ +der koordiniert. Jede Funktion fordert für ihren Fensterbereich eine +Variable vom Typ FENSTER an. Vor jedem Bildschirmzugriff kann die +Funktion erfahren, ob andere Programme den Bildschirm im Fenster­ +bereich überschrieben haben. Gleichzeitig meldet sie damit Verän­ +derungen an anderen Fenstern an, die sich mit dem eigenen über­ +schneiden. + + +PROC fenster initialisieren (FENSTER VAR neu) + + Jede Fenstervariable muß vor Benutzung initialisiert werden. + + +PROC fenstergroesse setzen (FENSTER VAR fenster, + INT CONST x anf, y anf, + x laenge, y laenge) + + Die Fenstergröße des Fensters wird gesetzt. 'x anf' und 'y anf' + werden von 1..n gezählt. Die Größe eines 24x80-Bildschirms + entspricht den Angaben (1, 1, 79, 24). Da das letzte Zeichen + einer Zeile wegen Rollgefahr nicht benutzt werden kann, werden + nur 79 Spalten angegeben. + + FEHLER: + + #on("i")#zu viele Fenster#off("i")# + Es sind nur 16 verschiedene Fenstergrößen möglich. + + +PROC fenstergroesse (FENSTER CONST fenster, + INT VAR x anf, y anf, + x laenge, y laenge) + + Meldet die eingestellte Größe des Fensters. + + +PROC fensterzugriff (FENSTER CONST mein fenster, + BOOL VAR veraendert) + + Ein Zugriff auf 'mein fenster' wird angemeldet. 'veraendert' gibt + an, ob das Fenster seit dem letzten Zugriff durch einen über­ + schneidenden Zugriff verändert wurde. Beim ersten Zugriff ist + 'veraendert' immer TRUE. + + +PROC fenster veraendert (FENSTER CONST fenster) + + Falls ein Unterprogramm eine FENSTER-Variable des Hauptpro­ + grammes benutzt, kennzeichnet das Unterprogramm das Fenster + mit dieser Prozedur als benutzt, damit das Hauptprogramm das + Bild neu ausgibt. + + +PROC bildschirm neu + + Gibt an, daß der Bildschirm von einer Funktion benutzt wurde, + die ihre Zugriffe nicht über den Fensterverwalter anmeldet. + Alle Fenster werden als verändert gekennzeichnet. + + +9.2 Anzeigegrundfunktionen + +Sämtliche Anzeigefunktionen werden in einem Fenster abgewickelt, +dessen Größe durch 'anzeigefenster' bestimmt wird. + Die Funktion 'bildausgeben' übernimmt die eigentliche Ausgabe. +Dabei kann durch Parameter mitgeteilt werden, ob sich an der Datei +außer der Markierung etwas geändert hat. Hat sich nichts geändert, +wird zur Optimierung unter Umständen nur die Markierung neu +ausgegeben. Das Bild wird jedoch auf jeden Fall ganz ausgegeben, +wenn das Fenster von anderer Seite verändert wurde. Auch das +Öffnen einer neuen Datei wird automatisch erkannt und richtig +behandelt. + Welche Felder dargestellt werden sollen, kann durch 'feldaus­ +wahl' angegeben werden. Dabei ist für jeden Anzeigemodus eine +eigene Feldauswahl möglich. Die Darstellung kann durch 'rollen' in +vertikaler Richtung verschoben werden. + Mit 'uebersicht' kann die Übersicht ausgegeben werden. Ihre +Größe wird durch 'uebersichtsfenster' angegeben. + + +PROC anzeigefenster (INT CONST x anf, y anf, + x laenge, y laenge) + + Das Anzeigefenster wird in der entsprechenden Größe reser­ + viert. + + FEHLER: + + #on("i")#Anzeigefenster zu klein#off("i")# + Das Fenster ist zu schmal (< 40 Zeichen), um eine sinnvolle + Anzeige zuzulassen. + + +PROC bild ausgeben (BOOL CONST datei veraendert) + + Im Anzeigefenster wird das Bild je nach eingestelltem Modus + ausgegeben, wenn das Fenster verändert wurde oder 'satz ver­ + aendert' TRUE ist. 'satz veraendert' muß immer dann angegeben + werden, wenn am Inhalt der virtuellen Datei etwas verändert + wurde. + + +PROC feldauswahl (TEXT CONST feldcode) + + Die im aktuellen Modus anzuzeigenden Felder und ihre Reihen­ + folge werden ausgewählt. Dabei enthält 'feldcodes' an der i-ten + Stelle den Code der Feldnummer des Feldes, das an i-ter Posi­ + tion erscheinen soll. + + +PROC rollen (INT CONST anzahl) + + Die Darstellung wird um die angegebene Anzahl von Zeilen + gerollt. Bei einer positiven Angabe wird zu höheren Feld- bzw. + Satznummern gerollt (Bild bewegt sich umgekehrt). Beim ersten + bzw. letzten Feld bzw. Satz hört das Rollen automatisch auf. + + +PROC uebersichtsfenster (INT CONST x anf, y anf, + x laenge, y laenge) + + Legt die Größe des Übersichtsfensters fest. + + +PROC uebersicht (TEXT CONST feldauswahl) + + Ruft eine Übersicht der aktuellen Datei auf, in der geblättert + und markiert werden kann. In 'feldauswahl' steht an der Stelle + i der Code der Feldnummer, die als i-tes in der Aufzählung + erscheinen soll. + + +9.3 Editorfunktionen + +Es stehen drei Funktionen zur Verfügung, die den Editor im Anzei­ +gemodus benutzen. Sie dienen zum Einfügen und Ändern sowie zum +Eingeben eines Suchmusters. + Der Editor wird durch ESC 'q' verlassen. Weitere ESC-Funk­ +tionen, die zum Verlassen führen sollen, können durch 'exit zeichen' +angegegeben und nach Funktionsausführung mit 'exit durch' abge­ +fragt werden. + + +PROC aendern (PROC hilfe) + + Bietet den aktuellen Satz zum Ändern an. Steht die virtuelle + Datei am Ende, wird automatisch 'einfuegen' durchgeführt. Bei + ESC '?' wird 'hilfe' aufgerufen. + + +PROC einfuegen (PROC hilfe) + + Fügt vor dem aktuellen Satz einen Satz ein, dessen Inhalt im + Editor angegeben wird. Bei ESC '?' wird 'hilfe' aufgerufen. + + +PROC suchen (PROC hilfe) + + Im Editor wird eine neue Suchbedingung eingegeben. Bei ESC '?' + wird 'hilfe' aufgerufen. + + +PROC exit durch (TEXT CONST zeichenkette) + + Gibt die Zeichen an, die beim Drücken nach ESC zum Verlassen + des Editors führen sollen. Die eingegebenen Daten werden je­ + doch vorher auf jeden Fall noch verarbeitet. + + +TEXT PROC exit durch + + Gibt an, durch welches Zeichen der Editor verlassen wurde. + diff --git a/app/eudas/4.3/doc/eudas.ref.fehler b/app/eudas/4.3/doc/eudas.ref.fehler new file mode 100644 index 0000000..736d009 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.fehler @@ -0,0 +1,139 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (115)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +Fehlermeldungen + + + +In diesem Kapitel sind alle Fehlermeldungen aufgeführt, die von +EUDAS erzeugt werden und zum Abbruch einer Funktion führen +können. + +#on("i")#'n' ist keine Feldnummer#off("i")# + Es wurde eine Nummer als Feldnummer angegeben, die nicht er­ + laubt ist. + +#on("i")#Datei ist keine EUDAS-Datei#off("i")# + Es wurde versucht, eine andere Datei als EUDAS-Datei zu bear­ + beiten. + +#on("i")#inkonsistente EUDAS-Datei#off("i")# + Die interne Struktur der Datei ist zerstört. Kann durch Hardware­ + probleme (Archiv-Lesefehler) oder EUDAS-interne Fehler ent­ + standen sein. + +#on("i")#EUDAS-Datei voll#off("i")# + Eine EUDAS-Datei kann nur eine bestimmte Anzahl von Sätzen + aufnehmen (mindestens 5000). + +#on("i")#Nicht erlaubtes Dezimalkomma#off("i")# + Als Dezimalkomma kann nur ein einzelnes Zeichen angegeben + werden. + +#on("i")#Zuviel Dateien geoeffnet#off("i")# + Es können nicht mehr als 10 Dateien gleichzeitig geöffnet, geket­ + tet und gekoppelt sein. + +#on("i")#Zu viele Felder#off("i")# + Alle geöffneten Dateien zusammen dürfen nicht mehr als 256 + Felder der virtuellen Datei ergeben. + +#on("i")#Zu viele Koppelfelder#off("i")# + Es dürfen insgesamt nicht mehr als 32 Koppelfelder entstehen. + +#on("i")#keine Koppelfelder vorhanden#off("i")# + Eine Datei kann nicht gekoppelt werden, wenn Sie kein Koppelfeld + besitzt. + +#on("i")#keine Datei geoeffnet#off("i")# + Es kann nicht gekettet oder gekoppelt werden, wenn noch keine + Datei geöffnet wurde. Ebenfalls sind keine Verarbeitungsproze­ + duren möglich. + +#on("i")#Nicht möglich, wenn auf Koppeldatei geschaltet#off("i")# + Wenn auf eine Koppeldatei umgeschaltet wurde, ist Öffnen, Ketten + und Koppeln nicht möglich. + +#on("i")#kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien#off("i")# + Wenn Dateien gekettet oder gekoppelt sind, ist Sortieren und + Ändern der Feldstruktur nicht möglich. + +#on("i")#Datei nicht gesichert#off("i")# + Eine vorher geöffnete Datei ist verändert und nicht gesichert. + +#on("i")#Datei wird von anderer Task geändert#off("i")# + Das Öffnen der Datei zum Ändern ist im Moment nicht möglich, da + ein anderer Benutzer sie bereits ändert. + +#on("i")#Suchmuster zu umfangreich#off("i")# + Ein Suchmuster darf nicht mehr als 100 Vergleiche erfordern. + +#on("i")#direkt Drucken nicht moeglich#off("i")# + Entweder ist kein Druckprogramm installiert oder die Spooltask + reagiert nicht. + +#on("i")#Das Feld "Feldname" ist nicht definiert#off("i")# + Sie haben einen falschen Namen angegeben. + +#on("i")#Kein Satz zum Tragen vorhanden#off("i")# + Es wurde versucht, aus einer leeren Datei oder am Dateiende zu + tragen. + +#on("i")#Zieldatei hat falsche Felderzahl#off("i")# + Eine Zieldatei beim Tragen hat weniger Felder als die aktuelle + Datei. Daher würden beim Tragen Informationen verlorengehen. + +#on("i")#Zieldatei darf nicht geöffnet sein#off("i")# + Eine geöffnete Datei ist als Zieldatei nicht zulässig. + +#on("i")#Das Feld "Feldname" verletzt die Pruefbedingung#off("i")# + Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und + die Bedingung war nicht erfüllt. + +#on("i")#Das Feld "Feldname" ist nicht in der Wertemenge#off("i")# + Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und + die Bedingung war nicht erfüllt. + +#on("i")#Das Feld "Feldname" stimmt nicht mit der Maske ueberein#off("i")# + Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und + die Bedingung war nicht erfüllt. + +#on("i")#Zu viele Fenster#off("i")# + Es sind nicht mehr als 16 verschiedene Größen von Fenstern + möglich. + +#on("i")#Fenster zu klein#off("i")# + Ein Menü wurde in einem zu kleinen Fenster aufgerufen. + +#on("i")#Hilfe existiert nicht#off("i")# + Es wurde versucht, eine nicht vorhandene Hilfestellung aufzu­ + rufen. + +#on("i")#Hilfe ist leer#off("i")# + Die angewählte Hilfestellung enthält keinen Text. + +#on("i")#Anzeigefenster zu klein#off("i")# + Das Anzeigefenster muß mindestens 40 Zeichen breit sein. + +#on("i")#Ungueltige Satznummer#off("i")# + Der angegebene Text stellt keine Satznummer dar. + +#on("i")#kein rekursiver Aufruf#off("i")# + Innerhalb von EUDAS darf 'eudas' nicht erneut aufgerufen wer­ + den. + +#on("i")#Task existiert nicht#off("i")# + Es wurde versucht, eine nicht existente Task als Manager einzu­ + stellen. + + diff --git a/app/eudas/4.3/doc/eudas.ref.inhalt b/app/eudas/4.3/doc/eudas.ref.inhalt new file mode 100644 index 0000000..ae997cb --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.inhalt @@ -0,0 +1,120 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (3)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +Inhalt + + + + Vorwort . . . . . . . . . . . . . . . . . . . i + Inhalt . . . . . . . . . . . . . . . . . . . . iii + + +I. Funktionen zum Nachschlagen + +#on("b")#1 Zustände und Bedienung#off("b")# +#free (0.2)# +1.1 Zustände . . . . . . . . . . . . . . . . . . . 3 +1.2 Menüs . . . . . . . . . . . . . . . . . . . . 8 +1.3 Auswahl . . . . . . . . . . . . . . . . . . . 8 +1.4 Hilfe und Dialog . . . . . . . . . . . . . . . 9 +1.5 Editor . . . . . . . . . . . . . . . . . . . . 9 + +#on("b")#2 Zusammenstellung der Funktionen#off("b")# +#free (0.2)# +2.1 Menü 'Öffnen' . . . . . . . . . . . . . . . . 13 +2.2 Menü 'Einzelsatz' . . . . . . . . . . . . . . 17 +2.3 Menü 'Gesamtdatei' . . . . . . . . . . . . . . 21 +2.4 Menü 'Drucken' . . . . . . . . . . . . . . . . 23 +2.5 Menü 'Dateien' . . . . . . . . . . . . . . . . 25 +2.6 Menü 'Archiv' . . . . . . . . . . . . . . . . 27 +2.7 Kurzabfrage . . . . . . . . . . . . . . . . . 29 + +#on("b")#3 Das virtuelle Dateimodell#off("b")# +#free (0.2)# +3.1 Dateistruktur . . . . . . . . . . . . . . . . 31 +3.2 Öffnen . . . . . . . . . . . . . . . . . . . . 32 +3.3 Koppeln . . . . . . . . . . . . . . . . . . . 33 +3.4 Änderungen . . . . . . . . . . . . . . . . . . 34 +3.5 Sichern . . . . . . . . . . . . . . . . . . . 36 +3.6 Umschalten auf Koppeldatei . . . . . . . . . . 36 +3.7 Mehrbenutzerbetrieb . . . . . . . . . . . . . 37 + +#on("b")#4 Ansehen und Bearbeiten#off("b")# +#free (0.2)# +4.1 Anzeige . . . . . . . . . . . . . . . . . . . 39 +4.2 Satzauswahl . . . . . . . . . . . . . . . . . 42 +4.3 Sortieren und Reorganisieren . . . . . . . . . 44 +4.4 Bearbeiten . . . . . . . . . . . . . . . . . . 46 + +#on("b")#5 Drucken und Druckmuster#off("b")# +#free (0.2)# +5.1 Druckmustersyntax . . . . . . . . . . . . . . 49 +5.2 Der Druckvorgang . . . . . . . . . . . . . . . 51 +5.3 Interpretation von Musterzeilen . . . . . . . 52 +5.4 Anschluß zum ELAN-Compiler . . . . . . . . . . 56 +5.5 Fehlermeldungen . . . . . . . . . . . . . . . 57 + + +II. EUDAS für Programmierer + +#on("b")#6 Struktur von EUDAS-Dateien#off("b")# +#free (0.2)# +6.1 Der Datentyp SATZ . . . . . . . . . . . . . . 61 +6.2 Der Datentyp EUDAT . . . . . . . . . . . . . . 63 +6.3 Satzposition . . . . . . . . . . . . . . . . . 64 +6.4 Satzzugriffe . . . . . . . . . . . . . . . . . 65 +6.5 Sortieren und Reorganisieren . . . . . . . . . 66 +6.6 EUDAS-Dateien als Assoziativspeicher . . . . . 68 + +#on("b")#7 Verwaltung der offenen Dateien#off("b")# +#free (0.2)# +7.1 Dateiverwaltung . . . . . . . . . . . . . . . 71 +7.2 Feldstruktur . . . . . . . . . . . . . . . . . 75 +7.3 Positionierung . . . . . . . . . . . . . . . . 77 +7.4 Änderungen . . . . . . . . . . . . . . . . . . 78 +7.5 Suchbedingungen . . . . . . . . . . . . . . . 79 + +#on("b")#8 Funktionen zur Bearbeitung#off("b")# +#free (0.2)# +8.1 Drucken . . . . . . . . . . . . . . . . . . . 83 +8.2 Kopieren . . . . . . . . . . . . . . . . . . . 85 +8.3 Tragen . . . . . . . . . . . . . . . . . . . . 87 +8.4 Verarbeitung . . . . . . . . . . . . . . . . . 89 +8.5 Funktionen in Ausdrücken . . . . . . . . . . . 90 + +#on("b")#9 Anzeige#off("b")# +#free (0.2)# +9.1 Fensterverwalter . . . . . . . . . . . . . . . 93 +9.2 Anzeigegrundfunktionen . . . . . . . . . . . . 94 +9.3 Editorfunktionen . . . . . . . . . . . . . . . 95 + +#on("b")#10 Programmierung der Menüs#off("b")# +#free (0.2)# +10.1 Menüformat . . . . . . . . . . . . . . . . . . 97 +10.2 Verwaltung der Menüs . . . . . . . . . . . . . 99 +10.3 Aufruf . . . . . . . . . . . . . . . . . . . . 101 +10.4 Dialog . . . . . . . . . . . . . . . . . . . . 103 + +#on("b")#11 Programmierung von Anwendungen#off("b")# +#free (0.2)# +11.1 Musterprogramme . . . . . . . . . . . . . . . 105 +11.2 Dateianwendungen . . . . . . . . . . . . . . . 109 +11.3 Integrierte Anwendungen . . . . . . . . . . . 111 + + +III. Anhang + + Fehlermeldungen . . . . . . . . . . . . . . . 115 + Prozeduren mit Parametern . . . . . . . . . . 119 + Register . . . . . . . . . . . . . . . . . . . 125 + diff --git a/app/eudas/4.3/doc/eudas.ref.macros b/app/eudas/4.3/doc/eudas.ref.macros new file mode 100644 index 0000000..1d24468 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.macros @@ -0,0 +1,73 @@ +#*format# +#limit (13.5)##start (3.5,2.5)##pagelength (21.0)##block# +#:firsthead (false)# +#linefeed (1.07)# +#*macro end# +#*text# +#type ("prop10")# +#linefeed (1.07)# +#*macro end# +#*beispiel# +#type ("12")# +#linefeed (0.97)# +#*macro end# +#*bildschirm# +#type ("15")# +#linefeed(0.83)# +#*macro end# +#*proc# +#type ("12")# +#*macro end# +#*endproc# +#free (0.1)# +#type ("prop10")# +#linefeed (1.07)# +#*macro end# +#*abschnitt ($1,$2,$3)# +#headodd# +#on("b")#$1#right#$3 %#off("b")# +#free (1.0)# +#end# +#on("b")##ib(9)#$1#ie(9,"   $3")# $2#off("b")# +#*macro end# +#*char($1)# +$1 +#*macro end# +#*kapitel ($1,$2,$3,$4)# +#free (1.3)# +#"nlq"# +#type("roman.24")# +#on("b")##center#$1#off("b")# +#free (0.2)# +#type ("roman.18")# +#on("b")##center#$2 #off("b")# +#on("b")##center# $3#off("b")# +#on("b")##center#$4#off("b")# +#type ("prop10")# +#free (0.6)# +#headeven# +#on("b")#% $2 $3 $4#off("b")# +#free (1.0)# +#end# +#headodd# +#right##on("b")#%#off("b")# +#free (1.0)# +#end# +#*macro end# +#*f2# +#free (0.2)# +#*macro end# +#*a ($1)# +#on("b")#$1.#off("b")#  +#*macro end# +#*bsp ($1)# +#type("12")#$1#type("prop")# +#*macro end# +#*f1# +#free (0.1)# +#*macro end# + + + + + diff --git a/app/eudas/4.3/doc/eudas.ref.proz b/app/eudas/4.3/doc/eudas.ref.proz new file mode 100644 index 0000000..2007bc1 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.proz @@ -0,0 +1,205 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (119)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +Prozeduren mit Parametern + + + + +:= (SATZ VAR, SATZ CONST) 6.1 + +aendern (PROC hilfe) 9.3 +aendern erlaubt : BOOL 7.1 +aenderungen eintragen 7.4 +anzahl dateien : INT 7.1 +anzahl felder : INT 7.2 +anzahl koppeldateien : INT 7.1 +anzeigefenster (INT CONST x anf, y anf, + x laenge, y laenge) 9.2 +auf satz (EUDAT VAR, INT CONST satznr) 6.3 +auf satz (EUDAT VAR, TEXT CONST muster) 6.3 +auf satz (INT CONST satznr) 7.3 +ausfuehrtaste (TEXT CONST taste) 10.3 +auswahl anbieten (TEXT CONST name, FENSTER CONST f, + TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) 10.3 + +bild ausgeben (BOOL CONST datei veraendert) 9.2 +bildschirm neu 9.1 + +dateiende (EUDAT CONST) : BOOL 6.3 +dateiende : BOOL 7.3 +dateien loeschen (BOOL CONST auch geaenderte) 7.1 +dateiversion : INT 7.1 +dezimalkomma (TEXT CONST komma) 6.5 +dezimalkomma : TEXT 6.5 +dialog 10.4 +dialogfenster (INT CONST x anf, y anf, + x laenge, y laenge) 10.4 +direkt drucken (BOOL CONST ja) 8.1 +druckdatei (TEXT CONST dateiname) 8.1 +drucke (TEXT CONST mustername) 8.1 + +editget (TEXT CONST prompt, TEXT VAR eingabe, + TEXT CONST res, hilfe) 10.4 +eindeutige felder (INT CONST anzahl) 8.3 +einfuegen (PROC hilfe) 9.3 +eudas dateiname (INT CONST dateinr) : TEXT 7.1 +EUDAT 6.2 +exit durch (TEXT CONST exit zeichen) 9.3 +exit durch : TEXT 9.3 + +f (TEXT CONST feldname) : TEXT 8.5 +fehler ausgeben 10.4 +feld aendern (SATZ VAR, INT CONST feldnr, + TEXT CONST inhalt) 6.1 +feld aendern (EUDAT VAR, INT CONST feldnr, + TEXT CONST inhalt) 6.4 +feld aendern (INT CONST feldnr, TEXT CONST inhalt) 7.2 +feldauswahl (TEXT CONST feldcodes) 9.2 +feld bearbeiten (SATZ CONST, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 6.1 +feld bearbeiten (EUDAT CONST, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 6.4 +feld bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 7.2 +felderzahl (SATZ CONST) : INT 6.1 +felderzahl (EUDAT CONST) : INT 6.2 +feldindex (SATZ CONST, TEXT CONST muster) : INT 6.1 +feldinfo (EUDAT VAR, INT CONST feldnr, info) 6.5 +feldinfo (EUDAT CONST, INT CONST feldnr) : INT 6.5 +feld lesen (SATZ CONST, INT CONST feldnr, + TEXT VAR inhalt) 6.1 +feld lesen (EUDAT CONST, INT CONST feldnr, + TEXT VAR inhalt) 6.4 +feld lesen (INT CONST feldnr, TEXT VAR inhalt) 7.2 +feldmaske (TEXT CONST feldname, maske) 8.3 +feldnamen aendern (EUDAT VAR, SATZ CONST namen) 6.2 +feldnamen bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 7.2 +feldnamen lesen (EUDAT CONST, SATZ VAR namen) 6.2 +feldnamen lesen (INT CONST feldnr, TEXT VAR name) 7.2 +feldnummer (TEXT CONST feldname) : INT 7.2 +FENSTER 9.1 +fenstergroesse (FENSTER CONST f, + INT VAR x anf, y anf, + x laenge, y laenge) 9.1 +fenstergroesse setzen (FENSTER VAR fenster, + INT CONST x anf, y anf, + x laenge, y laenge) 9.1 +fenster initialisieren (FENSTER VAR fenster) 9.1 +fenster veraendert (FENSTER CONST fenster) 9.1 +fensterzugriff (FENSTER CONST fenster, + BOOL VAR veraendert) 9.1 + +global manager 10.2 +gruppenwechsel (INT CONST gruppennr) : BOOL 8.1 + +hilfe anbieten (TEXT CONST name, FENSTER CONST f) 10.3 +hole satz (TEXT CONST dateiname) 8.3 + +inhalt veraendert (INT CONST dateinr) : BOOL 7.1 +ja (TEXT CONST frage, hilfe) : BOOL 10.4 + +K (TEXT CONST feldname, ausdruck) 8.2 +kette (TEXT CONST dateiname) 7.1 +kopiere (TEXT CONST dateiname, FILE VAR muster) 8.2 +kopiere (TEXT CONST dateiname, PROC kopierfunktion) 8.2 +kopple (TEXT CONST dateiname) 7.1 + +lfd nr : TEXT 8.1 + +markierte saetze : INT 7.5 +markierung aendern 7.5 +markierungen loeschen 7.5 +maxdruckzeilen (INT CONST anzahl zeilen) 8.1 +menue anbieten (ROW 6 TEXT CONST menuenamen, + FENSTER VAR f, + BOOL CONST esc erlaubt, + PROC (INT CONST, INT CONST) interpreter) 10.3 +menuedaten einlesen (TEXT CONST dateiname) 10.2 +menue loeschen (TEXT CONST name, INT CONST index) 10.2 +menue loeschen (BOOL CONST hilfen reduzieren) 10.2 +menue manager (DATASPACE VAR ds, + INT CONST order, phase, + TASK CONST order task) 10.2 +menuenamen (INT CONST index) : THESAURUS 10.2 + +neuer dialog 10.4 +notizen aendern (EUDAT VAR, INT CONST notiz nr, + TEXT CONST notizen) 6.2 +notizen lesen (EUDAT CONST, INT CONST notiz nr, + TEXT VAR notizen) 6.2 + +oeffne (EUDAT VAR, TEXT CONST dateiname) 6.2 +oeffne (TEXT CONST dateiname, + BOOL CONST aendern erlaubt) 7.1 + +pruefe (TEXT CONST feldname, BOOL CONST bedingung) 8.3 + +reorganisiere (TEXT CONST dateiname) 6.5 +rollen (INT CONST anzahl) 9.2 + +saetze (EUDAT CONST) : INT 6.3 +SATZ 6.1 +satz aendern (EUDAT VAR, SATZ CONST neuer satz) 6.4 +satz ausgewaehlt : BOOL 7.5 +satz einfuegen (EUDAT VAR, SATZ CONST satz) 6.4 +satz einfuegen 7.4 +satz initialisieren (SATZ VAR satz) 6.1 +satzkombination : INT 7.3 +satz lesen (EUDAT CONST, SATZ VAR satz) 6.4 +satz loeschen (EUDAT VAR) 6.4 +satz loeschen 7.4 +satz markiert : BOOL 7.5 +satznr (EUDAT CONST) : INT 6.3 +satznummer : INT 7.3 +sichere (INT CONST dateinr, TEXT CONST dateiname) 7.1 +sortiere (EUDAT VAR, TEXT CONST reihenfolge) 6.5 +sortiere (EUDAT VAR) 6.5 +sortierreihenfolge (EUDAT CONST) : TEXT 6.5 +status anzeigen (TEXT CONST zeile) 10.3 +std kopiermuster (TEXT CONST dateiname, FILE VAR f) 8.2 +suchbedingung (INT CONST feldnr, + TEXT CONST bedingung) 7.5 +suchbedingung loeschen 7.5 +suchen (PROC hilfe) 9.3 + +textdarstellung (TEXT CONST text) : TEXT 8.5 +trage (TEXT CONST dateiname, FILE VAR protokoll, + BOOL CONST test) 8.3 +trage satz (TEXT CONST dateiname) 8.3 + +unsortierte saetze (EUDAT CONST) : INT 6.5 + +V (TEXT CONST feldname, ausdruck) 8.4 +verarbeite (FILE VAR verarbeitungsmuster) 8.4 +verarbeite (PROC verarbeitungsfunktion) 8.4 + +waehlbar (INT CONST menuenr, funktionsnr, + BOOL CONST moeglich) 10.3 +wahl (INT CONST stelle) : INT 10.3 +weiter (EUDAT VAR) 6.3 +weiter (EUDAT VAR, TEXT CONST muster) 6.3 +weiter (INT CONST modus) 7.3 +wert (TEXT CONST feldname) : REAL 8.5 +wert (TEXT CONST feldname, INT CONST kommastellen) : REAL 8.5 +wertemenge (TEXT CONST feldname, menge) 8.3 + +zahltext (REAL CONST wert, INT CONST kommastellen) : TEXT 8.5 +zahltext (TEXT CONST feldname, + INT CONST kommastellen) : TEXT 8.5 +zurueck (EUDAT VAR) 6.3 +zurueck (EUDAT VAR, TEXT CONST muster) 6.3 +zurueck (INT CONST modus) 7.3 + diff --git a/app/eudas/4.3/doc/eudas.ref.reg b/app/eudas/4.3/doc/eudas.ref.reg new file mode 100644 index 0000000..a34307a --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.reg @@ -0,0 +1,436 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (125)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +Register + + + +#columns (2, 0.5)# +#limit (6.5)# +ABKUERZUNGEN-Anweisung 49 +Abkürzungsteil 49 +Abkürzungsverzeichnis 68 +Abkürzungszeile 50 +Abschlußzeile 39 +aendern 96 +Ändern 10, 19 + -, nach Vorschrift 48 +aendern erlaubt 74 +Änderungen 34 +aenderungen eintragen 79 +Änderungsmuster 21 +Alternative 43 +Ankreuzen 8 +anzahl dateien 74 +anzahl felder 75 +anzahl koppeldateien 74 +Anzeige 39, 93 +anzeigefenster 95 +Arbeitskopie 13, 32 + -, löschen 15, 36 + -, sichern 15, 36 +Archivmanager 28 + -, reservieren 29 +Archiv (Menü) 27 +Archivübersicht drucken 27 +Assoziativspeicher 68 +auf koppeldatei 74 +Aufräumen 26 +auf satz 65, 78 +Auf Satz Nr. 17 +Ausdrucken 24 +Ausführen 8 +ausfuehrtaste 8, 102 +AUSWAHL 97 +AUSWAHL: 4 +Auswahl 8 + -, Format 98 +auswahl anbieten 103 + +Bearbeiten 46 +BILD 97 +bild ausgeben 95 +bildschirm neu 94 + +Datei, aufräumen 26 + -, kopieren (logisch) 25 + -, kopieren vom Archiv 27 + -, löschen 25 + -, löschen auf Archiv 28 + -, Platzbedarf 26 + -, reorganisieren 26 + -, schreiben auf Archiv 27 + -, umbenennen 25 + -, virtuelle 32, 71 +Dateianwendungen 109 +Dateien Archiv, Übersicht 27 +dateiende 64, 78 +dateien loeschen 74 +Dateien (Menü) 25 +Dateien System, Übersicht 25 +Dateilimit 52 +Dateimanager 28 +Dateiname 40 +dateiversion 75 +DATUM 45 +Dezimalkomma 45 +dezimalkomma 67 +dialog 104 +Dialog 9, 103 +dialogfenster 104 +DIN 45 +direkt drucken 83f. +Druckausgabe, Richtung 23 +druckdatei 85 +drucke 84 +Drucken 23, 49, 83 + -, Archivübersicht 27 +Drucken (Menü) 23 +Druckmuster 23, 49, 83 + -, Fehler 56 +Druckvorgang 51 + +editget 104 +EDITIEREN: 6 +Editieren 23 + -, Zeile 9 +Editor 9, 29 +eindeutige felder 47, 89 +einfuegen 96 +Einfügen 10, 19 + -, Satz 36 + -, Zeile 10 +EINGABE: 4 +Eingabe 9 +Einzelsatz (Menü) 17 +ELAN-Compiler 56 +ELAN-Kommandos 8 +ENDE 97 +Endekennzeichnung 40 +ESC '?' 6 +ESC '9' 4 +ESC '1' 4 +ESC '?' 4 +ESC '?' 3 +ESC 'D' 5 +ESC ESC 3 +ESC 'F' 5f. +ESC 'g' 5 +ESC 'h' 4ff. +ESC 'K' 36 +ESC OBEN 5 +ESC 'p' 5 +ESC 'q' 4, 6 +ESC RUBIN 5 +ESC RUBOUT 5 +ESC UNTEN 5 +ESC 'w' 4f. +ESC 'z' 4f. +eudas 29 +EUDAS: 3 +EUDAS-Datei, aufspalten 110 + -, drucken 23, 49, 83 + -, einrichten 13 + -, ketten 14, 32 + -, kopieren 21, 46, 85 + -, koppeln 14, 32 + -, nach Vorschrift ändern 48 + -, öffnen 13, 32 + -, reorganisieren 67 + -, sortieren 22 + -, Struktur 31, 61 + -, tragen 46, 87 + -, Übersicht 22 + -, verändern 21 +eudas dateiname 75 +EUDAT 61, 63, 109 +EUMEL-Netz 28 +exit durch 96 + +f 91 +FEHLER 5 +fehler ausgeben 104 +Feld 31 +FELD 98 +feld aendern 62, 65, 76 +Feldauswahl 20, 41, 95 +feld bearbeiten 62, 65, 76 +felderzahl 62, 63 +feldindex 62 +feldinfo 66, 77 +Feldinhalt 31, 39 +feld lesen 65, 76 +feldmaske 47, 89 +Feldmuster 53 +Feldname 31, 39 + -, ändern 16 + -, anfügen 16 +feldnamen aendern 63 +feldnamen bearbeiten 76 +feldnamen lesen 64, 76 +feldnummer 76 +Feldstruktur 15 +Feldtyp 31, 42 +Feldtypen 45, 66 + -, ändern 16 +Feldvergleich 43 +Fenster 93 +fenstergroesse 94 +fenstergroesse setzen 93 +fenster initialisieren 93 +fenster veraendert 94 +fensterzugriff 94 +folgedatei 75 +Folgezeilen 41 +Formular 39 +FRAGE: 5 +Fragen 9 +Funktion, ausführen 8 + -, gesperrte 8 + +Gesamtdatei (Menü) 21 +Gib Kommando: 6 +global manager 36, 100 +Gruppe 51 +GRUPPE-Anweisung 49 +gruppenwechsel 51, 85 + +Hauptdatei 32 +HILFE: 4 +HILFE 97, 99 +Hilfe 9 + -, Format 98 +hilfe anbieten 103 +Holen 19 +hole satz 89 +HOP LINKS 4 +HOP 'o' 4 +HOP OBEN 3ff. +HOP RECHTS 4 +HOP RETURN 4 +HOP RUBOUT 4 +HOP UNTEN 3ff. +HOP 'x' 4 + +inhalt veraendert 74 +Initialisieren 28 +Initialisierungsteil 49 + +ja 104 + +K 46, 86 +kette 73 +Ketten 14, 32 +Klassenwechsel 106 +Kombinationen 34 +Kommandos 8 +Kommandozeile 50 +kopiere 86 +Kopieren 21, 46, 85 +Kopieren (logisch) 25 +Kopieren vom Archiv 27 +Kopiermuster 21, 46 +KOPPEL 40 +Koppeldatei, umschalten auf 36 +Koppelfelder 33 +Koppeln 14, 32f. +kopple 72 +Kurzabfrage 29 + +LEER 3f. +Leertaste 8 +lfd nr 85 +lineform 24 +LINKS 3f. +Literaturangaben 108 +Löschen 25 + -, Satz 36 + -, Zeile 10 +Löschen auf Archiv 28 + +Manager 13 +Manager (Mehrbenutzer) 16, 36 +markierte saetze 81 +Markierung 18, 40, 42 +markierung aendern 81 +Markierungen löschen 22 +markierungen loeschen 81 +maxdruckzeilen 85 +MEHR-Anweisung 50 +MENUE 97 +Menü 8 + -, Aufruf 101 + -, Verwaltung 99 +menue anbieten 101 +menuedaten einlesen 99 +Menüformat 97 +menue loeschen 100 +menue manager 100 +menuenamen 100 +Modi 55 +MODUS-Anweisung 50 +Musterprogramme 105 +Musterteil 50 +Musterzeichen 53 +Musterzeile 50 + -, Interpretation 52 + +Nachbearbeiten 24 +Nachspann 49 +NACHSPANN-Anweisung 49 +Namenskonflikte 33 +neuer dialog 104 +Normalmodus 55 +Notizen 15, 31, 64 +notizen aendern 64, 77 +notizen lesen 64, 77 + +'o' 4 +OBEN 3f. +ODER-Verknüpfung 43 +oeffne 63, 72 +Öffnen 32 +Öffnen (Menü) 13 + +pageform 24 +Paralleleditor 56, 83 +Paßwort 29 +Platzbedarf 26 +Positionieren 17, 31, 64, 77 +Priorität 44 +Programmzeile 51 +Protokolldatei 47 +Prüfbedingungen 16, 31, 47, 64, + 87 +pruefe 47, 88 +Pufferplatz 54 + +RECHTS 3f. +Refinement 56 +reorganisiere 67 +Reorganisieren 26, 45, 67 +Reservieren 29 +RETURN 4 +Richtung Druckausgabe 23 +rollen 95 +Rollen 41 +RUBIN 4 +RUBOUT 4 + +saetze 64 +SATZ 61 +Satz 31 +satz aendern 66 +satz ausgewaehlt 80 +Satzauswahl 42 +Satzeditor 9 +satz einfuegen 66, 79 +Satzformular 39 +satz initialisieren 62 +satzkombination 77 +satz lesen 66 +satz loeschen 66, 79 +satz markiert 81 +satznr 64 +satznummer 77 +Satznummer 39 +Satzposition 64 +Satzzeiger 31 +Satzzugriffe 65 +Schreiben auf Archiv 27 +SEITE 99 +sichere 73 +Sichern 15, 36 +sortiere 67 +Sortieren 22, 31, 44, 66 +Sortierreihenfolge 31, 44 +sortierreihenfolge 67 +Sortierzustand 45 +Spaltendruck 52 +Sperre 36 +Standard-Kopiermuster 21, 46 +status anzeigen 103 +Statuszeile 3 +std kopiermuster 87 +Suchbedingung 17, 39, 42 + -, löschen 18 + -, setzen 18 +suchbedingung 80 +suchbedingung lesen 80 +suchbedingung loeschen 80 +suchen 96 +Suchen, Optimierung 44 +Suchmuster 42 + -, eingeben 10 + +Tabellenmodus 55 +Tasten 3 +Tastenfunktionen 3 +TEXT 45 +textdarstellung 91 +Textdatei, ausdrucken 24 + -, editieren 23 + -, nachbearbeiten 24 +Textzeile 49f. +trage 88 +Tragen 16, 19, 21, 46, 87 +trage satz 88 + +uebersicht 95 +uebersichtsfenster 95 +Umbenennen 25 +Umbruch 40, 55 +Umschalten auf Koppeldatei 36 +UND-Verknüpfung 43 +unsortierte saetze 67 +UNTEN 3f. +Überschrift 39 +Übersicht 22, 41 +Übersicht Dateien Archiv 27 +Übersicht Dateien System 25 + +V 48, 90 +Verändern 21 +verarbeite 90 +Verarbeitung 89 +Verknüpfung von Bedingungen +43 +virtuelle Datei 32, 71 +VORSPANN 98 +Vorspann 49 +VORSPANN-Anweisung 49 + +waehlbar 102 +wahl 103 +Warten 6 +weiter 65, 78 +Weiter 17 +wert 91 +wertemenge 47, 88 +WIEDERHOLUNG-Anweisung 49 +Wiederholungsteil 49 + +'x' 4 + +ZAHL 45 +zahltext 91 +Zeichen, reservierte 44 +ZEIGEN: 6 +Zeilenende 54 +Zeilenwiederholung 55 +Zielarchiv 28 +Zurück 17 +zurueck 65, 78 +Zustand 3 +Zustandsübergänge 7 + diff --git a/app/eudas/4.3/doc/eudas.ref.titel b/app/eudas/4.3/doc/eudas.ref.titel new file mode 100644 index 0000000..223a839 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.titel @@ -0,0 +1,91 @@ +#limit (14.0)# +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#gs-MP BAP + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# +#free (6.0)# +#on("b")#EUDAS#off("b")# +#free (1.0)# +#on("b")#Anwender-#off("b")# +#on("b")#Datenverwaltungssystem#off("b")# +#free (2.0)# +#on ("b")#VERSION 4#off("b")# +#free(1.0)# +#on("u")#                                                    #off("u")# +#free (0.5)# +#on("b")#REFERENZHANDBUCH#off("b")# +#block# +#page# +#free (9.5)# +Hergestellt mit Hilfe der EUMEL-Textverarbeitung und des Pro­ +gramms FontMaster der Martin Schönbeck GmbH. +#free (1.7)# +Ausgabe September 1987 + +Dieses Handbuch und das zugehörige Programm sind urheberrechtlich +geschützt. Die dadurch begründeten Rechte, insbesondere der Ver­ +vielfältigung in irgendeiner Form, bleiben dem Autor vorbehalten. + +Es kann keine Garantie dafür übernommen werden, daß das Pro­ +gramm für eine bestimmte Anwendung geeignet ist. Die Verantwor­ +tung dafür liegt beim Kunden. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrekt­ +heit und Vollständigkeit der Angaben wird aber keine Gewähr über­ +nommen. Das Handbuch kann jederzeit ohne Ankündigung geändert +werden. + +(c) Copyright 1987 Thomas Berlage + Software-Systeme + Im alten Keller 3 +#free (0.1)# + D-5205 Sankt Augustin 1 +#page# +#free (7.0)# +#center##on("b")#I.#off("b")# +#free (1.0)# +#center##on("b")#FUNKTIONEN#off("b")# +#center##on("b")#ZUM#off ("b")# +#center##on("b")#NACHSCHLAGEN#off("b")# +#page# +#free (7.0)# +#center##on("b")#II.#off("b")# +#free (1.0)# +#center##on("b")#EUDAS#off("b")# +#center##on("b")#FÜR#off ("b")# +#center##on("b")#PROGRAMMIERER#off("b")# +#page# +#free (7.0)# +#center##on("b")#III.#off("b")# +#free (1.0)# +#center##on("b")#ANHANG#off("b")# + + + + diff --git a/app/eudas/4.3/doc/eudas.ref.vorwort b/app/eudas/4.3/doc/eudas.ref.vorwort new file mode 100644 index 0000000..f911be8 --- /dev/null +++ b/app/eudas/4.3/doc/eudas.ref.vorwort @@ -0,0 +1,81 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#EUDAS + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# +#center#1 + +Vorwort + + + +Lieber EUDAS-Benutzer! + +Dies ist das zweite Handbuch, das Sie zu EUDAS bekommen. Wenn +Sie sich mit EUDAS noch nicht auskennen, sollten Sie zunächst das +#on("i")#Benutzerhandbuch#off("i")# zu Rate ziehen, ehe Sie in dieses Handbuch +schauen. + + Das #on("i")#Referenzhandbuch#off("i")# ist in zwei Teile geteilt. Im ersten Teil +finden Sie eine Übersicht über alle EUDAS-Funktionen (im Kapitel +2) sowie zusammengefaßte Informationen über die Bedienung (Kapi­ +tel 1) und die genaue Wirkung der einzelnen Funktionen (Kapitel 3 +bis 5). Dieser Teil soll Ihnen zum Nachschlagen dienen, wenn Sie +eine bestimmte Information suchen. + Im zweiten Teil sind alle Informationen zusammengefaßt, die +ein Programmierer zur Benutzung der EUDAS-Funktionen braucht. Es +sei an dieser Stelle jedoch davon abgeraten, sofort eigene Program­ +me zu schreiben, da sich in vielen Fällen die gleiche Wirkung auch +durch Programmierung innerhalb von EUDAS-Funktionen erreichen +läßt (zum Beispiel in Druck- und Änderungsmustern). + Im Zweifelsfall orientieren Sie sich anhand von Kapitel 11, wie +Sie Ihr Problem am besten lösen können. + + + + + + + + + + + + + diff --git a/app/eudas/4.3/doc/ref.abb.1-1 b/app/eudas/4.3/doc/ref.abb.1-1 new file mode 100644 index 0000000..d3b3217 --- /dev/null +++ b/app/eudas/4.3/doc/ref.abb.1-1 @@ -0,0 +1,42 @@ +#limit (13.5)# +#start (3.5, 5.0)# +#lpos (0.5)##c pos (3.5)##c pos (4.7)##cpos (7.0)##c pos (10.5)# +#table# +      eudas   ESC q   + +    ESC ESC   ESC h +#free (0.2)# +GIB KDO:     EUDAS   +#free (0.2)# +    ESC h     +    RET        LEER  'Buchst.'   + +        ESC q           + +        FEHLER + + +  WARTEN       +      n, j   +        FRAGE + +      RET   +        EINGABE +#linefeed (0.5)# + + +        ESC z           +      ESC q   +#linefeed (1.0)# +        AUSWAHL + +      ESC q   +        EDITIEREN + +      ESC q   +        SATZEDITOR +ESC ?   ESC q         +      ESC q   +HILFE       ZEIGEN + + diff --git a/app/eudas/4.3/doc/register b/app/eudas/4.3/doc/register new file mode 100644 index 0000000..9cca0fc --- /dev/null +++ b/app/eudas/4.3/doc/register @@ -0,0 +1,490 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (181)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +Register + + + +#columns (2, 0.5)# +#limit (6.5)# +% 63, 69, 148 +%% 141 +& 63, 69, 103, 148 + 57 +-- 103 +.. 102 +.a$ 65 +'+' 107 +'-' 107 + +Abbruch 35 +Abkürzungen 133 +Abkürzungsteil 134, 140 +Absatzmarken 125, 129 +Abschlußzeile 45 +Abschneiden 71 +Abschnitt 67, 69, 134 +Alternative 99 + -, globale 100 + -, lokale 99 +AND 162 +Ändern 55 +Änderungen 83, 85, 90, 95 + -, automatisch 121 +Änderungsmuster 121, 166 +Anführungsstrich 27, 34 +Ankreuzen 36, 40 +Anrede 138 +Anweisung 63 + -, Textkosmetik 74 +Anzeige 44 + -, rollen 97 +Arbeitsbereich 16 +Arbeitskopie 56, 84, 173 + -, Beispiel 58 + -, löschen 57 +Arbeitstask 16 +Archiv 32 + -, anmelden 34 + -diskette 36 + -, lesen 34 + -, löschen 176 + -manager 175, 177 + -menü 33, 174 + -name 34, 36 + -, schreiben 36 + -übersicht 175 +Arithmetik 161 +Attribut 4, 29 +Aufräumen 173 +Ausdrucken 66 +Ausdrücke 116, 151 + -, Zusammensetzung 152 +Ausgabedatei 66 +Ausgaberichtung 65 +Auswahlzustand 36, 40 +Automatische Änderungen 121 + +Bedienungsregeln 39 +begin 16 +Benutzerhandbuch i +Berechnungen 8 +Bewegen 45 +Bildschirmaufbau 45 +Bitte warten 34, 40 +blättern 46 +BOOL 154, 162 + +Carriage Return 15 +CAT 167 +CONST 155 +CR 15 +Cursor 35, 46 + -tasten 54 + +date 137 +Datei 27 + -arten 27 + -, aufräumen 173 + -auswahl 36 + -größe, Begrenzung 124 + -, kopieren 172 + -limit 71 + -, löschen 38, 172 + -namen 172 + -, Platzbedarf 173 + -, reorganisieren 174 + -sperre 95 + -, umbenennen 172 + -verwaltung 37 + -, virtuelle 83 +Dateien, Archiv 174 + - (Menü) 38, 171 + -, System 171 +DATEIENDE 106 +Daten, ändern 55 + -, anzeigen 44 + -, sichern 33 + -typen 152 + -typen, umwandeln 154 + -verwaltung 3 +Datum 44, 99, 133, 137 +DATUM 112 +DECR 167 +Denotation 154 +Dezimalkomma 111, 161 +Dezimalpunkt 148 +DIN 112 +Diskette 28, 32 + -, formatieren 176 + -, initialisieren 176 +Diskettenlaufwerk 175 +Doppeleinträge 121 +DOS 178 +Druckausgabe, Bearbeitung 125 +Drucken 7, 61 + -, Ablauf 66 + -, Aufruf 64, 66 + - (Menü) 22, 65 + -, Übersicht 175 +Druckersteuerungsanweisungen + 74, 124 +Druckmuster 13, 23, 61, 166 + -, Fehler 134 + -, Übersetzung 134, 142 + -, Zeilenlänge 71 +Druckrichtung 123 +Druckverfahren 62 + +Editieren 64 +Editor 34, 41, 52, 125 +eindeutige felder 121 +Einfügen 18, 52 +Eingabe, Daten 52 + -, Suchmuster 46 +Eingabeüberprüfung 112 +Eingabezustand 35, 40 +Eingangsmenü 17 +Einzelsatz (Menü) 18, 44, 92, 97 +ELAN-Anweisungen 141 +ELAN-Ausdrücke 116, 151 +ELAN-Compiler 134 +ELIF 168 +ELSE 139 +ENDE 45 +Endesatz 45, 48, 53, 85 +ENTER 15 +ESC '1' 107 +ESC '?' 31, 39, 40 +ESC '9' 107 +ESC 'D' 99 +ESC ESC 41, 111 +ESC 'F' 67 +ESC 'g' 99 +ESC 'h' 35, 39, 40, 55, 107 +ESC 'K' 92 +ESC OBEN 97 +ESC 'p' 99 +ESC 'P' 118 +ESC 'q' 32ff.,40 , 47, 65, 107 +ESC RUBIN 54 +ESC RUBOUT 54 +ESC UNTEN 97 +ESC 'w' 32, 40, 53 +ESC 'z' 32, 36, 40, 95 +Etiketten 126 +eudas 30, 125 +EUDAS-Archivdiskette 11, 29 +EUDAS-Datei 27, 61, 171 + -, drucken 61 + -, einrichten 17, 51 + -, Grenzen 29 + -, kopieren 113 + -, Mehrfachbenutzung 93 + -, Struktur 28 +EUDAS, Aufruf 30 + -, Installation 11 + -, Start 15 + -, Verlassen 24, 32 +EUMEL-Netz 175 +EUMEL-Textverarbeitung 5 +EUMEL-Zeichencode 110 + +f 117, 134, 156 +FALSE 154 +Fehler, Druckmuster 66 + -, quittieren 36 + -zustand 35, 40 +Feld 29 +Feldauswahl 97, 106 +Felder, anfügen 111, 114 +Feldinhalt 29, 156, 160 +feldmaske 120 +Feldmuster 63, 69 +Feldmustertypen 71 +Feldnamen 29, 67 + -, abfragen 67 + -, Abgrenzung 72 + -, ändern 112 + -, eingeben 51 + -, Länge 133 +Feldreihenfolge 113 +Feldstruktur 111 +Feldteil 45 +Feldtypen 110, 154 + -, ändern 111 +Feldvergleich 103 +Formatieren 177 +Formbrief 74 +Formular 8, 44 +Fragezustand 38, 40 +Funktionen 152 + -, ausführen 31, 46 + -, auswählen 30 + -, gesperrt 31 +Fußzeile 44 + +Gib Kommando 41, 11 +global manager 93 +GRUPPE 145 +Gruppen 144 + -definition 145 + -, mehrere 145 + -wechsel 145 +gruppenwechsel 145 + +halt 39, 110 +Hardwarefehler 33 +Hauptdatei 87ff. +Hilfe 31 +Hilfezustand 31, 40 +Hilfstexte 13, 31 +Hintergrunddiskette 12 +Hintergrundengpaß 124 +Holen 56 +HOP OBEN 40, 98, 106 +HOP RETURN 106 +HOP RUBIN 54 +HOP RUBOUT 54 +HOP UNTEN 40, 98, 106 +HOP 'x' 98 + +IF 117 +IF-Abfragen 161, 168 +IF-Anweisungen 138 +INCR 167 +Init 176 +Initialisierungsteil 124, 143 +Installation 11 +int 140 +INT 153 + +K 113 +Karteikarten 5 +KB 173 +Ketten 13, 83, 85, 95 +Kilobyte 173 +Klammern 163 + -, spitze 72 +Kombination 89 +Kombinationsnummer 90 +Kopieren, logisch 172 + -, EUDAS-Datei 112 + - (vom Archiv) 34, 176 +Kopieranweisung 113 +Kopiermuster 113, 115, 166 + -, Übersetzung 116 +KOPPEL 92 +Koppeldatei, Markierung 105 + -, Position 93 + -, umschalten 92 +Koppelfeld 86, 89 + -, übernehmen 92 +Koppeln 13, 83, 85, 95 + -, mehrere Dateien 87 +Koppelvorgang, Schema 87 +Korrekturversion 14 + +Länge, feste 70, 137 + -, variable 70 +Leerautomatik 73 +Leertaste 17, 31 +length 158 +lfd nr 137, 157 +limit 71, 125 +lineform 125, 129 +LINKS 31, 35 +linksbündig 71 +Linksschieben 128 +list (archive) 34 +Löschen 55 + - (auf Archiv) 176 + - (Datei) 172 + +Manager 93, 95 +Managertask 175 +MARK 104 +Markieren 104 + -, in Übersicht 107 +Markierung 104 + -, löschen 105 +maxdruckzeilen 124 +MEHR 129 +Mehrfachbenutzung 93 +Menü 30 +Menüzustand 31, 40 +min 155 +Modi 128 +Multi-User 12 +Multi-User-System 16 +Musterbrief 139 +Musterteil 135 +Musterzeichen 70 + +Nachbearbeitung 125 +Nachspann 68, 144 +NACHSPANN 68 +Negation 103 +Netz 175 +Numerieren 137 + +'o' 40, 98 +OBEN 30, 106 +ODER 100 +Öffnen 17, 21, 43, 51, 57, 83, 95 + - (Menü) 30 +Operatoren 152, 155 + -, Priorität 163 +OR 163 + +pageform 125 +Paralleleditor 67, 142 +Parameter 152 +Paßwort 94, 177 +Pfeiltasten 54 +Platzbedarf, Datei 173 +pos 159 +Position, feste 69 + -, variable 69 +Positionierung 48 +Proportionalschrift 129 +Prüfbedingungen 118 +pruefe 120 +PUBLIC 13 + +REAL 153 +real 155 +RECHTS 31, 55 +rechtsbündig 71, 137 +Referenzhandbuch i, 79 +Refinement 134, 140, 163 +Reorganisieren 174 +Reservieren 178 +RET 15 +RETURN 15 +Richtung, Druckausgabe 65, 123 +Rollen 97, 106 +RUBIN 35, 54 +RUBOUT 35, 54 +Runden 160 + +Satz 29 + -, anwählen 46 + -editor 41, 47, 53, 92, 98 + -, einfügen 52 + -, holen 56 + -, löschen 55 + -, tragen 55 +Satz.Nr 46, 48 +Satznummer 45, 90 +Satzauswahl, kopieren 114 +Schreiben (auf Archiv) 36, 176 +Schreibmarke 35 +Schrifttypen 125 +Selektion 48 +Sichern 20, 56, 84, 95 +Single-User 12 +Single-User-System 16 +Sortieren 109 + -, Optimierung 110 + -, Zieldatei 115 +Sortierreihenfolge 109 +Spaltenbreite 126 +Spaltendruck 126 +Speicherplatz 14, 38, 176 + -, Datei 173 +Sperren von Dateien 95 +Standard-Kopiermuster 115 +Stationsnummer 175 +Statistik 169 +Statuszeile 31, 39 +Stern 50, 101 +SUB 158, 163 +subtext 158 +SUCH 47 +Suchbedingung f. Drucken 67 +Suchbedingung, Kombination 49 +Suchbedingung löschen 48 +Suchbedingung setzen 46 +Suchen 21, 46 + -, Optimierung 104 +Suchmuster 47, 99 + -, Eingabe 47 +SV-Taste 16, 39 +System 32 + +Tabellenmodus 128 +Tagesdatum 99 +Task, Manager 93 +Tasks 13 +Teildatei 114 +Teiltexte 158 +TEXT 112, 153 +text 140 +Textdatei 28, 61, 171 + -, ändern 65 + -, ansehen 65 + -, ausdrucken 66 + -, editieren 64 +Texte, verketten 156 +Text-Funktionen 156 +Textkonstanten 139 +Text, konstanter 117 +Text, Länge 158 +Textverarbeitung 3, 123 +THEN 139 +Tragen 55, 118 +TRUE 154 + +Uhrzeit 133 +Umbruch 129 +Umlaute 143 +Umschalten auf Koppeldatei 92 +UND 100ff. +UNTEN 30, 106 +Überschrift 45, 68 +Übersicht (Archiv) 34, 175 + - (Dateien) 37, 171 + - (Sätze) 105 + +V 122 +VAR 165 +Variablen 165 + -, Initialisierung 143, 167 + -, Lebensdauer 166 + -, Typ 165 +Verändern 121 +Vergleiche 102, 162 +virtuelle Datei 83 +Vorspann 68, 144 +VORSPANN 68 + +Weiter 45, 48, 90 +wert 148, 160 +wertemenge 119 +WIEDERHOLUNG 63, 126 + +'x' 36, 40 + +ZAHL 110 +zahltext 148, 160 +Zeichen, reservierte 64, 69, 103 +Zeigen 40 +Zeile einfügen 54 +Zeilenfortsetzung 129 +Zeilenlänge 71 +Zielarchiv 175 +Zieldatei, Struktur 113 +Zurück 45, 48, 90 +Zustand 31, 40 +Zuweisung 166 + + diff --git a/app/eudas/4.3/doc/uedas.hdb.4 b/app/eudas/4.3/doc/uedas.hdb.4 new file mode 100644 index 0000000..ecbfd58 --- /dev/null +++ b/app/eudas/4.3/doc/uedas.hdb.4 @@ -0,0 +1,686 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (27)# +#headodd# +#center#EUDAS#right#% + +#end# +#headeven# +%#center#EUDAS + +#end# +#center#1 + +4 Umgang mit Dateien und Menüs + + + +Zu Anfang dieses Teils sollen Sie zunächst die Terminologie von +EUDAS kennenlernen. Das Karteikartenmodell des ersten Kapitels +muß ja auf einem Rechner realisiert werden. Dazu müssen erst eini­ +ge Ausdrücke erklärt werden. + + +4.1 EUDAS-Dateien + +Der wichtigste Ausdruck, der Ihnen noch sehr häufig begegnen wird, +ist #on("i")#Datei#off("i")#. Eine Datei ist eine Sammlung von Informationen in einem +Computer, die als ein Objekt transportiert und behandelt werden +können. Dieser Name wurde analog zu "Kartei" gebildet, mit dem +Unterschied, daß eine "Daten-Kartei" gemeint ist. + Jede Datei hat einen eigenen Namen, durch den sie identifiziert +wird. Der Name ist oft in Anführungsstriche eingeschlossen - die +Anführungsstriche gehören jedoch nicht zum Namen, sondern dienen +nur zur Abgrenzung, welche Zeichen zum Namen gehören. Der Name +ist also wie die Aufschrift auf einem Aktenordner. Wenn alle Ordner +im Schrank stehen, können Sie anhand des Namens den richtigen +Ordner finden, anderenfalls müßten Sie alle Ordner öffnen. + +#on("b")#Dateiarten#off("b")# Dateien werden nun für viele verschiedene Arten +von +Informationen benutzt. Sie können einerseits Texte enthalten oder +auch Karteien, Grafiken, Formeln oder Zahlenkolonnen. Sie haben +bereits im ersten Kapitel den Unterschied zwischen Datenverwaltung +und Textverarbeitung kennengelernt. In diesem Zusammenhang sind +die beiden ersten Verwendungsweisen wichtig. + +#limit (12.0)# + #on("i")#Textdateien#off("i")# + sind Dateien, die normale Texte enthalten, die mit + dem Editor verändert und einfach ausgedruckt + werden können. In ihnen werden also Informationen + gespeichert, wie die Textverarbeitung sie benötigt. + + #on("i")#EUDAS-Dateien#off("i")# + sind dagegen Dateien, die Informationen in der + Form von Karteikarten enthalten. Sie haben also + die Struktur, wie sie von der Datenverwaltung be­ + nötigt wird. +#limit (13.5)# + + Der Computer kann aber auch alle Arten von Dateien gleich­ +behandeln, und zwar dann, wenn der Inhalt der Dateien nicht be­ +trachtet werden muß. + Ein häufiger Fall ist zum Beispiel, wenn Dateien zur Sicherung +auf eine Diskette geschrieben werden sollen. In diesem Fall genügt +die Angabe des Namens; dem Rechner ist es egal, welchen Inhalt die +Datei hat. + Anders ist es aber, wenn Sie den Inhalt betrachten wollen. +Dazu brauchen Sie dann ein Programm, das die innere Struktur der +Datei kennt. Textdateien können Sie zum Beispiel mit dem Editor +ansehen. EUDAS-Dateien müssen Sie jedoch mit EUDAS ansehen, da +der Editor die EUDAS-Struktur nicht kennt. Es ist in vielen Fällen +sinnvoll, durch einen Zusatz im Dateinamen zu kennzeichnen, ob es +sich um eine Textdatei oder eine EUDAS-Datei handelt. + + +#free (3.7)# + +#center#Abb. 4-1 Struktur einer EUDAS-Datei + + +#on("b")#Terminologie#off("b")# EUDAS verwendet bestimmte Ausdrücke, um die +Strukturelemente einer EUDAS-Datei zu kennzeichnen. Die Struktur +einer EUDAS-Datei ist schematisch in Abb. 4-1 dargestellt. Die +Ausdrücke wurden nun nicht direkt aus dem Karteikartenmodell +übernommen, da es auch noch andere Modelle gibt und keine fal­ +schen Assoziationen auftreten sollen. + EUDAS verwendet die Bezeichnung #on("i")#Satz#off("i")# für eine Karteikarte. +Eine EUDAS-Datei besteht also aus einer Anzahl von gleichartigen +Sätzen. Zur Veranschaulichung kann man sich diese nebeneinander­ +gelegt vorstellen. + Jeder Satz ist unterteilt in sogenannte #on("i")#Felder#off("i")#. Ein Feld ent­ +spricht einem Attribut bzw. einem Eintrag auf der Karteikarte. Ein +Feld ist wiederum unterteilt in einen #on("i")#Feldnamen#off("i")# und einen #on("i")#Feldin­ +halt#off("i")#. + Der Feldname identifiziert ein bestimmtes Feld innerhalb eines +Satzes. Die Feldnamen sind natürlich für alle Sätze gleich. Die +Feldnamen einer EUDAS-Datei sind beliebig und können von Ihnen +selbst festgelegt werden. + Der Feldinhalt enthält die eigentliche Information des entspre­ +chenden Attributs. Der Feldinhalt darf ebenfalls aus beliebig vielen +Zeichen bestehen. Die Feldinhalte sind natürlich für jeden Satz +verschieden und stellen die eigentliche gespeicherte Information +dar. + +#on("b")#Grenzen#off("b")# Aus technischen Gründen gibt es natürlich auch +einige +Beschränkungen, die hier nicht verschwiegen werden sollen. Eine +Datei kann maximal etwa 5000 Sätze enthalten, ein Satz darf aus +maximal 255 Feldern bestehen. Insgesamt kann ein Satz etwa 32000 +Zeichen umfassen. Die einzelnen Sätze in der EUDAS-Datei werden +durch ihre jeweilige Positionsnummer identifiziert, also quasi von 1 +bis 5000 durchnumeriert. + + +4.2 EUDAS-Menüs + +In den folgenden Abschnitten sollen Sie lernen, wie die Bedienung +von EUDAS funktioniert. Dazu sollen Sie eine EUDAS-Beispieldatei +von der EUDAS-Diskette in Ihr System holen. Diese Datei brauchen +Sie dann später, um die Funktionen von EUDAS zu kennenzulernen. + Die Beispieldatei hat den gleichen Inhalt wie die in Kapitel 3 +von Ihnen erstellte Datei. Falls Ihnen also die EUDAS-Archiv­ +diskette nicht zur Verfügung steht, können Sie in diesem Kapitel +auch jede andere Archivdiskette verwenden. + Bitte beachten Sie im folgenden, daß Sie einfache Anführungs­ +striche nicht mit eingeben, doppelte Anführungsstriche aber wohl. + +#on("b")#EUDAS-Aufruf#off("b")# Zuerst müssen Sie EUDAS aufrufen. Dazu +begeben +Sie sich in die in Kapitel 3 eingerichtete Task ('continue ("arbeit")') +und geben bei 'gib kommando:' das Kommando 'eudas': + + + gib kommando: + #on("i")#eudas#off("i")# + + +Falls Ihr System über Menüs gesteuert wird, müssen Sie eine ent­ +sprechende Funktion wählen. Anschließend erscheint folgendes +Menü: + +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + EUDAS-Datei : + O Öffnen : + - Ketten : + - Koppeln : + --------------: + Arbeitskopie : + - Sichern : + --------------: + Aktuelle Datei: + - Notizen : + - Feldstrukt. : + - Prüfbeding. : + --------------: + Mehrbenutzer : + M Manager : + --------------: + : + : + : + : + : + Akt.Datei: Manager: Datum: 22.07.87 +___________________________________________________________________________________________ + + +#on("b")#Menüs#off("b")# Ein #on("i")#Menü#off("i")# ist eine Auswahl für einige verschiedene Funk­ +tionen. Die Funktionen sind jeweils benannt und werden durch einen +davorstehenden Buchstaben oder ein Minuszeichen gekennzeichnet. +Eine der Funktionen ist immer durch inverse Darstellung markiert. + Diese Markierung können Sie nun mit Hilfe der Pfeiltasten OBEN +und UNTEN verschieben. Auf diese Weise können Sie sich die ge­ +wünschte Funktion auswählen. Die Funktionen werden jedoch durch +das Markieren nicht ausgeführt. Sie können also beliebig mit den +Pfeiltasten herumexperimentieren. + Ausgeführt wird die markierte Funktion, wenn Sie die Leertaste +drücken. Sofort erscheint ein Stern vor dem Funktionsnamen, um +anzuzeigen, daß die Ausführung beginnt. Probieren Sie dies jetzt +nicht aus, dazu ist später Gelegenheit. + Funktionen mit einem Minuszeichen davor können Sie zwar +anwählen (markieren), aber nicht ausführen. Solche Funktionen sind +momentan gesperrt, weil ihre Ausführung keinen Sinn hat oder sogar +Fehler erzeugen würde. + Mit den Pfeiltasten LINKS und RECHTS können Sie im Menüzu­ +stand weitere EUDAS-Menüs abrufen. Welche Menüs zur Verfügung +stehen, zeigt Ihnen die oberste Bildschirmzeile. Das aktuelle Menü +ist jeweils invers dargestellt. + +#on("b")#Hilfe#off("b")# Wenn Sie nun wissen möchten, welche Bedeutung die +mar­ +kierte Funktion hat (die Funktionsbezeichnungen sind aus Platz­ +gründen sehr kurz gehalten), können Sie einen #on("i")#Hilfstext#off("i")# zu dieser +Funktion abrufen. Dies erfolgt durch die Betätigung der Tasten ESC +und '?' hintereinander. Diese doppelten Tastenkombinationen mit der +ESC-Taste am Anfang werden Ihnen noch sehr häufig begegnen - +denken Sie immer daran, die Tasten hintereinander und nicht +gleichzeitig zu tippen. Der zeitliche Abstand zwischen den Tasten­ +drücken kann beliebig lang sein; hingegen sollten Sie eine Taste +nicht zu lange drücken, da sonst eventuell eine automatische Wie­ +derholfunktion Ihrer Tastatur startet. + Probieren Sie nun die Tastenkombination ESC '?' aus. Als Reak­ +tion erscheint in der rechten Hälfte des Bildschirms ein Text. Dieser +sollte Ihnen die gewünschten Informationen bieten. + Gleichzeitig hat sich aber auch die oberste Bildschirmzeile +verändert. Sie zeigt jetzt folgendes Bild: + +___________________________________________________________________________________________ + + HILFE: Beenden: ESC q Seite weiter: ESC w Seite zurueck: ESC z +___________________________________________________________________________________________ + + +#on("b")#Zustände#off("b")# Wenn Sie sich nicht im Menü befinden, fungiert +die ober­ +ste Zeile als sogenannte #on("i")#Statuszeile#off("i")#. Diese Zeile zeigt immer an, in +welchem #on("i")#Zustand#off("i")# das Programm sich befindet. Der Zustand des Pro­ +gramms hat nämlich Einfluß darauf, welche Tasten Sie drücken +können und wie das Programm darauf reagiert. Die Statuszeile zeigt +daher außer dem Zustand auch die wichtigsten Tastenfunktionen. + Sie kennen jetzt also schon zwei Zustände von EUDAS: den +Menüzustand und den Hilfe-Zustand. + +#on("b")#Hilfe-Zustand#off("b")# Vom Menüzustand kommen Sie über die +Tastenkom­ +bination ESC '?' in den Hilfe-Zustand. Im Hilfe-Zustand haben die +Pfeiltasten OBEN und UNTEN keine Wirkung mehr (probieren Sie dies +aus). + Ein Hilfstext besteht im allgemeinen aus mehreren Seiten. Die +erste Seite enthält dabei die speziellen Informationen, danach +folgen dann allgemeine Informationen. Mit den Tastenkombinationen +ESC 'w' und ESC 'z' können Sie zwischen den Seiten umschalten +(denken Sie daran, was oben über Tastenkombinationen gesagt +wurde). Wenn Sie dies ausprobieren, werden Sie auf der zweiten +Seite allgemeine Hinweise zur Menübedienung finden. Auf der letz­ +ten Seite wird ESC 'w' ignoriert, ebenso ESC 'z' auf der ersten Seite. + Mit der Tastenkombination ESC 'q' (quit) kehren Sie aus dem +Hilfezustand in den vorherigen Zustand zurück. Diese Tastenkombi­ +nation löst allgemein in EUDAS die Rückkehr in den alten Zustand +aus. Wenn Sie ESC 'q' getippt haben, erscheint die alte Menüzeile +und Sie können wieder Funktionen auswählen. + Der Hilfszustand läßt sich von nahezu allen (noch zu bespre­ +chenden) Zuständen mit ESC '?' aufrufen. Es wird jeweils ein zum +aktuellen Zustand passender Hilfstext ausgegeben. + Die möglichen Zustandsübergange sind nochmal in Abb. 4-2 +zusammengefaßt. + + +#free (2.5)# + +#center#Abb. 4-2 Menü- und Hilfezustand + + +#on("b")#EUDAS verlassen#off("b")# Im Menüzustand können Sie EUDAS jederzeit +durch Tippen von ESC 'q' verlassen. Sie landen dann wieder bei 'gib +kommando:'. + + +4.3 Archivmenü + +#on("b")#System/Archiv#off("b")# An dieser Stelle müssen Sie sich die Begriffe #on("i")#Archiv#off("i")# +und #on("i")#System#off("i")# klarmachen. Als Archiv bezeichnet man die Möglichkeit, +bei Bedarf Disketten in Ihren Rechner einlegen können, um Dateien +(und Programme) von anderen Rechnern zu übernehmen. Um diese +Dateien bearbeiten zu können, müssen Sie sie in das System (Ihre +Festplatte oder Hintergrunddiskette) kopieren. + Die wichtigste Aufgabe des Archivs ist es, Daten vor Beschädi­ +gung zu sichern. Durch Fehlbedienung oder Systemfehler kann es +nämlich leicht geschehen, daß die Daten in Ihrem System verloren +gehen oder zerstört werden. Wenn Sie die Daten jedoch auf einer +Diskette gesichert und die Diskette sicher verwahrt haben, können +Sie die Daten wiederherstellen. + Es ist sehr wichtig, daß Sie Ihre Dateien auf Archivdisketten +sichern, denn ein einziger Hardwarefehler kann die Arbeit von +Jahren vernichten (Sagen Sie nicht: "Mir passiert so etwas nicht" - +bis jetzt hat es noch jeden erwischt). + +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + Dateien Archiv: + U Übersicht : + D Üb. Drucken : + --------------: + Datei : + K Kopieren : + vom Archiv : + S Schreiben : + auf Archiv : + L Löschen : + auf Archiv : + --------------: + Archivdiskette: + I Init : + --------------: + Z Zielarchiv : + P Paßwort : + - Reservieren : + --------------: + : + : + Akt.Datei: Ziel: "ARCHIVE" Datum: 22.07.87 +___________________________________________________________________________________________ + + +#center#Abb. 4-3 Archivmenü + + +#on("b")#Archivmenü#off("b")# Wenn Sie EUDAS aufrufen, befinden Sie sich +immer im +ersten Menü. Sie benötigen jedoch jetzt Funktionen aus dem sech­ +sten Menü 'Archiv'. Wählen Sie dieses Menü jetzt an. Es erscheint +das in Abb. 4-3 dargestellte Bild. Die Funktionen in diesem Menü +befassen sich mit beliebigen Dateien auf dem Archiv. + Für den Versuch legen Sie bitte die EUDAS-Archivdiskette ein. +Dann wählen Sie die Funktion 'Übersicht' in dem Menü an, wenn sie +nicht schon markiert ist. Sie können nun die ausgewählte Funktion +durch Tippen der Leertaste ausführen. + In der obersten Zeile erscheint nun der Hinweis 'Bitte war­ +ten..'. Er zeigt an, daß nun eine Funktion ausgeführt wird, bei der +Sie zunächst nichts tun können. Sie sollten in diesem Zustand keine +Tasten drücken, denn EUDAS kann nicht darauf reagieren. + +#on("b")#Archivübersicht#off("b")# Nach einer mehr oder minder langen +Aktivitäts­ +phase Ihres Diskettenlaufwerks erscheint dann die Archivübersicht. +Das Erscheinungsbild mit dem markierten Editorbalken in der ober­ +sten Zeile kommt Ihnen vielleicht bekannt vor. Sie haben nämlich +nichts anderes als das EUMEL-Kommando 'list (archive)' ausgeführt. +Neu ist lediglich die Statuszeile: + +___________________________________________________________________________________________ + + ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Beenden: ESC q Hilfe: ESC ? +___________________________________________________________________________________________ + + +Wenn Sie sich die Übersicht angeschaut haben, verlassen Sie den +Editor wieder mit ESC 'q'. + Beachten Sie, daß Sie unter EUDAS das Archiv nicht extra an­ +melden müssen; dies geschieht automatisch, wenn Sie eine Funktion +aufrufen. Bei Leseoperationen müssen Sie nicht einmal den Archiv­ +namen wissen. Das Archiv wird automatisch wieder abgemeldet, +wenn Sie das Archivmenü verlassen. + +#on("b")#Archiv lesen#off("b")# Unter den in der Übersicht aufgelisteten +Dateien +sollten Sie auch die Datei finden, die Sie brauchen. Sie heißt +'Adressen'. An dieser Stelle ein kleiner Hinweis: An vielen Stellen +werden Sie sehen, daß Dateinamen in Anführungsstriche einge­ +schlossen sind. Die Anführungsstriche gehören jedoch #on("i")#nicht#off("i")# zum +Namen. Sie dienen nur zur Abgrenzung, da in Dateinamen beliebige +Zeichen erlaubt sind. Wenn Sie aufgefordert werden, einen Datei­ +namen einzugeben, müssen Sie dies immer ohne Anführungsstriche +tun. + Hoffentlich haben Sie in der ganzen Diskussion nicht das Ziel +aus den Augen verloren: Sie sollten eine Datei ins System holen, um +nachher mit ihr zu experimentieren. Zu diesem Zweck gibt es im +Archivmenü die Funktion +#free (0.2)# + + K Kopieren + (vom Archiv) + +#free (0.2)# +Wählen Sie diese Funktion jetzt mit den Pfeiltasten aus und drücken +Sie zum Ausführen die Leertaste. + +#on("b")#Eingabezustand#off("b")# Nach kurzem 'Bitte warten..'-Zustand werden +Sie +im rechten Bildschirmteil nach dem Namen der Datei gefragt. Gleich­ +zeitig erscheint eine neue Statuszeile. Es ergibt sich folgendes Bild: + +___________________________________________________________________________________________ + + EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbrechen: ESC h Hilfe: ESC ? + --------------:Dateiname: + Dateien Archiv: + U Übersicht : + D Üb. drucken : + --------------: + Datei : + * Kopieren : + vom Archiv : + ... + +___________________________________________________________________________________________ + + +Sie können in diesem Zustand den Namen der gewünschten Datei +eingeben. Außer den in der Statuszeile genannten Funktionen kön­ +nen Sie die aus dem Editor bekannten Tasten benutzen, um den +Text in der Zeile gegebenenfalls zu korrigieren (Pfeiltasten LINKS +und RECHTS, RUBOUT, RUBIN). Die Schreibmarke (Cursor) zeigt Ihnen +an, wo das nächste Zeichen plaziert wird. + +#on("b")#Abbruch#off("b")# Eine Tastenkombination verdient noch besondere +Beach­ +tung: Mit ESC 'h' können Sie in vielen Situationen eine Funktion +noch abbrechen - zum Beispiel wenn Sie irrtümlich die falsche +Funktion gewählt haben. + Im Gegensatz zu ESC 'q' erfolgt hier die sofortige Rückkehr aus +der Funktion ins Menü, möglichst ohne daß die Funktion Auswir­ +kungen hinterläßt. Bei einem Abbruch bleibt also in der Regel das +System unverändert. + +#on("b")#Fehlerzustand#off("b")# Um auch die Fehlerbehandlung von EUDAS +auszu­ +probieren, sollten Sie hier einen falschen Namen eingeben, zum +Beispiel: +#free (0.2)# + + Dateiname: #on("i")#Adresen#off("i")# + +#free (0.2)# +EUDAS sucht jetzt auf der Diskette nach einer Datei dieses Namens, +findet sie aber nicht. Als Reaktion erscheint dann die Meldung: + +___________________________________________________________________________________________ + + !!! FEHLER !!! Quittieren: ESC q Hilfe zur Meldung: ESC ? + --------------:Dateiname: Adresen + Dateien Archiv:>>> "Adresen" gibt es nicht + U Übersicht : + D Üb. drucken : + --------------: + ... + +___________________________________________________________________________________________ + + +Im Normalfall sollten Sie die Fehlermeldung mit ESC 'q' quittieren, +damit Sie den Befehl erneut versuchen können. Auch hier haben Sie +die Möglichkeit, eine besondere Information zu dem Fehler abzurufen +(es liegen jedoch nicht für alle möglichen Fehler spezielle Texte +vor). + Nach dem Quittieren des Fehlers befinden Sie sich wieder im +Menüzustand. Wiederholen Sie jetzt die Funktion, indem Sie die +Leertaste tippen. Sie werden dann erneut nach dem Namen gefragt. + +#on("b")#Auswahlzustand#off("b")# Um endlich ans Ziel zu kommen, benutzen Sie +diesmal eine sehr komfortable Abkürzung, die EUDAS Ihnen bietet. +Durch Drücken von ESC 'z' können Sie sich nämlich alle möglichen +Namen anzeigen lassen und den gewünschten einfach ankreuzen. + Anschließend sieht der Bildschirm wie in Abb. 4-4 aus. In die­ +sem Zustand können Sie mit den Pfeiltasten den Cursor zur ge­ +wünschten Datei bewegen und diese ankreuzen. Da Sie auch meh­ +rere Dateien in beliebiger Folge ankreuzen können, erscheint eine +'1' vor der Datei zur Anzeige der Reihenfolge. Sie wollen aber nur +diese eine Datei 'Adressen' holen und beenden die Auswahl daher +mit ESC 'q'. Wenn alles glattgeht, wird jetzt die Datei vom Archiv +ins System kopiert. + +#on("b")#Archiv schreiben#off("b")# Auf nahezu gleiche Weise können Sie mit +der Funktion + + + S Schreiben + auf Archiv + + +eine Datei wieder auf die Diskette schreiben. Als erstes müssen Sie +dann den Namen der Archivdiskette eingeben, damit Sie nicht aus +Versehen auf eine falsche Archivdiskette schreiben. + Auch hier können Sie die gewünschten Dateien ankreuzen (na­ +türlich bietet EUDAS dann die Dateien des Systems an). Sie brau­ +chen keine Angst zu haben, aus Versehen eine Datei mit gleichem +Namen zu überschreiben - EUDAS fragt in solchen Fällen immer +nochmal an. + +___________________________________________________________________________________________ + + AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ? + --------------:-------------------------------------------------------------- + Dateien Archiv: Auswahl der Dateien auf dem Archiv. + U Übersicht : Gewuenschte Datei(en) bitte ankreuzen: + D Üb. Drucken :-------------------------------------------------------------- + --------------: o "eudas.1" + Datei : o "eudas.2" + * Kopieren : o "eudas.3" + vom Archiv : o "eudas.4" + S Schreiben : o "eudas.init" + auf Archiv : o "eudas.generator" + L Löschen : o "Adressen" + auf Archiv :-------------------------------------------------------------- + --------------: + Archivdiskette: + I Init : + --------------: + Z Zielarchiv : + P Paßwort : + - Reservieren : + --------------: + : + : + Akt.Datei: Ziel: "ARCHIVE" Datum: 22.07.87 +___________________________________________________________________________________________ + + +#center#Abb. 4-4 Dateiauswahl + + + +4.4 Dateiverwaltung + +So: nach dieser anstrengenden Arbeit sollen Sie sich überzeugen, +daß die Datei 'Adressen' nun wirklich im System zur Verfügung +steht. Dazu gehen Sie mit LINKS ein Menü zurück. Dieses Menü +beschäftigt sich mit Dateien im System und ist in Abb. 4-5 gezeigt. + Auch hier finden Sie eine Funktion "Übersicht". Rufen Sie diese +auf. Ganz analog zum Archiv erscheint eine Übersicht aller Dateien +im Editor. Verlassen Sie die Übersicht wieder mit ESC 'q'. + +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + Dateien System: + U Übersicht : + --------------: + Datei : + L Löschen : + N Umbenennen : + K Kopieren : + P Platzbedarf : + A Aufräumen : + --------------: + : + : + : + : + : + : + : + : + : + : + : + Akt.Datei: Task: "arbeit" Datum: 22.07.87 +___________________________________________________________________________________________ + + +#center#Abb. 4-5 Menü 'Dateien' + + +#on("b")#Datei löschen#off("b")# Eine weitere Funktion aus diesem Menü werden +Sie ebenfalls noch öfter brauchen, nämlich +#free (0.2)# + + L Löschen + +#free (0.2)# +Mit dieser Funktion können Sie eine Datei wieder aus dem System +entfernen - zum Beispiel wenn Sie sich die Adressen angesehen +haben und danach den Speicherplatz nicht weiter verschwenden +wollen. Als letztes Beispiel sollen Sie auch diese Funktion aufrufen +(keine Angst, wir löschen die Datei nicht wirklich, es gibt vorher +noch eine Notbremse). + +#on("b")#Fragezustand#off("b")# Als erstes werden Sie wieder nach dem +Dateinamen +gefragt (dies ist Ihnen schon bekannt). Hier haben Sie jetzt die +Wahl, ob Sie den Namen eingeben oder mit ESC 'z' ankreuzen. Da das +Löschen unwiederbringlich ist, werden Sie anschließend zur Sicher­ +heit gefragt, ob Sie die Datei wirklich löschen wollen: + +___________________________________________________________________________________________ + + FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ? + --------------:Dateiname: Adressen + Dateien System:"Adressen" im System loeschen (j/n) ? + U Übersicht : + --------------: + ... + +___________________________________________________________________________________________ + + +Diese Frage können Sie bejahen oder verneinen (oder die Funktion +ohne Auswirkungen abbrechen). In diesem Fall sollten Sie die Frage +verneinen - es sei denn, Ihnen hat das Spielen mit EUDAS so gut +gefallen, daß Sie die ganze Prozedur wiederholen und die Datei +nochmal vom Archiv holen wollen. + + +4.5 Bedienungsregeln + +Mit dieser letzten Demonstration haben Sie jetzt schon fast alle +Arten des Umgangs mit EUDAS kennengelernt. Sicher ist dies beim +ersten Mal sehr verwirrend. Mit vier Regeln können Sie jedoch +EUDAS immer bedienen: + +#limit (12.0)# + 1. Achten Sie darauf, welche möglichen Tastendrücke + in der Statuszeile stehen. Richten Sie sich danach! +#free (0.2)# + 2. Sind Sie sich unsicher, rufen Sie Hilfsfunktion mit + ESC '?' auf. Damit erhalten Sie weitere Informatio­ + nen. +#free (0.2)# + 3. Funktioniert diese Tastenkombination nicht (geben + Sie dem Rechner eine kurze Zeit zum Reagieren), + versuchen Sie die Tastenkombinationen ESC 'h' (Ab­ + bruch) oder ESC 'q' (Verlassen). Falls sich daraufhin + etwas verändert, fangen Sie wieder mit 1. an. +#free (0.2)# + 4. Erfolgt darauf keine Reaktion, drücken Sie die SV- + Taste und versuchen Sie das Programm mit 'halt' zu + stoppen. Führt auch das nicht zum Erfolg, hat sich + Ihr Rechner "aufgehängt". Sie müssen den Rechner + dann neu starten. Wenn Sie keine Erfahrung mit + einer solchen Situation haben, wenden Sie sich an + Ihren Händler oder Systembetreuer. +#limit (13.5)# + +Im Zusammenhang mit dem letzten Punkt sei nochmal auf die Wich­ +tigkeit einer regelmäßigen Datensicherung auf Archivdisketten +hingewiesen. Im Normalfall sollten Sie aber mit den Punkten 1 bis 3 +zurechtkommen. + +#on("b")#Zustände#off("b")# Im letzten Abschnitt haben Sie eine ganze Reihe +von +Zuständen kennengelernt, die EUDAS einnehmen kann. In jedem +Zustand haben Sie verschiedene Möglichkeiten zur Reaktion. Glück­ +licherweise erscheinen diese Möglichkeiten zum großen Teil in der +Statuszeile. + Damit Sie die verwirrenden Erfahrungen des letzten Abschnitts +etwas ordnen können, wollen wir an dieser Stelle die verschiedenen +Zustände noch einmal zusammenfassen. Der Beschreibung vorange­ +stellt ist die jeweilige Kennzeichnung am Beginn der Statuszeile. + +EUDAS: #on("b")# Sie können mit ESC 'w' und ESC 'z' im Hilfstext blättern. Mit + ESC 'q' kommen Sie in den alten Zustand. + +AUSWAHL: Hier können Sie die gewünschten Namen mit 'x' ankreuzen + und mit 'o' wieder entfernen. Normales Beenden mit ESC 'q'. + Hilfestellung durch ESC '?'. Abbruch der gesamten Funktion mit + ESC 'h'. + +EINGABE: Hier können Sie eine einzelne Zeile eingeben oder ändern + (wie im Editor). Einfügen und Löschen mit RUBIN und RUBOUT. + Abbruch und Hilfestellung möglich. + +FRAGE: Beantworten Sie die gestellte Frage mit 'j' oder 'n'. Abbruch + (ESC 'h') und Hilfestellung (ESC '?') möglich. + +ZEIGEN: Mit HOP OBEN und HOP UNTEN können Sie in der Übersicht + blättern. Ende der Übersicht mit ESC 'q'. Hilfestellung möglich. + +!!! FEHLER !!! Quittieren Sie die Meldung mit ESC 'q'. Hilfestellung + möglich. + +Bitte warten.. In diesem Zustand keine Taste drücken, der Rechner + ist beschäftigt. + +Drei weitere Zustände, die Sie noch nicht kennengelernt haben, sind +hier schon mal der Vollständigkeit halber aufgeführt: + +SATZ ÄNDERN: +SATZ EINFÜGEN: +SUCHMUSTER EINGEBEN: Satzeditor zum Eingeben von Feldinhalten. + Normales Verlassen mit ESC 'q'. Abbruch und Hilfestellung mög­ + lich. Beschreibung s. 6.2. + +EDITIEREN: EUMEL-Editor mit Änderungsmöglichkeit für beliebige + Texte. Normales Verlassen mit ESC 'q'. Hilfestellung möglich. + Beschreibung der Möglichkeiten siehe EUMEL-Benutzerhand­ + buch. + +Gib Kommando: Hier können Sie ein beliebiges ELAN-Kommando ein­ + geben und mit RETURN bestätigen. Abbruch und Hilfestellung + möglich. Kann im Menü durch ESC ESC aufgerufen werden. + +Wie Sie sehen, werden auch hier wieder die gleichen Tastenkombi­ +nationen verwendet, die Sie schon kennen. + In dieser Übersicht sind jeweils nur die wichtigsten Tastenkom­ +binationen aufgeführt. Informieren Sie sich gegebenenfalls mit ESC +'?'. Einige weitere Tastenfunktionen werden Sie im folgenden noch +kennenlernen. Eine vollständige Übersicht finden Sie im Referenz­ +handbuch. + diff --git a/app/eudas/4.3/src/Adressen b/app/eudas/4.3/src/Adressen new file mode 100644 index 0000000..74f0e3d Binary files /dev/null and b/app/eudas/4.3/src/Adressen differ diff --git a/app/eudas/4.3/src/dummy.text b/app/eudas/4.3/src/dummy.text new file mode 100644 index 0000000..0eb03b0 --- /dev/null +++ b/app/eudas/4.3/src/dummy.text @@ -0,0 +1,14 @@ +PACKET dummy text DEFINES + lineform, pageform, autoform, autopageform : + +PROC lineform (TEXT CONST datei) : fehler END PROC lineform; +PROC pageform (TEXT CONST datei) : fehler END PROC pageform; +PROC autoform (TEXT CONST datei) : fehler END PROC autoform; +PROC autopageform (TEXT CONST datei) : fehler END PROC autopageform; + +PROC fehler : + errorstop ("Keine Textverarbeitung installiert") +END PROC fehler; + +END PACKET dummy text; + diff --git a/app/eudas/4.3/src/eudas.1 b/app/eudas/4.3/src/eudas.1 new file mode 100644 index 0000000..18607c4 --- /dev/null +++ b/app/eudas/4.3/src/eudas.1 @@ -0,0 +1,52 @@ +PACKETeudassatzzugriffeDEFINES SATZ,:=,satzinitialisieren,felderzahl,feldlesen,feldbearbeiten,feldaendern,feldindex:LETb0=256,c0=2;LETd0=" ",e0="";LETf0=#101 +#" ist keine Feldnummer";TEXT VARg0:=c0*d0;TYPE SATZ=TEXT;OP:=(SATZ VARh0,SATZ CONSTi0):CONCR(h0):=CONCR(i0)END OP:=;PROCsatzinitialisieren(SATZ VARj0):satzinitialisieren(j0,0)END PROCsatzinitialisieren;PROCsatzinitialisieren(SATZ VARj0,INT CONSTk0):replace(g0,1,2*k0+3);INT VARl0;CONCR(j0):=e0;FORl0FROM1UPTOk0+1REP CONCR(j0)CATg0END REP END PROCsatzinitialisieren;INT PROCfelderzahl(SATZ CONSTj0):INT VARm0:=(CONCR(j0)ISUB1)DIV2;INT CONSTn0:=CONCR(j0)ISUBm0;REPm0DECR1UNTILm0<=0CORo0END REP;m0.o0:(CONCR(j0)ISUBm0)<>n0.END PROCfelderzahl;PROCfeldlesen(SATZ CONSTj0,INT CONSTp0,TEXT VARq0):r0(CONCR(j0),p0);IF NOTiserrorTHENq0:=subtext(CONCR(j0),s0,t0)END IF END PROCfeldlesen;PROCfeldbearbeiten(SATZ CONSTj0,INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):r0(CONCR(j0),p0);IF NOTiserrorTHENu0(CONCR(j0),s0,t0)END IF END PROCfeldbearbeiten;INT VARs0,t0;PROCr0(TEXT CONSTj0,INT CONSTp0):IFv0THENerrorstop(text(p0)+f0)ELIFw0THENs0:=j0ISUBp0;t0:=(j0ISUBp0+1)-1ELSEs0:=1;t0:=0END IF.v0:p0<=0ORp0>b0. +w0:p0+p0<(j0ISUB1)-1.END PROCr0;TEXT VARx0;PROCfeldaendern(SATZ VARj0,INT CONSTp0,TEXT CONSTq0):INT VARy0;INT CONSTz0:=((CONCR(j0)ISUB1)-2)DIV2;IFa1THENb1ELSEerrorstop(text(p0)+f0)END IF.a1:p0>0ANDp0<=b0.b1:INT CONSTc1:=p0-z0;IFc1<=0THENd1ELIFq0<>e0THENe1END IF.e1:INT CONSTf1:=CONCR(j0)ISUB(z0+1);x0:=subtext(CONCR(j0),g1,f1-1);CONCR(j0):=subtext(CONCR(j0),1,z0+z0);h1(CONCR(j0),1,z0,i1);j1;k1;CONCR(j0)CATx0;CONCR(j0)CATq0.i1:c1+c1.j1:INT CONSTl1:=f1+i1;FORy0FROMz0+1UPTOp0REPm1(CONCR(j0),l1)END REP.k1:m1(CONCR(j0),l1+length(q0)).g1:CONCR(j0)ISUB1.d1:INT CONSTs0:=CONCR(j0)ISUBp0,n1:=CONCR(j0)ISUB(p0+1);IFs0>length(CONCR(j0))THENo1ELSEp1END IF.o1:h1(CONCR(j0),p0+1,z0+1,length(q0));CONCR(j0)CATq0.p1:x0:=subtext(CONCR(j0),n1);CONCR(j0):=subtext(CONCR(j0),1,s0-1);h1(CONCR(j0),p0+1,z0+1,q1);CONCR(j0)CATq0;CONCR(j0)CATx0.q1:length(q0)-r1.r1:n1-s0.END PROCfeldaendern;PROCm1(TEXT VARj0,INT CONSTs1):replace(g0,1,s1);j0CATg0END PROCm1;PROCh1(TEXT VARj0,INT CONSTt1,u1,v1):INT VARy0;FORy0FROMt1UPTOu1 +REPreplace(j0,y0,w1+v1)END REP.w1:j0ISUBy0.END PROCh1;INT PROCfeldindex(SATZ CONSTj0,TEXT CONSTx1):INT VARt1:=(CONCR(j0)ISUB1)-1,y0:=1;REPt1:=pos(CONCR(j0),x1,t1+1);IFt1=0THEN LEAVEfeldindexWITH0END IF;y1UNTILz1CANDa2END REP;y0.y1:WHILE(CONCR(j0)ISUBy0)length(r1)+1THENt1ELSEreplace(l1,1,q1);p1:=subtext(r1,begin);r1:=subtext(r1,1,begin-1);r1CATl1;r1CATp1END IF END PROCinsert;PROCdelete(INTVEC VARr1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>=length(r1)THENt1ELSEp1:=subtext(r1,begin+2);r1:=subtext(r1,1,begin-1);r1CATp1END IF END PROCdelete;INT PROCpos(INTVEC CONSTr1,INT CONSTq1):replace(l1,1,q1);INT VARbegin:=1;REPbegin:=pos(r1,l1,begin)+1UNTIL(beginAND1)=0ORbegin=1END REP;beginDIV2END PROCpos;PROCu1(INTVEC VARv1,w1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(v1)+1THENt1ELSEw1:=subtext(v1,begin);v1:=subtext(v1,1,begin-1)END IF END PROCu1;PROCx1(INTVEC VARv1,w1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin +>length(v1)+1THENt1ELSEw1:=subtext(v1,1,begin-1);v1:=subtext(v1,begin)END IF END PROCx1;.t1:errorstop(9,f1).s1:errorstop(10,f1).PROCy1(DATEI VARz1):z1.felderzahl:=0;z1.feldinfo:=o1;satzinitialisieren(z1.p0);z1.q0:=f1;z1.r0:=1;z1.s0:=1;z1.u0:=0;z1.t0:=0;z1.w0:=0;z1.v0:=1;z1.a1:=0;z1.c1(1):=f1;z1.c1(2):=f1;z1.c1(3):=f1;z1.satznr:=1;z1.x0:=1;z1.y0:=1;z1.z0:=1;z1.index(1).l0:=m1;z1.index(1):=INDEX:(0,0,1,1,n1(1,1));INT VARa2;FORa2FROM1UPTOb0REPz1.d1(a2):=0END REP;z1.e1(1):=EINTRAG:(0,0,1,0,b2).b2:z1.p0.END PROCy1;PROCoeffne(EUDAT VARz1,TEXT CONSTc2):enablestop;IF NOTexists(c2)THEN CONCR(z1):=new(c2);y1(CONCR(z1));type(old(c2),e0)ELIFtype(old(c2))=e0THEN CONCR(z1):=old(c2)ELSEerrorstop(g1)ENDIF END PROCoeffne;PROCoeffne(EUDAT VARz1,DATASPACE CONSTd2):IFtype(d2)<0THEN CONCR(z1):=d2;y1(CONCR(z1));type(d2,e0)ELIFtype(d2)=e0THEN CONCR(z1):=d2ELSEerrorstop(g1)END IF END PROCoeffne;PROCfeldlesen(EUDAT CONSTz1,INT CONSTe2,TEXT VARf2):feldlesen(g2,e2,f2).g2:z1.e1(z1.z0).o0.END PROCfeldlesen;PROC +feldaendern(EUDAT VARz1,INT CONSTe2,TEXT CONSTh2):IFi2THENj2(CONCR(z1));k2;feldaendern(g2,e2,h2)END IF.i2:z1.z0<>1.k2:IFe2=1THENdisablestop;l2(CONCR(z1),m2(h2))END IF.g2:z1.e1(z1.z0).o0.END PROCfeldaendern;INT PROCfelderzahl(EUDAT CONSTz1):z1.felderzahlEND PROCfelderzahl;PROCfeldbearbeiten(EUDAT CONSTz1,INT CONSTe2,PROC(TEXT CONST,INT CONST,INT CONST)n2):feldbearbeiten(g2,e2,PROC(TEXT CONST,INT CONST,INT CONST)n2).g2:z1.e1(z1.z0).o0.END PROCfeldbearbeiten;PROCfeldnamenlesen(EUDAT CONSTz1,SATZ VARo2):o2:=z1.p0END PROCfeldnamenlesen;PROCfeldnamenaendern(EUDAT VARz1,SATZ CONSTp2):z1.p0:=p2;INT CONSTq2:=felderzahl(p2);IFq2>z1.felderzahlTHENr2;z1.felderzahl:=q2END IF.r2:z1.feldinfoCATn1(s2,-1).s2:q2-length(z1.feldinfo)DIV2.END PROCfeldnamenaendern;INT PROCfeldinfo(EUDAT CONSTz1,INT CONSTe2):z1.feldinfoISUBe2END PROCfeldinfo;PROCfeldinfo(EUDAT VARz1,INT CONSTe2,t2):replace(z1.feldinfo,e2,t2);IFpos(z1.q0,code(e2))>0THENz1.a1:=z1.w0END IF END PROCfeldinfo;INT PROCsatznr(EUDAT CONSTz1):z1. +satznrEND PROCsatznr;BOOL PROCdateiende(EUDAT CONSTz1):z1.satznr>z1.w0END PROCdateiende;INT PROCsaetze(EUDAT CONSTz1):z1.w0END PROCsaetze;PROCu2(DATEI VARz1,INT CONSTx0,k0,satznr):IFx0<1ORx0>z1.s0CORk0<1ORk0>z1.index(x0).j0THENerrorstop(h1)END IF;disablestop;z1.x0:=x0;z1.y0:=k0;z1.satznr:=satznr;z1.z0:=z1.index(x0).l0ISUBk0END PROCu2;PROCaufsatz(EUDAT VARz1,INT CONSTv2):INT VARsatznr;IFv2<1THENsatznr:=1ELIFv2>z1.w0THENsatznr:=z1.w0+1ELSEsatznr:=v2END IF;w2(CONCR(z1),satznr)END PROCaufsatz;PROCaufsatz(EUDAT VARz1,TEXT CONSTx2):aufsatz(z1,1);IFy2THENweiter(z1,x2)END IF.y2:feldlesen(z1,1,k1);k1<>x2.END PROCaufsatz;PROCw2(DATEI VARz1,INT CONSTsatznr):IFz2THENu2(z1,1,1,1)END IF;INT VARx0:=z1.x0,a3:=z1.satznr-z1.y0;IFsatznr>z1.satznrTHENb3ELSEc3END IF;u2(z1,x0,k0,satznr).z2:satznr+satznr=satznr.k0:satznr-a3.END PROCw2; +PROCweiter(EUDAT VARz1):f3(CONCR(z1))END PROCweiter;PROCf3(DATEI VARz1):IFg3THENh3END IF.g3:z1.z0<>1.h3:INT VARx0:=z1.x0,k0:=z1.y0;IFk0=index.j0THENx0:=index.i0;k0:=1ELSEk0INCR1END IF;u2(z1,x0,k0,z1.satznr+1).index:z1.index(x0).END PROCf3;PROCzurueck(EUDAT VARz1):i3(CONCR(z1))END PROCzurueck;PROCi3(DATEI VARz1):IFj3THENk3END IF.j3:z1.satznr<>1.k3:INT VARx0:=z1.x0,k0:=z1.y0;IFk0=1THENx0:=m0.h0;k0:=m0.j0ELSEk0DECR1END IF;u2(z1,x0,k0,z1.satznr-1).m0:z1.index(x0).END PROCi3;PROCweiter(EUDAT VARz1,TEXT CONSTx2):f3(CONCR(z1),x2)END PROCweiter;PROCf3(DATEI VARz1,TEXT CONSTx2):l3;WHILEm3CANDn3REPo3END REP;IFm3THENp3(z1,k0)ELSEw2(z1,z1.w0+1)END IF.l3:INT VARq3,k0:=z1.z0;IFn3THENr3(z1,m2(x2),k0,q3)ELSEo3END IF.m3:k0<>0.n3:feldlesen(g2,1,k1);k1<>x2.g2:z1.e1(k0).o0.o3:k0:=z1.e1(k0).i0.END PROCf3;PROCzurueck(EUDAT VARz1,TEXT CONSTx2):i3(CONCR(z1),x2)END PROCzurueck;PROCi3(DATEI VARz1,TEXT CONSTx2):l3;WHILEm3CANDn3REPs3END REP;IFm3THENp3(z1,k0)ELSEw2(z1,1)END IF.l3:INT VARk0:=z1.z0,q3;IFk0=1ORt3THEN +r3(z1,m2(x2),q3,k0)END IF.m3:k0<>0.n3:k0=z1.z0ORt3.t3:feldlesen(g2,1,k1);k1<>x2.g2:z1.e1(k0).o0.s3:k0:=z1.e1(k0).h0.END PROCi3;PROCp3(DATEI VARz1,INT CONSTk0):INT CONSTu3:=z1.e1(k0).m0;INT VARy0:=1,satznr:=0;WHILEy0<>u3REPsatznrINCRz1.index(y0).j0;y0:=z1.index(y0).i0END REP;y0:=pos(z1.index(u3).l0,k0);satznrINCRy0;u2(z1,u3,y0,satznr).END PROCp3;INT VARindex;PROCv3(TEXT CONSTw3,INT CONSTx3,y3):INT VARz3:=x3;index:=0;IFy3-x3<4THENa4ELSEb4END IF;index:=indexMODb0+1.a4:WHILEz3<=y3REPindex:=index*4;indexINCRcode(w3SUBz3);z3INCR1END REP.b4:WHILEz3<=y3REPindexINCRindex;indexINCRcode(w3SUBz3);IFindex>16000THENindex:=indexMODb0END IF;z3INCR1END REP.END PROCv3;INT PROCm2(TEXT CONSTw3):v3(w3,1,length(w3));indexEND PROCm2;INT PROCm2(SATZ CONSTo0):feldbearbeiten(o0,1,PROC(TEXT CONST,INT CONST,INT CONST)v3);indexEND PROCm2;PROCr3(DATEI CONSTz1,INT CONSTm2,INT VARk0,c4):INT VARx0:=z1.r0;c4:=z1.d1(m2);k0:=0;BOOL VARd4:=TRUE;WHILEd4ANDc4<>0REPe4;o3END REP.e4:IFf4THENg4ELSEh4END IF.f4:z1.e1(c4).m0=z1.x0 +.g4:x0:=z1.x0;INT CONSTi4:=pos(l0,c4);IFi4=0THENerrorstop(h1)ELIFi4<=j4THENd4:=FALSE END IF.l0:z1.index(x0).l0.j4:z1.y0.h4:WHILEx0<>z1.e1(c4).m0REP IFx0=z1.x0THENd4:=FALSE;LEAVEe4ELSEx0:=z1.index(x0).h0END IF END REP.o3:IFd4THENk0:=c4;c4:=z1.e1(k0).h0END IF.END PROCr3;PROCk4(DATEI VARz1,INT CONSTm2):disablestop;INT CONSTk0:=z1.z0,h0:=z1.e1(k0).h0,i0:=z1.e1(k0).i0;IFi0<>0THENz1.e1(i0).h0:=h0ELSEz1.d1(m2):=h0END IF;IFh0<>0THENz1.e1(h0).i0:=i0END IF.END PROCk4;PROCl4(DATEI VARz1,INT CONSTm2,i0,h0):disablestop;INT CONSTk0:=z1.z0;z1.e1(k0).h0:=h0;z1.e1(k0).i0:=i0;IFh0<>0THENz1.e1(h0).i0:=k0END IF;IFi0<>0THENz1.e1(i0).h0:=k0ELSEz1.d1(m2):=k0END IF END PROCl4;PROCsatzlesen(EUDAT CONSTz1,SATZ VARo0):o0:=z1.e1(z1.z0).o0END PROCsatzlesen;PROCsatzaendern(EUDAT VARz1,SATZ CONSTm4):IF NOTdateiende(z1)THENn4END IF.n4:j2(CONCR(z1));disablestop;l2(CONCR(z1),m2(m4));g2:=m4.g2:z1.e1(z1.z0).o0.END PROCsatzaendern;PROCl2(DATEI VARz1,INT CONSTo4):IFp4THENq4END IF.p4:INT CONSTr4:=m2(g2);r4<>o4.q4:s4;t4.s4: +k4(z1,r4).t4:INT VARh0,i0;r3(z1,o4,h0,i0);l4(z1,o4,h0,i0).g2:z1.e1(z1.z0).o0.END PROCl2;PROCsatzloeschen(EUDAT VARz1):IF NOTdateiende(z1)THENu4END IF.u4:disablestop;v4(CONCR(z1));w4(CONCR(z1));z1.w0DECR1.END PROCsatzloeschen;PROCv4(DATEI VARz1):x4(z1);INT CONSTk0:=z1.z0;k4(z1,m2(g2));z1.e1(k0).i0:=z1.u0;z1.u0:=k0.g2:z1.e1(k0).o0.END PROCv4;PROCsatzeinfuegen(EUDAT VARz1,SATZ CONSTm4):y4(CONCR(z1),m4)END PROCsatzeinfuegen;PROCy4(DATEI VARz1,SATZ CONSTm4):INT VARk0,h0,i0;enablestop;z4;a5;disablestop;z1.w0INCR1;b5(z1,k0);INT CONSTc5:=m2(k1);r3(z1,c5,i0,h0);l4(z1,c5,i0,h0);j2(z1).z4:IFz1.u0<>0THENk0:=z1.u0;z1.u0:=z1.e1(k0).i0ELIFz1.v0=d0THENerrorstop(i1)ELSEz1.v0INCR1;k0:=z1.v0END IF;z1.e1(k0).n0:=0;z1.e1(k0).o0:=m4.a5:feldlesen(m4,1,k1);IFz1.b1>0THEN IFk1=""THENd5;feldaendern(z1.e1(k0).o0,1,k1)END IF END IF.d5:k1:=text(z1.b1);k1:=e5+k1;IFz1.b1>32000THENz1.b1:=1ELSEz1.b1INCR1END IF.e5:(4-length(k1))*"0".END PROCy4;PROCautomatischerschluessel(EUDAT VARf5,BOOL CONSTg5):IFg5ANDf5.b1<0OR NOTg5 +ANDf5.b1>0THENf5.b1:=-f5.b1END IF END PROCautomatischerschluessel;BOOL PROCautomatischerschluessel(EUDAT CONSTf5):f5.b1>0END PROCautomatischerschluessel;INTVEC VARh5;PROCw4(DATEI VARz1):INT CONSTx0:=z1.x0,h0:=index.h0,i0:=index.i0;BOOL VARi5;delete(index.l0,z1.y0);index.j0DECR1;j5(z1,x0,i0,i5);IF NOTi5THENj5(z1,h0,x0,i5)END IF;k5(z1).index:z1.index(x0).END PROCw4;PROCj5(DATEI VARz1,INT CONSTz3,l5,BOOL VARi5):i5:=FALSE;IFz3<>0ANDl5<>0THENm5END IF.m5:INT CONSTn5:=index.j0,o5:=p5.j0;IFq5THENr5;i5:=TRUE END IF.q5:n5+o5<=g0ORn5=0ORo5=0.r5:index.j0INCRp5.j0;s5(z1,p5.l0,z3);index.l0CATp5.l0;t5.t5:index.i0:=p5.i0;IFindex.i0<>0THENz1.index(index.i0).h0:=z3ELSEz1.r0:=z3END IF;p5.i0:=z1.t0;z1.t0:=l5.index:z1.index(z3).p5:z1.index(l5).END PROCj5;PROCk5(DATEI VARz1):INT CONSTg2:=z1.satznr;u2(z1,1,1,1);w2(z1,g2)END PROCk5;PROCs5(DATEI VARz1,INTVEC CONSTl0,INT CONSTz3):INT VARa2;FORa2FROM1UPTOlength(l0)DIV2REPz1.e1(l0ISUBa2).m0:=z3END REP END PROCs5;PROCb5(DATEI VARz1,INT CONSTu5):INT VARx0:=z1.x0;IF +index.j0>=f0THENv5END IF;index.j0INCR1;insert(index.l0,z1.y0,u5);z1.z0:=u5;z1.e1(u5).m0:=x0.v5:INT VARc5:=0;w5;IFc5<>0THENx5ELSEy5(z1)END IF;k5(z1);x0:=z1.x0.w5:IFz1.t0<>0THENc5:=z1.t0;z1.t0:=p5.i0ELIFz1.s00THENz1.index(c6).h0:=c5ELSEz1.r0:=c5END IF;p5.i0:=c6;p5.h0:=x0;index.i0:=c5.a6:INT VARb6;IFd6THENb6:=g0ELSEb6:=index.j0DIV2+1END IF.d6:c6=0.index:z1.index(x0).p5:z1.index(c5).END PROCb5;PROCy5(DATEI VARz1):INT VARx0:=1;REPe6;f6END REP.e6:BOOL VARi5;REP INT CONSTi0:=index.i0;j5(z1,x0,i0,i5)UNTIL NOTi5END REP;IFi0=0THEN LEAVEy5ELIFg6THENh6END IF.g6:INT CONSTi6:=g0-index.j0;i6>0.h6:x1(p5.l0,h5,i6+1);p5.j0DECRi6;s5(z1,h5,x0);index.l0CATh5;index.j0:=g0.f6:x0:=i0.index:z1.index(x0).p5:z1.index(i0).END PROCy5;TEXT VARj6:=",";LETk6=1;TEXT PROCdezimalkomma:j6END PROCdezimalkomma;PROCdezimalkomma(TEXT CONSTl6):IFlength(l6)<>1THENerrorstop( +j1)ELSEj6:=l6ENDIF END PROCdezimalkomma;INT PROCunsortiertesaetze(EUDAT CONSTz1):z1.a1END PROCunsortiertesaetze;TEXT PROCsortierreihenfolge(EUDAT CONSTz1):z1.q0END PROCsortierreihenfolge;PROCj2(DATEI VARz1):IFm6(z1)THENdisablestop;z1.e1(z1.z0).n0INCRk6;z1.a1INCR1END IF END PROCj2;PROCx4(DATEI VARz1):IF NOTm6(z1)THENdisablestop;z1.e1(z1.z0).n0DECRk6;z1.a1DECR1END IF END PROCx4;BOOL PROCm6(DATEI CONSTz1,INT CONSTk0):(z1.e1(k0).n0ANDk6)=0END PROCm6;BOOL PROCm6(DATEI CONSTz1):m6(z1,z1.z0)END PROCm6;INTVEC VARn6;TEXT VARq0;TEXT VARo6,p6;PROCsortiere(EUDAT VARz1):q0:=z1.q0;IFq0=f1THENq6END IF;r6(CONCR(z1)).q6:INT VARa2;FORa2FROM1UPTOz1.felderzahlREPq0CATcode(a2)END REP.END PROCsortiere;PROCsortiere(EUDAT VARz1,TEXT CONSTs6):q0:=s6;r6(CONCR(z1))END PROCsortiere;PROCr6(DATEI VARz1):IFz1.q0<>q0THENz1.q0:=q0;z1.a1:=z1.w0+1ELIFz1.a1=0THEN LEAVEr6END IF;n6:=z1.feldinfo;IFt6THENu6(z1);z1.a1:=0ELSEv6(z1)END IF;w2(z1,1).t6:z1.w0DIVz1.a1<3.END PROCr6;PROCu6(DATEI VARz1):INT VARz0,o0:=1,w6;w2(z1,1);x4( +z1);z0:=z1.z0;WHILEx6REPy6;z6;cout(o0)END REP;disablestop;y5(z1);u2(z1,1,1,1).x6:o0e7REPi3(z1);IFm7THEN LEAVEl7END IF END REP;LEAVEc7.m7:m6(z1).j7:IFn7GROESSERz1.e1(z0).o0THENf7:=g7-1ELSEe7:=g7+1END IF.n7:z1.e1(k7).o0.d7:p3(z1,z0);IFz1.satznrg8THEN LEAVEt7END IF.b8:IF NOT(o6LEXEQUALp6)THEN LEAVEt7END IF.d8:IFo6<>p6THEN LEAVEt7END IF.x7:IFe8THENf8>g8ELSEf8p6ELSEo6p6ELSEo60THENtext:="-"ELSEtext:=f1END IF;.n8:TEXT CONSTo8:=i8SUBk0;IFpos(j8,o8)>0THENtextCATo8ELIFo8=k8 +THENtextCAT".";k8:=f1END IF.END PROCwertberechnen;PROCh8(TEXT VARp8):IFlength(p8)<>8THENp8:=f1ELSEp8:=subtext(p8,7)+subtext(p8,4,5)+subtext(p8,1,2)END IF END PROCh8;PROCreorganisiere(TEXT CONSTc2):EUDAT VARq8,r8;oeffne(q8,c2);disablestop;DATASPACE VARd2:=nilspace;oeffne(r8,d2);s8(CONCR(q8),r8);IF NOTiserrorTHENforget(c2,quiet);copy(d2,c2)END IF;forget(d2)END PROCreorganisiere;PROCs8(DATEI VARq8,EUDAT VARr8):enablestop;t8;u8(q8,CONCR(r8)).t8:w2(q8,1);aufsatz(r8,1);WHILE NOTdateiendeREPsatzeinfuegen(r8,v8);cout(q8.satznr);f3(q8);weiter(r8)END REP.dateiende:q8.satznr>q8.w0.v8:q8.e1(q8.z0).o0.END PROCs8;PROCu8(DATEI VARq8,r8):r8.felderzahl:=q8.felderzahl;r8.p0:=q8.p0;r8.feldinfo:=q8.feldinfo;r8.q0:=q8.q0;r8.c1(1):=q8.c1(1);r8.c1(2):=q8.c1(2);r8.c1(3):=q8.c1(3)END PROCu8;PROCnotizenlesen(EUDAT CONSTz1,INT CONSTv2,TEXT VARw8):w8:=z1.c1(v2)END PROCnotizenlesen;PROCnotizenaendern(EUDAT VARz1,INT CONSTv2,TEXT CONSTw8):z1.c1(v2):=w8END PROCnotizenaendern;END PACKETeudasdateien; +PACKETdatenverwaltungDEFINESoeffne,kopple,kette,zugriff,sichere,dateienloeschen,aufkoppeldatei,anzahlkoppeldateien,anzahldateien,aendernerlaubt,inhaltveraendert,eudasdateiname,folgedatei,dateiversion,anzahlfelder,feldnamenlesen,feldnamenbearbeiten,feldnummer,feldinfo,notizenlesen,notizenaendern,feldlesen,feldbearbeiten,feldaendern,satznummer,satzkombination,dateiende,weiter,zurueck,aufsatz,satzeinfuegen,satzloeschen,aenderungeneintragen,suchbedingung,suchbedingunglesen,suchbedingungloeschen,suchversion,satzausgewaehlt,markierungaendern,satzmarkiert,markierungenloeschen,markiertesaetze:LET INTVEC=TEXT,DATEI=STRUCT(TEXTname,SATZb0,INTVECc0,INTd0,INTe0,INTf0,DATASPACEg0,EUDATh0,SATZi0,BOOLj0,BOOLk0,l0,m0,TEXTn0,INTVECo0,INTp0),VERWEIS=STRUCT(INTq0,r0);LETs0="",t0="";LETmaxint=32767,u0=10,v0=256,w0=32;ROWu0DATEI VARx0;INT VARy0:=0,z0:=0,a1,b1:=0,c1,d1:=0,e1,f1,g1,h1:=0;BOOL VARi1:=TRUE,j1,k1;TEXT VARl1;ROWv0VERWEIS VARm1;ROWw0VERWEIS VARn1;INT VARo1;LETp1=#301 +#"Zuviel Dateien geoeffnet",q1=#302 +#"Datei existiert nicht",r1=#303 +#"Nicht moeglich, wenn auf Koppeldatei geschaltet",s1=#304 +#"Zu viele Felder",t1=#305 +#"Zu viele Koppelfelder",u1=#306 +#"keine Koppelfelder vorhanden",v1=#307 +#"kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien",w1=#308 +#"keine Datei geoeffnet",x1=#309 +#"Datei nicht gesichert",y1=#310 +#"Suchmuster zu umfangreich";TEXT VARz1;TEXT VARa2:=" ";INTVEC VARb2;OP CAT(INTVEC VARtext,INT CONSTwert):replace(a2,1,wert);textCATa2END OP CAT;PROCinsert(INTVEC VARc2,INT CONSTd2,wert):INT CONSTe2:=d2+d2-2;b2:=subtext(c2,e2+1);c2:=subtext(c2,1,e2);c2CATwert;c2CATb2END PROCinsert;PROCdelete(INTVEC VARc2,INT CONSTd2):INT CONSTe2:=d2+d2-2;b2:=subtext(c2,e2+3);c2:=subtext(c2,1,e2);c2CATb2END PROCdelete;PROCf2(INTVEC VARc2,INT CONSTg2,h2):INT VARi2;FORi2FROMg2UPTOlength(c2)DIV2-1REPreplace(c2,i2,(c2ISUBi2)+h2)END REP END PROCf2;EUDAT VARj2;SATZ VARk2;PROCl2(TEXT CONSTm2):IFy0=u0THENerrorstop(p1)END IF;IF NOTexists(m2)THENerrorstop(q1)END IF;IFn2THENerrorstop(r1)END IF;oeffne(j2,m2)END PROCl2;PROCo2(DATEI VARq0,TEXT CONSTm2):IFj1THENq0.g0:=old(m2);oeffne(q0.h0,q0.g0)ELSEoeffne(q0.h0,m2)END IF;q0.e0:=0;q0.k0:=FALSE;q0.l0:=FALSE;q0.name:=m2;p2(q0)END PROCo2;PROCq2(INT CONSTr2):INT VARs2:=r2;WHILEx0(s2).e0<>0REPs2:=x0(s2).e0END REP;x0(s2).e0:=y0END PROCq2;PROCt2:IFdateiende(x0(1).h0)THEN +aufsatz(1)ELSEaufsatz(satznr(x0(1).h0))END IF END PROCt2;PROCu2:c1:=felderzahl(x0(1).h0);d1:=c1;feldnamenlesen(x0(1).h0,x0(1).b0);o1:=0;INT VARi2;FORi2FROM1UPTOd1REPm1(i2).q0:=0END REP END PROCu2;PROCv2:h1INCR1;IFh1>32000THENh1:=-32000END IF END PROCv2;PROCoeffne(TEXT CONSTm2,BOOL CONSTw2):enablestop;dateienloeschen(FALSE);suchbedingungloeschen;l2(m2);j1:=w2;x2;o2(x0(y0),m2);t2;u2.x2:y0:=1;v2;g1:=0.END PROCoeffne;PROCkopple(TEXT CONSTm2):enablestop;IFy0=0THENerrorstop(w1)END IF;l2(m2);y2;z2;a3;o2(x0(y0),m2);b3.y2:feldnamenlesen(j2,k2);INT VARc0:=0;INTVEC VARc3:=t0;WHILEc00THENc0INCR1;c3CATindexEND IF UNTILindex=0END REP.z2:IFd1+felderzahl(j2)-c0>v0THENerrorstop(s1)ELIFo1+c0>w0THENerrorstop(t1)ELIFc0=0THENerrorstop(u1)END IF;y0INCR1;x0(y0).b0:=k2;x0(y0).c0:=c3;x0(y0).d0:=c0;INT VARd3:=c0;WHILEd3=i3THENm1(k3).q0INCR1END IF END REP.a3:z0INCR1;IFb1=0THENb1:=y0ELSEq2(b1)END IF.b3:v2;x0(y0).j0:=FALSE;x0(y0).m0:=FALSE;x0(y0).f0:=satznr(j2);l3(x0(y0)).END PROCkopple;PROCkette(TEXT CONSTm2):enablestop;IFy0=0THENerrorstop(w1)END IF;l2(m2);y0INCR1;o2(x0(y0),m2);q2(1);IFi1THENaufsatz(satznummer)END IF END PROCkette;PROCzugriff(PROC(EUDAT VAR)m3):IFy0>1ORn2THENerrorstop(v1)ELSEaenderungeneintragen;m3(x0(1).h0);v2;t2;u2;x0(1).l0:=TRUE ENDIF END PROCzugriff;PROCsichere(INT CONSTn3,TEXT CONSTm2):aenderungeneintragen;notizenaendern(x0(n3).h0,2,date);IFj1THENforget(m2,quiet);copy(x0(n3).g0,m2)END IF;x0(n3).l0:=FALSE END PROCsichere;PROCdateienloeschen(BOOL CONSTo3):aenderungeneintragen;IFn2THEN +aufkoppeldatei(0)END IF;p3;q3.p3:z0:=0;b1:=0;x0(1).e0:=0;d1:=0;i1:=TRUE.q3:WHILEy0>0REP IFr3AND NOTo3THENerrorstop(x1);LEAVEdateienloeschenEND IF;forget(x0(y0).g0);y0DECR1END REP.r3:j1ANDx0(y0).l0.END PROCdateienloeschen;INT VARs3,t3,u3,v3,w3,x3,y3,z3;BOOL VARa4;INTVEC VARb4;SATZ VARc4;BOOL VARn2:=FALSE;INT VARd4:=0,e4:=1;BOOL PROCaufkoppeldatei:n2END PROCaufkoppeldatei;PROCaufkoppeldatei(INT CONSTf4):disablestop;v2;IFn2THENg4;n2:=FALSE;h4;i4ELSEj4;n2:=TRUE;k4 END IF.g4:a1:=s3;c1:=t3;d1:=u3;e1:=v3;g1:=x3;b1:=y3;x0(e4).e0:=z3;l4:=d4;k1:=a4;m4:=b4;n4:=c4;IFl4>0THENk8:=1ELSEk8:=-1END IF. +i4:d4:=0;e4:=1;enablestop;aufsatz(satznummer);WHILEf1<>w3REPweiter(1)END REP.h4:x0(e4).f0:=satznr(x0(e4).h0);IFf4=1AND NOTdateiende(x0(a1).h0)THENo4END IF.o4:INT VARp4;FORp4FROM1UPTOx0(e4).d0REPfeldaendern(x0(a1).h0,q4,r4)END REP;w3:=1.q4:x0(e4).c0ISUBp4.r4:feldlesen(x0(e4).h0,p4,z1);z1.j4:s3:=a1;t3:=c1;u3:=d1;v3:=e1;w3:=f1;x3:=g1;y3:=b1;z3:=x0(f4).e0;a4:=k1;b4:=m4;c4:=n4.k4:a1:=f4;d4:=l4;e4:=f4;c1:=felderzahl(x0(f4).h0);d1:=c1;e1:=0;g1 +:=(length(x0(f4).o0)-1)DIV2;b1:=0;x0(f4).e0:=0;suchbedingungloeschen;aufsatz(x0(f4).f0).END PROCaufkoppeldatei;INT PROCanzahlkoppeldateien:z0END PROCanzahlkoppeldateien;INT PROCanzahldateien:y0END PROCanzahldateien;BOOL PROCaendernerlaubt:j1END PROCaendernerlaubt;BOOL PROCinhaltveraendert(INT CONSTs4):aenderungeneintragen;x0(s4).l0END PROCinhaltveraendert;TEXT PROCeudasdateiname(INT CONSTs4):x0(s4).nameEND PROCeudasdateiname;INT PROCfolgedatei(INT CONSTs4):IFs4=0THENb1ELSEx0(s4).e0END IF END PROCfolgedatei;INT PROCdateiversion:h1END PROCdateiversion;INT PROCanzahlfelder:d1END PROCanzahlfelder;PROCfeldnamenlesen(INT CONSTd3,TEXT VARname):IFd3<=c1THENfeldlesen(x0(e4).b0,d3,name)ELSEfeldlesen(t4,u4,name)END IF.t4:x0(m1(d3).q0).b0.u4:m1(d3).r0.END PROCfeldnamenlesen;PROCfeldnamenbearbeiten(INT CONSTd3,PROC(TEXT CONST,INT CONST,INT CONST)v4):IFd3<=c1THENfeldbearbeiten(x0(e4).b0,d3,PROC(TEXT CONST,INT CONST,INT CONST)v4)ELSEfeldbearbeiten(t4,u4,PROC(TEXT CONST,INT CONST,INT CONST)v4)END IF. +t4:x0(m1(d3).q0).b0.u4:m1(d3).r0.END PROCfeldnamenbearbeiten;INT PROCfeldnummer(TEXT CONSTw4):INT VARx4:=c1,f4:=feldindex(x0(e4).b0,w4),s2:=b1;WHILEf4=0ANDs2<>0REPf4:=feldindex(x0(s2).b0,w4);y4;s2:=x0(s2).e0END REP;f4.y4:INT CONSTz4:=x0(s2).d0;IFf4=0THENx4INCRfelderzahl(x0(s2).h0);x4DECRz4ELSEf4INCRx4;f4DECRz4END IF.END PROCfeldnummer;INT PROCfeldinfo(INT CONSTd3):IFd3<=c1THENfeldinfo(x0(e4).h0,d3)ELSEfeldinfo(x0(t4).h0,u4)END IF.t4:m1(d3).q0.u4:m1(d3).r0.END PROCfeldinfo;PROCnotizenlesen(INT CONSTf4,TEXT VARa5):notizenlesen(x0(e4).h0,f4,a5)END PROCnotizenlesen;PROCnotizenaendern(INT CONSTf4,TEXT CONSTa5):notizenaendern(x0(e4).h0,f4,a5)END PROCnotizenaendern;PROCfeldlesen(INT CONSTd3,TEXT VARa5):IFd3<=c1THENfeldlesen(x0(a1).h0,d3,a5)ELSEb5END IF.b5:INT CONSTt4:=m1(d3).q0;IFx0(t4).j0THENfeldlesen(x0(t4).i0,u4,a5)ELSEfeldlesen(x0(t4).h0,u4,a5)END IF.u4:m1(d3).r0.END PROCfeldlesen;PROCfeldbearbeiten(INT CONSTd3,PROC(TEXT CONST,INT CONST,INT CONST)v4):IFd3<=c1THENfeldbearbeiten(x0(a1).h0, +d3,PROC(TEXT CONST,INT CONST,INT CONST)v4)ELSEc5END IF.c5:INT CONSTt4:=m1(d3).q0;IFx0(t4).j0THENfeldbearbeiten(x0(t4).i0,u4,PROC(TEXT CONST,INT CONST,INT CONST)v4)ELSEfeldbearbeiten(x0(t4).h0,u4,PROC(TEXT CONST,INT CONST,INT CONST)v4)END IF.u4:m1(d3).r0.END PROCfeldbearbeiten;PROCfeldaendern(INT CONSTd3,TEXT CONSTa5):INT CONSTt4:=m1(d3).q0;IFd3<=c1THENd5ELSEe5END IF.d5:x0(a1).l0:=TRUE;IFf5CANDg5THENh5END IF;feldaendern(x0(a1).h0,d3,a5).f5:NOTn2CANDt4>0.g5:feldlesen(x0(a1).h0,d3,z1);z1<>a5.h5:INT VARi5:=u4,j5:=t4;REPk5(x0(l5));x0(l5).m0:=TRUE;feldaendern(x0(l5).i0,f3,a5);j5INCR1;i5DECR1UNTILi5=0END REP.e5:k5(x0(t4));IFm5THENx0(t4).k0:=TRUE;feldaendern(x0(t4).i0,u4,a5)END IF.m5:feldlesen(x0(t4).i0,u4,z1);z1<>a5.u4:m1(d3).r0.l5:n1(j5).q0.f3:n1(j5).r0.END PROCfeldaendern;PROCk5(DATEI VARq0):IF NOTq0.j0THENq0.j0:=TRUE;n5END IF.n5:IFdateiende(q0.h0)THENsatzinitialisieren(q0.i0,q0.d0);o5ELSEsatzlesen(q0.h0,q0.i0)END IF.o5:INT VARi2;FORi2FROM1UPTOq0.d0REPfeldlesen(q0.c0ISUBi2,z1);feldaendern( +q0.i0,i2,z1)END REP.END PROCk5;PROCl3(DATEI VARq0):p5;q5.p5:feldlesen(x0(a1).h0,r5,n0).r5:q0.c0ISUB1.n0:q0.n0.q5:aufsatz(q0.h0,n0);WHILE NOTs5(q0)REPweiter(q0.h0,n0)END REP;IFdateiende(q0.h0)THENk5(q0)ELSEq0.j0:=FALSE END IF.END PROCl3;PROCt5:INT VARs2:=b1;WHILEs2<>0REPl3(x0(s2));s2:=x0(s2).e0END REP;f1:=1END PROCt5;BOOL PROCs5(DATEI CONSTq0):IF NOTdateiende(q0.h0)THENu5END IF;TRUE.u5:INT VARv5;FORv5FROM2UPTOq0.d0REPfeldlesen(x0(a1).h0,c0ISUBv5,z1);feldbearbeiten(q0.h0,v5,PROC(TEXT CONST,INT CONST,INT CONST)w5);IF NOTx5THEN LEAVEs5WITH FALSE END IF END REP.c0:q0.c0.END PROCs5;BOOL VARx5;PROCw5(TEXT CONSTy5,INT CONSTr2,z5):x5:=length(z1)+r2=z5+1CANDpos(y5,z1,r2,z5+1)=r2END PROCw5;LETa6=22101,b6="h",c6=""27"";BOOL VARd6;PROCe6:TEXT VARf6;d6:=FALSE;REPf6:=incharety;type(f6)UNTILf6=s0END REP END PROCe6;PROCg6:IFd6THENtype(c6)END IF END PROCg6;BOOL PROCh6:TEXT VARf6;REPf6:=incharety;IFf6=s0THEN LEAVEh6WITH FALSE ELSEi6END IF END REP;FALSE.i6:IFd6THENd6:=FALSE;j6ELSEk6END IF.j6:IFf6=b6THENl6 +;errorstop(a6,s0);LEAVEh6WITH TRUE ELSEtype(c6);type(f6)END IF.k6:IFf6=c6THENd6:=TRUE ELSEtype(f6)END IF.l6:REP UNTILgetcharety=s0END REP.END PROCh6;PROCweiter(INT CONSTm6):IF NOTi1THENaenderungeneintragen;n6END IF.n6:SELECTm6OF CASE1:o6CASE2:p6CASE3:q6END SELECT.o6:r6(FALSE).p6:e6;REPr6(k1);cout(satznummer)UNTILsatzausgewaehltORi1ORh6END REP;g6.q6:INT VARs6:=satznr(x0(a1).h0);WHILEt6ANDe0<>0REPu6;s6:=1END REP;aufsatz(x0(a1).h0,v6);cout(satznummer);t5;i1:=dateiende(x0(a1).h0);w6.t6:x6(x0(a1),s6+1);INT CONSTv6:=x0(a1).o0ISUBx0(a1).p0;v6<>maxint.e0:x0(a1).e0.END PROCweiter;PROCzurueck(INT CONSTm6):IFsatznummer>1THENaenderungeneintragen;y6END IF.y6:SELECTm6OF CASE1:z6CASE2:a7CASE3:b7END SELECT.z6:c7(FALSE).a7:e6;REPc7(k1);cout(satznummer)UNTILsatzausgewaehltORsatznummer=1ORh6END REP;g6.b7:INT VARs6:=satznr(x0(a1).h0);WHILEt6ANDa1<>1REPd7;s6:=maxint-1END REP;aufsatz(x0(a1).h0,e7);cout(satznummer);t5;i1:=FALSE;w6.t6:INT VARe7;x6(x0(a1),s6);IFx0(a1).p0=1THENe7:=1;TRUE ELSEe7:=x0(a1).o0ISUB( +x0(a1).p0-1);FALSE END IF.END PROCzurueck;PROCr6(BOOL CONSTf7):g7;IFh7THENo6;t5ELSEf1INCR1END IF;w6.g7:INT VARs2:=b1;WHILEs2>0REPi7;s2:=x0(s2).e0END REP.i7:BOOL VARj7;k7(x0(s2),j7);IFj7THEN LEAVEg7END IF.h7:s2=0.o6:IFf7THENweiter(x0(a1).h0,l1)ELSEweiter(x0(a1).h0)END IF;WHILEdateiende(x0(a1).h0)REPl7UNTILi1END REP.l7:IFx0(a1).e0<>0THENu6;m7ELSEi1:=TRUE END IF.m7:aufsatz(x0(a1).h0,1).END PROCr6;PROCk7(DATEI VARq0,BOOL VARj7):IFdateiende(q0.h0)THENj7:=FALSE ELSEn7END IF.n7:j7:=TRUE;REPweiter(q0.h0,q0.n0);IFdateiende(q0.h0)THENj7:=FALSE;aufsatz(q0.h0,q0.n0)END IF UNTILs5(q0)END REP.END PROCk7;PROCc7(BOOL CONSTf7):WHILEsatznr(x0(a1).h0)=1CANDsatznummer>1REPd7;o7(x0(a1).h0)END REP;IFf7THENzurueck(x0(a1).h0,l1)ELSEzurueck(x0(a1).h0)END IF;i1:=FALSE;t5;w6END PROCc7;PROCu6:e1INCRsaetze(x0(a1).h0);a1:=x0(a1).e0END PROCu6;PROCd7:INT VARp7:=1;WHILEx0(p7).e0<>a1REPp7:=x0(p7).e0END REP;e1DECRsaetze(x0(p7).h0);a1:=p7END PROCd7;PROCaenderungeneintragen:INT VARs2:=b1;WHILEs2<>0REPq7;s2:=x0(s2).e0END +REP.q7:IFx0(s2).j0THENr7(x0(s2))END IF.END PROCaenderungeneintragen;PROCr7(DATEI VARq0):IFs7AND NOTt7THENu7ELIFv7ANDw7THENx7ELIFt7THENl3(q0)END IF;y7;k0:=FALSE;t7:=FALSE.s7:NOTdateiende(q0.h0)ANDk0.v7:felderzahl(i0)>q0.d0.w7:t7ORk0.x7:l0:=TRUE;feldlesen(i0,1,q0.n0);satzeinfuegen(q0.h0,i0).y7:q0.j0:=FALSE.u7:l0:=TRUE;satzaendern(q0.h0,i0).k0:q0.k0.t7:q0.m0.i0:q0.i0.l0:q0.l0.END PROCr7;PROCo7(EUDAT VARh0):aufsatz(h0,saetze(h0)+1)END PROCo7;PROCaufsatz(INT CONSTsatznr):aenderungeneintragen;a1:=e4;e1:=0;WHILEz7ANDa8REPu6END REP;aufsatz(x0(a1).h0,satznr-e1);t5;i1:=dateiende(x0(a1).h0);w6.z7:satznr-e1>saetze(x0(a1).h0).a8:x0(a1).e0<>0.END PROCaufsatz;INT PROCsatznummer:e1+satznr(x0(a1).h0)END PROCsatznummer;INT PROCsatzkombination:f1END PROCsatzkombination;BOOL PROCdateiende:i1END PROCdateiende;SATZ VARb8;satzinitialisieren(b8);PROCsatzeinfuegen:aenderungeneintragen;c8;satzeinfuegen(x0(a1).h0,b8);x0(a1).l0:=TRUE;d8;i1:=FALSE;w6.c8:x6(x0(a1),satznr(x0(a1).h0));f2(x0(a1).o0,x0(a1).p0,1).d8:f1 +:=1;INT VARs2:=b1;WHILEs2<>0REPo7(x0(s2).h0);s2:=x0(s2).e0END REP.END PROCsatzeinfuegen;PROCsatzloeschen:IF NOTi1THENaenderungeneintragen;e8;satzloeschen(x0(a1).h0);x0(a1).l0:=TRUE;aufsatz(satznummer)END IF.e8:IFsatzmarkiertTHENdelete(x0(a1).o0,x0(a1).p0);g1DECR1END IF;f2(x0(a1).o0,x0(a1).p0,-1).END PROCsatzloeschen;LETf8=100;ROWf8STRUCT(INTr0,g8,h8,i8,TEXTn0)VARj8;SATZ VARn4;INT VARl4,k8,l8:=1;BOOL VARm8,n8;suchbedingungloeschen;INT VARo8;LETp8=1,q8=2,r8=3,s8=4,t8=5,u8=6,v8=7,w8=8,x8=9;PROCw6:IFi1THENn8:=FALSE ELSEy8;n8:=z8END IF.y8:o8:=k8;WHILEo8>0REPa9;feldbearbeiten(b9,PROC(TEXT CONST,INT CONST,INT CONST)c9)END REP.a9:INT VARd9:=j8(o8).g8;IFd9>=256THENe9;f9END IF.e9:feldlesen((d9AND255)+1,z1).f9:IFg9=2THENh9END IF;j8(o8).n0:=z1.b9:j8(o8).r0.z8:o8<0.END PROCw6;PROCc9(TEXT CONSTy5,INT CONSTi9,j9):INT VARd9:=j8(o8).g8;IFd9>=256THENd9:=d9DIV256END IF;IFk9THENo8:=j8(o8).h8ELSEo8:=j8(o8).i8END IF.k9:SELECTd9OF CASEp8:l9CASEq8:m9CASEr8:n9CASEs8:o9CASEt8:p9CASEu8:q9CASEv8:r9CASEw8:s9CASEx8 +:t9OTHERWISE FALSE END SELECT.l9:SELECTg9OF CASE0:u9;z1LEXEQUALn0CASE1:u9;v9=w9OTHERWISElength(n0)=j9-i9+1ANDx9END SELECT.x9:i9>j9CORm9.m9:pos(y5,n0,i9,j9)=i9.n9:pos(y5,n0,j9+1-length(n0),j9)>0.o9:pos(y5,n0,i9,j9)>0.p9:u9;SELECTg9OF CASE0:n0LEXGREATERz1CASE1:v9=w9CASE2:h9;z1>=n0OTHERWISEz1>=n0END SELECT.r9:i9<=j9.s9:satzmarkiert.t9:TRUE.u9:z1:=subtext(y5,i9,j9).END PROCc9;TEXT PROCn0:j8(o8).n0END PROCn0;PROCh9:IFlength(z1)=8THEN TEXT CONSTy9:=subtext(z1,7,8);replace(z1,7,subtext(z1,1,2));replace(z1,1,y9)ELSEz1:=s0END IF END PROCh9;INT PROCg9:feldinfo(j8(o8).r0)END PROCg9;REAL PROCv9:REAL VARz9;wertberechnen(z1,z9);z9END PROCv9;REAL PROCw9:REAL VARz9;wertberechnen(n0,z9);z9END PROCw9;LETa10=";",b10=",",c10="..",d10="++",e10="--",f10="*";BOOL VARg10,h10,i10;INT VARj10,k10,l10,m10,n10;INTVEC VARm4;PROCsuchbedingung(INT CONSTd3,TEXT CONSTj8):INT VARr2:=1,o10:=0;INT CONSTp10:=length(j8)+1;k10:=0;n10 +:=d3;j10:=l4+1;WHILEr21THENk1:=FALSE END IF;o10:=pos(j8,a10,r2);IFo10=0THENo10:=p10END IF.r10:u10;h10:=TRUE;INT CONSTv10:=pos(j8,c10,r2,z5+1);IFw10THENx10(s0,x8,-k10)ELIFv10=0THENy10ELSEz10END IF.u10:IFsubtext(j8,r2,r2+1)=e10THENr2INCR2;i10:=TRUE ELSEi10:=FALSE END IF.w10:r2>z5.y10:IFa11THENb11ELSEc11END IF.a11:r2+1=z5CANDsubtext(j8,r2,z5)=d10.b11:x10(s0,w8,-k10).c11:INT VARd11:=pos(j8,f10,r2,z5+1);IFd11=0THENe11ELIFr2=z5THENf11ELSEg11;REPh11END REP END IF.e11:IFi11THENk1:=TRUE;l1:=j8END IF;x10(subtext(j8,r2,z5),p8,-k10).i11:d3=1ANDr2=1ANDz5=p10-1ANDj11AND NOTn2AND(j8SUB1)<>"&".j11:length(m4)<=2.f11:x10(s0,v8,-k10).g11:INT VARg8;IFd11=r2THENg8:=p8ELSEg8:=q8END IF.h11:IFg8<>p8THENk11END IF;r2:=d11+1;d11:=pos(j8,f10,r2,z5+1);IFd11=0THENd11:=z5+1;g8:=r8ELSEg8:=s8END IF.k11:TEXT CONSTn0:=subtext(j8,r2, +d11-1);IFi10ORl11THEN IFi10THENh10:=TRUE END IF;x10(n0,g8,-k10);IFl11THEN LEAVEc11END IF ELSEx10(n0,g8,l4+2)END IF.l11:d11>=z5.z10:TEXT CONSTm11:=subtext(j8,r2,v10-1),n11:=subtext(j8,v10+2,z5);IFv10=r2THENx10(n11,t8,-k10)ELIFv10=z5-1THENx10(m11,u8,-k10)ELSEo11END IF.o11:IFi10THENx10(m11,u8,-k10);h10:=TRUE ELSEx10(m11,u8,l4+2)END IF;x10(n11,t8,-k10).END PROCsuchbedingung;PROCx10(TEXT CONSTp11,INT CONSTg8,h8):q11;r11;IFg10THENs11;t11;m10:=l4ELIFh10THENu11END IF;v11;w11.q11:m8:=FALSE;IFl4=d4THENl8INCR1;IFl8>32000THENl8:=1END IF END IF.r11:IFl4=f8THENsuchbedingungloeschen;errorstop(y1)ELSEl4INCR1;k8:=d4+1END IF.s11:IFk10>length(m4)DIV2THENm4CATl4;x11(k8,0,l4)END IF;IFk10=length(m4)DIV2THENl10:=0ELSEl10:=m4ISUB(k10+1)END IF.t11:x11(k8,-k10,l4);g10:=FALSE;h10:=FALSE.u11:x11(m10,l10,l4);m10:=l4;h10:=FALSE.v11:j8(l4).g8:=g8;j8(l4).r0:=n10;IFi10THENj8(l4).h8:=l10;j8(l4).i8:=h8ELSEj8(l4).h8:=h8;j8(l4).i8:=l10END IF.w11:IFy11THENz11ELSEa12END IF.y11:(p11SUB1)="&"CANDb12.b12:INT +CONSTc12:=feldnummer +(subtext(p11,2));c12>0.z11:j8(l4).g8:=c12-1+256*g8.a12:INT CONSTd12:=feldinfo(n10);IFd12=2AND(g8=t8ORg8=u8)THENz1:=p11;h9;j8(l4).n0:=z1ELSEj8(l4).n0:=p11END IF.END PROCx10;PROCx11(INT CONSTi9,wert,e12):INT VARi2;FORi2FROMi9UPTOl4-1REP IFj8(i2).h8=wertTHENj8(i2).h8:=e12ELIFj8(i2).i8=wertTHENj8(i2).i8:=e12END IF END REP END PROCx11;PROCsuchbedingunglesen(INT CONSTd3,TEXT VARj8):feldlesen(n4,d3,j8)END PROCsuchbedingunglesen;PROCsuchbedingungloeschen:disablestop;IFn2THENl4:=d4ELSEd4:=0;l4:=0END IF;k8:=-1;m4:=t0;satzinitialisieren(n4);k1:=FALSE;m8:=TRUE;n8:=NOTi1END PROCsuchbedingungloeschen;BOOL PROCsatzausgewaehlt:IF NOTm8THENw6;m8:=TRUE END IF;n8END PROCsatzausgewaehlt;INT PROCsuchversion:IFl4=d4THEN0ELSEl8END IF END PROCsuchversion;PROCx6(DATEI VARq0,INT CONSTy5):IF(q0.o0ISUBq0.p0)=y5END REP.g12:WHILEq0.p0>1CAND(q0.o0ISUB(q0.p0-1))>=y5REPq0.p0DECR1END REP.END PROCx6;PROCmarkierungaendern:disablestop;IFsatzmarkiertTHENdelete( +x0(a1).o0,x0(a1).p0);g1DECR1ELSEinsert(x0(a1).o0,x0(a1).p0,satznr(x0(a1).h0));g1INCR1END IF END PROCmarkierungaendern;BOOL PROCsatzmarkiert:INT CONSTy5:=satznr(x0(a1).h0);x6(x0(a1),y5);y5=(x0(a1).o0ISUBx0(a1).p0)END PROCsatzmarkiert;INT PROCmarkiertesaetze:g1END PROCmarkiertesaetze;PROCmarkierungenloeschen:disablestop;IFn2THENp2(x0(a1))ELSEh12END IF;g1:=0.h12:INT VARs2:=1;REPp2(x0(s2));s2:=x0(s2).e0UNTILs2=0END REP.END PROCmarkierungenloeschen;PROCp2(DATEI VARq0):q0.o0:=s0;q0.o0CATmaxint;q0.p0:=1END PROCp2;END PACKETdatenverwaltung; + diff --git a/app/eudas/4.3/src/eudas.2 b/app/eudas/4.3/src/eudas.2 new file mode 100644 index 0000000..0048409 --- /dev/null +++ b/app/eudas/4.3/src/eudas.2 @@ -0,0 +1,62 @@ +PACKETverarbeitungDEFINESkopiere,stdkopiermuster,verarbeite,trage,eindeutigefelder,pruefe,wertemenge,feldmaske,tragesatz,holesatz,K,V,f,wert,zahltext,textdarstellung:SATZ VARb0,c0,d0;INT VARe0;BOOL VARf0;LETg0="",INTVEC=TEXT;INTVEC VARh0;TEXT VARi0:=" ";OP CAT(INTVEC VARj0,INT CONSTk0):replace(i0,1,k0);j0CATi0END OP CAT;PROCstdkopiermuster(TEXT CONSTl0,FILE VARm0):n0;INT VARo0;p0;q0;INT VARr0;FORr0FROM1UPTOo0REPs0;IFt0THENu0ELSEv0END IF END REP.p0:output(m0);EUDAT VARw0;IFexists(l0)THENoeffne(w0,l0)END IF.q0:IFexists(l0)CANDfelderzahl(w0)>0THENfeldnamenlesen(w0,b0);o0:=felderzahl(w0)ELSEx0;o0:=anzahlfelderEND IF.x0:TEXT VARy0;satzinitialisieren(b0);FORr0FROM1UPTOanzahlfelderREPfeldnamenlesen(r0,y0);feldaendern(b0,r0,y0)END REP.t0:feldnummer(y0)>0.s0:feldlesen(b0,r0,y0);put(m0,textdarstellung(y0)).u0:write(m0,"K f(");write(m0,textdarstellung(y0));putline(m0,");").v0:putline(m0,"K """";").END PROCstdkopiermuster;PROCkopiere(TEXT CONSTl0,FILE VARm0):z0(a1,m0).a1:"kopiere ("+ +textdarstellung(l0)+", ".END PROCkopiere;PROCz0(TEXT CONSTb1,FILE VARc1):d1;write(e1,b1);putline(e1,"PROC programmfunktion);");putline(e1,"PROC programmfunktion:");f1;putline(e1,"END PROC programmfunktion");g1;forget(h1,quiet).d1:TEXT VARh1;INT VARi1:=0;REPi1INCR1;h1:=text(i1)UNTIL NOTexists(h1)END REP;disablestop;FILE VARe1:=sequentialfile(output,h1);headline(e1,j1).f1:TEXT VARk1;input(c1);WHILE NOTeof(c1)REPgetline(c1,k1);putline(e1,k1)END REP.g1:TEXT CONSTl1:=std;run(h1);lastparam(l1).END PROCz0;PROCkopiere(TEXT CONSTl0,PROCm1):enablestop;INT VARn1;o1(n1);IFdateiendeTHENaufsatz(1);LEAVEkopiereELSEp1END IF;WHILE NOTdateiendeREPsatzinitialisieren(d0);e0:=1;m1;q1;satzeinfuegen(w0,d0);weiter(w0);weiter(n1)END REP;aufsatz(1).p1:f0:=TRUE;EUDAT VARw0;oeffne(w0,l0);aufsatz(w0,saetze(w0)+1);feldnamenlesen(w0,c0);h0:=g0.q1:IFf0THENfeldnamenaendern(w0,c0);f0:=FALSE END IF END PROCkopiere;OP K(TEXT CONSTy0,r1):IFf0THENs1;END IF;feldaendern(d0,h0ISUBe0,r1);e0INCR1.s1:INT VARt1:=feldindex(c0,y0); +IFt1=0THENt1:=felderzahl(c0)+1;feldaendern(c0,t1,y0);END IF;h0CATt1.END OP K;PROCverarbeite(FILE VARu1):z0("verarbeite (",u1)END PROCverarbeite;PROCverarbeite(PROCv1):enablestop;INT VARn1;o1(n1);WHILE NOTdateiendeREPv1;weiter(n1)END REP;aufsatz(1)END PROCverarbeite;OP V(TEXT CONSTy0,r1):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0)ELSEfeldaendern(w1,r1)END IF END OP V;PROCo1(INT VARn1):n0;aufsatz(1);IFmarkiertesaetze>0THENn1:=3;IF NOTsatzmarkiertTHENweiter(n1)END IF ELSEn1:=2;IF NOTsatzausgewaehltTHENweiter(n1)END IF END IF END PROCo1;PROCn0:IFanzahldateien=0THENerrorstop(y1)END IF.END PROCn0;TEXT VARz1,a2;LETb2="""";TEXT PROCf(TEXT CONSTy0):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0);z1:=g0ELSEfeldlesen(w1,z1)END IF;z1END PROCf;REAL PROCwert(TEXT CONSTy0):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0);0.0ELSEfeldlesen(w1,z1);REAL VARc2;wertberechnen(z1,c2);c2END IF END PROCwert;REAL PROCwert(TEXT CONSTy0,INT CONSTd2):round(wert(y0),d2)END PROCwert;TEXT PROCzahltext(REAL CONSTe2,INT +CONSTd2):REAL CONSTf2:=round(abs(e2),d2);INT VARg2:=h2+d2+2;IFe2<0.0THENa2:="-"ELSEa2:=g0END IF;IFf2<1.0ANDf2<>0.0THENa2CAT"0";g2DECR1ENDIF;a2CATtext(f2,g2,d2);IFd2>0THENchange(a2,".",dezimalkomma)ELSEchange(a2,".",g0)END IF;a2.h2:max(0,decimalexponent(f2)).END PROCzahltext;TEXT PROCzahltext(TEXT CONSTy0,INT CONSTd2):zahltext(wert(y0),d2)END PROCzahltext;TEXT PROCtextdarstellung(TEXT CONSTi2):z1:=i2;changeall(z1,b2,b2+b2);j2;insertchar(z1,b2,1);z1CATb2;z1.j2:INT VARk2:=1;WHILEl2REPchange(z1,k2,k2,m2)END REP.l2:k2:=pos(z1,""0"",""31"",k2);k2>0.m2:b2+text(code(z1SUBk2))+b2.END PROCtextdarstellung;PROCx1(TEXT CONSTy0):errorstop(n2+textdarstellung(y0)+o2)END PROCx1;SATZ VARp2;EUDAT VARq2;LETj1=#501 +#"erzeugtes Programm",y1=#502 +#"keine Datei geoeffnet",r2=#503 +#"Kein Satz zum Tragen vorhanden",s2=#504 +#"Zieldatei hat falsche Felderzahl",t2=#505 +#" existiert nicht",u2=#506 +#" verletzt die Pruefbedingung.",v2=#507 +#" ist in der Zieldatei bereits vorhanden.",o2=#508 +#" ist nicht definiert.",w2=#509 +#" ist nicht in der Wertemenge.",x2=#510 +#" stimmt nicht mit der Maske ueberein.",y2=#511 +#"Satz ",n2=#512 +#"Das Feld ";INT VARz2;FILE VARa3;BOOL VARb3:=FALSE,c3,d3;TEXT VARe3;PROCtrage(TEXT CONSTl0,FILE VARf3,BOOL CONSTg3):disablestop;b3:=g3;IFb3THENa3:=f3;output(a3)END IF;h3(l0);b3:=FALSE END PROCtrage;PROCh3(TEXT CONSTl0):enablestop;INT VARn1;o1(n1);i3(l0);INT VARj3:=0;REP IF NOTk3THENweiter(n1)ELSEcout(satznummer+j3)END IF;IFdateiendeTHENaufsatz(1);LEAVEh3END IF;l3END REP.k3:IFn1=3THENsatzmarkiertELSEsatzausgewaehltEND IF.l3:c3:=TRUE;IFb3THENnotizenlesen(q2,1,e3);do(e3)END IF;IFc3THENm3;IFc3THENsatzloeschen;j3INCR1END IF END IF;IF NOTc3THENweiter(n1)END IF.END PROCh3;PROCi3(TEXT CONSTl0):IFdateiendeTHENerrorstop(r2)END IF;oeffne(q2,l0);z2:=0;IFfelderzahl(q2)=0THENp1ELIFfelderzahl(q2)<>anzahlfelderTHENerrorstop(s2)END IF;aufsatz(q2,saetze(q2)+1).p1:satzinitialisieren(p2,anzahlfelder);INT VARr0;FORr0FROM1UPTOanzahlfelderREPfeldnamenlesen(r0,z1);feldaendern(p2,r0,z1)END REP;feldnamenaendern(q2,p2).END PROCi3;PROCm3:IFz2>0CANDn3THENo3("",v2)ELSEp3;satzeinfuegen(q2,p2);weiter(q2)END IF.p3: +satzinitialisieren(p2,anzahlfelder);INT VARr0;FORr0FROM1UPTOanzahlfelderREPfeldlesen(r0,z1);feldaendern(p2,r0,z1)END REP.n3:TEXT VARc1;INT CONSTq3:=satznr(q2);feldlesen(1,c1);d3:=FALSE;aufsatz(q2,c1);WHILE NOTdateiende(q2)REPr3;weiter(q2,c1)UNTILd3END REP;aufsatz(q2,q3);d3.r3:INT VARi1;d3:=TRUE;FORi1FROM2UPTOz2REPfeldlesen(q2,i1,z1);feldbearbeiten(i1,PROC(TEXT CONST,INT CONST,INT CONST)s3);IF NOTd3THEN LEAVEr3END IF END REP.END PROCm3;PROCs3(TEXT CONSTt3,INT CONSTu3,v3):IFw3COR(length(z1)>0CANDx3)THENd3:=FALSE END IF.w3:(v3-u3+1)<>length(z1).x3:pos(t3,z1,u3,v3+1)<>u3.END PROCs3;PROCo3(TEXT CONSTy3,z3):IFb3THENa4ELSEerrorstop(z3)END IF.a4:put(a3,y2);put(a3,satznummer);IFy3<>""THENwrite(a3,n2);write(a3,textdarstellung(y3))END IF;putline(a3,z3);c3:=FALSE.END PROCo3;PROCeindeutigefelder(INT CONSTb4):z2:=b4END PROCeindeutigefelder;PROCpruefe(TEXT CONSTy3,BOOL CONSTc4):IF NOTc4THENo3(y3,u2)END IF END PROCpruefe;PROCwertemenge(TEXT CONSTy3,d4):INT CONSTw1:=feldnummer(y3);IFw1=0THENo3(y3,o2) +ELSEe4END IF.e4:INT VARk2:=0;LETf4=",";feldlesen(w1,z1);IFg4THEN LEAVEe4END IF;z1CATf4;REPk2:=pos(d4,z1,k2+1);IFk2=1ORk2>1CAND(d4SUBk2-1)=f4THEN LEAVEe4END IF UNTILk2=0END REP;o3(y3,w2).g4:INT CONSTh4:=length(d4)-length(z1);(d4SUBh4)=f4ANDpos(d4,z1,h4+1)>0.END PROCwertemenge;PROCfeldmaske(TEXT CONSTy3,i4):INT CONSTw1:=feldnummer(y3);IFw1=0THENo3(y3,o2)ELSEfeldlesen(w1,z1);j4END IF.j4:INT VARk2;TEXT CONSTk4:=code(length(i4)+1);TEXT VARl4:=""1"";FORk2FROM1UPTOlength(z1)REP TEXT CONSTm4:=z1SUBk2;n4UNTILl4=""END REP;IFo4THENo3(y3,x2)END IF.n4:INT VARp4:=1;WHILEp4<=length(l4)REP INT CONSTq4:=code(l4SUBp4);IF(i4SUBq4)="*"THENr4ELIFs4THENreplace(l4,p4,code(q4+1));p4INCR1ELSEdeletechar(l4,p4)END IF END REP.r4:IFq4=length(i4)THEN LEAVEfeldmaskeEND IF;p4INCR1;IFpos(l4,code(q4+1))=0THENinsertchar(l4,code(q4+1),p4)END IF.s4:SELECTpos("9XAa",i4SUBq4)OF CASE1:pos("0123456789",m4)>0CASE2:TRUE CASE3:pos("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",m4)>0CASE4:pos("abcdefghijklmnopqrstuvwxyzäöüß",m4)>0OTHERWISE(i4 +SUBq4)=m4END SELECT.o4:(l4=""CORpos(l4,k4)=0)ANDt4.t4:(i4SUBlength(i4))<>"*"ORpos(l4,code(length(i4)))=0.END PROCfeldmaske;PROCtragesatz(TEXT CONSTl0):i3(l0);INT CONSTu4:=satznr(q2);m3;satzloeschen;aufsatz(q2,u4)END PROCtragesatz;PROCholesatz(TEXT CONSTl0):n0;IF NOTexists(l0)THENerrorstop(textdarstellung(l0)+t2)END IF;oeffne(q2,l0);IFfelderzahl(q2)<>anzahlfelderTHENerrorstop(s2)ELIFsaetze(q2)=0THENerrorstop(r2)END IF;aufsatz(q2,saetze(q2));satzlesen(q2,p2);v4;satzloeschen(q2).v4:satzeinfuegen;INT VARr0;FORr0FROM1UPTOfelderzahl(p2)REPfeldlesen(p2,r0,z1);feldaendern(r0,z1)END REP.END PROCholesatz;END PACKETverarbeitung; +PACKETeudasdruckenDEFINESdrucke,interpretiere,gruppentest,druckdatei,direktdrucken,maxdruckzeilen,gruppenwechsel,lfdnr:LETb0=25,SPEICHER=STRUCT(INTc0,d0,e0,f0,TEXTg0);ROWb0SPEICHER VARh0;INT VARi0;LETj0="",k0=" ",l0=" ";TEXT VARm0;PROCinterpretiere(INT CONSTn0,o0,PROC(INT CONST,TEXT VAR)p0):INT VARq0,r0:=0,s0:=0,t0:=o0;u0(n0);WHILE NOTv0REPw0;IFx0THENr0INCR1ELSEy0;z0END IF END REP.z0:IFa1(q0)THENb1ELSEc1;s0:=0END IF.b1:SELECTq0OF CASEd1:e1CASEf1:g1OTHERWISE LEAVEinterpretiereEND SELECT.y0:WHILEr0>0REPh1(k0);r0DECR1END REP.e1:i1(i0).g1:i1(s0).x0:j1=j0ORj1=k0.c1:INT VARk1:=0,l1:=0;BOOL VARm1:=FALSE;REPn1;k1INCR1;IFi0=3THENm1:=TRUE END IF UNTILo1END REP.o1:IFi0<=2THEN TRUE ELIFs0<>0THENk1=s0ELSEl1=0END IF.n1:INT VARp1:=1,q1:=0,r1:=0,s1:=1,t1:=1;m0:=j0;REP IFu1THENv1END IF;IFw1THENx1END IF;y1;s1INCR1END REP.u1:k1=0.v1:z1(a2.c0,a2.d0,a2.e0);IF NOTb2THENc2END IF.b2:a2.c0>length(j1).c2:INT CONSTd2:=e2(t0);IFd2>0THENfeldlesen(d2,a2.g0)ELSEp0(-d2,a2.g0)END IF;t0INCR1;a2.f0:=0;IFa2.g0<>j0THENl1 +INCR1END IF.w1:a2.e0>=4.a2:h0(s1).y1:INT CONSTreserve:=f2(a2);IFreserve>0THENg2ELSEr1DECRreserveEND IF.g2:q1INCRreserve;IFh2ANDq1>r1THENq1:=r1END IF;IFi2ANDj2THENk2END IF.h2:i0=2ORi0=4.i2:reserve=a2.d0.j2:(a2.e0AND1)=0.k2:IFa2.c0=1COR(j1SUB(a2.c0-1))=k0THEN INT VARl2:=m2(s1);WHILE(j1SUBl2)=k0REPl2INCR1;a2.d0INCR1;q1INCR1END REP END IF.x1:IFs1=1THEN IFb2THENn2END IF ELSEo2END IF.n2:IFm1THENh1(k0)ELSEh1(j1)END IF;LEAVEn1.o2:INT VARp2:=0,q2:=a2.c0;INT CONSTr2:=q2-length(j1);s2;t2;u2;v2.s2:IFr2>0THENq1INCRr2;q2DECR(r2-1)END IF;w2.w2:INT CONSTx2:=m2(s1-1),y2:=pos(j1,l0,x2,q2);IFy2>0THENq2:=y2;z2ELIFr2<0AND(j1SUB(q2-1))<>k0THENq2:=x2END IF.z2:INT VARa3:=q2+1;REPp2INCR1;a3INCR1UNTIL(j1SUBa3)<>k0END REP;q1INCRp2.t2:INT VARb3:=0;WHILEt1=3.y3:NOTa4.c4:IFq3THENp3(v3)END IF;e4(f3.g0,w3,x3);IFf4THENp3(v3)END IF.f4:NOTq3.b4:IFpos(f3.g0,k0,w3,x3)>0THENg4END IF;INT CONSTh4:=pos(f3.g0,"!","�",x3+1);IFh4=0THENf3.f0:=length(f3.g0);l1DECR1ELSEf3.f0:=h4-1END IF.g4:x3INCR1;v3DECR1;WHILE(f3.g0SUBx3)<>k0REPx3DECR1;v3INCR1END REP;WHILE(f3.g0SUBx3)=k0REPx3DECR1;v3INCR1UNTILl20THENi4;j4;LEAVEn1ELSEk4END IF.i4:IF NOTm1THENe4(j1,p1,length(j1))END IF.j4:INT VARl4:=length(m0);IF(m0SUBl4)=k0THEN REPl4DECR1UNTIL(m0SUBl4)<>k0END REP; +m0:=subtext(m0,1,l4)END IF;IFm4THENm0CATk0END IF;h1(m0).m4:(j1SUB LENGTHj1)=k0AND(i0<>3ORl1=0).k4:q1:=0;r1:=0.END PROCinterpretiere;INT PROCm2(INT CONSTn4):h0(n4).c0+h0(n4).d0END PROCm2;INT PROCf2(SPEICHER CONSTo4):o4.d0-length(o4.g0)+o4.f0END PROCf2;LETp4=" ";PROCp3(INT CONSTq4):INT VARr4:=q4;WHILEr4>=10REPm0CATp4;r4DECR10END REP;WHILEr4>0REPm0CATk0;r4DECR1END REP END PROCp3;PROCr3(SPEICHER VARo4):IFo4.f0=0THENm0CATo4.g0ELSEe4(o4.g0,o4.f0+1,length(o4.g0))END IF;o4.f0:=length(o4.g0)END PROCr3;PROCg3(INT CONSTs4,t4,BOOL CONSTm1):IFm1THENp3(t4-s4)ELSEe4(j1,s4,t4-1)END IF END PROCg3;TEXT VARu4;PROCe4(TEXT CONSTv4,INT CONSTs4,t4):u4:=subtext(v4,s4,t4);m0CATu4END PROCe4;FILE VARw4;TEXT VARj1;INT VARx4;LETy4=#401 +#"keine schliessende Klammer in Feldmuster",z4=#402 +#"kein Kommando in Kommandozeile",a5=#403 +#"unbekanntes Kommando";LETb5="&",c5="%",d5="%",e5="<",f5=">";LETg5=#404 +#" "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR "LETh5=1,i5=2,j5=3,k5=4,l5=5,d1=6,f1=7,m5=100;INT VARn5,o5,p5;BOOL VARv0,q5;.r5:lineno(w4).s5:n5:=maxlinelength(w4).PROCt5(TEXT CONSTu5):REPx4INCR1UNTIL(j1SUBx4)<>u5END REP END PROCt5;PROCz1(INT VARw3,v5,e0):w5;IFb2THENw3:=max(n5,length(j1))+1;v5:=0;e0:=5ELSEw3:=x4;x5END IF.w5:y5(b5,c5).b2:x4>length(j1).x5:TEXT CONSTz5:=j1SUBx4;IFz5=c5THENe0:=0ELSEe0:=4END IF;a6;feldnamenlesen;b6.a6:t5(z5);IFx4-1>w3THENc6END IF.c6:e0INCR3.feldnamenlesen:IF(j1SUBx4)=e5THENd6ELSEe6END IF;IFf6THENz1(w3,v5,e0);LEAVEz1END IF.f6:o5>p5.d6:o5:=x4+1;p5:=pos(j1,f5,o5);IFp5=0THENg6(y4,subtext(j1,x4));p5:=length(j1)ELSEp5DECR1END IF;x4:=p5+2.e6:o5:=x4;y5(k0,c5);INT CONSTh6:=pos(j1,b5,o5,x4);IFh6>0THENx4:=h6END IF;p5:=x4-1.b6:IFi6THENj6;t5(z5)END IF;v5:=x4-w3.i6:(j1SUBx4)=z5.j6:e0:=e0OR1.END PROCz1;PROCz1(TEXT VARname):INT VARk6,v5,l6;z1(k6,v5,l6);IFv5>0THENname:=subtext(j1,o5,p5)ELSEname:=j0END IF +END PROCz1;PROCy5(TEXT CONSTm6,n6):INT CONSTo6:=pos(j1,m6,x4),p6:=pos(j1,n6,x4);x4:=length(j1)+1;IFo6>0THENx4:=o6END IF;IFp6>0ANDp6=lines(w4)END PROCw0;BOOL PROCa1(INT VARq0):x4:=1;IF(j1SUB1)<>d5THEN FALSE ELIF(j1SUB2)<>d5THENr6;s6;TRUE ELSEq0:=m5;TRUE END IF.r6:TEXT VARt6;t5(k0);IFx4>length(j1)THENg6(z4,j1);q0:=0;LEAVEa1WITH TRUE END IF;INT CONSTu6:=pos(j1,k0,x4);IFu6=0THENt6:=subtext(j1,x4);t6CATk0;x4:=length(j1)+1ELSEt6:=subtext(j1,x4,u6);x4:=u6END IF.s6:INT CONSTv6:=pos(g5,t6);IFv6>0CAND(g5SUB(v6-2))=k0THENq0:=code(g5SUB(v6-1))ELSEq0:=0;g6(a5,t6);END IF.END PROCa1;PROCi1(INT VARw6):t5(k0);INT CONSTx6:=x4;WHILEy6REPx4INCR1END REP;IFx4>x6THENw6:=int(subtext(j1,x6,x4-1))ELSEw6:=-1END IF.y6:pos("0123456789",j1SUBx4)>0.END PROCi1;FILE VARz6;TEXT VARa7;BOOL VARb7;PROCc7(TEXT CONSTname):a7:=name;d7("PROC ",name, +" :")END PROCc7;PROCe7:d7("END PROC ",a7,";")END PROCe7;PROCf7(TEXT CONSTg7):b7:=TRUE;putline(z6,g7)END PROCf7;PROCf7(TEXT CONSTh7,i7,j7):b7:=TRUE;d7(h7,i7,j7)END PROCf7;PROCd7(TEXT CONSTh7,i7,j7):write(z6,h7);write(z6,i7);write(z6,j7);line(z6)END PROCd7;TEXT VARk7;PROCf7(TEXT CONSTh7,INT CONSTl7,TEXT CONSTj7):k7:=subtext(j1,l7);f7(h7,k7,j7)END PROCf7;PROCm7(INT CONSTq6,n7):d7("; interpretiere (",text(q6)+", "+text(n7),", PROC (INT CONST, TEXT VAR) abk);")END PROCm7;LETo7=#405 +#"kein % WIEDERHOLUNG gefunden",p7=#406 +#"Nur GRUPPE-Anweisung erlaubt",q7=#407 +#"keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition",r7=#408 +#"illegale Gruppennummer",s7=#409 +#"diese Gruppe wurde schon definiert",t7=#410 +#"diese Abkuerzung ist nicht definiert",u7=#411 +#"dieser Abschnitt wurde schon einmal definiert",v7=#412 +#"falscher Modus",w7=#413 +#"diese Anweisung darf im Musterteil nicht vorkommen",x7=#414 +#"im Abkuerzungsteil darf keine Anweisung auftreten",y7=#415 +#"in dieser Zeile stehen zu viele Feldmuster",z7=#416 +#"das Druckmuster enthaelt zu viele Feldmuster",a8=#417 +#"nach dem ""&"" soll direkt der Name einer Abkuerzung folgen",b8=#418 +#"kein Doppelpunkt nach Abkuerzung",c8=#419 +#"Abkuerzung mehrfach definiert",d8=#420 +#"das Druckmuster enthaelt zu viele Abkuerzungen";LETe8=200,f8=4,g8=250,GRUPPE=STRUCT(BOOLh8,i8,TEXTg0),ABSCHNITT=STRUCT(INTo0,n0,TEXTc7);ROWe8INT VARe2;INT VARj8;ROWf8GRUPPE VARk8;ROW3ABSCHNITT VARl8;SATZ VARp0;TEXT VARm8;INT VARn8;OP CAT(TEXT VARo8,INT CONSTwert):TEXT VARp8:=" ";replace(p8,1,wert);o8CATp8END OP CAT;PROCq8:enablestop;u0(1);r8;s8;WHILE NOTv0REPt8END REP;u8.r8:INT VARq0;INT VARv8;n8:=0;satzinitialisieren(p0);m8:=j0;j8:=0;b7:=FALSE;l8(1):=ABSCHNITT:(0,0,"vorspann");l8(2):=ABSCHNITT:(0,0,"wdh");l8(3):=ABSCHNITT:(0,0,"nachspann");FORv8FROM1UPTOf8REPk8(v8).i8:=FALSE END REP.s8:BOOL VARw8:=FALSE;REP IFv0THENg6(o7);LEAVEq8END IF;w0;IFa1(q0)THENx8END IF END REP.x8:SELECTq0OF CASEm5:y8CASEl5:z8CASEh5,i5,j5:IF NOTw8THENc7("gruppen")END IF;e7;LEAVEs8OTHERWISE IFq0>0THENg6(p7)END IF END SELECT.y8:IFw8THENg6(q7,j1)ELSEreplace(j1,1," ");f7(j1)END IF.z8:IF NOTw8THENc7("gruppen");w8:=TRUE END IF;INT VARa9;i1(a9);IFa9<1ORa9>f8THENg6(r7,j1)ELIFk8(a9).i8THENg6(s7,j1)ELSEk8(a9).i8:=TRUE +;b9END IF.b9:f7("gruppentest (",text(a9),", ");f7(" ",x4,");").t8:SELECTq0OF CASEh5:c9CASEi5:d9CASEj5:e9END SELECT.c9:f9(l8(1),q0).d9:i1(g9);i1(h9);f9(l8(2),q0).e9:f9(l8(3),q0).u8:IFb7THENi9;j9END IF;k9;IFb7THENl9;m9END IF.k9:FORv8FROM1UPTOn8REP IF(m8ISUBv8)>0THENg6(t7,n9,m8ISUBv8)ELSEo9END IF END REP.n9:TEXT VARp9;feldlesen(p0,v8,p9);p9.i9:FORv8FROM1UPTO3REP IFl8(v8).n0=0THENq9END IF END REP.q9:c7(l8(v8).c7);e7.j9:f7("PROC abk (INT CONST nr, TEXT VAR inhalt) :");IFn8>0THENf7("SELECT nr OF")ELSEf7("inhalt := text (nr)")END IF.o9:TEXT CONSTr9:=text(v8);f7("CASE "+r9," : inhalt := abk",r9).l9:IFn8>0THENf7("END SELECT")END IF;f7("END PROC abk;").m9:f7("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)").END PROCq8;PROCf9(ABSCHNITT VARs9,INT VARq0):BOOL VARt9:=TRUE;c7(s9.c7);u9;v9;w9.u9:IFs9.n0<>0THENg6(u7,j1)END IF;s9.n0:=r5+1;s9.o0:=j8+1.v9:WHILE NOTv0REPw0;IFa1(q0)THENx9ELSEy9;z9END IF END REP;a10;LEAVEf9.x9:SELECTq0OF CASEm5:replace(j1,1," ");f7(j1);t9:=TRUE +CASEh5,i5,j5:a10;LEAVEf9CASEk5:a10;LEAVEv9CASEd1:y9;INT VARb10;i1(b10);IFb10<1ORb10>4THENg6(v7,j1)END IF CASEf1:y9OTHERWISE IFq0>0THENg6(w7)END IF END SELECT.y9:IFt9THENm7(r5,j8+1);t9:=FALSE END IF.a10:e7.z9:TEXT VARname;INT VARc10:=0;REPz1(name);IFname=j0THEN LEAVEz9END IF;c10INCR1;d10END REP.d10:IFc10>=b0THENg6(y7)END IF;IFj8=e8THENg6(z7)ELSEj8INCR1END IF;e10.e10:INT VARf10:=feldnummer(name);IFf10=0THENf10:=feldindex(p0,name);IFf10=0THENg10(name,r5);e2(j8):=-n8ELSEe2(j8):=-f10END IF ELSEe2(j8):=f10END IF.w9:BOOL VARh10:=TRUE;WHILE NOTv0REPw0;IFa1(q0)THENi10ELIFj10THENk10END IF END REP.i10:SELECTq0OF CASEh5,i5,j5:LEAVEw9OTHERWISE IFq0>0THENg6(x7)END IF END SELECT.k10:IFh10THENf7(".");h10:=FALSE END IF;IFl10THENm10ELSEf7(j1)END IF.l10:(j1SUB1)=b5.m10:TEXT VARn10;z1(n10);IFn10=j0THENg6(a8,j1);LEAVEm10END IF;o10;p10.o10:LETq10=":";x4DECR1;t5(k0);IF(j1SUBx4)=q10THENx4INCR1ELSEg6(b8,j1)END IF.p10:g10(n10,0);f7(r10,x4-1,"").r10:"abk"+text(feldindex(p0,n10)).j10:j1<>j0ANDj1<>k0.END PROCf9; +PROCg10(TEXT CONSTname,INT CONSTq6):INT CONSTs10:=feldindex(p0,name);IFs10>0THENt10ELSEu10END IF.t10:IF(m8ISUBs10)>0THENreplace(m8,s10,q6)ELIFq6=0THENg6(c8,name)END IF.u10:IFn8=g8THENg6(d8)ELSEn8INCR1END IF;m8CATq6;feldaendern(p0,n8,name).END PROCg10;LETv10=#421 +#"FEHLER in Zeile ",w10=#422 +#" bei >>",x10=#423 +#"<<";PROCg6(TEXT CONSTy10,z10,INT CONSTq6):LETa11=" ";TEXT VARb11:=v10;b11CATtext(q6);IFz10<>j0THENb11CATw10;b11CATz10;b11CATx10END IF;note(b11);noteline;note(a11);note(y10);noteline;IFonlineANDcommanddialogueTHENline;putline(b11);put(a11);putline(y10)END IF END PROCg6;PROCg6(TEXT CONSTy10):g6(y10,j0,r5)END PROCg6;PROCg6(TEXT CONSTy10,z10):g6(y10,z10,r5)END PROCg6;LETc11=#424 +#"erzeugtes Programm",d11=#425 +#"keine Datei geoeffnet",e11=#426 +#"interner Fehler",f11=#427 +#"Druckausgabe steht in",g11=#428 +#"zum Drucker geschickt.",h11=#429 +#"direkt Drucken nicht moeglich",i11=#430 +#".a$";TEXT VARj11,k11;BOOL VARl11,m11,n11,o11;FILE VARp11;INT VARg9,h9,q11,r11,s11,t11:=4000,u11;PROCdrucke:drucke(lastparam)END PROCdrucke;PROCdrucke(TEXT CONSTv11):enablestop;lastparam(v11);w4:=sequentialfile(input,v11);modify(w4);IFanzahldateien=0THENerrorstop(d11)END IF;disablestop;w11;q8;IFanythingnotedTHENnoteedit(w4)ELIFb7THENx11ELSEdrucke(PROCy11,PROCz11,PROCa12,PROCb12)END IF;forget(c12,quiet).w11:TEXT VARc12;INT VARv8:=0;REPv8INCR1;c12:=text(v8)UNTIL NOTexists(c12)END REP;z6:=sequentialfile(output,c12);headline(z6,c11).x11:run(c12);lastparam(v11).END PROCdrucke;PROCy11:END PROCy11;PROCz11:d12(1)END PROCz11;PROCa12:d12(2)END PROCa12;PROCb12:d12(3)END PROCb12;PROCd12(INT CONSTe12):IFl8(e12).n0>0THENinterpretiere(l8(e12).n0,l8(e12).o0,PROC(INT CONST,TEXT VAR)f12)END IF END PROCd12;PROCf12(INT CONSTe12,TEXT VARg0):errorstop(e11);g0:=code(e12)END PROCf12;PROCdrucke(PROCg12,PROCh12,PROCi12,PROCj12):INT VARk12,l12,m12;enablestop;n12;o12;p12;u11:=1;WHILE NOTdateiendeREPq12;cout( +satznummer);r12;weiter(k12);s12END REP;t12;u12;aufsatz(1).o12:l12:=0;aufsatz(1);IFmarkiertesaetze>0THENk12:=3;IF NOTsatzmarkiertTHENweiter(k12)END IF ELSEk12:=2;IF NOTsatzausgewaehltTHENweiter(k12)END IF END IF.p12:INT VARv8;FORv8FROM1UPTOf8REPk8(v8).g0:=j0END REP.q12:IFl12=0THENg12;v12;w12(PROCh12)ELSEm11:=FALSE;x12;y12END IF;l12:=satznummer;m12:=satzkombination.x12:l11:=FALSE;g12.y12:IFl11THENz12(l12,m12,PROCj12)END IF;u11INCR1;IFl11THENw12(PROCh12)END IF.r12:IFh9<1THENs5ELSEn5:=h9END IF;IFq11t11THENu12;n12END IF.t12:v12;IFl12=0THENw12(PROCj12)ELSEz12(l12,m12,PROCj12)END IF;u0(1).END PROCdrucke;PROCv12:INT VARv8;FORv8FROM1UPTOf8REPk8(v8).h8:=TRUE END REP;m11:=TRUE;l11:=TRUE END PROCv12;PROCw12(PROCs9):q11:=g9;toline(p11,s11+1);s5;i0:=1;s9END PROCw12;PROCz12(INT CONSTl12,m12,PROCj12):INT CONSTa13:=satznummer,b13:=satzkombination;aufsatz(l12);WHILEsatzkombination<>m12REPweiter(1)END REP;w12 +(PROCj12);aufsatz(a13);WHILEsatzkombination<>b13REPweiter(1)END REP END PROCz12;PROCn12:IFaktuellereditor>0THENc13ELSEd13END IF;e13.c13:p11:=editfile;IFcol>1THENsplitline(p11,col,FALSE);down(p11);col(p11,1)END IF;s11:=lineno(p11)-1.d13:IF NOTn11THENf13END IF;p11:=sequentialfile(modify,k11);maxlinelength(p11,maxlinelength(w4));s11:=lines(p11).f13:INT VARr4:=0;REPr4INCR1;k11:=headline(w4)+i11+text(r4);UNTIL NOTexists(k11)END REP.e13:u0(1);WHILE NOTv0REPg13END REP.g13:w0;INT VARq0;IFa1(q0)THENh13ELSEh1(j1)END IF.h13:IFq0<>m5ANDq0<>l5THEN LEAVEe13END IF.END PROCn12;PROCu12:IFaktuellereditor>0THEN ELIFn11THENn11:=FALSE;ELIFo11THENdisablestop;i13ELSEline;put(f11);putline(textdarstellung(k11));pause(40)END IF.i13:TEXT CONSTw6:=std;lastparam(k11);do("print (std)");IFiserrorTHENclearerror;errorstop(h11)ELSEline;put(textdarstellung(k11));putline(g11);forget(k11,quiet);pause(40)END IF;lastparam(w6).END PROCu12;PROCh1(TEXT CONSTq6):IFq11>=g9ORq11=0THENinsertrecord(p11);writerecord(p11,q6);s11INCR1 +ELSEj13END IF;down(p11).j13:IFeof(p11)THENj11:=j0;insertrecord(p11);s11INCR1ELSEreadrecord(p11,j11)END IF;k13;writerecord(p11,j11).k13:INT CONSTl13:=n5*q11;WHILElength(j11)k8(a9).g0THENk8(a9).g0:=n13;k8(a9).h8:=TRUE;l11:=TRUE ELSEk8(a9).h8:=FALSE END IF END PROCgruppentest;BOOL PROCgruppenwechsel(INT CONSTa9):IFa9>0THENk8(a9).h8ELSEm11END IF END PROCgruppenwechsel;TEXT PROClfdnr:text(u11)END PROClfdnr;END PACKETeudasdrucken; + diff --git a/app/eudas/4.3/src/eudas.3 b/app/eudas/4.3/src/eudas.3 new file mode 100644 index 0000000..98f0fae --- /dev/null +++ b/app/eudas/4.3/src/eudas.3 @@ -0,0 +1,58 @@ +PACKETfensterDEFINES FENSTER,fensterinitialisieren,fenstergroessesetzen,fenstergroesse,fensterveraendert,fensterzugriff,bildschirmneu:TYPE FENSTER=STRUCT(INTb0,c0);LETd0=16,BITVEKTOR=INT,GROESSE=STRUCT(INTe0,f0,g0,h0);ROWd0STRUCT(INTi0,j0,BITVEKTORk0,GROESSEl0)VARm0;INT VARn0:=1;BITVEKTOR VARo0;INT VARp0;FORp0FROM2UPTOd0REPm0(p0).i0:=0END REP;m0(1).i0:=1;m0(1).j0:=0;m0(1).k0:=0;m0(1).l0:=GROESSE:(1,1,79,24);PROCfensterinitialisieren(FENSTER VARf):f.b0:=1;m0(1).i0INCR1;f.c0:=n0;n0INCR1;IFn0>=32000THENn0:=-32000END IF END PROCfensterinitialisieren;PROCfenstergroessesetzen(FENSTER VARf,INT CONSTe0,f0,g0,h0):INT VARq0;r0;IFq0>d0THENs0;t0;u0END IF;v0.r0:q0:=1;WHILEq0<=d0REP IFw0THEN LEAVEr0END IF;q0INCR1END REP.w0:x0.e0=e0ANDx0.f0=f0ANDx0.g0=g0ANDx0.h0=h0.x0:m0(q0).l0.s0:q0:=1;WHILEq0<=d0REP IFm0(q0).i0=0THEN LEAVEs0END IF;q0INCR1END REP;errorstop("zu viele Fenstergroessen");LEAVEfenstergroessesetzen.t0:m0(q0).i0:=0;m0(q0).j0:=0;m0(q0).l0:=GROESSE:(e0,f0,g0,h0);m0(q0).k0:=0.u0:INT VARy0;FOR +y0FROM1UPTOd0REP IFm0(y0).i0>0THENz0END IF END REP.z0:IFa1(b1,c1)THENsetbit(m0(q0).k0,y0);setbit(m0(y0).k0,q0)ELSEresetbit(m0(y0).k0,q0)END IF.b1:m0(q0).l0.c1:m0(y0).l0.v0:m0(f.b0).i0DECR1;f.b0:=q0;m0(q0).i0INCR1.END PROCfenstergroessesetzen;BOOL PROCa1(GROESSE CONSTa,d1):e1ANDf1.e1:IFa.e0<=d1.e0THENd1.e0f.c0THENm0(f.b0).j0:=f.c0;h1:=TRUE END IF;o0:=o0ORg1;resetbit(o0,f.b0).g1:m0(f.b0).k0.END PROCfensterzugriff;PROCbildschirmneu:o0:=-1END PROCbildschirmneu;ROW16INT VARi1:=ROW16INT:(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1);PROCsetbit(BITVEKTOR +VARj1,INT CONSTq0):j1:=j1ORi1(q0)END PROCsetbit;PROCresetbit(BITVEKTOR VARj1,INT CONSTq0):j1:=j1AND(-1-i1(q0))END PROCresetbit;BOOL PROCbit(BITVEKTOR CONSTj1,INT CONSTq0):(j1ANDi1(q0))<>0END PROCbit;END PACKETfenster; +PACKETeudasmenuesDEFINES +##globalmanager,menuemanager, +##lock,free,menuedateneinlesen,menuenamen,menueloeschen,waehlbar,ausfuehrtaste,menueanbieten,auswahlanbieten,wahl,eschopausfuehren,hilfeanbieten,statusanzeigen,dialogfenster,dialogfensterloeschen,dialog,neuerdialog,ja,editget,fehlerausgeben:ROW8TEXT VARb0:=ROW8TEXT:("MENUE","BILD","FELD","ENDE","AUSWAHL","VORSPANN","HILFE","SEITE");LETc0=1,d0=2,e0=3,f0=4,g0=5,h0=6,i0=7,j0=8;LETk0=2,integer=3,l0=4,m0=7;LETn0=#701 +#"FEHLER in Zeile ";FILE VARo0;TEXT VARp0,q0;PROCr0:IFeof(o0)THENp0:="%DUMMY"ELSEreadrecord(o0,p0);IFp0=s0THENp0:=t0END IF;cout(lineno(o0));down(o0)END IF END PROCr0;BOOL PROCu0:IF(p0SUB1)=v0THENw0ELSE FALSE END IF.w0:INT VARx0;replace(p0,1,t0);scan(p0);replace(p0,1,v0);nextsymbol(q0,x0);IFx0<>k0THENy0(z0);FALSE ELSE TRUE END IF.END PROCu0;BOOL PROCa1(INT CONSTb1):b0(b1)=q0END PROCa1;INT PROCc1:TEXT VARd1;INT VARx0;nextsymbol(d1,x0);IFx0=integerTHENint(d1)ELSE IFx0<>m0THENy0(e1)END IF;-1END IF END PROCc1;TEXT PROCf1:TEXT VARd1;INT VARx0;nextsymbol(d1,x0);IFx0=l0THENd1ELSE IFx0<>m0THENy0(g1)END IF;s0END IF END PROCf1;PROCy0(TEXT CONSTh1):note(n0);note(lineno(o0)-1);noteline;note(h1);noteline;line;putline(h1)END PROCy0;INT VARi1,j1,k1,l1;PROCm1(INT CONSTn1,o1):cursor(k1+n1-1,l1+o1-1)END PROCm1;LETp1=#702 +#"Zeile ist ohne Zusammenhang",q1=#703 +#"K Menuedaten im Speicher";PROCmenuedateneinlesen(TEXT CONSTr1):s1;o0:=sequentialfile(input,r1);modify(o0);toline(o0,1);WHILE NOTeof(o0)REPr0;IFu0THENt1ELIF NOTanythingnotedTHENy0(p1)END IF END REP;u1;IFanythingnotedTHENnoteedit(o0)END IF.t1:IFa1(c0)THENv1ELIFa1(g0)THENw1ELIFa1(i0)THENx1ELIF NOTanythingnotedTHENy0(p1)END IF.u1:IFonlineTHENline;put(y1DIV2);putline(q1)END IF.y1:dspages(z1(1))+dspages(z1(2))+dspages(z1(3)).END PROCmenuedateneinlesen;TYPE MENUE=STRUCT(SATZa2,b2,c2,TEXTd2,e2);BOUND ROW200MENUE VARf2;TEXT VARg2,h2;SATZ VARi2,j2;LETs0="",t0=" ",k2=" ",l2=2,v0="%",m2=""7"",n2=""27"",o2=""5"";LETp2=#704 +#"% BILD erwartet",q2=#705 +#"Feldnummer beim %FELD-Kommando fehlt",r2=#706 +#"% ENDE erwartet",s2=#707 +#"Name fehlt",z0=#708 +#"Kommandozeile enthaelt kein Kommando",e1=#709 +#"Parameter soll eine Zahl sein",g1=#710 +#"Parameter soll ein TEXT sein",t2=#711 +#"Wiederholungszeile fehlt";PROCv1:TEXT VARname:=f1;IFname=s0THENy0(s2)ELSE INT VARindex;u2;v1(f2(index))END IF.u2:index:=link(v2(2),name);IFindex=0THENinsert(v2(2),name,index)END IF.END PROCv1;PROCv1(MENUE VARw2):x2;y2;z2;a3;b3.x2:satzinitialisieren(w2.a2);satzinitialisieren(i2);satzinitialisieren(j2);h2:=s0;g2:=s0.y2:c3;INT VARd3:=1;REPr0;IFu0THEN LEAVEy2ELSEe3;d3INCR1END IF END REP.c3:r0;IF NOT(u0CANDa1(d0))THENy0(p2)END IF.e3:IF(p0SUBl2)=k2THENg2CATcode(d3);replace(p0,l2,t0)END IF;feldaendern(w2.a2,d3,p0).z2:WHILEa1(e0)REPf3END REP.f3:INT VARg3:=c1;IFg3=-1THENy0(q2);g3:=100END IF;h3;i3;j3.h3:feldaendern(i2,g3,f1).i3:TEXT CONSTk3:=f1;INT VARl3;FORl3FROM1UPTOlength(k3)REPh2CATcode(g3);h2CAT(k3SUBl3)END REP.j3:TEXT VARm3:=s0;r0;WHILE NOTu0REPm3CATp0;r0END REP;feldaendern(j2,g3,m3).a3:IF NOTa1(f0)THENy0(r2)END IF.b3:w2.b2:=i2;w2.c2:=j2;w2.d2:=h2;w2.e2:=g2.END PROCv1;LETn3=#712 +#"Kommando wird ausgeführt ..",o3=#713 +#""15"Gib Kommando: ",p3=#714 +#"falsche Ausfuehrtaste",q3=#715 +#" existiert nicht.";LETr3=" ",s3=""15"",t3=""14"",u3="*"8"";INT VARv3:=0,w3,x3;BOOL VARy3,z3;TEXT VARa4,b4,c4:=" "1""2""3""8""10""13""27"",d4,e4:=s0;ROW6TEXT VARf4;FENSTER VARg4;fensterinitialisieren(g4);fenstergroessesetzen(g4,1,1,79,1);PROCwaehlbar(INT CONSTh4,i4,BOOL CONSTj4):IFj4THENk4ELSEl4END IF;y3:=TRUE.k4:IFlength(f4(h4))>=i4THENreplace(f4(h4),i4," ")END IF.l4:WHILElength(f4(h4))1CORn4THENerrorstop(p3)ELSEreplace(c4,1,m4)END IF.n4:m4<>""13""ANDpos(c4,m4,2)>0.END PROCausfuehrtaste;PROCmenueanbieten(ROW6TEXT CONSTmenuenamen,FENSTER VARf,BOOL CONSTo4,PROC(INT CONST,INT CONST)p4):ROW6INT VARq4,r4,s4;INT VARt4,u4:=0,v4:=1,w4:=0,x4;TEXT VARy4;ROW6TEXT VARz4;s1;a5;b5;disablestop;REPc5;d5;e5END REP.a5:v3INCR1;INT CONSTf5:=v3;y4:=""6""0""0"";g5;h5;y4CATo2.g5:INT VARi5:=pos(menuenamen(1),".");IFi5>0THENy4CATsubtext(menuenamen(1),1,i5-1)END IF;y4CAT": " +.h5:x4:=0;WHILEx4<6CANDj5REPx4INCR1;k5;s4(x4):=1END REP.j5:menuenamen(x4+1)<>s0.k5:q4(x4):=length(y4);i5:=pos(menuenamen(x4),".");IFi5=0THENy4CATmenuenamen(x4)ELSEy4CATsubtext(menuenamen(x4),i5+1)END IF;y4CAT" ";r4(x4):=length(y4)-1.b5:INT VARl5;FORl5FROM1UPTO6REPf4(l5):=s0END REP;y3:=TRUE;p4(0,0).c5:IFv4>0THENm5;n5;u4:=v4;v4:=0;o5ELIFv3<>f5THENa4:=y4;f4:=z4;v3:=f5ELIFy3THENz4:=f4END IF.m5:IFu4>0THENreplace(y4,q4(u4)," ");replace(y4,r4(u4)," ");IFz3THENp4(u4,-1)END IF END IF.n5:replace(y4,q4(v4),s3);replace(y4,r4(v4),t3);fensterveraendert(g4);a4:=y4;p5.o5:t4:=link(v2(2),menuenamen(u4));IFt4=0THENq5(menuenamen(u4));LEAVEmenueanbietenEND IF;z3:=FALSE;y3:=TRUE;fensterveraendert(f).d5:w4:=u4;r5(f2(t4),f,w4,s4(u4),PROC(INT CONST,INT CONST)p4).e5:SELECTw4OF CASE0:s5CASE1:t5CASE2:u5CASE3:v5CASE4:w5OTHERWISEx5END SELECT.u5:IFu41THENv4:=u4-1ELSEv4:=x4END IF.x5:w4:=w4-10;IFw4<=x4THENv4:=w4END IF.t5:IFo4THEN BOOL VARy5:=FALSE;REPz5;a6UNTILb6END REP;IFy5 +THENbildschirmneu;dialogfensterloeschen;p4(u4,-2)END IF END IF.a6:IFc6THENy5:=TRUE;statusanzeigen(n3);cursor(1,2);out(d6);do(d4)END IF.c6:pos(d4,"!","�",1)>0.b6:NOTiserror.s5:IFz3THENp4(u4,-1)END IF;fensterveraendert(f);LEAVEmenueanbieten.w5:IFs4(u4)>0THENp4(t4,s4(u4))ELSEs4(u4):=-s4(u4)END IF.END PROCmenueanbieten;PROCp5:BOOL VARe6;fensterzugriff(g4,e6);IFe6THENout(a4)END IF END PROCp5;PROCr5(MENUE CONSTw2,FENSTER VARf,INT VARf6,wahl,PROC(INT CONST,INT CONST)p4):INT VARg6:=0;h6;i6(f);IFx3=0THENw3:=0END IF;neuerdialog;j6;REPp5;k6;l6END REP.h6:IFwahl>length(w2.e2)THENwahl:=w3;ELIFiserrorTHENfehlerausgeben;p4(f6,-2);END IF.j6:IFy3THENm6;n6;y3:=FALSE END IF.m6:b4:=r3;INT VARl5;FORl5FROM1UPTOlength(f4(f6))REPreplace(b4,code(w2.e2SUBl5),f4(f6)SUBl5)END REP.n6:INT VARo6;FORo6FROM1UPTOlength(w2.e2)REP INT CONSTp6:=code(w2.e2SUBo6);IFp6>x3THEN LEAVEn6END IF;q6(w2.a2,p6)END REP.k6:REPr6;IFiserrorTHENs6ELSE LEAVEk6END IF END REP.r6:TEXT VARt6;BOOL VARu6:=FALSE;WHILEx31THENwahlDECR1ELSEwahl:=length(w2.e2)END IF.j7:w4:=3;LEAVEr5.k7:IFwahl0.v7:w4:=code(t6)-38;LEAVEr5.w7:c7:=0;REPc7:=pos(w2.d2,t6,c7+1)UNTIL(c7MOD +2)=0END REP;c7>0ANDy7.y7:code(w2.d2SUBc7-1)<=length(w2.e2).x7:wahl:=code(w2.d2SUBc7-1);x6(w2,wahl);IF(f4(f6)SUBwahl)<>"-"THENz7(w2,wahl,x3);w4:=4;LEAVEr5END IF.n7:wahl:=1.o7:wahl:=1.p7:wahl:=length(w2.e2).t7:IFa8THENwahl:=code(w2.d2SUBc7-1);w4:=4;LEAVEr5ELSEpush(lernsequenzauftaste(t6))END IF.a8:c7:=0;REPc7:=pos(w2.d2,t6,c7+1)UNTIL(c7MOD2)=0CAND(c7=0CORb8)END REP;c7>0.b8:code(w2.d2SUBc7-1)>length(w2.e2).q7:w4:=1;LEAVEr5.r7:TEXT VARc8;feldlesen(w2.b2,wahl,c8);hilfeanbieten(c8,d8);IFiserrorTHENfehlerausgebenEND IF;p4(f6,-2);i6(f).s7:w4:=0;LEAVEr5.g7:IF(f4(f6)SUBwahl)<>"-"THENz7(w2,wahl,x3);w4:=4;LEAVEr5END IF.w4:f6.END PROCr5;PROCi6(FENSTER CONSTf):BOOL VARe6;fensterzugriff(f,e6);fenstergroesse(f,k1,l1,j1,i1);IFe6THENx3:=0;m1(1,1)END IF END PROCi6;PROCx6(MENUE CONSTw2,INT CONSTwahl):INT CONSTe8:=code(w2.e2SUBwahl);IFw3>0THEN IFw3=wahlTHENq6(w2.a2,e8)ELSE INT CONSTf8:=code(w2.e2SUBw3);b7(w2.a2,f8,FALSE);b7(w2.a2,e8,TRUE);w3:=wahlEND IF END IF;m1(1,e8)END PROCx6;PROCy6(TEXT VARg8): +enablestop;getchar(g8)END PROCy6;PROCz7(MENUE CONSTw2,INT VARwahl,INT CONSTx3):INT CONSTl1:=code(w2.e2SUBwahl);IFh8THENi8END IF;TEXT VARm3;feldlesen(w2.c2,wahl,m3);IFm3<>s0ANDm3<>t0THENdo(m3);bildschirmneu;wahl:=-wahlEND IF.h8:x3>=l1.i8:m1(1,l1);out(u3).END PROCz7;PROCeschopausfuehren:TEXT VARj8:=s0,k8;lernsequenzauftastelegen(""0"",s0);push(""27""1""0""0"");editget(j8,32000,0,""0"","",k8);j8:=lernsequenzauftaste(""0"");IFj8<>s0THENl8ELSEm8END IF.l8:REPgetchar(k8)UNTILpos(""1""2""8""11""12"",k8)=0END REP;lernsequenzauftastelegen(k8,j8).m8:getchar(k8).END PROCeschopausfuehren;INT VARn8,o8,p8;PROCq6(SATZ CONSTa2,INT CONSTq8):m1(1,q8);IF(b4SUBq8)<>t0THENout(b4SUBq8)ELSEfeldbearbeiten(a2,q8,PROC(TEXT CONST,INT CONST,INT CONST)r8)END IF END PROCq6;PROCr8(TEXT CONSTs8,INT CONSTn8,o8):out(s8SUBn8+o8-o8)END PROCr8;PROCb7(SATZ CONSTa2,INT CONSTd3,BOOL CONSTt8):enablestop;IFt8THENq6(a2,d3);out(s3);n8:=3;p8:=1;ELSEm1(1,d3);IF(b4SUBd3)="-"THENout("-");n8:=2ELSEn8:=1END IF;p8:=0END IF;u8(a2,d3)END +PROCb7;PROCb7(SATZ CONSTa2,INT CONSTd3):n8:=1;p8:=0;u8(a2,d3)END PROCb7;PROCu8(SATZ CONSTa2,INT CONSTd3):IFd3<=felderzahl(a2)THENv8ELSEo8:=0END IF;w8.v8:feldbearbeiten(a2,d3,PROC(TEXT CONST,INT CONST,INT CONST)x8).w8:IFk1+j1>=80ANDp8=0THENout(o2)ELSEj1-o8-p8-1TIMESOUTt0;y8;out(":")END IF.y8:IFp8>0THENout(t3)END IF.END PROCu8;PROCx8(TEXT CONSTz8,INT CONSTa9,b9):INT CONSTc9:=a9-1;n8INCRc9;o8:=min(b9,j1+c9-p8-1);outsubtext(z8,n8,o8);o8DECRc9END PROCx8;PROCz5:LETd9=""27"k";TEXT VARe9;fensterveraendert(g4);f9;g9;REPh9UNTILe9<>d9END REP;IFpos(d4,"!","�",1)>0THENe4:=d4END IF.f9:IFiserrorTHENfehlerausgeben;d4:=e4ELSEd4:=s0END IF.g9:cursor(1,1);out(o3);j1-15TIMESOUTt0;out(t3).h9:cursor(16,1);editget(d4,32000,62,"","kh",e9);IFiserrorTHENclearerrorELIFe9=d9THENd4:=e4ELIFe9=i9THENd4:=s0END IF.END PROCz5;PROCq5(TEXT CONSTr1):errorstop(textdarstellung(r1)+q3)END PROCq5;TYPE AUSWAHL=STRUCT(SATZj9,k9,l9,TEXTm9,n9,o9);BOUND ROW200AUSWAHL VARp9;PROCw1:TEXT VARname:=f1;IFname=s0THENy0(s2)ELSE INT VAR +index:=link(v2(3),name);IFindex=0THENinsert(v2(3),name,index)END IF;w1(p9(index))END IF END PROCw1;PROCw1(AUSWAHL VARa):x2;IFq9THENr9END IF;y2;s9.x2:satzinitialisieren(a.j9);satzinitialisieren(a.k9);satzinitialisieren(a.l9);a.m9:=s0;a.n9:=s0;a.o9:=s0.q9:r0;u0CANDa1(h0).r9:INT VARd3:=1;REPr0;IFu0THEN LEAVEr9ELSEt9;d3INCR1END IF END REP.t9:feldaendern(a.j9,d3,p0).y2:c3;d3:=1;BOOL VARu9:=TRUE;REPr0;IFu0THENv9;LEAVEy2ELSEe3;d3INCR1END IF END REP.c3:IF NOT(u0CANDa1(d0))THENy0(p2)END IF.v9:IFu9THENy0(t2)END IF.e3:IFu9THENw9ELSEx9END IF.w9:IFpos(p0,k2)>0THENy9;d3:=0;u9:=FALSE ELSEfeldaendern(a.k9,d3,p0)END IF.y9:z9;a.m9:=p0;a10.z9:INT VARb10:=0;REPb10:=pos(p0,k2,b10+1);IFb10>0THENa.n9CATcode(b10)END IF UNTILb10=0END REP.a10:FORb10FROM1UPTOlength(a.n9)-1REPa.o9CATcode(c10-4)END REP;a.o9CAT""0"".c10:code(a.n9SUBb10+1)-code(a.n9SUBb10).x9:feldaendern(a.l9,d3,p0).s9:IF NOTa1(f0)THENy0(r2)END IF.END PROCw1;LETd10=""1""8""10"",e10="+"27"q";LETf10=#716 +#"Fenster zu klein",g10=#717 +#"AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ?";INT VARh10,i10,j10,k10,l10,m10,n10,o10;LET INTVEC=TEXT;INTVEC VARp10;TEXT VARq10;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,TEXT CONSTr10,PROC(TEXT VAR,INT CONST)s10):s1;INT CONSTindex:=link(v2(3),name);IFindex=0THENq5(name)ELSEr5(p9(index),f,r10,PROC(TEXT VAR,INT CONST)s10)END IF END PROCauswahlanbieten;PROCr5(AUSWAHL CONSTa,FENSTER CONSTf,TEXT CONSTr10,PROC(TEXT VAR,INT CONST)s10):INT VARx3:=0,g6:=0;enablestop;t10;statusanzeigen(g10);u10;v10;w10;REPk6;x10END REP.t10:BOOL VARy10;fensterzugriff(f,y10);fenstergroesse(f,k1,l1,j1,i1).u10:INT VARz10:=1024;h10:=z10;REPz10:=z10DIV2;s10(p0,h10);IFp0=s0THENh10DECRz10ELSEh10INCRz10END IF UNTILz10=1END REP;s10(p0,h10);IFp0=s0THENh10DECR1END IF.w10:INT VARa11:=k10+1,b11:=1,c11:=1;p10:=s0;q10:=a.n9.v10:j10:=felderzahl(a.j9);k10:=j10+felderzahl(a.k9);i10:=length(a.n9);l10:=(h10+i10-1)DIVi10;m10:=k10+l10;n10:=m10+felderzahl(a.l9);o10:=0;IFk10>=i1THENerrorstop(f10) +END IF.k6:REPr6;IFiserrorTHENclearerror;x3:=0ELSE LEAVEk6END IF END REP.r6:TEXT VARt6;WHILEx3i10THENa11DECR1; +c11DECRi10;IFa11<=j10THENa11INCR1;o10DECR1;x3:=j10END IF END IF.j7:IFb11>1THENb11DECR1;c11DECR1END IF.i11:IFb11=i10THENpush(""13"")ELSEpush(""1""2"")END IF.k7:IFc11+i10<=h10THENa11INCR1;c11INCRi10;IFa11>i1THENa11DECR1;o10INCR1;x3:=j10END IF END IF.l7:IFa11+o100THENw11;x11END IF.w11:change(p10,2*v11-1,2*v11,s0).m7:IFt60THENx3:=j10END IF.c12:max(0,k10-j10-o10).y11:WHILEc11>i10ANDa11>j10+1REPa11DECR1;c11DECRi10END REP.n11:c11DECR(b11-1);b11:=1.p7:IFa11=i1THENd12ELSEe12END IF.d12:a12:=min(i1-j10,n10-a11-o10);o10INCRa12;INT CONSTf12:=max(0,a11+o10-m10+g12);a11DECRf12;c11INCR(a12 +-f12)*i10;IFa12>0THENx3:=j10END IF.g12:IFb11-1>h10MODi10THEN1ELSE0END IF.e12:WHILEa11=80THENout(o2)ELSEj1-max(l3,length(a.m9))TIMESOUTt0END IF.END PROCg11;PROCu11(INT CONSTp0,u12,wert):m1(code(q10SUBu12)-4,p0);IFwert=0THENout(" o ")ELSEout(text(wert,3));out(" x ")END IF END PROCu11;INT PROCwahl(INT CONSTv12):IFv12+v12<=length(p10)THENp10ISUBv12ELSE0END IF END PROCwahl;LETw12=200,x12=5000;LET HILFE=STRUCT(INTy12,ROWw12THESAURUSz12,ROWw12SATZa13,ROWx12SATZb13);BOUND HILFE VARc13;INT VARd13,e13,f13,g13;BOOL VARh13:=FALSE;LETi13=#718 +#"Das Hilfsgebiet existiert bereits",j13=#719 +#"Diese Seite ist in der anderen Hilfe nicht vorhanden";PROCx1:TEXT VARname:=f1;BOOL VARk13;IFname=s0THENy0(s2)ELSEl13;m13;n13END IF.l13:INT CONSTo13:=pos(name,"/");TEXT VARp13;IFo13=0THENp13:=nameELSEp13:=subtext(name,1,o13-1)END IF;q13;r13.q13:INT VARs13:=link(v2(1),p13);k13:=FALSE;IFs13=0THENinsert(v2(1),p13,s13);c13.z12(s13):=emptythesaurus;satzinitialisieren(c13.a13(s13));ELIFo13=0THENy0(i13);LEAVEx1ELIFh13THENk13:=TRUE END IF.r13:INT VARt13;TEXT VARu13:=subtext(name,o13+1);IFo13=0THENt13:=1ELSEt13:=link(c13.z12(s13),u13);IFt13=0AND NOTk13THENinsert(c13.z12(s13),u13,t13)END IF END IF.m13:INT VARv13:=c13.y12;IFv13<0THENv13:=0END IF;TEXT VARw13:=s0;r0;WHILEu0CANDa1(j0)REPx13END REP.x13:INT CONSTy13:=c1;TEXT CONSTz13:=f1;IFz13<>s0THENa14;r0ELSEb14END IF.a14:TEXT VARc14;d14(z13,c14);IFy13+y13<=length(c14)THENw13CAT(c14ISUBy13)ELIF NOT(anythingnotedORk13)THENy0(j13)END IF.b14:INT VARd3:=1;IF NOTk13THENv13INCR1;w13CATv13;satzinitialisieren(c13.b13(v13))END IF;REPr0;IFu0THEN LEAVEb14ELIF + NOTk13THENfeldaendern(c13.b13(v13),d3,p0);d3INCR1END IF END REP.n13:IF NOTa1(f0)THENy0(r2)END IF;IF NOT(anythingnotedORk13)THENfeldaendern(c13.a13(s13),t13,w13);c13.y12:=v13END IF.END PROCx1;PROCd14(TEXT CONSTname,TEXT VARw13):INT CONSTo13:=pos(name,"/");INT VARp13,t13:=0;IFo13=0THENp13:=link(v2(1),name)ELSEp13:=link(v2(1),subtext(name,1,o13-1));e14END IF;IFt13=0THENt13:=1END IF;IFp13=0THENerrorstop(f14)ELSEfeldlesen(c13.a13(p13),t13,w13)END IF.e14:IFp13>0THENt13:=link(c13.z12(p13),subtext(name,o13+1))END IF.END PROCd14;LETf14=#720 +#"Hilfe existiert nicht",g14=#721 +#"Hilfe ist leer",h14=#722 +#"HILFE: Beenden: ESC q Seite weiter: ESC w Seite zurueck: ESC z";PROChilfeanbieten(TEXT CONSTname,FENSTER CONSTf):enablestop;s1;TEXT VARw13;i14;d14(name,w13);IFw13=s0THENerrorstop(g14)ELSEj14END IF.i14:fensterveraendert(f);fenstergroesse(f,d13,e13,f13,g13).j14:k14;statusanzeigen(h14);INT VARa13:=1;REPl14;m14END REP.l14:INT CONSTn14:=w13ISUBa13;o14(c13.b13(n14)).m14:TEXT VARt6;REPgetchar(t6);IFt6=n2THENgetchar(t6);a6;LEAVEm14ELSEout(m2)END IF END REP.a6:SELECTpos("qwz?"1"",t6)OF CASE1:LEAVEhilfeanbietenCASE2:p14CASE3:q14CASE4:r14CASE5:eschopausfuehrenOTHERWISEout(m2)END SELECT.p14:IF2*a131THENa13DECR1END IF.r14:a13:=1.END PROChilfeanbieten;PROCo14(SATZ CONSTs14):INT VARd3;FORd3FROM1UPTOg13REPcursor(d13,e13+d3-1);feldbearbeiten(s14,d3,PROC(TEXT CONST,INT CONST,INT CONST)t14)END REP;cursor(d13,e13+g13-1)END PROCo14;PROCt14(TEXT CONSTa2,INT CONSTa9,b9):IFb9-a9+1>f13THENo8:=a9+f13-1ELSEo8:=b9END IF;outsubtext(a2,a9,o8);IFd13+f13>=80THENout( +o2)ELSEf13+a9-o8-1TIMESOUTt0END IF END PROCt14;PROCstatusanzeigen(TEXT CONSTstatus):cursor(1,1);out(status);out(o2);fensterveraendert(g4)END PROCstatusanzeigen;LETd6=""4"",u14=""27"?",v14=""27"q",i9=""27"h";LETw14=#723 +#" ? (j/n) ",x14=#724 +#"jJ",y14=#725 +#"nN",z14=#726 +#"FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ?",a15=#727 +#"EINGABE: Bestätigen: RETURN Abbrechen: ESC h Hilfe: ESC ?",b15=#728 +#"EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbruch: ESC h Hilfe: ESC ?",c15=#729 +#""15"!!! FEHLER !!! "14" Quittieren: ESC q Hilfe zur Meldung: ESC ?";FENSTER VARd8;fensterinitialisieren(d8);INT VARd15,e15,f15,g15,h15;PROCdialogfenster(INT CONSTn1,o1,i15,j15):fenstergroessesetzen(d8,n1,o1,i15,j15);e15:=n1;f15:=o1;g15:=i15;h15:=j15END PROCdialogfenster;PROCneuerdialog:d15:=h15END PROCneuerdialog;PROCdialog:BOOL VARe6;fensterzugriff(d8,e6);d15INCR1;IFd15>h15ORe6THENdialogfensterloeschen;d15:=1END IF;cursor(e15,f15+d15-1).END PROCdialog;PROCdialogfensterloeschen:BOOL CONSTk15:=e15+g15>=80;d15:=0;REPcursor(e15,f15+d15);IFk15THENout(o2)ELSEg15TIMESOUTt0END IF;d15INCR1UNTILd15>=h15END REP.END PROCdialogfensterloeschen;BOOL PROCja(TEXT CONSTl15,r10):REPstatusanzeigen(z14);dialog;out(l15);out(w14);k14;m15END REP;FALSE.m15:TEXT VARt6;REPgetchar(t6);IFpos(x14,t6)>0THENout(t6);LEAVEjaWITH TRUE ELIFpos(y14,t6)>0THENout(t6);LEAVEjaWITH FALSE ELIFt6=n2THENn15ELSEout(m2)END IF END REP.n15:getchar(t6);IFt6="?"THENhilfeanbieten(r10,d8);neuerdialog;LEAVEm15ELIFt6="h"THEN +errorstop(s0);LEAVEjaWITH FALSE ELIFt6=""1""THENeschopausfuehrenELSEout(m2)END IF.END PROCja;PROCeditget(TEXT CONSTo15,TEXT VARt6,TEXT CONSTp15,r10):TEXT VARe9;q15;dialog;out(o15);out(t0);editget(t6,1000,r15,"","?hq"+p15,e9);IFe9=u14THENhilfeanbieten(r10,d8);neuerdialog;editget(o15,t6,p15,r10)ELIFe9=i9ORe9=v14THENerrorstop(s0)ELIFlength(e9)=2THENt6:=e9END IF.q15:IFpos(p15,"z")>0THENstatusanzeigen(b15)ELSEstatusanzeigen(a15)END IF.r15:g15-length(o15)-1.END PROCeditget;PROCfehlerausgeben:TEXT CONSTh1:=errormessage;IFerrorcode=1THENpage;bildschirmneuEND IF;clearerror;k14;IFh1<>s0THENstatusanzeigen(c15);s15;t15;neuerdialogEND IF.s15:dialog;out(m2);out(">>> ");outsubtext(errormessage,1,g15).t15:TEXT VARt6;getchar(t6);IFt6=n2THENn15END IF.n15:getchar(t6);IFt6="?"THENhilfeanbieten("FEHLER/"+text(errorcode),d8)ELIFt6=""1""THENeschopausfuehrenEND IF.END PROCfehlerausgeben;PROCk14:WHILEgetcharety<>s0REP END REP END PROCk14;LETu15=3,v15=12,w15=14,x15=1070,y15=1068,z15=1069,a16=0,b16=2;ROWu15 +DATASPACE VARz1;ROWu15THESAURUS VARv2;BOOL VARc16:=FALSE;INITFLAG VARd16;PROCs1:IF NOTinitialized(d16)THENe16END IF.e16:BOOL VARb6:=c16;f16;IFb6THENg16ELSEmenueloeschen(FALSE)END IF.f16:INT VARh16;FORh16FROM1UPTOu15WHILEb6REPi16END REP.i16: +##INT VARj16,k16;FORk16FROM1UPTO10REPforget(z1(h16));z1(h16):=nilspace;pingpong(father,x15+h16,z1(h16),j16);IFj16=a16THEN LEAVEi16ELIFj16<>b16THENpause(15)END IF UNTILj16=b16END REP;forget(z1(h16));z1(h16):=nilspace; +##b6:=FALSE.END PROCs1;THESAURUS PROCmenuenamen(INT CONSTh16):s1;IFh16<0THENc13.z12(-h16)ELSEv2(h16)END IF END PROCmenuenamen;PROCmenueloeschen(TEXT CONSTname,INT CONSTh16):s1;IFh16<0THENl16(name,c13.z12(-h16))ELSEl16(name,v2(h16))END IF END PROCmenueloeschen;PROCl16(TEXT CONSTname,THESAURUS VARz8):INT CONSTindex:=link(z8,name);IFindex>0THENdelete(z8,index)END IF END PROCl16;PROCmenueloeschen(BOOL CONSTm16):INT VARh16;d16:=TRUE;h13:=m16;FORh16FROM1UPTOu15REPforget(z1(h16));z1(h16):=nilspace;v2(h16):=emptythesaurusEND REP;g16END PROCmenueloeschen;PROCg16:c13:=z1(1);f2:=z1(2);p9:=z1(3)END PROCg16; +##LETn16=#730 +#"Datei wird von anderer Task geaendert.",o16=#731 +#"Auftrag nur fuer Soehne erlaubt";THESAURUS VARp16:=emptythesaurus;ROW200TASK VARq16;TEXT VARr16;BOUND STRUCT(TEXTname,s16,t16)VARu16;PROCmenuemanager(DATASPACE VARv16,INT CONSTw16,x16,TASK CONSTy16):enablestop;c16:=TRUE;IFw16>=y15ANDw16<=x15+u15THENz16ELSE IFw16=v15ORw16=w15THENa17END IF;freemanager(v16,w16,x16,y16)END IF.z16:IFw16=y15THENb17ELIFw16=z15THENc17ELSEd17END IF.b17:u16:=v16;e17(u16.name,y16);send(y16,a16,v16).c17:u16:=v16;f17(u16.name);send(y16,a16,v16).a17:IFx16=1THENg17ELSEf17(r16)END IF.g17:u16:=v16;r16:=u16.name;IFh17THENerrorstop(n16)END IF.h17:INT VARv12:=link(p16,r16);v12>0CAND NOT(q16(v12)=y16).d17:IFy16=39THENfenstergroessesetzen(fenster,g1,h1,i1,j1);y0:=g1+i1>=80;o0:=i1;n0:=j1;q0:=g1;p0:=h1;x0:=TRUE ELSEerrorstop(f1)END IF END PROCanzeigefenster;PROCk1:BOOL VARfensterveraendert;fensterzugriff(fenster,fensterveraendert);IFfensterveraendertTHENa1:=TRUE END IF END PROCk1;PROCl1:IFm1ORx0THENn1;o1;p1;q1;r1;s1END IF.m1:v0<>dateiversion.n1:l0:=0;WHILEl0y1THENm0:=max(y1,1)END IF;a1:=TRUE.y1:l0-n0+3.END PROCrollen;PROCfeldauswahl(TEXT +CONSTz1):l1;a2;a1:=TRUE.a2:l0:=length(z1);INT VARb2;FORb2FROM1UPTOl0REPk0(b2).i0:=code(z1SUBb2)END REP;m0:=1.END PROCfeldauswahl;INT VARc2;PROCd2:type(c1,-1);editfile:=sequentialfile(modify,c1);editinfo(editfile,-1);toline(editfile,1);col(editfile,1);maxlinelength(editfile,10000);c2:=1END PROCd2;.e2:c2<=l0.PROCf2(PROC(TEXT CONST,INT CONST)g2):h2;IFeof(editfile)THENg2("",i0)ELIFi2THENj2;k2;g2(e1,i0)ELIFl2THENreadrecord(editfile,e1);k2;g2(e1,i0);down(editfile)ELSEexec(PROC(TEXT CONST,INT CONST)g2,editfile,i0);down(editfile)END IF.h2:INT CONSTv1:=c2,i0:=k0(v1).i0;REPc2INCR1UNTILc2>l0CORm2END REP.m2:k0(c2).i0<>i0.i2:c2-v1>1.j2:e1:="";REPexec(PROC(TEXT CONST,INT CONST)n2,editfile,length(e1));down(editfile)UNTILeof(editfile)ORlineno(editfile)=c2END REP.l2:INT CONSTo2:=len(editfile);subtext(editfile,o2,o2)=c0.END PROCf2;PROCn2(TEXT CONSTp2,INT CONSTq2):IFq2>0CAND(e1SUBq2)<>c0CAND(p2SUB1)<>c0THENe1CATc0END IF;e1CATp2END PROCn2;PROCk2:INT VARo2:=length(e1);WHILE(e1SUBo2)=c0REPo2DECR1END REP;e1 +:=subtext(e1,1,o2)END PROCk2;BOOL VARr2;PROCeinfuegen(PROCs2):enablestop;l1;IFl0>0THENd2;k1;t2(PROCs2);satzeinfuegen;r2:=TRUE;u2END IF END PROCeinfuegen;PROCu2:WHILEe2REPf2(PROC(TEXT CONST,INT CONST)v2)END REP;aenderungeneintragenEND PROCu2;PROCv2(TEXT CONSTw2,INT CONSTi0):IF NOTr2CORw2<>d0THENfeldaendern(i0,w2)END IF END PROCv2;PROCaendern(PROCs2):enablestop;IFdateiendeTHENeinfuegen(PROCs2)ELSEx2END IF.x2:l1;IFl0>0THENd2;k1;y2(a1);z2;t2(PROCs2);r2:=FALSE;u2END IF.z2:a3:=1;WHILEa3<=l0REPfeldbearbeiten(k0(a3).i0,PROC(TEXT CONST,INT CONST,INT CONST)b3);insertrecord(editfile);writerecord(editfile,e1);down(editfile);a3INCR1END REP;toline(editfile,1).END PROCaendern;INT VARa3;PROCb3(TEXT CONSTu1,INT CONSTv1,w1):e1:=subtext(u1,c3,d3).c3:v1+k0(a3).j0.d3:IFe3THENw1ELSEv1+k0(a3+1).j0-1END IF.e3:a3=l0CORk0(a3+1).i0<>k0(a3).i0.END PROCb3;PROCsuchen(PROCs2):enablestop;l1;IFl0>0THENd2;k1;IFsuchversion<>0THENf3END IF;t2(PROCs2);g3END IF.f3:a3:=1;WHILEa3<=l0REPinsertrecord(editfile);h3;down(editfile) +;a3INCR1END REP;toline(editfile,1).h3:IFk0(a3).j0=0THENsuchbedingunglesen(k0(a3).i0,e1);writerecord(editfile,e1)END IF.g3:suchbedingungloeschen;WHILEe2REPf2(PROC(TEXT CONST,INT CONST)i3)END REP.END PROCsuchen;PROCi3(TEXT CONSTj3,INT CONSTi0):suchbedingung(i0,j3)END PROCi3;PROCbildausgeben(BOOL CONSTk3):enablestop;l1;k1;IFk3ORa1ORl3THENy2(a1);t0:=satznummer;u0:=satzkombination;m3(TRUE)ELSEn3(TRUE)END IF.l3:satznummer<>t0ORu0<>satzkombination.END PROCbildausgeben;INT VARj0;BOOL VARo3;PROCy2(BOOL CONSTp3):INT VARb2:=1,q3:=0;o3:=TRUE;WHILEb2<=l0OR NOTo3REPr3END REP.r3:IFo3CANDk0(b2).i0=q3THENs3ELSE IFt3THENu3END IF;k0(b2).j0:=j0;feldbearbeiten(k0(b2).i0,PROC(TEXT CONST,INT CONST,INT CONST)v3);b2INCR1END IF.s3:IFp3THENw3(b2)ELSEk0(b2).j0:=j0;b2INCR1END IF.t3:b2>l0CORk0(b2).i0<>q3.u3:IFo3THENx3ELSEy3(b2);k0(b2).i0:=q3END IF.x3:q3:=k0(b2).i0;j0:=0.END PROCy2;PROCv3(TEXT CONSTu1,INT CONSTv1,w1):INT CONSTz3:=w1-v1-j0+1;IFz3>s0-2THENj0INCRs0-2;a4;o3:=FALSE ELSEj0INCRz3;o3:=TRUE END IF.a4:INT VAR +b4:=v1+j0-1;IFc4ANDd4THEN WHILE(u1SUBb4)<>c0REPb4DECR1;j0DECR1END REP END IF.c4:(u1SUBb4)<>c0.d4:pos(u1,c0,b4-s0,b4-1)>0.END PROCv3;PROCy3(INT CONSTb2):INT VARe4;FORe4FROMl0DOWNTOb2REPk0(e4+1):=k0(e4)END REP;l0INCR1;a1:=TRUE END PROCy3;PROCw3(INT CONSTb2):INT VARe4;FORe4FROMb2+1UPTOl0REPk0(e4-1):=k0(e4)END REP;l0DECR1;a1:=TRUE END PROCw3;INT VARf4;TEXT VARg4,h4,i4,j4:="",k4;LETl4=#802 +#""15" Bild verschoben ! ESC 1 druecken ! "14"";LETm4=""3""10"19"11""12"q?hpg";LETn4=1,o4=2,p4=3,q4=4,r4=5,s4=6,t4=7,u4=8,v4=9,w4=10,x4=11;PROCt2(PROCs2):INT VARy4:=m0;lernsequenzauftastelegen("D",date);REPm3(FALSE);z4;a5;b5;c5UNTILd5END REP;toline(editfile,1);col(editfile,1).z4:IFlines(editfile)1THENe5(m0-1,h4)END IF;e5(f5,i4);toline(editfile,y4).f5:min(l0+1,m0+n0-1).b5:openeditor(groesstereditor+1,editfile,TRUE,q0+r0+3,p0,s0,g5);edit(groesstereditor,m4+j4,PROC(TEXT CONST)h5).g5:min(l0-m0+2,n0).c5:y4:=lineno(editfile);i5;SELECTf4OF CASEn4:j5CASEo4:k5CASEp4:l5CASEq4:m5CASEr4:n5CASEs4:o5CASEu4:s2;a1:=TRUE CASEv4:errorstop(d0)CASEw4:p5CASEx4:q5END SELECT.i5:INT CONSTr5:=col(editfile);col(editfile,1);IFm0<>1THENs5(m0-1,h4)END IF;s5(f5,i4);col(editfile,r5).j5:INT VARt5;t5:=y4-m0;rollen(-n0+1);y4:=m0+t5.k5:t5:=y4-m0;rollen(n0-1);y4:=min(m0+t5,l0).l5:rollen(-999);y4:=1.m5:t5:=y4-m0;rollen(999);y4:= +min(m0+t5,l0).n5:toline(editfile,y4);u5;y3(y4).u5:readrecord(editfile,e1);g4:=subtext(e1,r5);e1:=subtext(e1,1,r5-1);writerecord(editfile,e1);down(editfile);insertrecord(editfile);writerecord(editfile,g4).o5:toline(editfile,y4);IFr5=1AND(v5CANDw5ORx5CANDy5)THENz5ELSEa6END IF.v5:y4<>l0.w5:k0(y4+1).i0=k0(y4).i0.x5:y4<>1.y5:k0(y4-1).i0=k0(y4).i0.z5:deleterecord(editfile);w3(y4).a6:readrecord(editfile,e1);e1:=subtext(e1,1,r5-1);writerecord(editfile,e1).p5:forget(b1);b1:=c1;z0:=TRUE.q5:IFz0THENforget(c1);c1:=b1;editfile:=sequentialfile(modify,c1)END IF.d5:f4=t4.END PROCt2;PROCh5(TEXT CONSTb6):enablestop;setbusyindicator;f4:=pos(m4,b6);IFf4>0THENk4:=b6;quitELIFpos(j4,b6)>0THENf4:=t4;k4:=b6;quitELIFkommandoauftaste(b6)<>d0THENstdkommandointerpreter(b6)ELSEnichtsneuEND IF END PROCh5;PROCe5(INT CONSTb2,TEXT VARc6):toline(editfile,b2);readrecord(editfile,c6);writerecord(editfile,l4)END PROCe5;PROCs5(INT CONSTb2,TEXT CONSTc6):toline(editfile,b2);IFeof(editfile)CORpos(editfile,l4,1)=0THENtoline( +editfile,1);down(editfile,l4);IFeof(editfile)THENtoline(editfile,b2);insertrecord(editfile)END IF END IF;writerecord(editfile,c6)END PROCs5;PROCexitzeichen(TEXT CONSTd6):j4:=d6END PROCexitzeichen;TEXT PROCexitdurch:k4END PROCexitdurch;INT VARe6;LETf6=#803 +#"ENDE.",g6=#804 +#"SUCH+",h6=#805 +#"SUCH-",i6=#806 +#"MARK+",j6=#807 +#"MARK-",k6=#808 +#" Feld "14" ",l6=#809 +#" Satz ",m6=#810 +#"< KOPPEL >";LETn6=".....",o6=" ";PROCm3(BOOL CONSTp6):INT VARq6:=p0+1,r6:=0;INT CONSTs6:=m0+n0-2;n3(p6);e6:=m0;WHILEe6<=s6REPt6;u6;v6;q6INCR1;e6INCR1END REP;a1:=FALSE.t6:IFa1THENcursor(q0,q6);IFe6<=l0THENw6ELIFe6=l0+1THENx6ELSEy6END IF END IF.w6:out(f0);IFk0(e6).i0=r6THENr0TIMESOUTc0ELSEr6:=k0(e6).i0;feldnamenbearbeiten(r6,PROC(TEXT CONST,INT CONST,INT CONST)z6)END IF;out(g0).x6:out(f0);o0-4TIMESOUT".";out(h0).y6:IFy0THENout(e0)ELSEo0TIMESOUTc0END IF.u6:IFp6ANDe6<=l0THENcursor(q0+r0+3,q6);feldbearbeiten(k0(e6).i0,PROC(TEXT CONST,INT CONST,INT CONST)a7)END IF.v6:IF NOTa1THEN TEXT CONSTinput:=getcharety;IFinput<>d0THENpush(input);IFpos(j4,input)>0THENt0:=0;LEAVEm3END IF END IF END IF.END PROCm3;PROCn3(BOOL CONSTp6):b7;c7;cursor(q0,p0);IF NOTp6THENoutsubtext(d1,1,r0+3);LEAVEn3END IF;replace(d1,r0+7,d7);replace(d1,r0+14,e7);out(d1);cursor(q0+o0-5,p0);out(text(m0)).b7:TEXT VARsatznr;satznr:=text(satznummer);IFanzahlkoppeldateien>0AND NOTaufkoppeldateiTHENsatznrCAT"-";satznrCATtext( +satzkombination)END IF.c7:replace(d1,7,o6);replace(d1,7,satznr).d7:IFsuchversion=0THENn6ELIFsatzausgewaehltTHENg6ELSEh6END IF.e7:IFdateiendeTHENf6ELIFmarkiertesaetze=0THENn6ELIFsatzmarkiertTHENi6ELSEj6END IF.END PROCn3;PROCz6(TEXT CONSTu1,INT CONSTv1,w1):IFw1-v1>=r0THENoutsubtext(u1,v1,v1+r0-1)ELSEoutsubtext(u1,v1,w1);r0-w1+v1-1TIMESOUTc0END IF END PROCz6;PROCa7(TEXT CONSTu1,INT CONSTv1,w1):INT VARo2;IFe6=l0CORf7THENo2:=w1ELSEo2:=v1+k0(e6+1).j0-1END IF;outsubtext(u1,v1+k0(e6).j0,o2);IFy0THENout(e0)ELSEg7TIMESOUTc0END IF.f7:k0(e6+1).i0<>k0(e6).i0.g7:s0-o2+v1+k0(e6).j0-1.END PROCa7;PROCp1:d1:=text(l6,r0+3);d1CATf0;INT VARe4;INT CONSTh7:=o0-length(d1)-11;FORe4FROM1UPTOh7REPd1CAT"."END REP;d1CATk6;i7.i7:TEXT VARj7;IFaufkoppeldateiTHENj7:=m6ELSEj7:=eudasdateiname(1)END IF;j7:=subtext(j7,1,h7-20);j7CATc0;replace(d1,r0+21,c0);replace(d1,r0+22,j7).END PROCp1;END PACKETsatzanzeige; +PACKETuebersichtsanzeigeDEFINESuebersicht,uebersichtsfenster:ROW24INT VARb0;ROW24INT VARc0;FENSTER VARfenster;fensterinitialisieren(fenster);INT VARd0:=24,e0:=79,f0:=1,g0:=1,h0,i0:=-1;BOOL VARj0,k0;TEXT VARl0;LETm0="",n0=""15"",o0=""14"",p0=" ",q0=""7"",r0=""5"";LETs0=#901 +#""15"Satznr. ",t0=#902 +#" << DATEIENDE >>",u0=#903 +#"UEBERSICHT: Rollen: HOP OBEN, HOP UNTEN Beenden: ESC q Hilfe: ESC ?";PROCuebersichtsfenster(INT CONSTv0,w0,x0,y0):fenstergroessesetzen(fenster,v0,w0,x0,y0);j0:=v0+x0>=80;d0:=y0;e0:=x0;f0:=w0;g0:=v0END PROCuebersichtsfenster;PROCuebersicht(TEXT CONSTz0,PROCa1):TEXT VARb1;BOOL VARc1;INT VARd1:=1,e1:=0,f1:=1;fensterzugriff(fenster,c1);statusanzeigen(u0);g1;k0:=FALSE;h1;REPi1;j1;k1END REP.g1:IFz0=m0THENl1ELSEl0:=z0;i0:=dateiversionEND IF.l1:IFi0<>dateiversionTHENm1;i0:=dateiversionEND IF.m1:INT VARn1;l0:=m0;FORn1FROM1UPTOanzahlfelderREPl0CATcode(n1)END REP.i1:WHILEe1""THEN LEAVEi1END IF;o1;e1INCR1END REP;p1;getchar(b1).o1:IFe1=0THENq1ELIFe1=1THENr1ELSEs1END IF.q1:cursor(g0,f0);out(s0);h0:=e0-10;INT VARfeldindex;FORfeldindexFROM1UPTOlength(l0)WHILEh0>0REPfeldnamenbearbeiten(code(l0SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)t1)END REP;u1;cursor(g0+e0-1,f0);out(o0).r1:v1(1);w1(1);x1.s1:cursor(g0,f0+e1);IFdateiendeTHENb0(e1):=0;h0:=e0;u1ELSEy1;w1(e1); +x1END IF.y1:weiter(2);z1;b0(e1):=satznummer;c0(e1):=satzkombination.z1:IF NOT(satzausgewaehltORdateiende)THEN LEAVEuebersichtEND IF.j1:IFd11THENd1DECR1;ELSEp2(1);e1:=1END IF.f2:IF NOTdateiendeTHEN IFd11THENd1:=1ELSEp2(d0-1);e1:=1END IF.j2:IFd1=d0-1AND NOTdateiendeTHENweiter(2);h1;e1:=1ELSEd1:=d0-1END IF.k2:IFd1<>1THENb0(1):=b0(d1);c0(1):=c0(d1);d1:=1;e1:=1END IF. +l2:aufsatz(1);IF NOTsatzausgewaehltTHENweiter(2)END IF;h1;d1:=1;e1:=1.m2:aufsatz(32767);h1;p2(d0-2);e1:=1.n2:k0:=true;w1(d1);LEAVEuebersicht.o2:a1;statusanzeigen(u0);e1:=0.END PROCuebersicht;PROCp2(INT CONSTq2):INT VARn1;v1(1);FORn1FROM1UPTOq2WHILEsatznummer>1REPzurueck(2)END REP;h1END PROCp2;PROCv1(INT CONSTr2):aufsatz(b0(r2));WHILEsatzkombination<>c0(r2)REPweiter(1)END REP END PROCv1;PROCh1:b0(1):=satznummer;c0(1):=satzkombinationEND PROCh1;BOOL PROCs2(INT CONSTr2):satznummer=b0(r2)CANDsatzkombination=c0(r2)END PROCs2;PROCt1(TEXT CONSTt2,INT CONSTu2,v2):INT CONSTd0:=min(h0,v2-u2+1);outsubtext(t2,u2,u2+d0-1);h0DECRd0;IFh0>=2THENout(", ");h0DECR2ELIFh0=1THENout(",");h0:=0END IF END PROCt1;PROCw1(INT CONSTr2):cursor(g0,f0+r2);IFk0THENout(n0)ELSEout(p0)END IF;outtext(text(b0(r2)),1,5);IFk0THENout(o0)ELSEout(p0)END IF;h0:=e0-7END PROCw1;PROCu1:IFj0THENout(r0)ELSEh0TIMESOUTp0END IF END PROCu1;PROCx1:IFsatzausgewaehltTHENa2;w2ELIFdateiendeTHENout(t0);h0DECR17ELSEa2;out("<< >>");h0DECR5END +IF;u1.w2:INT VARfeldindex;FORfeldindexFROM1UPTOlength(l0)WHILEh0>0REPfeldbearbeiten(code(l0SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)t1)END REP.END PROCx1;PROCa2:IFsatzmarkiertTHENout("+ ")ELSEout("- ")END IF;h0DECR2END PROCa2;END PACKETuebersichtsanzeige; +PACKETeudassteuerungDEFINESeudas,einzelsicherung,suchen,aendern,einfuegen,prueffehlereditieren,feldstruktur,dateiverwaltung,archivverwaltung,edit,dateinamenanfordern,ausfuehrung,einzelausfuehrung:LETb0=1003,c0=3243;LETd0="",e0=" ",f0=""27"z",g0=""4"",h0=""5"";FILE VARi0;DATASPACE VARj0;INT VARk0,l0:=dateiversion-1;FENSTER VARm0,n0,o0,p0;TEXT VARq0;fensterinitialisieren(m0);fensterinitialisieren(n0);fensterinitialisieren(o0);fensterinitialisieren(p0);fenstergroessesetzen(m0,1,2,79,23);fenstergroessesetzen(n0,1,2,15,22);fenstergroessesetzen(o0,16,2,64,22);fenstergroessesetzen(p0,1,24,79,1);dialogfenster(16,2,64,22);anzeigefenster(16,2,64,23);uebersichtsfenster(1,2,79,23);TEXT VARr0;BOOL VARs0:=FALSE;LETt0=#1001 +#"EUDAS.Öffnen",u0=#1002 +#"EUDAS.Einzelsatz",v0=#1003 +#"EUDAS.Gesamtdatei",w0=#1004 +#"EUDAS.Drucken",x0=#1005 +#"EUDAS.Dateien",y0=#1006 +#"EUDAS.Archiv";LETz0=#1007 +#"EUDAS kann nicht unter EUDAS aufgerufen werden",a1=#1008 +#"Suchbedingung einstellen",b1=#1009 +#"Alle Saetze drucken",c1=#1010 +#"Alle markierten Satze drucken",d1=#1011 +#"Aktuellen Satz drucken",e1=#1012 +#"Mit neuer Auswahl noch einmal",f1=#1013 +#"Akt.Datei: ",g1=#1014 +#" Datum: ";PROCh1:cursor(30,6);out("EEEEE U U DDDD A SSSS");cursor(30,7);out("E U U D D A A S");cursor(30,8);out("EEE U U D D AAAAA SSS");cursor(30,9);out("E U U D D A A S");cursor(30,10);out("EEEEE UUU DDDD A A SSSS");cursor(30,12);out("Version 4.3");cursor(30,13);out("Stand: 13.08.87");cursor(30,15);out("(C) COPYRIGHT:");cursor(30,16);out("Thomas Berlage");cursor(30,17);out("Software-Systeme")END PROCh1;PROCeudas:IFaktuellereditor>0THENi1ELIFs0THENerrorstop(z0)ELSEj1END IF.j1:page;bildschirmneu;h1;k0:=heapsize;k1;disablestop;s0:=TRUE;menueanbieten(ROW6TEXT:(t0,u0,v0,w0,x0,y0),n0,TRUE,PROC(INT CONST,INT CONST)l1);s0:=FALSE;enablestop;m1;page;bildschirmneuEND PROCeudas;PROCi1:TEXT VARn1;o1;m1;IFp1THEN LEAVEi1END IF;q1(FALSE);aufsatz(1);r1(n1);REPs1;uebersicht(n1,PROCt1);o1;u1UNTILv1END REP;dateienloeschen(FALSE).p1:INT VARw1;FORw1FROM1UPTOanzahldateienREP IFinhaltveraendert(w1)THEN LEAVEp1WITH TRUE END IF END REP;FALSE.s1:IFja(a1, +"JA/Suchmuster")THENsuchen;allesneuEND IF.u1:IFmarkiertesaetze=0CANDx1THENdateinamenanfordern(y1);einzelausfuehrung(PROC(TEXT CONST)z1,b0);ELIFmarkiertesaetze>0CANDa2THENdateinamenanfordern(y1);einzelausfuehrung(PROC(TEXT CONST)z1,b0);markierungenloeschenELIFb2THENmarkierungenloeschen;markierungaendern;dateinamenanfordern(y1);einzelausfuehrung(PROC(TEXT CONST)z1,b0);markierungenloeschenEND IF.x1:ja(b1,"JA/alle Satze").a2:ja(c1,"JA/alle markierten").b2:ja(d1,"JA/Einzelsatz drucken").v1:NOTja(e1,"JA/noch einmal").END PROCi1;PROCo1:bildschirmneu;cursor(1,1);out(g0);cursor(15,1);23TIMESOUT(""10":"8"")END PROCo1;PROCz1(TEXT CONSTc2):d2;disablestop;drucke(c2);e2;o1END PROCz1;PROCl1(INT CONSTf2,g2):enablestop;SELECTf2OF CASE0:h2CASE1:i2(g2)CASE2:j2(g2)CASE3:k2(g2)CASE4:l2(g2)CASE5:dateiverwaltung(g2)CASE6:archivverwaltung(g2)END SELECT.h2:IFanzahldateien=0THENm2(FALSE);n2(FALSE)ELIF NOTaendernerlaubtTHENn2(FALSE)END IF;o2;waehlbar(6,6,p2);waehlbar(6,9,NOTp2);IFq2THENwaehlbar(1,8,FALSE); +waehlbar(6,7,FALSE)END IF.q2:FALSE.END PROCl1;PROCm2(BOOL CONSTr2):INT VARs2;waehlbar(1,4,r2);waehlbar(1,5,r2);waehlbar(1,7,r2);FORs2FROM1UPTO11REPwaehlbar(2,s2,r2)END REP;waehlbar(3,1,r2);waehlbar(3,4,r2);waehlbar(3,6,r2);waehlbar(4,1,r2)END PROCm2;PROCo2:BOOL VARr2:=anzahldateien=1ANDaendernerlaubt;waehlbar(1,6,r2);waehlbar(3,5,r2);r2:=anzahldateien>0ANDanzahldateien<10AND NOTaufkoppeldatei;waehlbar(1,2,r2);waehlbar(1,3,r2)END PROCo2;PROCn2(BOOL CONSTr2):INT VARs2;FORs2FROM7UPTO10REPwaehlbar(2,s2,r2)END REP;waehlbar(3,2,r2);waehlbar(3,3,r2)END PROCn2;PROCk1:fensterveraendert(p0);r0:=""6""23""0"";r0CATf1;IFanzahldateien>0THENr0CAT"""";r0CATeudasdateiname(1);r0CAT""""END IF;IFanzahldateien>1THENr0CAT" .. "END IF;r0CAT""5""6""23"";r0CATcode(79-length(date)-length(g1));r0CATg1;r0CATdateEND PROCk1;PROCt2(TEXT CONSTu2,v2):BOOL VARw2;fensterzugriff(p0,w2);IFw2THENout(r0);cursor(35,24);out(u2);IFv2<>d0THENout("""");outsubtext(v2,1,22-length(u2));out(""" ")END IF END IF END PROCt2;THESAURUS +VARx2:=emptythesaurus;BOOL VARy2,z2:=FALSE;TASK VARa3;TEXT VARb3:=d0,c3:=d0;LETd3=#1015 +#" Manager: ",e3=#1017 +#"Keine Sicherung noetig.",f3=#1018 +#"Interne Arbeitskopien loeschen",g3=#1019 +#"Arbeitskopie ",h3=#1020 +#" unveraendert.",i3=#1021 +#" veraendert! Sichern",j3=#1022 +#"Alte Version ueberschreiben",k3=#1023 +#"Sondern unter dem Namen:",l3=#1024 +#" ueberschreiben",m3=#1025 +#"Datei wieder sortieren",n3=#1026 +#"Notizen",o3=#1027 +#"Name Managertask:",p3=#1028 +#"Task existiert nicht !",q3=#1029 +#"Wollen Sie etwas veraendern (eine Arbeitskopie anlegen)",r3=#1030 +#"Alle Markierungen gelöscht.",s3=#1032 +#"Pruefbedingungen",t3=#1033 +#"Feldnamen oder Feldtypen aendern",u3=#1034 +#"Feldnamen anfuegen",v3=#1035 +#"Neuer Feldname:",w3=#1036 +#"Neuer Typ (TEXT,DIN,ZAHL,DATUM):",x3=#1037 +#"Neue Feldnamen",y3=#1038 +#"TEXT",z3=#1039 +#"DIN",a4=#1040 +#"ZAHL",b4=#1041 +#"DATUM",c4=#1042 +#"Alte Feldreihenfolge aendern",d4=#1043 +#""7"ACHTUNG: System voll, Dateien loeschen!";PROCi2(INT CONSTg2):SELECTg2OF CASE0:e4CASE1:f4CASE2:g4CASE3:h4CASE4:i4CASE5:j4CASE6:k4CASE7:l4CASE8:m4OTHERWISEn4END SELECT;t2(d3,b3);o4;p4.e4:IFanzahldateien=0THENl1(0,0)END IF.f4:m1;q1(TRUE).g4:disablestop;q4;ausfuehrung(PROC(TEXT CONST)r4,c0);s4;enablestop;o2.h4:disablestop;q4;ausfuehrung(PROC(TEXT CONST)t4,c0);s4;enablestop;o2.i4:IFaendernerlaubtTHENu4ELSEdialog;out(e3);v4END IF;w4.u4:INT VARw1;FORw1FROM1UPTOanzahldateienREPeinzelsicherung(w1)END REP;IFja(f3,"JA/Dateien loeschen")THENx4;dateienloeschen(TRUE)END IF.w4:IFanzahldateien=0THENm2(FALSE);n2(FALSE)END IF;o2;k1.v4:INT CONSTy4:=anzahldateien;dateienloeschen(FALSE);FORw1FROM1UPTOy4REP IFz4(w1)THENa5(eudasdateiname(w1))END IF END REP.j4:b5;dialogfensterloeschen.k4:zugriff(PROC(EUDAT VAR)feldstruktur).l4:c5;dialogfensterloeschen.m4:b3:="";fensterveraendert(p0);editget(o3,b3,"","GET/multi task");IFb3=""THENz2:=FALSE ELIFexists(/b3)THENa3:=task(b3);z2:=TRUE ELSEz2:=FALSE;b3:=""; +errorstop(p3)END IF.p4:IFheapsize-k0>4THENcollectheapgarbage;k0:=heapsizeEND IF.n4:IFg2=-1THENdialogfensterloeschen;fensterveraendert(p0);LEAVEi2END IF.END PROCi2;PROCm1:BOOL VARd5:=FALSE;IFaendernerlaubtTHENe5END IF;IFd5THENdialogEND IF.e5:INT VARw1;FORw1FROM1UPTOanzahldateienREP IFinhaltveraendert(w1)THENeinzelsicherung(w1);d5:=TRUE;f5END IF END REP.f5:IFw1=1CANDstd=eudasdateiname(1)THENlastparam(d0)END IF.END PROCm1;PROCeinzelsicherung(INT CONSTw1):g5;IFinhaltveraendert(w1)THEN IFja(h5,"JA/sichere")THENi5END IF ELSEdialog;out(h5)END IF.g5:TEXT VARh5:=g3;h5CATtextdarstellung(eudasdateiname(w1));IFinhaltveraendert(w1)THENh5CATi3ELSEh5CATh3END IF.i5:TEXT VARname:=eudasdateiname(w1);IFja(j3,"JA/alte version")THENforget(name,quiet)ELIFz4(w1)THENerrorstop(d0)ELSEj5END IF;sichere(w1,name);k5.j5:editget(k3,name,"","GET/Sicherungsname");IFexists(name)THENl5END IF.l5:IFja(textdarstellung(name)+l3,"JA/ueber")THENforget(name,quiet)ELSEeinzelsicherung(w1);LEAVEeinzelsicherungEND IF.k5:EUDAT VAR +m5;oeffne(m5,name);IFn5CANDo5THENp5;sortiere(m5)END IF.n5:sortierreihenfolge(m5)<>d0CANDunsortiertesaetze(m5)>0.o5:ja(m3,"JA/Sicherungssortierung").END PROCeinzelsicherung;PROCq1(BOOL CONSTq5):IFaendernerlaubtTHENx4END IF;dateienloeschen(TRUE);m2(FALSE);n2(FALSE);forget(j0);disablestop;q4;y2:=q5;einzelausfuehrung(PROC(TEXT CONST)r5,c0);s4;o2;enablestop;IFanzahldateien>0THENm2(TRUE);n2(aendernerlaubt)END IF END PROCq1;PROCq4:IFz2THENx2:=ALLa3END IF END PROCq4;PROCs4:x2:=emptythesaurus;k1END PROCs4;PROCx4:INT VARw1;FORw1FROM1UPTOanzahldateienREP IFz4(w1)THENs5END IF END REP.s5:IFt5THENdisablestop;u5;save(eudasdateiname(w1),a3);v5;enablestop;forget(eudasdateiname(w1),quiet)ELSEfree(eudasdateiname(w1),a3)END IF;w5(w1,FALSE).t5:exists(eudasdateiname(w1)).END PROCx4;PROCx5:IFz4(anzahldateien)ANDaendernerlaubtTHENforget(eudasdateiname(anzahldateien),quiet)END IF END PROCx5;PROCr5(TEXT CONSTc2):BOOL VARy5;z5;oeffne(c2,y5);x5.z5:IFa6ANDy2THENb6(c2);EUDAT VARm5;oeffne(m5,c2);feldstruktur(m5);y5 +:=TRUE ELSEy5:=y2CANDja(q3,"JA/oeffne");c6(c2,y5)END IF.a6:NOTexists(c2)AND NOT(x2CONTAINSc2).END PROCr5;PROCr4(TEXT CONSTc2):c6(c2,aendernerlaubt);kette(c2);x5END PROCr4;PROCt4(TEXT CONSTc2):c6(c2,aendernerlaubt);kopple(c2);x5END PROCt4;PROCc6(TEXT CONSTc2,BOOL CONSTd6):BOOL VARe6:=FALSE;IFz2THENf6END IF;w5(anzahldateien+1,e6).f6:IF(x2CONTAINSc2)CAND(NOTexists(c2)CORg6)THEN IFd6THENlock(c2,a3)END IF;forget(c2,quiet);fetch(c2,a3);e6:=TRUE END IF.g6:ja(textdarstellung(c2)+h6,"JA/fetch").END PROCc6;PROCw5(INT CONSTi6,BOOL CONSTe6):WHILElength(c3)e0END IF END PROCz4;PROCb5:notizenlesen(3,q0);DATASPACE VARk6:=nilspace;FILE VARf:=sequentialfile(output,k6);disablestop;headline(f,n3);l6(f,q0,m0,"EDIT/Notizen");forget(k6);enablestop;IFaendernerlaubtTHENnotizenaendern(3,q0)END IF END PROCb5;PROCl6(FILE VARf,TEXT VARm6,FENSTER CONSTn6,TEXT CONSTo6):LETp6= +"#-#";enablestop;q6;r6;s6.q6:INT VARt6:=1,u6;REPu6:=pos(m6,p6,t6);IFu6=0THENputline(f,subtext(m6,t6))ELSEputline(f,subtext(m6,t6,u6-1))END IF;t6:=u6+3UNTILu6=0ORt6>length(m6)END REP.r6:modify(f);edit(f,n6,o6,TRUE).s6:TEXT VARv6;m6:=d0;input(f);WHILE NOTeof(f)REPgetline(f,v6);w6;m6CATv6;m6CATp6END REP.w6:IF(v6SUBlength(v6))=e0THENv6:=subtext(v6,1,length(v6)-1)END IF.END PROCl6;PROCfeldstruktur(EUDAT VARm5):SATZ VARx6;feldnamenlesen(m5,x6);IFy6THENz6END IF;IFja(t3,"JA/Feldaendern")THENa7END IF.y6:IFfelderzahl(x6)>0THENja(u3,"JA/feldnamen")ELSE TRUE END IF.z6:DATASPACE VARk6:=nilspace;FILE VARf:=sequentialfile(output,k6);disablestop;b7(f,x6);forget(k6);enablestop;feldnamenaendern(m5,x6).a7:c7;auswahlanbieten("EUDAS-Felder",o0,"AUSWAHL/Felder",PROC(TEXT VAR,INT CONST)d7);INT VARe7:=1;WHILEwahl(e7)>0REPf7;e7INCR1END REP;feldnamenaendern(m5,x6).c7:satzinitialisieren(g7);FORe7FROM1UPTOfelderzahl(x6)REPfeldlesen(x6,e7,q0);feldaendern(g7,e7,h7+textdarstellung(q0))END REP.h7:"("+i7(feldinfo(m5, +e7))+") ".f7:TEXT VARj7;feldlesen(x6,wahl(e7),j7);editget(v3,j7,"","GET/feldname");feldaendern(x6,wahl(e7),j7);TEXT VARk7:=i7(feldinfo(m5,wahl(e7)));REPeditget(w3,k7,"","GET/feldtyp")UNTILl7(k7)>=-1END REP;feldinfo(m5,wahl(e7),l7(k7)).END PROCfeldstruktur;PROCc5:enablestop;DATASPACE VARk6:=nilspace;FILE VARf:=sequentialfile(output,k6);headline(f,s3);notizenlesen(1,q0);disablestop;l6(f,q0,m0,"EDIT/Pruefbed");forget(k6);enablestop;IFaendernerlaubtTHENnotizenaendern(1,q0)END IF.END PROCc5;PROCb7(FILE VARf,SATZ VARx6):enablestop;m7;n7.m7:modify(f);headline(f,x3);edit(f,o0,"EDIT/Feldnamen",TRUE).n7:INT VARe7:=felderzahl(x6);input(f);WHILE NOTeof(f)REPgetline(f,q0);w6;e7INCR1;feldaendern(x6,e7,q0)END REP.w6:IF(q0SUBlength(q0))=e0THENq0:=subtext(q0,1,length(q0)-1)END IF.END PROCb7;TEXT PROCi7(INT CONSTk7):SELECTk7+1OF CASE0:y3CASE1:z3CASE2:a4CASE3:b4OTHERWISEd0END SELECT END PROCi7;INT PROCl7(TEXT CONSTo7):IFo7=y3THEN-1ELIFo7=z3THEN0ELIFo7=a4THEN1ELIFo7=b4THEN2ELSE-2END IF END PROCl7;PROCo4: +INT VARp7,q7;storage(p7,q7);IFq7>p7THENneuerdialog;dialog;out(d4)END IF END PROCo4;BOOL VARr7,s7:=FALSE,t7:=FALSE;LETu7=#1044 +#"SATZ AENDERN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",v7=#1045 +#"SATZ EINFUEGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",w7=#1046 +#"SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",x7=#1047 +#"Umschalten auf Koppeldatei ",y7=#1048 +#"Koppelfelder uebernehmen",z7=#1049 +#"Ungueltige Satznummer",a8=#1050 +#"Neue Satznummer:",b8=#1051 +#" Bitte warten.. ",c8=#1052 +#"wzK",d8=#1053 +#"wz";LETe8=""6""23""0" :",f8=""6""23""0" :"5"";PROCj2(INT CONSTg2):SELECTg2OF CASE0:g8CASE1:h8CASE2:i8CASE3:j8CASE4:k8CASE5:l8CASE6:m8CASE7:n8CASE8:o8CASE9:p8CASE10:q8CASE11:r8CASE12:s8CASE13:t8CASE14:u8CASE15:v8CASE16:w8OTHERWISEx8END SELECT;o4.g8:exitzeichen(d8).h8:p5;weiter(2);bildausgeben(FALSE).i8:p5;zurueck(2);bildausgeben(FALSE).k8:suchen;bildausgeben(TRUE).l8:suchbedingungloeschen;bildausgeben(FALSE).j8:TEXT VARy8:=d0;z8;editget(a8,y8,"","GET/auf satz");INT CONSTa9:=int(y8);IFy8=d0THENbildausgeben(FALSE)ELIFlastconversionokTHENaufsatz(a9);bildausgeben(FALSE)ELSEerrorstop(z7)END IF.n8:einfuegen;bildausgeben(TRUE).o8:aendern;bildausgeben(TRUE).m8:markierungaendern;bildausgeben(FALSE).p8:b9;z8;dateinamenanfordern(c9);einzelausfuehrung(PROC(TEXT CONST)d9,c0);bildausgeben(TRUE).q8:b9;z8;dateinamenanfordern(e9);einzelausfuehrung(PROC(TEXT CONST)holesatz,c0);bildausgeben(TRUE).r8:TEXT VARf9;z8;g9(f9);IFf9<>d0THENfeldauswahl(f9)END IF;bildausgeben(TRUE).s8:h9 +;rollen(-23);IFanzahldateien>0THENbildausgeben(FALSE)END IF.t8:h9;rollen(23);IFanzahldateien>0THENbildausgeben(FALSE)END IF.u8:h9;rollen(-9999);IFanzahldateien>0THENbildausgeben(FALSE)END IF.v8:h9;rollen(9999);IFanzahldateien>0THENbildausgeben(FALSE)END IF.w8:IFaufkoppeldateiTHENi9ELSEj9END IF;IFanzahldateien>0THENbildausgeben(TRUE)END IF.i9:IF(t7ORs7)THENk9;l9ELSEaufkoppeldatei(0)END IF;o2.k9:z8;IF NOTdateiendeCANDja(y7,"JA/uebernehmen")THENaufkoppeldatei(1)ELSEaufkoppeldatei(0)END IF.l9:s7:=FALSE;IFt7THENt7:=FALSE;aendernELSEm9(TRUE)END IF.x8:IFg2=-2THEN IFanzahldateien>0THENn9;bildausgeben(FALSE)ELSEz8END IF ELSEdialogfensterloeschen;fensterveraendert(p0)END IF.n9:out(e8).z8:out(f8).END PROCj2;PROCsuchen:disablestop;exitzeichen("");statusanzeigen(w7);suchen(PROCo9);exitzeichen(d8)END PROCsuchen;PROCo9:hilfeanbieten("EDIT/Suchen",o0)END PROCo9;PROCp5:statusanzeigen(b8)END PROCp5;PROCeinfuegen:m9(FALSE)END PROCeinfuegen;PROCm9(BOOL CONSTp9):BOOL VARq9:=p9;r9;REPstatusanzeigen(v7);IFq9 +THENaendern(PROCs9);q9:=FALSE ELSEeinfuegen(PROCs9)END IF;t9;u9END REP.u9:SELECTpos(c8,exitdurch)OF CASE0:IFr7THENsatzloeschenENDIF;LEAVEm9CASE1:IFr7THENsatzloeschenELSEp5;weiter(2)END IF CASE2:IFr7THENsatzloeschenELSEp5;zurueck(2)END IF CASE3:j9;IFaufkoppeldateiTHENs7:=TRUE;LEAVEm9END IF;q9:=TRUE END SELECT.END PROCm9;PROCs9:hilfeanbieten("EDIT/Einfuegen",o0)END PROCs9;PROCr9:IFanzahlkoppeldateien>0AND NOTaufkoppeldateiTHENexitzeichen(c8)ELSEexitzeichen(d8)END IF END PROCr9;PROCaendern:r9;kommandoauftastelegen("F","prueffehler editieren");REPstatusanzeigen(u7);aendern(PROCv9);t9;w9END REP.w9:SELECTpos(c8,exitdurch)OF CASE0:IFr7THENsatzloeschenENDIF;LEAVEaendernCASE1:IFr7THENsatzloeschenELSEp5;weiter(2)END IF CASE2:IFr7THENsatzloeschenELSEp5;zurueck(2)END IF CASE3:j9;IFaufkoppeldateiTHENt7:=TRUE;LEAVEaendernEND IF END SELECT.END PROCaendern;PROCv9:hilfeanbieten("EDIT/Aendern",o0)END PROCv9;PROCprueffehlereditieren:IFl0=dateiversionTHENmodify(i0);edit(i0)END IF END +PROCprueffehlereditieren;PROCj9:INT VARw1:=folgedatei(0);WHILEw1>0REPout( f8);IFx9THENaufkoppeldatei(w1);o2;LEAVEj9END IF;w1:=folgedatei(w1)END REP.x9:ja(x7+textdarstellung(eudasdateiname(w1)),"JA/umschalten").END PROCj9;PROCy9(TEXT CONSTv6,INT CONSTz9):outsubtext(v6,a10);out(h0).a10:pos(v6,e0,6)+1+z9-z9.END PROCy9;PROCt9:feldbearbeiten(1,PROC(TEXT CONST,INT CONST,INT CONST)b10)END PROCt9;PROCb10(TEXT CONSTx6,INT CONSTt6,u6):r7:=t6<3ORt6>length(x6)+u6-u6END PROCb10;PROCh9:cursor(15,24)END PROCh9;PROCd9(TEXT CONSTc2):IFexists(c2)THENc10ELSEb6(c2)END IF;p5;tragesatz(c2).c10:IFd10(c2)<>0THENerrorstop(e10)END IF.END PROCd9;PROCg9(TEXT VARf9):auswahlanbieten("EUDAS-Anzeigefelder",o0,"AUSWAHL/Anzeigefelder",PROC(TEXT VAR,INT CONST)f10);f9:=d0;INT VARy8:=1;WHILEwahl(y8)>0REPf9CATcode(wahl(y8));y8INCR1END REP END PROCg9;LETr8=#1054 +#"Angezeigte Felder auswaehlen",g10=#1055 +#" aufsteigend sortieren";DATASPACE VARh10;PROCk2(INT CONSTg2):SELECTg2OF CASE1:i10CASE2:j10CASE3:k10CASE4:l10CASE5:m10CASE6:n10OTHERWISEn4END SELECT;o4.j10:b9;dateinamenanfordern(c9);einzelausfuehrung(PROC(TEXT CONST)o10,c0).i10:b9;dateinamenanfordern(c9);einzelausfuehrung(PROC(TEXT CONST)p10,c0);dialogfensterloeschen;t2("","").k10:dateinamenanfordern(q10);ausfuehrung(PROC(TEXT CONST)r10,b0);dialogfensterloeschen;t2("","").l10:TEXT VARs10;r1(s10);uebersicht(s10,PROCt1);dialogfensterloeschen;t2("","").m10:zugriff(PROC(EUDAT VAR)t10).n10:markierungenloeschen;dialog;out(r3).n4:IFg2=-1THENdialogfensterloeschen;fensterveraendert(p0)ELIFg2=-2THENt2("","")END IF.END PROCk2;PROCb9:IFd10(std)<>0THENlastparam(d0)END IF END PROCb9;PROCo10(TEXT CONSTc2):BOOL VARu10;IFexists(c2)THENc10;v10ELSEb6(c2);u10:=FALSE END IF;BOOL CONSTw10:=ja(x10,"JA/sortieren");p5;y10;trage(c2,i0,u10);z10;IFw10THEN EUDAT VARm5;oeffne(m5,c2);sortiere(m5)END IF.c10:IFd10(c2)<>0THENerrorstop(e10)END IF.v10:u10:=ja(a11, +"JA/testen").y10:IFu10THENforget(j0);j0:=nilspace;i0:=sequentialfile(output,j0);l0:=dateiversionELSEforget(j0);l0:=dateiversion-1END IF.z10:IFu10CANDlines(i0)>0THENdialog;put(lines(i0));put(b11)END IF.END PROCo10;PROCr10(TEXT CONSTc2):IF NOTexists(c2)THENc11(c2,"EDIT/Verarbeite")END IF;d2;FILE VARf:=sequentialfile(input,c2);disablestop;verarbeite(f);e2.END PROCr10;PROCr1(TEXT VARs10):s10:=d0;IFja(r8,"JA/Ub.Felder")THENg9(s10)END IF END PROCr1;PROCt1:hilfeanbieten("UEBERSICHT",m0)END PROCt1;PROCp10(TEXT CONSTc2):disablestop;h10:=nilspace;d11(c2);forget(h10)END PROCp10;PROCd11(TEXT CONSTc2):TEXT VARe11:="";FILE VARf;EUDAT VARm5;BOOL VARw10:=FALSE;enablestop;IFexists(c2)THENf11ELSEb6(c2)END IF;editget(g11,e11,"","GET/kopiermuster");IFexists(e11)THENf:=sequentialfile(input,e11)ELSEh11;stdkopiermuster(c2,f)END IF;modify(f);i11;j11.f11:IFd10(c2)<>0THENerrorstop(e10)END IF;oeffne(m5,c2);IFsortierreihenfolge(m5)<>d0THENw10:=ja(x10,"JA/sortieren")END IF.h11:IFe11=d0THENf:=sequentialfile(output, +h10)ELSEb6(e11);f:=sequentialfile(output,e11)END IF.i11:edit(f,m0,"EDIT/Kopiermuster",TRUE);d2;kopiere(c2,f).j11:IFw10THENoeffne(m5,c2);sortiere(m5)END IF.END PROCd11;INT PROCd10(TEXT CONSTc2):INT VARw1;FORw1FROM1UPTOanzahldateienREP IFeudasdateiname(w1)=c2THEN LEAVEd10WITHw1END IF END REP;0END PROCd10;PROCc11(TEXT CONSTc2,k11):IF NOTexists(c2)THENb6(c2)END IF;FILE VARf:=sequentialfile(modify,c2);edit(f,m0,k11,TRUE)END PROCc11;PROCd2:p5;cursor(1,2);out(g0);bildschirmneuEND PROCd2;PROCt10(EUDAT VARm5):TEXT VARl11:=sortierreihenfolge(m5);IFl11=d0CORm11THENn11;p5;sortiere(m5,l11)ELSEp5;sortiere(m5)END IF.m11:ja(c4,"JA/Sortierfelder").n11:feldnamenlesen(m5,g7);auswahlanbieten("EUDAS-Sortierfelder",o0,"AUSWAHL/Sortierfelder",PROC(TEXT VAR,INT CONST)d7);INT VARe7:=1;l11:=d0;WHILEwahl(e7)<>0REPl11CATcode(wahl(e7));o11;e7INCR1END REP.o11:feldlesen(g7,wahl(e7),q0);IFja(textdarstellung(q0)+g10,"JA/Sortierrichtung")THENl11CAT"+"ELSEl11CAT"-"END IF.END PROCt10;PROCf10(TEXT VARname,INT CONSTy8):IF +y8<=anzahlfelderTHENfeldnamenlesen(y8,name)ELSEname:=d0END IF END PROCf10;LETp11=#1056 +#"Ausgabe automatisch zum Drucker",q11=#1057 +#"Ausgabe in bestimmte Datei",r11=#1058 +#"Name Ausgabedatei:",x10=#1059 +#"Zieldatei anschliessend sortieren",a11=#1060 +#"Pruefbedingungen testen",b11=#1061 +#"Prueffehler festgestellt",e10=#1062 +#"Zieldatei darf nicht geoeffnet sein",g11=#1063 +#"Name Kopiermuster (RET=Std):";LETs11=#1093 +#" zeilenweise formatieren",t11=#1094 +#" seitenweise formatieren";BOOL VARu11:=FALSE,v11:=FALSE;PROCl2(INT CONSTg2):SELECTg2OF CASE1:w11CASE2:x11CASE3:y11CASE4:z11CASE5:a12OTHERWISEn4END SELECT;o4.w11:dateinamenanfordern(y1);ausfuehrung(PROC(TEXT CONST)b12,b0);dialogfensterloeschen;t2("","").x11:direktdrucken(ja(p11,"JA/direkt drucken"));IF NOTdirektdruckenCANDja(q11,"JA/Druckdatei")THEN TEXT VARc2:=d0;editget(r11,c2,"","GET/Druckdatei");IFc2<>d0THENdruckdatei(c2)END IF END IF.y11:ausfuehrung(PROC(TEXT CONST)c12,b0);dialogfensterloeschen;t2("","").z11:ausfuehrung(PROC(TEXT CONST)print,b0).a12:ausfuehrung(PROC(TEXT CONST)d12,b0);dialogfensterloeschen;t2("","").n4:IFg2=-1THENdialogfensterloeschen;fensterveraendert(p0)ELIFg2=-2THENt2("","")END IF.END PROCl2;PROCe2:IFe12THENclearerrorEND IF.e12:iserrorCANDerrormessage=d0.END PROCe2;PROCb12(TEXT CONSTc2):IF NOTexists(c2)THENc12(c2)END IF;d2;disablestop;drucke(c2);e2END PROCb12;PROCc12(TEXT CONSTc2):c11(c2,"EDIT/Druckmuster")END PROCc12;PROCprint(TEXT CONSTc2):do("print ("+ +textdarstellung(c2)+")")END PROCprint;PROCd12(TEXT CONSTc2):IFja(textdarstellung(c2)+s11,"JA/zeilenform")THENf12END IF;IFja(textdarstellung(c2)+t11,"JA/seitenform")THENseitenformatierenEND IF.f12:IFu11THENautoform(c2)ELSElineform(c2)END IF;page;bildschirmneu.seitenformatieren:IFv11THENautopageform(c2)ELSEpageform(c2)END IF;bildschirmneu.END PROCd12;PROCg12(BOOL CONSTh12,i12):u11:=h12;v11:=i12END PROCg12;TEXT VARj12;LETk12=#1064 +#" Task: ",l12=#1065 +#"Neuer Name:",m12=#1066 +#"Zieldatei:",n12=#1067 +#" belegt ",o12=#1068 +#"KB.",p12=#1069 +#" existiert nicht.",q12=#1070 +#" in dieser Task loeschen",r12=#1071 +#" neu einrichten";PROCdateiverwaltung(INT CONSTg2):enablestop;SELECTg2OF CASE0:s12CASE1:t12CASE2:u12CASE3:v12CASE4:w12CASE5:x12CASE6:y12OTHERWISEn4END SELECT;o4.s12:j12:=name(myself).y12:ausfuehrung(PROC(TEXT CONST)z12,0).v12:ausfuehrung(PROC(TEXT CONST)a13,0).u12:ausfuehrung(PROC(TEXT CONST)a5,0).t12:disablestop;DATASPACE VARb13:=nilspace;FILE VARf:=sequentialfile(output,b13);list(f);IF NOTiserrorTHENedit(f,o0,"SHOW/Uebersicht",FALSE)END IF;forget(b13);enablestop;c13.w12:ausfuehrung(PROC(TEXT CONST)d13,0).x12:ausfuehrung(PROC(TEXT CONST)e13,0).n4:IFg2=-1THENdialogfensterloeschen;fensterveraendert(p0)ELIFg2=-2THENt2(k12,j12)END IF.END PROCdateiverwaltung;PROCc13:WHILEgetcharety<>d0REP END REP END PROCc13;PROCz12(TEXT CONSTc2):IFtype(old(c2))=c0THENreorganisiere(c2)ELSEreorganize(c2)END IF END PROCz12;PROCa13(TEXT CONSTc2):TEXT VARf13:=c2;IFexists(c2)THENeditget(l12,f13,"","GET/rename")END IF;rename(c2,f13)END PROCa13;PROCa5(TEXT CONSTc2):IFg13THENerrorstop(e10)ELIFexists(c2)CANDh13 +THENforget(c2,quiet)END IF.g13:d10(c2)<>0.h13:ja(textdarstellung(c2)+q12,"JA/forget").END PROCa5;PROCd13(TEXT CONSTc2):TEXT VARi13:=d0;editget(m12,i13,"","GET/copy");copy(c2,i13)END PROCd13;PROCe13(TEXT CONSTc2):dialog;out(textdarstellung(c2));IFexists(c2)THENout(n12);put(dspages(old(c2))DIV2);out(o12)ELSEout(p12)END IF END PROCe13;TEXT VARj13:=d0,k13:="ARCHIVE";INT VARl13:=0;THESAURUS VARm13;BOOL VARn13,p2:=TRUE,o13;LETp13=#1072 +#" Ziel: ",q13=#1073 +#"Archiv heisst ",r13=#1074 +#"Name des Archivs:",s13=#1075 +#"Name Zielarchiv:",t13=#1076 +#"Nr. der Zielstation (od. RETURN):",u13=#1077 +#"Ist das Zielarchiv ein Archivmanager",v13=#1078 +#"Archivdiskette vorher formatieren",w13=#1079 +#"Neuer Archivname:",h6=#1080 +#" im System ueberschreiben",x13=#1081 +#" auf Archiv loeschen",y13=#1082 +#"Archiv ",z13=#1083 +#" ueberschreiben",a14=#1084 +#"Archiv initialisieren",b14=#1085 +#" auf Archiv ueberschreiben";LETc14=#1095 +#"Passwort: ",d14=#1096 +#"Passwort stimmt nicht mit der ersten Eingabe überein",e14=#1097 +#"Passwort zur Kontrolle bitte nochmal eingeben.",f14=#1098 +#"Passwort loeschen",g14=#1099 +#"Unzlaessige Stationsnummer",h14=#1100 +#"Angegebene Task ist kein Manager";PROCarchivverwaltung(INT CONSTg2):enablestop;SELECTg2OF CASE0:i14CASE1:j14CASE2:k14CASE3:l14CASE4:m14CASE5:n14CASE6:o14CASE7:p14CASE8:q14CASE9:r14OTHERWISEs14END SELECT;o4.i14:n13:=FALSE.m14:IFp2THENt14END IF;p5;m13:=ALLu14;ausfuehrung(PROC(TEXT CONST)v14,0).l14:disablestop;w14;p5;m13:=ALLu14;IFx14THENm13:=ALLu14END IF;enablestop;y14(PROC(TEXT CONST)z14).n14:IFp2THENt14END IF;p5;m13:=ALLu14;y14(PROC(TEXT CONST)n14).j14:w14;disablestop;p5;DATASPACE VARb13:=nilspace;f:=sequentialfile(output,b13);list(f,u14);IFx14THENlist(f,u14)END IF;IF NOTiserrorTHENmodify(f);toline(f,1);writerecord(f,headline(f));headline(f,d0);edit(f,o0,"SHOW/Uebersicht",FALSE)END IF;forget(b13);c13;enablestop.k14:w14;a15;FILE VARf:=sequentialfile(output,b15);disablestop;p5;list(f,u14);IFx14THENlist(f,u14)END IF;enablestop;modify(f);insertrecord(f);writerecord(f,headline(f));print(b15);forget(b15,quiet).a15:INT VARs2:=0;TEXT VARb15;REPs2INCR1;b15:="Archivliste "+text(s2)UNTIL NOT +exists(b15)END REP.o14:w14;IFja(v13,"JA/format")THENc15ELIFd15THEN IFe15THEN LEAVEo14END IF ELSE IFf15THEN LEAVEo14END IF END IF;j5;g15.c15:p5;disablestop;u5;format(u14);v5;enablestop.d15:reserve("",u14);p5;disablestop;m13:=ALLu14;BOOL CONSTh15:=x14;clearerror;enablestop;h15.e15:NOTja(y13+textdarstellung(j13)+z13,"JA/archiv loeschen").f15:NOTja(a14,"JA/archiv init").j5:editget(w13,j13,"","GET/Archivname");reserve(j13,u14).g15:p5;disablestop;u5;clear(u14);v5.p14:TEXT VARi15:=k13;IFn13THENrelease(u14);n13:=FALSE END IF;editget(s13,i15,"","GET/Zielarchiv");IFi15=d0THEN LEAVEp14END IF;j15;p2:=ja(u13,"JA/Zielmanager");k15;waehlbar(6,6,p2);waehlbar(6,9,NOTp2);bildschirmneu;t2(p13,l15+k13).j15:TEXT VARm15:=text(station(myself));IFstation(myself)<>0THENeditget(t13,m15,"","GET/Zielstation")END IF.k15:l13:=int(m15);IF NOTlastconversionokTHENerrorstop(g14)END IF;k13:=i15;n15(u14).l15:IFl13=0THENd0ELSEtext(l13)+"/"END IF.r14:TEXT VARo15:=d0;editget(r13,o15,"","GET/Archivname");reserve(o15,u14);n13 +:=TRUE.s14:IFg2=-1THEN IFn13THENrelease(u14)END IF;dialogfensterloeschen;fensterveraendert(p0)ELIFg2=-2THENt2(p13,l15+k13)END IF.END PROCarchivverwaltung;TASK PROCu14:IFl13=0THENtask(k13)ELSEl13/k13END IF END PROCu14;PROCn15(TASK CONSTo7):INT VARs2;IFstation(o7)=station(myself)THEN FORs2FROM1UPTO5REP IFstatus(o7)=2ORstatus(o7)=6THEN LEAVEn15END IF;pause(10)END REP;errorstop(h14)END IF END PROCn15;PROCt14:TEXT VARw13:=j13;editget(r13,w13,"","GET/Archivname");IF NOTn13ORw13<>j13THENreserve(w13,u14);n13:=TRUE END IF;j13:=w13END PROCt14;PROCw14:IF NOTn13ANDp2THENreserve(j13,u14);n13:=TRUE END IF END PROCw14;BOOL PROCx14:IFp2ANDiserrorTHEN TEXT CONSTp15:=errormessage;IFsubtext(p15,1,14)=q13CANDsubtext(p15,16,20)<>"?????"THENclearerror;q15;LEAVEx14WITH TRUE END IF END IF;FALSE.q15:j13:=subtext(p15,16,length(p15)-1);reserve(j13,u14).END PROCx14;PROCv14(TEXT CONSTc2):disablestop;IF NOT(m13CONTAINSc2)CORr15THENs15;p5;u5;save(c2,u14);v5END IF.r15:ja(textdarstellung(c2)+b14,"JA/save").s15:INT +CONSTy8:=d10(c2);IFy8>0CANDaendernerlaubtCANDinhaltveraendert(y8)THENeinzelsicherung(y8)END IF.END PROCv14;PROCz14(TEXT CONSTc2):disablestop;IF NOTexists(c2)CORg6THENp5;u5;fetch(c2,u14);v5END IF.g6:ja(textdarstellung(c2)+h6,"JA/fetch").END PROCz14;PROCn14(TEXT CONSTc2):disablestop;IF NOT(m13CONTAINSc2)CORn14THENp5;u5;erase(c2,u14);v5END IF.n14:ja(textdarstellung(c2)+x13,"JA/erase").END PROCn14;PROCu5:o13:=commanddialogue;commanddialogue(FALSE)END PROCu5;PROCv5:commanddialogue(o13)END PROCv5;PROCy14(PROC(TEXT CONST)t15):TEXT VARc2:=d0;editget(u15,c2,"z","GET/Dateiname");IFc2=f0THENv15ELSElastparam(c2);t15(c2)END IF.v15:w15(m13,0);auswahlanbieten("EUDAS-Archivauswahl",o0,"AUSWAHL/Archiv",PROC(TEXT VAR,INT CONST)x15);y15(PROC(TEXT CONST)t15).END PROCy14;PROCq14:BOUND ROW2TEXT VARz15;DATASPACE VARk6:=nilspace;z15:=k6;disablestop;a16(z15(1));IFz15(1)=d0THENb16ELSEc16END IF;forget(k6).b16:IFja(f14,"JA/pw loeschen")THENdialog;dialog;enterpassword(d0)END IF.c16:dialog;out(e14);a16(z15(2));IF +z15(1)<>z15(2)THENerrorstop(d14)ELSEdialog;dialog;enterpassword(z15(1))END IF.END PROCq14;PROCa16(TEXT VARd16):enablestop;dialog;out(c14);getsecretline(d16)END PROCa16;SATZ VARg7;LETu15=#1086 +#"Name der Datei:",c9=#1087 +#"Name der Zieldatei:",q10=#1088 +#"Name der Verarbeitungsvorschrift:",y1=#1089 +#"Name des Druckmusters:",e9=#1090 +#"Name der Quelldatei:";LETe16=#1101 +#"Keine Datei zur Auswahl vorhanden.";TEXT VARf16:=u15,g16;PROCw15(THESAURUS CONSTo7,INT CONSTk7):i16;h16;j16;k16.h16:g16:=d0;INT VARs2;FORs2FROM1UPTOanzahldateienREP INT CONSTl16:=feldindex(g7,eudasdateiname(s2));IFl16>0THENg16CATcode(l16)END IF END REP.i16:INT VARm16:=1,t6:=0;satzinitialisieren(g7);REPget(o7,q0,t6);IFq0=d0THEN LEAVEi16ELIFk7=0CORtype(old(q0))=k7THENfeldaendern(g7,m16,q0);m16INCR1END IF END REP.j16:t6:=0;REPget(x2,q0,t6);IFq0=d0THEN LEAVEj16ELIF NOT(o7CONTAINSq0)THENfeldaendern(g7,m16,q0);m16INCR1END IF END REP.k16:IFm16=1THENdialog;out(e16);errorstop(d0)END IF.END PROCw15;PROCx15(TEXT VARv2,INT CONSTm16):IFm16<256THENfeldlesen(g7,m16,v2);IFpos(g16,code(m16))>0THENv2:=" "+textdarstellung(v2)ELIFv2<>d0THENv2:=textdarstellung(v2)END IF ELSEv2:=d0END IF END PROCx15;PROCy15(PROC(TEXT CONST)t15):INT VARm16:=1;REP IFwahl(m16)=0THEN LEAVEy15ELSEfeldlesen(g7,wahl(m16),q0);dialog;out(text(m16,3));out(". ");out(textdarstellung(q0));lastparam(q0);t15(q0)END IF;m16INCR1END REP END +PROCy15;PROCausfuehrung(PROC(TEXT CONST)t15,INT CONSTk7):enablestop;TEXT VARc2;dateinamenanfordern(c2,k7);IFc2=f0THENy15(PROC(TEXT CONST)t15)ELSElastparam(c2);t15(c2)END IF END PROCausfuehrung;PROCeinzelausfuehrung(PROC(TEXT CONST)t15,INT CONSTk7):enablestop;TEXT VARc2;dateinamenanfordern(c2,k7);IFc2=f0THEN IFwahl(1)=0THENerrorstop(d0)ELSEfeldlesen(g7,wahl(1),c2)END IF END IF;lastparam(c2);t15(c2)END PROCeinzelausfuehrung;PROCdateinamenanfordern(TEXT CONSTu2):f16:=u2END PROCdateinamenanfordern;PROCdateinamenanfordern(TEXT VARc2,INT CONSTk7):IFexists(std)AND(k7=0CORtype(old(std))=k7)THENc2:=stdELSEc2:=d0END IF;disablestop;editget(f16,c2,"z","GET/Dateiname");f16:=u15;enablestop;IFc2=d0THENerrorstop(d0)ELIFc2=f0THENw15(all,k7);auswahlanbieten("EUDAS-Dateiauswahl",o0,"AUSWAHL/Datei",PROC(TEXT VAR,INT CONST)x15);p5END IF END PROCdateinamenanfordern;PROCd7(TEXT VARv2,INT CONSTm16):IFm16<=256THENfeldlesen(g7,m16,v2)ELSEv2:=d0END IF END PROCd7;PROCb6(TEXT CONSTc2):IF NOTja(textdarstellung(c2)+ +r12,"JA/einrichten")THENerrorstop(d0)END IF END PROCb6;LETn16=#1091 +#"EDITIEREN: Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ?",o16=#1092 +#"ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ?";INT VARp16;BOOL VARq16,r16;PROCedit(FILE VARf,FENSTER CONSTfenster,TEXT CONSTk11,BOOL CONSTaendern):INT VARs16,t16,u16,v16;fenstergroesse(fenster,s16,t16,u16,v16);fensterveraendert(fenster);enablestop;w16;q16:=aendern;REPx16;openeditor(groesstereditor+1,f,aendern,s16,t16,u16,v16);edit(groesstereditor,"eqvw19dpgn"9"?hF",PROC(TEXT CONST)y16);z16END REP.w16:IFaendernANDt16<3ANDv16>22ANDs16<14ANDu16>75THENr16:=TRUE ELSEr16:=FALSE END IF.z16:SELECTp16OF CASE0:LEAVEeditCASE1:hilfeanbieten(k11,fenster)CASE2:errorstop(d0)END SELECT.END PROCedit;PROCx16:IFq16THENstatusanzeigen(n16)ELSEstatusanzeigen(o16)END IF END PROCx16;PROCy16(TEXT CONSTa17):p16:=pos("?h",a17);IFp16>0THENquitELIFr16CANDa17="F"THENb17;x16ELSEstdkommandointerpreter(a17);x16;bildschirmneuEND IF END PROCy16;PROCb17:IFanzahlfelder>0THENc17;d17;e17END IF.c17:INT VARe7;satzinitialisieren(g7,anzahlfelder);FORe7FROM1UPTOanzahlfelderREPfeldnamenlesen(e7,q0); +feldaendern(g7,e7,q0)END REP.d17:auswahlanbieten("EUDAS-Editfelder",o0,"AUSWAHL/Feldnamen",PROC(TEXT VAR,INT CONST)d7).e17:INT VARm16:=1;WHILEwahl(m16)>0REP IFm16>1THENpush(e0)END IF;feldnamenlesen(wahl(m16),q0);push("""");push(q0);push("""");m16INCR1END REP.END PROCb17;END PACKETeudassteuerung; + diff --git a/app/eudas/4.3/src/eudas.generator b/app/eudas/4.3/src/eudas.generator new file mode 100644 index 0000000..96269e9 --- /dev/null +++ b/app/eudas/4.3/src/eudas.generator @@ -0,0 +1,86 @@ +INT VAR size, used; +BOOL VAR einzeln,sparen; +IF (pcb (9) AND 255) = 1 THEN + errorstop ("Nicht für Single-User-Systeme geeignet") +END IF; +storage (size, used); +einzeln := size - used < 500; +soehne loeschen; +forget ("eudas.generator", quiet); +page; +putline ("EUDAS - automatische Generierung"); +putline ("Version 4.3 vom 31.07.87"); +line; +sparen := no ("Ausfuehrliche Hilfstexte installieren"); +line; +disable stop; +do ("TEXT VARt:=additionalcommands"); +IF is error THEN + clear error; + enable stop; + gen ("dummy.text") +END IF; +enable stop; +IF id (0) < 175 THEN + gen ("pos.173") +END IF; +IF NOT einzeln THEN + holen ("eudas.1"); + holen ("eudas.2"); + holen ("eudas.3"); + holen ("eudas.4"); + holen ("eudas.init"); + release (archive) +END IF; +check off; +gen ("eudas.1"); +gen ("eudas.2"); +gen ("eudas.3"); +gen ("eudas.4"); +IF anything noted THEN + push (""27"q"); note edit; pause (100) +END IF; +holen ("eudas.init"); +IF einzeln THEN + release (archive) +END IF; +IF sparen THEN do ("menue loeschen (TRUE)") END IF; +do("menuedaten einlesen (""eudas.init"")"); +forget ("eudas.init", quiet); +check on; +do ("global manager"); + +PROC vom archiv (TEXT CONST datei): + out (""""); out (datei); putline (""" wird geholt."); + fetch (datei, archive) +END PROC vom archiv; + +PROC holen (TEXT CONST datei) : + IF NOT exists (datei) THEN vom archiv (datei) END IF +END PROC holen; + +PROC gen (TEXT CONST datei) : + holen (datei); + out (""""); out (datei); out (""" wird uebersetzt: "); + insert (datei); + forget (datei, quiet) +END PROC gen; + +PROC soehne loeschen : + + command dialogue (TRUE); + access catalogue; + TASK VAR sohn := son (myself); + WHILE NOT is niltask (sohn) REP + TASK CONST naechster := brother (sohn); + IF yes ("Sohntask """ + name (sohn) + """ loeschen") THEN + end (sohn) + ELIF yes ("Generierung abbrechen") THEN + errorstop ("") + END IF; + sohn := naechster + END REP + +END PROC soehne loeschen; + + diff --git a/app/eudas/4.3/src/eudas.init b/app/eudas/4.3/src/eudas.init new file mode 100644 index 0000000..54fa28d --- /dev/null +++ b/app/eudas/4.3/src/eudas.init @@ -0,0 +1,1463 @@ +% MENUE "EUDAS.Öffnen" +% BILD +-------------- +EUDAS-Datei +O Öffnen +E Ketten +K Koppeln +-------------- +Arbeitskopie +S Sichern +-------------- +Aktuelle Datei +N Notizen +F Feldstrukt. +P Prüfbeding. +-------------- +Mehrbenutzer +M Manager +-------------- +% FELD 1 "EUDAS/1O" "oO" +% FELD 2 "EUDAS/1E" "eE" +% FELD 3 "EUDAS/1K" "kK" +% FELD 4 "EUDAS/1S" "sS" +% FELD 5 "EUDAS/1N" "nN" +% FELD 6 "EUDAS/1F" "fF" +% FELD 7 "EUDAS/1P" "pP" +% FELD 8 "EUDAS/1M" "mM" +% ENDE +% MENUE "EUDAS.Einzelsatz" +% BILD +-------------- +Positionieren +W Weiter +Z Zurück +N Satz.Nr +-------------- +Suchbedingung +S Setzen +L Löschen +M Markierung +-------------- +Datensatz +E Einfügen +A Ändern +T Tragen +H Holen +-------------- +F Feldauswahl +-------------- +% FELD 1 "EUDAS/2W" "wW" +% FELD 2 "EUDAS/2Z" "zZ" +% FELD 3 "EUDAS/2N" "nN" +% FELD 4 "EUDAS/2S" "sS" +% FELD 5 "EUDAS/2L" "lL" +% FELD 6 "EUDAS/2M" "mM" +% FELD 7 "EUDAS/2E" "eE" +% FELD 8 "EUDAS/2A" "aA" +% FELD 9 "EUDAS/2T" "tT" +% FELD 10 "EUDAS/2H" "hH" +% FELD 11 "EUDAS/2F" "fF" +% FELD 12 "" ""3"" +% FELD 13 "" ""10"" +% FELD 14 "" "1" +% FELD 15 "" "9" +% FELD 16 "" "K" +% ENDE +% MENUE "EUDAS.Gesamtdatei" +% BILD +-------------- +Satzauswahl +K Kopieren +T Tragen +V Verändern +U Übersicht +-------------- +Aktuelle Datei +S Sortieren +-------------- +Alle Markier. +L Löschen +-------------- +% FELD 1 "EUDAS/3K" "kK" +% FELD 2 "EUDAS/3T" "tT" +% FELD 3 "EUDAS/3V" "vV" +% FELD 4 "EUDAS/3U" "uU" +% FELD 5 "EUDAS/3S" "sS" +% FELD 6 "EUDAS/3L" "lL" +% ENDE +% MENUE "EUDAS.Drucken" +% BILD +-------------- +Satzauswahl +D Drucken +-------------- +Druckausgabe +R Richtung +-------------- +Textdatei +E Editieren +A Ausdrucken +N Nachbearb. +-------------- +% FELD 1 "EUDAS/4D" "dD" +% FELD 2 "EUDAS/4R" "rR" +% FELD 3 "EUDAS/4E" "eE" +% FELD 4 "EUDAS/4A" "aA" +% FELD 5 "EUDAS/4N" "nN" +% ENDE +% MENUE "EUDAS.Dateien" +% BILD +-------------- +Dateien System +U Übersicht +-------------- +Datei +L Löschen +N Umbenennen +K Kopieren +P Platzbedarf +A Aufräumen +-------------- +% FELD 1 "EUDAS/5U" "Uu" +% FELD 2 "EUDAS/5L" "Ll" +% FELD 3 "EUDAS/5N" "Nn" +% FELD 4 "EUDAS/5K" "Kk" +% FELD 5 "EUDAS/5P" "Pp" +% FELD 6 "EUDAS/5R" "Aa" +% ENDE +% MENUE "EUDAS.Archiv" +% BILD +-------------- +Dateien Archiv +U Übersicht +D Üb. Drucken +-------------- +Datei +K Kopieren + vom Archiv +S Schreiben + auf Archiv +L Löschen + auf Archiv +-------------- +Archivdiskette +I Init +-------------- +Z Zielarchiv +P Passwort +R Reservieren +-------------- +% FELD 1 "EUDAS/6U" "Uu" +% FELD 2 "EUDAS/6D" "Dd" +% FELD 3 "EUDAS/6K" "Kk" +% FELD 4 "EUDAS/6S" "Ss" +% FELD 5 "EUDAS/6L" "Ll" +% FELD 6 "EUDAS/6I" "Ii" +% FELD 7 "EUDAS/6Z" "Zz" +% FELD 8 "EUDAS/6P" "Pp" +% FELD 9 "EUDAS/6R" "Rr" +% ENDE +% AUSWAHL "EUDAS-Felder" +% VORSPANN +-------------------------------------------------------------- + Bitte die Felder, die geaendert werden sollen, ankreuzen: +% BILD +-------------------------------------------------------------- +   +-------------------------------------------------------------- +% ENDE +% AUSWAHL "EUDAS-Sortierfelder" +% VORSPANN +-------------------------------------------------------------- + Bitte die Felder, nach denen sortiert werden soll, in Reihen- + folge ankreuzen: +% BILD +-------------------------------------------------------------- +   +-------------------------------------------------------------- +% ENDE +% AUSWAHL "EUDAS-Anzeigefelder" +% VORSPANN +-------------------------------------------------------------- + Bitte die Felder, die angezeigt werden sollen, in Reihenfolge + ankreuzen: +% BILD +-------------------------------------------------------------- +   +-------------------------------------------------------------- +% ENDE +% AUSWAHL "EUDAS-Editfelder" +% VORSPANN +-------------------------------------------------------------- + Bitte die Felder ankreuzen, die in die Datei übernommen + werden sollen: +% BILD +-------------------------------------------------------------- +   +-------------------------------------------------------------- +% ENDE +% AUSWAHL "EUDAS-Archivauswahl" +% VORSPANN +-------------------------------------------------------------- + Auswahl der Dateien auf dem Archiv. + Gewuenschte Datei(en) bitte ankreuzen: +% BILD +-------------------------------------------------------------- +   +-------------------------------------------------------------- +% ENDE +% AUSWAHL "EUDAS-Dateiauswahl" +% VORSPANN +-------------------------------------------------------------- + Auswahl der vorhandenen Dateien. + Gewuenschte Datei(en) bitte ankreuzen: +% BILD +-------------------------------------------------------------- +   +-------------------------------------------------------------- +% ENDE +% HILFE "EUDAS/Allgemein" +% SEITE 1 +--- MENÜBEDIENUNG --- +Das Menü dient zur Auswahl von Funktionen. Die Funktionen sind +durch einen vorangestellten Buchstaben gekennzeichnet. Mit den +Pfeiltasten können Sie die Markierung zu einer beliebigen +Position auf und ab bewegen. Diese Funktion können Sie dann +durch Drücken der Leertaste ausführen. Durch ESC '?' (nachein- +ander gedrückt) erhalten Sie Informationen zur gerade +markierten Funktion. +Funktionen, die im momentanen Zustand nicht ausgeführt werden +können, sind durch ein Minuszeichen gekennzeichnet. +In der obersten Bildschirmzeile sind weitere Menüs aufgeführt, +die Sie aufrufen können. Das aktuelle Menü ist invers +markiert. Ein anderes Menü wählen Sie durch Drücken der +Pfeiltasten RECHTS oder LINKS. +Wollen Sie das Programm wieder verlassen, drücken Sie die +ESC-Taste und 'q' hintereinander. +--- +% ENDE +% HILFE "EUDAS/1O" +% SEITE 1 +--- Öffnen zum Bearbeiten --- +Diese Funktion öffnet eine EUDAS-Datei zur anschließenden Bear­ +beitung. Sie können angeben, ob Sie die Datei nur ansehen oder +auch ändern wollen. Die vorher geöffnete Datei wird ggf. ge­ +sichert. Wenn Sie eine neue Datei angeben, wird diese einge­ +richtet. Dabei müssen Sie die Feldnamen eingeben. + +=> Hinweise zur Menübedienung auf der zweiten Seite (ESC 'w') +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1E" +% SEITE 1 +--- EUDAS-Datei ketten +Mit dieser Funktion können Sie eine EUDAS-Datei logisch an die +bereits geöffnete Datei anketten. Dazu müssen jedoch die beiden +Dateien in ihrer Feldstruktur übereinstimmen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1N" +% SEITE 1 +--- Notizen ansehen/ändern --- +Mit dieser Funktion können Sie der aktuell geöffneten Datei +Notizen zuordnen bzw. sich die vorherigen Notizen ansehen. Dazu +wird der normale Editor verwendet. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1M" +% SEITE 1 +--- Manager (Mehrbenutzerbetrieb) --- +Mit dieser Funktion können Sie die Task festlegen, aus der beim +Öffnen automatisch EUDAS-Dateien geholt werden können. Dadurch +können mehrere Benutzer auf die gleiche Datei zugreifen, jedoch +immer nur einer ändern. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1F" +% SEITE 1 +--- Feldstruktur ändern --- +Mit dieser Funktion können Sie + +1. neue Feldnamen anfügen + Sie können neue Feldnamen der Datei am Ende anfügen. Sie + müssen die Namen untereinander im Editor in der gewünschten + Reihenfolge angeben. Vorher werden Sie jedoch gefragt, ob + Sie diese Funktion überhaupt ausführen wollen. + +2. Feldnamen und Feldtypen ändern + In diesem Teil wird Ihnen eine Auswahl aller vorhandenen + Felder angeboten, in der jeweils auch der Typ angegeben ist. + Wenn Sie diese Funktion nicht ausführen wollen, beenden Sie + die Auswahl einfach mit ESC q. Sonst wählen Sie die Felder + aus, deren Namen oder Typ Sie ändern wollen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1P" +% SEITE 1 +--- Prüfbedingungen --- +Bei dieser Funktion können Sie im Editor ein Prüfpro­ +gramm eingeben, das mit der Datei gespeichert wird und beim +Reintragen neuer Sätze ausgeführt wird. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1K" +% SEITE 1 +--- EUDAS-Datei koppeln --- +Mit dieser Funktion können Sie eine Datei angeben, die zu den +bisher geöffneten Dateien dazugekoppelt wird. Anschließend +werden zu jedem Satz der existierenden Datei die in den Koppel­ +feldern übereinstimmenden Sätze der Koppeldatei gezeigt. +Als Koppelfelder werden dabei die ersten Felder der Koppeldatei +betrachtet, die auch in der geöffneten Datei vorhanden sind. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3S" +% SEITE 1 +--- Aktuelle Datei sortieren --- +Mit dieser Funktion kann die aktuell geöffnete EUDAS-Datei +sortiert werden. Die Reihenfolge, in der die Felder berücksich­ +tigt werden, kann vorher angegeben werden. Eventuell müssen +zum richtigen Sortieren Feldtypen vergeben werden (s. +"Feldstrukt."). +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1S" +% SEITE 1 +--- Aktuelle Dateien sichern --- +EUDAS arbeitet bei Änderungen immer auf Sicherheitskopien der +Dateien. Wenn Ändern erlaubt ist, müssen geänderte Arbeits­ +kopien mit dieser Funktion gesichert werden. Für eine veränder­ +te Datei kann dabei auch ein neuer Name angegeben werden, damit +die alte Version erhalten bleibt. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2W" +% SEITE 1 +--- Satz weiter --- +Diese Funktion geht zum nächsten Satz und zeigt ihn an. Wenn +eine Suchbedingung eingestellt ist, werden nicht ausgewählte +Sätze übersprungen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2Z" +% SEITE 1 +--- Satz zurück --- +Diese Funktion geht zum vorigen Satz. Wenn eine Suchbedingung +eingestellt ist, werden nicht ausgewählte Sätze übersprungen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2S" +% SEITE 1 +--- Suchbedingung setzen --- +Mit dieser Funktion kann eine Suchbedingung als Suchmuster +eingegeben werden, die angibt, welche Sätze bearbeitet werden +sollen. Die vorher eingestellte Suchbedingung wird automatisch +gelöscht. Die Bedingungen für die einzelnen Felder können im +Editor eingegeben werden. + +mögliche Bedingungen: + Text identisch mit Text.. größergleich + *Text endet mit ..Text kleiner + Text* beginnt mit Text..Text zwischen + *Text* enthält * nicht leer + + --Bed Verneinung + +Kombination von Bedingungen: + Bedingungen für verschiedene Felder: + UND + Komma zwischen Bedingungen: + lokales ODER (Prio höher als UND) + Semikolon zwischen Bedingungen: + globales ODER (Prio niedriger als UND) +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2L" +% SEITE 1 +--- Suchbedingung löschen --- +Mit dieser Funktion kann eine eingestellte Suchbedingung wieder +gelöscht werden, so daß wieder alle Sätze sichtbar sind. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2N" +% SEITE 1 +--- auf Satz Nr. --- +Mit dieser Funktion kann ein bestimmter Satz direkt angewählt +werden. Dazu müssen Sie lediglich dessen Satznummer angeben. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2E" +% SEITE 1 +--- neuen Satz einfügen --- +Mit dieser Funktion wird vor dem aktuellen Satz ein neuer Satz +eingefügt. Die Inhalte dieses zunächst leeren Satzes können Sie +mit Hilfe des Editors neben die einzelnen Feldnamen schreiben. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2A" +% SEITE 1 +--- Satz ändern --- +Mit dieser Funktion können Sie die Inhalte des aktuellen Satzes +verändern. Am Bildschirm können Sie die Daten mit Hilfe des +Editors ändern, löschen und Neues hinzufügen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2M" +% SEITE 1 +--- Markierung ein/aus --- +Mit dieser Funktion können Sie einen Satz markieren, damit +später nur die markierten Sätze bearbeitet werden. Ist der Satz +schon markiert, wird die Markierung wieder gelöscht. Wenn min­ +destens ein Satz markiert ist, erscheint die Markierungsinfor­ +mation in der Überschrift. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3L" +% SEITE 1 +--- Alle Markierungen loeschen --- +Mit dieser Funktion werden alle Markierungen in der Datei +gelöscht. Die Markierungsinformation wird nicht mehr angezeigt. +Die Markierungen werden auch beim neuen Öffnen gelöscht, da sie +nicht permanent in der Datei gespeichert sind. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2T" +% SEITE 1 +--- Einzelsatz tragen --- +Mit dieser Funktion kann der aktuelle Satz in eine andere Datei +transportiert werden. Anschließend wird er gelöscht. Der Satz +wird am Ende der Zieldatei angefügt, wobei diese gegebenenfalls +eingerichtet wird. Den Namen der Zieldatei können Sie eingeben. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2H" +% SEITE 1 +--- Einzelsatz holen --- +Diese Funktion holt den letzten Satz einer anderen Datei und +fügt ihn vor dem aktuellen Satz ein. Damit wird das letzte +'Tragen' wieder rückgängig gemacht. Die Dateien müssen gleiche +Felderzahl haben. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3U" +% SEITE 1 +--- Übersicht --- +Mit dieser Funktion können Sie sich eine Übersicht über mehrere +Sätze verschaffen. Es werden vom aktuellen Satz an alle durch +die Suchbedingung spezifizierten Sätze angezeigt, jeder Satz in +einer Zeile. In dieser Übersicht können Sie blättern und auch +bestimmte Sätze zur späteren Bearbeitung markieren. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2F" +% SEITE 1 +--- Auswahl Felder --- +Mit dieser Funktion kann gewählt werden, welche Felder in +welcher Reihenfolge angezeigt werden sollen. Alle Felder +werden zum Ankreuzen angeboten. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4D" +% SEITE 1 +--- Drucken nach Muster --- +Mit dieser Funktion können die Inhalte der Datei nach einem +Druckmuster ausgedruckt werden. Das Druckmuster ist eine Text­ +datei und muß vorher erstellt werden. Es gibt die Form des +Ausdrucks an. Über den Aufbau eines Druckmusters lesen Sie am +besten das Benutzerhandbuch. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3T" +% SEITE 1 +--- Satzauswahl tragen --- +Diese Funktion trägt alle durch die Suchbedingung oder durch +Markierung ausgewählten Sätze in eine andere Datei und löscht +sie danach. Die Zieldatei muß gleiche Felderzahl haben, damit +keine Information verlorengeht. Beim Tragen können auch die +Prüfbedingungen der Zieldatei geprüft werden, wenn Sie die +entsprechende Frage bejahen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4E" +% SEITE 1 +--- Textdatei erstellen/aendern --- +Mit dieser Funktion kann eine Textdatei erstellt, geändert oder +angesehen werden. Es wird der normale Editor verwendet. Mit +dieser Funktion werden auch Druckmuster bearbeitet. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3K" +% SEITE 1 +--- Satzauswahl kopieren --- +Diese Funktion kopiert alle durch die Suchbedingung oder durch +Markierung ausgewählten Sätze in eine andere Datei. Welche +Felder in welcher Reihenfolge kopiert werden sollen, wird durch +ein Kopiermuster bestimmt, das nach der Struktur der Zieldatei +bestimmt wird und dann von Ihnen noch geändert werden kann. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4R" +% SEITE 1 +--- Richtung Ausgabe --- +Mit dieser Funktion können Sie festlegen, ob die Ausgabe des +Druckvorgangs direkt anschließend ausgedruckt werden soll, oder +in eine Datei gespeichert wird. Sie können den Namen dieser +Datei eingeben, anderenfalls wählt sich EUDAS selbst einen +Namen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4A" +% SEITE 1 +--- Textdatei ausdrucken --- +Mit dieser Funktion wird eine Textdatei direkt ausgedruckt. Die +Datei kann Anweisungen zur Druckersteuerung enthalten, die Sie +dem EUMEL-Benutzerhandbuch entnehmen können. Sie können hiermit +Ausgabedateien des Druckprozesses und das Druckmuster selbst +ausdrucken. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3V" +% SEITE 1 +--- Ändern nach Vorschrift --- +Diese Funktion ermöglicht es, alle durch die Suchbedingung oder +durch Markierung ausgewählten Sätze nach einer Vorschrift auto­ +matisch zu ändern. Die Art der Änderungen wird dabei durch ein +Verarbeitungsmuster festgelegt, das vorher als Textdatei er­ +stellt werden muß. Über die Form des Verarbeitungsmusters s. +Benutzerhandbuch. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4N" +% SEITE 1 +--- Textdatei nachbearbeiten --- +Mit dieser Funktion können Sie eine Datei zeilenweise und +seitenweise formatieren (lineform/pageform). Dies dient an +dieser Stelle zur Bearbeitung von Druckdateien, die +verschiedene oder Proportionalschriften enthalten. Sie werden +jeweils für jede der beiden Funktionen gefragt, ob Sie sie +ausführen wollen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6S" +% SEITE 1 +--- Schreiben auf Archiv --- +Diese Funktion schreibt eine oder mehrere Dateien auf das +Archiv. Der Archivname muß vorher eingegeben werden. Dann kann +entweder der Name der gewünschten Datei eingegeben werden oder +mit ESC 'z' eine Auswahl von Dateien angekreuzt werden. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5A" +% SEITE 1 +--- Datei aufräumen --- +Diese Funktion reorganisiert eine Datei, an der viel geändert +wurde, zur Platz- und Zeitersparnis. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5K" +% SEITE 1 +--- Datei kopieren --- +Mit dieser Funktion kann eine beliebige Datei logisch kopiert +werden. Die Kopie ist identisch mit dem Original und belegt den +gleichen Platz, erst bei Änderungen werden unterschiedliche +Daten gespeichert. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5P" +% SEITE 1 +--- Platzbedarf Datei --- +Diese Funktion gibt an, wieviel Platz eine Datei im System +belegt. Dieser Platz kann aber mit anderen Dateien geteilt +sein. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6D" +% SEITE 1 +--- Archivübersicht drucken --- +Diese Funktion druckt die Übersicht der Archivdateien aus. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6I" +% SEITE 1 +--- Archiv initialisieren --- +Diese Funktion initialisiert einen Archivträger vor dem +Beschreiben. Sämtliche Daten werden gelöscht. Auf Wunsch kann +der Datenträger auch formatiert werden (falls vom System +unterstützt). +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6Z" +% SEITE 1 +--- Zielarchiv einstellen --- +Mit dieser Funktion kann eine Managertask angegeben werden, auf +die die Archivfunktionen angewendet werden. Dies dient sowohl +zur Ansteuerung von mehreren Archiven (z.B. über Netz) als auch +zur Kommunikation mit anderen Managern. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6P" +% SEITE 1 +--- Passwort --- +Mit dieser Funktion können Sie das Passwort einstellen, das +beim Versenden von Dateien an andere Tasks verwendet wird. Beim +Schreiben einer Datei wird das Passwort der Datei mitgegeben +und beim Lesen wird überprüft, ob das Passwort übereinstimmt. +Das Passwort kann in der Form Schreibpasswort/Lesepasswort +angegeben werden. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6R" +% SEITE 1 +--- Reservieren --- +Mit dieser Funktion können Sie einen Kanalmanager (z.B. +DOS-Task) reservieren. Die Reservierung wird beim Verlassen des +Archivmenüs wieder aufgehoben. Den Parameter zur Reservierung +(Modus bei DOS-Task) können Sie angeben. Bei normalen Archiv­ +tasks wird die Reservierung automatisch vorgenommen, daher ist +diese Funktion dann gesperrt. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6K" +% SEITE 1 +--- Kopieren vom Archiv --- +Diese Funktion kopiert eine Datei vom Archiv ins System. Der +Archivname wird automatisch bestimmt. Sie können dann entweder +den gewünschten Dateinamen angeben oder mit ESC 'z' eine Aus­ +wahl aller Dateien auf dem Archiv abrufen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5N" +% SEITE 1 +--- Datei Namen ändern --- +Mit dieser Funktion können Sie für eine Datei auf dem System +einen neuen Namen vergeben. Wenn Sie den neuen Namen eingeben, +wird Ihnen der alte Name angeboten. Sie können ihn ändern oder +ganz überschreiben. Dadurch ersparen Sie sich bei kleinen +Änderungen das Neutippen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6L" +% SEITE 1 +--- Löschen auf Archiv --- +Diese Funktion ermöglicht es, eine Datei auf dem Archiv zu +löschen. Der Platz dieser Datei wird jedoch nur dann wiederver­ +wendet, wenn keine Dateien mehr dahinter stehen. Der Archivname +muß eingegeben werden. Sie können bei der Eingabe des Datei­ +namens mit ESC 'z' eine Dateiauswahl abrufen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5L" +% SEITE 1 +--- Datei löschen --- +Diese Funktion löscht eine Datei auf dem System nach Anfrage. +Sie können den Dateinamen eingeben oder mit ESC 'z' eine Aus­ +wahl aller vorhandenen Dateien abrufen. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6U" +% SEITE 1 +--- Übersicht Archiv --- +Diese Funktion liefert eine Übersicht der Dateien auf dem +Archiv. Verlassen Sie diese Übersicht mit ESC 'q'. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5U" +% SEITE 1 +--- Übersicht Dateien --- +Diese Funktion liefert eine Übersicht über alle im System vor­ +handenen Dateien. Verlassen Sie diese Übersicht mit ESC 'q'. +--- +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "AUSWAHL/Allgemein" +% SEITE 1 +--- AUSWAHL --- +Mit Hilfe der Auswahl ist es möglich, aus einem Angebot einen +Teil auszuwählen. Die gewünschten Namen werden einfach in +beliebiger Reihenfolge angekreuzt und anschließend in dieser +Reihenfolge verwendet. +Die Schreibmarke (Cursor) gibt an, welcher Name gerade ange­ +kreuzt werden kann. Mit den Pfeiltasten kann der Cursor auf den +Kreisen bewegt werden. 'x' kreuzt einen Namen an, 'o' löscht +die Ankreuzung wieder. +Mit ESC 'q' wird die Auswahl verlassen. ESC 'a' bricht die +Auswahl und die folgende Funktion ab. Falls das Angebot nicht +auf den Bildschirm paßt, wird es gerollt. ESC '1' positioniert +immer auf den Anfang und ESC '9' auf das Ende der Auswahl. Mit +HOP 'x' werden alle noch nicht angekreuzten Namen angekreuzt, +mit HOP 'o' werden alle Ankreuzungen gelöscht. +--- +% ENDE +% HILFE "AUSWAHL/Felder" +% SEITE 1 +--- +Sie können hier alle Felder ankreuzen, die Sie ändern wollen. +Ändern können Sie den Feldnamen und den Feldtyp. Wollen Sie +keine Felder ändern, drücken Sie einfach ESC 'q'. +--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Sortierfelder" +% SEITE 1 +--- +Kreuzen Sie hier die Felder an, die bei der Sortierung berück­ +sichtigt werden sollen. Die Reihenfolge des Ankreuzens ist +wichtig. Beim Vergleich zweier Sätze wird erst das als erstes +angekreuzte Feld verglichen und danach die Einordnung der Sätze +bestimmt. Ist dieses Feld bei beiden gleich, wird das nächste +angekreuzte Feld untersucht usw. +--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Anzeigefelder" +% SEITE 1 +--- +Kreuzen Sie hier alle Felder an, die Sie angezeigt haben möch­ +ten. Die Felder erscheinen in der angekreuzten Reihenfolge. Für +beide Arten der Anzeige können Sie eine separate Feldauswahl +einstellen. +--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Feldnamen" +% SEITE 1 +--- +Durch Blättern in der Auswahl können Sie die Schreibweise der +Feldnamen ansehen. Die Namen, die Sie ankreuzen, werden danach +mit Anführungsstrichen in die gerade editierte Datei übernommen. +--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Archiv" +% SEITE 1 +--- +Diese Auswahl zeigt alle auf dem Archiv vorhandenen Dateien an. +Kreuzen Sie die Dateien an, die Sie bearbeiten möchten. Die +Dateien werden in der angekreuzten Reihenfolge verwendet. +--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Datei" +% SEITE 1 +--- +Diese Auswahl zeigt alle Dateien auf dem System, die Sie ver­ +wenden können. Kreuzen Sie die gewünschte(n) Datei(en) an. +--- +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "FEHLER/Allgemein" +% SEITE 1 +--- FEHLERMELDUNGEN --- +Fehlermeldungen werden von einem Programm abgesetzt, wenn es +seine Funktion nicht durchführen kann. Der Text der Meldung +identifiziert die Ursache des Problems. Zur Zeit liegen noch +keine meldungsspezifischen Informationen vor, schauen Sie ggf. +in das Benutzerhandbuch. +--- +% ENDE +% HILFE "FEHLER/9" +% SEITE 1 +--- +Diese Fehlermeldung deutet auf einen internen Programmfehler +(wenn Sie nicht selber ein Programm geschrieben haben). Melden +Sie diesen Fehler bitte, damit eine Korrektur vorgenommen +werden kann. Schreiben Sie sich dazu die Begleitumstände auf +(welche Datei haben Sie benutzt, welche Funktion). Versuchen +Sie gegebenenfalls, den Fehler zu wiederholen. Es ist nämlich +z.B. wichtig, ob der Fehler nur bei einer bestimmten Datei +auftritt oder ganz "zufällig". Wenn Sie vermuten, daß der +Fehler an einer bestimmten Datei liegt, sichern Sie diese Datei +bitte auf einer Diskette, um sie eventuell einschicken zu +können. +--- +% ENDE +% HILFE "FEHLER/10" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "FEHLER/11" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "FEHLER/14" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "GET/Allgemein" +% SEITE 1 +--- EINGABE --- +Die Eingabe erwartet von Ihnen eine bestimmte Information, die +Sie eingeben sollen. Die Art der Information wird durch den +Anforderungstext angegeben. Wenn Sie sich beim Eintippen ver­ +schrieben haben, können Sie mit den Pfeiltasten zurückgehen +und den Text korrigieren. Eine bereits dastehende Information +können Sie überschreiben. RUBOUT löscht ein Zeichen, RUBIN +schaltet in den Einfügemodus (Zeichen werden nicht mehr über­ +schrieben). Beenden Sie die Eingabe mit RETURN. ESC 'h' bricht +die Eingabe und die folgende Funktion ab. Wenn in der Status­ +zeile angegeben, können Sie mit ESC 'z' eine Auswahl verfüg­ +barer Namen abrufen, die Sie dann Ankreuzen können. +--- +% ENDE +% HILFE "GET/Sicherungsname" +% SEITE 1 +--- +Sie können jetzt den Namen angeben, unter dem die Arbeitskopie +gespeichert werden soll. Ihnen wird der alte Name zum Über­ +schreiben angeboten. Drücken Sie nur RETURN, wird der alte Name +genommen und die alte Version überschrieben. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Dateiname" +% SEITE 1 +--- +Bitte geben Sie den Namen der Datei ein, mit dem die Operation +ausgeführt werden soll. Mit ESC 'z' können Sie sich die zur +Verfügung stehenden Namen auch als Auswahl zeigen lassen. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/feldname" +% SEITE 1 +--- +Sie können den Namen des angegebenen Feldes ändern, indem Sie +den alten Namen überschreiben bzw. korrigieren. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/feldtyp" +% SEITE 1 +--- +Sie können hier einen von vier möglichen Typen eingeben: + TEXT normaler Text mit Vergleich nach EUMEL-Code. + DIN Text, der nach DIN 5007 verglichen wird (Umlaute rich­ + tig, Groß-/Kleinschreibung und Sonderzeichen ignoriert). + ZAHL Alle nichtnumerischen Zeichen außer Minus und Dezimal­ + komma werden beim Vergleichen ignoriert. + DATUM Datum der Form "tt.mm.jj" +Die Feldtypen werden beim Sortieren und Suchen beachtet. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/auf Satz" +% SEITE 1 +--- +Sie können hier die Satznummer des Satzes eingeben, den Sie +sehen wollen. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/copy" +% SEITE 1 +--- + Geben Sie hier den Namen für die logische Kopie der Datei an. + Dieser Name darf keine existierende Datei bezeichnen. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Archivname" +% SEITE 1 +--- +Geben Sie den Namen des eingelegten Archivs ein (zur Sicher­ +heit). Der zuletzt verwendete Name wird zum Ändern angeboten. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/rename" +% SEITE 1 +--- +Sie können den alten Namen der Datei durch Überschreiben und +Korrigieren ändern. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Druckdatei" +% SEITE 1 +--- +Geben Sie hier den Namen der Datei ein, in die die Ausgabe des +Druckprozesses geschrieben werden soll. Diese Datei wird nur +für den nächsten Druckvorgang verwendet. Sie müssen den Namen +also jedes Mal wieder neu angeben. Existiert die Datei schon, +wird die Ausgabe an das Ende angehängt. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Zielarchiv" +% SEITE 1 +--- +Geben Sie hier entweder den Namen einer Archivtask ein +(normalerweise "ARCHIVE") oder einer anderen Managertask. Bei +Netzbetrieb können Sie auch die Station anschließend angeben. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Zielstation" +% SEITE 1 +--- +Geben Sie hier die Stationsnummer der Zieltask ein. Wenn sich +die Zieltask in Ihrem eigenen System befindet, brauchen Sie nur +RETURN zu drücken. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/multi task" +% SEITE 1 +--- +Sie können hier den Namen einer EUDAS-Managertask angeben +(EUDAS muß in dieser Task insertiert sein). Wenn Sie keinen +Namen angeben, werden keine entsprechenden Abfragen beim Öffnen +mehr gemacht. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/kopiermuster" +% SEITE 1 +--- +Geben Sie den Namen einer Datei ein, in der das Kopiermuster +stehen soll. Drücken Sie einfach RETURN, wenn Sie das Muster +nicht aufbewahren wollen. Wenn die Datei noch nicht existiert, +wird das Standard-Kopiermuster in die Datei geschrieben. +Anschließend kann das Muster noch im Editor geändert werden. +--- +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "JA/Allgemein" +% SEITE 1 +--- FRAGEN --- +Das Programm stellt Ihnen eine Frage, die Sie bejahen oder +verneinen können. Sie bejahen die Frage, indem Sie 'j' drücken +und verneinen Sie mit 'n' (beides groß oder klein). Mit ESC 'h' +können Sie die Funktion abbrechen. +--- +% ENDE +% HILFE "JA/oeffne" +% SEITE 1 +--- +Beantworten Sie die Frage mit 'n', wenn Sie die Datei nur anse­ +hen wollen. In diesem Fall wird keine Sicherheitskopie er­ +stellt. Verneinen Sie die Frage, wird eine interen Kopie ange­ +legt, die Sie dann verändern können. Die Kopie muß nach dem +Ändern gesichert werden. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/alte version" +% SEITE 1 +--- +Wenn Sie diese Frage bejahen, wird die Arbeitskopie unter dem +angegebenen Namen gesichert. Die alte Version geht dadurch +verloren. Wenn Sie die Frage verneinen, haben Sie Gelegenheit, +einen neuen Namen anzugeben, damit die alte Version erhalten +bleiben kann. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Datei loeschen" +% SEITE 1 +--- +Beim Sichern hatten Sie Gelegenheit, alle veränderten Dateien +zu sichern. Die Sicherheitskopien können damit gelöscht werden. +Dazu bejahen Sie die Frage. Wenn die Dateien jedoch noch geöff­ +net bleiben sollen, oder Sie eine Datei aus Versehen nicht +gesichert haben, müssen Sie diese Frage verneinen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/sichere" +% SEITE 1 +--- +Die interne Arbeitskopie der angegebenen Datei wurde gegenüber +dem Original verändert. Wenn Sie diese Änderungen behalten +wollen, müssen Sie die Frage bejahen. Sie haben dann noch die +Möglichkeit, die geänderte Version unter neuem Namen zu +sichern, um die alte Version zu behalten. Wenn Sie die Frage +verneinen, gehen die Änderungen verloren und das Original +bleibt erhalten. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/ueber" +% SEITE 1 +--- +Sie haben für die Arbeitskopie einen Namen angegeben, der noch +existiert. Bejahen Sie die Frage, wird die alte Datei dieses +Namens überschrieben. Anderenfalls erhalten Sie eine neue Gele­ +genheit, einen Namen einzugeben. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sicherungssortierung" +% SEITE 1 +--- +Die angegebene Datei war früher schon einmal sortiert worden. +Die Sortierung wurde jedoch durch nachfolgende Änderungen +zerstört. Wenn Sie die Datei wieder sortiert haben wollen, +beantworten Sie die Frage mit 'j'. Die Sortierung dauert nicht +lange, wenn nur wenige Sätze verändert wurden. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/feldnamen" +% SEITE 1 +--- +Falls Sie neue Felder zu den existierenden anfügen wollen, +müssen Sie diese Frage bejahen. Sie erhalten dann Gelegenheit, +die neuen Namen im Editor einzugeben. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sortierfelder" +% SEITE 1 +--- +Die Reihenfolge, in der die Felder bei der Sortierung berück­ +sichtigt werden, ist in der EUDAS-Datei intern gespeichert. +Wenn Sie diese Reihenfolge, die beim letzten Sortieren angege­ +ben wurde, ändern möchten, müssen Sie die Frage bejahen. Sie +können dann die neue Feldreihenfolge auswählen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/sortieren" +% SEITE 1 +--- +Wenn Sie diese Frage bejahen, wird die Zieldatei nach Ausfüh­ +rung der Funktion in ihrer eingestellten Feldreihenfolge sor­ +tiert. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/forget" +% SEITE 1 +--- +Wenn Sie diese Frage bejahen, wird die Datei wirklich gelöscht. +Wenn Sie die Datei irrtümlich gewählt haben, müssen Sie die +Frage verneinen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/direkt drucken" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, wird das Ergebnis des Druckens am +Ende des Vorgangs ausgedruckt. Anderenfalls wird das Ergebnis +in einer Datei zwischengespeichert. Sie können die Ausgabe dann +noch behandeln, ehe Sie sie ausdrucken. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/einrichten" +% SEITE 1 +--- +Sie haben eine Datei angegeben, die noch nicht existiert. Wenn +Sie die Frage bejahen, wird die Datei neu eingerichtet. Ande­ +renfalls wird die Funktion abgebrochen, so daß Sie Gelegenheit +haben, die Funktion mit einem neuen Namen zu wiederholen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/testen" +% SEITE 1 +--- +Wenn Sie diese Frage bejahen, werden beim Tragen die Prüfbedin­ +gungen der Zieldatei abgefragt. Sätze, die diese Bedingungen +nicht erfüllen, werden nicht getragen und können danach geän­ +dert werden. Beim Ändern wird dann jeweils die den Satz betref­ +fende Meldung ausgegeben. Die Prüfbedingungen der Zieldatei +können Sie mit der Funktion "Feldstruktur aendern" angeben oder +ändern. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/save" +% SEITE 1 +--- +Die angegebene Datei befindet sich bereits auf dem Archiv. Wenn +Sie die Datei überschreiben wollen, müssen Sie die Frage beja­ +hen. Ansonsten wird die Datei nicht auf das Archiv geschrieben +(keine Wirkung). +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/fetch" +% SEITE 1 +--- +Die angegebene Datei ist bereits im System vorhanden. Wenn Sie +diese Datei überschreiben wollen, müssen Sie die Frage bejahen. +Anderenfalls wird keine Aktion vorgenommen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/erase" +% SEITE 1 +--- +Zur Sicherheit wird gefragt, ob Sie die angegebene Datei wirk­ +lich auf dem Archiv löschen wollen. Wenn Sie die Frage vernei­ +nen, wird keine Aktion durchgeführt. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Druckdatei" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, können Sie für die Ausgabedatei +einen bestimmten Namen angeben. Anderenfalls wird ein Name +"EUDAS-Ausgabe.n" automatisch von EUDAS vergeben. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Zielmanager" +% SEITE 1 +--- +Ein Archivmanager ist eine Task, die tatsächlich ein +physikalisches Speichermedium (Diskette) bedient, das für den +jeweiligen Benutzer reserviert werden muß. Normale Managertasks +können von mehreren Benutzern gleichzeitig angesprochen werden. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/format" +% SEITE 1 +--- +Wenn Ihr Rechner dies unterstützt, können Sie Archivdisketten +vor dem Initialisieren noch physikalisch formatieren. Dies ist +immer dann notwendig, wenn eine Diskette neu ist (vor der +ersten Benutzung) oder wenn Schreibfehler aufgetreten sind, die +sich nicht mehr reparieren lassen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/archiv loeschen" +% SEITE 1 +--- +Wenn Sie irrtümlich die falsche Diskette eingelegt haben oder +eine andere Funktion ausführen wollten, können Sie die Funktion +durch Verneinen der Frage abbrechen. Achten Sie auf den +angegebenen Archivnamen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/archiv init" +% SEITE 1 +--- +Wenn Sie aus Versehen die falsche Funktion gewählt haben, +können Sie die Funktion durch Verneinen der Frage abbrechen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Feld aendern" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, werden Ihnen alle vorhandenen +Felder zum Ankreuzen angeboten. Sie können dann für die +angekreuzten Felder die Namen und Feldtypen ändern. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/alle Saetze" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, werden anschließend alle Sätze, die +in der Übersicht zu sehen waren, gedruckt. Den Namen des +Druckmusters können Sie dann gleich eingeben. Wenn Sie keinen +oder nur den aktuellen Satz drucken wollen, müssen Sie die +Frage verneinen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/alle markierten" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, werden anschließend alle markierten +Sätze gedruckt. Den Namen des Druckmusters können Sie dann +gleich eingeben. Wenn Sie keinen oder nur den aktuellen Satz +drucken wollen, müssen Sie die Frage verneinen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Einzelsatz drucken" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, wird der aktuelle (markierte) Satz +gedruckt. Den Namen des Druckmusters können Sie dann gleich +eingeben. Wenn Sie keinen Satz drucken wollen, müssen Sie die +Frage verneinen. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/noch einmal" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, können Sie noch einmal die Datei +mit einer neuen Suchbedingung ansehen und erneut drucken. Sonst +kehren Sie wieder in den Editor zurück. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Ub. Felder" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, können Sie einzelne Felder in einer +bestimmten Reihenfolge für die Übersichtsanzeige auswählen. +Anderenfalls werden alle Felder angezeigt. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Suchmuster" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, können Sie eine Suchbedingung für +die angezeigten Sätze angeben. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/umschalten" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, schalten Sie auf die genannte +Koppeldatei um. Damit wird diese Datei zeitweise als einzige +geöffnete betrachtet. Damit können Sie einen bestimmten Satz +aufsuchen, den Sie später beim Zurückschalten übernehmen +können. Verneinen Sie die Frage, werden Ihnen weitere mögliche +Koppeldateien angeboten, oder Sie kehren ohne Schaden zurück. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/uebernehmen" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, werden die Koppelfelder des jetzt +ausgewählten Satzes in den aktuellen Satz der ersten Datei +übernommen, an dem Sie dann weiter ändern können. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sortierrichtung" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, wird die Datei nach dem genannten +Feld in aufsteigender Richtung sortiert, anderenfalls in +absteigender. Für weitere Felder können Sie wieder eine andere +Richtung angeben. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/zeilenform" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, wird die angegebene Datei +zeilenweise interaktiv formatiert. Der Text wird unter +Berücksichtigung der Schrifttypen gleichmäßig auf die Zeilen +verteilt. Beachten Sie die Wirkung der Absatzmarken! +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/seitenform" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, wird die angegebene Datei +interaktiv seitenweise formatiert. Der Text wird bis zur +angegebenen Seitenlänge auf die Seiten verteilt. Dabei werden +Seitenköpfe und Fußnoten eingefügt. Das Ergebnis steht in der +Datei "xxx.p". +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/pw loeschen" +% SEITE 1 +--- +Wenn Sie die Frage bejahen, wird das Passwort gelöscht und das +leere Passwort eingestellt. Anderenfalls bleibt das alte +Passwort erhalten. +--- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "EDIT/Allgemein" +% SEITE 1 +--- EDITOR --- +Mit dem Editor können Sie einen Text zeilenweise eingeben. +Dabei können Sie den Cursor mit den Pfeiltasten bewegen. RUBOUT +löscht ein Zeichen, RUBIN schaltet in den Einfügemodus um. Für +weitere Informationen zum Editor s. EUMEL-Benutzerhandbuch. ESC +'q' verläßt den Editor normal. Mit ESC 'h' wird die Funktion +abgebrochen. +--- +% ENDE +% HILFE "EDIT/Feldnamen" +% SEITE 1 +--- +Sie können hier die neuen Feldnamen in der gewünschten Reihen­ +folge untereinander eingeben. Jeder Feldname muß in einer +Zeile stehen und ohne Anführungsstriche geschrieben sein. +--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Pruefbed" +% SEITE 1 +--- +Sie können hier die Prüfbedingungen der Datei eingeben bzw. +ändern. Die Prüfbedingungen sind ein ELAN-Programm. Da ELAN- +Programme formatfrei sind, kann es sein, daß Ihr Programm beim +nächsten Mal anders erscheint, als Sie es eingegeben haben. +--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Notizen" +% SEITE 1 +--- +Sie können jetzt zu der angegebenen Datei beliebige Notizen +eingeben bzw. ändern. Sie befinden sich im Editor und können +die gleichen Funktionen wie bei der normalen Texteingabe +verwenden. +--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Suchen" +% SEITE 1 +--- +Sie können jetzt eine Selektionsbedingung einstellen. Dazu +müssen Sie jeweils neben den Feldnamen eine Bedingung schrei­ +ben. Mögliche Bedingungen sind: + Text muß gleich sein + Text* muß mit Text anfangen + *Text muß mit Text enden + *Text* enthält Text + Text.. muß größer oder gleich Text sein + ..Text muß kleiner als Text sein oder mit Text anfangen + Text1..Text2 liegt zwischen den beiden Texten +"--" verneint eine Bedingung. Weitere Bedingungen und Kombina­ +tion von Bedingungen s. EUDAS-Benutzerhandbuch. +--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Einfuegen" +% SEITE 1 +--- +Sie können hier die Inhalte eines neuen Satzes eingeben, der +vor dem aktuellen Satz eingefügt wird. +Spezielle Tastenkombinationen: + ESC RUBOUT Rest der Zeile löschen + ESC RUBIN Zeile aufbrechen + ESC OBEN nach oben blättern + ESC UNTEN nach unten blättern + ESC '1' auf erste Zeile + ESC '9' auf letzte Zeile + ESC 'h' Abbruch, der Satz wird nicht eingefügt + ESC 'w' Beenden und gleich den nächsten Satz einfügen + ESC 'D' aktuelles Tagesdatum schreiben +--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Aendern" +% SEITE 1 +--- +Sie können die Inhalte des aktuellen Satzes hier abändern. +Spezielle Tastenkombinationen: + ESC RUBOUT Rest der Zeile löschen + ESC RUBIN Zeile aufbrechen + ESC OBEN nach oben blättern + ESC UNTEN nach unten blättern + ESC '1' auf erste Zeile + ESC '9' auf letzte Zeile + ESC 'h' Abbruch, der Satz bleibt unverändert + ESC 'w' Beenden und gleich den nächsten Satz ändern + ESC 'D' aktuelles Tagesdatum schreiben +--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Druckmuster" +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Verarbeite" +% SEITE 1 +--- +Sie können hier eine Verarbeitungsvorschrift eingeben. Die +Verarbeitungsvorschrift ist ein ELAN-Programm. Ein Feld wird +geändert durch den Operator "V": + "Feldname" V "neuer Feldinhalt"; +Statt des neuen Feldinhalts kann auch ein beliebiger ELAN-Aus­ +druck angegeben werden. Mit + f ("Feldname") +wird der Inhalt eines Feldes als Text geliefert. +--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Kopiermuster" +% SEITE 1 +--- +Sie können das hier angegebene Kopiermuster verändern. Sollen +Felder nicht kopiert werden, brauchen Sie nur die entsprechen­ +den Zeilen zu löschen. Soll eine Feld andere Inhalte bekommen, +geben Sie in dem Ausdruck + "Feldname" K f ("Feldname"); +hinter dem K einen anderen ELAN-Ausdruck ein. Die Reihenfolge +der K-Ausdrücke bestimmt die Reihenfolge der Feldnamen in der +Zieldatei, wenn die Zieldatei noch nicht existierte. +--- +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "UEBERSICHT" +% SEITE 1 +--- +In diesem Modus können Sie sich alle Sätze der Datei durch +Blättern ansehen. Der aktuelle Satz ist jeweils markiert. Die +eingestellte Suchbedingung wird beachtet. Mit den Pfeiltasten +OBEN und UNTEN bewegen Sie sich vorwärts und rückwärts in der +Datei. Mit HOP OBEN, HOP UNTEN und HOP RETURN blättern Sie wie +im Editor. Mit ESC '1' gelangen Sie an den Anfang, mit ESC '9' +an das Ende der Datei. Mit '+' und '-' können Sie die +Markierung des aktuellen Satzes für spätere Verarbeitung +ändern. Verlassen Sie die Übersicht mit ESC 'q'. +--- +% ENDE +% HILFE "SHOW/Uebersicht" +% SEITE 1 +--- +In der gezeigten Dateiübersicht können Sie mit HOP OBEN und HOP +UNTEN blättern, wenn nicht alle Dateien auf eine Seite passen. +Verlassen Sie die Übersicht mit ESC 'q'. +--- +% ENDE + diff --git a/app/eudas/4.3/src/pos.173 b/app/eudas/4.3/src/pos.173 new file mode 100644 index 0000000..a9706a3 --- /dev/null +++ b/app/eudas/4.3/src/pos.173 @@ -0,0 +1,19 @@ +PACKET xpos DEFINES x pos : +INT PROC x pos (TEXT CONST a, b, INT CONST c, d) : + pos (a, b, c, d) +END PROC x pos; +END PACKET x pos; +PACKET pos 173 DEFINES pos: +INT PROC pos (TEXT CONST a, b, INT CONST c, d) : + x pos (a, b, c, d+1) +END PROC pos; +END PACKET pos 173; +PACKET add 173 DEFINES split line, reserve : +PROC split line (FILE VAR f, INT CONST spalte, BOOL CONST dummy) : + split line (f, spalte) +END PROC split line; +PROC reserve (TEXT CONST modus, TASK CONST task) : + call (19, modus, task) +END PROC reserve; +END PACKET add 173; + diff --git a/app/eudas/4.4/doc/ref-manual/abb.1-1 b/app/eudas/4.4/doc/ref-manual/abb.1-1 new file mode 100644 index 0000000..4f705dc --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.1-1 @@ -0,0 +1,71 @@ +init dgs; +window (0.0, 0.0, 13.5, 7.1); (*viewport (0.0,0.0,13.5,7.1); *) +scale (1.0,1.0,0.0,0.0); +(*clear pixels;*) + +karteikasten (1.0, 3.5, "Kartei A", "Wegner", "Herbert"); +karteikasten (5.0, 0.5, "Kartei B", "Regmann", "Karin"); + +LET myname = "abb.1-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (10000); +*) +PROC karteikasten (REAL CONST x, y, TEXT CONST name, t name, t vorname) : + + move (x - 0.1, y); + draw (x + 3.6, y); + draw (x + 3.6, y + 1.0); + draw (x - 0.1, y + 1.0); + draw (x - 0.1, y); + + move (x + 0.1, y + 1.1); + draw (x + 0.5, y + 1.5); + move (x + 0.1, y + 1.1); + draw (x + 3.6, y + 1.1); + move (x - 0.1, y + 1.0); + draw (x + 0.5, y + 1.6); + + move (x + 3.6, y); + draw (x + 5.2, y + 1.6); + draw (x + 5.2, y + 2.6); + draw (x + 3.6, y + 1.0); + move (x + 3.6, y + 1.1); draw (x + 5.0, y + 2.5); + move (x + 5.2, y + 2.6); draw (x + 5.0, y + 2.6); + + move (x + 0.5, y + 1.1); + draw (x + 0.5, y + 2.5); + draw (x + 4.0, y + 2.5); + draw (x + 4.0, y + 1.5); + move (x + 0.5, y + 2.5); + draw (x + 1.5, y + 3.5); + draw (x + 5.0, y + 3.5); + draw (x + 5.0, y + 2.5); + move (x + 5.0, y + 3.5); + draw (x + 4.0, y + 2.5); + REAL VAR x off := 0.1; + WHILE x off < 1.0 REP + move (x + 0.5 + xoff, y + 2.5 + x off); + draw (x + 4.0 + xoff, y + 2.5 + xoff); + draw (x + 4.0 + xoff, y + 1.5 + xoff); + x off INCR 0.1 + END REP; + font size (0.5); + font expansion (1.5); + move (x + 0.5, y + 0.2); draw (name); + font size (0.25); + move (x + 0.7, y + 2.10); draw ("Name"); + move (x + 0.7, y + 1.65); draw ("Vorname"); + move (x + 0.7, y + 1.20); draw ("Strasse"); + move (x + 2.1, y + 2.10); draw (": " + t name); + move (x + 2.1, y + 1.65); draw (": " + t vorname); + move (x + 2.1, y + 1.20); draw (":"); + +END PROC karteikasten; + diff --git a/app/eudas/4.4/doc/ref-manual/abb.4-1 b/app/eudas/4.4/doc/ref-manual/abb.4-1 new file mode 100644 index 0000000..439e052 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.4-1 @@ -0,0 +1,43 @@ +init dgs; +window (0.0, 0.0, 13.5, 3.2); viewport (0.0,0.0,13.5,3.2); +(* scale (2.0,2.0,0.0,0.0); *) +(*clear pixels;*) + +font size (0.25); +font expansion (1.5); + +INT VAR i; +FOR i FROM 0 UPTO 4 REP + move (2.0, real (i) * 0.5); + draw (10.0, real (i) * 0.5); + move (2.1, real (i) * 0.5 + 0.1); + draw ("Feld " + code (code ("E") - i)); +END REP; +move (2.0, 2.5); +draw (10.0, 2.5); +move (2.0, 2.5); +draw (2.0, 0.0); +move (3.5, 3.0); +draw (10.0, 3.0); +FOR i FROM 1 UPTO 4 REP + move (2.0 + real (i) * 1.5, 3.0); + draw (2.0 + real (i) * 1.5, 0.0); + move (2.2 + real (i) * 1.5, 2.6); + draw ("Satz " + text (i)) +END REP; +move (9.5, 3.0); +draw (9.5, 0.0); +(* +pause (1000); +*) + +LET myname = "abb.4-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); + + diff --git a/app/eudas/4.4/doc/ref-manual/abb.4-2 b/app/eudas/4.4/doc/ref-manual/abb.4-2 new file mode 100644 index 0000000..a836def --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.4-2 @@ -0,0 +1,46 @@ +init dgs; +window (0.0, 0.0, 13.5, 2.0); viewport (0.0,0.0,13.5,2.0); +(*scale (1.7,1.7,-1.6,0.0);*) +(* +clear pixels; +*) + +kasten (1.0, 0.0, 3.0, 1.5); +kasten (7.0, 0.0, 3.0, 1.5); +font size (0.4); font expansion (1.5); +move (1.8, 0.6); draw ("Menü"); +move (7.9, 0.6); draw ("Hilfe"); +move (4.5, 1.0); draw (6.5, 1.0); + draw (6.25, 1.25); move (6.5, 1.0); draw (6.25, 0.75); +move (6.5, 0.5); draw (4.5, 0.5); + draw (4.75, 0.75); move (4.5, 0.5); draw (4.75, 0.25); +font size (0.25); +move (5.0, 1.1); draw ("ESC '?'"); +move (5.0, 0.6); draw ("ESC 'q'"); +move (10.5, 1.0); draw (11.5, 1.0); draw (11.5, 0.5); draw (10.5, 0.5); + draw (10.75, 0.75); move (10.5, 0.5); draw (10.75, 0.25); +move (11.8, 0.9); draw ("ESC 'w'"); +move (11.8, 0.4); draw ("ESC 'z'"); + + +LET myname = "abb.4-2"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000); +*) +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + diff --git a/app/eudas/4.4/doc/ref-manual/abb.6-1 b/app/eudas/4.4/doc/ref-manual/abb.6-1 new file mode 100644 index 0000000..fb83242 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.6-1 @@ -0,0 +1,75 @@ +init dgs; +window (0.0, 0.0, 13.5, 4.0); viewport (0.0,0.0,13.5,4.0); +(*scale (1.0,1.0, 0.0,0.0);*) +(* +clear pixels; +*) + +move (2.25, 1.0); draw (4.75, 1.0); +move (2.25, 3.0); draw (4.75, 3.0); + move (2.5, 1.0); draw (2.5, 3.3); + move (3.0, 1.0); draw (3.0, 3.3); + move (3.5, 1.0); draw (3.5, 3.3); + move (4.0, 1.0); draw (4.0, 3.3); + move (4.5, 1.0); draw (4.5, 3.3); +font size (0.30); font expansion (1.5); +move (2.6, 3.1); draw ("4"); +move (2.6, 2.0); draw ("M"); +move (3.1, 3.1); draw ("5"); +move (3.1, 2.0); draw ("N"); +move (3.6, 3.1); draw ("6"); +move (3.6, 2.0); draw ("O"); +move (4.1, 3.1); draw ("7"); +move (4.1, 2.0); draw ("P"); + pfeil (3.75, 0.75); + +move (5.0, 2.0); draw (7.0, 2.0); draw (6.75, 2.25); + move (7.0, 2.0); draw (6.75, 1.75); +move (5.0, 2.1); draw ("Einfügen"); + +move (7.25, 1.0); draw (8.5, 1.0); move (9.0, 1.0); draw (10.25, 1.0); +move (7.25, 3.0); draw (8.5, 3.0); move (9.0, 3.0); draw (10.25, 3.0); + move (7.5, 1.0); draw (7.5, 3.3); + move (8.0, 1.0); draw (8.0, 3.3); + move (8.5, 1.0); draw (8.5, 3.3); + move (9.0, 1.0); draw (9.0, 3.3); + move (9.5, 1.0); draw (9.5, 3.3); + move (10.0, 1.0); draw (10.0, 3.3); +move (7.6, 3.1); draw ("4"); +move (7.6, 2.0); draw ("M"); +move (8.1, 3.1); draw ("5"); +move (8.1, 2.0); draw ("N"); +move (8.6, 3.1); draw ("6"); +move (9.1, 3.1); draw ("7"); +move (9.1, 2.0); draw ("O"); +move (9.6, 3.1); draw ("8"); +move (9.6, 2.0); draw ("P"); + +pfeil (8.75, 0.75); + +PROC pfeil (REAL CONST x spitze, y spitze) : + + move (x spitze, y spitze); + draw (x spitze + 0.25, y spitze - 0.25); + draw (x spitze + 0.1, y spitze - 0.25); + draw (x spitze + 0.1, y spitze - 0.5); + draw (x spitze - 0.1, y spitze - 0.5); + draw (x spitze - 0.1, y spitze - 0.25); + draw (x spitze - 0.25, y spitze - 0.25); + draw (x spitze, y spitze) + +END PROC pfeil; + + +LET myname = "abb.6-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.4/doc/ref-manual/abb.6-2 b/app/eudas/4.4/doc/ref-manual/abb.6-2 new file mode 100644 index 0000000..7771a29 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.6-2 @@ -0,0 +1,77 @@ +init dgs; +window (0.0, 0.0, 13.5, 5.0); viewport (0.0,0.0,13.5,5.0); +(*scale (1.4,1.4, 0.0,0.0);*) +(*clear pixels;*) + +move (2.5, 4.5); draw (12.4, 4.5); draw (12.4, 4.0); draw (11.0, 4.0); + draw (11.0, 3.5); move (10.5, 3.5); draw (10.5, 4.0); draw (2.5, 4.0); +move (13.5, 4.5); draw (12.5, 4.5); draw (12.5, 3.5); move (13.0, 3.5); + draw (13.0, 4.0); draw (13.5, 4.0); +move (2.5, 3.5); draw (13.5, 3.5); move (13.5, 3.0); draw (10.0, 3.0); + draw (10.0, 2.5); move (9.5, 2.5); draw (9.5, 3.0); draw (2.5, 3.0); +move (10.5, 3.0); draw (10.5, 2.5); move (11.0, 2.5); draw (11.0, 3.0); +move (12.5, 2.5); draw (12.5, 3.0); move (13.0, 3.0); draw (13.0, 2.5); +move (2.5, 2.5); draw (6.4, 2.5); draw (6.4, 2.0); draw (4.0, 2.0); + draw (4.0, 1.5); draw (6.5, 1.5); draw (6.5, 2.5); draw (13.5, 2.5); + move (13.5, 2.0); draw (7.0, 2.0); draw (7.0, 1.5); draw (9.0, 1.5); + draw (9.0, 1.0); draw (3.5, 1.0); draw (3.5, 2.0); draw (2.5, 2.0); +move (9.5, 2.0); draw (9.5, 1.0); draw (10.4, 1.0); draw (10.4, 1.5); + draw (10.0, 1.5); draw (10.0, 2.0); +move (10.5, 2.0); draw (10.5, 1.0); draw (13.0, 1.0); draw (13.0, 2.0); + move (11.0, 2.0); draw (11.0, 1.5); draw (12.5, 1.5); draw (12.5, 2.0); +move (4.5, 1.5); draw (4.75, 1.25); draw (4.5, 1.0); +move (5.5, 1.5); draw (5.75, 1.25); draw (5.5, 1.0); +move (7.5, 1.5); draw (7.75, 1.25); draw (7.5, 1.0); +move (11.5, 1.5); draw (11.75, 1.25); draw (11.5, 1.0); + +font size (0.25); font expansion (1.4); +move (2.5, 4.1); draw ("K0"); +move (2.5, 3.1); draw ("N0"); +move (2.5, 2.1); draw ("A0"); + +move (0.0, 4.1); draw ("'Kalender'"); +move (0.0, 3.1); draw ("'Namen'"); +move (0.0, 2.1); draw ("'Adressen'"); +move (0.0, 1.1); draw ("Arbeitskopie"); + +move (4.9, 1.1); draw ("A1"); +move (5.9, 1.1); draw ("A2"); +move (7.9, 1.1); draw ("A3"); +move (11.9, 1.1); draw ("K1"); + +x alignment (right); +move (13.5, 4.1); draw ("K1"); +move (13.5, 3.1); draw ("N0"); +move (13.5, 2.1); draw ("A2"); + +x alignment (normal); +font size (0.2); +INT VAR i; +FOR i FROM 0 UPTO 10 REP + time (2.5 + real (i) * 1.0, i) +END REP; + +PROC time (REAL CONST x pos, INT CONST nr) : + + move (x pos, 4.9); draw (x pos, 4.6); + move (x pos, 3.9); draw (x pos, 3.6); + move (x pos, 2.9); draw (x pos, 2.6); + move (x pos, 1.9); draw (x pos, 1.6); + move (x pos, 0.9); draw (x pos, 0.6); + move (x pos + 0.1, 0.6); draw (text (nr)) + +END PROC time; + + +LET myname = "abb.6-2"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000); +*) + diff --git a/app/eudas/4.4/doc/ref-manual/abb.7-1 b/app/eudas/4.4/doc/ref-manual/abb.7-1 new file mode 100644 index 0000000..3536ad9 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.7-1 @@ -0,0 +1,46 @@ +init dgs; +window (0.0, 0.0, 13.5, 6.0); viewport (0.0,0.0,13.5,6.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +kasten (5.0, 4.5, 3.0, 1.0); +kasten (5.0, 1.5, 3.0, 1.0); +kasten (1.5, 3.0, 3.0, 1.0); +font size (0.35); font expansion (1.5); +x alignment (center); +move (6.5, 4.8); draw ("Druckmuster"); +move (6.5, 1.8); draw ("Druckdatei"); +move (3.0, 3.3); draw ("EUDAS-Datei"); +move (6.5, 0.0); draw ("Drucker"); + +move (6.5, 4.25); draw (6.5, 2.75); draw (6.25, 3.0); + move (6.5, 2.75); draw (6.75, 3.0); +move (4.75, 3.5); draw (6.25, 3.5); draw (6.0, 3.75); + move (6.25, 3.5); draw (6.0, 3.25); +move (6.5, 1.25); draw (6.5, 0.5); draw (6.75, 0.75); + move (6.5, 0.5); draw (6.25, 0.75); + + +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + + +LET myname = "abb.7-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000); +*) + diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-1 b/app/eudas/4.4/doc/ref-manual/abb.9-1 new file mode 100644 index 0000000..774b78b --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.9-1 @@ -0,0 +1,41 @@ +init dgs; +window (0.0, 0.0, 13.5, 4.0); viewport (0.0,0.0,13.5,4.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +move (1.5, 1.0); draw (8.75, 1.0); +move (1.5, 3.5); draw (8.75, 3.5); +INT VAR i; +FOR i FROM 0 UPTO 9 REP + move (1.75 + real (i) * 0.75, 3.7); + draw (1.75 + real (i) * 0.75, 1.0); +END REP; + +move (4.7, 3.7); draw (4.7, 1.0); + +font size (0.25); font expansion (1.5); +x alignment (center); +FOR i FROM 0 UPTO 8 REP + move (2.125 + real (i) * 0.75, 3.6); draw (text (i + 110)) +END REP; +FOR i FROM 1 UPTO 5 REP + move (2.125 + real (i + 3) * 0.75, 0.6); draw ("(" + text (i) + ")") +END REP; + +font size (0.35); x alignment (left); +move (2.0, 0.0); draw ("Datei A"); +move (5.0, 0.0); draw ("Datei B"); + + +LET myname = "abb.9-1"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-2 b/app/eudas/4.4/doc/ref-manual/abb.9-2 new file mode 100644 index 0000000..4e9444d --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.9-2 @@ -0,0 +1,96 @@ +init dgs; +window (0.0, 0.0, 13.5, 6.5); viewport (0.0,0.0,13.5,6.5); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +INT VAR i; +move (4.0, 0.0); draw (4.0, 2.0); +move (5.5, 0.0); draw (5.5, 2.0); +FOR i FROM 0 UPTO 4 REP + move (4.0, real (i) * 0.5); + draw (5.5, real (i) * 0.5) +END REP; + +move (4.0, 3.0); draw (4.0, 6.0); +move (5.5, 3.0); draw (5.5, 6.0); +FOR i FROM 0 UPTO 6 REP + move (4.0, real (i) * 0.5 + 3.0); + draw (5.5, real (i) * 0.5 + 3.0) +END REP; + +move (7.5, 2.0); draw (7.5, 6.0); +move (9.0, 2.0); draw (9.0, 6.0); +FOR i FROM 0 UPTO 8 REP + move (7.5, real (i) * 0.5 + 2.0); + draw (9.0, real (i) * 0.5 + 2.0) +END REP; + +strichel (5.5, 6.0, 7.5, 6.0); +strichel (5.5, 3.0, 7.5, 3.0); +strichel (5.5, 1.0, 7.5, 3.0); +strichel (5.5, 0.0, 7.5, 2.0); + +move (5.5, 4.75); draw (6.0, 4.75); + draw (6.0, 1.75); draw (5.5, 1.75); +move (4.0, 3.75); draw (3.5, 3.75); + draw (3.5, 1.25); draw (4.0, 1.25); + +font size (0.4); font expansion (1.5); +move (0.0, 0.8); draw ("Koppeldatei"); +move (0.0, 4.3); draw ("Hauptdatei"); +move (10.0, 4.3); draw ("virtuelle"); +move (10.0, 3.4); draw ("Datei"); + +font size (0.3); +move (4.5, 0.1); draw ("H2"); +move (4.5, 0.6); draw ("H1"); +move (4.5, 1.1); draw ("B"); +move (4.5, 1.6); draw ("A"); +move (4.5, 3.1); draw ("F4"); +move (4.5, 3.6); draw ("B"); +move (4.5, 4.1); draw ("F3"); +move (4.5, 4.6); draw ("A"); +move (4.5, 5.1); draw ("F2"); +move (4.5, 5.6); draw ("F1"); +move (8.0, 5.6); draw ("F1"); +move (8.0, 5.1); draw ("F2"); +move (8.0, 4.6); draw ("A"); +move (8.0, 4.1); draw ("F3"); +move (8.0, 3.6); draw ("B"); +move (8.0, 3.1); draw ("F4"); +move (8.0, 2.6); draw ("H1"); +move (8.0, 2.1); draw ("H2"); + +PROC strichel (REAL CONST x anf, y anf, x end, y end) : + + REAL VAR laenge := x end - x anf; + INT VAR teile := int (abstand/ 0.4); + REAL VAR verhaeltnis := (y end - y anf) / laenge; + laenge := laenge / (real (2 * teile + 1)); + INT VAR i; + FOR i FROM 0 UPTO teile REP + move (x anf + real (i + i) * laenge, + y anf + verhaeltnis * real (i + i) * laenge); + draw (x anf + real (i + i + 1) * laenge, + y anf + verhaeltnis * real (i + i + 1) * laenge) + END REP . + +abstand : + sqrt ((y end - y anf) + (y end - y anf) + + (x end - x anf) * (x end - x anf)) . + +END PROC strichel; + + +LET myname = "abb.9-2"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000); +*) + diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-3 b/app/eudas/4.4/doc/ref-manual/abb.9-3 new file mode 100644 index 0000000..9b190ab --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.9-3 @@ -0,0 +1,113 @@ +init dgs; +window (0.0, 0.0, 13.5, 7.0); viewport (0.0,0.0,13.5,7.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +x alignment (center); +font size (0.3); font expansion (1.2); +kasten (1.5, 5.0, 2.0, 1.5); +move (2.5, 5.9); draw ("EUDAS-"); +move (2.5, 5.3); draw ("Datei 1"); +move (3.5, 5.75); draw (4.0, 5.75); +kasten (4.0, 5.0, 2.0, 1.5); +move (5.0, 5.9); draw ("gekettete"); +move (5.0, 5.3); draw ("Datei A"); +move (6.0, 5.75); draw (6.5, 5.75); +kasten (6.5, 5.0, 2.0, 1.5); +move (7.5, 5.9); draw ("gekettete"); +move (7.5, 5.3); draw ("Datei B"); +kasten (1.5, 2.0, 2.0, 1.5); +move (2.5, 2.9); draw ("gekoppelte"); +move (2.5, 2.3); draw ("Datei C"); +kasten (4.0, 0.0, 2.0, 1.5); +move (5.0, 0.9); draw ("gekoppelte"); +move (5.0, 0.3); draw ("Datei D"); + +punkt (9.0, 5.75); +punkt (9.25, 5.75); +punkt (9.5, 5.75); + +strichel (1.0, 4.5, 10.0, 4.5); +strichel (1.0, 7.0, 10.0, 7.0); +strichel (1.0, 4.5, 1.0, 7.0); +x alignment (right); font size (0.4); +move (10.0, 3.9); +draw ("Hauptdatei"); + +punkt (2.5, 3.75); +punkt (2.5, 4.0); +punkt (2.5, 4.25); + +punkt (5.0, 1.75); +punkt (5.0, 2.0); +punkt (5.0, 2.25); +punkt (5.0, 2.5); +punkt (5.0, 2.75); +punkt (5.0, 3.0); +punkt (5.0, 3.25); +punkt (5.0, 3.5); +punkt (5.0, 3.75); +punkt (5.0, 4.0); +punkt (5.0, 4.25); + +PROC punkt (REAL CONST x pos, y pos) : + + LET p size = 0.025; + move (x pos, y pos + p size); + draw (x pos + p size, y pos); + draw (x pos, y pos - p size); + draw (x pos - p size, y pos); + draw (x pos, y pos + p size) + +END PROC punkt; + + +PROC strichel (REAL CONST x anf, y anf, x end, y end) : + + REAL VAR laenge := x end - x anf; + INT VAR teile := int (abstand/ 0.4); + REAL VAR senkrecht, verhaeltnis; + IF laenge <> 0.0 THEN + verhaeltnis := (y end - y anf) / laenge; senkrecht := 1.0 + ELSE + verhaeltnis := 1.0; senkrecht := 0.0 ; + laenge := y end - y anf + END IF; + laenge := laenge / (real (2 * teile + 1)); + INT VAR i; + FOR i FROM 0 UPTO teile REP + move (x anf + real (i + i) * laenge * senkrecht, + y anf + verhaeltnis * real (i + i) * laenge); + draw (x anf + real (i + i + 1) * laenge * senkrecht, + y anf + verhaeltnis * real (i + i + 1) * laenge) + END REP . + +abstand : + sqrt ((y end - y anf) * (y end - y anf) + + (x end - x anf) * (x end - x anf)) . + +END PROC strichel; + +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + + +LET myname = "abb.9-3"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-4 b/app/eudas/4.4/doc/ref-manual/abb.9-4 new file mode 100644 index 0000000..e243265 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.9-4 @@ -0,0 +1,98 @@ +init dgs; +window (0.0, 0.0, 13.5, 6.0); viewport (0.0,0.0,13.5,6.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +kasten (2.0, 1.0, 1.4, 2.0); +kasten (3.5, 1.0, 1.4, 2.0); +kasten (6.5, 1.0, 1.4, 2.0); +kasten (2.0, 3.4, 1.4, 2.0); +kasten (5.0, 3.4, 1.4, 2.0); +kasten (6.5, 3.4, 1.4, 2.0); + strichel (3.5, 3.4, 3.5, 5.4); + strichel (3.5, 5.4, 4.9, 5.4); + strichel (4.9, 5.4, 4.9, 3.4); + strichel (4.9, 3.4, 3.5, 3.4); +move (1.9, 2.7); draw (1.5, 2.7); +draw (1.5, 4.6); draw (1.9, 4.6); + +x alignment (center); +font size (0.3); font expansion (1.4); + +move (2.7, 5.6); draw ("22-1"); +move (2.7, 4.9); draw ("X"); +move (2.7, 4.4); draw ("K"); +move (2.7, 2.5); draw ("K"); +move (2.7, 2.0); draw ("N1"); +move (2.7, 0.4); draw ("(114)"); + +move (4.2, 5.6); draw ("22-2"); +move (4.2, 4.9); draw ("X"); +move (4.2, 4.4); draw ("K"); +move (4.2, 2.5); draw ("K"); +move (4.2, 2.0); draw ("N2"); +move (4.2, 0.4); draw ("(209)"); + +move (5.7, 5.6); draw ("23-1"); +move (5.7, 4.9); draw ("Y"); +move (5.7, 4.4); draw ("L"); + +move (7.2, 5.6); draw ("24-1"); +move (7.2, 4.9); draw ("Z"); +move (7.2, 4.4); draw ("M"); +move (7.2, 2.5); draw ("M"); +move (7.2, 0.4); draw ("(17)"); + +font size (0.4); x alignment (normal); +move (8.5, 2.0); draw ("Koppeldatei"); +move (8.5, 4.4); draw ("Hauptdatei"); + +PROC strichel (REAL CONST x anf, y anf, x end, y end) : + + REAL VAR laenge := x end - x anf; + INT VAR teile := int (abstand/ 0.4); + REAL VAR senkrecht, verhaeltnis; + IF laenge <> 0.0 THEN + verhaeltnis := (y end - y anf) / laenge; senkrecht := 1.0 + ELSE + verhaeltnis := 1.0; senkrecht := 0.0 ; + laenge := y end - y anf + END IF; + laenge := laenge / (real (2 * teile + 1)); + INT VAR i; + FOR i FROM 0 UPTO teile REP + move (x anf + real (i + i) * laenge * senkrecht, + y anf + verhaeltnis * real (i + i) * laenge); + draw (x anf + real (i + i + 1) * laenge * senkrecht, + y anf + verhaeltnis * real (i + i + 1) * laenge) + END REP . + +abstand : + sqrt ((y end - y anf) * (y end - y anf) + + (x end - x anf) * (x end - x anf)) . + +END PROC strichel; + +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + + +LET myname = "abb.9-4"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-5 b/app/eudas/4.4/doc/ref-manual/abb.9-5 new file mode 100644 index 0000000..c00655c --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/abb.9-5 @@ -0,0 +1,51 @@ +init dgs; +window (0.0, 0.0, 13.5, 7.0); viewport (0.0,0.0,13.5,7.0); +(*scale (1.7,1.7, 0.0,0.0);*) +(*clear pixels;*) + +kasten (1.5, 0.0, 3.5, 2.0); +kasten (7.0, 0.0, 3.5, 2.0); +kasten (4.0, 4.0, 4.0, 3.0); + kasten (5.0, 5.5, 2.0, 1.0); + +move (3.25, 2.25); draw (4.75, 3.75); + draw (4.5, 3.75); move (4.75, 3.75); draw (4.75, 3.5); + move (3.25, 2.25); draw (3.5, 2.25); + move (3.25, 2.25); draw (3.25, 2.5); +move (8.75, 2.25); draw (7.25, 3.75); + draw (7.5, 3.75); move (7.25, 3.75); draw (7.25, 3.5); + move (8.75, 2.25); draw (8.5, 2.25); + move (8.75, 2.25); draw (8.75, 2.5); + +x alignment (center); +font size (0.4); font expansion (1.4); + +move (3.25, 0.2); draw ("Benutzer A"); +move (8.75, 0.2); draw ("Benutzer B"); +move (6.0, 4.3); draw ("Manager"); +font size (0.3); +move (6.0, 5.6); draw ("Kunden"); + +PROC kasten (REAL CONST x anf, y anf, x l, y l) : + + move (x anf, y anf); + draw (x anf, y anf + y l); + draw (x anf + x l, y anf + y l); + draw (x anf + x l, y anf); + draw (x anf, y anf) + +END PROC kasten; + + +LET myname = "abb.9-5"; +save pixels (myname + ".p"); +FILE VAR f := sequential file (modify, myname + ".p"); +to line (f, 1); insert record (f); +write record (f, "#linefeed (0.8)#"); +insert record (f); write record (f, myname); +to eof (f); insert record (f); write record (f, myname); +to line (f, 1); +(* +pause (9000) +*) + diff --git a/app/eudas/4.4/doc/ref-manual/bildergenerator b/app/eudas/4.4/doc/ref-manual/bildergenerator new file mode 100644 index 0000000..8129476 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/bildergenerator @@ -0,0 +1,25 @@ +PROC starten : + + command dialogue (FALSE); + disable stop; + fetch (name, /"DGS NEC"); + run (name); + save (name + ".p", /"DGS NEC"); + end (myself) + +END PROC starten; + +TEXT VAR name; + +PROC gen (TEXT CONST t) : + + name := t; + begin ("p", PROC starten, a); + TASK VAR a; + WHILE exists (a) REP pause (100) END REP + +END PROC gen; + +gen ("abb.4-2"); +gen ("abb.6-1"); + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.1 b/app/eudas/4.4/doc/ref-manual/eudas.ref.1 new file mode 100644 index 0000000..4ca390a --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.1 @@ -0,0 +1,323 @@ +#type ("prop")##limit (14.0)# +#format# +#page (3)# +#kapitel ("1", "Zustände", "und", "Bedienung")# + + + +#abschnitt ("1.1", "ZUSTÄNDE", "Zustände")# + +EUDAS befindet sich zu jeder Zeit in einem von 11 verschiedenen +Zuständen. Für jeden Zustand ist festgelegt, welche Eingabetasten +benutzt werden können und welche Wirkung sie haben. Bestimmte +Tastenfunktionen führen in einen anderen Zustand. Obwohl für +jeden Zustand andere Tastenkombinationen gültig sind, wird für die +gleiche Funktion in jedem Zustand auch die gleiche Taste oder +Tastenkombination verwendet. + Die wichtigsten Tastenfunktionen eines Zustandes werden in +der #on("i")#Statuszeile#off("i")# am oberen Bildschirmrand angezeigt. + Im folgenden sind alle möglichen Zustände als Übersicht be­ +schrieben. Eine Übersicht der Zustandsübergänge enthält Abb. 1-1. + Zu jedem Zustand wird die entsprechende Statuszeile darge­ +stellt sowie alle möglichen Tastenfunktionen und ihre Bedeutung. + +#bildschirm# +EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv +#text# +_____________________________________________________ + +OBEN Anwahl der nächsthöheren Funktion +UNTEN Anwahl der nächsttieferen Funktion +RECHTS Anwahl des nächsten Menüs zur Rechten +LINKS Anwahl des nächsten Menüs zur Linken +HOP OBEN Anwahl der ersten Funktion +HOP UNTEN Anwahl der letzten Funktion +'1' .. '6' Anwahl des entsprechenden Menüs +LEER Ausführen der gewählten Funktion +'Buchstabe' Ausführen der Funktion mit 'Buchstabe' davor +ESC '?' Hilfestellung zur gewählten Funktion +ESC ESC Eingabe von ELAN-Kommandos + + +#bildschirm# +HILFE: Beenden: ESC q Seite weiter: ESC w Seite zurueck: ESC z +#text# +_____________________________________________________ + +ESC 'w' Blättern zur nächsten Seite +ESC 'z' Blättern zur vorigen Seite +ESC 'q' Verlassen (Rückkehr in alten Zustand) + + +#bildschirm# +AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ? +#text# +_____________________________________________________ + +'x' Auswahl ankreuzen +'o' Ankreuzen rückgängig machen +LEER Ankreuzen und Auswahl sofort verlassen +OBEN Zur nächsten Auswahl nach oben +UNTEN Zur nächsten Auswahl nach unten +HOP OBEN Zur obersten Auswahl bzw. eine Seite zurück +HOP UNTEN Zur untersten Auswahl bzw. eine Seite weiter +HOP RETURN Aktuelle Auswahl wird erste auf der Seite +ESC '1' zur ersten Auswahl +ESC '9' zur letzten Auswahl +ESC 'q' Auswahl verlassen und weitermachen +ESC '?' Hilfe zur Auswahl +HOP 'x' alle freien Wahlen ankreuzen +HOP 'o' alle Kreuze entfernen +ESC 'h' Auswahl und Funktion abbrechen + + +#bildschirm# +EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbrechen: ESC h Hilfe: ESC ? +#text# +_____________________________________________________ + +RECHTS zum nächsten Zeichen +LINKS zum vorigen Zeichen +HOP RECHTS zum letzten Zeichen +HOP LINKS zum ersten Zeichen +RUBOUT Zeichen löschen +RUBIN Einfügemodus umschalten +HOP RUBOUT Rest der Zeile löschen +'Zeichen' Zeichen überschreiben oder einfügen +RETURN Eingabe abschließen und weitermachen +ESC '?' Hilfe zur Eingabe +ESC 'h' Eingabe und Funktion abbrechen +ESC 'z' Auswahl zeigen (falls in Statuszeile aufgeführt) + + +#bildschirm# +FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ? +#text# +_____________________________________________________ + +'j', 'J' Frage bejahen +'n', 'N' Frage verneinen +ESC '?' Hilfe zur Frage +ESC 'h' Frage und Funktion abbrechen + + +#bildschirm# +!!! FEHLER !!! Quittieren: ESC q Hilfe zur Meldung: ESC ? +#text# +_____________________________________________________ + +ESC '?' Hilfe zum Fehler +ESC 'Taste' Fehler quittieren +'Taste' Fehler quittieren + + +#bildschirm# +SATZ ÄNDERN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? +SATZ EINFÜGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? +SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? +#text# +_____________________________________________________ + +ESC OBEN eine Seite zurück blättern +ESC UNTEN eine Seite vor blättern +ESC '?' Hilfe zum Satzeditor +ESC 'p' ganzen Satz merken (nicht bei Suchmuster) +ESC 'g' Satz durch gemerkten ersetzen (nicht bei Such­ + muster) +ESC 'h' Abbruch der Funktion +ESC 'D' Tagesdatum schreiben +ESC 'F' Prüffehler nach Tragen editieren +ESC 'w' Verlassen und mit nächstem Satz erneut aufrufen + (nicht im Suchmuster) +ESC 'z' Verlassen und mit vorigem Satz erneut aufrufen + (nicht im Suchmuster) +ESC RUBIN Rest der Zeile in neue Zeile umbrechen +ESC RUBOUT Rest der Zeile löschen +HOP RUBIN nicht verwenden! +HOP RUBOUT nicht verwenden! +#f2# +Weitere Tasten siehe EUMEL-Benutzerhandbuch (Editor). + + +#bildschirm# +Bitte warten.. +#text# +_____________________________________________________ + +keine Tasten erlaubt (außer SV) + + +#bildschirm# +ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ? +#text# +_____________________________________________________ + +HOP OBEN auf erste Zeile bzw. eine Seite zurück +HOP UNTEN auf letzte Zeile bzw. eine Seite vor +ESC '?' Hilfe zur Übersicht +ESC 'h' Abbruch der Funktion +ESC 'q' Verlassen + + +#bildschirm# +EDITIEREN: Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ? +#text# +_____________________________________________________ + +ESC 'F' Feldnamen anzeigen und auswählen +ESC 'h' Abbruch der Funktion +#f2# +Weitere Tasten siehe EUMEL-Benutzerhandbuch (Editor). + + +#bildschirm# +Gib Kommando: +#text# +_____________________________________________________ + +Tasten siehe EINGABE. + + +#free (18.5)# +#beispiel# +#center#Abb. 1-1 Zustandsübergänge +#text# + + + +#abschnitt ("1.2", "MENÜS", "Menüs")# + +Menüs dienen zur Auswahl von Funktionen. Sie werden am linken +Rand des Bildschirms angezeigt. Welches Menü aktiv ist, wird durch +Markierung des Menünamens in der obersten Bildschirmzeile unter +allen zur Verfügung stehenden Menüs angezeigt. In jedem Menü ist +die zuletzt ausgeführte Funktion ebenfalls markiert. + +#a ("Ausführen von Funktionen")# Zum Ausführen einer bestimmten Funk­ +tion wird mit Hilfe der Cursortasten ein bestimmtes Menü und die +gewünschte Funktion angewählt. Die Funktion wird dann durch +Drücken der Leertaste ausgeführt. Alternativ kann auch der vor der +Funktion stehende Buchstabe gedrückt werden. + Die einzelnen Menüs können auch durch Nummern (1 bis 6) +angewählt werden (absolute Positionierung). + Soll eine andere Taste als die Leertaste zum Ausführen ver­ +wendet werden, so kann dies durch die Prozedur 'ausfuehrtaste' +angegeben werden (s. Abschnitt 10.3). + Funktionen, deren Ausführung augenblicklich nicht möglich +oder nicht sinnvoll ist, werden durch ein vorangestelltes Minuszei­ +chen gekennzeichnet. Sie können zwar angewählt, nicht aber ausge­ +führt werden. + Durch ESC '?' wird ein erläuternder Hilfstext zur gerade ange­ +wählten Funktion angezeigt. Näheres dazu s. Abschnitt 1.4. + Durch ESC ESC kann ein beliebiges ELAN-Kommando eingegeben +und ausgeführt werden. Die Eingabe des Kommandos erfolgt in der +Statuszeile. + + +#abschnitt ("1.3", "AUSWAHL", "Auswahl")# + +Die Auswahlfunktion dient dazu, aus vorhandenen Datei- oder +Feldnamen in bestimmter Reihenfolge auszuwählen. Die einzelnen +Namen werden untereinander aufgelistet. + Vor jedem Namen ist ein 'o' zum Ankreuzen angegeben. Mit den +Cursortasten kann der Cursor vor einen bestimmten Namen positio­ +niert werden. Mit 'x' kann dieser Name dann angekreuzt werden. Das +Ankreuzen kann durch 'o' wieder rückgängig gemacht werden. + Die Reihenfolge des Ankreuzens wird durch vorangestellte +Nummern gekennzeichnet. Die Namen werden von der entsprechenden +Funktion später in genau dieser Reihenfolge verwendet. + Wenn nicht alle Namen auf den Bildschirm passen, kann die +Darstellung gerollt werden. Ein Teil der Überschrift bleibt dabei +stehen; am Anfang und am Ende wird jeweils eine Abschlußzeile zur +Kennzeichnung mitgerollt. + Mit ESC '?' kann eine Hilfestellung abgerufen werden. Mit ESC +'q' wird die Auswahl beendet. Mit ESC 'h' können die Auswahl und +die in Ausführung befindliche Operation abgebrochen werden. + + +#abschnitt ("1.4", "HILFE UND DIALOG", "Hilfe und Dialog")# + +In den meisten Situationen kann durch ESC '?' eine spezifische +Hilfestellung abgerufen werden. Die Anzeige der Hilfsinformation +geschieht im rechten Bildschirmteil. + Die Texte sind seitenweise aufgebaut. Es wird immer eine Seite +angezeigt. Mit ESC 'w' bzw. ESC 'z' kann auf die nächste bzw, vorige +Seite umgeblättert werden. Mit ESC 'q' wird die Hilfestellung wieder +verlassen und die Situation wiederhergestellt, in der die Hilfe auf­ +gerufen wurde. + +#a ("Fragen")# Die meisten Funktionen wickeln zur Eingabe von zusätz­ +lichen Parametern oder zum Stellen von Fragen einen Dialog in der +unteren Schirmhälfte ab. Es gibt zwei Möglichkeiten des Dialogs: +eine Frage oder die Eingabe eines Textes. + Bei einer Frage kann man mit 'j' oder 'n' antworten. Sowohl +große als auch kleine Buchstaben werden akzeptiert. Mit ESC '?' +kann eine Hilfsinformation zu der Frage abgerufen werden. ESC 'h' +bricht die fragende Funktion ab. + +#a ("Eingabe")# Bei der Eingabe eines Textes können die üblichen Opera­ +tionen zum Editieren in einer Zeile verwendet werden. Die Eingabe +wird durch RETURN beendet. Auch hier kann durch ESC '?' eine +Hilfsinformation abgerufen werden. ESC 'h' bricht ebenfalls die fra­ +gende Funktion ab. In einigen Fällen (ersichtlich aus der Statuszei­ +le) kann durch ESC 'z' eine Auswahl der verfügbaren Namen abgeru­ +fen werden. + + +#abschnitt ("1.5", "EDITOR", "Editor")# + +Der EUMEL-Editor wird in EUDAS auf zweierlei Weise aufgerufen. +Zum einen dient er im Satzformular zum Eingeben von Daten und +Suchmustern. Dort wird er als #on("i")#Satzeditor#off("i")# bezeichnet. Da hier die +Feldnamen mit berücksichtigt werden müssen, gibt es einige Unter­ +schiede zum normalen Editor. + An anderen Stellen wird der Editor ohne Änderungen eingesetzt +zum Eingeben von Feldnamen oder Mustern. In diesem Fall finden +Sie die Bedienungshinweise im EUMEL-Benutzerhandbuch. + +#a ("Satzeditor")# Beim Ändern, Einfügen und Eingeben des Suchmusters +wird im EUDAS-Formular der Editor aufgerufen. Das Editorfenster +beschränkt sich auf den rechten Teil des Formulars, der einen Teil +der Überschrift und die Feldinhalte umfaßt. Im Satzeditor können +dann die entsprechenden Inhalte eingegeben bzw. verändert werden. + Rollen unter Beibehaltung der Korrespondenz ist durch ESC +OBEN und ESC UNTEN möglich. Diese Funktionen wirken wie bei der +Anzeige - das Editorfenster wird ebenfalls entsprechend mitgerollt. +Mit ESC '1' kann wie üblich auf die erste, mit ESC '9' auf die letzte +Zeile gesprungen werden. Auch diese Funktionen passen die Feld­ +namen entsprechend an. + Falls die für ein Feld vorgesehenen Zeilen nicht für den Inhalt +ausreichen, kann durch ESC RUBIN eine weitere Zeile für dieses Feld +bereitgestellt werden. ESC RUBIN wirkt wie zweimal HOP RUBIN, die +Korrespondenz mit den Feldnamen bleibt jedoch gewahrt. + Zum Löschen steht ESC RUBOUT zur Verfügung. Es löscht eine +ganze Zeile, aber nur, wenn für dieses Feld noch andere Zeilen zur +Verfügung stehen, wird die Zeile tatsächlich vom Bildschirm ent­ +fernt. Im Normalfall bleibt sonst eine Leerzeile für dieses Feld ste­ +hen. + Ist die Information für ein Feld auf mehrere Zeilen verteilt, so +werden diese Zeilen zur Verarbeitung aneinandergehängt. Gegebe­ +nenfalls wird zwischen zwei Zeilen noch ein Leerzeichen eingefügt. + Der Editor kann wie üblich mit ESC 'q' verlassen werden. ESC +'h' bricht die Funktion ab, ohne die erfolgten Änderungen und Ein­ +gaben zu berücksichtigen. Mit ESC 'w' und ESC 'z' kann das Bearbei­ +ten von mehreren Sätzen beschleunigt werden. Durch diese Tasten­ +kombinationen wird der Editor verlassen und die gleiche Operation +(Ändern/Einfügen) beim nächsten bzw. vorigen Satz wiederholt. + +#a ("Hinweis")# Aus technischen Gründen kann das Editorfenster gegen­ +über den Feldnamen verschoben werden (durch Rollen mit HOP +UNTEN zum Beispiel). Dabei geht die sichtbare Korrespondenz zwi­ +schen Feldnamen und Feldinhalten verloren. Ein solcher Fall wird +durch einen markierten Balken mit entsprechender Meldung ange­ +zeigt. Durch ESC '1' wird das Fenster aber wieder zurechtgerückt. + Aus diesem Grund sollte im Satzeditor auf HOP OBEN und HOP +UNTEN sowie auf RETURN am Ende des Fensters verzichtet werden. +Auch HOP RUBIN und HOP RUBOUT sollten nicht verwendet werden, +weil auf diese Weise die Anzahl der Zeilen verändert wird. Eine +solche Störung kann nicht durch ESC '1' beseitigt werden. Von Hand +müssen die entsprechenden Zeilen wieder gelöscht oder eingefügt +werden. + + + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.10 b/app/eudas/4.4/doc/ref-manual/eudas.ref.10 new file mode 100644 index 0000000..2478130 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.10 @@ -0,0 +1,394 @@ +#type ("prop")##limit (14.0)# +#format# +#page (97)# +#kapitel ("10", "Programmierung", "der", "Menüs")# + + + +#abschnitt ("10.1", "MENÜFORMAT", "Menüformat")# + +EUDAS verwendet drei verschiedene Strukturen zur Benutzerunter­ +stützung: Menü, Auswahl und Hilfestellung. Ein Menü dient zur +Auswahl von Funktionen, eine Auswahl bietet Feld- oder Datei­ +namen an und eine Hilfestellung zeigt einen Informationstext. + Alle diese Strukturen werden aus einer Initialisierungsdatei +eingelesen. Die Initialisierungsdatei ist eine normale Textdatei. Ihr +Format soll in diesem Abschnitt beschrieben werden. + Die Strukturen können in beliebiger Reihenfolge in der Initiali­ +sierungsdatei stehen. Jede Struktur wird durch eine spezielle +Anweisung eingeleitet. Anweisungen beginnen ähnlich wie im +Druckmuster mit einem Prozentzeichen. Dementsprechend gibt es die +drei Anweisungen + +#beispiel# + % MENUE "Name" + % AUSWAHL "Name" + % HILFE "Gebiet/Name" +#text# + +die jeweils eine Struktur einleiten. Beendet wird eine Definition +immer mit + +#beispiel# + % ENDE +#text# + +#a ("Menü")# Für ein Menü wird noch der Text angegeben, der auf dem +Bildschirm erscheinen soll. Er wird durch die Anweisung + +#beispiel# + % BILD +#text# + +eingeleitet. Danach folgen Zeilen mit dem Bildschirminhalt in der +gewünschten Größe (die tatsächliche Anzeigegröße wird erst beim +Aufruf angegeben). Dabei werden die Auswahlpositionen, auf denen +der Cursor sich bewegen kann, durch ein geschütztes Leerzeichen in +Spalte 2 festgelegt. + Nach der Angabe des Bildes muß für jede mögliche Auswahl­ +position noch eine weitere Angabe gemacht werden. Die Auswahl­ +positionen (oder Felder) werden dabei von oben nach unten durch­ +gezählt. Begonnen wird mit der Nummer 1. + Eine Felddefinition hat das Format + +#beispiel# + % FELD nr "Hilfstext" "Tasten" +#text# + +Die Nummer identifiziert das Feld. Der Hilfstext gibt den Namen der +Hilfestellung an, die gezeigt werden soll, wenn auf diesem Feld ESC +'?' gedrückt wird. Die Tasten sind alle Zeichen, die gedrückt werden +können, um dieses Feld direkt auszuführen. + Anschließend an die Felddefinition kann in weiteren Zeilen +noch ein ELAN-Programm folgen, das bei Auswahl des Feldes aus­ +geführt wird. + +#a ("Auswahl")# Für eine Auswahl muß zuerst ein Vorspann angegeben +werden, der immer in den ersten Bildschirmzeilen der Auswahl an­ +gezeigt wird. Dieser wird durch + +#beispiel# + % VORSPANN +#text# + +eingeleitet. Danach folgt das Bild. Das Bild setzt sich aus drei Tei­ +len zusammen. Die erste Zeile, in der ein geschütztes Leerzeichen +vorkommt, bildet den Wiederholungsteil. Diese Zeile wird nachher so +oft wie nötig mit entsprechenden Inhalten wiederholt, wobei das +geschützte Leerzeichen als Bindestrich dargestellt wird, auf dem +sich der Cursor bewegen kann. Die Teile davor und danach werden +jeweils bei Bedarf mitgerollt. + Die Wiederholungszeile darf mehrere geschützte Leerzeichen +enthalten. Die Inhalte werden dann in mehreren Spalten angezeigt. +Zu beachten ist, daß vor einem Trennstrich noch mindestens fünf +Zeichen Platz für eine laufende Nummer bleiben müssen. + +#a ("Hilfe")# Der Name einer Hilfestellung setzt sich aus zwei Teilen +zusammen, die durch einen Schrägstrich getrennt werden. Der erste +Name gibt die Kategorie der Hilfestellung an, der zweite Name den +Einzeltext. Dies dient dazu, die relativ große Zahl der Hilfstexte +überschaubar zu machen. Als Beispiel + +#beispiel# + % HILFE "JA/Allgemein" +#text# + +Eine Hilfestellung besteht einfach aus mehreren Seiten Text. Jede +Seite wird durch die AnweisungQ + +#beispiel# +Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q +#text# + + + + + + + +#beispiel# + +#text# + + + + +Text folgen. + + + + + + + + +hinzugefügt. + + + + + + + + +#proc# + +#endproc# + + + + + +#proc# + +#endproc# + + deutung: + + + + + + + +#proc# + +#endproc# + + + +#proc# + +#endproc# + + + + +#proc# + +#endproc# + + + + +#proc# + + + +#endproc# + + + + +#beispiel# + + + + + + + + + ELSE + + + + + + + +#text# + + + + + + + + + + + + + + + + + + + + + + + + + + + + +selbst. + +#proc# + + + + +#endproc# + + + + + + + + +#f2# + + + + + +#f2# + + + + + + + + + + + + +#f2# + FEHLER: +#f1# + + + +#proc# + + +#endproc# + + + + +#proc# + +#endproc# + + +#f2# + FEHLER: +#f1# + + + + +#proc# + + + +#endproc# + + + + + +#f2# + FEHLER: +#f1# + + + +#proc# + +#endproc# + + + + +#proc# + +#endproc# + + + +#f2# + FEHLER: +#f1# + + + +#proc# + +#endproc# + + + + + + + + + + + + + + + + + + + + + +#proc# + +#endproc# + + + +#proc# +PROC dialog +#endproc# + + + + +#proc# + +#endproc# + + + +#proc# + +#endproc# + + + + +#proc# + + +#endproc# + + + + + + +#proc# + +#endproc# + + + + + den. + + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.11 b/app/eudas/4.4/doc/ref-manual/eudas.ref.11 new file mode 100644 index 0000000..3c555d1 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.11 @@ -0,0 +1,327 @@ +#type ("prop")##limit (14.0)# +#format# +#page (105)# +#kapitel ("11", "Programmierung", "von", "Anwendungen")# + + + +Zur Realisierung eigener EUDAS-Anwendungen mit Hilfe von ELAN- +Programmen gibt es mehrere Möglichkeiten mit zunehmender Lei­ +stungsfähigkeit, aber auch steigender Komplexität und Fehleranfäl­ +ligkeit. In den folgenden Abschnitten werden die drei wesentlichen +Methoden vorgestellt. Sie sollten erst dann eine kompliziertere +Methode in Angriff nehmen, wenn Sie die einfachere beherrschen. + + +#abschnitt ("11.1", "MUSTERPROGRAMME", "Musterprogramme")# + +Die bevorzugte Methode zur Erstellung eigener Anwendungen unter +EUDAS ist die Programmierung von Mustern. EUDAS läßt dies bei +Druckmustern, Kopiermustern und Änderungsmustern zu. + In diesem Fall steuert EUDAS den Ablauf des Programms im +groben automatisch. Die jeweils unterschiedlichen Anweisungen, was +im einzelnen zu tun ist, werden in ELAN programmiert. Aus dem +Muster mit diesen zusätzlichen Anweisungen generiert EUDAS dann +das Programm und führt es mit Hilfe des ELAN-Compilers aus. + +#a ("Vorteile")# Diese Methode hat den Vorteil, daß nur die minimal not­ +wendigen Anweisungen tatsächlich selbst programmiert werden +müssen. Dafür reichen bereits geringe ELAN-Kenntnisse vollkommen +aus. Ein Muster kann relativ schnell erstellt und getestet werden. +Durch den einfachen Aufbau ist auch die Fehlerwahrscheinlichkeit +beim Entwickeln geringer als bei anderen Methoden. + Daneben lassen sich die Musterprogramme jeweils bequem im +Menü durch Angabe des Namens oder durch Ankreuzen ausführen, +also auch durch unbedarfte Benutzer. + +#a ("Nachteile")# Nachteil dieser Methode ist, daß jeweils beim Aufruf das +Programm nochmal neu erzeugt und übersetzt werden muß, da die +Übersetzung auch von der gerade geöffneten Datei abhängt. Dies +stört besonders bei umfangreichen Druckmustern (auf langsamen +Rechnern). + Zum zweiten wird ein umfangreiches Druckmuster auch bald +unübersichtlich, da Strukturierungshilfen für größere Programme +fehlen. Der eigentliche Mustertext ist dann schwer von den zahlrei­ +chen Abkürzungen zu trennen. + Als Abhilfe für diese beiden Nachteile bietet es sich an, um­ +fangreichere Abkürzungen bzw. Ausdrücke eingebettet in ein +ELAN-Paket aus dem Muster herauszunehmen und vorher zu in­ +sertieren. + Dadurch fällt zum einen die ständige Neuübersetzung dieser +Ausdrücke weg, zum anderen ist das eigentliche Muster wieder +überschaubar. Voraussetzung zur Anwendung eines solchen Musters +ist dann jedoch, daß das zugehörige Paket in der jeweiligen Task +bereits vorher übersetzt wurde. + Die nachfolgenden Beispiele zeigen, wie dieses Verfahren in der +Realität aussehen kann. + +#a ("Beispiel 1")# In der Schulverwaltung soll ein Kopier- oder Ände­ +rungsmuster erstellt werden, das die Versetzung am Schuljahresende +realisiert. Angenommen wird eine Datei, die alle Schüler enthält. +Schüler, die nicht versetzt werden, sind vorher im Feld 'Versetzung' +mit einem beliebigen Text gekennzeichnet worden (zum Beispiel +'Nachprüfung' o.ä.). + Die Versetzung kann auf zweierlei Weise erfolgen: zum einen +durch automatische Änderung, wenn die alte Version noch auf einer +Archivdiskette aufgehoben wird, oder durch Kopieren in eine neue +Datei. + Bei beiden Mustern ist die einzige Änderung die Angabe der +neuen Klasse. Daher bietet es sich an, eine Prozedur 'neue klasse' +zu definieren, die als Ergebnis die neue Klasse eines Schülers lie­ +fert. Diese Prozedur kann dann im Änderungsmuster wie folgt ver­ +wendet werden: + +#beispiel# + "Klasse" V neue klasse; +#text# + +Entsprechend läuft die Verwendung im Kopiermuster: + +#beispiel# + "Name" K f ("Name"); + "Vorname" K f ("Vorname"); + "Klasse" K neue klasse; + ... +#text# + +Die Prozedur 'neue klasse' muß dann in einem Paket definiert wer­ +den, das etwa folgendes Aussehen haben könnte (spezifische Ände­ +rungen natürlich möglich): + +#beispiel# + PACKET klassenwechsel DEFINES neue klasse: + + TEXT PROC neue klasse : + + IF f ("Versetzung") = "" THEN + klasse um 1 erhoeht + ELSE + alte klasse ohne zusatz + END IF . + + klasse um 1 erhoeht : + INT CONST alte klasse := int (f ("Klasse")); + IF alte klasse < 9 THEN + "0" + text (alte klasse + 1) + zusatz + ELSE + text (alte klasse + 1) + zusatz + END IF . + + zusatz : + f ("Klasse") SUB 3. + + alte klasse ohne zusatz : + subtext (f ("Klasse"), 1, 2) . + + END PROC neue klasse; + + END PACKET klassenwechsel; +#text# + +Schüler, die versetzt werden, erhalten ihre neue Jahrgangsstufe mit +dem alten Klassenzusatz zugeteilt. Dabei ist darauf zu achten, daß +die Klassen 5 bis 9 eine '0' vorangestellt bekommen, damit die +Sortierung funktioniert. + Schüler, die nicht versetzt werden, behalten ihre alte Jahr­ +gangsstufe, allerdings ohne einen Klassenzusatz, der ihnen an­ +schließend manuell zugewiesen werden muß. + Zur Benutzung muß das oben angegebene Paket in eine Text­ +datei geschrieben und mit dem Kommando 'insert' fest insertiert +werden. + +#a ("Beispiel 2")# Aus einer Datei mit bibliographischen Einträgen sollen +bestimmte Literaturhinweise gedruckt werden. Der Literaturhinweis +soll jeweils als Endlostext umbrochen werden. Dafür müssen in einer +Abkürzung alle Daten verkettet werden. Es sei das folgende ein­ +fache Druckmuster vorgegeben: + +#beispiel# + % WIEDERHOLUNG + % MODUS 3 + [&] &titel + + % ABKUERZUNGEN + &krz : f ("Kurzbez") . (* z.B. "Lew84" *) + &titel : titel lang . +#text# + +Die Prozedur 'titel lang' wird in folgendem Paket definiert: + +#beispiel# + PACKET bibliographie DEFINES titel lang : + + TEXT VAR puffer; (* verringert Heap-Belastung *) + + TEXT PROC titel lang : + + puffer := f ("Name 1"); + puffer CAT ", "; + puffer CAT f ("Vorname 1"); + ggf weitere namen; + titel kursiv; + enthalten in; + erscheinungsort und jahr; + puffer . + + ggf weitere namen: + IF f ("Name 2") <> "" THEN + puffer CAT "; "; + puffer CAT f ("Name 2") + END IF . + + titel kursiv : + puffer CAT " \#on (""i"")\#"; + puffer CAT f ("Titel"); + puffer CAT "\#off (""i"")\#, " . + + enthalten in : + IF f ("in") <> "" THEN + puffer CAT " in: "; + puffer CAT f ("in"); + puffer CAT ", " + END IF . + + erscheinungsort und jahr : + puffer CAT f ("Ort"); + puffer CAT ", "; + puffer CAT f ("Jahr") . + + END PROC titel lang; + + END PACKET bibliographie; +#text# + +Die Puffervariable wird verwendet, um die bei Verwendung des +Operators '+' entstehende Heapbelastung zu verringern. An diese +Variable werden nacheinander alle notwendigen Daten mit den ent­ +sprechenden Trennzeichen angehängt. + Im Druckmuster wird dieser lange Text dann im Modus 3 auf +mehrere Zeilen umbrochen, wobei die Einrückung erhalten bleibt. Die +Druckausgabe kann dann bei Bedarf noch mit 'lineform' bearbeitet +werden, um einen noch besseren Umbruch zu erzielen. + + +#abschnitt ("11.2", "DATEIANWENDUNGEN", "Dateianwendungen")# + +Die zweite Möglichkeit der Programmierung unter EUDAS besteht +darin, ELAN-Programme zu schreiben, die EUDAS-Dateien mit Hilfe +des in Kapitel 6 beschriebenen Datentyps EUDAT manipulieren. Die +Programmierung gestaltet sich ähnlich wie mit FILEs. + +#a ("Vorteile")# Durch dieses Verfahren haben Sie volle Freiheit der Pro­ +grammierung. Da lediglich die Struktur der EUDAS-Dateien als +Datenspeicher verwendet wird, sind sehr viele Anwendungen denk­ +bar. + Außerdem können so beliebig viele Dateien gleichzeitig bear­ +beitet werden. Da die Programme nicht auf die virtuelle Datei zu­ +greifen, ist ein Konflikt mit dem aktuellen Zustand von EUDAS +nahezu ausgeschlossen. + +#a ("Nachteile")# Der Nachteil dieses Verfahrens ist, daß viele Dinge +selbst programmiert werden müssen, so zum Beispiel das Durchgehen +einer Datei. Auch die Hilfsmittel der virtuellen Datei wie Such­ +muster, Koppeln und alle Anwendungen, die auf die virtuelle Datei +zugreifen, stehen nicht zur Verfügung. + +#a ("Beispiel 1")# Die in Abschnitt 6.6 vorgestellte Anwendung als Asso­ +ziativspeicher kann als Beispiel für diese Methode dienen. + +#a ("Beispiel 2")# Eine EUDAS-Datei (zum Beispiel eine Schülerdatei) soll +in mehrere Dateien aufgespalten werden (zum Beispiel klassen­ +weise). Dies kann durch das folgende Beispielprogramm bewirkt +werden: + +#beispiel# + LET + klassenfeld = 3, + quellname = "Schüler", + zielname = "Jahrgang "; + ROW 9 EUDAT VAR ziel; + EUDAT VAR quelle; + SATZ VAR feldnamen; + + quelle oeffnen; + zieldateien einrichten; + auf satz (quelle, 1); + WHILE NOT dateiende (quelle) REP + aktuellen satz kopieren; + weiter (quelle) + END REP . + + quelle oeffnen : + oeffne (quelle, quellname); + feldnamen lesen (quelle, feldnamen) . + + zieldateien einrichten : + INT VAR i; + FOR i FROM 1 UPTO 9 REP + oeffne (ziel (i), zielname + text (i + 4)); + feldnamen aendern (ziel (i), feldnamen) + END REP . + + aktuellen satz kopieren : + SATZ VAR satz; + satz lesen (quelle, satz); + satz einfuegen (ziel (stufe), satz); + weiter (ziel (stufe)) . + + stufe : + TEXT VAR klasse; + feld lesen (satz, klassenfeld, klasse); + int (klasse) - 4 . +#text# + + +#abschnitt ("11.3", "INTEGRIERTE ANWENDUNGEN", "Integrierte Anwendungen")# + +Die schwierigste Möglichkeit, Anwendungen unter EUDAS zu reali­ +sieren, ist ihre Integration. Ein solches Programm greift selbst auf +die virtuelle Datei zu, nutzt die Funktionen von EUDAS so weit wie +möglich und definiert vielleicht sogar ein eigenes Menü. + +#a ("Vorteile")# Auf diese Weise können natürlich alle Möglichkeiten +ausgeschöpft werden. Sie können Programme erstellen, die als eine +natürliche Erweiterung von EUDAS wirken oder EUDAS ganz erset­ +zen. + +#a ("Nachteile")# Eine solche Integration ist aber besonders schwierig, +wenn EUDAS und die Erweiterung nebeneinander benutzt werden +sollen. In diesem Fall hat EUDAS keine komplette Kontrolle der +Interaktion, so daß leicht undefinierte Zustände möglich sind. + Weniger Probleme treten auf, wenn sichergestellt ist, daß nur +die Anwendung selbst verwendet wird. Auch in diesem Fall ist zu +beachten, daß EUDAS nicht als Programmierumgebung für Anwen­ +dungssysteme konzipiert wurde und daher nicht immer leicht zu +benutzen ist. + Am einfachsten ist es noch, nur eigene Menüs für eine andere +Anwendung zu verwenden, da die Menüprozeduren relativ unabhän­ +gig vom Rest sind. + +#a ("Richtlinien")# Bei Erweiterungen von EUDAS sind folgende Richtlinien +zu beachten: +#f2# +1. Ein Programm, das selber Dateien für die virtuelle Datei öffnen + will, sollte vorher prüfen, ob noch eine Datei geöffnet ist und in + diesem Fall abbrechen. Beim Multi-User-Betrieb ist nämlich + sonst nicht gewährleistet, daß alle Sperren wieder entfernt + werden. +#f2# +2. Ein solches Programm sollte seine eigenen Dateien vor dem + Wechsel zu EUDAS selbst wieder sichern und die Arbeitskopien + löschen, damit der Ausgangszustand zu Beginn des Programms + wiederhergestellt wird. +#f2# +3. Programme, die Menüs benutzen, sollten nicht unter EUDAS auf­ + gerufen werden, da sonst eine Beeinflussung der EUDAS-Menüs + möglich ist. +#f2# +An dieser Stelle soll noch einmal von der Erstellung integrierter +Anwendungen abgeraten werden, wenn es auch andere Möglichkeiten +gibt, das gegebene Problem mit EUDAS zu lösen. Der hohe Aufwand +dieser Methode rechtfertigt sich nur in wenigen Fällen. + Experimentierfreudige Anwender werden sich durch diese War­ +nung sowieso nicht abhalten lassen. Ihnen sollte aber bewußt sein, +daß ein solches Vorgehen auf eigene Gefahr stattfindet und kein +Anspruch auf Beratung oder Fehlerbeseitigung in einem solchen Fall +besteht. + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.2 b/app/eudas/4.4/doc/ref-manual/eudas.ref.2 new file mode 100644 index 0000000..bed3bf6 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.2 @@ -0,0 +1,820 @@ +#type ("prop")##limit (14.0)# +#format# +#page (13)# +#kapitel ("2", "Zusammenstellung", "der", "Funktionen")# + + + +Im folgenden finden Sie eine Übersicht über alle Menüfunktionen. Zu +jeder Funktion ist aufgeführt, welche Parameter angegeben werden +müssen. Die Parameter werden als Text erfragt. Bei einigen Funk­ +tionen können alle möglichen Parameterwerte mit ESC 'z' (Zeigen) +als Auswahl abgerufen werden. Bei manchen können in der Auswahl +mehrere Werte angekreuzt werden, die dann nacheinander abgear­ +beitet werden. Welcher Fall zutrifft, ist jeweils aufgeführt. + + +#abschnitt ("2.1", "MENÜ 'ÖFFNEN'", "Menü 'Öffnen'")# + + +#linefeed (0.5)# +#on ("b")#O EUDAS-Datei Öffnen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl +#f2# +Zweck: Stellt eine EUDAS-Datei als aktuelle Arbeitsdatei ein. + Falls eine vorher geöffnete Datei verändert wurde, + wird sie nach Anfrage gesichert. Falls die zu öffnende + Datei noch nicht existiert, kann sie nach Anfrage + eingerichtet werden. Dabei müssen dann die Feld­ + namen angegeben werden. +#f2# + Es wird gefragt, ob die Datei geändert werden soll. In + diesem Fall wird eine Arbeitskopie hergestellt. Fast + alle EUDAS-Funktionen beziehen sich nachher auf die + so eingestellte Datei. +#f2# + Ist ein Mehrbenutzer-Manager eingestellt, kann auch + eine Datei aus dieser Managertask als Parameter + angegeben werden. Die Datei wird dann automatisch + von dort kopiert und eine Sperre im Manager gesetzt, + falls Änderungen vorgenommen werden sollen. +#f2# +Verweise: Abschnitt 3.2 + Benutzerhandbuch Abschnitt 5.1 und 9.1 + + +#linefeed (0.5)# +#on("b")#E EUDAS-Datei Ketten#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Falls bereits eine EUDAS-Datei geöffnet ist, kann eine + weitere Datei gleicher Struktur logisch angekettet + werden. Bei der Bearbeitung werden dann beide Datei­ + en wie eine zusammenhängende Datei behandelt. +#f2# + Die gekettete Datei kann ebenfalls verändert werden, + wenn dies beim Öffnen der ersten Datei angegeben + wurde. Die angegebene Datei kann auch aus einem + Manager stammen. +#f2# +Verweise: Abschnitt 3.2 + Benutzerhandbuch Abschnitt 9.2 + + +#linefeed (0.5)# +#on("b")#K EUDAS-Datei Koppeln#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Falls bereits eine Datei geöffnet ist, kann eine andere + EUDAS-Datei dazugekoppelt werden. Dazu muß min­ + destens das erste Feld der zu koppelnden Datei in der + bereits geöffneten Datei vorkommen. +#f2# + Nach dem Koppeln erscheinen beide Dateien wie eine + Datei. Zu jedem Satz der ersten Datei erscheinen je­ + weils alle Sätze der Koppeldatei, die in dem Koppelfeld + übereinstimmen. +#f2# + Die gekoppelte Datei kann ebenfalls verändert werden, + wenn dies beim Öffnen der ersten Datei angegeben + wurde. Die angegebene Datei kann auch aus einem + Manager stammen. +#f2# +Verweise: Abschnitt 3.3 + Benutzerhandbuch Abschnitt 9.3 und 9.4 + + +#linefeed (0.5)# +#on("b")#S Arbeitskopie Sichern#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Wurde eine EUDAS-Datei geöffnet und verändert, muß + zum Schluß die veränderte Arbeitskopie wieder ge­ + sichert werden. Die Arbeitskopie kann entweder ge­ + löscht werden, die alte Version ersetzen oder unter + einem neuen Namen registriert werden. +#f2# + Für jede veränderte Datei wird zunächst erfragt, ob + die alte Version überschrieben werden soll. Dies ist + der Normalfall. Bei Verneinung dieser Frage muß ein + neuer Name für die Arbeitskopie angegeben werden. +#f2# + Zum Schluß wird erfragt, ob alle Arbeitskopien ge­ + löscht werden sollen (Normalfall: ja). Anderenfalls + bleiben die Dateien weiter geöffnet. +#f2# +Verweise: Abschnitt 3.5 + Benutzerhandbuch Abschnitt 6.4 + + +#linefeed (0.5)# +#on("b")#N Notizen ansehen/ändern#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Zu jeder EUDAS-Datei kann als Notiz ein beliebiger + Text gespeichert werden. Dieser Text der aktuellen + Datei wird mit dieser Funktion im Editor angezeigt + und kann verändert werden, wenn eine Arbeitskopie + angelegt wurde. Anderenfalls werden etwaige Verän­ + derungen einfach ignoriert. +#f2# +Verweise: Abschnitt 3.1 + + +#linefeed (0.5)# +#on("b")#F Feldstruktur ändern#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Mit dieser Funktion können neue Felder an die aktu­ + elle Datei angefügt werden. Außerdem lassen sich + Feldnamen und Feldtypen ändern. Die Feldtypen be­ + stimmen die Behandlung eines Feldes beim Suchen oder + Sortieren (z.B. von Zahlen). +#f2# + Zunächst wird erfragt, ob neue Feldnamen angefügt + werden sollen. Diese können dann im Editor eingege­ + ben werden. Danach wird gefragt, ob Feldnamen oder + Feldtypen geändert werden sollen (neu angefügte + Felder erhalten erst einmal den Typ TEXT). Falls die + Frage bejaht wird, können in einer Auswahl die zu + ändernden Felder angekreuzt werden. Für jedes ange­ + kreuzte Feld werden dann der Name und der Typ zum + Überschreiben angeboten. +#f2# +Verweise: Abschnitt 3.1 + Benutzerhandbuch Abschnitt 11.1 + + +#linefeed (0.5)# +#on("b")#P Prüfbedingungen ansehen/ändern#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Beim Tragen in eine EUDAS-Datei können Bedingungen + für die zu tragenden Sätze überprüft werden. Diese + Bedingungen für die aktuelle Datei können mit dieser + Funktion angezeigt und, falls erlaubt, auch geändert + werden. +#f2# +Verweise: Abschnitt 3.1 und 4.4 + Benutzerhandbuch Abschnitt 11.3 + + +#linefeed (0.5)# +#on("b")#M Mehrbenutzer Manager einstellen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Managertaskname, kein Zeigen +#f2# +Zweck: EUDAS kann beim Öffnen eine Datei von einer anderen + Task des Systems kopieren. Dadurch können mehrere + Benutzer kontrolliert auf die gleiche Datei zugreifen. + Wenn diese Möglichkeit verwendet werden soll, muß + mit dieser Funktion zunächst die in Frage kommende + Managertask angegeben werden. +#f2# +Verweise: Abschnitt 3.7 + Benutzerhandbuch Abschnitt 9.6 + + +#abschnitt ("2.2", "MENÜ 'EINZELSATZ'", "Menü 'Einzelsatz'")# + + +#linefeed (0.5)# +#on("b")#W Weiter#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Geht einen Satz weiter in der aktuellen Datei - falls + eine Suchbedingung eingestellt ist, weiter zum näch­ + sten ausgewählten Satz. +#f2# +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 5.2 + + +#linefeed (0.5)# +#on("b")#Z Zurück#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Geht einen Satz zurück in der aktuellen Datei - falls + eine Suchbedingung eingestellt ist, zurück zum vori­ + gen ausgewählten Satz. +#f2# +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 5.2 + + +#linefeed (0.5)# +#on("b")#N Auf Satz Nr. ..#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Positioniert auf einen bestimmten Satz der aktuellen + Datei, dessen Satznummer eingegeben werden muß, und + zwar unabhängig, ob der Satz durch die Suchbedingung + ausgewählt wird oder nicht. Trifft die eingestellte + Suchbedingung nicht auf den Satz zu, erscheint + 'SUCH-' in der Überschrift. Existiert die eingegebene + Satznummer nicht, positioniert EUDAS hinter den + letzten Satz der Datei. +#f2# +Verweise: Benutzerhandbuch Abschnitt 5.2 + + +#linefeed (0.5)# +#on("b")#S Suchbedingung Setzen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Es kann eine neue Suchbedingung für die aktuelle + Datei eingegeben werden, bzw. eine vorher eingestellte + Suchbedingung wird zum Ändern angeboten. Die Such­ + bedingung wird in Form eines Suchmusters in das + Satzformular geschrieben. +#f2# + Die eingestellte Suchbedingung wird beim Positionieren + und bei allen Bearbeitungsfunktionen beachtet. +#f2# +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 5.3, 5.4 und 10.3 + + +#linefeed (0.5)# +#on("b")#L Suchbedingung Löschen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Die eingestellte Suchbedingung wird wieder gelöscht. +#f2# +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 5.3 + + +#linefeed (0.5)# +#on ("b")#M Markierung umkehren#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Mit dieser Funktion können einzelne Sätze zur späte­ + ren Bearbeitung markiert werden. Falls der aktuelle + Satz bereits markiert ist, wird die Markierung wieder + entfernt, ansonsten wird er markiert. +#f2# + Wenn mindestens ein Satz markiert ist, beachten die + Bearbeitungsfunktionen nur die markierten Sätze. So + kann eine manuelle Auswahl durchgeführt werden. Die + Markierung bleibt nur bis zum Sichern bestehen. Sie + ist keine permanente Eigenschaft einer EUDAS-Datei. +#f2# +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 10.4 + + +#linefeed (0.5)# +#on ("b")#E Datensatz Einfügen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Mit dieser Funktion wird vor dem aktuellen Satz ein + leerer Satz eingefügt, für den anschließend die Feld­ + inhalte im Satzformular eingetragen werden können. +#f2# +Verweise: Abschnitt 3.4 + Benutzerhandbuch Abschnitt 6.2 und 10.2 + + +#linefeed (0.5)# +#on ("b")#A Datensatz Ändern#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Die Inhalte des aktuellen Satzes werden im Satzformu­ + lar zum Ändern angeboten. +#f2# +Verweise: Abschnitt 3.4 + Benutzerhandbuch Abschnitt 6.3 und 10.2 + + +#linefeed (0.5)# +#on ("b")#T Datensatz Tragen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl +#f2# +Zweck: Mit dieser Funktion kann der aktuelle Satz in eine + anderen EUDAS-Datei gleicher Struktur transportiert + werden. In der Zieldatei wird er am Ende angefügt. +#f2# +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 6.3 + + +#linefeed (0.5)# +#on ("b")#H Datensatz Holen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl +#f2# +Zweck: Mit dieser Funktion kann der letzte Satz einer ande­ + ren Datei vor dem aktuellen Satz eingefügt werden, + sofern die Struktur gleich ist. Damit kann ein vorher­ + gegangenes Tragen rückgängig gemacht werden. +#f2# +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 6.3 + + +#linefeed (0.5)# +#on ("b")#F Feldauswahl#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Die Felder der aktuellen Datei werden in einer Aus­ + wahl angeboten. Am Bildschirm werden danach nur die + ausgewählten Felder in der gewählten Reihenfolge + dargestellt. Die Auswahl hat jedoch nur Auswirkung + auf die Darstellung am Bildschirm, anderen Funktionen + stehen nach wie vor alle Felder zur Verfügung. Die + Auswahl gilt bis zum Sichern, sie wird also nicht mit + der Datei abgespeichert. +#f2# +Verweise: Abschnitt 4.1 + Benutzerhandbuch Abschnitt 10.1 + + +#abschnitt ("2.3", "MENÜ 'GESAMTDATEI'", "Menü 'Gesamtdatei'")# + + +#linefeed (0.5)# +#on ("b")#K Satzauswahl Kopieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl + Name Kopiermuster, ohne Zeigen +#f2# +Zweck: Mit dieser Funktion werden die ausgewählten bzw. + markierten Sätze der aktuellen Datei in eine andere + Datei kopiert. Welche Felder kopiert werden sollen und + in welcher Reihenfolge, wird durch ein Kopiermuster + festgelegt. Dieses Kopiermuster kann benannt werden + oder unbenannt nur für ein Mal erstellt werden. Wird + das Kopiermuster neu erstellt, wird ein Standard- + Kopiermuster zum Ändern angeboten. +#f2# +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 11.2 + + +#linefeed (0.5)# +#on ("b")#T Satzauswahl Tragen#off("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: EUDAS-Dateiname, mit Zeigen, eine Wahl +#f2# +Zweck: Transportieren der ausgewählten bzw. markierten + Sätze in eine andere Datei gleicher Struktur. Die Sätze + werden in der Zieldatei am Ende eingefügt. +#f2# +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 11.3 + + +#linefeed (0.5)# +#on ("b")#V Satzauswahl Verändern#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Änderungsmuster, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Bearbeiten der ausgewählten bzw. markierten Sätze + der aktuellen Datei nach Vorgabe einer Änderungs­ + vorschrift. +#f2# +Verweise: Abschnitt 4.4 + Benutzerhandbuch Abschnitt 11.4 + + +#linefeed (0.5)# +#on ("b")#U Übersicht Satzauswahl#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Anzeige aller ausgewählten Sätze in einem Über­ + sichtsformat mit einem Satz pro Bildschirmzeile. Die + Felder, die in der Übersicht angezeigt werden sollen, + können vorher ausgewählt werden. In der Übersicht ist + Blättern und Markieren von Sätzen möglich. +#f2# +Verweise: Abschnitt 4.1 + Benutzerhandbuch Abschnitt 10.5 + + +#linefeed (0.5)# +#on ("b")#S Aktuelle Datei Sortieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Sortieren der aktuellen Datei in beliebiger Reihenfolge + auf- oder absteigend. Zum Sortieren muß eine Ar­ + beitskopie angelegt sein. Die Feldreihenfolge, in der + sortiert werden soll, wird vorher erfragt. +#f2# +Verweise: Abschnitt 4.3 + Benutzerhandbuch Abschnitt 11.1 + + +#linefeed (0.5)# +#on ("b")#L Alle Markierungen Löschen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Löschen aller Markierungen der aktuellen Datei. +#f2# +Verweise: Abschnitt 4.2 + Benutzerhandbuch Abschnitt 10.4 + + +#abschnitt ("2.4", "MENÜ 'DRUCKEN'", "Menü 'Drucken'")# + + +#linefeed (0.5)# +#on ("b")#D Satzauswahl Drucken#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Druckmuster, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Ausdruck des Inhalts der ausgewählten oder markier­ + ten Sätze in druckbarer Form nach Vorgabe eines + Druckmusters. Die Ausgabe kann automatisch zum + Drucker geschickt werden oder erst in einer Datei + zwischengespeichert werden. +#f2# +Verweise: Kapitel 5 + Benutzerhandbuch Abschnitt 7.1 und 7.2 + + +#linefeed (0.5)# +#on ("b")#R Richtung Druckausgabe#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Mit dieser Funktion kann festgelegt werden, ob die + Druckausgabe automatisch zum Drucker geschickt wird, + in eine bestimmte Datei oder in eine automatisch + eingerichtete Datei geschrieben wird. +#f2# + Die Angabe einer bestimmten Datei gilt nur für den + nächsten Druckvorgang. Sie muß also gegebenenfalls + wieder neu eingestellt werden. +#f2# +Verweise: Abschnitt 5.2 + Benutzerhandbuch Abschnitt 7.2 und 12.1 + + +#linefeed (0.5)# +#on ("b")#E Textdatei Editieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Textdatei, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Aufruf des EUMEL-Editors zum Erstellen und Ändern + von Druckmustern und Änderungsmustern sowie zum + Ansehen der Druckausgabe. +#f2# +Verweise: Benutzerhandbuch Abschnitt 7.2 + + +#linefeed (0.5)# +#on ("b")#A Textdatei Ausdrucken#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Textdatei, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Mit dieser Funktion kann eine Textdatei oder die + zwischengespeicherte Ausgabe des Druckens einer + EUDAS-Datei zum Drucker geschickt werden. +#f2# +Verweise: Benutzerhandbuch Abschnitt 7.2 + + +#linefeed (0.5)# +#on ("b")#N Textdatei Nachbearbeiten#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Name Textdatei, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Mit dieser Funktion kann die zwischengespeicherte + Ausgabe des Druckens einer EUDAS-Datei mit den + Textkosmetikprogrammen 'lineform' und 'pageform' + bearbeitet werden. +#f2# +Verweise: Benutzerhandbuch Abschnitt 12.1 + + +#abschnitt ("2.5", "MENÜ 'DATEIEN'", "Menü 'Dateien'")# + + +#linefeed (0.5)# +#on ("b")#U Übersicht Dateien System#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Übersicht über die Dateien im System in der aktuellen + Benutzertask. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#L Datei Löschen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Löschen einer beliebigen Datei in der aktuellen Be­ + nutzertask nach Anfrage. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#N Datei Umbenennen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl + Neuer Name, ohne Zeigen +#f2# +Zweck: Umbenennen einer beliebigen Datei in der aktuellen + Benutzertask. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#K Datei Kopieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl + Zieldateiname, ohne Zeigen +#f2# +Zweck: Anfertigen einer logischen Kopie einer beliebigen + Datei in der aktuellen Benutzertask. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#P Platzbedarf einer Datei#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Zeigt den belegten Speicherplatz einer beliebigen + Datei in der aktuellen Benutzertask. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#linefeed (0.5)# +#on ("b")#A Datei Aufräumen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Reorganisieren einer Textdatei oder einer EUDAS- + Datei, um Platz zu sparen oder den Zugriff zu be­ + schleunigen. Empfiehlt sich bei stark veränderten + oder umsortierten Dateien. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.1 + + +#abschnitt ("2.6", "MENÜ 'ARCHIV'", "Menü 'Archiv'")# + + +#linefeed (0.5)# +#on ("b")#U Übersicht Dateien Archiv#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Übersicht aller Dateien auf der eingelegten Archivdis­ + kette. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#D Archivübersicht Drucken#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Die Archivübersicht wird direkt zum Drucker ge­ + schickt. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#K Datei Kopieren vom Archiv#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Dateiname, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Eine Datei auf der Archivdiskette wird in die aktuelle + Benutzertask kopiert. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#S Datei Schreiben auf Archiv#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Archivname + Dateiname, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Eine Datei aus der aktuellen Benutzertask wird auf + die eingelegte Archivdiskette geschrieben. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#L Datei Löschen auf Archiv#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Archivname + Dateiname, mit Zeigen, mehrfache Wahl +#f2# +Zweck: Löschen einer Datei auf der eingelegten Archivdisket­ + te. Der Platz kann jedoch nicht immer wiederverwendet + werden. +#f2# +Verweis: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#I Archivdiskette Initialisieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: keine +#f2# +Zweck: Mit dieser Funktion kann eine Archivdiskette komplett + gelöscht werden. Die Diskette kann dabei auch gleich­ + zeitig formatiert werden, falls der Rechner dies zu­ + läßt. Das Initialisieren ist notwendig, bevor eine neue + Diskette als Archiv verwendet werden kann. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#Z Zielarchiv einstellen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Managertaskname, ohne Zeigen +#f2# +Zweck: Mit dieser Funktion kann eine Managertask angegeben + werden, die als Ziel der Archivoperationen dient. + Damit können Dateien auch in beliebigen Managertasks + oder über das EUMEL-Netz gesichert werden. +#f2# + Es wird erfragt, ob die angegebene Task ein Archiv­ + manager oder ein gewöhnlicher Dateimanager ist. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#P Paßwort einstellen#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Paßwort +#f2# +Zweck: Mit dieser Funktion kann ein Paßwort eingestellt + werden, das bei der Kommunikation mit allgemeinen + Managertasks überprüft wird. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.2 + + +#linefeed (0.5)# +#on ("b")#R Archivmanager Reservieren#off ("b")# +#linefeed (1.07)# +_____________________________________________________ + +Parameter: Reservierungstext +#f2# +Zweck: Falls als Zielarchiv eine Managertask eingestellt ist, + die zwar kein Archivmanager ist, aber reserviert + werden muß (z.B. 'DOS'), kann die Reservierung mit + dieser Funktion ausgeführt werden. Die Freigabe + erfolgt automatisch beim Verlassen des Menüs. +#f2# +Verweise: Benutzerhandbuch Abschnitt 16.2 + + + +#abschnitt ("2.7", "KURZABFRAGE", "Kurzabfrage")# + +Wird 'eudas' innerhalb des EUMEL-Editors aufgerufen, so wird eine +spezielle Kurzabfrage gestartet. Diese ermöglicht die Übernahme von +Druckdaten direkt in die editierte Datei. + Zunächst wird der Dateiname der zu verwendenden EUDAS- +Datei erfragt. Diese Datei wird dann geöffnet. Vorher geöffnete und +veränderte Dateien werden nach Anfrage gesichert. + Als nächstes kann für die folgende Übersicht eine Feldauswahl +eingestellt werden, damit die relevanten Felder auch auf dem Bild­ +schirm erscheinen. + Danach beginnt ein wiederholbarer Prozeß mit der Eingabe +eines Suchmusters nach Anfrage. Die ausgewählten Sätze werden +dann in einer Übersicht gezeigt. In der Übersicht können auch Sätze +markiert werden. + Nach Verlassen der Übersicht bestehen drei Möglichkeiten zum +Drucken: Falls mindestens ein Satz markiert wurde, können nach +Anfrage alle markierten Sätze gedruckt werden. Wurde kein Satz +markiert, können nach Anfrage alle ausgewählten (bzw. vorher +angezeigten) Sätze gedruckt werden. Wird diese Frage jeweils ver­ +neint, kann nach Anfrage auch der aktuelle Satz als einziger ge­ +druckt werden. + Wurde eine der Fragen bejaht, wird der Name des Druckmusters +erfragt, das bereits existieren muß. Das Ergebnis der Druckausgabe +wird dann an der aktuellen Cursorposition in der editierten Datei +eingefügt. + Der Prozeß kann danach mit einem anderen Suchmuster wieder­ +holt werden. Dabei werden alle Markierungen wieder gelöscht. + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.3 b/app/eudas/4.4/doc/ref-manual/eudas.ref.3 new file mode 100644 index 0000000..77c3fc6 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.3 @@ -0,0 +1,256 @@ +#type ("prop")##limit (14.0)# +#format# +#page (31)# +#kapitel ("3", "Das", "virtuelle", "Dateimodell")# + + + +#abschnitt ("3.1", "DATEISTRUKTUR", "Dateistruktur")# + +Eine EUDAS-Datei hat folgende Bestandteile: + +- 0 bis 5000 #on("i")#Sätze#off("i")#, von 1 an durchnumeriert. Jeder Satz enthält für + jedes Feld einen variabel langen Text als Inhalt, der standard­ + mäßig leer ist. + +- 1 bis 256 #on("i")#Felder#off("i")#, die die Sätze aufteilen. Jedes Feld besitzt einen + #on("i")#Feldnamen#off("i")# als Text und einen von vier #on("i")#Feldtypen#off("i")# (TEXT, ZAHL, + DATUM oder DIN). Der Feldname dient zur Identifizierung des + Feldes, der Feldtyp spezifiziert die Art der Behandlung beim Ver­ + gleichen von Feldern. + +- Drei Zusatztexte. Der erste nimmt die #on("i")#Prüfbedingungen#off("i")# auf, der + zweite speichert das Datum der letzten Veränderung und der + dritte kann allgemeine #on("i")#Notizen#off("i")# aufnehmen. + +- Einen #on("i")#Satzzeiger#off("i")#, der einen bestimmten Satz als aktuellen Satz + auszeichnet. Der Satzzeiger kann durch Positionierungsoperatio­ + nen verändert werden. + +- Eine #on("i")#Sortierreihenfolge#off("i")#, die angibt, in welcher Feldreihenfolge die + Datei zuletzt sortiert worden ist. Dazu für jeden Satz eine Anga­ + be, ob er entsprechend dieser Reihenfolge an der richtigen Posi­ + tion steht. + +- Eine interne Datenstruktur, die beschleunigten Zugriff auf eine + Satz nach dem Inhalt des ersten Feldes ermöglicht. Diese Struktur + steht ganz unter Kontrolle von EUDAS und kann nicht von außen + manipuliert werden. + + +#abschnitt ("3.2", "ÖFFNEN", "Öffnen")# + +#a ("Virtuelle Datei")# Die meisten EUDAS-Funktionen arbeiten nicht +direkt auf einer EUDAS-Datei, sondern auf der sogenannten #on("i")#vir­ +tuellen Datei#off("i")#, die aus mehreren realen Dateien bestehen kann. Die +virtuelle Datei erscheint nach außen hin wie eine einzelne +EUDAS-Datei. Die Operationen auf der virtuellen Datei werden je­ +weils auf die einzelnen Bestandteile abgebildet. + Damit eine EUDAS-Datei Bestandteil der virtuellen Datei wird, +muß sie geöffnet werden. Dieses Öffnen kann auf dreierlei Art und +Weise geschehen. + Das Öffnen der ersten Datei stellt eine neue virtuelle Datei +her. Die Feldnamen und Feldeigenschaften der ersten Datei werden +in der virtuellen Datei übernommen. Dies ist der Normalfall, in dem +sich die virtuelle Datei noch nicht von der zugrundeliegenden Datei +unterscheidet. + Bei diesem ersten Öffnen muß angegeben werden, ob die vir­ +tuelle Datei verändert werden soll oder nicht. Falls die virtuelle +Datei verändert werden soll, wird eine Arbeitskopie aller geöffneten +Dateien angelegt. Die Ursprungsdateien können erst am Ende der +Arbeit mit den geänderten Kopien überschrieben werden. + +#a ("Weitere Dateien")# Weitere Dateien können gekettet oder gekoppelt +werden. Gekettete Dateien werden logisch an die zuerst geöffnete +Datei angehängt. Ihre Dateistruktur wird ignoriert, sollte aber mit +der ersten Datei übereinstimmen. Die Folge aneinander geketteter +EUDAS-Dateien wird als #on("i")#Hauptdatei#off("i")# bezeichnet. + In der Hauptdatei werden die Sätze von 1 an durchnumeriert; +die Aufeinanderfolge der Sätze wird durch die Anordnung der Sätze +in den einzelnen Dateien und die Reihenfolge bestimmt, in der die +Dateien gekettet wurden. + Die gekoppelten Dateien werden der Hauptdatei untergeordnet. +Die in ihnen enthaltenen Informationen werden nur angezeigt, wenn +sie mit einem Satzinhalt der Hauptdatei korrespondieren. Der +Mechanismus dieser Satzkopplung wird im nächsten Abschnitt +beschrieben. + +#beispiel# +#free (8.0)# + +#center#Abb. 3-1 Schematischer Aufbau der virtuellen Datei +#text# + + +#abschnitt ("3.3", "KOPPELN", "Koppeln")# + + Die Sätze der gekoppelten Dateien werden in Relation zu den +Sätzen in der Hauptdatei gesetzt. Zu jedem Satz in der Hauptdatei +kann eine Anzahl von Sätzen aus jeder Koppeldatei gehören. Diese +Sätze müssen in den Inhalten der sogenannten #on("i")#Koppelfelder#off("i")# über­ +einstimmen. + Welche Felder Koppelfelder sind, richtet sich nach den Feld­ +namen. Die ersten Felder der Koppeldatei, die auch in der Haupt­ +datei vorhanden sind, werden als Koppelfelder betrachtet. Die Kop­ +pelfelder müssen also bei der Koppeldatei am Anfang stehen - in +der Hauptdatei kann jedes beliebige Feld ein Koppelfeld sein. + Wenn eine Datei zur virtuellen Datei gekoppelt wird, werden +alle Felder, die nicht Koppelfelder sind, in die virtuelle Datei auf­ +genommen. Die Koppelfelder brauchen nicht noch mal wiederholt zu +werden, da ihr Inhalt ja immer identisch ist. + Zu beachten ist, daß bei diesem Verfahren auch Namenskonflik­ +te entstehen können, wenn nach den Koppelfeldern später wieder +ein Feldname vorkommt, der auch in der Hauptdatei vorhanden ist. +In den Fällen, in denen Felder durch ihren Namen angesprochen +werden, ist dann das zweite Feld gleichen Namens nicht verfügbar. + +#beispiel# +#free (7.0)# + +#center#Abb. 3-2 Schema des Koppelvorgangs +#text# + +#a ("Kombinationen")# Beim Vorwärtsgehen in der virtuellen Datei werden +zu jedem Satz der Hauptdatei nacheinander alle möglichen Kombina­ +tionen der zugehörigen Koppelsätze angezeigt, denn es können +mehrere passende Koppelsätze vorhanden sein. Die Satznummer +bleibt dabei gleich; die einzelnen Kombinationen werden von 1 an +durchgezählt. Beim Rückwärtsgehen wird aus technischen Gründen +immer nur die erste Kombination angezeigt. + Existiert zu einem Satz kein passender Koppelsatz, so bleiben +die entsprechenden Felder leer. Die Koppelsätze müssen in der +ganzen Koppeldatei gesucht werden, daher ist bei großen Koppel­ +dateien die Suchzeit zu berücksichtigen. + + +#abschnitt ("3.4", "ÄNDERUNGEN", "Änderungen")# + +In der virtuellen Datei kann auch geändert werden. Dabei ist jedoch +Vorsicht angebracht. Es muß festgelegt sein, wie Änderungen der +einzelnen Felder auf die beteiligten Dateien abgebildet werden. + Falls die virtuelle Datei keine Koppeldateien enthält, werden +Änderungen am aktuellen Satz an der zugehörigen Datei durchge­ +führt. Das Löschen eines Satzes wird auch direkt in der Datei +durchgeführt. Ein neuer Satz wird immer in der Datei eingefügt, zu +der der aktuelle Satz gehört - am Ende der ersten Datei kann also +kein Satz eingefügt werden, wenn noch weitere Dateien folgen. + Enthält die virtuelle Datei Koppeldateien, werden die Änderun­ +gen in der Hauptdatei wie oben beschrieben durchgeführt. Änderun­ +gen, die Felder in den Koppeldateien betreffen, werden nach folgen­ +der Entscheidungstabelle behandelt: + + 1 2 3 4 5 + --------------- + Koppelfelder verändert N J J N N + Übrige Felder verändert N - - J J + Übrige Felder leer - J N - N + Vorher Koppelsatz vorhanden - - - J N + --------------- + Neuen Satz einfügen x x + Koppelsatz ändern x + Kopplung aktualisieren x + +Fall 1: Es wurden keine Veränderungen an den Feldern des Kop­ + pelsatzes vorgenommen, daher ist auch keine Aktion not­ + wendig. + +Fall 2: Eines der Koppelfelder wurde verändert. Die Änderung wird + in der Hauptdatei durchgeführt. Die übrigen Felder des + Koppelsatzes sind jedoch als leer angegeben. In diesem Fall + wird der Koppelsatz nicht verändert, sondern nur eine + neue Korrespondenz gesucht. + +Fall 3: Eines der Koppelfelder wurde verändert, gleichzeitig ent­ + halten aber auch die anderen Felder Informationen. In + diesem Fall wird ein neuer Satz in der Koppeldatei ange­ + fügt, der die neuen Inhalte enthält. So wird vermieden, + daß an anderer Stelle plötzlich kein passender Koppelsatz + mehr vorhanden ist. + +Fall 4: Nur Felder der Koppeldatei, die nicht Koppelfelder sind, + wurden verändert, außerdem existierte ein korrespondie­ + render Satz in der Koppeldatei. In diesem Fall werden die + Informationen im Koppelsatz abgeändert. + +Fall 5: Wie 4, nur war vorher noch kein Koppelsatz vorhanden + (Felder waren leer). In diesem Fall muß ein neuer Satz in + die Koppeldatei eingefügt werden. Einfügungen in die + Koppeldatei geschehen immer am Dateiende. + +#a ("Einfügen/Löschen")# Beim Löschen eines Satzes der virtuellen Datei +durch Tragen bleiben die Koppeldateien unverändert. Nach dem +Einfügen eines neuen Satzes wird nur dann ein Satz in einer Kop­ +peldatei eingefügt, wenn dieser Satz nicht nur Koppelfelder enthal­ +ten würde. Falls beim Einfügen nur die Koppelfelder angegeben +werden, wird ein korrespondierender Satz in der Koppeldatei ge­ +sucht. Vergleichen Sie hierzu die Regeln beim Ändern. + + +#abschnitt ("3.5", "SICHERN", "Sichern")# + +Falls Änderungen der virtuellen Datei erlaubt sind, arbeitet EUDAS +immer auf Sicherheitskopien der beteiligten Dateien. Eine Datei, die +wirklich verändert wurde, muß vor dem Aufbau einer neuen virtuel­ +len Datei gesichert oder explizit gelöscht werden. + Für jede einzelne Datei kann festgelegt werden, ob sie gesi­ +chert werden soll oder nicht. Als Hilfe wird dazu für jede Datei +angegeben, ob sie tatsächlich verändert wurde oder nicht. Die +Arbeitskopie kann beim Sichern die alte Version überschreiben oder +unter einem neuen Namen gesichert werden. + Am Ende des Sicherns können die Arbeitskopien gelöscht wer­ +den. Anderenfalls werden die Dateien so betrachtet, als ob sie di­ +rekt nach dem Sichern wieder geöffnet worden wären und stehen +weiterhin zur Verfügung. + Falls alle Dateien entweder gesichert oder nicht verändert +sind, werden beim nächsten Öffnen einer neuen virtuellen Datei die +vorherigen Arbeitskopien gelöscht. + + +#abschnitt ("3.6", "UMSCHALTEN AUF KOPPELDATEI", "Umschalten auf Koppeldatei")# + +Falls eine Datei gekoppelt ist, kann man die virtuelle Datei auf +diese Koppeldatei umschalten. Dadurch verhält sich die virtuelle +Datei so, als ob nur diese Koppeldatei geöffnet wäre. Die Einstel­ +lungen der Hauptdatei wie Markierungen und Suchbedingung bleiben +jedoch erhalten und stehen beim Zurückschalten wieder zur Verfü­ +gung. + Die Satzposition der Koppeldatei beim letzten Umschalten wird +ebenfalls gespeichert und wird beim nächsten Umschalten wieder +eingenommen, unabhängig von der tatsächlichen Satzposition der +Koppeldatei zu diesem Zeitpunkt. + Für die Koppeldatei können eigene Markierungen vergeben +werden, die auch nach dem Umschalten gespeichert bleiben. Auch +ein Suchmuster kann für die Koppeldatei eingestellt werden, dies +geht jedoch beim Zurückschalten wieder verloren. Die eingestellte +Feldauswahl für die Bildschirmanzeige geht leider bei jedem Um­ +schalten verloren. + Das Umschalten kann entweder im Menü 'Einzelsatz' oder beim +Einfügen und Ändern durch ESC 'K' bewirkt werden, ebenso das +Zurückschalten nur im Menü 'Einzelsatz'. Beim Umschalten aus Ein­ +fügen oder Ändern erfolgt beim Zurückschalten eine Rückkehr in +diesen Zustand. Dabei können nach Anfrage die Koppelfelder des +aktuellen Satzes der Koppeldatei in die Hauptdatei übernommen und +damit eine bestimmte Kopplung bewirkt werden. + + +#abschnitt ("3.7", "MEHRBENUTZERBETRIEB", "Mehrbenutzerbetrieb")# + +Durch Einstellen einer Managertask für den Mehrbenutzerbetrieb +können auch Dateien dieser Managertask beim Öffnen direkt ver­ +wendet werden. Die Datei wird automatisch aus der Managertask +kopiert und geöffnet. + Falls die Datei geändert werden soll, wird eine Sperre in der +Managertask gesetzt, die verhindert, daß auch ein anderer Benutzer +diese Datei zum Ändern öffnet. Beim Sichern erfolgt dann ein Rück­ +schreiben der Arbeitskopie. Die Sperre wird jedoch erst dann zu­ +rückgesetzt, wenn alle Arbeitskopien gelöscht werden, da erst dann +keine Möglichkeit des Rückschreibens mehr besteht. + Alle Dateien der Managertask werden bei der Dateiauswahl zum +Öffnen mit angeboten. Falls eine Datei in beiden Tasks existiert, +wird die Datei in der Managertask genommen, die Datei der eigenen +Task jedoch erst nach Anfrage überschrieben. + Damit die Sperre funktionieren kann, muß EUDAS in der Mana­ +gertask zur Verfügung stehen und die Task muß #on("i")#nach#off("i")# dem Insertie­ +ren von EUDAS als 'global manager' definiert werden (nicht 'free +global manager' verwenden). + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.4 b/app/eudas/4.4/doc/ref-manual/eudas.ref.4 new file mode 100644 index 0000000..92ec931 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.4 @@ -0,0 +1,421 @@ +#type ("prop")##limit (14.0)# +#format# +#page (39)# +#kapitel ("4", "Ansehen", "und", "Bearbeiten")# + + + +#abschnitt ("4.1", "ANZEIGE", "Anzeige")# + +Die Anzeige und Eingabe von Einzelsätzen sowie die Eingabe von +Suchmustern geschieht in einem Standardformular in einem recht­ +eckigen Fenster. Dieses Fenster befindet sich in der rechten Bild­ +schirmhälfte. + Das Formular besteht aus vier Teilen: der Überschrift, den +Feldnamen, den Feldinhalten und der Abschlußzeile (s. Abbildung). + +#bildschirm# + Überschrift +#free (0.3)# + Satz 33 ..SUCH+..MARK-... datei ............... Feld 1 + Feld 1 + Feld 2 + Feld 3 Feldinhalte + + Feld 4 + .............................................................. +#free (0.3)# + Feldnamen Abschlußzeile + +#text# + +#a ("Überschrift")# Die Überschrift zeigt folgende Informationen an: + + #bsp ("Satz n[-m]")# + Die Satznummer des aktuellen Satzes, bei gekoppelten Dateien + auch die Satzkombination. + + #bsp ("SUCH+/-")# + Zeigt an, ob der aktuelle Satz die eingestellte Suchbedingung + erfüllt oder nicht (wird während Eintragungen nicht angezeigt). + Wenn keine Suchbedingung eingestellt ist, erscheint diese An­ + zeige nicht. + + #bsp ("MARK+/-")# + Zeigt an, ob der aktuelle Satz markiert ist oder nicht (Wird + während Eintragungen nicht angezeigt). Wenn kein Satz mar­ + kiert ist, erscheint diese Anzeige nicht. + + #bsp ("ENDE")# + Wird hinter dem letzten Satz der Datei als Kennzeichnung des + Endesatzes ausgegeben. + + #bsp ("'Dateiname'")# + Gibt den Namen der ersten geöffneten Datei an. + + #bsp ("")# + Erscheint statt des Dateinamens, wenn auf eine Koppeldatei + umgeschaltet wurde. + + #bsp ("Feld n/Zeile n")# + Zeilennummer des obersten angezeigten Feldes (bei Anzeige) + bzw. der aktuellen Cursorzeile (während Eintragungen). + +#a ("Feldteil")# Die Feldnamen sind zur Unterscheidung von den Feld­ +inhalten invers dargestellt. Die Breite der Feldnamen richtet sich +nach der Länge des längsten Feldnamens. Ist dieser zu lang, um +noch eine ordentliche Anzeige zu ermöglichen, wird bei einer be­ +stimmten Länge der Rest des Namens abgeschnitten. + Zwischen dem Feldnamen an der linken Seite und dem dane­ +benstehenden Feldinhalt besteht immer eine Korrespondenz, d.h. der +Inhalt eines Feldes wird direkt neben dem Namen dargestellt. In der +Regel wird pro Feld eine Bildschirmzeile reserviert. Kann der Feld­ +inhalt jedoch nicht mehr in einer Zeile untergebracht werden, wer­ +den weitere Zeilen zur Darstellung dieses Feldes herangezogen. In +diesen Zeilen steht statt des Feldnamens nur ein markierter Leer­ +raum. + Alle folgenden Zeilen ohne Namen gehören zu dem gleichen +Feld. Der Inhalt wird auf diese Zeilen umbrochen, d.h. wenn ein +Wort nicht mehr auf die Zeile paßt, wird es komplett in die nächste +Zeile geschrieben (wie beim Editor). Wörter werden nur dann zer­ +schnitten, wenn sie nicht als Ganzes auf eine Zeile passen. Wörter +werden untereinander durch Leerzeichen getrennt. + Aus Effizienzgründen werden in bestimmten Fällen auch mehr +Folgezeilen als nötig angezeigt. Hat nämlich ein neuer Satz einen +kürzeren Inhalt als der vorige, so werden die Feldnamen nur dann +wieder zusammengerückt, wenn das ganze Bild neugeschrieben wer­ +den muß. Anderenfalls werden nur die Feldinhalte aktualisiert. + Die Bildausgabe wird unterbrochen, wenn 'w' oder 'z' gedrückt +wurde, da dann die Inhalte des aktuellen Satzes nicht mehr inter­ +essieren. + +#a ("Rollen")# Da nicht alle Felder auf den Bildschirm passen müssen, +kann das Bild gerollt werden. + Mit ESC UNTEN wird um eine Seite nach unten geblättert, mit +ESC OBEN wieder zurück. Hinter dem letzten Feld erscheint ein +markierter Balken als Abschlußzeile. Weiter als bis zum Erscheinen +dieses Balken kann nicht gerollt werden. Mit ESC '1' wird ganz an +den Anfang gerollt, mit ESC '9' ganz ans Ende. + Bei Feldern, die sich über mehrere Zeilen erstrecken, kann es +passieren, daß nach dem Rollen die erste Bildschirmzeile nicht die +erste Zeile eines Feldes ist, also der erste Teil eines Feldes nicht +dargestellt wird. Trotzdem wird in diesem Fall in der ersten Anzei­ +gezeile der Feldname angezeigt. + +#a ("Feldauswahl")# Man kann auswählen, welche Felder in welcher Rei­ +henfolge angezeigt werden sollen. Dies dient der besseren Übersicht. +Von der Anzeige werden nur die ausgewählten Felder behandelt, die +anderen Felder bleiben leer, werden nicht verändert oder berück­ +sichtigt. Die Anzeigeauswahl ändert jedoch nichts an der Datei­ +struktur. + Die Feldauswahl ist keine permanente Eigenschaft einer +EUDAS-Datei. Sie geht daher bei einem neuen Öffnen oder beim +Umschalten auf eine Koppeldatei verloren. + +#a ("Übersicht")# Im Gegensatz zur normalen Anzeige, bei der ein Satz pro +Bildschirm dargestellt wird, können in der Übersicht mehrere Sätze +gleichzeitig überschaut werden. Dabei wird jeder Satz in einer Zeile +untergebracht. Die Auswahl der Felder, die in der Übersicht er­ +scheinen sollen, wird vor Beginn der Funktion erfragt. + In jeder Zeile steht die Nummer des jeweiligen Satzes, eine +Anzeige, ob er markiert ist (+) oder nicht (-) und die Feldinhalte +in der gewählten Reihenfolge und Auswahl, jeweils duch Komma und +Leerzeichen getrennt. Inhalte, die nicht mehr auf die Zeile passen, +werden abgeschnitten. + Es werden nur durch das Suchmuster ausgewählte Sätze ange­ +zeigt. Ist der aktuelle Satz nicht ausgewählt, so erscheint an seiner +Stelle #bsp("'<< >>'")# als Hinweis. In der Überschrift sind die Feldnamen +angegeben - durch Komma getrennt, so viele wie hinpassen. + Die Satznummer des aktuellen Satzes ist jeweils markiert. In +der Übersicht kann geblättert werden. HOP OBEN und HOP UNTEN, +OBEN und UNTEN wirken wie im Editor. + Durch '+' oder '-' kann auch die Markierung des aktuellen +Satzes verändert werden. + + +#abschnitt ("4.2", "SATZAUSWAHL", "Satzauswahl")# + +Die Auswahl der Sätze, die gedruckt oder mit den Funktionen aus +Abschnitt 4.4 bearbeitet werden sollen, kann entweder durch eine +Suchbedingung oder durch Markierung vorgenommen werden. Wenn +mindestens ein Satz markiert ist, werden von den Bearbeitungs­ +funktionen nur die markierten Sätze behandelt. Anderenfalls wird +die eingestellte Suchbedingung beachtet. + Die Bildschirmanzeige richtet sich immer nur nach der einge­ +stellten Suchbedingung. + +#a ("Suchmuster")# Ein Suchmuster gibt für jedes Feld bestimmte Bedin­ +gungen an. Es wird im Standardformular mit Hilfe des Satzeditors +eingegeben. Dabei stehen neben jedem Feld die Bedingungen für +dieses Feld in einer intuitiv verständlichen Form. Folgende Einzel­ +bedingungen sind möglich: + + #bsp("Muster")# Inhalt ist gleich Muster + #bsp("Muster..")# Inhalt ist größergleich Muster + #bsp("..Muster")# Inhalt ist kleiner Muster + #bsp("Muster1..Muster2")# Inhalt liegt dazwischen + #bsp("*Muster")# Inhalt endet mit Muster + #bsp("Muster*")# Inhalt beginnt mit Muster + #bsp("*Muster*")# Inhalt enthält Muster + #bsp("*")# Inhalt ist nicht leer + #bsp("++")# Satz markiert (unabhängig vom Feldinhalt) + +Die ersten vier Einzelbedingungen beachten auch den Typ eines +Feldes (wie er bei der Feldstruktur eingegeben werden kann und +beim Sortieren beachtet wird). So werden z.B. bei der Gleichheit von +Zahlen alle nicht-numerischen Zeichen ignoriert (s. Sortieren). + Die drei Bedingungen mit Stern können auch miteinander ver­ +knüpft werden. Die Einzelbedingungen müssen dann alle zutreffen, +damit der Satz ausgewählt wird. So bedeutet zum Beispiel das +Muster #bsp ("'M1*M2*M3*M4'")#, daß das Feld mit 'M1' beginnen und mit 'M4' +enden muß. Außerdem muß es 'M2' und 'M3' enthalten, jedoch nicht +unbedingt in der angegebenen Reihenfolge. + Wird der Mustertext durch '&' und einen gültigen Feldnamen der +aktuellen Datei ersetzt, findet der Vergleich nicht mit einem +Mustertext, sondern mit dem Inhalt des angegebenen Feldes statt. +Als Feldtyp für den Vergleich wird in diesem Fall der Typ des Fel­ +des genommen, in dem der Vergleich steht. + +#a ("Verknüpfung")# Einzelbedingungen können durch Voranstellen von +'--' verneint werden. Einzelbedingungen für verschiedene Felder +werden mit UND verknüpft. + Es gibt zwei Arten der ODER-Verknüpfung: die lokale und die +globale. Die lokale ODER-Verknüpfung wird durch ein Komma zwi­ +schen Einzelbedingungen realisiert. Sie hat eine höhere Priorität als +das UND zwischen verschiedenen Feldern. So hat folgendes Such­ +muster + +#beispiel# + Feld1 Bed1,Bed2 + Feld2 Bed3 +#text# + +die Bedeutung + +#beispiel# + ( Bed1 (Feld1) ODER Bed2 (Feld2) ) UND Bed3 (Feld3) +#text# + +Die globale ODER-Verknüpfung wird durch ein Semikolon repräsen­ +tiert. Alle Einzelbedingungen nach dem n-ten Semikolon aller Zeilen +werden zu einer Alternative zusammengefaßt. Damit hat das Such­ +muster + +#beispiel# + Feld1 Bed1;Bed2 + Feld2 Bed3 +#text# + +die Bedeutung + +#beispiel# + ( Bed1 (Feld1) UND Bed3 (Feld2) ) ODER Bed2 (Feld1) +#text# + +Damit ergibt sich für die Priorität der einzelnen Konstruktionen +folgende Reihenfolge: + + höchste Einzelbedingung + Verkettung von Einzelbedingungen (UND) + Verneinung + lokales ODER + UND zwischen Feldern + niedrigste globales ODER + +#a ("Optimierung")# Wenn für das erste Feld einer Datei eine Gleich- +Bedingung angegeben wurde und keine globale Alternative vorhan­ +den ist, kann der Suchvorgang wegen der Dateistruktur optimiert +werden, indem nur Sätze untersucht werden müssen, die im ersten +Feld den gesuchten Text enthalten. + +#a ("Reservierte Zeichen")# Im Rahmen der Analyse einer Musterzeile +wirken folgende Zeichenfolgen als unbeschränkt reservierte Zeichen: + +#beispiel# + , ; .. * +#text# + +Sie dürfen daher in keinem Mustertext oder Feldnamen vorkommen, +da sie als Separator wirken. Die beiden folgenden Zeichenfolgen +werden nur zu Anfang eines durch die vorstehenden Separatoren +gebildeten Abschnitts erkannt: + +#beispiel# + -- & ++ +#text# + +Sie dürfen daher prinzipiell an weiterer Stelle vorkommen, ohne als +Sonderzeichen erkannt zu werden. Alle anderen Zeichen in der Zeile +werden dem Mustertext bzw. Feldnamen ohne weitere Interpretation +zugeordnet. + + +#abschnitt ("4.3", "SORTIEREN UND REORGANISIEREN", "Sortieren und Reorganisieren")# + +Eine EUDAS-Datei kann in einer beliebigen Feldreihenfolge sortiert +werden. Mit dieser Angabe kann man bestimmen, welche Felder beim +Vergleich zweier Sätze berücksichtigt werden sollen und in welcher +Reihenfolge. + Die Sortierreihenfolge wird in der Datei gespeichert und wird +anschließend immer wieder verwendet, wenn keine anderen Angaben +gemacht wurden. + Der Sortierzustand einer Datei wird ebenfalls gespeichert. Wenn +nur wenige Sätze seit der letzten Sortierung verändert wurden, +müssen auch nur diese Sätze einsortiert werden. + +#a ("Feldtypen")# Um eine korrekte Sortierung auch von Zahlen oder +Daten sicherzustellen, wird jedem Feld einer EUDAS-Datei ein Feld­ +typ zugeordnet, der beim Sortieren (und auch beim Suchen) berück­ +sichtigt wird. + Es gibt folgende Feldtypen (als Standard wird der Typ TEXT +verwendet): + + TEXT Vergleich von Texten nach dem EUMEL-Code der einzel­ + nen Zeichen. Dies ist Standard und sorgt für schnellst­ + möglichen Vergleich. Die weiteren Typen brauchen erheb­ + lich mehr Zeit. + + DIN Vergleich nach DIN 5007 (s. EUMEL-Benutzerhandbuch). + Umlaute werden korrekt eingeordnet, Groß- und Klein­ + buchstaben werden gleichbehandelt, Sonderzeichen werden + ignoriert. + + ZAHL Der Wert einer Zahl wird verglichen. Außer den Ziffern, + dem Dezimalkomma und dem Minuszeichen vor der ersten + Ziffer werden alle anderen Zeichen ignoriert. Das Dezi­ + malkomma ist standardmäßig auf ',' eingestellt, kann aber + verändert werden (s. Abschnitt 6.5). Die nicht ignorierten + Zeichen werden in eine REAL-Zahl umgewandelt und dann + verglichen. + + DATUM Es werden Daten der Form 'tt.mm.jj' verglichen. In diesem + Fall werden Tag und Jahr vertauscht und dann vergli­ + chen. Texte mit einer anderen Länge als 8 werden alle + als gleich betrachtet. + +#a ("Reorganisieren")# Wenn viele Änderungen an einer EUDAS-Datei +vorgenommen worden sind, steigt ihr Platzbedarf durch viele Text­ +leichen an. In diesem Fall empfiehlt es sich, die Datei zu reorgani­ +sieren. Auch wenn beim Sortieren viele Sätze vertauscht wurden, +sollte die Datei reorganisiert werden, da beim Sortieren die physi­ +kalische Reihenfolge der Sätze nicht verändert wird. In diesem Fall +ergibt sich nach dem Reorganisieren ein Geschwindigkeitsvorteil. + + +#abschnitt ("4.4", "BEARBEITEN", "Bearbeiten")# + +#a ("Kopieren")# Durch Kopieren kann ein Ausschnitt aus der virtuellen +Datei in eine andere EUDAS-Datei kopiert werden. Es werden alle +ausgewählten Sätze kopiert. Wenn mindestens ein Satz markiert ist, +werden alle markierten Sätze als ausgewählt betrachtet, ansonsten +alle, die durch die Suchbedingung angegeben sind. Die kopierten +Sätze werden am Ende der Zieldatei angefügt. + Welche Felder kopiert werden sollen, wird durch das Kopier­ +muster angegeben. Hierbei können auch mehrere Felder zu einem +verschmolzen werden. Allgemein ergeben sich die Felder der Ziel­ +datei aus einem beliebigen ELAN-Ausdruck. + Das Kopiermuster ist ein ELAN-Programm und enthält im we­ +sentlichen Ausdrücke der Form + +#beispiel# + "Feldname" K Ausdruck ; +#text# + +Durch diese Anweisung wird der Ausdruck in das Feld der Zieldatei +mit dem angegebenen Namen kopiert. Existiert dieses Feld in der +Zieldatei noch nicht, so wird es als letztes angefügt. Falls die +Zieldatei noch nicht existiert, wird sie eingerichtet. In diesem Fall +bestimmt also die Reihenfolge der 'K'-Ausdrücke die Reihenfolge der +Feldnamen in der Zieldatei. + Da die Reihenfolge der 'K'-Ausdrücke wichtig ist, dürfen diese +nicht in einer IF-Anweisung stehen, sondern müssen für jeden Satz +komplett in der gleichen Reihenfolge ausgeführt werden. + +#a ("Standard-Kopiermuster")# Vor dem Kopieren wird ein Standard- +Kopiermuster zum Editieren angeboten, das sich nach der Zieldatei +richtet. Existiert die Zieldatei noch nicht, wird das Muster so kon­ +struiert, daß alle Felder der virtuellen Datei unverändert kopiert +werden. Wollen Sie einige Felder nicht kopieren, brauchen Sie nur +die entsprechenden Zeilen zu löschen; wollen Sie die Felder in eine +andere Reihenfolge bringen, müssen Sie die Zeilen umordnen. + Existiert die Zieldatei bereits, gibt das Standard-Kopiermuster +an, daß alle Felder der Zieldatei einen Wert erhalten. Ist ein Feld +der Zieldatei in der virtuellen Datei enthalten, so wird dieses ko­ +piert, ansonsten erhält das Feld einen leeren Inhalt. Sie können in +diesem Fall weitere Felder angeben oder für die leeren Felder Aus­ +drücke formulieren. + +#a ("Tragen")# Durch Tragen werden alle ausgewählten Sätze der virtuel­ +len Datei in eine andere Datei transportiert. Sie sind in der vir­ +tuellen Datei dann nicht mehr vorhanden. Damit bei diesem Vorgang +keine Informationen verlorengehen können, muß die Zieldatei so +viele Felder haben wie die virtuelle Datei. Normalerweise sollte sie +in der Feldstruktur mit der virtuellen Datei übereinstimmen. + Die getragenen Sätze werden jeweils am Ende der Datei ange­ +fügt. + Beim Tragen können zusätzlich noch Konsistenzbedingungen +überprüft werden. Die Prüfbedingungen sind in der Zieldatei gespei­ +chert und können beim Ändern der Feldstruktur angegeben werden. + Die Prüfbedingung ist ein ELAN-Programm, das vor dem Tragen +des jeweiligen Satzes ausgeführt wird. Durch spezielle Testprozedu­ +ren kann das Tragen des Satzes verhindert werden, wenn diese +Prozeduren ein negatives Ergebnis liefern. Gleichzeitig wird eine +Meldung in eine Protokolldatei geschrieben, die dann zur Identifi­ +zierung der fehlerhaften Sätze dienen kann. + Folgende Prüfprozeduren stehen zur Verfügung (siehe auch +Abschnitt 8.3): + +#beispiel# + pruefe ("Feldname", Bedingung) +#text# + Hiermit kann eine beliebige Bedingung (BOOL-Ausdruck in + ELAN) überprüft werden. + +#beispiel# + wertemenge ("Feldname", "Wert1,Wert2,...,Wertn") +#text# + Das Feld muß einen in der angegebenen Liste enthaltenen + Werte annehmen. + +#beispiel# + feldmaske ("Feldname", "Maske") +#text# + Das Feld wird auf Übereinstimmung mit der Maske geprüft. + Fünf spezielle Zeichen in der Maske können dabei auf + mehrere Zeichen zutreffen: + '9' alle Ziffern + 'a' alle Kleinbuchstaben, Umlaute, 'ß' + 'A' alle Großbuchstaben, Umlaute + 'X' alle Zeichen + '*' Folge von beliebigen Zeichen + Der Stern sollte sparsam angewendet werden, da er verar­ + beitungsaufwendig ist. + +#beispiel# + eindeutige felder (n) +#text# + Die Zahl 'n' gibt an, die wieviel ersten Felder der Zieldatei + eindeutig sein müssen. Stimmt der zu tragende Satz mit + einem Satz der Zieldatei in diesen Feldern überein, wird + eine Fehlermeldung erzeugt. + +Es können auch einzelne Sätze manuell getragen werden. In diesem +Fall wird die Prüfbedingung nicht getestet. Ebenso kann der Satz +wieder zurückgeholt und in der aktuellen Datei eingefügt werden. + +#a ("Nach Vorschrift ändern")# Die ausgewählten Sätze der virtuellen +Datei können automatisch nach einer Verarbeitungsvorchrift geän­ +dert werden. Die Verarbeitungsvorschrift ist ein ELAN-Programm, in +dem mit Hilfe des Operators 'V' Änderungen angegeben werden: + +#beispiel# + "Feldname" V TEXT-Ausdruck ; +#text# + +Das angegebene Feld erhält den Inhalt, der durch den Ausdruck +angegeben ist. Änderungen an Koppeldateien werden wie im Dialog +behandelt (s. Abschnitt 3.4). + + + + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.5 b/app/eudas/4.4/doc/ref-manual/eudas.ref.5 new file mode 100644 index 0000000..02127a6 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.5 @@ -0,0 +1,415 @@ +#type ("prop")##limit (14.0)# +#format# +#page (49)# +#kapitel ("5", "Drucken", "und", "Druckmuster")# + + + +#abschnitt ("5.1", "DRUCKMUSTERSYNTAX", "Druckmustersyntax")# + +Ein Druckmuster ist eine Beschreibung für die Form, in der die In­ +halte einer EUDAS-Datei ausgedruckt werden sollen. Der syntakti­ +sche Aufbau des Druckmusters ist zeilenorientiert und gehorcht +folgender Syntax: + + Druckmuster : + [ Initialisierungsteil ] + [ Vorspann ] + [ Wiederholungsteil ] + [ Nachspann ] + + Initialisierungsteil : + ( Kommandozeile #char (""124"")# Textzeile )#bsp ("*")# + ( GRUPPE-Anweisung #char(""124"")# Textzeile )#bsp ("*")# + + Vorspann : + VORSPANN-Anweisung Abschnitt + + Wiederholungsteil : + WIEDERHOLUNG-Anweisung Abschnitt + + Nachspann : + NACHSPANN-Anweisung Abschnitt + + Abschnitt : + Musterteil + [ ABKUERZUNGEN-Anweisung Abkürzungsteil ] + + Musterteil : + ( Musterzeile #char(""124"")# Kommandozeile #char(""124"")# + MODUS-Anweisung #char (""124"")# MEHR-Anweisung )#bsp ("*")# + +Zur Notation: [] bedeutet optional, ()#bsp("*")# beliebig häufige Wiederho­ +lung, #char(""124"")# Alternative und keine Angabe einfache Aneinanderreihung. +Die verschiedenen Zeilentypen werden weiter unten beschrieben. + Zusätzlich gilt die Bedingung, daß von Vorspann, Wiederho­ +lungsteil und Nachspann mindestens einer vorhanden sein muß. + +#a ("Zeilentypen")# Im Druckmuster gibt es 6 verschiedene Zeilentypen: + +#on("i")#Kommandozeilen#off("i")# + Eine Kommandozeile beginnt mit '%%' in der ersten und zweiten + Spalte. Der Inhalt der Zeile ab Spalte 3 wird dem ELAN-Compi­ + ler übergeben. Die Bedeutung dieser Zeilen ergibt sich aus dem + in 5.4 beschriebenen Übersetzungsmechanismus. + +#on("i")#Anweisungen#off("i")# + Anweisungen beginnen mit '%' in der ersten Spalte und dienen + zur Steuerung des Druckgenerators. Der Name der Anweisung + muß in Großbuchstaben und ohne Leerzeichen geschrieben + werden. Davor dürfen sich noch Leerzeichen befinden. An­ + schließend können noch Parameter folgen, die nur durch Leer­ + zeichen getrennt aneinander gereiht werden. Die Syntax einer + Anweisung ähnelt der eines Operators in ELAN. + +#on("i")#Textzeilen#off("i")# + Textzeilen sind die nicht anderweitig markierten Zeilen im + Initialisierungsteil. Sie werden unverändert an den Anfang + jeder Druckdatei gestellt. + +#on("i")#Musterzeilen#off("i")# + Musterzeilen sind nicht besonders gekennzeichnete Zeilen im + Musterteil. Sie enthalten Feldmuster und werden nach dem + Einsetzen von Inhalten in die Ausgabedatei übernommen. Die + Interpretation der Musterzeilen wird in Abschnitt 5.3 beschrie­ + ben. + +#on("i")#Abkürzungszeilen#off("i")# + Abkürzungszeilen markieren den Beginn einer Abkürzung im + Abkürzungsteil eines Abschnittes. Sie werden durch '&' in der + ersten Spalte gekennzeichnet. Darauf folgt ohne Zwischenraum + der Name einer Abkürzung (ohne Leerzeichen) und danach + durch Leerzeichen getrennt ein Semikolon. Der Name der Ab­ + kürzung wird bei der Übersetzung durch einen Refinementnamen + ersetzt und die Zeile dem ELAN-Compiler übergeben. Der Rest + der Zeile kann also den Beginn eines werteliefernden Refine­ + ments enthalten. + +#on("i")#Programmzeilen#off("i")# + Programmzeilen sind die nicht durch '&' markierten Zeilen im + Abkürzungsteil. Sie werden unverändert an den ELAN-Compiler + übergeben. Der erlaubte Inhalt richtet sich nach dem Überset­ + zungsmechanismus (5.4). + + +#abschnitt ("5.2", "DER DRUCKVORGANG", "Der Druckvorgang")# + +Der Druckvorgang besteht im wesentlichen darin, daß für alle zu +bearbeitenden Sätze der Wiederholungsteil einmal interpretiert wird +und das Ergebnis in eine Ausgabedatei geschrieben wird, die dann +gedruckt werden kann. Wenn mindestens ein Satz markiert ist, wer­ +den alle markierten Sätze der virtuellen Datei bearbeitet, ansonsten +alle durch die Suchbedingung erfaßten. + +#a ("Gruppen")# Eine #on("i")#Gruppe#off("i")# ist eine Folge von Sätzen, die in einem be­ +stimmten Merkmal übereinstimmen. Durch eine GRUPPE-Anweisung +der Form + +#beispiel# + % GRUPPE n Ausdruck +#text# + +werden aufeinanderfolgende Sätze mit gleichem Wert des angegebe­ +nen Ausdrucks gruppiert. Über die Nummer 'n' kann festgestellt +werden, ob sich das angegebene Merkmal verändert hat. Dies ge­ +schieht mit der Prozedur + +#beispiel# + BOOL PROC gruppenwechsel (INT CONST gruppennr) +#text# + +Immer wenn zwischen zwei Sätzen ein Gruppenwechsel stattfindet, +wird beim vorigen Satz der Nachspann und beim folgenden Satz der +Vorspann einmal interpretiert. Dies führt dazu, daß entsprechende +Vorspann- bzw. Nachspannzeilen gedruckt werden. + Vor dem ersten und nach dem letzten zu bearbeitenden Satz +wechseln alle Gruppen, d.h. dort wird immer ein Vorspann bzw. +Nachspann erzeugt. + Ist ein zu interpretierender Abschnitt nicht vorhanden, so wird +an dieser Stelle keine Ausgabe erzeugt. Die Textzeilen des Initali­ +sierungsteils werden auf jeden Fall bei Beginn des Druckvorganges +in die Ausgabedatei geschrieben. Falls die Ausgabedatei voll ist, +wird eine neue Datei angefangen und die Zeilen des Initialisie­ +rungsteils erneut an den Anfang gestellt. + +#beispiel# + Satz- Gruppen- Ausgabe + nummer merkmal +#free (0.1)# + Initialisierungsteil + ------------------------------------------------- + 1 x Vorspann + WDH-Teil + 2 x WDH-Teil + Nachspann + ------------------------------------------------- + 3 y Vorspann + WDH-Teil + 4 y WDH-Teil + 5 y WDH-Teil + Nachspann + ------------------------------------------------- + ENDE + +#center#Abb. 5-1 Ablauf des Druckvorganges mit Gruppen +#text# + +#a ("Spaltendruck")# Normalerweise werden die Ausgaben der einzelnen +Abschnitte hintereinander in der Ausgabedatei plaziert. Durch An­ +gabe einer Nummer als Parameter in der WIEDERHOLUNG-Anweisung +können auch soviel Spalten wie angegeben nebeneinander gedruckt +werden. Die Spaltenbreite wird dabei durch das Dateilimit (Komman­ +do 'limit' im Editor) festgelegt. Alternativ kann die Spaltenbreite +auch als zweiter Parameter durch Leerzeichen getrennt angegeben +werden. + Vorspann und Nachspann werden jedoch auf jeden Fall wieder +in eine eigene Zeile geschrieben, der Spaltendruck also unterbro­ +chen. + + +#abschnitt ("5.3", "INTERPRETATION VON MUSTERZEILEN", "Interpretation von Musterzeilen")# + +Musterzeilen können Feldmuster enthalten, die bei der Interpreta­ +tion durch entsprechende Inhalte ersetzt werden, ehe die Muster­ +zeile in die Ausgabedatei übernommen wird. Der Beginn eines Feld­ +musters wird durch ein Musterzeichen ('&' oder '%') markiert. Wo +und wie der Inhalt eingesetzt wird, kann durch folgende Variationen +angegeben werden: + +#beispiel# + Typ ! Beispiel ! Position ! Länge ! bündig + ----+-----------+------------------------------ + 1 ! &Name ! fest ! variabel ! links + 2 ! %Name ! variabel ! variabel ! links + 3 ! &Name&&& ! fest ! fest ! links + 4 ! %Name%%% ! variabel ! fest ! links + 5 ! &&&Name& ! fest ! fest ! rechts + 6 ! %%%Name% ! variabel ! fest ! rechts +#text# + +Der in dem Feldmuster angegebene Name muß Name einer Abkür­ +zung in irgendeinem Abkürzungsteil oder eines Feldes sein. Der +Name darf kein Leerzeichen oder Musterzeichen enthalten. Falls dies +doch der Fall ist, muß der Name in spitze Klammern eingeschlossen +werden. + Bei fester Länge wird bei zu kurzem Inhalt mit Leerzeichen +aufgefüllt, bei zu langem Inhalt abgeschnitten. Bei linksbündigem +Einsetzen geschieht dies an der rechten, sonst an der linken Seite. + Feldmuster variabler Länge können je nach Inhalt dazu führen, +daß der folgende Teil der Musterzeile verschoben wird. Für diesen +Einsetzprozeß gelten die folgenden Regeln: + +#a ("Position")# Feldmuster fester Position (mit '&' beginnend) werden +immer in der Position eingesetzt, in der sie stehen. Feldmuster +variabler Position (mit '%' beginnen) können nach rechts verschoben +werden, wenn vorherige Inhalte länger als ihre Muster sind, und +nach links, wenn Modus 1 oder 3 eingestellt ist und vorherige In­ +halte kürzer sind. + +#a ("Länge")# Feldmuster variabler Länge erhalten auf jeden Fall den +Platz, der durch die Länge des Feldmusters reserviert ist. Sind die +Inhalte kürzer, kann der gewonnene Platz als Reserve für andere +Feldmuster verwendet werden; sind die Inhalte länger, so wird der +Inhalt so weit eingesetzt, wie noch Reserve vorhanden ist und der +Rest abgeschnitten. + Muß in ein Feldmuster variabler Länge ein leerer Inhalt einge­ +setzt werden, so werden beim Drucken auch die auf das Feldmuster +folgenden Leerzeichen unterdrückt, falls vor dem Feldmuster noch +ein Leerzeichen steht oder das Feldmuster in Spalte 1 beginnt. + Feldmuster fester Länge werden immer in ihrer reservierten +Länge eingesetzt. Sie werden im folgenden behandelt wie Feldmuster +variabler Länge, deren Inhalt so lang ist wie das Feldmuster. + +#a ("Verteilung")# Die Verteilung der verschiebbaren Feldmuster auf der +Zeile geschieht jeweils in dem Abschnitt zwischen zwei Feldmustern +fester Position bzw. Zeilenanfang oder Zeilenende. Für jeden Ab­ +schnitt wird festgestellt, wieviel Stellen die Inhalte insgesamt mehr +oder weniger als ihre Muster benötigen. + Der Längenausgleich geschieht zwischen dem letzten Feldmuster +und dem Ende des Abschnitts. Dort wird ein Pufferplatz bestimmt, +der bei Überlänge bis auf ein Leerzeichen verkleinert werden kann +und an dem bei Unterlänge zusätzliche Leerzeichen eingefügt wer­ +den. + Außer am Pufferplatz wird an keinem Mustertext des Abschnitts +etwas geändert. Zwischentexte zwischen den Feldmustern werden +unverändert übertragen und mit den umgebenden Feldmustern ver­ +schoben. + Als Pufferplatz wird die erste Lücke hinter dem letzten Feld­ +muster eines Abschnittes verwendet, die mehr als ein Leerzeichen +enthält. Ist keine solche Lücke vorhanden, wird das Ende des Ab­ +schnitts verwendet, falls dort ein Leerzeichen steht, und sonst das +Ende des letzten Feldmusters. + Die durch den Pufferplatz und kürzere Inhalte gewonnene Re­ +serve wird von links an die Feldmuster mit Überlänge verteilt, bis +die Reserve verbraucht ist. + +#a ("Zeilende")# Das Zeilenende wird als ein Quasi-Feldmuster mit fester +Position aufgefaßt, das am Limit der Druckmusterdatei steht. Es +sind also keine Einsetzungen möglich, die über das Limit der Datei +hinausgehen. Als Pufferplatz wird hier jedoch die erste Blanklücke +vom Zeilenende her verwendet, damit Mustertexte am Zeilenende +gegebenenfalls stehenbleiben. Ist keine solche Lücke vorhanden, so +wird das Zeilenende als Pufferplatz verwendet. + Obwohl nicht als Pufferplatz ausgewiesen, kann der Raum zwi­ +schen Zeilenende und Dateilimit als Reserve verwendet werden. + +#a ("Modi")# Der Einsetzmechanismus kann durch die MODUS-Anweisung +mit einem Parameter verändert werden. Folgende Modi stehen zur +Verfügung: + +#beispiel# + Modus ! Effekt + ------+---------------------------------------- + 1 ! Normalmodus. + ! '%'-Feldmuster werden auch + ! nach links geschoben. + ! Keine Zeilenwiederholung. + ------+---------------------------------------- + 2 ! Tabellenmodus. + ! '%'-Feldmuster werden nicht + ! nach links geschoben. + ! Keine Zeilenwiederholung. + ------+---------------------------------------- + 3 ! Normalmodus mit Zeilenwiederholung. + ! '%'-Feldmuster werden auch + ! nach links geschoben. + ! Zeilenwiederholung ohne Zwischentexte. + ------+---------------------------------------- + 4 ! Tabellenmodus mit Zeilenwiederholung. + ! '%'-Feldmuster werden nicht + ! nach links geschoben. + ! Zeilenwiederholung mit Zwischentexten. + ------+---------------------------------------- +#text# + +Bei Zeilenwiederholung werden Inhalte in einer folgenden Zeile +fortgesetzt, falls sie in der ersten Zeile nicht untergebracht werden +konnten. Dazu wird die Musterzeile mit den Restinhalten erneut +interpretiert. Je nach Modus werden auch die Zwischentexte noch +wiederholt. Der Restinhalt umfaßt immer noch das ganze letzte Wort, +das nicht mehr auf die vorige Zeile paßte. Es findet also ein Um­ +bruch statt. Die Positionen, die in der vorigen Zeile vom Anfang des +Wortes eingenommen würden, werden durch Leerzeichen ersetzt. + Durch die MEHR-Anweisung mit einem Parameter kann die Zahl +der Zeilenwiederholungen für die nächste Musterzeile festgesetzt +werden. Dies hat jedoch nur eine Auswirkung, falls Zeilenwieder­ +holung zugelassen ist. Stehen zur Interpretation keine Restinhalte +mehr zur Verfügung, wird mit leeren Inhalten weitergearbeitet. Kann +ein Inhalt bei der vorgegebenen Anzahl von Zeilen nicht ganz dar­ +gestellt werden, wird der Rest nicht ausgegeben. + + +#abschnitt ("5.4", "ANSCHLUSS ZUM ELAN-COMPILER", "Anschluß zum ELAN-Compiler")# + +Falls in einem Druckmuster Abkürzungen, Kommandozeilen oder +Gruppendefinitionen vorkommen, wird das Druckmuster in ein +ELAN-Programm umgewandelt, das dann vom ELAN-Compiler über­ +setzt wird. + Alle Zeilen eines Abkürzungsteils werden direkt in das Pro­ +gramm übernommen, wobei der Name einer Abkürzung durch einen +beliebig gewählten Refinementnamen ersetzt wird ('abk' + eine lau­ +fende Nummer). Alle Abkürzungen und Refinements werden als glo­ +bale Refinements definiert, also außerhalb von Prozeduren. Dadurch +wird erreicht, daß sie an jeder Stelle verwendet werden können. + Damit eine Abkürzung richtig als Refinement übersetzt wird, +muß sie ein TEXT-Objekt als Wert liefern. Die anderen Refinements +sind beliebig, da sie nur in selbstdefinierten Anweisungen verwen­ +det werden. Die Refinements der Abkürzungen werden in einer Zu­ +weisung an eine TEXT-Variable verwendet, damit der Druckgenera­ +tor auf den entsprechenden Wert zugreifen kann. + Jeder Abschnitt wird dagegen als eine Prozedur übersetzt. Eine +Folge von Musterzeilen wird in eine Anweisung übersetzt, diese +Musterzeilen einzusetzen und zu drucken. Eine '%%'-Anweisung wird +einfach unverändert dazwischengeschrieben. Die Prozedur für den +Wiederholungsteil wird einmal für jeden ausgewählten Satz aufgeru­ +fen, die Vorspann- und die Nachspann-Prozedur einmal bei jedem +Gruppenwechsel. + Anweisungen im Initialisierungsteil werden an den Anfang des +Programms als globale Definitionen gestellt. + +#a ("Fehler")# Findet sich in dem erzeugten ELAN-Programm ein Fehler, +der durch den Druckgenerator nicht erkannt werden konnte (z.B. +eine Abkürzung liefert keinen Wert), so muß der ELAN-Compiler +diesen Fehler erkennen. Anschließend zeigt er das erzeugte Pro­ +gramm zusammen mit seinen Fehlermeldungen im Paralleleditor. Sie +müssen nun die Fehlermeldung lokalisieren und anhand der eben +gegebenen Hinweise in das ursprüngliche Druckmuster zurücküber­ +setzen, damit Sie dort den Fehler korrigieren können. + + +#abschnitt ("5.5", "FEHLERMELDUNGEN", "Fehlermeldungen")# + +Folgende Fehlermeldungen können bei der Übersetzung eines Druck­ +musters auftreten: + +#on("i")#keine schliessende Klammer in Feldmuster#off("i")# + Wenn der Name in einem Feldmuster in spitze Klammern einge­ + schlossen werden soll, muß noch in der gleichen Zeile eine + schließende Klammer vorhanden sein. + +#on("i")#kein Kommando in Kommandozeile#off("i")# + Eine Zeile, die mit '%' beginnt, enthält keinen weiteren Text. + +#on("i")#unbekanntes Kommando#off("i")# + Das erste Wort in einer Kommandozeile ist kein bekanntes Kom­ + mando. + +#on("i")#kein % WIEDERHOLUNG gefunden#off("i")# + Das Druckmuster enthält keine Anweisung, die den Beginn eines + Abschnittes markiert. Es muß aber mindestens ein Abschnitt + vorhanden sein. + +#on("i")#nur GRUPPE-Anweisung erlaubt#off("i")# + Im Initialisierungsteil ist nur die GRUPPE-Anweisung erlaubt. + +#on("i")#keine ELAN-Anweisung im Initialisierungsteil nach Gruppen­ +definition#off("i")# + Sobald im Initialisierungsteil eine GRUPPE-Anweisung aufgetreten + ist, ist keine Kommandozeile mehr möglich. + +#on("i")#illegale Gruppennummer#off("i")# + In einer GRUPPE-Anweisung wurde eine zu große Nummer angege­ + ben. Gruppen sollten von 1 an durchnumeriert werden. + +#on("i")#diese Gruppe wurde schon definiert#off("i")# + Eine Gruppennummer wurde mehrfach verwendet. + +#on("i")#diese Abkürzung ist nicht definiert#off("i")# + Ein Name in einem Feldmuster tritt nicht als Feld-oder Abkür­ + zungsname auf. Eventuell enthält er ein Leerzeichen! + +#on("i")#dieser Abschnitt wurde schon einmal definiert#off("i")# + Kein Abschnitt kann mehrmals angegeben werden. + +#on("i")#falscher Modus#off("i")# + In einer MODUS-Anweisung wurde ein nicht definierter Modus als + Parameter angegeben. + +#on("i")#diese Anweisung darf im Musterteil nicht vorkommen#off("i")# + +#on("i")#im Abkürzungsteil darf keine Anweisung auftreten#off("i")# + +#on("i")#in dieser Zeile stehen zu viele Feldmuster#off("i")# + Es können maximal 24 Feldmuster in einer Zeile stehen. Abhilfe: + mehrere Feldmuster durch eine Abkürzung zusammenfassen. + +#on("i")#das Druckmuster enthält zu viele Feldmuster#off("i")# + Die Gesamtanzahl der Feldmuster ist begrenzt. Abhilfe: mehrere + Feldmuster durch eine Abkürzung zusammenfassen. + +#on("i")#nach dem "&" soll direkt der Name einer Abkürzung folgen#off("i")# + In einer Abkürzungszeile stehen Leerzeichen hinter dem '&'. + +#on("i")#kein Doppelpunkt nach Abkürzung#off("i")# + Nach dem Abkürzungsnamen in einer Abkürzungszeile muß durch + ein Leerzeichen getrennt ein Doppelpunkt folgen. + +#on("i")#Abkürzung mehrfach definiert#off("i")# + Die Abkürzung wurde unter dem gleichen Namen schon einmal, + vielleicht in einem anderen Abschnitt, definiert. + +#on("i")#das Druckmuster enthält zu viele Abkürzungen#off("i")# + Abhilfe: mehrere Abkürzungen zu einem Ausdruck zusammenfas­ + sen. + + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.6 b/app/eudas/4.4/doc/ref-manual/eudas.ref.6 new file mode 100644 index 0000000..92c7610 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.6 @@ -0,0 +1,466 @@ +#type ("prop")##limit (14.0)# +#format# +#page (61)# +#kapitel ("6","Struktur","von","EUDAS-Dateien")# + + + +EUDAS-Dateien können unabhängig von EUDAS über den Daten­ +typ EUDAT manipuliert werden. Die zur Verfügung stehenden Zu­ +griffsoperationen sind in diesem Kapitel beschrieben. + Der Datentyp EUDAT ist analog zum Datentyp FILE. Jede +EUDAT-Variable kann an eine EUDAS-Datei angekoppelt werden. +Dadurch lassen sich beliebig viele EUDAS-Dateien gleichzeitig be­ +arbeiten. Wie der Abschnitt 6.6 zeigt, sind so auch ganz andere +Anwendungen realisierbar. + Die wesentlichen EUDAS-Funktionen (Ansehen, Suchen, Druk­ +ken) können jedoch nicht direkt auf EUDAT-Variablen angewendet +werden, sondern greifen auf die virtuelle Datei zu, die im nächsten +Kapitel beschreiben wird. + + +#abschnitt ("6.1", "DER DATENTYP SATZ", "Der Datentyp SATZ")# + +Der Datentyp SATZ stellt einen einzelnen EUDAS-Satz dar, der +intern als TEXT realisiert ist. Ein SATZ besteht aus bis zu 256 +Feldern, die jeweils einen TEXT enthalten können. Nach dem Initi­ +alisieren sind alle Felder mit "" vorbelegt. Die Felder können über +Nummern von 1 bis 256 angesprochen werden. + Damit kann man sich einen SATZ als dynamisches ROW n TEXT +vorstellen, das bis zu 256 Elemente haben kann. Anders als ein +entsprechendes ROW belegt ein leerer SATZ praktisch keinen Spei­ +cherplatz. + Folgende Zugriffsprozeduren stehen zur Verfügung: + +#proc# +TYPE SATZ + +OP := (SATZ VAR, SATZ CONST) + +PROC satz initialisieren (SATZ VAR) +#endproc# + Jeder SATZ muß vor Benutzung initialisiert werden. + +#proc# +INT PROC felderzahl (SATZ CONST) +#endproc# + Liefert die Nummer des höchsten belegten Feldes. + +#proc# +PROC feld lesen (SATZ CONST, INT CONST feldnr, + TEXT VAR inhalt) +#endproc# + Liest den Inhalt des Feldes 'feldnr' in 'inhalt'. +#f2# + FEHLER: +#f2# + #on("i")#n ist keine Feldnummer#off("i")# + 'n' liegt außerhalb des Bereiches 1..256. + +#proc# +PROC feld bearbeiten (SATZ CONST, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) +#endproc# + Ruft 'bearbeite' auf, wobei 'bearbeite' ein Text und zwei Posi­ + tionen in diesem Text übergeben werden. Die Positionen geben + das erste und das letzte Zeichen des durch 'feldnr' ausgewähl­ + ten Feldes an. Ist der Anfang größer als das Ende, so ist das + Feld leer. +#f2# + FEHLER: +#f2# + #on("i")#n ist keine Feldnummer#off("i")# + 'n' liegt außerhalb des Bereiches 1..256. + +#proc# +PROC feld aendern (SATZ VAR, INT CONST feldnr, + TEXT CONST inhalt) +#endproc# + Schreibt 'inhalt' in das Feld mit der Nummer 'feldnr' +#f2# + FEHLER: +#f2# + #on("i")#n ist keine Feldnummer#off("i")# + 'n' liegt außerhalb des Bereiches 1..256. + +#proc# +INT PROC feldindex (SATZ CONST, TEXT CONST muster) +#endproc# + Falls eines der Felder 'muster' enthält, wird die Nummer dieses + Feldes geliefert, sonst 0. + + +#abschnitt ("6.2","DER DATENTYP EUDAT","Der Datentyp EUDAT")# + +Der Datentyp EUDAT muß ähnlich wie ein FILE an einen benann­ +ten oder unbenannten Datenraum angekoppelt werden. Der Daten­ +raum hat anschließend den Typ 3243. Weitere Zugriffe auf eine +EUDAT-Variable sind erst nach erfolgtem Ankoppeln zulässig. An­ +derenfalls können undefinierte Fehler entstehen. + +#proc# +TYPE EUDAT + +PROC oeffne (EUDAT VAR, TEXT CONST dateiname) +#endproc# + Koppelt die EUDAT-Variable an die EUDAS-Datei mit dem + Namen 'dateiname' an. Die Datei wird eingerichtet, falls sie + noch nicht existiert. +#f2# + FEHLER: +#f2# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Die angegebene Datei hat nicht den Typ 3243. + +#proc# +PROC oeffne (EUDAT VAR, DATASPACE CONST ds) +#endproc# + Koppelt die EUDAT-Variable an den Datenraum 'ds'. +#f2# + FEHLER: +#f2# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Der Datenraum wurde bereits verwendet und hat nicht den Typ + 3243. + +Eine EUDAS-Datei ist in Felder und Sätze unterteilt. Die Felder +werden beim Zugriff über Nummern angesprochen. Jedem Feld ist +jedoch zur Identifikation ein TEXT als Feldname zugeordnet. Die +Feldnamen werden als SATZ gespeichert, wobei jedes Feld seinen +zugeordneten Namen enthält. + +#proc# +INT PROC felderzahl (EUDAT CONST) +#endproc# + Liefert Anzahl der benannten Felder. Ist zu Anfang 0. + +#proc# +PROC feldnamen aendern (EUDAT VAR, + SATZ CONST neue namen) +#endproc# + Setzt die Feldnamen einer Datei. Ist 'felderzahl (neue namen)' + größer als die Felderzahl der Datei, so wird die Felderzahl der + Datei entsprechend heraufgesetzt. + +#proc# +PROC feldnamen lesen (EUDAT CONST, SATZ VAR namen) +#endproc# + Liefert alle Feldnamen in einer SATZ-Variablen. + +Eine EUDAS-Datei enthält drei zusätzliche Notiztexte. Zwei davon +sind bereits reserviert, und zwar: +#free (0.2)# + 1: Prüfbedingungen + 2: Datum der letzten Änderung +#f2# +Der dritte kann für freie Notizen verwendet werden. + +#proc# +PROC notizen lesen (EUDAT CONST, INT CONST notiz nr, + TEXT VAR notizen) +#endproc# + Schreibt die Notizen der EUDAS-Datei in 'notizen' ('notiz nr' = + 1,2,3). + +#proc# +PROC notizen aendern (EUDAT VAR, INT CONST notiz nr, + TEXT CONST notizen) +#endproc# + Ändert die Notizen. Alte Notizen werden dabei überschrieben + ('notiz nr' = 1,2,3). + + +#abschnitt ("6.3", "SATZPOSITION", "Satzposition")# + +Eine EUDAS-Datei läßt sich sequentiell vorwärts und rückwärts +bearbeiten. Dazu gibt es eine aktuelle Satzposition. Ein bestimmter +Satz kann auch direkt angesprungen werden. Die Prozeduren, die +nach dem Inhalt des ersten Feldes suchen, arbeiten besonders +schnell, da die entsprechenden Sätze über eine Hashmethode gefun­ +den werden. + +#proc# +INT PROC satznr (EUDAT CONST) +#endproc# + Liefert aktuelle Satzposition. + +#proc# +INT PROC saetze (EUDAT CONST) +#endproc# + Liefert Anzahl der Sätze. + +#proc# +BOOL PROC dateiende (EUDAT CONST) +#endproc# + Liefert TRUE, wenn 'satznr' groesser als 'saetze' ist. Die letzte + erreichbare Satzposition liegt um eins hinter dem letzten Satz + (um auch am Ende anfügen zu können). + +#proc# +PROC auf satz (EUDAT VAR, INT CONST satznr) +#endproc# + Positioniert auf den gewünschten Satz. Bei nicht existierenden + Sätzen wird auf den ersten bzw. hinter den letzten Satz ge­ + sprungen. + +#proc# +PROC weiter (EUDAT VAR) +#endproc# + Geht einen Satz weiter, jedoch nicht über das Dateiende hinaus. + +#proc# +PROC zurueck (EUDAT VAR) +#endproc# + Geht einen Satz zurück, falls der erste Satz noch nicht erreicht + ist. + +#proc# +PROC auf satz (EUDAT VAR, TEXT CONST muster) +#endproc# + Positioniert auf den ersten Satz, der als erstes Feld 'muster' + enthält, anderenfalls hinter den letzten Satz. + +#proc# +PROC weiter (EUDAT VAR, TEXT CONST muster) +#endproc# + Geht weiter, bis das erste Feld 'muster' enthält, bzw. bis hinter + den letzten Satz. + +#proc# +PROC zurueck (EUDAT VAR, TEXT CONST muster) +#endproc# + Geht zurück, bis das erste Feld 'muster' enthält, bzw. auf den + ersten Satz der EUDAS-Datei. + + +#abschnitt ("6.4", "SATZZUGRIFFE", "Satzzugriffe")# + +Der aktuelle Satz ist ein SATZ-Objekt. Auf die Felder des aktuellen +Satzes kann direkt zugegriffen werden. + +#proc# +PROC feld lesen (EUDAT CONST, INT CONST feldnr, + TEXT VAR inhalt) +#endproc# + Wirkt wie 'feld lesen' auf den aktuellen Satz. + +#proc# +PROC feld aendern (EUDAT VAR, INT CONST feldnr, + TEXT CONST inhalt) +#endproc# + Wirkt wie 'feld aendern' auf den aktuellen Satz. + +#proc# +PROC feld bearbeiten (EUDAT CONST, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) +#endproc# + Wirkt wie 'feld bearbeiten' auf den aktuellen Satz. + +Der aktuelle Satz kann auch als Ganzes bearbeitet werden. + +#proc# +PROC satz lesen (EUDAT CONST, SATZ VAR satz) +#endproc# + Liefert den aktuellen Satz. + +#proc# +PROC satz aendern (EUDAT VAR, SATZ CONST satz) +#endproc# + Ersetzt den aktuellen Satz durch 'satz'. + +#proc# +PROC satz einfuegen (EUDAT VAR, SATZ CONST satz) +#endproc# + Fügt 'satz' vor dem aktuellen Satz ein. +#f2# + FEHLER: +#f2# + #on("i")#EUDAS-Datei voll#off("i")# + Eine EUDAS-Datei faßt mindestens 5000 Sätze. + +#proc# +PROC satz loeschen (EUDAT VAR) +#endproc# + Löscht den aktuellen Satz. + + +#abschnitt ("6.5", "SORTIEREN UND REORGANISIEREN", "Sortieren und Reorganisieren")# + +Zum Sortieren können für die einzelnen Felder Typen angegeben +werden, damit auch Zahlen und Daten richtig sortiert werden kön­ +nen. Außerdem kann die Feldreihenfolge angegeben werden, nach +der sortiert werden soll. + +#proc# +PROC feldinfo (EUDAT VAR, INT CONST feldnr, info) +#endproc# + Setzt den Feldtyp des Feldes 'feldnr'. Es bedeuten + -1 : normaler Text (Standard) + 0 : Text nach DIN. Ziffern und Sonderzeichen werden igno­ + riert. Groß-und Kleinbuchstaben gelten gleich. Umlaute + werden beachtet. + 1 : Zahl (beim Vergleich werden alle Zeichen außer Zif­ + fern ignoriert). + 2 : Datum. Es werden Daten der Form "tt.mm.jj" vergli­ + chen. + +#proc# +INT PROC feldinfo (EUDAT CONST, INT CONST feldnr) +#endproc# + Der Feldtyp des angegebenen Feldes wird geliefert. Zu Anfang + ist -1 voreingestellt. + +#proc# +INT PROC unsortierte saetze (EUDAT CONST) +#endproc# + Liefert die Anzahl von Sätzen, die seit dem letzten Sortiervor­ + gang geändert wurden. Bei einer neuen Datei, die noch nie + sortiert wurde, wird immer 0 geliefert. + +#proc# +PROC dezimalkomma (TEXT CONST komma) +#endproc# + Stellt das Dezimalkomma ein, das beim Vergleich von Zahlen + gelten soll. +#f2# + FEHLER: +#f2# + #on("i")#Nicht erlaubtes Dezimalkomma#off("i")# + Nur Texte der Länge 1 sind zugelassen. + +#proc# +TEXT PROC dezimalkomma +#endproc# + Liefert das eingestellte Dezimalkomma ("," ist voreingestellt). + +#proc# +PROC sortiere (EUDAT VAR, TEXT CONST reihenfolge) +#endproc# + Sortiert die Datei in der von 'reihenfolge' angegebenen Reihen­ + folge. Dabei enthält 'reihenfolge' an der Stelle #bsp ("2*i+1")# den Code + der Feldnummer, die als i-te in der Sortierung berücksichtigt + werden soll. Das Zeichen an der Stelle #bsp ("2*i")# gibt an, ob das Feld + mit der davorstehenden Feldnummer aufsteigend ('+') oder + absteigend ('-') sortiert werden soll. + +#proc# +PROC sortiere (EUDAT VAR) +#endproc# + Sortiert die Datei in der zuletzt eingestellten Reihenfolge. + Wurde noch keine Reihenfolge angegeben, wird die Datei in der + Feldreihenfolge sortiert. + +#proc# +TEXT PROC sortierreihenfolge (EUDAT CONST) +#endproc# + Liefert die zuletzt eingestellte Reihenfolge. Wurde noch nicht + sortiert, so wird "" geliefert. + +Nach umfangreichen Änderungen an einer EUDAS-Datei ist eine +Reorganisation sinnvoll, um "Textleichen" zu beseitigen. + +#proc# +PROC reorganisiere (TEXT CONST dateiname) +#endproc# + Die EUDAS-Datei mit dem Namen 'dateiname' wird reorgani­ + siert. + + +#abschnitt ("6.6", "EUDAS-DATEIEN ALS ASSOZIATIVSPEICHER", "EUDAS-Dateien als Assoziativspeicher")# + +In diesem Abschnitt soll ein Beispiel erläutert werden, in dem +EUDAS-Dateien unabhängig von EUDAS für einen ganz anderen +Zweck benutzt werden. Das folgende kurze Paket soll ein Abkür­ +zungsverzeichnis realisieren, das auf einer EUDAS-Datei basiert. + +#beispiel# + PACKET abkuerzungsverzeichnis + DEFINES + verzeichnis laden, + abkuerzung einfuegen, + abkuerzung aendern, + abkuerzung loeschen, + langform : + + EUDAT VAR verz; + SATZ VAR satz; + TEXT VAR inhalt; + + PROC verzeichnis laden (TEXT CONST dateiname) : + + oeffne (verz, dateiname) + + END PROC verzeichnis laden; + + PROC abkuerzung einfuegen (TEXT CONST abk, lang) : + + auf satz (verz, abk); + IF NOT dateiende (verz) THEN + errorstop ("Abkürzung existiert bereits") + ELSE + satz initialisieren (satz); + feld aendern (satz, 1, abk); + feld aendern (satz, 2, lang); + satz einfuegen (satz) + END IF + + END PROC abkuerzung einfuegen; + + PROC abkuerzung aendern (TEXT CONST abk, lang) : + + auf satz (verz, abk); + IF dateiende (verz) THEN + errorstop ("Abkürzung existiert nicht") + ELSE + feld aendern (verz, 2, lang) + END IF + + END PROC abkuerzung aendern; + + PROC abkuerzung loeschen (TEXT CONST abk) : + + auf satz (verz, abk); + IF NOT dateiende (verz) THEN + satz loeschen (verz) + END IF + + END PROC abkuerzung loeschen; + + TEXT PROC langform (TEXT CONST abk) : + + auf satz (verz, abk); + IF dateiende (verz) THEN + inhalt := ""; + errorstop ("Abkürzung nicht vorhanden") + ELSE + feld lesen (verz, 2, inhalt) + END IF; + inhalt + + END PROC langform; + + END PACKET abkuerzungsverzeichnis; +#text# + +Die Prozedur 'verzeichnis laden' koppelt die interne EUDAT-Vari­ +able 'verz' an eine benannte EUDAS-Datei, die eventuell vorher mit +EUDAS erstellt wurde. In diesem Beispiel sind die Feldnamen egal; +falls die übergebene EUDAS-Datei noch nicht existiert, wird sie mit +0 Feldern eingerichtet, was aber nur für eine spätere Anzeige mit +EUDAS störend wäre. + Grundlage für das Aufsuchen einer bestimmten Abkürzung bil­ +det immer die Prozedur 'auf satz', die nach dem Inhalt des ersten +Feldes optimiert sucht. Falls die Abkürzung nicht gefunden wurde, +wird auf das Dateiende positioniert, daher wird jeweils 'dateiende' +abgefragt. + Beim Einfügen eines neuen Satzes muß eine komplette Satz­ +variable angegeben werden, die bereits mit den Inhalten gefüllt ist. +Beim späteren Ändern kann jedoch direkt auf ein Feld zugegriffen +werden, ohne die Satzvariable explizit rauszuholen. + Die Abfrage einer bestimmten Abkürzung bereitet dann keine +Schwierigkeiten mehr. + Für die Verwendung von EUDAS-Dateien in diesem Beispiel +spricht zum einen die einfache Programmierung, zum anderen aber +auch die Möglichkeit, das erstellte Verzeichnis mit den Hilfsmitteln +von EUDAS zu warten und auszudrucken. + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.7 b/app/eudas/4.4/doc/ref-manual/eudas.ref.7 new file mode 100644 index 0000000..47533ac --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.7 @@ -0,0 +1,519 @@ +#type ("prop")##limit (14.0)# +#format# +#page (71)# +#kapitel ("7", "Verwaltung", "der offenen", "Dateien")# + + +Die in diesem Kapitel beschriebene Schnittstelle verbindet mehrere +EUDAS-Dateien zu einem großen Dateimodell. Diese virtuelle Datei +dient als Grundlage für die meisten EUDAS-Funktionen. Zuerst muß +eine Datei als Bestandteil der virtuellen Datei geöffnet werden, ehe +sie bearbeitet werden kann. Es ist so bei den Funktionen keine +Angabe mehr nötig, welche Datei gemeint ist. + Diese Schnittstelle ist in vielen Teilen für die interne +EUDAS-Anwendung ausgelegt. Bei einigen Prozeduren werden aus +Effizienzgründen keinerlei Überprüfungen auf illegale Aufrufe oder +Parameter durchgeführt. Wollen Sie eine solche Prozedur dennoch +verwenden, sollten Sie die Einhaltung der angegebenen Bedingungen +sorgfältig überprüfen. + + +#abschnitt ("7.1", "DATEIVERWALTUNG", "Dateiverwaltung")# + +Mit 'oeffne' wird eine Datei zum Bearbeiten geöffnet. Mit 'kette' und +'kopple' können weitere Dateien dazugekettet bzw. dazugekoppelt +werden. Durch 'sichere' können veränderte Kopien zurückgeschrie­ +ben werden. Durch 'dateien loeschen' werden die internen Kopien +gelöscht. + Mit 'anzahl dateien' kann die Anzahl der vorhandenen Dateien +erfragt werden. 'anzahl koppeldateien' gibt Auskunft darüber, wie­ +viel Dateien davon gekoppelt sind. 'aendern erlaubt' gibt den Status +wieder, der beim Öffnen der ersten Datei angegeben wurde. 'inhalt +veraendert' gibt an, ob die angegebene Datei verändert wurde. Mit +'eudas dateiname' können die Namen der geöffneten Dateien erfragt +werden. Bei jedem 'oeffne' wird 'dateiversion' um 1 erhöht. Dies +dient dazu, ein erfolgtes neues Öffnen von anderen Stellen aus zu +entdecken. + Mit 'auf koppeldatei' kann die virtuelle Datei auf eine Koppel­ +datei umgeschaltet werden, so daß der Eindruck entsteht, nur diese +Datei wäre geöffnet worden. + +#proc# +PROC oeffne (TEXT CONST dateiname, + BOOL CONST aendern erlaubt) +#endproc# + Falls Ändern erlaubt sein soll, wird eine Kopie der angegebenen + Datei zur Bearbeitung für EUDAS angelegt. Vorher geöffnete + Dateien werden gelöscht. Die Änderungserlaubnis wird entspre­ + chend gesetzt. Es wird die Satzposition der EUDAS-Datei ange­ + nommen (Ausnahme: steht die EUDAS-Datei hinter dem letzten + Satz, wird auf Satz 1 positioniert). 'dateiversion' sowie 'anzahl + dateien' werden um 1 erhöht. +#f2# + FEHLER: +#f1# + #on("i")#Datei nicht gesichert#off("i")# + Eine vorher geöffnete Datei war verändert, aber nicht gesi­ + chert. +#f1# + #on("i")#Datei existiert nicht#off("i")# + Die angegebene Datei ist nicht vorhanden. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Die angegebene Datei hat nicht den für EUDAS-Dateien festge­ + legten Typ. + +#proc# +PROC kopple (TEXT CONST dateiname) +#endproc# + Die angegebene Datei wird zu den bereits geöffneten Dateien + dazugekoppelt. Falls Ändern erlaubt ist, wird eine Kopie dieser + Datei verwendet. Dabei werden die ersten Felder der Datei, die + bereits in der Hauptdatei vorhanden sind, als Koppelfelder + festgelegt. Alle weiteren Felder werden zusätzlich zu den bis­ + herigen angelegt. 'dateiversion', 'anzahl dateien' und 'anzahl  + koppeldateien' werden um 1 erhöht. +#f2# + FEHLER: +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß vorher eine Datei geöffnet werden. +#f1# + #on("i")#Zuviel Dateien geoeffnet#off("i")# + Die Anzahl der gleichzeitig geöffneten Dateien ist begrenzt. +#f1# + #on("i")#Datei existiert nicht#off("i")# + Die angegebene Datei ist nicht vorhanden. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Die angegebene Datei hat nicht den für EUDAS-Dateien festge­ + legten Typ. +#f1# + #on("i")#Zu viele Felder#off("i")# + Die Anzahl der Felder insgesamt ist begrenzt. +#f1# + #on("i")#Zu viele Koppelfelder#off("i")# + Die Anzahl der Koppelfelder ist begrenzt. +#f1# + #on("i")#keine Koppelfelder vorhanden#off("i")# + Das erste Feld der zu koppelnden Datei ist in der Hauptdatei + nicht vorhanden (unterschiedliche Feldnamen). + +#proc# +PROC kette (TEXT CONST dateiname) +#endproc# + Die angegebene Datei wird an die Hauptdatei angekettet, d.h. + die Sätze der neuen Datei werden am bisherigen Dateiende + angefügt. Falls Ändern erlaubt ist, wird eine Kopie dieser Datei + verwendet. Die zu kettende Datei muß in der Feldstruktur nicht + mit der Hauptdatei übereinstimmen. Die aktuelle Satzposition + wird beibehalten. 'dateiversion' und 'anzahl dateien' werden um + 1 erhöht. +#f2# + FEHLER: +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß vorher eine Datei geöffnet werden. +#f1# + #on("i")#Zuviel Dateien geoeffnet#off("i")# + Die Anzahl der gleichzeitig geöffneten Dateien ist begrenzt. +#f1# + #on("i")#Datei existiert nicht#off("i")# + Die angegebene Datei ist nicht vorhanden. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Die angegebene Datei hat nicht den für EUDAS-Dateien festge­ + legten Typ. + +#proc# +PROC sichere (INT CONST dateinr, TEXT CONST dateiname) +#endproc# + Die geöffneten Dateien werden in der Reihenfolge ihres Öffnens + durchnumeriert (von 1 an). Die Arbeitskopie mit der angegebe­ + nen Nummer wird unter dem angegebenen Namen gesichert, aber + selbst nicht verändert. Die vorher unter diesem Namen vorhan­ + dene Datei wird gelöscht. War die zu sichernde Arbeitskopie + verändert worden, so wird sie anschließend als nicht verändert + angesehen. + Bedingungen: + 1 <= dateinr <= anzahl dateien + +#proc# +PROC dateien loeschen (BOOL CONST auch geaenderte) +#endproc# + Es werden alle geöffneten Arbeitskopien gelöscht. EUDAS wird + wieder in den Anfangszustand versetzt. Wird 'auch geaenderte' + angegeben, wird bei geänderten, aber nicht gesicherten Dateien + die Fehlermeldung unterdrückt. +#f2# + FEHLER: +#f1# + #on("i")#Datei nicht gesichert#off("i")# + Eine vorher geöffnete Datei war verändert, aber nicht gesi­ + chert. + +#proc# +BOOL PROC auf koppeldatei +#endproc# + Liefert TRUE, wenn auf eine Koppeldatei umgeschaltet wurde. + +#proc# +PROC auf koppeldatei (INT CONST nr) +#endproc# + Umschalten auf Koppeldatei 'nr'. Ist bereits umgeschaltet, wird + wieder zurückgeschaltet. In diesem Fall werden bei 'nr' = 1 die + Koppelfelder übernommen, anderenfalls nicht. Beim Umschalten + bleiben Satzposition, Markierungen und Suchmuster gespeichert. + In der Koppeldatei wird die beim letzten Umschalten eingestell­ + te Position wieder eingenommen. 'dateiversion' wird um 1 er­ + höht. + +#proc# +INT PROC anzahl dateien +#endproc# + Gibt die Anzahl der insgesamt geöffneten Dateien an. + +#proc# +INT PROC anzahl koppeldateien +#endproc# + Gibt die Anzahl der gekoppelten Dateien an. + +#proc# +BOOL PROC aendern erlaubt +#endproc# + Reflektiert den Status, der bei 'oeffne' gesetzt wurde. + +#proc# +BOOL PROC inhalt veraendert (INT CONST dateinr) +#endproc# + Gibt an, ob die geöffnete Datei mit der angegebenen Nummer + verändert wurde. Wird ggf. von 'sichere' zurückgesetzt. + Bedingung: + 1 <= dateinr <= anzahl dateien + +#proc# +TEXT PROC eudas dateiname (INT CONST dateinr) +#endproc# + Liefert den Namen, unter dem die entsprechende Datei geöffnet + wurde. + Bedingung: + 1 <= dateinr <= anzahl dateien + +#proc# +INT PROC dateiversion +#endproc# + Wird bei jedem 'oeffne', 'kette' und 'kopple' zyklisch erhöht. + +#proc# +INT PROC folgedatei (INT CONST dateinr) +#endproc# + Eine geöffnete EUDAS-Datei wird in eine von zwei Listen auf­ + genommen, die der geketteten Dateien und die der gekoppelten. + Diese Prozedur liefert jeweils die Nummer der nächsten Datei in + der Liste, am Ende aber 0. Die Liste der geketteten Dateien + beginnt immer mit 1, mit 'folgedatei (0)' erhält man die erste + gekoppelte Datei. + Bedingung: + 0 <= dateinr <= anzahl dateien + + +#abschnitt ("7.2", "FELDSTRUKTUR", "Feldstruktur")# + +Die einzelnen Sätze der kombinierten EUDAS-Datei sind in Felder +unterteilt. Diese setzen sich zusammen aus den Feldern der Haupt­ +datei und der einzelnen Koppeldateien, wobei die Koppelfelder je­ +weils nur einmal auftauchen. + 'anzahl felder' liefert die Anzahl der vorhanden Felder. Mit +'feldnamen lesen' und 'feldnamen bearbeiten' können die Feldnamen +abgefragt werden. 'feldnummer' liefert einen Index für einen vor­ +gegebenen Feldnamen, da die Felder immer über Nummern angespro­ +chen werden. + Die Prozeduren 'feld lesen' und 'feld bearbeiten' ermöglichen +den Zugriff auf den Feldinhalt des aktuellen Satzes; durch 'feld +aendern' kann dieser Inhalt abgeändert werden. + +#proc# +INT PROC anzahl felder +#endproc# + Liefert die Anzahl der vorhanden Felder. + +#proc# +PROC feldnamen lesen (INT CONST feldnr, + TEXT VAR feldname) +#endproc# + Liefert in 'feldname' den Namen des Feldes mit der Nummer + 'feldnr'. + Bedingung: + 1 <= feldnr <= anzahl felder + +#proc# +PROC feldnamen bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) +#endproc# + Die Prozedur 'bearbeite' wird aufgerufen. Als Parameter werden + ein Text und Anfangs- und Endposition des gewünschten Feld­ + namens in diesem Text übergeben. Verhindert unnötiges Kopie­ + ren des Feldnamens in eine TEXT-Variable. Der übergebene + Text darf nicht verändert werden! + Bedingung: + 1 <= feldnr <= anzahl felder + +#proc# +INT PROC feldnummer (TEXT CONST feldname) +#endproc# + Liefert den index zu dem angegebenen Feldnamen. Falls ein + solcher Name nicht existiert, wird 0 geliefert. + +#proc# +PROC feld lesen (INT CONST feldnr, TEXT VAR inhalt) +#endproc# + Liefert den Inhalt des angegebenen Feldes. + Bedingung: + 1 <= feldnr <= anzahl felder + +#proc# +PROC feld bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) +#endproc# + Die Prozedur 'bearbeite' wird aufgerufen. Der Feldinhalt des + angegebenen Feldes steht im übergebenen Text innerhalb der + Grenzen. Ist die Obergrenze kleiner als die Untergrenze, so ist + das Feld leer. + Bedingung: + 1 <= feldnr <= anzahl felder + +#proc# +PROC feld aendern (INT CONST feldnr, TEXT CONST inhalt) +#endproc# + Ändert den Inhalt des angegebenen Feldes. + Bedingung: + NOT ende der datei + 1 <= feldnr <= anzahl felder + +#proc# +INT PROC feldinfo (INT CONST feldnummer) +#endproc# + Liefert den Typ des angegebenen Feldes. + Bedingung: + 1 <= feldnummer <= anzahl felder + +#proc# +PROC notizen lesen (INT CONST nr, TEXT VAR inhalt) +#endproc# + Liest die angegebenen Notizen ('nr' = 1,2,3) aus der ersten + Datei oder der umgeschalteten Koppeldatei. + +#proc# +PROC notizen aendern (INT CONST nr, TEXT CONST inhalt) +#endproc# + Ändert die Notizen ('nr' = 1,2,3) der ersten Datei oder der um­ + geschalteten Koppeldatei. + + +#abschnitt ("7.3", "POSITIONIERUNG", "Positionierung")# + +Das virtuelle Dateimodell von EUDAS verfügt ebenfalls über eine +Satzposition, die verändert werden kann. + Durch 'satznummer' wird die aktuelle Satznummer geliefert, +beim Koppeln kann über 'satzkombination' die Reihenfolge der Kop­ +pelkombinationen bestimmt werden. 'dateiende' zeigt an, ob die +Satzposition hinter dem letzten Satz liegt. Mit 'weiter' und 'zurueck' +erfolgt die eigentliche Positionierung. Hier kann außer der Positio­ +nierung um Einzelsätze auch die Positionierung auf den nächsten +ausgewählten oder markierten Satz angefordert werden. Mit 'auf  +satz' schließlich kann ein bestimmter Satz angesprungen werden. + +#proc# +INT PROC satznummer +#endproc# + Liefert die Nummer des aktuellen Satzes. Die Sätze werden von + 1 an durchnumeriert, wobei über die geketteten Dateien wei­ + tergezählt wird. + Bedingung: + anzahl dateien > 0 + +#proc# +INT PROC satzkombination +#endproc# + Liefert die laufende Nummer der Koppelkombination des aktuel­ + len Satzes. Wird nur durch 'weiter' im Einzelsatzmodus erhöht. + Normalerweise 1. + Bedingung: + anzahl dateien > 0 + +#proc# +BOOL PROC dateiende +#endproc# + Gibt an, ob die Satzposition hinter dem letzten Satz liegt. + +#proc# +PROC weiter (INT CONST modus) +#endproc# + Erhöht die aktuelle Satzposition. Für 'modus' gibt es 3 Möglich­ + keiten: + 1: Falls eine weitere Satzkombination besteht, wird diese ein­ + genommen, sonst zum nächsten Satz. + 2: Zum nächsten durch Suchbedingung ausgewählten Satz. Wird + optimiert. + 3: Zum nächsten markierten Satz. Wird optimiert. + Ist kein Satz mehr vorhanden, wird die Satzposition hinter dem + letzten Satz eingenommen. + Bedingung: + anzahl dateien > 0 + +#proc# +PROC zurueck (INT CONST modus) +#endproc# + Geht um einen Satz zurück. Die Modusangabe ist wie bei 'wei­ + ter', jedoch wird im Modus 1 keine weitere Satzkombination + ausprobiert. Die Positionierung endet bei Satz 1. + Bedingung: + anzahl dateien > 0 + +#proc# +PROC auf satz (INT CONST satznr) +#endproc# + Geht auf den angegebenen Satz. Ist 'satznr' < 1, wird auf Satz 1 + positioniert, ist der angegebene Satz nicht vorhanden, wird + hinter den letzten Satz positioniert. Es wird jeweils die erste + Satzkombination eingenommen. + Bedingung: + anzahl dateien > 0 + + +#abschnitt ("7.4", "ÄNDERUNGEN", "Änderungen")# + +Sätze des Dateimodells können eingefügt oder gelöscht werden. +Durch das Einfügen entsteht ein leerer Satz vor dem aktuellen Satz; +alle weiteren Sätze rücken eine Stelle weiter. Beim Löschen wird +dieser Vorgang wieder rückgängig gemacht. + Durch 'satz einfuegen' wird ein Leersatz eingefügt; durch +'satz loeschen' wird der aktuelle Satz gelöscht. + Sätze in gekoppelten Dateien werden grundsätzlich nicht ge­ +löscht; auch beim Einfügen entsteht nicht automatisch ein Leersatz +in den gekoppelten Dateien. Änderungen in den Koppeldateien +(durch 'feld aendern') werden gepuffert. Durch 'aenderungen ein­ +tragen' werden die Änderungen dann in die Koppeldateien eingetra­ +gen. Dabei kann auch ein neuer Satz in die Koppeldatei eingefügt +werden. Bei Positionierungen wird diese Prozedur automatisch auf­ +gerufen. + +#proc# +PROC satz einfuegen +#endproc# + Fügt vor dem aktuellen Satz einen Leersatz ein. + Bedingung: + anzahl dateien > 0 + +#proc# +PROC satz loeschen +#endproc# + Löscht den aktuellen Satz. Hat hinter dem letzten Satz keine + Wirkung. + Bedingung: + anzahl dateien > 0 + +#proc# +PROC aenderungen eintragen +#endproc# + Trägt die gepufferten Änderungen in die Koppeldateien ein. + Dabei können die folgenden Fälle auftreten: + 1. Der Satz in der Koppeldatei wird geändert. + Dies geschieht dann, wenn vorher ein passender Satz in der + Koppeldatei vorhanden war und die Koppelfelder nicht ver­ + ändert wurden. + 2. In der Koppeldatei wird ein neuer Satz eingefügt. + Wenn die Koppelfelder und noch andere Felder einer Datei + geändert wurden, wird in dieser Datei ein neuer Satz einge­ + fügt. + 3. Es wird neu gekoppelt. + Wurden nur die Koppelfelder einer Datei geändert, wird ein + neuer, zu diesen Feldern passender Satz gesucht. Nach + 'aenderungen eintragen' erscheinen unter den Feldern der + Datei die neuen Inhalte. + + +#abschnitt ("7.5", "SUCHBEDINGUNGEN", "Suchbedingungen")# + +Über 'suchbedingung' kann eine Suchbedingung eingetragen werden, +die für jeden Satz geprüft werden soll. Mit 'satz ausgewaehlt' wird +erfragt, ob der aktuelle Satz die Suchbedingung erfüllt. Die Such­ +bedingung kann mit 'suchbedingung loeschen' wieder ausgeschaltet +werden. + Einzelne Sätze können auch markiert werden. Nach einem Öff­ +nen ist zunächst kein Satz markiert. Durch 'markierung  aendern' +kann die Markierung eines Satzes geändert werden. 'satz markiert' +fragt ab, ob der aktuelle Satz markiert ist. 'markierte saetze' liefert +die Anzahl der markierten Sätze. Mit 'markierungen loeschen' wer­ +den alle Markierungen entfernt. + +#proc# +PROC suchbedingung (INT CONST feldnr, + TEXT CONST bedingung) +#endproc# + Stellt für das angegebene Feld die im Text als Muster angege­ + bene Suchbedingung ein. Weitere Aufrufe verknüpfen die Be­ + dingungen mit UND (auch wenn das gleiche Feld erneut angege­ + ben wird). + Bedingung: + anzahl dateien > 0 + 1 <= feldnr <= anzahl felder +#f2# + FEHLER: +#f1# + #on("i")#Suchmuster zu umfangreich#off("i")# + Es wurden zu viele Vergleiche gefordert. + +#proc# +BOOL PROC satz ausgewaehlt +#endproc# + Gibt an, ob die Suchbedingung auf den aktuellen Satz zutrifft. + Hinter dem letzten Satz wird immer FALSE geliefert. + Bedingung: + anzahl dateien > 0 + +#proc# +PROC suchbedingung lesen (INT CONST feldnr, TEXT VAR bedingung) +#endproc# + Liefert die zuletzt für das angegebene Feld eingestellte Bedin­ + gung, falls die Suchbedingung nicht gelöscht und keine Datei + neu geöffnet wurde. + Bedingung: + 1 <= feldnr <= anzahl felder + +#proc# +PROC suchbedingung loeschen +#endproc# + Löscht die eingestellte Suchbedingung wieder. Anschließend + sind alle Sätze ausgewählt. + Bedingung: + anzahl dateien > 0 + +#proc# +PROC markierung aendern +#endproc# + Ändert die Markierung des aktuellen Satzes ins Gegenteil. + Bedingung: + anzahl dateien > 0 + +#proc# +BOOL PROC satz markiert +#endproc# + Gibt an, ob der aktuelle Satz markiert ist. + Bedingung: + anzahl dateien > 0 + +#proc# +INT PROC markierte saetze +#endproc# + Gibt an, wieviel Sätze insgesamt markiert sind. + Bedingung: + anzahl dateien > 0 + +#proc# +PROC markierungen loeschen +#endproc# + Löscht alle Markierungen. + Bedingung: + anzahl dateien > 0 + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.8 b/app/eudas/4.4/doc/ref-manual/eudas.ref.8 new file mode 100644 index 0000000..5e8d220 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.8 @@ -0,0 +1,444 @@ +#type ("prop")##limit (14.0)# +#format# +#page (83)# +#kapitel ("8", "Funktionen", "zur", "Bearbeitung")# + + + +Die Verarbeitungsfunktionen arbeiten jeweils auf der aktuell geöff­ +neten Datei. Falls mindestens ein Satz markiert ist, werden nur +markierte Sätze bearbeitet, anderenfalls die durch die Suchbedin­ +gung ausgewählten Sätze. + + +#abschnitt ("8.1", "DRUCKEN", "Drucken")# + +Zum Drucken wird ein Druckmuster als Textdatei benötigt. Dessen +Name muß beim Aufruf der Prozedur 'drucke' angegeben werden. +Werden beim Übersetzen des Druckmusters Fehler entdeckt, so wird +der Paralleleditor aufgerufen und kein Druckvorgang durchgeführt. + Normalerweise sendet der Druckgenerator die Ausgabe direkt +zum Drucker. Alternativ kann die Ausgabe auch in eine Datei ge­ +schrieben werden. Dieses Verfahren kann mit 'direkt drucken' umge­ +stellt werden. Der Aufruf + +#beispiel# + direkt drucken (TRUE) +#text# + +sendet alle Dateien direkt zum Drucker, mit + +#beispiel# + direkt drucken (FALSE) +#text# + +wird die Ausgabe in Dateien abgelegt. Diese Dateien erhalten Namen +der Form + +#beispiel# + "Druckmustername.a$n" +#text# + +wobei 'n' eine laufende Nummer zur Unterscheidung ist. + Soll die Druckausgabe in eine ganz bestimmte Datei geleitet +werden, so kann vor dem Aufruf von 'drucke' die Prozedur 'druck­ +datei' aufgerufen werden, die als Parameter den Namen der Ausga­ +bedatei erhält. Existiert die Datei noch nicht, wird sie eingerichtet, +ansonsten wird die Ausgabe am Ende angehängt. + Die Einstellung der Ausgabedatei gilt nur für einen Druckvor­ +gang und überschreibt für diesen Druckvorgang 'direkt drucken'. +Beim nächsten Druckvorgang wird wieder die durch 'direkt drucken' +festgelegte Einstellung verwendet. + Wenn beim Drucken ein großes Ausgabevolumen anfällt, kann es +sinnvoll sein, die Ausgabe in mehrere kleine Dateien aufzuteilen. +Dies gilt auch, wenn direkt gedruckt werden soll, da auch in diesem +Fall eine Zwischendatei erzeugt werden muß. Die maximale Anzahl +von Zeilen pro Datei wird durch 'max druckzeilen' angegeben. + Der dort angegeben Wert gilt nur ungefähr - ein Wechsel der +Ausgabedatei findet dann statt, wenn die Ausgabedatei nach Bear­ +beitung eines Satzes die Maximalanzahl überschritten hat. In die +neue Datei wird anschließend zuerst der Initialisierungsteil des +Druckmusters kopiert, ehe mit der Ausgabe des nächsten Satzes +fortgefahren wird. + +Die Prozeduren im einzelnen: + +#proc# +PROC drucke (TEXT CONST druckmuster) +#endproc# + Die aktuell geöffnete Datei wird nach dem angegebenen Druck­ + muster gedruckt. +#f2# + FEHLER: +#f1# + #on("i")#Datei "druckmuster" existiert nicht#off("i")# + Das angegebene Druckmuster ist nicht vorhanden. +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Zum Drucken muß eine Datei geöffnet sein. +#f1# + #on("i")#direkt Drucken nicht möglich#off("i")# + Es ist kein Druckprogramm installiert oder der Spooler läßt sich + mit 'print' nicht ansprechen. Der Druck wird abgebrochen, die + Ausgabedatei ist noch vorhanden. + +#proc# +PROC direkt drucken (BOOL CONST ja) +#endproc# + Gibt an, ob die Druckausgaben direkt gedruckt oder in einer + Datei gesammelt werden sollen. + +#proc# +PROC druckdatei (TEXT CONST ausgabedatei) +#endproc# + Leitet die Druckausgabe des nächsten Druckvorgangs in die + Datei 'ausgabedatei'. Die Einstellung von 'direkt drucken' wird + für diesen Druckvorgang überschrieben. Die Ausgabe wird am + Ende der Datei angehängt, falls nötig, wird die Ausgabedatei + vorher eingerichtet. + +#proc# +PROC maxdruckzeilen (INT CONST zeilen) +#endproc# + Stellt die maximale Anzahl von Zeilen für die Ausgabedatei ein. + Beim Überschreiten dieses Wertes wird eine neue Datei ange­ + fangen. Standardwert ist 4000. + +#proc# +TEXT PROC lfd nr +#endproc# + Liefert während des Druckens die laufende Nummer des gerade + gedruckten Satzes als Text. + +#proc# +BOOL PROC gruppenwechsel (INT CONST gruppennr) +#endproc# + Kann innerhalb eines Vor- oder Nachspanns beim Drucken ab­ + gefragt werden, um festzustellen, ob die angegebene Gruppe + gewechselt und damit den Vor- bzw. Nachspann mitverursacht + hat (es können zu einem Zeitpunkt mehrere Gruppen wechseln). + Die Gruppennummer 0 gibt die Standardgruppe an, die nur vor + dem ersten und nach dem letzten Satz wechselt. + + +#abschnitt ("8.2", "KOPIEREN", "Kopieren")# + +Zum selektiven Kopieren von EUDAS-Dateien wird ein Kopiermuster +benötigt. Dieses gibt die Zuordnung zwischen Feldern der Ziel- und +der Quelldatei an. Die Quelldatei ist immer die aktuell geöffnete +Datei. + Die Kopierfunktion wird durch 'kopiere' aufgerufen. Parameter +sind der Name der Zieldatei und das Kopiermuster als FILE. Alter­ +nativ kann statt des Kopiermusters eine Prozedur übergeben wer­ +den, die die Kopieranweisungen erhält. + Der eigentliche Kopiervorgang wird durch den Operator 'K' +bewirkt. Dieser erhält den Zielfeldnamen und einen TEXT-Aus­ +druck als Parameter. Der Wert des TEXT-Ausdrucks wird in das +jeweilige Feld der Zieldatei geschrieben. + Existiert die Zieldatei noch nicht, so wird sie mit den Feldern +eingerichtet, die in den einzelnen 'K'-Ausdrücken angegeben sind +und zwar in der angeführten Reihenfolge. Existiert die Zieldatei, so +werden gegebenenfalls noch nicht vorhandene Felder am Ende ange­ +fügt. + Die Prozedur 'std kopiermuster' liefert zu einer gegebenen +Zieldatei ein Standard-Muster, das als Auswahlgrundlage dienen +kann. Existiert die Zieldatei nicht, werden alle Felder der Quell­ +datei 1 : 1 kopiert, anderenfalls wird zu jedem Feld der Zieldatei +ein passendes Feld der Quelldatei gesucht - die Feldreihenfolge +richtet sich in diesem Fall nach der Zieldatei. + +#proc# +PROC kopiere (TEXT CONST dateiname, + FILE VAR kopiermuster) +#endproc# + Die aktuell geöffnete Datei wird nach den Angaben in 'kopier­ + muster' in die Datei 'dateiname' kopiert. Das Kopiermuster wird + dem ELAN-Compiler übergeben. Tritt bei der Übersetzung ein + Fehler auf, wird der Paralleleditor aufgerufen. +#f2# + FEHLER: +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + +#proc# +PROC kopiere (TEXT CONST dateiname, PROC kopierfunktion) +#endproc# + Wie oben, nur ist die Kopierfunktion gleich als Prozedur vor­ + handen. +#f2# + FEHLER: +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + +#proc# +OP K (TEXT CONST feldname, ausdruck) +#endproc# + Kopiert den Ausdruck in das Feld 'feldname' der Zieldatei. + Dieses Feld wird eingerichtet, falls es noch nicht existiert. + Dieser Operator ist nur während eines Kopiervorganges de­ + finiert (also in einem Kopiermuster oder einer Kopierfunktion). + Er darf nicht in einer IF-Klausel stehen, sondern muß bei + jedem Satz mit gleichem Feldnamen an der gleichen Stelle auf­ + gerufen werden. + +#proc# +PROC std kopiermuster (TEXT CONST dateiname, + FILE VAR kopiermuster) +#endproc# + Liefert ein Standard-Kopiermuster, abhängig von der Zieldatei + 'dateiname'. Existiert diese nicht, wird die Quelldatei unverän­ + dert kopiert, ansonsten richtet sich das Kopiermuster nach der + Zieldatei. + + +#abschnitt ("8.3", "TRAGEN", "Tragen")# + +Durch Tragen können Sätze komplett in eine Zieldatei transportiert +werden. In der Quelldatei sind sie anschließend nicht mehr vorhan­ +den. Eine ganze Auswahl von Sätzen kann mit 'trage' transportiert +werden. 'trage satz' transportiert nur den aktuellen Satz. Mit +'hole satz' kann der letzte Satz der Zieldatei wieder zurückgeholt +werden, so daß eine EUDAS-Datei auch als Zwischenspeicher für +Einzelsätze verwendet werden kann. + Existiert die Zieldatei bereits, muß sie mindestens so viele +Felder wie die Quelldatei besitzen, damit keine Informationen ver­ +lorengehen können. Die Feldnamen müssen nicht übereinstimmen. +Existiert die Zieldatei noch nicht, wird sie mit den Feldern der +Quelldatei eingerichtet. + Die Tragefunktion kann um eine gleichzeitige Prüfung erweitert +werden. Dabei werden Bedingungen überprüft, die bei der Zieldatei +gespeichert sind. Sätze, die diese Bedingungen verletzen, werden +nicht getragen. Eine entsprechende Meldung wird in eine Protokoll­ +datei geschrieben, die als Parameter übergeben werden muß. + Die Prüfbedingungen stehen als ausführbares Programm in den +Notizen der Zieldatei. Prüfbedingungen können mit mehreren Proze­ +duren formuliert werden. 'pruefe' nimmt eine beliebige Bedingung als +Parameter und gibt bei Mißerfolg eine Meldung aus. 'wertemenge' +prüft auf Übereinstimmung mit einem der angegebenen Werte. 'feld­ +maske' legt eine Maske für ein Feld fest, die auf den Inhalt zutref­ +fen muß. + Mit Hilfe der Prozedur 'eindeutige felder' können Satzduplikate +erkannt werden. Auch diese werden nicht getragen. + Die bei den Prüfbedingungen angegebenen Feldnamen müssen in +der Quelldatei vorhanden sein. Falls eine Prüfprozedur außerhalb +von 'trage' aufgerufen wird, führt eine Verletzung der Prüfbedin­ +gung zu einem 'errorstop'. + +#proc# +PROC trage (TEXT CONST dateiname, + FILE VAR protokoll, BOOL CONST test) +#endproc# + Alle ausgewählten Sätze werden in die Datei 'dateiname' getra­ + gen. Diese wird gegebenenfalls eingerichtet. Falls 'test' ange­ + geben ist, werden die in den Notizen der Zieldatei enthaltenen + Bedingungen geprüft. Nur in diesem Fall muß 'protokoll' initial­ + isiert sein. +#f2# + FEHLER: +#f1# + #on("i")#kein Satz zum Tragen vorhanden#off("i")# + Die Quelldatei ist leer oder es ist keine Datei geöffnet. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#Zieldatei hat falsche Felderzahl#off("i")# + Zu wenig Felder in der Zieldatei. + +#proc# +PROC trage satz (TEXT CONST dateiname) +#endproc# + Der aktuelle Satz wird in die Datei 'dateiname' getragen. +#f2# + FEHLER: +#f1# + #on("i")#kein Satz zum Tragen vorhanden#off("i")# + Keine Datei geöffnet oder Datei ist am Ende. +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#Zieldatei hat falsche Felderzahl#off("i")# + Zu wenig Felder in der Zieldatei. + +#proc# +PROC pruefe (TEXT CONST feldname, BOOL CONST bedingung) +#endproc# + Wenn die angegebene Bedingung FALSE liefert, wird eine Mel­ + dung in die Protokolldatei geschrieben und der jeweilige Satz + nicht getragen. + +#proc# +PROC wertemenge (TEXT CONST feldname. menge) +#endproc# + Es wird geprüft, ob das angegebene Feld in der Wertemenge + enthalten ist. Die einzelnen Werte in der Wertemenge werden + dabei durch Komma getrennt. Leerzeichen sind signifikant. + +#proc# +PROC feldmaske (TEXT CONST feldname, maske) +#endproc# + Es wird geprüft, ob das angegebene Feld zu der Maske paßt. Die + Zeichen in der Maske haben dabei folgende Bedeutung: + '9' trifft auf jede Ziffer zu + 'X' trifft auf jedes Zeichen zu + 'A' trifft auf jeden Großbuchstaben zu (einschließlich + Umlaute) + 'a' trifft auf jeden Kleinbuchstaben zu (einschließlich + Umlaute und 'ß') + '*' trifft auf eine Folge beliebiger Zeichen zu (auch die + leere Folge). Eine sparsame Verwendung wird empfoh­ + len, da die Bearbeitung sehr aufwendig ist. + Alle anderen Zeichen treffen nur auf ein gleiches Zeichen zu. + +#proc# +PROC eindeutige felder (INT CONST anzahl) +#endproc# + Gibt an, die wieviel ersten Felder einen Satz eindeutig identifi­ + zieren sollen. Ein Satz, der mit einem Satz der Datei in diesen + Feldern übereinstimmt, wird nicht getragen. Ohne diese Angabe + wird keine derartige Prüfung vorgenommen. + +#proc# +PROC hole satz (TEXT CONST dateiname) +#endproc# + Holt den letzten Satz der angegebenen Datei und fügt ihn vor + dem aktuellen Satz ein. +#f2# + FEHLER: +#f1# + #on("i")#"dateiname" existiert nicht#off("i")# +#f1# + #on("i")#Datei ist keine EUDAS-Datei#off("i")# + Zieldatei existiert, ist aber keine EUDAS-Datei. +#f1# + #on("i")#Zieldatei hat falsche Felderzahl#off("i")# + Zu viele Felder in der angegebenen Datei. +#f1# + #on("i")#Kein Satz zum Tragen vorhanden#off("i")# + Die angegebene Datei ist leer. +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + + +#abschnitt ("8.4", "VERARBEITUNG", "Verarbeitung")# + +Die ausgewählten Sätze der aktuellen Datei können nach einer +Verarbeitungsvorschrift verändert oder geprüft werden. Dies ge­ +schieht durch die Prozedur 'verarbeite'. Als Parameter kann ent­ +weder ein Verarbeitungsmuster als FILE oder die Verarbeitungs­ +funktion direkt als Prozedur übergeben werden. + Die Vorschrift wird durch den Operator 'V' realisiert. + +#proc# +PROC verarbeite (FILE VAR verarbeitungsmuster) +#endproc# + Die aktuelle Datei wird nach dem angegebenen Muster bearbei­ + tet. Enthält die Vorschrift, die dem ELAN-Compiler übergeben + wird, einen Fehler, wird der Paralleleditor aufgerufen. +#f2# + FEHLER: +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + +#proc# +PROC verarbeite (PROC verarbeitungsfunktion) +#endproc# + Wie oben, nur wird die Vorschrift direkt als Prozedur überge­ + ben. +#f2# + FEHLER: +#f1# + #on("i")#keine Datei geoeffnet#off("i")# + Es muß eine virtuelle Datei vorhanden sein. + +#proc# +OP V (TEXT CONST feldname, ausdruck) +#endproc# + Das angegebene Feld des aktuellen Satzes wird durch den Aus­ + druck ersetzt. +#f2# + FEHLER: +#f1# + #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# + Das angegebene Feld ist nicht vorhanden. + + +#abschnitt ("8.5", "FUNKTIONEN IN AUSDRÜCKEN", "Funktionen in Ausdrücken")# + +Für Ausdrücke bei den in diesem Kapitel beschriebenen Prozeduren +sind einfache Funktionen zur Abfrage von Feldinhalten vorhanden. +Mit 'f' kann der Inhalt eines benannten Feldes erfragt werden, bei +'wert' wird der Inhalt erst in eine REAL-Zahl umgewandelt, wobei +nichtnumerische Zeichen ignoriert werden. + Die Prozedur 'textdarstellung' kann dazu verwendet werden, +den Wert einer TEXT-Variablen als TEXT-Denoter in ELAN-Syntax +darzustellen. + Die Prozedur 'zahltext' kann dazu verwendet werden, aus einer +REAL-Zahl einen mit der richtigen Zahl von Nachkommastellen ver­ +sehenen, variabel langen Text zu machen. + +#proc# +TEXT PROC f (TEXT CONST feldname) +#endproc# + Liefert den Inhalt des angegebenen Feldes. +#f2# + FEHLER: +#f1# + #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# + +#proc# +REAL PROC wert (TEXT CONST feldname) +#endproc# + Liefert den Inhalt des angegebenen Feldes als REAL. Dabei + werden nichtnumerische Zeichen ignoriert, ausgenommen das + Minuszeichen und das eingestellte Dezimalkomma (s. 'dezimal­ + komma'). Tritt kein numerisches Zeichen auf, wird der Wert 0.0 + geliefert. +#f2# + FEHLER: +#f1# + #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# + +#proc# +REAL PROC wert (TEXT CONST feldname, INT CONST kommastellen) +#endproc# + Wie 'wert' mit einem Parameter, nur daß das Ergebnis auf die + angegebene Anzahl von Nachkommastellen gerundet wird. +#f2# + FEHLER: +#f1# + #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# + +#proc# +TEXT PROC textdarstellung (TEXT CONST anzeigetext) +#endproc# + Liefert 'anzeigetext' als TEXT-Denoter, also in Anführungs­ + strichen. Anführungsstriche im Text werden dabei verdoppelt. + Steuerzeichen von 0 bis 31 werden in lesbare Form gebracht. + +#proc# +TEXT PROC zahltext (REAL CONST wert, INT CONST kommastellen) +#endproc# + Liefert den Text des angegebenen Werts mit dem eingestellten + Dezimalkomma und mit der angegebenen Zahl von Nachkomma­ + stellen. Sind die Kommastellen 0, wird auch das Komma unter­ + drückt. Der Text erhält soviel Stellen, wie zur Darstellung + benötigt werden. + +#proc# +TEXT PROC zahltext (TEXT CONST feldname, + INT CONST kommastellen) +#endproc# + Wirkt wie 'zahltext (wert (feldname), kommastellen)'. + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.9 b/app/eudas/4.4/doc/ref-manual/eudas.ref.9 new file mode 100644 index 0000000..85dd337 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.9 @@ -0,0 +1,184 @@ +#type ("prop")##limit (14.0)# +#format# +#page (93)# +#kapitel ("9", "Anzeige", " ", " ")# + + + +#abschnitt ("9.1", "FENSTERVERWALTER", "Fensterverwalter")# + +Funktionen, die einen Teil des Bildschirms in einem rechteckigen +Fenster beschreiben, werden über den Fensterverwalter untereinan­ +der koordiniert. Jede Funktion fordert für ihren Fensterbereich eine +Variable vom Typ FENSTER an. Vor jedem Bildschirmzugriff kann die +Funktion erfahren, ob andere Programme den Bildschirm im Fenster­ +bereich überschrieben haben. Gleichzeitig meldet sie damit Verän­ +derungen an anderen Fenstern an, die sich mit dem eigenen über­ +schneiden. + +#proc# +PROC fenster initialisieren (FENSTER VAR neu) +#endproc# + Jede Fenstervariable muß vor Benutzung initialisiert werden. + +#proc# +PROC fenstergroesse setzen (FENSTER VAR fenster, + INT CONST x anf, y anf, + x laenge, y laenge) +#endproc# + Die Fenstergröße des Fensters wird gesetzt. 'x anf' und 'y anf' + werden von 1..n gezählt. Die Größe eines 24x80-Bildschirms + entspricht den Angaben (1, 1, 79, 24). Da das letzte Zeichen + einer Zeile wegen Rollgefahr nicht benutzt werden kann, werden + nur 79 Spalten angegeben. +#f2# + FEHLER: +#f1# + #on("i")#zu viele Fenster#off("i")# + Es sind nur 16 verschiedene Fenstergrößen möglich. + +#proc# +PROC fenstergroesse (FENSTER CONST fenster, + INT VAR x anf, y anf, + x laenge, y laenge) +#endproc# + Meldet die eingestellte Größe des Fensters. + +#proc# +PROC fensterzugriff (FENSTER CONST mein fenster, + BOOL VAR veraendert) +#endproc# + Ein Zugriff auf 'mein fenster' wird angemeldet. 'veraendert' gibt + an, ob das Fenster seit dem letzten Zugriff durch einen über­ + schneidenden Zugriff verändert wurde. Beim ersten Zugriff ist + 'veraendert' immer TRUE. + +#proc# +PROC fenster veraendert (FENSTER CONST fenster) +#endproc# + Falls ein Unterprogramm eine FENSTER-Variable des Hauptpro­ + grammes benutzt, kennzeichnet das Unterprogramm das Fenster + mit dieser Prozedur als benutzt, damit das Hauptprogramm das + Bild neu ausgibt. + +#proc# +PROC bildschirm neu +#endproc# + Gibt an, daß der Bildschirm von einer Funktion benutzt wurde, + die ihre Zugriffe nicht über den Fensterverwalter anmeldet. + Alle Fenster werden als verändert gekennzeichnet. + + +#abschnitt ("9.2", "ANZEIGEGRUNDFUNKTIONEN", "Anzeigegrundfunktionen")# + +Sämtliche Anzeigefunktionen werden in einem Fenster abgewickelt, +dessen Größe durch 'anzeigefenster' bestimmt wird. + Die Funktion 'bildausgeben' übernimmt die eigentliche Ausgabe. +Dabei kann durch Parameter mitgeteilt werden, ob sich an der Datei +außer der Markierung etwas geändert hat. Hat sich nichts geändert, +wird zur Optimierung unter Umständen nur die Markierung neu +ausgegeben. Das Bild wird jedoch auf jeden Fall ganz ausgegeben, +wenn das Fenster von anderer Seite verändert wurde. Auch das +Öffnen einer neuen Datei wird automatisch erkannt und richtig +behandelt. + Welche Felder dargestellt werden sollen, kann durch 'feldaus­ +wahl' angegeben werden. Dabei ist für jeden Anzeigemodus eine +eigene Feldauswahl möglich. Die Darstellung kann durch 'rollen' in +vertikaler Richtung verschoben werden. + Mit 'uebersicht' kann die Übersicht ausgegeben werden. Ihre +Größe wird durch 'uebersichtsfenster' angegeben. + +#proc# +PROC anzeigefenster (INT CONST x anf, y anf, + x laenge, y laenge) +#endproc# + Das Anzeigefenster wird in der entsprechenden Größe reser­ + viert. +#f2# + FEHLER: +#f1# + #on("i")#Anzeigefenster zu klein#off("i")# + Das Fenster ist zu schmal (< 40 Zeichen), um eine sinnvolle + Anzeige zuzulassen. + +#proc# +PROC bild ausgeben (BOOL CONST datei veraendert) +#endproc# + Im Anzeigefenster wird das Bild je nach eingestelltem Modus + ausgegeben, wenn das Fenster verändert wurde oder 'satz ver­ + aendert' TRUE ist. 'satz veraendert' muß immer dann angegeben + werden, wenn am Inhalt der virtuellen Datei etwas verändert + wurde. + +#proc# +PROC feldauswahl (TEXT CONST feldcode) +#endproc# + Die im aktuellen Modus anzuzeigenden Felder und ihre Reihen­ + folge werden ausgewählt. Dabei enthält 'feldcodes' an der i-ten + Stelle den Code der Feldnummer des Feldes, das an i-ter Posi­ + tion erscheinen soll. + +#proc# +PROC rollen (INT CONST anzahl) +#endproc# + Die Darstellung wird um die angegebene Anzahl von Zeilen + gerollt. Bei einer positiven Angabe wird zu höheren Feld- bzw. + Satznummern gerollt (Bild bewegt sich umgekehrt). Beim ersten + bzw. letzten Feld bzw. Satz hört das Rollen automatisch auf. + +#proc# +PROC uebersichtsfenster (INT CONST x anf, y anf, + x laenge, y laenge) +#endproc# + Legt die Größe des Übersichtsfensters fest. + +#proc# +PROC uebersicht (TEXT CONST feldauswahl) +#endproc# + Ruft eine Übersicht der aktuellen Datei auf, in der geblättert + und markiert werden kann. In 'feldauswahl' steht an der Stelle + i der Code der Feldnummer, die als i-tes in der Aufzählung + erscheinen soll. + + +#abschnitt ("9.3", "EDITORFUNKTIONEN", "Editorfunktionen")# + +Es stehen drei Funktionen zur Verfügung, die den Editor im Anzei­ +gemodus benutzen. Sie dienen zum Einfügen und Ändern sowie zum +Eingeben eines Suchmusters. + Der Editor wird durch ESC 'q' verlassen. Weitere ESC-Funk­ +tionen, die zum Verlassen führen sollen, können durch 'exit zeichen' +angegegeben und nach Funktionsausführung mit 'exit durch' abge­ +fragt werden. + +#proc# +PROC aendern (PROC hilfe) +#endproc# + Bietet den aktuellen Satz zum Ändern an. Steht die virtuelle + Datei am Ende, wird automatisch 'einfuegen' durchgeführt. Bei + ESC '?' wird 'hilfe' aufgerufen. + +#proc# +PROC einfuegen (PROC hilfe) +#endproc# + Fügt vor dem aktuellen Satz einen Satz ein, dessen Inhalt im + Editor angegeben wird. Bei ESC '?' wird 'hilfe' aufgerufen. + +#proc# +PROC suchen (PROC hilfe) +#endproc# + Im Editor wird eine neue Suchbedingung eingegeben. Bei ESC '?' + wird 'hilfe' aufgerufen. + +#proc# +PROC exit durch (TEXT CONST zeichenkette) +#endproc# + Gibt die Zeichen an, die beim Drücken nach ESC zum Verlassen + des Editors führen sollen. Die eingegebenen Daten werden je­ + doch vorher auf jeden Fall noch verarbeitet. + +#proc# +TEXT PROC exit durch +#endproc# + Gibt an, durch welches Zeichen der Editor verlassen wurde. + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.fehler b/app/eudas/4.4/doc/ref-manual/eudas.ref.fehler new file mode 100644 index 0000000..6ce4287 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.fehler @@ -0,0 +1,129 @@ +#type ("prop")##limit (14.0)# +#format# +#page (115)# +#kapitel (" ", "Fehlermeldungen", " ", " ")# + + + +In diesem Kapitel sind alle Fehlermeldungen aufgeführt, die von +EUDAS erzeugt werden und zum Abbruch einer Funktion führen +können. + +#on("i")#'n' ist keine Feldnummer#off("i")# + Es wurde eine Nummer als Feldnummer angegeben, die nicht er­ + laubt ist. + +#on("i")#Datei ist keine EUDAS-Datei#off("i")# + Es wurde versucht, eine andere Datei als EUDAS-Datei zu bear­ + beiten. + +#on("i")#inkonsistente EUDAS-Datei#off("i")# + Die interne Struktur der Datei ist zerstört. Kann durch Hardware­ + probleme (Archiv-Lesefehler) oder EUDAS-interne Fehler ent­ + standen sein. + +#on("i")#EUDAS-Datei voll#off("i")# + Eine EUDAS-Datei kann nur eine bestimmte Anzahl von Sätzen + aufnehmen (mindestens 5000). + +#on("i")#Nicht erlaubtes Dezimalkomma#off("i")# + Als Dezimalkomma kann nur ein einzelnes Zeichen angegeben + werden. + +#on("i")#Zuviel Dateien geoeffnet#off("i")# + Es können nicht mehr als 10 Dateien gleichzeitig geöffnet, geket­ + tet und gekoppelt sein. + +#on("i")#Zu viele Felder#off("i")# + Alle geöffneten Dateien zusammen dürfen nicht mehr als 256 + Felder der virtuellen Datei ergeben. + +#on("i")#Zu viele Koppelfelder#off("i")# + Es dürfen insgesamt nicht mehr als 32 Koppelfelder entstehen. + +#on("i")#keine Koppelfelder vorhanden#off("i")# + Eine Datei kann nicht gekoppelt werden, wenn Sie kein Koppelfeld + besitzt. + +#on("i")#keine Datei geoeffnet#off("i")# + Es kann nicht gekettet oder gekoppelt werden, wenn noch keine + Datei geöffnet wurde. Ebenfalls sind keine Verarbeitungsproze­ + duren möglich. + +#on("i")#Nicht möglich, wenn auf Koppeldatei geschaltet#off("i")# + Wenn auf eine Koppeldatei umgeschaltet wurde, ist Öffnen, Ketten + und Koppeln nicht möglich. + +#on("i")#kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien#off("i")# + Wenn Dateien gekettet oder gekoppelt sind, ist Sortieren und + Ändern der Feldstruktur nicht möglich. + +#on("i")#Datei nicht gesichert#off("i")# + Eine vorher geöffnete Datei ist verändert und nicht gesichert. + +#on("i")#Datei wird von anderer Task geändert#off("i")# + Das Öffnen der Datei zum Ändern ist im Moment nicht möglich, da + ein anderer Benutzer sie bereits ändert. + +#on("i")#Suchmuster zu umfangreich#off("i")# + Ein Suchmuster darf nicht mehr als 100 Vergleiche erfordern. + +#on("i")#direkt Drucken nicht moeglich#off("i")# + Entweder ist kein Druckprogramm installiert oder die Spooltask + reagiert nicht. + +#on("i")#Das Feld "Feldname" ist nicht definiert#off("i")# + Sie haben einen falschen Namen angegeben. + +#on("i")#Kein Satz zum Tragen vorhanden#off("i")# + Es wurde versucht, aus einer leeren Datei oder am Dateiende zu + tragen. + +#on("i")#Zieldatei hat falsche Felderzahl#off("i")# + Eine Zieldatei beim Tragen hat weniger Felder als die aktuelle + Datei. Daher würden beim Tragen Informationen verlorengehen. + +#on("i")#Zieldatei darf nicht geöffnet sein#off("i")# + Eine geöffnete Datei ist als Zieldatei nicht zulässig. + +#on("i")#Das Feld "Feldname" verletzt die Pruefbedingung#off("i")# + Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und + die Bedingung war nicht erfüllt. + +#on("i")#Das Feld "Feldname" ist nicht in der Wertemenge#off("i")# + Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und + die Bedingung war nicht erfüllt. + +#on("i")#Das Feld "Feldname" stimmt nicht mit der Maske ueberein#off("i")# + Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und + die Bedingung war nicht erfüllt. + +#on("i")#Zu viele Fenster#off("i")# + Es sind nicht mehr als 16 verschiedene Größen von Fenstern + möglich. + +#on("i")#Fenster zu klein#off("i")# + Ein Menü wurde in einem zu kleinen Fenster aufgerufen. + +#on("i")#Hilfe existiert nicht#off("i")# + Es wurde versucht, eine nicht vorhandene Hilfestellung aufzu­ + rufen. + +#on("i")#Hilfe ist leer#off("i")# + Die angewählte Hilfestellung enthält keinen Text. + +#on("i")#Anzeigefenster zu klein#off("i")# + Das Anzeigefenster muß mindestens 40 Zeichen breit sein. + +#on("i")#Ungueltige Satznummer#off("i")# + Der angegebene Text stellt keine Satznummer dar. + +#on("i")#kein rekursiver Aufruf#off("i")# + Innerhalb von EUDAS darf 'eudas' nicht erneut aufgerufen wer­ + den. + +#on("i")#Task existiert nicht#off("i")# + Es wurde versucht, eine nicht existente Task als Manager einzu­ + stellen. + + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.inhalt b/app/eudas/4.4/doc/ref-manual/eudas.ref.inhalt new file mode 100644 index 0000000..a9ac27f --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.inhalt @@ -0,0 +1,137 @@ +#type ("prop")##limit (14.0)# +#format# +#page(3)# +#kapitel (" ", " Inhalt", "", " ")# + + + +#type ("12")# + Vorwort . . . . . . . . . . . . . . . . . . . i + Inhalt . . . . . . . . . . . . . . . . . . . . iii + + +#type ("prop")# +#abschnitt ("I.", "FUNKTIONEN ZUM NACHSCHLAGEN", "Funktionen zum Nachschlagen")# + +#type ("prop")# +#on("b")#1 Zustände und Bedienung#off("b")# +#free (0.2)# +#type ("12")# +1.1 Zustände . . . . . . . . . . . . . . . . . . . 3 +1.2 Menüs . . . . . . . . . . . . . . . . . . . . 8 +1.3 Auswahl . . . . . . . . . . . . . . . . . . . 8 +1.4 Hilfe und Dialog . . . . . . . . . . . . . . . 9 +1.5 Editor . . . . . . . . . . . . . . . . . . . . 9 + +#type ("prop")# +#on("b")#2 Zusammenstellung der Funktionen#off("b")# +#free (0.2)# +#type ("12")# +2.1 Menü 'Öffnen' . . . . . . . . . . . . . . . . 13 +2.2 Menü 'Einzelsatz' . . . . . . . . . . . . . . 17 +2.3 Menü 'Gesamtdatei' . . . . . . . . . . . . . . 21 +2.4 Menü 'Drucken' . . . . . . . . . . . . . . . . 23 +2.5 Menü 'Dateien' . . . . . . . . . . . . . . . . 25 +2.6 Menü 'Archiv' . . . . . . . . . . . . . . . . 27 +2.7 Kurzabfrage . . . . . . . . . . . . . . . . . 29 + +#type ("prop")# +#on("b")#3 Das virtuelle Dateimodell#off("b")# +#free (0.2)# +#type ("12")# +3.1 Dateistruktur . . . . . . . . . . . . . . . . 31 +3.2 Öffnen . . . . . . . . . . . . . . . . . . . . 32 +3.3 Koppeln . . . . . . . . . . . . . . . . . . . 33 +3.4 Änderungen . . . . . . . . . . . . . . . . . . 34 +3.5 Sichern . . . . . . . . . . . . . . . . . . . 36 +3.6 Umschalten auf Koppeldatei . . . . . . . . . . 36 +3.7 Mehrbenutzerbetrieb . . . . . . . . . . . . . 37 + +#type ("prop")# +#on("b")#4 Ansehen und Bearbeiten#off("b")# +#free (0.2)# +#type ("12")# +4.1 Anzeige . . . . . . . . . . . . . . . . . . . 39 +4.2 Satzauswahl . . . . . . . . . . . . . . . . . 42 +4.3 Sortieren und Reorganisieren . . . . . . . . . 44 +4.4 Bearbeiten . . . . . . . . . . . . . . . . . . 46 + +#type ("prop")# +#on("b")#5 Drucken und Druckmuster#off("b")# +#free (0.2)# +#type ("12")# +5.1 Druckmustersyntax . . . . . . . . . . . . . . 49 +5.2 Der Druckvorgang . . . . . . . . . . . . . . . 51 +5.3 Interpretation von Musterzeilen . . . . . . . 52 +5.4 Anschluß zum ELAN-Compiler . . . . . . . . . . 56 +5.5 Fehlermeldungen . . . . . . . . . . . . . . . 57 + + +#type ("prop")# +#abschnitt ("II.", "EUDAS FÜR PROGRAMMIERER", "EUDAS für Programmierer")# + +#type ("prop")# +#on("b")#6 Struktur von EUDAS-Dateien#off("b")# +#free (0.2)# +#type ("12")# +6.1 Der Datentyp SATZ . . . . . . . . . . . . . . 61 +6.2 Der Datentyp EUDAT . . . . . . . . . . . . . . 63 +6.3 Satzposition . . . . . . . . . . . . . . . . . 64 +6.4 Satzzugriffe . . . . . . . . . . . . . . . . . 65 +6.5 Sortieren und Reorganisieren . . . . . . . . . 66 +6.6 EUDAS-Dateien als Assoziativspeicher . . . . . 68 + +#type ("prop")# +#on("b")#7 Verwaltung der offenen Dateien#off("b")# +#free (0.2)# +#type ("12")# +7.1 Dateiverwaltung . . . . . . . . . . . . . . . 71 +7.2 Feldstruktur . . . . . . . . . . . . . . . . . 75 +7.3 Positionierung . . . . . . . . . . . . . . . . 77 +7.4 Änderungen . . . . . . . . . . . . . . . . . . 78 +7.5 Suchbedingungen . . . . . . . . . . . . . . . 79 + +#type ("prop")# +#on("b")#8 Funktionen zur Bearbeitung#off("b")# +#free (0.2)# +#type ("12")# +8.1 Drucken . . . . . . . . . . . . . . . . . . . 83 +8.2 Kopieren . . . . . . . . . . . . . . . . . . . 85 +8.3 Tragen . . . . . . . . . . . . . . . . . . . . 87 +8.4 Verarbeitung . . . . . . . . . . . . . . . . . 89 +8.5 Funktionen in Ausdrücken . . . . . . . . . . . 90 + +#type ("prop")# +#on("b")#9 Anzeige#off("b")# +#free (0.2)# +#type ("12")# +9.1 Fensterverwalter . . . . . . . . . . . . . . . 93 +9.2 Anzeigegrundfunktionen . . . . . . . . . . . . 94 +9.3 Editorfunktionen . . . . . . . . . . . . . . . 95 + +#type ("prop")# +#on("b")#10 Programmierung der Menüs#off("b")# +#free (0.2)# +#type ("12")# +10.1 Menüformat . . . . . . . . . . . . . . . . . . 97 +10.2 Verwaltung der Menüs . . . . . . . . . . . . . 99 +10.3 Aufruf . . . . . . . . . . . . . . . . . . . . 101 +10.4 Dialog . . . . . . . . . . . . . . . . . . . . 103 + +#type ("prop")# +#on("b")#11 Programmierung von Anwendungen#off("b")# +#free (0.2)# +#type ("12")# +11.1 Musterprogramme . . . . . . . . . . . . . . . 105 +11.2 Dateianwendungen . . . . . . . . . . . . . . . 109 +11.3 Integrierte Anwendungen . . . . . . . . . . . 111 + + +#type ("prop")# +#abschnitt ("III.", "ANHANG", "Anhang")# + +#type ("12")# + Fehlermeldungen . . . . . . . . . . . . . . . 115 + Prozeduren mit Parametern . . . . . . . . . . 119 + Register . . . . . . . . . . . . . . . . . . . 125 + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.macros b/app/eudas/4.4/doc/ref-manual/eudas.ref.macros new file mode 100644 index 0000000..e86794e --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.macros @@ -0,0 +1,70 @@ +#*format# +#limit (13.5)##start (3.5,2.5)##pagelength (21.0)##block# +#:firsthead (false)# +#linefeed (1.07)# +#*macro end# +#*text# +#type ("prop10")# +#linefeed (1.07)# +#*macro end# +#*beispiel# +#type ("12")# +#linefeed (0.97)# +#*macro end# +#*bildschirm# +#type ("15")# +#linefeed(0.83)# +#*macro end# +#*proc# +#type ("12")# +#*macro end# +#*endproc# +#free (0.1)# +#type ("prop10")# +#linefeed (1.07)# +#*macro end# +#*abschnitt ($1,$2,$3)# +#headodd# +#on("b")#$1#right#$3 %#off("b")# +#free (1.0)# +#end# +#on("b")##ib(9)#$1#ie(9,"   $3")# $2#off("b")# +#*macro end# +#*char($1)# +$1 +#*macro end# +#*kapitel ($1,$2,$3,$4)# +#free (1.3)# +#"nlq"# +#type("roman.24")# +#on("b")##center#$1#off("b")# +#free (0.2)# +#type ("roman.18")# +#on("b")##center#$2 #off("b")# +#on("b")##center# $3#off("b")# +#on("b")##center#$4#off("b")# +#type ("prop10")# +#free (0.6)# +#headeven# +#on("b")#% $2 $3 $4#off("b")# +#free (1.0)# +#end# +#headodd# +#right##on("b")#%#off("b")# +#free (1.0)# +#end# +#*macro end# +#*f2# +#free (0.2)# +#*macro end# +#*a ($1)# +#on("b")#$1.#off("b")#  +#*macro end# +#*bsp ($1)# +#type("12")#$1#type("prop")# +#*macro end# +#*f1# +#free (0.1)# +#*macro end# + + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.proz b/app/eudas/4.4/doc/ref-manual/eudas.ref.proz new file mode 100644 index 0000000..7ec9b50 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.proz @@ -0,0 +1,195 @@ +#type ("prop")##limit (14.0)# +#format# +#page (119)# +#kapitel (" ", "Prozeduren", "mit", "Parametern")# + + + +#beispiel# +:= (SATZ VAR, SATZ CONST) 6.1 + +aendern (PROC hilfe) 9.3 +aendern erlaubt : BOOL 7.1 +aenderungen eintragen 7.4 +anzahl dateien : INT 7.1 +anzahl felder : INT 7.2 +anzahl koppeldateien : INT 7.1 +anzeigefenster (INT CONST x anf, y anf, + x laenge, y laenge) 9.2 +auf satz (EUDAT VAR, INT CONST satznr) 6.3 +auf satz (EUDAT VAR, TEXT CONST muster) 6.3 +auf satz (INT CONST satznr) 7.3 +ausfuehrtaste (TEXT CONST taste) 10.3 +auswahl anbieten (TEXT CONST name, FENSTER CONST f, + TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) 10.3 + +bild ausgeben (BOOL CONST datei veraendert) 9.2 +bildschirm neu 9.1 + +dateiende (EUDAT CONST) : BOOL 6.3 +dateiende : BOOL 7.3 +dateien loeschen (BOOL CONST auch geaenderte) 7.1 +dateiversion : INT 7.1 +dezimalkomma (TEXT CONST komma) 6.5 +dezimalkomma : TEXT 6.5 +dialog 10.4 +dialogfenster (INT CONST x anf, y anf, + x laenge, y laenge) 10.4 +direkt drucken (BOOL CONST ja) 8.1 +druckdatei (TEXT CONST dateiname) 8.1 +drucke (TEXT CONST mustername) 8.1 + +editget (TEXT CONST prompt, TEXT VAR eingabe, + TEXT CONST res, hilfe) 10.4 +eindeutige felder (INT CONST anzahl) 8.3 +einfuegen (PROC hilfe) 9.3 +eudas dateiname (INT CONST dateinr) : TEXT 7.1 +EUDAT 6.2 +exit durch (TEXT CONST exit zeichen) 9.3 +exit durch : TEXT 9.3 + +f (TEXT CONST feldname) : TEXT 8.5 +fehler ausgeben 10.4 +feld aendern (SATZ VAR, INT CONST feldnr, + TEXT CONST inhalt) 6.1 +feld aendern (EUDAT VAR, INT CONST feldnr, + TEXT CONST inhalt) 6.4 +feld aendern (INT CONST feldnr, TEXT CONST inhalt) 7.2 +feldauswahl (TEXT CONST feldcodes) 9.2 +feld bearbeiten (SATZ CONST, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 6.1 +feld bearbeiten (EUDAT CONST, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 6.4 +feld bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 7.2 +felderzahl (SATZ CONST) : INT 6.1 +felderzahl (EUDAT CONST) : INT 6.2 +feldindex (SATZ CONST, TEXT CONST muster) : INT 6.1 +feldinfo (EUDAT VAR, INT CONST feldnr, info) 6.5 +feldinfo (EUDAT CONST, INT CONST feldnr) : INT 6.5 +feld lesen (SATZ CONST, INT CONST feldnr, + TEXT VAR inhalt) 6.1 +feld lesen (EUDAT CONST, INT CONST feldnr, + TEXT VAR inhalt) 6.4 +feld lesen (INT CONST feldnr, TEXT VAR inhalt) 7.2 +feldmaske (TEXT CONST feldname, maske) 8.3 +feldnamen aendern (EUDAT VAR, SATZ CONST namen) 6.2 +feldnamen bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 7.2 +feldnamen lesen (EUDAT CONST, SATZ VAR namen) 6.2 +feldnamen lesen (INT CONST feldnr, TEXT VAR name) 7.2 +feldnummer (TEXT CONST feldname) : INT 7.2 +FENSTER 9.1 +fenstergroesse (FENSTER CONST f, + INT VAR x anf, y anf, + x laenge, y laenge) 9.1 +fenstergroesse setzen (FENSTER VAR fenster, + INT CONST x anf, y anf, + x laenge, y laenge) 9.1 +fenster initialisieren (FENSTER VAR fenster) 9.1 +fenster veraendert (FENSTER CONST fenster) 9.1 +fensterzugriff (FENSTER CONST fenster, + BOOL VAR veraendert) 9.1 + +global manager 10.2 +gruppenwechsel (INT CONST gruppennr) : BOOL 8.1 + +hilfe anbieten (TEXT CONST name, FENSTER CONST f) 10.3 +hole satz (TEXT CONST dateiname) 8.3 + +inhalt veraendert (INT CONST dateinr) : BOOL 7.1 +ja (TEXT CONST frage, hilfe) : BOOL 10.4 + +K (TEXT CONST feldname, ausdruck) 8.2 +kette (TEXT CONST dateiname) 7.1 +kopiere (TEXT CONST dateiname, FILE VAR muster) 8.2 +kopiere (TEXT CONST dateiname, PROC kopierfunktion) 8.2 +kopple (TEXT CONST dateiname) 7.1 + +lfd nr : TEXT 8.1 + +markierte saetze : INT 7.5 +markierung aendern 7.5 +markierungen loeschen 7.5 +maxdruckzeilen (INT CONST anzahl zeilen) 8.1 +menue anbieten (ROW 6 TEXT CONST menuenamen, + FENSTER VAR f, + BOOL CONST esc erlaubt, + PROC (INT CONST, INT CONST) interpreter) 10.3 +menuedaten einlesen (TEXT CONST dateiname) 10.2 +menue loeschen (TEXT CONST name, INT CONST index) 10.2 +menue loeschen (BOOL CONST hilfen reduzieren) 10.2 +menue manager (DATASPACE VAR ds, + INT CONST order, phase, + TASK CONST order task) 10.2 +menuenamen (INT CONST index) : THESAURUS 10.2 + +neuer dialog 10.4 +notizen aendern (EUDAT VAR, INT CONST notiz nr, + TEXT CONST notizen) 6.2 +notizen lesen (EUDAT CONST, INT CONST notiz nr, + TEXT VAR notizen) 6.2 + +oeffne (EUDAT VAR, TEXT CONST dateiname) 6.2 +oeffne (TEXT CONST dateiname, + BOOL CONST aendern erlaubt) 7.1 + +pruefe (TEXT CONST feldname, BOOL CONST bedingung) 8.3 + +reorganisiere (TEXT CONST dateiname) 6.5 +rollen (INT CONST anzahl) 9.2 + +saetze (EUDAT CONST) : INT 6.3 +SATZ 6.1 +satz aendern (EUDAT VAR, SATZ CONST neuer satz) 6.4 +satz ausgewaehlt : BOOL 7.5 +satz einfuegen (EUDAT VAR, SATZ CONST satz) 6.4 +satz einfuegen 7.4 +satz initialisieren (SATZ VAR satz) 6.1 +satzkombination : INT 7.3 +satz lesen (EUDAT CONST, SATZ VAR satz) 6.4 +satz loeschen (EUDAT VAR) 6.4 +satz loeschen 7.4 +satz markiert : BOOL 7.5 +satznr (EUDAT CONST) : INT 6.3 +satznummer : INT 7.3 +sichere (INT CONST dateinr, TEXT CONST dateiname) 7.1 +sortiere (EUDAT VAR, TEXT CONST reihenfolge) 6.5 +sortiere (EUDAT VAR) 6.5 +sortierreihenfolge (EUDAT CONST) : TEXT 6.5 +status anzeigen (TEXT CONST zeile) 10.3 +std kopiermuster (TEXT CONST dateiname, FILE VAR f) 8.2 +suchbedingung (INT CONST feldnr, + TEXT CONST bedingung) 7.5 +suchbedingung loeschen 7.5 +suchen (PROC hilfe) 9.3 + +textdarstellung (TEXT CONST text) : TEXT 8.5 +trage (TEXT CONST dateiname, FILE VAR protokoll, + BOOL CONST test) 8.3 +trage satz (TEXT CONST dateiname) 8.3 + +unsortierte saetze (EUDAT CONST) : INT 6.5 + +V (TEXT CONST feldname, ausdruck) 8.4 +verarbeite (FILE VAR verarbeitungsmuster) 8.4 +verarbeite (PROC verarbeitungsfunktion) 8.4 + +waehlbar (INT CONST menuenr, funktionsnr, + BOOL CONST moeglich) 10.3 +wahl (INT CONST stelle) : INT 10.3 +weiter (EUDAT VAR) 6.3 +weiter (EUDAT VAR, TEXT CONST muster) 6.3 +weiter (INT CONST modus) 7.3 +wert (TEXT CONST feldname) : REAL 8.5 +wert (TEXT CONST feldname, INT CONST kommastellen) : REAL 8.5 +wertemenge (TEXT CONST feldname, menge) 8.3 + +zahltext (REAL CONST wert, INT CONST kommastellen) : TEXT 8.5 +zahltext (TEXT CONST feldname, + INT CONST kommastellen) : TEXT 8.5 +zurueck (EUDAT VAR) 6.3 +zurueck (EUDAT VAR, TEXT CONST muster) 6.3 +zurueck (INT CONST modus) 7.3 + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.reg b/app/eudas/4.4/doc/ref-manual/eudas.ref.reg new file mode 100644 index 0000000..61ebef9 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.reg @@ -0,0 +1,426 @@ +#type ("prop")##limit (6.5)# +#format# +#page (125)# +#kapitel (" ", "Register ", "", " ")# + + + +#columns (2, 0.5)# +#limit (6.5)# +ABKUERZUNGEN-Anweisung 49 +Abkürzungsteil 49 +Abkürzungsverzeichnis 68 +Abkürzungszeile 50 +Abschlußzeile 39 +aendern 96 +Ändern 10, 19 + -, nach Vorschrift 48 +aendern erlaubt 74 +Änderungen 34 +aenderungen eintragen 79 +Änderungsmuster 21 +Alternative 43 +Ankreuzen 8 +anzahl dateien 74 +anzahl felder 75 +anzahl koppeldateien 74 +Anzeige 39, 93 +anzeigefenster 95 +Arbeitskopie 13, 32 + -, löschen 15, 36 + -, sichern 15, 36 +Archivmanager 28 + -, reservieren 29 +Archiv (Menü) 27 +Archivübersicht drucken 27 +Assoziativspeicher 68 +auf koppeldatei 74 +Aufräumen 26 +auf satz 65, 78 +Auf Satz Nr. 17 +Ausdrucken 24 +Ausführen 8 +ausfuehrtaste 8, 102 +AUSWAHL 97 +AUSWAHL: 4 +Auswahl 8 + -, Format 98 +auswahl anbieten 103 + +Bearbeiten 46 +BILD 97 +bild ausgeben 95 +bildschirm neu 94 + +Datei, aufräumen 26 + -, kopieren (logisch) 25 + -, kopieren vom Archiv 27 + -, löschen 25 + -, löschen auf Archiv 28 + -, Platzbedarf 26 + -, reorganisieren 26 + -, schreiben auf Archiv 27 + -, umbenennen 25 + -, virtuelle 32, 71 +Dateianwendungen 109 +Dateien Archiv, Übersicht 27 +dateiende 64, 78 +dateien loeschen 74 +Dateien (Menü) 25 +Dateien System, Übersicht 25 +Dateilimit 52 +Dateimanager 28 +Dateiname 40 +dateiversion 75 +DATUM 45 +Dezimalkomma 45 +dezimalkomma 67 +dialog 104 +Dialog 9, 103 +dialogfenster 104 +DIN 45 +direkt drucken 83f. +Druckausgabe, Richtung 23 +druckdatei 85 +drucke 84 +Drucken 23, 49, 83 + -, Archivübersicht 27 +Drucken (Menü) 23 +Druckmuster 23, 49, 83 + -, Fehler 56 +Druckvorgang 51 + +editget 104 +EDITIEREN: 6 +Editieren 23 + -, Zeile 9 +Editor 9, 29 +eindeutige felder 47, 89 +einfuegen 96 +Einfügen 10, 19 + -, Satz 36 + -, Zeile 10 +EINGABE: 4 +Eingabe 9 +Einzelsatz (Menü) 17 +ELAN-Compiler 56 +ELAN-Kommandos 8 +ENDE 97 +Endekennzeichnung 40 +ESC '?' 6 +ESC '9' 4 +ESC '1' 4 +ESC '?' 4 +ESC '?' 3 +ESC 'D' 5 +ESC ESC 3 +ESC 'F' 5f. +ESC 'g' 5 +ESC 'h' 4ff. +ESC 'K' 36 +ESC OBEN 5 +ESC 'p' 5 +ESC 'q' 4, 6 +ESC RUBIN 5 +ESC RUBOUT 5 +ESC UNTEN 5 +ESC 'w' 4f. +ESC 'z' 4f. +eudas 29 +EUDAS: 3 +EUDAS-Datei, aufspalten 110 + -, drucken 23, 49, 83 + -, einrichten 13 + -, ketten 14, 32 + -, kopieren 21, 46, 85 + -, koppeln 14, 32 + -, nach Vorschrift ändern 48 + -, öffnen 13, 32 + -, reorganisieren 67 + -, sortieren 22 + -, Struktur 31, 61 + -, tragen 46, 87 + -, Übersicht 22 + -, verändern 21 +eudas dateiname 75 +EUDAT 61, 63, 109 +EUMEL-Netz 28 +exit durch 96 + +f 91 +FEHLER 5 +fehler ausgeben 104 +Feld 31 +FELD 98 +feld aendern 62, 65, 76 +Feldauswahl 20, 41, 95 +feld bearbeiten 62, 65, 76 +felderzahl 62, 63 +feldindex 62 +feldinfo 66, 77 +Feldinhalt 31, 39 +feld lesen 65, 76 +feldmaske 47, 89 +Feldmuster 53 +Feldname 31, 39 + -, ändern 16 + -, anfügen 16 +feldnamen aendern 63 +feldnamen bearbeiten 76 +feldnamen lesen 64, 76 +feldnummer 76 +Feldstruktur 15 +Feldtyp 31, 42 +Feldtypen 45, 66 + -, ändern 16 +Feldvergleich 43 +Fenster 93 +fenstergroesse 94 +fenstergroesse setzen 93 +fenster initialisieren 93 +fenster veraendert 94 +fensterzugriff 94 +folgedatei 75 +Folgezeilen 41 +Formular 39 +FRAGE: 5 +Fragen 9 +Funktion, ausführen 8 + -, gesperrte 8 + +Gesamtdatei (Menü) 21 +Gib Kommando: 6 +global manager 36, 100 +Gruppe 51 +GRUPPE-Anweisung 49 +gruppenwechsel 51, 85 + +Hauptdatei 32 +HILFE: 4 +HILFE 97, 99 +Hilfe 9 + -, Format 98 +hilfe anbieten 103 +Holen 19 +hole satz 89 +HOP LINKS 4 +HOP 'o' 4 +HOP OBEN 3ff. +HOP RECHTS 4 +HOP RETURN 4 +HOP RUBOUT 4 +HOP UNTEN 3ff. +HOP 'x' 4 + +inhalt veraendert 74 +Initialisieren 28 +Initialisierungsteil 49 + +ja 104 + +K 46, 86 +kette 73 +Ketten 14, 32 +Klassenwechsel 106 +Kombinationen 34 +Kommandos 8 +Kommandozeile 50 +kopiere 86 +Kopieren 21, 46, 85 +Kopieren (logisch) 25 +Kopieren vom Archiv 27 +Kopiermuster 21, 46 +KOPPEL 40 +Koppeldatei, umschalten auf 36 +Koppelfelder 33 +Koppeln 14, 32f. +kopple 72 +Kurzabfrage 29 + +LEER 3f. +Leertaste 8 +lfd nr 85 +lineform 24 +LINKS 3f. +Literaturangaben 108 +Löschen 25 + -, Satz 36 + -, Zeile 10 +Löschen auf Archiv 28 + +Manager 13 +Manager (Mehrbenutzer) 16, 36 +markierte saetze 81 +Markierung 18, 40, 42 +markierung aendern 81 +Markierungen löschen 22 +markierungen loeschen 81 +maxdruckzeilen 85 +MEHR-Anweisung 50 +MENUE 97 +Menü 8 + -, Aufruf 101 + -, Verwaltung 99 +menue anbieten 101 +menuedaten einlesen 99 +Menüformat 97 +menue loeschen 100 +menue manager 100 +menuenamen 100 +Modi 55 +MODUS-Anweisung 50 +Musterprogramme 105 +Musterteil 50 +Musterzeichen 53 +Musterzeile 50 + -, Interpretation 52 + +Nachbearbeiten 24 +Nachspann 49 +NACHSPANN-Anweisung 49 +Namenskonflikte 33 +neuer dialog 104 +Normalmodus 55 +Notizen 15, 31, 64 +notizen aendern 64, 77 +notizen lesen 64, 77 + +'o' 4 +OBEN 3f. +ODER-Verknüpfung 43 +oeffne 63, 72 +Öffnen 32 +Öffnen (Menü) 13 + +pageform 24 +Paralleleditor 56, 83 +Paßwort 29 +Platzbedarf 26 +Positionieren 17, 31, 64, 77 +Priorität 44 +Programmzeile 51 +Protokolldatei 47 +Prüfbedingungen 16, 31, 47, 64, + 87 +pruefe 47, 88 +Pufferplatz 54 + +RECHTS 3f. +Refinement 56 +reorganisiere 67 +Reorganisieren 26, 45, 67 +Reservieren 29 +RETURN 4 +Richtung Druckausgabe 23 +rollen 95 +Rollen 41 +RUBIN 4 +RUBOUT 4 + +saetze 64 +SATZ 61 +Satz 31 +satz aendern 66 +satz ausgewaehlt 80 +Satzauswahl 42 +Satzeditor 9 +satz einfuegen 66, 79 +Satzformular 39 +satz initialisieren 62 +satzkombination 77 +satz lesen 66 +satz loeschen 66, 79 +satz markiert 81 +satznr 64 +satznummer 77 +Satznummer 39 +Satzposition 64 +Satzzeiger 31 +Satzzugriffe 65 +Schreiben auf Archiv 27 +SEITE 99 +sichere 73 +Sichern 15, 36 +sortiere 67 +Sortieren 22, 31, 44, 66 +Sortierreihenfolge 31, 44 +sortierreihenfolge 67 +Sortierzustand 45 +Spaltendruck 52 +Sperre 36 +Standard-Kopiermuster 21, 46 +status anzeigen 103 +Statuszeile 3 +std kopiermuster 87 +Suchbedingung 17, 39, 42 + -, löschen 18 + -, setzen 18 +suchbedingung 80 +suchbedingung lesen 80 +suchbedingung loeschen 80 +suchen 96 +Suchen, Optimierung 44 +Suchmuster 42 + -, eingeben 10 + +Tabellenmodus 55 +Tasten 3 +Tastenfunktionen 3 +TEXT 45 +textdarstellung 91 +Textdatei, ausdrucken 24 + -, editieren 23 + -, nachbearbeiten 24 +Textzeile 49f. +trage 88 +Tragen 16, 19, 21, 46, 87 +trage satz 88 + +uebersicht 95 +uebersichtsfenster 95 +Umbenennen 25 +Umbruch 40, 55 +Umschalten auf Koppeldatei 36 +UND-Verknüpfung 43 +unsortierte saetze 67 +UNTEN 3f. +Überschrift 39 +Übersicht 22, 41 +Übersicht Dateien Archiv 27 +Übersicht Dateien System 25 + +V 48, 90 +Verändern 21 +verarbeite 90 +Verarbeitung 89 +Verknüpfung von Bedingungen +43 +virtuelle Datei 32, 71 +VORSPANN 98 +Vorspann 49 +VORSPANN-Anweisung 49 + +waehlbar 102 +wahl 103 +Warten 6 +weiter 65, 78 +Weiter 17 +wert 91 +wertemenge 47, 88 +WIEDERHOLUNG-Anweisung 49 +Wiederholungsteil 49 + +'x' 4 + +ZAHL 45 +zahltext 91 +Zeichen, reservierte 44 +ZEIGEN: 6 +Zeilenende 54 +Zeilenwiederholung 55 +Zielarchiv 28 +Zurück 17 +zurueck 65, 78 +Zustand 3 +Zustandsübergänge 7 + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.titel b/app/eudas/4.4/doc/ref-manual/eudas.ref.titel new file mode 100644 index 0000000..289de34 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.titel @@ -0,0 +1,68 @@ +#type ("prop")##limit (14.0)# +#format# +#free (6.0)# +#type ("roman.18")# +#on("b")#EUDAS#off("b")# +#free (1.0)# +#type ("roman.14")# +#on("b")#Anwender-#off("b")# +#on("b")#Datenverwaltungssystem#off("b")# +#free (2.0)# +#type ("10")# +#on ("b")#VERSION 4#off("b")# +#free(1.0)# +#on("u")#                                                    #off("u")# +#free (0.5)# +#on("b")#REFERENZHANDBUCH#off("b")# +#type ("prop")##block# +#page# +#free (9.5)# +Hergestellt mit Hilfe der EUMEL-Textverarbeitung und des Pro­ +gramms FontMaster der Martin Schönbeck GmbH. +#free (1.7)# +Ausgabe September 1987 + +Dieses Handbuch und das zugehörige Programm sind urheberrechtlich +geschützt. Die dadurch begründeten Rechte, insbesondere der Ver­ +vielfältigung in irgendeiner Form, bleiben dem Autor vorbehalten. + +Es kann keine Garantie dafür übernommen werden, daß das Pro­ +gramm für eine bestimmte Anwendung geeignet ist. Die Verantwor­ +tung dafür liegt beim Kunden. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrekt­ +heit und Vollständigkeit der Angaben wird aber keine Gewähr über­ +nommen. Das Handbuch kann jederzeit ohne Ankündigung geändert +werden. + +(c) Copyright 1987 Thomas Berlage + Software-Systeme + Im alten Keller 3 +#free (0.1)# + D-5205 Sankt Augustin 1 +#page# +#type ("roman.24")# +#free (7.0)# +#center##on("b")#I.#off("b")# +#free (1.0)# +#type ("roman.18")# +#center##on("b")#FUNKTIONEN#off("b")# +#center##on("b")#ZUM#off ("b")# +#center##on("b")#NACHSCHLAGEN#off("b")# +#page# +#type ("roman.24")# +#free (7.0)# +#center##on("b")#II.#off("b")# +#free (1.0)# +#type ("roman.18")# +#center##on("b")#EUDAS#off("b")# +#center##on("b")#FÜR#off ("b")# +#center##on("b")#PROGRAMMIERER#off("b")# +#page# +#free (7.0)# +#type ("roman.24")# +#center##on("b")#III.#off("b")# +#free (1.0)# +#type ("roman.18")# +#center##on("b")#ANHANG#off("b")# + diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.vorwort b/app/eudas/4.4/doc/ref-manual/eudas.ref.vorwort new file mode 100644 index 0000000..f3880f4 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.vorwort @@ -0,0 +1,29 @@ +#type ("prop")##limit (14.0)# +#format# +#page (1)# +#kapitel (" ", "Vorwort", " ", " ")# + + + +Lieber EUDAS-Benutzer! + +Dies ist das zweite Handbuch, das Sie zu EUDAS bekommen. Wenn +Sie sich mit EUDAS noch nicht auskennen, sollten Sie zunächst das +#on("i")#Benutzerhandbuch#off("i")# zu Rate ziehen, ehe Sie in dieses Handbuch +schauen. + + Das #on("i")#Referenzhandbuch#off("i")# ist in zwei Teile geteilt. Im ersten Teil +finden Sie eine Übersicht über alle EUDAS-Funktionen (im Kapitel +2) sowie zusammengefaßte Informationen über die Bedienung (Kapi­ +tel 1) und die genaue Wirkung der einzelnen Funktionen (Kapitel 3 +bis 5). Dieser Teil soll Ihnen zum Nachschlagen dienen, wenn Sie +eine bestimmte Information suchen. + Im zweiten Teil sind alle Informationen zusammengefaßt, die +ein Programmierer zur Benutzung der EUDAS-Funktionen braucht. Es +sei an dieser Stelle jedoch davon abgeraten, sofort eigene Program­ +me zu schreiben, da sich in vielen Fällen die gleiche Wirkung auch +durch Programmierung innerhalb von EUDAS-Funktionen erreichen +läßt (zum Beispiel in Druck- und Änderungsmustern). + Im Zweifelsfall orientieren Sie sich anhand von Kapitel 11, wie +Sie Ihr Problem am besten lösen können. + diff --git a/app/eudas/4.4/doc/ref-manual/ref.abb.1-1 b/app/eudas/4.4/doc/ref-manual/ref.abb.1-1 new file mode 100644 index 0000000..bc70722 --- /dev/null +++ b/app/eudas/4.4/doc/ref-manual/ref.abb.1-1 @@ -0,0 +1,58 @@ +#type ("prop")##limit (13.5)# +#start (3.5, 5.0)# +#lpos (0.5)##c pos (3.5)##c pos (4.7)##cpos (7.0)##c pos (10.5)# +#table# +      eudas   ESC q   + +    ESC ESC   ESC h +#free (0.2)# +#type ("roman.12")# +GIB KDO:     EUDAS   +#type ("prop")# +#free (0.2)# +    ESC h     +    RET        LEER  'Buchst.'   + +        ESC q           + +#type ("roman.12")# +        FEHLER + + +  WARTEN       +#type ("prop")# +      n, j   +#type ("roman.12")# +        FRAGE +#type ("prop")# + +      RET   +#type ("roman.12")# +        EINGABE +#type ("prop")# +#linefeed (0.5)# + + +        ESC z           +      ESC q   +#linefeed (1.0)# +#type ("roman.12")# +        AUSWAHL +#type ("prop")# + +      ESC q   +#type ("roman.12")# +        EDITIEREN +#type ("prop")# + +      ESC q   +#type ("roman.12")# +        SATZEDITOR +#type ("prop")# +ESC ?   ESC q         +      ESC q   +#type ("roman.12")# +HILFE       ZEIGEN +#type ("prop")# + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.1 b/app/eudas/4.4/doc/user-manual/eudas.hdb.1 new file mode 100644 index 0000000..0c6871b --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.1 @@ -0,0 +1,254 @@ +#type ("prop10")##limit (14.0)# +#page (3)# +#format# +#kapitel ("1", "Was", "kann", "EUDAS ?")# + + + +In diesem Kapitel wollen wir Ihnen erklären, was EUDAS Ihnen ei­ +gentlich bringen soll. Sie arbeiten sicher nicht nur aus Spaß am +Computer, sondern wollen ihn für bestimmte Aufgaben einsetzen. Ein +Computer kann bestimmte Aufgaben nur dann bearbeiten, wenn er +dafür programmiert worden ist. + EUDAS ist nun ein Programm, das allgemein Aufgaben der Da­ +tenverwaltung lösen kann. Zunächst wollen wir Ihnen erläutern, +wodurch dieses Anwendungsgebiet genau charakterisiert wird. + + +#abschnitt ("1.1", "TEXTVERARBEITUNG UND DATENVERWALTUNG", "Textverarbeitung und Datenverwaltung")# + +Es gibt zwei Einsatzbereiche des Computers, die von fast jedem An­ +wender benötigt werden, egal auf welchem Spezialgebiet er tätig ist: +nämlich die #on("i")#Textverarbeitung#off("i")# und die #on("i")#Datenverwaltung#off("i")#. Durch die +Unterscheidung dieser beiden Bereiche werden die charakteristi­ +schen Merkmale der Datenverwaltung abgegrenzt. + +#a ("Textverarbeitung")# Die Textverarbeitung befaßt sich damit, einen +beliebigen Text auf einem Rechner zu erfassen und anschließend +über einen Drucker wieder auszugeben. Der Sinn dieser Arbeit liegt +darin, daß man einen einmal eingegebenen Text sehr einfach ändern +kann. Außerdem kann der Computer einige unangenehme Aufgaben +übernehmen, die beim Schreiben von Texten auftreten: die Auftei­ +lung auf Zeilen und Seiten, die Seitennumerierung und vieles mehr. + Charakteristisch für die Textverarbeitung ist, daß der Einfluß +des Computers sich auf kosmetische Details beschränkt. Die Spei­ +cherung und eventuelle Aufbereitung zum Drucken haben praktisch +nichts mit dem Inhalt des Textes zu tun. Dies wäre für den Rechner +auch sehr schwierig, da die im Text enthaltenen Informationen in +menschlicher Sprache vorliegen, die für einen Rechner nicht ver­ +ständlich ist. + +#a ("Datenverwaltung")# Bei der Datenverwaltung werden ebenfalls textu­ +elle Informationen gespeichert, diese liegen aber in einer aufberei­ +teten Form vor, die einen Teil des Inhalts für den Computer ver­ +ständlich macht. Bei der Datenverwaltung werden Objekte betrach­ +tet, die verschiedene Eigenschaften haben können. Ein solches +Objekt kann z.B. eine Person sein. Als Eigenschaften werden mit +dieser Person zusammenhängende Informationen betrachetet, die für +die jeweilige Anwendung wichtig sind. + Ein Beispiel für eine solche Betrachtungsweise ist der Arbeit­ +nehmer im Betrieb. Einige der typischerweise erfaßten Daten sind +Name, Adresse, Telefon, Geburtsdatum und Geschlecht. Alle diese +Daten sind Eigenschaften oder #on("i")#Attribute#off("i")#, die einem bestimmten +Menschen mehr oder weniger fest zugeordnet sind. + Die Betonung inhaltlicher Beziehungen erleichtert es dem Com­ +puter, die gespeicherten Daten in verschiedenen Variationen aus­ +zuwerten. + +#a ("Beispiel")# Um die Unterscheidung zwischen Textverarbeitung und +Datenverwaltung deutlicher zu machen, werden im folgenden Bei­ +spiel die Informationen über eine Person in zwei unterschiedlichen +Formen dargeboten, die für den Menschen die gleiche Aussagekraft +haben: + + 1. Frau Magdalene Kant, geb. Hagedorn, wurde am 12. Januar + 1946 geboren. Sie wohnt in Bonn in der Meckenheimer Allee + 112. Seit 1977 arbeitet sie in unserer Firma. Sie ist tele­ + fonisch erreichbar unter der Nummer 0228/356782. + + 2. Name: Magdalene + Vorname: Kant + Geburtsname: Hagedorn + Geburtsdatum: 12.01.46 + Geschlecht: weiblich + Strasse: Meckenheimer Allee 112 + PLZ: 5200 + Wohnort: Bonn 1 + Vorwahl: 0228 + Telefon: 356782 + beschäftigt seit: 1977 + +Die Form der Darstellung wie in der ersten Alternative eignet sich +nur für den Menschen, da die gleiche Information auf viele ver­ +schiedene Weisen ausgedrückt werden könnte (z.B. unterschiedlicher +Satzbau). Die zweite Alternative beschränkt sich auf die für die +bestimmte Anwendung wesentlichen Zusammenhänge; der Computer +kann die Aufteilung der Information in einzelne Attribute ausnut­ +zen. + In dieser zweiten Form können Sie Daten mit EUDAS erfassen +und auch auswerten. Die Attribute können Sie jeweils passend zu +den erfaßten Daten selbst bestimmen. + Für Daten in der ersten Form steht Ihnen die EUMEL-Textver­ +arbeitung zur Verfügung. EUDAS wurde so entwickelt, daß Sie auch +Daten an die Textverarbeitung übergeben können. + Es ist nämlich möglich, einen freien Text aus der Attributdar­ +stellung automatisch zu erzeugen, indem Sie dem Computer den +Satzbau mit entsprechenden Platzhaltern vorgeben. Der Rechner +setzt die einzelnen Attribute dann an die angegebenen Stellen. +Diese Funktion ist ein Kernstück von EUDAS und wird in Abschnitt +1.3 näher erläutert. + + +#abschnitt ("1.2", "EUDAS ALS KARTEIKASTEN", "EUDAS als Karteikasten")# + +Wie Sie vielleicht schon bemerkt haben, ähnelt die zweite Form der +Darstellung einer Karteikarte, auf der Platz für bestimmte Einträge +freigehalten wird. Anhand dieses Modells können Sie sich in vielen +Fällen die Arbeitsweise von EUDAS veranschaulichen. Sie sollten die +Analogie allerdings nicht zu weit treiben: EUDAS schaufelt ja nicht +wirklich mit Karteikarten herum. Manche Funktionen sind eben +computerspezifisch und ließen sich mit Karteikarten gar nicht +durchführen. + Mit EUDAS können Sie die möglichen Einträge auf den Karteikar­ +ten (also die Attribute) völlig frei bestimmen; die einzige Beschrän­ +kung besteht darin, daß Sie in einem Karteikasten nur Karten mit +völlig gleichem Aufbau verwenden können. Wenn Sie eine neue Kar­ +teikarte entwerfen wollen, brauchen Sie nur Namen für die einzel­ +nen Einträge anzugeben. EUDAS zeigt Ihnen dann quasi eine Karte +am Bildschirm, in der diese Einträge aufgeführt sind. + Sie können nun am Bildschirm Daten auf diese Karteikarten +schreiben. Dabei dürfen die Einträge fast beliebig lang sein; wenn +der Platz auf dem Bildschirm nicht reicht, können Sie sich Ihre +überdimensionale Karteikarte in Ausschnitten ansehen. + Die einmal eingegebenen Daten bleiben nun so lange gespei­ +chert, wie Sie wollen (bzw. bis Ihr Rechner zusammenfällt). Haben +Sie beim Eintragen Fehler gemacht, können Sie diese jederzeit kor­ +rigieren oder später noch weitere Informationen ergänzen. + +#beispiel# +#free (7.5)# + +#center#Abb. 1-1 EUDAS als Karteikasten +#text# + +#a ("Anwendungen")# Mit den gespeicherten Daten können Sie nun ver­ +schiedene Dinge anstellen (bzw. vom Rechner anstellen lassen). Das +Einfachste ist natürlich das, was Sie mit einer Kartei auch machen +würden, sich nämlich einzelne Karteikarten anzuschauen. + Um eine bestimmte Karteikarte herauszufinden, geben Sie +EUDAS einfach den Inhalt vor, nach dem gesucht werden soll. Hier +zeigt sich bereits der erste Vorteil eines Computers: Die Suche in +der EUDAS-Kartei ist viel schneller, als Sie es von Hand könnten. +Außerdem kann der Rechner keine Karte zufällig übersehen. + EUDAS zeigt sich auch dann überlegen, wenn Sie einen ganz +bestimmten Teil der Kartei durchforsten müssen. Eine Bücherei muß +z.B. regelmäßig alle Bücher heraussuchen, deren Leihfrist über­ +schritten ist. Der Computer durchsucht in solchen Fällen ermü­ +dungsfrei auch große Datenmengen. + Wenn Sie die Karteikarten in einer bestimmten Reihenfolge +haben wollen, kann EUDAS auch das Sortieren übernehmen. Weitere +automatische Vorgänge betreffen z.B. das Rauswerfen überflüssiger +oder veralteter Karten. Die Einträge können auch nach einer be­ +stimmten Vorschrift alle geändert werden. Solche Aufgaben treten +z.B. in der Schule auf, wo die Schüler jedes Jahr versetzt werden +müssen (natürlich bis auf Ausnahmen). + Auch Beziehungen zwischen verschiedenen Karteien kann +EUDAS herstellen. Dies kann man noch einmal an dem Beispiel der +Bücherei illustrieren. Wenn ein Buch gefunden wurde, dessen Leih­ +frist überschritten ist, muß der zugehörige Ausleiher gefunden und +angeschrieben werden. Das Heraussuchen beider Karten kann EUDAS +in einem Arbeitsgang durchführen. + + +#abschnitt ("1.3", "DRUCKEN", "Drucken")# + +Eine besondere Stärke von EUDAS ist die Möglichkeit, die gespei­ +cherten Daten in schriftlicher Form auszuwerten. Dadurch, daß die +Daten in einer Form gespeichert sind, die den Inhalt widerspiegelt, +können die gleichen Daten in vielen verschiedenen Formen auf +Papier ausgegeben werden. + +#beispiel# + + + Karl Eudas + An Poltersdorf + XXXXXXXXXXX + XXXXXXXXXXX + + XXXX XXXXXXXXXXXX + + Lieber XXXXXXX ! + + Dies ist ein Beispiel für ein + Druckmuster. + + Viele Grüße + + + +#center#Abb. 1-2 Muster für die Druckausgabe +#text# + +Zu diesem Zweck geben Sie EUDAS ein Muster des gewünschten Aus­ +drucks vor. Der Rechner setzt dann an entsprechend markierten +Leerstellen die gespeicherten Informationen ein und druckt das +Ergebnis aus. Auf diese Weise ersparen Sie sich die umfangreiche +Schreibarbeit, die anfällt, wenn die Informationen auf den Kartei­ +karten in anderer Form benötigt werden. + Natürlich müssen Sie zum Entwerfen des Formulars kein ge­ +wiefter Programmierer sein. Wenn Sie einen Rundbrief verschicken +wollen, schreiben Sie den Brief, als wollten Sie Ihn nur einmal +schicken. Lediglich im Adressfeld müssen Sie Platzhalter an den +Stellen vorsehen, an denen später die wirklichen Adressen stehen +sollen. + +#a ("Verwendungsmöglichkeiten")# Die Möglichkeiten für solche Formulare +sind unbegrenzt. Beispiele sind Briefe, Adreßaufkleber, Überwei­ +sungsaufträge und sortierte Listen. Mit den Inhalten einer Kartei +können Sie beliebig viele verschiedene Ausgaben erzeugen. Bei dem +obigen Beispiel der Leihbücherei könnten Sie EUDAS dazu einsetzen, +nicht nur die säumigen Ausleiher herauszufinden, sondern die Mah­ +nung gleich fertig für einen Fensterbriefumschlag herzustellen. Für +den Bediener bliebe die einzige Tätigkeit, diesen Vorgang anzuwer­ +fen. + Wie weiter oben schon erwähnt, können Sie diese Ausgaben von +EUDAS auch zur Textverarbeitung übernehmen. So können Sie zum +Beispiel die Literaturliste für ein Buch mit EUDAS führen und Aus­ +züge später jeweils an die passenden Stellen einfügen. + +#a ("Berechnungen")# Die Druckfunktion von EUDAS kann jedoch nicht nur +zum Ausfüllen von Formularen verwendet werden. Wenn Sie Berech­ +nungen anstellen oder Auswertungen vornehmen wollen, können Sie +im Druckmuster auch Anweisungen der Sprache ELAN verwenden. +Damit haben Sie eine komplette Programmiersprache für Ihre Muster +zur Verfügung. + Ehe Sie einen Schreck bekommen: Selbst für komplizierte Muster +brauchen Sie nur einen ganz kleinen Teil von ELAN zu beherrschen, +da die meiste Arbeit immer von EUDAS übernommen wird (Sie müssen +also nicht etwa selber ein ganzes Programm schreiben). + Anwendungen für diese Möglichkeit gibt es genug. Angefangen +von einfachen Zählungen bis hin zu statistischen Auswertungen, +von einfachen Summen bis zum kompletten Rechnungsschreiben. +Immer nimmt Ihnen EUDAS alles das ab, was automatisch ablaufen +kann. Sie versorgen EUDAS nur noch mit den passenden Formeln für +Ihre Anwendung. + + +#abschnitt ("1.4", "GRENZEN", "Grenzen")# + +Natürlich können Sie nicht alle Probleme mit EUDAS gleichermaßen +gut lösen. EUDAS verwendet ein einfaches Modell (Karteikasten) und +versucht, mit möglichst wenig Informationen von Ihrer Seite auszu­ +kommen. Kompliziertere Sachverhalte verlangen auch kompliziertere +Strukturen, die Sie dann selbst entwerfen müssen. Eine einfache +Lösung mit EUDAS kann in solchen Fällen zu langsam oder zu um­ +ständlich sein. + Wenn Sie jedoch die wenigen Strukturprinzipien von EUDAS +verstanden haben, werden Sie sehr schnell viele Probleme mit +EUDAS lösen können. Zuerst erfassen Sie einfach alle Daten, die Sie +brauchen und überlegen sich erst dann, in welcher Form Sie diese +Daten haben wollen. Auch nachträglich können Sie jederzeit noch +neue Daten und Formulare hinzufügen, so daß Sie mit der Zeit +EUDAS gewinnbringend für viele Routineaufgaben benutzen werden. + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.10 b/app/eudas/4.4/doc/user-manual/eudas.hdb.10 new file mode 100644 index 0000000..9d48385 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.10 @@ -0,0 +1,485 @@ +#type ("prop")##limit (14.0)# +#format# +#page (97)# +#kapitel("10", "Datenabfrage", "am", "Bildschirm")# + + + +#abschnitt ("10.1", "FELDAUSWAHL", "Feldauswahl")# + +Da die Anzahl der möglichen Felder bei EUDAS-Dateien viel größer +ist als die Anzahl der zur Verfügung stehenden Zeilen auf dem +Bildschirm (255 gegenüber 22), muß es eine Möglichkeit geben, auch +die übrigen Felder anzusehen. + +#a ("Rollen")# Dazu kann man den Bildschirmausschnitt in vertikaler +Richtung #on("i")#rollen#off("i")#. Sie müssen sich die Bildschirmanzeige als einen +Ausschnitt des wirklichen Satzes vorstellen. Um weitere Inhalte des +Satzes zu sehen, verschieben Sie den Ausschnitt einfach. + Dazu dienen die beiden Tastenkombinationen ESC OBEN und ESC +UNTEN. Diese Kombinationen wirken nur im Menü "Einzelsatz". An +der Bildschirmanzeige ändert sich natürlich nur dann etwas, wenn +es noch weitere Felder zum Anzeigen gibt. + Ob dies der Fall ist, können Sie an zwei Indikatoren ablesen. +Zum einen wird hinter dem letzten Feld eine markierte Abschluß­ +zeile ausgegeben. Ist diese nicht sichtbar, gibt es noch Felder, die +Sie mit ESC UNTEN hochholen können. Zum anderen steht die Num­ +mer der ersten Zeile in der Überschrift. Ist diese Nummer größer als +1, können Sie mit ESC OBEN noch Felder sichtbar machen. + Das Rollen ist oft auch dann notwendig, wenn sich ein Feld +über mehrere Zeilen erstreckt. In diesem Fall kann es passieren, +daß die erste Zeile des Feldes nicht mehr sichtbar ist, da sie ober­ +halb des Anzeigebereichs liegen würde. + +#a ("Feldauswahl")# Eine weitere Möglichkeit bei zu vielen Feldern be­ +steht darin, nur die interessanten Felder zur Anzeige auszuwählen. +Dies geschieht mit der Funktion +#free (0.2)# +#beispiel# + F Feldauswahl +#text# +#free (0.2)# +Ihnen werden alle Felder zur Auswahl angeboten. Kreuzen Sie die +Felder an, die Sie sehen wollen und denken Sie daran, daß die Rei­ +henfolge des Ankreuzens beachtet wird. Anschließend werden Ihnen +nur die ausgewählten Felder angezeigt. Falls Sie kein Feld ankreu­ +zen, bleibt die alte Feldauswahl bestehen. + Wollen Sie wieder alle Felder sehen, müssen Sie diese nicht alle +einzeln ankreuzen. Mit HOP 'x' in der Auswahl werden alle Felder +angekreuzt (die noch nicht angekreuzt waren). Diese Tastenkombi­ +nation können Sie allgemein bei einer Auswahl verwenden. Sie +können die Kreuzchen mit 'o' auch wieder löschen, um zum Beispiel +"alle außer einem" auszuwählen. + Beachten Sie, daß die Auswahl der anzuzeigenden Felder nichts +mit der eigentlichen Dateistruktur zu tun hat, sondern nur für die +Anzeige gilt. Den Verarbeitungsfunktionen (zum Beispiel Drucken) +stehen natürlich nach wie vor alle Felder zur Verfügung. + Unvermutete Effekte können dann entstehen, wenn Sie bei +einer eingestellten Feldauswahl ändern oder einfügen. Die nicht +ausgewählten Felder werden beim Ändern natürlich nicht geändert +und beim Einfügen einfach leer gelassen. + + +#abschnitt ("10.2", "SATZEDITOR", "Satzeditor")# + +An dieser Stelle sollen noch einige weitere Funktionen des Satz­ +editors vorgestellt werden, die Sie noch nicht kennengelernt haben. + +#a ("Rollen im Satzeditor")# Sie können auch rollen, wenn Sie sich im +Satzeditor befinden (also beim Suchen, Einfügen und Ändern). Den­ +ken Sie daran, daß Sie die Einzelsatzanzeige immer mit ESC OBEN +und ESC UNTEN rollen, während sonst (Editor, Auswahl von Datei­ +namen) immer mit HOP OBEN und HOP UNTEN gerollt wird. + Diese Diskrepanz hat technische Gründe und läßt sich leider +nicht vermeiden. Wie Sie sich vielleicht erinnern, führt das Blättern +mit HOP OBEN und HOP UNTEN im Satzeditor dazu, daß die Korre­ +spondenz zwischen Feldnamen und Feldinhalt verlorengeht. Daher +muß an dieser Stelle mit ESC statt HOP gearbeitet werden. + +#a ("Ähnliche Sätze")# Wenn Sie mehrere ähnliche Sätze eintragen müssen, +bietet Ihnen EUDAS eine Erleichterung an. Sie können nämlich beim +Einfügen die Daten eines anderen Satzes übernehmen. + Dazu müssen Sie beim Ändern oder Einfügen des anderen Satzes +ESC 'p' drücken. Der Inhalt des Satzes wird dann in einen Zwischen­ +speicher gebracht. Beachten Sie, daß im Gegensatz zum EUMEL- +Editor kein Text markiert sein muß, sondern immer der ganze Satz +transportiert wird. + Beim Einfügen eines neuen Satzes können Sie diesen Satz dann +mit ESC 'g' in den Satzeditor übernehmen. Alle vorherigen Inhalte +werden überschrieben. Anschließend können Sie die Daten nach +Wunsch abändern. + Der Inhalt des Zwischenspeichers kann beliebig oft auf diese +Weise kopiert werden. Der Inhalt des Zwischenspeichers wird bei +Ändern der Feldauswahl oder beim Öffnen einer neuen Datei ge­ +löscht. + +#a ("Tagesdatum")# Im Satzeditor können Sie mit ESC 'D' das aktuelle +Tagesdatum abfragen. Es wird an der aktuellen Cursorposition ein­ +getragen, als ob Sie es selbst getippt hätten. + Auf diese Weise können Sie Sätze einfach mit Datum versehen +oder nach Sätzen suchen, die mit dem Tagesdatum in Beziehung +stehen (zum Beispiel 'Fälligkeit = Heute'). + + +#abschnitt ("10.3", "SUCHMUSTER", "Suchmuster")# + +Die bisher genannten Möglichkeiten des Suchmusters sind noch +etwas beschränkt. Eine Bedingung in unserer Adressendatei, die wir +im Suchmuster noch nicht ausdrücken können, wäre zum Beispiel: +Suche alle Adressen der Personen, die Wegner oder Simmern heißen. + Diese Alternative, Wegner ODER Simmern, kann nun in EUDAS +durch ein Komma ausgedrückt werden: + +#beispiel# + Name Wegner,Simmern + Vorname +#text# + +Beachten Sie, daß hinter dem Komma kein Leerzeichen folgen darf, +wie Sie es vielleicht gewohnt sind, in einem Text zu schreiben. +EUDAS kann nämlich nicht unterscheiden, ob Sie das Leerzeichen +nur aus optischen Gründen geschrieben haben, oder ob Sie danach +suchen wollen. + +#a ("Lokale Alternative")# Die eben beschriebene Konstruktionsmethode +heißt #on("i")#lokale Alternative#off("i")#. Lokal deshalb, weil Sie nur innerhalb +eines Feldes gilt. Was das bedeuten soll, sehen Sie, wenn Sie die +Bedingung mit einer weiteren Bedingung für ein anderes Feld kom­ +binieren: + +#beispiel# + Name Wegner,Simmern + Vorname + Strasse + PLZ 5* + Ort +#text# + +Dieses Muster hat die Bedeutung: Wähle alle Personen namens Weg­ +ner oder Simmern aus, die im PLZ-Bereich 5 wohnen. Die beiden +Bedingungen für den Namen sind mit der Bedingung für die PLZ mit +UND verknüpft - das heißt, eine der beiden ersten Bedingungen muß +zutreffen #on("i")#und#off("i")# die untere Bedingung. Dieses UND ist global, da es +Bedingungen für verschiedene Felder miteinander verbindet. + Natürlich können Sie für mehrere Felder gleichzeitig lokale +Alternativen angeben. Eine anderes Suchmuster könnte zum Beispiel +so aussehen: + +#beispiel# + Name Wegner,Simmern + Vorname + Strasse + PLZ 5,5000 + Ort +#text# + +In diesem Fall muß eine ausgewählte Person Wegner oder Simmern +heißen und in Köln wohnen. + +#a ("Globale Alternative")# Es wird nun aber für bestimmte Situationen +noch eine andere Art von Alternativen benötigt. Als Beispiel soll +ein Suchmuster dienen, das folgende Bedingung ausdrückt. Gesucht +ist eine weibliche Person mit Namen Simmern oder eine männliche +Person mit Namen Wegner. + Dieser Fall läßt sich mit unseren bisherigen Mitteln nicht lö­ +sen. Es wird nämlich eine Alternative zwischen zwei zusammen­ +gesetzten Bedingungen gefordert. Als Ausweg bietet sich an, prak­ +tisch mehrere Suchmuster anzugeben, die dann mit ODER verknüpft +werden. + Um diese verschiedenen Suchmuster optisch am Bildschirm zu +kennzeichnen, wird ein Semikolon als sogenannte #on("i")#globale Alternati­ +ve#off("i")# verwendet. Das Semikolon trennt das Suchmuster quasi in ver­ +schiedene Spalten auf, die jeweils eine eigene Bedingung enthalten +können. Unser gewünschtes Suchmuster würde also so aussehen: + +#beispiel# + Name Wegner;Simmern + Vorname + Strasse + PLZ + Ort + m/w m;w +#text# + +Ebenso wie bei lokalen Alternativen darf hinter dem Semikolon kein +Leerzeichen folgen. Daher kann das zweite Semikolon auch nicht +direkt unter dem ersten stehen. Die Spalten werden also einfach nur +durchgezählt: nach dem ersten Semikolon beginnt die zweite Spal­ +te, nach dem zweiten Semikolon die dritte usw. + In Zeilen, in denen keine Bedingungen stehen, kann auch das +Semikolon weggelassen werden. Es kann ebenfalls weggelassen wer­ +den, wenn die weiteren Spalten leer sind. Steht ein Semikolon direkt +am Anfang der Zeile, so ist die erste Spalte leer. + Um dies zu illustrieren, sei hier noch ein weiteres Beispiel +angegeben: + +#beispiel# + Name Wegner + Vorname ;Anna-Maria + Strasse +#text# + +In diesem Fall muß eine ausgewählte Person mit Nachnamen Wegner +oder mit Vornamen Anna-Maria heißen. + +#a ("Stern")# Bis jetzt haben Sie hauptsächlich Bedingungen betrachtet, +die exakt zutreffen mußten. Sie wissen aber bereits, daß man auch +Bedingungen angeben kann, bei denen nur ein Teil des zu suchen­ +den Feldes bekannt ist, nämlich indem der unbekannte Teil mit +einem Stern markiert wird. + In Kapitel 5 haben Sie gelernt, daß der Stern nur am Anfang +und Ende des Musters stehen kann. Dies trifft nicht ganz zu, denn +Sie können den Stern auch inmitten eines Textes anwenden. So +trifft die Bedingung #bsp("'Si*n'")# auf alle Namen zu, die mit 'Si' beginnen +und mit 'n' enden. + Beachten Sie hier das "und" in der Formulierung der Bedingung. +Das Muster ist eigentlich eine Schreibweise für zwei Bedingungen +für ein Feld, die mit UND verknüpft sind. + Sie können auch noch weitere Sterne in das Muster aufnehmen. +Dabei gibt es jedoch eine Kleinigkeit zu beachten. Das Muster +#bsp("'*x*y*'")# bedeutet: das Feld muß ein 'x' und ein 'y' enthalten. Über +die Reihenfolge der beiden Zeichen ist jedoch in dieser Bedingung +nichts gesagt, obwohl es vielleicht vom Aussehen suggeriert wird. + Denken Sie daran, keine zwei Sterne nebeneinander zu schrei­ +ben - eine solche Bedingung hätte keinen Sinn. + Es gibt eine weitere spezielle Bedingung, die mit Hilfe des +Sterns formuliert wird. Ein einzelner Stern bedeutet nämlich: Das +Feld ist nicht leer. Beachten Sie den kleinen Unterschied: ein Stern +in einem Muster kann für einen beliebigen Text stehen, der auch +leer sein kann. Ein einzelner Stern jedoch steht für einen beliebigen +Text, der nicht leer ist. + Damit Sie ein Gefühl für die Verwendung des Sterns bekommen, +hier noch ein paar Beispiele: + +#beispiel# +Mei*r* +#text# + Der Name beginnt mit 'Mei' und enthält ein 'r'. Trifft zu auf + 'Meier', 'Meiring', aber nicht auf 'Meiling' oder 'Merzei'. + +#beispiel# +Donau*dampf*schiff*schaft +#text# + Feld beginnt mit 'Donau', endet mit 'schaft' und enthält + 'dampf' und 'schiff'. Trifft zu auf 'Donaudampfschiffahrtsge­ + sellschaft', aber auch auf 'Donaugesellschiffdampffahrtschaft'. + +#beispiel# +Roller*erfahren +#text# + Dieses Muster muß man ganz genau interpretieren. Es bedeutet: + der Inhalt beginnt mit 'Roller' und endet mit 'erfahren'. Das + Muster trifft nicht nur auf 'Roller erfahren' sondern auch auf + 'Rollerfahren' zu. Der Stern verliert also in diesem Fall seine + symbolische Bedeutung als Platzhalter für einen bestimmten + Text. + +#a ("Vergleiche")# Es gibt in EUDAS noch weitere Muster, die einen gan­ +zen Bereich von Werten auswählen. Diese betreffen Bedingungen der +Art "größer als" und "kleiner als". Solche Vergleichsbeziehungen +werden durch zwei Punkte dargestellt. + So wählt das Muster #bsp("'K..'")# alle Felder aus, die in der alphabe­ +tischen Reihenfolge hinter 'K' liegen, wobei das 'K' selbst mit ein­ +geschlossen ist. Umgekehrt trifft #bsp("'..K'")# auf alle Felder zu, die davor +liegen. + Sie können beide Bedingungen auch kombinieren. So trifft die +Bedingung #bsp("'A..K'")# auf alle Felder zu, die im Lexikon unter 'A' bis +'J' erscheinen (die Felder mit 'K' sind hier ausgeschlossen). Beach­ +ten Sie, daß die direkte Kombination wieder die Verknüpfung zweier +einzelner Bedingungen mit UND darstellt. + +#a ("Negation")# Um den Bereich möglicher Suchmuster noch zu erweitern, +können Sie einzelne Bedingungen auch noch verneinen. Dies ge­ +schieht durch Voranstellen zweier Minuszeichen. So bedeutet das +Muster #bsp("'--Meier'")#, daß alle Personen ausgewählt werden, die nicht +Meier heißen. + Die Verneinung bezieht sich immer auf das unmittelbar folgende +Muster (bis zum nächsten Komma, Semikolon oder dem Zeilenende) +und nicht etwa auf eine ganze Zeile. Sie umfaßt jedoch die UND- +Verknüpfung der kombinierten Bedingungen. So sind zum Beispiel die +Muster #bsp("'--E..M'")#, #bsp("'--E..,--..M'")# und #bsp("'..E,M..'")# völlig gleichbedeu­ +tend. + +#a ("Feldvergleich")# Als letztes haben Sie im Suchmuster auch noch die +Möglichkeit, ein Feld mit anderen Feldern des gleichen Satzes zu +vergleichen. Bisher hatten Sie ein Feld ja immer nur mit konstanten +Texten verglichen. + Um dies zu erreichen, geben Sie statt eines Vergleichstextes +den Feldnamen des Feldes an, mit dem Sie vergleichen wollen. Zur +Kennzeichnung müssen Sie dem Namen noch ein '&' voranstellen. +Diese Konstruktion funktioniert mit allen bisher besprochenen Ver­ +gleichen. Beispielsweise trifft + +#beispiel# + Feld1 ..&Feld2 +#text# + +auf alle Sätze zu, in denen der Inhalt von Feld1 kleiner ist als der +Inhalt von Feld2. + Im Gegensatz zum Druckmuster dürfen in den Feldnamen zwar +Leerzeichen enthalten sein, nicht jedoch +#free (0.2)# +#beispiel# + .. * , ; +#text# +#free (0.2)# +da diese Zeichen als reservierte Zeichen gelten und jeweils als +Begrenzer wirken. Die gleiche Beschränkung gilt dementsprechend +auch für konstante Vergleichstexte. + Beachten Sie, daß hinter dem '&' bis zum nächsten Begrenzer­ +zeichen ein gültiger (vorhandener) Feldname stehen muß. Anderen­ +falls wird der Text als konstantes Muster betrachtet. + Wie schon oben gesagt, kann der Feldvergleich mit allen Ver­ +gleichen verwendet werden. Auch gemischte Konstruktionen sind +zulässig, beispielsweise + +#beispiel# + Feld1 A..&Feld3,*&Feld9* +#text# + +Diese Bedingung trifft zu, wenn Feld1 größer oder gleich 'A', aber +kleiner als der Inhalt von Feld3 ist, oder wenn der Inhalt von Feld9 +darin vorkommt. + +#a ("Optimierung")# Hier noch eine Bemerkung zur Geschwindigkeit des +Suchens. Je mehr Bedingungen Sie angeben, desto mehr Vergleiche +müssen beim Suchen angestellt werden und desto länger dauert es. + Das erste Feld einer Datei erfährt jedoch eine Sonderbehand­ +lung. Wenn Sie für dieses Feld ein Muster für Übereinstimmung +angeben, kann der Suchvorgang enorm beschleunigt werden, da das +erste Feld einer Datei intern speziell verwaltet wird. Damit das +Verfahren funktioniert, dürfen keine globalen Alternativen oder +lokale Alternativen für das erste Feld verwendet werden. + Diese Suchoptimierung sollten Sie bereits beim Einrichten einer +Datei berücksichtigen. Geben Sie als erstes Feld das an, nach dem +am ehesten direkt gesucht wird. Typisches Beispiel hierfür ist der +Nachname, aber auch Artikelnummern sind sinnvoll. Wichtig ist, daß +das erste Feld nicht zu oft identisch ist und auch mehr als zwei +Buchstaben enthält, damit die Optimierung ihre volle Wirksamkeit +entfaltet. + Denken Sie daran, daß durch die Feldauswahl ein beliebiges +Feld als erstes auf dem Bildschirm stehen kann. Für die Optimierung +wird jedoch immer das Feld betrachtet, das beim Einrichten der +Datei als erstes angegeben wurde. + + +#abschnitt ("10.4", "MARKIEREN", "Markieren")# + +Manchmal entsteht die Situation, daß Sie eine Reihe von Sätzen +bearbeiten wollen, aber keine Suchbedingung formulieren können, +die auf alle diese Sätze zutrifft. In diesem Fall bietet EUDAS Ihnen +die Möglichkeit, solche Sätze von Hand zu markieren. + Ein Beispiel: Sie haben eine ganze Reihe von Sätzen geändert +und wollen diese Änderungen als Protokoll ausdrucken. Es läßt sich +aber nicht mit Hilfe eines Suchmusters feststellen, welche Sätze +geändert wurden. + Als Abhilfe wählen Sie bei jedem geänderten Satz die Funktion +#free (0.2)# +#beispiel# + M Markierung +#text# +#free (0.2)# +Dadurch wird der bisher unmarkierte Satz markiert. Dies wird +kenntlich an der Anzeige #bsp("'MARK+'")# in der Überschrift. Sobald Sie den +ersten Satz markiert haben, erscheint bei jedem Satz, ob er markiert +ist oder nicht. + Haben Sie einen Satz irrtümlich markiert, können Sie die Mar­ +kierung mit der gleichen Funktion auch wieder entfernen. + Alle Funktionen, die bisher die durch das Suchmuster ausge­ +wählten Sätze bearbeitet haben, arbeiten nun nur noch auf den +markierten Sätzen. Somit können Sie anschließend mit der Druck­ +funktion die gewünschten Sätze drucken. Die Markierung hat also +Priorität über die eingestellte Suchbedingung. Lediglich die Bewe­ +gung am Bildschirm beachtet immer nur die Suchbedingung. + Sie können alle Markierungen der Datei mit der Funktion +#free (0.2)# +#beispiel# + Alle Markier. + L Löschen +#text# +#free (0.2)# +im Menü 'Gesamtdatei' wieder entfernen. Anschließend wird beim +Drucken wieder das Suchmuster beachtet. Die Markierungen ver­ +schwinden auch, wenn eine neue Datei geöffnet wird. Die Markie­ +rungen sind also nicht permanent in einer Datei gespeichert, son­ +dern existieren nur, während die Datei geöffnet ist. + Bei Koppeldateien können Sie aus technischen Gründen immer +nur alle Kombinationen auf einmal markieren. Die Markierung einer +Kombination markiert auch alle anderen Kombinationen des gleichen +Satzes. + + +#abschnitt ("10.5", "ÜBERSICHT", "Übersicht")# + +Wie Sie bisher gesehen haben, zeigte EUDAS immer einen einzigen +Satz in dem Standardformular auf dem Bildschirm. Es gibt jedoch +auch eine Möglichkeit, mehrere Sätze gleichzeitig zu betrachten. +Dazu dient die Funktion +#free (0.2)# +#beispiel# + U Übersicht +#text# +#free (0.2)# +im Menü 'Gesamtdatei'. + In der Übersicht nimmt jeder Satz nur eine Bildschirmzeile in +Anspruch. Die Feldinhalte werden, durch Komma getrennt, in der +Zeile nacheinander aufgezählt, bis kein Platz mehr vorhanden ist. +Am Anfang jeder Zeile steht die Satznummer und ob der jeweilige +Satz markiert ist (entweder '+' für markiert oder '-'). In der Über­ +schrift stehen in gleicher Weise die Feldnamen angegeben. + Der aktuelle Satz wird innerhalb der Übersichtsanzeige immer +durch eine inverse Satznummer dargestellt. Es werden nur die durch +das eingestellte Suchmuster ausgewählten Sätze gezeigt. Trifft die +Selektionsbedingung nicht auf den aktuellen Satz zu, wird an seiner +Stelle zur Information ein leerer Platzhalter angezeigt. Hinter dem +letzten Satz wird auch das Dateiende als besonders gekennzeichne­ +ter Satz angegeben. + +#bildschirm# +___________________________________________________________________________________________ + + ÜBERSICHT: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ? + Satznr. Name, Vorname, PLZ, Ort, Strasse, m/w, + 1 - Wegner, Herbert, Krämergasse 12, 5000, Köln, m, + 2 - Sandmann, Helga, Willicher Weg 109, 5300, Bonn 1, w, + 3 - Katani, Albert, Lindenstr. 3, 5210, Troisdorf, m, + 4 - Ulmen, Peter, Mozartstraße 17, 5, Köln 60, m, + 5 - Regmann, Karin, Grengelweg 44, 5000, Köln 90, w, + 6 - Arken, Hubert, Talweg 12, 5200, Siegburg, m, + 7 - Simmern, Anna-Maria, Platanenweg 67, 5, Köln 3, w, + 8 - Kaufmann-Drescher, Angelika, Hauptstr. 123, 53, Bonn 2, w, + 9 - Fuhrmann, Harald, Glockengasse 44, 5000, Köln 1, m, + 10 - Seefeld, Friedrich, Kabelgasse, 5000, Köln-Ehrenfeld, m, + 11 - << DATEIENDE >> + +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 10-1 Übersicht +#text# + +#a ("Feldauswahl")# Wenn Sie die Funktion aufrufen, haben Sie zuerst +noch die Möglichkeit, nur einen Teil der vorhandenen Felder zur +Anzeige auszuwählen. Dazu bejahen Sie die Frage und können dann +die Felder in der gewünschten Reihenfolge ankreuzen. Analog zur +Funktion 'Feldauswahl' wird auch hier die zuletzt für die Übersicht +verwendete Feldauswahl beibehalten, wenn Sie die Frage verneinen +oder kein Feld ankreuzen. Die Feldauswahl für die Übersicht ist +unabhängig von der Feldauswahl für die normale Satzanzeige. + Von der Möglichkeit zur Feldauswahl sollten Sie Gebrauch ma­ +chen, denn durch die komprimierte Darstellung der Übersicht kann +meistens nur ein kleiner Teil eines Satzes dargestellt werden. + +#a ("Rollen")# Nachdem die Sätze auf dem Bildschirm erschienen sind, +haben Sie wieder die Möglichkeit, die Darstellung zu rollen. Dazu +können Sie die Pfeiltasten OBEN und UNTEN sowie die Tastenkombi­ +nationen HOP OBEN und HOP UNTEN verwenden. Diese Funktionen +verschieben den invers dargestellten aktuellen Satz und funktio­ +nieren wie im Editor. Beachten Sie auch hier wieder den Unterschied +zum Rollen in der Einzelsatzanzeige. + Das Rollen wirkt wie ein Positionieren mit 'Weiter' oder 'Zu­ +rück'. Nach der Rückkehr aus der Übersicht können Sie sich also an +einer ganz anderen Stelle in der Datei befinden. + Es stehen Ihnen zum Rollen auch noch die folgenden Tasten­ +kombinationen zur Verfügung (wie im Editor): HOP RETURN macht +den aktuellen Satz zum ersten auf der Seite. ESC '1' zeigt den er­ +sten Satz der Datei, ESC '9' analog dazu den letzten. + Wenn Sie eine komplizierte Suchbedingung eingestellt haben +und EUDAS viele Sätze erfolglos überprüfen muß, dauert der Bild­ +aufbau natürlich entsprechend lange. EUDAS gibt zu Ihrer Informa­ +tion aber immer die Nummer des Satzes aus, der gerade überprüft +wird. Außerdem werden Tastenbefehle nach jeder Zeile angenommen, +so daß Sie schon weiterblättern können, wenn Sie den ersten Satz +gesehen haben. + +#a ("Markieren")# In der Übersicht können Sie auch Sätze markieren. Mit +'+' markieren Sie den aktuellen Satz; mit '-' entfernen Sie die Mar­ +kierung wieder. So können Sie einfach die Sätze ankreuzen, die Sie +später bearbeiten wollen. + +#a ("Verlassen")# Mit ESC 'q' können Sie die Übersicht wieder verlassen, +auch mitten beim Aufbau des Bildes. Haben Sie erkannt, daß EUDAS +sinnlos mit einer falschen Suchbedingung sucht, können Sie die +Funktion auch mit ESC 'h' (Halt) abbrechen und gegebenenfalls ein +neues Suchmuster einstellen. + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.11 b/app/eudas/4.4/doc/user-manual/eudas.hdb.11 new file mode 100644 index 0000000..957a413 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.11 @@ -0,0 +1,645 @@ +#type ("prop")##limit (14.0)# +#format# +#page (109)# +#kapitel ("11", "Funktionen", "zur", "Bearbeitung")# + + + +#abschnitt ("11.1", "SORTIEREN", "Sortieren")# + +Wenn Sie die Sätze in Ihrer EUDAS-Datei in einer bestimmten Rei­ +henfolge haben wollen (dies wird in vielen Fällen zum Drucken +verlangt), müssen Sie die Datei sortieren. Sie können EUDAS ange­ +ben, in welcher Reihenfolge die Sortierung erfolgen soll. Um die +aktuelle Datei zu sortieren, rufen Sie die Funktion +#free (0.2)# +#beispiel# + Akt. Datei + S Sortieren +#text# +#free (0.2)# +auf. Falls die Datei noch nie sortiert wurde, wird Ihnen auf jeden +Fall die Sortierreihenfolge zum Auswählen angeboten. Anderenfalls +werden Sie gefragt, ob Sie die vorherige Sortierreihenfolge ändern +wollen. + Das Sortieren wird als Veränderung betrachtet und nur auf der +Arbeitskopie durchgeführt! + +#a ("Sortierreihenfolge")# Die Sortierreihenfolge gibt an, welche Felder in +welcher Reihenfolge beim Vergleichen zweier Sätze benutzt werden +sollen. Zuerst wird das an erster Stelle angegebene Feld verglichen. +Sind die Inhalte hier unterschiedlich, wird die Einordnung der Sätze +nach diesem Feld bestimmt. + Sind die Inhalte in diesem Feld aber gleich, so wird nach dem +nächsten Feld verglichen. Ist kein weiteres Feld in der Sortierrei­ +henfolge angegeben, wird der Vergleich an dieser Stelle mit einem +zufälligen Ergebnis abgebrochen, das heißt, es kann nicht vorher­ +gesagt werden, welcher der beiden Sätze zuerst kommt. + Die Sortierreihenfolge können Sie in einer Menüauswahl einge­ +ben. Kreuzen Sie die Felder an, die Sie vergleichen wollen und ach­ +ten Sie auf die richtige Reihenfolge. Die eingegebene Reihenfolge +wird in der Datei gespeichert, um beim nächsten Sortiervorgang +wiederverwendet zu werden. + Nachdem Sie alle bei der Sortierung zu berücksichtigenden +angekreuzt haben, werden Sie für jedes dieser Felder gefragt, ob +nach dem Feld aufsteigend oder absteigend sortiert werden soll. + +#a ("Ablauf")# Der Ablauf des Sortierens wird durch Ausgabe von Satz­ +nummern dargestellt. Bis zur ausgegebenen Satznummer sind alle +Sätze richtig sortiert. Bei Bedarf kann der Vorgang durch SV und +dann 'halt' abgebrochen werden. Die Datei bleibt dabei auf jeden +Fall intakt. + +#a ("Optimierung")# Die gespeicherte Sortierreihenfolge wird auch noch zu +einer weiteren Optimierung benutzt. Wenn eine Datei sortiert war +und nur wenige Änderungen stattgefunden haben, brauchen beim +nächsten Sortiervorgang nur die wenigen veränderten Sätze einzeln +einsortiert zu werden. Das funktioniert natürlich nur unter der +Voraussetzung, daß die gleiche Sortierreihenfolge gewählt wird. Das +Sortieren braucht in diesem Fall erheblich weniger Zeit. + +#a ("Probleme")# Normalerweise werden die einzelnen Felder nach dem +EUMEL-Zeichencode verglichen. Das bedeutet, daß sich die Reihen­ +folge der Zeichen nach dem EUMEL-Zeichencode richtet. Ein Zeichen +mit einem höheren Code wird also vor einem Zeichen mit einem +niedrigeren Code einsortiert. + In manchen Fällen ergeben sich mit diesem Vergleichsverfahren +aber auch Schwierigkeiten. Wenn in einem Feld Zahlen oder DM- +Beträge stehen, führt die Methode zu falschen Ergebnissen. Die '10' +wird zum Beispiel vor der '2' einsortiert. Warum? Texte werden +immer linksbündig geschrieben und verglichen. Bei Zahlen richtet +sich die Wertigkeit jedoch nach dem Abstand vom Komma. + Da bei Texten zuerst das erste Zeichen verglichen wird, ent­ +steht hier durch Vergleich von '1' und '2' der Eindruck, die '10' +käme vor der '2'. Korrigieren könnte man dies, indem man ein Leer­ +zeichen vor die '2' schreibt. Wenn also die (nicht geschriebenen) +Dezimalkommata direkt untereinanderstehen, werden Zahlen richtig +verglichen. + +#a ("Typ ZAHL")# EUDAS hat jedoch eine bequemere Art, dieses Problem zu +behandeln. Ein Feld, das Zahlen enthalten soll, bekommt einen spe­ +ziellen Typ ZAHL zugewiesen, der zu einer richtigen Sortierung +führt. + Bei Feldern vom Typ ZAHL ignoriert EUDAS bei Vergleichen alle +nichtnumerischen Zeichen und vergleicht den Wert der Zahl. So +können Sie zum Beispiel in einem Satz '2,50 DM' und im anderen +Satz '10 DM' eintragen - EUDAS kann jetzt die richtige Reihenfolge +feststellen. + Übrigens: falls Sie numerische Werte lieber mit einem Dezi­ +malpunkt statt einem Dezimalkomma schreiben, können Sie EUDAS +das mit dem ELAN-Kommando + +#beispiel# + dezimalkomma (".") +#text# + +mitteilen. Wenn Sie ein solches Kommando eingeben wollen, können +Sie im EUDAS-Menü ESC ESC drücken. In der Statuszeile erscheint +dann die Aufforderung: + +#beispiel# + Gib Kommando: +#text# + +Hier können Sie wie im Editor oder im EUMEL-Monitor ein beliebiges +Kommando eingeben und ausführen. + Die Normaleinstellung für das Dezimalkomma erreichen Sie +wieder durch das Kommando + +#beispiel# + dezimalkomma (",") +#text# + + +#a ("Typ ändern")# Die Feldtypen sind eine permanente Eigenschaft einer +EUDAS-Datei. Beim Einrichten einer neuen Datei wird zunächst der +Standardtyp für alle Felder genommen. Sie erhalten jedoch Gelegen­ +heit, abweichende Feldtypen zu vergeben, wenn Sie die Frage +#f2# +#bildschirm# +___________________________________________________________________________________________ + + Feldnamen oder Feldtypen ändern (j/n) ? +___________________________________________________________________________________________ +#text# + +bejahen. + Auch nachträglich können Sie die Feldtypen noch ändern. Dies +geschieht mit der Funktion +#free (0.2)# +#beispiel# + F Feldstrukt. +#text# +#free (0.2)# +im Menü 'Öffnen'. Zunächst werden Sie gefragt, ob Sie noch weitere +Feldnamen anfügen wollen. So könnten Sie die Datei um weitere +Felder ergänzen, die bei allen Sätzen zunächst leer sind. Die neuen +Felder müssen Sie wie beim Einrichten der Datei untereinander im +Editor schreiben. + Als zweites erscheint dann die gleiche Frage wie oben. Wenn +Sie diese bejahen, wird Ihnen eine Auswahl der zu ändernden Fel­ +der mit Feldnamen und den zugehörigen Feldtypen angeboten. Kreu­ +zen Sie hier die Felder an, deren Feldtypen Sie ändern möchten. + Da Sie mit dieser Funktion sowohl Feldnamen als auch Feld­ +typen verändern können, wird Ihnen für jedes Feld zunächst der +Name zum Ändern angeboten. Sie können den Namen korrigieren oder +überschreiben. Die Namensänderung hat jedoch keine Auswirkung +auf den Feldinhalt! + Wenn Sie den Namen nicht ändern wollen, drücken Sie einfach +RETURN. Anschließend können Sie für das Feld den neuen Feldtyp +angeben. Tippen Sie einen der vier Feldtypen als Text ein und +drücken Sie RETURN. Anschließend hat das Feld einen neuen Typ. +Die verschiedenen möglichen Typen werden jetzt genau erklärt. + +#a ("Feldtypen")# TEXT ist der Standardtyp, der die Feldinhalte nach +EUMEL-Zeichencode vergleicht. Den Typ ZAHL hatten wir schon +weiter oben kennengelernt. Daneben gibt es noch den Typ DATUM. + Dieser Typ vergleicht Daten der Form 'tt.mm.jj'. Soll ein sol­ +ches Datum richtig einsortiert werden, müßte es anderenfalls in der +Reihenfolge umgedreht werden (also 'jj.mm.tt'). Dies ist aber nicht +nötig, wenn das Feld den Typ DATUM bekommt. Beachten Sie, daß +alle Inhalte, die nicht die beschriebene Form haben, als gleich be­ +trachtet werden. + Der letzte Typ ist DIN. Dabei werden Texte nach DIN 5007 ver­ +glichen. Das bedeutet, daß Groß- und Kleinbuchstaben als gleich +angesehen werden, daß alle nichtalphabetischen Zeichen ignoriert +werden und die Umlaute ihren richtigen Platz bekommen (Umlaute +werden in normalen Texten hinter allen anderen Zeichen einsor­ +tiert). Da hierfür ein relativ großer Zeitaufwand notwendig ist, +sollte dieser Typ nur dann gewählt werden, wenn er erforderlich ist. +Den schnellsten Vergleich ermöglicht der Typ TEXT. + +#a ("Hinweis")# Beachten Sie, daß mit der Vergabe von Feldtypen keine +Überprüfung der Eingabe verbunden ist. Insbesondere beim Datum +wird nicht geprüft, ob die Form 'tt.mm.jj' eingehalten wurde. Wollen +Sie solche Überprüfungen vornehmen, lesen Sie bitte Abschnitt 11.3. + + +#abschnitt ("11.2", "KOPIEREN", "Kopieren")# + +In diesem Abschnitt sollen Sie erfahren, wie Sie eine EUDAS-Datei +#on("i")#kopieren#off("i")# können. Diese Funktion kann nicht nur ein inhaltsgleiches +Duplikat einer EUDAS-Datei herstellen (dies könnten Sie einfacher +durch eine logische Kopie bewerkstelligen, s. 16.1), sondern auch +komplizierte Umstrukturierungen vornehmen. + +#a ("Kopiermuster")# Der Schlüssel zu dieser Leistungsfähigkeit ist das +#on("i")#Kopiermuster#off("i")#. Wie beim Druckmuster legen Sie dadurch die genauen +Auswirkungen der Funktion fest. + Für jedes Feld in der Zieldatei, in die kopiert werden soll, +enthält das Kopiermuster die Angabe, woraus der Inhalt dieses +Feldes entstehen soll. Durch Auswahl und Reihenfolge dieser Anga­ +ben bestimmen Sie die Struktur der Zieldatei. + Im einfachsten Fall sieht die Kopieranweisung für ein Feld wie +folgt aus: + +#beispiel# + "Feldname" K f ("Feldname"); +#text# + +Das 'K' dient zur Festlegung der Kopierfunktion. Auf der linken +Seite steht in Anführungsstrichen der Name des Zielfeldes. Der +Ausdruck auf der rechten Seite gibt den zukünftigen Inhalt des +Feldes an. Der Ausdruck im obigen Beispiel steht einfach für den +Inhalt des Feldes 'Feldname' in der aktuellen Datei. Das Semikolon +am Ende dient zur Abgrenzung, da der ganze Ausdruck auch mehrere +Zeilen lang sein darf. + In der oben genannten Form würde das Feld 'Feldname' iden­ +tisch in die Zieldatei kopiert. Weitere Möglichkeiten besprechen wir +später. + +#a ("Feldreihenfolge")# Zunächst wollen wir uns damit befassen, wie Sie +die Feldreihenfolge in der Zieldatei beeinflussen können. Dies ge­ +schieht einfach dadurch, daß Sie die Kopieranweisungen in der ge­ +wünschten Reihenfolge aufschreiben. Damit können wir bereits ein +erstes komplettes Beispiel betrachten: + +#beispiel# + "Name" K f ("Name"); + "Vorname" K f ("Vorname"); + "PLZ" K f ("PLZ"); + "Ort" K f ("Ort"); + "Strasse" K f ("Strasse"); + "m/w" K f ("m/w"); +#text# + +Dieses Kopiermuster würde die bereits beschriebene Adressendatei +identisch kopieren, da alle Felder in der gleichen Reihenfolge vor­ +kommen. + Wenn Sie jedoch die Feldreihenfolge ändern wollen (um zum +Beispiel ein anderes Feld als erstes zu optimieren), brauchen Sie +bloß die Reihenfolge im Kopiermuster zu verändern: + +#beispiel# + "Ort" K f ("Ort"); + "Name" K f ("Name"); + "Vorname" K f ("Vorname"); + "PLZ" K f ("PLZ"); + "Strasse" K f ("Strasse"); + "m/w" K f ("m/w"); +#text# + +Im Gegensatz zur Auswahl der Feldreihenfolge für die Anzeige än­ +dern Sie so die Feldreihenfolge für die Zieldatei permanent. + +#a ("Felder anfügen")# Die beiden angegebenen Kopiermuster haben jedoch +nur dann die beschriebene Wirkung, wenn die Zieldatei noch nicht +existert. Bei einer existierenden Datei kann die Feldreihenfolge +nicht mehr geändert werden; daher hat die Reihenfolge der Kopier­ +anweisungen dann keine Wirkung. + Sie können jedoch zu einer existierenden Zieldatei noch Felder +hinzufügen. EUDAS verwendet nämlich folgende einfache Vorschrift: + +#limit (12.0)# + Wenn als Zielfeld in einer Kopieranweisung ein Feld + genannt wird, das in der Zieldatei noch nicht vorkommt, + wird es als weiteres Feld der Zieldatei hinzugefügt. +#limit (13.5)# + +Diese Strategie hat im Fall der nicht existierenden Datei zur Folge, +daß alle Felder neu sind und in der Reihenfolge ihres Auftretens +eingerichtet werden. Existiert die Datei schon, werden zusätzliche +Felder am Ende angefügt. + Beachten Sie, daß zusätzliche Felder für eine existierende +Datei nur in den neu hinzukopierten Sätzen gefüllt sind. In den +alten Sätzen bleiben alle neuen Felder einfach leer. + +#a ("Satzauswahl")# An dieser Stelle sollte erwähnt werden, daß wie bei +allen Funktionen, die die gesamte Datei betreffen, nur die durch die +Suchbedingung ausgewählten Sätze kopiert werden. Ist mindestens +ein Satz markiert, werden nur die markierten Sätze kopiert und die +Suchbedingung ignoriert. + +#a ("Teildatei")# Jetzt können Sie auch die zweite wichtige Aufgabe des +Kopierens verstehen. Sie können aus einer Datei einen Teil der +Sätze und einen Teil der Felder #on("i")#herausziehen#off("i")#. Danach haben Sie +unter Umständen eine wesentlich kleinere Datei, die sich auch +schneller bearbeiten läßt. Gerade wenn Sie nicht den allerneuesten +64-Bit-Supercomputer haben, können Sie so viel Zeit sparen, wenn +Sie wiederholt nur mit einem Teil der Datei arbeiten müssen. + Die Auswahl der Sätze für einen solchen Zweck erfolgt über ein +Suchmuster; im Kopiermuster geben Sie dann nur die gewünschten +Felder an. + +#a ("Aufruf")# An dieser Stelle wollen wir jetzt endlich behandeln, wie Sie +die Kopierfunktion aufrufen. Dazu gibt es die Auswahl +#free (0.2)# +#beispiel# + Satzauswahl + K Kopieren +#text# +#free (0.2)# +im Menü "Gesamtdatei". Als erstes werden Sie nach dem Namen der +Zieldatei gefragt. Existiert die Zieldatei schon und war sie vorher +sortiert, werden Sie gefragt, ob Sie die Datei zum Schluß wieder +sortieren wollen. Wie immer beim Sortieren werden auch hier gege­ +benenfalls nur die neu hinzugekommenen Sätze einsortiert. + Als nächstes müssen Sie den Namen des Kopiermusters angeben. +Da das Kopiermuster eine normale Textdatei ist, können Sie sich +einen beliebigen Namen ausdenken, unter dem das Muster dann +gespeichert wird. + Wollen Sie das Kopiermuster nicht aufbewahren, sondern nur +einmal verwenden, brauchen Sie keinen Namen anzugeben. Drücken +Sie einfach RETURN und für die Dauer des Kopierens wird das +Kopiermuster als unbenannte Datei eingerichtet. + Nachdem Sie den Namen des Kopiermusters eingegeben haben, +gelangen Sie in den Editor, wo Sie das Muster ändern können. Damit +Sie beim ersten Mal nicht so viel tippen müssen, bietet EUDAS Ihnen +bei einer neuen Musterdatei ein #on("i")#Standard-Kopiermuster#off("i")# zum Ändern +an. Das Aussehen des Standard-Kopiermusters richtet sich danach, +ob die Zieldatei schon existiert oder nicht. + Existiert die Zieldatei noch nicht, so werden im Standard- +Kopiermuster alle Felder der Ausgangsdatei in ihrer originalen Rei­ +henfolge angegeben. Wenn Sie dieses Muster nicht noch ändern, wird +die aktuelle Datei identisch kopiert. + Sie können jedoch die Feldreihenfolge verändern oder Felder +weglassen, indem Sie einfach die entsprechenden Zeilen vertauschen +oder löschen. Für Umbenennungen überschreiben Sie einfach den +Namen auf der linken Seite der Kopieranweisung. So können Sie das +Kopiermuster mit geringstem Aufwand erstellen. + Existiert die Zieldatei jedoch schon, werden Ihnen im Kopier­ +muster alle Felder der Zieldatei angeboten. Bei Feldern, die in der +aktuellen Datei nicht vorkommen, erscheint folgende Anweisung: + +#beispiel# + "Anrede" K ""; +#text# + +Obwohl die Anweisung in diesem Fall keine Wirkung hat (wenn man +sie wegließe, würde das Feld ebenfalls leer bleiben), ist sie dennoch +aufgeführt, damit Sie auf der rechten Seite einen entsprechenden +Ausdruck einsetzen können. + Bei den angebotenen Anweisungen hat eine Änderung der Rei­ +henfolge oder eines Feldnamens keinen Sinn, da diese Felder ja alle +bereits existieren. Jedoch können Sie die Ausdrücke auf der rechten +Seite variieren und neue Anweisungen (Felder) hinzufügen. + +#a ("Ablauf")# Wenn Sie die Eingabe des Kopiermusters mit ESC 'q' verlas­ +sen, wird das Kopiermuster übersetzt. Dabei können Fehlermeldun­ +gen auftreten. Sie können dann die Fehler korrigieren, wobei Sie die +Fehlermeldungen gleichzeitig auf dem Bildschirm sehen können. War +das Kopiermuster korrekt, werden alle ausgewählten (bzw. markier­ +ten) Sätze der aktuellen Datei in die Zieldatei kopiert und diese +anschließend gegebenenfalls noch sortiert. + Die kopierten Sätze werden jeweils am Ende der Zieldatei ange­ +fügt. War die Zieldatei vorher schon sortiert, können Sie angeben, +daß die neuen Sätze zum Schluß noch einsortiert werden. Anderen­ +falls können Sie die Datei anschließend mit der Funktion 'Sortieren' +sortieren. + +#a ("ELAN-Ausdrücke")# Wenn Sie schon einmal programmiert haben, wird +Ihnen vielleicht aufgefallen sein, daß ein Kopiermuster einem +ELAN-Programm verdächtig ähnlich sieht. Diese Vermutung trügt Sie +nicht. Dies läßt den Schluß zu, daß Sie noch mehr ELAN hier an­ +bringen können. + Haben Sie noch nie programmiert, sollten Sie jetzt nicht in +Panik geraten, denn das Wichtigste dieses Abschnitts haben Sie +bereits gelernt. Vielleicht sind Ihnen die folgenden Beispiele bereits +ganz nützlich. Um alle Möglichkeiten auszunutzen, sollten Sie sich +aber irgendwann (später!) mit den Kapiteln 14 und 15 befassen, in +denen Sie Genaueres erfahren. + Zunächst sei festgestellt, daß der rechte Teil einer Kopieran­ +weisung ein beliebiger ELAN-Ausdruck sein kann, der einen TEXT +liefert. Den wichtigsten Ausdruck kennen Sie bereits: + +#beispiel# + f ("Feldname") +#text# + +liefert den Inhalt des Feldes 'Feldname' des aktuellen Satzes der +aktuellen Datei. Gibt es das Feld nicht, erscheint eine Fehlermel­ +dung bei der Ausführung. + Sie können jedoch auch einen konstanten Text angeben, der +dann für alle Sätze gleich ist. Dazu schließen Sie den Text einfach +in Anführungsstriche ein. Die folgende Kopieranweisung dient dazu, +ein neues Feld einzurichten, das aber vorläufig noch leer bleiben +soll: + +#beispiel# + "Feldname" K ""; +#text# + +Ebenso können Sie mehrere Felder zu einem neuen verbinden, zum +Beispiel: + +#beispiel# + "Wohnort" K f ("PLZ") + " " + f ("Ort"); +#text# + +Das Pluszeichen kennzeichnet die Aneinanderreihung von zwei Tex­ +ten. Denken Sie auch immer an das Semikolon am Ende. In gleicher +Weise können Sie viele andere Textfunktionen verwenden, die in +Kapitel 14 beschrieben sind. + Prinzipiell können Sie auch Bedingungen mit IF abfragen, wie +zum Beispiel in der folgenden Übersetzung: + +#beispiel# + IF f ("m/w") = "w" THEN + "Anrede" K "Frau" + ELSE + "Anrede" K "Herr" + END IF; +#text# + +Auf diese Weise können Sie Kodierungen verschiedenster Art auto­ +matisch umsetzen. Sie müssen hierbei jedoch unbedingt darauf ach­ +ten, daß innerhalb der IF-Konstruktion immer eine Kopieranweisung +ausgeführt wird. Falls nämlich kein Fall zutrifft und für ein Feld +keine Kopieranweisung ausgeführt wird, wird das Feld bei einer +neuen Datei auch nicht richtig eingerichtet. + + +#abschnitt ("11.3", "TRAGEN", "Tragen")# + +In Kapitel 6 hatten Sie gesehen, wie man einzelne Sätze aus der +aktuellen Datei in eine andere trägt, und auch, wie man sie wieder +zurückholen kann. Diese Funktion diente im wesentlichen dazu, +nicht mehr benötigte Sätze zu entfernen. + Sie haben aber auch die Möglichkeit, eine ganze Reihe von +Sätzen in einem Arbeitsgang zu tragen, nämlich alle durch das +Suchmuster ausgewählten beziehungsweise alle markierten Sätze. +Diese Funktion dient ebenfalls dazu, Sätze zu entfernen, beispiels­ +weise alle Sätze, die vor einem gewissen Stichtag liegen. Als wei­ +tere Anwendung können Sie beim Tragen aber auch Bedingungen +überprüfen. + Diese #on("i")#Prüfbedingungen#off("i")# sollen sicherstellen, daß die Daten in +einer Datei ganz bestimmten Richtlinien entsprechen. Zum Beispiel +kann geprüft werden, ob ein eingegebenen Datum stimmen kann, ob +ein Satz doppelt aufgenommen wurde oder ob eine Artikelnummer die +richtige Anzahl von Stellen hat. + Die Prüfbedingungen werden einer Datei fest zugeordnet. Sie +können mit der Funktion +#free (0.2)# +#beispiel# + P Prüfbed. +#text# +#free (0.2)# +im Menü 'Öffnen' eingegeben oder geändert werden. Die Prüfbedin­ +gungen werden als Text im Editor geschrieben. + +#a ("Ablauf")# Das ganze Verfahren läuft nun so ab: Sie fügen neue Sätze +immer erst in eine Zwischendatei ein, die die gleiche Struktur wie +die eigentliche Datei hat. Wenn Sie alle Sätze fertig eingegeben +haben, tragen Sie diese Datei komplett in die gewünschte Datei. +Dabei werden die Prüfbedingungen getestet. + Erfüllt ein Satz die Bedingungen, wird er anstandslos getragen. +Trifft eine Bedingung aber nicht zu, bleibt der Satz in der Zwi­ +schendatei und eine entsprechende Meldung wird ausgegeben. Die +Meldungen werden gespeichert, um Sie später nochmal abrufen zu +können. + Sie müssen jetzt in der Zwischendatei die notwendigen Ände­ +rungen durchführen, damit die Prüfbedingungen erfüllt werden. Beim +Aufruf der Funktion +#free (0.2)# +#beispiel# + A Ändern +#text# +#free (0.2)# +können Sie mit Hilfe der Tastenkombination ESC 'P' (großes P) die +Datei mit den Fehlermeldungen in einem kleinen Teilfenster editie­ +ren. Anhand dieser Hinweise können Sie dann den Satz korrigieren. +Die Meldungen bleiben bis zum nächsten Öffnen oder Tragen erhal­ +ten. + Nach der Korrektur können Sie den gleichen Vorgang erneut +aufrufen - es sind ja nur noch die zuerst fehlerhaften Sätze in der +Zwischendatei. Bei Bedarf können Sie diesen Vorgang wiederholen, +bis alle Sätze korrekt übernommen worden sind. + +#a ("Aufruf")# Das Tragen wird aufgerufen durch die Funktion +#free (0.2)# +#beispiel# + Satzauswahl + T Tragen +#text# +#free (0.2)# +Nach Eingabe des Zieldateinamens müssen Sie noch angeben, ob Sie +die Prüfbedingungen testen wollen. + +#a ("Prüfbedingungen")# Zu diskutieren bleibt noch die Form der Prüfbe­ +dingungen. Diese stellen ein kleines ELAN-Programm dar, in dem +einige spezielle Prozeduren zum Prüfen enthalten sind. Wenn Sie +nicht ELAN programmieren können, sollte Sie diese Bemerkung nicht +erschrecken: die Prüfbedingungen sind einfach genug. + Sie schreiben also die Prüfbedingungen jeweils untereinander. +Eine mögliche Bedingung ist + +#beispiel# + wertemenge ("Feldname", "Wert1,Wert2,Wert3,Wert4"); +#text# + +Diese Bedingung gibt an, daß das Feld einen der angegebenen Werte +haben muß. Die Werte werden untereinander durch Komma getrennt. +Es gibt jedoch keine Möglichkeit, Werte mit Komma darzustellen, da +das Komma immer als Trennung wirkt. Leerzeichen dürfen in den +Werten vorkommen, sie müssen dann aber auch genau so im Feld +stehen. + Wir könnten zum Beispiel eine Bedingung für unser Feld 'm/w' +wie folgt formulieren + +#beispiel# + wertemenge ("m/w", "m,w"); +#text# + +EUDAS würde sich dann beschweren, wenn das Feld leer wäre (ir­ +gendein Geschlecht muß die Person ja wohl haben). Wenn das Feld +auch leer sein darf, geben Sie einfach zwei Kommata hintereinander +oder ein Komma am Anfang an: + +#beispiel# + wertemenge ("m/w", ",m,w"); +#text# + +Eine andere Möglichkeit der Prüfbedingung besteht darin, eine +Maske für ein Feld zu definieren. Diese Maske gibt an, daß an be­ +stimmten Stellen des Feldes nur bestimmte Zeichen stehen dürfen. +So könnte man zum Beispiel folgende Maske für ein Datumsfeld +angeben: + +#beispiel# + feldmaske ("Datum", "99.99.99"); +#text# + +Die Neunen haben hier eine spezielle Bedeutung und und stehen für +eine beliebige Ziffer. Es gibt noch einige weitere Zeichen, die eine +reservierte Bedeutung haben, nämlich: + +#beispiel# + '9' für jede Ziffer (wie schon erwähnt) + 'X' für jedes Zeichen + 'A' für jeden Großbuchstaben + 'a' für jeden Kleinbuchstaben + '*' für eine Folge beliebiger Zeichen +#text# + +Alle anderen Zeichen im Muster stehen für sich selbst. Eine Sonder­ +stellung besitzt der Stern; er sollte sparsam verwendet werden, da +seine Benutzung etwas aufwendiger ist. Der Stern kann auch für +eine leere Zeichenfolge stehen. Als weiteres Beispiel könnte man +definieren + +#beispiel# + feldmaske ("Name", "A*"); +#text# + +damit immer ein Name angegeben ist, der noch dazu mit einem Groß­ +buchstaben beginnt. + Für Bedingungen, die sich nicht mit diesen beiden Prozeduren +formulieren lassen, gibt es noch + +#beispiel# + pruefe ("Feldname", Bedingung); +#text# + +Diese Prozedur erhält einen logischen (booleschen) Wert als Parame­ +ter, der einen Vergleich darstellt. Ist dieser Parameter falsch +(FALSE), wird eine entsprechende Fehlermeldung protokolliert. So +könnte man folgende Bedingung angeben: + +#beispiel# + pruefe ("Alter", wert ("Alter") > 18.0); +#text# + +Diese Bedingung würde sicherstellen, daß alle Personen in der Datei +volljährig sind ('wert' ist eine von EUDAS definierte Funktion, die +den Inhalt eines Feldes als REAL-Zahl liefert - denken Sie auch +daran, daß der ELAN-Compiler Zahlen mit Dezimalpunkt geschrieben +haben möchte). + Da die Prüfbedingungen ein ELAN-Programm sind, können Sie +natürlich sämtliche ELAN-Anweisungen verwenden. + Weiterhin haben Sie die Möglichkeit, Doppeleinträge zu verhin­ +dern. Dazu geben Sie mit Hilfe der Prozedur + +#beispiel# + eindeutige felder (n); +#text# + +wieviele Felder vom ersten an eindeutig sein sollen. Ein zu tragen­ +der Satz, der mit irgendeinem anderen Satz in diesen Feldern über­ +einstimmt, wird als fehlerhaft zurückgewiesen. In unserer Adressen­ +datei könnte man + +#beispiel# + eindeutige felder (2); +#text# + +angeben. Damit würde ein neuer Satz mit bereits vorhandenem Na­ +men und Vornamen abgelehnt. + +#a ("Limit")# Aus technischen Gründen können die Prüfbedingungen einer +Datei nur 2000 Zeichen umfassen. Wollen Sie aufwendigere Bedin­ +gungen konstruieren, sollten Sie sich diese als Prozedur definieren +und insertieren. In den Prüfbedingungen müssen Sie dann nur diese +Prozedur aufrufen. + + +#abschnitt ("11.4", "AUTOMATISCHE ÄNDERUNGEN", "Automatische Änderungen")# + +Mit EUDAS können Sie die geöffnete Datei nicht nur satzweise von +Hand ändern, sondern auch automatisch die ganze Datei. Dazu müs­ +sen Sie dem Rechner eine Vorschrift geben, nach der er handeln +kann. Ein solches #on("i")#Änderungsmuster#off("i")# stellt im Prinzip schon ein klei­ +nes Programm dar. Der Änderungsvorgang wird durch die Auswahl +#free (0.2)# +#beispiel# + V Verändern +#text# +#free (0.2)# +aufgerufen. Dabei wird der Name des Änderungsmusters erfragt. Dies +ist eine normale Textdatei. Existiert das Muster noch nicht, können +Sie den Inhalt an dieser Stelle im Editor angeben. Anschließend +werden alle ausgewählten Sätze nach der Vorschrift bearbeitet. +Dabei wird jeweils die aktuelle Satznummer ausgegeben. + +#a ("Änderungsmuster")# Da auch ein Kopiermuster ein Programm ist, ist +es nicht erstaunlich, daß Änderungsmuster ganz ähnlich aussehen. +Eine typische Zeile sieht etwa so aus: + +#beispiel# + "Feldname" V "neuer Inhalt"; +#text# + +Diese Zeile bedeutet: Ersetze den Inhalt des Feldes 'Feldname' +durch den Text 'neuer Inhalt'. Anstelle des neuen Textes kann +wieder ein beliebiger ELAN-Ausdruck stehen. Ein Beispiel, in dem +ein Feld einen Stern angehängt bekommt, sieht dann so aus: + +#beispiel# + "Feldname" V f ("Feldname") + "*"; +#text# + +Beachten Sie, daß Sie den Ausdruck auf der rechten Seite eventuell +in Klammern setzen müssen (obwohl der Operator 'V' die niedrigste +Priorität hat). Wenn Sie sich nicht sicher sind, können Sie den Aus­ +druck immer in Klammern einschließen. + Ebenso wie im Kopiermuster können Sie hier beliebige ELAN- +Ausdrücke verwenden. Auch IF-Abfragen und ähnliche Konstruktio­ +nen sind möglich, im Gegensatz zum Kopiermuster sogar ohne Be­ +schränkungen. + Im Vergleich zu einem separat geschriebenen ELAN-Programm +hat das Änderungsmuster den Vorteil, daß Sie nur die eigentlichen +Veränderungsanweisungen kodieren müssen. Die wiederholte Anwen­ +dung auf die ausgewählten Sätze erledigt EUDAS automatisch. Wol­ +len Sie eine solche Änderungsanweisung fest insertieren, so brau­ +chen Sie das Muster nur in eine Prozedur zu verpacken und EUDAS +zu übergeben (Näheres s. Referenzhandbuch). + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.12 b/app/eudas/4.4/doc/user-manual/eudas.hdb.12 new file mode 100644 index 0000000..b62dcbf --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.12 @@ -0,0 +1,431 @@ +#type ("prop")##limit (14.0)# +#format# +#page (123)# +#kapitel ("12", "Weitere", "Möglichkeiten", "zum Drucken")# + + + +#abschnitt ("12.1", "ANSCHLUSS AN DIE TEXTVERARBEITUNG", "Anschluß an die Textverarbeitung")# + +Auf zweierlei Art und Weise kann der EUDAS-Druckgenerator mit +den Programmen der EUMEL-Textverarbeitung zusammenarbeiten. +Zum ersten können Ausgabedateien des Druckprozesses anschließend +mit den Textkosmetik-Werkzeugen bearbeitet werden. Zum anderen +kann EUDAS im Editor direkt Daten aus einer EUDAS-Datei in die +editierte Datei importieren. + +#a ("Druckrichtung")# Wie Sie schon in Kapitel 7 gesehen haben, kann +man die Ausgabe des Druckgenerators statt auf den Drucker in eine +Datei umleiten. Die Datei erhält dann einen automatisch generierten +Namen. Sie können jedoch auch festlegen, daß die Ausgabe in eine +ganz bestimmte Datei geschrieben werden soll. Dazu wählen Sie die +Funktion +#f2# +#beispiel# + Ausgabe + R Richtung +#text# +#f2# +im Druckmenü. Es erscheint die Frage +#f2# +#bildschirm# +___________________________________________________________________________________________ + + Ausgabe automatisch zum Drucker (j/n) ? +___________________________________________________________________________________________ +#text# + +Verneinen Sie die Frage und es erscheint +#f2# +#bildschirm# +___________________________________________________________________________________________ + + Ausgabe in bestimmte Datei (j/n) ? +___________________________________________________________________________________________ +#text# + +Wenn Sie diese Frage auch verneinen, erhält die Ausgabedatei einen +automatisch generierten Namen. Wenn Sie die Frage aber bejahen, +können Sie anschließend den Namen der Ausgabedatei angeben. + Existiert die angegebene Datei schon, wird der Ausdruck am +Ende der Datei angefügt. Anderenfalls wird die Datei neu eingerich­ +tet. + Die Angabe der Ausgabedatei gilt jedoch nur für den folgenden +Druckvorgang. Wenn Sie mehrmals in die gleiche Datei drucken wol­ +len, müssen Sie den Namen immer wieder neu angeben. Falls Sie dies +vergessen, wird die folgenden Male wieder ein Name automatisch +generiert. + +#a ("Begrenzung der Dateigröße")# Für kleinere Systeme ist es vorteilhaft, +wenn die Druckausgabe nicht in einer großen Datei gesammelt wird, +sondern sich auf mehrere kleine Dateien verteilt. Da die Ausgabe­ +datei nach dem Drucken gelöscht wird, kann man auf diese Weise +einen Hintergrundengpaß vermeiden. Es besteht die Möglichkeit, die +maximale Größe der Ausgabedatei mit dem ELAN-Kommando +#f2# +#beispiel# + maxdruckzeilen (1000) +#text# +#f2# +auf eine bestimmte Zeilenzahl (maximal 4000) zu beschränken. Wenn +der Druckgenerator nach der Bearbeitung eines Satzes feststellt, +daß diese Maximalzahl überschritten wurde, wird die Ausgabedatei +direkt gedruckt (falls durch 'Richtung' eingestellt) und eine neue +Ausgabedatei eröffnet. + +#a ("Initialisierungsteil")# Dabei ist jedoch zu beachten, daß Drucker­ +steuerungsanweisungen, die im Vorspann eingestellt wurden, jetzt in +der neuen Datei nicht mehr vorhanden sind. In einem solchen Fall +würden die folgenden Teile der Ausgabe mit einer anderen Einstel­ +lung gedruckt. + Um dies zu vermeiden, können Sie solche Anweisungen in den +#on("i")#Initialisierungsteil#off("i")# schreiben. Der Initialisierungsteil umfaßt alle +Zeilen des Druckmusters bis zum ersten Abschnitt, also bis zur +ersten Anweisung. Zeilen im Initialisierungsteil werden beim Eröff­ +nen einer neuen Ausgabedatei an den Anfang dieser Datei ge­ +schrieben. + Druckersteuerungsanweisungen, die ein bestimmtes Schriftbild +der Ausgabe erzeugen ('type', 'limit', 'linefeed', 'start' usw.), sollten +also in den Initialisierungsteil vor Beginn aller Abschnitte ge­ +schrieben werden. + +#a ("Nachbearbeitung")# Wenn Sie in der Druckausgabe verschiedene +Schriften oder Proportionalschrift verwenden wollen, sollten Sie die +folgenden Hinweise beachten. Da EUDAS keine Informationen über +die Schriftbreiten und -größen hat, werden alle Schrifttypen gleich +behandelt. Dies gilt insbesondere für die Zeilenbreite, die ja durch +das Dateilimit des Druckmusters festgelegt ist. + So kann es passieren, daß Zeilen mit kleinen Schrifttypen zu +früh abgeschnitten werden, während Zeilen mit großen Schriften +nicht mehr auf das Blatt passen. Für diesen Fall sollten Sie das +größte benötigte Limit einstellen (zum Beispiel 135 bei Schmal­ +schrift auf DIN A 4) und die Ausgabedatei anschließend mit 'line­ +form' bearbeiten. + 'lineform' verteilt zu langen Text auf mehrere Zeilen. Außerdem +werden gegebenenfalls Trennungen durchgeführt. + 'lineform' benötigt zur Information Absatzmarken. Fehlt an +einer Zeile die Absatzmarke, wird die nächste Zeile so weit wie +möglich direkt angehängt. Die Absatzmarken in der Ausgabedatei +werden direkt aus dem Druckmuster übernommen (es ist nicht mög­ +lich, Absatzzeilen durch eingesetzte Leerzeichen zu erzeugen). Im +Normalfall sollten alle Zeilen im Druckmuster eine Absatzmarke +haben. + Wenn Sie seitenorientierte Überschriften haben möchten, kön­ +nen Sie auch 'pageform' einsetzen. Die gewünschten Überschrift­ +anweisungen können Sie im Initialisierungsteil angeben. + Die beiden Funktionen wählen Sie über den Menüpunkt +#f2# +#beispiel# + N Nachbearb. +#text# +#f2# +im Druckmenü. Dort können Sie den Namen der Ausgabedatei ange­ +ben, die Sie bearbeiten möchten. Es wird jeweils gefragt, ob Sie +'lineform' und 'pageform' anwenden wollen. Das Ergebnis der Bear­ +beitung können Sie danach ausdrucken. + +#a ("EUDAS im Editor")# Wenn Sie sich im Editor zum Zweck der Textver­ +arbeitung befinden, können Sie Daten aus einer EUDAS-Datei direkt +in die editierte Datei übernehmen. Dazu wählen Sie zunächst die +gewünschten Sätze aus - danach geben Sie den Namen eines Druck­ +musters an. EUDAS druckt die gewählten Sätze unter Beachtung des +Druckmusters direkt in die editierte Datei. + Wenn Sie das Kommando +#f2# +#beispiel# + eudas +#text# +#f2# +im Editor geben (nach ESC ESC), gelangen Sie in ein spezielles +Kurzprogramm, das alle notwendigen Information von Ihnen erfragt. + Zunächst müssen Sie den Namen der gewünschten EUDAS-Datei +angeben. Diese Datei wird dann automatisch geöffnet. Vorher geöff­ +nete Dateien werden nach Anfrage gesichert. Beachten Sie, daß +keine Datei mehr geöffnet ist, wenn Sie später EUDAS wieder normal +aufrufen. + Danach wird Ihnen eine Übersicht aller Sätze gezeigt - in einer +Form, die Sie aus der Funktion 'Übersicht' bereits kennen. Wie dort +wird Ihnen zunächst eine Auswahl der Felder angeboten, um die +Anzeige übersichtlich zu halten. Anschließend können Sie noch ein +Suchmuster angeben. + In der Übersicht können Sie sich dann zu einem bestimmten +Satz bewegen oder mehrere Sätze markieren. Nach dem Verlassen der +Übersicht können Sie den aktuellen Satz oder alle ausgewählten +(bzw. markierten) Sätze drucken. Natürlich können Sie auch beide +Fragen verneinen. + Zum Drucken wird der Name des Druckmusters erfragt. Dieses +muß bereits existieren. Die Ausgabe wird an der Stelle eingefügt, an +der der Cursor in der editierten Datei steht - die Zeile wird bei +Bedarf aufgesplittet. + Nach dem Drucken können Sie den Vorgang wiederholen, wenn +Sie zum Beispiel einen weiteren Satz drucken wollen. Dazu können +Sie auch ein neues Suchmuster angeben. Markierungen von Sätzen +werden nach dem Drucken gelöscht. + + +#abschnitt ("12.2", "SPALTENDRUCK", "Spaltendruck")# + +Für manche Anwendungen reicht es nicht aus, wenn die bearbeite­ +ten Sätze jeweils untereinander in der Ausgabe erscheinen. Häufig­ +stes Beispiel dafür ist der Etikettendruck. Hierfür werden vielfach +mehrbahnige Formulare eingesetzt. + In diesem Fall müssen die Sätze bis zur gewünschten Anzahl +von Spalten nebeneinander gesetzt werden - erst danach wird die +nächste Reihe angefangen. + EUDAS unterstützt diese Anwendung. Dazu wird hinter der +'%WIEDERHOLUNG'-Anweisung die Anzahl der Spalten als Parameter +geschrieben (durch Leerzeichen getrennt). Der Wiederholungsteil +wird dann mit der angegebenen Anzahl von Spalten gedruckt. Zu +beachten ist, daß Vorspann und Nachspann diese Spaltenanordnung +durchbrechen, also immer hinter dem bisher Gedruckten beginnen. + Die Spaltenbreite wird vom Dateilimit des Druckmusters be­ +stimmt. Die Zeilen eines Wiederholungsteils werden bis zum Limit +mit Leerzeichen aufgefüllt, wenn der nächste Wiederholungsteil +danebengesetzt wird. + Alternativ kann die Spaltenbreite in Zeichen auch als zweiter +Parameter angegeben werden. Der Wert gilt jedoch nur für den Wie­ +derholungsteil - Vor- und Nachspann richten sich immer nur nach +dem Dateilimit. + Es spielt keine Rolle, ob die nebeneinandergesetzten Wieder­ +holungsteile unterschiedliche Längen haben. Die kürzeren Teile +werden einfach bei Bedarf durch Leerzeilen ergänzt. Es ist jedoch zu +beachten, daß sich auf diese Weise unterschiedliche Längen für die +einzelnen Reihen ergeben können. + Beispiel: Das Ergebnis für Satz 1, 3, 4 und 5 sei vier Zeilen +lang, für Satz 2 aber fünf Zeilen. Bei zweispaltigem Druck wird die +erste Reihe eine Zeile länger als die folgenden (s. dazu Abb. 12-1). + +#beispiel# + Satz 1 Satz 2 + braucht braucht + vier Zeilen. ausnahmsweise + ---------------- fünf Zeilen. + ---------------- + Satz 3 Satz 4 + braucht braucht + vier Zeilen. vier Zeilen. + ---------------- ---------------- + Satz 5 + braucht + vier Zeilen. + ---------------- + +#center#Abb. 12-1 Seitenaufteilung beim Spaltendruck +#text# + +#a ("Beispiel")# Zum Abschluß noch als Beispiel ein Druckmuster für ein +dreibahniges Etikettenformular. Die Spaltenbreite und die Länge des +Wiederholungsteils richten sich natürlich nach dem verwendeten +Formular und müssen im Einzelfall ausprobiert werden. + +#beispiel# + % VORSPANN + \#start (1.0, 0.8)\# + % WIEDERHOLUNG 3 40 + + &Vorname %Name + &Strasse + + &PLZ %Ort + \#free (1.693)\# +#text# + + +#abschnitt ("12.3", "MODI", "Modi")# + +Gesetzt der Fall, Sie wollen eine Tabelle drucken, deren Einträge +auf jeden Fall in voller Länge erscheinen sollen, auch wenn sie die +Spaltenbreite überschreiten. Dies würde bedeuten, daß Tabellenein­ +träge nach rechts geschoben werden, wenn vorhergehende Einträge +länger sind. Für diesen Fall können also nur Feldmuster variabler +Position (mit '%') eingesetzt werden. Diese werden jedoch auch nach +links geschoben, wenn vorher kürzere Inhalte auftreten. + +#a ("Tabellenmodus")# Um dieses Linksschieben zu unterdrücken, können +Sie mit folgender Anweisung im Musterteil in den #on("i")#Tabellenmodus#off("i")# +umschalten: + +#beispiel# + % MODUS 2 +#text# + +Der so eingestellte Modus gilt bis zum Ende des jeweiligen Ab­ +schnitts. Zu Beginn eines Abschnitts ist der Modus 1 (Normalmodus) +eingestellt. + +#a ("Beispiel")# Um diese Anweisung auszuprobieren, sollten Sie folgendes +Druckmuster auf unsere Beispieldatei anwenden: + +#beispiel# + % WIEDERHOLUNG + % MODUS 2 + &Vorname %Name +#text# + +In der Ausgabe können Sie sehen, daß der Nachname nicht nach +links geschoben wird, so daß eine Tabelle entsteht. Ist der Vorname +jedoch zu lang, wird die Tabelleneinteilung durchbrochen und der +Nachname nach rechts geschoben, um den Vornamen nicht abschnei­ +den zu müssen: + +#beispiel# + Herbert Wegner + Helga Sandmann + Albert Katani + Peter Ulmen + Karin Regmann + Hubert Arken + Anna-Maria Simmern + Angelika Kaufmann-Drescher + Harald Fuhrmann + Friedrich Seefeld +#text# + +#a ("Zeilenfortsetzung")# Eine weitere Möglichkeit, überlange Feldinhalte +einzusetzen, besteht darin, daß der Rest des Inhaltes, der nicht +mehr in den reservierten Raum paßt, in der nächsten Zeile fortge­ +setzt wird. Dies wird im Modus 3 erreicht. Falls ein Feldinhalt ab­ +geschnitten werden müßte, wird in diesem Modus die gleiche Mu­ +sterzeile nochmal mit den restlichen Inhalten gedruckt. Dies wird +fortgesetzt, bis alle Inhalte abgearbeitet sind. + Damit die Fortsetzung sinnvoll ist, wird das letzte Wort ganz in +die nächste Zeile übernommen, falls es zerschnitten würde (ähnlich +wie im Editor). Der dadurch freiwerdende Raum in der vorigen Zeile +wird mit Leerzeichen gefüllt. Ist rechtsbündiges Einsetzen verlangt, +werden die einzelnen Teile jeweils rechtsbündig in ihrem reservier­ +ten Platz justiert. + Dieser Modus ist besonders interessant, wenn Sie längere Kom­ +mentare in eine EUDAS-Datei eintragen, die Sie dann natürlich auch +wieder drucken wollen. Den Text tragen Sie bereits in mehreren +Zeilen in die EUDAS-Datei ein. Beachten Sie, daß der Umbruch des +Textes im Druck nicht mit dem Umbruch des Textes am Bildschirm +übereinstimmt. Wollen Sie dies verhindern, müssen Sie jeden Absatz +des Textes in ein eigenes Feld schreiben. + Wie zu Anfang des Kapitels bereits angedeutet, kann der Um­ +bruch bei Proportionalschrift nicht korrekt sein, da EUDAS die Zei­ +chenbreiten nicht kennt. Um die nachfolgende Bearbeitung mit +'lineform' zu ermöglichen, werden bei fortgesetzten Feldern grund­ +sätzlich keine Absatzmarken an die Zeilen geschrieben. Lediglich die +letzte Fortsetzungszeile erhält eine Absatzmarke. + In den Fortsetzungszeilen, werden die Feldmuster, deren Inhalte +bereits abgearbeitet sind, leer eingesetzt. Die Mustertexte zwischen +den Feldmustern werden in den Fortsetzungszeilen durch Leerzei­ +chen ersetzt. + Die Anzahl der Fortsetzungszeilen kann durch die Anweisung + +#beispiel# + % MEHR n +#text# + +auf eine bestimmte Zahl 'n' festgelegt werden. Wenn alle Inhalte +abgearbeitet wurden, aber die Anzahl der Zeilen noch nicht erreicht +ist, werden entsprechend viele Zeilen mit leeren Inhalten erzeugt. + Die Zeilenwiederholung kann auch mit dem Tabellenmodus kom­ +biniert werden. Dies wird im Modus 4 erreicht. Felder variabler +Position werden auch in diesem Modus nicht nach links geschoben. +Außerdem werden aber in Fortsetzungszeilen die Mustertexte zwi­ +schen den Feldmustern wiederholt, um z.B. Tabellenbegrenzungen zu +erzeugen. + +#a ("Beispiele")# Zur Verdeutlichung hier noch einige Beispiele. Das fol­ +gende Druckmuster: + +#beispiel# + % WIEDERHOLUNG + % MODUS 3 + Kommentar: &Kommentar + ---------- +#text# + +könnte folgende Ausgabe bewirken: + +#beispiel# + Kommentar: Dies ist ein längerer Kommentar aus + einer EUDAS-Datei, der zum Drucken + auf eine Breite von 48 Zeichen + umbrochen worden ist. Nur die letzte + Zeile hat eine Absatzmarke. + ---------- +#text# + +Soll die Anzahl der Zeilen immer gleich bleiben, könnte man folgen­ +des Druckmuster verwenden: + +#beispiel# + % WIEDERHOLUNG + % MODUS 3 + % MEHR 5 + Kommentar: &Kommentar + ---------- +#text# + +Mit einem kürzeren Text ergäbe sich folgendes Bild: + +#beispiel# + Kommentar: Nur ein kurzer Text. + + + + + ---------- +#text# + +Für eine Tabelle würde man den Modus 4 benutzen: + +#beispiel# + % VORSPANN + -------------------------------------------------------- + ! Abk. ! Kommentar ! + !---------+--------------------------------------------! + % WIEDERHOLUNG + % MODUS 4 + ! &abk ! &Kommentar&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! + ----------+--------------------------------------------- +#text# + +Als Ausgabe könnte folgender Text erscheinen: + +#beispiel# + -------------------------------------------------------- + ! Abk. ! Kommentar ! + !---------+--------------------------------------------! + ! MA11 ! Dieser Kurs hat eine Menge an besonderen ! + ! ! Eigenschaften, die ihn für jüngere ! + ! ! Teilnehmer geeignet erscheinen lassen. ! + !---------+--------------------------------------------! + ! TD04 ! Stellt keine besonderen Anforderungen. ! + !---------+--------------------------------------------! + ! PM01 ! Seit dem 01.01. eingerichtet und noch ! + ! ! nicht voll besetzt. ! + ----------+--------------------------------------------- +#text# + +Beachten Sie hier, daß Tabelleneinträge hier nicht wie im Modus 2 +geschoben, sondern auf weitere Zeilen verteilt werden, wenn sie zu +lang sind. Außerdem werden die Tabellenbegrenzungen mit wieder­ +holt. Das Feldmuster für Kommentar muß jedoch mit fester Länge +angegeben werden, da sonst die rechte Tabellenbegrenzung bis zum +Dateilimit geschoben würde. + +#a ("Zusammenfassung")# Zum Abschluß dieses Abschnitts eine Zusammen­ +fassung aller möglichen Modi: + + Modus Effekt + + 1 Normalmodus. + '%'-Feldmuster werden auch nach links geschoben. + Keine Zeilenwiederholung. +#f2# + 2 Tabellenmodus. + '%'-Feldmuster werden nicht nach links geschoben. + Keine Zeilenwiederholung. +#f2# + 3 Normalmodus mit Zeilenwiederholung. + '%'-Feldmuster werden auch nach links geschoben. + Zeilenwiederholung ohne Zwischentexte. +#f2# + 4 Tabellenmodus mit Zeilenwiederholung. + '%'-Feldmuster werden nicht nach links geschoben. + Zeilenwiederholung mit Zwischentexten. + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.13 b/app/eudas/4.4/doc/user-manual/eudas.hdb.13 new file mode 100644 index 0000000..387d439 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.13 @@ -0,0 +1,734 @@ +#type ("prop")##limit (14.0)# +#format# +#page (133)# +#kapitel ("13", "Programmierung", "von", "Druckmustern")# + + + +#abschnitt ("13.1", "ABKÜRZUNGEN", "Abkürzungen")# + +In den vorigen Kapiteln haben Sie erfahren, daß man Feldmuster +von ganz bestimmter Länge definieren kann, deren Inhalt in genau +dieser Länge eingesetzt und bei Bedarf abgeschnitten wird. Bei der +Angabe dieser Länge spielt jedoch die Länge des Feldnamens eine +ganz entscheidende Rolle. Das kürzeste Feldmuster fester Länge, das +Sie definieren können, ist nämlich zwei Zeichen länger als der Feld­ +name (ein Musterzeichen vorher und eins nachher). + Hätte das Feld 'PLZ' den Namen 'Postleitzahl' bekommen, so +müßte ein solches Feldmuster mindestens eine Länge von 14 Zeichen +haben. Damit Sie mit diesem Feldnamen auch ein Feldmuster der +Länge 4 bekommen können (Postleitzahlen haben in den seltensten +Fällen mehr als 4 Stellen), haben Sie die Möglichkeit, den Namen +'Postleitzahl' für die Verwendung im Druckmuster geeignet abzu­ +kürzen. + Abkürzungen haben jedoch noch eine viel weitreichendere +Bedeutung. Mit ihnen ist es möglich, nicht nur die Feldinhalte einer +EUDAS-Datei einzusetzen, sondern auch jeden anderen Text, den Sie +mit einem ELAN-Programm erzeugen können. + Die einfachsten zusätzlichen Daten, die Sie verwenden können, +sind z.B. Datum und Uhrzeit. Für weitergehende Zwecke können Sie +die Inhalte der EUDAS-Datei auch für Berechnungen verwenden und +damit so umfangreiche Probleme wie das Schreiben von Rechnungen +oder statistische Auswertungen unter Verwendung eines Druck­ +musters lösen. + +#a ("Abkürzungsteil")# Abkürzungen werden in einem speziellen Abkür­ +zungsteil am Ende eines Abschnittes angegeben. Der Abkürzungsteil +wird durch die Anweisung + +#beispiel# + % ABKUERZUNGEN +#text# + +eingeleitet. Eine Abkürzungsdefinition hat eine ähnliche Form wie +ein Refinement (Falls Sie nicht wissen, was das ist, vergessen Sie +es). Zu Beginn steht der Name der Abkürzung in Form eines Feld­ +musters, beginnend in der ersten Spalte. Danach folgt, durch Leer­ +zeichen getrennt, ein Doppelpunkt in der gleichen Zeile. Daran +schließt sich ein beliebiger ELAN-Ausdruck an, der sich in freiem +Format über beliebig viele Zeilen erstrecken kann und mit einem +Punkt abgeschlossen werden muß. Dieser ELAN-Ausdruck muß ein +TEXT-Objekt liefern. + +#a ("Feldinhalt")# Für die Abfrage von Inhalten aus einer EUDAS-Datei +ist der Ausdruck +#f2# +#beispiel# + f ("Feldname") +#text# +#f2# +vordefiniert. Die Abkürzung des Feldes 'Postleitzahl' würde also als +Ausschnitt folgendermaßen aussehen: + +#beispiel# + % ABKUERZUNGEN + &p : f ("Postleitzahl") . +#text# + +Mit dieser Definition kann man im Muster so verfahren, als ob das +Feld 'Postleitzahl' auch 'p' hieße. Diese einfachste Form der Ab­ +kürzung können Sie natürlich variieren, indem Sie für 'p' und +'Postleitzahl' Ihre eigenen Namen einsetzen. + +#a ("Übersetzung")# Beachten Sie, daß das Druckmuster in ein ELAN-Pro­ +gramm umgeformt werden muß, da ELAN-Ausdrücke in ihm vorkom­ +men. Das automatisch erzeugte ELAN-Programm wird dann vom +ELAN-Compiler übersetzt und ausgeführt. Fehler in den ELAN-Aus­ +drücken im Abkürzungsteil können erst vom ELAN-Compiler ent­ +deckt werden. Dieser kennt jedoch das Druckmuster nicht und mel­ +det die Fehler anhand des generierten Programms. Sie müssen in +einem solchen Fall aufpassen, daß Sie die Fehlerquelle an der rich­ +tigen Stelle im Druckmuster lokalisieren (Hilfestellungen dazu sind +im Kapitel über die Übersetzung von Druckmustern zu finden). + +#a ("Beispiel")# Um die Verwendung von Abkürzungen zu demonstrieren, +wollen wir folgendes Druckmuster betrachten: + +#beispiel# + % VORSPANN + Adressenliste als Beispiel für Abkürzungen + Stand: &Datum + ------------------------------------------ + % ABKUERZUNGEN + &Datum : date . + + % WIEDERHOLUNG + &&l : &Vorname %Name + &Strasse + &&p& &Ort + ------------------------------------------ + % ABKUERZUNGEN + &l : lfd nr . + &p : f ("PLZ") . + + % NACHSPANN + &l Adressen gedruckt. +#text# + +Dieses Beispiel enthält eine ganze Reihe interessanter Details. Als +erstes sollten Sie registrieren, daß auch im Vorspann oder Nach­ +spann Feldmuster verwendet werden können. Soll in diesem Fall ein +Feldinhalt aus der EUDAS-Datei eingesetzt werden, so werden beim +Vorspann die Inhalte des ersten und beim Nachspann die Inhalte des +letzten durch Suchmuster ausgewählten Satzes verwendet. Daher +kann auch jeder Abschnitt einen Abkürzungsteil haben. Abkürzun­ +gen gelten jedoch für alle Abschnitte (s. '&l'); die Aufteilung in +mehrere Abkürzungsteile fördert im wesentlichen die Übersichtlich­ +keit. + Versuchen Sie, an diesem Beispiel die wichtigsten Unterschiede +zwischen dem #on("i")#Musterteil#off("i")# und dem #on("i")#Abkürzungsteil#off("i")# eines Abschnittes +zu verstehen. Das Format des Musterteiles soll in die Ausgabe +übernommen werden; daher ist dort die Stellung jedes Wortes wich­ +tig. Im Abkürzungsteil definieren Sie Abkürzungen ohne bestimm­ +tes Format - mit der einzigen Ausnahme, daß eine Abkürzungs­ +definition mit einem '&' in der ersten Spalte anfangen und ein +Leerzeichen vor dem Doppelpunkt haben muß. Wie Sie sehen, dürfen +dort Leerzeilen zur besseren Lesbarkeit eingefügt werden. +Sie sollten bei unserem Beispiel folgende Ausgabe erhalten: + +#beispiel# + Adressenliste als Beispiel für Abkürzungen + Stand: 28.12.84 + ------------------------------------------ + 1 : Herbert Wegner + Krämergasse 12 + 5000 Köln + ------------------------------------------ + 2 : Helga Sandmann + Willicher Weg 109 + 5300 Bonn 1 + ------------------------------------------ + 3 : Albert Katani + Lindenstr. 3 + 5210 Troisdorf + ------------------------------------------ + 4 : Peter Ulmen + Mozartstraße 17 + 5 Köln 60 + ------------------------------------------ + 5 : Karin Regmann + Grengelweg 44 + 5000 Köln 90 + ------------------------------------------ + 6 : Hubert Arken + Talweg 12 + 5200 Siegburg + ------------------------------------------ + 7 : Anna-Maria Simmern + Platanenweg 67 + 5 Köln 3 + ------------------------------------------ + 8 : Angelika Kaufmann-Drescher + Hauptstr. 123 + 53 Bonn 2 + ------------------------------------------ + 9 : Harald Fuhrmann + Glockengasse 44 + 5000 Köln 1 + ------------------------------------------ + 10 : Friedrich Seefeld + Kabelgasse + 5000 Köln-Ehrenfeld + ------------------------------------------ + 10 Adressen gedruckt. +#text# + +Nun zu den Abkürzungen im einzelnen. Das Feld 'PLZ' muß abge­ +kürzt werden, damit es rechtsbündig vor den Ort gedruckt werden +kann. Die Abkürzung 'p' benutzt die im vorigen Kapitel beschriebe­ +ne Form zur Abfrage des Feldinhaltes. + 'Datum' wird als Abkürzung für das aktuelle Datum definiert, +ein häufig benötigter Fall. 'date' ist der ELAN-Ausdruck, der das +Datum liefert. (Bemerkung für ELAN-Programmierer: der Name der +Abkürzung gehorcht nicht der ELAN-Syntax für Bezeichner). + Eine für Tabellen sinnvolle Funktion wird bei der Definition +von 'l' verwendet. Der von EUDAS definierte Ausdruck 'lfd nr' lie­ +fert die laufende Nummer des gerade gedruckten Satzes als Text. +Dabei ist zu beachten, daß die laufende Nummer nicht mit der Satz­ +nummer übereinstimmt, sondern nur während des Druckvorganges +von 1 an bei jedem gedruckten Satz hochgezählt wird. Diese Funk­ +tion dient dazu, die Sätze in der Liste durchzunumerieren. + Die laufende Nummer soll in der Liste rechtsbündig mit Doppel­ +punkt vor dem Namen stehen. Dazu wird das Feldmuster '&&l' be­ +nutzt, eine Form, die eigentlich keinen Sinn hat (die Kombination +'variable Länge' und 'rechtsbündig' gibt es nicht). Um ein möglichst +kurzes Feldmuster schreiben zu können, wird in diesem Fall jedoch +feste Länge unterstellt (auch ohne folgendes '&'). Damit hat das +kürzeste Feldmuster fester Länge drei Zeichen sowohl im linksbün­ +digen ('&l&') wie auch im rechtsbündigen Fall ('&&l'). + +#a ("Auswertungen")# Die Verwendung der Abkürzung 'l' im Nachspann +kann als erstes Beispiel für eine Auswertungsfunktion gelten. Da +für den Nachspann die Daten des letzten Satzes verwendet werden, +erscheint hier die laufende Nummer des letzten Satzes und somit die +Anzahl der Sätze, die gedruckt wurden. Das kann dazu benutzt +werden, die Sätze zu zählen, die eine bestimmte Suchbedingung +erfüllen. Folgendes Druckmuster zählt die Anzahl der Frauen oder +Männer in der Datei: + +#beispiel# + % NACHSPANN + &l Personen mit dem Geschlecht '%' vorhanden. + % ABKUERZUNGEN + &l : lfd nr . +#text# + +Wenn Sie vor dem Drucken jetzt die Suchbedingung 'm' für das Feld +'m/w' einstellen, werden alle Männer ausgewählt. Das Drucken be­ +steht in diesem Fall nur aus dem Hochzählen der laufenden Nummer +für jeden Mann. Im Nachspann kann das Ergebnis dann ausgegeben +werden; zugleich soll der aktuelle Wert des Feldes 'm/w' gedruckt +werden, damit das Druckmuster auch für das Zählen der Frauen +verwendet werden kann. + Die beiden möglichen Ausgaben würden dann so aussehen: + +#beispiel# + 6 Personen mit dem Geschlecht 'm' vorhanden. + + 4 Personen mit dem Geschlecht 'w' vorhanden. +#text# + +#a ("Zusammenfassung")# Wir können die Erkenntnisse dieses Abschnittes +wie folgt zusammenfassen: +#f2# +#bsp("*")# Feldmuster können auch im Vorspann und Nachspann verwendet + werden. Im Vorspann werden die Daten des ersten, im Nachspann + die Daten des letzten ausgewählten Satzes verwendet. +#f2# +#bsp("*")# Der Musterteil eines Abschnittes definiert ein Format; der Ab­ + kürzungsteil ist formatfrei. +#f2# +#bsp("*")# 'lfd nr' dient zum Durchnumerieren aller gedruckten Sätze. +#f2# +#bsp("*")# Ein rechtsbündiges Feldmuster hat immer auch feste Länge. + +#a ("Komplexe Abkürzungen")# Mit Hilfe von Abkürzungen können wir +jetzt auch bessere Musterbriefe schreiben. Ein Problem, das bereits +angesprochen wurde, besteht darin, daß in der Anrede je nach Ge­ +schlecht 'Herr' oder 'Frau' stehen soll. Um dieses Problem zu lösen, +wird der Inhalt des Feldes 'm/w' benötigt. + Da in einer Abkürzung jede ELAN-Anweisung erlaubt ist, die +einen Text liefert, können natürlich auch #on("i")#IF-Anweisungen#off("i")# verwen­ +det werden. Mit diesen Informationen können wir jetzt die Abkür­ +zung 'Anrede' definieren: + +#beispiel# + % ABKUERZUNGEN + &Anrede : + IF f ("m/w") = "w" THEN + "Frau" + ELSE + "Herr" + END IF . +#text# + +Für Nicht-Programmierer: Die IF-Anweisung besteht aus einer Ab­ +frage und zwei Alternativen. Die Abfrage steht zwischen dem IF und +dem THEN und besteht in der Regel aus einer Abfrage, ob zwei +Dinge gleich oder ungleich (<>), größer oder kleiner sind. Außerdem +können mehrere Abfragen mit AND (und) und OR (oder) kombiniert +werden. Näheres dazu im Kapitel 14. + Die Alternative hinter dem THEN wird ausgewählt, wenn die +Abfrage zutrifft. An dieser Stelle sind wieder beliebige Ausdrücke +erlaubt, die einen Text liefern, einschließlich erneuter IF-Anwei­ +sungen (Schachtelung). Die Alternative zwischen ELSE und END IF +wird ausgewählt, wenn die Abfrage nicht zutrifft. + +#a ("Textkonstanten")# Bisher wurden nur ELAN-Funktionen als Textlie­ +feranten betrachtet ('date', 'lfd nr', 'f'). In unserem Fall werden +aber #on("i")#Textkonstanten#off("i")# in den Alternativen der IF-Anweisung benö­ +tigt. Textkonstanten werden in ELAN in Anführungsstriche einge­ +schlossen, die aber nicht zum Text gehören. Innerhalb einer Text­ +konstanten werden Leerzeichen wie alle anderen Zeichen angesehen +(erscheinen also auch nachher in der Ausgabe). + Bei solchen Abkürzungen, die längere Anweisungen umfassen, +sollten Sie das freie Format ausnutzen und eine möglichst über­ +sichtliche Darstellung wählen. Wie Sie sehen, muß nur der Doppel­ +punkt noch in der ersten Zeile stehen, der Rest kann sich beliebig +auf die folgenden Zeilen erstrecken. + +#a ("Beispiel")# Ein typischer Einsatz einer IF-Anweisung für die Anrede +sieht so aus: + +#beispiel# + % WIEDERHOLUNG + + Sehr geehrte&Anrede %! + + ... + % ABKUERZUNGEN + &Anrede : + IF f ("m/w") = "m" THEN + "r Herr" + ELSE + " Frau" + END IF . +#text# + +Sie sollten jetzt diese Konstruktion in einen Musterbrief einfügen +können. Probieren Sie ihn dann als Beispiel aus ! + +#a ("Weitere Möglichkeiten")# Durch Verwendung von Abkürzungen ist es +auch möglich, rechtsbündige Felder mit einer Länge von weniger als +3 Zeichen zu simulieren. Dies geschieht mit Hilfe der Textoperatio­ +nen von ELAN. Ohne ELAN-Vorkenntnisse können Sie dieses Bei­ +spiel überlesen. In unserer Liste im obigen Beispiel sind die laufen­ +den Nummern höchstens zweistellig und sollten deshalb auch nur +zwei Stellen belegen. Dies würde folgende Abkürzung ermöglichen: + +#beispiel# + % ABKUERZUNGEN + &l : text (lfd nr als zahl, 2) . + lfd nr als zahl : int (lfd nr) . +#text# + +Die Prozedur 'text' wird dazu benutzt, eine Zahl rechtsbündig auf +zwei Stellen zu formatieren (s. EUMEL-Benutzerhandbuch). Da die +Abkürzung immer eine Länge von zwei Zeichen hat, kann sie auch in +einem Feldmuster variabler Länge eingesetzt werden. Die Attribute +'feste Länge' und 'rechtsbündig' werden in diesem Fall also nicht +durch das Feldmuster, sondern durch die Abkürzung selbst erzeugt. + Um die Prozedur 'text' anwenden zu können, muß die laufende +Nummer als Zahl (sprich: INT-Objekt) vorliegen. Diese Umwandlung +wird mit der Prozedur 'int' vorgenommen, die einen Text in eine +Zahl umwandelt. Obwohl man 'int (lfd nr)' direkt in den Aufruf von +'text' hätte schreiben können, wird hier als Demonstration dafür ein +Refinement verwendet. + Refinements können in einem Abkürzungsteil neben Abkürzun­ +gen stehen und von allen Abkürzungen benutzt werden. Sie werden +ähnlich geschrieben wie Abkürzungen, nur ihr Name muß in Klein­ +buchstaben geschrieben werden, dafür muß er nicht in der ersten +Spalte anfangen und kann Leerzeichen enthalten. Bei komplizierte­ +ren Ausdrücken sollten Refinements zur besseren Lesbarkeit einge­ +setzt werden. + Sie können die IF-Anweisung auch mit beliebig vielen ELIF- +Teilen versehen. Achten Sie jedoch darauf, daß die IF-Anweisung +#on("i")#immer#off("i")# irgendeinen Wert liefern muß. Sie dürfen also den ELSE-Teil +nicht weglassen. Statt einer IF-Anweisung können Sie natürlich +auch eine SELECT-Anweisung verwenden. Es stehen Ihnen im Prin­ +zip alle werteliefernden Anweisungen von ELAN zur Verfügung. + Die Programmiersprache ELAN bietet Ihnen noch weit mehr +Möglichkeiten, als hier beschrieben werden können. So können Sie +sich eigene Prozeduren definieren und diese dann in Abkürzungen +verwenden. In Kapitel 14 und 15 finden Sie eine Einführung in die +wichtigsten Konstrukte, die für EUDAS gebraucht werden. + + +#abschnitt ("13.2", "BEDINGTE MUSTERTEILE", "Bedingte Musterteile")# + +Wenn größere Teile des Druckmusters in Abhängigkeit von bestimm­ +ten Daten unterschiedlich ausfallen sollen, werden die dazu benö­ +tigten Abkürzungen sehr umfangreich. Für solche Fälle kann man +IF-Anweisungen auch im Musterteil eines Abschnitts verwenden. In +diesem Fall werden die Alternativen der IF-Anweisung durch +Musterzeilen dargestellt. + Im Musterteil müssen jedoch die Zeilen, die Teil der IF-An­ +weisung sind, von den Musterzeilen unterschieden werden. Deshalb +werden die Anweisungszeilen durch ein '%'-Zeichen in der ersten +#on("i")#und#off("i")# zweiten Spalte gekennzeichnet. Das zweite '%'-Zeichen dient +zur Unterscheidung von Anweisungen an den Druckgenerator, die +nicht an den ELAN-Compiler übergeben werden sollen. + Mit einer IF-Anweisung im Musterteil kann man das Anredepro­ +blem auch folgendermaßen lösen: + +#beispiel# + % WIEDERHOLUNG + %% IF f ("m/w") = "w" THEN + Sehr geehrte Frau &! + %% ELSE + Sehr geehrter Herr &! + %% END IF; +#text# + +Beachten Sie den Unterschied, daß die IF-Anweisung hier mit einem +Semikolon abgeschlossen werden muß - in Abkürzungen mußte ja ein +Punkt danach folgen. Außerdem darf hier der ELSE-Teil (die zweite +Alternative) fehlen, während in einer Abkürzung in jeder Alternati­ +ve etwas stehen muß (zumindest der leere Text ""). + Falls sich der IF-THEN-Teil über mehr als eine Zeile erstrek­ +ken soll, muß jede dieser Zeilen mit '%%' beginnen, da die Folgezei­ +len sonst als Musterzeilen gedruckt würden. Benutzen Sie in einem +solchen Fall jedoch besser ein Refinement, das Sie im Abkürzungs­ +teil definieren müssen. + Sie können im Musterteil auch andere ELAN-Anweisungen +verwenden. Der Unterschied zu Abkürzungen liegt darin, daß die +Musterzeilen nicht als Werte angesehen werden, die die Anweisung +liefern muß, sondern als Anweisungen, die dort aufgeführten Mu­ +sterzeilen einzusetzen und zu drucken. Daher kann im Musterteil +auch eine FOR-Schleife sinnvoll sein, wenn in Abhängigkeit eines +Wertes eine bestimmte Anzahl von Zeilen gedruckt werden soll. + + +#abschnitt ("13.3", "ÜBERSETZUNG", "Übersetzung")# + +Wenn Sie bis jetzt auch als ELAN-Programmierer immer noch nicht +ganz durchblicken, wie Sie welche ELAN-Anweisungen verwenden +können, dann ist das noch kein Anlaß zur Sorge. Es ist kaum mög­ +lich, die genauen Auswirkungen beliebiger Anweisungen zu be­ +schreiben, ohne den Übersetzungsprozeß zu schildern, der diese +Anweisungen zu einem ELAN-Programm zusammenbindet. Daher soll +diese Übersetzung jetzt genauer erklärt werden. + +#a ("Übersetzungsmechanismus")# Alle Zeilen eines Abkürzungsteils wer­ +den direkt in das Programm übernommen, wobei der Name einer Ab­ +kürzung durch einen beliebig gewählten Refinementnamen ersetzt +wird ('abk' + eine laufende Nummer). Alle Abkürzungen und Re­ +finements werden als globale Refinements definiert, also außerhalb +von Prozeduren. Dadurch wird erreicht, daß sie an jeder Stelle +verwendet werden können. + Damit eine Abkürzung richtig als Refinement übersetzt wird, +muß sie ein TEXT-Objekt als Wert liefern. Die anderen Refinements +sind beliebig, da Sie nur in selbstdefinierten Anweisungen verwen­ +det werden. Die Refinements der Abkürzungen werden in einer Zu­ +weisung an eine TEXT-Variable verwendet, damit der Druckgenera­ +tor auf den entsprechenden Wert zugreifen kann. + Jeder Abschnitt wird dagegen als eine Prozedur übersetzt. Jede +Folge von Musterzeilen wird in eine Anweisung übersetzt, diese +Musterzeilen einzusetzen und zu drucken. Jede '%%'-Anweisung +wird einfach unverändert dazwischen geschrieben. Die Vorspann- +Prozedur wird einmal zu Anfang aufgerufen, die Prozedur für den +Wiederholungsteil einmal für jeden ausgewählten Satz und die Nach­ +spann-Prozedur einmal am Schluß. + Bei Fehlern im ELAN-Teil zeigt der Compiler das erzeugte Pro­ +gramm zusammen mit seinen Fehlermeldungen im Paralleleditor. Sie +müssen nun die Fehlermeldung lokalisieren und anhand der eben +gegebenen Hinweise in das ursprüngliche Druckmuster zurücküber­ +setzen, damit Sie dort den Fehler korrigieren können. + +#a ("Beispiel")# Nun müßten Sie genug Informationen haben, um beliebige +ELAN-Anweisungen in das Druckmuster einfügen zu können. Als +Beispiel wollen wir versuchen, alle Männer und Frauen in der +Adressendatei zu zählen, ohne ein Suchmuster einstellen zu müssen +und ohne den Druckvorgang zweimal ablaufen zu lassen (wie dies +bei dem obigen Beispiel der Fall war). Ein erster Versuch könnte so +aussehen: + +#beispiel# + % VORSPANN + %% INT VAR maenner, frauen; + %% maenner := 0; + %% frauen := 0; + % WIEDERHOLUNG + %% IF f ("m/w") = "m" THEN + %% maenner INCR 1 + %% ELSE + %% frauen INCR 1 + %% END IF + % NACHSPANN + &maenner Männer und %frauen Frauen vorhanden. +#text# + +Aber Vorsicht! In diesem Beispiel sind mehrere Fehler eingebaut. +Finden Sie sie! + +#a ("Fehler im Beispiel")# Der erste Fehler befindet sich im Nachspann. +Hier wird versucht, die Namen der beiden Variablen 'maenner' und +'frauen' direkt in einem Feldmuster zu verwenden. Diese beiden +Namen sind dem Druckgenerator nicht bekannt, sondern nur dem +ELAN-Compiler. Um die Werte der beiden Variablen einsetzen zu +können, müssen Sie also zwei geeignete Abkürzungen definieren. + Der zweite Fehler ist schwieriger zu finden. Wie oben gesagt, +wird jeder Abschnitt in eine Prozedur übersetzt. Die in einem Ab­ +schnitt definierten Variablen können also nur in diesem Abschnitt +verwendet werden (sie sind lokal) und auch nicht im Abkürzungs­ +teil, da dieser wieder global vereinbart wird. Die beiden im Vor­ +spann definierten Variablen stehen also im Wiederholungsteil und im +Nachspann nicht zur Verfügung. + +#a ("Anweisungen im Initialisierungsteil")# Für diesen Fall gibt es die +Möglichkeit, ELAN-Anweisungen vor allen Abschnitten im Initiali­ +sierungsteil zu definieren. Diese Anweisungen sind dann ebenfalls +global. Das richtige Druckmuster finden Sie auf der nächsten Seite. + Natürlich könnten Sie die Initialisierung der beiden Variablen +auch noch aus dem Vorspann herausnehmen. Denken Sie daran, daß +Sie aus INT-Variablen erst einen Text machen müssen, ehe Sie sie +in eine Musterzeile einsetzen können. Beachten Sie Schreibweise der +Variablen: in ELAN können die Umlaute nicht in Bezeichnern ver­ +wendet werden, daher muß die Variable mit 'ae' geschrieben wer­ +den. Im Mustertext und in Abkürzungs- und Feldnamen können die +Umlaute jedoch frei verwendet werden. + +#beispiel# + %% INT VAR maenner, frauen; + % VORSPANN + %% maenner := 0; + %% frauen := 0; + % WIEDERHOLUNG + %% IF f ("m/w") = "m" THEN + %% maenner INCR 1 + %% ELSE + %% frauen INCR 1 + %% END IF + % NACHSPANN + &m Männer und %f Frauen vorhanden . + % ABKUERZUNGEN + &m : text (maenner) . + &f : text (frauen) . +#text# + + +#abschnitt ("13.4", "GRUPPEN", "Gruppen")# + +Der Druckgenerator bietet die Möglichkeit, Vorspann und Nachspann +nicht nur am Anfang und am Ende, sondern auch an bestimmten +Stellen zwischen Sätzen zu drucken. Diese Stellen sind dadurch +bestimmt, daß ein bestimmtes Merkmal (z.B. ein Feldinhalt) seinen +Wert ändert. Ein solches Merkmal wird im Druckmuster #on("i")#Gruppe#off("i")# ge­ +nannt. + Ein Beispiel für die Verwendung von Gruppen ist eine Schüler­ +datei, die nach Klassen geordnet ist. Definiert man das Feld 'Klas­ +se' als Gruppe, so wird jeweils am Ende einer Klasse ein Nachspann +und am Beginn einer Klasse ein Vorspann gedruckt. + Dieses Verfahren ist eine Erweiterung der bisher beschriebenen +Methode, indem eine Datei quasi in mehrere Dateien untergliedert +wird, die jedoch in einem Arbeitsgang gedruckt werden können. +Voraussetzung dafür ist jedoch, daß die Datei nach dem Gruppen­ +merkmal geordnet ist - der Druckgenerator sammelt nicht erst alle +Schüler einer Klasse aus der Datei, sondern erwartet sie hinter­ +einander. + +#a ("Gruppendefinition")# Eine Gruppe wird im Initialisierungsteil des +Druckmusters (also vor allen Abschnitten) definiert. Notwendige +Daten sind eine Nummer zur Identifizierung und das Merkmal. Die +Nummer sollte am sinnvollsten von 1 an vergeben werden; die mög­ +lichen Werte sind nach oben hin beschränkt. Das Merkmal ist ein +beliebiger ELAN-Ausdruck, der einen Text liefert. Sinnvollerweise +wird er den Inhalt eines Feldes enthalten. + Gruppendefinitionen müssen nach allen ELAN-Anweisungen im +Initialisierungsteil folgen, und zwar, weil die Gruppendefinitionen +alle in einer Prozedur zusammengefaßt werden, die bei jedem neuen +Satz auf Gruppenwechsel testet. + Unter der Annahme, daß die oben erwähnte Schülerdatei ein +Feld 'Klasse' besitzt, würde die Gruppe wie folgt definiert: + +#beispiel# + % GRUPPE 1 f ("Klasse") +#text# + +Nach der Anweisung 'GRUPPE' folgt die Gruppennummer und dann +ein ELAN-Ausdruck. Die ganze Definition muß in einer Zeile stehen; +reicht der Platz nicht aus, müssen Sie in einem Abkürzungsteil ein +Refinement definieren. + +#a ("Klassenliste")# Das komplette Druckmuster für die Klassenliste könn­ +te folgendes Aussehen haben, wenn außer 'Klasse' auch noch die +Felder 'Name' und 'Vorname' vorhanden sind: + +#beispiel# + % GRUPPE 1 f ("Klasse") + % VORSPANN + Klassenliste für Klasse &Klasse + ---------------------------- + % WIEDERHOLUNG + &Vorname %Name + % NACHSPANN + \#page\# +#text# + +Wenn eine Gruppe definiert ist, werden im Nachspann immer die +Feldinhalte des letzten Satzes vor dem Gruppenwechsel gedruckt, im +Vorspann die Inhalte des ersten Satzes nach dem Wechsel. Daher +kann hier im Vorspann die Klasse gedruckt werden, da sie sich erst +ändert, wenn schon wieder der nächste Vorspann gedruckt wird. + +#a ("Mehrere Gruppen")# Wie die Identifikation über eine Gruppennummer +vermuten läßt, können Sie mehrere Gruppen definieren. Nachspann +und Vorspann werden jeweils gedruckt, wenn sich das Merkmal ir­ +gendeiner Gruppe ändert. Ob eine bestimmte Gruppe gewechselt hat, +kann mit der Abfrage + +#beispiel# + BOOL PROC gruppenwechsel (INT CONST gruppennummer) +#text# + +in einer IF-Anweisung ermittelt werden. Vor dem ersten und nach +dem letzten Satz wechseln automatisch alle Gruppen. + Die ganze Datei bildet eine Quasi-Gruppe mit der Nummer 0. +Sie ist immer definiert und wechselt nur vor dem ersten und nach +dem letzten Satz. Sie ist es, die bewirkt, daß Vorspann und Nach­ +spann in ihrer normalen Weise gedruckt werden. + +#a ("Anwendungsbeispiel")# Um einige der Möglichkeiten zu illustrieren, +die durch Gruppen geschaffen werden, wollen wir als Beispiel eine +Anwendung betrachten, die neue Wege für die Benutzung von EUDAS +aufzeigt. + Aus einer Datei, in der für jede Bestellung der Kunde, der Ar­ +tikel, die bestellte Menge und der Einzelpreis des Artikels einge­ +tragen werden, sollen anschließend Rechnungen gedruckt werden. +Die Datei soll folgende Felder haben: + +#beispiel# + 'Kundennummer' + 'Artikelnummer' + 'Einzelpreis' + 'Menge' +#text# + +Als Voraussetzung müssen die Bestellungen in der Datei jeweils +nach Kunden geordnet vorliegen. Die Kundennummer wird als Gruppe +definiert, so daß die Bestellungen eines Kunden zu einer Rechnung +zusammengefaßt werden können. Das Druckmuster rechnet dann die +einzelnen Preise zusammen und gibt eine Endsumme aus. + Damit in der Rechnung Name und Adresse des Kunden auftau­ +chen können, wird zu der Bestellungsdatei die Kundendatei gekop­ +pelt, die folgende Felder haben soll: + +#beispiel# + 'Kundennummer' + 'Name' + 'Vorname' + 'Strasse' + 'PLZ' + 'Ort' +#text# + +Stellen Sie sich zum Ausprobieren des folgenden Druckmusters ge­ +gebenenfalls eigene Daten zusammen. Hier nun das Druckmuster: + +#beispiel# + %% REAL VAR gesamtpreis, summe; + % GRUPPE 1 f ("Kundennummer") + % VORSPANN + %% summe := 0.0; + Fa. Kraus & Sohn + Schotterstr. 10 + + 5000 Köln 1 + &Vorname %Name + &Strasse + + &PLZ &Ort &Datum + + R E C H N U N G + =============== + + Menge Artikelnr. Einzelpreis Gesamtpreis + ------------------------------------------------ + % ABKUERZUNGEN + &Datum : date . + + % WIEDERHOLUNG + %% gesamtpreis := round + %% (wert ("Einzelpreis") * wert ("Menge"), 2); + %% summe INCR gesamtpreis; + &Menge &Artikelnummer &&&&epr&& &&&&gpr&& + % ABKUERZUNGEN + &epr : f ("Einzelpreis") . + &gpr : zahltext (gesamtpreis, 2) . + + % NACHSPANN + ------------------------------------------------ + Summe: &&&&sum&& + + 14% MWSt. &&&Mwst&& + ========= + Endbetrag &&&&end&& + \#page\# + % ABKUERZUNGEN + &sum : zahltext (summe, 2) . + &Mwst : zahltext (mwst, 2) . + &end : zahltext (summe + mwst, 2) . + mwst : round (summe * 0.14, 2) . +#text# + +Im Initialisierungsteil dieses Druckmusters wird die Kundennummer +als Gruppe definiert. Dies hat zur Folge, daß für jeden neuen Kun­ +den eine neue Rechnung begonnen wird, nachdem vorher im Nach­ +spann die Rechnungssumme des vorherigen Kunden berechnet und +ausgedruckt wurde. Vor dieser Gruppendefinition sind 'gesamtpreis' +und 'summe' definiert, die später als globale Variablen zur Verfü­ +gung stehen sollen. Diese Zeile darf nicht nach der Gruppendefini­ +tion stehen. + Im Vorspann wird der Kopf der Rechnung angegeben. Dieser +enthält neben den Daten des Kunden (aus der gekoppelten Kun­ +dendatei) noch das Datum. Die Kundennummer wird nur zum Kop­ +peln und als Gruppenmerkmal benötigt, erscheint also nicht auf der +Rechnung. + Es fällt auf, daß im Firmennamen ein '&'-Zeichen auftaucht, +das doch für die Markierung von Feldmustern reserviert ist. Die +beiden Musterzeichen können jedoch im normalen Text auftauchen, +wenn ihnen direkt ein Leerzeichen folgt. In diesem Fall werden Sie +nicht als Beginn eines Feldmusters interpretiert, sondern unverän­ +dert gedruckt. Der gleiche Fall taucht noch mit '%' im Nachspann +auf. + Im Wiederholungsteil wird zunächst aus dem Einzelpreis und der +Menge des jeweiligen Artikels der Gesamtpreis für diesen Artikel +berechnet. Für die Abfrage der Feldinhalte wird die Funktion 'wert' +verwendet, die wie 'f' funktioniert, jedoch gleich einen REAL-Wert +liefert. + Zu beachten ist, daß 'wert' wie beim Sortieren von Zahl alle +Sonderzeichen ignoriert. Weiterhin müssen die Zahlen mit dem ein­ +gestellten Dezimalkomma geschrieben werden (also normalerweise +mit Komma), damit ihr Wert richtig erkannt wird. Anderenfalls soll­ +ten Sie den Dezimalpunkt einstellen (s. 11.1). + Damit kaufmännisch richtig gerechnet wird, wird der Gesamt­ +preis auf 2 Nachkommastellen gerundet und erst dann aufsummiert. +Würde der Gesamtpreis nur zum Einsetzen gerundet, könnten bei der +anschließenden Addition der nicht gerundeten Werte eine falsche +Gesamtsumme entstehen. + Erst nach diesen Berechnungen kann die Musterzeile folgen, in +die die Werte dann eingesetzt werden. Um eine Ausgabe mit zwei +Nachkommastellen zu erzeugen, wird die von EUDAS definierte +Funktion 'zahltext' benutzt. Diese erzeugt aus einem REAL-Wert +einen Text mit der angegebenen Anzahl von Kommastellen und setzt +das korrekte Dezimalkomma ein. Das Ergebnis dieser Funktion wird +dann rechtsbündig eingesetzt. + Im Nachspann wird dann der summierte Wert mit aufgeschlage­ +ner Mehrwertsteuer gedruckt. Die Mehrwertsteuer muß ebenfalls auf +zwei Nachkommastellen gerundet werden. + +#a ("Erweiterung")# Zur Erweiterung könnten Sie die Bestelldatei noch mit +einer Artikeldatei koppeln, die etwa folgende Struktur haben würde: + +#beispiel# + 'Artikelnummer' + 'Bezeichnung' + 'Einzelpreis' +#text# + +In diesem Fall könnten Sie noch jeweils die Artikelbezeichnung in +eine Rechnungszeile drucken. Außerdem würde der Preis zentral +gespeichert. Eine entsprechende Änderung des Druckmusters sollte +Ihnen keine Schwierigkeiten bereiten. + + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.14 b/app/eudas/4.4/doc/user-manual/eudas.hdb.14 new file mode 100644 index 0000000..895d7d9 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.14 @@ -0,0 +1,697 @@ +#type ("prop")##limit (14.0)# +#format# +#page (151)# +#kapitel ("14", "Ausdrücke", "in", "ELAN")# + + + +#abschnitt ("14.1", "WAS SIND AUSDRÜCKE ?", "Was sind Ausdrücke ?")# + +In diesem Kapitel wollen wir uns mit ELAN-Ausdrücken beschäfti­ +gen, wie sie für EUDAS gebraucht werden. Natürlich kann dies keine +ernsthafte Einführung für ELAN-Programmierer sein - mit solchen +Ambitionen halten Sie sich am besten an die entsprechende ELAN- +Literatur. + Dieser Text richtet sich eher an den Benutzer, der kaum Erfah­ +rung mit ELAN hat, aber die Möglichkeiten von EUDAS optimal nut­ +zen will. Viele fortgeschrittene Fähigkeiten von EUDAS laufen ja +über ELAN-Programme. + +#a ("Vorkommen")# Sie haben ELAN-Ausdrücke bereits an verschiedenen +Stellen eingesetzt, wenn Sie sich mit den vorhergehenden Kapiteln +befaßt haben. ELAN-Ausdrücke werden in nahezu allen Verarbei­ +tungsfunktionen benötigt. + Im Druckmuster dienen sie dazu, den Inhalt eines Feldmusters +festzulegen. Die Definition einer Abkürzung besteht immer aus dem +Namen der Abkürzung und einem Ausdruck. Ebenso wird in einer +Gruppendefinition ein Ausdruck angegeben. + Beim Kopiermuster und beim Änderungsmuster besteht jeweils +die rechte Seite einer Anweisung aus einem Ausdruck. Weiterhin +werden Ausdrücke auch in anderen ELAN-Konstruktionen benötigt, +wie zum Beispiel direkt am Anfang einer IF-Anweisung. + +#a ("Bedeutung")# Ein Ausdruck steht allgemein für einen Wert. Im ein­ +fachsten Fall kann dies eine Konstante sein, der Wert des Aus­ +drucks ändert sich also nicht. Anderenfalls spricht man von einem +zusammengesetzten Ausdruck. Dessen Wert ergibt sich dann durch +die Ausführung der im Ausdruck angegebenen Operationen. Dieser +Wert kann je nach dem aktuellen Zustand des Systems verschieden +sein, da er jedes Mal neu berechnet wird, wenn er gebraucht wird. + Ein Beispiel für einen zusammengesetzten Ausdruck ist #bsp ("2+2")# +Dieser Ausdruck steht für den Wert 4. + Der Wert eines Ausdrucks ist das, was uns eigentlich interes­ +siert. Beim Druckvorgang wird dieser Wert dann gedruckt, beim +Kopieren und Verändern in ein Feld eingetragen. + +#a ("Zusammensetzung")# Ausdrücke lassen sich aus verschiedenen Ele­ +menten zusammensetzen. Grundlage bilden die Konstanten. Konstan­ +ten können durch #on("i")#Operatoren#off("i")# miteinander verknüpft werden. So ist +in dem Ausdruck #bsp ("2+3")# das #bsp ("'+'")# ein Operator, der die Konstanten #bsp("2")# +und #bsp("3")# verknüpft. Das Ergebnis der Verknüpfung hängt natürlich vom +jeweiligen Operator ab. + Wie Sie schon in der Schule gelernt haben ("Punktrechnung vor +Strichrechnung"), muß man die Reihenfolge der Operatoren festlegen, +wenn mehrere Operatoren im Spiel sind. Ähnliche Regeln gibt es für +alle Operatoren in ELAN. + Wenn eine andere Reihenfolge der Operatoren erwünscht ist, +können Sie diese durch Einsatz von Klammern verändern. Auch dies +dürfte Ihnen aus der Schule noch in Erinnerung sein. Der Unter­ +schied in ELAN ist lediglich, daß es dort einige zusätzliche Opera­ +toren gibt, die Ihnen nicht aus der Mathematik vertraut sind. + Ein weiteres Konstruktionselement von Ausdrücken sind #on("i")#Funk­ +tionen#off("i")#. Auch diese kennen Sie aus der Schule. Lediglich die +Schreibweise muß für den "dummen" Computer etwas ausführlicher +gehalten werden (Beispiel: #bsp ("sin (3.14 * x)")#). + Die Argumente der Funktion hinter dem Funktionsnamen müssen +auf jeden Fall in Klammern stehen. In der Terminologie der Pro­ +grammiersprachen spricht man von #on("i")#Parametern#off("i")#. Parameter können +wieder komplexe Ausdrücke sein. Bei Funktionen mit mehreren +Parametern werden diese durch Komma getrennt: +#f2# +#beispiel# + min (2.5 * x, x + 1.25) +#text# + + +#abschnitt ("14.2", "DATENTYPEN", "Datentypen")# + +Bevor wir beginnen, konkrete Ausdrücke zu behandeln, müssen wir +erst das Konzept der #on("i")#Datentypen#off("i")# einführen. Grundidee dabei ist, +daß es verschiedene Klassen von Werten gibt, die nicht einfach +untereinander gemischt werden können. + So gibt es in ELAN einen grundlegenden Unterschied zwischen +#on("i")#Zahlen#off("i")# und #on("i")#Texten#off("i")#. Texte bestehen aus einer beliebigen Aneinan­ +derreihung von Zeichen, die im Normalfall nur für den betrachten­ +den Menschen eine Bedeutung haben. Mit Zahlen kann man dagegen +Berechnungen anstellen. + Der tiefere Grund für die Trennung in verschiedene Typen ist +also, daß für jeden Typ gewisse Operationen definiert snd, die nur +für diesen Typ sinnvoll sind. So ist zum Beispiel die Addition der +beiden Texte #bsp("""abc""")# und #bsp("""-/-""")# völlig sinnlos. + Aber nicht nur die Operationen sind verschieden, sondern auch +die interne Darstellung im Rechner. So werden der Text #bsp ("""1234""")# und +die Zahl #bsp ("1234")# völlig anders gespeichert, obwohl man ihnen die glei­ +che Bedeutung beimessen könnte. + +#a ("Grundtypen")# In ELAN gibt es vier verschiedene Grundtypen, die für +uns wichtig sind. Sie können sich in ELAN auch eigene Typen +schaffen, dies geht jedoch weit über unsere Bedürfnisse hinaus. + Der in EUDAS am meisten verwendete Typ heißt #on("i")#TEXT#off("i")#. TEXT- +Objekte bestehen aus einer Folge von 0 bis 32000 Zeichen. Die Zei­ +chen entstammen einem Satz von 256 verschiedenen Symbolen, die +jeweils eine andere Darstellung haben. Einige der Zeichen lassen +sich überhaupt nicht darstellen, sondern führen bestimmte Funktio­ +nen aus (zum Beispiel Bildschirm löschen). + Sämtliche Feldinhalte einer EUDAS-Datei sind TEXTe, ebenso +die Zeilen von Textdateien. Auch Datei- und Feldnamen sind +TEXTe. Von daher besteht eigentlich kein Grund, warum Sie sich +außer zur Programmierung noch mit anderen Datentypen beschäfti­ +gen sollten. + Neben den Texten gibt es noch die Zahlen. Diese sind in ihrer +internen Darstellung so beschaffen, daß ein effizientes Rechnen mit +ihnen möglich ist. Andererseits können sie nicht mehr beliebige +Informationen darstellen, sondern haben eine sehr eingeschränkte +Bedeutung. + Um unterschiedichen Bedürfnissen gerecht zu werden, gibt es in +ELAN zwei verschiedene Zahltypen. Der Typ #on("i")#INT#off("i")# umfaßt nur ganze +Zahlen ohne Kommastellen. Damit die Zahl möglichst wenig Spei­ +cherplatz belegt, ist der Wertebereich bei den meisten Rechnern auf +-32768..32767 beschränkt (die krummen Zahlen ergeben sich wegen +der Binärarithmetik des Rechners). Dieser Typ eignet sich am besten +zum Abzählen und zum Auswählen aus einer festen Anzahl von +Objekten (zum Beispiel Feld 1 bis Feld 255). + Zum eigentlichen Rechnen gibt es den Typ #on("i")#REAL#off("i")#. Dieser umfaßt +auch Kommazahlen. Genauigkeit, Wertebereich und Darstellung sind +nahezu identisch mit den Möglichkeiten eines Taschenrechners. der +Typ REAL wird immer dann verwendet, wenn mit realen Größen +(Geldbeträge, physikalische Werte) gerechnet werden muß. + Zuletzt gibt es noch den Typ #on("i")#BOOL#off("i")#. Er hat nur zwei mögliche +Werte, nämlich TRUE (wahr) und FALSE (falsch). Er wird dazu benö­ +tigt, Ausdrücke zu schreiben, die den Zweig einer IF-Anweisung +bestimmen. + +#a ("Denotation")# ELAN verfügt über einen strengen Typenschutz; das +heißt, Objekte verschiedenen Typs dürfen nicht gemischt werden. +Daher muß schon bei der Schreibweise der Konstanten festgelegt +sein, welchen Typ die Konstante hat. + Bei Texten geschieht dies durch den Einschluß in Anführungs­ +striche. Die Anführungsstriche sorgen gleichzeitig auch für eine +Abgrenzung der Zeichen des Textes und des umgebenden Programms. +Sie kennen diese Schreibweise bereits von vielen Stellen in EUDAS. + Ebenfalls keine Probleme bereitet der Typ BOOL, da die +Schreibweise der beiden möglichen Werte TRUE und FALSE eindeutig +ist. + Problematisch wird es bei den Zahlen. Da die ganzen Zahlen in +den rationalen Zahlen enthalten sind, muß für die ganzen Zahlen +durch die Schreibweise festgelegt werden, zu welchem der beiden +Typen sie gehören. Man hat festgelegt, daß REAL-Zahlen immer mit +Komma geschrieben werden müssen, während Zahlen ohne Komma den +Typ INT haben (das Komma wird in ELAN bei den REAL-Zahlen in +internationaler Schreibweise als Punkt notiert). + So ist #bsp("4")# eine INT-Zahl, während #bsp("4.0")# den Typ REAL besitzt. +Denken Sie in Zukunft immer daran, welcher Zahltyp jeweils ver­ +langt wird und richten Sie die Schreibweise danach. + +#a ("Unterschied zu Feldtypen")# Verwechseln Sie die hier vorgestellten +Datentypen nicht mit den Feldtypen einer EUDAS-Datei. Die Feld­ +typen beziehen sich immer auf den gleichen Datentyp, nämlich +TEXT. Die Feldtypen bestimmen lediglich die spezielle Behandlung +des Feldes beim Suchen und Sortieren, während Datentypen tat­ +sächlich Unterschiede in der Speicherung und den anwendbaren +Operationen bedeuten. + Daher können Sie Feldtypen auch nach Bedarf ändern, während +der Datentyp eines Objekts ein für alle Mal feststeht. Merken Sie +sich, daß Feldinhalte in EUDAS immer den Typ TEXT haben. + +#a ("Umwandlungen")# Obwohl verschiedene Datentypen nicht miteinander +gemischt werden dürfen, können sie mit speziellen Funktionen in­ +einander umgewandelt werden. So ist zum Beispiel die Addition von +#bsp("1")# und #bsp("1.5")# verboten, aber der folgende Ausdruck +#f2# +#beispiel# + real (1) + 1.5 +#text# +#f2# +liefert den Wert #bsp("2.5")# mit dem Typ REAL. Umgekehrt geht die Um­ +wandlung mit der Funktion 'int', dabei werden jedoch die Nachkom­ +mastellen abgeschnitten. Weitere Hinweise dazu erhalten Sie im +Abschnitt 14.4. + Wichtiger jedoch ist die Umwandlung von Zahlen in TEXT-Ob­ +jekte. Was Sie auf Ihrem Bildschirm oder Ausdruck sehen, sind ja +immer nur Zeichenfolgen und damit Texte. Zahlen (INT oder REAL) +in ihrer internen Darstellung können Sie prinzipiell nicht sehen. Sie +müssen zur Darstellung immer in Texte umgewandelt werden. + Auch beim Rechnen mit Werten aus EUDAS-Dateien müssen +mehrere Umwandlungen stattfinden. Der Feldinhalt, der ja ein TEXT +ist, muß zunächst in eine Zahl umgewandelt werden. Dann wird mit +dieser Zahl gerechnet. Wenn das Ergebnis wieder in ein Feld einge­ +tragen oder gedruckt werden soll, muß eine Rückumwandlung in +einen Text vorgenommen werden. + Die zum Umwandeln benötigten Funktionen werden ebenfalls im +Abschnitt 14.4 besprochen. + +#a ("Funktionsbeschreibung")# In den zwei folgenden Abschnitten sollen +die wichtigsten Funktionen und Operatoren anhand von Beispielen +beschrieben werden. Da jede Funktion nur auf bestimmte Datentypen +angewendet werden kann, gibt es eine Notation, die genau die Form +eines Funktionsaufrufs festlegt. +#f2# +#beispiel# + INT PROC min (INT CONST a, b) +#text# +#f2# +Die obige Schreibweise hat folgende Bedeutung: Spezifiziert wird die +Funktion 'min', die als Ergebnis einen INT-Wert liefert (das INT +ganz links). Die Bezeichnung PROC gibt an, daß es sich um eine +Funktion handelt. In Klammern ist dann angegeben, welche Parame­ +ter verwendet werden müssen. Die Funktion hat zwei Parameter, +beide vom Typ INT. Die Bezeichnung CONST gibt an, daß auch Kon­ +stanten verwendet werden dürfen (Normalfall). + Zu beachten ist, daß bei jedem Aufruf beide Parameter vorhan­ +den und vom Typ INT sein müssen. Anderenfalls gibt es eine Feh­ +lermeldung. + Die gleiche Schreibweise wird auch zur Spezifikation von Ope­ +ratoren verwendet: +#f2# +#beispiel# + INT OP + (INT CONST a, b) +#text# +#f2# +Jedoch dürfen Operatoren nicht mit Parametern in Klammern ge­ +schrieben werden, sondern der Operator wird zwischen die Parameter +geschrieben. + Eine Besonderheit von ELAN ist es, daß es verschiedene Opera­ +toren und Funktionen mit gleichem Namen geben kann. Die Funktio­ +nen werden nur unterschieden nach dem Typ ihrer Parameter. So +gibt es nicht nur den oben genannten Operator #bsp("'+'")#, sondern auch +den folgenden: +#f2# +#beispiel# + REAL OP + (REAL CONST a, b) +#text# +#f2# +Obwohl im Aussehen gleich, handelt es sich doch um verschiedene +Operatoren mit möglicherweise völlig verschiedener Wirkung. Dies +sieht man an diesem Beispiel: +#f2# +#beispiel# + TEXT OP + (TEXT CONST a, b) +#text# +#f2# +Dieser Operator führt nun keine Addition aus, sondern eine #on("i")#Verket­ +tung#off("i")# zweier Texte. Je nach Typ der Parameter wird der entspre­ +chende Operator ausgesucht. + + +#abschnitt ("14.3", "TEXT-FUNKTIONEN", "TEXT-Funktionen")# + +In diesem Abschnitt wollen wir die wichtigsten Funktionen und +Operatoren zur Behandlung von Texten beschreiben. Wie Sie noch +sehen werden, spielt dabei aber auch der Typ INT eine gewisse +Rolle. + +#a ("EUDAS-Abfragen")# Die wichtigste Funktion zur Abfrage von Inhal­ +ten der aktuellen Datei sollten Sie bereits kennen: +#f2# +#beispiel# + TEXT PROC f (TEXT CONST feldname) +#text# +#f2# +Neu ist eigentlich nur die Schreibweise der Spezifikation. Sie sollten +aber in der Lage sein, daraus einen konkreten Ausdruck zu kon­ +struieren. Bisher haben wir immer die Schreibweise +#f2# +#beispiel# + f ("Feldname") +#text# +#f2# +verwendet. Dies ist jedoch nur ein Beispiel. Die korrekte Angabe +finden Sie oben. + Die Funktion 'f' darf natürlich nicht angewendet werden, wenn +keine Datei geöffnet ist. In die Verlegenheit kommen Sie aber nur +beim Ausprobieren, denn alle gefährlichen EUDAS-Funktionen sind +sonst gesperrt. + Falls das angegebene Feld nicht existiert, wird mit einer Feh­ +lermeldung abgebrochen. Beachten Sie, daß dies immer erst bei der +Ausführung festgestellt werden kann. Bei der Eingabe, zum Beispiel +eines Druckmusters, kann dies noch nicht überprüft werden. + Eine weitere Abfrage, die EUDAS während des Druckens ermög­ +licht, ist die Funktion +#f2# +#beispiel# + TEXT PROC lfd nr +#text# +#f2# +Diese hat keine Parameter und liefert die laufende Nummer des +gedruckten Satzes #on("i")#als Text#off("i")#. + Diese beiden Funktionen können als Ausgangsbasis dienen zur +Manipulation mit weiteren Funktionen. + +#a ("Verkettung")# Zur Verkettung von Teiltexten gibt es den oben schon +beschriebenen Operator '+'. Wenn Sie mehr als zwei Texte verketten +wollen, können Sie den Operator beliebig hintereinander verwenden: +#f2# +#beispiel# + f ("PLZ") + " " + f ("Ort") +#text# +#f2# +Wie in diesem Beispiel können Sie sowohl Konstanten als auch Tex­ +te, die von anderen Funktionen geliefert werden, verketten. Beach­ +ten Sie, daß die Texte immer ohne Zwischenraum aneinandergehängt +werden; daher wird im obigen Beispiel ein Leerzeichen extra ange­ +geben. + Wenn Sie eine bestimmte Anzahl von gleichen Zeichen haben +möchten (zum Beispiel für horizontale Linien oder große Zwischen­ +räume), können Sie dafür folgenden Operator verwenden: +#f2# +#beispiel# + TEXT OP * (INT CONST anzahl, TEXT CONST einzeltext) +#text# +#f2# +Hier sehen Sie als Beispiel einen Operator, der mit verschiedenen +Datentypen arbeitet. Sie müssen die Parameter jedoch immer in der +angegebenen Reihenfolge benutzen. Das folgende Beispiel ist kor­ +rekt: +#f2# +#beispiel# + 20 * "-" +#text# +#f2# +während dies nicht erlaubt ist: +#f2# +#beispiel# + "-" * 20 +#text# +#f2# +Wieder können Sie diesen Operator mit anderen Funktionen verknü­ +pfen: +#f2# +#beispiel# + "!" + 10 * " " + "!" + 5 * "-" + "!" +#text# +#f2# +Da der Multiplikationsoperator Vorrang vor der Addition hat, kom­ +men Sie hier sogar ohne Klammern aus (überlegen Sie sich, wo ein +Fehler auftreten würde, wenn dies nicht so wäre). Als Ergebnis +dieses komplexen Ausdrucks ergäbe sich der folgende Text: +#f2# +#beispiel# + "! !-----!" +#text# + +#a ("Teiltexte")# Um auch Teile von Texten bearbeiten zu können, werden +die Zeichen eines Textes von 1 an (mit INT-Zahlen) durchnumeriert. +Anhand dieser Positionen können Sie Teiltexte extrahieren. + Damit Sie die Position des letztes Zeichens (und damit die An­ +zahl der Zeichen) erfragen können, gibt es die Funktion +#f2# +#beispiel# + INT PROC length (TEXT CONST text) +#text# +#f2# +Wieviel Zeichen in einem Feld stehen, können Sie also mit +#f2# +#beispiel# + length (f ("Feldname")) +#text# +#f2# +erfahren. + Einen Teiltext bekommen Sie mit der Funktion 'subtext'. Diese +gibt es in zwei Ausführungen. +#f2# +#beispiel# + TEXT PROC subtext (TEXT CONST text, INT CONST anfang) +#text# +#f2# +liefert den Teiltext von einer bestimmten Position an (einschließ­ +lich) bis zum Textende. Mit +#f2# +#beispiel# + TEXT PROC subtext (TEXT CONST t, INT CONST anf, ende) +#text# +#f2# +können Sie auch die Position des letzten Zeichens (einschließlich) +angeben. Daher würden die beiden folgenden Aufrufe +#f2# +#beispiel# + subtext (f ("Feldname"), 1) + subtext (f ("Feldname"), 1, length (f ("Feldname"))) +#text# +#f2# +den Feldinhalt unverändert liefern. Ein weiteres Beispiel: +#f2# +#beispiel# + subtext ("Ein Text als Beispiel", 5, 8) +#text# +#f2# +liefert als Ergebnis #bsp("""Text""")#. + Es gibt noch den Operator 'SUB', der jeweils nur ein Zeichen +aus dem Text liefert: +#f2# +#beispiel# + TEXT OP SUB (TEXT CONST text, INT CONST stelle) +#text# +#f2# +Der Aufruf ist gleichwertig zu einem Aufruf von 'subtext', in dem +beide Stellen gleich sind. + Bei beiden Funktionen wird nicht vorhandener Text einfach +ignoriert. So liefert +#f2# +#beispiel# + subtext ("Hallo", 4, 8) +#text# +#f2# +das Ergebnis #bsp ("""lo""")# und +#f2# +#beispiel# + "Hallo" SUB 10 +#text# +#f2# +den leeren Text #bsp("""""")#. + +#a ("Verschachtelte Ausdrücke")# Wie Sie bereits gesehen haben, kann +man Ausdrücke ineinander verschachteln. Dies ist in unserem Fall +sehr nützlich, wenn Teiltexte bestimmt werden sollen, deren Posi­ +tion nicht konstant ist. Ein Beispiel, in dem 'length' bei der Fest­ +legung der Endposition verwendet wird, haben Sie weiter oben +bereits gesehen. + Als weitere Möglichkeit können Sie mit Positionen, die ja INT- +Zahlen sind, ganz normal rechnen. Folgender Ausdruck liefert zum +Beispiel die letzten drei Zeichen eines Feldes: +#f2# +#beispiel# + subtext (f ("Feldname"), length (f ("Feldname")) - 2) +#text# +#f2# +Wichtig ist, daß ein Ausdruck, der wieder als Parameter für einen +anderen Ausdruck verwendet werden soll, den richtigen Typ hat, +der von dem anderen Ausdruck verlangt wird. + In dem obigen Beispiel muß als Position ein INT verwendet +werden. Diese Position wird vom Operator '-' berechnet. Es gibt +aber nur einen Subtraktionsoperator, der einen INT liefert, nämlich +den, der wiederum zwei INTs subtrahiert. Glücklicherweise sind +sowohl 'length' als auch die 2 vom Typ INT, anderenfalls wäre der +Ausdruck fehlerhaft. 'length' wiederum benötigt einen TEXT als +Parameter, der von der Funktion 'f' stammt, die als Parameter eben­ +falls einen TEXT verlangt. + Wie Sie sehen, kann es durchaus verwickelt zugehen, wenn ein +Ausdruck aus den verschiedensten Teilausdrücken unterschiedlichen +Typs zusammengesetzt ist. Die gleiche Überprüfung wie eben ge­ +schildert sollten Sie bei jedem Ausdruck vornehmen, damit keine +Fehlermeldung erscheint. + +#a ("Variable Positionen")# Zur Berechnung von Positionen gibt es noch +eine weitere nützliche Prozedur, nämlich +#f2# +#beispiel# + INT PROC pos (TEXT CONST text, teiltext) +#text# +#f2# +Sie liefert die Position, an der der angegebene Teiltext zum ersten +Mal in dem Text vorkommt, oder 0, wenn der Teiltext nicht darin +vorkommt. So ist +#f2# +#beispiel# + pos ("Hallo", "l") = 3 +#text# +#f2# +und +#f2# +#beispiel# + pos ("Hallo", "lo") = 4 +#text# +#f2# +und +#f2# +#beispiel# + pos ("Hallo", "xx") = 0 +#text# +#f2# +Diese Funktion kann zum Beispiel dazu verwendet werden, ein Feld +in mehrere Teile aufzuspalten. Sind zum Beispiel Name und Vorname +in einem Feld durch Leerzeichen getrennt hintereinandergeschrie­ +ben, liefert +#f2# +#beispiel# + subtext (f ("Name"), 1, pos (f ("Name"), " ") - 1) +#text# +#f2# +den Vornamen und entsprechend +#f2# +#beispiel# + subtext (f ("Name"), pos (f ("Name"), " ") + 1) +#text# +#f2# +den Nachnamen. Soll die Position erst ab einer gewissen Stelle ge­ +sucht werden, gibt es noch die folgende Variation der Funktion: +#f2# +#beispiel# + INT PROC pos (TEXT CONST text, teiltext, INT CONST ab) +#text# +#f2# +Bei dieser Funktion wird erst ab der angegebenen Stelle einschließ­ +lich gesucht. + + +#abschnitt ("14.4", "RECHENFUNKTIONEN", "Rechenfunktionen")# + +#a ("Umwandlungen")# Bevor mit dem Inhalt eines Feldes gerechnet wer­ +den kann (auch wenn das Feld den Feldtyp ZAHL hat), muß der Wert +des Feldinhaltes als REAL-Zahl berechnet werden. Dazu gibt es die +Funktion +#f2# +#beispiel# + REAL PROC wert (TEXT CONST feldname) +#text# +#f2# +Die Funktion 'wert' ignoriert alle Sonderzeichen in dem Feld außer +dem Minuszeichen (als Vorzeichen) und dem eingestellten Dezimal­ +komma. Wenn das Feld 'Summe' beispielsweise #bsp("""-***20,09 DM""")# ent­ +hält, ergibt sich +#f2# +#beispiel# + wert ("Summe") = 20.09 +#text# +#f2# +Zum kaufmännischen Rechnen ist es manchmal erforderlich, den Wert +auf eine bestimmte Anzahl von Nachkommastellen zu runden. Diese +Anzahl kann man bei einer Variante von 'wert' als Parameter ange­ +ben: +#f2# +#beispiel# + REAL PROC wert (TEXT CONST feldname, + INT CONST kommastellen) +#text# +#f2# +Mit den so erhaltenen Werten können Sie dann die weiter unten +beschriebenen Berechnungen durchführen. Bevor Sie das Ergebnis +jedoch drucken oder in ein Feld eintragen können, müssen Sie den +REAL-Wert wieder in einen TEXT verwandeln. Dazu dient die Funk­ +tion +#f2# +#beispiel# + TEXT PROC zahltext (REAL CONST wert, + INT CONST kommastellen) +#text# +#f2# +Der übergebene Wert wird mit der gewünschten Anzahl von Komma­ +stellen als Text formatiert. Dazu wird der Wert gerundet. Außerdem +wird statt eines Punktes das eingestellte Dezimalkomma eingesetzt. +Die Länge des Textes richtet sich nach der Anzahl von benötigten +Stellen, es werden also keine führenden Nullen oder Leerzeichen +eingesetzt (dafür kann man den Text beim Drucken ja rechtsbündig +einsetzen). + Wird 0 als Kommastellen angegeben, wird auch kein Dezimal­ +komma erzeugt (Darstellung wie ein INT). Als Abkürzung können Sie +auch +#f2# +#beispiel# + TEXT PROC zahltext (TEXT CONST feldname, + INT CONST kommastellen) +#text# +#f2# +als Ersatz für +#f2# +#beispiel# + zahltext (wert ("Feldname"), kommastellen) +#text# +#f2# +verwenden. So kann ein Feld einheitlich zum Drucken formatiert +werden. + +#a ("Arithmetik")# Sowohl mit INT- als auch mit REAL-Zahlen (jedoch +nicht gemischt) können Sie die üblichen Rechenoperatoren #bsp("'+'")#, #bsp("'-'")# +und #bsp("'*'")# verwenden. Auch Minimum ('min') und Maximum ('max') sind +für zwei Parameter dieser Typen definiert. + Lediglich die Division wird bei beiden Typen unterschiedlich +gehandhabt. Für REAL-Zahlen gibt es den Operator #bsp("'/'")# für die +übliche Division. Da die ganzzahlige Division eine andere Bedeutung +hat, wird dafür der Operator 'DIV' verwendet. Den Rest der ganz­ +zahligen Division liefert 'MOD'. + 'abs' liefert den Wert eines REAL oder INT ohne das Vorzeichen. +Die Umwandlungsfunktionen 'int' und 'real' hatten wir ja bereits +weiter oben erwähnt. + Für REAL-Zahlen gibt es noch weitere mathematische Funktio­ +nen (Exponentialfunktion, Trigonometrie), die Sie am besten im +EUMEL-Benutzerhandbuch nachschlagen, wenn Bedarf dafür besteht. + + +#abschnitt ("14.5", "ABFRAGEN", "Abfragen")# + +#a ("IF-Abfragen")# Wie Sie schon im vorigen Kapitel gesehen haben, +kann man in Druckmustern auch IF-Abfragen als Ausdrücke ver­ +wenden. Die IF-Abfragen können zwar auch ineinander verschach­ +telt werden, sie dürfen jedoch nicht mehr innerhalb eines normalen +Ausdrucks angewendet werden. + Eine IF-Abfrage enthält 3 Teilausdrücke in folgender Form: + +#beispiel# + IF 'BOOL-Ausdruck' THEN + 'Ausdruck1' + ELSE + 'Ausdruck2' + END IF +#text# + +Der erste Ausdruck muß einen Wert vom Typ BOOL liefern, der ent­ +scheidet, welcher der beiden Teilausdrücke ausgewertet wird. Wir +werden gleich noch sehen, was für Möglichkeiten es da gibt. + Die beiden Teilausdrücke dürfen auch wieder IF-Abfragen sein, +sind sie es jedoch nicht, dürfen in ihnen dann keine IF-Abfragen +mehr vorkommen. Die IF-Abfragen liegen also immer auf der äußer­ +sten Ebene. + Die beiden Teilausdrücke dürfen einen beliebigen Typ haben, er +muß jedoch für beide gleich sein. + Als Ergebnis der IF-Abfrage wird 'Ausdruck1' geliefert, wenn +der BOOL-Ausdruck wahr ist, sonst 'Ausdruck2'. + +#a ("Vergleiche")# Die wesentlichen Operationen, die boolesche Ausdrücke +zur Verwendung in IF-Abfragen bilden, sind die Vergleichsoperato­ +ren: + +#beispiel# + = <> <= >= < > +#text# + +Sie vergleichen jeweils zwei Elemente vom Typ TEXT, INT oder REAL +und liefern TRUE (wahr) oder FALSE (falsch). Selbstverständlich +können auch sie zwei zusammengesetzte Teilausdrücke vergleichen. + Eine Anwendung ist zum Beispiel der Test, ob ein Text in einem +anderen enthalten ist: + +#beispiel# + IF pos (f ("Betrag"), "DM") > 0 THEN + "deutsches Geld" + ELSE + "ausländisches Geld" + END IF +#text# + +Die Funktion 'pos' wird hier dazu benutzt, festzustellen, ob es sich +um deutsches oder ausländisches Geld handelt. + Oft müssen jedoch mehrere Vergleiche miteinander kombiniert +werden. Zu diesem Zweck gibt es die beiden Operatoren AND (und) +und OR (oder). Damit AND das Ergebnis TRUE liefert, müssen beide +Vergleiche wahr sein, bei OR muß mindestens einer der beiden wahl +sein. + Die Reihenfolge aller dieser Operatoren ist so gewählt, daß +normalerweise keine Klammern benötigt werden. Funktionen haben +immer Vorrang vor Operatoren, bei den Operatoren kommt die Multi­ +plikation vor der Addition, dann kommen die Vergleiche, danach das +AND und danach das OR. Alle anderen Operatoren (#on("i")#insbesondere +SUB#off("i")#) teilen sich den letzten Rang. + Wenn Sie also in einem Ausdruck mehrere Vergleiche mit AND +und OR verknüpfen, und das OR soll stärker binden als das AND, +müssen Sie dies durch Klammern ausdrücken. + Den oben besprochenen Operator SUB sollten Sie immer in +Klammern setzen, wenn Sie ihn in einem Vergleich benutzen. Da er +die niedrigste Priorität hat, gäbe es sonst mit Sicherheit Fehler: + +#beispiel# + IF (f ("Name") SUB 1) = "M" THEN + "vielleicht Müller" + ELSE + "bestimmt nicht" + END IF +#text# + +#a ("Refinements")# Bisher hatten wir gesagt, daß IF-Abfragen nicht +innerhalb von anderen Ausdrücken verwendet werden dürfen. Diese +Einschränkung kann man umgehen, indem man #on("i")#Refinements#off("i")# verwen­ +det. + Ein Refinement hat im Druckmuster eine ähnliche Wirkung wie +eine Abkürzung, lediglich der Name darf nur mit Kleinbuchstaben +und Ziffern geschrieben sein und kann nicht als Feldmuster ver­ +wendet werden. + +#beispiel# + &abk : + subtext (f ("Name"), namensanfang) . + namensanfang : + IF pos (f ("Name"), " ") > 0 THEN + pos (f ("Name"), " ") + 1 + ELSE + length (f ("Name")) + END IF . +#text# + +Innerhalb von Refinements dürfen auch wieder andere Refinements +verwendet werden. + Auch in Kopier- und Änderungsmustern können Sie Refinements +verwenden. Hier müssen Sie jedoch darauf achten, daß alle Refine­ +ments am Ende gesammelt werden und vor dem ersten Refinement +ein Punkt stehen muß. Ebenso müssen die Refinements wie im +Druckmuster durch Punkte voneinander getrennt sein: + +#beispiel# + "Anrede" K anrede; + . + anrede : + IF f ("m/w") = "w" THEN + "Frau" + ELSE + "Herr" + END IF . +#text# + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.15 b/app/eudas/4.4/doc/user-manual/eudas.hdb.15 new file mode 100644 index 0000000..c15fb9a --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.15 @@ -0,0 +1,269 @@ +#type ("prop")##limit (14.0)# +#format# +#page (165)# +#kapitel ("15", "Anweisungen", "in", "ELAN")# + + + +#abschnitt ("15.1", "VARIABLEN UND ZUWEISUNGEN", "Variablen und Zuweisungen")# + +Im vorigen Kapitel haben wir Ausdrücke in ELAN kennengelernt. Der +Wert eines Ausdrucks wird bei jeder Verwendung erneut berechnet. +Wenn wir den Wert eines Ausdrucks aufbewahren wollen, müssen wir +ihn schon in eine EUDAS-Datei schreiben. + Oft tritt jedoch die Notwendigkeit auf, Werte zu merken, ohne +sie in einer Datei zu speichern. Beispiel dafür ist ein Zählvorgang im +Druckmuster. In jedem Wiederholungsteil muß der dazukommende +Wert zum bisherigen, aufsummierten und aufbewahrten Wert addiert +werden. Das Zwischenergebnis der Zählung muß also irgendwo ge­ +speichert werden. + +#a ("Variablen")# Zu diesem Zweck gibt es Variablen. Sie sind ähnlich wie +Felder in einer Datei. Ihre Existenz ist jedoch unabhängig von einer +Datei. Außerdem sind sie zu Anfang nicht einfach leer, sondern +haben einen undefinierten Wert. + Variablen müssen im Programm definiert werden. Sie existieren +dann während der Ausführung dieses Programms und gehen an­ +schließend verloren. Zu Beginn des Programms sind sie, wie schon +gesagt, undefiniert. + Eine Variable muß immer einen Typ haben. Dieser Typ ist für +die Lebensdauer der Variable unveränderlich. Die Variable kann +natürlich nur Werte dieses Typs annehmen. + Eine Variablendefinition (oder auch -deklaration) besteht aus +der Angabe eines Typs, dem Schlüsselwort #bsp ("VAR")# und einem freige­ +wählten Namen. Wie schon bei den Refinements darf ein solcher +Name nur aus Kleinbuchstaben (keine Umlaute) und eventuell Zif­ +fern bestehen. Dagegen darf der Name Leerzeichen enthalten. +Beispiel: + +#beispiel# + INT VAR zaehler; + TEXT VAR feldname; + REAL VAR mein ergebnis 1; +#text# + +Das Semikolon am Ende beschließt die Definition. + Die Lebensdauer einer Variablen hängt davon ab, an welcher +Stelle sie definiert ist. Eine Variable, die im Druckmuster im Initia­ +lisierungsteil definiert ist, behält ihren Wert für die gesamte Dauer +des Druckvorgangs. Eine Variable in einem Abschnitt lebt dagegen +nur für eine Abarbeitung dieses Abschnitts. Bei der nächsten Abar­ +beitung ist sie wieder undefiniert. + Das gleiche gilt für Kopier- und Änderungsmuster. Auch hier +sind Variablen nur für die Dauer der Bearbeitung eines Satzes +gültig. + +#a ("Zuweisung")# Um einer Variablen einen Wert zu geben, führt man eine +#on ("i")#Zuweisung#off("i")# aus. Die Zuweisung wird durch Doppelpunkt und Gleich­ +heitszeichen aneinandergeschrieben gekennzeichnet. Auf der linken +Seite steht die Variable, auf der rechten Seite eine Ausdruck: + +#beispiel# + zaehler := 1; +#text# + +Wie oben schließt das Semikolon die Anweisung ab. Nach der Aus­ +führung hat die Variable den Wert 1. Der Wert vorher ist für die +Zuweisung egal, er kann definiert oder undefiniert sein. + Eine Variable kann in einem Ausdruck verwendet werden, indem +man einfach den Namen hinschreibt. Der Ausdruck + +#beispiel# + zaehler + 1 +#text# + +hat nach der obigen Zuweisung den Wert 2. Eine Variable muß bei +der Verwendung definiert sein, sonst können beliebige Fehler ent­ +stehen. Es muß also vor der ersten Verwendung ausdrücklich eine +Zuweisung erfolgt sein. + Da Variablen in Ausdrücken verwendet werden können und +Ausdrücke auf der rechten Seite einer Zuweisung stehen, ist folgen­ +de Konstruktion möglich: + +#beispiel# + zaehler := zaehler + 1; +#text# + +Diese Zeile bewirkt, daß der Wert der Variable um 1 erhöht wird. +Zuerst wird bei der Zuweisung der Wert des Ausdrucks auf der rech­ +ten Seite bestimmt. Zu diesem Zeitpunkt habe die Variable bei­ +spielsweise den Wert 1. Der Ausdruck hat dann den Wert 2 (1+1). +Dieser Wert wird der neue Wert der Variablen. + Bei der nächsten Ausführung würde sich der gleiche Vorgang +wiederholen, so daß die Variable anschließend den Wert 3 hat. + Auch bei der Zuweisung gilt natürlich, daß die Variable auf der +linken Seite den gleichen Datentyp haben muß wie der Ausdruck auf +der rechten Seite. + +#a ("Initialisierung")# Sie können Variablendeklaration und Zuweisung +auch miteinander verknüpfen, so daß die Variable gleich zu Anfang +einen Wert erhält: + +#beispiel# + INT VAR zaehler := 0; +#text# + +Dieses Verfahren ist eine gute Vorsichtsmaßregel, damit Sie keine +undefinierten Variablen verwenden. + +#a ("Inkrement")# Da der Fall so häufig auftritt, daß der Wert einer Vari­ +ablen um einen bestimmten Wert erhöht wird (bei allen Zählvorgän­ +gen), gibt es auch dafür eine Abkürzung, und zwar die beiden Ope­ +ratoren INCR und DECR. + +#beispiel# + zaehler INCR 1; + mein ergebnis 1 DECR 24.4; +#text# + +Die Operatoren sind für REALs und INTs definiert. INCR erhöht um +einen Betrag, DECR erniedrigt. Auf der rechten Seite darf wieder ein +beliebiger Ausdruck stehen. + Für TEXTe gibt es eine ähnliche Abkürzung, allerdings nur für +die Addition (Verkettung). Hier heißt der Operator CAT. Die beiden +folgenden Zeilen haben die gleiche Bedeutung: + +#beispiel# + feldname := feldname + "."; + feldname CAT "."; +#text# + + +#abschnitt ("15.2", "WEITERE KONSTRUKTIONEN", "Weitere Konstruktionen")# + +#a ("IF")# Die Ihnen bereits bekannte IF-Konstruktion dient nicht nur +dazu, Werte zu liefern, sondern steuert auch die Abarbeitung von +beliebigen Anweisungen. Diese Anweisungen können Kopier- und +Änderungsanweisungen sein (s. Kapitel 11), oder die oben beschrie­ +benen Zuweisungen. + In einem Teil der IF-Konstruktion können auch mehrere Anwei­ +sungen stehen. Diese müssen dann jedoch unbedingt durch Semiko­ +lon getrennt sein. Mehrere Anweisungen hintereinander haben ein­ +fach die Bedeutung der Ausführung in der notierten Reihenfolge. + Als drittes kann auch der ELSE-Teil weggelassen, da nicht in +jedem Fall ein Ergebnis erwartet wird. Falls die Bedingung nicht +zutrifft, muß nicht unbedingt etwas ausgeführt werden. + +#beispiel# + IF zaehler > 0 THEN + zaehler DECR 1; + mein ergebnis 1 INCR wert ("zaehlfeld") + END IF; +#text# + +Auch diese IF-Konstruktion kann wieder geschachtelt werden. Für +viele Fälle gibt es jedoch einen ELIF-Teil, der die Verschachtelung +erspart: + +#beispiel# + IF f ("m/w") = "m" THEN + maenner INCR 1 + ELIF f ("m/w") = "w" THEN + frauen INCR 1 + ELSE + zweifelhaft INCR 1 + END IF; +#text# + +Der ELIF-Teil beinhaltet noch einmal einen Test. Dieser Test wird +jedoch nur dann durchgeführt, wenn die erste Bedingung falsch war. +Gibt es noch mehr Wahlmöglichkeiten, können Sie beliebig viele +ELIF-Teile benutzen. + Beachten Sie, daß die letzte Anweisung in einem Teil der IF- +Konstruktion nicht unbedingt ein folgendes Semikolon haben muß +(das Semikolon soll nur trennen). Ein Semikolon an dieser Stelle +kann aber auch nicht schaden. + +#a ("Werteliefernde Programme")# Nicht nur Ausdrücke können Werte lie­ +fern, sondern auch ganze Anweisungsfolgen. Dies ist eine Erweite­ +rung der werteliefernden IF-Konstruktion. Sie können dies für Ab­ +kürzungen oder Refinements ausnutzen. + +#beispiel# + endergebnis : + gesammelte zeichen CAT "."; + gesammelte zeichen . +#text# + +In diesem Beispiel werden in einer Textvariable bestimmte Zeichen +gesammelt. Zum Schluß soll ein Punkt angefügt werden und dieser +Text dann als Ergebnis des Refinements geliefert werden. + Damit eine Anweisungsfolge einen Wert liefert, muß am Ende +der Anweisungsfolge ein Ausdruck stehen. Der Wert des Ausdrucks +nach Abarbeitung der Anweisungen ist dann der Wert der Anwei­ +sungsfolge. + Allerdings kann man den gleichen Wert oft verschieden aus­ +drücken. Folgendes Refinement hat die gleiche Wirkung wie oben: + +#beispiel# + endergebnis : + gesammelte zeichen + "." . +#text# + +In manchen Fällen ist eine Formulierung als werteliefernde Anwei­ +sungsfolge jedoch übersichtlicher. + +#a ("Beispiel")# Zum Abschluß dieses Kapitels wollen wir als Beispiel eine +statistische Auswertung einer Zahlenreihe als Druckmuster formu­ +lieren. + Gegeben sei eine Datei mit folgenden Feldern: + +#beispiel# + "Meßwert 1" + "Meßwert 2" +#text# + +Wir wollen als Ergebnis Mittelwert und Standardabweichung der +beiden Meßwerte ausdrucken. Dazu dient das Druckmuster auf der +folgenden Seite. + Im Initialisierungsteil des Druckmusters werden die notwendi­ +gen Variablen definiert und initialisiert. Beachten Sie hier, daß in +einer Definition mehrere Variablen durch Komma getrennt aufgeführt +werden können, wenn sie den gleichen Typ haben. + Im Wiederholungsteil müssen dann jeweils die Zwischensummen +aktualisiert werden. Da mit der Funktion 'wert' eine relativ auf­ +wendige Umwandlung verbunden ist, wird der Wert des jeweiligen +Feldes erst einmal in einer Variable zwischengespeichert, da er +mehrmals benötigt wird. Diese Zwischenspeicherungsvariable muß +nicht initialisiert werden + Im Nachspann werden dann die Ergebnisse gedruckt. Die Formeln +sind jeweils als Abkürzungen definiert. Die Funktion 'zahltext' sorgt +dafür, daß die Werte mit drei Nachkommastellen (gerundet) aufge­ +führt werden. + Da die Formeln relativ komplex sind, werden sie auf mehrere +Zeilen verteilt (in ELAN hat das Zeilenende keine Bedeutung). + +#beispiel# + %% REAL VAR + %% messwert, + %% summe 1 := 0.0, quadratsumme 1 := 0.0, + %% summe 2 := 0.0, quadratsumme 2 := 0.0; + %% INT VAR anzahl := 0; + % WIEDERHOLUNG + %% anzahl INCR 1; + %% messwert := wert ("Meßwert 1"); + %% summe 1 INCR messwert; + %% quadratsumme 1 INCR messwert * messwert; + %% messwert := wert ("Meßwert 2"); + %% summe 2 INCR messwert; + %% quadratsumme 2 INCR messwert * messwert; + % NACHSPANN + &anz Meßwerte. + Meßwert 1 Meßwert 2 + Mittelwert &&mw1&&&& &&mw2&&&& + Standardabweichung &&st1&&&& &&st2&&&& + % ABKUERZUNGEN + &mw1 : zahltext (summe 1 / real (anzahl), 3) . + &mw2 : zahltext (summe 2 / real (anzahl), 3) . + &st1 : zahltext + (sqrt ((quadratsumme 1 - summe 1 * summe 1 / + real (anzahl)) / real (anzahl - 1)), 3) . + &st2 : zahltext + (sqrt ((quadratsumme 2 - summe 2 * summe 2 / + real (anzahl)) / real (anzahl - 1)), 3) . +#text# + +Mit entsprechenden Formeln können Sie dieses Beispiel für Ihre +eigenen Statistiken erweitern. Die Beispiele der letzten beiden Ka­ +pitel sollten Ihnen genügend Anregungen dafür gegeben haben. + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.16 b/app/eudas/4.4/doc/user-manual/eudas.hdb.16 new file mode 100644 index 0000000..b0e84ee --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.16 @@ -0,0 +1,329 @@ +#type ("prop")##limit (14.0)# +#format# +#page (171)# +#kapitel ("16", "Dateiverwaltung", "mit", "EUDAS")# + + + +#abschnitt ("16.1", "DATEIEN IM SYSTEM", "Dateien im System")# + +Zum Bearbeiten von Dateien innerhalb des Systems gibt es das Menü +'Dateien', das Sie bereits in Kapitel 4 kurz kennengelernt haben. +An dieser Stelle sollen die übrigen Funktionen dieses Menüs be­ +sprochen werden. + +#beispiel# + -------------- + Dateien System + U Übersicht + -------------- + Datei + L Löschen + N Umbenennen + K Kopieren + P Platzbedarf + A Aufräumen + -------------- + +#center#Abb. 16-1 Menü 'Dateien' +#text# + +Beachten Sie, daß alle Funktionen in diesem Menü mit Dateien +beliebiger Struktur arbeiten können, also sowohl mit Textdateien +als auch EUDAS-Dateien (und anderen). Dies liegt daran, daß +Dateien an dieser Stelle einfach als "schwarze Kästen" mit beliebi­ +gem Inhalt betrachtet werden. + +#a ("Übersicht")# Die Funktion 'Übersicht' haben Sie bereits ausprobiert. +Sie zeigt in einem Editorfenster an der rechten Seite alle Dateien, +die sich in Ihrer Task befinden. Falls nicht alle Dateien auf den +Bildschirm passen, können Sie das Fenster mit HOP OBEN und HOP +UNTEN rollen. Sie verlassen die Übersicht wie üblich mit ESC 'q'. + +#a ("Löschen")# Auch die Funktion 'Löschen' sollten Sie schon kennen. +Mit dieser Funktion verschwindet eine Datei auf Nimmerwieder­ +sehen. Daher werden Sie sicherheitshalber immer gefragt, ob Sie die +Datei wirklich löschen wollen. Sie können in einer Auswahl auch +alle zu löschenden Dateien ankreuzen (dann wird trotzdem nochmal +gefragt). + Eine EUDAS-Datei, die gerade geöffnet ist, können Sie nicht +löschen (sonst würde EUDAS zumindest durcheinanderkommen). Sie +müssen die Datei zuerst sichern - oder nicht sichern, aber die +Arbeitskopien löschen. + +#a ("Umbenennen")# Mit der Funktion 'Umbenennen' können Sie einer Datei +einen neuen Namen geben. Sie werden zuerst aufgefordert, den alten +Namen der Datei einzugeben. Alternativ können Sie hier wieder die +umzubenennenden Dateien auswählen. Danach wird Ihnen (für jede +ausgewählte Datei) der alte Dateiname zum Überschreiben angebo­ +ten. + Sie können diesen Namen mit den üblichen Editierfunktionen +verändern oder mit HOP RUBOUT löschen und ganz neu eingeben. +Auf diese Weise sparen Sie sich erheblichen Tippaufwand, wenn Sie +einen langen Dateinamen an nur einer Stelle verändern wollen. + +#a ("Kopieren")# Wie in Abschnitt 11.2 bereits angedeutet, gibt es eine +Funktion zum logischen Kopieren von Dateien. Dies ist eine Funk­ +tion, die sich auf spezielle Eigenschaften des EUMEL-Systems +stützt. Wenn Sie eine Datei #on("i")#logisch#off("i")# kopieren, wird lediglich ein +Verweis kopiert. Die Daten werden zunächst nur einmal für beide +Dateien gespeichert. + Natürlich hätte das Ganze wenig Sinn, wenn danach bei Ände­ +rungen immer beide Dateien geändert würden. Bei Änderungen an +einer Datei werden jedoch nur die geänderten Daten getrennt ange­ +legt, der Rest wird weiterhin gemeinsam benutzt. Die beiden Dateien +sind also nach außen hin komplett unabhängig, intern werden je­ +doch gemeinsame Daten so weit wie möglich geteilt. Auf diese Weise +wird sowohl Zeit als auch Speicherplatz gespart. + Dieses Verfahren ist besonders dann sinnvoll, wenn Sie sich +einen bestimmten Stand einer Datei aufbewahren wollen. In diesem +Fall stellen Sie sich eine logische Kopie her und arbeiten mit dem +Original weiter. Es werden dann nur die Daten zusätzlich angelegt, +die Sie seit der Kopie verändert haben. + EUDAS benutzt die gleiche Funktion auch für die Arbeitskopie. +Die Arbeitskopie teilt ebenfalls ihre Daten mit dem Original. Ande­ +renfalls wäre es ja auch zeitlich gar nicht möglich, beim Öffnen eine +Arbeitskopie anzufertigen. + Beim Aufruf der Funktion 'Kopieren' werden Sie zunächst nach +dem Namen der Datei gefragt (wie üblich mit Auswahlmöglichkeit). +Dann können Sie einen neuen Namen für die Kopie angeben. Dieser +neue Name darf jedoch nicht für eine andere Datei vergeben sein. +Wollen Sie eine andere Datei überkopieren, müssen Sie diese zu­ +nächst löschen. + Denken Sie daran, daß die hier beschriebene Funktion sich +wesentlich vom Kopieren im Menü 'Gesamtdatei' unterscheidet. Dort +wird nämlich eine tatsächliche Kopie durchgeführt, dafür können Sie +sich dann auch selektiv bestimmte Daten herausgreifen. Außerdem +gilt die dortige Funktion nur für EUDAS-Dateien. + +#a ("Platzbedarf")# Zu Ihrer Information können Sie sich auch den Platz­ +bedarf anzeigen lassen, den eine Datei auf dem Speichermedium hat. +Wenn Sie den Namen der Datei angegeben haben, wird Ihnen die +Größe in "Kilobyte" (KB) angegeben. Ein KB entspricht etwa 1000 +Zeichen, also einer halben vollgeschriebenen Bildschirmseite. + Bei logisch kopierten Dateien wird für jede Datei der benötigte +Platz separat angegeben. Sie können die Zahlen also nicht einfach +addieren, um den Gesamtspeicherbedarf zu ermitteln, da Sie dann +die gemeinsam benutzten Bereiche doppelt zählen würden. + +#a ("Aufräumen")# Wenn eine Datei viel geändert wurde, führen zwei +Effekte zu einer langsameren Verarbeitung dieser Datei. Zum einen +wird durch Textleichen der Platzbedarf größer. Dies tritt vor allem +dann auf, wenn zu einzelnen Sätzen immer etwas hinzugefügt wurde +(eine Folge der Flexibilität, mit variablen Textlängen operieren zu +dürfen). + Da der Platzbedarf der Datei also wächst, sind mehr Speicher­ +zugriffe notwendig, als es dem Inhalt entspricht. Doch nicht nur der +Platz, sondern auch die Verteilung der Sätze machen sich unange­ +nehm bemerkbar. Da vergrößerte Sätze intern am Ende der Datei +gespeichert werden, werden logisch aufeinanderfolgende Sätze phy­ +sikalisch weit verstreut. + Der gleiche Effekt ensteht auch durch Umsortieren oder Ein­ +fügen von Sätzen. Um die Datei sequentiell zu bearbeiten, sind also +ständig wechselnde Speicherzugriffe erforderlich. + Die beiden beschriebenen Effekte führen zur Geschwindigkeits­ +verringerung. Dies kann verhindert werden, indem die Datei in eine +frische Datei umkopiert wird. Diesen Vorgang nennt man #on("i")#Reorgani­ +sieren#off("i")#. Dafür gibt es die Funktion 'Aufräumen'. + Während des Umkopierens werden die Satznummern ausgegeben. +Achten Sie darauf, daß zum Reorganisieren genügend Platz auf dem +System vorhanden ist, um eine komplette Kopie der zu reorganisie­ +renden Datei aufzunehmen. + Zum Reorganisieren muß nämlich tatsächlich eine physikalische +Kopie angefertigt werden. Eine logische Kopie oder das Schreiben +auf das Archiv reorganisieren eine Datei dagegen nicht, wohl aber +die Funktion 'Kopieren' im Menü 'Gesamtdatei'. + Da der Inhalt gelesen werden muß, funktioniert die Funktion +'Aufräumen' im Gegensatz zu den oben gemachten Versprechungen +nur für Textdateien oder EUDAS-Dateien, nicht aber für andere +Dateitypen. Die Unterscheidung der Dateitypen wird automatisch +vorgenommen. + + +#abschnitt ("16.2", "DATEIEN AUF DEM ARCHIV", "Dateien auf dem Archiv")# + +Mit den Funktionen im Menü 'Archiv' können Sie nicht nur Dateien +auf dem Archiv behandeln, sondern auch in anderen Tasks oder per +EUMEL-Netz sogar auf anderen Rechnern. + +#beispiel# + -------------- + Dateien Archiv + U Übersicht + D Üb. Drucken + -------------- + Datei + K Kopieren + vom Archiv + S Schreiben + auf Archiv + L Löschen + auf Archiv + -------------- + Archivdiskette + I Init + -------------- + Z Zielarchiv + P Paßwort + R Reservieren + -------------- + +#center#Abb. 16-2 Menue 'Archiv' +#text# + +#a ("Zielarchiv")# Dazu können Sie die Task einstellen, mit der Sie arbei­ +ten möchten. Normaleinstellung ist die Task 'ARCHIVE', die Ihre +Archivdiskette bedient. Dies wird auch in der untersten Bildschirm­ +zeile angezeigt. + Die Task stellen Sie mit der Funktion 'Zielarchiv' ein. Sie +werden dann nach dem Namen der Task gefragt. Diese Task muß +eine Managertask sein (also unabhängig vom Bildschirm arbeiten) +und sie muß bereits existieren. + Wenn Sie auf Ihrem Rechner das EUMEL-Netz installiert haben, +werden Sie auch nach der Nummer der Zielstation gefragt, also der +Nummer des Rechners, auf dem die gewünschte Task arbeitet. Durch +Drücken von RETURN wird automatisch Ihre eigene Stationsnummer +verwendet. + Nun gibt es zwei Arten von Managertasks, mit denen EUDAS +zusammenarbeiten kann, #on("i")#Archivmanager#off("i")# und normale Dateimanager. +Der Unterschied besteht darin, daß ein Archivmanager für einen +Benutzer reserviert werden muß, damit man nicht auf Disketten +eines anderen Benutzers zugreifen kann. Normale Dateimanager +können und sollen dagegen von mehreren Benutzern in beliebiger +Reihenfolge angesprochen werden. + Manche Rechner haben mehrere Archivmanager für mehrere +Diskettenlaufwerke. Durch das Einstellen des Zielarchivs können Sie +auf verschiedenen Laufwerken archivieren. Ein Archivmanager kann +sich natürlich auch auf einem anderen Rechner befinden. Sie benut­ +zen dann dessen Diskettenlaufwerk. + Beim Einstellen des Zielarchivs wird als letztes gefragt, ob die +Zieltask ein Archivmanager ist oder nicht. Im Normalfall sollten Sie +die Frage bejahen, wenn Sie 'ARCHIVE' einstellen, und ansonsten +verneinen (s. die obigen Ausnahmefälle). + Das eingestellte Zielarchiv wird jeweils in der untersten Bild­ +schirmzeile angezeigt. + Die Reservierung eines Archivmanagers findet beim ersten Zu­ +griff statt. Beim Umschalten des Zielarchivs oder Verlassen des +Menüs wird die Reservierung automatisch wieder aufgehoben. + +#a ("Übersicht")# Mit der Funktion 'Übersicht' können Sie eine Auflistung +aller Dateien abrufen, die sich auf der Archivdiskette (bzw. in dem +eingestellten Manager) befinden. Wie die Dateiübersicht im System +können Sie die Darstellung wie im Editor rollen und mit ESC 'q' +verlassen. + Wollen Sie die Übersicht gedruckt haben, rufen Sie die Funktion +'Übersicht drucken' auf. Die Übersicht wird dann nochmals zusam­ +mengestellt und gleich gedruckt. + +#a ("Schreiben und Lesen")# Mit den Funktionen 'Kopieren vom Archiv' +und 'Schreiben auf Archiv' können Sie Dateien zwischen dem Archiv +und Ihrer Task hin und her transportieren. Es wird jeweils eine +Kopie angefertigt, das heißt das Original auf der Diskette oder in +Ihrer Task wird nicht verändert. + Wenn die transportierte Datei an ihrem Ziel schon existiert, +wird gefragt, ob die vorher existierende Datei gelöscht (überschrie­ +ben) werden soll. Überschreiben aus Versehen ist nicht möglich, +wenn Sie die Frage sorgfältig beantworten. + Beim Aufruf der Funktionen können Sie den gewünschten Da­ +teinamen angeben oder in der Auswahl ankreuzen. Die Auswahl ist +hier besonders sinnvoll, wenn Sie mehrere Dateien (eventuell sogar +in einer bestimmten Reihenfolge) sichern müssen. Außerdem können +Sie ja keine Datei transportieren, die nicht existiert; alle Möglich­ +keiten werden Ihnen also durch Ankreuzen angeboten. + Beachten Sie, daß beim Überschreiben einer Datei auf einer +Archivdiskette der Speicherplatz der alten (überschriebenen) Ver­ +sion im allgemeinen nicht wiederverwendet werden kann. In diesem +Fall kann das Archiv voll werden, obwohl eigentlich genügend Platz +da wäre. + +#a ("Löschen")# Das gleiche Problem tritt auf beim Löschen einer Datei +auf dem Archiv. Mit der Funktion 'Löschen auf Archiv' können Sie +zwar die Datei auf der Diskette ungültig machen, der Platz wird +jedoch nur dann wiederverwendet, wenn es die letzte Datei auf der +Diskette war. Anderenfalls bleiben "Leichen" übrig, die Sie in der +Archivübersicht als Striche erkennen können. + Diese Probleme treten jedoch mit anderen Managern nicht auf, +da diese Ihren Speicherplatz intelligenter verwalten können. + +#a ("Initialisieren")# Als Abhilfe bei einem übergelaufenen Archiv müssen +Sie das ganze Archiv initialisieren und neu beschreiben. Dazu gibt +es die Funktion 'Init'. + Diese Funktion müssen Sie auch dann verwenden, wenn Sie eine +Archivdiskette zum ersten Mal verwenden. Auf dem Archiv muß +nämlich als erstes der Archivname eingetragen werden, ehe es be­ +nutzt werden kann. Diesen Namen müssen Sie hier angeben. + Alle alten Daten des Archivs werden komplett gelöscht. Daher +müssen Sie vorher die noch gültigen Daten vom Archiv ins System +kopiert haben. Wenn das Archiv vorher schon beschrieben war, +werden Sie anhand des Namens gefragt, ob Sie die richtige Diskette +zum Überschreiben eingelegt haben. + Wenn Sie eine fabrikneue Diskette aus der Verpackung nehmen, +müssen Sie diese vor der Initialisierung #on("i")#formatieren#off("i")#. Dabei wird die +Diskette auf ein bestimmtes physikalisches Format eingestellt. Ohne +diese Operation ist weder Schreiben noch Lesen überhaupt möglich. + In der Regel muß eine Diskette nur einmal formatiert werden. +Sie können sie jedoch jederzeit wieder formatieren (wenn Sie zum +Beispiel nicht wissen, was Ihnen da für eine alte Diskette in die +Finger geraten ist). + Am Anfang des Initialisierens werden Sie gefragt, ob Sie die +Diskette formatieren wollen. Manche Rechner unterstützen diese +Operation innerhalb des EUMEL-Systems nicht. In diesem Fall (und +natürlich auch sonst normalerweise) müssen Sie die Frage vernei­ +nen. Das Formatieren muß dann vorher irgendwie außerhalb des +Systems geschehen sein. + Das Initialisieren funktioniert natürlich nur bei Archivmana­ +gern. Bei einer anderen Zieltask ist diese Funktion gesperrt. + +#a ("Paßwort")# Dateien in einem allgemeinen Dateimanager (nicht jedoch +auf dem Archiv) können Sie mit einem Paßwort gegen unbefugten +Zugriff sichern. Sinnvolle Voraussetzung dafür ist, daß der Datei­ +manager selbst mit einem anderen Paßwort gegen Betreten gesichert +ist. + Das von Ihnen verwendete Paßwort geben Sie mit der Funktion +'Paßwort' ein. Damit Ihnen niemand über die Schulter schauen +kann, werden alle Zeichen auf dem Bildschirm als Punkte darge­ +stellt. Anschließend müssen Sie das Paßwort noch einmal eingeben, +damit sich kein unbemerkter Schreibfehler eingeschlichen hat. + Das Paßwort wird dann bei allen Transport- und Löschopera­ +tionen abgefragt. Eine Datei im Manager erhält Ihr Paßwort zuge­ +wiesen, wenn Sie sie das erste Mal im Manager ablegen. Bei allen +folgenden Zugriffen muß das gleiche Paßwort eingestellt sein, sonst +wird der Zugriff verweigert. + Natürlich können Sie für verschiedene Dateien verschiedene +Paßwörter einstellen. Trotz Einstellung eines Paßworts können auch +andere Benutzer ihre Dateien im gleichen Manager ablegen. + Sie können auch für Schreiben (und Löschen) sowie Lesen +unterschiedliche Paßwörter einstellen. Dazu benutzen Sie einfach +einen Trennstrich in der Form +#f2# +#beispiel# + Schreibpaßwort/Lesepaßwort +#text# +#f2# +Soll eine Datei überhaupt nicht überschrieben oder gelöscht werden +können, können Sie '-' als Schreibpaßwort verwenden: +#f2# +#beispiel# + -/Lesepaßwort +#text# +#f2# +Die Datei kann dann nur beim direkten Betreten der Managertask +verändert werden. + Wollen Sie die Paßworteinstellung wieder aufheben, drücken Sie +bei der Paßworteingabe nur RETURN, da der leere Text als "kein +Paßwort" interpretiert wird. + +#a ("Reservieren")# Wollen Sie eine Task als Zieltask verwenden, die zwar +kein Archivmanager ist, aber reserviert werden muß (zum Beispiel +'DOS' zum Ansprechen fremder Diskettenformate) müssen Sie die +Reservierung mit der Funktion 'Reservieren' selbst vornehmen. Die +Zieltask darf nicht als Archivmanager gekennzeichnet sein (dann ist +die Funktion 'Reservieren' nämlich gesperrt). + Bei der Reservierung müssen Sie den Reservierungsparameter +(abhängig von der Art der Zieltask - bei 'DOS' beispielsweise den +Modus) als Text eingeben. Nach der Reservierung können Sie die +anderen Funktionen des Archivmenüs verwenden. + Die Freigabe der Zieltask erfolgt automatisch beim Verlassen +des Menüs oder beim Einstellen einer neuen Zieltask. + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.2 b/app/eudas/4.4/doc/user-manual/eudas.hdb.2 new file mode 100644 index 0000000..a72ba81 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.2 @@ -0,0 +1,164 @@ +#type ("prop")##limit (14.0)# +#format# +#page (11)# +#kapitel ("2", "Installation", "des", "Programms")# + + + +Bevor Sie EUDAS auf Ihrem System benutzen können, müssen Sie das +Programm zuvor installieren. Wenn EUDAS schon auf Ihrem System +zur Verfügung steht, können Sie dieses Kapitel getrost überlesen. + + +#abschnitt ("2.1", "LIEFERUMFANG", "Lieferumfang")# + +EUDAS wird auf einer Diskette geliefert, die alle notwendigen Pro­ +gramme enthält. Um den Inhalt der Diskette feststellen zu können, +starten Sie Ihr System und bringen es dazu, daß 'gib kommando:' +erscheint. Dann legen Sie die Diskette ein und geben das Kommando + +#beispiel# + archive ("EUDAS"); list (archive); release (archive) +#text# + +Anschließend erscheint eine Übersicht der auf dem Archiv vorhan­ +denen Programmteile. Folgende Namen sollten sich in dieser Über­ +sicht wiederfinden: + +#beispiel# + "eudas.1" + "eudas.2" + "eudas.3" + "eudas.4" + "eudas.init" + "eudas.generator" + "Adressen" +#text# + +Eventuell können noch weitere Namen in der Übersicht auftauchen. +Sollte einer der angegebenen Namen nicht vorhanden sein, rekla­ +mieren Sie die Diskette. Falls Sie statt der Übersicht eine Fehler­ +meldung erhalten, sollten Sie überprüfen, ob die Diskette das rich­ +tige Format besitzt oder Ihr Diskettenlaufwerk Probleme bereitet. + Wenn Sie so den Inhalt der Diskette kontrolliert haben, können +Sie EUDAS installieren. Je nachdem, ob Sie ein Single-User oder ein +Multi-User System benutzen, sind die Anweisungen unterschiedlich. +Sie brauchen nur den Sie betreffenden der beiden folgenden Ab­ +schnitte zu lesen. Falls Sie nicht wissen, welches System Sie benut­ +zen: ein Multi-User System wird auf der Systemdiskette und am +Bildschirm durch die Kennzeichnung 'EUMEL x.y.z/M' identifiziert, +bei einem Single-User System steht als letztes Zeichen ein 'S'. + + +#abschnitt ("2.2", "SINGLE-USER", "Single-User")# + +Dieser Abschnitt betrifft Sie nur, wenn Sie EUDAS auf einem +Single-User System installieren wollen. + Sie können EUDAS immer nur auf einer bestimmten Hinter­ +grunddiskette installieren. Auf dieser Diskette sollten noch min­ +destens 250 KB frei sein (stellen Sie dies durch das Kommando +'storage info' sicher). EUDAS kann anschließend auch nur auf dieser +Diskette verwendet werden. + Starten Sie nun die gewünschte Diskette. Dann legen Sie die +Diskette, auf der EUDAS sich befindet, in das Archivlaufwerk. Geben +Sie dann das Kommando + +#beispiel# + archive ("EUDAS"); fetch ("eudas.generator", archive); run +#text# + +Sie haben damit das Generatorprogramm gestartet, das die Installa­ +tion automatisch durchführt. Lassen Sie während dieses Vorganges +das EUDAS-Archiv eingelegt. Sie werden benachrichtigt, wenn die +Generierung abgeschlossen ist. + Wenn Sie EUDAS auf allen Ihren Hintergrunddisketten haben +möchten, können Sie das so erzeugte System als Muttersystem +sichern. Mit dem Kommando 'save system' können Sie den Hinter­ +grund komprimiert auf eine leere Archivdiskette schreiben. Mit +dieser Sicherung können Sie dann jederzeit neue Systemdisketten +wie von Ihrem Originalsystem herstellen. + +#a("Einschränkungen")# Aus Platzgründen hat die Single-User-Version +von EUDAS folgende Einschränkungen: +#free (0.2)# +#bsp("*")# Sie können die Funktionen Ketten und Koppeln nicht verwenden. +#free (0.2)# +#bsp("*")# Sie können im Druckmuster keine ELAN-Anweisungen und -Aus­ + drücke verwenden. +#free (0.2)# +#bsp("*")# Es stehen nur einige allgemeine Hilfstexte zur Verfügung. +#free (0.2)# +#bsp("*")# Funktionen, die mehrere Tasks vorausssetzen, sind ebenfalls + gesperrt. +#free (0.2)# +Die betreffenden Funktionen sind zwar gegebenenfalls im Menü +enthalten, lassen sich aber nicht aufrufen. + + +#abschnitt ("2.3", "MULTI-USER", "Multi-User")# + +Dieser Abschnitt betrifft Sie nur, wenn Sie EUDAS auf einem Mul­ +ti-User System installieren wollen. + EUDAS muß in einer bestimmten Task installiert werden. Alle +neuen Söhne und Enkel dieser Task können dann EUDAS aufrufen. +Im Normalfall wird diese Task 'PUBLIC' sein. + Zum Installieren müssen Sie in diese Task gehen (in diesem +Beispiel 'PUBLIC'). Dazu rufen Sie durch Tippen der SV-Taste den +Supervisor und geben das Kommando + +#beispiel# + continue ("PUBLIC") +#text# + +Stelle Sie mit Hilfe des 'storage info'-Kommandos fest, ob auf Ihrem +Hintergrund noch mindestens 300 KB frei sind (dieser Platz wird zur +Generierung benötigt). Dann legen Sie die EUDAS-Archivdiskette ein +und geben folgendes Kommando + +#beispiel# + archive ("EUDAS"); fetch ("eudas.generator", archive); run +#text# + +Falls die Task 'PUBLIC' Söhne besitzt, werden Sie gefragt, ob Sie +diese löschen wollen. EUDAS steht nämlich nur in den Söhnen zur +Verfügung, die #on("i")#nach#off("i")# der Installation eingerichtet wurden. Antworten +Sie auf die Frage durch einfaches Tippen von 'j' oder 'n'. wenn Sie +die Frage verneinen, können Sie die Generierung zu diesem Zeit­ +punkt auch noch abbrechen und zunächst die Söhne aufräumen. + Es erscheint die Frage +#f2# +#beispiel# + Ausführliche Hilfstexte installieren ? (j/n) +#text# +#f2# +Verneinen Sie die Frage, wenn in Ihrem System der Speicherplatz +kritisch ist (zum Beispiel wenn Sie keine Festplatte haben). Es +werden dann nur die wichtigsten allgemeinen Hilfstexte installiert +(Ersparnis etwa 40 KByte). + Anschließend wird die automatische Generierung gestartet. +Lassen Sie die EUDAS-Archivdiskette eingelegt. Die Generierung ist +beendet, wenn das EUMEL-Bild erscheint. Die Task, in der die +Generierung stattfindet, wird automatisch zu einer Managertask, das +heißt, daß man von ihr Söhne einrichten kann. + Sie können das so erweiterte System auch mit 'save system' auf +einer oder mehreren Archivdiskette sichern. Lesen Sie dazu die +Hinweise zur Systemsicherung im EUMEL-Systemhandbuch. + +#a ("Korrekturversionen")# Falls Sie später einmal eine Korrekturversion +von EUDAS bekommen, sollten Sie vor der neuen Generierung die +Task, in der EUDAS vorher generiert war, löschen (Vorsicht: alle +Söhne werden mitgelöscht) und wieder neu einrichten. Anderenfalls +bleibt die alte Version als unzugängliche "Leiche" auf Ihrem System +liegen. + In diesem Fall und auch, wenn Sie mehrere Programme in der +gleichen Task installieren, kann es zum Überlauf der internen Über­ +setzertabellen kommen. Für größere Installationen oder wenn Sie +viele verschiedene Programme benutzen, empfiehlt es sich, zur +Generierung eine eigene Task 'EUDAS' als Sohn von 'PUBLIC' zu +verwenden. Sie dürfen dann aber in 'PUBLIC' nicht zu viel insertie­ +ren, da 'EUDAS' ja alle Programme von 'PUBLIC' erbt. Denken Sie +daran, daß Sie EUDAS nur in Tasks benutzen können, die unter der +Task 'EUDAS' eingerichtet wurden. + + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.3 b/app/eudas/4.4/doc/user-manual/eudas.hdb.3 new file mode 100644 index 0000000..51da351 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.3 @@ -0,0 +1,504 @@ +#type ("prop")##limit (14.0)# +#format# +#page (15)# +#kapitel ("3", "Ein Beispiel", "zum", "Ausprobieren")# + + + +Bevor Sie in die tieferen Geheimnisse von EUDAS einsteigen, sollen +Sie in diesem Kapitel erst einige Erfahrungen mit der Bedienung +sammeln. Dadurch erhalten Sie Sicherheit im Umgang mit dem Pro­ +gramm und haben bereits einen Eindruck dessen, was Sie anschlie­ +ßend erwartet. + Das Durchlesen dieses Kapitels ist nur dann sinnvoll, wenn Sie +die Anweisungen selbst am Rechner ausprobieren. Anderenfalls +beginnen Sie besser mit dem nächsten Kapitel. + Im folgenden sind die Eingaben, die Sie machen sollen, kursiv +gedruckt, während Ausgaben des Rechners normal erscheinen. +Außerdem erscheinen spezielle Tasten in spitzen Klammern: +#f2# +#beispiel# + +#text# +#f2# +Bitte tippen Sie nicht die eckigen Klammern oder Großbuchstaben, +sondern die entsprechende Taste. Oft haben die Sondertasten auch +etwas andere Bezeichnungen (die obige zum Beispiel 'CR', 'Carriage +Return', 'RETURN', 'ENTER'). Bitte fragen Sie bei Unklarheiten Ihren +Systemlieferanten oder -betreuer. + + +#abschnitt ("3.1", "START", "Start")# + +Die Anweisungen zum Starten von EUDAS sind unterschiedlich, je +nachdem wie Ihr System eingerichtet ist. Bitte beachten Sie daher +die verschiedenen Fälle. + +1. Falls Sie EUDAS nicht selbst installiert haben, fragen Sie am + besten Ihren Systembetreuer. Ansonsten verhalten Sie sich wie + unter 2. + +2. Falls Sie EUDAS nach den Anweisungen von Kapitel 2 in einem + Multi-User-System eingerichtet haben, müssen Sie zunächst eine + Arbeitstask (Arbeitsbereich) einrichten. Dazu tippen Sie die + SV-Taste (diese trägt häufig die unterschiedlichsten Bezeich­ + nungen). Es erscheint + +#beispiel# + EUMEL x.y.z/M + + gib supervisor kommando : +#text# + + Sie tippen nun folgendes Kommando: + +#beispiel# + #on("i")#begin ("arbeit")#off("i")# +#text# + + Vergessen Sie nicht die RETURN-Taste am Schluß. Machen Sie + jetzt weiter bei Punkt 4. + +3. Falls Sie ein Single-User-System besitzen, starten Sie die + Systemdiskette und geben das Datum ein. Dann machen Sie wei­ + ter mit Punkt 4. + +4. Danach erscheint: + +#beispiel# + gib kommando : +#text# + + und Sie tippen: + +#beispiel# + #on("i")#eudas#off("i")# +#text# + + Als Ergebnis wird das EUDAS-Eingangsmenü angezeigt (s. Abb. + 3-1 auf der nächsten Seite). + + +#abschnitt ("3.2", "DATEN EINTRAGEN", "Daten eintragen")# + +Als Beispiel sollen Sie eine kleine Adressenkartei einrichten. Der +Fachausdruck für eine elektronische Kartei ist #on("i")#Datei#off("i")#. +#f2# +#bildschirm# +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + EUDAS-Datei : + O Öffnen : + - Ketten : + - Koppeln : EEEEE U U DDDD A SSSS + --------------: E U U D D A A S + Arbeitskopie : EEE U U D D AAAAA SSS + - Sichern : E U U D D A A S + --------------: EEEEE UUU DDDD A A SSSS + Aktuelle Datei: + - Notizen : Version 4.3 + - Feldstrukt. : Stand: 14.07.87 + - Prüfbeding. : + --------------: (C) Copyright + Mehrbenutzer : Thomas Berlage + M Manager : Software-Systeme + --------------: + : + : + : + : + : + Akt.Datei: Manager: Datum: 22.07.87 +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 3-1 EUDAS-Eingangsmenü +#text# + + Zunächst müssen Sie eine neue Datei einrichten. Dazu tippen +Sie die Leertaste. Dadurch wird die invers dargestellte Funktion +'Öffnen' ausgeführt. Folgen Sie bitte dem nachstehenden Dialog auf +der rechten Bildschirmseite: + +#beispiel# + Name der Datei: #on ("i")#Mitglieder#off("i")# + "Mitglieder" neu einrichten ? (j/n) #on("i")#j#off("i")# +#text# + +Unter der Überschrift 'Neue Feldnamen' tippen Sie jetzt folgendes +(bitte keine Leerstellen vor den Namen tippen): + +#beispiel# + #on("i")#Name#off("i")# + #on("i")#Vorname#off("i")# + #on("i")#PLZ#off("i")# + #on("i")#Ort#off("i")# + #on("i")#Strasse#off("i")# + #on("i")#m/w#off("i")##on("i")#q#off("i")# +#text# + +Zum Schluß beantworten Sie noch eine Frage: + +#beispiel# + Feldnamen oder Feldtypen aendern ? (j/n) #on("i")#n#off("i")# +#text# + +Damit ist die neue Datei eingerichtet. + Nun tippen Sie die Pfeiltaste #bsp("")#. Es erscheint ein neues +Menübild (s. Abb. 3-2). +#f2# +#bildschirm# +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: Satz 1 .........ENDE... Mitglieder .......... Feld 1 + Positionieren : Name + W Weiter : Vorname + Z Zurück : PLZ + N Satz.Nr : Ort + --------------: Strasse + Suchbedingung : m/w + S Setzen : ........................................................... + L Löschen : + M Markierung : + --------------: + Datensatz : + E Einfügen : + A Ändern : + T Tragen : + H Holen : + --------------: + F Feldauswahl : + --------------: + : + : + : + +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 3-2 Menü 'Einzelsatz' +#text# + +Nun tippen Sie so lange die Pfeiltaste #bsp("")#, bis die Funktion +'Einfügen' invers markiert ist. Dann tippen Sie die Leertaste zum Aus­ +führen dieser Funktion. Die Schreibmarke springt nach rechts ins +Datenfeld zum Eingeben. Geben Sie jetzt den ersten Datensatz wie +folgt ein: + +#beispiel# + #on("i")#Wegner#off("i")# + #on("i")#Herbert#off("i")# + #on("i")#5000#off("i")# + #on("i")#Köln#off("i")# + #on("i")#Krämergasse 12#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# +#text# + +Anschließend wird das Datenfeld wieder freigemacht, so daß Sie +gleich den zweiten Datensatz eingeben können. Dies tun Sie auf die +gleiche Weise, nur mit anderen Daten: + +#beispiel# + #on("i")#Sandmann#off("i")# + #on("i")#Helga#off("i")# + #on("i")#5300#off("i")# + #on("i")#Bonn 1#off("i")# + #on("i")#Willicher Weg 109#off("i")# + #on("i")#w#off("i")##on("i")#w#off("i")# +#text# + +Ebenso verfahren Sie dann weiter mit den folgenden Daten. Falls Sie +sich vertippt haben, können Sie mit den vier Pfeiltasten an die +entsprechende Stelle gehen und die falschen Buchstaben über­ +schreiben. + +#beispiel# + #on("i")#Katani#off("i")# + #on("i")#Albert#off("i")# + #on("i")#5210#off("i")# + #on("i")#Troisdorf#off("i")# + #on("i")#Lindenstr. 3#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# + + #on("i")#Ulmen#off("i")# + #on("i")#Peter#off("i")# + #on("i")#5#off("i")# + #on("i")#Köln 60#off("i")# + #on("i")#Mozartstraße 17#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# + + #on("i")#Regmann#off("i")# + #on("i")#Karin#off("i")# + #on("i")#5000#off("i")# + #on("i")#Köln 90#off("i")# + #on("i")#Grengelweg 44#off("i")# + #on("i")#w#off("i")##on("i")#w#off("i")# + + #on("i")#Arken#off("i")# + #on("i")#Hubert#off("i")# + #on("i")#5200#off("i")# + #on("i")#Siegburg#off("i")# + #on("i")#Talweg 12#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# + + #on("i")#Simmern#off("i")# + #on("i")#Anna-Maria#off("i")# + #on("i")#5#off("i")# + #on("i")#Köln 3#off("i")# + #on("i")#Platanenweg 67#off("i")# + #on("i")#w#off("i")##on("i")#w#off("i")# + + #on("i")#Kaufmann-Drescher#off("i")# + #on("i")#Angelika#off("i")# + #on("i")#53#off("i")# + #on("i")#Bonn#off("i")# + #on("i")#Hauptstr. 123#off("i")# + #on("i")#w#off("i")##on("i")#w#off("i")# + + #on("i")#Fuhrmann#off("i")# + #on("i")#Harald#off("i")# + #on("i")#5000#off("i")# + #on("i")#Köln 1#off("i")# + #on("i")#Glockengasse 44#off("i")# + #on("i")#m#off("i")##on("i")#w#off("i")# +#text# + +Bei der letzten Adresse ist die letzte Taste unterschiedlich, da Sie +keine weiteren Daten mehr eintragen wollen. Bitte beachten Sie dies. + +#beispiel# + #on("i")#Seefeld#off("i")# + #on("i")#Friedrich#off("i")# + #on("i")#5000#off("i")# + #on("i")#Köln-Ehrenfeld#off("i")# + #on("i")#Kabelgasse#off("i")# + #on("i")#m#off("i")##on("i")#q#off("i")# +#text# + +Damit die neu eingetragenen Daten permanent gespeichert sind, +müssen Sie sie #on("i")#sichern#off("i")#. Dazu kehren Sie durch Tippen von #bsp("")# +in das erste Menü zurück. Dort tippen Sie wieder so lange #bsp("")#, +bis die Funktion 'Sichern' markiert ist. Tippen Sie dann die Leer­ +taste zum Ausführen und folgen dem nachstehenden Dialog: + +#beispiel# + Arbeitskopie "Mitglieder" veraendert! Sichern ? (j/n) #on("i")#j#off("i")# + Alte Version ueberschreiben ? (j/n) #on("i")#j#off("i")# + Interne Arbeitskopien loeschen ? (j/n) #on("i")#j#off("i")# +#text# + +Damit steht Ihnen nun eine Mitgliederdatei mit 10 Einträgen zur +weiteren Verfügung. + + +#abschnitt ("3.3", "DATEN ABFRAGEN", "Daten abfragen")# + +Um Daten abzufragen, müssen Sie die Datei zunächst wieder öffnen. +Dazu bewegen Sie die inverse Markierung durch mehrmaliges Tippen +von #bsp("")# nach oben bis zur Funktion 'Öffnen' und tippen Sie die +Leertaste. Danach ergibt sich folgender Dialog: + +#beispiel# + Name der Datei: #on("i")#Mitglieder#off("i")# + Wollen Sie etwas aendern (eine Arbeitskopie einrichten) + ? (j/n) #on("i")#n#off("i")# +#text# + +Danach gehen Sie durch Tippen von #bsp ("")# in das zweite Menü. +Dort erscheint jetzt die zehnte Adresse. + Zunächst sollen Sie an den Anfang gehen. Dazu schieben Sie +die Markierung auf die Funktion 'Satz.Nr' mit Hilfe der Pfeiltasten +und tippen dann die Leertaste. Nach folgender Angabe + +#beispiel# + Neue Satznummer: #on("i")#1#off("i")# +#text# + +erscheint die erste Adresse. Nun sollen Sie nach der Adresse von +Harald Fuhrmann suchen. Dazu bringen Sie die Markierung auf die +Funktion 'Suchbedingung Setzen' und tippen die Leertaste. Die +Schreibmarke springt wieder in das Datenfeld. Dort geben Sie ein: + +#beispiel# + #on("i")#Fuhrmann#off("i")##on("i")#q#off("i")# +#text# + +In der markierten Überschrift erscheint 'SUCH-' zum Zeichen, daß +eine Suchbedingung eingestellt ist. Dann schieben Sie die Markie­ +rung auf die Funktion 'Weiter' und tippen die Leertaste. Kurz da­ +nach erscheint die Adresse von Herrn Fuhrmann mit dem Hinweis +'SUCH+' (gefunden). + Führen Sie dann die Funktion 'Zurück' aus (Verschieben der +Markierung und Tippen der Leertaste). Es erscheint wieder die erste +Adresse mit dem Hinweis 'SUCH-' (kein weiterer Fuhrmann gefun­ +den). Führen Sie dann die Funktion `Suchbedingung Löschen' aus. +Der 'SUCH'-Hinweis verschwindet wieder. + Als nächstes sollen Sie die Daten nach allen weiblichen Mit­ +gliedern durchsuchen. Dazu führen Sie wieder die Funktion 'Such­ +bedingung Setzen' aus. Diesmal tippen Sie im Datenfeld fünfmal die +Pfeiltaste #bsp ("")#, bis die Schreibmarke neben der Bezeichnung +'m/w' steht. Dort tippen Sie + +#beispiel# + #on("i")#w#off("i")##on("i")#q#off("i")# +#text# + +Wenn Sie jetzt die Funktion 'Weiter' ausführen, erscheint das erste +weibliche Mitglied, Frau Sandmann. Da aber noch weitere Frauen in +der Datei vorkommen, führen Sie erneut 'Weiter' aus und es erschei­ +nen die nächsten weiblichen Mitglieder. + Wenn kein gesuchtes Mitglied mehr gefunden wurde, erscheint +ein leeres Datenfeld mit den Bezeichnungen 'ENDE' und 'SUCH-' in +der Überschrift. Durch mehrmaliges Ausführen von 'Zurück' können +Sie die weiblichen Mitglieder wieder in der umgekehrten Reihenfolge +ansehen, bis Sie an den Anfang der Datei kommen. + Bitte lassen Sie die Suchbedingung eingestellt, denn im näch­ +sten Abschnitt wollen wir alle weiblichen Mitglieder ausdrucken. + + +#abschnitt ("3.4", "DRUCKEN", "Drucken")# + +Zuerst begeben Sie sich durch zweimaliges Tippen von #bsp ("")# in +das Druckmenü, das in Abb. 3-3 gezeigt wird. +#f2# +#bildschirm# +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + Satzauswahl : + D Drucken : + --------------: + Druckausgabe : + R Richtung : + --------------: + Textdatei : + E Editieren : + A Ausdrucken : + N Nachbearb. : + --------------: + : + : + : + : + : + : + : + : + : + : + Akt.Datei: "Mitglieder" Datum: 22.07.87 +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 3-3 Menü 'Drucken' +#text# + +Zunächst müssen Sie ein Druckmuster erstellen, das angibt, wie der +Druck aussehen soll. Dazu führen Sie die Funktion 'Textdatei Edi­ +tieren' aus. Es erscheint die Aufforderung: + +#beispiel# + Name der Datei: #on("i")#liste#off("i")# +#text# + +Dann wird der Bildschirm gelöscht und Sie können folgendes einge­ +ben: + +#beispiel# + #on("i")#% VORSPANN#off ("i")# + #on("i")#Liste der weiblichen Mitglieder#off ("i")# + #on("i")#-------------------------------#off ("i")# + #on("i")#% WIEDERHOLUNG#off ("i")# + #on("i")#&Vorname %Name#off ("i")##on("i")#q#off("i")# +#text# + +Ebenso wie beim Eingeben von Daten können Sie hier mit den Pfeil­ +tasten auf fehlerhafte Stellen zurückgehen und dort korrigieren. + Nun sollten Sie sich vergewissern, ob Ihr Drucker eingeschaltet +und bereit (Ready) ist. Falls Sie keinen Drucker haben, folgen Sie +bitte den Anweisungen unter 2. Anderenfalls gehen Sie wie folgt +vor. + +1. Rufen Sie die Funktion 'Richtung' auf und beantworten Sie + folgende Frage: + +#beispiel# + Ausgabe automatisch zum Drucker ? (j/n) #on("i")#j#off("i")# +#text# + + Dann rufen Sie die Funktion 'Drucken' auf und geben den Namen + des Druckmusters an: + +#beispiel# + Name des Druckmusters: #on("i")#liste#off ("i")# +#text# + + Als Ergebnis sollte folgende Liste auf Ihrem Drucker erscheinen: + +#beispiel# + Liste der weiblichen Mitglieder + ------------------------------- + Helga Sandmann + Karin Regmann + Anna-Maria Simmern + Angelika Kaufmann-Drescher +#text# + +2. Rufen Sie die Funktion 'Richtung' auf und beantworten Sie + folgende Fragen: + +#beispiel# + Ausgabe automatisch zum Drucker ? (j/n) #on("i")#n#off("i")# + Ausgabe in bestimmte Datei ? (j/n) #on("i")#n#off("i")# +#text# + + Dann rufen Sie die Funktion 'Drucken' auf und geben den Namen + des Druckmusters an: + +#beispiel# + Name des Druckmusters: #on("i")#liste#off ("i")# +#text# + + Nach dem Ende des Druckprozesses (wenn das Sternchen vor + 'Drucken' wieder durch ein 'D' ersetzt worden ist), rufen Sie + wieder die Funktion 'Textdatei Editieren' auf und geben folgen­ + den Namen an: + +#beispiel# + Name der Datei: #on("i")#liste.a$1#off("i")# +#text# + + Es erscheint die gleiche Ausgabe wie unter 1 beschrieben auf + dem Bildschirm. Wenn Sie die Ausgabe genug gesehen haben, + kehren Sie durch + +#beispiel# + #on("i")#q#off("i")# +#text# + + wieder in das Menü zurück. + + +#abschnitt ("3.5", "ERGEBNIS", "Ergebnis")# + +Da Sie sich wieder im Menü befinden, könne Sie EUDAS durch +#f2# + #on("i")#q#off("i")# +#f2# +wieder verlassen. Danach können Sie Ihre Sitzung beenden, etwas +Anderes tun oder EUDAS erneut aufrufen. + + Sie haben nun selbst ausprobiert, wie Sie unter EUDAS Daten +eingeben können, wie Sie diese Daten abrufen und in ihnen suchen +können. Sie haben die Daten auch schon ausgedruckt. + Damit Sie besser verstehen, was Sie soeben gemacht haben, +werden Sie in den folgenden vier Kapiteln die Grundfunktionen von +EUDAS mit den dazugehörigen Erläuterungen kennenlernen. + Danach können Sie dann selber Ihre eigene Anwendung entwer­ +fen und EUDAS zu Ihrer Arbeitserleichterung einsetzen. + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.4 b/app/eudas/4.4/doc/user-manual/eudas.hdb.4 new file mode 100644 index 0000000..dc86791 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.4 @@ -0,0 +1,676 @@ +#type ("prop")##limit (14.0)# +#format# +#page (27)# +#kapitel ("4", "Umgang mit", "Dateien", "und Menüs")# + + + +Zu Anfang dieses Teils sollen Sie zunächst die Terminologie von +EUDAS kennenlernen. Das Karteikartenmodell des ersten Kapitels +muß ja auf einem Rechner realisiert werden. Dazu müssen erst eini­ +ge Ausdrücke erklärt werden. + + +#abschnitt ("4.1", "EUDAS-DATEIEN", "EUDAS-Dateien")# + +Der wichtigste Ausdruck, der Ihnen noch sehr häufig begegnen wird, +ist #on("i")#Datei#off("i")#. Eine Datei ist eine Sammlung von Informationen in einem +Computer, die als ein Objekt transportiert und behandelt werden +können. Dieser Name wurde analog zu "Kartei" gebildet, mit dem +Unterschied, daß eine "Daten-Kartei" gemeint ist. + Jede Datei hat einen eigenen Namen, durch den sie identifiziert +wird. Der Name ist oft in Anführungsstriche eingeschlossen - die +Anführungsstriche gehören jedoch nicht zum Namen, sondern dienen +nur zur Abgrenzung, welche Zeichen zum Namen gehören. Der Name +ist also wie die Aufschrift auf einem Aktenordner. Wenn alle Ordner +im Schrank stehen, können Sie anhand des Namens den richtigen +Ordner finden, anderenfalls müßten Sie alle Ordner öffnen. + +#a ("Dateiarten")# Dateien werden nun für viele verschiedene Arten von +Informationen benutzt. Sie können einerseits Texte enthalten oder +auch Karteien, Grafiken, Formeln oder Zahlenkolonnen. Sie haben +bereits im ersten Kapitel den Unterschied zwischen Datenverwaltung +und Textverarbeitung kennengelernt. In diesem Zusammenhang sind +die beiden ersten Verwendungsweisen wichtig. + +#limit (12.0)# + #on("i")#Textdateien#off("i")# + sind Dateien, die normale Texte enthalten, die mit + dem Editor verändert und einfach ausgedruckt + werden können. In ihnen werden also Informationen + gespeichert, wie die Textverarbeitung sie benötigt. + + #on("i")#EUDAS-Dateien#off("i")# + sind dagegen Dateien, die Informationen in der + Form von Karteikarten enthalten. Sie haben also + die Struktur, wie sie von der Datenverwaltung be­ + nötigt wird. +#limit (13.5)# + + Der Computer kann aber auch alle Arten von Dateien gleich­ +behandeln, und zwar dann, wenn der Inhalt der Dateien nicht be­ +trachtet werden muß. + Ein häufiger Fall ist zum Beispiel, wenn Dateien zur Sicherung +auf eine Diskette geschrieben werden sollen. In diesem Fall genügt +die Angabe des Namens; dem Rechner ist es egal, welchen Inhalt die +Datei hat. + Anders ist es aber, wenn Sie den Inhalt betrachten wollen. +Dazu brauchen Sie dann ein Programm, das die innere Struktur der +Datei kennt. Textdateien können Sie zum Beispiel mit dem Editor +ansehen. EUDAS-Dateien müssen Sie jedoch mit EUDAS ansehen, da +der Editor die EUDAS-Struktur nicht kennt. Es ist in vielen Fällen +sinnvoll, durch einen Zusatz im Dateinamen zu kennzeichnen, ob es +sich um eine Textdatei oder eine EUDAS-Datei handelt. + +#beispiel# +#free (3.7)# + +#center#Abb. 4-1 Struktur einer EUDAS-Datei +#text# + +#a ("Terminologie")# EUDAS verwendet bestimmte Ausdrücke, um die +Strukturelemente einer EUDAS-Datei zu kennzeichnen. Die Struktur +einer EUDAS-Datei ist schematisch in Abb. 4-1 dargestellt. Die +Ausdrücke wurden nun nicht direkt aus dem Karteikartenmodell +übernommen, da es auch noch andere Modelle gibt und keine fal­ +schen Assoziationen auftreten sollen. + EUDAS verwendet die Bezeichnung #on("i")#Satz#off("i")# für eine Karteikarte. +Eine EUDAS-Datei besteht also aus einer Anzahl von gleichartigen +Sätzen. Zur Veranschaulichung kann man sich diese nebeneinander­ +gelegt vorstellen. + Jeder Satz ist unterteilt in sogenannte #on("i")#Felder#off("i")#. Ein Feld ent­ +spricht einem Attribut bzw. einem Eintrag auf der Karteikarte. Ein +Feld ist wiederum unterteilt in einen #on("i")#Feldnamen#off("i")# und einen #on("i")#Feldin­ +halt#off("i")#. + Der Feldname identifiziert ein bestimmtes Feld innerhalb eines +Satzes. Die Feldnamen sind natürlich für alle Sätze gleich. Die +Feldnamen einer EUDAS-Datei sind beliebig und können von Ihnen +selbst festgelegt werden. + Der Feldinhalt enthält die eigentliche Information des entspre­ +chenden Attributs. Der Feldinhalt darf ebenfalls aus beliebig vielen +Zeichen bestehen. Die Feldinhalte sind natürlich für jeden Satz +verschieden und stellen die eigentliche gespeicherte Information +dar. + +#a ("Grenzen")# Aus technischen Gründen gibt es natürlich auch einige +Beschränkungen, die hier nicht verschwiegen werden sollen. Eine +Datei kann maximal etwa 5000 Sätze enthalten, ein Satz darf aus +maximal 255 Feldern bestehen. Insgesamt kann ein Satz etwa 32000 +Zeichen umfassen. Die einzelnen Sätze in der EUDAS-Datei werden +durch ihre jeweilige Positionsnummer identifiziert, also quasi von 1 +bis 5000 durchnumeriert. + + +#abschnitt ("4.2", "EUDAS-MENÜS", "EUDAS-Menüs")# + +In den folgenden Abschnitten sollen Sie lernen, wie die Bedienung +von EUDAS funktioniert. Dazu sollen Sie eine EUDAS-Beispieldatei +von der EUDAS-Diskette in Ihr System holen. Diese Datei brauchen +Sie dann später, um die Funktionen von EUDAS zu kennenzulernen. + Die Beispieldatei hat den gleichen Inhalt wie die in Kapitel 3 +von Ihnen erstellte Datei. Falls Ihnen also die EUDAS-Archiv­ +diskette nicht zur Verfügung steht, können Sie in diesem Kapitel +auch jede andere Archivdiskette verwenden. + Bitte beachten Sie im folgenden, daß Sie einfache Anführungs­ +striche nicht mit eingeben, doppelte Anführungsstriche aber wohl. + +#a ("EUDAS-Aufruf")# Zuerst müssen Sie EUDAS aufrufen. Dazu begeben +Sie sich in die in Kapitel 3 eingerichtete Task ('continue ("arbeit")') +und geben bei 'gib kommando:' das Kommando 'eudas': + +#beispiel# + gib kommando: + #on("i")#eudas#off("i")# +#text# + +Falls Ihr System über Menüs gesteuert wird, müssen Sie eine ent­ +sprechende Funktion wählen. Anschließend erscheint folgendes +Menü: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + EUDAS-Datei : + O Öffnen : + - Ketten : + - Koppeln : + --------------: + Arbeitskopie : + - Sichern : + --------------: + Aktuelle Datei: + - Notizen : + - Feldstrukt. : + - Prüfbeding. : + --------------: + Mehrbenutzer : + M Manager : + --------------: + : + : + : + : + : + Akt.Datei: Manager: Datum: 22.07.87 +___________________________________________________________________________________________ +#text# + +#a ("Menüs")# Ein #on("i")#Menü#off("i")# ist eine Auswahl für einige verschiedene Funk­ +tionen. Die Funktionen sind jeweils benannt und werden durch einen +davorstehenden Buchstaben oder ein Minuszeichen gekennzeichnet. +Eine der Funktionen ist immer durch inverse Darstellung markiert. + Diese Markierung können Sie nun mit Hilfe der Pfeiltasten OBEN +und UNTEN verschieben. Auf diese Weise können Sie sich die ge­ +wünschte Funktion auswählen. Die Funktionen werden jedoch durch +das Markieren nicht ausgeführt. Sie können also beliebig mit den +Pfeiltasten herumexperimentieren. + Ausgeführt wird die markierte Funktion, wenn Sie die Leertaste +drücken. Sofort erscheint ein Stern vor dem Funktionsnamen, um +anzuzeigen, daß die Ausführung beginnt. Probieren Sie dies jetzt +nicht aus, dazu ist später Gelegenheit. + Funktionen mit einem Minuszeichen davor können Sie zwar +anwählen (markieren), aber nicht ausführen. Solche Funktionen sind +momentan gesperrt, weil ihre Ausführung keinen Sinn hat oder sogar +Fehler erzeugen würde. + Mit den Pfeiltasten LINKS und RECHTS können Sie im Menüzu­ +stand weitere EUDAS-Menüs abrufen. Welche Menüs zur Verfügung +stehen, zeigt Ihnen die oberste Bildschirmzeile. Das aktuelle Menü +ist jeweils invers dargestellt. + +#a ("Hilfe")# Wenn Sie nun wissen möchten, welche Bedeutung die mar­ +kierte Funktion hat (die Funktionsbezeichnungen sind aus Platz­ +gründen sehr kurz gehalten), können Sie einen #on("i")#Hilfstext#off("i")# zu dieser +Funktion abrufen. Dies erfolgt durch die Betätigung der Tasten ESC +und '?' hintereinander. Diese doppelten Tastenkombinationen mit der +ESC-Taste am Anfang werden Ihnen noch sehr häufig begegnen - +denken Sie immer daran, die Tasten hintereinander und nicht +gleichzeitig zu tippen. Der zeitliche Abstand zwischen den Tasten­ +drücken kann beliebig lang sein; hingegen sollten Sie eine Taste +nicht zu lange drücken, da sonst eventuell eine automatische Wie­ +derholfunktion Ihrer Tastatur startet. + Probieren Sie nun die Tastenkombination ESC '?' aus. Als Reak­ +tion erscheint in der rechten Hälfte des Bildschirms ein Text. Dieser +sollte Ihnen die gewünschten Informationen bieten. + Gleichzeitig hat sich aber auch die oberste Bildschirmzeile +verändert. Sie zeigt jetzt folgendes Bild: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + HILFE: Beenden: ESC q Seite weiter: ESC w Seite zurueck: ESC z +___________________________________________________________________________________________ +#text# + +#a ("Zustände")# Wenn Sie sich nicht im Menü befinden, fungiert die ober­ +ste Zeile als sogenannte #on("i")#Statuszeile#off("i")#. Diese Zeile zeigt immer an, in +welchem #on("i")#Zustand#off("i")# das Programm sich befindet. Der Zustand des Pro­ +gramms hat nämlich Einfluß darauf, welche Tasten Sie drücken +können und wie das Programm darauf reagiert. Die Statuszeile zeigt +daher außer dem Zustand auch die wichtigsten Tastenfunktionen. + Sie kennen jetzt also schon zwei Zustände von EUDAS: den +Menüzustand und den Hilfe-Zustand. + +#a ("Hilfe-Zustand")# Vom Menüzustand kommen Sie über die Tastenkom­ +bination ESC '?' in den Hilfe-Zustand. Im Hilfe-Zustand haben die +Pfeiltasten OBEN und UNTEN keine Wirkung mehr (probieren Sie dies +aus). + Ein Hilfstext besteht im allgemeinen aus mehreren Seiten. Die +erste Seite enthält dabei die speziellen Informationen, danach +folgen dann allgemeine Informationen. Mit den Tastenkombinationen +ESC 'w' und ESC 'z' können Sie zwischen den Seiten umschalten +(denken Sie daran, was oben über Tastenkombinationen gesagt +wurde). Wenn Sie dies ausprobieren, werden Sie auf der zweiten +Seite allgemeine Hinweise zur Menübedienung finden. Auf der letz­ +ten Seite wird ESC 'w' ignoriert, ebenso ESC 'z' auf der ersten Seite. + Mit der Tastenkombination ESC 'q' (quit) kehren Sie aus dem +Hilfezustand in den vorherigen Zustand zurück. Diese Tastenkombi­ +nation löst allgemein in EUDAS die Rückkehr in den alten Zustand +aus. Wenn Sie ESC 'q' getippt haben, erscheint die alte Menüzeile +und Sie können wieder Funktionen auswählen. + Der Hilfszustand läßt sich von nahezu allen (noch zu bespre­ +chenden) Zuständen mit ESC '?' aufrufen. Es wird jeweils ein zum +aktuellen Zustand passender Hilfstext ausgegeben. + Die möglichen Zustandsübergange sind nochmal in Abb. 4-2 +zusammengefaßt. + +#beispiel# +#free (2.5)# + +#center#Abb. 4-2 Menü- und Hilfezustand +#text# + +#a ("EUDAS verlassen")# Im Menüzustand können Sie EUDAS jederzeit +durch Tippen von ESC 'q' verlassen. Sie landen dann wieder bei 'gib +kommando:'. + + +#abschnitt ("4.3", "ARCHIVMENÜ", "Archivmenü")# + +#a ("System/Archiv")# An dieser Stelle müssen Sie sich die Begriffe #on("i")#Archiv#off("i")# +und #on("i")#System#off("i")# klarmachen. Als Archiv bezeichnet man die Möglichkeit, +bei Bedarf Disketten in Ihren Rechner einlegen können, um Dateien +(und Programme) von anderen Rechnern zu übernehmen. Um diese +Dateien bearbeiten zu können, müssen Sie sie in das System (Ihre +Festplatte oder Hintergrunddiskette) kopieren. + Die wichtigste Aufgabe des Archivs ist es, Daten vor Beschädi­ +gung zu sichern. Durch Fehlbedienung oder Systemfehler kann es +nämlich leicht geschehen, daß die Daten in Ihrem System verloren +gehen oder zerstört werden. Wenn Sie die Daten jedoch auf einer +Diskette gesichert und die Diskette sicher verwahrt haben, können +Sie die Daten wiederherstellen. + Es ist sehr wichtig, daß Sie Ihre Dateien auf Archivdisketten +sichern, denn ein einziger Hardwarefehler kann die Arbeit von +Jahren vernichten (Sagen Sie nicht: "Mir passiert so etwas nicht" - +bis jetzt hat es noch jeden erwischt). + +#bildschirm# +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + Dateien Archiv: + U Übersicht : + D Üb. Drucken : + --------------: + Datei : + K Kopieren : + vom Archiv : + S Schreiben : + auf Archiv : + L Löschen : + auf Archiv : + --------------: + Archivdiskette: + I Init : + --------------: + Z Zielarchiv : + P Paßwort : + - Reservieren : + --------------: + : + : + Akt.Datei: Ziel: "ARCHIVE" Datum: 22.07.87 +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 4-3 Archivmenü +#text# + +#a ("Archivmenü")# Wenn Sie EUDAS aufrufen, befinden Sie sich immer im +ersten Menü. Sie benötigen jedoch jetzt Funktionen aus dem sech­ +sten Menü 'Archiv'. Wählen Sie dieses Menü jetzt an. Es erscheint +das in Abb. 4-3 dargestellte Bild. Die Funktionen in diesem Menü +befassen sich mit beliebigen Dateien auf dem Archiv. + Für den Versuch legen Sie bitte die EUDAS-Archivdiskette ein. +Dann wählen Sie die Funktion 'Übersicht' in dem Menü an, wenn sie +nicht schon markiert ist. Sie können nun die ausgewählte Funktion +durch Tippen der Leertaste ausführen. + In der obersten Zeile erscheint nun der Hinweis 'Bitte war­ +ten..'. Er zeigt an, daß nun eine Funktion ausgeführt wird, bei der +Sie zunächst nichts tun können. Sie sollten in diesem Zustand keine +Tasten drücken, denn EUDAS kann nicht darauf reagieren. + +#a ("Archivübersicht")# Nach einer mehr oder minder langen Aktivitäts­ +phase Ihres Diskettenlaufwerks erscheint dann die Archivübersicht. +Das Erscheinungsbild mit dem markierten Editorbalken in der ober­ +sten Zeile kommt Ihnen vielleicht bekannt vor. Sie haben nämlich +nichts anderes als das EUMEL-Kommando 'list (archive)' ausgeführt. +Neu ist lediglich die Statuszeile: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Beenden: ESC q Hilfe: ESC ? +___________________________________________________________________________________________ +#text# + +Wenn Sie sich die Übersicht angeschaut haben, verlassen Sie den +Editor wieder mit ESC 'q'. + Beachten Sie, daß Sie unter EUDAS das Archiv nicht extra an­ +melden müssen; dies geschieht automatisch, wenn Sie eine Funktion +aufrufen. Bei Leseoperationen müssen Sie nicht einmal den Archiv­ +namen wissen. Das Archiv wird automatisch wieder abgemeldet, +wenn Sie das Archivmenü verlassen. + +#a ("Archiv lesen")# Unter den in der Übersicht aufgelisteten Dateien +sollten Sie auch die Datei finden, die Sie brauchen. Sie heißt +'Adressen'. An dieser Stelle ein kleiner Hinweis: An vielen Stellen +werden Sie sehen, daß Dateinamen in Anführungsstriche einge­ +schlossen sind. Die Anführungsstriche gehören jedoch #on("i")#nicht#off("i")# zum +Namen. Sie dienen nur zur Abgrenzung, da in Dateinamen beliebige +Zeichen erlaubt sind. Wenn Sie aufgefordert werden, einen Datei­ +namen einzugeben, müssen Sie dies immer ohne Anführungsstriche +tun. + Hoffentlich haben Sie in der ganzen Diskussion nicht das Ziel +aus den Augen verloren: Sie sollten eine Datei ins System holen, um +nachher mit ihr zu experimentieren. Zu diesem Zweck gibt es im +Archivmenü die Funktion +#free (0.2)# +#beispiel# + K Kopieren + (vom Archiv) +#text# +#free (0.2)# +Wählen Sie diese Funktion jetzt mit den Pfeiltasten aus und drücken +Sie zum Ausführen die Leertaste. + +#a ("Eingabezustand")# Nach kurzem 'Bitte warten..'-Zustand werden Sie +im rechten Bildschirmteil nach dem Namen der Datei gefragt. Gleich­ +zeitig erscheint eine neue Statuszeile. Es ergibt sich folgendes Bild: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbrechen: ESC h Hilfe: ESC ? + --------------:Dateiname: + Dateien Archiv: + U Übersicht : + D Üb. drucken : + --------------: + Datei : + * Kopieren : + vom Archiv : + ... + +___________________________________________________________________________________________ +#text# + +Sie können in diesem Zustand den Namen der gewünschten Datei +eingeben. Außer den in der Statuszeile genannten Funktionen kön­ +nen Sie die aus dem Editor bekannten Tasten benutzen, um den +Text in der Zeile gegebenenfalls zu korrigieren (Pfeiltasten LINKS +und RECHTS, RUBOUT, RUBIN). Die Schreibmarke (Cursor) zeigt Ihnen +an, wo das nächste Zeichen plaziert wird. + +#a ("Abbruch")# Eine Tastenkombination verdient noch besondere Beach­ +tung: Mit ESC 'h' können Sie in vielen Situationen eine Funktion +noch abbrechen - zum Beispiel wenn Sie irrtümlich die falsche +Funktion gewählt haben. + Im Gegensatz zu ESC 'q' erfolgt hier die sofortige Rückkehr aus +der Funktion ins Menü, möglichst ohne daß die Funktion Auswir­ +kungen hinterläßt. Bei einem Abbruch bleibt also in der Regel das +System unverändert. + +#a ("Fehlerzustand")# Um auch die Fehlerbehandlung von EUDAS auszu­ +probieren, sollten Sie hier einen falschen Namen eingeben, zum +Beispiel: +#free (0.2)# +#beispiel# + Dateiname: #on("i")#Adresen#off("i")# +#text# +#free (0.2)# +EUDAS sucht jetzt auf der Diskette nach einer Datei dieses Namens, +findet sie aber nicht. Als Reaktion erscheint dann die Meldung: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + !!! FEHLER !!! Quittieren: ESC q Hilfe zur Meldung: ESC ? + --------------:Dateiname: Adresen + Dateien Archiv:>>> "Adresen" gibt es nicht + U Übersicht : + D Üb. drucken : + --------------: + ... + +___________________________________________________________________________________________ +#text# + +Im Normalfall sollten Sie die Fehlermeldung mit ESC 'q' quittieren, +damit Sie den Befehl erneut versuchen können. Auch hier haben Sie +die Möglichkeit, eine besondere Information zu dem Fehler abzurufen +(es liegen jedoch nicht für alle möglichen Fehler spezielle Texte +vor). + Nach dem Quittieren des Fehlers befinden Sie sich wieder im +Menüzustand. Wiederholen Sie jetzt die Funktion, indem Sie die +Leertaste tippen. Sie werden dann erneut nach dem Namen gefragt. + +#a ("Auswahlzustand")# Um endlich ans Ziel zu kommen, benutzen Sie +diesmal eine sehr komfortable Abkürzung, die EUDAS Ihnen bietet. +Durch Drücken von ESC 'z' können Sie sich nämlich alle möglichen +Namen anzeigen lassen und den gewünschten einfach ankreuzen. + Anschließend sieht der Bildschirm wie in Abb. 4-4 aus. In die­ +sem Zustand können Sie mit den Pfeiltasten den Cursor zur ge­ +wünschten Datei bewegen und diese ankreuzen. Da Sie auch meh­ +rere Dateien in beliebiger Folge ankreuzen können, erscheint eine +'1' vor der Datei zur Anzeige der Reihenfolge. Sie wollen aber nur +diese eine Datei 'Adressen' holen und beenden die Auswahl daher +mit ESC 'q'. Wenn alles glattgeht, wird jetzt die Datei vom Archiv +ins System kopiert. + +#a ("Archiv schreiben")# Auf nahezu gleiche Weise können Sie mit der +Funktion +#f2# +#beispiel# + S Schreiben + auf Archiv +#text# +#f2# +eine Datei wieder auf die Diskette schreiben. Als erstes müssen Sie +dann den Namen der Archivdiskette eingeben, damit Sie nicht aus +Versehen auf eine falsche Archivdiskette schreiben. + Auch hier können Sie die gewünschten Dateien ankreuzen (na­ +türlich bietet EUDAS dann die Dateien des Systems an). Sie brau­ +chen keine Angst zu haben, aus Versehen eine Datei mit gleichem +Namen zu überschreiben - EUDAS fragt in solchen Fällen immer +nochmal an. + +#bildschirm# +___________________________________________________________________________________________ + + AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ? + --------------:-------------------------------------------------------------- + Dateien Archiv: Auswahl der Dateien auf dem Archiv. + U Übersicht : Gewuenschte Datei(en) bitte ankreuzen: + D Üb. Drucken :-------------------------------------------------------------- + --------------: o "eudas.1" + Datei : o "eudas.2" + * Kopieren : o "eudas.3" + vom Archiv : o "eudas.4" + S Schreiben : o "eudas.init" + auf Archiv : o "eudas.generator" + L Löschen : o "Adressen" + auf Archiv :-------------------------------------------------------------- + --------------: + Archivdiskette: + I Init : + --------------: + Z Zielarchiv : + P Paßwort : + - Reservieren : + --------------: + : + : + Akt.Datei: Ziel: "ARCHIVE" Datum: 22.07.87 +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 4-4 Dateiauswahl +#text# + + +#abschnitt ("4.4", "DATEIVERWALTUNG", "Dateiverwaltung")# + +So: nach dieser anstrengenden Arbeit sollen Sie sich überzeugen, +daß die Datei 'Adressen' nun wirklich im System zur Verfügung +steht. Dazu gehen Sie mit LINKS ein Menü zurück. Dieses Menü +beschäftigt sich mit Dateien im System und ist in Abb. 4-5 gezeigt. + Auch hier finden Sie eine Funktion "Übersicht". Rufen Sie diese +auf. Ganz analog zum Archiv erscheint eine Übersicht aller Dateien +im Editor. Verlassen Sie die Übersicht wieder mit ESC 'q'. +#f2# +#bildschirm# +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + Dateien System: + U Übersicht : + --------------: + Datei : + L Löschen : + N Umbenennen : + K Kopieren : + P Platzbedarf : + A Aufräumen : + --------------: + : + : + : + : + : + : + : + : + : + : + : + Akt.Datei: Task: "arbeit" Datum: 22.07.87 +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 4-5 Menü 'Dateien' +#text# + +#a ("Datei löschen")# Eine weitere Funktion aus diesem Menü werden Sie +ebenfalls noch öfter brauchen, nämlich +#free (0.2)# +#beispiel# + L Löschen +#text# +#free (0.2)# +Mit dieser Funktion können Sie eine Datei wieder aus dem System +entfernen - zum Beispiel wenn Sie sich die Adressen angesehen +haben und danach den Speicherplatz nicht weiter verschwenden +wollen. Als letztes Beispiel sollen Sie auch diese Funktion aufrufen +(keine Angst, wir löschen die Datei nicht wirklich, es gibt vorher +noch eine Notbremse). + +#a ("Fragezustand")# Als erstes werden Sie wieder nach dem Dateinamen +gefragt (dies ist Ihnen schon bekannt). Hier haben Sie jetzt die +Wahl, ob Sie den Namen eingeben oder mit ESC 'z' ankreuzen. Da das +Löschen unwiederbringlich ist, werden Sie anschließend zur Sicher­ +heit gefragt, ob Sie die Datei wirklich löschen wollen: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ? + --------------:Dateiname: Adressen + Dateien System:"Adressen" im System loeschen (j/n) ? + U Übersicht : + --------------: + ... + +___________________________________________________________________________________________ +#text# + +Diese Frage können Sie bejahen oder verneinen (oder die Funktion +ohne Auswirkungen abbrechen). In diesem Fall sollten Sie die Frage +verneinen - es sei denn, Ihnen hat das Spielen mit EUDAS so gut +gefallen, daß Sie die ganze Prozedur wiederholen und die Datei +nochmal vom Archiv holen wollen. + + +#abschnitt ("4.5", "BEDIENUNGSREGELN", "Bedienungsregeln")# + +Mit dieser letzten Demonstration haben Sie jetzt schon fast alle +Arten des Umgangs mit EUDAS kennengelernt. Sicher ist dies beim +ersten Mal sehr verwirrend. Mit vier Regeln können Sie jedoch +EUDAS immer bedienen: + +#limit (12.0)# + 1. Achten Sie darauf, welche möglichen Tastendrücke + in der Statuszeile stehen. Richten Sie sich danach! +#free (0.2)# + 2. Sind Sie sich unsicher, rufen Sie Hilfsfunktion mit + ESC '?' auf. Damit erhalten Sie weitere Informatio­ + nen. +#free (0.2)# + 3. Funktioniert diese Tastenkombination nicht (geben + Sie dem Rechner eine kurze Zeit zum Reagieren), + versuchen Sie die Tastenkombinationen ESC 'h' (Ab­ + bruch) oder ESC 'q' (Verlassen). Falls sich daraufhin + etwas verändert, fangen Sie wieder mit 1. an. +#free (0.2)# + 4. Erfolgt darauf keine Reaktion, drücken Sie die SV- + Taste und versuchen Sie das Programm mit 'halt' zu + stoppen. Führt auch das nicht zum Erfolg, hat sich + Ihr Rechner "aufgehängt". Sie müssen den Rechner + dann neu starten. Wenn Sie keine Erfahrung mit + einer solchen Situation haben, wenden Sie sich an + Ihren Händler oder Systembetreuer. +#limit (13.5)# + +Im Zusammenhang mit dem letzten Punkt sei nochmal auf die Wich­ +tigkeit einer regelmäßigen Datensicherung auf Archivdisketten +hingewiesen. Im Normalfall sollten Sie aber mit den Punkten 1 bis 3 +zurechtkommen. + +#a ("Zustände")# Im letzten Abschnitt haben Sie eine ganze Reihe von +Zuständen kennengelernt, die EUDAS einnehmen kann. In jedem +Zustand haben Sie verschiedene Möglichkeiten zur Reaktion. Glück­ +licherweise erscheinen diese Möglichkeiten zum großen Teil in der +Statuszeile. + Damit Sie die verwirrenden Erfahrungen des letzten Abschnitts +etwas ordnen können, wollen wir an dieser Stelle die verschiedenen +Zustände noch einmal zusammenfassen. Der Beschreibung vorange­ +stellt ist die jeweilige Kennzeichnung am Beginn der Statuszeile. + +#bsp ("EUDAS:")# Menüzustand. Sie können Menü und Funktion mit den Pfeil­ + tasten anwählen und eine Funktion durch Tippen der Leertaste + ausführen. ESC '?' gibt Hilfestellung zu jeder Funktion. ESC 'q' + beendet EUDAS. + +#bsp ("HILFE:")# Sie können mit ESC 'w' und ESC 'z' im Hilfstext blättern. Mit + ESC 'q' kommen Sie in den alten Zustand. + +#bsp ("AUSWAHL:")# Hier können Sie die gewünschten Namen mit 'x' ankreuzen + und mit 'o' wieder entfernen. Normales Beenden mit ESC 'q'. + Hilfestellung durch ESC '?'. Abbruch der gesamten Funktion mit + ESC 'h'. + +#bsp ("EINGABE:")# Hier können Sie eine einzelne Zeile eingeben oder ändern + (wie im Editor). Einfügen und Löschen mit RUBIN und RUBOUT. + Abbruch und Hilfestellung möglich. + +#bsp ("FRAGE:")# Beantworten Sie die gestellte Frage mit 'j' oder 'n'. Abbruch + (ESC 'h') und Hilfestellung (ESC '?') möglich. + +#bsp ("ZEIGEN:")# Mit HOP OBEN und HOP UNTEN können Sie in der Übersicht + blättern. Ende der Übersicht mit ESC 'q'. Hilfestellung möglich. + +#bsp ("!!! FEHLER !!!")# Quittieren Sie die Meldung mit ESC 'q'. Hilfestellung + möglich. + +#bsp ("Bitte warten..")# In diesem Zustand keine Taste drücken, der Rechner + ist beschäftigt. + +Drei weitere Zustände, die Sie noch nicht kennengelernt haben, sind +hier schon mal der Vollständigkeit halber aufgeführt: + +#bsp ("SATZ ÄNDERN:")# +#bsp ("SATZ EINFÜGEN:")# +#bsp ("SUCHMUSTER EINGEBEN:")# Satzeditor zum Eingeben von Feldinhalten. + Normales Verlassen mit ESC 'q'. Abbruch und Hilfestellung mög­ + lich. Beschreibung s. 6.2. + +#bsp ("EDITIEREN:")# EUMEL-Editor mit Änderungsmöglichkeit für beliebige + Texte. Normales Verlassen mit ESC 'q'. Hilfestellung möglich. + Beschreibung der Möglichkeiten siehe EUMEL-Benutzerhand­ + buch. + +#bsp ("Gib Kommando:")# Hier können Sie ein beliebiges ELAN-Kommando ein­ + geben und mit RETURN bestätigen. Abbruch und Hilfestellung + möglich. Kann im Menü durch ESC ESC aufgerufen werden. + +Wie Sie sehen, werden auch hier wieder die gleichen Tastenkombi­ +nationen verwendet, die Sie schon kennen. + In dieser Übersicht sind jeweils nur die wichtigsten Tastenkom­ +binationen aufgeführt. Informieren Sie sich gegebenenfalls mit ESC +'?'. Einige weitere Tastenfunktionen werden Sie im folgenden noch +kennenlernen. Eine vollständige Übersicht finden Sie im Referenz­ +handbuch. + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.5 b/app/eudas/4.4/doc/user-manual/eudas.hdb.5 new file mode 100644 index 0000000..f3abc69 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.5 @@ -0,0 +1,373 @@ +#type ("prop")##limit (14.0)# +#format# +#page (43)# +#kapitel ("5", "Gespeicherte", "Daten", "abfragen")# + + + +#abschnitt ("5.1", "ÖFFNEN", "Öffnen")# + +Als letzte Vorbereitung, bevor Sie mit der Adreßdatei spielen kön­ +nen, müssen Sie die Datei wie einen Karteikasten #on("i")#öffnen#off("i")#. Nach dem +Öffnen beziehen sich alle weiteren Funktionen auf die gerade ge­ +öffnete Datei. Aus diesem Grund darf auch immer nur eine einzige +Datei geöffnet sein - als hätte auf Ihrem Schreibtisch nur ein Kar­ +teikasten Platz. + Dazu wählen Sie jetzt wieder das erste Menü an. Dort finden +Sie die Funktion +#free (0.2)# +#beispiel# + O Öffnen +#text# +#free (0.2)# +Wählen Sie diese Funktion aus. Dann drücken Sie die Leertaste, um +die Funktion auszuführen. Als erstes erscheint im unteren Teil des +Bildschirms eine Frage: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + Wollen Sie etwas aendern (eine Arbeitskopie anlegen) (j/n) ? +___________________________________________________________________________________________ +#text# + +Der Cursor bleibt hinter der Frage stehen. Sie kennen diesen Frage­ +zustand ja schon. + In diesem Fall wollen Sie an der Spieldatei nichts verändern, +Sie beantworten die Frage also mit einem 'n'. Als nächstes werden +Sie nach dem Namen gefragt (Beachten Sie auch hier wieder die +Statuszeile). + Tippen Sie nun 'Adressen' und beenden Sie die Eingabe mit +RETURN. EUDAS öffnet die Datei und kehrt zum Menü zurück. Alter­ +nativ können Sie die Datei auch in einer Auswahl ankreuzen, wenn +Sie ESC 'z' tippen. + +#a ("Fußzeile")# Nach der Ausführung dieser Funktion sollten Sie Ihre +Aufmerksamkeit auf die letzte Zeile des Bildschirms richten. Hier +finden Sie jetzt folgendes vor: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + Akt.Datei: "Adressen" Manager: Datum: 22.07.87 +___________________________________________________________________________________________ +#text# + +Neben dem Datum und dem eingestellten Manager (dies kommt viel +später) sehen Sie hier, welche Datei Sie geöffnet haben und nun +bearbeiten können. Diese Fußzeile finden Sie auch in den ande­ +ren Menüs. Lediglich die mittlere Angabe ändert sich bei den ande­ +ren Menüs (eine Erläuterung dazu finden Sie in späteren Kapiteln). + +#a ("Anzeige")# Zum Anzeigen der Daten in der Adreßdatei müssen Sie das +zweite Menü 'Einzelsatz' anwählen (durch Drücken der Pfeiltaste +RECHTS). Am linken Rand erscheint das neue Menü mit den Anzei­ +gefunktionen. Der Rest des Bildschirms enthält das Formular für die +Adreßdatei mit den Daten des ersten Satzes. Abbildung 5-1 zeigt +das Bild, das sich dann ergibt. +#f2# +#bildschirm# +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: Satz 1 ................... Adressen ....... Zeile 1 + Positionieren : Name Wegner + W Weiter : Vorname Herbert + Z Zurück : PLZ 5000 + N Satz.Nr : Ort Köln + --------------: Strasse Krämergasse 12 + Suchbedingung : m/w m + S Setzen : ........................................................... + L Löschen : + M Markierung : + --------------: + Datensatz : + - Einfügen : + - Ändern : + - Tragen : + - Holen : + --------------: + F Feldauswahl : + --------------: + : + : + : + +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 5-1 Menü 'Einzelsatz' +#text# + +Das automatisch generierte Formular zeigt immer genau einen Satz. +Das Formular besteht aus drei Teilen: der Überschrift, dem Feldteil +und der Abschlußzeile. In der #on("i")#Überschrift#off("i")# steht der Name der Datei +("Adressen"), die Satznummer (1) und die Nummer der ersten ange­ +zeigten Zeile (immer 1, außer wenn die Datei mehr Felder hat, als +auf den Bildschirm passen). In manchen Fällen können auch noch +weitere Informationen dort auftauchen, wie wir später sehen wer­ +den. + Im #on("i")#Feldteil#off("i")# befindet sich der eigentliche Inhalt, und zwar sind +links markiert die Feldnamen zu sehen, während rechts die zugehö­ +rigen Inhalte des betreffenden Satzes stehen. Dieses Bild ähnelt +einer Karteikarte mit einem festen Format. + Die #on("i")#Abschlußzeile#off("i")# am Ende gibt an, daß für diesen Satz keine +weiteren Informationen mehr vorhanden sind. Wir werden aber spä­ +ter noch sehen, wie man anderenfalls die restlichen Informatio­ +nen sichtbar machen kann. + + +#abschnitt ("5.2", "BEWEGEN", "Bewegen")# + +Nun wollen Sie nicht immer nur einen Satz betrachten (das wäre ja +furchtbar langweilig). Daher müssen Sie die Möglichkeit haben, sich +in der Datei zu "bewegen". Dies geschieht mit Hilfe der beiden +Funktionen +#free (0.2)# +#beispiel# + W Weiter +#text# +#free (0.2)# +und +#free (0.2)# +#beispiel# + Z Zurück +#text# +#free (0.2)# +Sie haben die Wirkung, daß der Satz mit der nächsthöheren bzw. +nächstniedrigeren Satznummer angezeigt wird. Natürlich funktioniert +dies nur, wenn noch ein Satz vorhanden ist: am Anfang (Satz 1) +können Sie nicht zurückgehen. In diesem Fall ignoriert EUDAS Ihren +Befehl einfach. + Wenn Sie bis zum Ende der Datei gehen (keine Angst - diese +Datei enthält nur 10 Sätze), werden Sie feststellen, daß zum Schluß +ein ganz leerer Satz erscheint. Dieser Satz ist eine Art Endemarkie­ +rung; er informiert Sie, daß keine weiteren Sätze vorhanden sind. +Dieser Satz ist aber kein richtiger Satz, daher wird in der Über­ +schrift 'ENDE' angezeigt. (Wenn Ihnen diese Art Endemarkierung +merkwürdig erscheint: sie hat schon einen triftigen Grund, s.6.2). + Um einen Satz mit bekannter Satznummer gezielt anzuwählen, +können Sie die Funktion +#free (0.2)# +#beispiel# + N Satz.Nr +#text# +#free (0.2)# +verwenden. Sie müssen anschließend die Satznummer eingeben (Bitte +mit RETURN beenden). Ist der Satz vorhanden, erscheint dieser, +ansonsten stehen Sie am Ende der Datei. + +#a ("Aufruf über Buchstaben")# Vielleicht ist Ihnen inzwischen schon +aufgefallen, daß vor jeder Funktion in einem Menü ein Buchstabe +steht. Damit hat es folgendes auf sich: da das Positionieren des +Cursors zum Auswählen einer Funktion mehrere Tastendrücke erfor­ +dern kann, haben Sie die Möglichkeit, jede Funktion auch über +einen Buchstaben auszuführen. + Dies ist besonders dann sinnvoll, wenn Sie mit den eben be­ +sprochenen Funktionen schnell in der Datei "blättern" wollen. An­ +dererseits müssen Sie sich aber für eine schnelle Reaktion auch +einige der Tasten merken. Für die Praxis empfiehlt sich folgender +Kompromiß: die meistgebrauchten Funktionen über Buchstaben und +der Rest durch Positionieren im Menü. + + +#abschnitt ("5.3", "SUCHEN", "Suchen")# + +Stellen Sie sich vor, die Datei wäre größer und Sie müßten eine +bestimmte Adresse heraussuchen. Dazu würden Sie durch die ganze +Datei durchgehen, bis die gewünschte Adresse erscheint. Das wäre +natürlich bei vielen Adressen eine ungeheuer mühselige Arbeit, die +mit einem Karteikasten wahrscheinlich schneller zu erledigen wäre. + EUDAS bietet Ihnen jedoch die Möglichkeit, nach bestimmten +Sätzen zu suchen. Dazu müssen Sie angeben, wonach gesucht werden +soll. Als Beispiel wollen wir die Adresse von Frau Simmern su­ +chen. Bewegen Sie sich zunächst zurück bis auf den ersten Satz. +Dann wählen Sie die Funktion +#free (0.2)# +#beispiel# + Suchbedingung + S Setzen +#text# +#free (0.2)# +Auf dem Bildschirm verschwinden die Feldinhalte und der Cursor +steht hinter dem ersten Feldnamen. Dies bedeutet, daß Sie neben +die Feldnamen etwas schreiben können. Auch in der Statuszeile +erscheint statt der Anzeige der Menünamen ein Hinweis auf die +Eingabemöglichkeit (s. Abb. 5-2). Sie befinden sich jetzt in einem +Zustand, in dem Sie hinter die Feldnamen etwas schreiben können +(dem sogenannten #on("i")#Satzeditor#off("i")#). + Als Angabe, was gesucht werden soll, schreiben Sie jetzt in der +ersten Zeile neben 'Name' die Bedingung 'Simmern'. Sie haben jetzt +ein einfaches #on("i")#Suchmuster#off("i")# angegeben. Ein Suchmuster besteht aus +Bedingungen, die neben die Feldnamen geschrieben werden. Unser +einfaches Suchmuster lautet übersetzt: + + Wähle alle Sätze aus, bei denen 'Simmern' im Feld 'Name' + steht. + +Beenden Sie die Eingabe des Suchmusters mit ESC 'q'. Es erscheint +wieder das vorherige Bild, mit dem Unterschied, daß jetzt in der +Überschrift ein 'SUCH-' auftaucht. EUDAS steht immer noch auf dem +ersten Satz. + Die Anzeige 'SUCH' gibt an, daß ein Suchmuster eingestellt +wurde. Das Minuszeichen bedeutet, daß der aktuelle Satz die Such­ +bedingung jedoch #on("i")#nicht#off("i")# erfüllt. + +#bildschirm# +___________________________________________________________________________________________ + + SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? + --------------: Satz 1 .................... ............... Zeile 1 + Positionieren : Name Simmern + W Weiter : Vorname + Z Zurück : PLZ + N Satz.Nr : Ort + --------------: Strasse + Suchbedingung : m/w + * Setzen : ........................................................... + L Löschen : + M Markierung : + --------------: + Datensatz : + - Einfügen : + - Ändern : + - Tragen : + - Holen : + --------------: + F Feldauswahl : + --------------: + : + : +___________________________________________________________________________________________ + +#beispiel# +#center#Abb. 5-2 Eingabe eines Suchmusters +#text# + +#a ("Positionierung")# Das Suchen beginnt erst, wenn Sie sich in der Datei +bewegen. In diesem Fall erhalten die Funktionen 'Satz weiter' und +'Satz zurück' eine etwas geänderte Bedeutung. Sie gehen nämlich +nicht einfach zum nächsten bzw. vorigen Satz, sondern zum näch­ +sten bzw. vorigen #on("i")#ausgewählten#off("i")# Satz. + Als Indikator, daß Sie sich auf dem gesuchten Satz befinden, +dient die Anzeige 'SUCH+'. Probieren Sie dies jetzt aus, indem Sie +weitergehen. Als nächster Satz erscheint der gewünschte Satz 7. Die +nicht ausgewählten Sätze wurden also übersprungen. Das gleiche +passiert, wenn Sie noch weiter gehen. Da kein passender Satz mehr +vorhanden ist, erscheint der leere Endesatz. + +#limit (12.0)# + Denken Sie daran, daß das Einstellen der Suchbedingung + noch keine Suche bewirkt. Diese müssen Sie selbst + durch Positionieren mit 'Weiter' oder 'Zurück' auslösen. +#limit (13.5)# + +Sollten Sie sich nicht am Anfang der Datei befinden, wenn Sie eine +Suchbedingung einstellen, kann es sein, daß sich der gesuchte Satz +vor oder hinter der aktuellen Position befindet. In diesem Fall +müssen Sie entscheiden, ob Sie vorwärts oder rückwärts gehen. +Wenn Sie rückwärts gehen und der Satz ist nicht in diesem Ab­ +schnitt, erscheint der erste Satz mit der Anzeige 'SUCH-'. Gehen Sie +dann wieder vorwärts, finden Sie den Satz auf jeden Fall. + Die Funktion 'Satz.Nr' richtet sich natürlich nicht nach der +eingestellten Bedingung, da Sie ja eine bestimmte Satznummer wün­ +schen. Aus der 'SUCH'-Anzeige können Sie jedoch entnehmen, ob +die Suchbedingung auf diesen Satz zutrifft. + +#a ("Suchbedingung löschen")# Wollen Sie wieder alle Sätze sehen, müssen +Sie die Funktion +#free (0.2)# +#beispiel# + Suchbedingung + L Löschen +#text# +#free (0.2)# +auswählen. Die Anzeige 'SUCH' verschwindet wieder, um anzudeu­ +ten, daß keine Suchbedingung mehr eingestellt ist. + +#a ("Beispiel")# Um den Charakter einer Selektion nochmal deutlich zu +machen, sollen Sie jetzt eine Bedingung einstellen, die auf mehrere +Sätze zutrifft. Dies hätte uns auch eben passieren können, wenn es +mehrere Simmern gegeben hätte. Wir können zum Beispiel alle weib­ +lichen Personen auswählen. + Als erstes löschen Sie die alte Suchbedingung. Tun Sie dies +nicht, wird Ihnen beim nächsten Eingeben das alte Suchmuster zum +Ändern angeboten. Dies ist praktisch, wenn ein Suchmuster nicht +den erhofften Erfolg brachte und Sie es modifizieren wollen. + Danach wählen Sie erneut die Funktion 'Suchbedingung setzen'. +Nun bewegen Sie den Cursor mit der Pfeiltaste UNTEN neben den +Feldnamen 'm/w'. Dort tragen Sie die Bedingung 'w' ein. Verlassen +Sie die Eingabe mit ESC 'q'. + Wenn Sie sich jetzt in der Datei bewegen, sehen Sie, daß immer +nur weibliche Personen angezeigt werden - die männlichen werden +unterdrückt (in Umkehrung der Realität). + +#beispiel# + ! 1 ! ! 3 ! 4 ! ! 6 ! + +-----+-----+-----+-----+-----+-----+-----+ + !Name ! .. ! ! .. ! .. ! ! .. ! + ! ! ! ! ! ! ! ! + : : : : : + ! ! ! ! ! ! ! ! + !m/w ! w ! ! w ! w ! ! w ! + +-----+-----+ +-----+-----+ +-----+ + +#center#Abb. 5-3 Wirkung einer Selektion +#text# + + +#abschnitt ("5.4", "SUCHBEDINGUNGEN", "Suchbedingungen")# + +Im letzten Abschnitt haben Sie gesehen, wie das Einstellen einer +Suchbedingung funktioniert. In diesem Abschnitt sollen Sie weitere +Möglichkeiten zur Formulierung von Suchmustern kennenlernen. + Die erste Möglichkeit kennen Sie schon. Wenn neben einen +Feldnamen ein Text geschrieben wird, bedeutet dies, daß ausge­ +wählte Sätze im Inhalt dieses Feldes mit dem Text übereinstimmen +müssen. + +#a ("Kombination")# Nun kann es sein, daß mehrere Bedingungen gelten +müssen. Im ersten Beispiel des vorigen Abschnitts hätten wir zum +Beispiel auch noch den Vornamen 'Anna-Maria' angeben können, um +bei mehreren Simmern die richtige auszuwählen. Wird also in mehre­ +re Felder eine Bedingung geschrieben, müssen alle diese Bedingun­ +gen gleichzeitig zutreffen. + Würden Sie in unserem Beispiel noch als dritte Bedingung 'm' +für das Feld 'm/w' angeben, würde gar kein Satz mehr ausgewählt, +da Anna-Maria Simmern natürlich nicht männlich ist. Auch das +kann also passieren. + +#beispiel# + Name Simmern + Vorname Anna-Maria + .. + .. + m/w m + +#center#Abb. 5-4 Kombination von Bedingungen +#text# + +#a ("Stern")# Die Bedingungen, die wir bis jetzt kennengelernt haben, +müssen alle ganz exakt zutreffen. Häufig tritt aber der Fall auf, +daß der gesuchte Name nicht genau bekannt ist. In diesem Fall +kann der Name im Suchmuster auch teilweise eingegeben werden. +Der unbekannte Teil am Anfang oder am Ende wird einfach durch +einen Stern markiert. + Wenn Sie also als Bedingung #bsp ("'Sim*'")# für den Namen angeben, so +würde dies auf den Namen Simmern zutreffen, aber zum Beispiel +auch auf Simmerath oder Simon. Die Bedingung #bsp("'*mern'")# würde nicht +nur auf Simmern zutreffen, sondern auch auf Pommern. + Der Stern kann aber auch für einen leeren Text stehen. So +trifft #bsp("'Simmern*"')# auf Simmern zu, aber auch auf Doppelnamen. die +mit Simmern beginnen. Wissen Sie jetzt nicht, ob Simmern in dem +Doppelnamen vorne oder hinten erscheint, können Sie auch an bei­ +den Seiten einen Stern machen. Die Bedingung #bsp("'*Simmern*'")# trifft +nicht nur auf Simmern, sondern sowohl auf Deckerath-Simmern als +auch auf Simmern-Jakob zu. + Es gibt noch eine Reihe von weiteren Möglichkeiten, Bedingun­ +gen im Suchmuster zu formulieren. Auch komplexe Kombinationen +von Bedingungen sind möglich. Mit dem bisher Besprochenen sollten +Sie aber in vielen Fällen auskommen. Die übrigen Möglichkeiten +werden in Abschnitt 10.2 erklärt. Schauen Sie bei Bedarf dort nach. + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.6 b/app/eudas/4.4/doc/user-manual/eudas.hdb.6 new file mode 100644 index 0000000..fc752a1 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.6 @@ -0,0 +1,382 @@ +#type ("prop")##limit (14.0)# +#format# +#page (51)# +#kapitel ("6", "Daten", "eingeben und", "ändern")# + + + +#abschnitt ("6.1", "NEUE DATEI EINRICHTEN", "Neue Datei einrichten")# + +Nachdem Sie sich bis jetzt an einer existierenden Datei erprobt +haben, können Sie nun dazu übergehen, eine eigene neue Datei +einzurichten. Als Beispiel sollen Sie ein kleines Telefonregister +erstellen. + Dazu gehen Sie wieder in das Menü 'Öffnen' zurück und wäh­ +len erneut die Funktion +#free (0.2)# +#beispiel# + O Öffnen +#text# +#free (0.2)# +indem Sie mehrmals OBEN tippen, bis die Funktion markiert. Dann +tippen Sie die Lerrtaste zum Ausführen. Als Dateinamen geben Sie +'Telefonnummern' an. + Da die Datei 'Telefonnummern' noch nicht existiert, werden Sie +gefragt: +#f2# +#beispiel# + "Telefonnummern" neu einrichten ? (j/n) #on("i")#j#off("i")# +#text# +#f2# +Es kann ja sein, daß Sie sich vertippt haben und eine andere, +existierende Datei meinten. In unserem Fall wird die Datei aber +wirklich neu eingerichtet, daher bejahen Sie die Frage. + +#a ("Feldnamen eingeben")# Wenn Sie beim Öffnen eine Datei neu einrich­ +ten, müssen Sie zuerst die Feldnamen festlegen, zum Beispiel diese: + +#beispiel# + 'Name' + 'Vorname' + 'Strasse' + 'PLZ' + 'Ort' + 'Telefon' + 'Bemerkungen' +#text# + +Ihnen wird jetzt Gelegenheit gegeben, die Feldnamen untereinander +einzugeben. Zur Korrektur können Sie die gleichen Tasten verwen­ +den wie im Editor (beachten Sie dazu die Statuszeile am oberen +Bildschirmrand. + Geben Sie die Namen in dieser Reihenfolge ein. Tippen Sie nach +jedem Namen die RETURN-Taste, damit der nächste Name in eine +neue Zeile kommt. Beenden Sie die Eingabe mit ESC 'q'. + Die folgende Frage ermöglicht es Ihnen, noch weitere Eigen­ +schaften der Felder festzulegen. Dies ist jedoch im Normalfall nicht +nötig. Beantworten Sie also die Frage mit 'n'. Ihre Datei ist nun +eingerichtet. + Wie Sie sehen, besteht das Einrichten einer Datei eigentlich +nur aus der Eingabe der Feldnamen. Wenn Sie später noch Felder +anfügen wollen, ist dies ohne weiteres möglich. + + +#abschnitt ("6.2", "SÄTZE EINFÜGEN", "Sätze Einfügen")# + +Nachdem die Datei nun eingerichtet worden ist, sollen Sie zunächst +einige Sätze eingeben. Wenn Sie wieder das Menü 'Einzelsatz' an­ +wählen, sehen Sie nur den leeren Satz mit der Anzeige 'ENDE', der +das Dateiende markiert. Um neue Sätze aufzunehmen, gibt es die +Funktion +#free (0.2)# +#beispiel# + E Einfügen +#text# +#free (0.2)# +Wenn Sie diese Funktion aufrufen, geschieht etwas Ähnliches wie +beim Eingeben des Suchmusters. Der Cursor wandert wieder hinter +den ersten Feldnamen und in der Statuszeile erscheint die Auffor­ +derung +#f2# +#bildschirm# +___________________________________________________________________________________________ + + SATZ EINFUEGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ? +___________________________________________________________________________________________ +#text# + +Sie können nun die Feldinhalte der einzelnen Felder neben die +entsprechenden Feldnamen schreiben. Mit der RETURN-Taste schlie­ +ßen Sie eine Zeile ab und gelangen in die nächste. + Um eventuelle falsche Eingaben zu korrigieren, können Sie +ähnlich wie im Editor mit den Pfeiltasten herumfahren und falsche +Eingaben überschreiben. Die Taste RUBOUT löscht falsche Zeichen. +Sie beenden die Eingabe mit ESC 'q'. Anschließend ist der neue Satz +vorhanden. + +#beispiel# +#free (4.5)# + +#center#Abb. 6-1 Einfügen +#text# + +#a ("Wirkung")# Die Wirkungsweise der Funktion 'Einfügen' verdeutlicht +die Abb. 6-1. Dargestellt ist ein Ausschnitt aus einer Datei mit den +Sätzen 4 bis 7 und durch Buchstaben dargestellten, beliebigen In­ +halten. Satz 6 sei der aktuelle Satz. + Beim Einfügen wird nun vor dem aktuellen Satz eine Lücke für +den neuen Satz geschaffen, die zunächst noch leer ist und dann von +Ihnen ausgefüllt werden muß. Die Satznummern aller folgenden Sätze +erhöhen sich um 1. + Die Leerstelle bleibt nur dann erhalten, wenn Sie Daten für den +neuen Satz eingeben. Anderenfalls wird nach ESC 'q' wieder der alte +Zustand hergestellt. + Dieses Verfahren erklärt auch, warum das Ende der Datei ein +leerer Pseudosatz ist. Um nämlich am Ende der Datei einen neuen +Satz anzufügen, muß man vor dem Endesatz einen Satz einfügen. + Nachdem Sie also jetzt den ersten Satz eingegeben haben, +müssen Sie sich wieder zum Ende bewegen, damit der nächste Satz +hinter dem ersten steht. Für diesen häufig benötigten Vorgang gibt +es eine Abkürzung: Wenn Sie die Eingabe mit ESC 'w' (Weiter) statt +ESC 'q' beenden, geht EUDAS nach dem Einfügen des Satzes weiter +zum nächsten und fügt dort wieder einen Satz ein. + Auf diese Weise können Sie also schnell eine ganze Reihe von +Sätzen nacheinander eingeben. Nachdem Sie einen Satz eingegeben +haben, tippen Sie ESC 'w' und können gleich anschließend schon mit +der Eingabe des nächsten Satzes beginnen. Alle so eingegebenen +Sätze erscheinen nachher in der Reihenfolge der Eingabe. + +#a ("Satzeditor")# Bei der Eingabe eines neuen Satzes haben Sie nahezu +alle Möglichkeiten, die auch der EUMEL-Editor bietet. Der be­ +schreibbare Bereich ist jedoch kleiner. Er umfaßt das ganze Gebiet, +in dem sonst die Feldinhalte erscheinen. + Wie beim Editor können Sie den Cursor mit den Cursortasten +(Pfeiltasten) bewegen. Mit der Taste RUBOUT können Sie ein Zeichen +löschen. Die restlichen Zeichen der Zeile rücken dann nach. Mit +RUBIN dagegen schalten Sie in einen Einfügemodus um. Alle einge­ +gebenen Zeichen werden dann eingefügt - der Rest der Zeile rückt +entsprechend nach rechts. Nochmaliges Tippen von RUBIN schaltet +wieder in den alten Modus. Welcher Modus eingeschaltet ist, steht +in der Überschriftzeile. + Mit der Kombination ESC RUBOUT können Sie den Rest einer +Zeile ab der Cursorposition löschen. Steht der Cursor in der ersten +Spalte, wird dementsprechend die ganze Zeile gelöscht. Im Unter­ +schied zum EUMEL-Editor rücken die folgenden Zeilen jedoch nicht +herauf. + Entsprechend fügen Sie mit der Funktion ESC RUBIN eine neue +Zeile ein. Dies ist immer dann erforderlich, wenn ein Feldinhalt +nicht auf eine Zeile paßt. Der Teil der Zeile, der hinter dem Cursor +steht, wird bei ESC RUBIN in die neue Zeile mitgenommen. + Normalerweise tippen Sie ESC RUBIN, wenn Sie an das Ende +einer Zeile kommen. Wenn Sie aber weiterschreiben, wird die Zeile +einfach gerollt. Dies ist nicht weiter schlimm, aber Sie können den +ganzen Feldinhalt nicht auf einmal sehen. + In der normalen Anzeige wird ein überlanger Inhalt auf jeden +Fall auf mehrere Zeilen verteilt. + +#a ("Warnung")# Ein Hinweis für alle, die sich mit der Editorbedienung +schon auskennen: EUDAS benutzt den Editor als Unterprogramm. +Jedoch haben einige Editorfunktionen unliebsame Auswirkungen. +Besonders gefährlich sind hier HOP RUBOUT und HOP RUBIN. Diese +Funktion zerstören die Korrespondenz zwischen Feldnamen und +Feldinhalten, das heißt der Feldinhalt steht nicht mehr neben dem +Feldnamen. + Weiterhin können Sie das Editorbild rollen, ohne daß die Feld­ +namen mitrollen (zum Beispiel wenn Sie in der untersten Zeile +RETURN drücken). In diesem Fall ist die Korrespondenz auch nicht +erhalten, das heißt die Inhalte stehen falsch, sind aber eigentlich +richtig. + In solchen Fällen erscheint am oberen oder unteren Rand der +Hinweis #bsp("""Bitte ESC '1' druecken""")#. Wenn das Editorbild nur gerollt +wurde, verschwindet durch ESC '1' der Hinweis wieder und das Bild +ist in Ordnung. Wenn jedoch Zeilen gelöscht oder eingefügt wurden, +müssen Sie diese Änderungen von Hand wieder rückgängig machen, +bis der Hinweis verschwindet. Sie sollten also HOP RUBOUT und HOP +RUBIN im Satzeditor nicht verwenden. + Im Zweifelsfall, wenn Sie meinen, den Satz durcheinanderge­ +bracht zu haben, können Sie immer mit ESC 'h' abbrechen. Es steht +dann der vorherige Zustand für einen neuen Versuch zur Verfügung. + + +#abschnitt ("6.3", "DATEN ÄNDERN", "Daten ändern")# + +Wenn Sie nachträglich noch eingegebene Daten ändern wollen, kön­ +nen Sie die Funktion +#free (0.2)# +#beispiel# + A Ändern +#text# +#free (0.2)# +verwenden. Sie haben anschließend wie beim Einfügen Gelegenheit, +neue Daten einzugeben. Allerdings werden Ihnen die bisherigen +Daten gleich mit angeboten, so daß Sie nur die Änderungen ein­ +geben müssen. Alles andere kann unverändert bleiben. Auch diese +Funktion wird mit ESC 'q' verlassen. ESC 'w' funktioniert beim +Ändern ebenfalls (der nächste Satz wird zum Ändern angeboten). + Stellen Sie beim Ändern oder Einfügen fest, daß Sie irgendeinen +krassen Fehler gemacht haben, können Sie die Operation mit ESC 'h' +abbrechen. Beim Ändern bleibt dann der alte Zustand unverändert, +beim Einfügen wird kein Satz eingefügt. + +#a ("Löschen")# Für den Fall, daß Sie einen Satz wieder ganz aus der +Datei löschen wollen, hat EUDAS eine besondere Vorsichtsmaßnahme +vorgesehen. Damit der Satz nicht gleich unwiederbringlich verloren­ +geht, müssen Sie ihn zunächst in eine andere Datei #on("i")#tragen#off("i")#. Falls +das Löschen ein Irrtum war, können Sie den Satz von dort noch +wiederholen. In vielen Fällen besteht ohnehin die Anforderung, daß +auch die nicht mehr aktuellen Daten noch eine gewisse Zeit aufge­ +hoben werden müssen. + Zum Tragen gibt es die Funktion +#f2# +#beispiel# + Datensatz + T Tragen +#text# +#f2# +Sie werden nach einem Dateinamen gefragt. Geben Sie hier zum +Beispiel 'müll' an. Da diese Datei noch nicht existiert, werden Sie +gefragt, ob Sie sie neu einrichten wollen (falls Sie sich vielleicht +verschrieben haben). Danach wird der aktuelle Satz in die Datei +'müll' transportiert. Am Bildschirm erscheint der nächste Satz. Der +getragene Satz kommt an das Ende der Zieldatei. + Eine Bedingung beim Tragen ist, daß die Zieldatei immer die +gleichen Felder haben muß wie die aktuelle Datei. Sie können also +nicht aus verschieden strukturierten Dateien in die gleiche Datei +tragen. + Zum Zurückholen eines Satzes benutzen Sie die Funktion +#f2# +#beispiel# + Datensatz + H Holen +#text# +#f2# +Der letzte Satz der Datei, die Sie angeben, wird vor dem aktuellen +Satz eingefügt. Dadurch wird der Effekt des letzten Tragens wieder +aufgehoben. + Um die getragenen Sätze endgültig zu vernichten, müssen Sie +die Zieldatei als Ganzes löschen. Die dazu notwendige Funktion aus +dem Menü 'Dateien' haben Sie bereits in Abschnitt 4.4 kennenge­ +lernt. + + +#abschnitt ("6.4", "ARBEITSKOPIE SICHERN", "Arbeitskopie sichern")# + +Wenn Sie eine Datei zum Ändern öffnen oder sie gerade neu einge­ +richtet haben, wird von dieser Datei intern eine Arbeitskopie ange­ +legt, die dann geändert wird. Sie müssen diese Arbeitskopie nach +den Änderungen sichern, damit die Änderungen wirksam werden. + In unserem Beispiel ist die Datei "Telefonnummern" immer noch +leer. Die Änderungen sind momentan nur in der internen Kopie +vorhanden. Wenn Sie die Datei zum Beispiel auf eine Archivdiskette +schreiben wollten, würden Sie eine leere Datei auf der Diskette +haben. + Zum Sichern rufen Sie die Funktion +#free (0.2)# +#beispiel# + S Sichern +#text# +#free (0.2)# +im ersten Menü auf. Es erscheint dann folgende Frage: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + Arbeitskopie "Telefonnummern" veraendert! Sichern (j/n) ? +___________________________________________________________________________________________ +#text# + +Beantworten Sie diese Frage mit 'j'. Als nächstes wird gefragt: +#f2# +#bildschirm# +___________________________________________________________________________________________ + + Alte Version überschreiben (j/n) ? +___________________________________________________________________________________________ +#text# + +Beantworten Sie auch diese Frage mit 'j'. Die Arbeitskopie über­ +schreibt dann die (leere) Version vor dem Ändern. + Wenn Sie die Frage verneint hätten, könnten Sie anschließend +einen neuen Namen für die Arbeitskopie angeben. Dies wäre dann +sinnvoll, wenn Sie den Stand vor den Änderungen noch aufbewahren +wollen. In diesem Fall ist es jedoch nutzlos, die alte leere Datei +noch behalten zu wollen. + Abschließend wird gefragt, ob Sie die Arbeitskopien löschen +wollen. Wenn Sie noch weiter mit der Datei arbeiten wollen, vernei­ +nen Sie diese Frage. Die Datei bleibt dann geöffnet. Anderenfalls +müßten Sie die Datei neu öffnen, wenn Sie sie wieder ansehen wol­ +len. + +#a ("Arbeitskopien")# Es ist sehr wichtig, daß Sie sich die Funktionsweise +mit der Arbeitskopie immer vor Augen halten, damit Sie später bei +der Arbeit mit EUDAS nicht überrascht werden. + Eine Arbeitskopie wird immer dann angelegt, wenn Sie beim +Öffnen einer EUDAS-Datei angeben, daß Sie diese Datei ändern +wollen. In dem Beispiel haben Sie eine neue Datei eingerichtet. +EUDAS nimmt dann automatisch an, daß Sie ändern wollen. Öffnen +Sie eine existierende Datei, werden Sie gefragt +#f2# +#bildschirm# +___________________________________________________________________________________________ + + Wollen Sie etwas ändern (Arbeitskopie anlegen) (j/n) ? +___________________________________________________________________________________________ +#text# + +Wenn Sie diese Frage verneinen, wird keine Arbeitskopie angelegt; +alle Änderungsfunktionen werden jedoch gesperrt. Daran können Sie +auch erkennen, daß keine Arbeitskopie vorliegt. + Die Arbeitskopie, die EUDAS sich anlegt, ist anonym. Wenn Sie +sich also im Menü 'Dateien' eine Übersicht zeigen lassen, erscheint +nur das Original. Bevor Sie mit diesem Original etwas anstellen +(zum Beispiel auf Archiv schreiben), sollten Sie sich vergewissern, +daß Sie die Arbeitskopie gesichert haben, da das Original sonst +nicht auf dem neuesten Stand ist. + Um Sie in diesem Fall zu warnen, erscheint vor einer geöffneten +Datei in einer Dateiauswahl das Symbol #bsp ("")#, zum Beispiel: + +#beispiel# + o "Telefonnummern" + o "Mitglieder" +#text# + +Wenn Sie dieses Symbol sehen, sollten Sie die Datei lieber erst +sichern, bevor Sie etwas mit ihr anstellen. + +#a ("Beispiel")# Um die Arbeitsweise von EUDAS noch besser zu verstehen, +betrachten Sie das Beispiel in Abb. 6-2. Nehmen Sie an, Sie haben +drei EUDAS-Dateien 'Kalender', 'Namen' und 'Adressen' mit ihren +Anfangsinhalten K0, N0 und A0 (symbolisch). In dem Diagramm sind +die Vorgänge zu den Zeitpunkten 0 bis 10 mit ihren Auswirkungen +auf die Inhalte der Dateien und der Arbeitskopie dargestellt. + +#beispiel# +#free (5.5)# +#center#Abb. 6-2 Beispiel zur Arbeitskopie +#text# + +Zu den einzelnen Zeitpunkten passiere folgendes: + +0: Anfangszustand. Es wurde noch keine Datei geöffnet, also ist + keine Arbeitskopie vorhanden. Es könnte aber auch eine + beliebige Datei ohne Änderungserlaubnis geöffnet sein. +#free (0.2)# +1: Die Datei 'Adressen' wird geöffnet zum Ändern. Der momen­ + tane Zustand der Datei wird als Arbeitskopie übernommen. +#free (0.2)# +2: Es wird eine Änderung vorgenommen (zum Beispiel) ein Satz + eingefügt). Diese Änderung betrifft aber nur die Kopie - die + Datei 'Adressen' als Original bleibt unverändert. +#free (0.2)# +3: Eine weitere Änderung führt zum Inhalt A2 der Arbeitsko­ + pie. +#free (0.2)# +4: Aufruf von 'Sichern'. Die alte Version von 'Adressen' wird + überschrieben und durch den Inhalt A2 ersetzt. Die Frage + nach dem Löschen der Arbeitskopie wird verneint; daher bleibt + die Kopie auch erhalten. +#free (0.2)# +5: Die Kopie wird erneut verändert. +#free (0.2)# +6: Aufruf von 'Sichern'. Die Frage, ob die Kopie gesichert wer­ + den soll, wird verneint. Die Arbeitskopie soll jedoch gelöscht + werden. Als Ergebnis geht die Änderung A3 verloren (viel­ + leicht war diese Änderung ein Irrtum). Die Datei 'Adressen' + wird nicht verändert. Es ist keine Arbeitskopie mehr vor­ + handen. +#free (0.2)# +7: Die Datei 'Namen' wird zum Ändern geöffnet. +#free (0.2)# +8: Die Datei 'Kalender' wird zum Ändern geöffnet. Da an der + vorigen Arbeitskopie keine Änderungen vorgenommen wurden, + kann die Kopie einfach überschrieben werden. Anderenfalls + wäre an dieser Stelle die Möglichkeit zum Sichern angeboten + worden. +#free (0.2)# +9: Es wird eine Änderung durchgeführt. +#free (0.2)# +10: Die geänderte Arbeitskopie wird gesichert, das Original über­ + schrieben und die Arbeitskopie gelöscht (Normalfall). + + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.7 b/app/eudas/4.4/doc/user-manual/eudas.hdb.7 new file mode 100644 index 0000000..67f635d --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.7 @@ -0,0 +1,665 @@ +#type ("prop")##limit (14.0)# +#format# +#page (61)# +#kapitel ("7", "Ausdrucken", "der", "Daten")# + + + +#abschnitt ("7.1", "DRUCKMUSTER", "Druckmuster")# + +Nachdem Sie sich die Inhalte der EUDAS-Datei ausgiebig am Bild­ +schirm angesehen haben, möchten Sie die gespeicherten Daten sicher +auch in gedruckter Form auf Papier sehen. Sie können eine +EUDAS-Datei jedoch nicht ohne weiteres ausdrucken, da sie eine +andere Struktur als normale Textdateien hat. + Vor dem Drucken müssen also die Inhalte der EUDAS-Datei +zunächst in lesbarer Form in eine Textdatei geschrieben werden. +EUDAS kann diese Aufgabe jedoch ohne Ihre Hilfe nicht alleine be­ +wältigen. + Es taucht nämlich das Problem auf, daß die Dateiinhalte in +vielen verschiedenen Formen dargestellt werden können (Sie erin­ +nern sich sicher noch an das erste Kapitel). Vielleicht wollen Sie +bestimmte Überschriften haben oder die Daten müssen auf ein be­ +stimmtes Formular passen. + Um die Ausgabe nach Ihren Wünschen zu gestalten, müssen Sie +also dem Rechner genau angeben, an welcher Stelle welche Felder +gedruckt werden sollen usw. Dies geht am einfachsten, indem Sie +dem Rechner ein Muster vorsetzen, nach dem er dann die richtigen +Ausdrucke erstellen kann. Dieses Muster schreiben Sie in eine eige­ +ne Textdatei, die #on("i")#Druckmuster#off("i")# genannt wird. Aus den Daten der +EUDAS-Datei und der Form, die im Druckmuster angegeben ist, wird +dann eine weitere Textdatei erzeugt, die die Daten in der ge­ +wünschten Form enthält und die anschließend automatisch gedruckt +werden kann. + Durch ein Druckmuster erhalten Sie fast völlige Freiheit in der +Gestaltung Ihrer Ausdrucke. Zum Beispiel können aus einer einzigen +Adressendatei einfache Listen, Einladungskarten oder Rundbriefe +erzeugt werden. Für eine einfache Adressenliste entspricht das +Druckmuster einer Zeile der Liste, wobei angegeben wird, in welche +Spalten die Inhalte gedruckt werden. Zum Drucken von Einladungs­ +karten wird als Druckmuster eine Einladungskarte verwendet, in der +die Stellen markiert sind, an denen die Adresse erscheinen soll. Das +gleiche kann man mit einem Brief machen, der dann mit jeder +Adresse einmal ausgedruckt wird. + +#a ("Druckverfahren")# Man kann sich diesen Druckprozeß wie folgt vor­ +stellen: + +#beispiel# +#free (6.5)# + +#center#Abb. 7-1 Druckverfahren +#text# + +Vereinfacht gesagt (das genaue Verfahren wird später beschrieben) +wird für jeden Satz der EUDAS-Datei das Druckmuster einmal in die +Druckdatei übernommen. Dabei werden die Inhalte aus der EUDAS- +Datei in einer noch anzugebenden Weise an den gewünschten Stellen +eingefügt. + Im weiteren sollen Sie erfahren, wie ein Druckmuster genau +aussieht und wie daraus ein Ausdruck entsteht. + +#a ("Beispiel")# Im folgenden sollen Sie zur Demonstration die bereits in +Kapitel 3 und 4 beschriebene Beispieldatei verwenden. Nach Mög­ +lichkeit sollten Sie die angegebenen Beispiele mit dieser Datei +selbst am Rechner ausprobieren. + +Folgende Sätze befinden sich in der Datei: + +#beispiel# + Vorname Name, Strasse, PLZ Ort, m/w + ------------------------------------------------------- + Herbert Wegner, Krämergasse 12, 5000 Köln, m + Helga Sandmann, Willicher Weg 109, 5300 Bonn 1, w + Albert Katani, Lindenstr. 3, 5210 Troisdorf, m + Peter Ulmen, Mozartstraße 17, 5 Köln 60, m + Karin Regmann, Grengelweg 44, 5000 Köln 90, w + Hubert Arken, Talweg 12, 5200 Siegburg, m + Anna-Maria Simmern, Platanenweg 67, 5 Köln 3, w + Angelika Kaufmann-Drescher, Hauptstr. 123, 53 Bonn 2, w + Harald Fuhrmann, Glockengasse 44, 5000 Köln 1, m + Friedrich Seefeld, Kabelgasse, 5000 Köln-Ehrenfeld, m +#text# + +Wie Sie sehen, wurde die Reihenfolge der Felder gegenüber der Datei +teilweise verändert und Name und Vorname ohne Komma hinterein­ +andergeschrieben, während die anderen Feldinhalte durch Komma +getrennt sind. Diese Liste wurde unter Verwendung eines Druck­ +musters erzeugt. + Da dieses Druckmuster jedoch vorerst noch zu kompliziert ist, +sollen Sie erst einmal ein einfacheres Druckmuster erstellen und +versuchen, nur die Namen aus der Datei in Tabellenform auszuge­ +ben. + Das dafür nötige Druckmuster hat folgendes Aussehen: + +#beispiel# + % WIEDERHOLUNG + ! &Name ! &Vorname ! +#text# + +Das Druckmuster besteht nur aus zwei Zeilen, von der die zwei­ +te das eigentliche Muster darstellt. Die erste Zeile ist eine #on("i")# Anwei­ +sung#off("i")# an den Druckgenerator. 'WIEDERHOLUNG' gibt an, daß die +folgenden Zeilen für jeden Satz wiederholt werden sollen (warum +diese Angabe notwendig ist, werden Sie später einsehen). Das Pro­ +zentzeichen kennzeichnet eine Anweisung und muß unbedingt in der +ersten Spalte des Druckmusters stehen, also ganz am linken Rand. + In der zweiten Zeile ist zu sehen, daß das Zeichen '&' dazu +benutzt wird, die Stellen zu markieren, an denen nachher Feldin­ +halte eingesetzt werden sollen. Hinter dem '&'-Zeichen folgt der +Name des Feldes, das an dieser Stelle eingesetzt werden soll. Eine +solche Konstruktion wird #on("i")#Feldmuster#off("i")# genannt. Beachten Sie, daß +Feldnamen hier immer ohne Anführungsstriche geschrieben werden +müssen. Die Ausrufungszeichen bilden den eigentlichen Mustertext +und werden unverändert als Tabellenbegrenzung in die Ausgabe +übernommen. + Als Ergebnis des Druckprozesses sollte folgende Ausgabe auf +dem Drucker erscheinen: + +#beispiel# + ! Wegner ! Herbert ! + ! Sandmann ! Helga ! + ! Katani ! Albert ! + ! Ulmen ! Peter ! + ! Regmann ! Karin ! + ! Arken ! Hubert ! + ! Simmern ! Anna-Maria ! + ! Kaufmann-Drescher ! Angelika ! + ! Fuhrmann ! Harald ! + ! Seefeld ! Friedrich ! +#text# + +Sie können erkennen, daß die Feldmuster in der Ausgabe jeweils +durch den Inhalt des zugehörigen Feldes ersetzt worden sind. Der +übrige Text in der Musterzeile ist unverändert geblieben. Beachten +Sie, daß das '&' ein reserviertes Zeichen ist, das ein Feldmuster im +umgebenden Text kennzeichnet und daher (vorerst) nicht gedruckt +werden kann. + + +#abschnitt ("7.2", "AUFRUF", "Aufruf")# + +In diesem Abschnitt sollen Sie erfahren, wie Sie diese Ausgabe +selbst erzeugen können. Damit der Druckgenerator arbeiten kann, +müssen Sie die Datei 'Adressen' erst einmal öffnen. Anschließend +wählen Sie das Menü 'Drucken' an. + +#a ("Druckmuster erstellen")# Als nächstes müssen Sie das Druckmuster +erstellen. Hierfür gibt es die Funktion +#free (0.2)# +#beispiel# + Textdatei + E Editieren +#text# +#free (0.2)# +da das Druckmuster eine normale Textdatei ist. + Wählen Sie diese Funktion. Sie werden dann nach einem Namen +für das Druckmuster gefragt. Wir wollen das Druckmuster 'Namens­ +liste' nennen - Sie können aber auch einen beliebigen anderen +Namen wählen. Denken Sie daran, die Anführungsstriche nicht mit +einzugeben. + Es erscheint anschließend das gewohnte Editorbild mit einer +entsprechenden Statuszeile. Geben Sie die zwei Zeilen des Druck­ +musters ein und beenden Sie den Editor mit ESC 'q'. Damit ist das +Druckmuster fertig. + + Die hier beschriebene Funktion können Sie nicht nur zum Er­ +stellen, sondern auch zum Ändern und einfachen Ansehen eines +Druckmusters bzw. einer Textdatei allgemein verwenden. Es wird +Ihnen immer der jeweilige Inhalt präsentiert, den Sie dann nach +Belieben abändern können oder nicht. + +#bildschirm# +___________________________________________________________________________________________ + + EUDAS: Öffnen Einzelsatz Gesamtdatei Drucken Dateien Archiv + --------------: + Satzauswahl : + D Drucken : + --------------: + Druckausgabe : + R Richtung : + --------------: + Textdatei : + E Editieren : + A Ausdrucken : + N Nachbearb. : + --------------: + +___________________________________________________________________________________________ +#beispiel# +#center#Abb. 7-2 Menü "Drucken" +#text# + +#a ("Ausgaberichtung")# Bevor Sie jetzt weitermachen, sollten Sie über­ +prüfen, ob an Ihrem System ein Drucker angeschlossen ist. Der +Drucker sollte bei den folgenden Versuchen betriebsbereit sein. + Ist kein Drucker angeschlossen oder wollen Sie kein Papier +verschwenden, haben Sie die Möglichkeit, den Ausdruck als Text­ +datei zu erhalten. Dazu wählen Sie die Funktion +#free (0.2)# +#beispiel# + Ausgabe + R Richtung +#text# +#free (0.2)# +an. Beantworten Sie beide Fragen, die Ihnen gestellt werden, mit +'n'. Die Ausgaben stehen dann nachher in Dateien mit einem Namen +der Form +#free (0.2)# +#beispiel# + Namensliste.a$n +#text# +#free (0.2)# +die Sie sich mit der oben beschriebenen Funktion dann genau wie +ein Druckmuster anschauen können. Der Name besteht also aus dem +Namen des Druckmusters, dem ein #bsp("'.a$'")# angehängt wird. Die Nummer +'n' dient zur Unterscheidung bei mehreren aufeinanderfolgenden +Ausgaben. Um Verwirrung zu vermeiden, sollten Sie die Datei nach +dem Anschauen löschen (im Menü 'Dateien'). + +#a ("Druckaufruf")# Wenn Sie diese Hinweise beachtet haben, können Sie +den Druckvorgang mit der Auswahl +#free (0.2)# +#beispiel# + Satzauswahl + D Drucken +#text# +#free (0.2)# +starten. Sie werden hier nach dem Namen des Druckmusters gefragt, +das Sie verwenden wollen (Sie können ja durchaus eine ganze Reihe +von verschiedenen Druckmustern haben). + Sie können den Ablauf des Druckvorganges daran verfolgen, +daß jeweils die Nummer des Satzes ausgegeben wird, der gerade +bearbeitet wird. Probieren Sie eventuell auch kleine Abwandlungen +des Druckmusters aus, indem Sie die Tabellenspalten schmaler oder +breiter machen oder die Ausrufungszeichen durch ein anderes Zei­ +chen ersetzen (je nach Geschmack). + +#a ("Ausgabedatei")# Wollen Sie die erzeugte Ausgabe (die in der Datei +'Namensliste.a$1' steht) irgendwann tatsächlich ausdrucken, ver­ +wenden Sie die Funktion +#free (0.2)# +#beispiel# + A Ausdrucken +#text# +#free (0.2)# +Sie werden dann nach dem Namen der Textdatei gefragt. Beachten +Sie, daß Sie diese Funktion #on("i")#nicht#off("i")# zum Drucken von EUDAS-Dateien +verwenden können, da aus einer EUDAS-Datei erst eine Druckdatei +erzeugt werden muß. + Auch wenn Sie angegeben haben, daß die Ausgabe des Druck­ +prozesses direkt ausgedruckt werden soll, startet Ihr Drucker erst, +wenn EUDAS die ganze Datei durchgegangen ist und der Vorgang für +Sie beendet ist. Dies liegt am EUMEL-System, das nur vollständige +Druckaufträge entgegennimmt, damit sich mehrere Benutzer nicht in +die Quere kommen können. In einem Multi-User-System können Sie +weiterarbeiten, während der Drucker beschäftig ist. + +#a ("Fehler")# Bevor der eigentliche Druckprozeß gestartet wird, wird das +Druckmuster auf unsinnige oder unverständliche Konstruktionen +überprüft. Ist dem Druckgenerator etwas suspekt, gibt er eine Feh­ +lermeldung aus, in der die fragliche Situation von seiner Seite aus +beschrieben wird. Er kann natürlich nicht Ihren Fehler "verstehen". +Daher müssen Sie unter Umständen eine Fehlermeldung erst inter­ +pretieren, ehe Sie die wahre Ursache erkennen können. + Damit Sie einen aufgetretenen Fehler gleich korrigieren können, +werden Ihnen das Druckmuster und die Fehlermeldungen parallel auf +dem Bildschirm zum Ändern und Anschauen angeboten. Sie können +mit dem Editor das Druckmuster ändern und in den Fehlermeldungen +blättern. Diese Konfiguration wird Paralleleditor genannt. Mit ESC +'w' wechseln Sie zwischen den beiden Bildschirmhälften. + +#a ("Suchbedingung")# Wollen Sie nicht alle Namen ausdrucken, so können +Sie vorher ein Suchmuster einstellen, das nur auf die gewünschten +Namen zutrifft (wie im Kapitel 5 beschrieben). Der Druckgenerator +richtet sich immer nach dem aktuell eingestellten Suchmuster und +druckt nur die ausgewählten Sätze. Wenn Sie zum Beispiel die Na­ +men aller Frauen ausdrucken wollen, stellen Sie im Tastenmodus ein +Suchmuster ein (das sollten Sie können), das für das Feld 'm/w' die +Bedingung 'w' enthält. Danach können Sie den Druckgenerator auf­ +rufen. Vergessen Sie nicht, das Suchmuster anschließend wieder zu +löschen. + +#a ("Feldnamen abfragen")# Wenn Sie selber ein Druckmuster erstellen, +wird es häufiger vorkommen, daß Sie die genaue Schreibweise der +Feldnamen nicht im Kopf haben. Für diesen Zweck definiert EUDAS +im Editor eine spezielle Tastenkombination. + Wenn Sie dort ESC 'F' tippen (großes 'F'), erhalten Sie eine +Auswahl aller Felder der gerade geöffneten Datei. Sie können sich +die Namen einfach ansehen, aber auch direkt in den Text des +Druckmusters übernehmen. + Wenn Sie nämlich vor dem Verlassen der Auswahl mit ESC 'q' +ein Feld ankreuzen, wird anschließend der Name in Anführungs­ +strichen an die Position geschrieben, an der vor dem Aufruf der +Cursor stand. Auf diese Weise können Sie sich auch das Tippen +langer Feldnamen vereinfachen. + Beachten Sie, daß Sie im Normalfall im Druckmuster die Anfüh­ +rungsstriche wieder entfernen müssen. Die Anführungsstriche dienen +zur Abgrenzung, wie weit der Feldname geht. Falls der Name Leer­ +zeichen enthält, beachten Sie bitte den Absatz 'Abgrenzung der +Feldnamen' in Abschnitt 7.4. + + +#abschnitt ("7.3", "ABSCHNITTE", "Abschnitte")# + +Die Tabellen, die Sie bis jetzt erzeugen können, sehen optisch noch +nicht sehr gut aus. Es fehlt auf jeden Fall eine vernünftige Über­ +schrift. Um eine Überschrift zu erzeugen, können Sie im Druckmuster +einen #on("i")#Vorspann#off("i")# definieren, der ganz zu Anfang einmal gedruckt +wird. + Dieser Vorspann wird durch die Anweisung +#f2# +#beispiel# + % VORSPANN +#text# +#f2# +eingeleitet (bitte nicht vergessen, daß das '%'-Zeichen für eine +Anweisung in der ersten Spalte stehen muß). Die folgenden Zeilen +bis zur 'WIEDERHOLUNG'-Anweisung gehören zum Vorspann. Ein +Druckmuster für unsere Namensliste mit Überschrift könnte dann so +aussehen: + +#beispiel# + % VORSPANN + Alle Namen aus der EUDAS-Datei 'adressen' + ----------------------------------------- + % WIEDERHOLUNG + ! &Name ! &Vorname ! +#text# + +Der Druckgenerator erzeugt mit diesem Druckmuster die gewünschte +Liste mit Überschrift. Sie können als Vorspann natürlich auch einen +beliebigen anderen Text verwenden. + In einer analogen Weise können Sie die Liste noch durch eine +waagerechte Linie abschließen, indem Sie einen #on("i")#Nachspann#off("i")# definie­ +ren. Die dafür notwendige Anweisung heißt +#f2# +#beispiel# + % NACHSPANN +#text# +#f2# +Die Zeilen nach dieser Anweisung werden gedruckt, nachdem alle +Sätze bearbeitet worden sind. Das folgende Druckmuster erzeugt +schon eine sehr schöne Liste: + +#beispiel# + % VORSPANN + Alle Namen aus der EUDAS-Datei 'adressen' + ----------------------------------------- + % WIEDERHOLUNG + ! &Name ! &Vorname ! + % NACHSPANN + ----------------------------------------- +#text# + +nämlich: + +#beispiel# + Alle Namen aus der EUDAS-Datei 'adressen' + ----------------------------------------- + ! Wegner ! Herbert ! + ! Sandmann ! Helga ! + ! Katani ! Albert ! + ! Ulmen ! Peter ! + ! Regmann ! Karin ! + ! Arken ! Hubert ! + ! Simmern ! Anna-Maria ! + ! Kaufmann-Drescher ! Angelika ! + ! Fuhrmann ! Harald ! + ! Seefeld ! Friedrich ! + ----------------------------------------- +#text# + +Die drei Teile, aus denen ein Druckmuster bestehen kann (Vorspann, +Nachspann und Wiederholungsteil), werden #on("i")#Abschnitte#off("i")# genannt. Wie +Sie später noch sehen werden, haben Abschnitte eine Reihe von +gemeinsamen Eigenschaften. Ein Abschnitt wird durch eine eigene +Anweisung eingeleitet und endet, wenn ein anderer Abschnitt be­ +ginnt oder das Druckmuster zu Ende ist. Alle Abschnitte können +auch weggelassen werden, irgendein Abschnitt muß aber immer +vorhanden sein. So ist es zum Beispiel möglich, ein Druckmuster zu +bauen, das nur aus einem Nachspann besteht (Sie werden allerdings +jetzt noch nicht verstehen können, warum so etwas sinnvoll sein +kann). + Zum Abschluß dieses Kapitels hier noch einmal eine Übersicht +der bisher vorgestellten Anweisungen: + +#beispiel# + Anweisung ! Bedeutung + ---------------+---------------------------------- + % VORSPANN ! leitet Vorspann ein + % WIEDERHOLUNG ! leitet Wiederholungsteil ein + % NACHSPANN ! leitet Nachspann ein +#text# + + +#abschnitt ("7.4", "FELDMUSTER", "Feldmuster")# + +Mit den bis jetzt beschriebenen Möglichkeiten des Druckgenerators +können Sie schon sehr viel anfangen. Es fehlt aber noch die Mög­ +lichkeit, mehrere Feldinhalte direkt hintereinander zu schreiben, +egal wie lang diese Inhalte sind. Diese Fähigkeit wird zum Beispiel +für die anfangs vorgestellte Liste benötigt. + +#a ("Variable Position")# Die Feldmuster, die Sie bis jetzt kennen, begin­ +nen mit einem '&'-Zeichen und werden immer genau an der Stelle +gedruckt, an der sie stehen (feste Position). Sie können ein Feld­ +muster aber auch mit '%' beginnen lassen. In diesem Fall kann der +Inhalt verschoben werden (variable Position), je nachdem, ob vorhe­ +rige Inhalte kürzer oder länger sind. + '%' ist wie '&' ein reserviertes Zeichen, kann also nicht direkt +gedruckt werden. Da '&' und '%' Feldmuster einleiten, heißen sie +#on("i")#Musterzeichen#off("i")#. + Um Feldmuster variabler Position einmal auszuprobieren, soll­ +ten Sie unser bisheriges Druckmuster in der folgenden Weise um­ +schreiben: + +#beispiel# + % WIEDERHOLUNG + &Vorname %Name +#text# + +(Vorspann und Nachspann der Einfachheit halber mal weggelassen). +Als Ergebnis erhalten wir: + +#beispiel# + Herbert Wegner + Helga Sandmann + Albert Katani + Peter Ulmen + Karin Regmann + Hubert Arken + Anna-Maria Simmern + Angelika Kaufmann-Drescher + Harald Fuhrmann + Friedrich Seefeld +#text# + +Das Feldmuster '%Name' ist also entsprechend der Länge des Vor­ +namens nach links oder nach rechts gerutscht. Zu beachten ist, daß +ein Feldmuster mit '%' nicht in der ersten Spalte stehen darf, denn +dann würde die Zeile als Anweisung angesehen. Ein Feldmuster +variabler Position wäre ja auch in der ersten Spalte wenig sinnvoll. + +#a ("Feste Länge")# Außer den beiden bisher besprochenen einfachen +Arten (mit '&' oder '%') gibt es noch weitere Ausprägungen von +Feldmustern für besondere Fälle. Wird ein Feldmuster noch von +weiteren Musterzeichen gefolgt, dann wird dieses Feldmuster immer +in der reservierten Länge eingesetzt. Die reservierte Länge reicht +vom ersten bis zum letzten Musterzeichen. Durch die zusätzlichen +Musterzeichen wird also ein bestimmter Platz freigehalten. + Ersetzt man im obigen Druckmuster '&Vorname' durch +'&Vorname&&', wird der Effekt des folgenden '%'-Feldes wieder +aufgehoben, da jetzt für alle Vornamen die gleiche Länge verwendet +wird (Probieren Sie dies aus). + Bei einem solchen Feldmuster mit fester Länge wird der Inhalt +abgeschnitten, falls er diese Länge überschreitet; ist der Inhalt +kürzer, wird rechts mit Leerstellen aufgefüllt. Aber auch bei Feld­ +mustern mit variabler Länge (also ohne folgende Musterzeichen) +kann abgeschnitten werden, nämlich genau dann, wenn der Inhalt so +lang ist, daß ein folgendes Feld mit fester Position (mit '&' anfan­ +gend) überschrieben würde. Hätten wir also in unserem ersten +Druckmuster nicht genügend Platz für die Spalten vorgesehen, +wären einige Namen abgeschnitten worden (probieren Sie es nochmal +aus, falls es Ihnen nicht schon passiert ist). + In einem weiteren Fall werden Feldmuster variabler Länge +abgeschnitten, nämlich wenn die generierte Zeile die maximale +Zeilenlänge überschreitet. Die maximale Zeilenlänge richtet sich +nach dem Dateilimit, das für das Druckmuster eingestellt ist. Nor­ +malerweise ist dies 77, so daß Sie in Normalschrift die Zeilenbreite +auf einem DIN A4-Blatt nicht überschreiten. + Benutzen Sie jedoch breites Papier oder eine schmale Schrift, +sollten Sie während der Eingabe des Druckmusters ESC ESC tippen +und das Kommando +#f2# +#beispiel# + limit (135) +#text# +#f2# +eingeben. EUDAS nutzt dann die volle Zeilenbreite aus. + +#a ("Rechtsbündig")# Sie sind jetzt aber noch nicht zu Ende mit den +Feldmustervariationen. Eine letzte Möglichkeit besteht darin, den +Inhalt rechtsbündig in ein Feldmuster einzusetzen. Dies hat natür­ +lich nur Sinn bei fester Länge. Man erreicht dies dadurch, daß man +das Feldmuster mit mehreren Musterzeichen beginnen läßt. So ist +#f2# +#beispiel# + %%Vorname% +#text# +#f2# +die rechtsbündige Version von +#f2# +#beispiel# + %Vorname%% +#text# +#f2# +Beide Feldmuster sind gleich lang, beim ersten wird jedoch am lin­ +ken Rand aufgefüllt oder abgeschnitten, beim zweiten dagegen am +rechten Rand. + +#a ("Zusammenfassung")# Hier noch einmal eine Zusammenstellung +aller möglichen Feldmustertypen: + +#beispiel# + Typ ! Beispiel ! Position ! Länge ! bündig + ----+-----------+------------------------------ + 1 ! &Name ! fest ! variabel ! links + 2 ! %Name ! variabel ! variabel ! links + 3 ! &Name&&& ! fest ! fest ! links + 4 ! %Name%%% ! variabel ! fest ! links + 5 ! &&&Name& ! fest ! fest ! rechts + 6 ! %%%Name% ! variabel ! fest ! rechts +#text# + +Wir können zusammenfassen: +#free (0.2)# +#bsp("*")# Feldmuster dienen im Druckmuster dazu, Stellen zu markieren, an + denen Inhalte eingesetzt werden sollen. +#free (0.2)# +#bsp("*")# Feldmuster beginnen mit einem Musterzeichen ('&' oder '%'); + darauf folgt der Feldname. +#free (0.2)# +#bsp("*")# Durch '&' wird feste und durch '%' variable Position festgelegt. +#free (0.2)# +#bsp("*")# Durch zusätzliche Musterzeichen kann eine feste Länge angege­ + ben werden; mehrere Musterzeichen am Anfang führen zu rechts­ + bündigem Einsetzen. + +#a ("Abgrenzung der Feldnamen")# Als nächstes sollen Sie den Fall be­ +trachten, daß Sie einen Namen in der oft auftretenden Form +#f2# +#beispiel# + Name, Vorname +#text# +#f2# +schreiben wollen. Die Schwierigkeit liegt in dem Komma, das direkt +hinter dem Namen folgen soll. Sie könnten versuchen, diese Situa­ +tion im Druckmuster folgendermaßen darzustellen: + +#beispiel# + % WIEDERHOLUNG + &Name, %Vorname +#text# + +In diesem Fall erhalten Sie aber die Fehlermeldung + +#beispiel# + FEHLER in Zeile 2 bei >>Name,<< + diese Abkuerzung ist nicht definiert +#text# + +Wenn Sie sich nicht genau vorstellen können, wie der Druckgenera­ +tor ein Feldmuster liest, wird Ihnen dieser Fehler mysteriös er­ +scheinen, denn 'Name' ist doch als Feld definiert (was eine Abkür­ +zung ist, werden Sie in Kapitel 13 lernen). Den entscheidenden +Hinweis liefert jedoch das Komma. Offensichtlich hat der Druck­ +generator das Komma als Teil des Feldnamens angesehen. + Dies liegt daran, daß ja irgendwann der Feldname in einem +Feldmuster beendet sein muß. Normalerweise interpretiert der +Druckgenerator ein Leerzeichen oder Musterzeichen als Ende des +Namens, alle vorherigen Zeichen gehören mit zum Feldnamen. Wenn +nun aber nach dem Feldmuster kein Leerzeichen folgen soll (wie in +unserem Beispiel) oder der Feldname selbst Leerzeichen enthält +(dies ist ja erlaubt, könnte aber im Druckmuster nie erkannt wer­ +den), muß noch eine zusätzliche Angabe erfolgen. + In solchen Fällen kann der Feldname in spitze Klammern einge­ +schlossen werden. Der Druckgenerator sieht den Feldnamen dann bei +der ersten schließenden Klammer als beendet an, wobei die Klam­ +mern natürlich nicht zum Feldnamen gehören, aber auch nicht ge­ +druckt werden. + Das obige Beispiel müßte also richtig so formuliert werden: + +#beispiel# + % WIEDERHOLUNG + &, %Vorname +#text# + +Wenn Sie dieses Druckmuster ausprobieren, werden Sie sehen, daß +die Namen tatsächlich in der gewünschten Form erscheinen. + +#a ("Leerautomatik")# Es gibt noch eine trickreiche Automatik in EUDAS, +die in manchen Fällen ganz nützlich ist - und zwar in Fällen, in +denen Sie mehrere Felder als Aufzählung durch Leerzeichen ge­ +trennt drucken wollen. Nehmen wir an, unsere Adreßdatei hätte +noch ein Feld 'Titel', in das Sie bei Bedarf 'Dr.' oder 'Prof. Dr.' +eintragen. In der Adresse würden Sie dann angeben: + +#beispiel# + &Titel %Vorname %Name +#text# + +Wenn der Titel jedoch leer ist, würde ein störendes Leerzeichen vor +dem Namen bleiben. In einem solchen Fall entfernt EUDAS das Leer­ +zeichen automatisch. Vorbedingung für diese Automatik ist, daß es +sich um ein Feld variabler Länge handelt und vor dem Feld noch ein +Leerzeichen steht (außer in Spalte 1). + +#a ("Aufgabe")# Sie sollten jetzt die Möglichkeiten des Druckgenerators +soweit kennengelernt haben, daß Sie ein Druckmuster für die zu +Anfang des Kapitels erwähnte Liste aller Dateiinhalte erstellen +können. Versuchen Sie dies zunächst allein, ehe Sie die Lösung +nachschauen. + + +Hier nun die Lösung: + +#beispiel# + % VORSPANN + Vorname Name, Strasse, PLZ Ort, m/w + ------------------------------------------------------- + % WIEDERHOLUNG + &Vorname %, %, %PLZ %, %m/w +#text# + +Beachten Sie die spitzen Klammern, die nötig sind, um das Kom­ +ma ohne Zwischenraum anzuschließen. + +#a ("Beispiel")# Als letztes Beispiel sollen Sie einen Fall betrachten, bei +dem pro Satz mehr als eine einzelne Listenzeile gedruckt werden +soll, und zwar sollen Sie einen Brief schreiben, in den der Druck­ +generator die Adressen verschiedener Leute einfügen soll. Die Er­ +stellung von Formbriefen ist eine sehr häufige Anwendung von +EUDAS. Mit den bisher beschriebenen Konstrukten kann man etwa +folgendes Druckmuster schreiben: + +#beispiel# + % WIEDERHOLUNG + &Vorname %Name + &Strasse + &PLZ %Ort + + Lieber &Vorname ! + + Ich lade Dich mit diesem Brief zu + meiner nächsten Party ein. + Bring gute Laune und was zu Essen mit. + + Viele Grüße + \#page\# +#text# + +Die letzte Zeile zeigt eine Möglichkeit, von der Sie wahrscheinlich +öfter Gebrauch machen werden, nämlich Druckersteuerungsanwei­ +sungen in das Druckmuster einzufügen. Die Anweisung '\#page\#' +wird an den Drucker weitergereicht und bewirkt, daß nach jedem +Brief eine neue Seite angefangen wird (Sie wollen sicher nicht +mehrere Briefe auf ein Blatt drucken). Sie können auch andere An­ +weisungen verwenden, z.B. neue Schrifttypen einstellen. Informieren +Sie sich gegebenenfalls, welche Anweisungen die Textkosmetik zur +Verfügung stellt. + +#a ("Ausblick")# Sie kennen jetzt bereits einen großen Teil der Möglich­ +keiten des Druckgenerators. Einige wünschenswerte Fähigkeiten +fehlen jedoch noch. So wäre es vorteilhaft, wenn abhängig vom +Inhalt des Feldes 'm/w' die Anrede 'Sehr geehrter Herr' oder 'Sehr +geehrte Frau' erzeugt werden könnte. Außerdem könnte das im +Rechner vorhandene Datum automatisch in den Brief übernommen +werden. Diese Möglichkeiten werden den Kapiteln 12 und 13 be­ +schrieben. + Sie sollten diese jedoch erst dann durchlesen, wenn Sie eine +gewisse Sicherheit im Umgang mit Druckmustern erlangt haben. +Zuvor sollten Sie die Inhalte dieses Kapitels beherrschen, damit Sie +EUDAS gut nutzen können. + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.8 b/app/eudas/4.4/doc/user-manual/eudas.hdb.8 new file mode 100644 index 0000000..3799dce --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.8 @@ -0,0 +1,187 @@ +#type ("prop")##limit (14.0)# +#format# +#page (75)# +#kapitel ("8", "Was war", "und was", "noch kommt")# + + + +#abschnitt ("8.1", "RÜCKBLICK", "Rückblick")# + +So! Wenn Sie bis hierhin gut mitgearbeitet haben, haben Sie die +erste und wichtigste Etappe beim Erlernen von EUDAS schon ge­ +schafft. Bevor Sie kennenlernen, was für Möglichkeiten Ihnen EUDAS +sonst noch bietet, wollen wir die wichtigsten Dinge rekapitulieren, +die Sie gelernt haben sollten. + +#a ("EUDAS-Dateien")# Sie sollten wissen, wie EUDAS-Dateien aussehen, +und daß sie sich von normalen Textdateien unterscheiden. Diese +Unterscheidung sollten Sie immer beachten, denn es gibt Funktio­ +nen, die nur EUDAS-Dateien annehmen (zum Beispiel 'Öffnen'), +andere, die nur Textdateien annehmen (zum Beispiel 'Textdatei +erstellen') und solche, die mit beliebigen Arten von Dateien "ohne +Ansehen der Person" funktionieren (zum Beispiel 'Kopieren vom +Archiv'). + +#a("Bedienung")# Sie sollten wissen, wie man eine Funktion im Menü +aufruft; wie Sie EUDAS die notwendigen Informationen (zum Beispiel +Dateinamen) mitgeben und wie Sie in besonderen Situationen (Feh­ +ler, Abbruch) reagieren können. Zur problemlosen Bedienung sollten +Sie auch die jeweilige Statuszeile interpretieren können. + +#a("Dateiverwaltung")# Sie sollten wissen, wie Sie Dateien von Archiv­ +disketten holen und dort auch wieder abspeichern können. Dazu ist +die Dateiauswahl durch Ankreuzen sehr hilfreich. Sie sollten von +Anfang an darauf achten, daß Sie Ihre Dateien regelmäßig auf dem +Archiv sichern, damit Sie bei etwaigen Problemen mit Ihrem Rechner +die Daten nicht verlieren. + +#a("Öffnen")# Sie sollten wissen, daß Sie eine EUDAS-Datei vor dem +Bearbeiten erst öffnen müssen. Weiterhin sollten Sie mit der Ar­ +beitskopie umgehen können, die EUDAS bei Änderungen anlegt. +Denken Sie daran, Ihre Datei nach Änderungen zu sichern. Sie soll­ +ten auch neue EUDAS-Dateien mit eigener Struktur anlegen können. + +#a("Ansehen und Ändern")# Sie sollten wissen, wie Sie die Daten Ihrer +EUDAS-Dateien am Bildschirm abrufen können - entweder manuell +oder mit Hilfe eines Suchmusters. Sie sollten Änderungen und Ein­ +fügungen durchführen können. + +#a("Drucken")# Sie sollten wissen, wie Sie die Daten einer EUDAS-Datei +mit Hilfe eines Druckmusters ausdrucken können. Denken Sie daran, +daß dies ein zweistufiger Vorgang ist (Generierung der Druckdatei - +Ausgeben an Drucker), den Sie an verschiedenen Stellen beeinflus­ +sen können. + +Lesen Sie das entsprechende Kapitel erneut durch, wenn Sie sich bei +einem Punkt dieser Aufzählung nicht sicher sind. Wichtig ist auch, +daß Sie die bschriebenen Funktionen selbst am Rechner ausprobiert +haben. + Wenn Sie dies alles geduldig absolviert haben, sind Sie in der +Lage, EUDAS sinnvoll für Ihre eigenen Probleme einzusetzen. Sie +sollten jetzt ruhig versuchen, eigene Lösungen zu realisieren. Sicher +werden Sie dabei erkennen, daß Ihnen noch einige Möglichkeiten +fehlen. Die Chancen sind aber gut, daß EUDAS Ihnen diese Möglich­ +keiten bietet. + Im nächsten Abschnitt erhalten Sie einen Überblick darüber, +was EUDAS noch zur Verfügung stellt. Dort können Sie sich orien­ +tieren, welche Kapitel Sie lesen sollten, wenn Sie bestimmte Fragen +haben. + + +#abschnitt ("8.2", "AUSBLICK", "Ausblick")# + +Im zweiten Teil dieses Handbuchs erwarten Sie eine ganze Reihe +interessanter Themen. Dort werden Erweiterungen und Verallgemei­ +nerungen von Funktionen beschreiben, die Sie bereits kennen. Viele +Funktionen sind jedoch ganz neu und manchmal auch nicht ganz +einfach zu beherrschen. + +#a ("Kapitel 9")# Das neunte Kapitel befaßt sich mit der grundsätzlichen +Struktur der geöffneten Datei. Sie erfahren, daß Sie mehr als eine +Datei gleichzeitig öffnen und bearbeiten können. Zum einen können +Sie gleichartige Dateien verketten oder Dateien über Beziehungen +koppeln. Insbesondere das Koppeln ist eine wichtige Grundlage für +viele fortgeschrittene Anwendungen von EUDAS. + In diesem Kapitel wird auch beschrieben, wie Sie auf einem +Mehrplatzsystem von mehreren Plätzen aus auf die gleichen EUDAS- +Dateien zugreifen können. Die Fähigkeiten von EUDAS auf diesem +Gebiet erreichen nicht das Niveau von großen Datenbanksystemen, +sind jedoch einfach anzuwenden und in vielen Fällen nützlich. + +#a ("Kapitel 10")# Im zehnten Kapitel erfahren Sie, wie Sie den Bildschirm +übersichtlicher gestalten können, wenn Sie Dateien mit zahlreichen +Feldern benötigen. Sie können bestimmte Felder auswählen, aber +auch die Sätze einfach ausschnittweise ansehen. + Das Suchmuster besitzt noch viele Fähigkeiten, die im ersten +Teil nicht zur Sprache gekommen sind. Sie können mehrere Bedin­ +gungen auf verschiedene Weisen miteinander kombinieren. Auch +einige neue Vergleiche treten auf. Außerdem können Sie mehrere +Felder eines Satzes miteinander vergleichen. + Zum schnellen Überblick steht Ihnen eine Funktion bereit, die +jeweils einen Satz pro Bildschirmzeile anzeigt. In dieser Übersicht +können Sie blättern und auch Sätze markieren (ankreuzen), um Sie +später zu bearbeiten. + +#a ("Kapitel 11")# Das elfte Kapitel ist den Funktionen zur Bearbeitung +gewidmet. Dort erfahren Sie, wie Sie eine Datei sortieren können. +Außerdem können Sie eine Datei ausschnittweise kopieren, wobei Sie +noch eine Vielzahl von Manipulationsmöglichkeiten haben. + Auch das Tragen von mehreren Sätzen in einem Arbeitsgang ist +möglich. Dabei können Konsistenzbedingungen einer Datei überprüft +werden. + Als letztes erfahren Sie, wie man eine EUDAS-Datei automa­ +tisch nach einer beliebigen Vorschrift ändern kann. Hier, wie bei +den vorherigen Funktionen, werden Sie zum ersten Mal erkennen, +wieviel man mit der Programmiersprache ELAN innerhalb von EUDAS +ohne viel Aufwand machen kann. + +#a ("Kapitel 12")# Das nächste Kapitel zeigt Ihnen weitere Möglichkeiten +zum Drucken. Sie können die Druckausgabe vor dem Drucken noch +mit den Programmen der EUMEL-Textverarbeitung aufbereiten. Auch +innerhalb der EUMEL-Textverarbeitung können Sie EUDAS aufrufen, +um Daten aus einer EUDAS-Datei in den Text einzufügen. + EUDAS kann auch in mehreren Spalten drucken (zum Beispiel +für Etiketten). Schließlich wird noch beschrieben, wie Sie lange +Felder auf mehrere Zeilen aufteilen können und welche speziellen +Möglichkeiten Sie zur Erzeugung von Tabellen haben. + +#a ("Kapitel 13")# Ab hier beginnt die Beschreibung dessen, was die +Ausgabe des Druckgenerators so ungeheuer anpassungsfähig macht: +die Verwendung der Programmiersprache ELAN. + Mit einfachsten ELAN-Elementen können Sie komplizierte For­ +matierungswünsche erfüllen. Dazu können Sie den Inhalt von Feld­ +mustern durch vorherige Bearbeitung und durch die Abfrage von +Bedingungen manipulieren. Ganze Musterteile können in Abhängig­ +keit von Bedingungen variabel gestaltet werden. + Auch der Ablauf von Druckvorgängen kann von Bedingungen +abhängig gemacht werden. So lassen sich gesteuert Vorspann und +Nachspann innerhalb des Ausdrucks einfügen und Zwischenüber­ +schriften oder -summen bilden (Gruppenverarbeitung). + +#a ("Kapitel 14 und 15")# Für denjenigen, der noch nie mit ELAN zu tun +hatte, werden diese Möglichkeiten sicher nicht ganz einfach zu +verstehen sein. Obwohl die vorherigen Kapitel viele benutzbare +Beispiele enthalten, ist zur vollen Ausnutzung ein gewisses Ver­ +ständnis von ELAN notwendig. + Dies soll in den Kapitel 14 und 15 vermittelt werden, und zwar +in dem Umfang, in dem es in EUDAS nötig ist (Sie sollen hier nicht +zum ELAN-Programmierer ausgebildet werden). Für den ELAN- +Kenner bieten diese Kapitel sicher nichts Neues, aber sie enthalten +viele Beispiele und Beschreibungen der Funktionen, die für EUDAS +wichtig sind. + Dabei geht Kapitel 15 weiter auf die Sprachmittel für Zählvor­ +gänge, Auswertungen und statistische Anwendungen ein, während in +Kapitel 14 die grundlegenden Ausdrücke zur Formulierung von +Manipulationen besprochen werden. + +#a ("Kapitel 16")# Im letzten Kapitel geht es dann wieder harmloser zu. +Hier werden die Funktionen beschrieben, die unter EUDAS zur +allgemeinen Dateiverwaltung zur Verfügung stehen. Im Grunde sind +dies alles Funktionen, die vom EUMEL-System zur Verfügung ge­ +stellt werden. EUDAS integriert sie lediglich in ein Menüsystem, +damit Sie als Benutzer die Funktionen möglichst einfach aufrufen +können. + Aber auch dem erfahrenen EUMEL-Benutzer bieten die Funktio­ +nen einen zusätzlichen Komfort, da auch hier die praktische Aus­ +wahl durch Ankreuzen in allen Funktionen vertreten ist. Außerdem +wird die Anzahl von Tastendrücken zum Erreichen eines Ziels ver­ +ringert. Daher besteht auch für den "Profi" keine Notwendigkeit, +grundsätzlich mit einer Kommandoschnittstelle weiterzuarbeiten. + +#a ("Referenzhandbuch")# Im Referenzhandbuch sind alle hier besproche­ +nen Funktionen noch einmal in einer sehr kurzen, zusammenfassen­ +den und abstrakten Form aufgeführt. Dort sollen Sie nachschlagen, +wenn Sie eine ganz bestimmte Information suchen und sich mit +EUDAS bereits auskennen. + Sie können jedoch auch ohne das Referenzhandbuch auskommen, +denn alles, was Sie wissen müssen, steht auch hier im Benutzer­ +handbuch. + Das Referenzhandbuch enthält auch einen Teil, der sich spe­ +ziell an den ELAN-Programmierer wendet, der besondere Anwendun­ +gen mit EUDAS realisieren will. Allerdings sollten alle dort be­ +schriebenen Möglichkeiten mit Vorsicht betrachtet werden, da sie im +Normalfall nicht so abgesichert sind, wie die hier beschriebenen +Fähigkeiten. Auch sollten Sie mit den Einsatzmöglichkeiten von +ELAN, wie sie in den Kapitel 11 und 13 beschrieben sind, wirklich +alle praktischen Probleme erledigen können. + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.9 b/app/eudas/4.4/doc/user-manual/eudas.hdb.9 new file mode 100644 index 0000000..8294ca0 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.9 @@ -0,0 +1,534 @@ +#type ("prop")##limit (14.0)# +#format# +#page (83)# +#kapitel ("9", "Das", "virtuelle", "Dateikonzept")# + + + +#abschnitt ("9.1", "KONZEPT", "Konzept")# + +Bisher haben Sie zu einem Zeitpunkt immer nur eine EUDAS-Datei +bearbeiten können. Wenn Sie zu einer anderen Datei wechseln woll­ +ten, mußten Sie die eine Datei sichern und die andere Datei wieder +öffnen. Es gibt jedoch Fälle, in denen Beziehungen zwischen mehre­ +ren Dateien bestehen. Daher kann EUDAS auch mit mehreren Dateien +gleichzeitig umgehen. + Es hat jedoch Vorteile, wenn man nur mit einer Datei arbeitet. +Sie müssen dann nicht immer den Namen der gewünschten Datei +angeben, wenn Sie eine Funktion ausführen. Dies brauchen Sie nur +einmal beim Öffnen zu tun - danach ist eindeutig festgelegt, wel­ +che Datei gemeint ist. + EUDAS versucht diese Vorteile auch bei mehreren Dateien zu +erhalten. Die verschiedenen Dateien werden so kombiniert, daß eine +neue Datei entsteht. Sie arbeiten dann nur mit dieser Datei, die alle +Daten der Einzeldateien enthält. + Damit Sie aber nicht so lange warten müssen, geschieht dieser +Kombinationsvorgang erst beim Ansehen. Die kombinierte Datei ist +also nicht wirklich vorhanden, sondern ihre Einzelsätze werden nur +bei Bedarf erzeugt. Daher heißt diese Gesamtdatei auch #on("i")#virtuelle#off("i")# +(scheinbare) Datei. + Eine Kombination von Dateien ist auf zwei Arten möglich. Sie +können gleichartige Dateien hintereinander#on("i")#ketten#off("i")#, oder Sie können +Dateien über gemeinsame Felder #on("i")#koppeln#off("i")#. Beide Methoden können +auch kombiniert werden. + +#a ("Änderungen")# Die virtuelle Datei kann auch verändert werden. Die +Veränderungen werden dann in den entsprechenden Ursprungsda­ +teien vorgenommen. Es ist jedoch nicht immer eindeutig, wie diese +Änderungen aussehen sollen. Achten Sie daher auf die speziellen +Regeln, die bei solchen Änderungen gelten, damit Sie die Auswir­ +kungen einer Änderung abschätzen können. + Wenn Sie Veränderungen vorgenommen haben, müssen Sie die +Arbeitskopien anschließend wieder sichern. Denken Sie daran, daß +EUDAS immer auf unbenannten Kopien arbeitet, wenn Sie ändern +wollen. Beim Sichern von mehreren Dateien wird Ihnen zu jeder +Datei einzeln angezeigt, ob sie tatsächlich verändert wurde. Sie +können dann ebenfalls einzeln entscheiden, ob Sie die Datei sichern +wollen oder nicht. + + +#abschnitt ("9.2", "KETTEN", "Ketten")# + +Wenn Sie einmal EUDAS-Dateien mit mehreren tausend Sätzen er­ +stellen, werden Sie feststellen, daß deren Handhabung recht um­ +ständlich sein kann. Da die Datei sehr groß ist, dauern zum Beispiel +Kopiervorgänge aufs Archiv viel länger als bei kleinen Dateien. + Wenn Sie nun auch noch für jede kleine Änderung die Datei +vom Archiv holen und anschließend wieder zurückschreiben müssen, +werden Sie einen Weg suchen, diese Arbeit zu erleichtern. Die ein­ +fachste Möglichkeit wäre, einen schnelleren Rechner zu kaufen. Dies +ist gleichzeitig aber auch die teuerste. + +#beispiel# +#free (4.5)# + +#center#Abb. 9-1 Verkettung von A und B +#text# + +EUDAS ermöglicht es Ihnen nun, die große Datei in mehrere kleine +aufzuspalten. In der Regel gibt es bei solch großen Dateien ein +Kriterium, nach dem die Sätze in verschiedene Dateien verteilt +werden können. Jede einzelne Datei kann nun bequem geändert +werden. + Ein Problem entsteht jedoch, wenn alle Dateien zusammen ver­ +arbeitet werden müssen (zum Beispiel beim Drucken). Für einen +solchen Vorgang können Sie die kleineren Dateien logisch aneinan­ +derketten. + Dies bedeutet für Sie, daß alle kleinen Dateien wie eine große +Datei wirken. Wenn Sie beim Bewegen in der Datei das Ende einer +einzelnen Datei erreichen, kommen Sie automatisch an den Anfang +der nächsten Datei. + +#a ("Aufruf")# Damit dies funktioniert, müssen die Dateien natürlich +gleiche Feldstruktur haben. Außerdem ist die Zahl der verkettbaren +Dateien aus technischen Gründen auf 10 beschränkt. + Sie können die Dateien verketten, indem Sie die Funktion +#free (0.2)# +#beispiel# + K Ketten +#text# +#free (0.2)# +im Menü 'Öffnen' aufrufen. + +#a ("Änderungen")# In der virtuellen Datei ist sowohl Einfügen als auch +Ändern erlaubt. Beim Einfügen ist jedoch zu beachten, daß am Ende +einer Datei nicht angefügt werden kann. Dies liegt daran, daß Sie +entweder vor dem letzten Satz der einen Datei oder vor dem ersten +Satz der anderen Datei einfügen. Der Endesatz der einen Datei, der +normalerweise sichtbar wäre, wird übersprungen. + Am Ende der letzten Datei können Sie natürlich anfügen, da +deren Endemarkierung als Ende der ganzen Datei ja wieder sichtbar +ist. + + +#abschnitt ("9.3", "KOPPELN", "Koppeln")# + +Nachdem das Verketten von Dateien noch ganz einfach zu verstehen +war, kommt jetzt eine Funktion auf Sie zu, die kompliziertere Mög­ +lichkeiten in sich birgt: nämlich das Koppeln. + Es kommt häufiger vor, daß sich ein Feld einer Datei auf einen +bestimmten Satz in einer anderen Datei bezieht. So könnten zum +Beispiel die Ausleihen einer Bücherei in folgender Datei gespeichert +sein: + +#beispiel# + 'Name' + 'Vorname' + 'Datum' + 'Buch-Nr.' +#text# + +Wenn jetzt ein Ausleiher sein Rückgabedatum überschritten hat, +möchte die Bücherei dem Kunden ein Mahnschreiben schicken. Auf +diesem Schreiben soll aber nicht die Buch-Nr. erscheinen, sondern +Autor und Titel des Buches. + Diese Sekundärinformationen sind in einer anderen Datei ge­ +speichert, der Bestandskartei: + +#beispiel# + 'Buch-Nr.' + 'Autor' + 'Titel' + 'Verlag' +#text# + +Alle Dateistrukturen hier sind natürlich zwecks größerer Übersicht­ +lichkeit vereinfacht. Um jetzt dem Kunden das Mahnschreiben zu +schicken, müssen die Informationen in den beiden Dateien korreliert +werden. + +#a ("Aufruf")# Zuerst wird die Ausleihdatei normal geöffnet. Dazu wird +dann die Bestandsdatei mit Hilfe der Funktion +#free (0.2)# +#beispiel# + K Koppeln +#text# +#free (0.2)# +gekoppelt. Dies hat folgenden Effekt: + Die Sätze erscheinen normal so, wie sie in der Ausleihdatei +auftauchen, also für jede Ausleihe genau ein Satz. Dazu erscheint +aber jeweils die Beschreibung des ausgeliehenen Buches aus der +Bestandsdatei: die beiden Dateien wurden über das Feld "Buch-Nr." +gekoppelt. + Als Struktur ergibt sich für die kombinierte Datei: + +#beispiel# + 'Name' + 'Vorname' + 'Datum' + 'Buch-Nr.' + 'Titel' + 'Autor' + 'Verlag' +#text# + +Die Felder der Koppeldatei wurden also noch hinzugefügt. + +#a ("Koppelfelder")# Zwei Dinge sind in diesem Zusammenhang wichtig: +Damit der Koppelvorgang ohne allzuviele Vorgaben auskommen kann, +müssen Felder, über die gekoppelt wird, den gleichen Namen haben +- und zwar exakt Zeichen für Zeichen. Zum zweiten muß ein solches +#on("i")#Koppelfeld#off("i")# am Anfang der gekoppelten Datei (in unserem Fall der +Bestandsdatei) stehen. Dies ist aus technischen Gründen notwendig, +damit der Koppelvorgang in vernünftiger Geschwindigkeit ablaufen +kann. + +#beispiel# +#free (7.0)# + +#center#Abb. 9-2 Schema des Koppelvorgangs +#text# + +#a ("Mehrere Dateien")# Genau wie beim Ketten ist die Kombination der +Dateien nicht physikalisch, sondern nur scheinbar vollzogen worden. +Bis zum Limit der maximal geöffneten Dateien (10) können Sie auch +weitere Dateien dazukoppeln. Die Koppelfelder dieser Dateien kön­ +nen sich jedoch immer nur auf die erste Datei beziehen, also nicht +auf eine andere Koppeldatei. + Dies könnte man in unserem Beispiel ausnutzen. Die Bücherei +hat sicher auch eine Datei ihrer Mitglieder. Diese könnte etwa so +aussehen: + +#beispiel# + 'Name' + 'Vorname' + 'm/w' + 'Strasse' + 'PLZ' + 'Ort' +#text# + +Diese Datei können wir ebenfalls zur Ausleihdatei dazukoppeln. +Damit haben wir auch gleich die Quelle gewonnen, aus der wir die +Anschrift für das Mahnschreiben gewinnen können. + Die Kopplung geschieht in diesem Fall über zwei Felder, näm­ +lich 'Name' und 'Vorname'. Damit ein Mitglied eindeutig identifi­ +ziert wird, werden beide Namen gebraucht. Dies berücksichtigt auch +das Koppelverfahren. Wiederum müssen die Namen exakt mit Namen +der ersten Datei übereinstimmen. + Wenn mehrere Koppelfelder für eine Koppeldatei notwendig sind, +müssen Sie alle hintereinander stehen. Wäre die Struktur der Mit­ +gliederdatei etwa + +#beispiel# + 'Name' + 'Titel' + 'Vorname' + 'm/w' + 'Strasse' + 'PLZ' + 'Ort' +#text# + +würde nur über 'Name' gekoppelt, da 'Titel' in der ersten Datei +nicht vorkommt. Alle weiteren Felder können dann keine Koppelfel­ +der mehr werden. Durch Umstellen der Feldreihenfolge der Koppel­ +datei (durch Umkopieren) oder durch entsprechende Benennung von +Feldern können Sie immer den gewünschten Effekt erzielen. + +#beispiel# +#free (8.0)# + +#center#Abb. 9-3 Aufbau der virtuellen Datei +#text# + +#a ("Zusammenfassung")# An dieser Stelle wollen wir die Ergebnisse die­ +ses Abschnitts als Regel zusammenfassen: + +#limit (12.0)# + Die ersten Felder der Koppeldatei, die wörtlich an be­ + liebiger Stelle auch in der ersten Datei auftauchen, + werden Koppelfelder genannt. Zu einem Satz der ersten + Datei wird ein Satz der Koppeldatei gezeigt, der im In­ + halt der Koppelfelder übereinstimmt. +#limit (13.5)# + +Übersetzt in unser Beispiel heißt dies: 'Buch-Nr.' bzw. 'Name' und +'Vorname' sind Koppelfelder. Zu einer bestimmten Ausleihe erschei­ +nen die Daten des Buches mit der angegebenen Buch-Nr. bzw. die +Adresse des Mitgliedes mit den angegebenen Namen. + + +#abschnitt ("9.4", "AUSWIRKUNGEN DES KOPPELNS", "Auswirkungen des Koppelns")# + +Nachdem Sie nun das Grundprinzip des Koppelns kennen, sollen Sie +einige Auswirkungen dieses Verfahrens kennenlernen. + Ein Beispiel dazu finden Sie in Abb. 9-4. Dargestellt sind je­ +weils die Satznummern und einige Inhalte. Die zweite Zeile in der +Hauptdatei und die erste in der Koppeldatei stellen das Koppelfeld +dar. + +#beispiel# +#free (6.5)# + +#center#Abb. 9-4 Kombinationen +#text# + +#a ("Kombinationen")# Zuerst muß geklärt werden, was passiert, wenn es +keinen passenden Satz in der Koppeldatei gibt. Zum Beispiel könnte +eine Buchnummer eingegeben worden sein, die in der Bestandsdatei +nicht existiert. In diesem Fall zeigt EUDAS für die Felder der Kop­ +peldatei einfach einen leeren Inhalt an (siehe Satz 23 der Haupt­ +datei, es gibt keinen Satz mit 'L' in der Koppeldatei). + Wenn umgekehrt zu einem bestimmten Buch keine Ausleihe +existiert, macht das natürlich nichts - das Buch erscheint nur +dann, wenn Sie die Bestandsdatei alleine öffnen. + Weiterhin kann es passieren, daß es zwei passende Sätze in der +Koppeldatei gibt. Dies kommt dann vor, wenn zwei Mitglieder glei­ +chen Namen und gleichen Vornamen haben (was gar nicht so selten +ist). In diesem Fall zeigt EUDAS beide Kombinationen an (siehe +Satz 23 der Hauptdatei). Die Ausleihe erscheint also zweimal, je­ +weils mit einem anderen Mitglied. + Damit man diesen Fall ohne weiteres erkennen kann, führt +EUDAS bei Kopplungen zwei Nummern: zum einen die normale Satz­ +nummer und zum anderen eine Kombinationsnummer. In dem eben +besprochenen Fall würde die Satznummer gleichbleiben, die Kombi­ +nationsnummer aber hochgezählt werden. Am Bildschirm wird die +Kombinationsnummer durch Bindestrich getrennt hinter die Satz­ +nummer geschrieben, wenn Sie Dateien koppeln. + Das Durchgehen aller Kombinationen zu einem Satz der Haupt­ +datei passiert aber nur dann, wenn Sie sich mit der Funktion 'Satz +weiter' in der Datei bewegen. Wenn Sie rückwärts gehen oder auf +einen bestimmten Satz positionieren, wird immer nur die erste Kom­ +bination angezeigt (Dies hat zum Teil technische Gründe). Beim +Zurückgehen von Satz 23-1 in dem Beispiel würde also auf Satz +22-1 positioniert und die Kombination 22-2 übersprungen. + +#a ("Änderungen")# Auch wenn Sie Dateien gekoppelt haben, können Sie +immer noch Sätze ändern und einfügen (wenn Sie dies beim Öffnen +erlaubt haben). Die Auswirkungen der Veränderungen sind jedoch +nicht mehr ganz so einfach wie bei geketteten Dateien, wo sich die +Änderungen ja einfach auf den aktuellen Satz bezogen. + Als Grundregel gilt, daß Änderungen möglichst wenig Auswir­ +kungen auf die Koppeldateien haben sollen. Das führt dazu, daß +beim Einfügen eines neuen Satzes oder beim Entfernen eines Satzes +durch Tragen keine Aktion in der Koppeldatei durchgeführt wird. +Dies ist auch nicht nötig, denn wenn zum Beispiel ein neuer (zu­ +nächst leerer) Satz eingefügt wird, existiert sowieso noch kein +passender Satz in der Koppeldatei und die entsprechenden Felder +bleiben leer. Hingegen darf beim Entfernen eines Satzes der Satz in +der Koppeldatei nicht entfernt werden, da er ja noch zu einem an­ +deren Satz gehören könnte. + Änderungen an den Koppelfeldern können nun zu drei verschie­ +denen Reaktionen führen: + +1. Es wird kein Satz der Koppeldatei geändert, sondern nur ein + neuer passender Satz gesucht. Dies geschieht immer dann, wenn + außer den Koppelfeldern nur leere Inhalte für die Felder der + Koppeldatei angegeben sind. Nach dem Ändern oder Einfügen + werden dann die Inhalte des neuen Koppelsatzes angezeigt. + + Beispiel: Bei einer Ausleihe geben Sie Name und Vorname des + Ausleihers an, nicht aber seine Adresse. Wenn Sie den Satzedi­ + tor beim Einfügen mit ESC 'q' verlassen, wird die zugehörige + Adresse angezeigt (falls der entsprechende Name in der Kop­ + peldatei vorhanden ist). + +2. Es wird ein neuer Satz in der Koppeldatei angefügt. Dies ge­ + schieht immer dann, wenn die Koppelfelder verändert wurden + und die anderen Felder der Koppeldatei nicht leer sind. Da­ + durch soll verhindert werden, daß die Koppelfelder in einem + Satz verändert werden, der vielleicht noch zu einem anderen + Satz paßt. + + Beispiel: Sie geben bei einer Ausleihe auch die Adresse mit + an. Wenn eine Person mit gleichem Namen und Vornamen bereits + existiert, wird die dort gespeicherte Adresse nicht überschrie­ + ben. Stattdessen wird die zweite Adresse auch in die Koppel­ + datei eingetragen. Beim nächsten Ansehen bekommen Sie dann + zwei Adressen angezeigt. So wird verhindert, daß Sie ungewollt + die erste Adresse vernichten. + +3. Der Satz in der Koppeldatei wird verändert. Dies geschieht nur + dann, wenn die Koppelfelder unverändert geblieben sind, der + Rest sich aber geändert hat. + + Beispiel: Sie ändern eine Ausleihe mit der zugehörigen + Adresse. Sie geben nur eine neue Straße an und lassen Name + und Vorname unverändert. Der Satz in der Koppeldatei enthält + anschließend die neue Straße. + +Da Koppeldateien keine Sortierung besitzen müssen, werden neue +Sätze der Koppeldatei immer am Ende angefügt. Dies ist zu beach­ +ten, wenn die Koppeldatei auch allein verwendet werden soll. Ge­ +gebenenfalls müssen Sie die Koppeldatei dann erst sortieren. + + +#abschnitt ("9.5", "UMSCHALTEN AUF KOPPELDATEI", "Umschalten auf Koppeldatei")# + +Häufig kommt es vor, daß Sie beim Einfügen eines neuen Satzes mit +gekoppelten Dateien die Verbindung mit einem existierenden Satz +der Koppeldatei erreichen wollen, aber den notwendigen Inhalt der +Koppelfelder nicht auswendig wissen. + So wollen Sie beim Eingeben einer Ausleihe Name und Vorname +des Entleihers nicht immer wieder abtippen. Dabei ist auch die +Gefahr von Eingabefehlern sehr groß. Stattdessen wollen Sie lieber +erst den Entleiher in der Mitgliederdatei suchen und dessen Namen +dann automatisch in den Entleihsatz übernehmen. + Hierfür bietet Ihnen EUDAS eine Unterstützung an. + +#a ("Ausführung")# Während Sie sich in der virtuellen Datei befinden, +können Sie auf eine bestimmte Koppeldatei umschalten, die Sie dann +wie eine Einzeldatei bearbeiten können. Beim Zurückschalten haben +Sie dann die Möglichkeit, die Koppelfelder des gefundenen Satzes zu +übernehmen. + Das Umschalten bewirken Sie durch die Tastenkombination ESC +'K' (großes K) nur im Menü 'Einzelsatz' sowie im Satzeditor beim +Einfügen und Ändern. An anderen Stellen hat dieser Befehl keine +Wirkung. Bei mehreren Koppeldateien werden Ihnen die Dateien der +Reihenfolge nach angeboten. Durch Verneinung aller Fragen können +Sie die Funktion ohne Wirkung beenden. + Haben Sie nun umgeschaltet, wird Ihnen die Koppeldatei dar­ +geboten, als hätten Sie sie allein geöffnet. Sie können die Datei +auch beliebig ändern (wenn Sie dies beim Öffnen angegeben haben). +Nur die Anzeige #bsp ("")# in der Bildüberschrift zeigt an, daß Sie +sich in einer Koppeldatei befinden. Sie können auch Funktionen in +anderen Menüs aufrufen. + Das Zurückschalten geschieht im Menü 'Einzelsatz' mit der +gleichen Tastenkombination. Alle Einstellungen der virtuellen Datei +von vorher bis auf die Feldauswahl bleiben erhalten. + Wenn Sie nicht im Menü, sondern im Satzeditor (also beim +Ändern oder Einfügen) umschalten, werden Sie zunächst wieder aus +dem Satzeditor rausgeworfen. Sie können dann in der Koppeldatei +den gewünschten Satz aufsuchen (oder neu eintragen). Beim Zurück­ +schalten werden Sie gefragt, ob Sie die Koppelfelder übernehmen +wollen oder nicht. Danach kehren Sie automatisch wieder in den +Satzeditor zurück, wobei jetzt die Koppelfelder gegebenenfalls aus­ +gefüllt oder überschrieben sind. + Durch erneutes Umschalten können Sie den Vorgang auch für +weitere Koppeldateien wiederholen. + Die Position, die Sie beim Umschalten in der Koppeldatei einge­ +nommen haben, wird bis zum nächsten Umschalten gespeichert. Sie +kommen dann zunächst wieder auf den gleichen Satz. So können Sie +die gleichen Koppelfelder wie beim letzten Mal übernehmen, indem +Sie einfach zweimal ESC 'K' tippen. + +#a ("Beispiel")# Der typische Vorgang beim Entleihen würde dann wie folgt +aussehen. Zunächst öffnen Sie die Entleihdatei mit Änderungser­ +laubnis; dann koppeln Sie die Mitgliederdatei und die Bestandsdatei +dazu. + Für eine neue Ausleihe rufen Sie zunächst die Funktion 'Ein­ +fügen' auf. Dann tippen Sie ESC 'K' und schalten auf die Mitglie­ +derdatei um. Dort suchen Sie das Mitglied und schalten wieder zu­ +rück. Existierte das Mitglied noch nicht, können Sie es gleich ein­ +tragen. Beim Zurückschalten übernehmen Sie den Namen des Mit­ +glieds. + Dann tragen Sie die Nummer des Buches ein (die müssen Sie nur +dann suchen, wenn Sie nicht auf dem Buch steht). Das Entleihdatum +erhalten Sie mit Hilfe der Tastenkombination ESC 'D' (wird im näch­ +sten Kapitel beschrieben). + Wollen Sie mehrere Ausleihen für ein Mitglied eintragen, so +tippen Sie beim nächsten Einfügen einfach zweimal ESC 'K', ohne +dazwischen eine Positionierung vorzunehmen. + + +#abschnitt ("9.6", "MEHRFACHBENUTZUNG", "Mehrfachbenutzung")# + +EUDAS ermöglicht es mehreren Benutzern an einem Rechner, mit den +gleichen Dateien zu arbeiten. Dies ist eigentlich nichts Besonderes, +denn das EUMEL-System ist ja bereits von Haus aus dazu geeignet. +Es müssen jedoch einige Schutzvorkehrungen getroffen werden, +damit dadurch keine Probleme entstehen. + Als Grundvoraussetzung für die Mehrfachbenutzung müssen +EUDAS-Dateien in einer unabhängigen #on("i")#Managertask#off("i")# gespeichert +sein. Eine Managertask kann man sich durch das Kommando 'global +manager' einrichten. In dieser Task sollte dann nicht mehr gearbei­ +tet werden. + Stattdessen kann sich der Benutzer Dateien aus dieser Mana­ +gertask kopieren und auch wieder dorthin zurückschreiben. Wie Sie +dies im EUDAS-Menü bewerkstelligen können, wird im Kapitel 16 +beschrieben. Es sei nochmal betont, daß dies eine Methode ist, die +Sie für beliebige Dateien verwenden können. + Im Kapitel 16 ist weiterhin auch beschrieben, wie Sie solche +Dateien mit #on("i")#Passworten#off("i")# schützen können, so daß sie nicht jeder +benutzen kann. Schauen Sie bei Bedarf dort nach. + +#beispiel# +#free (7.7)# + +#center#Abb. 9-5 Mehrfachbenutzung +#text# + +#a ("Konflikte")# Wir wollen uns jedoch jetzt um ein Problem kümmern, das +bei dieser Art von Mehrfachbenutzung auftritt. Nehmen wir an, +unsere Bücherei habe zwei Plätze, an denen Entleihen durchgeführt +werden können. Beide Plätze sollen mit der gleichen Entleihdatei +arbeiten (wie Sie gleich noch sehen werden und aus anderen Grün­ +den würde man EUDAS für eine solche Bücherei nicht einsetzen - +wir wollen hier nur das Prinzip illustrieren). + Der Ablauf wäre dann folgendermaßen. Jeder Platz kopiert sich +für eine Entleihe die gemeinsame Datei aus der Managertask, öffnet +sie, trägt die Entleihe ein und sichert die Datei wieder. Dann wird +die Datei in die Managertask zurückgeschrieben, wo sie die alte +Entleihdatei ersetzt. + Abgesehen von dem viel zu hohen manuellen Aufwand kann der +Fall eintreten, daß beide gleichzeitig eine Entleihe bearbeiten. +Nehmen wir an, beide benutzen die Entleihdatei mit dem symboli­ +schen Inhalt A. Auf Platz 1 kommt noch die Entleihe B, auf Platz 2 +die Entleihe C dazu. Platz 1 will anschließend den Inhalt AB zu­ +rückschreiben, Platz 2 den Inhalt AC. + Je nach der zeitlichen Reihenfolge wird nur eine der beiden +Versionen übrigbleiben, da derjenige, der später zurücksichert, die +vorherige Version überschreibt. Richtig sollte die endgültige Version +ABC herauskommen. Unser Beispiel führt jedoch auf jeden Fall zu +einer fehlerhaften Datei. + Grund dafür ist, daß beim Zurückschreiben der ganzen Datei ein +Platz gesperrt werden muß, während der andere Platz eine Datei +zum Ändern angefordert hat. Man könnte auch dazu übergehen, nur +einzelne Sätze zu übertragen; diese Methode wird jedoch von EUDAS +wegen des hohen Aufwandes nicht unterstützt (daher würde man +EUDAS eben auch nicht für eine Mehrplatz-Bücherei nehmen). + In vielen Fällen reicht das Sperren ganzer Dateien jedoch aus, +besonders, wenn nicht ganz so häufig an einzelnen Sätzen geändert +wird. EUDAS bietet dafür neben der notwendigen Sperre auch noch +eine automatische Versendung der Dateien an. + +#a ("Manager")# Es bietet sich an, dieses Kopieren der Dateien beim Öff­ +nen (auch Koppeln und Ketten) und Sichern automatisch durchzu­ +führen. Als Voraussetzung dafür müssen Sie EUDAS angeben, mit +welcher Managertask Sie arbeiten wollen. Dazu dient die Funktion +#free (0.2)# +#beispiel# + M Manager +#text# +#free (0.2)# +im Menü 'Öffnen'. Sie werden dann nach dem Namen der Task ge­ +fragt. Geben Sie keinen Namen an, wird der Managermodus wieder +ausgeschaltet. Welche Task als Manager eingestellt ist, sehen Sie in +der untersten Bildschirmzeile. + In der Task, die Sie angeben, muß EUDAS insertiert sein (oder +in einem Vater), da sonst die Sperre nicht funktioniert. + Wenn Sie nun einen solchen Manager angegeben haben, können +Sie beim Öffnen Dateinamen aus dieser Task angeben. Auch bei ESC +'z' werden Ihnen alle Namen aus dem Manager mit angeboten. Wenn +Sie einen solchen Namen angeben, der nicht aus Ihrer eigenen Task +stammt, wird die Datei vor dem Öffnen automatisch kopiert. Wenn +Sie angegeben haben, daß Sie die Datei verändern wollen, wird in +der Managertask eine entsprechende Sperre gesetzt. + Wenn Sie die Datei nach Änderungen dann sichern, wird die +geänderte Kopie zurückgeschrieben. Die Sperre wird jedoch erst +dann aufgehoben, wenn Sie die Arbeitskopien endgültig löschen. + Möchte nun ein anderer Benutzer diese Datei öffnen, während +Sie sie ändern, kann er dies nur, wenn er sie nicht ändern will. +Natürlich wird die Datei dann auch nicht wieder zurückgeschickt. +Will er sie ändern, erhält er eine Fehlermeldung und kann den +Versuch später wiederholen. + +#a ("Vorsichtsmaßregeln")# Bedenken Sie, daß der Schutz nur wirksam sein +kann, wenn Sie diesen Vorgang nicht unter Umgehung der Menü­ +steuerung ausführen. Würden Sie sich zum Beispiel eine Datei vom +Manager holen (s. Kapitel 16), ohne daß Sie ein Änderungsvorhaben +anmelden können, können Sie diese Datei ja trotzdem ändern und +wieder zurückschicken. In diesem Fall hat EUDAS keine Kontrolle +mehr über die Datei. + Aus dem gleichen Grund sollten Sie sich die Managertask auch +nicht an Ihren Bildschirm holen, denn auch dann könnten Sie ohne +Kontrolle Änderungen durchführen (zudem kann der Manager wäh­ +rend dieser Zeit nicht auf andere Benutzer reagieren). + Nur wenn Sie eine neue Datei im Manager anlegen, müssen Sie +dies von Hand tun. Dazu erstellen Sie die Datei ganz normal und +schreiben Sie mit der in Kapitel 16 beschriebenen Funktion zum +Manager. Sie sollten jedoch darauf achten, daß dort nicht schon +eine Datei gleichen Namens liegt (EUDAS fragt ja dann, ob über­ +schrieben werden soll). + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.inhalt b/app/eudas/4.4/doc/user-manual/eudas.hdb.inhalt new file mode 100644 index 0000000..edd8709 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.inhalt @@ -0,0 +1,172 @@ +#type ("prop")##limit (14.0)# +#format# +#kapitel (" ", " Inhalt", "", " ")# + + + +#type ("12")# + Vorwort . . . . . . . . . . . . . . . . . . . i + Inhalt . . . . . . . . . . . . . . . . . . . . iii + + +#type ("prop")# +#abschnitt ("I.", "DIE ERSTEN SCHRITTE", "Die ersten Schritte")# + +#type ("prop")# +#on("b")#1 Was kann EUDAS ?#off("b")# +#free (0.2)# +#type ("12")# +1.1 Textverarbeitung und Datenverwaltung . . . . . 3 +1.2 EUDAS als Karteikasten . . . . . . . . . . . . 5 +1.3 Drucken . . . . . . . . . . . . . . . . . . . 7 +1.4 Grenzen . . . . . . . . . . . . . . . . . . . 9 + +#type ("prop")# +#on("b")#2 Installation#off("b")# +#free (0.2)# +#type ("12")# +2.1 Lieferumfang . . . . . . . . . . . . . . . . . 11 +2.2 Single-User . . . . . . . . . . . . . . . . . 12 +2.3 Multi-User . . . . . . . . . . . . . . . . . . 13 + +#type ("prop")# +#on("b")#3 Ein Beispiel zum Ausprobieren#off("b")# +#free (0.2)# +#type ("12")# +3.1 Start . . . . . . . . . . . . . . . . . . . . 15 +3.2 Daten eintragen . . . . . . . . . . . . . . . 16 +3.3 Daten abfragen . . . . . . . . . . . . . . . . 21 +3.4 Drucken . . . . . . . . . . . . . . . . . . . 22 +3.5 Ergebnis . . . . . . . . . . . . . . . . . . . 24 + + +#type ("prop")# +#abschnitt ("II.", "EINFÜHRUNG IN DIE BENUTZUNG", "Einführung in die Benutzung")# + +#type ("prop")# +#on("b")#4 Umgang mit Dateien und Menüs#off("b")# +#free (0.2)# +#type ("12")# +4.1 EUDAS-Dateien . . . . . . . . . . . . . . . . 27 +4.2 EUDAS-Menüs . . . . . . . . . . . . . . . . . 29 +4.3 Archivmenü . . . . . . . . . . . . . . . . . . 32 +4.4 Dateiverwaltung . . . . . . . . . . . . . . . 37 +4.5 Bedienungsregeln . . . . . . . . . . . . . . . 39 + +#type ("prop")# +#on("b")#5 Gespeicherte Daten abfragen#off("b")# +#free (0.2)# +#type ("12")# +5.1 Öffnen . . . . . . . . . . . . . . . . . . . . 43 +5.2 Bewegen . . . . . . . . . . . . . . . . . . . 45 +5.3 Suchen . . . . . . . . . . . . . . . . . . . . 46 +5.4 Suchbedingungen . . . . . . . . . . . . . . . 49 + +#type ("prop")# +#on("b")#6 Daten eingeben und ändern#off("b")# +#free (0.2)# +#type ("12")# +6.1 Neue Datei einrichten . . . . . . . . . . . . 51 +6.2 Sätze einfügen . . . . . . . . . . . . . . . . 52 +6.3 Daten ändern . . . . . . . . . . . . . . . . . 55 +6.4 Arbeitskopie sichern . . . . . . . . . . . . . 56 + +#type ("prop")# +#on("b")#7 Ausdrucken der Daten#off("b")# +#free (0.2)# +#type ("12")# +7.1 Druckmuster . . . . . . . . . . . . . . . . . 61 +7.2 Aufruf . . . . . . . . . . . . . . . . . . . . 64 +7.3 Abschnitte . . . . . . . . . . . . . . . . . . 67 +7.4 Feldmuster . . . . . . . . . . . . . . . . . . 69 + +#type ("prop")# +#on("b")#8 Was war und was noch kommt#off("b")# +#free (0.2)# +#type ("12")# +8.1 Rückblick . . . . . . . . . . . . . . . . . . 75 +8.2 Ausblick . . . . . . . . . . . . . . . . . . . 76 + + +#type ("prop")# +#abschnitt ("III.", "WEITERE MÖGLICHKEITEN", "Weitere Möglichkeiten")# + +#type ("prop")# +#on("b")#9 Das virtuelle Dateikonzept#off("b")# +#free (0.2)# +#type ("12")# +9.1 Konzept . . . . . . . . . . . . . . . . . . . 83 +9.2 Ketten . . . . . . . . . . . . . . . . . . . . 84 +9.3 Koppeln . . . . . . . . . . . . . . . . . . . 85 +9.4 Auswirkungen des Koppelns . . . . . . . . . . 89 +9.5 Umschalten auf Koppeldatei . . . . . . . . . . 92 +9.6 Mehrfachbenutzung . . . . . . . . . . . . . . 93 + +#type ("prop")# +#on("b")#10 Datenabfrage am Bildschirm#off("b")# +#free (0.2)# +#type ("12")# +10.1 Feldauswahl . . . . . . . . . . . . . . . . . 97 +10.2 Satzeditor . . . . . . . . . . . . . . . . . . 98 +10.3 Suchmuster . . . . . . . . . . . . . . . . . . 99 +10.4 Markieren . . . . . . . . . . . . . . . . . . 104 +10.5 Übersicht . . . . . . . . . . . . . . . . . . 105 + +#type ("prop")# +#on("b")#11 Funktionen zur Bearbeitung#off("b")# +#free (0.2)# +#type ("12")# +11.1 Sortieren . . . . . . . . . . . . . . . . . . 109 +11.2 Kopieren . . . . . . . . . . . . . . . . . . . 112 +11.3 Tragen . . . . . . . . . . . . . . . . . . . . 118 +11.4 Automatische Änderungen . . . . . . . . . . . 121 + +#type ("prop")# +#on("b")#12 Weitere Möglichkeiten zum Drucken#off("b")# +#free (0.2)# +#type ("12")# +12.1 Anschluß an die Textverarbeitung . . . . . . . 123 +12.2 Spaltendruck . . . . . . . . . . . . . . . . . 126 +12.3 Modi . . . . . . . . . . . . . . . . . . . . . 128 + +#type ("prop")# +#on("b")#13 Programmierung von Druckmustern#off("b")# +#free (0.2)# +#type ("12")# +13.1 Abkürzungen . . . . . . . . . . . . . . . . . 133 +13.2 Bedingte Musterteile . . . . . . . . . . . . . 141 +13.3 Übersetzung . . . . . . . . . . . . . . . . . 142 +13.4 Gruppen . . . . . . . . . . . . . . . . . . . 144 + +#type ("prop")# +#on("b")#14 Ausdrücke in ELAN#off("b")# +#free (0.2)# +#type ("12")# +14.1 Was sind Ausdrücke ? . . . . . . . . . . . . . 151 +14.2 Datentypen . . . . . . . . . . . . . . . . . . 152 +14.3 TEXT-Funktionen . . . . . . . . . . . . . . . 156 +14.4 Rechenfunktionen . . . . . . . . . . . . . . . 160 +14.5 Abfragen . . . . . . . . . . . . . . . . . . . 161 + +#type ("prop")# +#on("b")#15 Anweisungen in ELAN#off("b")# +#free (0.2)# +#type ("12")# +15.1 Variablen und Zuweisungen . . . . . . . . . . 165 +15.2 Weitere Konstruktionen . . . . . . . . . . . . 168 + +#type ("prop")# +#on("b")#16 Dateiverwaltung mit EUDAS#off("b")# +#free (0.2)# +#type ("12")# +16.1 Dateien im System . . . . . . . . . . . . . . 171 +16.2 Dateien auf dem Archiv . . . . . . . . . . . . 174 + + +#type ("prop")# +#abschnitt ("IV.", "ANHANG", "Anhang")# + +#type ("12")# + Register . . . . . . . . . . . . . . . . . . . 181 + + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.macros b/app/eudas/4.4/doc/user-manual/eudas.hdb.macros new file mode 100644 index 0000000..2def44f --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.macros @@ -0,0 +1,66 @@ +#*format# +#limit (13.5)##start (3.5,2.5)##pagelength (21.0)##block# +#:firsthead (false)# +#linefeed (1.07)# +#*macro end# +#*text# +#type ("prop10")# +#linefeed (1.07)# +#*macro end# +#*beispiel# +#type ("12")# +#linefeed (0.97)# +#*macro end# +#*bildschirm# +#type ("17")# +#linefeed(0.83)# +#*macro end# +#*proc# +#type ("12")# +#*macro end# +#*endproc# +#free (0.1)# +#type ("prop10")# +#linefeed (1.0)# +#*macro end# +#*abschnitt ($1,$2,$3)# +#headodd# +#on("b")#$1#right#$3 %#off("b")# +#free (1.0)# +#end# +#on("b")##ib(9)#$1#ie(9,"   $3")# $2#off("b")# +#*macro end# +#*char($1)# +$1 +#*macro end# +#*kapitel ($1,$2,$3,$4)# +#free (1.3)# +#"nlq"# +#type("roman.24")# +#on("b")##center#$1#off("b")# +#free (0.2)# +#type ("roman.18")# +#on("b")##center#$2 #off("b")# +#on("b")##center# $3#off("b")# +#on("b")##center#$4#off("b")# +#type ("prop10")# +#free (0.6)# +#headeven# +#on("b")#% $2 $3 $4#off("b")# +#free (1.0)# +#end# +#headodd# +#right##on("b")#%#off("b")# +#free (1.0)# +#end# +#*macro end# +#*f2# +#free (0.2)# +#*macro end# +#*a ($1)# +#on("b")#$1.#off("b")#  +#*macro end# +#*bsp ($1)# +#type("12")#$1#type("prop")# +#*macro end# + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.titel b/app/eudas/4.4/doc/user-manual/eudas.hdb.titel new file mode 100644 index 0000000..022235c --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.titel @@ -0,0 +1,73 @@ +#type ("prop")##limit (14.0)# +#format# +#free (6.0)# +#type ("roman.18")# +#on("b")#EUDAS#off("b")# +#free (1.0)# +#type ("roman.14")# +#on("b")#Anwender-#off("b")# +#on("b")#Datenverwaltungssystem#off("b")# +#free (2.0)# +#type ("10")# +#on ("b")#VERSION 4#off("b")# +#free(1.0)# +#on("u")#                                                    #off("u")# +#free (0.5)# +#on("b")#BENUTZERHANDBUCH#off("b")# +#type ("prop")##block# +#page# +#free (12.0)# +Ausgabe Juli 1987 + +Dieses Handbuch und das zugehörige Programm sind urheberrechtlich +geschützt. Die dadurch begründeten Rechte, insbesondere der Ver­ +vielfältigung in irgendeiner Form, bleiben dem Autor vorbehalten. + +Es kann keine Garantie dafür übernommen werden, daß das Pro­ +gramm für eine bestimmte Anwendung geeignet ist. Die Verantwor­ +tung dafür liegt beim Kunden. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrekt­ +heit und Vollständigkeit der Angaben wird aber keine Gewähr über­ +nommen. Das Handbuch kann jederzeit ohne Ankündigung geändert +werden. + +(c) Copyright 1987 Thomas Berlage + Software-Systeme + Im alten Keller 3 +#free (0.1)# + D-5205 Sankt Augustin 1 +#page# +#type ("roman.24")# +#free (7.0)# +#center##on("b")#I.#off("b")# +#free (1.0)# +#type ("roman.18")# +#center##on("b")#DIE#off("b")# +#center##on("b")#ERSTEN#off ("b")# +#center##on("b")#SCHRITTE#off("b")# +#page# +#type ("roman.24")# +#free (7.0)# +#center##on("b")#II.#off("b")# +#free (1.0)# +#type ("roman.18")# +#center##on("b")#EINFÜHRUNG#off("b")# +#center##on("b")#IN DIE#off ("b")# +#center##on("b")#BENUTZUNG#off("b")# +#page# +#free (7.0)# +#type ("roman.24")# +#center##on("b")#III.#off("b")# +#free (1.0)# +#type ("roman.18")# +#center##on("b")#WEITERE#off("b")# +#center##on("b")#MÖGLICHKEITEN#off("b")# +#page# +#free (7.0)# +#type ("roman.24")# +#center##on("b")#IV.#off("b")# +#free (1.0)# +#type ("roman.18")# +#center##on("b")#ANHANG#off("b")# + diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.vorwort b/app/eudas/4.4/doc/user-manual/eudas.hdb.vorwort new file mode 100644 index 0000000..2b372b4 --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.vorwort @@ -0,0 +1,59 @@ +#type ("prop")##limit (14.0)# +#format# +#kapitel (" ", " Vorwort", "", " ")# + + + +Lieber EUDAS-Benutzer ! + +Dieses Handbuch soll Sie bei Ihrer Arbeit mit EUDAS begleiten. Ob­ +wohl EUDAS nicht schwierig zu bedienen ist, gibt es doch eine Reihe +von Dingen zu lernen, ehe Sie ein EUDAS-Spezialist geworden sind. + Um Ihnen diesen Weg möglichst einfach zu machen, ist die +EUDAS-Dokumentation in zwei Handbücher aufgeteilt. Dies ist das +#on("b")#Benutzerhandbuch#off("b")#, das Ihnen eine gut lesbare Einführung in alle +Fähigkeiten von EUDAS bieten soll. Außerdem gibt es noch das +#on("b")#Referenzhandbuch#off("b")#, das Ihnen zum Nachschlagen und als Hilfe beim +Programmieren dienen soll. + + Bis Sie EUDAS gut beherrschen, sollten Sie sich also mit dem +Benutzerhandbuch beschäftigen. Das Benutzerhandbuch ist nochmal +in drei Teile aufgeteilt, um Ihnen das Lernen zu erleichtern. In +jedem Teil werden die vorher behandelten Dinge zyklisch wieder +aufgenommen und auf höherem Niveau erweitert. + Der allererste Teil des Handbuchs umfaßt nur drei Kapitel und +soll Ihnen über den ersten Tag mit EUDAS hinweghelfen. Dort finden +Sie eine Übersicht, was Sie mit EUDAS anfangen können, wie Sie das +Programm auf Ihrem Rechner installieren und ein kurzes Beispiel +zum Ausprobieren. + Im zweiten Teil lernen Sie dann die Grundkonzepte von EUDAS +anhand von zahlreichen Beispielen kennen. Sie sollten die Beispiele +am Rechner ausprobieren und ihre Bedeutung verstehen. Nach dem +Durcharbeiten dieses Teils (was höchstens wenige Tage in Anspruch +nimmt) sind Sie dann in der Lage, EUDAS für eigene Zwecke anzu­ +wenden. + Wenn Ihre Ansprüche dann wachsen, sollten Sie sich mit dem +dritten Teil befassen. Hier erhalten Sie Einblick in weitergehende +Möglichkeiten von EUDAS. Die einzelnen Kapitel sind relativ unab­ +hängig voneinander, so daß Sie nur die für Sie interessanten +genauer durchlesen müssen. + In Kapitel 8 finden Sie als Orientierung nicht nur eine Wieder­ +holung dessen, was Sie im zweiten Teil gelernt haben sollten, son­ +dern auch eine Übersicht, welche weiteren Möglichkeiten im dritten +Teil noch beschrieben werden. + + Im Referenzhandbuch finden Sie später, wenn Sie einige Erfah­ +rung gesammelt haben, eine genaue Beschreibung der Wirkungsweise +aller Funktionen. Um diese zu verstehen, sollten Sie jedoch bereits +eine grobe Ahnung der Wirkungsweise haben. + Als zweites finden Sie im Referenzhandbuch Informationen für +Programmierer, die EUDAS-Funktionen in eigenen Programmen ver­ +wenden wollen. Dies sollte jedoch in den meisten Fällen nicht not­ +wendig sein, so daß dieser Teil für Spezialisten reserviert bleibt. + + Trotz größter Bemühungen kann das Handbuch natürlich nicht +frei von Unklarheiten und Fehlern sein. Anregungen und Kritik sind +daher dringend erwünscht, um diese Dokumentation zu verbessern. + +Und nun viel Spaß bei Ihrer Arbeit mit EUDAS ! + diff --git a/app/eudas/4.4/doc/user-manual/register b/app/eudas/4.4/doc/user-manual/register new file mode 100644 index 0000000..59e47df --- /dev/null +++ b/app/eudas/4.4/doc/user-manual/register @@ -0,0 +1,482 @@ +#type ("prop")##limit (6.5)# +#format# +#page (181)# +#kapitel (" ", "Register ", "", " ")# + + + +#columns (2, 0.5)# +#limit (6.5)# +#bsp("%")# 63, 69, 148 +#bsp("%%")# 141 +#bsp("&")# 63, 69, 103, 148 +#bsp("")# 57 +#bsp("--")# 103 +#bsp("..")# 102 +#bsp(".a$")# 65 +#bsp("'+'")# 107 +#bsp("'-'")# 107 + +Abbruch 35 +Abkürzungen 133 +Abkürzungsteil 134, 140 +Absatzmarken 125, 129 +Abschlußzeile 45 +Abschneiden 71 +Abschnitt 67, 69, 134 +Alternative 99 + -, globale 100 + -, lokale 99 +AND 162 +Ändern 55 +Änderungen 83, 85, 90, 95 + -, automatisch 121 +Änderungsmuster 121, 166 +Anführungsstrich 27, 34 +Ankreuzen 36, 40 +Anrede 138 +Anweisung 63 + -, Textkosmetik 74 +Anzeige 44 + -, rollen 97 +Arbeitsbereich 16 +Arbeitskopie 56, 84, 173 + -, Beispiel 58 + -, löschen 57 +Arbeitstask 16 +Archiv 32 + -, anmelden 34 + -diskette 36 + -, lesen 34 + -, löschen 176 + -manager 175, 177 + -menü 33, 174 + -name 34, 36 + -, schreiben 36 + -übersicht 175 +Arithmetik 161 +Attribut 4, 29 +Aufräumen 173 +Ausdrucken 66 +Ausdrücke 116, 151 + -, Zusammensetzung 152 +Ausgabedatei 66 +Ausgaberichtung 65 +Auswahlzustand 36, 40 +Automatische Änderungen 121 + +Bedienungsregeln 39 +begin 16 +Benutzerhandbuch i +Berechnungen 8 +Bewegen 45 +Bildschirmaufbau 45 +Bitte warten 34, 40 +blättern 46 +BOOL 154, 162 + +Carriage Return 15 +CAT 167 +CONST 155 +CR 15 +Cursor 35, 46 + -tasten 54 + +date 137 +Datei 27 + -arten 27 + -, aufräumen 173 + -auswahl 36 + -größe, Begrenzung 124 + -, kopieren 172 + -limit 71 + -, löschen 38, 172 + -namen 172 + -, Platzbedarf 173 + -, reorganisieren 174 + -sperre 95 + -, umbenennen 172 + -verwaltung 37 + -, virtuelle 83 +Dateien, Archiv 174 + - (Menü) 38, 171 + -, System 171 +DATEIENDE 106 +Daten, ändern 55 + -, anzeigen 44 + -, sichern 33 + -typen 152 + -typen, umwandeln 154 + -verwaltung 3 +Datum 44, 99, 133, 137 +DATUM 112 +DECR 167 +Denotation 154 +Dezimalkomma 111, 161 +Dezimalpunkt 148 +DIN 112 +Diskette 28, 32 + -, formatieren 176 + -, initialisieren 176 +Diskettenlaufwerk 175 +Doppeleinträge 121 +DOS 178 +Druckausgabe, Bearbeitung 125 +Drucken 7, 61 + -, Ablauf 66 + -, Aufruf 64, 66 + - (Menü) 22, 65 + -, Übersicht 175 +Druckersteuerungsanweisungen + 74, 124 +Druckmuster 13, 23, 61, 166 + -, Fehler 134 + -, Übersetzung 134, 142 + -, Zeilenlänge 71 +Druckrichtung 123 +Druckverfahren 62 + +Editieren 64 +Editor 34, 41, 52, 125 +eindeutige felder 121 +Einfügen 18, 52 +Eingabe, Daten 52 + -, Suchmuster 46 +Eingabeüberprüfung 112 +Eingabezustand 35, 40 +Eingangsmenü 17 +Einzelsatz (Menü) 18, 44, 92, 97 +ELAN-Anweisungen 141 +ELAN-Ausdrücke 116, 151 +ELAN-Compiler 134 +ELIF 168 +ELSE 139 +ENDE 45 +Endesatz 45, 48, 53, 85 +ENTER 15 +ESC '1' 107 +ESC '?' 31, 39, 40 +ESC '9' 107 +ESC 'D' 99 +ESC ESC 41, 111 +ESC 'F' 67 +ESC 'g' 99 +ESC 'h' 35, 39, 40, 55, 107 +ESC 'K' 92 +ESC OBEN 97 +ESC 'p' 99 +ESC 'P' 118 +ESC 'q' 32ff.,40 , 47, 65, 107 +ESC RUBIN 54 +ESC RUBOUT 54 +ESC UNTEN 97 +ESC 'w' 32, 40, 53 +ESC 'z' 32, 36, 40, 95 +Etiketten 126 +eudas 30, 125 +EUDAS-Archivdiskette 11, 29 +EUDAS-Datei 27, 61, 171 + -, drucken 61 + -, einrichten 17, 51 + -, Grenzen 29 + -, kopieren 113 + -, Mehrfachbenutzung 93 + -, Struktur 28 +EUDAS, Aufruf 30 + -, Installation 11 + -, Start 15 + -, Verlassen 24, 32 +EUMEL-Netz 175 +EUMEL-Textverarbeitung 5 +EUMEL-Zeichencode 110 + +f 117, 134, 156 +FALSE 154 +Fehler, Druckmuster 66 + -, quittieren 36 + -zustand 35, 40 +Feld 29 +Feldauswahl 97, 106 +Felder, anfügen 111, 114 +Feldinhalt 29, 156, 160 +feldmaske 120 +Feldmuster 63, 69 +Feldmustertypen 71 +Feldnamen 29, 67 + -, abfragen 67 + -, Abgrenzung 72 + -, ändern 112 + -, eingeben 51 + -, Länge 133 +Feldreihenfolge 113 +Feldstruktur 111 +Feldteil 45 +Feldtypen 110, 154 + -, ändern 111 +Feldvergleich 103 +Formatieren 177 +Formbrief 74 +Formular 8, 44 +Fragezustand 38, 40 +Funktionen 152 + -, ausführen 31, 46 + -, auswählen 30 + -, gesperrt 31 +Fußzeile 44 + +Gib Kommando 41, 11 +global manager 93 +GRUPPE 145 +Gruppen 144 + -definition 145 + -, mehrere 145 + -wechsel 145 +gruppenwechsel 145 + +halt 39, 110 +Hardwarefehler 33 +Hauptdatei 87ff. +Hilfe 31 +Hilfezustand 31, 40 +Hilfstexte 13, 31 +Hintergrunddiskette 12 +Hintergrundengpaß 124 +Holen 56 +HOP OBEN 40, 98, 106 +HOP RETURN 106 +HOP RUBIN 54 +HOP RUBOUT 54 +HOP UNTEN 40, 98, 106 +HOP 'x' 98 + +IF 117 +IF-Abfragen 161, 168 +IF-Anweisungen 138 +INCR 167 +Init 176 +Initialisierungsteil 124, 143 +Installation 11 +int 140 +INT 153 + +K 113 +Karteikarten 5 +KB 173 +Ketten 13, 83, 85, 95 +Kilobyte 173 +Klammern 163 + -, spitze 72 +Kombination 89 +Kombinationsnummer 90 +Kopieren, logisch 172 + -, EUDAS-Datei 112 + - (vom Archiv) 34, 176 +Kopieranweisung 113 +Kopiermuster 113, 115, 166 + -, Übersetzung 116 +KOPPEL 92 +Koppeldatei, Markierung 105 + -, Position 93 + -, umschalten 92 +Koppelfeld 86, 89 + -, übernehmen 92 +Koppeln 13, 83, 85, 95 + -, mehrere Dateien 87 +Koppelvorgang, Schema 87 +Korrekturversion 14 + +Länge, feste 70, 137 + -, variable 70 +Leerautomatik 73 +Leertaste 17, 31 +length 158 +lfd nr 137, 157 +limit 71, 125 +lineform 125, 129 +LINKS 31, 35 +linksbündig 71 +Linksschieben 128 +list (archive) 34 +Löschen 55 + - (auf Archiv) 176 + - (Datei) 172 + +Manager 93, 95 +Managertask 175 +MARK 104 +Markieren 104 + -, in Übersicht 107 +Markierung 104 + -, löschen 105 +maxdruckzeilen 124 +MEHR 129 +Mehrfachbenutzung 93 +Menü 30 +Menüzustand 31, 40 +min 155 +Modi 128 +Multi-User 12 +Multi-User-System 16 +Musterbrief 139 +Musterteil 135 +Musterzeichen 70 + +Nachbearbeitung 125 +Nachspann 68, 144 +NACHSPANN 68 +Negation 103 +Netz 175 +Numerieren 137 + +'o' 40, 98 +OBEN 30, 106 +ODER 100 +Öffnen 17, 21, 43, 51, 57, 83, 95 + - (Menü) 30 +Operatoren 152, 155 + -, Priorität 163 +OR 163 + +pageform 125 +Paralleleditor 67, 142 +Parameter 152 +Paßwort 94, 177 +Pfeiltasten 54 +Platzbedarf, Datei 173 +pos 159 +Position, feste 69 + -, variable 69 +Positionierung 48 +Proportionalschrift 129 +Prüfbedingungen 118 +pruefe 120 +PUBLIC 13 + +REAL 153 +real 155 +RECHTS 31, 55 +rechtsbündig 71, 137 +Referenzhandbuch i, 79 +Refinement 134, 140, 163 +Reorganisieren 174 +Reservieren 178 +RET 15 +RETURN 15 +Richtung, Druckausgabe 65, 123 +Rollen 97, 106 +RUBIN 35, 54 +RUBOUT 35, 54 +Runden 160 + +Satz 29 + -, anwählen 46 + -editor 41, 47, 53, 92, 98 + -, einfügen 52 + -, holen 56 + -, löschen 55 + -, tragen 55 +Satz.Nr 46, 48 +Satznummer 45, 90 +Satzauswahl, kopieren 114 +Schreiben (auf Archiv) 36, 176 +Schreibmarke 35 +Schrifttypen 125 +Selektion 48 +Sichern 20, 56, 84, 95 +Single-User 12 +Single-User-System 16 +Sortieren 109 + -, Optimierung 110 + -, Zieldatei 115 +Sortierreihenfolge 109 +Spaltenbreite 126 +Spaltendruck 126 +Speicherplatz 14, 38, 176 + -, Datei 173 +Sperren von Dateien 95 +Standard-Kopiermuster 115 +Stationsnummer 175 +Statistik 169 +Statuszeile 31, 39 +Stern 50, 101 +SUB 158, 163 +subtext 158 +SUCH 47 +Suchbedingung f. Drucken 67 +Suchbedingung, Kombination 49 +Suchbedingung löschen 48 +Suchbedingung setzen 46 +Suchen 21, 46 + -, Optimierung 104 +Suchmuster 47, 99 + -, Eingabe 47 +SV-Taste 16, 39 +System 32 + +Tabellenmodus 128 +Tagesdatum 99 +Task, Manager 93 +Tasks 13 +Teildatei 114 +Teiltexte 158 +TEXT 112, 153 +text 140 +Textdatei 28, 61, 171 + -, ändern 65 + -, ansehen 65 + -, ausdrucken 66 + -, editieren 64 +Texte, verketten 156 +Text-Funktionen 156 +Textkonstanten 139 +Text, konstanter 117 +Text, Länge 158 +Textverarbeitung 3, 123 +THEN 139 +Tragen 55, 118 +TRUE 154 + +Uhrzeit 133 +Umbruch 129 +Umlaute 143 +Umschalten auf Koppeldatei 92 +UND 100ff. +UNTEN 30, 106 +Überschrift 45, 68 +Übersicht (Archiv) 34, 175 + - (Dateien) 37, 171 + - (Sätze) 105 + +V 122 +VAR 165 +Variablen 165 + -, Initialisierung 143, 167 + -, Lebensdauer 166 + -, Typ 165 +Verändern 121 +Vergleiche 102, 162 +virtuelle Datei 83 +Vorspann 68, 144 +VORSPANN 68 + +Weiter 45, 48, 90 +wert 148, 160 +wertemenge 119 +WIEDERHOLUNG 63, 126 + +'x' 36, 40 + +ZAHL 110 +zahltext 148, 160 +Zeichen, reservierte 64, 69, 103 +Zeigen 40 +Zeile einfügen 54 +Zeilenfortsetzung 129 +Zeilenlänge 71 +Zielarchiv 175 +Zieldatei, Struktur 113 +Zurück 45, 48, 90 +Zustand 31, 40 +Zuweisung 166 + + diff --git a/app/eudas/4.4/source-disk b/app/eudas/4.4/source-disk new file mode 100644 index 0000000..5777895 --- /dev/null +++ b/app/eudas/4.4/source-disk @@ -0,0 +1,3 @@ +eudas/eudas-4_refdoc_1987-09.img +eudas/eudas-4_userdoc_1987-07.img +eudas/eudas-4.4_1987-10-01.img diff --git a/app/eudas/4.4/src/eudas.dateistruktur b/app/eudas/4.4/src/eudas.dateistruktur new file mode 100644 index 0000000..b4a57e5 --- /dev/null +++ b/app/eudas/4.4/src/eudas.dateistruktur @@ -0,0 +1,1690 @@ +PACKET eudas dateien + +(*************************************************************************) +(* *) +(* EUDAS-Dateien als indexsequentielle Dateien *) +(* *) +(* Version 05 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 25.04.87 *) +(* *) +(*************************************************************************) + + DEFINES + + EUDAT, +(*dump, Test *) + oeffne, + satznr, + dateiende, + saetze, + auf satz, + weiter, + zurueck, + satz lesen, + satz aendern, + satz loeschen, + satz einfuegen, + feld lesen, + feld aendern, + feld bearbeiten, + felderzahl, + feldnamen lesen, + feldnamen aendern, + notizen lesen, + notizen aendern, + feldinfo, + automatischer schluessel, + dezimalkomma, + wert berechnen, + reorganisiere, + sortiere, + sortierreihenfolge, + unsortierte saetze : + + +LET + maxhash = 531, + maxindex = 121, + maxsatz = 5000, + eudat typ = 3243, + maxeintrag = 64, + dreiviertel maxeintrag = 48; + +LET + INTVEC = TEXT, + + INDEX = STRUCT + (INT vorgaenger, nachfolger, + INT eintraege, stelle, + INTVEC satzindex), + + EINTRAG = STRUCT + (INT vorgaenger, nachfolger, indexblock, attribut, + SATZ satz), + + DATEI = STRUCT + (INT felderzahl, + SATZ feldnamen, + INTVEC feldinfo, + TEXT sortierfelder, + INT letzter index, indexblocks, erster leerindex, + INT erster leersatz, anz satzeintraege, + INT anz saetze, satznr, + INT indexzeiger, indexstelle, satzzeiger, + INT anz unsortierte, schluesselzaehler, + ROW 3 TEXT notizen, + ROW maxhash INT hashliste, + ROW maxindex INDEX index, + ROW maxsatz EINTRAG ablage); + +TYPE EUDAT = BOUND DATEI; + +LET + niltext = ""; + +LET + datei ist keine eudas datei = #201# + "Datei ist keine EUDAS-Datei", + inkonsistente datei = #202# + "inkonsistente EUDAS-Datei", + eudas datei voll = #203# + "EUDAS-Datei voll", + nicht erlaubtes dezimalkomma = #204# + "Nicht erlaubtes Dezimalkomma"; + +TEXT VAR + feldpuffer; + +TEXT VAR + inttext := " "; + +INTVEC CONST + blockreservierung := intvec (maxeintrag, 1); + + +(*************************** Test-Dump ***********************************) +(* +PROC dump (EUDAT CONST datei, TEXT CONST file) : + + FILE VAR f := sequential file (output, file); + idump (CONCR (datei), f) + +END PROC dump; + +PROC idump (DATEI CONST datei, FILE VAR f) : + + put (f, "Felderzahl:"); put (f, datei. felderzahl); line (f); + INT VAR i; putline (f, "feldnamen:"); + FOR i FROM 1 UPTO felderzahl (datei. feldnamen) REP + TEXT VAR feld; feld lesen (datei. feldnamen, i, feld); + write (f, feld); write (f, ",") + END REP; line (f); putline (f, "feldinfo:"); + FOR i FROM 1 UPTO length (datei. feldinfo) DIV 2 REP + put (f, datei. feldinfo ISUB i) + END REP; line (f); + put (f, "letzter index:"); put (f, datei. letzter index); + put (f, "indexblocks:"); put (f, datei. indexblocks); + put (f, "erster leerindex:"); put (f, datei. erster leerindex); line (f); + put (f, "erster leersatz:"); put (f, datei. erster leersatz); + put (f, "anz satzeintraege:"); put (f, datei. anz satzeintraege); line (f); + put (f, "anz saetze:"); put (f, datei. anz saetze); + put (f, "satznr:"); put (f, datei.satznr); line (f); + put (f, "indexzeiger:"); put (f, datei. indexzeiger); + put (f, "indexstelle:"); put (f, datei. indexstelle); + put (f, "satzzeiger:"); put (f, datei. satzzeiger); line (f); + put (f, "anz unsortierte:"); put (f, datei. anz unsortierte); line (f); + ROW 10 INT VAR anzahl ketten; + FOR i FROM 1 UPTO 10 REP anzahl ketten (i) := 0 END REP; + FOR i FROM 1 UPTO maxhash REP + INT VAR laenge := 0; + laenge der hashkette bestimmen; + IF laenge > 10 THEN laenge := 10 END IF; + IF laenge > 0 THEN anzahl ketten (laenge) INCR 1 END IF + END REP; + put (f, "Hash:"); + FOR i FROM 1 UPTO 10 REP put (f, anzahl ketten (i)) END REP; line (f); + FOR i FROM 1 UPTO datei. indexblocks REP + put (f, "INDEX"); put (f, i); put (f, "vor:"); put (f, + datei. index (i). vorgaenger); put (f, "nach:"); put (f, + datei. index (i). nachfolger); put (f, "eintraege:"); put (f, + datei. index (i). eintraege); line (f); INT VAR j; + FOR j FROM 1 UPTO length (datei. index (i). satzindex) DIV 2 REP + put (f, datei. index (i). satzindex ISUB j) + END REP; + line (f) + END REP; + FOR i FROM 1 UPTO datei. anz satzeintraege REP + put (f, "SATZ"); put (f,i); put (f, "vor:"); put (f, + datei. ablage (i). vorgaenger); put (f, "nach:"); put (f, + datei. ablage (i). nachfolger); put (f, "index:"); put (f, + datei. ablage (i). indexblock); put (f, "attr:"); put (f, + datei. ablage (i). attribut); line (f); + FOR j FROM 1 UPTO felderzahl (datei. ablage (i). satz) REP + feld lesen (datei. ablage (i). satz, j, feld); + write (f, feld); write (f, ",") + END REP; cout (i); + line (f) + END REP . + +laenge der hashkette bestimmen : + INT VAR index := datei. hashliste (i); + WHILE index <> 0 REP + index := datei. ablage (index). vorgaenger; + laenge INCR 1 + END REP . + +END PROC i dump; +*) + +(**************************** INTVEC *************************************) + +(* An Stelle von maximal dimensionierten ROW max INT werden an ver- *) +(* schiedenen Stellen TEXTe mit eingeschriebenen Integern verwendet. *) +(* Auf diese Art und Weise werden auch das Einfuegen und Loeschen, sowie *) +(* das Aufsplitten und Zusammenfuegen effizienter realisiert. *) + +LET + empty intvec = ""; + +TEXT VAR + buffer; + +INTVEC PROC intvec (INT CONST length, value) : + + replace (inttext, 1, value); + length * inttext + +END PROC intvec; + +PROC insert (INTVEC VAR vector, INT CONST pos, value) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (vector) + 1 THEN + subscript overflow + ELSE + replace (inttext, 1, value); + buffer := subtext (vector, begin); + vector := subtext (vector, 1, begin - 1); + vector CAT inttext; + vector CAT buffer + END IF + +END PROC insert; + +PROC delete (INTVEC VAR vector, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin >= length (vector) THEN + subscript overflow + ELSE + buffer := subtext (vector, begin + 2); + vector := subtext (vector, 1, begin - 1); + vector CAT buffer + END IF + +END PROC delete; + +INT PROC pos (INTVEC CONST vector, INT CONST value) : + + replace (inttext, 1, value); + INT VAR begin := 1; + REP + begin := pos (vector, inttext, begin) + 1 + UNTIL (begin AND 1) = 0 OR begin = 1 END REP; + begin DIV 2 + +END PROC pos; + +PROC split up (INTVEC VAR source, dest, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (source) + 1 THEN + subscript overflow + ELSE + dest := subtext (source, begin); + source := subtext (source, 1, begin - 1) + END IF + +END PROC split up; + +PROC split down (INTVEC VAR source, dest, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (source) + 1 THEN + subscript overflow + ELSE + dest := subtext (source, 1, begin - 1); + source := subtext (source, begin) + END IF + +END PROC split down; + +. +subscript overflow : + errorstop (9, niltext) . + +subscript underflow : + errorstop (10, niltext) . + + +(************************** Datei oeffnen ********************************) + +PROC initialisiere eudat (DATEI VAR datei) : + + datei. felderzahl := 0; + datei. feldinfo := empty intvec; + satz initialisieren (datei. feldnamen); + datei. sortierfelder := niltext; + datei. letzter index := 1; + datei. indexblocks := 1; + datei. erster leersatz := 0; + datei. erster leerindex := 0; + datei. anz saetze := 0; + datei. anz satzeintraege := 1; + datei. anz unsortierte := 0; + datei. notizen (1) := niltext; + datei. notizen (2) := niltext; + datei. notizen (3) := niltext; + datei. satznr := 1; + datei. indexzeiger := 1; + datei. indexstelle := 1; + datei. satzzeiger := 1; + datei. index (1). satzindex := blockreservierung; + datei. index (1) := INDEX : (0, 0, 1, 1, intvec(1, 1)); + INT VAR i; + FOR i FROM 1 UPTO maxhash REP + datei. hashliste (i) := 0 + END REP; + datei. ablage (1) := EINTRAG : (0, 0, 1, 0, leersatz) . + +leersatz : + datei. feldnamen . + +END PROC initialisiere eudat; + +PROC oeffne (EUDAT VAR datei, TEXT CONST dateiname) : + + enable stop; + IF NOT exists (dateiname) THEN + CONCR (datei) := new (dateiname); + initialisiere eudat (CONCR (datei)); + type (old (dateiname), eudat typ) + ELIF type (old (dateiname)) = eudat typ THEN + CONCR (datei) := old (dateiname) + ELSE + errorstop (datei ist keine eudas datei) + ENDIF + +END PROC oeffne; + +PROC oeffne (EUDAT VAR datei, DATASPACE CONST ds) : + + IF type (ds) < 0 THEN + CONCR (datei) := ds; + initialisiere eudat (CONCR (datei)); + type (ds, eudat typ) + ELIF type (ds) = eudat typ THEN + CONCR (datei) := ds + ELSE + errorstop (datei ist keine eudas datei) + END IF + +END PROC oeffne; + + +(************************* Feldzugriffe **********************************) + +PROC feld lesen (EUDAT CONST datei, INT CONST feldnr, TEXT VAR inhalt) : + + feld lesen (aktueller satz, feldnr, inhalt) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld lesen; + +PROC feld aendern (EUDAT VAR datei, INT CONST feldnr, + TEXT CONST neuer inhalt) : + + IF nicht hinter letztem satz THEN + aktueller satz unsortiert (CONCR (datei)); + moeglicherweise schluessel aendern; + feld aendern (aktueller satz, feldnr, neuer inhalt) + END IF . + +nicht hinter letztem satz : + datei. satzzeiger <> 1 . + +moeglicherweise schluessel aendern : + IF feldnr = 1 THEN + disable stop; + schluessel aendern (CONCR (datei), hashindex (neuer inhalt)) + END IF . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld aendern; + +INT PROC felderzahl (EUDAT CONST datei) : + + datei. felderzahl + +END PROC felderzahl; + +PROC feld bearbeiten (EUDAT CONST datei, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + feld bearbeiten (aktueller satz, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld bearbeiten; + + +(************************* Feldinformationen *****************************) + +(* Jedes Feld der Datei hat einen Namen und eine Typinformation. Die *) +(* Anzahl der vorhandenen Felder richtet sich nach dem hoechsten ver- *) +(* gebenen Feldnamen. 'feldinfo' kann folgende Werte annehmen : *) +(* -1 : normales Textfeld *) +(* 0 : Textfeld, das nach DIN-Norm verglichen wird *) +(* 1 : Zahlfeld (alle irrelevanten Zeichen werden ignoriert) *) +(* 2 : Datum mit einer Laenge von 8 Zeichen *) +(* Das Feldinfo eines noch nicht eingerichteten Feldes fuehrt zu *) +(* einer Fehlermeldung. *) + +PROC feldnamen lesen (EUDAT CONST datei, SATZ VAR namen) : + + namen := datei. feldnamen + +END PROC feldnamen lesen; + +PROC feldnamen aendern (EUDAT VAR datei, SATZ CONST neue namen) : + + datei. feldnamen := neue namen; + INT CONST neue felder := felderzahl (neue namen); + IF neue felder > datei. felderzahl THEN + feldinfo erweitern; + datei. felderzahl := neue felder + END IF . + +feldinfo erweitern : + datei. feldinfo CAT intvec (fehlende zeilen, - 1) . + +fehlende zeilen : + neue felder - length (datei. feldinfo) DIV 2. + +END PROC feldnamen aendern; + +INT PROC feldinfo (EUDAT CONST datei, INT CONST feldnr) : + + datei. feldinfo ISUB feldnr + +END PROC feldinfo; + +PROC feldinfo (EUDAT VAR datei, INT CONST feldnr, zeilen) : + + replace (datei. feldinfo, feldnr, zeilen); + IF pos (datei. sortierfelder, code (feldnr)) > 0 THEN + datei. anz unsortierte := datei. anz saetze + END IF + +END PROC feldinfo; + + +(*************************** Positionsabfragen ***************************) + +INT PROC satznr (EUDAT CONST datei) : + + datei. satznr + +END PROC satznr; + +BOOL PROC dateiende (EUDAT CONST datei) : + + datei. satznr > datei. anz saetze + +END PROC dateiende; + +INT PROC saetze (EUDAT CONST datei) : + + datei. anz saetze + +END PROC saetze; + + +(***************************** Positionieren *****************************) + +(* Positioniert werden kann nach der Satznummer oder nach dem ersten *) +(* Feld. Das erste Feld kann durch eine Hashtabelle schnell gefunden *) +(* werden. In der Hashtabelle sind die Saetze nach absoluten Positionen *) +(* eingetragen und nicht nach Satznummern. Ueber den Rueckverweis auf *) +(* den Indexblock kann die Satznummer zu einem gegebenen Satz gefunden *) +(* werden. *) + +PROC neue satzposition (DATEI VAR datei, INT CONST indexzeiger, stelle, + satznr) : + + IF indexzeiger < 1 OR indexzeiger > datei. indexblocks COR + stelle < 1 OR stelle > datei. index (indexzeiger). eintraege THEN + errorstop (inkonsistente datei) + END IF; + disable stop; + datei. indexzeiger := indexzeiger; + datei. indexstelle := stelle; + datei. satznr := satznr; + datei. satzzeiger := datei. index (indexzeiger). satzindex ISUB stelle + +END PROC neue satzposition; + +PROC auf satz (EUDAT VAR datei, INT CONST nr) : + + INT VAR satznr; + IF nr < 1 THEN + satznr := 1 + ELIF nr > datei. anz saetze THEN + satznr := datei. anz saetze + 1 + ELSE + satznr := nr + END IF; + auf satz intern (CONCR (datei), satznr) + +END PROC auf satz; + +PROC auf satz (EUDAT VAR datei, TEXT CONST muster) : + + auf satz (datei, 1); + IF nicht auf erstem satz THEN + weiter (datei, muster) + END IF . + +nicht auf erstem satz : + feld lesen (datei, 1, feldpuffer); + feldpuffer <> muster . + +END PROC auf satz; + +PROC auf satz intern (DATEI VAR datei, INT CONST satznr) : + + IF von anfang naeher THEN + neue satzposition (datei, 1, 1, 1) + END IF; + INT VAR + indexzeiger := datei. indexzeiger, + erreichter satz := datei. satznr - datei. indexstelle; + IF satznr > datei. satznr THEN + vorwaerts gehen + ELSE + rueckwaerts gehen + END IF; + neue satzposition (datei, indexzeiger, stelle, satznr) . + +von anfang naeher : + satznr + satznr < datei. satznr . + +vorwaerts gehen : + WHILE noch vor satz REP + erreichter satz INCR eintraege; + indexzeiger := datei. index (indexzeiger). nachfolger + END REP . + +noch vor satz : + INT CONST eintraege := datei. index (indexzeiger). eintraege; + erreichter satz + eintraege < satznr . + +rueckwaerts gehen : + WHILE noch hinter satz REP + indexzeiger := datei. index (indexzeiger). vorgaenger; + erreichter satz DECR datei. index (indexzeiger). eintraege + END REP . + +noch hinter satz : + erreichter satz >= satznr . + +stelle : + satznr - erreichter satz . + +END PROC auf satz intern; + +PROC weiter (EUDAT VAR datei) : + + weiter intern (CONCR (datei)) + +END PROC weiter; + +PROC weiter intern (DATEI VAR datei) : + + IF nicht dateiende THEN + naechster satz + END IF . + +nicht dateiende : + datei. satzzeiger <> 1 . + +naechster satz : + INT VAR + indexzeiger := datei. indexzeiger, + stelle := datei. indexstelle; + + IF stelle = index. eintraege THEN + indexzeiger := index. nachfolger; + stelle := 1 + ELSE + stelle INCR 1 + END IF; + neue satzposition (datei, indexzeiger, stelle, datei. satznr + 1) . + +index : + datei. index (indexzeiger) . + +END PROC weiter intern; + +PROC zurueck (EUDAT VAR datei) : + + zurueck intern (CONCR (datei)) + +END PROC zurueck; + +PROC zurueck intern (DATEI VAR datei) : + + IF nicht am anfang THEN + voriger satz + END IF . + +nicht am anfang : + datei. satznr <> 1 . + +voriger satz : + INT VAR + indexzeiger := datei. indexzeiger, + stelle := datei. indexstelle; + + IF stelle = 1 THEN + indexzeiger := indexblock. vorgaenger; + stelle := indexblock. eintraege + ELSE + stelle DECR 1 + END IF; + neue satzposition (datei, indexzeiger, stelle, datei. satznr - 1) . + +indexblock : + datei. index (indexzeiger) . + +END PROC zurueck intern; + +PROC weiter (EUDAT VAR datei, TEXT CONST muster) : + + weiter intern (CONCR (datei), muster) + +END PROC weiter; + +PROC weiter intern (DATEI VAR datei, TEXT CONST muster) : + + stelle in hashkette bestimmen; + WHILE noch weitere saetze CAND muster nicht gefunden REP + eine stelle weiter + END REP; + IF noch weitere saetze THEN + positioniere intern (datei, stelle) + ELSE + auf satz intern (datei, datei. anz saetze + 1) + END IF . + +stelle in hashkette bestimmen : + INT VAR dummy, stelle := datei. satzzeiger; + IF muster nicht gefunden THEN + stelle in hashkette (datei, hashindex (muster), stelle, dummy) + ELSE + eine stelle weiter + END IF . + +noch weitere saetze : + stelle <> 0 . + +muster nicht gefunden : + feld lesen (aktueller satz, 1, feldpuffer); + feldpuffer <> muster . + +aktueller satz : + datei. ablage (stelle). satz . + +eine stelle weiter : + stelle := datei. ablage (stelle). nachfolger . + +END PROC weiter intern; + +PROC zurueck (EUDAT VAR datei, TEXT CONST muster) : + + zurueck intern (CONCR (datei), muster) + +END PROC zurueck; + +PROC zurueck intern (DATEI VAR datei, TEXT CONST muster) : + + stelle in hashkette bestimmen; + WHILE noch weitere saetze CAND muster nicht gefunden REP + eine stelle zurueck + END REP; + IF noch weitere saetze THEN + positioniere intern (datei, stelle) + ELSE + auf satz intern (datei, 1) + END IF . + +stelle in hashkette bestimmen : + INT VAR stelle := datei. satzzeiger, dummy; + IF stelle = 1 OR schluessel stimmt nicht ueberein THEN + stelle in hashkette (datei, hashindex (muster), dummy, stelle) + END IF . + +noch weitere saetze : + stelle <> 0 . + +muster nicht gefunden : + stelle = datei. satzzeiger OR schluessel stimmt nicht ueberein . + +schluessel stimmt nicht ueberein : + feld lesen (aktueller satz, 1, feldpuffer); + feldpuffer <> muster . + +aktueller satz : + datei. ablage (stelle). satz . + +eine stelle zurueck : + stelle := datei. ablage (stelle). vorgaenger . + +END PROC zurueck intern; + +PROC positioniere intern (DATEI VAR datei, INT CONST stelle) : + + INT CONST zielblock := datei. ablage (stelle). indexblock; + INT VAR + indexstelle := 1, + satznr := 0; + WHILE indexstelle <> zielblock REP + satznr INCR datei. index (indexstelle). eintraege; + indexstelle := datei. index (indexstelle). nachfolger + END REP; + indexstelle := pos (datei. index (zielblock). satzindex, stelle); + satznr INCR indexstelle; + neue satzposition (datei, zielblock, indexstelle, satznr) . + +END PROC positioniere intern; + + +(************************* Hashverwaltung ********************************) + +INT VAR index; + +PROC hashindex berechnen (TEXT CONST feld, INT CONST von, bis) : + + INT VAR + zeiger := von; + index := 0; + IF bis - von < 4 THEN + mit faktor 4 streuen + ELSE + mit faktor 2 streuen + END IF; + index := index MOD maxhash + 1 . + +mit faktor 4 streuen : + WHILE zeiger <= bis REP + index := index * 4; + index INCR code (feld SUB zeiger); + zeiger INCR 1 + END REP . + +mit faktor 2 streuen : + WHILE zeiger <= bis REP + index INCR index; + index INCR code (feld SUB zeiger); + IF index > 16000 THEN index := index MOD maxhash END IF; + zeiger INCR 1 + END REP . + +END PROC hashindex berechnen; + +INT PROC hashindex (TEXT CONST feld) : + + hashindex berechnen (feld, 1, length (feld)); + index + +END PROC hashindex; + +INT PROC hashindex (SATZ CONST satz) : + + feld bearbeiten (satz, 1, + PROC (TEXT CONST, INT CONST, INT CONST) hashindex berechnen); + index + +END PROC hashindex; + +PROC stelle in hashkette (DATEI CONST datei, INT CONST hashindex, + INT VAR stelle, vorher) : + + INT VAR indexzeiger := datei. letzter index; + vorher := datei. hashliste (hashindex); + stelle := 0; + BOOL VAR hinter aktuellem satz := TRUE; + WHILE hinter aktuellem satz AND vorher <> 0 REP + stelle untersuchen; + eine stelle weiter + END REP . + +stelle untersuchen : + IF verweis auf aktuellen block THEN + ueberpruefe innerhalb block + ELSE + teste ob aktueller block in indexkette + END IF . + +verweis auf aktuellen block : + datei. ablage (vorher). indexblock = datei. indexzeiger . + +ueberpruefe innerhalb block : + indexzeiger := datei. indexzeiger; + INT CONST stelle in block := pos (satzindex, vorher); + IF stelle in block = 0 THEN + errorstop (inkonsistente datei) + ELIF stelle in block <= aktuelle stelle THEN + hinter aktuellem satz := FALSE + END IF . + +satzindex : + datei. index (indexzeiger). satzindex . + +aktuelle stelle : + datei. indexstelle . + +teste ob aktueller block in indexkette : + WHILE indexzeiger <> datei. ablage (vorher). indexblock REP + IF indexzeiger = datei. indexzeiger THEN + hinter aktuellem satz := FALSE; + LEAVE stelle untersuchen + ELSE + indexzeiger := datei. index (indexzeiger). vorgaenger + END IF + END REP . + +eine stelle weiter : + IF hinter aktuellem satz THEN + stelle := vorher; + vorher := datei. ablage (stelle). vorgaenger + END IF . + +END PROC stelle in hashkette; + +PROC hash ausketten (DATEI VAR datei, INT CONST hashindex) : + + disable stop; + INT CONST + stelle := datei. satzzeiger, + vorgaenger := datei. ablage (stelle). vorgaenger, + nachfolger := datei. ablage (stelle). nachfolger; + + IF nachfolger <> 0 THEN + datei. ablage (nachfolger). vorgaenger := vorgaenger + ELSE + datei. hashliste (hashindex) := vorgaenger + END IF; + IF vorgaenger <> 0 THEN + datei. ablage (vorgaenger). nachfolger := nachfolger + END IF . + +END PROC hash ausketten; + +PROC hash einketten (DATEI VAR datei, INT CONST hashindex, + nachfolger, vorgaenger) : + + disable stop; + INT CONST stelle := datei. satzzeiger; + datei. ablage (stelle). vorgaenger := vorgaenger; + datei. ablage (stelle). nachfolger := nachfolger; + IF vorgaenger <> 0 THEN + datei. ablage (vorgaenger). nachfolger := stelle + END IF; + IF nachfolger <> 0 THEN + datei. ablage (nachfolger). vorgaenger := stelle + ELSE + datei. hashliste (hashindex) := stelle + END IF + +END PROC hash einketten; + + +(************************** Satzzugriffe *********************************) + +PROC satz lesen (EUDAT CONST datei, SATZ VAR satz) : + + satz := datei. ablage (datei. satzzeiger). satz + +END PROC satz lesen; + +PROC satz aendern (EUDAT VAR datei, SATZ CONST neuer satz) : + + IF NOT dateiende (datei) THEN + satz wirklich aendern + END IF . + +satz wirklich aendern : + aktueller satz unsortiert (CONCR (datei)); + disable stop; + schluessel aendern (CONCR (datei), hashindex (neuer satz)); + aktueller satz := neuer satz . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC satz aendern; + +PROC schluessel aendern (DATEI VAR datei, INT CONST neuer hashindex) : + + IF anderer hashindex THEN + in neue hashkette + END IF . + +anderer hashindex : + INT CONST alter hashindex := hashindex (aktueller satz); + alter hashindex <> neuer hashindex . + +in neue hashkette : + in alter kette ausketten; + in neuer kette einketten . + +in alter kette ausketten : + hash ausketten (datei, alter hashindex) . + +in neuer kette einketten : + INT VAR vorgaenger, nachfolger; + stelle in hashkette (datei, neuer hashindex, vorgaenger, nachfolger); + hash einketten (datei, neuer hashindex, vorgaenger, nachfolger) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC schluessel aendern; + +PROC satz loeschen (EUDAT VAR datei) : + + IF NOT dateiende (datei) THEN + satz wirklich loeschen + END IF . + +satz wirklich loeschen : + disable stop; + satzeintrag loeschen (CONCR (datei)); + indexeintrag loeschen (CONCR (datei)); + datei. anz saetze DECR 1 . + +END PROC satz loeschen; + +PROC satzeintrag loeschen (DATEI VAR datei) : + + aktueller satz sortiert (datei); + INT CONST stelle := datei. satzzeiger; + hash ausketten (datei, hashindex (aktueller satz)); + datei. ablage (stelle). nachfolger := datei. erster leersatz; + datei. erster leersatz := stelle . + +aktueller satz : + datei. ablage (stelle). satz . + +END PROC satzeintrag loeschen; + +PROC satz einfuegen (EUDAT VAR datei, SATZ CONST neuer satz) : + + satz einfuegen intern (CONCR (datei), neuer satz) + +END PROC satz einfuegen; + +PROC satz einfuegen intern (DATEI VAR datei, SATZ CONST neuer satz) : + + INT VAR + stelle, + vorgaenger, + nachfolger; + + enable stop; + satzeintrag belegen; + ggf schluessel einfuegen; + disable stop; + datei. anz saetze INCR 1; + indexeintrag einfuegen (datei, stelle); + INT CONST neuer index := hashindex (feldpuffer); + stelle in hashkette (datei, neuer index, nachfolger, vorgaenger); + hash einketten (datei, neuer index, nachfolger, vorgaenger); + aktueller satz unsortiert (datei) . + +satzeintrag belegen : + IF datei. erster leersatz <> 0 THEN + stelle := datei. erster leersatz; + datei. erster leersatz := datei. ablage (stelle). nachfolger + ELIF datei. anz satzeintraege = maxsatz THEN + errorstop (eudas datei voll) + ELSE + datei. anz satzeintraege INCR 1; + stelle := datei. anz satzeintraege + END IF; + datei. ablage (stelle). attribut := 0; + datei. ablage (stelle). satz := neuer satz . + +ggf schluessel einfuegen : + feld lesen (neuer satz, 1, feldpuffer); + IF datei. schluesselzaehler > 0 THEN + IF feldpuffer = "" THEN + neuen schluessel erzeugen; + feld aendern (datei. ablage (stelle). satz, 1, feldpuffer) + END IF + END IF . + +neuen schluessel erzeugen : + feldpuffer := text (datei. schluesselzaehler); + feldpuffer := fuehrende nullen + feldpuffer; + IF datei. schluesselzaehler > 32000 THEN + datei. schluesselzaehler := 1 + ELSE + datei. schluesselzaehler INCR 1 + END IF . + +fuehrende nullen : + (4 - length (feldpuffer)) * "0" . + +END PROC satz einfuegen intern; + +PROC automatischer schluessel (EUDAT VAR eudat, BOOL CONST automatisch) : + + IF automatisch AND eudat. schluesselzaehler < 0 OR + NOT automatisch AND eudat. schluesselzaehler > 0 THEN + eudat. schluesselzaehler := - eudat. schluesselzaehler + END IF + +END PROC automatischer schluessel; + +BOOL PROC automatischer schluessel (EUDAT CONST eudat) : + + eudat. schluesselzaehler > 0 + +END PROC automatischer schluessel; + + +(************************* Indexverwaltung *******************************) + +(* Die logische Reihenfolge der Saetze wird durch einen Index herge- *) +(* stellt. Dieser besteht aus einer Liste von INTVECs. Ein Listenelement *) +(* nimmt Satzeintraege auf, bis die Maximalgroesse erreicht ist. In *) +(* diesem Fall wird ein neues Listenelement eingefuegt. Beim Loeschen *) +(* von Eintraegen wird ueberprueft, ob zwei benachbarte Eintraege kom- *) +(* biniert werden koennen. Steht fuer eine Anforderung kein Eintrag mehr *) +(* zur Verfuegung, wird der ganze Index reorganisiert. Es ist garantiert,*) +(* dass der Index die maximale Anzahl von Satzeintraegen aufnehmen kann. *) + +INTVEC VAR indexpuffer; + + +PROC indexeintrag loeschen (DATEI VAR datei) : + + INT CONST + indexzeiger := datei. indexzeiger, + vorgaenger := index. vorgaenger, + nachfolger := index. nachfolger; + BOOL VAR moeglich; + delete (index. satzindex, datei. indexstelle); + index. eintraege DECR 1; + indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich); + IF NOT moeglich THEN + indizes zusammenlegen (datei, vorgaenger, indexzeiger, moeglich) + END IF; + indexzeiger justieren (datei) . + +index : + datei. index (indexzeiger) . + +END PROC indexeintrag loeschen; + +PROC indizes zusammenlegen (DATEI VAR datei, INT CONST zeiger, folgezeiger, + BOOL VAR moeglich) : + + moeglich := FALSE; + IF zeiger <> 0 AND folgezeiger <> 0 THEN + versuche zusammenzulegen + END IF . + +versuche zusammenzulegen : + INT CONST + eintraege a := index. eintraege, + eintraege b := folgeindex. eintraege; + IF zusammenlegbar THEN + wirklich zusammenlegen; + moeglich := TRUE + END IF . + +zusammenlegbar: + eintraege a + eintraege b <= dreiviertel maxeintrag OR + eintraege a = 0 OR eintraege b = 0 . + +wirklich zusammenlegen : + index. eintraege INCR folgeindex. eintraege; + indexverweise aendern (datei, folgeindex. satzindex, zeiger); + index. satzindex CAT folgeindex. satzindex; + folgeindex ausketten . + +folgeindex ausketten : + index. nachfolger := folgeindex. nachfolger; + IF index. nachfolger <> 0 THEN + datei. index (index. nachfolger). vorgaenger := zeiger + ELSE + datei. letzter index := zeiger + END IF; + folgeindex. nachfolger := datei. erster leerindex; + datei. erster leerindex := folgezeiger . + +index : + datei. index (zeiger) . + +folgeindex : + datei. index (folgezeiger) . + +END PROC indizes zusammenlegen; + +PROC indexzeiger justieren (DATEI VAR datei) : + + INT CONST aktueller satz := datei. satznr; + neue satzposition (datei, 1, 1, 1); + auf satz intern (datei, aktueller satz) + +END PROC indexzeiger justieren; + +PROC indexverweise aendern (DATEI VAR datei, INTVEC CONST satzindex, + INT CONST zeiger) : + + INT VAR i; + FOR i FROM 1 UPTO length (satzindex) DIV 2 REP + datei. ablage (satzindex ISUB i). indexblock := zeiger + END REP + +END PROC indexverweise aendern; + +PROC indexeintrag einfuegen (DATEI VAR datei, INT CONST eintrag) : + + INT VAR indexzeiger := datei. indexzeiger; + IF index. eintraege >= maxeintrag THEN + platz schaffen + END IF; + index. eintraege INCR 1; + insert (index. satzindex, datei. indexstelle, eintrag); + datei. satzzeiger := eintrag; + datei. ablage (eintrag). indexblock := indexzeiger . + +platz schaffen : + INT VAR neuer index := 0; + neuen indexblock besorgen; + IF neuer index <> 0 THEN + index aufsplitten + ELSE + index reorganisieren (datei) + END IF; + indexzeiger justieren (datei); + indexzeiger := datei. indexzeiger . + +neuen indexblock besorgen : + IF datei. erster leerindex <> 0 THEN + neuer index := datei. erster leerindex; + datei. erster leerindex := folgeindex. nachfolger + ELIF datei. indexblocks < maxindex THEN + datei. indexblocks INCR 1; + neuer index := datei. indexblocks; + folgeindex. satzindex := blockreservierung + END IF . + +index aufsplitten : + neuen block einketten; + splitpunkt bestimmen; + folgeindex. eintraege := index. eintraege - halbe eintraege; + split up (index. satzindex, folgeindex. satzindex, halbe eintraege + 1); + index. eintraege := halbe eintraege; + indexverweise aendern (datei, folgeindex. satzindex, neuer index) . + +neuen block einketten : + INT CONST alter nachfolger := index. nachfolger; + IF alter nachfolger <> 0 THEN + datei. index (alter nachfolger). vorgaenger := neuer index + ELSE + datei. letzter index := neuer index + END IF; + folgeindex. nachfolger := alter nachfolger; + folgeindex. vorgaenger := indexzeiger; + index. nachfolger := neuer index . + +splitpunkt bestimmen : + INT VAR halbe eintraege; + IF letzter block THEN + halbe eintraege := dreiviertel maxeintrag + ELSE + halbe eintraege := index. eintraege DIV 2 + 1 + END IF . + +letzter block : + alter nachfolger = 0 . + +index : + datei. index (indexzeiger) . + +folgeindex : + datei. index (neuer index) . + +END PROC indexeintrag einfuegen; + +PROC index reorganisieren (DATEI VAR datei) : + + INT VAR indexzeiger := 1; + REP + index auffuellen; + zum naechsten index + END REP . + +index auffuellen : + BOOL VAR moeglich; + REP + INT CONST nachfolger := index. nachfolger; + indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich) + UNTIL NOT moeglich END REP; + IF nachfolger = 0 THEN + LEAVE index reorganisieren + ELIF noch platz THEN + rest auffuellen + END IF . + +noch platz : + INT CONST platz := dreiviertel maxeintrag - index. eintraege; + platz > 0 . + +rest auffuellen : + split down (folgeindex. satzindex, indexpuffer, platz + 1); + folgeindex. eintraege DECR platz; + indexverweise aendern (datei, indexpuffer, indexzeiger); + index. satzindex CAT indexpuffer; + index. eintraege := dreiviertel maxeintrag . + +zum naechsten index : + indexzeiger := nachfolger . + +index : + datei. index (indexzeiger) . + +folgeindex : + datei. index (nachfolger) . + +END PROC index reorganisieren; + + +(************************* Sortierabfragen *******************************) + +TEXT VAR dez komma := ","; + +LET + sortmask = 1; + +TEXT PROC dezimalkomma : + + dez komma + +END PROC dezimalkomma; + +PROC dezimalkomma (TEXT CONST neues komma) : + + IF length (neues komma) <> 1 THEN + errorstop (nicht erlaubtes dezimalkomma) + ELSE + dez komma := neues komma + ENDIF + +END PROC dezimalkomma; + +INT PROC unsortierte saetze (EUDAT CONST datei) : + + datei. anz unsortierte + +END PROC unsortierte saetze; + +TEXT PROC sortierreihenfolge (EUDAT CONST datei) : + + datei. sortierfelder + +END PROC sortierreihenfolge; + +PROC aktueller satz unsortiert (DATEI VAR datei) : + + IF sortiert (datei) THEN + disable stop; + datei. ablage (datei. satzzeiger). attribut INCR sortmask; + datei. anz unsortierte INCR 1 + END IF + +END PROC aktueller satz unsortiert; + +PROC aktueller satz sortiert (DATEI VAR datei) : + + IF NOT sortiert (datei) THEN + disable stop; + datei. ablage (datei. satzzeiger). attribut DECR sortmask; + datei. anz unsortierte DECR 1 + END IF + +END PROC aktueller satz sortiert; + +BOOL PROC sortiert (DATEI CONST datei, INT CONST stelle) : + + (datei. ablage (stelle). attribut AND sortmask) = 0 + +END PROC sortiert; + +BOOL PROC sortiert (DATEI CONST datei) : + + sortiert (datei, datei. satzzeiger) + +END PROC sortiert; + + +(************************* Sortieren *************************************) + +(* Eine Datei kann in einer beliebigen Feldreihenfolge sortiert werden. *) +(* Dabei wird das Feldinfo beachtet. Wurden seit der letzten Sortierung *) +(* nur wenige Saetze geaendert (deren Plaetze in 'unsortierte' gespei- *) +(* chert sind), werden nur diese Saetze einsortiert. *) + +INTVEC VAR sortierinfo; + +TEXT VAR sortierfelder; + +TEXT VAR l, r; + + +PROC sortiere (EUDAT VAR datei) : + + sortierfelder := datei. sortierfelder; + IF sortierfelder = niltext THEN + standardbelegung + END IF; + sortiere intern (CONCR (datei)) . + +standardbelegung : + INT VAR i; + FOR i FROM 1 UPTO datei. felderzahl REP + sortierfelder CAT code (i) + END REP . + +END PROC sortiere; + +PROC sortiere (EUDAT VAR datei, TEXT CONST felder) : + + sortierfelder := felder; + sortiere intern (CONCR (datei)) + +END PROC sortiere; + +PROC sortiere intern (DATEI VAR datei) : + + IF datei. sortierfelder <> sortierfelder THEN + datei. sortierfelder := sortierfelder; + datei. anz unsortierte := datei. anz saetze + 1 + ELIF datei. anz unsortierte = 0 THEN + LEAVE sortiere intern + END IF; + sortierinfo := datei. feldinfo; + IF mehr als ein drittel THEN + komplett sortieren (datei); + datei. anz unsortierte := 0 + ELSE + einzeln sortieren (datei) + END IF; + auf satz intern (datei, 1) . + +mehr als ein drittel : + datei. anz saetze DIV datei. anz unsortierte < 3 . + +END PROC sortiere intern; + +PROC komplett sortieren (DATEI VAR datei) : + + INT VAR + satzzeiger, + satz := 1, + satz vorher; + + auf satz intern (datei, 1); + aktueller satz sortiert (datei); + satzzeiger := datei. satzzeiger; + WHILE noch satz vorhanden REP + zum naechsten satz; + satz richtig einsortieren; + cout (satz) + END REP; + disable stop; + index reorganisieren (datei); + neue satzposition (datei, 1, 1, 1) . + +noch satz vorhanden : + satz < datei. anz saetze . + +zum naechsten satz : + satz INCR 1; + auf satz intern (datei, satz); + satz vorher := satzzeiger; + satzzeiger := datei. satzzeiger . + +satz richtig einsortieren : + IF satz kleiner als vorgaenger THEN + satz einsortieren (datei, satz, satzzeiger); + satzzeiger := satz vorher + ELSE + aktueller satz sortiert (datei) + END IF . + +satz kleiner als vorgaenger : + datei. ablage (satz vorher). satz GROESSER + datei. ablage (satzzeiger). satz . + +END PROC komplett sortieren; + +PROC einzeln sortieren (DATEI VAR datei) : + + INT VAR i; + FOR i FROM 1 UPTO datei. anz satzeintraege REP + IF NOT sortiert (datei, i) THEN + satz einsortieren (datei, datei. anz saetze + 1, i); + cout (i) + END IF + END REP + +END PROC einzeln sortieren; + +PROC satz einsortieren (DATEI VAR datei, INT CONST satznr, satzzeiger) : + + stelle suchen; + an dieser stelle einfuegen . + +stelle suchen : + INT VAR + anfang := 1, + ende := satznr - 1, + mitte; + WHILE stelle nicht gefunden REP + intervall in der mitte halbieren; + teilintervall auswaehlen + END REP . + +stelle nicht gefunden : + anfang <= ende . + +intervall in der mitte halbieren : + mitte := (anfang + ende) DIV 2; + INT VAR vergleichssatz; + auf satz intern (datei, mitte); + IF NOT sortiert (datei) THEN + passenden vergleichssatz suchen + END IF; + vergleichssatz := datei. satzzeiger . + +passenden vergleichssatz suchen : + WHILE datei. satznr < ende REP + weiter intern (datei); + IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF + END REP; + WHILE datei. satznr > anfang REP + zurueck intern (datei); + IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF + END REP; + LEAVE stelle suchen . + +satz richtig : + sortiert (datei) . + +teilintervall auswaehlen : + IF zu vergleichender satz GROESSER datei. ablage (satzzeiger). satz THEN + ende := mitte - 1 + ELSE + anfang := mitte + 1 + END IF . + +zu vergleichender satz : + datei. ablage (vergleichssatz). satz . + +an dieser stelle einfuegen : + positioniere intern (datei, satzzeiger); + IF datei. satznr < anfang THEN anfang DECR 1 END IF; + disable stop; + aktueller satz sortiert (datei); + in hashkette ausketten; + indexeintrag loeschen (datei); + auf satz intern (datei, anfang); + indexeintrag einfuegen (datei, satzzeiger); + in hashkette einketten . + +in hashkette ausketten : + INT CONST h index := hashindex (aktueller satz); + hash ausketten (datei, h index) . + +in hashkette einketten : + INT VAR vorgaenger, nachfolger; + stelle in hashkette (datei, h index, vorgaenger, nachfolger); + hash einketten (datei, h index, vorgaenger, nachfolger) . + +aktueller satz : + datei. ablage (satzzeiger). satz . + +END PROC satz einsortieren; + +BOOL OP GROESSER (SATZ CONST links, rechts) : + + ungleiches feld suchen; + sortierrichtung feststellen; + SELECT sortierinfo ISUB vergleichsfeld OF + CASE 0 : din vergleich + CASE 1 : zahl vergleich + CASE 2 : datum vergleich + OTHERWISE text vergleich + END SELECT . + +ungleiches feld suchen : + INT VAR nr zeiger := 1; + WHILE nr zeiger < length (sortierfelder) REP + INT CONST vergleichsfeld := code (sortierfelder SUB nr zeiger); + feld lesen (links, vergleichsfeld, l); + feld lesen (rechts, vergleichsfeld, r); + SELECT sortierinfo ISUB vergleichsfeld OF + CASE 0 : din gleich + CASE 1 : zahl gleich + OTHERWISE text gleich + END SELECT; + nr zeiger INCR 2 + END REP; + LEAVE GROESSER WITH FALSE . + +sortierrichtung feststellen : + BOOL VAR aufsteigend; + IF (sortierfelder SUB (nr zeiger + 1)) = "-" THEN + aufsteigend := FALSE + ELSE + aufsteigend := TRUE + END IF . + +zahl gleich : + REAL VAR l wert, r wert; + wert berechnen (l, l wert); + wert berechnen (r, r wert); + IF l wert <> r wert THEN + LEAVE ungleiches feld suchen + END IF . + +din gleich : + IF NOT (l LEXEQUAL r) THEN + LEAVE ungleiches feld suchen + END IF . + +text gleich : + IF l <> r THEN + LEAVE ungleiches feld suchen + END IF . + +zahl vergleich : + IF aufsteigend THEN + l wert > r wert + ELSE + l wert < r wert + END IF . + +din vergleich : + IF aufsteigend THEN + l LEXGREATER r + ELSE + r LEXGREATER l + END IF . + +datum vergleich : + datum umdrehen (l); + datum umdrehen (r); + IF aufsteigend THEN + l > r + ELSE + l < r + END IF . + +textvergleich : + IF aufsteigend THEN + l > r + ELSE + l < r + END IF . + +END OP GROESSER; + +PROC wert berechnen (TEXT CONST zahl, REAL VAR wert) : + + LET ziffern = "0123456789"; + TEXT VAR komma := dez komma, text; + INT VAR stelle; + INT CONST laenge := length (zahl); + anfang bestimmen; + WHILE stelle <= laenge REP + zeichen untersuchen; + stelle INCR 1 + END REP; + wert := real (text) . + +anfang bestimmen : + stelle := pos (zahl, "0", "9", 1); + IF stelle = 0 THEN + wert := 0.0; LEAVE wert berechnen + ELIF pos (zahl, "-", 1, stelle) > 0 THEN + text := "-" + ELSE + text := niltext + END IF; . + +zeichen untersuchen: + TEXT CONST char := zahl SUB stelle; + IF pos (ziffern, char) > 0 THEN + text CAT char + ELIF char = komma THEN + text CAT "."; komma := niltext + END IF . + +END PROC wert berechnen; + +PROC datum umdrehen (TEXT VAR datum) : + + IF length (datum) <> 8 THEN + datum := niltext + ELSE + datum := subtext (datum, 7) + subtext (datum, 4, 5) + + subtext (datum, 1, 2) + END IF + +END PROC datum umdrehen; + + +(**************************** Reorganisieren *****************************) + +PROC reorganisiere (TEXT CONST dateiname) : + + EUDAT VAR datei 1, datei 2; + oeffne (datei 1, dateiname); + disable stop; + DATASPACE VAR ds := nilspace; + oeffne (datei 2, ds); + kopiere eudat (CONCR (datei 1), datei 2); + IF NOT is error THEN + forget (dateiname, quiet); + copy (ds, dateiname) + END IF; + forget (ds) + +END PROC reorganisiere; + +PROC kopiere eudat (DATEI VAR datei 1, EUDAT VAR datei 2) : + + enable stop; + kopiere saetze; + kopiere interna (datei 1, CONCR (datei 2)) . + +kopiere saetze : + auf satz intern (datei 1, 1); + auf satz (datei 2, 1); + WHILE NOT dateiende REP + satz einfuegen (datei 2, kopiersatz); + cout (datei 1. satznr); + weiter intern (datei 1); + weiter (datei 2) + END REP . + +dateiende : + datei 1. satznr > datei 1. anz saetze . + +kopiersatz : + datei 1. ablage (datei 1. satzzeiger). satz . + +END PROC kopiere eudat; + +PROC kopiere interna (DATEI VAR datei 1, datei 2) : + + datei 2. felderzahl := datei 1. felderzahl; + datei 2. feldnamen := datei 1. feldnamen; + datei 2. feldinfo := datei 1. feldinfo; + datei 2. sortierfelder := datei 1. sortierfelder; + datei 2. notizen (1) := datei 1. notizen (1); + datei 2. notizen (2) := datei 1. notizen (2); + datei 2. notizen (3) := datei 1. notizen (3) + +END PROC kopiere interna; + + +(************************* Notizen ***************************************) + +PROC notizen lesen (EUDAT CONST datei, INT CONST nr, TEXT VAR notiztext) : + + notiztext := datei. notizen (nr) + +END PROC notizen lesen; + +PROC notizen aendern (EUDAT VAR datei, INT CONST nr, TEXT CONST notiztext) : + + datei. notizen (nr) := notiztext + +END PROC notizen aendern; + +END PACKET eudas dateien; + diff --git a/app/eudas/4.4/src/eudas.datenverwaltung b/app/eudas/4.4/src/eudas.datenverwaltung new file mode 100644 index 0000000..bd4f74f --- /dev/null +++ b/app/eudas/4.4/src/eudas.datenverwaltung @@ -0,0 +1,1989 @@ +PACKET datenverwaltung + +(*************************************************************************) +(* *) +(* Verwaltung der aktuellen EUDAS-Dateien *) +(* *) +(* Version 09 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 01.10.87 *) +(* *) +(*************************************************************************) + + DEFINES + + oeffne, + kopple, + kette, + zugriff, + sichere, + dateien loeschen, + auf koppeldatei, + + anzahl koppeldateien, + anzahl dateien, + aendern erlaubt, + inhalt veraendert, + eudas dateiname, + folgedatei, + + dateiversion, + + anzahl felder, + feldnamen lesen, + feldnamen bearbeiten, + feldnummer, + feldinfo, + notizen lesen, + notizen aendern, + + feld lesen, + feld bearbeiten, + feld aendern, + + satznummer, + satzkombination, + dateiende, + weiter, + zurueck, + auf satz, + + satz einfuegen, + satz loeschen, + aenderungen eintragen, + + suchbedingung, + suchbedingung lesen, + suchbedingung loeschen, + suchversion, + satz ausgewaehlt, + markierung aendern, + satz markiert, + markierungen loeschen, + markierte saetze : + + +LET + INTVEC = TEXT, + + DATEI = STRUCT + (TEXT name, + SATZ feldnamen, + INTVEC koppelfelder, + INT anz koppelfelder, + INT naechste datei, + INT alte koppelposition, + DATASPACE ds, + EUDAT eudat, + SATZ satzpuffer, + BOOL gepuffert, + BOOL veraendert, datei veraendert, koppelfeld veraendert, + TEXT muster, + INTVEC marksaetze, + INT markzeiger), + + VERWEIS = STRUCT (INT datei, feld); + +LET + niltext = "", + empty intvec = ""; + +LET + maxint = 32767, + maxdateien = 10, + maxfelder = 256, + maxkoppeln = 32; + +ROW maxdateien DATEI VAR daten; + +INT VAR + anz dateien := 0, + anz koppeldateien := 0, + hauptdatei, + erste koppeldatei := 0, + felderzahl der ersten datei, + anz felder := 0, + satznummer offset, + kombination, + markierungen, + laufzaehler := 0; + +BOOL VAR + ende der datei := TRUE, + aenderungserlaubnis, + globales muster vorhanden; + +TEXT VAR globales muster; + +ROW maxfelder VERWEIS VAR verweis; + +ROW maxkoppeln VERWEIS VAR koppeln; + +INT VAR koppeleintraege; + +LET + zuviel dateien = #301# + "Zuviel Dateien geoeffnet", + datei existiert nicht = #302# + "Datei existiert nicht", + nicht im umgeschalteten zustand = #303# + "Nicht moeglich, wenn auf Koppeldatei geschaltet", + zu viele felder = #304# + "Zu viele Felder", + zu viele koppelfelder = #305# + "Zu viele Koppelfelder", + keine koppelfelder = #306# + "keine Koppelfelder vorhanden", + kein zugriff bei ketten oder koppeln = #307# + "kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien", + keine datei geoeffnet = #308# + "keine Datei geoeffnet", + datei nicht gesichert = #309# + "Datei nicht gesichert", + suchmuster zu umfangreich = #310# + "Suchmuster zu umfangreich"; + +TEXT VAR feldpuffer; + + +(***************************** INTVEC ************************************) + +TEXT VAR raum fuer ein int := " "; + +INTVEC VAR puffer; + +OP CAT (INTVEC VAR text, INT CONST wert) : + + replace (raum fuer ein int, 1, wert); + text CAT raum fuer ein int + +END OP CAT; + +PROC insert (INTVEC VAR vector, INT CONST stelle, wert) : + + INT CONST trennung := stelle + stelle - 2; + puffer := subtext (vector, trennung + 1); + vector := subtext (vector, 1, trennung); + vector CAT wert; + vector CAT puffer + +END PROC insert; + +PROC delete (INTVEC VAR vector, INT CONST stelle) : + + INT CONST trennung := stelle + stelle - 2; + puffer := subtext (vector, trennung + 3); + vector := subtext (vector, 1, trennung); + vector CAT puffer + +END PROC delete; + +PROC inkrement (INTVEC VAR vector, INT CONST ab, um) : + + INT VAR i; + FOR i FROM ab UPTO length (vector) DIV 2 - 1 REP + replace (vector, i, (vector ISUB i) + um) + END REP + +END PROC inkrement; + + +(***************************** Dateien eintragen *************************) + +EUDAT VAR eudas datei; + +SATZ VAR namen; + +PROC datei testen (TEXT CONST dateiname) : + + IF anz dateien = maxdateien THEN + errorstop (zuviel dateien) + END IF; + IF NOT exists (dateiname) THEN + errorstop (datei existiert nicht) + END IF; + IF umgeschaltet THEN + errorstop (nicht im umgeschalteten zustand) + END IF; + oeffne (eudas datei, dateiname) + +END PROC datei testen; + +PROC datei eintragen (DATEI VAR datei, TEXT CONST dateiname) : + + IF aenderungserlaubnis THEN + datei. ds := old (dateiname); + oeffne (datei. eudat, datei. ds) + ELSE + oeffne (datei. eudat, dateiname) + END IF; + datei. naechste datei := 0; + datei. veraendert := FALSE; + datei. datei veraendert := FALSE; + datei. name := dateiname; + mark loeschen (datei) + +END PROC datei eintragen; + +PROC in dateikette (INT CONST anfang) : + + INT VAR dateiindex := anfang; + WHILE daten (dateiindex). naechste datei <> 0 REP + dateiindex := daten (dateiindex). naechste datei + END REP; + daten (dateiindex). naechste datei := anz dateien + +END PROC in dateikette; + +PROC anfangsposition einnehmen : + + IF dateiende (daten (1). eudat) THEN + auf satz (1) + ELSE + auf satz (satznr (daten (1). eudat)) + END IF + +END PROC anfangsposition einnehmen; + +PROC felder anlegen : + + felderzahl der ersten datei := felderzahl (daten (1). eudat); + anz felder := felderzahl der ersten datei; + feldnamen lesen (daten (1). eudat, daten (1). feldnamen); + koppeleintraege := 0; + INT VAR i; + FOR i FROM 1 UPTO anz felder REP + verweis (i). datei := 0 + END REP + +END PROC felder anlegen; + +PROC laufzaehler erhoehen : + + laufzaehler INCR 1; + IF laufzaehler > 32000 THEN + laufzaehler := - 32000 + END IF + +END PROC laufzaehler erhoehen; + +PROC oeffne (TEXT CONST dateiname, BOOL CONST auch aendern) : + + enable stop; + dateien loeschen (FALSE); + suchbedingung loeschen; + datei testen (dateiname); + aenderungserlaubnis := auch aendern; + status setzen; + datei eintragen (daten (anz dateien), dateiname); + anfangsposition einnehmen; + felder anlegen . + +status setzen : + anz dateien := 1; + laufzaehler erhoehen; + markierungen := 0 . + +END PROC oeffne; + +PROC kopple (TEXT CONST dateiname) : + + enable stop; + IF anz dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + datei testen (dateiname); + koppelfelder bestimmen; + platz in feldtabellen belegen; + in kette der koppeldateien einfuegen; + datei eintragen (daten (anz dateien), dateiname); + koppelstatus setzen . + +koppelfelder bestimmen : + feldnamen lesen (eudas datei, namen); + INT VAR koppelfelder := 0; + INTVEC VAR koppelfeldnr := empty intvec; + WHILE koppelfelder < felderzahl (eudas datei) REP + feld lesen (namen, koppelfelder + 1, feldpuffer); + INT CONST index := feldindex (daten (1). feldnamen, feldpuffer); + IF index > 0 THEN + koppelfelder INCR 1; + koppelfeldnr CAT index + END IF + UNTIL index = 0 END REP . + +platz in feldtabellen belegen : + IF anz felder + felderzahl (eudas datei) - koppelfelder > maxfelder THEN + errorstop (zu viele felder) + ELIF koppeleintraege + koppelfelder > maxkoppeln THEN + errorstop (zu viele koppelfelder) + ELIF koppelfelder = 0 THEN + errorstop (keine koppelfelder) + END IF; + anz dateien INCR 1; + daten (anz dateien). feldnamen := namen; + daten (anz dateien). koppelfelder := koppelfeldnr; + daten (anz dateien). anz koppelfelder := koppelfelder; + INT VAR feldnr := koppelfelder; + WHILE feldnr < felderzahl (eudas datei) REP + anz felder INCR 1; feldnr INCR 1; + verweis (anz felder). datei := anz dateien; + verweis (anz felder). feld := feldnr + END REP; + FOR feldnr FROM 1 UPTO koppelfelder REP + koppelfeld eintragen + END REP . + +koppelfeld eintragen : + INT CONST koppelfeld := koppelfeldnr ISUB feldnr; + IF verweis (koppelfeld). datei = 0 THEN + neues koppelfeld eintragen + ELSE + alten eintrag erweitern + END IF . + +neues koppelfeld eintragen : + koppeleintraege INCR 1; + koppeln (koppeleintraege). datei := anz dateien; + koppeln (koppeleintraege). feld := feldnr; + verweis (koppelfeld). datei := koppeleintraege; + verweis (koppelfeld). feld := 1 . + +alten eintrag erweitern : + INT CONST eintragposition := + verweis (koppelfeld). datei + verweis (koppelfeld). feld; + folgende eintraege hochschieben; + verweis (koppelfeld). feld INCR 1; + koppeln (eintragposition). datei := anz dateien; + koppeln (eintragposition). feld := feldnr . + +folgende eintraege hochschieben : + INT VAR eintrag; + FOR eintrag FROM koppeleintraege DOWNTO eintragposition REP + koppeln (eintrag + 1) := koppeln (eintrag) + END REP; + koppeleintraege INCR 1; + FOR eintrag FROM 1 UPTO felderzahl der ersten datei REP + IF verweis (eintrag). datei >= eintragposition THEN + verweis (eintrag). datei INCR 1 + END IF + END REP . + +in kette der koppeldateien einfuegen : + anz koppeldateien INCR 1; + IF erste koppeldatei = 0 THEN + erste koppeldatei := anz dateien + ELSE + in dateikette (erste koppeldatei) + END IF . + +koppelstatus setzen : + laufzaehler erhoehen; + daten (anz dateien). gepuffert := FALSE; + daten (anz dateien). koppelfeld veraendert := FALSE; + daten (anz dateien). alte koppelposition := satznr (eudas datei); + koppeldatei aktualisieren (daten (anz dateien)) . + +END PROC kopple; + +PROC kette (TEXT CONST dateiname) : + + enable stop; + IF anz dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + datei testen (dateiname); + anz dateien INCR 1; + datei eintragen (daten (anz dateien), dateiname); + in dateikette (1); + IF ende der datei THEN auf satz (satznummer) END IF + +END PROC kette; + +PROC zugriff (PROC (EUDAT VAR) bearbeitung) : + + IF anz dateien > 1 OR umgeschaltet THEN + errorstop (kein zugriff bei ketten oder koppeln) + ELSE + aenderungen eintragen; + bearbeitung (daten (1). eudat); + laufzaehler erhoehen; + anfangsposition einnehmen; + felder anlegen; + daten (1). datei veraendert := TRUE + ENDIF + +END PROC zugriff; + +PROC sichere (INT CONST dateinummer, TEXT CONST dateiname) : + + aenderungen eintragen; + notizen aendern (daten (dateinummer). eudat, 2, date); + IF aenderungserlaubnis THEN + forget (dateiname, quiet); + copy (daten (dateinummer). ds, dateiname) + END IF; + daten (dateinummer). datei veraendert := FALSE + +END PROC sichere; + +PROC dateien loeschen (BOOL CONST auch geaenderte) : + + aenderungen eintragen; + IF umgeschaltet THEN auf koppeldatei (0) END IF; + kontrollvariablen loeschen; + dateien einzeln loeschen . + +kontrollvariablen loeschen : + anz koppeldateien := 0; + erste koppeldatei := 0; + daten (1). naechste datei := 0; + anz felder := 0; + ende der datei := TRUE . + +dateien einzeln loeschen : + WHILE anz dateien > 0 REP + IF wirklich veraendert AND NOT auch geaenderte THEN + errorstop (datei nicht gesichert); + LEAVE dateien loeschen + END IF; + forget (daten (anz dateien). ds); + anz dateien DECR 1 + END REP . + +wirklich veraendert : + aenderungserlaubnis AND daten (anz dateien). datei veraendert . + +END PROC dateien loeschen; + + +(*********************** Umschalten Koppeldatei **************************) + +INT VAR + save hauptdatei, + save felderzahl der ersten datei, + save anz felder, + save satznummer offset, + save kombination, + save markierungen, + save erste koppeldatei, + save naechste koppeldatei; + +BOOL VAR + save globales muster vorhanden; + +INTVEC VAR + save oder anfang; + +SATZ VAR + save muster gespeichert; + + +BOOL VAR + umgeschaltet := FALSE; + +INT VAR + anzahl hauptmuster := 0, + feldnamendatei := 1; + + +BOOL PROC auf koppeldatei : + + umgeschaltet + +END PROC auf koppeldatei; + +PROC auf koppeldatei (INT CONST nr) : + + disable stop; + laufzaehler erhoehen; + IF umgeschaltet THEN + alte variablen wiederherstellen; + umgeschaltet := FALSE; + ggf koppelfelder uebernehmen; + fuer korrekten zustand sorgen + ELSE + alte variablen sichern; + umgeschaltet := TRUE; + neuen zustand herstellen + END IF . + +alte variablen wiederherstellen : + hauptdatei := save hauptdatei; + felderzahl der ersten datei := save felderzahl der ersten datei; + anz felder := save anz felder; + satznummer offset := save satznummer offset; + markierungen := save markierungen; + erste koppeldatei := save erste koppeldatei; + daten (feldnamendatei). naechste datei := save naechste koppeldatei; + anzahl muster := anzahl hauptmuster; + globales muster vorhanden := save globales muster vorhanden; + oder anfang := save oder anfang; + muster gespeichert := save muster gespeichert; + IF anzahl muster > 0 THEN + erster musterindex := 1 + ELSE + erster musterindex := -1 + END IF . + +fuer korrekten zustand sorgen : + anzahl hauptmuster := 0; + feldnamendatei := 1; + enable stop; + auf satz (satznummer); + WHILE kombination <> save kombination REP + weiter (1) + END REP . + +ggf koppelfelder uebernehmen : + daten (feldnamendatei). alte koppelposition := + satznr (daten (feldnamendatei). eudat); + IF nr = 1 AND NOT dateiende (daten (hauptdatei). eudat) THEN + alle koppelfelder in hauptdatei uebernehmen + END IF . + +alle koppelfelder in hauptdatei uebernehmen : + INT VAR koppel nr; + FOR koppel nr FROM 1 UPTO daten (feldnamendatei). anz koppelfelder REP + feld aendern (daten (hauptdatei). eudat, feld nr koppelfeld, + feldinhalt koppelfeld) + END REP; + save kombination := 1 . + +feld nr koppelfeld : + daten (feldnamendatei). koppelfelder ISUB koppel nr . + +feldinhalt koppelfeld : + feld lesen (daten (feldnamendatei). eudat, koppel nr, feldpuffer); + feldpuffer . + +alte variablen sichern : + save hauptdatei := hauptdatei; + save felderzahl der ersten datei := felderzahl der ersten datei; + save anz felder := anz felder; + save satznummer offset := satznummer offset; + save kombination := kombination; + save markierungen := markierungen; + save erste koppeldatei := erste koppeldatei; + save naechste koppeldatei := daten (nr). naechste datei; + save globales muster vorhanden := globales muster vorhanden; + save oder anfang := oder anfang; + save muster gespeichert := muster gespeichert . + +neuen zustand herstellen : + hauptdatei := nr; + anzahl hauptmuster := anzahl muster; + feldnamendatei := nr; + felderzahl der ersten datei := felderzahl (daten (nr). eudat); + anz felder := felderzahl der ersten datei; + satznummer offset := 0; + markierungen := (length (daten (nr). marksaetze) - 1) DIV 2; + erste koppeldatei := 0; + daten (nr). naechste datei := 0; + suchbedingung loeschen; + auf satz (daten (nr). alte koppelposition) . + +END PROC auf koppeldatei; + + +(************************** Dateiabfragen ********************************) + +INT PROC anzahl koppeldateien : + + anz koppeldateien + +END PROC anzahl koppeldateien; + +INT PROC anzahl dateien : + + anz dateien + +END PROC anzahl dateien; + +BOOL PROC aendern erlaubt : + + aenderungserlaubnis + +END PROC aendern erlaubt; + +BOOL PROC inhalt veraendert (INT CONST dateinr) : + + aenderungen eintragen; + daten (dateinr). datei veraendert + +END PROC inhalt veraendert; + +TEXT PROC eudas dateiname (INT CONST dateinr) : + + daten (dateinr). name + +END PROC eudas dateiname; + +INT PROC folgedatei (INT CONST dateinr) : + + IF dateinr = 0 THEN + erste koppeldatei + ELSE + daten (dateinr). naechste datei + END IF + +END PROC folgedatei; + + +(*************************** Dateiversion ********************************) + +(* Die Dateiversion wird bei jedem neuen 'oeffne' hochgezaehlt. Sie *) +(* dient dazu, ein neues 'oeffne' festzustellen, um eventuell als *) +(* Optimierung gespeicherte Daten als ungueltig zu kennzeichnen. *) + +INT PROC dateiversion : + + laufzaehler + +END PROC dateiversion; + + +(******************************* Felder **********************************) + +INT PROC anzahl felder : + + anz felder + +END PROC anzahl felder; + +PROC feldnamen lesen (INT CONST feldnr, TEXT VAR name) : + + IF feldnr <= felderzahl der ersten datei THEN + feld lesen (daten (feldnamendatei). feldnamen, feldnr, name) + ELSE + feld lesen (dateiverweis, feldverweis, name) + END IF . + +dateiverweis : + daten (verweis (feldnr). datei). feldnamen . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldnamen lesen; + +PROC feldnamen bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + IF feldnr <= felderzahl der ersten datei THEN + feld bearbeiten (daten (feldnamendatei). feldnamen, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + feld bearbeiten (dateiverweis, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + END IF . + +dateiverweis : + daten (verweis (feldnr). datei). feldnamen . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldnamen bearbeiten; + +INT PROC feldnummer (TEXT CONST feldname) : + + INT VAR + offset := felderzahl der ersten datei, + nr := feldindex (daten (feldnamendatei). feldnamen, feldname), + dateiindex := erste koppeldatei; + WHILE nr = 0 AND dateiindex <> 0 REP + nr := feldindex (daten (dateiindex). feldnamen, feldname); + offset oder nr erhoehen; + dateiindex := daten (dateiindex). naechste datei + END REP; + nr . + +offset oder nr erhoehen : + INT CONST zahl der koppelfelder := daten (dateiindex). anz koppelfelder; + IF nr = 0 THEN + offset INCR felderzahl (daten (dateiindex). eudat); + offset DECR zahl der koppelfelder + ELSE + nr INCR offset; + nr DECR zahl der koppelfelder + END IF . + +END PROC feldnummer; + +INT PROC feldinfo (INT CONST feldnr) : + + IF feldnr <= felderzahl der ersten datei THEN + feldinfo (daten (feldnamendatei). eudat, feldnr) + ELSE + feldinfo (daten (dateiverweis). eudat, feldverweis) + END IF . + +dateiverweis : + verweis (feldnr). datei . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldinfo; + +PROC notizen lesen (INT CONST nr, TEXT VAR inhalt) : + + notizen lesen (daten (feldnamendatei). eudat, nr, inhalt) + +END PROC notizen lesen; + +PROC notizen aendern (INT CONST nr, TEXT CONST inhalt) : + + notizen aendern (daten (feldnamendatei). eudat, nr, inhalt) + +END PROC notizen aendern; + + +(*************************** Feldzugriffe ********************************) + +PROC feld lesen (INT CONST feldnr, TEXT VAR inhalt) : + + IF feldnr <= felderzahl der ersten datei THEN + feld lesen (daten (hauptdatei). eudat, feldnr, inhalt) + ELSE + in koppeldatei lesen + END IF . + +in koppeldatei lesen : + INT CONST dateiverweis := verweis (feldnr). datei; + IF daten (dateiverweis). gepuffert THEN + feld lesen (daten (dateiverweis). satzpuffer, feldverweis, inhalt) + ELSE + feld lesen (daten (dateiverweis). eudat, feldverweis, inhalt) + END IF . + +feldverweis : + verweis (feldnr). feld . + +END PROC feld lesen; + +PROC feld bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + IF feldnr <= felderzahl der ersten datei THEN + feld bearbeiten (daten (hauptdatei). eudat, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + in koppeldatei bearbeiten + END IF . + +in koppeldatei bearbeiten : + INT CONST dateiverweis := verweis (feldnr). datei; + IF daten (dateiverweis). gepuffert THEN + feld bearbeiten (daten (dateiverweis). satzpuffer, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + feld bearbeiten (daten (dateiverweis). eudat, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + END IF . + +feldverweis : + verweis (feldnr). feld . + +END PROC feld bearbeiten; + +PROC feld aendern (INT CONST feldnr, TEXT CONST inhalt) : + + INT CONST dateiverweis := verweis (feldnr). datei; + IF feldnr <= felderzahl der ersten datei THEN + in hauptdatei aendern + ELSE + in koppeldatei aendern + END IF . + +in hauptdatei aendern : + daten (hauptdatei). datei veraendert := TRUE; + IF ist koppelfeld CAND wirklich veraenderung THEN + weitere dateien aktualisieren + END IF; + feld aendern (daten (hauptdatei). eudat, feldnr, inhalt) . + +ist koppelfeld : + NOT umgeschaltet CAND dateiverweis > 0 . + +wirklich veraenderung : + feld lesen (daten (hauptdatei). eudat, feldnr, feldpuffer); + feldpuffer <> inhalt . + +weitere dateien aktualisieren : + INT VAR + koppelzaehler := feldverweis, + koppelverweis := dateiverweis; + REP + satzpuffer aktualisieren (daten (koppeldatei)); + daten (koppeldatei). koppelfeld veraendert := TRUE; + feld aendern (daten (koppeldatei). satzpuffer, koppelfeld, inhalt); + koppelverweis INCR 1; + koppelzaehler DECR 1 + UNTIL koppelzaehler = 0 END REP . + +in koppeldatei aendern : + satzpuffer aktualisieren (daten (dateiverweis)); + IF koppeldatei wirklich veraendert THEN + daten (dateiverweis). veraendert := TRUE; + feld aendern (daten (dateiverweis). satzpuffer, feldverweis, inhalt) + END IF . + +koppeldatei wirklich veraendert : + feld lesen (daten (dateiverweis). satzpuffer, feldverweis, feldpuffer); + feldpuffer <> inhalt . + +feldverweis : + verweis (feldnr). feld . + +koppeldatei : + koppeln (koppelverweis). datei . + +koppelfeld : + koppeln (koppelverweis). feld . + +END PROC feld aendern; + +PROC satzpuffer aktualisieren (DATEI VAR datei) : + + IF NOT datei. gepuffert THEN + datei. gepuffert := TRUE; + satzpuffer lesen + END IF . + +satzpuffer lesen : + IF dateiende (datei. eudat) THEN + satz initialisieren (datei. satzpuffer, datei. anz koppelfelder); + koppelfelder in satzpuffer schreiben + ELSE + satz lesen (datei. eudat, datei. satzpuffer) + END IF . + +koppelfelder in satzpuffer schreiben : + INT VAR i; + FOR i FROM 1 UPTO datei. anz koppelfelder REP + feld lesen (datei. koppelfelder ISUB i, feldpuffer); + feld aendern (datei. satzpuffer, i, feldpuffer) + END REP . + +END PROC satzpuffer aktualisieren; + +PROC koppeldatei aktualisieren (DATEI VAR datei) : + + muster lesen; + koppeldatei positionieren . + +muster lesen : + feld lesen (daten (hauptdatei). eudat, musterfeld, muster) . + +musterfeld : + datei. koppelfelder ISUB 1 . + +muster : + datei. muster . + +koppeldatei positionieren : + auf satz (datei. eudat, muster); + WHILE NOT koppelfelder gleich (datei) REP + weiter (datei. eudat, muster) + END REP; + IF dateiende (datei. eudat) THEN + satzpuffer aktualisieren (datei) + ELSE + datei. gepuffert := FALSE + END IF . + +END PROC koppeldatei aktualisieren; + +PROC koppeldateien aktualisieren : + + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + koppeldatei aktualisieren (daten (dateiindex)); + dateiindex := daten (dateiindex). naechste datei + END REP; + kombination := 1 + +END PROC koppeldateien aktualisieren; + +BOOL PROC koppelfelder gleich (DATEI CONST datei) : + + IF NOT dateiende (datei. eudat) THEN + koppelfelder vergleichen + END IF; + TRUE . + +koppelfelder vergleichen : + INT VAR koppelindex; + FOR koppelindex FROM 2 UPTO datei. anz koppelfelder REP + feld lesen (daten (hauptdatei). eudat, koppelfelder ISUB koppelindex, + feldpuffer); + feld bearbeiten (datei. eudat, koppelindex, + PROC (TEXT CONST, INT CONST, INT CONST) feld vergleichen); + IF NOT vergleich erfolgreich THEN + LEAVE koppelfelder gleich WITH FALSE + END IF + END REP . + +koppelfelder : + datei. koppelfelder . + +END PROC koppelfelder gleich; + +BOOL VAR vergleich erfolgreich; + +PROC feld vergleichen (TEXT CONST satz, INT CONST anfang, ende) : + + vergleich erfolgreich := length (feldpuffer) + anfang = ende + 1 CAND + pos (satz, feldpuffer, anfang, ende + 1) = anfang + +END PROC feld vergleichen; + + +(**************************** Anhalten ***********************************) + +LET + halt error = 22101, + halt zeichen = "h", + esc = ""27""; + +BOOL VAR esc zustand; + + +PROC halt abfrage starten : + + TEXT VAR z; + esc zustand := FALSE; + REP + z := incharety; type (z) + UNTIL z = niltext END REP + +END PROC halt abfrage starten; + +PROC halt abfrage beenden : + + IF esc zustand THEN + type (esc) + END IF + +END PROC halt abfrage beenden; + +BOOL PROC angehalten : + + TEXT VAR z; + REP + z := incharety; + IF z = niltext THEN + LEAVE angehalten WITH FALSE + ELSE + zeichen behandeln + END IF + END REP; + FALSE . + +zeichen behandeln : + IF esc zustand THEN + esc zustand := FALSE; + auf halt zeichen testen + ELSE + auf esc testen + END IF . + +auf halt zeichen testen : + IF z = halt zeichen THEN + tastenpuffer loeschen; + errorstop (halt error, niltext); + LEAVE angehalten WITH TRUE + ELSE + type (esc); type (z) + END IF . + +auf esc testen : + IF z = esc THEN + esc zustand := TRUE + ELSE + type (z) + END IF . + +tastenpuffer loeschen : + REP UNTIL getcharety = niltext END REP . + +END PROC angehalten; + + +(************************** Positionieren ********************************) + +PROC weiter (INT CONST modus) : + + IF NOT ende der datei THEN + aenderungen eintragen; + nach modus weiter gehen + END IF . + +nach modus weitergehen : + SELECT modus OF + CASE 1 : einen satz weiter + CASE 2 : weiter bis ausgewaehlt + CASE 3 : weiter bis markiert + END SELECT . + +einen satz weiter : + weiter gehen (FALSE) . + +weiter bis ausgewaehlt : + halt abfrage starten; + REP + weiter gehen (globales muster vorhanden); + cout (satznummer) + UNTIL satz ausgewaehlt OR ende der datei OR angehalten END REP; + halt abfrage beenden . + +weiter bis markiert : + INT VAR satzpos := satznr (daten (hauptdatei). eudat); + WHILE kein markierter satz mehr AND naechste datei <> 0 REP + eine datei weiter; + satzpos := 1 + END REP; + auf satz (daten (hauptdatei). eudat, naechster markierter satz); + cout (satznummer); + koppeldateien aktualisieren; + ende der datei := dateiende (daten (hauptdatei). eudat); + suchbedingung auswerten . + +kein markierter satz mehr : + mark stelle (daten (hauptdatei), satzpos + 1); + INT CONST naechster markierter satz := + daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger; + naechster markierter satz = maxint . + +naechste datei : + daten (hauptdatei). naechste datei . + +END PROC weiter; + +PROC zurueck (INT CONST modus) : + + IF satznummer > 1 THEN + aenderungen eintragen; + nach modus zurueckgehen + END IF . + +nach modus zurueckgehen : + SELECT modus OF + CASE 1 : einen satz zurueck + CASE 2 : zurueck bis ausgewaehlt + CASE 3 : zurueck bis markiert + END SELECT . + +einen satz zurueck : + zurueck gehen (FALSE) . + +zurueck bis ausgewaehlt : + halt abfrage starten; + REP + zurueck gehen (globales muster vorhanden); + cout (satznummer) + UNTIL satz ausgewaehlt OR satznummer = 1 OR angehalten END REP; + halt abfrage beenden . + +zurueck bis markiert : + INT VAR satzpos := satznr (daten (hauptdatei). eudat); + WHILE kein markierter satz mehr AND hauptdatei <> 1 REP + eine datei zurueck; + satzpos := maxint - 1 + END REP; + auf satz (daten (hauptdatei). eudat, neuer satz); + cout (satznummer); + koppeldateien aktualisieren; + ende der datei := FALSE; + suchbedingung auswerten . + +kein markierter satz mehr : + INT VAR neuer satz; + mark stelle (daten (hauptdatei), satzpos); + IF daten (hauptdatei). markzeiger = 1 THEN + neuer satz := 1; + TRUE + ELSE + neuer satz := daten (hauptdatei). marksaetze ISUB + (daten (hauptdatei). markzeiger - 1); + FALSE + END IF . + +END PROC zurueck; + +PROC weiter gehen (BOOL CONST muster vorgegeben) : + + neue kombination suchen; + IF keine kombination mehr THEN + einen satz weiter; + koppeldateien aktualisieren + ELSE + kombination INCR 1 + END IF; + suchbedingung auswerten . + +neue kombination suchen : + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex > 0 REP + in koppeldatei weitergehen; + dateiindex := daten (dateiindex). naechste datei + END REP . + +in koppeldatei weitergehen : + BOOL VAR match gefunden; + kombination suchen (daten (dateiindex), match gefunden); + IF match gefunden THEN + LEAVE neue kombination suchen + END IF . + +keine kombination mehr : + dateiindex = 0 . + +einen satz weiter : + IF muster vorgegeben THEN + weiter (daten (hauptdatei). eudat, globales muster) + ELSE + weiter (daten (hauptdatei). eudat) + END IF; + WHILE dateiende (daten (hauptdatei). eudat) REP + auf naechste datei + UNTIL ende der datei END REP . + +auf naechste datei : + IF daten (hauptdatei). naechste datei <> 0 THEN + eine datei weiter; + auf ersten satz der naechsten datei + ELSE + ende der datei := TRUE + END IF . + +auf ersten satz der naechsten datei : + auf satz (daten (hauptdatei). eudat, 1) . + +END PROC weiter gehen; + +PROC kombination suchen (DATEI VAR datei, BOOL VAR match gefunden) : + + IF dateiende (datei. eudat) THEN + match gefunden := FALSE + ELSE + in datei weitergehen + END IF . + +in datei weitergehen : + match gefunden := TRUE; + REP + weiter (datei. eudat, datei. muster); + IF dateiende (datei. eudat) THEN + match gefunden := FALSE; + auf satz (datei. eudat, datei. muster) + END IF + UNTIL koppelfelder gleich (datei) END REP . + +END PROC kombination suchen; + +PROC zurueck gehen (BOOL CONST muster vorgegeben) : + + WHILE satznr (daten (hauptdatei). eudat) = 1 CAND satznummer > 1 REP + eine datei zurueck; + auf dateiende (daten (hauptdatei). eudat) + END REP; + IF muster vorgegeben THEN + zurueck (daten (hauptdatei). eudat, globales muster) + ELSE + zurueck (daten (hauptdatei). eudat) + END IF; + ende der datei := FALSE; + koppeldateien aktualisieren; + suchbedingung auswerten + +END PROC zurueck gehen; + +PROC eine datei weiter : + + satznummer offset INCR saetze (daten (hauptdatei). eudat); + hauptdatei := daten (hauptdatei). naechste datei + +END PROC eine datei weiter; + +PROC eine datei zurueck : + + INT VAR neuer index := 1; + WHILE daten (neuer index). naechste datei <> hauptdatei REP + neuer index := daten (neuer index). naechste datei + END REP; + satznummer offset DECR saetze (daten (neuer index). eudat); + hauptdatei := neuer index + +END PROC eine datei zurueck; + +PROC aenderungen eintragen : + + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + koppeldatei betrachten; + dateiindex := daten (dateiindex). naechste datei + END REP . + +koppeldatei betrachten : + IF daten (dateiindex). gepuffert THEN + datei aktualisieren (daten (dateiindex)) + END IF . + +END PROC aenderungen eintragen; + +PROC datei aktualisieren (DATEI VAR datei) : + + IF alter satz geaendert AND NOT koppelfelder veraendert THEN + satz in koppeldatei aendern + ELIF nicht nur koppelfelder belegt AND irgendwas veraendert THEN + neuen satz in koppeldatei einfuegen + ELIF koppelfelder veraendert THEN + koppeldatei aktualisieren (datei) + END IF; + puffer deaktivieren; + veraendert := FALSE; + koppelfelder veraendert := FALSE . + +alter satz geaendert : + NOT dateiende (datei. eudat) AND veraendert . + +nicht nur koppelfelder belegt : + felderzahl (satzpuffer) > datei. anz koppelfelder . + +irgendwas veraendert : + koppelfelder veraendert OR veraendert . + +neuen satz in koppeldatei einfuegen : + datei veraendert := TRUE; + feld lesen (satzpuffer, 1, datei. muster); + satz einfuegen (datei. eudat, satzpuffer) . + +puffer deaktivieren : + datei. gepuffert := FALSE . + +satz in koppeldatei aendern : + datei veraendert := TRUE; + satz aendern (datei. eudat, satzpuffer) . + +veraendert : + datei. veraendert . + +koppelfelder veraendert : + datei. koppelfeld veraendert . + +satzpuffer : + datei. satzpuffer . + +datei veraendert : + datei. datei veraendert . + +END PROC datei aktualisieren; + +PROC auf dateiende (EUDAT VAR eudat) : + + auf satz (eudat, saetze (eudat) + 1) + +END PROC auf dateiende; + +PROC auf satz (INT CONST satznr) : + + aenderungen eintragen; + hauptdatei := feldnamendatei; + satznummer offset := 0; + WHILE ueber datei hinaus AND noch weitere datei REP + eine datei weiter + END REP; + auf satz (daten (hauptdatei). eudat, satznr - satznummer offset); + koppeldateien aktualisieren; + ende der datei := dateiende (daten (hauptdatei). eudat); + suchbedingung auswerten . + +ueber datei hinaus : + satznr - satznummer offset > saetze (daten (hauptdatei). eudat) . + +noch weitere datei : + daten (hauptdatei). naechste datei <> 0 . + +END PROC auf satz; + +INT PROC satznummer : + + satznummer offset + satznr (daten (hauptdatei). eudat) + +END PROC satznummer; + +INT PROC satzkombination : + + kombination + +END PROC satzkombination; + +BOOL PROC dateiende : + + ende der datei + +END PROC dateiende; + + +(*************************** Satzverwaltung ******************************) + +SATZ VAR leersatz; +satz initialisieren (leersatz); + +PROC satz einfuegen : + + aenderungen eintragen; + mark satz einfuegen; + satz einfuegen (daten (hauptdatei). eudat, leersatz); + daten (hauptdatei). datei veraendert := TRUE; + alle koppeldateien ans ende; + ende der datei := FALSE; + suchbedingung auswerten . + +mark satz einfuegen : + mark stelle (daten (hauptdatei), satznr (daten (hauptdatei). eudat)); + inkrement (daten (hauptdatei). marksaetze, + daten (hauptdatei). markzeiger, 1) . + +alle koppeldateien ans ende : + kombination := 1; + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + auf dateiende (daten (dateiindex). eudat); + dateiindex := daten (dateiindex). naechste datei + END REP . + +END PROC satz einfuegen; + +PROC satz loeschen : + + IF NOT ende der datei THEN + aenderungen eintragen; + mark satz loeschen; + satz loeschen (daten (hauptdatei). eudat); + daten (hauptdatei). datei veraendert := TRUE; + auf satz (satznummer) + END IF . + +mark satz loeschen : + IF satz markiert THEN + delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger); + markierungen DECR 1 + END IF; + inkrement (daten (hauptdatei). marksaetze, + daten (hauptdatei). markzeiger, -1) . + +END PROC satz loeschen; + + +(*************************** Suchmuster **********************************) + +LET + maxmuster = 100; + +ROW maxmuster STRUCT (INT feld, relator, true exit, false exit, + TEXT muster) + VAR bedingung; + +SATZ VAR muster gespeichert; + +INT VAR + anzahl muster, + erster musterindex, + versionszaehler := 1; + +BOOL VAR + bereits ausgewertet, + erfuellt; + +suchbedingung loeschen; + +INT VAR + muster index; + +LET + gleich test = 1, + beginn test = 2, + endet test = 3, + enthalten test = 4, + kleiner test = 5, + groesser test = 6, + nicht leer test = 7, + markiert test = 8, + true test = 9; + + +PROC suchbedingung auswerten : + + IF ende der datei THEN + erfuellt := FALSE + ELSE + kette verfolgen; + erfuellt := in true exit + END IF . + +kette verfolgen : + musterindex := erster musterindex; + WHILE muster index > 0 REP + gegenfeld bearbeiten; + feld bearbeiten (suchfeld, + PROC (TEXT CONST, INT CONST, INT CONST) bedingung ueberpruefen) + END REP . + +gegenfeld bearbeiten : + INT VAR verwendeter relator := bedingung (musterindex). relator; + IF verwendeter relator >= 256 THEN + gegenfeld lesen; + bei datum umdrehen + END IF . + +gegenfeld lesen : + feld lesen ((verwendeter relator AND 255) + 1, feldpuffer) . + +bei datum umdrehen : + IF jeweiliges feldinfo = 2 THEN + feldpuffer drehen + END IF; + bedingung (musterindex). muster := feldpuffer . + +suchfeld : + bedingung (musterindex). feld . + +in true exit : + musterindex < 0 . + +END PROC suchbedingung auswerten; + +PROC bedingung ueberpruefen (TEXT CONST satz, INT CONST von, bis) : + + INT VAR verwendeter relator := bedingung (musterindex). relator; + IF verwendeter relator >= 256 THEN + verwendeter relator := verwendeter relator DIV 256 + END IF; + IF bedingung trifft zu THEN + musterindex := bedingung (musterindex). true exit + ELSE + musterindex := bedingung (musterindex). false exit + END IF . + +bedingung trifft zu : + SELECT verwendeter relator OF + CASE gleich test : ist gleich + CASE beginn test : beginnt mit + CASE endet test : endet mit + CASE enthalten test : ist enthalten + CASE kleiner test : ist kleiner + CASE groesser test : ist groesser + CASE nicht leer test : ist nicht leer + CASE markiert test : ist markiert + CASE true test : ist true + OTHERWISE FALSE + END SELECT . + +ist gleich : + SELECT jeweiliges feldinfo OF + CASE 0 : feldpuffer als subtext; feldpuffer LEXEQUAL muster + CASE 1 : feldpuffer als subtext; feldwert = musterwert + OTHERWISE length (muster) = bis - von + 1 AND text gleich + END SELECT . + +text gleich : + von > bis COR beginnt mit . + +beginnt mit : + pos (satz, muster, von, bis) = von . + +endet mit : + pos (satz, muster, bis + 1 - length (muster), bis) > 0 . + +ist enthalten : + pos (satz, muster, von, bis) > 0 . + +ist kleiner : + feldpuffer als subtext; + SELECT jeweiliges feldinfo OF + CASE 0 : muster LEXGREATER feldpuffer + CASE 1 : feldwert < musterwert + CASE 2 : feldpuffer drehen; feldpuffer < muster + OTHERWISE feldpuffer < muster + END SELECT . + +ist groesser : + feldpuffer als subtext; + SELECT jeweiliges feldinfo OF + CASE 0 : feldpuffer LEXGREATEREQUAL muster + CASE 1 : feldwert >= musterwert + CASE 2 : feldpuffer drehen; feldpuffer >= muster + OTHERWISE feldpuffer >= muster + END SELECT . + +ist nicht leer : + von <= bis . + +ist markiert : + satz markiert . + +ist true : + TRUE . + +feldpuffer als subtext : + feldpuffer := subtext (satz, von, bis) . + +END PROC bedingung ueberpruefen; + +TEXT PROC muster : + + bedingung (musterindex). muster + +END PROC muster; + +PROC feldpuffer drehen : + + IF length (feldpuffer) = 8 THEN + TEXT CONST jahr := subtext (feldpuffer, 7, 8); + replace (feldpuffer, 7, subtext (feldpuffer, 1, 2)); + replace (feldpuffer, 1, jahr) + ELSE + feldpuffer := niltext + END IF + +END PROC feldpuffer drehen; + +INT PROC jeweiliges feldinfo : + feldinfo (bedingung (musterindex). feld) +END PROC jeweiliges feldinfo; + +REAL PROC feldwert : + + REAL VAR r; + wert berechnen (feldpuffer, r); + r + +END PROC feldwert; + +REAL PROC musterwert : + + REAL VAR r; + wert berechnen (muster, r); + r + +END PROC musterwert; + + +LET + grosses oder = ";", + kleines oder = ",", + intervall symbol = "..", + markierungssymbol = "++", + negation = "--", + stern = "*"; + +BOOL VAR + neue alternative, + neue disjunktion, + verneinung; + +INT VAR + erstes feldmuster, + oder index, + naechster oder anfang, + anfang der disjunktion, + bearbeitetes feld; + +INTVEC VAR oder anfang; + + +PROC suchbedingung (INT CONST feldnr, TEXT CONST bedingung) : + + INT VAR + anfang := 1, + semi pos := 0; + INT CONST + bedingung ende := length (bedingung) + 1; + oder index := 0; + bearbeitetes feld := feldnr; + erstes feldmuster := anzahl muster + 1; + WHILE anfang < bedingung ende REP + feldende feststellen; + bedingung eintragen; + anfang := ende + 2 + END REP; + feld aendern (muster gespeichert, feldnr, bedingung) . + +feldende feststellen : + INT VAR + oder pos := pos (bedingung, kleines oder, anfang); + IF oder pos = 0 THEN oder pos := bedingung ende END IF; + IF semi pos < anfang THEN + neue alternative beginnen + END IF; + INT CONST ende := min (oder pos, semi pos) - 1 . + +neue alternative beginnen : + oder index INCR 1; + neue alternative := TRUE; + IF oder index > 1 THEN globales muster vorhanden := FALSE END IF; + semi pos := pos (bedingung, grosses oder, anfang); + IF semi pos = 0 THEN semi pos := bedingung ende END IF . + +bedingung eintragen : + verneinung testen; + neue disjunktion := TRUE; + INT CONST + intervall pos := pos (bedingung, intervall symbol, anfang, ende + 1); + IF leere bedingung THEN + eintragen (niltext, true test, - oder index) + ELIF intervall pos = 0 THEN + textvergleich + ELSE + groessenvergleich + END IF . + +verneinung testen : + IF subtext (bedingung, anfang, anfang + 1) = negation THEN + anfang INCR 2; verneinung := TRUE + ELSE + verneinung := FALSE + END IF . + +leere bedingung : + anfang > ende . + +text vergleich : + IF test auf markierung THEN + test auf markierung eintragen + ELSE + sterne suchen + END IF . + +test auf markierung : + anfang + 1 = ende CAND + subtext (bedingung, anfang, ende) = markierungssymbol . + +test auf markierung eintragen : + eintragen (niltext, markiert test, - oder index) . + +sterne suchen : + INT VAR stern pos := pos (bedingung, stern, anfang, ende + 1); + IF stern pos = 0 THEN + teste ob feld gleich + ELIF anfang = ende THEN + test auf nichtleeres feld + ELSE + relator bestimmen; + REP + teste auf enthalten sein + END REP + END IF . + +teste ob feld gleich : + IF globales muster moeglich THEN + globales muster vorhanden := TRUE; + globales muster := bedingung + END IF; + eintragen (subtext (bedingung, anfang, ende), gleich test, - oder index) . + +globales muster moeglich : + feldnr = 1 AND anfang = 1 AND ende = bedingung ende - 1 AND + noch keine globalen alternativen AND NOT umgeschaltet AND + (bedingung SUB 1) <> "&" . + +noch keine globalen alternativen : + length (oder anfang) <= 2 . + +test auf nichtleeres feld : + eintragen (niltext, nichtleer test, - oder index) . + +relator bestimmen : + INT VAR relator; + IF stern pos = anfang THEN + relator := gleich test + ELSE + relator := beginn test + END IF . + +teste auf enthalten sein : + IF relator <> gleich test THEN + teilmuster eintragen + END IF; + anfang := stern pos + 1; + stern pos := pos (bedingung, stern, anfang, ende + 1); + IF stern pos = 0 THEN + stern pos := ende + 1; + relator := endet test + ELSE + relator := enthalten test + END IF . + +teilmuster eintragen : + TEXT CONST muster := subtext (bedingung, anfang, stern pos - 1); + IF verneinung OR letztes feld THEN + IF verneinung THEN neue disjunktion := TRUE END IF; + eintragen (muster, relator, - oder index); + IF letztes feld THEN LEAVE sterne suchen END IF + ELSE + eintragen (muster, relator, anzahl muster + 2) + END IF . + +letztes feld : + stern pos >= ende . + +groessenvergleich : + TEXT CONST + muster 1 := subtext (bedingung, anfang, intervall pos - 1), + muster 2 := subtext (bedingung, intervall pos + 2, ende); + IF intervall pos = anfang THEN + eintragen (muster 2, kleiner test, - oder index) + ELIF intervall pos = ende - 1 THEN + eintragen (muster 1, groesser test, - oder index) + ELSE + intervall eintragen + END IF . + +intervall eintragen : + IF verneinung THEN + eintragen (muster 1, groesser test, - oder index); + neue disjunktion := TRUE + ELSE + eintragen (muster 1, groesser test, anzahl muster + 2) + END IF; + eintragen (muster 2, kleiner test, - oder index) . + +END PROC suchbedingung; + +PROC eintragen (TEXT CONST textmuster, INT CONST relator, true exit) : + + musterstatus verwalten; + musterplatz belegen; + IF neue alternative THEN + alte false exits auf neuen anfang setzen; + alte true exits auf diesen platz setzen; + anfang der disjunktion := anzahl muster + ELIF neue disjunktion THEN + false exits der letzten disjunktion anketten + END IF; + vergleichsdaten eintragen; + textmuster eintragen . + +musterstatus verwalten : + bereits ausgewertet := FALSE; + IF anzahl muster = anzahl hauptmuster THEN + versionszaehler INCR 1; + IF versionszaehler > 32000 THEN versionszaehler := 1 END IF + END IF . + +musterplatz belegen : + IF anzahl muster = maxmuster THEN + suchbedingung loeschen; + errorstop (suchmuster zu umfangreich) + ELSE + anzahl muster INCR 1; + erster musterindex := anzahl hauptmuster + 1 + END IF . + +alte false exits auf neuen anfang setzen : + IF oder index > length (oder anfang) DIV 2 THEN + oder anfang CAT anzahl muster; + setze verkettung (erster musterindex, 0, anzahl muster) + END IF; + IF oder index = length (oder anfang) DIV 2 THEN + naechster oder anfang := 0 + ELSE + naechster oder anfang := oder anfang ISUB (oder index + 1) + END IF . + +alte true exits auf diesen platz setzen : + setze verkettung (erster musterindex, - oder index, anzahl muster); + neue alternative := FALSE; + neue disjunktion := FALSE . + +false exits der letzten disjunktion anketten : + setze verkettung (anfang der disjunktion, naechster oder anfang, + anzahl muster); + anfang der disjunktion := anzahl muster; + neue disjunktion := FALSE . + +vergleichsdaten eintragen : + bedingung (anzahl muster). relator := relator; + bedingung (anzahl muster). feld := bearbeitetes feld; + IF verneinung THEN + bedingung (anzahl muster). true exit := naechster oder anfang; + bedingung (anzahl muster). false exit := true exit + ELSE + bedingung (anzahl muster). true exit := true exit; + bedingung (anzahl muster). false exit := naechster oder anfang + END IF . + +textmuster eintragen : + IF textmuster ist gegenfeld THEN + feldnummer des gegenfelds eintragen + ELSE + textmuster original eintragen + END IF . + +textmuster ist gegenfeld : + (textmuster SUB 1) = "&" CAND gueltiges feld . + +gueltiges feld : + INT CONST nr gegenfeld := feldnummer (subtext (textmuster, 2)); + nr gegenfeld > 0 . + +feldnummer des gegenfelds eintragen : + bedingung (anzahl muster). relator := nr gegenfeld - 1 + 256 * relator . + +textmuster original eintragen : + INT CONST info := feldinfo (bearbeitetes feld); + IF info = 2 AND (relator = kleiner test OR relator = groesser test) THEN + feldpuffer := textmuster; + feldpuffer drehen; + bedingung (anzahl muster). muster := feldpuffer + ELSE + bedingung (anzahl muster). muster := textmuster + END IF . + +END PROC eintragen; + +PROC setze verkettung (INT CONST von, wert, durch) : + + INT VAR i; + FOR i FROM von UPTO anzahl muster - 1 REP + IF bedingung (i). true exit = wert THEN + bedingung (i). true exit := durch + ELIF bedingung (i). false exit = wert THEN + bedingung (i). false exit := durch + END IF + END REP + +END PROC setze verkettung; + +PROC suchbedingung lesen (INT CONST feldnr, TEXT VAR bedingung) : + + feld lesen (muster gespeichert, feldnr, bedingung) + +END PROC suchbedingung lesen; + +PROC suchbedingung loeschen : + + disable stop; + IF umgeschaltet THEN + anzahl muster := anzahl hauptmuster + ELSE + anzahl hauptmuster := 0; + anzahl muster := 0 + END IF; + erster musterindex := -1; + oder anfang := empty intvec; + satz initialisieren (muster gespeichert); + globales muster vorhanden := FALSE; + bereits ausgewertet := TRUE; + erfuellt := NOT ende der datei + +END PROC suchbedingung loeschen; + +BOOL PROC satz ausgewaehlt : + + IF NOT bereits ausgewertet THEN + suchbedingung auswerten; + bereits ausgewertet := TRUE + END IF; + erfuellt + +END PROC satz ausgewaehlt; + +INT PROC suchversion : + + IF anzahl muster = anzahl hauptmuster THEN + 0 + ELSE + versionszaehler + END IF + +END PROC suchversion; + + +(*************************** Markierung **********************************) + +PROC mark stelle (DATEI VAR datei, INT CONST satz) : + + IF (datei. marksaetze ISUB datei. markzeiger) < satz THEN + vorwaerts gehen + ELSE + rueckwaerts gehen + END IF . + +vorwaerts gehen : + REP + datei. markzeiger INCR 1 + UNTIL (datei. marksaetze ISUB datei. markzeiger) >= satz END REP . + +rueckwaerts gehen : + WHILE datei. markzeiger > 1 CAND + (datei. marksaetze ISUB (datei. markzeiger - 1)) >= satz REP + datei. markzeiger DECR 1 + END REP . + +END PROC mark stelle; + +PROC markierung aendern : + + disable stop; + IF satz markiert THEN + delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger); + markierungen DECR 1 + ELSE + insert (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger, + satznr (daten (hauptdatei). eudat)); + markierungen INCR 1 + END IF + +END PROC markierung aendern; + +BOOL PROC satz markiert : + + INT CONST satz := satznr (daten (hauptdatei). eudat); + mark stelle (daten (hauptdatei), satz); + satz = + (daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger) + +END PROC satz markiert; + +INT PROC markierte saetze : + + markierungen + +END PROC markierte saetze; + +PROC markierungen loeschen : + + disable stop; + IF umgeschaltet THEN + mark loeschen (daten (hauptdatei)) + ELSE + in allen geketteten dateien loeschen + END IF; + markierungen := 0 . + +in allen geketteten dateien loeschen : + INT VAR dateiindex := 1; + REP + mark loeschen (daten (dateiindex)); + dateiindex := daten (dateiindex). naechste datei + UNTIL dateiindex = 0 END REP . + +END PROC markierungen loeschen; + +PROC mark loeschen (DATEI VAR datei) : + + datei. marksaetze := niltext; + datei. marksaetze CAT maxint; + datei. markzeiger := 1 + +END PROC mark loeschen; + + +END PACKET datenverwaltung; + diff --git a/app/eudas/4.4/src/eudas.drucken b/app/eudas/4.4/src/eudas.drucken new file mode 100644 index 0000000..3176c23 --- /dev/null +++ b/app/eudas/4.4/src/eudas.drucken @@ -0,0 +1,1891 @@ +PACKET eudas drucken + +(*************************************************************************) +(* *) +(* Drucken von EUDAS-Dateien nach Druckmuster *) +(* *) +(* Version 10 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 01.10.87 *) +(* *) +(*************************************************************************) + + DEFINES + +(*dump, (* Test *) *) + + drucke, + interpretiere, + gruppentest, + + druckdatei, + direkt drucken, + max druckzeilen, + + gruppenwechsel, + lfd nr : + + +(*************************** Musterinterpreter ***************************) + +(* + EXPORTS + + INT max musterspeicher + INT VAR interpretationsmodus + interpretiere (INT CONST erste zeile, erstes muster, + PROC (INT CONST, TEXT VAR) abk) +*) + + +LET + max musterspeicher = 25, + SPEICHER = STRUCT (INT feldanfang, + feldlaenge, + setzmodus, + bearbeitet bis, + TEXT inhalt); + +ROW max musterspeicher SPEICHER VAR musterspeicher; + +INT VAR interpretationsmodus; + +LET + niltext = "", + blank = " ", + zwei blanks = " "; + +TEXT VAR ausgabezeile; + + +PROC interpretiere (INT CONST erste zeile, erstes muster, + PROC (INT CONST, TEXT VAR) abkuerzungen) : + + INT VAR + kommandoindex, + anzahl leerzeilen := 0, + anzahl wiederholungen := 0, + aktuelles muster := erstes muster; + + muster auf zeile (erste zeile); + WHILE NOT druckmusterende REP + musterzeile lesen; + IF leerzeile THEN + anzahl leerzeilen INCR 1 + ELSE + letzte leerzeilen beruecksichtigen; + zeile auswerten + END IF + END REP . + +zeile auswerten : + IF kommandozeile (kommandoindex) THEN + kommando auswerten + ELSE + zeile interpretieren; + anzahl wiederholungen := 0 + END IF . + +kommando auswerten : + SELECT kommandoindex OF + CASE modus index : modus umstellen + CASE mehr index : anzahl wiederholungen setzen + OTHERWISE LEAVE interpretiere + END SELECT . + +letzte leerzeilen beruecksichtigen : + WHILE anzahl leerzeilen > 0 REP + zeile drucken (blank); + anzahl leerzeilen DECR 1 + END REP . + +modus umstellen : + int param (interpretationsmodus) . + +anzahl wiederholungen setzen : + int param (anzahl wiederholungen) . + +leerzeile : + musterzeile = niltext OR musterzeile = blank . + +zeile interpretieren : + INT VAR + zeilenzaehler := 0, + zu bearbeitende inhalte := 0; + BOOL VAR + blanks dazwischen := FALSE; + + REP + einen zeilendurchgang; + zeilenzaehler INCR 1; + IF interpretationsmodus = 3 THEN + blanks dazwischen := TRUE + END IF + UNTIL zeile fertig bearbeitet END REP . + +zeile fertig bearbeitet : + IF interpretationsmodus <= 2 THEN + TRUE + ELIF anzahl wiederholungen <> 0 THEN + zeilenzaehler = anzahl wiederholungen + ELSE + zu bearbeitende inhalte = 0 + END IF . + +einen zeilendurchgang : + INT VAR + letztes feldende := 1, + reservelaenge := 0, + benoetigte reserve := 0, + einzulesendes muster := 1, + einzusetzendes muster := 1; + + ausgabezeile := niltext; + REP + IF musterinhalt abspeichern THEN + musterinhalt besorgen + END IF; + IF festes muster THEN + zeilenabschnitt ausgeben + END IF; + einsetzdaten sammeln; + einzulesendes muster INCR 1 + END REP . + +musterinhalt abspeichern : + zeilenzaehler = 0 . + +musterinhalt besorgen : + naechstes muster (lesespeicher. feldanfang, lesespeicher. feldlaenge, + lesespeicher. setzmodus); + IF NOT zeilenende THEN + musterinhalt lesen + END IF . + +zeilenende : + lesespeicher. feldanfang > length (musterzeile) . + +musterinhalt lesen : + INT CONST musterfunktion := musterindex (aktuelles muster); + IF musterfunktion > 0 THEN + feld lesen (musterfunktion, lesespeicher. inhalt) + ELSE + abkuerzungen (-musterfunktion, lesespeicher. inhalt) + END IF; + aktuelles muster INCR 1; + lesespeicher. bearbeitet bis := 0; + IF lesespeicher. inhalt <> niltext THEN + zu bearbeitende inhalte INCR 1 + END IF . + +festes muster : + lesespeicher. setzmodus >= 4 . + +lesespeicher : + musterspeicher (einzulesendes muster) . + +einsetzdaten sammeln : + INT CONST reserve := setzdifferenz (lesespeicher); + IF reserve > 0 THEN + reserve merken + ELSE + benoetigte reserve DECR reserve + END IF . + +reserve merken : + reservelaenge INCR reserve; + IF linksschieben verboten AND reservelaenge > benoetigte reserve THEN + reservelaenge := benoetigte reserve + END IF; + IF kein inhalt mehr einzusetzen AND variabel THEN + loeschbare blanks zaehlen + END IF . + +linksschieben verboten : + interpretationsmodus = 2 OR interpretationsmodus = 4 . + +kein inhalt mehr einzusetzen : + reserve = lesespeicher. feldlaenge . + +variabel : + (lesespeicher. setzmodus AND 1) = 0 . + +loeschbare blanks zaehlen : + IF lesespeicher. feldanfang = 1 COR + (musterzeile SUB (lesespeicher. feldanfang - 1)) = blank THEN + INT VAR ende := feldende (einzulesendes muster); + WHILE (musterzeile SUB ende) = blank REP + ende INCR 1; + lesespeicher. feldlaenge INCR 1; + reservelaenge INCR 1 + END REP + END IF . + +zeilenabschnitt ausgeben : + IF einzulesendes muster = 1 THEN + IF zeilenende THEN + zeile ganz ausgeben + END IF + ELSE + zeile bis dahin zusammenstellen + END IF . + +zeile ganz ausgeben : + IF blanks dazwischen THEN + zeile drucken (blank) + ELSE + zeile drucken (musterzeile) + END IF; + LEAVE einen zeilendurchgang . + +zeile bis dahin zusammenstellen : + INT VAR + blankluecke := 0, + blankpuffer := lesespeicher. feldanfang; + INT CONST + endeluecke := blankpuffer - length (musterzeile); + blankluecke suchen; + alle zwischenliegenden muster in ausgabedatei kopieren; + letzten zwischenraum kopieren; + zeilenende behandeln . + +blankluecke suchen : + IF endeluecke > 0 THEN + reservelaenge INCR endeluecke; + blankpuffer DECR (endeluecke - 1) + END IF; + rueckwaerts zwei blanks suchen . + +rueckwaerts zwei blanks suchen : + INT CONST + ende voriges feld := feldende (einzulesendes muster - 1), + leerstelle := + pos (musterzeile, zwei blanks, ende voriges feld, blankpuffer); + IF leerstelle > 0 THEN + blankpuffer := leerstelle; + groesse der blankluecke bestimmen + ELIF endeluecke < 0 AND (musterzeile SUB (blankpuffer - 1)) <> blank THEN + blankpuffer := ende voriges feld + END IF . + +groesse der blankluecke bestimmen : + INT VAR ende der luecke := blankpuffer + 1; + REP + blankluecke INCR 1; + ende der luecke INCR 1 + UNTIL (musterzeile SUB ende der luecke) <> blank END REP; + reservelaenge INCR blankluecke . + +alle zwischenliegenden muster in ausgabedatei kopieren : + INT VAR verschiebung := 0; + WHILE einzusetzendes muster < einzulesendes muster REP + setzspeicher in einzelvariablen lesen; + musterzwischenraum kopieren; + muster einsetzen; + einzusetzendes muster INCR 1 + END REP . + +setzspeicher in einzelvariablen lesen : + INT CONST + feldanfang := setzspeicher. feldanfang, + feldlaenge := setzspeicher. feldlaenge, + setzmodus := setzspeicher. setzmodus . + +musterzwischenraum kopieren : + zwischenraum (letztes feldende, feldanfang, blanks dazwischen); + letztes feldende := feldanfang + feldlaenge . + +setzspeicher : + musterspeicher (einzusetzendes muster) . + +muster einsetzen : + INT CONST ueberschuss := - setzdifferenz (setzspeicher); + IF ueberschuss = - feldlaenge THEN + leeres feld behandeln + ELIF ueberschuss <= 0 THEN + in voller laenge einsetzen + ELIF variable laenge AND reserve vorhanden THEN + einsetzen und nach rechts schieben + ELSE + bis zur grenze einsetzen + END IF . + +leeres feld behandeln : + IF variable laenge THEN + verschiebung INCR ueberschuss; + IF linksschieben verboten THEN + verschiebung korrigieren + END IF + ELSE + blanks anfuegen (-ueberschuss) + END IF . + +verschiebung korrigieren : + IF verschiebung < 0 THEN + blanks anfuegen (-verschiebung); + verschiebung := 0 + END IF . + +in voller laenge einsetzen : + IF rechtsbuendig THEN + blanks anfuegen (-ueberschuss) + END IF; + musterspeicher ganz ausgeben (setzspeicher); + zu bearbeitende inhalte DECR 1; + IF feste laenge THEN + ggf mit blanks auffuellen + ELSE + verschiebung INCR ueberschuss; + linksschieben korrigieren + END IF . + +rechtsbuendig : + (setzmodus AND 2) = 2 . + +feste laenge : + (setzmodus AND 1) = 1 . + +ggf mit blanks auffuellen : + IF NOT rechtsbuendig THEN + blanks anfuegen (-ueberschuss) + END IF . + +linksschieben korrigieren : + IF linksschieben verboten AND verschiebung < 0 THEN + blanks anfuegen (-verschiebung); + verschiebung := 0 + END IF . + +variable laenge : + NOT feste laenge . + +reserve vorhanden : + ueberschuss <= reservelaenge . + +einsetzen und nach rechts schieben : + musterspeicher ganz ausgeben (setzspeicher); + zu bearbeitende inhalte DECR 1; + verschiebung INCR ueberschuss; + reservelaenge DECR ueberschuss . + +bis zur grenze einsetzen : + INT VAR + umbruchblanks := 0, + anfang := setzspeicher. bearbeitet bis + 1, + setz ende := anfang + feldlaenge - 1; + IF variable laenge THEN + setz ende INCR reservelaenge + END IF; + IF rechtsbuendig AND keine mehrfachzeilen THEN + rechten teil einsetzen + ELIF mehrfachzeilen erlaubt THEN + umbruch + END IF; + teilfeld ausgeben; + IF variable laenge THEN + verschiebung INCR reservelaenge; + reservelaenge := 0 + END IF . + +rechten teil einsetzen : + INT CONST nach rechts := length (setzspeicher. inhalt) - setz ende; + anfang INCR nach rechts; + setz ende INCR nach rechts . + +mehrfachzeilen erlaubt : + interpretationsmodus >= 3 . + +keine mehrfachzeilen : + NOT mehrfachzeilen erlaubt . + +teilfeld ausgeben : + IF rechtsbuendig THEN + blanks anfuegen (umbruchblanks) + END IF; + druckausgabe (setzspeicher. inhalt, anfang, setz ende); + IF linksbuendig THEN + blanks anfuegen (umbruchblanks) + END IF . + +linksbuendig : + NOT rechtsbuendig . + +umbruch : + IF pos (setzspeicher. inhalt, blank, anfang, setz ende) > 0 THEN + ende zuruecksetzen + END IF; + INT CONST naechstes wort := + pos (setzspeicher. inhalt, ""33"", ""254"", setz ende + 1); + IF naechstes wort = 0 THEN + setzspeicher. bearbeitet bis := length (setzspeicher. inhalt); + zu bearbeitende inhalte DECR 1 + ELSE + setzspeicher. bearbeitet bis := naechstes wort - 1 + END IF . + +ende zuruecksetzen : + setz ende INCR 1; umbruchblanks DECR 1; + WHILE (setzspeicher. inhalt SUB setz ende) <> blank REP + setz ende DECR 1; + umbruchblanks INCR 1 + END REP; + WHILE (setzspeicher. inhalt SUB setz ende) = blank REP + setz ende DECR 1; + umbruchblanks INCR 1 + UNTIL ende < anfang END REP . + +letzten zwischenraum kopieren : + zwischenraum (letztes feldende, blankpuffer, blanks dazwischen); + IF verschiebung < 0 THEN + IF blankpuffer <= length (musterzeile) THEN + blanks anfuegen (-verschiebung) + END IF; + letztes feldende := blankpuffer + ELSE + letztes feldende := blankpuffer + min (verschiebung, blankluecke) + END IF . + +zeilenende behandeln : + IF endeluecke > 0 THEN + rest der musterzeile drucken; + zeile ausgeben; + LEAVE einen zeilendurchgang + ELSE + folgenden abschnitt vorbereiten + END IF . + +rest der musterzeile drucken : + IF NOT blanks dazwischen THEN + druckausgabe (musterzeile, letztes feldende, length (musterzeile)) + END IF . + +zeile ausgeben : + INT VAR neues ende := length (ausgabezeile); + IF (ausgabezeile SUB neues ende) = blank THEN + REP + neues ende DECR 1 + UNTIL (ausgabezeile SUB neues ende) <> blank END REP; + ausgabezeile := subtext (ausgabezeile, 1, neues ende) + END IF; + IF absatzmarkierung noetig THEN + ausgabezeile CAT blank + END IF; + zeile drucken (ausgabezeile) . + +absatzmarkierung noetig : + (musterzeile SUB LENGTH musterzeile) = blank AND + (interpretationsmodus <> 3 OR zu bearbeitende inhalte = 0) . + +folgenden abschnitt vorbereiten : + reservelaenge := 0; + benoetigte reserve := 0 . + +END PROC interpretiere; + +INT PROC feldende (INT CONST speicherindex) : + + musterspeicher (speicherindex). feldanfang + + musterspeicher (speicherindex). feldlaenge + +END PROC feldende; + +INT PROC setzdifferenz (SPEICHER CONST speicher) : + + speicher. feldlaenge - length (speicher. inhalt) + + speicher. bearbeitet bis + +END PROC setzdifferenz; + +LET + zehn blanks = " "; + +PROC blanks anfuegen (INT CONST anzahl) : + + INT VAR zaehler := anzahl; + WHILE zaehler >= 10 REP + ausgabezeile CAT zehn blanks; + zaehler DECR 10 + END REP; + WHILE zaehler > 0 REP + ausgabezeile CAT blank; + zaehler DECR 1 + END REP + +END PROC blanks anfuegen; + +PROC musterspeicher ganz ausgeben (SPEICHER VAR speicher) : + + IF speicher. bearbeitet bis = 0 THEN + ausgabezeile CAT speicher. inhalt + ELSE + druckausgabe (speicher. inhalt, speicher. bearbeitet bis + 1, + length (speicher. inhalt)) + END IF; + speicher. bearbeitet bis := length (speicher. inhalt) + +END PROC musterspeicher ganz ausgeben; + +PROC zwischenraum (INT CONST von, bis, BOOL CONST blanks dazwischen) : + + IF blanks dazwischen THEN + blanks anfuegen (bis - von) + ELSE + druckausgabe (musterzeile, von, bis - 1) + END IF + +END PROC zwischenraum; + +TEXT VAR ausgabepuffer; + +PROC druckausgabe (TEXT CONST context, INT CONST von, bis) : + + ausgabepuffer := subtext (context, von, bis); + ausgabezeile CAT ausgabepuffer + +END PROC druckausgabe; + + +(************************* Musterscanner *********************************) + +(* + EXPORTS + + FILE VAR druckmuster + naechstes muster (TEXT VAR mustername) + naechstes muster (INT VAR musteranfang, musterlaenge, setzmodus) + musterzeile lesen + TEXT musterzeile + INT zeilennr + muster auf zeile (INT CONST neue zeile) + BOOL kommandozeile (INT VAR kommandoindex) + int param (INT VAR param) + INT m pos + BOOL druckmusterende + ueberlesen (TEXT CONST zeichen) + INT musterzeilenbreite + standard musterzeilenbreite +*) + + +FILE VAR druckmuster; + +TEXT VAR musterzeile; + +INT VAR m pos; + +LET + keine schliessende klammer = #401# + "keine schliessende Klammer in Feldmuster", + kein kommando in kommandozeile = #402# + "kein Kommando in Kommandozeile", + unbekanntes kommando = #403# + "unbekanntes Kommando"; + +LET + fix symbol = "&", + var symbol = "%", + com symbol = "%", + klammer auf = "<", + klammer zu = ">"; + +LET + kommandos = #404# + " "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN + "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR " + + +LET + vor index = 1, + wdh index = 2, + nach index = 3, + abk index = 4, + gruppe index = 5, + modus index = 6, + mehr index = 7, + do index = 100; + +INT VAR + musterzeilenbreite, + name anfang, + name ende; + +BOOL VAR + druckmusterende, + zeile gelesen; + + +. +zeilennr : + line no (druckmuster) . + +standard musterzeilenbreite : + musterzeilenbreite := maxlinelength (druckmuster) . + + +PROC ueberlesen (TEXT CONST zeichen) : + + REP + m pos INCR 1 + UNTIL (musterzeile SUB m pos) <> zeichen END REP + +END PROC ueberlesen; + +PROC naechstes muster (INT VAR anfang, laenge, setzmodus) : + + m pos auf naechsten anfang; + IF zeilenende THEN + anfang := max (musterzeilenbreite, length (musterzeile)) + 1; + laenge := 0; + setzmodus := 5 + ELSE + anfang := m pos; + muster lesen + END IF . + +m pos auf naechsten anfang : + m pos auf zeichen (fix symbol, var symbol) . + +zeilenende : + m pos > length (musterzeile) . + +muster lesen : + TEXT CONST musterzeichen := musterzeile SUB m pos; + IF musterzeichen = var symbol THEN + setzmodus := 0 + ELSE + setzmodus := 4 + END IF; + anfangszeichen ueberlesen; + feldnamen lesen; + endezeichen ueberlesen . + +anfangszeichen ueberlesen : + ueberlesen (musterzeichen); + IF m pos - 1 > anfang THEN + ist rechtsbuendig + END IF . + +ist rechtsbuendig : + setzmodus INCR 3 . + +feldnamen lesen : + IF (musterzeile SUB m pos) = klammer auf THEN + bis klammer zu lesen + ELSE + bis blank oder muster lesen + END IF; + IF leerer feldname THEN + naechstes muster (anfang, laenge, setzmodus); + LEAVE naechstes muster + END IF . + +leerer feldname : + name anfang > name ende . + +bis klammer zu lesen : + name anfang := m pos + 1; + name ende := pos (musterzeile, klammer zu, name anfang); + IF name ende = 0 THEN + fehler (keine schliessende klammer, subtext (musterzeile, m pos)); + name ende := length (musterzeile) + ELSE + name ende DECR 1 + END IF; + m pos := name ende + 2 . + +bis blank oder muster lesen : + name anfang := m pos; + m pos auf zeichen (blank, var symbol); + INT CONST zwischenpos := pos (musterzeile, fix symbol, name anfang, m pos); + IF zwischenpos > 0 THEN + m pos := zwischenpos + END IF; + name ende := m pos - 1 . + +endezeichen ueberlesen : + IF musterzeichen angetroffen THEN + ist fest; + ueberlesen (musterzeichen) + END IF; + laenge := m pos - anfang . + +musterzeichen angetroffen : + (musterzeile SUB m pos) = musterzeichen . + +ist fest : + setzmodus := setzmodus OR 1 . + +END PROC naechstes muster; + +PROC naechstes muster (TEXT VAR name) : + + INT VAR d1, laenge, d3; + naechstes muster (d1, laenge, d3); + IF laenge > 0 THEN + name := subtext (musterzeile, name anfang, name ende) + ELSE + name := niltext + END IF + +END PROC naechstes muster; + +PROC m pos auf zeichen (TEXT CONST zeichen 1, zeichen 2) : + + INT CONST + pos 1 := pos (musterzeile, zeichen 1, m pos), + pos 2 := pos (musterzeile, zeichen 2, m pos); + m pos := length (musterzeile) + 1; + IF pos 1 > 0 THEN + m pos := pos 1 + END IF; + IF pos 2 > 0 AND pos 2 < m pos THEN + m pos := pos 2 + END IF + +END PROC m pos auf zeichen; + +PROC muster auf zeile (INT CONST zeile) : + + to line (druckmuster, zeile); + zeile gelesen := FALSE; + druckmusterende := eof (druckmuster) + +END PROC muster auf zeile; + +PROC musterzeile lesen : + + IF zeile gelesen THEN + down (druckmuster) + ELSE + zeile gelesen := TRUE + END IF; + read record (druckmuster, musterzeile); + m pos := 1; + druckmusterende := line no (druckmuster) >= lines (druckmuster) + +END PROC musterzeile lesen; + +BOOL PROC kommandozeile (INT VAR kommandoindex) : + + m pos := 1; + IF (musterzeile SUB 1) <> com symbol THEN + FALSE + ELIF (musterzeile SUB 2) <> com symbol THEN + kommando abtrennen; + kommandoindex bestimmen; + TRUE + ELSE + kommandoindex := do index; + TRUE + END IF . + +kommando abtrennen : + TEXT VAR kommando; + ueberlesen (blank); + IF m pos > length (musterzeile) THEN + fehler (kein kommando in kommandozeile, musterzeile); + kommandoindex := 0; + LEAVE kommandozeile WITH TRUE + END IF; + INT CONST blank pos := pos (musterzeile, blank, m pos); + IF blank pos = 0 THEN + kommando := subtext (musterzeile, m pos); + kommando CAT blank; + m pos := length (musterzeile) + 1 + ELSE + kommando := subtext (musterzeile, m pos, blank pos); + m pos := blank pos + END IF . + +kommandoindex bestimmen : + INT CONST wo := pos (kommandos, kommando); + IF wo > 0 CAND (kommandos SUB (wo - 2)) = blank THEN + kommandoindex := code (kommandos SUB (wo - 1)) + ELSE + kommandoindex := 0; + fehler (unbekanntes kommando, kommando); + END IF . + +END PROC kommandozeile; + +PROC int param (INT VAR param) : + + ueberlesen (blank); + INT CONST par anfang := m pos; + WHILE ziffer REP + m pos INCR 1 + END REP; + IF m pos > par anfang THEN + param := int (subtext (musterzeile, par anfang, m pos - 1)) + ELSE + param := -1 + END IF . + +ziffer : + pos ("0123456789", musterzeile SUB m pos) > 0 . + +END PROC int param; + + +(**************************** Codegenerierung ****************************) + +(* + EXPORTS + + FILE VAR programm + BOOL wird uebersetzt + proc name (TEXT CONST name) + end proc + anweisung (TEXT CONST text) + anweisung (TEXT CONST pre, mid, post) + anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post) + interpret anweisung (INT CONST zeile, muster) +*) + +FILE VAR programm; + +TEXT VAR + aktuelle proc; + +BOOL VAR + wird uebersetzt; + + +PROC proc name (TEXT CONST name) : + + aktuelle proc := name; + programmausgabe ("PROC ", name, " :") + +END PROC proc name; + +PROC end proc : + + programmausgabe ("END PROC ", aktuelle proc, ";") + +END PROC end proc; + +PROC anweisung (TEXT CONST programmtext) : + + wird uebersetzt := TRUE; + putline (programm, programmtext) + +END PROC anweisung; + +PROC anweisung (TEXT CONST pre, mid, post) : + + wird uebersetzt := TRUE; + programmausgabe (pre, mid, post) + +END PROC anweisung; + +PROC programmausgabe (TEXT CONST pre, mid, post) : + + write (programm, pre); + write (programm, mid); + write (programm, post); + line (programm) + +END PROC programmausgabe; + +TEXT VAR textpuffer; + +PROC anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post) : + + text puffer := subtext (musterzeile, spalte); + anweisung (pre, textpuffer, post) + +END PROC anweisung; + +PROC interpret anweisung (INT CONST zeile, muster) : + + programmausgabe ("; interpretiere (", + text (zeile) + ", " + text (muster), + ", PROC (INT CONST, TEXT VAR) abk);") + +END PROC interpret anweisung; + + +(************************ Muster uebersetzen *****************************) + +(* + EXPORTS + + druckmuster uebersetzen + ROW 3 ABSCHNITT VAR abschnitte + ROW max muster INT VAR musterindex + fehler (TEXT CONST meldung) + ROW maxgruppen GRUPPE VAR gruppen + +*) + + +LET + vorzeitiges ende = #405# + "kein % WIEDERHOLUNG gefunden", + nur gruppe erlaubt = #406# + "Nur GRUPPE-Anweisung erlaubt", + kein do mehr erlaubt nach gruppen = #407# + "keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition", + illegale gruppennummer = #408# + "illegale Gruppennummer", + gruppe schon definiert = #409# + "diese Gruppe wurde schon definiert", + abkuerzung nicht definiert = #410# + "diese Abkuerzung ist nicht definiert", + abschnitt mehrfach definiert = #411# + "dieser Abschnitt wurde schon einmal definiert", + falscher modus = #412# + "falscher Modus", + im musterteil nicht erlaubt = #413# + "diese Anweisung darf im Musterteil nicht vorkommen", + im abkuerzungsteil nicht erlaubt = #414# + "im Abkuerzungsteil darf keine Anweisung auftreten", + zuviele muster pro zeile = #415# + "in dieser Zeile stehen zu viele Feldmuster", + zuviele muster = #416# + "das Druckmuster enthaelt zu viele Feldmuster", + name der abkuerzung fehlt = #417# + "nach dem ""&"" soll direkt der Name einer Abkuerzung folgen", + kein doppelpunkt nach abkuerzung = #418# + "kein Doppelpunkt nach Abkuerzung", + abkuerzung mehrfach definiert = #419# + "Abkuerzung mehrfach definiert", + zu viele abkuerzungen = #420# + "das Druckmuster enthaelt zu viele Abkuerzungen"; + +LET + max muster = 200, + max gruppen = 4, + max abkuerzungen = 250, + + GRUPPE = STRUCT (BOOL wechsel, + definiert, + TEXT inhalt), + + ABSCHNITT = STRUCT (INT erstes muster, + erste zeile, + TEXT proc name); + + +ROW max muster INT VAR musterindex; + +INT VAR anzahl muster; + +ROW maxgruppen GRUPPE VAR gruppen; + +ROW 3 ABSCHNITT VAR abschnitte; + +SATZ VAR abkuerzungen; + +TEXT VAR + abkuerzungszeile; + +INT VAR + anzahl abkuerzungen; + + +OP CAT (TEXT VAR intvec, INT CONST wert) : + + TEXT VAR platz fuer int := " "; + replace (platz fuer int, 1, wert); + intvec CAT platz fuer int + +END OP CAT; + +PROC druckmuster uebersetzen : + + enable stop; + muster auf zeile (1); + uebersetzungsvariablen initialisieren; + initialisierungsteil uebersetzen; + WHILE NOT druckmusterende REP + einen von drei abschnitten uebersetzen + END REP; + abkuerzungen einsetzen . + +uebersetzungsvariablen initialisieren : + INT VAR kommandoindex; + INT VAR i; + anzahl abkuerzungen := 0; + satz initialisieren (abkuerzungen); + abkuerzungszeile := niltext; + anzahl muster := 0; + wird uebersetzt := FALSE; + abschnitte (1) := ABSCHNITT : (0, 0, "vorspann"); + abschnitte (2) := ABSCHNITT : (0, 0, "wdh"); + abschnitte (3) := ABSCHNITT : (0, 0, "nachspann"); + FOR i FROM 1 UPTO max gruppen REP + gruppen (i). definiert := FALSE + END REP . + +initialisierungsteil uebersetzen : + BOOL VAR + schon gruppendefinition := FALSE; + + REP + IF druckmusterende THEN + fehler (vorzeitiges ende); + LEAVE druckmuster uebersetzen + END IF; + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + initialisierungskommando uebersetzen + END IF + END REP . + +initialisierungskommando uebersetzen : + SELECT kommandoindex OF + + CASE do index : + do kommando kopieren + + CASE gruppe index : + gruppendefinition aufnehmen + + CASE vor index, wdh index, nach index : + IF NOT schon gruppendefinition THEN + proc name ("gruppen") + END IF; + end proc; + LEAVE initialisierungsteil uebersetzen + + OTHERWISE + IF kommandoindex > 0 THEN + fehler (nur gruppe erlaubt) + END IF + + END SELECT . + +do kommando kopieren : + IF schon gruppendefinition THEN + fehler (kein do mehr erlaubt nach gruppen, musterzeile) + ELSE + replace (musterzeile, 1, " "); + anweisung (musterzeile) + END IF . + +gruppendefinition aufnehmen : + IF NOT schon gruppendefinition THEN + proc name ("gruppen"); + schon gruppendefinition := TRUE + END IF; + INT VAR gruppennr; + int param (gruppennr); + IF gruppennr < 1 OR gruppennr > max gruppen THEN + fehler (illegale gruppennummer, musterzeile) + ELIF gruppen (gruppennr). definiert THEN + fehler (gruppe schon definiert, musterzeile) + ELSE + gruppen (gruppennr). definiert := TRUE; + ausdruck uebersetzen + END IF . + +ausdruck uebersetzen : + anweisung ("gruppentest (", text (gruppennr), ", "); + anweisung (" ", m pos, ");") . + +einen von drei abschnitten uebersetzen : + SELECT kommandoindex OF + CASE vor index : vorspann uebersetzen + CASE wdh index : wiederholungsteil uebersetzen + CASE nach index : nachspann uebersetzen + END SELECT . + +vorspann uebersetzen : + abschnitt uebersetzen (abschnitte (1), kommandoindex) . + +wiederholungsteil uebersetzen : + int param (spalten); int param (spaltenbreite); + abschnitt uebersetzen (abschnitte (2), kommandoindex) . + +nachspann uebersetzen : + abschnitt uebersetzen (abschnitte (3), kommandoindex) . + +abkuerzungen einsetzen : + IF wird uebersetzt THEN + fehlende procs definieren; + abk headline + END IF; + abkuerzungen ueberpruefen; + IF wird uebersetzt THEN + abk ende; + druckaufruf + END IF . + +abkuerzungen ueberpruefen : + FOR i FROM 1 UPTO anzahl abkuerzungen REP + IF (abkuerzungszeile ISUB i) > 0 THEN + fehler (abkuerzung nicht definiert, + name der abkuerzung, abkuerzungszeile ISUB i) + ELSE + anweisung in abk proc generieren + END IF + END REP . + +name der abkuerzung : + TEXT VAR puffer; + feld lesen (abkuerzungen, i, puffer); + puffer . + +fehlende procs definieren : + FOR i FROM 1 UPTO 3 REP + IF abschnitte (i). erste zeile = 0 THEN + abschnitt proc definieren + END IF + END REP . + +abschnitt proc definieren : + proc name (abschnitte (i). proc name); + end proc . + +abk headline : + anweisung ("PROC abk (INT CONST nr, TEXT VAR inhalt) :"); + IF anzahl abkuerzungen > 0 THEN + anweisung ("SELECT nr OF") + ELSE + anweisung ("inhalt := text (nr)") + END IF . + +anweisung in abk proc generieren : + TEXT CONST lfd index := text (i); + anweisung ("CASE " + lfd index, " : inhalt := abk", lfd index) . + +abk ende : + IF anzahl abkuerzungen > 0 THEN + anweisung ("END SELECT") + END IF; + anweisung ("END PROC abk;") . + +druckaufruf : + anweisung + ("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)") . + +END PROC druckmuster uebersetzen; + +PROC abschnitt uebersetzen (ABSCHNITT VAR abschnitt, + INT VAR kommandoindex) : + + BOOL VAR war do zeile := TRUE; (* generiert erstes 'interpretiere' *) + proc name (abschnitt. proc name); + abschnitt anfang speichern; + musterteil uebersetzen; + abkuerzungen uebersetzen . + +abschnitt anfang speichern : + IF abschnitt. erste zeile <> 0 THEN + fehler (abschnitt mehrfach definiert, musterzeile) + END IF; + abschnitt. erste zeile := zeilennr + 1; + abschnitt. erstes muster := anzahl muster + 1 . + +musterteil uebersetzen : + WHILE NOT druckmusterende REP + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + abschnitt kommando uebersetzen + ELSE + interpret anweisung generieren; + musterzeile auf feldmuster untersuchen + END IF + END REP; + abschnitt beenden; + LEAVE abschnitt uebersetzen . + +abschnitt kommando uebersetzen : + SELECT kommandoindex OF + + CASE do index : + replace (musterzeile, 1, " "); + anweisung (musterzeile); + war do zeile := TRUE + + CASE vor index, wdh index, nach index : + abschnitt beenden; + LEAVE abschnitt uebersetzen + + CASE abk index : + abschnitt beenden; + LEAVE musterteil uebersetzen + + CASE modus index : + interpret anweisung generieren; + INT VAR parameter; + int param (parameter); + IF parameter < 1 OR parameter > 4 THEN + fehler (falscher modus, musterzeile) + END IF + + CASE mehr index : + interpret anweisung generieren + + OTHERWISE + IF kommandoindex > 0 THEN + fehler (im musterteil nicht erlaubt) + END IF + + END SELECT . + +interpret anweisung generieren : + IF war do zeile THEN + interpret anweisung (zeilennr, anzahl muster + 1); + war do zeile := FALSE + END IF . + +abschnitt beenden : + end proc . + +musterzeile auf feldmuster untersuchen : + TEXT VAR name; + INT VAR muster pro zeile := 0; + + REP + naechstes muster (name); + IF name = niltext THEN + LEAVE musterzeile auf feldmuster untersuchen + END IF; + muster pro zeile INCR 1; + muster uebersetzen + END REP . + +muster uebersetzen : + IF muster pro zeile >= max musterspeicher THEN + fehler (zu viele muster pro zeile) + END IF; + IF anzahl muster = max muster THEN + fehler (zu viele muster) + ELSE + anzahl muster INCR 1 + END IF; + vorlaeufigen musterindex suchen . + +vorlaeufigen musterindex suchen : + INT VAR feldnr := feldnummer (name); + IF feldnr = 0 THEN + feldnr := feldindex (abkuerzungen, name); + IF feldnr = 0 THEN + abkuerzung eintragen (name, zeilennr); + musterindex (anzahl muster) := -anzahl abkuerzungen + ELSE + musterindex (anzahl muster) := -feldnr + END IF + ELSE + musterindex (anzahl muster) := feldnr + END IF . + +abkuerzungen uebersetzen : + BOOL VAR erste abkuerzungszeile := TRUE; + WHILE NOT druckmusterende REP + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + auf ende pruefen + ELIF zeile nicht leer THEN + abkuerzung behandeln + END IF + END REP . + +auf ende pruefen : + SELECT kommandoindex OF + CASE vor index, wdh index, nach index : + LEAVE abkuerzungen uebersetzen + OTHERWISE + IF kommandoindex > 0 THEN + fehler (im abkuerzungsteil nicht erlaubt) + END IF + END SELECT . + +abkuerzung behandeln : + IF erste abkuerzungszeile THEN + anweisung ("."); + erste abkuerzungszeile := FALSE + END IF; + IF erste zeile einer abkuerzung THEN + namen isolieren + ELSE + anweisung (musterzeile) + END IF . + +erste zeile einer abkuerzung : + (musterzeile SUB 1) = fix symbol . + +namen isolieren : + TEXT VAR abkuerzungsname; + naechstes muster (abkuerzungsname); + IF abkuerzungsname = niltext THEN + fehler (name der abkuerzung fehlt, musterzeile); + LEAVE namen isolieren + END IF; + doppelpunkt suchen; + an compiler uebergeben . + +doppelpunkt suchen : + LET doppelpunkt = ":"; + m pos DECR 1; (* wegen 'ueberlesen' *) + ueberlesen (blank); + IF (musterzeile SUB m pos) = doppelpunkt THEN + m pos INCR 1 + ELSE + fehler (kein doppelpunkt nach abkuerzung, musterzeile) + END IF . + +an compiler uebergeben : + abkuerzung eintragen (abkuerzungsname, 0); + anweisung (refinement name, m pos - 1, "") . + +refinement name : + "abk" + text (feldindex (abkuerzungen, abkuerzungsname)) . + +zeile nicht leer : + musterzeile <> niltext AND musterzeile <> blank . + +END PROC abschnitt uebersetzen; + +PROC abkuerzung eintragen (TEXT CONST name, INT CONST zeile) : + + INT CONST vorhanden := feldindex (abkuerzungen, name); + IF vorhanden > 0 THEN + alten eintrag ergaenzen + ELSE + neu anlegen + END IF . + +alten eintrag ergaenzen : + IF (abkuerzungszeile ISUB vorhanden) > 0 THEN + replace (abkuerzungszeile, vorhanden, zeile) + ELIF zeile = 0 THEN + fehler (abkuerzung mehrfach definiert, name) + END IF . + +neu anlegen : + IF anzahl abkuerzungen = max abkuerzungen THEN + fehler (zu viele abkuerzungen) + ELSE + anzahl abkuerzungen INCR 1 + END IF; + abkuerzungszeile CAT zeile; + feld aendern (abkuerzungen, anzahl abkuerzungen, name) . + +END PROC abkuerzung eintragen; + +LET + fehler in = #421# + "FEHLER in Zeile ", + fehler bei = #422# + " bei >>", + fehler ende = #423# + "<<"; + +PROC fehler (TEXT CONST fehlermeldung, bei, INT CONST zeile) : + + LET + blanks = " "; + TEXT VAR + meldung := fehler in; + meldung CAT text (zeile); + IF bei <> niltext THEN + meldung CAT fehler bei; + meldung CAT bei; + meldung CAT fehler ende + END IF; + note (meldung); note line; + note (blanks); note (fehlermeldung); note line; + IF online AND command dialogue THEN + line; + putline (meldung); + put (blanks); putline (fehlermeldung) + END IF + +END PROC fehler; + +PROC fehler (TEXT CONST fehlermeldung) : + + fehler (fehlermeldung, niltext, zeilennr) + +END PROC fehler; + +PROC fehler (TEXT CONST fehlermeldung, bei) : + + fehler (fehlermeldung, bei, zeilennr) + +END PROC fehler; + + +(************************** Drucksteuerung *******************************) + +(* + EXPORTS + + drucke (TEXT CONST dateiname) + drucke (PROC gruppen, PROC vor, PROC wdh, PROC nach) + druckdatei (TEXT CONST dateiname) + direkt drucken (BOOL CONST modus) + BOOL direkt drucken + max druckzeilen (INT CONST zeilen) + BOOL gruppenwechsel (INT CONST gruppennr) + gruppentest (INT CONST gruppe, TEXT CONST merkmal) + TEXT lfd nr + zeile drucken (TEXT CONST zeile) + INT spalten + INT spaltenbreite +*) + + +LET + erzeugtes programm = #424# + "erzeugtes Programm", + keine datei geoeffnet = #425# + "keine Datei geoeffnet", + interner fehler = #426# + "interner Fehler", + druckausgabe steht in = #427# + "Druckausgabe steht in", + zum drucker geschickt = #428# + "zum Drucker geschickt.", + direkt drucken nicht moeglich = #429# + "direkt Drucken nicht moeglich", + eudas ausgabe punkt = #430# + ".a$"; + +TEXT VAR + spaltenpuffer, + druckdateiname; + +BOOL VAR + wechsel erfolgt, + wechsel 0, + externer dateiname, + direkt ausdrucken; + +FILE VAR ausgabe; + +INT VAR + spalten, + spaltenbreite, + gedruckte spalten, + gemeinsamer anfang, + gedruckte zeilen, + max zeilen := 4000, + satzzaehler; + + +PROC drucke : + + drucke (last param) + +END PROC drucke; + +PROC drucke (TEXT CONST dateiname) : + + enable stop; + last param (dateiname); + druckmuster := sequential file (input, dateiname); + modify (druckmuster); + IF anzahl dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + disable stop; + programmdatei einrichten; + druckmuster uebersetzen; + IF anything noted THEN + note edit (druckmuster) + ELIF wird uebersetzt THEN + programm uebersetzen + ELSE + drucke (PROC dummy gruppentest, + PROC std vor, PROC std wdh, PROC std nach) + END IF; + forget (programmdatei, quiet) . + +programmdatei einrichten : + TEXT VAR programmdatei; + INT VAR i := 0; + REP + i INCR 1; + programmdatei := text (i) + UNTIL NOT exists (programmdatei) END REP; + programm := sequential file (output, programmdatei); + headline (programm, erzeugtes programm) . + +programm uebersetzen : + run (programmdatei); + last param (dateiname) . + +END PROC drucke; + +PROC dummy gruppentest : END PROC dummy gruppentest; + +PROC std vor : + + abschnitt ausfuehren (1) + +END PROC std vor; + +PROC std wdh : + + abschnitt ausfuehren (2) + +END PROC std wdh; + +PROC std nach : + + abschnitt ausfuehren (3) + +END PROC std nach; + +PROC abschnitt ausfuehren (INT CONST nr) : + + IF abschnitte (nr). erste zeile > 0 THEN + interpretiere (abschnitte (nr). erste zeile, + abschnitte (nr). erstes muster, + PROC (INT CONST, TEXT VAR) std abk) + END IF + +END PROC abschnitt ausfuehren; + +PROC std abk (INT CONST nr, TEXT VAR inhalt) : + + errorstop (interner fehler); + inhalt := code (nr) (* Dummy-Anweisung, damit Parameter benutzt *) + +END PROC std abk; + +PROC drucke (PROC grp test, PROC vorspann, PROC wdh, PROC nachspann) : + + INT VAR + modus, + letzter satz, + letzte kombination; + + enable stop; + druckdatei eroeffnen; + auf ersten satz; + gruppen initialisieren; + satzzaehler := 1; + WHILE NOT dateiende REP + bei gruppenwechsel nachspann und vorspann; + cout (satznummer); + wiederholungsteil interpretieren; + weiter (modus); + ende der druckdatei ueberpruefen + END REP; + letzten nachspann drucken; + datei ausdrucken; + auf satz (1) . + +auf ersten satz : + letzter satz := 0; + auf satz (1); + IF markierte saetze > 0 THEN + modus := 3; + IF NOT satz markiert THEN weiter (modus) END IF + ELSE + modus := 2; + IF NOT satz ausgewaehlt THEN weiter (modus) END IF + END IF . + +gruppen initialisieren : + INT VAR i; + FOR i FROM 1 UPTO maxgruppen REP + gruppen (i). inhalt := niltext + END REP . + +bei gruppenwechsel nachspann und vorspann : + IF letzter satz = 0 THEN + grp test; + alle gruppen wechseln; + abschnitt interpretieren (PROC vorspann) + ELSE + wechsel 0 := FALSE; + gruppenwechsel testen; + gruppenwechsel mit nachspann + END IF; + letzter satz := satznummer; + letzte kombination := satzkombination . + +gruppenwechsel testen : + wechsel erfolgt := FALSE; + grp test . + +gruppenwechsel mit nachspann : + IF wechsel erfolgt THEN + nachspann drucken (letzter satz, letzte kombination, PROC nachspann) + END IF; + satzzaehler INCR 1; + IF wechsel erfolgt THEN + abschnitt interpretieren (PROC vorspann) + END IF . + +wiederholungsteil interpretieren : + IF spaltenbreite < 1 THEN + standard musterzeilenbreite + ELSE + musterzeilenbreite := spaltenbreite + END IF; + IF gedruckte spalten < spalten THEN + to line (ausgabe, gemeinsamer anfang) + ELSE + to line (ausgabe, gedruckte zeilen + 1); + gemeinsamer anfang := gedruckte zeilen + 1; + gedruckte spalten := 0 + END IF; + interpretationsmodus := 1; + wdh; + gedruckte spalten INCR 1 . + +ende der druckdatei ueberpruefen : + IF gedruckte zeilen > maxzeilen THEN + datei ausdrucken; + druckdatei eroeffnen + END IF . + +letzten nachspann drucken : + alle gruppen wechseln; + IF letzter satz = 0 THEN + abschnitt interpretieren (PROC nachspann) + ELSE + nachspann drucken (letzter satz, letzte kombination, PROC nachspann) + END IF; + muster auf zeile (1) . + +END PROC drucke; + +PROC alle gruppen wechseln : + + INT VAR i; + FOR i FROM 1 UPTO max gruppen REP + gruppen (i). wechsel := TRUE + END REP; + wechsel 0 := TRUE; + wechsel erfolgt := TRUE + +END PROC alle gruppen wechseln; + +PROC abschnitt interpretieren (PROC abschnitt) : + + gedruckte spalten := spalten; + to line (ausgabe, gedruckte zeilen + 1); + standard musterzeilenbreite; + interpretationsmodus := 1; + abschnitt + +END PROC abschnitt interpretieren; + +PROC nachspann drucken (INT CONST letzter satz, letzte kombination, + PROC nachspann) : + + INT CONST + aktueller satz := satznummer, + aktuelle kombination := satzkombination; + auf satz (letzter satz); + WHILE satzkombination <> letzte kombination REP weiter (1) END REP; + abschnitt interpretieren (PROC nachspann); + auf satz (aktueller satz); + WHILE satzkombination <> aktuelle kombination REP weiter (1) END REP + +END PROC nachspann drucken; + +PROC druckdatei eroeffnen : + + IF aktueller editor > 0 THEN + in editfile schreiben + ELSE + in ausgabedatei schreiben + END IF; + druckanweisungen uebertragen . + +in editfile schreiben : + ausgabe := edit file; + IF col > 1 THEN + split line (ausgabe, col, FALSE); + down (ausgabe); col (ausgabe, 1) + END IF; + gedruckte zeilen := line no (ausgabe) - 1 . + +in ausgabedatei schreiben : + IF NOT externer dateiname THEN + druckdateinamen generieren + END IF; + ausgabe := sequential file (modify, druckdateiname); + max linelength (ausgabe, max linelength (druckmuster)); + gedruckte zeilen := lines (ausgabe) . + +druckdateinamen generieren : + INT VAR zaehler := 0; + REP + zaehler INCR 1; + druckdateiname := + headline (druckmuster) + eudas ausgabe punkt + text (zaehler); + UNTIL NOT exists (druckdateiname) END REP . + +druckanweisungen uebertragen : + muster auf zeile (1); + WHILE NOT druckmusterende REP + zeile uebertragen + END REP . + +zeile uebertragen : + musterzeile lesen; + INT VAR kommandoindex; + IF kommandozeile (kommandoindex) THEN + auf ende testen + ELSE + zeile drucken (musterzeile) + END IF . + +auf ende testen : + IF kommandoindex <> do index AND kommandoindex <> gruppe index THEN + LEAVE druckanweisungen uebertragen + END IF . + +END PROC druckdatei eroeffnen; + +PROC datei ausdrucken : + + IF aktueller editor > 0 THEN + ELIF externer dateiname THEN + externer dateiname := FALSE; + ELIF direkt ausdrucken THEN + disable stop; + ausdruck versuchen + ELSE + line; put (druckausgabe steht in); + putline (textdarstellung (druckdateiname)); + pause (40) + END IF . + +ausdruck versuchen : + TEXT CONST param := std; + last param (druckdateiname); + do ("print (std)"); + IF is error THEN + clear error; + errorstop (direkt drucken nicht moeglich) + ELSE + line; put (textdarstellung (druckdateiname)); + putline (zum drucker geschickt); + forget (druckdateiname, quiet); + pause (40) + END IF; + last param (param) . + +END PROC datei ausdrucken; + +PROC zeile drucken (TEXT CONST zeile) : + + IF gedruckte spalten >= spalten OR gedruckte spalten = 0 THEN + insert record (ausgabe); + write record (ausgabe, zeile); + gedruckte zeilen INCR 1 + ELSE + an zeile anfuegen + END IF; + down (ausgabe) . + +an zeile anfuegen : + IF eof (ausgabe) THEN + spaltenpuffer := niltext; + insert record (ausgabe); + gedruckte zeilen INCR 1 + ELSE + read record (ausgabe, spaltenpuffer) + END IF; + spaltenpuffer verlaengern; + write record (ausgabe, spaltenpuffer) . + +spaltenpuffer verlaengern : + INT CONST ziellaenge := musterzeilenbreite * gedruckte spalten; + WHILE length (spaltenpuffer) < ziellaenge REP + spaltenpuffer CAT blank + END REP; + spaltenpuffer CAT zeile . + +END PROC zeile drucken; + +PROC direkt drucken (BOOL CONST modus) : + + direkt ausdrucken := modus + +END PROC direkt drucken; + +BOOL PROC direkt drucken : + + direkt ausdrucken + +END PROC direkt drucken; + +PROC druckdatei (TEXT CONST dateiname) : + + druckdateiname := dateiname; + externer dateiname := TRUE + +END PROC druckdatei; + +TEXT PROC druckdatei : + + druckdateiname + +END PROC druckdatei; + +PROC max druckzeilen (INT CONST zeilen) : + + max zeilen := zeilen + +END PROC max druckzeilen; + +PROC gruppentest (INT CONST gruppennr, TEXT CONST merkmal) : + + IF merkmal <> gruppen (gruppennr). inhalt THEN + gruppen (gruppennr). inhalt := merkmal; + gruppen (gruppennr). wechsel := TRUE; + wechsel erfolgt := TRUE + ELSE + gruppen (gruppennr). wechsel := FALSE + END IF + +END PROC gruppentest; + +BOOL PROC gruppenwechsel (INT CONST gruppennr) : + + IF gruppennr > 0 THEN + gruppen (gruppennr). wechsel + ELSE + wechsel 0 + END IF + +END PROC gruppenwechsel; + +TEXT PROC lfd nr : + + text (satzzaehler) + +END PROC lfd nr; + +(* +PROC dump : + + FILE VAR d := sequential file (output, "EUDAS-DUMP"); + put (d, "anzahl muster :"); put (d, anzahl muster); line (d); + INT VAR i; + FOR i FROM 1 UPTO anzahl muster REP + put (d, musterindex (i)); + END REP; + line (d); + put (d, "anzahl abkuerzungen :"); put (d, anzahl abkuerzungen); + line (d); + FOR i FROM 1 UPTO anzahl abkuerzungen REP + TEXT VAR p; feld lesen (abkuerzungen, i, p); + write (d, """"); write (d, p); write (d, """ "); + put (d, abkuerzungsindex ISUB i) + END REP; + line (d); + FOR i FROM 1 UPTO 3 REP + put (d, abschnitte (i). proc name); put (d, abschnitte (i). erste zeile); + put (d, abschnitte (i). erstes muster); line (d) + END REP; + edit ("EUDAS-DUMP"); + forget ("EUDAS-DUMP") + +END PROC dump; *) + +END PACKET eudas drucken; + diff --git a/app/eudas/4.4/src/eudas.fenster b/app/eudas/4.4/src/eudas.fenster new file mode 100644 index 0000000..3281404 --- /dev/null +++ b/app/eudas/4.4/src/eudas.fenster @@ -0,0 +1,238 @@ +PACKET fenster + +(*************************************************************************) +(* *) +(* Bildschirmaufteilung in Fenster *) +(* *) +(* Version 05 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 17.04.87 *) +(* *) +(*************************************************************************) + + DEFINES + + FENSTER, + fenster initialisieren, + fenstergroesse setzen, + fenstergroesse, + fenster veraendert, + fensterzugriff, + bildschirm neu : + + +TYPE FENSTER = STRUCT (INT koordinaten, version); + +LET + maxfenster = 16, + BITVEKTOR = INT, + GROESSE = STRUCT (INT x anf, y anf, x laenge, y laenge); + +ROW maxfenster STRUCT (INT referenzen, aktuelle version, + BITVEKTOR ueberschneidungen, + GROESSE groesse) + VAR fenstergroessen; + +INT VAR naechste version := 1; + +BITVEKTOR VAR veraenderungen; + +INT VAR i; +FOR i FROM 2 UPTO maxfenster REP + fenstergroessen (i). referenzen := 0 +END REP; +fenstergroessen (1). referenzen := 1; +fenstergroessen (1). aktuelle version := 0; +fenstergroessen (1). ueberschneidungen := 0; +fenstergroessen (1). groesse := GROESSE : (1, 1, 79, 24); + + +(************************* fenster anfordern *****************************) + +PROC fenster initialisieren (FENSTER VAR f) : + + f. koordinaten := 1; + fenstergroessen (1). referenzen INCR 1; + f. version := naechste version; + naechste version INCR 1; + IF naechste version >= 32000 THEN naechste version := -32000 END IF + +END PROC fenster initialisieren; + +PROC fenstergroesse setzen (FENSTER VAR f, + INT CONST x anf, y anf, x laenge, y laenge) : + + INT VAR stelle; + passendes fenster suchen; + IF stelle > maxfenster THEN + freie stelle suchen; + neue koordinaten initialisieren; + ueberschneidungen bestimmen + END IF; + auf referenz setzen . + +passendes fenster suchen : + stelle := 1; + WHILE stelle <= maxfenster REP + IF groesse passt THEN + LEAVE passendes fenster suchen + END IF; + stelle INCR 1 + END REP . + +groesse passt : + g. x anf = x anf AND g. y anf = y anf AND g. x laenge = x laenge AND + g. y laenge = y laenge . + +g : + fenstergroessen (stelle). groesse . + +freie stelle suchen : + stelle := 1; + WHILE stelle <= maxfenster REP + IF fenstergroessen (stelle). referenzen = 0 THEN + LEAVE freie stelle suchen + END IF; + stelle INCR 1 + END REP; + errorstop ("zu viele Fenstergroessen"); + LEAVE fenstergroesse setzen . + +neue koordinaten initialisieren : + fenstergroessen (stelle). referenzen := 0; + fenstergroessen (stelle). aktuelle version := 0; + fenstergroessen (stelle). groesse := + GROESSE : (x anf, y anf, x laenge, y laenge); + fenstergroessen (stelle). ueberschneidungen := 0 . + +ueberschneidungen bestimmen : + INT VAR vergleich; + FOR vergleich FROM 1 UPTO maxfenster REP + IF fenstergroessen (vergleich). referenzen > 0 THEN + vergleiche auf ueberschneidung + END IF + END REP . + +vergleiche auf ueberschneidung : + IF ueberschneidung (neues fenster, vergleichsfenster) THEN + set bit (fenstergroessen (stelle). ueberschneidungen, vergleich); + set bit (fenstergroessen (vergleich). ueberschneidungen, stelle) + ELSE + reset bit (fenstergroessen (vergleich). ueberschneidungen, stelle) + END IF . + +neues fenster : + fenstergroessen (stelle). groesse . + +vergleichsfenster : + fenstergroessen (vergleich). groesse . + +auf referenz setzen : + fenstergroessen (f. koordinaten). referenzen DECR 1; + f. koordinaten := stelle; + fenstergroessen (stelle). referenzen INCR 1 . + +END PROC fenstergroesse setzen; + +BOOL PROC ueberschneidung (GROESSE CONST a, b) : + + ueberschneidung in x richtung AND ueberschneidung in y richtung . + +ueberschneidung in x richtung : + IF a. x anf <= b. x anf THEN + b. x anf < a. x anf + a. x laenge + ELSE + a. x anf < b. x anf + b. x laenge + END IF . + +ueberschneidung in y richtung : + IF a. y anf <= b. y anf THEN + b. y anf < a. y anf + a. y laenge + ELSE + a. y anf < b. y anf + b. y laenge + END IF . + +END PROC ueberschneidung; + +PROC fenstergroesse (FENSTER CONST f, + INT VAR x anf, y anf, x laenge, y laenge) : + + x anf := g. x anf; + y anf := g. y anf; + x laenge := g. x laenge; + y laenge := g. y laenge . + +g : + fenstergroessen (f. koordinaten). groesse . + +END PROC fenstergroesse; + + +(************************** fenster veraendert ***************************) + +PROC fenster veraendert (FENSTER CONST f) : + + fenstergroessen (f. koordinaten). aktuelle version := 0; + veraenderungen := veraenderungen OR meine ueberschneidungen . + +meine ueberschneidungen : + fenstergroessen (f. koordinaten). ueberschneidungen . + +END PROC fenster veraendert; + + +(************************** fensterzugriff *******************************) + +PROC fensterzugriff (FENSTER CONST f, BOOL VAR veraendert) : + + veraendert := bit (veraenderungen, f. koordinaten); + IF fenstergroessen (f. koordinaten). aktuelle version <> f. version THEN + fenstergroessen (f. koordinaten). aktuelle version := f. version; + veraendert := TRUE + END IF; + veraenderungen := veraenderungen OR meine ueberschneidungen; + reset bit (veraenderungen, f. koordinaten) . + +meine ueberschneidungen : + fenstergroessen (f. koordinaten). ueberschneidungen . + +END PROC fensterzugriff; + + +(************************ bildschirm neu *********************************) + +PROC bildschirm neu : + + veraenderungen := - 1 + +END PROC bildschirm neu; + + +(**************************** BITVEKTOR **********************************) + +(* Erforderlich, da 'reset bit' im EUMEL nicht richtig funktionierte. *) + +ROW 16 INT VAR bitwert := ROW 16 INT : + (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1); + +PROC set bit (BITVEKTOR VAR vektor, INT CONST stelle) : + + vektor := vektor OR bitwert (stelle) + +END PROC set bit; + +PROC reset bit (BITVEKTOR VAR vektor, INT CONST stelle) : + + vektor := vektor AND (-1 - bitwert (stelle)) + +END PROC reset bit; + +BOOL PROC bit (BITVEKTOR CONST vektor, INT CONST stelle) : + + (vektor AND bitwert (stelle)) <> 0 + +END PROC bit; + +END PACKET fenster; + diff --git a/app/eudas/4.4/src/eudas.menues b/app/eudas/4.4/src/eudas.menues new file mode 100644 index 0000000..6204848 --- /dev/null +++ b/app/eudas/4.4/src/eudas.menues @@ -0,0 +1,2616 @@ +PACKET eudas menues + +(*************************************************************************) +(* *) +(* Menue-Manager *) +(* *) +(* Version 09 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 31.07.87 *) +(* *) +(*************************************************************************) + + DEFINES + +## (* Nur Multi-User *) + global manager, + menue manager, +## + lock, + free, + menuedaten einlesen, + menuenamen, + menue loeschen, + + waehlbar, + ausfuehrtaste, + menue anbieten, + auswahl anbieten, + wahl, + esc hop ausfuehren, + + hilfe anbieten, + status anzeigen, + + dialogfenster, + dialogfenster loeschen, + dialog, + neuer dialog, + ja, + editget, + fehler ausgeben : + + +(***************************** Zeilenanalyse *****************************) + +ROW 8 TEXT VAR kommandotext := + ROW 8 TEXT : ("MENUE", "BILD", "FELD", "ENDE", "AUSWAHL", + "VORSPANN", "HILFE", "SEITE"); + +LET + menue kommando = 1, + bild kommando = 2, + feld kommando = 3, + ende kommando = 4, + auswahl kommando = 5, + vorspann kommando = 6, + hilfe kommando = 7, + seite kommando = 8; + +LET + bold = 2, + integer = 3, + string = 4, + end of line = 7; + +LET + fehler in zeile = #701# + "FEHLER in Zeile "; + +FILE VAR file; + +TEXT VAR + zeile, + kommando; + + +PROC zeile lesen : + + IF eof (file) THEN + zeile := "%DUMMY" + ELSE + read record (file, zeile); + IF zeile = niltext THEN zeile := blank END IF; + cout (line no (file)); + down (file) + END IF + +END PROC zeile lesen; + +BOOL PROC kommandozeile : + + IF (zeile SUB 1) = kommandozeichen THEN + kommando isolieren + ELSE + FALSE + END IF . + +kommando isolieren : + INT VAR typ; + replace (zeile, 1, blank); + scan (zeile); + replace (zeile, 1, kommandozeichen); + next symbol (kommando, typ); + IF typ <> bold THEN + fehler (kein kommando angegeben); + FALSE + ELSE + TRUE + END IF . + +END PROC kommandozeile; + +BOOL PROC kommando ist (INT CONST identifikation) : + + kommandotext (identifikation) = kommando + +END PROC kommando ist; + +INT PROC int parameter : + + TEXT VAR symbol; + INT VAR typ; + next symbol (symbol, typ); + IF typ = integer THEN + int (symbol) + ELSE + IF typ <> end of line THEN fehler (kein int parameter) END IF; + -1 + END IF + +END PROC int parameter; + +TEXT PROC text parameter : + + TEXT VAR symbol; + INT VAR typ; + next symbol (symbol, typ); + IF typ = string THEN + symbol + ELSE + IF typ <> end of line THEN fehler (kein text parameter) END IF; + niltext + END IF + +END PROC text parameter; + +PROC fehler (TEXT CONST meldung) : + + note (fehler in zeile); note (line no (file) - 1); note line; + note (meldung); note line; + line; putline (meldung) + +END PROC fehler; + + +(***************************** Fensterkoordinaten ************************) + +INT VAR + y laenge, + x laenge, + x pos, + y pos; + +PROC f cursor (INT CONST x, y) : + + cursor (x pos + x - 1, y pos + y - 1) + +END PROC f cursor; + + +(**************************** Einlesen zentral ***************************) + +LET + zeile ohne zusammenhang = #702# + "Zeile ist ohne Zusammenhang", + k menuedaten im speicher = #703# + "K Menuedaten im Speicher"; + +PROC menuedaten einlesen (TEXT CONST dateiname) : + + ggf initialisieren; + file := sequential file (input, dateiname); + modify (file); + to line (file, 1); + WHILE NOT eof (file) REP + zeile lesen; + IF kommandozeile THEN + eventuell verteilen + ELIF NOT anything noted THEN + fehler (zeile ohne zusammenhang) + END IF + END REP; + seiten anzeigen; + IF anything noted THEN + note edit (file) + END IF . + +eventuell verteilen : + IF kommando ist (menue kommando) THEN + menue aus datei lesen + ELIF kommando ist (auswahl kommando) THEN + auswahl aus datei lesen + ELIF kommando ist (hilfe kommando) THEN + hilfe aus datei lesen + ELIF NOT anything noted THEN + fehler (zeile ohne zusammenhang) + END IF . + +seiten anzeigen : + IF online THEN + line; put (anzahl ds seiten DIV 2); + putline (k menuedaten im speicher) + END IF . + +anzahl ds seiten : + ds pages (menueds (1)) + ds pages (menueds (2)) + ds pages (menueds (3)) . + +END PROC menuedaten einlesen; + + +(**************************** TYPE MENUE *********************************) + +TYPE MENUE = STRUCT (SATZ + bild, + hilfen, + kommandos, + TEXT + feldtasten, + feldzeilen); + +BOUND ROW 200 MENUE VAR menues; + + +(************************** Menue Einlesen *******************************) + +TEXT VAR + m feldzeilen, + m feldtasten; + +SATZ VAR + m hilfen, + m kommandos; + +LET + niltext = "", + blank = " ", + feldmarkierung = ""223"", + markierungsspalte = 2, + kommandozeichen = "%", + piep = ""7"", + esc = ""27"", + cleol = ""5""; + +LET + bildkommando erwartet = #704# + "% BILD erwartet", + keine feldnr angegeben = #705# + "Feldnummer beim %FELD-Kommando fehlt", + ende fehlt = #706# + "% ENDE erwartet", + kein name angegeben = #707# + "Name fehlt", + kein kommando angegeben = #708# + "Kommandozeile enthaelt kein Kommando", + kein int parameter = #709# + "Parameter soll eine Zahl sein", + kein text parameter = #710# + "Parameter soll ein TEXT sein", + keine wiederholungszeile = #711# + "Wiederholungszeile fehlt"; + + +PROC menue aus datei lesen : + + TEXT VAR name := text parameter; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + INT VAR index; + neues menue einfuegen; + menue aus datei lesen (menues (index)) + END IF . + +neues menue einfuegen : + index := link (thesaurus (2), name); + IF index = 0 THEN + insert (thesaurus (2), name, index) + END IF . + +END PROC menue aus datei lesen; + +PROC menue aus datei lesen (MENUE VAR m) : + + menue initialisieren; + bild einlesen; + felddefinitionen bearbeiten; + auf ende testen; + ergebnis abspeichern . + +menue initialisieren : + satz initialisieren (m. bild); + satz initialisieren (m hilfen); + satz initialisieren (m kommandos); + m feldtasten := niltext; + m feldzeilen := niltext . + +bild einlesen : + teste auf bild kommando; + INT VAR zeilennr := 1; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE bild einlesen + ELSE + bildzeile bearbeiten; + zeilennr INCR 1 + END IF + END REP . + +teste auf bild kommando : + zeile lesen; + IF NOT (kommandozeile CAND kommando ist (bild kommando)) THEN + fehler (bild kommando erwartet) + END IF . + +bildzeile bearbeiten : + IF (zeile SUB markierungsspalte) = feldmarkierung THEN + m feldzeilen CAT code (zeilennr); + replace (zeile, markierungsspalte, blank) + END IF; + feld aendern (m. bild, zeilennr, zeile) . + +felddefinitionen bearbeiten : + WHILE kommando ist (feld kommando) REP + eine felddefinition bearbeiten + END REP . + +eine felddefinition bearbeiten : + INT VAR feldnr := int parameter; + IF feldnr = -1 THEN + fehler (keine feldnr angegeben); + feldnr := 100 + END IF; + hilfe text einlesen; + feldtasten einlesen; + kommandos einlesen . + +hilfe text einlesen : + feld aendern (m hilfen, feldnr, text parameter) . + +feldtasten einlesen : + TEXT CONST tasten := text parameter; + INT VAR p; + FOR p FROM 1 UPTO length (tasten) REP + m feldtasten CAT code (feldnr); + m feldtasten CAT (tasten SUB p) + END REP . + +kommandos einlesen : + TEXT VAR k := niltext; + zeile lesen; + WHILE NOT kommandozeile REP + k CAT zeile; + zeile lesen + END REP; + feld aendern (m kommandos, feldnr, k) . + +auf ende testen : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF . + +ergebnis abspeichern : + m. hilfen := m hilfen; + m. kommandos := m kommandos; + m. feldtasten := m feldtasten; + m. feldzeilen := m feldzeilen . + +END PROC menue aus datei lesen; + + +(************************** Menue in Datei *******************************) +(* +PROC menue in datei schreiben (MENUE CONST m, FILE VAR f, TEXT CONST name) : + + output (f); + put (f, "% MENUE"); + putline (f, textdarstellung (name)); + bild rekonstruieren; + felddefinitionen rekonstruieren; + putline (f, "% ENDE") . + +bild rekonstruieren : + INT VAR zeilennr; + putline (f, "% BILD"); + FOR zeilennr FROM 1 UPTO felderzahl (m. bild) REP + feld lesen (m. bild, zeilennr, zeile); + feldmarkierungen wiederherstellen; + putline (f, zeile) + END REP . + +feldmarkierungen wiederherstellen : + INT VAR zeilenpos := pos (m. feldzeilen, code (zeilennr)); + IF zeilenpos > 0 THEN + REP + replace (zeile, markierungsspalte, feldmarkierung); + zeilenpos INCR 1 + UNTIL (m. feldzeilen SUB zeilenpos) <> code (zeilennr) END REP + END IF . + +felddefinitionen rekonstruieren : + INT VAR feldnr; + FOR feldnr FROM 1 UPTO length (m. feldzeilen) REP + put (f, "% FELD"); + put (f, feldnr); + feld lesen (m. hilfen, feldnr, zeile); + put (f, textdarstellung (zeile)); + feldzeichen sammeln; + kommandos ausgeben + END REP . + +feldzeichen sammeln : + INT VAR stelle := 1; + zeile := niltext; + WHILE stelle < length (m. feldtasten) REP + IF code (m. feldtasten SUB stelle) = feldnr THEN + zeile CAT (m. feldtasten SUB stelle + 1) + END IF; + stelle INCR 1 + END REP; + putline (f, textdarstellung (zeile)) . + +kommandos ausgeben : + INT VAR anfang := 1; + feld lesen (m. kommandos, feldnr, zeile); + REP + stelle := pos (zeile, ";", anfang); + IF stelle = 0 THEN + zeilenrest ausgeben; + LEAVE kommandos ausgeben + ELSE + putline (f, subtext (zeile, anfang, stelle)); + anfang := stelle + 1 + END IF + END REP . + +zeilenrest ausgeben : + IF anfang <= length (zeile) THEN + putline (f, subtext (zeile, anfang)) + END IF . + +END PROC menue in datei schreiben; +*) + +(*************************** Menue anbieten ******************************) + +LET + ausfuehren status = #712# + "Kommando wird ausgeführt ..", + gib kommando = #713# + ""15"Gib Kommando: ", + falsche ausfuehrtaste = #714# + "falsche Ausfuehrtaste", + t existiert nicht = #715# + " existiert nicht."; + +LET + blank 24 = " ", + begin mark = ""15"", + end mark = ""14"", + ausfuehren marke = "*"8""; + +INT VAR + rekursionstiefe := 0, + markenpos, + gezeichnete zeilen; + +BOOL VAR + funktionssperre veraendert, + menue init durchgefuehrt; + +TEXT VAR + balken, + sperrzeichen, + menuefunktionstasten := ""32""1""2""3""8""10""13""27"", + edit kommando, + altes kommando := niltext; + +ROW 6 TEXT VAR + funktionssperre; + +FENSTER VAR balkenfenster; +fenster initialisieren (balkenfenster); +fenstergroesse setzen (balkenfenster, 1, 1, 79, 1); + + +PROC waehlbar (INT CONST menue, funktion, BOOL CONST moeglich) : + + IF moeglich THEN + ggf sperre aufheben + ELSE + sperre setzen + END IF; + funktionssperre veraendert := TRUE . + +ggf sperre aufheben : + IF length (funktionssperre (menue)) >= funktion THEN + replace (funktionssperre (menue), funktion, " ") + END IF . + +sperre setzen : + WHILE length (funktionssperre (menue)) < funktion REP + funktionssperre (menue) CAT " " + END REP; + replace (funktionssperre (menue), funktion, "-") . + +END PROC waehlbar; + +PROC ausfuehrtaste (TEXT CONST taste) : + + IF length (taste) <> 1 COR taste schon belegt THEN + errorstop (falsche ausfuehrtaste) + ELSE + replace (menuefunktionstasten, 1, taste) + END IF . + +taste schon belegt : + taste <> ""13"" AND pos (menuefunktionstasten, taste, 2) > 0 . + +END PROC ausfuehrtaste; + +PROC menue anbieten (ROW 6 TEXT CONST menuenamen, + FENSTER VAR f, BOOL CONST esc erlaubt, + PROC (INT CONST, INT CONST) interpreter) : + + ROW 6 INT VAR + m anfang, + m ende, + m wahl; + + INT VAR + menuenr intern, + leistenindex := 0, + neuer leistenindex := 1, + leave code := 0, + besetzte menues; + + TEXT VAR + menuebalken; + + ROW 6 TEXT VAR + sperre; + + ggf initialisieren; + menuebalken aufbauen; + funktionssperre aufbauen; + disable stop; + REP + menuebalken und sperre aktualisieren; + menue aufrufen; + funktion ausfuehren + END REP . + +menuebalken aufbauen : + rekursionstiefe INCR 1; + INT CONST meine rekursionstiefe := rekursionstiefe; + menuebalken := ""6""0""0""; + identifikation extrahieren; + weitere menues anfuegen; + menuebalken CAT cl eol . + +identifikation extrahieren : + INT VAR ppos := pos (menuenamen (1), "."); + IF ppos > 0 THEN + menuebalken CAT subtext (menuenamen (1), 1, ppos - 1) + END IF; + menuebalken CAT ": " . + +weitere menues anfuegen : + besetzte menues := 0; + WHILE besetzte menues < 6 CAND noch ein menue vorhanden REP + besetzte menues INCR 1; + ein weiteres menue; + m wahl (besetzte menues) := 1 + END REP . + +noch ein menue vorhanden : + menuenamen (besetzte menues + 1) <> niltext . + +ein weiteres menue : + m anfang (besetzte menues) := length (menuebalken); + ppos := pos (menuenamen (besetzte menues), "."); + IF ppos = 0 THEN + menuebalken CAT menuenamen (besetzte menues) + ELSE + menuebalken CAT subtext (menuenamen (besetzte menues), ppos + 1) + END IF; + menuebalken CAT " "; + m ende (besetzte menues) := length (menuebalken) - 1 . + +funktionssperre aufbauen : + INT VAR i; + FOR i FROM 1 UPTO 6 REP + funktionssperre (i) := niltext + END REP; + funktionssperre veraendert := TRUE; + interpreter (0, 0) . + +menuebalken und sperre aktualisieren : + IF neuer leistenindex > 0 THEN + altes menue demarkieren; + neues menue markieren; + leistenindex := neuer leistenindex; + neuer leistenindex := 0; + neues menue auswaehlen + ELIF rekursionstiefe <> meine rekursionstiefe THEN + balken := menuebalken; + funktionssperre := sperre; + rekursionstiefe := meine rekursionstiefe + ELIF funktionssperre veraendert THEN + sperre := funktionssperre + END IF . + +altes menue demarkieren : + IF leistenindex > 0 THEN + replace (menuebalken, m anfang (leistenindex), " "); + replace (menuebalken, m ende (leistenindex), " "); + IF menue init durchgefuehrt THEN + interpreter (leistenindex, -1) + END IF + END IF . + +neues menue markieren : + replace (menuebalken, m anfang (neuer leistenindex), begin mark); + replace (menuebalken, m ende (neuer leistenindex), end mark); + fenster veraendert (balkenfenster); + balken := menuebalken; + menuebalken anzeigen . + +neues menue auswaehlen : + menuenr intern := link (thesaurus (2), menuenamen (leistenindex)); + IF menuenr intern = 0 THEN + existiert nicht (menuenamen (leistenindex)); + LEAVE menue anbieten + END IF; + menue init durchgefuehrt := FALSE; + funktionssperre veraendert := TRUE; + fenster veraendert (f) . + +menue aufrufen : + leave code := leistenindex; + anbieten (menues (menuenr intern), f, leave code, m wahl (leistenindex), + PROC (INT CONST, INT CONST) interpreter) . + +funktion ausfuehren : + SELECT leave code OF + CASE 0 : menue verlassen + CASE 1 : kommandodialog + CASE 2 : menuewechsel nach rechts + CASE 3 : menuewechsel nach links + CASE 4 : wahl behandeln + OTHERWISE direkte menuewahl + END SELECT . + +menuewechsel nach rechts : + IF leistenindex < besetzte menues THEN + neuer leistenindex := leistenindex + 1 + ELSE + neuer leistenindex := 1 + END IF . + +menuewechsel nach links : + IF leistenindex > 1 THEN + neuer leistenindex := leistenindex - 1 + ELSE + neuer leistenindex := besetzte menues + END IF . + +direkte menuewahl : + leave code := leave code - 10; + IF leave code <= besetzte menues THEN + neuer leistenindex := leave code + END IF . + +kommandodialog : + IF esc erlaubt THEN + BOOL VAR bild veraendert := FALSE; + REP + editget kommando; + kommando ausfuehren + UNTIL erfolgreich END REP; + IF bild veraendert THEN + bildschirm neu; + dialogfenster loeschen; + interpreter (leistenindex, -2) + END IF + END IF . + +kommando ausfuehren : + IF echtes kommando THEN + bild veraendert := TRUE; + status anzeigen (ausfuehren status); + cursor (1, 2); out (cl eop); + do (edit kommando) + END IF . + +echtes kommando : + pos (edit kommando, ""33"", ""254"", 1) > 0 . + +erfolgreich : + NOT is error . + +menue verlassen : + IF menue init durchgefuehrt THEN + interpreter (leistenindex, -1) + END IF; + fenster veraendert (f); + LEAVE menue anbieten . + +wahl behandeln : + IF m wahl (leistenindex) > 0 THEN + interpreter (menuenr intern, m wahl (leistenindex)) + ELSE + m wahl (leistenindex) := - m wahl (leistenindex) + END IF . + +END PROC menue anbieten; + +PROC menuebalken anzeigen : + + BOOL VAR veraendert; + fensterzugriff (balkenfenster, veraendert); + IF veraendert THEN out (balken) END IF + +END PROC menuebalken anzeigen; + +PROC anbieten (MENUE CONST m, FENSTER VAR f, INT VAR menuenr, wahl, + PROC (INT CONST, INT CONST) interpreter) : + + INT VAR + tastenzustand := 0; + + fehler behandeln; + neuen fensterzugriff anmelden (f); + IF gezeichnete zeilen = 0 THEN + markenpos := 0 + END IF; + neuer dialog; + geaenderte funktionssperre beruecksichtigen; + REP + menuebalken anzeigen; + auf eingabe warten; + menuefunktion + END REP . + +fehler behandeln : + IF wahl > length (m. feldzeilen) THEN + wahl := markenpos; + ELIF is error THEN + fehler ausgeben; + interpreter (menuenr, -2); + END IF . + +geaenderte funktionssperre beruecksichtigen : + IF funktionssperre veraendert THEN + sperrzeichen setzen; + bereits angezeigte funktionen korrigieren; + funktionssperre veraendert := FALSE + END IF . + +sperrzeichen setzen : + sperrzeichen := blank 24; + INT VAR i; + FOR i FROM 1 UPTO length (funktionssperre (menuenr)) REP + replace (sperrzeichen, code (m. feldzeilen SUB i), + funktionssperre (menuenr) SUB i) + END REP . + +bereits angezeigte funktionen korrigieren : + INT VAR f index; + FOR f index FROM 1 UPTO length (m. feldzeilen) REP + INT CONST funktionszeile := code (m. feldzeilen SUB f index); + IF funktionszeile > gezeichnete zeilen THEN + LEAVE bereits angezeigte funktionen korrigieren + END IF; + erstes zeichen ausgeben (m. bild, funktionszeile) + END REP . + +auf eingabe warten : + REP + ausgabe und zeichen annehmen; + IF is error THEN + halt vom terminal behandeln + ELSE + LEAVE auf eingabe warten + END IF + END REP . + +ausgabe und zeichen annehmen : + TEXT VAR eingabe; + BOOL VAR menue jetzt fertig ausgegeben := FALSE; + WHILE gezeichnete zeilen < y laenge REP + eingabe := getcharety; + eventuell eine zeile ausgeben + END REP; + bildschirm update; + cursor positionieren (m, wahl); + getchar mit enable stop (eingabe) . + +eventuell eine zeile ausgeben : + IF eingabe = niltext THEN + ggf init durchfuehren; + gezeichnete zeilen INCR 1; + menuezeile markiert oder nicht markiert ausgeben + ELSE + LEAVE ausgabe und zeichen annehmen + END IF . + +ggf init durchfuehren : + IF NOT menue init durchgefuehrt AND gezeichnete zeilen = 0 THEN + interpreter (menuenr, 0); + menue init durchgefuehrt := TRUE + END IF . + +menuezeile markiert oder nicht markiert ausgeben : + IF gezeichnete zeilen = code (m. feldzeilen SUB wahl) THEN + menuezeile ausgeben (m. bild, gezeichnete zeilen, TRUE); + markenpos := wahl + ELSE + menuezeile ausgeben (m. bild, gezeichnete zeilen, FALSE) + END IF; + IF gezeichnete zeilen = y laenge THEN + menue jetzt fertig ausgegeben := TRUE + END IF . + +bildschirm update : + IF menue jetzt fertig ausgegeben AND NOT is error THEN + interpreter (menuenr, -2); + IF is error THEN clear error END IF + END IF . + +halt vom terminal behandeln : + fehler ausgeben; + menuebalken anzeigen; + gezeichnete zeilen := 0 . + +menuefunktion : + INT VAR posi; + SELECT tastenzustand OF + CASE 0 : normale funktion + CASE 1 : hop funktion + CASE 2 : esc funktion + END SELECT . + +normale funktion : + SELECT pos (menuefunktionstasten, eingabe) OF + CASE 1 : leerzeichen ausfuehren + CASE 2 : tastenzustand := 1 + CASE 3 : rechts ausfuehren + CASE 4 : oben ausfuehren + CASE 5 : links ausfuehren + CASE 6 : unten ausfuehren + CASE 7 : return ausfuehren + CASE 8 : tastenzustand := 2 + OTHERWISE sondertaste + END SELECT . + +hop funktion : + SELECT pos (""1""3""10"", eingabe) OF + CASE 1 : hop hop ausfuehren + CASE 2 : hop oben ausfuehren + CASE 3 : hop unten ausfuehren + OTHERWISE out (piep) + END SELECT; + tastenzustand := 0 . + +esc funktion : + SELECT pos (""1""27"?qh", eingabe) OF + CASE 1 : esc hop ausfuehren + CASE 2 : esc esc ausfuehren + CASE 3 : esc fragezeichen ausfuehren + CASE 4, 5 : esc q ausfuehren + OTHERWISE belegte taste + END SELECT; + tastenzustand := 0 . + +rechts ausfuehren : + leave code := 2; + LEAVE anbieten . + +oben ausfuehren : + IF wahl > 1 THEN + wahl DECR 1 + ELSE + wahl := length (m. feldzeilen) + END IF . + +links ausfuehren : + leave code := 3; + LEAVE anbieten . + +unten ausfuehren : + IF wahl < length (m. feldzeilen) THEN + wahl INCR 1 + ELSE + wahl := 1 + END IF . + +return ausfuehren : + unten ausfuehren . + +sondertaste : + IF menuewahl THEN + menuewahl bearbeiten + ELIF wahl fuer bestimmtes feld THEN + feld waehlen + ELIF eingabe <= ""32"" THEN + push (esc + eingabe) + END IF . + +menuewahl : + pos ("123456", eingabe) > 0 . + +menuewahl bearbeiten : + leave code := code (eingabe) - 38; + LEAVE anbieten . + +wahl fuer bestimmtes feld : + posi := 0; + REP + posi := pos (m. feldtasten, eingabe, posi + 1) + UNTIL (posi MOD 2) = 0 END REP; + posi > 0 AND feld mit bildschirmposition . + +feld mit bildschirmposition : + code (m. feldtasten SUB posi - 1) <= length (m. feldzeilen) . + +feld waehlen : + wahl := code (m. feldtasten SUB posi - 1); + cursor positionieren (m, wahl); + IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN + wahl getroffen (m, wahl, gezeichnete zeilen); + leave code := 4; + LEAVE anbieten + END IF . + +hop hop ausfuehren : + wahl := 1 . + +hop oben ausfuehren : + wahl := 1 . + +hop unten ausfuehren : + wahl := length (m. feldzeilen) . + +belegte taste : + IF esc sonderfunktion THEN + wahl := code (m. feldtasten SUB posi - 1); + leave code := 4; + LEAVE anbieten + ELSE + push (lernsequenz auf taste (eingabe)) + END IF . + +esc sonderfunktion : + posi := 0; + REP + posi := pos (m. feldtasten, eingabe, posi + 1) + UNTIL (posi MOD 2) = 0 CAND + (posi = 0 COR feld ohne bildschirmposition) END REP; + posi > 0 . + +feld ohne bildschirmposition : + code (m. feldtasten SUB posi - 1) > length (m. feldzeilen) . + +esc esc ausfuehren : + leave code := 1; + LEAVE anbieten . + +esc fragezeichen ausfuehren : + TEXT VAR hilfe name; + feld lesen (m. hilfen, wahl, hilfe name); + hilfe anbieten (hilfe name, d fenster); + IF is error THEN fehler ausgeben END IF; + interpreter (menuenr, -2); + neuen fensterzugriff anmelden (f) . + +esc q ausfuehren : + leave code := 0; + LEAVE anbieten . + +leerzeichen ausfuehren : + IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN + wahl getroffen (m, wahl, gezeichnete zeilen); + leave code := 4; + LEAVE anbieten + END IF . + +leave code : + menuenr . + +END PROC anbieten; + +PROC neuen fensterzugriff anmelden (FENSTER CONST f) : + + BOOL VAR veraendert; + fensterzugriff (f, veraendert); + fenstergroesse (f, x pos, y pos, x laenge, y laenge); + IF veraendert THEN + gezeichnete zeilen := 0; + f cursor (1, 1) + END IF + +END PROC neuen fensterzugriff anmelden; + +PROC cursor positionieren (MENUE CONST m, INT CONST wahl) : + + INT CONST wahlzeile := code (m. feldzeilen SUB wahl); + IF markenpos > 0 THEN + IF markenpos = wahl THEN + erstes zeichen ausgeben (m. bild, wahlzeile) + ELSE + INT CONST markenzeile := code (m. feldzeilen SUB markenpos); + menuezeile ausgeben (m. bild, markenzeile, FALSE); + menuezeile ausgeben (m. bild, wahlzeile, TRUE); + markenpos := wahl + END IF + END IF; + f cursor (1, wahlzeile) + +END PROC cursor positionieren; + +PROC getchar mit enable stop (TEXT VAR z) : + + enable stop; + getchar (z) + +END PROC getchar mit enable stop; + +PROC wahl getroffen (MENUE CONST m, INT VAR wahl, + INT CONST gezeichnete zeilen) : + + INT CONST + y pos := code (m. feldzeilen SUB wahl); + IF zeile bereits gezeichnet THEN + ausfuehrung markieren + END IF; + TEXT VAR k; + feld lesen (m. kommandos, wahl, k); + IF k <> niltext AND k <> blank THEN + do (k); + bildschirm neu; + wahl := - wahl + END IF . + +zeile bereits gezeichnet : + gezeichnete zeilen >= y pos . + +ausfuehrung markieren : + f cursor (1, y pos); + out (ausfuehren marke) . + +END PROC wahl getroffen; + +PROC esc hop ausfuehren : + + TEXT VAR + puffer := niltext, + ausgang; + lernsequenz auf taste legen (""0"", niltext); + push (""27""1""0""0""); + editget (puffer, 32000, 0, ""0"", "", ausgang); + puffer := lernsequenz auf taste (""0""); + IF puffer <> niltext THEN + gelerntes auf richtige taste legen + ELSE + letzten nullcode auslesen + END IF . + +gelerntes auf richtige taste legen : + REP + getchar (ausgang) + UNTIL pos (""1""2""8""11""12"", ausgang) = 0 END REP; + lernsequenz auf taste legen (ausgang, puffer) . + +letzten nullcode auslesen : + getchar (ausgang) . + +END PROC esc hop ausfuehren; + + +INT VAR + anfang, + ende, + mark ende; + +PROC erstes zeichen ausgeben (SATZ CONST bild, INT CONST bildzeile) : + + f cursor (1, bildzeile); + IF (sperrzeichen SUB bildzeile) <> blank THEN + out (sperrzeichen SUB bildzeile) + ELSE + feld bearbeiten (bild, bildzeile, + PROC (TEXT CONST, INT CONST, INT CONST) zeichen 1) + END IF + +END PROC erstes zeichen ausgeben; + +PROC zeichen 1 (TEXT CONST satz, INT CONST anfang, ende) : + + out (satz SUB anfang + ende - ende) + +END PROC zeichen 1; + +PROC menuezeile ausgeben (SATZ CONST bild, + INT CONST zeilennr, BOOL CONST markiert) : + + enable stop; + IF markiert THEN + erstes zeichen ausgeben (bild, zeilennr); + out (begin mark); + anfang := 3; mark ende := 1; + ELSE + f cursor (1, zeilennr); + IF (sperrzeichen SUB zeilennr) = "-" THEN + out ("-"); anfang := 2 + ELSE + anfang := 1 + END IF; + mark ende := 0 + END IF; + bildzeile ausgeben (bild, zeilennr) + +END PROC menuezeile ausgeben; + +PROC menuezeile ausgeben (SATZ CONST bild, INT CONST zeilennr) : + + anfang := 1; mark ende := 0; + bildzeile ausgeben (bild, zeilennr) + +END PROC menuezeile ausgeben; + +PROC bildzeile ausgeben (SATZ CONST bild, INT CONST zeilennr) : + + IF zeilennr <= felderzahl (bild) THEN + zeileninhalt ausgeben + ELSE + ende := 0 + END IF; + zeilenrest loeschen . + +zeileninhalt ausgeben : + feld bearbeiten (bild, zeilennr, + PROC (TEXT CONST, INT CONST, INT CONST) abschnitt ausgeben) . + +zeilenrest loeschen : + IF x pos + x laenge >= 80 AND mark ende = 0 THEN + out (cleol) + ELSE + x laenge - ende - mark ende - 1 TIMESOUT blank; + ggf endemarkierung; + out (":") + END IF . + +ggf endemarkierung : + IF mark ende > 0 THEN + out (end mark) + END IF . + +END PROC bildzeile ausgeben; + +PROC abschnitt ausgeben (TEXT CONST t, INT CONST von, bis) : + + INT CONST offset := von - 1; + anfang INCR offset; + ende := min (bis, x laenge + offset - mark ende - 1); + outsubtext (t, anfang, ende); + ende DECR offset + +END PROC abschnitt ausgeben; + +PROC editget kommando : + + LET esc k = ""27"k"; + TEXT VAR + exit char; + fenster veraendert (balkenfenster); + bei fehler altes kommando wiederholen; + markierte zeile ausgeben; + REP + kommando editieren + UNTIL exit char <> esc k END REP; + IF pos (edit kommando , ""33"", ""254"", 1) > 0 THEN + altes kommando := edit kommando + END IF . + +bei fehler altes kommando wiederholen : + IF is error THEN + fehler ausgeben; + edit kommando := altes kommando + ELSE + edit kommando := niltext + END IF . + +markierte zeile ausgeben : + cursor (1, 1); + out (gib kommando); + x laenge - 15 TIMESOUT blank; + out (end mark) . + +kommando editieren : + cursor (16, 1); + editget (edit kommando, 32000, 62, "", "kh", exit char); + IF is error THEN + clear error + ELIF exit char = esc k THEN + edit kommando := altes kommando + ELIF exit char = esc h THEN + edit kommando := niltext + END IF . + +END PROC edit get kommando; + +PROC existiert nicht (TEXT CONST dateiname) : + + errorstop (textdarstellung (dateiname) + t existiert nicht) + +END PROC existiert nicht; + + +(*************************** Auswahl Einlesen ****************************) + +TYPE AUSWAHL = STRUCT ( + SATZ + kopf, + vorspann, + nachspann, + TEXT + wiederholung, + feldspalten, + feldlaengen); + +BOUND ROW 200 AUSWAHL VAR auswahlen; + + +PROC auswahl aus datei lesen : + + TEXT VAR name := text parameter; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + INT VAR index := link (thesaurus (3), name); + IF index = 0 THEN + insert (thesaurus (3), name, index) + END IF; + auswahl aus datei lesen (auswahlen (index)) + END IF + +END PROC auswahl aus datei lesen; + +PROC auswahl aus datei lesen (AUSWAHL VAR a) : + + menue initialisieren; + IF kopf vorhanden THEN + kopf einlesen + END IF; + bild einlesen; + teste auf ende . + +menue initialisieren : + satz initialisieren (a. kopf); + satz initialisieren (a. vorspann); + satz initialisieren (a. nachspann); + a. wiederholung := niltext; + a. feldspalten := niltext; + a. feldlaengen := niltext . + +kopf vorhanden : + zeile lesen; + kommandozeile CAND kommando ist (vorspann kommando) . + +kopf einlesen : + INT VAR zeilennr := 1; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE kopf einlesen + ELSE + kopfzeile bearbeiten; + zeilennr INCR 1 + END IF + END REP . + +kopfzeile bearbeiten : + feld aendern (a. kopf, zeilennr, zeile) . + +bild einlesen : + teste auf bildkommando; + zeilennr := 1; + BOOL VAR noch vorspann := TRUE; + REP + zeile lesen; + IF kommandozeile THEN + teste ob wiederholung gewesen; + LEAVE bild einlesen + ELSE + bildzeile bearbeiten; + zeilennr INCR 1 + END IF + END REP . + +teste auf bildkommando : + IF NOT (kommandozeile CAND kommando ist (bild kommando)) THEN + fehler (bild kommando erwartet) + END IF . + +teste ob wiederholung gewesen : + IF noch vorspann THEN + fehler (keine wiederholungszeile) + END IF . + +bildzeile bearbeiten : + IF noch vorspann THEN + teste auf wiederholung + ELSE + nachspannzeile + END IF . + +teste auf wiederholung : + IF pos (zeile, feldmarkierung) > 0 THEN + behandle wiederholungszeile; + zeilennr := 0; + noch vorspann := FALSE + ELSE + feld aendern (a. vorspann, zeilennr, zeile) + END IF . + +behandle wiederholungszeile : + spalten suchen; + a. wiederholung := zeile; + feldlaengen berechnen . + +spalten suchen : + INT VAR feldpos := 0; + REP + feldpos := pos (zeile, feldmarkierung, feldpos + 1); + IF feldpos > 0 THEN + a. feldspalten CAT code (feldpos) + END IF + UNTIL feldpos = 0 END REP . + +feldlaengen berechnen : + FOR feldpos FROM 1 UPTO length (a. feldspalten) - 1 REP + a. feldlaengen CAT code (spaltenabstand - 4) + END REP; + a. feldlaengen CAT ""0"" . + +spaltenabstand : + code (a. feldspalten SUB feldpos + 1) - code (a. feldspalten SUB feldpos) . + +nachspannzeile : + feld aendern (a. nachspann, zeilennr, zeile) . + +teste auf ende : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF . + +END PROC auswahl aus datei lesen; + + +(*************************** Auswahl anbieten ****************************) + +LET + hop links unten = ""1""8""10"", + plus esc q = "+"27"q"; + +LET + fenster zu klein = #716# + "Fenster zu klein", + auswahlstatus = #717# +"AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ?"; + +INT VAR + wahlen, + spalten, + kopfzeilen, + bis vorspann, + wiederholungszeilen, + bis wiederholung, + gesamtzeilen, + gerollt; + +LET INTVEC = TEXT; + +INTVEC VAR gewaehlt; + +TEXT VAR spaltenpositionen; + + +PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) : + + ggf initialisieren; + INT CONST index := link (thesaurus (3), name); + IF index = 0 THEN + existiert nicht (name) + ELSE + anbieten (auswahlen (index), f, hilfe, PROC (TEXT VAR, INT CONST) inhalt) + END IF + +END PROC auswahl anbieten; + +PROC anbieten (AUSWAHL CONST a, FENSTER CONST f, TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) : + + INT VAR + gezeichnete zeilen := 0, + tastenzustand := 0; + enable stop; + fensterzugriff durchfuehren; + status anzeigen (auswahlstatus); + anzahl der wahlen feststellen; + bildparameter berechnen; + auswahl initialisieren; + REP + auf eingabe warten; + auswahlfunktion durchfuehren + END REP . + +fensterzugriff durchfuehren : + BOOL VAR dummy; + fensterzugriff (f, dummy); + fenstergroesse (f, x pos, y pos, x laenge, y laenge) . + +anzahl der wahlen feststellen : + INT VAR + schritt := 1024; + wahlen := schritt; + REP + schritt := schritt DIV 2; + inhalt (zeile, wahlen); + IF zeile = niltext THEN + wahlen DECR schritt + ELSE + wahlen INCR schritt + END IF + UNTIL schritt = 1 END REP; + inhalt (zeile, wahlen); + IF zeile = niltext THEN wahlen DECR 1 END IF . + +auswahl initialisieren : + INT VAR + akt zeile := bis vorspann + 1, + akt spalte := 1, + akt wahl := 1; + gewaehlt := niltext; + spaltenpositionen := a. feldspalten . + +bildparameter berechnen : + kopfzeilen := felderzahl (a. kopf); + bis vorspann := kopfzeilen + felderzahl (a. vorspann); + spalten := length (a. feldspalten); + wiederholungszeilen := (wahlen + spalten - 1) DIV spalten; + bis wiederholung := bis vorspann + wiederholungszeilen; + gesamtzeilen := bis wiederholung + felderzahl (a. nachspann); + gerollt := 0; + IF bis vorspann >= y laenge THEN + errorstop (fenster zu klein) + END IF . + +auf eingabe warten : + REP + ausgabe und zeichen annehmen; + IF is error THEN + clear error; + gezeichnete zeilen := 0 + ELSE + LEAVE auf eingabe warten + END IF + END REP . + +ausgabe und zeichen annehmen : + TEXT VAR eingabe; + WHILE gezeichnete zeilen < y laenge REP + eingabe := getcharety; + eventuell eine zeile ausgeben + END REP; + cursor positionieren; + getchar mit enable stop (eingabe) . + +eventuell eine zeile ausgeben : + IF eingabe = niltext THEN + gezeichnete zeilen INCR 1; + entsprechende zeile ausgeben + ELSE + LEAVE ausgabe und zeichen annehmen + END IF . + +entsprechende zeile ausgeben : + INT CONST tatsaechliche zeile := gezeichnete zeilen + gerollt; + f cursor (1, gezeichnete zeilen); + IF gezeichnete zeilen <= kopfzeilen THEN + menuezeile ausgeben (a. kopf, gezeichnete zeilen) + ELIF tatsaechliche zeile <= bis vorspann THEN + menuezeile ausgeben (a. vorspann, tatsaechliche zeile - kopfzeilen) + ELIF tatsaechliche zeile <= bis wiederholung THEN + wiederholungszeile ausgeben + ELSE + menuezeile ausgeben (a. nachspann, + tatsaechliche zeile - bis wiederholung) + END IF . + +wiederholungszeile ausgeben : + auswahlzeile ausgeben (a, erste wahl, + PROC (TEXT VAR, INT CONST) inhalt) . + +erste wahl : + (tatsaechliche zeile - bis vorspann - 1) * spalten + 1 . + +cursor positionieren : + f cursor (code (spaltenpositionen SUB akt spalte), akt zeile) . + +auswahlfunktion durchfuehren : + SELECT tastenzustand OF + CASE 0 : normale funktion + CASE 1 : hop funktion + CASE 2 : esc funktion + END SELECT . + +normale funktion : + SELECT pos (""1""2""3""8""9""10""13""27" +x-o", eingabe) OF + CASE 1 : tastenzustand := 1 + CASE 2 : rechts ausfuehren + CASE 3 : oben ausfuehren + CASE 4 : links ausfuehren + CASE 5 : tab ausfuehren + CASE 6 : unten ausfuehren + CASE 7 : return ausfuehren + CASE 8 : tastenzustand := 2 + CASE 9 : leertaste ausfuehren + CASE 10, 11 : plus ausfuehren + CASE 12, 13 : minus ausfuehren + OTHERWISE sondertaste + END SELECT . + +hop funktion : + SELECT pos (""1""2""3""8""10""13"+x-o", eingabe) OF + CASE 1 : hop hop ausfuehren + CASE 2 : hop rechts ausfuehren + CASE 3 : hop oben ausfuehren + CASE 4 : hop links ausfuehren + CASE 5 : hop unten ausfuehren + CASE 6 : hop return ausfuehren + CASE 7, 8 : hop plus ausfuehren + CASE 9, 10 : hop minus ausfuehren + OTHERWISE out (piep) + END SELECT; + tastenzustand := 0 . + +esc funktion : + SELECT pos (""1"19?qh", eingabe) OF + CASE 1 : esc hop ausfuehren + CASE 2 : esc 1 ausfuehren + CASE 3 : esc 9 ausfuehren + CASE 4 : esc fragezeichen ausfuehren + CASE 5 : esc q ausfuehren + CASE 6 : errorstop (niltext) + OTHERWISE belegte taste + END SELECT; + tastenzustand := 0 . + +rechts ausfuehren : + IF akt spalte < spalten AND akt wahl < wahlen THEN + akt spalte INCR 1; + akt wahl INCR 1 + END IF . + +oben ausfuehren : + IF akt wahl > spalten THEN + akt zeile DECR 1; + akt wahl DECR spalten; + IF akt zeile <= kopfzeilen THEN + akt zeile INCR 1; + gerollt DECR 1; + gezeichnete zeilen := kopfzeilen + END IF + END IF . + +links ausfuehren : + IF akt spalte > 1 THEN + akt spalte DECR 1; + akt wahl DECR 1 + END IF . + +tab ausfuehren : + IF akt spalte = spalten THEN + push (""13"") (* return *) + ELSE + push (""1""2"") (* hop rechts *) + END IF . + +unten ausfuehren : + IF akt wahl + spalten <= wahlen THEN + akt zeile INCR 1; + akt wahl INCR spalten; + IF akt zeile > y laenge THEN + akt zeile DECR 1; + gerollt INCR 1; + gezeichnete zeilen := kopfzeilen + END IF + END IF . + +return ausfuehren : + IF akt zeile + gerollt < bis wiederholung THEN + push (hop links unten) + END IF . + +leertaste ausfuehren : + push (plus esc q) . + +plus ausfuehren : + IF wahlpos (akt wahl) = 0 AND akt wahl <= wahlen THEN + gewaehlt CAT akt wahl; + IF akt zeile <= gezeichnete zeilen THEN + wahlnummer (akt zeile, akt spalte, length (gewaehlt) DIV 2) + END IF + END IF . + +minus ausfuehren : + INT CONST alte pos := wahlpos (akt wahl); + IF alte pos > 0 THEN + wahl entfernen; + wahlpositionen ausgeben + END IF . + +wahl entfernen : + change (gewaehlt, 2 * alte pos - 1, 2 * alte pos, niltext) . + +sondertaste : + IF eingabe < blank THEN + push (lernsequenz auf taste (eingabe)) + ELSE + out (piep) + END IF . + +hop hop ausfuehren : + hop links ausfuehren; nach oben . + +hop rechts ausfuehren : + WHILE akt wahl < wahlen AND akt spalte < spalten REP + akt wahl INCR 1; akt spalte INCR 1 + END REP . + +hop oben ausfuehren : + IF akt zeile = kopfzeilen + 1 THEN + nach oben rollen + ELSE + nach oben + END IF . + +nach oben rollen : + INT VAR um := min (y laenge - kopfzeilen, gerollt); + gerollt DECR um; + INT CONST runter := noch angezeigter vorspann; + akt zeile INCR runter; + akt wahl DECR (um - runter) * spalten; + IF um > 0 THEN + gezeichnete zeilen := kopfzeilen + END IF . + +noch angezeigter vorspann : + max (0, bis vorspann - kopfzeilen - gerollt) . + +nach oben : + WHILE akt wahl > spalten AND akt zeile > kopfzeilen + 1 REP + akt zeile DECR 1; + akt wahl DECR spalten + END REP . + +hop links ausfuehren : + akt wahl DECR (akt spalte - 1); + akt spalte := 1 . + +hop unten ausfuehren : + IF akt zeile = y laenge THEN + nach unten rollen + ELSE + nach unten + END IF . + +nach unten rollen : + um := min (y laenge - kopfzeilen, gesamtzeilen - akt zeile - gerollt); + gerollt INCR um; + INT CONST rauf := max (0, akt zeile + gerollt - bis wiederholung + + spaltenkorrektur); + akt zeile DECR rauf; + akt wahl INCR (um - rauf) * spalten; + IF um > 0 THEN + gezeichnete zeilen := kopfzeilen + END IF . + +spaltenkorrektur : + IF akt spalte - 1 > wahlen MOD spalten THEN + 1 + ELSE + 0 + END IF . + +nach unten : + WHILE akt zeile < y laenge AND akt wahl + spalten <= wahlen REP + akt zeile INCR 1; + akt wahl INCR spalten + END REP . + +hop return ausfuehren : + gerollt INCR (akt zeile - kopfzeilen - 1); + akt zeile := kopfzeilen + 1; + gezeichnete zeilen := kopfzeilen . + +hop plus ausfuehren : + INT VAR w; + FOR w FROM 1 UPTO wahlen REP + IF wahlpos (w) = 0 THEN + gewaehlt CAT w + END IF + END REP; + wahlpositionen ausgeben . + +hop minus ausfuehren : + gewaehlt := niltext; + wahlpositionen ausgeben . + +esc fragezeichen ausfuehren : + hilfe anbieten (hilfe, f); + status anzeigen (auswahlstatus); + gezeichnete zeilen := 0 . + +esc q ausfuehren : + LEAVE anbieten . + +belegte taste : + push (lernsequenz auf taste (eingabe)) . + +esc 1 ausfuehren : + akt zeile := bis vorspann + 1; + akt wahl := 1; + akt spalte := 1; + gerollt := 0; + gezeichnete zeilen := kopfzeilen . + +esc 9 ausfuehren : + IF bis wiederholung <= y laenge THEN + akt zeile := bis wiederholung + ELSE + akt zeile := max (kopfzeilen + 1, + y laenge + bis wiederholung - gesamtzeilen) + END IF; + gerollt := bis wiederholung - akt zeile; + akt spalte := (wahlen - 1) MOD spalten + 1; + akt wahl := wahlen; + gezeichnete zeilen := kopfzeilen . + +END PROC anbieten; + +PROC wahlpositionen ausgeben : + + INT VAR z, s, w; + w := erste angezeigte wahl; + FOR z FROM erste wahlzeile UPTO letzte wahlzeile REP + FOR s FROM 1 UPTO spalten REP + wahlnummer (z, s, wahlpos (w)); + w INCR 1 + END REP + END REP . + +erste angezeigte wahl : + max (0, gerollt - bis vorspann + kopfzeilen) * spalten + 1 . + +erste wahlzeile : + max (kopfzeilen, bis vorspann - gerollt) + 1 . + +letzte wahlzeile : + min (y laenge, bis wiederholung - gerollt) . + +END PROC wahlpositionen ausgeben; + + +TEXT VAR zwei bytes := "xx"; + +INT PROC wahlpos (INT CONST feld) : + + replace (zwei bytes, 1, feld); + INT VAR p := 0; + REP + p := pos (gewaehlt, zwei bytes, p + 1) + UNTIL p = 0 OR p MOD 2 = 1 END REP; + (p + 1) DIV 2 + +END PROC wahlpos; + +OP CAT (INTVEC VAR intvec, INT CONST wert) : + + replace (zwei bytes, 1, wert); + intvec CAT zwei bytes + +END OP CAT; + +PROC auswahlzeile ausgeben (AUSWAHL CONST a, INT CONST erste wahl, + PROC (TEXT VAR, INT CONST) inhalt) : + + INT VAR + p := 1, + feld, + s := 1; + FOR feld FROM erste wahl UPTO erste wahl + spalten - 1 REP + outsubtext (a. wiederholung, p, spaltenpos - 5); + position ausgeben; + inhalt (zeile, feld); + INT CONST f laenge := min (jeweilige feldlaenge, length (zeile)); + outsubtext (zeile, 1, f laenge); + p := spaltenpos + f laenge + 2; + s INCR 1 + END REP; + zeilenrest loeschen . + +spaltenpos : + code (spaltenpositionen SUB s) . + +position ausgeben : + INT CONST n := wahlpos (feld); + IF n = 0 THEN + out (" o ") + ELSE + out (text (n, 3)); out (" x ") + END IF . + +jeweilige feldlaenge : + IF s = spalten THEN + x laenge - spaltenpos - 1 + ELSE + code (a. feldlaengen SUB s) + END IF . + +zeilenrest loeschen : + outsubtext (a. wiederholung, p, x laenge); + IF x pos + x laenge >= 80 THEN + out (cl eol) + ELSE + x laenge - max (p, length (a. wiederholung)) TIMESOUT blank + END IF . + +END PROC auswahlzeile ausgeben; + +PROC wahlnummer (INT CONST zeile, spalte, wert) : + + f cursor (code (spaltenpositionen SUB spalte) - 4, zeile); + IF wert = 0 THEN + out (" o ") + ELSE + out (text (wert, 3)); out (" x ") + END IF + +END PROC wahlnummer; + +INT PROC wahl (INT CONST stelle) : + + IF stelle + stelle <= length (gewaehlt) THEN + gewaehlt ISUB stelle + ELSE + 0 + END IF + +END PROC wahl; + + +(************************ Hilfen *****************************************) + +LET + maxgebiete = 200, + maxseiten = 5000; + +LET HILFE = STRUCT ( + INT anzahl seiten, + ROW maxgebiete THESAURUS hilfsnamen, + ROW maxgebiete SATZ seitenindex, + ROW maxseiten SATZ seiten); + +BOUND HILFE VAR h; + +INT VAR hx, hy, hxl, hyl; + +BOOL VAR hilfen sparen := FALSE; + + +(************************* Hilfe einlesen ********************************) + +LET + hilfsgebiet existiert bereits = #718# + "Das Hilfsgebiet existiert bereits", + seite existiert nicht = #719# + "Diese Seite ist in der anderen Hilfe nicht vorhanden"; + + +PROC hilfe aus datei lesen : + + TEXT VAR name := text parameter; + BOOL VAR hilfe ueberspringen; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + eintrag reservieren; + seiten einlesen; + hilfe abspeichern + END IF . + +eintrag reservieren : + INT CONST trennung := pos (name, "/"); + TEXT VAR gebiet; + IF trennung = 0 THEN + gebiet := name + ELSE + gebiet := subtext (name, 1, trennung - 1) + END IF; + gebietsindex bestimmen; + einzelindex bestimmen . + +gebietsindex bestimmen : + INT VAR gebietsindex := link (thesaurus (1), gebiet); + hilfe ueberspringen := FALSE; + IF gebietsindex = 0 THEN + insert (thesaurus (1), gebiet, gebietsindex); + h. hilfsnamen (gebietsindex) := empty thesaurus; + satz initialisieren (h. seitenindex (gebietsindex)); + ELIF trennung = 0 THEN + fehler (hilfsgebiet existiert bereits); + LEAVE hilfe aus datei lesen + ELIF hilfen sparen THEN + hilfe ueberspringen := TRUE + END IF . + +einzelindex bestimmen : + INT VAR einzelindex; + TEXT VAR einzelname := subtext (name, trennung + 1); + IF trennung = 0 THEN + einzelindex := 1 + ELSE + einzelindex := link (h. hilfsnamen (gebietsindex), einzelname); + IF einzelindex = 0 AND NOT hilfe ueberspringen THEN + insert (h. hilfsnamen (gebietsindex), einzelname, einzelindex) + END IF + END IF . + +seiten einlesen : + INT VAR vorlaeufige seiten := h. anzahl seiten; + IF vorlaeufige seiten < 0 THEN + vorlaeufige seiten := 0 + END IF; + TEXT VAR alle seiten := niltext; + zeile lesen; + WHILE kommandozeile CAND kommando ist (seite kommando) REP + eine seite einlesen + END REP . + +eine seite einlesen : + INT CONST seitennr := int parameter; + TEXT CONST referenz := text parameter; + IF referenz <> niltext THEN + seitenreferenz besorgen; + zeile lesen + ELSE + neue seite einlesen + END IF . + +seitenreferenz besorgen : + TEXT VAR referenzseiten; + seiten bestimmen (referenz, referenzseiten); + IF seitennr + seitennr <= length (referenzseiten) THEN + alle seiten CAT (referenzseiten ISUB seitennr) + ELIF NOT (anything noted OR hilfe ueberspringen) THEN + fehler (seite existiert nicht) + END IF . + +neue seite einlesen : + INT VAR zeilennr := 1; + IF NOT hilfe ueberspringen THEN + vorlaeufige seiten INCR 1; + alle seiten CAT vorlaeufige seiten; + satz initialisieren (h. seiten (vorlaeufige seiten)) + END IF; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE neue seite einlesen + ELIF NOT hilfe ueberspringen THEN + feld aendern (h. seiten (vorlaeufige seiten), zeilennr, zeile); + zeilennr INCR 1 + END IF + END REP . + +hilfe abspeichern : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF; + IF NOT (anything noted OR hilfe ueberspringen) THEN + feld aendern (h. seitenindex (gebietsindex), einzelindex, alle seiten); + h. anzahl seiten := vorlaeufige seiten + END IF . + +END PROC hilfe aus datei lesen; + +PROC seiten bestimmen (TEXT CONST name, TEXT VAR alle seiten) : + + INT CONST trennung := pos (name, "/"); + INT VAR + gebiet, + einzelindex := 0; + IF trennung = 0 THEN + gebiet := link (thesaurus (1), name) + ELSE + gebiet := link (thesaurus (1), subtext (name, 1, trennung - 1)); + einzelindex suchen + END IF; + IF einzelindex = 0 THEN + einzelindex := 1 + END IF; + IF gebiet = 0 THEN + errorstop (hilfe existiert nicht) + ELSE + feld lesen (h. seitenindex (gebiet), einzelindex, alle seiten) + END IF . + +einzelindex suchen : + IF gebiet > 0 THEN + einzelindex := + link (h. hilfsnamen (gebiet), subtext (name, trennung + 1)) + END IF . + +END PROC seiten bestimmen; + + +(************************* Hilfe anbieten ********************************) + +LET + hilfe existiert nicht = #720# + "Hilfe existiert nicht", + hilfe ist leer = #721# + "Hilfe ist leer", + hilfe status = #722# +"HILFE: Beenden: ESC q Seite weiter: ESC w Seite zurueck: ESC z"; + + +PROC hilfe anbieten (TEXT CONST name, FENSTER CONST f) : + + enable stop; + ggf initialisieren; + TEXT VAR alle seiten; + fensterzugriff anmelden; + seiten bestimmen (name, alle seiten); + IF alle seiten = niltext THEN + errorstop (hilfe ist leer) + ELSE + seiten ausgeben + END IF . + +fensterzugriff anmelden : + fenster veraendert (f); + fenstergroesse (f, hx, hy, hxl, hyl) . + +seiten ausgeben : + tastenpuffer loeschen; + status anzeigen (hilfe status); + INT VAR seitenindex := 1; + REP + eine seite ausgeben; + kommando annehmen + END REP . + +eine seite ausgeben : + INT CONST tatsaechliche seite := alle seiten ISUB seitenindex; + seite ausgeben (h. seiten (tatsaechliche seite)) . + +kommando annehmen : + TEXT VAR eingabe; + REP + getchar (eingabe); + IF eingabe = esc THEN + getchar (eingabe); + kommando ausfuehren; + LEAVE kommando annehmen + ELSE + out (piep) + END IF + END REP . + +kommando ausfuehren : + SELECT pos ("qwz?"1"", eingabe) OF + CASE 1 : LEAVE hilfe anbieten + CASE 2 : eine seite weiter + CASE 3 : eine seite zurueck + CASE 4 : an anfang + CASE 5 : esc hop ausfuehren + OTHERWISE out (piep) + END SELECT . + +eine seite weiter : + IF 2 * seitenindex < length (alle seiten) THEN + seitenindex INCR 1 + END IF . + +eine seite zurueck : + IF seitenindex > 1 THEN + seitenindex DECR 1 + END IF . + +an anfang : + seitenindex := 1 . + +END PROC hilfe anbieten; + +PROC seite ausgeben (SATZ CONST seite) : + + INT VAR zeilennr; + FOR zeilennr FROM 1 UPTO hyl REP + cursor (hx, hy + zeilennr - 1); + feld bearbeiten (seite, zeilennr, + PROC (TEXT CONST, INT CONST, INT CONST) zeile ausgeben) + END REP; + cursor (hx, hy + hyl - 1) + +END PROC seite ausgeben; + +PROC zeile ausgeben (TEXT CONST bild, INT CONST von, bis) : + + IF bis - von + 1 > hxl THEN + ende := von + hxl - 1 + ELSE + ende := bis + END IF; + outsubtext (bild, von, ende); + IF hx + hxl >= 80 THEN + out (cleol) + ELSE + hxl + von - ende - 1 TIMESOUT blank + END IF + +END PROC zeile ausgeben; + + +(*********************** Statuszeile *************************************) + +PROC status anzeigen (TEXT CONST status) : + + cursor (1, 1); + out (status); + out (cl eol); + fenster veraendert (balkenfenster) + +END PROC status anzeigen; + + +(******************************* Dialog **********************************) + +LET + cleop = ""4"", + esc fragezeichen = ""27"?", + esc q = ""27"q", + esc h = ""27"h"; + +LET + ja nein text = #723# + " ? (j/n) ", + ja zeichen = #724# + "jJ", + nein zeichen = #725# + "nN", + ja status = #726# +"FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ?", + editget status ohne esc z = #727# +"EINGABE: Bestätigen: RETURN Abbrechen: ESC h Hilfe: ESC ?", + editget status mit esc z = #728# +"EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbruch: ESC h Hilfe: ESC ?", + fehler status = #729# +""15"!!! FEHLER !!! "14" Quittieren: ESC q Hilfe zur Meldung: ESC ?"; + +FENSTER VAR d fenster; +fenster initialisieren (d fenster); + +INT VAR + dialogzeile, + dx, + dy, + dxl, + dyl; + + +PROC dialogfenster (INT CONST x, y, x l, y l) : + + fenstergroesse setzen (d fenster, x, y, x l, y l); + dx := x; dy := y; dxl := x l; dyl := y l + +END PROC dialogfenster; + +PROC neuer dialog : + + dialogzeile := dyl + +END PROC neuer dialog; + +PROC dialog : + + BOOL VAR veraendert; + fensterzugriff (d fenster, veraendert); + dialogzeile INCR 1; + IF dialogzeile > dyl OR veraendert THEN + dialogfenster loeschen; + dialogzeile := 1 + END IF; + cursor (dx, dy + dialogzeile - 1) . + +END PROC dialog; + +PROC dialogfenster loeschen : + + BOOL CONST bis zeilenende := dx + dxl >= 80; + dialogzeile := 0; + REP + cursor (dx, dy + dialogzeile); + IF bis zeilenende THEN + out (cleol) + ELSE + dxl TIMESOUT blank + END IF; + dialogzeile INCR 1 + UNTIL dialogzeile >= dyl END REP . + +END PROC dialogfenster loeschen; + +BOOL PROC ja (TEXT CONST frage, hilfe) : + + REP + status anzeigen (ja status); + dialog; + out (frage); out (ja nein text); + tastenpuffer loeschen; + zeichen annehmen und auswerten + END REP; + FALSE . + +zeichen annehmen und auswerten : + TEXT VAR eingabe; + REP + getchar (eingabe); + IF pos (ja zeichen, eingabe) > 0 THEN + out (eingabe); LEAVE ja WITH TRUE + ELIF pos (nein zeichen, eingabe) > 0 THEN + out (eingabe); LEAVE ja WITH FALSE + ELIF eingabe = esc THEN + esc funktionen + ELSE + out (piep) + END IF + END REP . + +esc funktionen : + getchar (eingabe); + IF eingabe = "?" THEN + hilfe anbieten (hilfe, d fenster); + neuer dialog; + LEAVE zeichen annehmen und auswerten + ELIF eingabe = "h" THEN + errorstop (niltext); + LEAVE ja WITH FALSE + ELIF eingabe = ""1"" THEN + esc hop ausfuehren + ELSE + out (piep) + END IF . + +END PROC ja; + +PROC editget (TEXT CONST prompt, TEXT VAR eingabe, TEXT CONST res, hilfe) : + + TEXT VAR exit char; + passenden status anzeigen; + dialog; + out (prompt); out (blank); + editget (eingabe, 1000, editlaenge, "", "?hq" + res, exit char); + IF exit char = esc fragezeichen THEN + hilfe anbieten (hilfe, d fenster); + neuer dialog; + editget (prompt, eingabe, res, hilfe) + ELIF exit char = esc h OR exit char = esc q THEN + errorstop (niltext) + ELIF length (exit char) = 2 THEN + eingabe := exit char + END IF . + +passenden status anzeigen : + IF pos (res, "z") > 0 THEN + status anzeigen (editget status mit esc z) + ELSE + status anzeigen (editget status ohne esc z) + END IF . + +editlaenge : + dxl - length (prompt) - 1 . + +END PROC editget; + +PROC fehler ausgeben : + + TEXT CONST meldung := errormessage; + IF error code = 1 THEN + page; bildschirm neu + END IF; + clear error; + tastenpuffer loeschen; + IF meldung <> niltext THEN + status anzeigen (fehler status); + meldung ausgeben; + eingabe abwarten; + neuer dialog + END IF . + +meldung ausgeben : + dialog; + out (piep); out (">>> "); + outsubtext (errormessage, 1, dxl) . + +eingabe abwarten : + TEXT VAR eingabe; + getchar (eingabe); + IF eingabe = esc THEN + esc funktionen + END IF . + +esc funktionen : + getchar (eingabe); + IF eingabe = "?" THEN + hilfe anbieten ("FEHLER/" + text (errorcode), d fenster) + ELIF eingabe = ""1"" THEN + esc hop ausfuehren + END IF . + +END PROC fehler ausgeben; + +PROC tastenpuffer loeschen : + + WHILE getcharety <> niltext REP END REP + +END PROC tastenpuffer loeschen; + + +(************************** Menue Manager ********************************) + +LET + max ds = 3, + save order = 12, + erase order = 14, + fetch order = 1070, + lock order = 1068, + free order = 1069, + ack = 0, + error nak = 2; + +ROW maxds DATASPACE VAR menue ds; + +ROW maxds THESAURUS VAR thesaurus; + +BOOL VAR vater ist menuemanager := FALSE; + +INITFLAG VAR menueinitialisierung; + + +PROC ggf initialisieren : + + IF NOT initialized (menueinitialisierung) THEN + initialisierung durchfuehren + END IF . + +initialisierung durchfuehren : + BOOL VAR erfolgreich := vater ist menuemanager; + datenraeume holen; + IF erfolgreich THEN + ankoppeln + ELSE + menue loeschen (FALSE) + END IF . + +datenraeume holen : + INT VAR nr; + FOR nr FROM 1 UPTO maxds + WHILE erfolgreich REP + versuche zu holen + END REP . + +versuche zu holen : +## (* nur im Multi-User *) + INT VAR + reply, + retries; + FOR retries FROM 1 UPTO 10 REP + forget (menue ds (nr)); + menue ds (nr) := nilspace; + pingpong (father, fetch order + nr, menue ds (nr), reply); + IF reply = ack THEN + LEAVE versuche zu holen + ELIF reply <> error nak THEN + pause (15) + END IF + UNTIL reply = error nak END REP; + forget (menue ds (nr)); + menue ds (nr) := nilspace; +## + erfolgreich := FALSE . + +END PROC ggf initialisieren; + +THESAURUS PROC menuenamen (INT CONST nr) : + + ggf initialisieren; + IF nr < 0 THEN + h. hilfsnamen (- nr) + ELSE + thesaurus (nr) + END IF + +END PROC menuenamen; + +PROC menue loeschen (TEXT CONST name, INT CONST nr) : + + ggf initialisieren; + IF nr < 0 THEN + loeschen (name, h. hilfsnamen (- nr)) + ELSE + loeschen (name, thesaurus (nr)) + END IF + +END PROC menue loeschen; + +PROC loeschen (TEXT CONST name, THESAURUS VAR t) : + + INT CONST index := link (t, name); + IF index > 0 THEN + delete (t, index) + END IF + +END PROC loeschen; + +PROC menue loeschen (BOOL CONST hilfen reduzieren) : + + INT VAR nr; + menueinitialisierung := TRUE; + hilfen sparen := hilfen reduzieren; + FOR nr FROM 1 UPTO max ds REP + forget (menue ds (nr)); + menue ds (nr) := nilspace; + thesaurus (nr) := empty thesaurus + END REP; + ankoppeln + +END PROC menue loeschen; + +PROC ankoppeln : + + h := menue ds (1); + menues := menue ds (2); + auswahlen := menue ds (3) + +END PROC ankoppeln; + +## (* nur im Multi-User *) + +LET + lock aktiv = #730# + "Datei wird von anderer Task geaendert.", + auftrag nur fuer soehne = #731# + "Auftrag nur fuer Soehne erlaubt"; + +THESAURUS VAR locks := empty thesaurus; + +ROW 200 TASK VAR lock owner; + +TEXT VAR save file name; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg; + +PROC menue manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + + enable stop; + vater ist menue manager := TRUE; + IF order >= lock order AND order <= fetch order + max ds THEN + menue auftrag + ELSE + IF order = save order OR order = erase order THEN + save pre + END IF; + free manager (ds, order, phase, order task) + END IF . + +menue auftrag : + IF order = lock order THEN + lock ausfuehren + ELIF order = free order THEN + free ausfuehren + ELSE + menue fetch + END IF . + +lock ausfuehren : + msg := ds; + set lock (msg. name, order task); + send (order task, ack, ds) . + +free ausfuehren : + msg := ds; + reset lock (msg. name); + send (order task, ack, ds) . + +save pre : + IF phase = 1 THEN + lock ueberpruefen + ELSE + reset lock (save file name) + END IF . + +lock ueberpruefen : + msg := ds; + save file name := msg. name; + IF gesperrt und task ungleich THEN + errorstop (lock aktiv) + END IF . + +gesperrt und task ungleich : + INT VAR stelle := link (locks, save file name); + stelle > 0 CAND NOT (lock owner (stelle) = order task) . + +menue fetch : + IF order task < myself THEN + ggf initialisieren; + forget (ds); ds := menue ds (order - fetch order); + send (order task, ack, ds) + ELSE + errorstop (auftrag nur fuer soehne) + END IF . + +END PROC menue manager; + +PROC set lock (TEXT CONST dateiname, TASK CONST owner) : + + INT VAR i := link (locks, dateiname); + IF i = 0 THEN + insert (locks, dateiname, i); + ggf reorganisieren; + lock owner (i) := owner + ELIF exists (lock owner (i)) THEN + IF NOT (lock owner (i) = owner) THEN + errorstop (lock aktiv) + END IF + ELSE + lock owner (i) := owner + END IF . + +ggf reorganisieren : + IF i = 0 THEN + locks reorganisieren; + insert (locks, dateiname, i) + END IF . + +locks reorganisieren : + TEXT VAR eintrag; + i := 0; + REP + get (locks, eintrag, i); + IF i = 0 THEN + LEAVE locks reorganisieren + END IF; + IF NOT exists (eintrag) OR NOT exists (lock owner (i)) THEN + delete (locks, i) + END IF + END REP . + +END PROC set lock; + +PROC reset lock (TEXT CONST dateiname) : + + INT VAR i; + delete (locks, dateiname, i) + +END PROC reset lock; + +PROC global manager : + + global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, + TASK CONST) menue manager) + +END PROC global manager; +## + +PROC lock (TEXT CONST dateiname, TASK CONST manager) : + + call (lock order, dateiname, manager) + +END PROC lock; + +PROC free (TEXT CONST dateiname, TASK CONST manager) : + + call (free order, dateiname, manager) + +END PROC free; + +END PACKET eudas menues; + diff --git a/app/eudas/4.4/src/eudas.satzanzeige b/app/eudas/4.4/src/eudas.satzanzeige new file mode 100644 index 0000000..25afc8e --- /dev/null +++ b/app/eudas/4.4/src/eudas.satzanzeige @@ -0,0 +1,993 @@ +PACKET satzanzeige + +(*************************************************************************) +(* *) +(* Anzeige von EUDAS-Saetzen *) +(* *) +(* Version 09 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 31.07.87 *) +(* *) +(*************************************************************************) + + DEFINES + + anzeigefenster, + bild ausgeben, + aendern, + einfuegen, + suchen, + feldauswahl, + rollen, + exit durch, + exit zeichen : + + +LET + maxfelder = 256; + +LET + blank = " ", + niltext = "", + cleol = ""5"", + begin mark = ""15"", + blank end mark = " "14"", + blank end mark blank = " "14" "; + +ROW maxfelder STRUCT (INT feldnr, anfang) VAR zeilen; + +INT VAR + anzahl zeilen, + erste zeile, + laenge := 24, + breite := 79, + zeilen anf := 1, + spalten anf := 1, + feldnamenlaenge, + inhaltsbreite, + zuletzt angezeigter satz := 0, + letzte kombi := 0, + anzeigeversion := dateiversion - 1, + anzeigedateien := 0; + +BOOL VAR + neues fenster := TRUE, + bis zeilenende := TRUE, + save ds voll := FALSE, + namen ausgeben; + +FENSTER VAR fenster; +fenster initialisieren (fenster); + +DATASPACE VAR + save ds, + edit ds; + +FILE VAR edit file; + +TEXT VAR + ueberschrift, + zeilenpuffer; + +LET + fenster zu klein = #801# + "Anzeigefenster zu klein"; + + +PROC anzeigefenster (INT CONST x anf, y anf, x laenge, y laenge) : + + IF x laenge >= 39 THEN + fenstergroesse setzen (fenster, x anf, y anf, x laenge, y laenge); + bis zeilenende := x anf + x laenge >= 80; + breite := x laenge; laenge := y laenge; + spalten anf := x anf; + zeilen anf := y anf; + neues fenster := TRUE + ELSE + errorstop (fenster zu klein) + END IF + +END PROC anzeigefenster; + +PROC fensterzugriff anmelden : + + BOOL VAR fenster veraendert; + fensterzugriff (fenster, fenster veraendert); + IF fenster veraendert THEN + namen ausgeben := TRUE + END IF + +END PROC fensterzugriff anmelden; + +PROC zeilendeskriptor aktualisieren : + + IF neue datei seit letztem mal OR neues fenster THEN + neue feldnummern uebernehmen; + feldnamenlaenge bestimmen; + ueberschrift generieren; + fuer bildausgabe sorgen; + edit datei loeschen; + veraenderungsstatus merken + END IF . + +neue datei seit letztem mal : + anzeigeversion <> dateiversion . + +neue feldnummern uebernehmen : + anzahl zeilen := 0; + WHILE anzahl zeilen < anzahl felder REP + anzahl zeilen INCR 1; + zeilen (anzahl zeilen). feldnr := anzahl zeilen + END REP; + erste zeile := 1 . + +feldnamenlaenge bestimmen : + INT VAR feldnr; + feldnamenlaenge := 11; + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen bearbeiten (feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) namen max) + END REP; + feldnamenlaenge := min (feldnamenlaenge, breite DIV 2); + inhaltsbreite := breite - feldnamenlaenge - 3 . + +fuer bildausgabe sorgen : + namen ausgeben := TRUE . + +edit datei loeschen : + forget (edit ds); + edit ds := nilspace; + IF neue datei seit letztem mal AND save ds voll THEN + forget (save ds); + save ds voll := FALSE + END IF . + +veraenderungsstatus merken : + anzeigeversion := dateiversion; + anzeigedateien := anzahl dateien; + neues fenster := FALSE . + +END PROC zeilendeskriptor aktualisieren; + +PROC namen max (TEXT CONST satz, INT CONST von, bis) : + + feldnamenlaenge INCR length (satz) - length (satz); + (* damit Parameter benutzt *) + feldnamenlaenge := max (feldnamenlaenge, bis - von + 1) + +END PROC namen max; + +PROC rollen (INT CONST vektor) : + + erste zeile := erste zeile + vektor; + IF erste zeile < 1 THEN + erste zeile := 1 + ELIF erste zeile > letzte zeile THEN + erste zeile := max (letzte zeile, 1) + END IF; + namen ausgeben := TRUE . + +letzte zeile : + anzahl zeilen - laenge + 3 . + +END PROC rollen; + +PROC feldauswahl (TEXT CONST wahlvektor) : + + zeilendeskriptor aktualisieren; + feldnummern uebernehmen; + namen ausgeben := TRUE . + +feldnummern uebernehmen : + anzahl zeilen := length (wahlvektor); + INT VAR zeilennr; + FOR zeilennr FROM 1 UPTO anzahl zeilen REP + zeilen (zeilennr). feldnr := code (wahlvektor SUB zeilennr) + END REP; + erste zeile := 1 . + +END PROC feldauswahl; + + +(**************************** editfile ***********************************) + +INT VAR gelesene zeile; + +PROC edit file loeschen : + + type (edit ds, - 1); + edit file := sequential file (modify, edit ds); + edit info (edit file, -1); + to line (editfile, 1); + col (editfile, 1); + maxlinelength (edit file, 10000); + gelesene zeile := 1 + +END PROC edit file loeschen; + +. +noch zeile zu bearbeiten : + gelesene zeile <= anzahl zeilen . + +PROC naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) bearbeite) : + + zu bearbeitende zeilen bestimmen; + IF eof (editfile) THEN + bearbeite ("", feldnr) + ELIF mehrere zeilen THEN + zeilen verketten; + blanks abschneiden; + bearbeite (zeilenpuffer, feldnr) + ELIF blanks am ende THEN + read record (edit file, zeilenpuffer); + blanks abschneiden; + bearbeite (zeilenpuffer, feldnr); + down (edit file) + ELSE + exec (PROC (TEXT CONST, INT CONST) bearbeite, edit file, feldnr); + down (edit file) + END IF . + +zu bearbeitende zeilen bestimmen : + INT CONST + von := gelesene zeile, + feldnr := zeilen (von). feldnr; + REP + gelesene zeile INCR 1 + UNTIL gelesene zeile > anzahl zeilen COR neues feld END REP . + +neues feld : + zeilen (gelesene zeile). feldnr <> feldnr . + +mehrere zeilen : + gelesene zeile - von > 1 . + +zeilen verketten : + zeilenpuffer := ""; + REP + exec (PROC (TEXT CONST, INT CONST) verkette, + edit file, length (zeilenpuffer)); + down (edit file) + UNTIL eof (edit file) OR line no (edit file) = gelesene zeile END REP . + +blanks am ende : + INT CONST ende := len (edit file); + subtext (edit file, ende, ende) = blank . + +END PROC naechste zeile bearbeiten; + +PROC verkette (TEXT CONST edit zeile, INT CONST pufferlaenge) : + + IF pufferlaenge > 0 CAND (zeilenpuffer SUB pufferlaenge) <> blank + CAND (edit zeile SUB 1) <> blank THEN + zeilenpuffer CAT blank + END IF; + zeilenpuffer CAT edit zeile + +END PROC verkette; + +PROC blanks abschneiden : + + INT VAR ende := length (zeilenpuffer); + WHILE (zeilenpuffer SUB ende) = blank REP + ende DECR 1 + END REP; + zeilenpuffer := subtext (zeilenpuffer, 1, ende) + +END PROC blanks abschneiden; + + +(*************************** Funktionen **********************************) + + +BOOL VAR aus einfuegen; + +PROC einfuegen (PROC hilfe) : + + enable stop; + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + editieren (PROC hilfe); + satz einfuegen; + aus einfuegen := TRUE; + felder aendern + END IF + +END PROC einfuegen; + +PROC felder aendern : + + WHILE noch zeile zu bearbeiten REP + naechste zeile bearbeiten + (PROC (TEXT CONST, INT CONST) ein feld aendern) + END REP; + aenderungen eintragen + +END PROC felder aendern; + +PROC ein feld aendern (TEXT CONST inhalt, INT CONST feldnr) : + + IF NOT aus einfuegen COR inhalt <> niltext THEN + feld aendern (feldnr, inhalt) + END IF + +END PROC ein feld aendern; + +PROC aendern (PROC hilfe) : + + enable stop; + IF dateiende THEN + einfuegen (PROC hilfe) + ELSE + wirklich aendern + END IF . + +wirklich aendern : + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + bild aufbauen (namen ausgeben); + feldinhalte eintragen; + editieren (PROC hilfe); + aus einfuegen := FALSE; + felder aendern + END IF . + +feldinhalte eintragen : + kopierzeile := 1; + WHILE kopierzeile <= anzahl zeilen REP + feld bearbeiten (zeilen (kopierzeile). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) inhalt kopieren); + insert record (edit file); + write record (edit file, zeilenpuffer); + down (edit file); + kopierzeile INCR 1 + END REP; + to line (edit file, 1) . + +END PROC aendern; + +INT VAR kopierzeile; + +PROC inhalt kopieren (TEXT CONST satz, INT CONST von, bis) : + + zeilenpuffer := subtext (satz, feldanfang, feldende) . + +feldanfang : + von + zeilen (kopierzeile). anfang . + +feldende : + IF keine fortsetzung THEN + bis + ELSE + von + zeilen (kopierzeile + 1). anfang - 1 + END IF . + +keine fortsetzung : + kopierzeile = anzahl zeilen COR + zeilen (kopierzeile + 1). feldnr <> zeilen (kopierzeile). feldnr . + +END PROC inhalt kopieren; + +PROC suchen (PROC hilfe) : + + enable stop; + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + IF such version <> 0 THEN + altes suchmuster eintragen + END IF; + editieren (PROC hilfe); + suchbedingung einstellen + END IF . + +altes suchmuster eintragen : + kopierzeile := 1; + WHILE kopierzeile <= anzahl zeilen REP + insert record (edit file); + suchmusterzeile eintragen; + down (edit file); + kopierzeile INCR 1 + END REP; + to line (edit file, 1) . + +suchmusterzeile eintragen : + IF zeilen (kopierzeile). anfang = 0 THEN + suchbedingung lesen (zeilen (kopierzeile). feldnr, zeilenpuffer); + write record (edit file, zeilenpuffer) + END IF . + +suchbedingung einstellen : + suchbedingung loeschen; + WHILE noch zeile zu bearbeiten REP + naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) zeilenbedingung) + END REP . + +END PROC suchen; + +PROC zeilenbedingung (TEXT CONST zeile, INT CONST feldnr) : + + suchbedingung (feldnr, zeile) + +END PROC zeilenbedingung; + +PROC bild ausgeben (BOOL CONST datei veraendert) : + + enable stop; + zeilendeskriptor aktualisieren; + fensterzugriff anmelden; + IF datei veraendert OR namen ausgeben OR anderer satz THEN + bild aufbauen (namen ausgeben); + zuletzt angezeigter satz := satznummer; + letzte kombi := satzkombination; + einzelbild ausgeben (TRUE) + ELSE + ueberschrift ausgeben (TRUE) + END IF . + +anderer satz : + satznummer <> zuletzt angezeigter satz OR letzte kombi <> satzkombination . + +END PROC bild ausgeben; + + +(*************************** Bild aufbauen *******************************) + +INT VAR anfang; + +BOOL VAR fertig; + + +PROC bild aufbauen (BOOL CONST kuerzen erlaubt) : + + INT VAR + zeilennr := 1, + alte feldnr := 0; + fertig := TRUE; + WHILE zeilennr <= anzahl zeilen OR NOT fertig REP + eine zeile behandeln + END REP . + +eine zeile behandeln : + IF fertig CAND zeilen (zeilennr). feldnr = alte feldnr THEN + eventuell zusammenruecken + ELSE + IF altes feld beendet THEN + feldwechsel + END IF; + zeilen (zeilennr). anfang := anfang; + feld bearbeiten (zeilen (zeilennr). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) laenge bestimmen); + zeilennr INCR 1 + END IF . + +eventuell zusammenruecken : + IF kuerzen erlaubt THEN + zeile loeschen (zeilennr) + ELSE + zeilen (zeilennr). anfang := anfang; + zeilennr INCR 1 + END IF . + +altes feld beendet : + zeilennr > anzahl zeilen COR zeilen (zeilennr). feldnr <> alte feldnr . + +feldwechsel : + IF fertig THEN + neues feld anfangen + ELSE + zeile einfuegen (zeilennr); + zeilen (zeilennr). feldnr := alte feldnr + END IF . + +neues feld anfangen : + alte feldnr := zeilen (zeilennr). feldnr; + anfang := 0 . + +END PROC bild aufbauen; + +PROC laenge bestimmen (TEXT CONST satz, INT CONST von, bis) : + + INT CONST restlaenge := bis - von - anfang + 1; + IF restlaenge > inhaltsbreite - 2 THEN + anfang INCR inhaltsbreite - 2; + rueckwaerts blank suchen; + fertig := FALSE + ELSE + anfang INCR restlaenge; + fertig := TRUE + END IF . + +rueckwaerts blank suchen : + INT VAR stelle := von + anfang - 1; + IF trennung im wort AND blanks vorhanden THEN + WHILE (satz SUB stelle) <> blank REP + stelle DECR 1; anfang DECR 1 + END REP + END IF . + +trennung im wort : + (satz SUB stelle) <> blank . + +blanks vorhanden : + pos (satz, blank, stelle - inhaltsbreite, stelle - 1) > 0 . + +END PROC laenge bestimmen; + +PROC zeile einfuegen (INT CONST zeilennr) : + + INT VAR i; + FOR i FROM anzahl zeilen DOWNTO zeilennr REP + zeilen (i+1) := zeilen (i) + END REP; + anzahl zeilen INCR 1; + namen ausgeben := TRUE + +END PROC zeile einfuegen; + +PROC zeile loeschen (INT CONST zeilennr) : + + INT VAR i; + FOR i FROM zeilennr + 1 UPTO anzahl zeilen REP + zeilen (i-1) := zeilen (i) + END REP; + anzahl zeilen DECR 1; + namen ausgeben := TRUE + +END PROC zeile loeschen; + + +(************************** Editieren ************************************) + +INT VAR rueckkehrcode; + +TEXT VAR + zeilenrest, + zeile vorher, + zeile nachher, + quit zeichen := "", + quit durch; + +LET + hinweiszeile = #802# + ""15" Bild verschoben ! ESC 1 druecken ! "14""; + +LET + eudas res = ""3""10"19"11""12"q?hpg"; + +LET + oben = 1, + unten = 2, + eins = 3, + neun = 4, + rubin = 5, + rubout = 6, + edit ende = 7, + frage = 8, + abbruch = 9, + double = 10, + esc get = 11; + + +PROC editieren (PROC hilfe) : + + INT VAR alte zeilennr := erste zeile; + lernsequenz auf taste legen ("D", date); + REP + einzelbild ausgeben (FALSE); + file verlaengern; + erste und letzte zeile markieren; + file editieren; + nachbehandeln + UNTIL wirklich verlassen END REP; + to line (edit file, 1); + col (edit file, 1) . + +file verlaengern : + IF lines (edit file) < anzahl zeilen + 1 THEN + output (edit file); + line (editfile, anzahl zeilen - lines (editfile) + 2); + modify (edit file) + END IF . + +erste und letzte zeile markieren : + IF erste zeile <> 1 THEN + einsetzen (erste zeile - 1, zeile vorher) + END IF; + einsetzen (zeile nach bildschirm, zeile nachher); + to line (edit file, alte zeilennr) . + +zeile nach bildschirm : + min (anzahl zeilen + 1, erste zeile + laenge - 1) . + +file editieren : + open editor (groesster editor + 1, edit file, TRUE, + spalten anf + feldnamenlaenge + 3, zeilen anf, + inhaltsbreite, editlaenge); + edit (groesster editor, eudas res + quit zeichen, + PROC (TEXT CONST) eudas interpreter) . + +editlaenge : + min (anzahl zeilen - erste zeile + 2, laenge) . + +nachbehandeln : + alte zeilennr := line no (edit file); + hinweiszeilen entfernen; + SELECT rueckkehrcode OF + CASE oben : nach oben rollen + CASE unten : nach unten rollen + CASE eins : auf erste zeile + CASE neun : auf letzte zeile + CASE rubin : zeile umbrechen + CASE rubout : zeile entfernen + CASE frage : hilfe; namen ausgeben := TRUE + CASE abbruch : errorstop (niltext) + CASE double : in save ds kopieren + CASE esc get : aus save ds holen + END SELECT . + +hinweiszeilen entfernen : + INT CONST spalte := col (edit file); + col (edit file, 1); + IF erste zeile <> 1 THEN + entfernen (erste zeile - 1, zeile vorher) + END IF; + entfernen (zeile nach bildschirm, zeile nachher); + col (edit file, spalte) . + +nach oben rollen : + INT VAR abstand; + abstand := alte zeilennr - erste zeile; + rollen (-laenge + 1); + alte zeilennr := erste zeile + abstand . + +nach unten rollen : + abstand := alte zeilennr - erste zeile; + rollen (laenge - 1); + alte zeilennr := min (erste zeile + abstand, anzahl zeilen) . + +auf erste zeile : + rollen (-999); + alte zeilennr := 1 . + +auf letzte zeile : + abstand := alte zeilennr - erste zeile; + rollen (999); + alte zeilennr := min (erste zeile + abstand, anzahl zeilen) . + +zeile umbrechen : + to line (edit file, alte zeilennr); + aktuelle zeile aufsplitten; + zeile einfuegen (alte zeilennr) . + +aktuelle zeile aufsplitten : + read record (edit file, zeilenpuffer); + zeilenrest := subtext (zeilenpuffer, spalte); + zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1); + write record (edit file, zeilenpuffer); + down (edit file); + insert record (edit file); + write record (edit file, zeilenrest) . + +zeile entfernen : + to line (edit file, alte zeilennr); + IF spalte = 1 AND + (nicht letzte zeile CAND noch gleiche dahinter OR + nicht erste zeile CAND noch gleiche davor) THEN + ganz loeschen + ELSE + nur ueberschreiben + END IF . + +nicht letzte zeile : + alte zeilennr <> anzahl zeilen . + +noch gleiche dahinter : + zeilen (alte zeilennr + 1). feldnr = zeilen (alte zeilennr). feldnr . + +nicht erste zeile : + alte zeilennr <> 1 . + +noch gleiche davor : + zeilen (alte zeilennr - 1). feldnr = zeilen (alte zeilennr). feldnr . + +ganz loeschen : + delete record (edit file); + zeile loeschen (alte zeilennr) . + +nur ueberschreiben : + read record (edit file, zeilenpuffer); + zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1); + write record (edit file, zeilenpuffer) . + +in save ds kopieren : + forget (save ds); + save ds := edit ds; + save ds voll := TRUE . + +aus save ds holen : + IF save ds voll THEN + forget (edit ds); + edit ds := save ds; + edit file := sequential file (modify, edit ds) + END IF . + +wirklich verlassen : + rueckkehrcode = edit ende . + +END PROC editieren; + +PROC eudas interpreter (TEXT CONST zeichen) : + + enable stop; + set busy indicator; + rueckkehrcode := pos (eudas res, zeichen); + IF rueckkehrcode > 0 THEN + quit durch := zeichen; + quit + ELIF pos (quit zeichen, zeichen) > 0 THEN + rueckkehrcode := edit ende; + quit durch := zeichen; + quit + ELIF kommando auf taste (zeichen) <> niltext THEN + std kommando interpreter (zeichen) + ELSE + nichts neu + END IF + +END PROC eudas interpreter; + +PROC einsetzen (INT CONST zeilennr, TEXT VAR speicher) : + + to line (edit file, zeilennr); + read record (edit file, speicher); + write record (edit file, hinweiszeile) + +END PROC einsetzen; + +PROC entfernen (INT CONST zeilennr, TEXT CONST speicher) : + + to line (edit file, zeilennr); + IF eof (edit file) COR pos (edit file, hinweiszeile, 1) = 0 THEN + to line (edit file, 1); + down (edit file, hinweiszeile); + IF eof (edit file) THEN + to line (edit file, zeilennr); + insert record (edit file) + END IF + END IF; + write record (edit file, speicher) + +END PROC entfernen; + +PROC exit zeichen (TEXT CONST zeichenkette) : + + quit zeichen := zeichenkette + +END PROC exit zeichen; + +TEXT PROC exit durch : + + quit durch + +END PROC exit durch; + + +(****************************** Ausgabe **********************************) + +INT VAR ausgabezeile; + +LET + t ende = #803# + "ENDE.", + t such plus = #804# + "SUCH+", + t such minus = #805# + "SUCH-", + t mark plus = #806# + "MARK+", + t mark minus = #807# + "MARK-", + t feld = #808# + " Feld "14" ", + t satz = #809# + " Satz ", + t koppel = #810# + "< KOPPEL >"; + +LET + fuenf punkte = ".....", + sieben blanks = " "; + + +PROC einzelbild ausgeben (BOOL CONST auch inhalte) : + + INT VAR + bildschirmzeile := zeilen anf + 1, + aktuelles feld := 0; + INT CONST letzte ausgabezeile := erste zeile + laenge - 2; + ueberschrift ausgeben (auch inhalte); + ausgabezeile := erste zeile; + WHILE ausgabezeile <= letzte ausgabezeile REP + feldnamen ausgeben; + feldinhalt ausgeben; + evtl unterbrechung; + bildschirmzeile INCR 1; + ausgabezeile INCR 1 + END REP; + namen ausgeben := FALSE . + +feldnamen ausgeben : + IF namen ausgeben THEN + cursor (spalten anf, bildschirmzeile); + IF ausgabezeile <= anzahl zeilen THEN + namen tatsaechlich ausgeben + ELIF ausgabezeile = anzahl zeilen + 1 THEN + endebalken ausgeben + ELSE + bildschirmzeile loeschen + END IF + END IF . + +namen tatsaechlich ausgeben : + out (begin mark); + IF zeilen (ausgabezeile). feldnr = aktuelles feld THEN + feldnamenlaenge TIMESOUT blank + ELSE + aktuelles feld := zeilen (ausgabezeile). feldnr; + feldnamen bearbeiten (aktuelles feld, + PROC (TEXT CONST, INT CONST, INT CONST) randanzeige) + END IF; + out (blank end mark) . + +endebalken ausgeben : + out (begin mark); + breite - 4 TIMESOUT "."; + out (blank end mark blank) . + +bildschirmzeile loeschen : + IF bis zeilenende THEN + out (cleol) + ELSE + breite TIMESOUT blank + END IF . + +feldinhalt ausgeben : + IF auch inhalte AND ausgabezeile <= anzahl zeilen THEN + cursor (spalten anf + feldnamenlaenge + 3, bildschirmzeile); + feld bearbeiten (zeilen (ausgabezeile). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) feldteil ausgeben) + END IF . + +evtl unterbrechung : + IF NOT namen ausgeben THEN + TEXT CONST input := getcharety; + IF input <> niltext THEN + push (input); + IF pos (quit zeichen, input) > 0 THEN + zuletzt angezeigter satz := 0; + LEAVE einzelbild ausgeben + END IF + END IF + END IF . + +END PROC einzelbild ausgeben; + +PROC ueberschrift ausgeben (BOOL CONST auch inhalte) : + + satznummer bestimmen; + satznummer in ueberschrift; + cursor (spalten anf, zeilen anf); + IF NOT auch inhalte THEN + outsubtext (ueberschrift, 1, feldnamenlaenge + 3); + LEAVE ueberschrift ausgeben + END IF; + replace (ueberschrift, feldnamenlaenge + 7, auswahlzeichen); + replace (ueberschrift, feldnamenlaenge + 14, markzeichen); + out (ueberschrift); + cursor (spalten anf + breite - 5, zeilen anf); + out (text (erste zeile)) . + +satznummer bestimmen : + TEXT VAR satznr; + satznr := text (satznummer); + IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN + satznr CAT "-"; + satznr CAT text (satzkombination) + END IF . + +satznummer in ueberschrift : + replace (ueberschrift, 7, sieben blanks); + replace (ueberschrift, 7, satznr) . + +auswahlzeichen : + IF such version = 0 THEN + fuenf punkte + ELIF satz ausgewaehlt THEN + t such plus + ELSE + t such minus + END IF . + +markzeichen : + IF dateiende THEN + t ende + ELIF markierte saetze = 0 THEN + fuenf punkte + ELIF satz markiert THEN + t mark plus + ELSE + t mark minus + END IF . + +END PROC ueberschrift ausgeben; + +PROC randanzeige (TEXT CONST satz, INT CONST von, bis) : + + IF bis - von >= feldnamenlaenge THEN + outsubtext (satz, von, von + feldnamenlaenge - 1) + ELSE + outsubtext (satz, von, bis); + feldnamenlaenge - bis + von - 1 TIMESOUT blank + END IF + +END PROC randanzeige; + +PROC feldteil ausgeben (TEXT CONST satz, INT CONST von, bis) : + + INT VAR ende; + IF ausgabezeile = anzahl zeilen COR letzte feldzeile THEN + ende := bis + ELSE + ende := von + zeilen (ausgabezeile + 1). anfang - 1 + END IF; + outsubtext (satz, von + zeilen (ausgabezeile). anfang, ende); + IF bis zeilenende THEN + out (cleol) + ELSE + laenge bis zum rand TIMESOUT blank + END IF . + +letzte feldzeile : + zeilen (ausgabezeile + 1). feldnr <> zeilen (ausgabezeile). feldnr . + +laenge bis zum rand : + inhaltsbreite - ende + von + zeilen (ausgabezeile). anfang - 1 . + +END PROC feldteil ausgeben; + +PROC ueberschrift generieren : + + ueberschrift := text (t satz, feldnamenlaenge + 3); + ueberschrift CAT begin mark; + INT VAR i; + INT CONST punktlaenge := breite - length (ueberschrift) - 11; + FOR i FROM 1 UPTO punktlaenge REP + ueberschrift CAT "." + END REP; + ueberschrift CAT t feld; + dateiname in ueberschrift . + +dateiname in ueberschrift : + TEXT VAR dateiname; + IF auf koppeldatei THEN + dateiname := t koppel + ELSE + dateiname := eudas dateiname (1) + END IF; + dateiname := subtext (dateiname, 1, punktlaenge - 20); + dateiname CAT blank; + replace (ueberschrift, feldnamenlaenge + 21, blank); + replace (ueberschrift, feldnamenlaenge + 22, dateiname) . + +END PROC ueberschrift generieren; + + +END PACKET satzanzeige; + diff --git a/app/eudas/4.4/src/eudas.satzzugriffe b/app/eudas/4.4/src/eudas.satzzugriffe new file mode 100644 index 0000000..d3f53f1 --- /dev/null +++ b/app/eudas/4.4/src/eudas.satzzugriffe @@ -0,0 +1,271 @@ +PACKET eudas satzzugriffe + +(*************************************************************************) +(* *) +(* Feldstrukturierung von Texten *) +(* *) +(* Version 03 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 17.04.87 *) +(* *) +(*************************************************************************) + + DEFINES + + SATZ, + := , + satz initialisieren, + felderzahl, + feld lesen, + feld bearbeiten, + feld aendern, + feldindex : + + +LET + maximale felderzahl = 256, + zeigerlaenge = 2; + +LET + blank = " ", + niltext = ""; + +LET + illegale feldnummer = #101# + " ist keine Feldnummer"; + +TEXT VAR + raum fuer ein int := zeigerlaenge * blank; + + +(**************************** Typ SATZ ***********************************) + +TYPE SATZ = TEXT; + +OP := (SATZ VAR links, SATZ CONST rechts) : + + CONCR (links) := CONCR (rechts) + +END OP := ; + + +(************************ Satz initialisieren ****************************) + +PROC satz initialisieren (SATZ VAR satz) : + + satz initialisieren (satz, 0) + +END PROC satz initialisieren; + +PROC satz initialisieren (SATZ VAR satz, INT CONST felder) : + + replace (raum fuer ein int, 1, 2 * felder + 3); + INT VAR i; + CONCR (satz) := niltext; + FOR i FROM 1 UPTO felder + 1 REP + CONCR (satz) CAT raum fuer ein int + END REP + +END PROC satz initialisieren; + + +(*************************** Felderzahl **********************************) + +INT PROC felderzahl (SATZ CONST satz) : + + INT VAR letzter zeiger := (CONCR (satz) ISUB 1) DIV 2; + INT CONST satzende := CONCR (satz) ISUB letzter zeiger; + REP + letzter zeiger DECR 1 + UNTIL letzter zeiger <= 0 COR kein leeres feld END REP; + letzter zeiger . + +kein leeres feld : + (CONCR (satz) ISUB letzter zeiger) <> satzende . + +END PROC felderzahl; + + +(************************** Feld lesen ***********************************) + +PROC feld lesen (SATZ CONST satz, INT CONST feldnr, TEXT VAR inhalt) : + + feldgrenzen bestimmen (CONCR (satz), feldnr); + IF NOT is error THEN + inhalt := subtext (CONCR (satz), feldanfang, feldende) + END IF + +END PROC feld lesen; + +PROC feld bearbeiten (SATZ CONST satz, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + feldgrenzen bestimmen (CONCR (satz), feldnr); + IF NOT is error THEN + bearbeite (CONCR (satz), feldanfang, feldende) + END IF + +END PROC feld bearbeiten; + + +(************************ Feldgrenzen bestimmen **************************) + +INT VAR + feldanfang, + feldende; + +PROC feldgrenzen bestimmen (TEXT CONST satz, INT CONST feldnr) : + + IF illegales feld THEN + errorstop (text (feldnr) + illegale feldnummer) + ELIF vorhandenes feld THEN + feldanfang := satz ISUB feldnr; + feldende := (satz ISUB feldnr + 1) - 1 + ELSE + feldanfang := 1; feldende := 0 + END IF . + +illegales feld : + feldnr <= 0 OR feldnr > maximale felderzahl . + +vorhandenes feld : + feldnr + feldnr < (satz ISUB 1) - 1 . + +END PROC feldgrenzen bestimmen; + + +(*************************** Feld aendern ********************************) + +TEXT VAR puffer; + +PROC feld aendern (SATZ VAR satz, INT CONST feldnr, TEXT CONST inhalt) : + + INT VAR zeigerstelle; + INT CONST satzfelder := ((CONCR (satz) ISUB 1) - 2) DIV 2; + IF normales feld THEN + normal ersetzen + ELSE + errorstop (text (feldnr) + illegale feldnummer) + END IF . + +normales feld : + feldnr > 0 AND feldnr <= maximale felderzahl . + +normal ersetzen : + INT CONST fehlende zeiger := feldnr - satzfelder; + IF fehlende zeiger <= 0 THEN + vorhandenes feld ersetzen + ELIF inhalt <> niltext THEN + neues feld anfuegen + END IF . + +neues feld anfuegen : + INT CONST endezeiger := CONCR (satz) ISUB (satzfelder + 1); + puffer := subtext (CONCR (satz), erstes feld, endezeiger - 1); + CONCR (satz) := subtext (CONCR (satz), 1, satzfelder + satzfelder); + korrigiere zeiger (CONCR (satz), 1, satzfelder, platz fuer zeiger); + neue zeiger anfuegen; + endezeiger anfuegen; + CONCR (satz) CAT puffer; + CONCR (satz) CAT inhalt . + +platz fuer zeiger : + fehlende zeiger + fehlende zeiger . + +neue zeiger anfuegen : + INT CONST neuer zeiger := endezeiger + platz fuer zeiger; + FOR zeigerstelle FROM satzfelder + 1 UPTO feldnr REP + zeiger anfuegen (CONCR (satz), neuer zeiger) + END REP . + +endezeiger anfuegen : + zeiger anfuegen (CONCR (satz), neuer zeiger + length (inhalt)) . + +erstes feld: + CONCR (satz) ISUB 1 . + +vorhandenes feld ersetzen : + INT CONST + feldanfang := CONCR (satz) ISUB feldnr, + naechster feldanfang := CONCR (satz) ISUB (feldnr + 1); + IF feldanfang > length (CONCR (satz)) THEN + optimiere leerfelder + ELSE + ersetze beliebig + END IF . + +optimiere leerfelder : + korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1, + length (inhalt)); + CONCR (satz) CAT inhalt . + +ersetze beliebig : + puffer := subtext (CONCR (satz), naechster feldanfang); + CONCR (satz) := subtext (CONCR (satz), 1, feldanfang - 1); + korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1, + laengendifferenz); + CONCR (satz) CAT inhalt; + CONCR (satz) CAT puffer . + +laengendifferenz : + length (inhalt) - feldlaenge . + +feldlaenge : + naechster feldanfang - feldanfang . + +END PROC feld aendern; + +PROC zeiger anfuegen (TEXT VAR satz, INT CONST zeigerwert) : + + replace (raum fuer ein int, 1, zeigerwert); + satz CAT raum fuer ein int + +END PROC zeiger anfuegen; + +PROC korrigiere zeiger (TEXT VAR satz, INT CONST anfang, ende, differenz) : + + INT VAR zeigerstelle; + FOR zeigerstelle FROM anfang UPTO ende REP + replace (satz, zeigerstelle, alter zeiger + differenz) + END REP . + +alter zeiger : + satz ISUB zeigerstelle . + +END PROC korrigiere zeiger; + + +(*************************** 'feldindex' *********************************) + +INT PROC feldindex (SATZ CONST satz, TEXT CONST muster) : + + INT VAR + anfang := (CONCR (satz) ISUB 1) - 1, + zeigerstelle := 1; + + REP + anfang := pos (CONCR (satz), muster, anfang + 1); + IF anfang = 0 THEN + LEAVE feldindex WITH 0 + END IF; + durchsuche zeiger ob feldanfang + UNTIL zeiger zeigt auf anfang CAND naechster zeiger hinter ende END REP; + zeigerstelle . + +durchsuche zeiger ob feldanfang : + WHILE (CONCR (satz) ISUB zeigerstelle) < anfang REP + zeigerstelle INCR 1 + END REP . + +zeiger zeigt auf anfang : + (CONCR (satz) ISUB zeigerstelle) = anfang . + +naechster zeiger hinter ende : + (CONCR (satz) ISUB (zeigerstelle + 1)) = anfang + length (muster) . + +END PROC feldindex; + + +END PACKET eudas satzzugriffe; + diff --git a/app/eudas/4.4/src/eudas.steuerung b/app/eudas/4.4/src/eudas.steuerung new file mode 100644 index 0000000..817a8e7 --- /dev/null +++ b/app/eudas/4.4/src/eudas.steuerung @@ -0,0 +1,2761 @@ +PACKET eudas steuerung + +(*************************************************************************) +(* *) +(* Menuesteuerung von EUDAS *) +(* *) +(* Version 09 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 01.10.87 *) +(* *) +(*************************************************************************) + + DEFINES + + eudas, + + einzelsicherung, + suchen, + aendern, + einfuegen, + prueffehler editieren, + feldstruktur, + + dateiverwaltung, + archivverwaltung, + + edit, + dateinamen anfordern, + ausfuehrung, + einzelausfuehrung : + + +(**************************** Variablen ***********************************) + +LET + file typ = 1003, + eudas typ = 3243; + +LET + niltext = "", + blank = " ", + esc z = ""27"z", + cleop = ""4"", + cleol = ""5""; + + +FILE VAR test file; + +DATASPACE VAR test ds; + +INT VAR + belegter heap, + test version := dateiversion - 1; + +FENSTER VAR + ganz, + links, + rechts, + fuss; + +TEXT VAR + feldpuffer; + +fenster initialisieren (ganz); +fenster initialisieren (links); +fenster initialisieren (rechts); +fenster initialisieren (fuss); +fenstergroesse setzen (ganz, 1, 2, 79, 23); +fenstergroesse setzen (links, 1, 2, 15, 22); +fenstergroesse setzen (rechts, 16, 2, 64, 22); +fenstergroesse setzen (fuss, 1, 24, 79, 1); +dialogfenster (16, 2, 64, 22); +anzeigefenster (16, 2, 64, 23); +uebersichtsfenster (1, 2, 79, 23); + + +(*************************** EUDAS ***************************************) + +TEXT VAR + fusszeile; + +BOOL VAR + eudas schon aktiv := FALSE; + +LET + menue 1 = #1001# + "EUDAS.Öffnen", + menue 2 = #1002# + "EUDAS.Einzelsatz", + menue 3 = #1003# + "EUDAS.Gesamtdatei", + menue 4 = #1004# + "EUDAS.Drucken", + menue 5 = #1005# + "EUDAS.Dateien", + menue 6 = #1006# + "EUDAS.Archiv"; + +LET + kein rekursiver aufruf = #1007# + "EUDAS kann nicht unter EUDAS aufgerufen werden", + suchmuster eingeben = #1008# + "Suchbedingung einstellen", + alle saetze drucken = #1009# + "Alle Saetze drucken", + alle markierten saetze drucken = #1010# + "Alle markierten Satze drucken", + einzelsatz drucken = #1011# + "Aktuellen Satz drucken", + uebersicht wiederholen = #1012# + "Mit neuer Auswahl noch einmal", + akt datei = #1013# + "Akt.Datei: ", + datum doppelpunkt = #1014# + " Datum: "; + + +PROC version ausgeben : + + cursor (30, 6); + out ("EEEEE U U DDDD A SSSS"); + cursor (30, 7); + out ("E U U D D A A S"); + cursor (30, 8); + out ("EEE U U D D AAAAA SSS"); + cursor (30, 9); + out ("E U U D D A A S"); + cursor (30, 10); + out ("EEEEE UUU DDDD A A SSSS"); + cursor (30, 12); + out ("Version 4.4"); + cursor (30, 13); + out ("Stand: 01.10.87"); + cursor (30, 15); + out ("(C) COPYRIGHT:"); + cursor (30, 16); + out ("Thomas Berlage"); + cursor (30, 17); + out ("Software-Systeme") + +END PROC version ausgeben; + +PROC eudas : + + IF aktueller editor > 0 THEN + eudas kurzabfrage + ELIF eudas schon aktiv THEN + errorstop (kein rekursiver aufruf) + ELSE + eudas aufrufen + END IF . + +eudas aufrufen : + page; bildschirm neu; + version ausgeben; + belegter heap := heap size; + fusszeile aufbauen; + disable stop; + eudas schon aktiv := TRUE; + menue anbieten (ROW 6 TEXT : (menue 1, menue 2, menue 3, + menue 4, menue 5, menue 6), + links, TRUE, + PROC (INT CONST, INT CONST) eudas interpreter); + eudas schon aktiv := FALSE; + enable stop; + auf sicherung ueberpruefen; + page; bildschirm neu + +END PROC eudas; + +PROC eudas kurzabfrage : + + TEXT VAR gewaehlte feldnamen; + bild frei; + auf sicherung ueberpruefen; + IF nicht alle gesichert THEN + LEAVE eudas kurzabfrage + END IF; + oeffnen im menue (FALSE); + auf satz (1); + feldauswahl fuer uebersicht (gewaehlte feldnamen); + REP + ggf suchmuster eingeben; + uebersicht (gewaehlte feldnamen, PROC uebersicht hilfe); + bild frei; + saetze drucken + UNTIL nicht noch einmal END REP; + dateien loeschen (FALSE) . + +nicht alle gesichert : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF inhalt veraendert (datei nr) THEN + LEAVE nicht alle gesichert WITH TRUE + END IF + END REP; + FALSE . + +ggf suchmuster eingeben : + IF ja (suchmuster eingeben, "JA/Suchmuster") THEN + suchen; alles neu + END IF . + +saetze drucken : + IF markierte saetze = 0 CAND alle drucken THEN + dateinamen anfordern (name des druckmusters); + einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ); + ELIF markierte saetze > 0 CAND alle markierten drucken THEN + dateinamen anfordern (name des druckmusters); + einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ); + markierungen loeschen + ELIF einzelsatz THEN + markierungen loeschen; markierung aendern; + dateinamen anfordern (name des druckmusters); + einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ); + markierungen loeschen + END IF . + +alle drucken : + ja (alle saetze drucken, "JA/alle Satze") . + +alle markierten drucken : + ja (alle markierten saetze drucken, "JA/alle markierten") . + +einzelsatz : + ja (einzelsatz drucken, "JA/Einzelsatz drucken") . + +nicht noch einmal : + NOT ja (uebersicht wiederholen, "JA/noch einmal") . + +END PROC eudas kurzabfrage; + +PROC bild frei : + + bildschirm neu; + cursor (1, 1); + out (cleop); + cursor (15, 1); + 23 TIMESOUT (""10":"8"") + +END PROC bild frei; + +PROC drucke uebersicht (TEXT CONST dateiname) : + + bild frei fuer uebersetzung; + disable stop; + drucke (dateiname); + uebersetzungsfehler behandeln; + bild frei + +END PROC drucke uebersicht; + +PROC eudas interpreter (INT CONST menuenr, wahl nr) : + + enable stop; + SELECT menuenr OF + CASE 0 : waehlbarkeit setzen + CASE 1 : oeffnen interpreter (wahl nr) + CASE 2 : anzeigen interpreter (wahl nr) + CASE 3 : bearbeiten interpreter (wahl nr) + CASE 4 : drucken interpreter (wahl nr) + CASE 5 : dateiverwaltung (wahl nr) + CASE 6 : archivverwaltung (wahl nr) + END SELECT . + +waehlbarkeit setzen : + IF anzahl dateien = 0 THEN + oeffnen sperre (FALSE); + aendern sperre (FALSE) + ELIF NOT aendern erlaubt THEN + aendern sperre (FALSE) + END IF; + ketten koppeln sperre; + waehlbar (6, 6, ziel ist manager); + waehlbar (6, 9, NOT ziel ist manager); + IF single user THEN + waehlbar (1, 8, FALSE); (* Manager *) + waehlbar (6, 7, FALSE) (* Zielarchiv *) + END IF . + +single user : + FALSE . + +END PROC eudas interpreter; + +PROC oeffnen sperre (BOOL CONST wie) : + + INT VAR i; + waehlbar (1, 4, wie); + waehlbar (1, 5, wie); + waehlbar (1, 7, wie); + FOR i FROM 1 UPTO 11 REP + waehlbar (2, i, wie) + END REP; + waehlbar (3, 1, wie); + waehlbar (3, 4, wie); + waehlbar (3, 6, wie); + waehlbar (4, 1, wie) + +END PROC oeffnen sperre; + +PROC ketten koppeln sperre : + + BOOL VAR wie := anzahl dateien = 1 AND aendern erlaubt; + waehlbar (1, 6, wie); + waehlbar (3, 5, wie); + wie := anzahl dateien > 0 AND anzahl dateien < 10 AND NOT auf koppeldatei; + waehlbar (1, 2, wie); + waehlbar (1, 3, wie) + +END PROC ketten koppeln sperre; + +PROC aendern sperre (BOOL CONST wie) : + + INT VAR i; + FOR i FROM 7 UPTO 10 REP + waehlbar (2, i, wie) + END REP; + waehlbar (3, 2, wie); + waehlbar (3, 3, wie) + +END PROC aendern sperre; + +PROC fusszeile aufbauen : + + fenster veraendert (fuss); + fusszeile := ""6""23""0""; + fusszeile CAT akt datei; + IF anzahl dateien > 0 THEN + fusszeile CAT """"; + fusszeile CAT eudas dateiname (1); + fusszeile CAT """" + END IF; + IF anzahl dateien > 1 THEN + fusszeile CAT " .. " + END IF; + fusszeile CAT ""5""6""23""; + fusszeile CAT code (79 - length (date) - length (datum doppelpunkt)); + fusszeile CAT datum doppelpunkt; + fusszeile CAT date + +END PROC fusszeile aufbauen; + +PROC fusszeile ausgeben (TEXT CONST prompt, inhalt) : + + BOOL VAR fuss veraendert; + fensterzugriff (fuss, fuss veraendert); + IF fuss veraendert THEN + out (fusszeile); + cursor (35, 24); + out (prompt); + IF inhalt <> niltext THEN + out (""""); outsubtext (inhalt, 1, 22 - length (prompt)); out (""" ") + END IF + END IF + +END PROC fusszeile ausgeben; + + +(**************************** Menue 'Oeffnen' *****************************) + +THESAURUS VAR zusaetzliche namen := empty thesaurus; + +BOOL VAR + nach aendern fragen, + multi user manager eingestellt := FALSE; + +TASK VAR multi user manager; + +TEXT VAR + manager taskname := niltext, + herkunftszeichen := niltext; + +LET + p manager = #1015# + " Manager: ", + keine sicherung noetig = #1017# + "Keine Sicherung noetig.", + arbeitskopien loeschen = #1018# + "Interne Arbeitskopien loeschen", + t arbeitskopie = #1019# + "Arbeitskopie ", + t unveraendert = #1020# + " unveraendert.", + t veraendert = #1021# + " veraendert! Sichern", + alte version ueberschreiben = #1022# + "Alte Version ueberschreiben", + unter dem namen = #1023# + "Sondern unter dem Namen:", + ueberschreiben = #1024# + " ueberschreiben", + sortierung wiederherstellen = #1025# + "Datei wieder sortieren", + t notizen ansehen = #1026# + "Notizen", + name task = #1027# + "Name Managertask:", + task existiert nicht = #1028# + "Task existiert nicht !", + wollen sie etwas veraendern = #1029# + "Wollen Sie etwas veraendern (eine Arbeitskopie anlegen)", + markierungen geloescht = #1030# + "Alle Markierungen gelöscht.", + t pruefbedingungen = #1032# + "Pruefbedingungen", + felder aendern = #1033# + "Feldnamen oder Feldtypen aendern", + t feldnamen anfuegen = #1034# + "Feldnamen anfuegen", + neuer feldname = #1035# + "Neuer Feldname:", + neuer typ = #1036# + "Neuer Typ (TEXT,DIN,ZAHL,DATUM):", + neue feldnamen eingeben = #1037# + "Neue Feldnamen", + id text = #1038# + "TEXT", + id din = #1039# + "DIN", + id zahl = #1040# + "ZAHL", + id datum = #1041# + "DATUM", + alte feldreihenfolge aendern = #1042# + "Alte Feldreihenfolge aendern", + speicherengpass = #1043# + ""7"ACHTUNG: System voll, Dateien loeschen!"; + + +PROC oeffnen interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : auf geschlossene datei pruefen + CASE 1 : neue datei oeffnen + CASE 2 : datei ketten + CASE 3 : datei koppeln + CASE 4 : aktuelle datei sichern + CASE 5 : notizen editieren + CASE 6 : feldstruktur aendern + CASE 7 : pruefbedingungen aendern + CASE 8 : multi user manager einstellen + OTHERWISE ggf dialogfenster loeschen + END SELECT; + fusszeile ausgeben (p manager, manager taskname); + storage kontrollieren; + heap kontrollieren . + +auf geschlossene datei pruefen : + IF anzahl dateien = 0 THEN + eudas interpreter (0, 0) + END IF . + +neue datei oeffnen : + auf sicherung ueberpruefen; + oeffnen im menue (TRUE); + push (2) . + +datei ketten : + disable stop; + manager pre; + ausfuehrung (PROC (TEXT CONST) ketten, eudas typ); + manager post; + enable stop; + ketten koppeln sperre . + +datei koppeln : + disable stop; + manager pre; + ausfuehrung (PROC (TEXT CONST) koppeln, eudas typ); + manager post; + enable stop; + ketten koppeln sperre . + +aktuelle datei sichern : + IF aendern erlaubt THEN + einzeldateien abfragen + ELSE + dialog; out (keine sicherung noetig); + dateien aus manager loeschen + END IF; + sperre setzen . + +einzeldateien abfragen : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + einzelsicherung (datei nr) + END REP; + IF ja (arbeitskopien loeschen, "JA/Dateien loeschen") THEN + dateien aus manager zuruecksichern; + dateien loeschen (TRUE) + END IF . + +sperre setzen : + IF anzahl dateien = 0 THEN + oeffnen sperre (FALSE); + aendern sperre (FALSE) + END IF; + ketten koppeln sperre; + fusszeile aufbauen . + +dateien aus manager loeschen : + INT CONST vorhandene dateien := anzahl dateien; + dateien loeschen (FALSE); + FOR datei nr FROM 1 UPTO vorhandene dateien REP + IF manager herkunft (datei nr) THEN + loeschen (eudas dateiname (datei nr)) + END IF + END REP . + +notizen editieren : + notizen ansehen; + dialogfenster loeschen . + +feldstruktur aendern : + zugriff (PROC (EUDAT VAR) feldstruktur) . + +pruefbedingungen aendern : + pruefbedingungen; + dialogfenster loeschen . + +multi user manager einstellen : + manager taskname := ""; + fenster veraendert (fuss); + editget (name task, manager taskname, "", "GET/multi task"); + IF manager taskname = "" THEN + multi user manager eingestellt := FALSE + ELIF exists (/manager taskname) THEN + multi user manager := task (manager taskname); + multi user manager eingestellt := TRUE + ELSE + multi user manager eingestellt := FALSE; + manager taskname := ""; + errorstop (task existiert nicht) + END IF . + +heap kontrollieren : + IF heap size - belegter heap > 4 THEN + collect heap garbage; + belegter heap := heap size + END IF . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen; + fenster veraendert (fuss); + LEAVE oeffnen interpreter + END IF . + +END PROC oeffnen interpreter; + +PROC auf sicherung ueberpruefen : + + BOOL VAR notwendig := FALSE; + IF aendern erlaubt THEN + wirklich pruefen + END IF; + IF notwendig THEN dialog (* Leerzeile *) END IF . + +wirklich pruefen : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF inhalt veraendert (datei nr) THEN + einzelsicherung (datei nr); + notwendig := TRUE; + ggf last param korrigieren + END IF + END REP . + +ggf last param korrigieren : + IF datei nr = 1 CAND std = eudas dateiname (1) THEN + last param (niltext) + END IF . + +END PROC auf sicherung ueberpruefen; + +PROC einzelsicherung (INT CONST datei nr) : + + frage zusammenbauen; + IF inhalt veraendert (datei nr) THEN + IF ja (frage, "JA/sichere") THEN + sicherung durchfuehren + END IF + ELSE + dialog; out (frage) + END IF . + +frage zusammenbauen : + TEXT VAR frage := t arbeitskopie; + frage CAT textdarstellung (eudas dateiname (datei nr)); + IF inhalt veraendert (datei nr) THEN + frage CAT t veraendert + ELSE + frage CAT t unveraendert + END IF . + +sicherung durchfuehren : + TEXT VAR name := eudas dateiname (datei nr); + IF ja (alte version ueberschreiben, "JA/alte version") THEN + forget (name, quiet) + ELIF manager herkunft (datei nr) THEN + errorstop (niltext) + ELSE + neuen namen erfragen + END IF; + sichere (datei nr, name); + eventuell sortierung wiederherstellen . + +neuen namen erfragen : + edit get (unter dem namen, name, "", "GET/Sicherungsname"); + IF exists (name) THEN + eventuell ueberschreiben + END IF . + +eventuell ueberschreiben : + IF ja (textdarstellung (name) + ueberschreiben, "JA/ueber") THEN + forget (name, quiet) + ELSE + einzelsicherung (datei nr); + LEAVE einzelsicherung + END IF . + +eventuell sortierung wiederherstellen : + EUDAT VAR eudat; + oeffne (eudat, name); + IF war sortiert CAND soll sortiert werden THEN + bitte warten; + sortiere (eudat) + END IF . + +war sortiert : + sortierreihenfolge (eudat) <> niltext CAND unsortierte saetze (eudat) > 0 . + +soll sortiert werden : + ja (sortierung wiederherstellen, "JA/Sicherungssortierung") . + +END PROC einzelsicherung; + +PROC oeffnen im menue (BOOL CONST aendern fragen) : + + IF aendern erlaubt THEN + dateien aus manager zuruecksichern + END IF; + dateien loeschen (TRUE); + oeffnen sperre (FALSE); + aendern sperre (FALSE); + forget (test ds); + disable stop; + manager pre; + nach aendern fragen := aendern fragen; + einzelausfuehrung (PROC (TEXT CONST) oeffnen, eudas typ); + manager post; + ketten koppeln sperre; + enable stop; + IF anzahl dateien > 0 THEN + oeffnen sperre (TRUE); + aendern sperre (aendern erlaubt) + END IF + +END PROC oeffnen im menue; + +PROC manager pre : + + IF multi user manager eingestellt THEN + zusaetzliche namen := ALL multi user manager + END IF + +END PROC manager pre; + +PROC manager post : + + zusaetzliche namen := empty thesaurus; + fusszeile aufbauen + +END PROC manager post; + +PROC dateien aus manager zuruecksichern : + + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF manager herkunft (datei nr) THEN + save oder free an manager + END IF + END REP . + +save oder free an manager : + IF in manager ueberschreiben THEN + disable stop; + set command dialogue false; + save (eudas dateiname (datei nr), multi user manager); + reset command dialogue; + enable stop; + forget (eudas dateiname (datei nr), quiet) + ELSE + free (eudas dateiname (datei nr), multi user manager) + END IF; + herkunft eintragen (datei nr, FALSE) . + +in manager ueberschreiben : + exists (eudas dateiname (datei nr)) . + +END PROC dateien aus manager zuruecksichern; + +PROC multi datei loeschen : + + IF manager herkunft (anzahl dateien) AND aendern erlaubt THEN + forget (eudas dateiname (anzahl dateien), quiet) + END IF + +END PROC multi datei loeschen; + +PROC oeffnen (TEXT CONST dateiname) : + + BOOL VAR auch aendern; + eventuell neu einrichten; + oeffne (dateiname, auch aendern); + multi datei loeschen . + +eventuell neu einrichten : + IF datei existiert nicht AND nach aendern fragen THEN + frage ob einrichten (dateiname); + EUDAT VAR eudat; + oeffne (eudat, dateiname); + feldstruktur (eudat); + auch aendern := TRUE + ELSE + auch aendern := + nach aendern fragen CAND ja (wollen sie etwas veraendern, "JA/oeffne"); + aus manager besorgen (dateiname, auch aendern) + END IF . + +datei existiert nicht : + NOT exists (dateiname) AND NOT (zusaetzliche namen CONTAINS dateiname) . + +END PROC oeffnen; + +PROC ketten (TEXT CONST dateiname) : + + aus manager besorgen (dateiname, aendern erlaubt); + kette (dateiname); + multi datei loeschen + +END PROC ketten; + +PROC koppeln (TEXT CONST dateiname) : + + aus manager besorgen (dateiname, aendern erlaubt); + kopple (dateiname); + multi datei loeschen + +END PROC koppeln; + +PROC aus manager besorgen (TEXT CONST dateiname, BOOL CONST mit lock) : + + BOOL VAR herkunft := FALSE; + IF multi user manager eingestellt THEN + manager abfragen + END IF; + herkunft eintragen (anzahl dateien + 1, herkunft) . + +manager abfragen : + IF (zusaetzliche namen CONTAINS dateiname) CAND + (NOT exists (dateiname) COR eigene datei ueberschreiben) THEN + IF mit lock THEN + lock (dateiname, multi user manager) + END IF; + forget (dateiname, quiet); + fetch (dateiname, multi user manager); + herkunft := TRUE + END IF . + +eigene datei ueberschreiben : + ja (textdarstellung (dateiname) + t im system ueberschreiben, "JA/fetch") . + +END PROC aus manager besorgen; + +PROC herkunft eintragen (INT CONST dateiindex, BOOL CONST herkunft) : + + WHILE length (herkunftszeichen) < dateiindex REP + herkunftszeichen CAT blank + END REP; + replace (herkunftszeichen, dateiindex, entsprechendes zeichen) . + +entsprechendes zeichen : + IF herkunft THEN + "-" + ELSE + blank + END IF . + +END PROC herkunft eintragen; + +BOOL PROC manager herkunft (INT CONST dateiindex) : + + IF length (herkunftszeichen) < dateiindex THEN + FALSE + ELSE + (herkunftszeichen SUB dateiindex) <> blank + END IF + +END PROC manager herkunft; + +PROC notizen ansehen : + + notizen lesen (3, feldpuffer); + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + disable stop; + headline (f, t notizen ansehen); + notizen anbieten (f, feldpuffer, ganz, "EDIT/Notizen"); + forget (ds); + enable stop; + IF aendern erlaubt THEN + notizen aendern (3, feldpuffer) + END IF + +END PROC notizen ansehen; + +PROC notizen anbieten (FILE VAR f, TEXT VAR puffer, + FENSTER CONST edit fenster, TEXT CONST hilfsname) : + + LET trennzeichen = "#-#"; + enable stop; + notizen in datei; + datei editieren; + notizen aus datei . + +notizen in datei : + INT VAR + von := 1, + bis; + REP + bis := pos (puffer, trennzeichen, von); + IF bis = 0 THEN + putline (f, subtext (puffer, von)) + ELSE + putline (f, subtext (puffer, von, bis - 1)) + END IF; + von := bis + 3 + UNTIL bis = 0 OR von > length (puffer) END REP . + +datei editieren : + modify (f); + edit (f, edit fenster, hilfsname, TRUE) . + +notizen aus datei : + TEXT VAR zeile; + puffer := niltext; + input (f); + WHILE NOT eof (f) REP + getline (f, zeile); + blank entfernen; + puffer CAT zeile; + puffer CAT trennzeichen + END REP . + +blank entfernen : + IF (zeile SUB length (zeile)) = blank THEN + zeile := subtext (zeile, 1, length (zeile) - 1) + END IF . + +END PROC notizen anbieten; + +PROC feldstruktur (EUDAT VAR eudat) : + + SATZ VAR satz; + feldnamen lesen (eudat, satz); + IF feldnamen anfuegen THEN + feldnamen editieren + END IF; + IF ja (felder aendern, "JA/Feldaendern") THEN + auswahl zu aendernder felder + END IF . + +feldnamen anfuegen : + IF felderzahl (satz) > 0 THEN + ja (t feldnamen anfuegen, "JA/feldnamen") + ELSE + TRUE + END IF . + +feldnamen editieren : + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + disable stop; + feldnamen anbieten (f, satz); + forget (ds); + enable stop; + feldnamen aendern (eudat, satz) . + +auswahl zu aendernder felder : + feldtypen dazuschreiben; + auswahl anbieten ("EUDAS-Felder", rechts, "AUSWAHL/Felder", + PROC (TEXT VAR, INT CONST) aus sammel); + INT VAR feldnr := 1; + WHILE wahl (feldnr) > 0 REP + ein feld aendern; + feldnr INCR 1 + END REP; + feldnamen aendern (eudat, satz) . + +feldtypen dazuschreiben : + satz initialisieren (sammel); + FOR feldnr FROM 1 UPTO felderzahl (satz) REP + feld lesen (satz, feldnr, feldpuffer); + feld aendern (sammel, feldnr, info + textdarstellung (feldpuffer)) + END REP . + +info : + "(" + typtext (feldinfo (eudat, feldnr)) + ") " . + +ein feld aendern : + TEXT VAR feldname; + feld lesen (satz, wahl (feldnr), feldname); + editget (neuer feldname, feldname, "", "GET/feldname"); + feld aendern (satz, wahl (feldnr), feldname); + TEXT VAR typ := typtext (feldinfo (eudat, wahl (feldnr))); + REP + editget (neuer typ, typ, "", "GET/feldtyp") + UNTIL texttyp (typ) >= -1 END REP; + feldinfo (eudat, wahl (feldnr), texttyp (typ)) . + +END PROC feldstruktur; + +PROC pruefbedingungen : + + enable stop; + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + headline (f, t pruefbedingungen); + notizen lesen (1, feldpuffer); + disable stop; + notizen anbieten (f, feldpuffer, ganz, "EDIT/Pruefbed"); + forget (ds); + enable stop; + IF aendern erlaubt THEN + notizen aendern (1, feldpuffer) + END IF . + +END PROC pruefbedingungen; + +PROC feldnamen anbieten (FILE VAR f, SATZ VAR satz) : + + enable stop; + neue namen editieren; + neue namen zurueckschreiben . + +neue namen editieren : + modify (f); + headline (f, neue feldnamen eingeben); + edit (f, rechts, "EDIT/Feldnamen", TRUE) . + +neue namen zurueckschreiben : + INT VAR feldnr := felderzahl (satz); + input (f); + WHILE NOT eof (f) REP + getline (f, feldpuffer); + blank entfernen; + feldnr INCR 1; + feld aendern (satz, feldnr, feldpuffer) + END REP . + +blank entfernen : + IF (feldpuffer SUB length (feldpuffer)) = blank THEN + feldpuffer := subtext (feldpuffer, 1, length (feldpuffer) - 1) + END IF . + +END PROC feldnamen anbieten; + +TEXT PROC typtext (INT CONST typ) : + + SELECT typ + 1 OF + CASE 0 : id text + CASE 1 : id din + CASE 2 : id zahl + CASE 3 : id datum + OTHERWISE niltext + END SELECT + +END PROC typtext; + +INT PROC texttyp (TEXT CONST t) : + + IF t = id text THEN -1 + ELIF t = id din THEN 0 + ELIF t = id zahl THEN 1 + ELIF t = id datum THEN 2 + ELSE -2 + END IF + +END PROC texttyp; + +PROC storage kontrollieren : + + INT VAR size, used; + storage (size, used); + IF used > size THEN + neuer dialog; dialog; + out (speicherengpass) + END IF + +END PROC storage kontrollieren; + + +(************************* Menue 'Einzelsatz' *****************************) + +BOOL VAR + satz leer, + umgeschaltet aus einfuegen := FALSE, + umgeschaltet aus aendern := FALSE; + +LET + aendern status = #1044# +"SATZ AENDERN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + einfuegen status = #1045# +"SATZ EINFUEGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + suchen status = #1046# +"SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + umschalten auf = #1047# + "Umschalten auf Koppeldatei ", + koppelfelder uebernehmen = #1048# + "Koppelfelder uebernehmen", + ungueltige satznummer = #1049# + "Ungueltige Satznummer", + neue satznummer = #1050# + "Neue Satznummer:", + t bitte warten = #1051# + " Bitte warten.. ", + wzk = #1052# + "wzK", + wz = #1053# + "wz"; + +LET + blanks unten links = ""6""23""0" :", + blanks unten ganz = ""6""23""0" :"5""; + + +PROC anzeigen interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : anzeige einschalten + CASE 1 : einen satz weiter + CASE 2 : einen satz zurueck + CASE 3 : direkt auf satz + CASE 4 : saetze auswaehlen + CASE 5 : auswahlbedingung loeschen + CASE 6 : aktuelle markierung aendern + CASE 7 : neuen satz einfuegen + CASE 8 : aktuellen satz aendern + CASE 9 : einzelsatz tragen + CASE 10: einzelsatz holen + CASE 11: felder auswaehlen + CASE 12: esc oben + CASE 13: esc unten + CASE 14: esc 1 + CASE 15: esc 9 + CASE 16: esc k + OTHERWISE anzeige update + END SELECT; + storage kontrollieren . + +anzeige einschalten : + exit zeichen (wz) . + +einen satz weiter : + bitte warten; + weiter (2); + bild ausgeben (FALSE) . + +einen satz zurueck : + bitte warten; + zurueck (2); + bild ausgeben (FALSE) . + +saetze auswaehlen : + suchen; + bild ausgeben (TRUE) . + +auswahlbedingung loeschen : + suchbedingung loeschen; + bild ausgeben (FALSE) . + +direkt auf satz : + TEXT VAR nr := niltext; + fusszeile ganz loeschen; + editget (neue satznummer, nr, "", "GET/auf satz"); + INT CONST ziel := int (nr); + IF nr = niltext THEN + bild ausgeben (FALSE) + ELIF last conversion ok THEN + auf satz (ziel); + bild ausgeben (FALSE) + ELSE + errorstop (ungueltige satznummer) + END IF . + +neuen satz einfuegen : + einfuegen; + bild ausgeben (TRUE) . + +aktuellen satz aendern : + aendern; + bild ausgeben (TRUE) . + +aktuelle markierung aendern : + markierung aendern; + bild ausgeben (FALSE) . + +einzelsatz tragen : + last param darf nicht geoeffnet sein; + fusszeile ganz loeschen; + dateinamen anfordern (name der zieldatei); + einzelausfuehrung (PROC (TEXT CONST) trage satz und frage, eudas typ); + bild ausgeben (TRUE) . + +einzelsatz holen : + last param darf nicht geoeffnet sein; + fusszeile ganz loeschen; + dateinamen anfordern (name der quelldatei); + einzelausfuehrung (PROC (TEXT CONST) hole satz, eudas typ); + bild ausgeben (TRUE) . + +felder auswaehlen : + TEXT VAR wahlvektor; + fusszeile ganz loeschen; + felder waehlen lassen (wahlvektor); + IF wahlvektor <> niltext THEN + feldauswahl (wahlvektor) + END IF; + bild ausgeben (TRUE) . + +esc oben : + rollcursor; + rollen (-23); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc unten : + rollcursor; + rollen (23); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc 1 : + rollcursor; + rollen (-9999); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc 9 : + rollcursor; + rollen (9999); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc k : + IF auf koppeldatei THEN + zurueckschalten + ELSE + auf koppeldatei umschalten + END IF; + IF anzahl dateien > 0 THEN + bild ausgeben (TRUE) + END IF . + +zurueckschalten : + IF (umgeschaltet aus aendern OR umgeschaltet aus einfuegen) THEN + fragen ob koppelfelder uebernehmen; + wieder in alte operation + ELSE + auf koppeldatei (0) + END IF; + ketten koppeln sperre . + +fragen ob koppelfelder uebernehmen : + fusszeile ganz loeschen; + IF NOT dateiende CAND ja (koppelfelder uebernehmen, "JA/uebernehmen") THEN + auf koppeldatei (1) + ELSE + auf koppeldatei (0) + END IF . + +wieder in alte operation : + umgeschaltet aus einfuegen := FALSE; + IF umgeschaltet aus aendern THEN + umgeschaltet aus aendern := FALSE; + aendern + ELSE + einfuegen intern (TRUE) + END IF . + +anzeige update : + IF wahl nr = -2 THEN + IF anzahl dateien > 0 THEN + fusszeile links loeschen; + bild ausgeben (FALSE) + ELSE + fusszeile ganz loeschen + END IF + ELSE + dialogfenster loeschen; + fenster veraendert (fuss) + END IF . + +fusszeile links loeschen : + out (blanks unten links) . + +fusszeile ganz loeschen : + out (blanks unten ganz) . + +END PROC anzeigen interpreter; + +PROC suchen : + + disable stop; + exit zeichen (""); + status anzeigen (suchen status); + suchen (PROC suchen hilfe); + exit zeichen (wz) + +END PROC suchen; + +PROC suchen hilfe : + + hilfe anbieten ("EDIT/Suchen", rechts) + +END PROC suchen hilfe; + +PROC bitte warten : + + status anzeigen (t bitte warten) + +END PROC bitte warten; + +PROC einfuegen : + + einfuegen intern (FALSE) + +END PROC einfuegen; + +PROC einfuegen intern (BOOL CONST nach umschalten) : + + BOOL VAR weiter aendern := nach umschalten; + exit zeichen setzen; + REP + status anzeigen (einfuegen status); + IF weiter aendern THEN + aendern (PROC einfuegen hilfe); + weiter aendern := FALSE + ELSE + einfuegen (PROC einfuegen hilfe) + END IF; + satz untersuchen; + exit zeichen bei einfuegen behandeln + END REP . + +exit zeichen bei einfuegen behandeln : + SELECT pos (wzk, exit durch) OF + CASE 0 : IF satz leer THEN + satz loeschen + END IF; + LEAVE einfuegen intern + CASE 1 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; weiter (2) + END IF + CASE 2 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; zurueck (2) + END IF + CASE 3 : auf koppeldatei umschalten; + IF auf koppeldatei THEN + umgeschaltet aus einfuegen := TRUE; + LEAVE einfuegen intern + END IF; + weiter aendern := TRUE + END SELECT . + +END PROC einfuegen intern; + +PROC einfuegen hilfe : + + hilfe anbieten ("EDIT/Einfuegen", rechts) + +END PROC einfuegen hilfe; + +PROC exit zeichen setzen : + + IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN + exit zeichen (wzk) + ELSE + exit zeichen (wz) + END IF + +END PROC exit zeichen setzen; + +PROC aendern : + + exit zeichen setzen; + kommando auf taste legen ("F", "prueffehler editieren"); + REP + status anzeigen (aendern status); + aendern (PROC aendern hilfe); + satz untersuchen; + exit zeichen bei aendern behandeln + END REP . + +exit zeichen bei aendern behandeln : + SELECT pos (wzk, exit durch) OF + CASE 0 : IF satz leer THEN + satz loeschen + END IF; + LEAVE aendern + CASE 1 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; weiter (2) + END IF + CASE 2 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; zurueck (2) + END IF + CASE 3 : auf koppeldatei umschalten; + IF auf koppeldatei THEN + umgeschaltet aus aendern := TRUE; + LEAVE aendern + END IF + END SELECT . + +END PROC aendern; + +PROC aendern hilfe : + + hilfe anbieten ("EDIT/Aendern", rechts) + +END PROC aendern hilfe; + +PROC prueffehler editieren : + + IF test version = datei version THEN + modify (test file); + edit (test file) + END IF + +END PROC prueffehler editieren; + +PROC auf koppeldatei umschalten : + + INT VAR datei nr := folgedatei (0); + WHILE datei nr > 0 REP + out (blanks unten ganz); + IF auf diese datei schalten THEN + auf koppeldatei (datei nr); + ketten koppeln sperre; + LEAVE auf koppeldatei umschalten + END IF; + datei nr := folgedatei (datei nr) + END REP . + +auf diese datei schalten : + ja (umschalten auf + textdarstellung (eudas dateiname (datei nr)), + "JA/umschalten") . + +END PROC auf koppeldatei umschalten; + +PROC zeilenrest ausgeben (TEXT CONST zeile, INT CONST dummy) : + + outsubtext (zeile, anfang); out (cleol) . + +anfang : + pos (zeile, blank, 6) + 1 + dummy - dummy . + +END PROC zeilenrest ausgeben; + +PROC satz untersuchen : + + feld bearbeiten (1, PROC (TEXT CONST, INT CONST, INT CONST) ob leer) + +END PROC satz untersuchen; + +PROC ob leer (TEXT CONST satz, INT CONST von, bis) : + + satz leer := von < 3 OR von > length (satz) + bis - bis + +END PROC ob leer; + +PROC rollcursor : + + cursor (15, 24) + +END PROC rollcursor; + +PROC trage satz und frage (TEXT CONST dateiname) : + + IF exists (dateiname) THEN + teste auf offen + ELSE + frage ob einrichten (dateiname) + END IF; + bitte warten; + trage satz (dateiname) . + +teste auf offen : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF . + +END PROC trage satz und frage; + +PROC felder waehlen lassen (TEXT VAR wahlvektor) : + + auswahl anbieten ("EUDAS-Anzeigefelder", rechts, "AUSWAHL/Anzeigefelder", + PROC (TEXT VAR, INT CONST) gib namen); + wahlvektor := niltext; + INT VAR nr := 1; + WHILE wahl (nr) > 0 REP + wahlvektor CAT code (wahl (nr)); + nr INCR 1 + END REP + +END PROC felder waehlen lassen; + + +(************************* Menue 'Gesamtdatei' ***************************) + +LET + felder auswaehlen = #1054# + "Angezeigte Felder auswaehlen", + aufsteigend sortieren = #1055# + " aufsteigend sortieren"; + +DATASPACE VAR + kopier ds; + + +PROC bearbeiten interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 1 : saetze kopieren + CASE 2 : saetze tragen + CASE 3 : nach vorschrift aendern + CASE 4 : uebersicht ausgeben + CASE 5 : datei sortieren + CASE 6 : alle markierungen loeschen + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +saetze tragen : + last param darf nicht geoeffnet sein; + dateinamen anfordern (name der zieldatei); + einzelausfuehrung (PROC (TEXT CONST) trage saetze, eudas typ) . + +saetze kopieren : + last param darf nicht geoeffnet sein; + dateinamen anfordern (name der zieldatei); + einzelausfuehrung (PROC (TEXT CONST) kopiere saetze, eudas typ); + dialogfenster loeschen; + fusszeile ausgeben ("", "") . + +nach vorschrift aendern : + dateinamen anfordern (name der verarbeitungsvorschrift); + ausfuehrung (PROC (TEXT CONST) verarbeite mit edit, file typ); + dialogfenster loeschen; + fusszeile ausgeben ("", "") . + +uebersicht ausgeben : + TEXT VAR uebersichtsauswahl; + feldauswahl fuer uebersicht (uebersichtsauswahl); + uebersicht (uebersichtsauswahl, PROC uebersicht hilfe); + dialogfenster loeschen; + fusszeile ausgeben ("", "") . + +datei sortieren : + zugriff (PROC (EUDAT VAR) einzelsortiere) . + +alle markierungen loeschen : + markierungen loeschen; + dialog; out (markierungen geloescht) . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen; + fenster veraendert (fuss) + ELIF wahl nr = -2 THEN + fusszeile ausgeben ("", "") + END IF . + +END PROC bearbeiten interpreter; + +PROC last param darf nicht geoeffnet sein : + + IF index der arbeitskopie (std) <> 0 THEN + last param (niltext) + END IF + +END PROC last param darf nicht geoeffnet sein; + +PROC trage saetze (TEXT CONST dateiname) : + + BOOL VAR mit test; + IF exists (dateiname) THEN + teste auf offen; + frage ob testen + ELSE + frage ob einrichten (dateiname); + mit test := FALSE + END IF; + BOOL CONST mit sortieren := ja (sortierfrage, "JA/sortieren"); + bitte warten; + ggf datei initialisieren; + trage (dateiname, test file, mit test); + fehlerzahl ausgeben; + IF mit sortieren THEN + EUDAT VAR eudat; + oeffne (eudat, dateiname); + sortiere (eudat) + END IF . + +teste auf offen : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF . + +frage ob testen : + mit test := ja (pruefbedingungen testen, "JA/testen") . + +ggf datei initialisieren : + IF mit test THEN + forget (test ds); + test ds := nilspace; + test file := sequential file (output, test ds); + test version := datei version + ELSE + forget (test ds); + test version := datei version - 1 + END IF . + +fehlerzahl ausgeben : + IF mit test CAND lines (test file) > 0 THEN + dialog; put (lines (test file)); + put (prueffehler festgestellt) + END IF . + +END PROC trage saetze; + +PROC verarbeite mit edit (TEXT CONST dateiname) : + + IF NOT exists (dateiname) THEN + edit unten (dateiname, "EDIT/Verarbeite") + END IF; + bild frei fuer uebersetzung; + FILE VAR f := sequential file (input, dateiname); + disable stop; + verarbeite (f); + uebersetzungsfehler behandeln . + +END PROC verarbeite mit edit; + +PROC feldauswahl fuer uebersicht (TEXT VAR uebersichtsauswahl) : + + uebersichtsauswahl := niltext; + IF ja (felder auswaehlen, "JA/Ub.Felder") THEN + felder waehlen lassen (uebersichtsauswahl) + END IF + +END PROC feldauswahl fuer uebersicht; + +PROC uebersicht hilfe : + + hilfe anbieten ("UEBERSICHT", ganz) + +END PROC uebersicht hilfe; + +PROC kopiere saetze (TEXT CONST dateiname) : + + disable stop; + kopier ds := nilspace; + kopiere saetze intern (dateiname); + forget (kopier ds) + +END PROC kopiere saetze; + +PROC kopiere saetze intern (TEXT CONST dateiname) : + + TEXT VAR mustername := ""; + FILE VAR f; + EUDAT VAR eudat; + BOOL VAR mit sortieren := FALSE; + + enable stop; + IF exists (dateiname) THEN + teste auf offen und sortieren + ELSE + frage ob einrichten (dateiname) + END IF; + editget (name kopiermuster, mustername, "", "GET/kopiermuster"); + IF exists (mustername) THEN + f := sequential file (input, mustername) + ELSE + ggf kopiermuster einrichten; + std kopiermuster (dateiname, f) + END IF; + modify (f); + wirklich kopieren; + ggf sortieren . + +teste auf offen und sortieren : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF; + oeffne (eudat, dateiname); + IF sortierreihenfolge (eudat) <> niltext THEN + mit sortieren := ja (sortierfrage, "JA/sortieren") + END IF . + +ggf kopiermuster einrichten : + IF mustername = niltext THEN + f := sequential file (output, kopier ds) + ELSE + frage ob einrichten (mustername); + f := sequential file (output, mustername) + END IF . + +wirklich kopieren : + edit (f, ganz, "EDIT/Kopiermuster", TRUE); + bild frei fuer uebersetzung; + kopiere (dateiname, f) . + +ggf sortieren : + IF mit sortieren THEN + oeffne (eudat, dateiname); + sortiere (eudat) + END IF . + +END PROC kopiere saetze intern; + +INT PROC index der arbeitskopie (TEXT CONST dateiname) : + + INT VAR dateinr; + FOR dateinr FROM 1 UPTO anzahl dateien REP + IF eudas dateiname (dateinr) = dateiname THEN + LEAVE index der arbeitskopie WITH dateinr + END IF + END REP; + 0 + +END PROC index der arbeitskopie; + +PROC edit unten (TEXT CONST dateiname, hilfe) : + + IF NOT exists (dateiname) THEN + frage ob einrichten (dateiname) + END IF; + FILE VAR f := sequential file (modify, dateiname); + edit (f, ganz, hilfe, TRUE) + +END PROC edit unten; + +PROC bild frei fuer uebersetzung : + + bitte warten; + cursor (1, 2); + out (cl eop); + bildschirm neu + +END PROC bild frei fuer uebersetzung; + +PROC einzelsortiere (EUDAT VAR eudat) : + + TEXT VAR reihenfolge := sortierreihenfolge (eudat); + IF reihenfolge = niltext COR alte reihenfolge aendern THEN + sortierreihenfolge aendern; + bitte warten; + sortiere (eudat, reihenfolge) + ELSE + bitte warten; + sortiere (eudat) + END IF . + +alte reihenfolge aendern : + ja (alte feldreihenfolge aendern, "JA/Sortierfelder") . + +sortierreihenfolge aendern : + feldnamen lesen (eudat, sammel); + auswahl anbieten ("EUDAS-Sortierfelder", rechts, "AUSWAHL/Sortierfelder", + PROC (TEXT VAR, INT CONST) aus sammel); + INT VAR feldnr := 1; + reihenfolge := niltext; + WHILE wahl (feldnr) <> 0 REP + reihenfolge CAT code (wahl (feldnr)); + nach richtung fragen; + feldnr INCR 1 + END REP . + +nach richtung fragen : + feld lesen (sammel, wahl (feldnr), feldpuffer); + IF ja (textdarstellung (feldpuffer) + aufsteigend sortieren, + "JA/Sortierrichtung") THEN + reihenfolge CAT "+" + ELSE + reihenfolge CAT "-" + END IF . + +END PROC einzelsortiere; + +PROC gib namen (TEXT VAR name, INT CONST nr) : + + IF nr <= anzahl felder THEN + feldnamen lesen (nr, name) + ELSE + name := niltext + END IF + +END PROC gib namen; + + +(************************* Menue 'Drucken' ********************************) + +LET + direkt ausgabe = #1056# + "Ausgabe automatisch zum Drucker", + in bestimmte datei = #1057# + "Ausgabe in bestimmte Datei", + name druckzieldatei = #1058# + "Name Ausgabedatei:", + sortierfrage = #1059# + "Zieldatei anschliessend sortieren", + pruefbedingungen testen = #1060# + "Pruefbedingungen testen", + prueffehler festgestellt = #1061# + "Prueffehler festgestellt", + nicht in offene datei = #1062# + "Zieldatei darf nicht geoeffnet sein", + name kopiermuster = #1063# + "Name Kopiermuster (RET=Std):"; + +LET + z form = #1093# + " zeilenweise formatieren", + s form = #1094# + " seitenweise formatieren"; + +BOOL VAR + zeilen automatisch := FALSE, + seiten automatisch := FALSE; + + +PROC drucken interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 1 : nach muster drucken + CASE 2 : ausgaberichtung umschalten + CASE 3 : musterdatei aendern + CASE 4 : textdatei drucken + CASE 5 : nachbearbeiten + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +nach muster drucken : + dateinamen anfordern (name des druckmusters); + ausfuehrung (PROC (TEXT CONST) drucke mit edit, file typ); + dialogfenster loeschen; + fusszeile ausgeben ("", "") . + +ausgaberichtung umschalten : + direkt drucken (ja (direktausgabe, "JA/direkt drucken")); + IF NOT direkt drucken CAND ja (in bestimmte datei, "JA/Druckdatei") THEN + TEXT VAR dateiname := niltext; + editget (name druckzieldatei, dateiname, "", "GET/Druckdatei"); + IF dateiname <> niltext THEN + druckdatei (dateiname) + END IF + END IF . + +musterdatei aendern : + ausfuehrung (PROC (TEXT CONST) muster edit, file typ); + dialogfenster loeschen; + fusszeile ausgeben ("", "") . + +textdatei drucken : + ausfuehrung (PROC (TEXT CONST) print, file typ) . + +nachbearbeiten : + ausfuehrung (PROC (TEXT CONST) nachbearbeitung, file typ); + dialogfenster loeschen; + fusszeile ausgeben ("", "") . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen; + fenster veraendert (fuss) + ELIF wahl nr = -2 THEN + fusszeile ausgeben ("", "") + END IF . + +END PROC drucken interpreter; + +PROC uebersetzungsfehler behandeln : + + IF uebersetzungsfehler THEN + clear error + END IF . + +uebersetzungsfehler : + is error CAND errormessage = niltext . + +END PROC uebersetzungsfehler behandeln; + +PROC drucke mit edit (TEXT CONST dateiname) : + + IF NOT exists (dateiname) THEN + muster edit (dateiname) + END IF; + bild frei fuer uebersetzung; + disable stop; + drucke (dateiname); + uebersetzungsfehler behandeln + +END PROC drucke mit edit; + +PROC muster edit (TEXT CONST dateiname) : + + edit unten (dateiname, "EDIT/Druckmuster") + +END PROC muster edit; + +PROC print (TEXT CONST dateiname) : + + do ("print (" + textdarstellung (dateiname) + ")") + +END PROC print; + +PROC nachbearbeitung (TEXT CONST dateiname) : + + IF ja (textdarstellung (dateiname) + z form, "JA/zeilenform") THEN + zeilen formatieren + END IF; + IF ja (textdarstellung (dateiname) + s form, "JA/seitenform") THEN + seiten formatieren + END IF . + +zeilen formatieren : + IF zeilen automatisch THEN + autoform (dateiname) + ELSE + lineform (dateiname) + END IF; + page; + bildschirm neu . + +seiten formatieren : + IF seiten automatisch THEN + autopageform (dateiname) + ELSE + pageform (dateiname) + END IF; + bildschirm neu . + +END PROC nachbearbeitung; + +PROC formatieren automatisch (BOOL CONST za, sa) : + + zeilen automatisch := za; + seiten automatisch := sa + +END PROC formatieren automatisch; + + +(********************** Menue 'Dateien' ***********************************) + +TEXT VAR arbeitsbereich; + +LET + p task = #1064# + " Task: ", + t neuer name = #1065# + "Neuer Name:", + t zieldatei = #1066# + "Zieldatei:", + t belegt = #1067# + " belegt ", + t kb = #1068# + "KB.", + t existiert nicht = #1069# + " existiert nicht.", + t loeschen = #1070# + " im dieser Task loeschen", + t neu einrichten = #1071# + " neu einrichten"; + + +PROC dateiverwaltung (INT CONST wahl nr) : + + enable stop; + SELECT wahl nr OF + CASE 0 : arbeitsbereich bestimmen + CASE 1 : dateiuebersicht + CASE 2 : datei loeschen + CASE 3 : datei umbenennen + CASE 4 : datei kopieren + CASE 5 : speicherbelegung datei + CASE 6 : datei reorganisieren + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +arbeitsbereich bestimmen : + arbeitsbereich := name (myself) . + +datei reorganisieren : + ausfuehrung (PROC (TEXT CONST) aufraeumen, 0) . + +datei umbenennen : + ausfuehrung (PROC (TEXT CONST) umbenennen, 0) . + +datei loeschen : + ausfuehrung (PROC (TEXT CONST) loeschen, 0) . + +dateiuebersicht : + disable stop; + DATASPACE VAR list ds := nilspace; + FILE VAR f := sequential file (output, list ds); + list (f); + IF NOT is error THEN + edit (f, rechts, "SHOW/Uebersicht", FALSE) + END IF; + forget (list ds); + enable stop; + tastenpuffer loeschen . + +datei kopieren : + ausfuehrung (PROC (TEXT CONST) ds kopieren, 0) . + +speicherbelegung datei : + ausfuehrung (PROC (TEXT CONST) speicherbelegung, 0) . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen; + fenster veraendert (fuss) + ELIF wahl nr = -2 THEN + fusszeile ausgeben (p task, arbeitsbereich) + END IF . + +END PROC dateiverwaltung; + +PROC tastenpuffer loeschen : + + WHILE getcharety <> niltext REP END REP + +END PROC tastenpuffer loeschen; + +PROC aufraeumen (TEXT CONST dateiname) : + + IF type (old (dateiname)) = eudas typ THEN + reorganisiere (dateiname) + ELSE + reorganize (dateiname) + END IF + +END PROC aufraeumen; + +PROC umbenennen (TEXT CONST dateiname) : + + TEXT VAR neuer name := dateiname; + IF exists (dateiname) THEN + editget (t neuer name, neuer name, "", "GET/rename") + END IF; + rename (dateiname, neuer name) + +END PROC umbenennen; + +PROC loeschen (TEXT CONST dateiname) : + + IF offene datei THEN + errorstop (nicht in offene datei) + ELIF exists (dateiname) CAND frage bejaht THEN + forget (dateiname, quiet) + END IF . + +offene datei : + index der arbeitskopie (dateiname) <> 0 . + +frage bejaht : + ja (textdarstellung (dateiname) + t loeschen, "JA/forget") . + +END PROC loeschen; + +PROC ds kopieren (TEXT CONST dateiname) : + + TEXT VAR zieldatei := niltext; + editget (t zieldatei, zieldatei, "", "GET/copy"); + copy (dateiname, zieldatei) + +END PROC ds kopieren; + +PROC speicherbelegung (TEXT CONST dateiname) : + + dialog; + out (textdarstellung (dateiname)); + IF exists (dateiname) THEN + out (t belegt); + put (ds pages (old (dateiname)) DIV 2); + out (t kb) + ELSE + out (t existiert nicht) + END IF + +END PROC speicherbelegung; + + +(*********************** Menue 'Archiv' ***********************************) + +TEXT VAR + letzter archivname := niltext, + zielarchiv := "ARCHIVE"; + +INT VAR zielstation := 0; + +THESAURUS VAR archivinhalt; + +BOOL VAR + archivzugriff, + ziel ist manager := TRUE, + dialogue state; + +LET + p zielarchiv = #1072# + " Ziel: ", + archiv heisst = #1073# + "Archiv heisst ", + name des archivs = #1074# + "Name des Archivs:", + name zielarchiv = #1075# + "Name Zielarchiv:", + nr zielstation = #1076# + "Nr. der Zielstation (od. RETURN):", + ist ziel archivmanager = #1077# + "Ist das Zielarchiv ein Archivmanager", + diskette formatieren = #1078# + "Archivdiskette vorher formatieren", + neuer archivname = #1079# + "Neuer Archivname:", + t im system ueberschreiben = #1080# + " im System ueberschreiben", + t auf archiv loeschen = #1081# + " auf Archiv loeschen", + t archiv = #1082# + "Archiv ", + t ueberschreiben = #1083# + " ueberschreiben", + frage archiv initialisieren = #1084# + "Archiv initialisieren", + t auf archiv ueberschreiben = #1085# + " auf Archiv ueberschreiben"; + +LET + t passwort = #1095# + "Passwort: ", + passwortwiederholung falsch = #1096# + "Passwort stimmt nicht mit der ersten Eingabe überein", + bitte passwort wiederholen = #1097# + "Passwort zur Kontrolle bitte nochmal eingeben.", + passwort loeschen = #1098# + "Passwort loeschen", + falsche stationsnr = #1099# + "Unzlaessige Stationsnummer", + task ist kein manager = #1100# + "Angegebene Task ist kein Manager"; + + +PROC archivverwaltung (INT CONST wahl nr) : + + enable stop; + SELECT wahl nr OF + CASE 0 : eintritt + CASE 1 : archivuebersicht + CASE 2 : uebersicht drucken + CASE 3 : datei vom archiv holen + CASE 4 : datei auf archiv sichern + CASE 5 : auf archiv loeschen + CASE 6 : archiv initialisieren + CASE 7 : zielarchiv einstellen + CASE 8 : passwort einstellen + CASE 9 : reservieren + OTHERWISE verlassen + END SELECT; + storage kontrollieren . + +eintritt : + archivzugriff := FALSE . + +datei auf archiv sichern : + IF ziel ist manager THEN + archivnamen holen + END IF; + bitte warten; + archivinhalt := ALL eudas archiv; + ausfuehrung (PROC (TEXT CONST) archivieren, 0) . + +datei vom archiv holen : + disable stop; + archiv anmelden; + bitte warten; + archivinhalt := ALL eudas archiv; + IF falscher name THEN archivinhalt := ALL eudas archiv END IF; + enable stop; + auf archiv (PROC (TEXT CONST) holen) . + +auf archiv loeschen : + IF ziel ist manager THEN + archivnamen holen + END IF; + bitte warten; + archivinhalt := ALL eudas archiv; + auf archiv (PROC (TEXT CONST) auf archiv loeschen) . + +archivuebersicht : + archiv anmelden; + disable stop; + bitte warten; + DATASPACE VAR list ds := nilspace; + f :=sequential file (output, list ds); + list (f, eudas archiv); + IF falscher name THEN list (f, eudas archiv) END IF; + IF NOT is error THEN + modify (f); to line (f, 1); + write record (f, headline (f)); + headline (f, niltext); + edit (f, rechts, "SHOW/Uebersicht", FALSE) + END IF; + forget (list ds); + tastenpuffer loeschen; + enable stop . + +uebersicht drucken : + archiv anmelden; + namen generieren; + FILE VAR f := sequential file (output, list name); + disable stop; + bitte warten; + list (f, eudas archiv); + IF falscher name THEN list (f, eudas archiv) END IF; + enable stop; + modify (f); + insert record (f); + write record (f, headline (f)); + print (list name); + forget (list name, quiet) . + +namen generieren : + INT VAR i := 0; + TEXT VAR list name; + REP + i INCR 1; + list name := "Archivliste " + text (i) + UNTIL NOT exists (list name) END REP . + +archiv initialisieren : + archiv anmelden; + IF ja (diskette formatieren, "JA/format") THEN + archiv formatieren + ELIF benanntes archiv THEN + IF loeschen verneint THEN LEAVE archiv initialisieren END IF + ELSE + IF initialisieren verneint THEN LEAVE archiv initialisieren END IF + END IF; + neuen namen erfragen; + tatsaechlich initialisieren . + +archiv formatieren : + bitte warten; + disable stop; + set command dialogue false; + format (eudas archiv); + reset command dialogue; + enable stop . + +benanntes archiv : + reserve ("", eudas archiv); + bitte warten; + disable stop; + archivinhalt := ALL eudas archiv; + BOOL CONST ergebnis := falscher name; + clear error; + enable stop; + ergebnis . + +loeschen verneint : + NOT ja (t archiv + textdarstellung (letzter archivname) + t ueberschreiben, + "JA/archiv loeschen") . + +initialisieren verneint : + NOT ja (frage archiv initialisieren, "JA/archiv init") . + +neuen namen erfragen : + editget (neuer archivname, letzter archivname, "", "GET/Archivname"); + reserve (letzter archivname, eudas archiv) . + +tatsaechlich initialisieren : + bitte warten; + disable stop; + set command dialogue false; + clear (eudas archiv); + reset command dialogue . + +zielarchiv einstellen : + TEXT VAR zieltaskname := zielarchiv; + IF archivzugriff THEN + release (eudas archiv); archivzugriff := FALSE + END IF; + editget (name zielarchiv, zieltaskname, "", "GET/Zielarchiv"); + IF zieltaskname = niltext THEN + LEAVE zielarchiv einstellen + END IF; + zielstation einlesen; + ziel ist manager := ja (ist ziel archivmanager, "JA/Zielmanager"); + werte uebertragen; + waehlbar (6, 6, ziel ist manager); + waehlbar (6, 9, NOT ziel ist manager); + bildschirm neu; + fusszeile ausgeben (p zielarchiv, stationsnr + zielarchiv) . + +zielstation einlesen : + TEXT VAR rechner := text (station (myself)); + IF station (myself) <> 0 THEN + editget (nr zielstation, rechner, "", "GET/Zielstation") + END IF . + +werte uebertragen : + zielstation := int (rechner); + IF NOT last conversion ok THEN + errorstop (falsche stationsnr) + END IF; + zielarchiv := zieltaskname; + teste auf manager (eudas archiv) . + +stationsnr : + IF zielstation = 0 THEN + niltext + ELSE + text (zielstation) + "/" + END IF . + +reservieren : + TEXT VAR parameter := niltext; + editget (name des archivs, parameter, "", "GET/Archivname"); + reserve (parameter, eudas archiv); + archivzugriff := TRUE . + +verlassen : + IF wahl nr = -1 THEN + IF archivzugriff THEN + release (eudas archiv) + END IF; + dialogfenster loeschen; + fenster veraendert (fuss) + ELIF wahl nr = -2 THEN + fusszeile ausgeben (p zielarchiv, stationsnr + zielarchiv) + END IF . + +END PROC archivverwaltung; + +TASK PROC eudas archiv : + + IF zielstation = 0 THEN + task (zielarchiv) + ELSE + zielstation / zielarchiv + END IF + +END PROC eudas archiv; + +PROC teste auf manager (TASK CONST t) : + + INT VAR i; + IF station (t) = station (myself) THEN + FOR i FROM 1 UPTO 5 REP + IF status (t) = 2 OR status (t) = 6 THEN + LEAVE teste auf manager + END IF; + pause (10) + END REP; + errorstop (task ist kein manager) + END IF + +END PROC teste auf manager; + +PROC archivnamen holen : + + TEXT VAR neuer archivname := letzter archivname; + editget (name des archivs, neuer archivname, "", "GET/Archivname"); + IF NOT archivzugriff OR neuer archivname <> letzter archivname THEN + reserve (neuer archivname, eudas archiv); + archivzugriff := TRUE + END IF; + letzter archivname := neuer archivname + +END PROC archivnamen holen; + +PROC archiv anmelden : + + IF NOT archivzugriff AND ziel ist manager THEN + reserve (letzter archivname, eudas archiv); + archivzugriff := TRUE + END IF + +END PROC archiv anmelden; + +BOOL PROC falscher name : + + IF ziel ist manager AND is error THEN + TEXT CONST meldung := errormessage; + IF subtext (meldung, 1, 14) = archiv heisst CAND + subtext (meldung, 16, 20) <> "?????" THEN + clear error; + nochmal anmelden; + LEAVE falscher name WITH TRUE + END IF + END IF; + FALSE . + +nochmal anmelden : + letzter archivname := subtext (meldung, 16, length (meldung) - 1); + reserve (letzter archivname, eudas archiv) . + +END PROC falscher name; + +PROC archivieren (TEXT CONST dateiname) : + + disable stop; + IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv ueberschreiben THEN + vorher eventuell sichern; + bitte warten; + set command dialogue false; + save (dateiname, eudas archiv); + reset command dialogue + END IF . + +auf archiv ueberschreiben : + ja (textdarstellung (dateiname) + t auf archiv ueberschreiben, "JA/save") . + +vorher eventuell sichern : + INT CONST nr := index der arbeitskopie (dateiname); + IF nr > 0 CAND aendern erlaubt CAND inhalt veraendert (nr) THEN + einzelsicherung (nr) + END IF . + +END PROC archivieren; + +PROC holen (TEXT CONST dateiname) : + + disable stop; + IF NOT exists (dateiname) COR eigene datei ueberschreiben THEN + bitte warten; + set command dialogue false; + fetch (dateiname, eudas archiv); + reset command dialogue + END IF . + +eigene datei ueberschreiben : + ja (textdarstellung (dateiname) + t im system ueberschreiben, "JA/fetch") . + +END PROC holen; + +PROC auf archiv loeschen (TEXT CONST dateiname) : + + disable stop; + IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv loeschen THEN + bitte warten; + set command dialogue false; + erase (dateiname, eudas archiv); + reset command dialogue + END IF . + +auf archiv loeschen : + ja (textdarstellung (dateiname) + t auf archiv loeschen, "JA/erase") . + +END PROC auf archiv loeschen; + +PROC set command dialogue false : + + dialogue state := command dialogue; + command dialogue (FALSE) + +END PROC set command dialogue false; + +PROC reset command dialogue : + + command dialogue (dialogue state) + +END PROC reset command dialogue; + +PROC auf archiv (PROC (TEXT CONST) operation) : + + TEXT VAR dateiname := niltext; + editget (name der datei, dateiname, "z", "GET/Dateiname"); + IF dateiname = esc z THEN + uebersicht zeigen + ELSE + last param (dateiname); + operation (dateiname) + END IF . + +uebersicht zeigen : + dateinamen sammeln (archivinhalt, 0); + auswahl anbieten ("EUDAS-Archivauswahl", rechts, "AUSWAHL/Archiv", + PROC (TEXT VAR, INT CONST) als text); + operation ausfuehren (PROC (TEXT CONST) operation) . + +END PROC auf archiv; + +PROC passwort einstellen : + + BOUND ROW 2 TEXT VAR pw; + DATASPACE VAR ds := nilspace; + pw := ds; + disable stop; + passwort holen (pw (1)); + IF pw (1) = niltext THEN + fragen ob loeschen + ELSE + doppelt eingeben + END IF; + forget (ds) . + +fragen ob loeschen : + IF ja (passwort loeschen, "JA/pw loeschen") THEN + dialog; dialog; + enter password (niltext) + END IF . + +doppelt eingeben : + dialog; out (bitte passwort wiederholen); + passwort holen (pw (2)); + IF pw (1) <> pw (2) THEN + errorstop (passwortwiederholung falsch) + ELSE + dialog; dialog; + enter password (pw (1)) + END IF . + +END PROC passwort einstellen; + +PROC passwort holen (TEXT VAR wort) : + + enable stop; + dialog; out (t passwort); + get secret line (wort) + +END PROC passwort holen; + + +(******************** Parameter-Auswahl ***********************************) + +SATZ VAR sammel; + +LET + name der datei = #1086# + "Name der Datei:", + name der zieldatei = #1087# + "Name der Zieldatei:", + name der verarbeitungsvorschrift = #1088# + "Name der Verarbeitungsvorschrift:", + name des druckmusters = #1089# + "Name des Druckmusters:", + name der quelldatei = #1090# + "Name der Quelldatei:"; + +LET + keine datei zur auswahl = #1101# + "Keine Datei zur Auswahl vorhanden."; + +TEXT VAR + aktueller prompt := name der datei, + offene; + + +PROC dateinamen sammeln (THESAURUS CONST t, INT CONST typ) : + + uebergebene namen sammeln; + offene dateien merken; + zusaetzliche namen dazu; + meldung falls keine datei . + +offene dateien merken : + offene := niltext; + INT VAR i; + FOR i FROM 1 UPTO anzahl dateien REP + INT CONST t link := feldindex (sammel, eudas dateiname (i)); + IF t link > 0 THEN + offene CAT code (t link) + END IF + END REP . + +uebergebene namen sammeln : + INT VAR + stelle := 1, + von := 0; + satz initialisieren (sammel); + REP + get (t, feldpuffer, von); + IF feldpuffer = niltext THEN + LEAVE uebergebene namen sammeln + ELIF typ = 0 COR type (old (feldpuffer)) = typ THEN + feld aendern (sammel, stelle, feldpuffer); + stelle INCR 1 + END IF + END REP . + +zusaetzliche namen dazu : + von := 0; + REP + get (zusaetzliche namen, feldpuffer, von); + IF feldpuffer = niltext THEN + LEAVE zusaetzliche namen dazu + ELIF NOT (t CONTAINS feldpuffer) THEN + feld aendern (sammel, stelle, feldpuffer); + stelle INCR 1 + END IF + END REP . + +meldung falls keine datei : + IF stelle = 1 THEN + dialog; out (keine datei zur auswahl); + errorstop (niltext) + END IF . + +END PROC dateinamen sammeln; + +PROC als text (TEXT VAR inhalt, INT CONST stelle) : + + IF stelle < 256 THEN + feld lesen (sammel, stelle, inhalt); + IF pos (offene, code (stelle)) > 0 THEN + inhalt := " " + textdarstellung (inhalt) + ELIF inhalt <> niltext THEN + inhalt := textdarstellung (inhalt) + END IF + ELSE + inhalt := niltext + END IF + +END PROC als text; + +PROC operation ausfuehren (PROC (TEXT CONST) operation) : + + INT VAR + stelle := 1; + REP + IF wahl (stelle) = 0 THEN + LEAVE operation ausfuehren + ELSE + feld lesen (sammel, wahl (stelle), feldpuffer); + dialog; out (text (stelle, 3)); out (". "); + out (textdarstellung (feldpuffer)); + last param (feldpuffer); + operation (feldpuffer) + END IF; + stelle INCR 1 + END REP + +END PROC operation ausfuehren; + +PROC ausfuehrung (PROC (TEXT CONST) operation, INT CONST typ) : + + enable stop; + TEXT VAR dateiname; + dateinamen anfordern (dateiname, typ); + IF dateiname = esc z THEN + operation ausfuehren (PROC (TEXT CONST) operation) + ELSE + last param (dateiname); + operation (dateiname) + END IF + +END PROC ausfuehrung; + +PROC einzelausfuehrung (PROC (TEXT CONST) operation, INT CONST typ) : + + enable stop; + TEXT VAR dateiname; + dateinamen anfordern (dateiname, typ); + IF dateiname = esc z THEN + IF wahl (1) = 0 THEN + errorstop (niltext) + ELSE + feld lesen (sammel, wahl (1), dateiname) + END IF + END IF; + last param (dateiname); + operation (dateiname) + +END PROC einzelausfuehrung; + +PROC dateinamen anfordern (TEXT CONST prompt) : + + aktueller prompt := prompt + +END PROC dateinamen anfordern; + +PROC dateinamen anfordern (TEXT VAR dateiname, INT CONST typ) : + + IF exists (std) AND (typ = 0 COR type (old (std)) = typ) THEN + dateiname := std + ELSE + dateiname := niltext + END IF; + disable stop; + editget (aktueller prompt, dateiname, "z", "GET/Dateiname"); + aktueller prompt := name der datei; + enable stop; + IF dateiname = niltext THEN + errorstop (niltext) + ELIF dateiname = esc z THEN + dateinamen sammeln (all, typ); + auswahl anbieten ("EUDAS-Dateiauswahl", rechts, "AUSWAHL/Datei", + PROC (TEXT VAR, INT CONST) als text); + bitte warten + END IF + +END PROC dateinamen anfordern; + +PROC aus sammel (TEXT VAR inhalt, INT CONST stelle) : + + IF stelle <= 256 THEN + feld lesen (sammel, stelle, inhalt) + ELSE + inhalt := niltext + END IF + +END PROC aus sammel; + +PROC frage ob einrichten (TEXT CONST dateiname) : + + IF NOT ja (textdarstellung (dateiname) + t neu einrichten, + "JA/einrichten") THEN + errorstop (niltext) + END IF + +END PROC frage ob einrichten; + + +(************************** Editor ****************************************) + +LET + edit status = #1091# +"EDITIEREN: Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ?", + show status = #1092# +"ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ?"; + +INT VAR return code; + +BOOL VAR + zeige edit status, + feldanzeige erlaubt; + + +PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe, + BOOL CONST aendern) : + + INT VAR x, y, x l, y l; + fenstergroesse (fenster, x, y, x l, y l); + fenster veraendert (fenster); + enable stop; + feldanzeige erlauben; + zeige edit status := aendern; + REP + edit status anzeigen; + open editor (groesster editor + 1, f, aendern, x, y, x l, y l); + edit (groesster editor, "eqvw19dpgn"9"?hF", PROC (TEXT CONST) kdo); + return code behandeln + END REP . + +feldanzeige erlauben : + IF aendern AND y < 3 AND y l > 22 AND x < 14 AND x l > 75 THEN + feldanzeige erlaubt := TRUE + ELSE + feldanzeige erlaubt := FALSE + END IF . + +return code behandeln : + SELECT return code OF + CASE 0 : LEAVE edit + CASE 1 : hilfe anbieten (hilfe, fenster) + CASE 2 : errorstop (niltext) + END SELECT . + +END PROC edit; + +PROC edit status anzeigen : + + IF zeige edit status THEN + status anzeigen (edit status) + ELSE + status anzeigen (show status) + END IF + +END PROC edit status anzeigen; + +PROC kdo (TEXT CONST zeichen) : + + return code := pos ("q?h", zeichen); + IF return code > 0 THEN + return code DECR 1; + quit + ELIF feldanzeige erlaubt CAND zeichen = "F" THEN + feldnamen anzeigen; + edit status anzeigen + ELSE + std kommando interpreter (zeichen); + edit status anzeigen; + bildschirm neu + END IF + +END PROC kdo; + +PROC feldnamen anzeigen : + + IF anzahl felder > 0 THEN + feldnamen sammeln; + sammlung zur auswahl anbieten; + ergebnis in editor uebernehmen + END IF . + +feldnamen sammeln : + INT VAR feldnr; + satz initialisieren (sammel, anzahl felder); + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldpuffer); + feld aendern (sammel, feldnr, feldpuffer) + END REP . + +sammlung zur auswahl anbieten : + auswahl anbieten ("EUDAS-Editfelder", rechts, "AUSWAHL/Feldnamen", + PROC (TEXT VAR, INT CONST) aus sammel) . + +ergebnis in editor uebernehmen : + INT VAR stelle := 1; + WHILE wahl (stelle) > 0 REP + IF stelle > 1 THEN push (blank) END IF; + feldnamen lesen (wahl (stelle), feldpuffer); + push (""""); push (feldpuffer); push (""""); + stelle INCR 1 + END REP . + +END PROC feldnamen anzeigen; + +END PACKET eudas steuerung; + diff --git a/app/eudas/4.4/src/eudas.uebersicht b/app/eudas/4.4/src/eudas.uebersicht new file mode 100644 index 0000000..4029956 --- /dev/null +++ b/app/eudas/4.4/src/eudas.uebersicht @@ -0,0 +1,420 @@ +PACKET uebersichtsanzeige + +(*************************************************************************) +(* *) +(* Anzeige von EUDAS-Dateien als Übersicht *) +(* *) +(* Version 02 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 08.07.87 *) +(* *) +(*************************************************************************) + + DEFINES + + uebersicht, + uebersichtsfenster : + + +ROW 24 INT VAR zeilensatz; + +ROW 24 INT VAR zeilenkombi; + +FENSTER VAR fenster; +fenster initialisieren (fenster); + +INT VAR + laenge := 24, + breite := 79, + zeilen anf := 1, + spalten anf := 1, + freier rest, + feldversion := -1; + +BOOL VAR + bis zeilenende, + satznummer markieren; + +TEXT VAR + feldnummern; + +LET + niltext = "", + begin mark = ""15"", + end mark = ""14"", + blank = " ", + piep = ""7"", + cleol = ""5""; + +LET + t satznr = #901# + ""15"Satznr. ", + t dateiende = #902# + " << DATEIENDE >>", + uebersicht status = #903# +"UEBERSICHT: Rollen: HOP OBEN, HOP UNTEN Beenden: ESC q Hilfe: ESC ?"; + + +PROC uebersichtsfenster (INT CONST x anf, y anf, x laenge, y laenge) : + + fenstergroesse setzen (fenster, x anf, y anf, x laenge, y laenge); + bis zeilenende := x anf + x laenge >= 80; + laenge := y laenge; + breite := x laenge; + zeilen anf := y anf; + spalten anf := x anf + +END PROC uebersichtsfenster; + +PROC uebersicht (TEXT CONST nummern, PROC hilfe) : + + TEXT VAR eingabezeichen; + BOOL VAR dummy; + INT VAR + angezeigter satz := 1, + ausgegebene zeilen := 0, + eingabezustand := 1; + + fensterzugriff (fenster, dummy); + status anzeigen (uebersicht status); + feldnummern bestimmen; + satznummer markieren := FALSE; + aktueller satz wird erster; + REP + kommando annehmen und zeile ausgeben; + alte markierung entfernen; + kommando interpretieren + END REP . + +feldnummern bestimmen : + IF nummern = niltext THEN + ggf alte auswahl uebernehmen + ELSE + feldnummern := nummern; + feldversion := dateiversion + END IF . + +ggf alte auswahl uebernehmen : + IF feldversion <> dateiversion THEN + alle felder anzeigen; + feldversion := dateiversion + END IF . + +alle felder anzeigen : + INT VAR i; + feldnummern := niltext; + FOR i FROM 1 UPTO anzahl felder REP + feldnummern CAT code (i) + END REP . + +kommando annehmen und zeile ausgeben : + WHILE ausgegebene zeilen < laenge REP + eingabezeichen := getcharety; + IF eingabezeichen <> "" THEN + LEAVE kommando annehmen und zeile ausgeben + END IF; + eine zeile ausgeben; + ausgegebene zeilen INCR 1 + END REP; + aktuellen satz markieren und einnehmen; + getchar (eingabezeichen) . + +eine zeile ausgeben : + IF ausgegebene zeilen = 0 THEN + ueberschrift ausgeben + ELIF ausgegebene zeilen = 1 THEN + erste zeile ausgeben + ELSE + weitere zeile ausgeben + END IF . + +ueberschrift ausgeben : + cursor (spalten anf, zeilen anf); + out (t satznr); + freier rest := breite - 10; + INT VAR feldindex; + FOR feldindex FROM 1 UPTO length (feldnummern) + WHILE freier rest > 0 REP + feldnamen bearbeiten (code (feldnummern SUB feldindex), + PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest) + END REP; + zeilenrest loeschen; + cursor (spalten anf + breite - 1, zeilen anf); + out (end mark) . + +erste zeile ausgeben : + auf uebersichtssatz (1); + satznummer in zeile (1); + satz als zeile ausgeben . + +weitere zeile ausgeben : + cursor (spalten anf, zeilen anf + ausgegebene zeilen); + IF dateiende THEN + zeilensatz (ausgegebene zeilen) := 0; + freier rest := breite; + zeilenrest loeschen + ELSE + naechsten satz einnehmen; + satznummer in zeile (ausgegebene zeilen); + satz als zeile ausgeben + END IF . + +naechsten satz einnehmen : + weiter (2); + auf abbruch testen; + zeilensatz (ausgegebene zeilen) := satznummer; + zeilenkombi (ausgegebene zeilen) := satzkombination . + +auf abbruch testen : + IF NOT (satz ausgewaehlt OR dateiende) THEN + LEAVE uebersicht + END IF . + +alte markierung entfernen : + IF angezeigter satz < ausgegebene zeilen THEN + satznummer in zeile (angezeigter satz) + END IF; + cursor (spalten anf, zeilen anf + angezeigter satz) . + +aktuellen satz markieren und einnehmen : + satznummer markieren := TRUE; + WHILE zeilensatz (angezeigter satz) = 0 REP + angezeigter satz DECR 1 + END REP; + satznummer in zeile (angezeigter satz); + auf uebersichtssatz (angezeigter satz); + markierung ausgeben; + satznummer markieren := FALSE . + +kommando interpretieren : + SELECT eingabezustand OF + CASE 1 : normales kommando interpretieren + CASE 2 : hop kommando interpretieren + CASE 3 : esc kommando interpretieren + END SELECT . + +normales kommando interpretieren : + SELECT pos (""3""10""1""27"+-", eingabezeichen) OF + CASE 1 : zeile nach oben + CASE 2 : zeile nach unten + CASE 3 : eingabezustand := 2 + CASE 4 : eingabezustand := 3 + CASE 5 : markieren + CASE 6 : demarkieren + OTHERWISE out (piep) + END SELECT . + +hop kommando interpretieren : + SELECT pos (""3""10""13"", eingabezeichen) OF + CASE 1 : seite nach oben + CASE 2 : seite nach unten + CASE 3 : hop return + OTHERWISE out (piep) + END SELECT; + eingabezustand := 1 . + +esc kommando interpretieren : + SELECT pos ("19qh?", eingabezeichen) OF + CASE 1 : esc 1 + CASE 2 : esc 9 + CASE 3, 4 : esc q + CASE 5 : hilfestellung + OTHERWISE out (piep) + END SELECT; + eingabezustand := 1 . + +zeile nach oben : + IF angezeigter satz > 1 THEN + angezeigter satz DECR 1; + ELSE + nach oben rollen (1); + ausgegebene zeilen := 1 + END IF . + +zeile nach unten : + IF NOT dateiende THEN + IF angezeigter satz < laenge - 1 THEN + angezeigter satz INCR 1 + ELSE + zeilensatz (1) := zeilensatz (2); + zeilenkombi (1) := zeilenkombi (2); + ausgegebene zeilen := 1 + END IF + END IF . + +markieren : + IF NOT satz markiert THEN + markierung aendern + END IF . + +demarkieren : + IF satz markiert THEN + markierung aendern + END IF . + +seite nach oben : + IF angezeigter satz > 1 THEN + angezeigter satz := 1 + ELSE + nach oben rollen (laenge - 1); + ausgegebene zeilen := 1 + END IF . + +seite nach unten : + IF angezeigter satz = laenge - 1 AND NOT dateiende THEN + weiter (2); + aktueller satz wird erster; + ausgegebene zeilen := 1 + ELSE + angezeigter satz := laenge - 1 + END IF . + +hop return : + IF angezeigter satz <> 1 THEN + zeilensatz (1) := zeilensatz (angezeigter satz); + zeilenkombi (1) := zeilenkombi (angezeigter satz); + angezeigter satz := 1; + ausgegebene zeilen := 1 + END IF . + +esc 1 : + auf satz (1); + IF NOT satz ausgewaehlt THEN + weiter (2) + END IF; + aktueller satz wird erster; + angezeigter satz := 1; + ausgegebene zeilen := 1 . + +esc 9 : + auf satz (32767); + aktueller satz wird erster; + nach oben rollen (laenge - 2); + ausgegebene zeilen := 1 . + +esc q : + satznummer markieren := true; + satznummer in zeile (angezeigter satz); + LEAVE uebersicht . + +hilfestellung : + hilfe; + status anzeigen (uebersicht status); + ausgegebene zeilen := 0 . + +END PROC uebersicht; + +PROC nach oben rollen (INT CONST gerollt) : + + INT VAR i; + auf uebersichtssatz (1); + FOR i FROM 1 UPTO gerollt + WHILE satznummer > 1 REP + zurueck (2) + END REP; + aktueller satz wird erster + +END PROC nach oben rollen; + +PROC auf uebersichtssatz (INT CONST zeile) : + + auf satz (zeilensatz (zeile)); + WHILE satzkombination <> zeilenkombi (zeile) REP + weiter (1) + END REP + +END PROC auf uebersichtssatz; + +PROC aktueller satz wird erster : + + zeilensatz (1) := satznummer; + zeilenkombi (1) := satzkombination + +END PROC aktueller satz wird erster; + +BOOL PROC uebereinstimmung (INT CONST zeile) : + + satznummer = zeilensatz (zeile) CAND satzkombination = zeilenkombi (zeile) + +END PROC uebereinstimmung; + +PROC feld bis rest (TEXT CONST satz, INT CONST von, bis) : + + INT CONST laenge := min (freier rest, bis - von + 1); + outsubtext (satz, von, von + laenge - 1); + freier rest DECR laenge; + IF freier rest >= 2 THEN + out (", "); freier rest DECR 2 + ELIF freier rest = 1 THEN + out (","); freier rest := 0 + END IF + +END PROC feld bis rest; + +PROC satznummer in zeile (INT CONST zeile) : + + cursor (spalten anf, zeilen anf + zeile); + IF satznummer markieren THEN + out (begin mark) + ELSE + out (blank) + END IF; + outtext (text (zeilensatz (zeile)), 1, 5); + IF satznummer markieren THEN + out (end mark) + ELSE + out (blank) + END IF; + freier rest := breite - 7 + +END PROC satznummer in zeile; + +PROC zeilenrest loeschen : + + IF bis zeilenende THEN + out (cleol) + ELSE + freier rest TIMESOUT blank + END IF + +END PROC zeilenrest loeschen; + +PROC satz als zeile ausgeben : + + IF satz ausgewaehlt THEN + markierung ausgeben; + felder ausgeben + ELIF dateiende THEN + out (t dateiende); + freier rest DECR 17 + ELSE + markierung ausgeben; + out ("<< >>"); + freier rest DECR 5 + END IF; + zeilenrest loeschen . + +felder ausgeben : + INT VAR feldindex; + FOR feldindex FROM 1 UPTO length (feldnummern) + WHILE freier rest > 0 REP + feld bearbeiten (code (feldnummern SUB feldindex), + PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest) + END REP . + +END PROC satz als zeile ausgeben; + +PROC markierung ausgeben : + + IF satz markiert THEN + out ("+ ") + ELSE + out ("- ") + END IF; + freier rest DECR 2 + +END PROC markierung ausgeben; + +END PACKET uebersichtsanzeige; + diff --git a/app/eudas/4.4/src/eudas.verarbeitung b/app/eudas/4.4/src/eudas.verarbeitung new file mode 100644 index 0000000..95af7cc --- /dev/null +++ b/app/eudas/4.4/src/eudas.verarbeitung @@ -0,0 +1,731 @@ +PACKET verarbeitung + +(*************************************************************************) +(* *) +(* Automatische Verarbeitung von EUDAS-Dateien *) +(* *) +(* Version 05 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 17.04.87 *) +(* *) +(*************************************************************************) + + DEFINES + + kopiere, + std kopiermuster, + verarbeite, + trage, + eindeutige felder, + pruefe, + wertemenge, + feldmaske, + trage satz, + hole satz, + K, + V, + f, + wert, + zahltext, + textdarstellung : + + +SATZ VAR + zielfeldnamen, + kopierfeldnamen, + kopiersatz; + +INT VAR kopierindex; + +BOOL VAR erstes mal; + +LET + niltext = "", + INTVEC = TEXT; + +INTVEC VAR kopiervektor; + +TEXT VAR zwei bytes := " "; + + +OP CAT (INTVEC VAR intvec, INT CONST zahl) : + + replace (zwei bytes, 1, zahl); + intvec CAT zwei bytes + +END OP CAT; + +PROC std kopiermuster (TEXT CONST dateiname, FILE VAR kopiermuster) : + + teste ob datei vorhanden; + INT VAR zielfelder; + dateien oeffnen; + feldnamen bestimmen; + INT VAR feldnr; + FOR feldnr FROM 1 UPTO zielfelder REP + feldnamen auslesen; + IF feld vorhanden THEN + direkt kopieren + ELSE + leer kopieren + END IF + END REP . + +dateien oeffnen : + output (kopiermuster); + EUDAT VAR eudas datei; + IF exists (dateiname) THEN + oeffne (eudas datei, dateiname) + END IF . + +feldnamen bestimmen : + IF exists (dateiname) CAND felderzahl (eudas datei) > 0 THEN + feldnamen lesen (eudas datei, zielfeldnamen); + zielfelder := felderzahl (eudas datei) + ELSE + quellfeldnamen kopieren; + zielfelder := anzahl felder + END IF . + +quellfeldnamen kopieren : + TEXT VAR feldname; + satz initialisieren (zielfeldnamen); + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldname); + feld aendern (zielfeldnamen, feldnr, feldname) + END REP . + +feld vorhanden : + feldnummer (feldname) > 0 . + +feldnamen auslesen : + feld lesen (zielfeldnamen, feldnr, feldname); + put (kopiermuster, textdarstellung (feldname)) . + +direkt kopieren : + write (kopiermuster, "K f("); + write (kopiermuster, textdarstellung (feldname)); + putline (kopiermuster, ");") . + +leer kopieren : + putline (kopiermuster, "K """";") . + +END PROC std kopiermuster; + +PROC kopiere (TEXT CONST dateiname, FILE VAR kopiermuster) : + + programmfunktion (kopieraufruf, kopiermuster) . + +kopieraufruf : + "kopiere (" + textdarstellung (dateiname) + ", " . + +END PROC kopiere; + +PROC programmfunktion (TEXT CONST aufruf, FILE VAR muster) : + + programmdatei einrichten; + write (programm, aufruf); + putline (programm, "PROC programmfunktion);"); + putline (programm, "PROC programmfunktion:"); + muster kopieren; + putline (programm, "END PROC programmfunktion"); + programm ausfuehren; + forget (programm datei, quiet) . + +programmdatei einrichten : + TEXT VAR programmdatei; + INT VAR i := 0; + REP + i INCR 1; + programmdatei := text (i) + UNTIL NOT exists (programmdatei) END REP; + disable stop; + FILE VAR programm := sequential file (output, programm datei); + headline (programm, erzeugtes programm) . + +muster kopieren : + TEXT VAR zeile; + input (muster); + WHILE NOT eof (muster) REP + getline (muster, zeile); + putline (programm, zeile) + END REP . + +programm ausfuehren : + TEXT CONST alter last param := std; + run (programmdatei); + last param (alter last param) . + +END PROC programm funktion; + +PROC kopiere (TEXT CONST dateiname, PROC kopierfunktion) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + IF dateiende THEN + auf satz (1); + LEAVE kopiere + ELSE + zieldatei einrichten + END IF; + + WHILE NOT dateiende REP + satz initialisieren (kopiersatz); + kopierindex := 1; + kopierfunktion; + evtl feldnamen einrichten; + satz einfuegen (eudas datei, kopiersatz); + weiter (eudas datei); + weiter (modus) + END REP; + auf satz (1) . + +zieldatei einrichten : + erstes mal := TRUE; + EUDAT VAR eudas datei; + oeffne (eudas datei, dateiname); + auf satz (eudas datei, saetze (eudas datei) + 1); + feldnamen lesen (eudas datei, kopierfeldnamen); + kopiervektor := niltext . + +evtl feldnamen einrichten : + IF erstes mal THEN + feldnamen aendern (eudas datei, kopierfeldnamen); + erstes mal := FALSE + END IF + +END PROC kopiere; + +OP K (TEXT CONST feldname, ausdruck) : + + IF erstes mal THEN + kopiervektor erstellen; + END IF; + feld aendern (kopiersatz, kopiervektor ISUB kopierindex, ausdruck); + kopierindex INCR 1 . + +kopiervektor erstellen : + INT VAR aktueller index := feldindex (kopierfeldnamen, feldname); + IF aktueller index = 0 THEN + aktueller index := felderzahl (kopierfeldnamen) + 1; + feld aendern (kopierfeldnamen, aktueller index, feldname); + END IF; + kopiervektor CAT aktueller index . + +END OP K; + +PROC verarbeite (FILE VAR verarbeitungsmuster) : + + programmfunktion ("verarbeite (", verarbeitungsmuster) + +END PROC verarbeite; + +PROC verarbeite (PROC verarbeitungsfunktion) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + + WHILE NOT dateiende REP + verarbeitungsfunktion; + weiter (modus) + END REP; + auf satz (1) + +END PROC verarbeite; + +OP V (TEXT CONST feldname, ausdruck) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname) + ELSE + feld aendern (nr, ausdruck) + END IF + +END OP V; + +PROC auf ersten satz (INT VAR modus) : + + teste ob datei vorhanden; + auf satz (1); + IF markierte saetze > 0 THEN + modus := 3; + IF NOT satz markiert THEN weiter (modus) END IF + ELSE + modus := 2; + IF NOT satz ausgewaehlt THEN weiter (modus) END IF + END IF + +END PROC auf ersten satz; + +PROC teste ob datei vorhanden : + + IF anzahl dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF . + +END PROC teste ob datei vorhanden; + + +(******************************** Zugriffe *******************************) + +TEXT VAR + feldpuffer, + werttext; + +LET quote = """"; + + +TEXT PROC f (TEXT CONST feldname) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname); + feldpuffer := niltext + ELSE + feld lesen (nr, feldpuffer) + END IF; + feldpuffer + +END PROC f; + +REAL PROC wert (TEXT CONST feldname) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname); + 0.0 + ELSE + feld lesen (nr, feldpuffer); + REAL VAR ergebnis; + wert berechnen (feldpuffer, ergebnis); + ergebnis + END IF + +END PROC wert; + +REAL PROC wert (TEXT CONST feldname, INT CONST kommastellen) : + + round (wert (feldname), kommastellen) + +END PROC wert; + +TEXT PROC zahltext (REAL CONST feldwert, INT CONST kommastellen) : + + REAL CONST w := round (abs (feldwert), kommastellen); + INT VAR stellen := exponent der zahl + kommastellen + 2; + IF feldwert < 0.0 THEN + werttext := "-" + ELSE + werttext := niltext + END IF; + IF w < 1.0 AND w <> 0.0 THEN + werttext CAT "0"; + stellen DECR 1 + ENDIF; + werttext CAT text (w, stellen, kommastellen); + IF kommastellen > 0 THEN + change (werttext, ".", dezimalkomma) + ELSE + change (werttext, ".", niltext) + END IF; + werttext . + +exponent der zahl : + max (0, decimal exponent (w)) . + +END PROC zahltext; + +TEXT PROC zahltext (TEXT CONST feldname, INT CONST kommastellen) : + + zahltext (wert (feldname), kommastellen) + +END PROC zahltext; + +TEXT PROC textdarstellung (TEXT CONST anzeigetext) : + + feldpuffer := anzeigetext; + change all (feldpuffer, quote, quote + quote); + steuerzeichen umwandeln; + insert char (feldpuffer, quote, 1); + feldpuffer CAT quote; + feldpuffer . + +steuerzeichen umwandeln : + INT VAR stelle := 1; + WHILE steuerzeichen vorhanden REP + change (feldpuffer, stelle, stelle, steuertext) + END REP . + +steuerzeichen vorhanden : + stelle := pos (feldpuffer, ""0"", ""31"", stelle); + stelle > 0 . + +steuertext : + quote + text (code (feldpuffer SUB stelle)) + quote . + +END PROC textdarstellung; + +PROC unbekannt (TEXT CONST feldname) : + + errorstop (t das feld + textdarstellung (feldname) + + nicht definiert) + +END PROC unbekannt; + + +(****************************** Tragen ***********************************) + +SATZ VAR tragsatz; + +EUDAT VAR zieldatei; + +LET + erzeugtes programm = #501# + "erzeugtes Programm", + keine datei geoeffnet = #502# + "keine Datei geoeffnet", + kein satz vorhanden = #503# + "Kein Satz zum Tragen vorhanden", + falsche felderzahl = #504# + "Zieldatei hat falsche Felderzahl", + existiert nicht = #505# + " existiert nicht", + verletzt die pruefbedingung = #506# + " verletzt die Pruefbedingung.", + bereits vorhanden = #507# + " ist in der Zieldatei bereits vorhanden.", + nicht definiert = #508# + " ist nicht definiert.", + nicht in wertemenge = #509# + " ist nicht in der Wertemenge.", + passt nicht zu maske = #510# + " stimmt nicht mit der Maske ueberein.", + t satz = #511# + "Satz ", + t das feld = #512# + "Das Feld "; + +INT VAR + anzahl eindeutiger felder; + +FILE VAR protokoll; + +BOOL VAR + testen := FALSE, + test erfolgreich, + uebereinstimmung; + +TEXT VAR testprogramm; + + +PROC trage (TEXT CONST dateiname, FILE VAR protokoll file, BOOL CONST test) : + + disable stop; + testen := test; + IF testen THEN + protokoll := protokoll file; + output (protokoll) + END IF; + trage intern (dateiname); + testen := FALSE + +END PROC trage; + +PROC trage intern (TEXT CONST dateiname) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + tragen vorbereiten (dateiname); + + INT VAR satzzaehler := 0; + REP + IF NOT ausgewaehlt THEN + weiter (modus) + ELSE + cout (satznummer + satzzaehler) + END IF; + IF dateiende THEN auf satz (1); LEAVE trage intern END IF; + satz testen und tragen + END REP . + +ausgewaehlt : + IF modus = 3 THEN satz markiert ELSE satz ausgewaehlt END IF . + +satz testen und tragen : + test erfolgreich := TRUE; + IF testen THEN + notizen lesen (zieldatei, 1, testprogramm); + do (testprogramm) + END IF; + IF test erfolgreich THEN + trage einzelsatz; + IF test erfolgreich THEN + satz loeschen; + satzzaehler INCR 1 + END IF + END IF; + IF NOT test erfolgreich THEN + weiter (modus) + END IF . + +END PROC trage intern; + +PROC tragen vorbereiten (TEXT CONST dateiname) : + + IF dateiende THEN + errorstop (kein satz vorhanden) + END IF; + oeffne (zieldatei, dateiname); + anzahl eindeutiger felder := 0; + IF felderzahl (zieldatei) = 0 THEN + zieldatei einrichten + ELIF felderzahl (zieldatei) <> anzahl felder THEN + errorstop (falsche felderzahl) + END IF; + auf satz (zieldatei, saetze (zieldatei) + 1) . + +zieldatei einrichten : + satz initialisieren (tragsatz, anzahl felder); + INT VAR feldnr; + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldpuffer); + feld aendern (tragsatz, feldnr, feldpuffer) + END REP; + feldnamen aendern (zieldatei, tragsatz) . + +END PROC tragen vorbereiten; + +PROC trage einzelsatz : + + IF anzahl eindeutiger felder > 0 CAND schon vorhanden THEN + protokolliere ("", bereits vorhanden) + ELSE + tragsatz aufbauen; + satz einfuegen (zieldatei, tragsatz); + weiter (zieldatei) + END IF . + +tragsatz aufbauen : + satz initialisieren (tragsatz, anzahl felder); + INT VAR feldnr; + FOR feldnr FROM 1 UPTO anzahl felder REP + feld lesen (feldnr, feldpuffer); + feld aendern (tragsatz, feldnr, feldpuffer) + END REP . + +schon vorhanden : + TEXT VAR muster; + INT CONST alte satznummer := satznr (zieldatei); + feld lesen (1, muster); + uebereinstimmung := FALSE; + auf satz (zieldatei, muster); + WHILE NOT dateiende (zieldatei) REP + teste auf uebereinstimmung; + weiter (zieldatei, muster) + UNTIL uebereinstimmung END REP; + auf satz (zieldatei, alte satznummer); + uebereinstimmung . + +teste auf uebereinstimmung : + INT VAR i; + uebereinstimmung := TRUE; + FOR i FROM 2 UPTO anzahl eindeutiger felder REP + feld lesen (zieldatei, i, feldpuffer); + feld bearbeiten (i, + PROC (TEXT CONST, INT CONST, INT CONST) felduebereinstimmung); + IF NOT uebereinstimmung THEN + LEAVE teste auf uebereinstimmung + END IF + END REP . + +END PROC trage einzelsatz; + +PROC felduebereinstimmung (TEXT CONST satz, INT CONST von, bis) : + + IF laengen ungleich COR + (length (feldpuffer) > 0 CAND text ungleich) THEN + uebereinstimmung := FALSE + END IF . + +laengen ungleich : + (bis - von + 1) <> length (feldpuffer) . + +text ungleich : + pos (satz, feldpuffer, von, bis + 1) <> von . + +END PROC felduebereinstimmung; + +PROC protokolliere (TEXT CONST feld, meldung) : + + IF testen THEN + in protokoll + ELSE + errorstop (meldung) + END IF . + +in protokoll : + put (protokoll, t satz); put (protokoll, satznummer); + IF feld <> "" THEN + write (protokoll, t das feld); + write (protokoll, textdarstellung (feld)) + END IF; + putline (protokoll, meldung); + test erfolgreich := FALSE . + +END PROC protokolliere; + +PROC eindeutige felder (INT CONST anzahl) : + + anzahl eindeutiger felder := anzahl + +END PROC eindeutige felder; + +PROC pruefe (TEXT CONST feld, BOOL CONST bedingung) : + + IF NOT bedingung THEN + protokolliere (feld, verletzt die pruefbedingung) + END IF + +END PROC pruefe; + +PROC wertemenge (TEXT CONST feld, menge) : + + INT CONST nr := feldnummer (feld); + IF nr = 0 THEN + protokolliere (feld, nicht definiert) + ELSE + pruefe ob enthalten + END IF . + +pruefe ob enthalten : + INT VAR stelle := 0; + LET komma = ","; + feld lesen (nr, feldpuffer); + IF ist letztes element THEN + LEAVE pruefe ob enthalten + END IF; + feldpuffer CAT komma; + REP + stelle := pos (menge, feldpuffer, stelle + 1); + IF stelle = 1 OR + stelle > 1 CAND (menge SUB stelle - 1) = komma THEN + LEAVE pruefe ob enthalten + END IF + UNTIL stelle = 0 END REP; + protokolliere (feld, nicht in wertemenge) . + +ist letztes element : + INT CONST letzter anfang := length (menge) - length (feldpuffer); + (menge SUB letzter anfang) = komma AND + pos (menge, feldpuffer, letzter anfang + 1) > 0 . + +END PROC wertemenge; + +PROC feldmaske (TEXT CONST feld, maske) : + + INT CONST nr := feldnummer (feld); + IF nr = 0 THEN + protokolliere (feld, nicht definiert) + ELSE + feld lesen (nr, feldpuffer); + mit maske vergleichen + END IF . + +mit maske vergleichen : + INT VAR stelle; + TEXT CONST ende := code (length (maske) + 1); + TEXT VAR moegliche positionen := ""1""; + FOR stelle FROM 1 UPTO length (feldpuffer) REP + TEXT CONST zeichen := feldpuffer SUB stelle; + zeichen vergleichen + UNTIL moegliche positionen = "" END REP; + IF nicht erfolgreich THEN + protokolliere (feld, passt nicht zu maske) + END IF . + +zeichen vergleichen : + INT VAR moeglich := 1; + WHILE moeglich <= length (moegliche positionen) REP + INT CONST position := code (moegliche positionen SUB moeglich); + IF (maske SUB position) = "*" THEN + stern behandeln + ELIF vergleich trifft zu THEN + replace (moegliche positionen, moeglich, code (position + 1)); + moeglich INCR 1 + ELSE + delete char (moegliche positionen, moeglich) + END IF + END REP . + +stern behandeln : + IF position = length (maske) THEN + LEAVE feldmaske + END IF; + moeglich INCR 1; + IF pos (moegliche positionen, code (position + 1)) = 0 THEN + insert char (moegliche positionen, code (position + 1), moeglich) + END IF . + +vergleich trifft zu : + SELECT pos ("9XAa", maske SUB position) OF + CASE 1 : pos ("0123456789", zeichen) > 0 + CASE 2 : TRUE + CASE 3 : pos ("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ", zeichen) > 0 + CASE 4 : pos ("abcdefghijklmnopqrstuvwxyzäöüß", zeichen) > 0 + OTHERWISE (maske SUB position) = zeichen + END SELECT . + +nicht erfolgreich : + (moegliche positionen = "" COR pos (moegliche positionen, ende) = 0) + AND nicht gerade stern am ende . + +nicht gerade stern am ende : + (maske SUB length (maske)) <> "*" OR + pos (moegliche positionen, code (length (maske))) = 0 . + +END PROC feldmaske; + +PROC trage satz (TEXT CONST dateiname) : + + tragen vorbereiten (dateiname); + INT CONST alter satz := satznr (zieldatei); + trage einzelsatz; + satz loeschen; + auf satz (zieldatei, alter satz) + +END PROC trage satz; + +PROC hole satz (TEXT CONST dateiname) : + + teste ob datei vorhanden; + IF NOT exists (dateiname) THEN + errorstop (textdarstellung (dateiname) + existiert nicht) + END IF; + oeffne (zieldatei, dateiname); + IF felderzahl (zieldatei) <> anzahl felder THEN + errorstop (falsche felderzahl) + ELIF saetze (zieldatei) = 0 THEN + errorstop (kein satz vorhanden) + END IF; + auf satz (zieldatei, saetze (zieldatei)); + satz lesen (zieldatei, tragsatz); + tragsatz einfuegen; + satz loeschen (zieldatei) . + +tragsatz einfuegen : + satz einfuegen; + INT VAR feldnr; + FOR feldnr FROM 1 UPTO felderzahl (tragsatz) REP + feld lesen (tragsatz, feldnr, feldpuffer); + feld aendern (feldnr, feldpuffer) + END REP . + +END PROC hole satz; + +END PACKET verarbeitung; + diff --git a/app/eudas/5.3/source-disk b/app/eudas/5.3/source-disk new file mode 100644 index 0000000..64243e5 --- /dev/null +++ b/app/eudas/5.3/source-disk @@ -0,0 +1,2 @@ +eudas/eudas-5.3_1989-02-06.1.img +eudas/eudas-5.3_1989-02-06.2.img diff --git a/app/eudas/5.3/src/Adressen b/app/eudas/5.3/src/Adressen new file mode 100644 index 0000000..74f0e3d Binary files /dev/null and b/app/eudas/5.3/src/Adressen differ diff --git a/app/eudas/5.3/src/boxzeichen b/app/eudas/5.3/src/boxzeichen new file mode 100644 index 0000000..12c3bb8 --- /dev/null +++ b/app/eudas/5.3/src/boxzeichen @@ -0,0 +1,3 @@ +box zeichen (""205""186""201""187""200""188""199""182""196"", + ""15""14"", ""178" ") + diff --git a/app/eudas/5.3/src/dummy.text b/app/eudas/5.3/src/dummy.text new file mode 100644 index 0000000..0eb03b0 --- /dev/null +++ b/app/eudas/5.3/src/dummy.text @@ -0,0 +1,14 @@ +PACKET dummy text DEFINES + lineform, pageform, autoform, autopageform : + +PROC lineform (TEXT CONST datei) : fehler END PROC lineform; +PROC pageform (TEXT CONST datei) : fehler END PROC pageform; +PROC autoform (TEXT CONST datei) : fehler END PROC autoform; +PROC autopageform (TEXT CONST datei) : fehler END PROC autopageform; + +PROC fehler : + errorstop ("Keine Textverarbeitung installiert") +END PROC fehler; + +END PACKET dummy text; + diff --git a/app/eudas/5.3/src/eudas.1 b/app/eudas/5.3/src/eudas.1 new file mode 100644 index 0000000..9a6070c --- /dev/null +++ b/app/eudas/5.3/src/eudas.1 @@ -0,0 +1,49 @@ +PACKETeudasdateienDEFINES EUDAT,oeffne,satznr,dateiende,saetze,aufsatz,weiter,zurueck,satzlesen,satzaendern,satzloeschen,satzeinfuegen,feldlesen,feldaendern,feldbearbeiten,felderzahl,feldnamenlesen,feldnamenaendern,notizenlesen,notizenaendern,feldinfo,automatischerschluessel,dezimalkomma,wertberechnen,reorganisiere,sortiere,sortierreihenfolge,unsortiertesaetze:LETb0=531,c0=121,d0=5000,e0=3243,f0=64,g0=48;LET INTVEC=TEXT,INDEX=STRUCT(INTh0,i0,INTj0,k0,INTVECl0),EINTRAG=STRUCT(INTh0,i0,m0,n0,SATZo0),DATEI=STRUCT(INTfelderzahl,SATZp0,INTVECfeldinfo,TEXTq0,INTr0,s0,t0,INTu0,v0,INTw0,satznr,INTx0,y0,z0,INTa1,b1,ROW3TEXTc1,ROWb0INTd1,ROWc0INDEXindex,ROWd0EINTRAGe1);TYPE EUDAT=BOUND DATEI;LETf1="";LETg1= +#201#"Datei ist keine EUDAS-Datei",h1= +#202#"inkonsistente EUDAS-Datei",i1= +#203#"EUDAS-Datei voll",j1= +#204#"Nicht erlaubtes Dezimalkomma"; +TEXT VARk1;TEXT VARl1:=" ";INTVEC CONSTm1:=n1(f0,1);LETo1="";TEXT VARp1;INTVEC PROCn1(INT CONSTlength,q1):replace(l1,1,q1);length*l1END PROCn1;PROCinsert(INTVEC VARr1,INT CONSTpos,q1):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(r1)+1THENt1ELSEreplace(l1,1,q1);p1:=subtext(r1,begin);r1:=subtext(r1,1,begin-1);r1CATl1;r1CATp1END IF END PROCinsert;PROCdelete(INTVEC VARr1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>=length(r1)THENt1ELSEp1:=subtext(r1,begin+2);r1:=subtext(r1,1,begin-1);r1CATp1END IF END PROCdelete;INT PROCpos(INTVEC CONSTr1,INT CONSTq1):replace(l1,1,q1);INT VARbegin:=1;REPbegin:=pos(r1,l1,begin)+1UNTIL(beginAND1)=0ORbegin=1END REP;beginDIV2END PROCpos;PROCu1(INTVEC VARv1,w1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(v1)+1THENt1ELSEw1:=subtext(v1,begin);v1:=subtext(v1,1,begin-1)END IF END PROCu1;PROCx1(INTVEC VARv1,w1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(v1)+1THENt1ELSEw1:= +subtext(v1,1,begin-1);v1:=subtext(v1,begin)END IF END PROCx1;.t1:errorstop(9,f1).s1:errorstop(10,f1).PROCy1(DATEI VARz1):z1.felderzahl:=0;z1.feldinfo:=o1;satzinitialisieren(z1.p0);z1.q0:=f1;z1.r0:=1;z1.s0:=1;z1.u0:=0;z1.t0:=0;z1.w0:=0;z1.v0:=1;z1.a1:=0;z1.c1(1):=f1;z1.c1(2):=f1;z1.c1(3):=f1;z1.satznr:=1;z1.x0:=1;z1.y0:=1;z1.z0:=1;z1.index(1).l0:=m1;z1.index(1):=INDEX:(0,0,1,1,n1(1,1));INT VARa2;FORa2FROM1UPTOb0REPz1.d1(a2):=0END REP;z1.e1(1):=EINTRAG:(0,0,1,0,b2).b2:z1.p0.END PROCy1;PROCoeffne(EUDAT VARz1,TEXT CONSTc2):enablestop;IF NOTexists(c2)THEN CONCR(z1):=new(c2);y1(CONCR(z1));type(old(c2),e0)ELIFtype(old(c2))=e0THEN CONCR(z1):=old(c2)ELSEerrorstop(g1)ENDIF END PROCoeffne;PROCoeffne(EUDAT VARz1,DATASPACE CONSTd2):IFtype(d2)<0THEN CONCR(z1):=d2;y1(CONCR(z1));type(d2,e0)ELIFtype(d2)=e0THEN CONCR(z1):=d2ELSEerrorstop(g1)END IF END PROCoeffne;PROCfeldlesen(EUDAT CONSTz1,INT CONSTe2,TEXT VARf2):feldlesen(g2,e2,f2).g2:z1.e1(z1.z0).o0.END PROCfeldlesen;PROCfeldaendern(EUDAT VARz1,INT +CONSTe2,TEXT CONSTh2):IFi2THENj2(CONCR(z1));k2;feldaendern(g2,e2,h2)END IF.i2:z1.z0<>1.k2:IFe2=1THENdisablestop;l2(CONCR(z1),m2(h2))END IF.g2:z1.e1(z1.z0).o0.END PROCfeldaendern;INT PROCfelderzahl(EUDAT CONSTz1):z1.felderzahlEND PROCfelderzahl;PROCfeldbearbeiten(EUDAT CONSTz1,INT CONSTe2,PROC(TEXT CONST,INT CONST,INT CONST)n2):feldbearbeiten(g2,e2,PROC(TEXT CONST,INT CONST,INT CONST)n2).g2:z1.e1(z1.z0).o0.END PROCfeldbearbeiten;PROCfeldnamenlesen(EUDAT CONSTz1,SATZ VARo2):o2:=z1.p0END PROCfeldnamenlesen;PROCfeldnamenaendern(EUDAT VARz1,SATZ CONSTp2):z1.p0:=p2;INT CONSTq2:=felderzahl(p2);IFq2>z1.felderzahlTHENr2;z1.felderzahl:=q2END IF.r2:z1.feldinfoCATn1(s2,-1).s2:q2-length(z1.feldinfo)DIV2.END PROCfeldnamenaendern;INT PROCfeldinfo(EUDAT CONSTz1,INT CONSTe2):z1.feldinfoISUBe2END PROCfeldinfo;PROCfeldinfo(EUDAT VARz1,INT CONSTe2,t2):replace(z1.feldinfo,e2,t2);IFpos(z1.q0,code(e2))>0THENz1.a1:=z1.w0END IF END PROCfeldinfo;INT PROCsatznr(EUDAT CONSTz1):z1.satznrEND PROCsatznr;BOOL PROC +dateiende(EUDAT CONSTz1):z1.satznr>z1.w0END PROCdateiende;INT PROCsaetze(EUDAT CONSTz1):z1.w0END PROCsaetze;PROCu2(DATEI VARz1,INT CONSTx0,k0,satznr):IFx0<1ORx0>z1.s0CORk0<1ORk0>z1.index(x0).j0THENerrorstop(h1)END IF;disablestop;z1.x0:=x0;z1.y0:=k0;z1.satznr:=satznr;z1.z0:=z1.index(x0).l0ISUBk0END PROCu2;PROCaufsatz(EUDAT VARz1,INT CONSTv2):INT VARsatznr;IFv2<1THENsatznr:=1ELIFv2>z1.w0THENsatznr:=z1.w0+1ELSEsatznr:=v2END IF;w2(CONCR(z1),satznr)END PROCaufsatz;PROCaufsatz(EUDAT VARz1,TEXT CONSTx2):aufsatz(z1,1);IFy2THENweiter(z1,x2)END IF.y2:feldlesen(z1,1,k1);k1<>x2.END PROCaufsatz;PROCw2(DATEI VARz1,INT CONSTsatznr):IFz2THENu2(z1,1,1,1)END IF;INT VARx0:=z1.x0,a3:=z1.satznr-z1.y0;IFsatznr>z1.satznrTHENb3ELSEc3END IF;u2(z1,x0,k0,satznr).z2:satznr+satznr=satznr.k0:satznr-a3.END PROCw2;PROCweiter(EUDAT VARz1):f3(CONCR( +z1))END PROCweiter;PROCf3(DATEI VARz1):IFg3THENh3END IF.g3:z1.z0<>1.h3:INT VARx0:=z1.x0,k0:=z1.y0;IFk0=index.j0THENx0:=index.i0;k0:=1ELSEk0INCR1END IF;u2(z1,x0,k0,z1.satznr+1).index:z1.index(x0).END PROCf3;PROCzurueck(EUDAT VARz1):i3(CONCR(z1))END PROCzurueck;PROCi3(DATEI VARz1):IFj3THENk3END IF.j3:z1.satznr<>1.k3:INT VARx0:=z1.x0,k0:=z1.y0;IFk0=1THENx0:=m0.h0;k0:=m0.j0ELSEk0DECR1END IF;u2(z1,x0,k0,z1.satznr-1).m0:z1.index(x0).END PROCi3;PROCweiter(EUDAT VARz1,TEXT CONSTx2):f3(CONCR(z1),x2)END PROCweiter;PROCf3(DATEI VARz1,TEXT CONSTx2):l3;WHILEm3CANDn3REPo3END REP;IFm3THENp3(z1,k0)ELSEw2(z1,z1.w0+1)END IF.l3:INT VARdummy,k0:=z1.z0;IFn3THENq3(z1,m2(x2),k0,dummy)ELSEo3END IF.m3:k0<>0.n3:feldlesen(g2,1,k1);k1<>x2.g2:z1.e1(k0).o0.o3:k0:=z1.e1(k0).i0.END PROCf3;PROCzurueck(EUDAT VARz1,TEXT CONSTx2):i3(CONCR(z1),x2)END PROCzurueck;PROCi3(DATEI VARz1,TEXT CONSTx2):l3;WHILEm3CANDn3REPr3END REP;IFm3THENp3(z1,k0)ELSEw2(z1,1)END IF.l3:INT VARk0:=z1.z0,dummy;IFk0=1ORs3THENq3(z1,m2(x2),dummy,k0) +END IF.m3:k0<>0.n3:k0=z1.z0ORs3.s3:feldlesen(g2,1,k1);k1<>x2.g2:z1.e1(k0).o0.r3:k0:=z1.e1(k0).h0.END PROCi3;PROCp3(DATEI VARz1,INT CONSTk0):INT CONSTt3:=z1.e1(k0).m0;INT VARy0:=1,satznr:=0;WHILEy0<>t3REPsatznrINCRz1.index(y0).j0;y0:=z1.index(y0).i0END REP;y0:=pos(z1.index(t3).l0,k0);satznrINCRy0;u2(z1,t3,y0,satznr).END PROCp3;INT VARindex;PROCu3(TEXT CONSTv3,INT CONSTw3,x3):INT VARy3:=w3;index:=0;IFx3-w3<4THENz3ELSEa4END IF;index:=indexMODb0+1.z3:WHILEy3<=x3REPindex:=index*4;indexINCRcode(v3SUBy3);y3INCR1END REP.a4:WHILEy3<=x3REPindexINCRindex;indexINCRcode(v3SUBy3);IFindex>16000THENindex:=indexMODb0END IF;y3INCR1END REP.END PROCu3;INT PROCm2(TEXT CONSTv3):u3(v3,1,length(v3));indexEND PROCm2;INT PROCm2(SATZ CONSTo0):feldbearbeiten(o0,1,PROC(TEXT CONST,INT CONST,INT CONST)u3);indexEND PROCm2;PROCq3(DATEI CONSTz1,INT CONSTm2,INT VARk0,b4):INT VARx0:=z1.r0;b4:=z1.d1(m2);k0:=0;BOOL VARc4:=TRUE;WHILEc4ANDb4<>0REPd4;o3END REP.d4:IFe4THENf4ELSEg4END IF.e4:z1.e1(b4).m0=z1.x0.f4:x0:=z1.x0;INT +CONSTh4:=pos(l0,b4);IFh4=0THENerrorstop(h1)ELIFh4<=i4THENc4:=FALSE END IF.l0:z1.index(x0).l0.i4:z1.y0.g4:WHILEx0<>z1.e1(b4).m0REP IFx0=z1.x0THENc4:=FALSE;LEAVEd4ELSEx0:=z1.index(x0).h0END IF END REP.o3:IFc4THENk0:=b4;b4:=z1.e1(k0).h0END IF.END PROCq3;PROCj4(DATEI VARz1,INT CONSTm2):disablestop;INT CONSTk0:=z1.z0,h0:=z1.e1(k0).h0,i0:=z1.e1(k0).i0;IFi0<>0THENz1.e1(i0).h0:=h0ELSEz1.d1(m2):=h0END IF;IFh0<>0THENz1.e1(h0).i0:=i0END IF.END PROCj4;PROCk4(DATEI VARz1,INT CONSTm2,i0,h0):disablestop;INT CONSTk0:=z1.z0;z1.e1(k0).h0:=h0;z1.e1(k0).i0:=i0;IFh0<>0THENz1.e1(h0).i0:=k0END IF;IFi0<>0THENz1.e1(i0).h0:=k0ELSEz1.d1(m2):=k0END IF END PROCk4;PROCsatzlesen(EUDAT CONSTz1,SATZ VARo0):o0:=z1.e1(z1.z0).o0END PROCsatzlesen;PROCsatzaendern(EUDAT VARz1,SATZ CONSTl4):IF NOTdateiende(z1)THENm4END IF.m4:j2(CONCR(z1));disablestop;l2(CONCR(z1),m2(l4));g2:=l4.g2:z1.e1(z1.z0).o0.END PROCsatzaendern;PROCl2(DATEI VARz1,INT CONSTn4):IFo4THENp4END IF.o4:INT CONSTq4:=m2(g2);q4<>n4.p4:r4;s4.r4:j4(z1,q4).s4:INT +VARh0,i0;q3(z1,n4,h0,i0);k4(z1,n4,h0,i0).g2:z1.e1(z1.z0).o0.END PROCl2;PROCsatzloeschen(EUDAT VARz1):IF NOTdateiende(z1)THENt4END IF.t4:disablestop;u4(CONCR(z1));v4(CONCR(z1));z1.w0DECR1.END PROCsatzloeschen;PROCu4(DATEI VARz1):w4(z1);INT CONSTk0:=z1.z0;j4(z1,m2(g2));z1.e1(k0).i0:=z1.u0;z1.u0:=k0.g2:z1.e1(k0).o0.END PROCu4;PROCsatzeinfuegen(EUDAT VARz1,SATZ CONSTl4):x4(CONCR(z1),l4)END PROCsatzeinfuegen;PROCx4(DATEI VARz1,SATZ CONSTl4):INT VARk0,h0,i0;enablestop;y4;z4;disablestop;z1.w0INCR1;a5(z1,k0);INT CONSTb5:=m2(k1);q3(z1,b5,i0,h0);k4(z1,b5,i0,h0);j2(z1).y4:IFz1.u0<>0THENk0:=z1.u0;z1.u0:=z1.e1(k0).i0ELIFz1.v0=d0THENerrorstop(i1)ELSEz1.v0INCR1;k0:=z1.v0END IF;z1.e1(k0).n0:=0;z1.e1(k0).o0:=l4.z4:feldlesen(l4,1,k1);IFz1.b1>0THEN IFk1=""THENc5;feldaendern(z1.e1(k0).o0,1,k1)END IF END IF.c5:k1:=text(z1.b1);k1:=d5+k1;IFz1.b1>32000THENz1.b1:=1ELSEz1.b1INCR1END IF.d5:(4-length(k1))*"0".END PROCx4;PROCautomatischerschluessel(EUDAT VARe5,BOOL CONSTf5):IFf5ANDe5.b1<0OR NOTf5ANDe5.b1>0THENe5. +b1:=-e5.b1END IF END PROCautomatischerschluessel;BOOL PROCautomatischerschluessel(EUDAT CONSTe5):e5.b1>0END PROCautomatischerschluessel;INTVEC VARg5;PROCv4(DATEI VARz1):INT CONSTx0:=z1.x0,h0:=index.h0,i0:=index.i0;BOOL VARh5;delete(index.l0,z1.y0);index.j0DECR1;i5(z1,x0,i0,h5);IF NOTh5THENi5(z1,h0,x0,h5)END IF;j5(z1).index:z1.index(x0).END PROCv4;PROCi5(DATEI VARz1,INT CONSTy3,k5,BOOL VARh5):h5:=FALSE;IFy3<>0ANDk5<>0THENl5END IF.l5:INT CONSTm5:=index.j0,n5:=o5.j0;IFp5THENq5;h5:=TRUE END IF.p5:m5+n5<=g0ORm5=0ORn5=0.q5:index.j0INCRo5.j0;r5(z1,o5.l0,y3);index.l0CATo5.l0;s5.s5:index.i0:=o5.i0;IFindex.i0<>0THENz1.index(index.i0).h0:=y3ELSEz1.r0:=y3END IF;o5.i0:=z1.t0;z1.t0:=k5.index:z1.index(y3).o5:z1.index(k5).END PROCi5;PROCj5(DATEI VARz1):INT CONSTg2:=z1.satznr;u2(z1,1,1,1);w2(z1,g2)END PROCj5;PROCr5(DATEI VARz1,INTVEC CONSTl0,INT CONSTy3):INT VARa2;FORa2FROM1UPTOlength(l0)DIV2REPz1.e1(l0ISUBa2).m0:=y3END REP END PROCr5;PROCa5(DATEI VARz1,INT CONSTt5):INT VARx0:=z1.x0;IFindex.j0>=f0THEN +u5END IF;index.j0INCR1;insert(index.l0,z1.y0,t5);z1.z0:=t5;z1.e1(t5).m0:=x0.u5:INT VARb5:=0;v5;IFb5<>0THENw5ELSEx5(z1)END IF;j5(z1);x0:=z1.x0.v5:IFz1.t0<>0THENb5:=z1.t0;z1.t0:=o5.i0ELIFz1.s00THENz1.index(b6).h0:=b5ELSEz1.r0:=b5END IF;o5.i0:=b6;o5.h0:=x0;index.i0:=b5.z5:INT VARa6;IFc6THENa6:=g0ELSEa6:=index.j0DIV2+1END IF.c6:b6=0.index:z1.index(x0).o5:z1.index(b5).END PROCa5;PROCx5(DATEI VARz1):INT VARx0:=1;REPd6;e6END REP.d6:BOOL VARh5;REP INT CONSTi0:=index.i0;i5(z1,x0,i0,h5)UNTIL NOTh5END REP;IFi0=0THEN LEAVEx5ELIFf6THENg6END IF.f6:INT CONSTh6:=g0-index.j0;h6>0.g6:x1(o5.l0,g5,h6+1);o5.j0DECRh6;r5(z1,g5,x0);index.l0CATg5;index.j0:=g0.e6:x0:=i0.index:z1.index(x0).o5:z1.index(i0).END PROCx5;TEXT VARi6:=",";LETj6=1;TEXT PROCdezimalkomma:i6END PROCdezimalkomma;PROCdezimalkomma(TEXT CONSTk6):IFlength(k6)<>1THENerrorstop(j1)ELSEi6:=k6 +ENDIF END PROCdezimalkomma;INT PROCunsortiertesaetze(EUDAT CONSTz1):z1.a1END PROCunsortiertesaetze;TEXT PROCsortierreihenfolge(EUDAT CONSTz1):z1.q0END PROCsortierreihenfolge;PROCj2(DATEI VARz1):IFl6(z1)THENdisablestop;z1.e1(z1.z0).n0INCRj6;z1.a1INCR1END IF END PROCj2;PROCw4(DATEI VARz1):IF NOTl6(z1)THENdisablestop;z1.e1(z1.z0).n0DECRj6;z1.a1DECR1END IF END PROCw4;BOOL PROCl6(DATEI CONSTz1,INT CONSTk0):(z1.e1(k0).n0ANDj6)=0END PROCl6;BOOL PROCl6(DATEI CONSTz1):l6(z1,z1.z0)END PROCl6;INTVEC VARm6;TEXT VARq0;TEXT VARn6,o6;PROCsortiere(EUDAT VARz1):q0:=z1.q0;IFq0=f1THENp6END IF;q6(CONCR(z1)).p6:INT VARa2;FORa2FROM1UPTOz1.felderzahlREPq0CATcode(a2)END REP.END PROCsortiere;PROCsortiere(EUDAT VARz1,TEXT CONSTr6):q0:=r6;q6(CONCR(z1))END PROCsortiere;PROCq6(DATEI VARz1):IFz1.q0<>q0THENz1.q0:=q0;z1.a1:=z1.w0+1ELIFz1.a1=0THEN LEAVEq6END IF;m6:=z1.feldinfo;IFs6THENt6(z1);z1.a1:=0ELSEu6(z1)END IF;w2(z1,1).s6:z1.w0DIVz1.a1<3.END PROCq6;PROCt6(DATEI VARz1):INT VARz0,o0:=1,v6;w2(z1,1);w4(z1);z0:=z1.z0 +;WHILEw6REPx6;y6;cout(o0)END REP;disablestop;x5(z1);u2(z1,1,1,1).w6:o0d7REPi3(z1);IFl7THEN LEAVEk7END IF END REP;LEAVEb7.l7:l6(z1).i7:IFm7GROESSERz1.e1(z0).o0THENe7:=f7-1ELSEd7:=f7+1END IF.m7:z1.e1(j7).o0.c7:p3(z1,z0);IFz1.satznrf8THEN LEAVEs7END IF.a8:IF NOT(n6LEXEQUALo6)THEN LEAVEs7END IF.c8:IFn6<>o6THEN LEAVEs7END IF.w7:IFd8THENe8>f8ELSEe8o6ELSEn6o6ELSEn60THENtext:="-"ELSEtext:=f1END IF;.m8:TEXT CONSTn8:=h8SUBk0;IFpos(i8,n8)>0THENtextCATn8ELIFn8=j8THENtextCAT +".";j8:=f1END IF.END PROCwertberechnen;PROCg8(TEXT VARo8):IFlength(o8)<>8THENo8:=f1ELSEo8:=subtext(o8,7)+subtext(o8,4,5)+subtext(o8,1,2)END IF END PROCg8;PROCreorganisiere(TEXT CONSTc2):EUDAT VARp8,q8;oeffne(p8,c2);disablestop;DATASPACE VARd2:=nilspace;oeffne(q8,d2);r8(CONCR(p8),q8);IF NOTiserrorTHENforget(c2,quiet);copy(d2,c2)END IF;forget(d2)END PROCreorganisiere;PROCr8(DATEI VARp8,EUDAT VARq8):enablestop;s8;t8(p8,CONCR(q8)).s8:w2(p8,1);aufsatz(q8,1);WHILE NOTdateiendeREPsatzeinfuegen(q8,u8);cout(p8.satznr);f3(p8);weiter(q8)END REP.dateiende:p8.satznr>p8.w0.u8:p8.e1(p8.z0).o0.END PROCr8;PROCt8(DATEI VARp8,q8):q8.felderzahl:=p8.felderzahl;q8.p0:=p8.p0;q8.feldinfo:=p8.feldinfo;q8.q0:=p8.q0;q8.c1(1):=p8.c1(1);q8.c1(2):=p8.c1(2);q8.c1(3):=p8.c1(3)END PROCt8;PROCnotizenlesen(EUDAT CONSTz1,INT CONSTv2,TEXT VARv8):v8:=z1.c1(v2)END PROCnotizenlesen;PROCnotizenaendern(EUDAT VARz1,INT CONSTv2,TEXT CONSTv8):z1.c1(v2):=v8END PROCnotizenaendern;END PACKETeudasdateien; +PACKETdatenverwaltungDEFINESoeffne,kopple,kette,zugriff,sichere,dateienloeschen,aufkoppeldatei,anzahlkoppeldateien,anzahldateien,aendernerlaubt,inhaltveraendert,eudasdateiname,folgedatei,herkunft,dateiversion,anzahlfelder,feldnamenlesen,feldnamenbearbeiten,feldnummer,feldinfo,notizenlesen,notizenaendern,feldlesen,feldbearbeiten,feldaendern,satznummer,satzkombination,dateiende,weiter,zurueck,aufsatz,satzeinfuegen,satzloeschen,aenderungeneintragen,suchbedingung,suchbedingunglesen,suchbedingungloeschen,suchversion,satzausgewaehlt,markierungaendern,satzmarkiert,markierungenloeschen,markiertesaetze:LET INTVEC=TEXT,DATEI=STRUCT(TEXTname,SATZb0,INTVECc0,INTd0,INTe0,INTf0,TASKg0,DATASPACEh0,EUDATi0,SATZj0,BOOLk0,BOOLl0,m0,n0,TEXTo0,INTVECp0,INTq0),VERWEIS=STRUCT(INTr0,s0);LETt0="",u0="";LETmaxint=32767,v0=10,w0=256,x0=32;ROWv0DATEI VARy0;INT VARz0:=0,a1:=0,b1,c1:=0,d1,e1:=0,f1,g1,h1,i1:=0;BOOL VARj1:=TRUE,k1,l1;TEXT VARm1;ROWw0VERWEIS VARn1;ROWx0VERWEIS VARo1;INT VARp1;LETq1= +#301#"Zuviel Dateien geoeffnet",r1= +#302#"Datei existiert nicht",s1= +#303#"Nicht moeglich, wenn auf Koppeldatei geschaltet",t1= +#304#"Zu viele Felder",u1= +#305#"Zu viele Koppelfelder",v1= +#306#"keine Koppelfelder vorhanden",w1= +#307#"kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien",x1= +#308#"keine Datei geoeffnet",y1= +#309#"Datei nicht gesichert",z1= +#310#"Suchmuster zu umfangreich"; +TEXT VARa2;TEXT VARb2:=" ";INTVEC VARc2;OP CAT(INTVEC VARtext,INT CONSTwert):replace(b2,1,wert);textCATb2END OP CAT;PROCinsert(INTVEC VARd2,INT CONSTe2,wert):INT CONSTf2:=e2+e2-2;c2:=subtext(d2,f2+1);d2:=subtext(d2,1,f2);d2CATwert;d2CATc2END PROCinsert;PROCdelete(INTVEC VARd2,INT CONSTe2):INT CONSTf2:=e2+e2-2;c2:=subtext(d2,f2+3);d2:=subtext(d2,1,f2);d2CATc2END PROCdelete;PROCg2(INTVEC VARd2,INT CONSTh2,i2):INT VARj2;FORj2FROMh2UPTOlength(d2)DIV2-1REPreplace(d2,j2,(d2ISUBj2)+i2)END REP END PROCg2;EUDAT VARk2;SATZ VARl2;PROCm2(TEXT CONSTn2):IFz0=v0THENerrorstop(q1)END IF;IF NOTexists(n2)THENerrorstop(r1)END IF;IFo2THENerrorstop(s1)END IF;oeffne(k2,n2)END PROCm2;PROCp2(DATEI VARr0,TEXT CONSTn2,TASK CONSTq2):IFk1OR NOTisniltask(q2)THENr0.h0:=old(n2);oeffne(r0.i0,r0.h0);IF NOTk1THENforget(n2,quiet)END IF ELSEoeffne(r0.i0,n2)END IF;r0.g0:=q2;r0.e0:=0;r0.l0:=FALSE;r0.m0:=FALSE;r0.name:=n2;r2(r0)END PROCp2;PROCs2(INT CONSTt2):INT VARu2:=t2;WHILEy0(u2).e0<>0REPu2:=y0(u2).e0END REP;y0(u2).e0:= +z0END PROCs2;PROCv2:IFdateiende(y0(1).i0)THENaufsatz(1)ELSEaufsatz(satznr(y0(1).i0))END IF END PROCv2;PROCw2:d1:=felderzahl(y0(1).i0);e1:=d1;feldnamenlesen(y0(1).i0,y0(1).b0);p1:=0;INT VARj2;FORj2FROM1UPTOe1REPn1(j2).r0:=0END REP END PROCw2;PROCx2:i1INCR1;IFi1>32000THENi1:=-32000END IF END PROCx2;PROCoeffne(TEXT CONSTn2,BOOL CONSTy2):oeffne(n2,y2,niltask)END PROCoeffne;PROCoeffne(TEXT CONSTn2,BOOL CONSTy2,TASK CONSTq2):enablestop;dateienloeschen(FALSE);suchbedingungloeschen;m2(n2);k1:=y2;z2;p2(y0(z0),n2,q2);v2;w2.z2:z0:=1;x2;h1:=0.END PROCoeffne;PROCkopple(TEXT CONSTn2):kopple(n2,niltask)END PROCkopple;PROCkopple(TEXT CONSTn2,TASK CONSTq2):enablestop;IFz0=0THENerrorstop(x1)END IF;m2(n2);a3;b3;c3;p2(y0(z0),n2,q2);d3.a3:feldnamenlesen(k2,l2);INT VARc0:=0;INTVEC VARe3:=u0;WHILEc00THENc0INCR1;e3CATindexEND IF UNTILindex=0END REP.b3:IFe1+felderzahl(k2)-c0>w0THENerrorstop(t1)ELIFp1+c0>x0THENerrorstop(u1) +ELIFc0=0THENerrorstop(v1)END IF;z0INCR1;y0(z0).b0:=l2;y0(z0).c0:=e3;y0(z0).d0:=c0;INT VARf3:=c0;WHILEf3=k3THENn1(m3).r0INCR1END IF END REP.c3:a1INCR1;IFc1=0THENc1:=z0ELSEs2(c1)END IF.d3:x2;y0(z0).k0:=FALSE;y0(z0).n0:=FALSE;y0(z0).f0:=satznr(k2);n3(y0(z0)).END PROCkopple;PROCkette(TEXT CONSTn2):kette(n2,niltask)END PROCkette;PROCkette(TEXT CONSTn2,TASK CONSTq2):enablestop;IFz0=0THENerrorstop(x1)END IF;m2(n2);z0INCR1;p2(y0(z0),n2,q2);s2(1);IFj1THENaufsatz(satznummer)END IF END PROCkette;PROCzugriff(PROC(EUDAT VAR)o3):IFz0>1ORo2THENerrorstop(w1)ELSEaenderungeneintragen;o3(y0(1).i0);x2;v2;w2;y0( +1).m0:=TRUE ENDIF END PROCzugriff;PROCsichere(INT CONSTp3,TEXT CONSTn2):aenderungeneintragen;notizenaendern(y0(p3).i0,2,date);IFk1THENforget(n2,quiet);copy(y0(p3).h0,n2)END IF;y0(p3).m0:=FALSE END PROCsichere;PROCdateienloeschen(BOOL CONSTq3):aenderungeneintragen;IFo2THENaufkoppeldatei(0)END IF;r3;s3.r3:a1:=0;c1:=0;y0(1).e0:=0;e1:=0;j1:=TRUE.s3:WHILEz0>0REP IFt3AND NOTq3THENerrorstop(y1);LEAVEdateienloeschenEND IF;forget(y0(z0).h0);z0DECR1END REP.t3:k1ANDy0(z0).m0.END PROCdateienloeschen;INT VARu3,v3,w3,x3,y3,z3,a4,b4;BOOL VARc4;INTVEC VARd4;SATZ VARe4;BOOL VARo2:=FALSE;INT VARf4:=0,g4:=1;BOOL PROCaufkoppeldatei:o2END PROCaufkoppeldatei;PROCaufkoppeldatei(INT CONSTh4):disablestop;x2;IFo2THENi4;o2:=FALSE;j4;k4ELSEl4;o2:=TRUE;m4END IF.i4:b1:=u3;d1:=v3;e1:=w3;f1:=x3;h1:=z3;c1:=a4;y0(g4).e0:=b4;n4:=f4;l1:=c4;o4:=d4;p4:=e4;IFn4>0THENq4:=1ELSEq4:=-1END IF.k4:f4:=0;g4:=1;enablestop;aufsatz(satznummer);WHILEg1<>y3REPweiter(1)END REP.j4:y0(g4).f0:=satznr(y0(g4).i0);IFh4=1AND NOTdateiende(y0(b1) +.i0)THENr4END IF.r4:INT VARs4;FORs4FROM1UPTOy0(g4).d0REPfeldaendern(y0(b1).i0,t4,u4)END REP;y3:=1.t4:y0(g4).c0ISUBs4.u4:feldlesen(y0(g4).i0,s4,a2);a2.l4:u3:=b1;v3:=d1;w3:=e1;x3:=f1;y3:=g1;z3:=h1;a4:=c1;b4:=y0(h4).e0;c4:=l1;d4:=o4;e4:=p4.m4:b1:=h4;f4:=n4;g4:=h4;d1:=felderzahl(y0(h4).i0);e1:=d1;f1:=0;h1:=(length(y0(h4).p0)-1)DIV2;c1:=0;y0(h4).e0:=0;suchbedingungloeschen;aufsatz(y0(h4).f0).END PROCaufkoppeldatei;INT PROCanzahlkoppeldateien:a1END PROCanzahlkoppeldateien;INT PROCanzahldateien:z0END PROCanzahldateien;BOOL PROCaendernerlaubt:k1END PROCaendernerlaubt;BOOL PROCinhaltveraendert(INT CONSTv4):aenderungeneintragen;y0(v4).m0END PROCinhaltveraendert;TEXT PROCeudasdateiname(INT CONSTv4):y0(v4).nameEND PROCeudasdateiname;INT PROCfolgedatei(INT CONSTv4):IFv4=0THENc1ELSEy0(v4).e0END IF END PROCfolgedatei;TASK PROCherkunft(INT CONSTv4):y0(v4).g0END PROCherkunft;INT PROCdateiversion:i1END PROCdateiversion;INT PROCanzahlfelder:e1END PROCanzahlfelder;PROCfeldnamenlesen(INT CONSTf3,TEXT VAR +name):IFf3<=d1THENfeldlesen(y0(g4).b0,f3,name)ELSEfeldlesen(w4,x4,name)END IF.w4:y0(n1(f3).r0).b0.x4:n1(f3).s0.END PROCfeldnamenlesen;PROCfeldnamenbearbeiten(INT CONSTf3,PROC(TEXT CONST,INT CONST,INT CONST)y4):IFf3<=d1THENfeldbearbeiten(y0(g4).b0,f3,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEfeldbearbeiten(w4,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)END IF.w4:y0(n1(f3).r0).b0.x4:n1(f3).s0.END PROCfeldnamenbearbeiten;INT PROCfeldnummer(TEXT CONSTz4):INT VARa5:=d1,h4:=feldindex(y0(g4).b0,z4),u2:=c1;WHILEh4=0ANDu2<>0REPh4:=feldindex(y0(u2).b0,z4);b5;u2:=y0(u2).e0END REP;h4.b5:INT CONSTc5:=y0(u2).d0;IFh4=0THENa5INCRfelderzahl(y0(u2).i0);a5DECRc5ELSEh4INCRa5;h4DECRc5END IF.END PROCfeldnummer;INT PROCfeldinfo(INT CONSTf3):IFf3<=d1THENfeldinfo(y0(g4).i0,f3)ELSEfeldinfo(y0(w4).i0,x4)END IF.w4:n1(f3).r0.x4:n1(f3).s0.END PROCfeldinfo;PROCnotizenlesen(INT CONSTh4,TEXT VARd5):notizenlesen(y0(g4).i0,h4,d5)END PROCnotizenlesen;PROCnotizenaendern(INT CONSTh4,TEXT CONSTd5):notizenaendern(y0(g4).i0,h4 +,d5);y0(g4).m0:=TRUE END PROCnotizenaendern;PROCfeldlesen(INT CONSTf3,TEXT VARd5):IFf3<=d1THENfeldlesen(y0(b1).i0,f3,d5)ELSEe5END IF.e5:INT CONSTw4:=n1(f3).r0;IFy0(w4).k0THENfeldlesen(y0(w4).j0,x4,d5)ELSEfeldlesen(y0(w4).i0,x4,d5)END IF.x4:n1(f3).s0.END PROCfeldlesen;PROCfeldbearbeiten(INT CONSTf3,PROC(TEXT CONST,INT CONST,INT CONST)y4):IFf3<=d1THENfeldbearbeiten(y0(b1).i0,f3,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEf5END IF.f5:INT CONSTw4:=n1(f3).r0;IFy0(w4).k0THENfeldbearbeiten(y0(w4).j0,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEfeldbearbeiten(y0(w4).i0,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)END IF.x4:n1(f3).s0.END PROCfeldbearbeiten;PROCfeldaendern(INT CONSTf3,TEXT CONSTd5):INT CONSTw4:=n1(f3).r0;IFf3<=d1THENg5ELSEh5END IF.g5:y0(b1).m0:=TRUE;IFi5CANDj5THENk5END IF;feldaendern(y0(b1).i0,f3,d5).i5:NOTo2CANDw4>0.j5:feldlesen(y0(b1).i0,f3,a2);a2<>d5.k5:INT VARl5:=x4,m5:=w4;REPn5(y0(o5));y0(o5).n0:=TRUE;feldaendern(y0(o5).j0,h3,d5);m5INCR1;l5DECR1UNTILl5=0END REP.h5:n5(y0(w4)); +IFp5THENy0(w4).l0:=TRUE;feldaendern(y0(w4).j0,x4,d5)END IF.p5:feldlesen(y0(w4).j0,x4,a2);a2<>d5.x4:n1(f3).s0.o5:o1(m5).r0.h3:o1(m5).s0.END PROCfeldaendern;PROCn5(DATEI VARr0):IF NOTr0.k0THENr0.k0:=TRUE;q5END IF.q5:IFdateiende(r0.i0)THENsatzinitialisieren(r0.j0,r0.d0);r5ELSEsatzlesen(r0.i0,r0.j0)END IF.r5:INT VARj2;FORj2FROM1UPTOr0.d0REPfeldlesen(r0.c0ISUBj2,a2);feldaendern(r0.j0,j2,a2)END REP.END PROCn5;PROCn3(DATEI VARr0):s5;t5.s5:feldlesen(y0(b1).i0,u5,o0).u5:r0.c0ISUB1.o0:r0.o0.t5:aufsatz(r0.i0,o0);WHILE NOTv5(r0)REPweiter(r0.i0,o0)END REP;IFdateiende(r0.i0)THENn5(r0)ELSEr0.k0:=FALSE END IF.END PROCn3;PROCw5:INT VARu2:=c1;WHILEu2<>0REPn3(y0(u2));u2:=y0(u2).e0END REP;g1:=1END PROCw5;BOOL PROCv5(DATEI CONSTr0):IF NOTdateiende(r0.i0)THENx5END IF;TRUE.x5:INT VARy5;FORy5FROM2UPTOr0.d0REPfeldlesen(y0(b1).i0,c0ISUBy5,a2);feldbearbeiten(r0.i0,y5,PROC(TEXT CONST,INT CONST,INT CONST)z5);IF NOTa6THEN LEAVEv5WITH FALSE END IF END REP.c0:r0.c0.END PROCv5;BOOL VARa6;PROCz5(TEXT CONSTb6,INT CONST +t2,c6):a6:=length(a2)+t2=c6+1CANDpos(b6,a2,t2,c6+1)=t2END PROCz5;LETd6=22101,e6="h",f6=""27"";BOOL VARg6;PROCh6:TEXT VARi6;g6:=FALSE;REPi6:=incharety;type(i6)UNTILi6=t0END REP END PROCh6;PROCj6:IFg6THENtype(f6)END IF END PROCj6;BOOL PROCk6:TEXT VARi6;REPi6:=incharety;IFi6=t0THEN LEAVEk6WITH FALSE ELSEl6END IF END REP;FALSE.l6:IFg6THENg6:=FALSE;m6ELSEn6END IF.m6:IFi6=e6THENo6;errorstop(d6,t0);LEAVEk6WITH TRUE ELSEtype(f6);type(i6)END IF.n6:IFi6=f6THENg6:=TRUE ELSEtype(i6)END IF.o6:REP UNTILgetcharety=t0END REP.END PROCk6;PROCweiter(INT CONSTp6):IF NOTj1THENaenderungeneintragen;q6END IF.q6:SELECTp6OF CASE1:r6CASE2:s6CASE3:t6END SELECT.r6:u6(FALSE).s6:h6;REPu6(l1);cout(satznummer)UNTILsatzausgewaehltORj1ORk6END REP;j6.t6:INT VARv6:=satznr(y0(b1).i0);WHILEw6ANDe0<>0REPx6;v6:=1END REP;aufsatz(y0(b1).i0,y6);cout(satznummer);w5;j1:=dateiende(y0(b1).i0);z6.w6:a7(y0(b1),v6+1);INT CONSTy6:=y0(b1).p0ISUBy0(b1).q0;y6=maxint.e0:y0(b1).e0.END PROCweiter;PROCzurueck(INT CONSTp6):IFsatznummer>1THEN +aenderungeneintragen;b7END IF.b7:SELECTp6OF CASE1:c7CASE2:d7CASE3:e7END SELECT.c7:f7(FALSE).d7:h6;REPf7(l1);cout(satznummer)UNTILsatzausgewaehltORsatznummer=1ORk6END REP;j6.e7:INT VARv6:=satznr(y0(b1).i0);WHILEw6ANDb1<>1REPg7;v6:=maxint-1END REP;aufsatz(y0(b1).i0,h7);cout(satznummer);w5;j1:=FALSE;z6.w6:INT VARh7;a7(y0(b1),v6);IFy0(b1).q0=1THENh7:=1;TRUE ELSEh7:=y0(b1).p0ISUB(y0(b1).q0-1);FALSE END IF.END PROCzurueck;PROCu6(BOOL CONSTi7):j7;IFk7THENr6;w5ELSEg1INCR1END IF;z6.j7:INT VARu2:=c1;WHILEu2>0REPl7;u2:=y0(u2).e0END REP.l7:BOOL VARm7;n7(y0(u2),m7);IFm7THEN LEAVEj7END IF.k7:u2=0.r6:IFi7THENweiter(y0(b1).i0,m1)ELSEweiter(y0(b1).i0)END IF;WHILEdateiende(y0(b1).i0)REPo7UNTILj1END REP.o7:IFy0(b1).e0<>0THENx6;p7ELSEj1:=TRUE END IF.p7:aufsatz(y0(b1).i0,1).END PROCu6;PROCn7(DATEI VARr0,BOOL VARm7):IFdateiende(r0.i0)THENm7:=FALSE ELSEq7END IF.q7:m7:=TRUE;REPweiter(r0.i0,r0.o0);IFdateiende(r0.i0)THENm7:=FALSE;aufsatz(r0.i0,r0.o0)END IF UNTILv5(r0)END REP.END PROCn7;PROCf7(BOOL CONSTi7): +WHILEsatznr(y0(b1).i0)=1CANDsatznummer>1REPg7;r7(y0(b1).i0)END REP;IFi7THENzurueck(y0(b1).i0,m1)ELSEzurueck(y0(b1).i0)END IF;j1:=FALSE;w5;z6END PROCf7;PROCx6:f1INCRsaetze(y0(b1).i0);b1:=y0(b1).e0END PROCx6;PROCg7:INT VARs7:=1;WHILEy0(s7).e0<>b1REPs7:=y0(s7).e0END REP;f1DECRsaetze(y0(s7).i0);b1:=s7END PROCg7;PROCaenderungeneintragen:INT VARu2:=c1;WHILEu2<>0REPt7;u2:=y0(u2).e0END REP.t7:IFy0(u2).k0THENu7(y0(u2))END IF.END PROCaenderungeneintragen;PROCu7(DATEI VARr0):IFv7AND NOTw7THENx7ELIFy7ANDz7THENa8ELIFw7THENn3(r0)END IF;b8;l0:=FALSE;w7:=FALSE.v7:NOTdateiende(r0.i0)ANDl0.y7:felderzahl(j0)>r0.d0.z7:w7ORl0.a8:m0:=TRUE;feldlesen(j0,1,r0.o0);satzeinfuegen(r0.i0,j0).b8:r0.k0:=FALSE.x7:m0:=TRUE;satzaendern(r0.i0,j0).l0:r0.l0.w7:r0.n0.j0:r0.j0.m0:r0.m0.END PROCu7;PROCr7(EUDAT VARi0):aufsatz(i0,saetze(i0)+1)END PROCr7;PROCaufsatz(INT CONSTsatznr):aenderungeneintragen;b1:=g4;f1:=0;WHILEc8ANDd8REPx6END REP;aufsatz(y0(b1).i0,satznr-f1);w5;j1:=dateiende(y0(b1).i0);z6.c8:satznr-f1>saetze(y0(b1).i0 +).d8:y0(b1).e0<>0.END PROCaufsatz;PROCaufsatz(TEXT CONSTe8):aenderungeneintragen;f8(e8,j1);w5;z6END PROCaufsatz;PROCf8(TEXT CONSTe8,BOOL CONSTg8):IFg8THENaufsatz(1)END IF;REPaufsatz(y0(b1).i0,e8);IF NOTdateiende(y0(b1).i0)THENj1:=FALSE;LEAVEf8ELIFy0(b1).e0=0THENj1:=TRUE;IF NOTg8THENf8(e8,TRUE)END IF;LEAVEf8END IF;x6END REP END PROCf8;INT PROCsatznummer:f1+satznr(y0(b1).i0)END PROCsatznummer;INT PROCsatzkombination:g1END PROCsatzkombination;BOOL PROCdateiende:j1END PROCdateiende;SATZ VARh8;satzinitialisieren(h8);PROCsatzeinfuegen:aenderungeneintragen;i8;satzeinfuegen(y0(b1).i0,h8);y0(b1).m0:=TRUE;j8;j1:=FALSE;z6.i8:a7(y0(b1),satznr(y0(b1).i0));g2(y0(b1).p0,y0(b1).q0,1).j8:g1:=1;INT VARu2:=c1;WHILEu2<>0REPr7(y0(u2).i0);u2:=y0(u2).e0END REP.END PROCsatzeinfuegen;PROCsatzloeschen:IF NOTj1THENaenderungeneintragen;k8;satzloeschen(y0(b1).i0);y0(b1).m0:=TRUE;aufsatz(satznummer)END IF.k8:IFsatzmarkiertTHENdelete(y0(b1).p0,y0(b1).q0);h1DECR1END IF;g2(y0(b1).p0,y0(b1).q0,-1).END PROCsatzloeschen; +LETl8=100;ROWl8STRUCT(INTs0,m8,n8,o8,TEXTo0)VARp8;SATZ VARp4;INT VARn4,q4,q8:=1;BOOL VARr8,s8;suchbedingungloeschen;INT VARt8;LETu8=1,v8=2,w8=3,x8=4,y8=5,z8=6,a9=7,b9=8,c9=9;PROCz6:IFj1THENs8:=FALSE ELSEd9;s8:=e9END IF.d9:t8:=q4;WHILEt8>0REPf9;feldbearbeiten(g9,PROC(TEXT CONST,INT CONST,INT CONST)h9)END REP.f9:INT VARi9:=p8(t8).m8;IFi9>=256THENj9;k9END IF.j9:feldlesen((i9AND255)+1,a2).k9:IFl9=2THENm9END IF;p8(t8).o0:=a2.g9:p8(t8).s0.e9:t8<0.END PROCz6;PROCh9(TEXT CONSTb6,INT CONSTn9,o9):INT VARi9:=p8(t8).m8;IFi9>=256THENi9:=i9DIV256END IF;IFp9THENt8:=p8(t8).n8ELSEt8:=p8(t8).o8END IF.p9:SELECTi9OF CASEu8:q9CASEv8:r9CASEw8:s9CASEx8:t9CASEy8:u9CASEz8:v9CASEa9:w9CASEb9:x9CASEc9:y9OTHERWISE FALSE END SELECT.q9:SELECTl9OF CASE0:z9;a2LEXEQUALo0CASE1:z9;a10=b10OTHERWISElength(o0)=o9-n9+1ANDc10END SELECT.c10:n9>o9CORr9.r9:pos(b6,o0,n9,o9)=n9.s9:pos(b6,o0,o9+1-length(o0),o9)>0.t9:pos(b6,o0,n9,o9)>0.u9:z9;SELECTl9OF CASE0:o0LEXGREATERa2CASE1:a10=b10CASE2:m9;a2>=o0OTHERWISEa2>=o0END SELECT.w9:n9<=o9.x9:satzmarkiert.y9:TRUE.z9:a2:=subtext(b6,n9,o9).END PROCh9;TEXT PROCo0:p8(t8).o0END PROCo0;PROCm9:IFlength(a2)=8THEN TEXT CONSTd10:=subtext(a2,7,8);replace(a2,7,subtext(a2,1,2));replace(a2,1,d10)ELSEa2:=t0END IF END PROCm9;INT PROCl9:feldinfo(p8(t8).s0)END PROCl9;REAL PROCa10:REAL VARe10;wertberechnen(a2,e10);e10END PROCa10;REAL PROCb10:REAL VARe10;wertberechnen(o0,e10);e10END PROCb10;LETf10=";",g10=",",h10="..",i10="++",j10="--",k10="*";BOOL VARl10,m10,n10;INT VARo10,p10,q10,r10,s10;INTVEC VARo4;PROCsuchbedingung(INT CONSTf3,TEXT CONSTp8):INT VARt2:=1,t10:=0;INT CONSTu10:=length(p8)+1;p10:=0;s10:=f3;o10:=n4+1;WHILEt21THENl1:=FALSE END IF;t10:=pos(p8,f10,t2);IFt10=0THENt10:=u10END IF.w10:z10;m10:= +TRUE;INT CONSTa11:=pos(p8,h10,t2,c6+1);IFb11THENc11(t0,c9,-p10)ELIFa11=0THENd11ELSEe11END IF.z10:IFsubtext(p8,t2,t2+1)=j10THENt2INCR2;n10:=TRUE ELSEn10:=FALSE END IF.b11:t2>c6.d11:IFf11THENg11ELSEh11END IF.f11:t2+1=c6CANDsubtext(p8,t2,c6)=i10.g11:c11(t0,b9,-p10).h11:INT VARi11:=pos(p8,k10,t2,c6+1);IFi11=0THENj11ELIFt2=c6THENk11ELSEl11;REPm11END REP END IF.j11:IFn11THENl1:=TRUE;m1:=p8END IF;c11(subtext(p8,t2,c6),u8,-p10).n11:f3=1ANDt2=1ANDc6=u10-1ANDo11AND NOTo2AND(p8SUB1)<>"&".o11:length(o4)<=2.k11:c11(t0,a9,-p10).l11:INT VARm8;IFi11=t2THENm8:=u8ELSEm8:=v8END IF.m11:IFm8<>u8THENp11END IF;t2:=i11+1;i11:=pos(p8,k10,t2,c6+1);IFi11=0THENi11:=c6+1;m8:=w8ELSEm8:=x8END IF.p11:TEXT CONSTo0:=subtext(p8,t2,i11-1);IFn10ORq11THEN IFn10THENm10:=TRUE END IF;c11(o0,m8,-p10);IFq11THEN LEAVEh11END IF ELSEc11(o0,m8,n4+2)END IF.q11:i11>=c6.e11:TEXT CONSTr11:=subtext(p8,t2,a11-1),s11:=subtext(p8,a11+2,c6);IFa11=t2THENc11(s11,y8,-p10)ELIFa11=c6-1THENc11(r11,z8,-p10)ELSEt11END IF.t11:IFn10THENc11(r11,z8,- +p10);m10:=TRUE ELSEc11(r11,z8,n4+2)END IF;c11(s11,y8,-p10).END PROCsuchbedingung;PROCc11(TEXT CONSTu11,INT CONSTm8,n8):v11;w11;IFl10THENx11;y11;r10:=n4ELIFm10THENz11END IF;a12;b12.v11:r8:=FALSE;IFn4=f4THENq8INCR1;IFq8>32000THENq8:=1END IF END IF.w11:IFn4=l8THENsuchbedingungloeschen;errorstop(z1)ELSEn4INCR1;q4:=f4+1END IF.x11:IFp10>length(o4)DIV2THENo4CATn4;c12(q4,0,n4)END IF;IFp10=length(o4)DIV2THENq10:=0ELSEq10:=o4ISUB(p10+1)END IF.y11:c12(q4,-p10,n4);l10:=FALSE;m10:=FALSE.z11:c12(r10,q10,n4);r10:=n4;m10:=FALSE.a12:p8(n4).m8:=m8;p8(n4).s0:=s10;IFn10THENp8(n4).n8:=q10;p8(n4).o8:=n8ELSEp8(n4).n8:=n8;p8(n4).o8:=q10END IF.b12:IFd12THENe12ELSEf12END IF.d12:(u11SUB1)="&"CANDg12.g12:INT CONSTh12:=feldnummer(subtext(u11,2));h12>0.e12:p8(n4).m8:=h12-1+256*m8.f12:INT CONSTi12:=feldinfo(s10);IFi12=2AND(m8=y8ORm8=z8)THENa2:=u11;m9;p8(n4).o0:=a2ELSEp8(n4).o0:=u11END IF.END PROCc11;PROCc12(INT CONSTn9,wert,j12):INT VARj2;FORj2FROMn9UPTOn4-1REP IFp8(j2).n8=wertTHENp8(j2).n8:=j12ELIFp8(j2).o8=wert +THENp8(j2).o8:=j12END IF END REP END PROCc12;PROCsuchbedingunglesen(INT CONSTf3,TEXT VARp8):feldlesen(p4,f3,p8)END PROCsuchbedingunglesen;PROCsuchbedingungloeschen:disablestop;IFo2THENn4:=f4ELSEf4:=0;n4:=0END IF;q4:=-1;o4:=u0;satzinitialisieren(p4);l1:=FALSE;r8:=TRUE;s8:=NOTj1END PROCsuchbedingungloeschen;BOOL PROCsatzausgewaehlt:IF NOTr8THENz6;r8:=TRUE END IF;s8END PROCsatzausgewaehlt;INT PROCsuchversion:IFn4=f4THEN0ELSEq8END IF END PROCsuchversion;PROCa7(DATEI VARr0,INT CONSTb6):IF(r0.p0ISUBr0.q0)=b6END REP.l12:WHILEr0.q0>1CAND(r0.p0ISUB(r0.q0-1))>=b6REPr0.q0DECR1END REP.END PROCa7;PROCmarkierungaendern:disablestop;IFsatzmarkiertTHENdelete(y0(b1).p0,y0(b1).q0);h1DECR1ELSEinsert(y0(b1).p0,y0(b1).q0,satznr(y0(b1).i0));h1INCR1END IF END PROCmarkierungaendern;BOOL PROCsatzmarkiert:INT CONSTb6:=satznr(y0(b1).i0);a7(y0(b1),b6);b6=(y0(b1).p0ISUBy0(b1).q0)END PROCsatzmarkiert;INT PROCmarkiertesaetze:h1END PROCmarkiertesaetze;PROC +markierungenloeschen:disablestop;IFo2THENr2(y0(b1))ELSEm12END IF;h1:=0.m12:INT VARu2:=1;REPr2(y0(u2));u2:=y0(u2).e0UNTILu2=0END REP.END PROCmarkierungenloeschen;PROCr2(DATEI VARr0):r0.p0:=t0;r0.p0CATmaxint;r0.q0:=1END PROCr2;END PACKETdatenverwaltung; + diff --git a/app/eudas/5.3/src/eudas.2 b/app/eudas/5.3/src/eudas.2 new file mode 100644 index 0000000..50fc707 --- /dev/null +++ b/app/eudas/5.3/src/eudas.2 @@ -0,0 +1,73 @@ +PACKETverarbeitungDEFINESkopiere,stdkopiermuster,verarbeite,trage,eindeutigefelder,pruefe,wertemenge,feldmaske,tragesatz,holesatz,K,V,f,wert,zahltext,textdarstellung:SATZ VARb0,c0,d0;INT VARe0;BOOL VARf0;LETg0="",INTVEC=TEXT;INTVEC VARh0;TEXT VARi0:=" ";OP CAT(INTVEC VARj0,INT CONSTk0):replace(i0,1,k0);j0CATi0END OP CAT;PROCstdkopiermuster(TEXT CONSTl0,FILE VARm0):n0;INT VARo0;p0;q0;INT VARr0;FORr0FROM1UPTOo0REPs0;IFt0THENu0ELSEv0END IF END REP.p0:output(m0);EUDAT VARw0;IFexists(l0)THENoeffne(w0,l0)END IF.q0:IFexists(l0)CANDfelderzahl(w0)>0THENfeldnamenlesen(w0,b0);o0:=felderzahl(w0)ELSEx0;o0:=anzahlfelderEND IF.x0:TEXT VARy0;satzinitialisieren(b0);FORr0FROM1UPTOanzahlfelderREPfeldnamenlesen(r0,y0);feldaendern(b0,r0,y0)END REP.t0:feldnummer(y0)>0.s0:feldlesen(b0,r0,y0);put(m0,textdarstellung(y0)).u0:write(m0,"K f(");write(m0,textdarstellung(y0));putline(m0,");").v0:putline(m0,"K """";").END PROCstdkopiermuster;PROCkopiere(TEXT CONSTl0,FILE VARm0):z0(a1,m0).a1:"kopiere ("+ +textdarstellung(l0)+", ".END PROCkopiere;PROCz0(TEXT CONSTb1,FILE VARc1):d1;write(e1,b1);putline(e1,"PROC programmfunktion);");putline(e1,"PROC programmfunktion:");f1;putline(e1,"END PROC programmfunktion");g1;forget(h1,quiet).d1:TEXT VARh1;INT VARi1:=0;REPi1INCR1;h1:=text(i1)UNTIL NOTexists(h1)END REP;disablestop;FILE VARe1:=sequentialfile(output,h1);headline(e1,j1).f1:TEXT VARk1;input(c1);WHILE NOTeof(c1)REPgetline(c1,k1);putline(e1,k1)END REP.g1:TEXT CONSTl1:=std;run(h1);lastparam(l1).END PROCz0;PROCkopiere(TEXT CONSTl0,PROCm1):enablestop;INT VARn1;o1(n1);IFdateiendeTHENaufsatz(1);LEAVEkopiereELSEp1END IF;WHILE NOTdateiendeREPsatzinitialisieren(d0);e0:=1;m1;q1;satzeinfuegen(w0,d0);weiter(w0);weiter(n1)END REP;aufsatz(1).p1:f0:=TRUE;EUDAT VARw0;oeffne(w0,l0);aufsatz(w0,saetze(w0)+1);feldnamenlesen(w0,c0);h0:=g0.q1:IFf0THENfeldnamenaendern(w0,c0);f0:=FALSE END IF END PROCkopiere;OP K(TEXT CONSTy0,r1):IFf0THENs1;END IF;feldaendern(d0,h0ISUBe0,r1);e0INCR1.s1:INT VARt1:=feldindex(c0,y0); +IFt1=0THENt1:=felderzahl(c0)+1;feldaendern(c0,t1,y0);END IF;h0CATt1.END OP K;PROCverarbeite(FILE VARu1):z0("verarbeite (",u1)END PROCverarbeite;PROCverarbeite(PROCv1):enablestop;INT VARn1;o1(n1);WHILE NOTdateiendeREPv1;weiter(n1)END REP;aufsatz(1)END PROCverarbeite;OP V(TEXT CONSTy0,r1):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0)ELSEfeldaendern(w1,r1)END IF END OP V;PROCo1(INT VARn1):n0;aufsatz(1);IFmarkiertesaetze>0THENn1:=3;IF NOTsatzmarkiertTHENweiter(n1)END IF ELSEn1:=2;IF NOTsatzausgewaehltTHENweiter(n1)END IF END IF END PROCo1;PROCn0:IFanzahldateien=0THENerrorstop(y1)END IF.END PROCn0;TEXT VARz1,a2;LETb2="""";TEXT PROCf(TEXT CONSTy0):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0);z1:=g0ELSEfeldlesen(w1,z1)END IF;z1END PROCf;REAL PROCwert(TEXT CONSTy0):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0);0.0ELSEfeldlesen(w1,z1);REAL VARc2;wertberechnen(z1,c2);c2END IF END PROCwert;REAL PROCwert(TEXT CONSTy0,INT CONSTd2):round(wert(y0),d2)END PROCwert;TEXT PROCzahltext(REAL CONSTe2,INT +CONSTd2):REAL CONSTf2:=round(abs(e2),d2);INT VARg2:=h2+d2+2;IFe2<0.0THENa2:="-"ELSEa2:=g0END IF;IFf2<1.0ANDf2<>0.0THENa2CAT"0";g2DECR1ENDIF;a2CATtext(f2,g2,d2);IFd2>0THENchange(a2,".",dezimalkomma)ELSEchange(a2,".",g0)END IF;a2.h2:max(0,decimalexponent(f2)).END PROCzahltext;TEXT PROCzahltext(TEXT CONSTy0,INT CONSTd2):zahltext(wert(y0),d2)END PROCzahltext;TEXT PROCtextdarstellung(TEXT CONSTi2):z1:=i2;changeall(z1,b2,b2+b2);j2;insertchar(z1,b2,1);z1CATb2;z1.j2:INT VARk2:=1;WHILEl2REPchange(z1,k2,k2,m2)END REP.l2:k2:=pos(z1,""0"",""31"",k2);k2>0.m2:b2+text(code(z1SUBk2))+b2.END PROCtextdarstellung;PROCx1(TEXT CONSTy0):errorstop(n2+textdarstellung(y0)+o2)END PROCx1;SATZ VARp2;EUDAT VARq2;LETj1= +#501#"erzeugtes Programm",y1= +#502#"keine Datei geoeffnet",r2= +#503#"Kein Satz zum Tragen vorhanden",s2= +#504#"Zieldatei hat falsche Felderzahl",t2= +#505#" existiert nicht",u2= +#506#" verletzt die Pruefbedingung.",v2= +#507#" ist in der Zieldatei bereits vorhanden.",o2= +#508#" ist nicht definiert.",w2= +#509#" ist nicht in der Wertemenge.",x2= +#510#" stimmt nicht mit der Maske ueberein.",y2= +#511#"Satz ",n2= +#512#"Das Feld "; +INT VARz2;FILE VARa3;BOOL VARb3:=FALSE,c3,d3;TEXT VARe3;PROCtrage(TEXT CONSTl0,FILE VARf3,BOOL CONSTg3):disablestop;b3:=g3;IFb3THENa3:=f3;output(a3)END IF;h3(l0);b3:=FALSE END PROCtrage;PROCh3(TEXT CONSTl0):enablestop;INT VARn1;o1(n1);i3(l0);INT VARj3:=0;REP IF NOTk3THENweiter(n1)ELSEcout(satznummer+j3)END IF;IFdateiendeTHENaufsatz(1);LEAVEh3END IF;l3END REP.k3:IFn1=3THENsatzmarkiertELSEsatzausgewaehltEND IF.l3:c3:=TRUE;IFb3THENnotizenlesen(q2,1,e3);do(e3)END IF;IFc3THENm3;IFc3THENsatzloeschen;j3INCR1END IF END IF;IF NOTc3THENweiter(n1)END IF.END PROCh3;PROCi3(TEXT CONSTl0):IFdateiendeTHENerrorstop(r2)END IF;oeffne(q2,l0);z2:=0;IFfelderzahl(q2)=0THENp1ELIFfelderzahl(q2)<>anzahlfelderTHENerrorstop(s2)END IF;aufsatz(q2,saetze(q2)+1).p1:satzinitialisieren(p2,anzahlfelder);INT VARr0;FORr0FROM1UPTOanzahlfelderREPfeldnamenlesen(r0,z1);feldaendern(p2,r0,z1)END REP;feldnamenaendern(q2,p2);n3;o3.n3:FORr0FROM1UPTOanzahlfelderREPfeldinfo(q2,r0,feldinfo(r0))END REP.o3:INT VARi1;FORi1FROM1UPTO3REP +notizenlesen(i1,z1);notizenaendern(q2,i1,z1)END REP.END PROCi3;PROCm3:IFz2>0CANDp3THENq3("",v2)ELSEr3;satzeinfuegen(q2,p2);weiter(q2)END IF.r3:satzinitialisieren(p2,anzahlfelder);INT VARr0;FORr0FROM1UPTOanzahlfelderREPfeldlesen(r0,z1);feldaendern(p2,r0,z1)END REP.p3:TEXT VARc1;INT CONSTs3:=satznr(q2);feldlesen(1,c1);d3:=FALSE;aufsatz(q2,c1);WHILE NOTdateiende(q2)REPt3;weiter(q2,c1)UNTILd3END REP;aufsatz(q2,s3);d3.t3:INT VARi1;d3:=TRUE;FORi1FROM2UPTOz2REPfeldlesen(q2,i1,z1);feldbearbeiten(i1,PROC(TEXT CONST,INT CONST,INT CONST)u3);IF NOTd3THEN LEAVEt3END IF END REP.END PROCm3;PROCu3(TEXT CONSTv3,INT CONSTw3,x3):IFy3COR(length(z1)>0CANDz3)THENd3:=FALSE END IF.y3:(x3-w3+1)<>length(z1).z3:pos(v3,z1,w3,x3+1)<>w3.END PROCu3;PROCq3(TEXT CONSTa4,b4):IFb3THENc4ELSEerrorstop(b4)END IF.c4:put(a3,y2);put(a3,satznummer);IFa4<>""THENwrite(a3,n2);write(a3,textdarstellung(a4))END IF;putline(a3,b4);c3:=FALSE.END PROCq3;PROCeindeutigefelder(INT CONSTd4):z2:=d4END PROCeindeutigefelder;PROCpruefe(TEXT +CONSTa4,BOOL CONSTe4):IF NOTe4THENq3(a4,u2)END IF END PROCpruefe;PROCwertemenge(TEXT CONSTa4,f4):INT CONSTw1:=feldnummer(a4);IFw1=0THENq3(a4,o2)ELSEg4END IF.g4:INT VARk2:=0;LETh4=",";feldlesen(w1,z1);IFi4THEN LEAVEg4END IF;z1CATh4;REPk2:=pos(f4,z1,k2+1);IFk2=1ORk2>1CAND(f4SUBk2-1)=h4THEN LEAVEg4END IF UNTILk2=0END REP;q3(a4,w2).i4:INT CONSTj4:=length(f4)-length(z1);(f4SUBj4)=h4ANDpos(f4,z1,j4+1)>0.END PROCwertemenge;PROCfeldmaske(TEXT CONSTa4,k4):INT CONSTw1:=feldnummer(a4);IFw1=0THENq3(a4,o2)ELSEfeldlesen(w1,z1);l4END IF.l4:INT VARk2;TEXT CONSTm4:=code(length(k4)+1);TEXT VARn4:=""1"";FORk2FROM1UPTOlength(z1)REP TEXT CONSTo4:=z1SUBk2;p4UNTILn4=""END REP;IFq4THENq3(a4,x2)END IF.p4:INT VARr4:=1;WHILEr4<=length(n4)REP INT CONSTs4:=code(n4SUBr4);IF(k4SUBs4)="*"THENt4ELIFu4THENreplace(n4,r4,code(s4+1));r4INCR1ELSEdeletechar(n4,r4)END IF END REP.t4:IFs4=length(k4)THEN LEAVEfeldmaskeEND IF;r4INCR1;IFpos(n4,code(s4+1))=0THENinsertchar(n4,code(s4+1),r4)END IF.u4:SELECTpos("9XAa",k4SUBs4)OF CASE +1:pos("0123456789",o4)>0CASE2:TRUE CASE3:pos("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",o4)>0CASE4:pos("abcdefghijklmnopqrstuvwxyzäöüß",o4)>0OTHERWISE(k4SUBs4)=o4END SELECT.q4:(n4=""CORpos(n4,m4)=0)ANDv4.v4:(k4SUBlength(k4))<>"*"ORpos(n4,code(length(k4)))=0.END PROCfeldmaske;PROCtragesatz(TEXT CONSTl0):i3(l0);INT CONSTw4:=satznr(q2);m3;satzloeschen;aufsatz(q2,w4)END PROCtragesatz;PROCholesatz(TEXT CONSTl0):n0;IF NOTexists(l0)THENerrorstop(textdarstellung(l0)+t2)END IF;oeffne(q2,l0);IFfelderzahl(q2)<>anzahlfelderTHENerrorstop(s2)ELIFsaetze(q2)=0THENerrorstop(r2)END IF;aufsatz(q2,saetze(q2));satzlesen(q2,p2);x4;satzloeschen(q2).x4:satzeinfuegen;INT VARr0;FORr0FROM1UPTOfelderzahl(p2)REPfeldlesen(p2,r0,z1);feldaendern(r0,z1)END REP.END PROCholesatz;END PACKETverarbeitung; +PACKETeudasdruckenDEFINESdrucke,interpretiere,gruppentest,druckdatei,direktdrucken,druckrichtung,maxdruckzeilen,gruppenwechsel,lfdnr:LETb0=25,SPEICHER=STRUCT(INTc0,d0,e0,f0,TEXTg0);ROWb0SPEICHER VARh0;INT VARi0;LETj0="",k0=" ",l0="#",m0=" ";TEXT VARn0;PROCinterpretiere(INT CONSTo0,p0,PROC(INT CONST,TEXT VAR)q0):INT VARr0,s0:=0,t0:=0,u0:=p0;v0(o0);WHILE NOTw0REPx0;IFy0THENs0INCR1ELSEz0;a1END IF END REP.a1:IFb1(r0)THENc1ELSEd1;t0:=0END IF.c1:SELECTr0OF CASEe1:f1CASEg1:h1OTHERWISE LEAVEinterpretiereEND SELECT.z0:WHILEs0>0REPi1(k0);s0DECR1END REP.f1:j1(i0).h1:j1(t0).y0:k1=j0ORk1=k0.d1:INT VARl1:=0,m1:=0;BOOL VARn1:=FALSE;REPo1;l1INCR1;IFi0=3THENn1:=TRUE END IF UNTILp1END REP.p1:IFi0<=2THEN TRUE ELIFt0<>0THENl1=t0ELSEm1=0END IF.o1:INT VARq1:=1,r1:=0,s1:=0,t1:=1,u1:=1;n0:=j0;REP IFv1THENw1END IF;IFx1THENy1END IF;z1;t1INCR1END REP.v1:l1=0.w1:a2(b2.c0,b2.d0,b2.e0);IF NOTc2THENd2;e2END IF.c2:b2.c0>length(k1).d2:IFf2ANDg2THENh2END IF.g2:(b2.e0AND1)=0.h2:INT VARi2:=b2.c0+b2.d0;IF(k1SUBi2)=k0THEN + WHILE(k1SUBi2+1)=k0REPi2INCR1;b2.d0INCR1END REP END IF.e2:INT CONSTj2:=k2(u0);IFj2>0THENfeldlesen(j2,b2.g0)ELSEq0(-j2,b2.g0)END IF;u0INCR1;b2.f0:=0;IFb2.g0<>j0THENm1INCR1END IF.x1:b2.e0>=4.b2:h0(t1).z1:INT CONSTreserve:=l2(b2);IFreserve>0THENm2ELSEs1DECRreserveEND IF.m2:r1INCRreserve;IFf2ANDr1>s1THENr1:=s1END IF;IFn2ANDo2THENp2END IF.f2:i0=2ORi0=4.n2:reserve=b2.d0.o2:(b2.e0AND1)=0.p2:IFb2.c0=1COR(k1SUB(b2.c0-1))=k0THEN INT VARq2:=r2(t1);WHILE(k1SUBq2)=k0REPq2INCR1;b2.d0INCR1;r1INCR1END REP END IF.y1:IFt1=1THEN IFc2THENs2END IF ELSEt2END IF.s2:IFn1THENi1(k0)ELSEi1(k1)END IF;LEAVEo1.t2:INT VARu2:=0,v2:=b2.c0;INT CONSTw2:=v2-length(k1);x2;y2;z2;a3.x2:IFw2>0THENr1INCRw2;v2DECR(w2-1)END IF;b3.b3:INT CONSTc3:=r2(t1-1),d3:=pos(k1,m0,c3,v2);IFd3>0THENv2:=d3;e3ELIFw2<0AND(k1SUB(v2-1))<>k0THENv2:=c3END IF.e3:INT VARf3:=v2+1;REPu2INCR1;f3INCR1UNTIL(k1SUBf3)<>k0END REP;r1INCRu2.y2:INT VARg3:=0;WHILEu1=3.e4:NOTh4.j4:IFv3THENu3(a4)END IF;n4(k3.g0,b4,c4);IFo4THENu3(a4)END IF.o4:NOTv3.i4:IFpos(k3.g0,k0,b4,c4)>0THENp4END IF;INT CONSTq4:=pos(k3.g0,"!","�",c4+1);IFq4=0THENk3.f0:=length(k3.g0);m1DECR1ELSEk3.f0:=q4-1END IF.p4:c4INCR1;a4DECR1;WHILE(k3.g0SUBc4)<>k0REPc4DECR1;a4INCR1 +END REP;WHILE(k3.g0SUBc4)=k0REPc4DECR1;a4INCR1UNTILq20THENr4;s4;LEAVEo1ELSEt4END IF.r4:IF NOTn1THENn4(k1,q1,length(k1))END IF.s4:INT VARu4:=length(n0);IF(n0SUBu4)=k0THEN REPu4DECR1UNTIL(n0SUBu4)<>k0END REP;n0:=subtext(n0,1,u4)END IF;IFv4THENn0CATk0END IF;i1(n0).v4:(k1SUB LENGTHk1)=k0AND(i0<>3ORm1=0).t4:r1:=0;s1:=0.END PROCinterpretiere;INT PROCr2(INT CONSTw4):h0(w4).c0+h0(w4).d0END PROCr2;INT PROCl2(SPEICHER CONSTx4):x4.d0-length(x4.g0)+m4(x4.g0)+x4.f0END PROCl2;INT PROCm4(TEXT CONSTy4):m4(y4,1,length(y4))END PROCm4;INT PROCm4(TEXT CONSTy4,INT CONSTz4,a5):INT CONSTb5:=pos(y4,l0,z4,a5);INT VARc5:=b5,d5,e5:=0;WHILEc5>0REPf5;IFg5THENh5ELSEi5END IF;j5END REP;e5.f5:d5:=pos(y4,l0,c5+1,a5).g5:d5=0.h5:IFa5=length(y4)THENe5INCRb5ELSEe5INCR(a5-c5+1)END IF.i5:e5INCR(d5-c5+1).j5:IFd5>0THENc5:=pos(y4,l0,d5+1,a5)ELSEc5:=0END IF.END PROCm4;LETk5=" ";PROCu3(INT CONSTl5):INT VARm5 +:=l5;WHILEm5>=10REPn0CATk5;m5DECR10END REP;WHILEm5>0REPn0CATk0;m5DECR1END REP END PROCu3;PROCw3(SPEICHER VARx4):IFx4.f0=0THENn0CATx4.g0ELSEn4(x4.g0,x4.f0+1,length(x4.g0))END IF;x4.f0:=length(x4.g0)END PROCw3;PROCl3(INT CONSTz4,a5,BOOL CONSTn1):IFn1THENu3(a5-z4)ELSEn4(k1,z4,a5-1)END IF END PROCl3;TEXT VARn5;PROCn4(TEXT CONSTo5,INT CONSTz4,a5):n5:=subtext(o5,z4,a5);n0CATn5END PROCn4;FILE VARp5;TEXT VARk1;INT VARq5;LETr5= +#401#"keine schliessende Klammer in Feldmuster",s5= +#402#"kein Kommando in Kommandozeile",t5= +#403#"unbekanntes Kommando"; +LETu5="&",v5="%",w5="%",x5="<",y5=">";LETz5= +#404#" "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR "LETa6=1,b6=2,c6=3,d6=4,e6=5,e1=6,g1=7,f6=100;INT VARg6,h6,i6;BOOL VARw0,j6;.k6:lineno(p5).l6:g6:=maxlinelength(p5).PROCm6(TEXT CONSTn6):REPq5INCR1UNTIL(k1SUBq5)<>n6END REP END PROCm6;PROCa2(INT VARb4,e5,e0):o6;IFc2THENb4:=max(g6,length(k1))+1;e5:=0;e0:=5ELSEb4:=q5;p6END IF.o6:q6(u5,v5).c2:q5>length(k1).p6:TEXT CONSTr6:=k1SUBq5;IFr6=v5THENe0:=0ELSEe0:=4END IF;s6;feldnamenlesen;t6.s6:m6(r6);IFq5-1>b4THENu6END IF.u6:e0INCR3.feldnamenlesen:IF(k1SUBq5)=x5THENv6ELSEw6END IF;IFx6THENa2(b4,e5,e0);LEAVEa2END IF.x6:h6>i6.v6:h6:=q5+1;i6:=pos(k1,y5,h6);IFi6=0THENy6(r5,subtext(k1,q5));i6:=length(k1)ELSEi6DECR1END IF;q5:=i6+2.w6:h6:=q5;q6(k0,v5);INT CONSTz6:=pos(k1,u5,h6,q5);IFz6>0THENq5:=z6END IF;i6:=q5-1.t6:IFa7THENb7;m6(r6)END IF;e5:=q5-b4.a7:(k1SUBq5)=r6.b7:e0:=e0OR1.END PROCa2;PROCa2(TEXT VARname):INT VARc7,e5,d7;a2(c7,e5,d7);IFe5>0THENname:=subtext(k1,h6,i6)ELSEname:=j0END +IF END PROCa2;PROCq6(TEXT CONSTe7,f7):INT CONSTg7:=pos(k1,e7,q5),h7:=pos(k1,f7,q5);q5:=length(k1)+1;IFg7>0THENq5:=g7END IF;IFh7>0ANDh7=lines(p5)END PROCx0;BOOL PROCb1(INT VARr0):q5:=1;IF(k1SUB1)<>w5THEN FALSE ELIF(k1SUB2)<>w5THENj7;k7;TRUE ELSEr0:=f6;TRUE END IF.j7:TEXT VARl7;m6(k0);IFq5>length(k1)THENy6(s5,k1);r0:=0;LEAVEb1WITH TRUE END IF;INT CONSTm7:=pos(k1,k0,q5);IFm7=0THENl7:=subtext(k1,q5);l7CATk0;q5:=length(k1)+1ELSEl7:=subtext(k1,q5,m7);q5:=m7END IF.k7:INT CONSTn7:=pos(z5,l7);IFn7>0CAND(z5SUB(n7-2))=k0THENr0:=code(z5SUB(n7-1))ELSEr0:=0;y6(t5,l7);END IF.END PROCb1;PROCj1(INT VARo7):m6(k0);INT CONSTp7:=q5;WHILEq7REPq5INCR1END REP;IFq5>p7THENo7:=int(subtext(k1,p7,q5-1))ELSEo7:=-1END IF.q7:pos("0123456789",k1SUBq5)>0.END PROCj1;FILE VARr7;TEXT VARs7;BOOL VARt7;PROCu7(TEXT CONSTname):s7:=name;v7("PROC ", +name," :")END PROCu7;PROCw7:v7("END PROC ",s7,";")END PROCw7;PROCx7(TEXT CONSTy7):t7:=TRUE;putline(r7,y7)END PROCx7;PROCx7(TEXT CONSTz7,a8,b8):t7:=TRUE;v7(z7,a8,b8)END PROCx7;PROCv7(TEXT CONSTz7,a8,b8):write(r7,z7);write(r7,a8);write(r7,b8);line(r7)END PROCv7;TEXT VARc8;PROCx7(TEXT CONSTz7,INT CONSTd8,TEXT CONSTb8):c8:=subtext(k1,d8);x7(z7,c8,b8)END PROCx7;PROCe8(INT CONSTi7,f8):v7("; interpretiere (",text(i7)+", "+text(f8),", PROC (INT CONST, TEXT VAR) abk);")END PROCe8;LETg8= +#405#"kein % WIEDERHOLUNG gefunden",h8= +#406#"Nur GRUPPE-Anweisung erlaubt",i8= +#407#"keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition",j8= +#408#"illegale Gruppennummer",k8= +#409#"diese Gruppe wurde schon definiert",l8= +#410#"diese Abkuerzung ist nicht definiert",m8= +#411#"dieser Abschnitt wurde schon einmal definiert",n8= +#412#"falscher Modus",o8= +#413#"diese Anweisung darf im Musterteil nicht vorkommen",p8= +#414#"im Abkuerzungsteil darf keine Anweisung auftreten",q8= +#415#"in dieser Zeile stehen zu viele Feldmuster",r8= +#416#"das Druckmuster enthaelt zu viele Feldmuster",s8= +#417#"nach dem ""&"" soll direkt der Name einer Abkuerzung folgen",t8= +#418#"kein Doppelpunkt nach Abkuerzung",u8= +#419#"Abkuerzung mehrfach definiert",v8= +#420#"das Druckmuster enthaelt zu viele Abkuerzungen"; +LETw8=200,x8=4,y8=250,GRUPPE=STRUCT(BOOLz8,a9,TEXTg0),ABSCHNITT=STRUCT(INTp0,o0,TEXTu7);ROWw8INT VARk2;INT VARb9;ROWx8GRUPPE VARc9;ROW3ABSCHNITT VARd9;SATZ VARq0;TEXT VARe9;INT VARf9;OP CAT(TEXT VARg9,INT CONSTwert):TEXT VARh9:=" ";replace(h9,1,wert);g9CATh9END OP CAT;PROCi9:enablestop;v0(1);j9;k9;WHILE NOTw0REPl9END REP;m9.j9:INT VARr0;INT VARn9;f9:=0;satzinitialisieren(q0);e9:=j0;b9:=0;t7:=FALSE;d9(1):=ABSCHNITT:(0,0,"vorspann");d9(2):=ABSCHNITT:(0,0,"wdh");d9(3):=ABSCHNITT:(0,0,"nachspann");FORn9FROM1UPTOx8REPc9(n9).a9:=FALSE END REP.k9:BOOL VARo9:=FALSE;REP IFw0THENy6(g8);LEAVEi9END IF;x0;IFb1(r0)THENp9END IF END REP.p9:SELECTr0OF CASEf6:q9CASEe6:r9CASEa6,b6,c6:IF NOTo9THENu7("gruppen")END IF;w7;LEAVEk9OTHERWISE IFr0>0THENy6(h8)END IF END SELECT.q9:IFo9THENy6(i8,k1)ELSEreplace(k1,1," ");x7(k1)END IF.r9:IF NOTo9THENu7("gruppen");o9:=TRUE END IF;INT VARs9;j1(s9);IFs9<1ORs9>x8THENy6(j8,k1)ELIFc9(s9).a9THENy6(k8,k1)ELSEc9(s9).a9:=TRUE;t9END IF.t9:x7("gruppentest (",text(s9),", ");x7( +" ",q5,");").l9:SELECTr0OF CASEa6:u9CASEb6:v9CASEc6:w9END SELECT.u9:x9(d9(1),r0).v9:j1(y9);j1(z9);x9(d9(2),r0).w9:x9(d9(3),r0).m9:IFt7THENa10;b10END IF;c10;IFt7THENd10;e10END IF.c10:FORn9FROM1UPTOf9REP IF(e9ISUBn9)>0THENy6(l8,f10,e9ISUBn9)ELSEg10END IF END REP.f10:TEXT VARh10;feldlesen(q0,n9,h10);h10.a10:FORn9FROM1UPTO3REP IFd9(n9).o0=0THENi10END IF END REP.i10:u7(d9(n9).u7);w7.b10:x7("PROC abk (INT CONST nr, TEXT VAR inhalt) :");IFf9>0THENx7("SELECT nr OF")ELSEx7("inhalt := text (nr)")END IF.g10:TEXT CONSTj10:=text(n9);x7("CASE "+j10," : inhalt := abk",j10).d10:IFf9>0THENx7("END SELECT")END IF;x7("END PROC abk;").e10:x7("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)").END PROCi9;PROCx9(ABSCHNITT VARk10,INT VARr0):BOOL VARl10:=TRUE;u7(k10.u7);m10;n10;o10.m10:IFk10.o0<>0THENy6(m8,k1)END IF;k10.o0:=k6+1;k10.p0:=b9+1.n10:WHILE NOTw0REPx0;IFb1(r0)THENp10ELSEq10;r10END IF END REP;s10;LEAVEx9.p10:SELECTr0OF CASEf6:replace(k1,1," ");x7(k1);l10:=TRUE CASEa6,b6,c6: +s10;LEAVEx9CASEd6:s10;LEAVEn10CASEe1:q10;INT VARt10;j1(t10);IFt10<1ORt10>4THENy6(n8,k1)END IF CASEg1:q10OTHERWISE IFr0>0THENy6(o8)END IF END SELECT.q10:IFl10THENe8(k6,b9+1);l10:=FALSE END IF.s10:w7.r10:TEXT VARname;INT VARu10:=0;REPa2(name);IFname=j0THEN LEAVEr10END IF;u10INCR1;v10END REP.v10:IFu10>=b0THENy6(q8)END IF;IFb9=w8THENy6(r8)ELSEb9INCR1END IF;w10.w10:INT VARx10:=feldnummer(name);IFx10=0THENx10:=feldindex(q0,name);IFx10=0THENy10(name,k6);k2(b9):=-f9ELSEk2(b9):=-x10END IF ELSEk2(b9):=x10END IF.o10:BOOL VARz10:=TRUE;WHILE NOTw0REPx0;IFb1(r0)THENa11ELIFb11THENc11END IF END REP.a11:SELECTr0OF CASEa6,b6,c6:LEAVEo10OTHERWISE IFr0>0THENy6(p8)END IF END SELECT.c11:IFz10THENx7(".");z10:=FALSE END IF;IFd11THENe11ELSEx7(k1)END IF.d11:(k1SUB1)=u5.e11:TEXT VARf11;a2(f11);IFf11=j0THENy6(s8,k1);LEAVEe11END IF;g11;h11.g11:LETi11=":";q5DECR1;m6(k0);IF(k1SUBq5)=i11THENq5INCR1ELSEy6(t8,k1)END IF.h11:y10(f11,0);x7(j11,q5-1,"").j11:"abk"+text(feldindex(q0,f11)).b11:k1<>j0ANDk1<>k0.END PROCx9;PROC +y10(TEXT CONSTname,INT CONSTi7):INT CONSTk11:=feldindex(q0,name);IFk11>0THENl11ELSEm11END IF.l11:IF(e9ISUBk11)>0THENreplace(e9,k11,i7)ELIFi7=0THENy6(u8,name)END IF.m11:IFf9=y8THENy6(v8)ELSEf9INCR1END IF;e9CATi7;feldaendern(q0,f9,name).END PROCy10;LETn11= +#421#"FEHLER in Zeile ",o11= +#422#" bei >>",p11= +#423#"<<"; +PROCy6(TEXT CONSTq11,r11,INT CONSTi7):LETs11=" ";TEXT VARt11:=n11;t11CATtext(i7);IFr11<>j0THENt11CATo11;t11CATr11;t11CATp11END IF;note(t11);noteline;note(s11);note(q11);noteline;IFonlineANDcommanddialogueTHENline;putline(t11);put(s11);putline(q11)END IF END PROCy6;PROCy6(TEXT CONSTq11):y6(q11,j0,k6)END PROCy6;PROCy6(TEXT CONSTq11,r11):y6(q11,r11,k6)END PROCy6;LETu11= +#424#"erzeugtes Programm",v11= +#425#"keine Datei geoeffnet",w11= +#426#"interner Fehler",x11= +#427#"Druckausgabe steht in",y11= +#428#"zum Drucker geschickt.",z11= +#429#"direkt Drucken nicht moeglich",a12= +#430#".a$"; +TEXT VARb12,c12:="";BOOL VARd12,e12,f12,g12:=FALSE;FILE VARh12;INT VARy9,z9,i12,j12,k12,l12:=1,m12:=4000,n12;PROCdrucke:drucke(lastparam)END PROCdrucke;PROCdrucke(TEXT CONSTo12):enablestop;lastparam(o12);p5:=sequentialfile(input,o12);modify(p5);IFanzahldateien=0THENerrorstop(v11)END IF;disablestop;p12;i9;IFanythingnotedTHENnoteedit(p5)ELIFt7THENq12ELSEdrucke(PROCr12,PROCs12,PROCt12,PROCu12)END IF;forget(v12,quiet).p12:TEXT VARv12;INT VARn9:=0;REPn9INCR1;v12:=text(n9)UNTIL NOTexists(v12)END REP;r7:=sequentialfile(output,v12);headline(r7,u11).q12:run(v12);lastparam(o12).END PROCdrucke;PROCr12:END PROCr12;PROCs12:w12(1)END PROCs12;PROCt12:w12(2)END PROCt12;PROCu12:w12(3)END PROCu12;PROCw12(INT CONSTx12):IFd9(x12).o0>0THENinterpretiere(d9(x12).o0,d9(x12).p0,PROC(INT CONST,TEXT VAR)y12)END IF END PROCw12;PROCy12(INT CONSTx12,TEXT VARg0):errorstop(w11);g0:=code(x12)END PROCy12;PROCdrucke(PROCz12,PROCa13,PROCb13,PROCc13):INT VARd13,e13,f13;enablestop;g13;h13;i13;n12:=1;WHILE NOTdateiendeREP +j13;cout(satznummer);k13;weiter(d13);l13END REP;m13;n13;aufsatz(1).h13:e13:=0;aufsatz(1);IFmarkiertesaetze>0THENd13:=3;IF NOTsatzmarkiertTHENweiter(d13)END IF ELSEd13:=2;IF NOTsatzausgewaehltTHENweiter(d13)END IF END IF.i13:INT VARn9;FORn9FROM1UPTOx8REPc9(n9).g0:=j0END REP.j13:IFe13=0THENz12;o13;p13(PROCa13)ELSEe12:=FALSE;q13;r13END IF;e13:=satznummer;f13:=satzkombination.q13:d12:=FALSE;z12.r13:IFd12THENs13(e13,f13,PROCc13)END IF;n12INCR1;IFd12THENp13(PROCa13)END IF.k13:IFz9<1THENl6ELSEg6:=z9END IF;IFi12m12THENn13;g13END IF.m13:o13;IFe13=0THENp13(PROCc13)ELSEs13(e13,f13,PROCc13)END IF;v0(1).END PROCdrucke;PROCo13:INT VARn9;FORn9FROM1UPTOx8REPc9(n9).z8:=TRUE END REP;e12:=TRUE;d12:=TRUE END PROCo13;PROCp13(PROCk10):i12:=y9;toline(h12,k12+1);l6;i0:=1;k10END PROCp13;PROCs13(INT CONSTe13,f13,PROCc13):INT CONSTt13:=satznummer,u13:=satzkombination;aufsatz(e13);WHILEsatzkombination<>f13REPweiter(1) +END REP;p13(PROCc13);aufsatz(t13);WHILEsatzkombination<>u13REPweiter(1)END REP END PROCs13;PROCg13:IFaktuellereditor>0THENv13ELSEw13END IF;x13.v13:h12:=editfile;IFcol>1THENsplitline(h12,col,FALSE);down(h12);col(h12,1)END IF;k12:=lineno(h12)-1.w13:IF NOTf12THENy13END IF;h12:=sequentialfile(modify,c12);maxlinelength(h12,maxlinelength(p5));k12:=lines(h12).y13:INT VARm5:=0;REPm5INCR1;c12:=headline(p5)+a12+text(m5);UNTIL NOTexists(c12)END REP.x13:v0(1);WHILE NOTw0REPz13END REP.z13:x0;INT VARr0;IFb1(r0)THENa14ELSEi1(k1)END IF.a14:IFr0<>f6ANDr0<>e6THEN LEAVEx13END IF.END PROCg13;PROCn13:IFaktuellereditor>0THEN LEAVEn13ELIFf12THENf12:=FALSE;ELIFg12THENdisablestop;b14ELIFonlineANDl12>1THENline;put(x11);putline(textdarstellung(c12));pause(40)END IF;toline(h12,1).b14:TEXT CONSTo7:=std;lastparam(c12);do("print (std)");IFiserrorTHENclearerror;errorstop(z11)ELIFonlineTHENline;put(textdarstellung(c12));putline(y11);forget(c12,quiet);pause(40)END IF;lastparam(o7).END PROCn13;PROCi1(TEXT CONSTi7):IFi12 +>=y9ORi12=0THENinsertrecord(h12);writerecord(h12,i7);k12INCR1ELSEc14END IF;down(h12).c14:IFeof(h12)THENb12:=j0;insertrecord(h12);k12INCR1ELSEreadrecord(h12,b12)END IF;d14;writerecord(h12,b12).d14:INT CONSTe14:=g6*i12;WHILElength(b12)c9(s9).g0THENc9(s9).g0:=h14;c9(s9).z8:=TRUE;d12:=TRUE ELSEc9(s9).z8:=FALSE END IF END PROCgruppentest;BOOL PROCgruppenwechsel(INT CONSTs9):IFs9>0THENc9(s9).z8ELSEe12END IF END PROCgruppenwechsel;TEXT PROClfdnr:text(n12)END +PROClfdnr;END PACKETeudasdrucken; +PACKETeudasstdlistenDEFINESdruckestandardlisten,stdlistenbreite,stdlistenlaenge,stdlistenfont:LETb0="******* Listendruckmuster *******";FILE VARf;TEXT VARc0,d0;TEXT VARe0:="";INT VARf0:=70,g0:=60;PROCstdlistenbreite(INT CONSTh0):f0:=h0END PROCstdlistenbreite;INT PROCstdlistenbreite:f0END PROCstdlistenbreite;PROCstdlistenlaenge(INT CONSTi0):g0:=i0END PROCstdlistenlaenge;INT PROCstdlistenlaenge:g0END PROCstdlistenlaenge;PROCstdlistenfont(TEXT CONSTfont):e0:=fontEND PROCstdlistenfont;TEXT PROCstdlistenfont:e0END PROCstdlistenfont;PROCdruckestandardlisten(INT CONSTj0,TEXT CONSTk0):forget(b0,quiet);f:=sequentialfile(output,b0);maxlinelength(f,f0);IFl0THENm0(k0)ELSEn0(k0)END IF;TEXT CONSTo0:=std;drucke(b0);forget(b0,quiet);lastparam(o0).l0:j0=2.END PROCdruckestandardlisten;ROW100INT VARp0;INT VARq0,r0,s0,t0,u0;PROCv0:IFe0<>""THENputline(f,"#type("+textdarstellung(e0)+")#")END IF;putline(f,"% GRUPPE 1 seitennummer");putline(f,"% VOR");put(f,date);put(f,timeofday);put(f,"Uhr:");put(f, +eudasdateiname(1));write(f,(f0-length(eudasdateiname(1))-25)*" ");putline(f,"&&-S");line(f)END PROCv0;PROCw0:putline(f,"% NACH");putline(f,"#page#");putline(f,"% ABK");putline(f,"&? : lfd nr .");putline(f,"&-S : seitennummer .");putline(f,"seitennummer :");putline(f," text (int (lfd nr) DIV saetze pro seite + 1) .");write(f,"saetze pro seite : ");put(f,(g0-2)DIVq0-1);putline(f,".")END PROCw0;PROCm0(TEXT CONSTk0):v0;x0;y0;w0.x0:write(f,"Nr. ");FORz0FROM1UPTOlength(k0)REPfeldnamenlesen(code(k0SUBz0),d0);IFz0");IFz00THENe1:=3;IF NOT +satzmarkiertTHENweiter(3)END IF ELSEe1:=2;IF NOTsatzausgewaehltTHENweiter(2)END IF END IF;WHILE NOTdateiendeREPf1;weiter(e1)END REP.d1:t0:=length(k0);FORz0FROM1UPTOt0REPp0(z0):=2END REP;u0:=0.f1:INT VARg1:=0;FORz0FROM1UPTOt0REPfeldbearbeiten(code(k0SUBz0),PROC(TEXT CONST,INT CONST,INT CONST)h1);IFs0>p0(z0)THENp0(z0):=s0END IF;g1INCRs0END REP;IFg1>u0THENu0:=g1END IF.END PROCc1;PROCh1(TEXT CONSTi1,INT CONSTj1,k1):s0:=k1-j1+1END PROCh1;PROCn0(TEXT CONSTk0):c1(k0);v0;x0;y0;l1;w0.x0:TEXT VARm1:="";INT VARz0;r0:=4;q0:=1;write(f,"Nr. ");FORz0FROM1UPTOlength(k0)REPfeldnamenlesen(code(k0SUBz0),d0);IFlength(d0)+2>=p0(z0)THENn1END IF;r0INCRp0(z0)+1;IFr0>f0THENline(f);r0:=p0(z0)+1;q0INCR1END IF;write(f,text(d0,p0(z0)+1))END REP;line(f);putline(f,maxlinelength(f)*"-").n1:m1CAT(k0SUBz0).y0:putline(f,"% WDH");write(f,"&&? ");FORz0FROM1UPTOlength(k0)REPo1END REP;line(f).o1:INT CONSTp1:=pos(m1,k0SUBz0);c0:="&";IFp1>0THENc0CATtext(code(p1+64),p0(z0))ELSEfeldnamenlesen(code(k0SUBz0),d0);c0CATtext("<"+d0+ +">",p0(z0))END IF;write(f,c0).l1:IFm1<>""THENputline(f,"% ABK");FORz0FROM1UPTOlength(m1)REPq1END REP END IF.q1:write(f,"&");write(f,code(z0+64));write(f," : ");write(f,"f (");feldnamenlesen(code(m1SUBz0),d0);write(f,textdarstellung(d0));putline(f,") .").END PROCn0;END PACKETeudasstdlisten; + diff --git a/app/eudas/5.3/src/eudas.3 b/app/eudas/5.3/src/eudas.3 new file mode 100644 index 0000000..92b783f --- /dev/null +++ b/app/eudas/5.3/src/eudas.3 @@ -0,0 +1,43 @@ +PACKETsatzanzeigeDEFINESanzeigefenster,bildausgeben,aendern,einfuegen,suchen,feldauswahl,rollen,exitdurch,exitzeichen:LETb0=256;LETc0=" ",d0="",e0=""5"",f0=""15"",g0=" "14"",h0=" "14" ";ROWb0STRUCT(INTi0,j0)VARk0;INT VARl0,m0,n0:=24,o0:=79,p0:=1,q0:=1,r0,s0,t0:=0,u0:=0,v0:=dateiversion-1,w0:=0;BOOL VARx0:=TRUE,y0:=TRUE,z0:=FALSE,a1;FENSTER VARfenster;fensterinitialisieren(fenster);DATASPACE VARb1,c1;FILE VAReditfile;TEXT VARd1,e1;LETf1= +#801#"Anzeigefenster zu klein"; +PROCanzeigefenster(FENSTER CONSTg1):INT VARh1,i1,j1,k1;fenstergroesse(g1,h1,i1,j1,k1);IFj1>=39THENfenstergroessesetzen(fenster,g1);y0:=h1+j1>=xsize;o0:=j1;n0:=k1;q0:=h1;p0:=i1;x0:=TRUE ELSEerrorstop(f1)END IF END PROCanzeigefenster;FENSTER PROCanzeigefenster:fensterEND PROCanzeigefenster;PROCl1:BOOL VARfensterveraendert;fensterzugriff(fenster,fensterveraendert);IFfensterveraendertTHENa1:=TRUE END IF END PROCl1;PROCm1:IFn1ORx0THENo1;p1;q1;r1;s1;t1END IF.n1:v0<>dateiversion.o1:l0:=0;WHILEl0z1THENm0:=max(z1, +1)END IF;a1:=TRUE.z1:l0-n0+3.END PROCrollen;PROCfeldauswahl(TEXT CONSTa2):m1;b2;a1:=TRUE.b2:l0:=length(a2);INT VARc2;FORc2FROM1UPTOl0REPk0(c2).i0:=code(a2SUBc2)END REP;m0:=1.END PROCfeldauswahl;INT VARd2;PROCe2:type(c1,-1);editfile:=sequentialfile(modify,c1);editinfo(editfile,-1);toline(editfile,1);col(editfile,1);maxlinelength(editfile,10000);d2:=1END PROCe2;.f2:d2<=l0.PROCg2(PROC(TEXT CONST,INT CONST)h2):i2;IFeof(editfile)THENh2("",i0)ELIFj2THENk2;l2;h2(e1,i0)ELIFm2THENreadrecord(editfile,e1);l2;h2(e1,i0);down(editfile)ELSEexec(PROC(TEXT CONST,INT CONST)h2,editfile,i0);down(editfile)END IF.i2:INT CONSTw1:=d2,i0:=k0(w1).i0;REPd2INCR1UNTILd2>l0CORn2END REP.n2:k0(d2).i0<>i0.j2:d2-w1>1.k2:e1:="";REPexec(PROC(TEXT CONST,INT CONST)o2,editfile,length(e1));down(editfile)UNTILeof(editfile)ORlineno(editfile)=d2END REP.m2:INT CONSTp2:=len(editfile);subtext(editfile,p2,p2)=c0.END PROCg2;PROCo2(TEXT CONSTq2,INT CONSTr2):IFr2>0CAND(e1SUBr2)<>c0CAND(q2SUB1)<>c0THENe1CATc0END IF;e1CATq2END PROCo2; +PROCl2:INT VARp2:=length(e1);WHILE(e1SUBp2)=c0REPp2DECR1END REP;e1:=subtext(e1,1,p2)END PROCl2;BOOL VARs2;PROCeinfuegen(PROCt2):enablestop;m1;IFl0>0THENe2;l1;u2(PROCt2);satzeinfuegen;s2:=TRUE;v2END IF END PROCeinfuegen;PROCv2:WHILEf2REPg2(PROC(TEXT CONST,INT CONST)w2)END REP;aenderungeneintragenEND PROCv2;PROCw2(TEXT CONSTx2,INT CONSTi0):IF NOTs2CORx2<>d0THENfeldaendern(i0,x2)END IF END PROCw2;PROCaendern(PROCt2):enablestop;IFdateiendeTHENeinfuegen(PROCt2)ELSEy2END IF.y2:m1;IFl0>0THENe2;l1;z2(a1);a3;u2(PROCt2);s2:=FALSE;v2END IF.a3:b3:=1;WHILEb3<=l0REPfeldbearbeiten(k0(b3).i0,PROC(TEXT CONST,INT CONST,INT CONST)c3);insertrecord(editfile);writerecord(editfile,e1);down(editfile);b3INCR1END REP;toline(editfile,1).END PROCaendern;INT VARb3;PROCc3(TEXT CONSTv1,INT CONSTw1,x1):e1:=subtext(v1,d3,e3).d3:w1+k0(b3).j0.e3:IFf3THENx1ELSEw1+k0(b3+1).j0-1END IF.f3:b3=l0CORk0(b3+1).i0<>k0(b3).i0.END PROCc3;PROCsuchen(PROCt2):enablestop;m1;IFl0>0THENe2;l1;IFsuchversion<>0THENg3END IF;u2(PROCt2);h3END +IF.g3:b3:=1;WHILEb3<=l0REPinsertrecord(editfile);i3;down(editfile);b3INCR1END REP;toline(editfile,1).i3:IFk0(b3).j0=0THENsuchbedingunglesen(k0(b3).i0,e1);writerecord(editfile,e1)END IF.h3:suchbedingungloeschen;WHILEf2REPg2(PROC(TEXT CONST,INT CONST)j3)END REP.END PROCsuchen;PROCj3(TEXT CONSTk3,INT CONSTi0):suchbedingung(i0,k3)END PROCj3;PROCbildausgeben(BOOL CONSTl3):enablestop;m1;l1;IFl3ORa1ORm3THENz2(a1);t0:=satznummer;u0:=satzkombination;n3(TRUE)ELSEo3(TRUE)END IF.m3:satznummer<>t0ORu0<>satzkombination.END PROCbildausgeben;INT VARj0;BOOL VARp3;PROCz2(BOOL CONSTq3):INT VARc2:=1,r3:=0;p3:=TRUE;WHILEc2<=l0OR NOTp3REPs3END REP.s3:IFp3CANDk0(c2).i0=r3THENt3ELSE IFu3THENv3END IF;k0(c2).j0:=j0;feldbearbeiten(k0(c2).i0,PROC(TEXT CONST,INT CONST,INT CONST)w3);c2INCR1END IF.t3:IFq3THENx3(c2)ELSEk0(c2).j0:=j0;c2INCR1END IF.u3:c2>l0CORk0(c2).i0<>r3.v3:IFp3THENy3ELSEz3(c2);k0(c2).i0:=r3END IF.y3:r3:=k0(c2).i0;j0:=0.END PROCz2;PROCw3(TEXT CONSTv1,INT CONSTw1,x1):INT CONSTa4:=x1-w1-j0+1;IFa4>s0-2 +THENj0INCRs0-2;b4;p3:=FALSE ELSEj0INCRa4;p3:=TRUE END IF.b4:INT VARc4:=w1+j0-1;IFd4ANDe4THEN WHILE(v1SUBc4)<>c0REPc4DECR1;j0DECR1END REP END IF.d4:(v1SUBc4)<>c0.e4:pos(v1,c0,c4-s0+3,c4-1)>0.END PROCw3;PROCz3(INT CONSTc2):INT VARf4;FORf4FROMl0DOWNTOc2REPk0(f4+1):=k0(f4)END REP;l0INCR1;a1:=TRUE END PROCz3;PROCx3(INT CONSTc2):INT VARf4;FORf4FROMc2+1UPTOl0REPk0(f4-1):=k0(f4)END REP;l0DECR1;a1:=TRUE END PROCx3;INT VARg4;TEXT VARh4,i4,j4,k4:="",l4;LETm4= +#802#""15" Bild verschoben ! ESC 1 druecken ! "14""; +LETn4=""3""10"19"11""12""13"q?hpg";LETo4=1,p4=2,q4=3,r4=4,s4=5,t4=6,u4=7,v4=8,w4=9,x4=10,y4=11,z4=12;PROCu2(PROCt2):INT VARa5:=m0;lernsequenzauftastelegen("D",date);REPn3(FALSE);b5;c5;d5;e5UNTILf5END REP;toline(editfile,1);col(editfile,1).b5:IFlines(editfile)1THENg5(m0-1,i4)END IF;g5(h5,j4);toline(editfile,a5).h5:min(l0+1,m0+n0-1).d5:openeditor(groesstereditor+1,editfile,TRUE,q0+r0+3,p0,s0,i5);edit(groesstereditor,n4+k4,PROC(TEXT CONST)j5);k5.k5:INT VARl5,m5;getcursor(l5,m5);IFl5<>1THENbildschirmneuEND IF.i5:min(l0-m0+2,n0).e5:a5:=lineno(editfile);n5;SELECTg4OF CASEo4:o5CASEp4:p5CASEq4:q5CASEr4:r5CASEs4:s5CASEt4:t5CASEu4:u5CASEw4:t2;a1:=TRUE CASEx4:errorstop(d0)CASEy4:v5CASEz4:w5END SELECT.n5:INT CONSTx5:=col(editfile);col(editfile,1);IFm0<>1THENy5(m0-1,i4)END IF;y5(h5,j4);col(editfile,x5).o5:INT VARz5;z5:=a5-m0;rollen(-n0+1);a5:=m0+z5.p5:z5:=a5-m0;rollen(n0-1);a5:=min(m0+z5,l0).q5:rollen(-999 +);a5:=1.r5:z5:=a5-m0;rollen(999);a5:=min(m0+z5,l0).s5:toline(editfile,a5);a6;z3(a5).a6:readrecord(editfile,e1);h4:=subtext(e1,x5);e1:=subtext(e1,1,x5-1);writerecord(editfile,e1);down(editfile);insertrecord(editfile);writerecord(editfile,h4).t5:toline(editfile,a5);IFx5=1AND(b6CANDc6ORd6CANDe6)THENf6ELSEg6END IF.b6:a5<>l0.c6:k0(a5+1).i0=k0(a5).i0.d6:a5<>1.e6:k0(a5-1).i0=k0(a5).i0.f6:deleterecord(editfile);x3(a5);IFa5>l0THENa5:=l0END IF.g6:readrecord(editfile,e1);e1:=subtext(e1,1,x5-1);writerecord(editfile,e1).u5:z5:=a5-m0;rollen(z5).v5:forget(b1);b1:=c1;z0:=TRUE.w5:IFz0THENforget(c1);c1:=b1;editfile:=sequentialfile(modify,c1)END IF.f5:g4=v4.END PROCu2;PROCj5(TEXT CONSTh6):enablestop;setbusyindicator;g4:=pos(n4,h6);IFg4>0THENl4:=h6;quitELIFpos(k4,h6)>0THENg4:=v4;l4:=h6;quitELIFkommandoauftaste(h6)<>d0THENstdkommandointerpreter(h6)ELSEnichtsneuEND IF END PROCj5;PROCg5(INT CONSTc2,TEXT VARi6):toline(editfile,c2);readrecord(editfile,i6);writerecord(editfile,m4)END PROCg5;PROCy5(INT CONSTc2, +TEXT CONSTi6):toline(editfile,c2);IFeof(editfile)CORpos(editfile,m4,1)=0THENtoline(editfile,1);down(editfile,m4);IFeof(editfile)THENtoline(editfile,c2);insertrecord(editfile)END IF END IF;writerecord(editfile,i6)END PROCy5;PROCexitzeichen(TEXT CONSTj6):k4:=j6END PROCexitzeichen;TEXT PROCexitdurch:l4END PROCexitdurch;INT VARk6;LETl6= +#803#"ENDE.",m6= +#804#"SUCH+",n6= +#805#"SUCH-",o6= +#806#"MARK+",p6= +#807#"MARK-",q6= +#808#" Zeile "14" ",r6= +#809#" Satz ",s6= +#810#""; +LETt6=".....",u6=" ";PROCn3(BOOL CONSTv6):INT VARw6:=p0+1,x6:=0;INT CONSTy6:=m0+n0-2;o3(v6);k6:=m0;WHILEk6<=y6REPz6;a7;b7;w6INCR1;k6INCR1END REP;a1:=FALSE.z6:IFa1THENcursor(q0,w6);IFk6<=l0THENc7ELIFk6=l0+1THENd7ELSEe7END IF END IF.c7:out(f0);IFk0(k6).i0=x6THENr0TIMESOUTc0ELSEx6:=k0(k6).i0;feldnamenbearbeiten(x6,PROC(TEXT CONST,INT CONST,INT CONST)f7)END IF;out(g0).d7:out(f0);o0-4TIMESOUT".";out(h0).e7:IFy0THENout(e0)ELSEo0TIMESOUTc0END IF.a7:IFv6ANDk6<=l0THENcursor(q0+r0+3,w6);feldbearbeiten(k0(k6).i0,PROC(TEXT CONST,INT CONST,INT CONST)g7)END IF.b7:IF NOTa1THEN TEXT CONSTinput:=getcharety;IFinput<>d0THENpush(input);IFpos(k4,input)>0THENt0:=0;LEAVEn3END IF END IF END IF.END PROCn3;PROCo3(BOOL CONSTv6):h7;i7;cursor(q0,p0);IF NOTv6THENoutsubtext(d1,1,r0+3);LEAVEo3END IF;replace(d1,r0+7,j7);replace(d1,r0+14,k7);out(d1);cursor(q0+o0-5,p0);out(text(m0)).h7:TEXT VARsatznr;satznr:=text(satznummer);IFanzahlkoppeldateien>0AND NOTaufkoppeldateiTHENsatznrCAT"-";satznrCATtext(satzkombination +)END IF.i7:replace(d1,7,u6);replace(d1,7,satznr).j7:IFsuchversion=0THENt6ELIFsatzausgewaehltTHENm6ELSEn6END IF.k7:IFdateiendeTHENl6ELIFmarkiertesaetze=0THENt6ELIFsatzmarkiertTHENo6ELSEp6END IF.END PROCo3;PROCf7(TEXT CONSTv1,INT CONSTw1,x1):IFx1-w1>=r0THENoutsubtext(v1,w1,w1+r0-1)ELSEoutsubtext(v1,w1,x1);r0-x1+w1-1TIMESOUTc0END IF END PROCf7;PROCg7(TEXT CONSTv1,INT CONSTw1,x1):INT VARp2;IFk6=l0CORl7THENp2:=x1ELSEp2:=w1+k0(k6+1).j0-1END IF;outsubtext(v1,w1+k0(k6).j0,p2);IFy0THENout(e0)ELSEm7TIMESOUTc0END IF.l7:k0(k6+1).i0<>k0(k6).i0.m7:s0-p2+w1+k0(k6).j0-1.END PROCg7;PROCq1:d1:=text(r6,r0+3);d1CATf0;INT VARf4;INT CONSTn7:=o0-length(d1)-12;FORf4FROM1UPTOn7REPd1CAT"."END REP;d1CATq6;o7.o7:IFaufkoppeldateiTHENreplace(d1,r0+22,s6)END IF.END PROCq1;END PACKETsatzanzeige; +PACKETuebersichtsanzeigeDEFINESuebersicht,uebersichtsfenster:ROW24INT VARb0;ROW24INT VARc0;FENSTER VARfenster;fensterinitialisieren(fenster);INT VARd0:=24,e0:=79,f0:=1,g0:=1,h0,i0:=-1;BOOL VARj0;TEXT VARk0;LETl0="",m0=""15"",n0=""14"",o0=" ",p0=""7"",q0=""5"";LETr0= +#901#""15"Satznr. ",s0= +#902#" << DATEIENDE >>",t0= +#903#"UEBERSICHT: Rollen: HOP OBEN, HOP UNTEN Beenden: ESC q Hilfe: ESC ?"; +PROCuebersichtsfenster(FENSTER CONSTu0):fenstergroesse(u0,g0,f0,e0,d0);fenstergroessesetzen(fenster,u0);j0:=g0+e0>=xsizeEND PROCuebersichtsfenster;FENSTER PROCuebersichtsfenster:fensterEND PROCuebersichtsfenster;PROCuebersicht(TEXT CONSTv0,PROCw0):TEXT VARx0;BOOL VARdummy;INT VARy0:=1,z0:=0,a1:=1;fensterzugriff(fenster,dummy);statusanzeigen(t0);b1;c1;REPd1;e1;f1END REP.b1:IFv0=l0THENg1ELSEk0:=v0;i0:=dateiversionEND IF.g1:IFi0<>dateiversionTHENh1;i0:=dateiversionEND IF.h1:INT VARi1;k0:=l0;FORi1FROM1UPTOanzahlfelderREPk0CATcode(i1)END REP.d1:WHILEz0""THEN LEAVEd1END IF;j1;z0INCR1END REP;k1;getchar(x0).j1:IFz0=0THENl1ELIFz0=1THENm1ELSEn1END IF.l1:cursor(g0,f0);out(r0);h0:=e0-length(r0)-1;INT VARfeldindex;FORfeldindexFROM1UPTOlength(k0)WHILEh0>0REPfeldnamenbearbeiten(code(k0SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)o1)END REP;p1;cursor(g0+e0-1,f0);out(n0).m1:q1(1);r1(1);s1.n1:cursor(g0,f0+z0);IFdateiendeTHENb0(z0):=0;h0:=e0;p1ELSEt1;r1(z0);s1END IF.t1: +weiter(2);u1;b0(z0):=satznummer;c0(z0):=satzkombination.u1:IF NOT(satzausgewaehltORdateiende)THEN LEAVEuebersichtEND IF.e1:cursor(g0,f0+y0).k1:WHILEb0(y0)=0REPy0DECR1END REP;q1(y0);cursor(g0+6,f0+y0).f1:SELECTa1OF CASE1:v1CASE2:w1CASE3:x1END SELECT.v1:SELECTpos(""3""10""1""27"+-",x0)OF CASE1:y1CASE2:z1CASE3:a1:=2CASE4:a1:=3CASE5:a2CASE6:b2OTHERWISEout(p0)END SELECT.w1:SELECTpos(""3""10""13"",x0)OF CASE1:c2CASE2:d2CASE3:e2OTHERWISEout(p0)END SELECT;a1:=1.x1:SELECTpos("19qh?",x0)OF CASE1:f2CASE2:g2CASE3,4:h2CASE5:i2OTHERWISEout(p0)END SELECT;a1:=1.y1:IFy0>1THENy0DECR1;ELSEj2(1);z0:=1END IF.z1:IF NOTdateiendeTHEN IFy01THENy0:=1ELSEj2(d0-1);z0:=1END IF.d2:IFy0=d0-1AND NOTdateiendeTHENweiter(2);c1;z0:=1ELSEy0:=d0-1END IF.e2:IFy0<>1THENb0(1):=b0(y0);c0(1):=c0(y0);y0:=1;z0:=1END +IF.f2:aufsatz(1);IF NOTsatzausgewaehltTHENweiter(2)END IF;c1;y0:=1;z0:=1.g2:aufsatz(32767);c1;j2(d0-2);z0:=1.h2:LEAVEuebersicht.i2:w0;statusanzeigen(t0);z0:=0.END PROCuebersicht;PROCj2(INT CONSTk2):INT VARi1;q1(1);FORi1FROM1UPTOk2WHILEsatznummer>1REPzurueck(2)END REP;c1END PROCj2;PROCq1(INT CONSTl2):aufsatz(b0(l2));WHILEsatzkombination<>c0(l2)REPweiter(1)END REP END PROCq1;PROCc1:b0(1):=satznummer;c0(1):=satzkombinationEND PROCc1;BOOL PROCm2(INT CONSTl2):satznummer=b0(l2)CANDsatzkombination=c0(l2)END PROCm2;PROCo1(TEXT CONSTn2,INT CONSTo2,p2):INT CONSTd0:=min(h0,p2-o2+1);outsubtext(n2,o2,o2+d0-1);h0DECRd0;IFh0>=2THENout(", ");h0DECR2ELIFh0=1THENout(",");h0:=0END IF END PROCo1;PROCr1(INT CONSTl2):cursor(g0,f0+l2);IFsatzmarkiertTHENout(m0)ELSEout(o0)END IF;outtext(text(satznummer),1,5);IFsatzmarkiertTHENout(n0)ELSEout(o0)END IF;h0:=e0-7END PROCr1;PROCp1:IFj0THENout(q0)ELSEh0TIMESOUTo0END IF END PROCp1;PROCs1:IFsatzausgewaehltTHENq2ELIFdateiendeTHENout(s0);h0DECRlength(s0)ELSEout("<< >>") +;h0DECR5END IF;p1.q2:INT VARfeldindex;FORfeldindexFROM1UPTOlength(k0)WHILEh0>0REPfeldbearbeiten(code(k0SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)o1)END REP.END PROCs1;END PACKETuebersichtsanzeige; +PACKETeudasdialoghilfenDEFINESfenstergroessenbestimmen,fensterlinks,fensterrechts,fensterganz,ausfuehrung,aufarchiv,bittewarten,frageobeinrichten,setcommanddialoguefalse,resetcommanddialogue,edit:LETb0=16;INT VARc0:=0,d0;FENSTER VARe0,f0,g0,h0;fensterinitialisieren(h0);fensterinitialisieren(e0);fensterinitialisieren(f0);fensterinitialisieren(g0);PROCfenstergroessenbestimmen:IFxsize<>c0ORysize<>d0THENi0;c0:=xsize;d0:=ysizeEND IF.i0:fenstergroessesetzen(e0,1,2,xsize-1,ysize-1);fenstergroessesetzen(f0,1,2,b0,ysize-2);fenstergroessesetzen(g0,b0+1,2,xsize-b0-1,ysize-2);fenstergroessesetzen(h0,1,ysize,xsize-1,1);dialogfenster(g0);anzeigefenster(g0);uebersichtsfenster(e0).END PROCfenstergroessenbestimmen;FENSTER PROCfensterrechts:g0END PROCfensterrechts;FENSTER PROCfensterlinks:f0END PROCfensterlinks;FENSTER PROCfensterganz:e0END PROCfensterganz;LETj0= +#1001#"Keine Datei zur Auswahl vorhanden.",k0= +#1002#"Name der Datei: "; +SATZ VARl0;THESAURUS VARm0;TEXT VARn0,o0,p0;LETq0="",r0=""27"z",s0=""5"";LETt0=11,u0=0;DATASPACE VARv0;INITFLAG VARw0;BOUND STRUCT(TEXTname,x0,y0)VARz0;PROCausfuehrung(TEXT CONSTa1,BOOL CONSTb1,INT CONSTc1,PROC(TEXT CONST)d1):ausfuehrung(a1,b1,c1,niltask,PROC(TEXT CONST)d1)END PROCausfuehrung;PROCausfuehrung(TEXT CONSTa1,BOOL CONSTb1,INT CONSTc1,TASK CONSTe1,PROC(TEXT CONST)d1):enablestop;f1;IFo0=q0THENerrorstop(q0)ELIFg1THENo0:=subtext(o0,3);h1(all,c1,e1);auswahlanbieten("EUDAS-Dateiauswahl",g0,i1,"AUSWAHL/Datei",PROC(TEXT VAR,INT CONST)j1);bittewarten;k1(PROC(TEXT CONST)d1)ELSElastparam(o0);d1(o0)END IF.f1:IFexists(std)AND(c1=0CORtype(old(std))=c1)THENo0:=stdELSEo0:=q0END IF;editget(a1,o0,"z","GET/Dateiname").i1:IFb1THEN1ELSE1024END IF.END PROCausfuehrung;PROCaufarchiv(PROC(TEXT CONST)d1,THESAURUS CONSTl1):o0:=q0;editget(k0,o0,"z","GET/Dateiname");IFo0=q0THENerrorstop(q0)ELIFg1THENm1ELSElastparam(o0);d1(o0)END IF.m1:o0:=subtext(o0,3);h1(l1,0,niltask);auswahlanbieten( +"EUDAS-Archivauswahl",g0,"AUSWAHL/Archiv",PROC(TEXT VAR,INT CONST)j1);k1(PROC(TEXT CONST)d1).END PROCaufarchiv;PROCh1(THESAURUS CONSTn1,INT CONSTc1,TASK CONSTe1):BOOL CONSTo1:=pos(o0,"*")=0;p1;q1;r1;s1.p1:INT VARt1:=1,u1:=0;satzinitialisieren(l0);REPget(n1,n0,u1);IFn0=q0THEN LEAVEp1ELIFv1ANDw1THENfeldaendern(l0,t1,n0);t1INCR1END IF END REP.v1:c1=0CORtype(old(n0))=c1.w1:o1COR(n0LIKEo0).q1:p0:=q0;INT VARx1;FORx1FROM1UPTOanzahldateienREP INT CONSTy1:=feldindex(l0,eudasdateiname(x1));IFy1>0THENp0CATcode(y1)END IF END REP.r1:IF NOTisniltask(e1)THENm0:=ALLe1;z1END IF.z1:u1:=0;REPget(m0,n0,u1);IFn0=q0THEN LEAVEz1ELIFw1CANDa2CANDb2THENfeldaendern(l0,t1,n0);t1INCR1END IF END REP.a2:NOT(n1CONTAINSn0).b2:c1=0CORc2(n0,e1)=c1.s1:IFt1=1THENdialog(j0);errorstop(q0)END IF.END PROCh1;INT PROCc2(TEXT CONSTd2,TASK CONSTe2):enablestop;INT VARf2,g2;IF NOTinitialized(w0)THENv0:=nilspaceEND IF;forget(v0);v0:=nilspace;z0:=v0;z0.name:=d2;z0.x0:=writepassword;z0.y0:=readpassword;call(e2,t0,v0,f2);IFf2<>u0THENg2 +:=0ELSEg2:=type(v0)END IF;forget(v0);g2END PROCc2;BOOL PROCg1:subtext(o0,1,2)=r0END PROCg1;PROCj1(TEXT VARh2,INT CONSTt1):IFt1<256THENfeldlesen(l0,t1,h2);IFpos(p0,code(t1))>0THENh2:=" "+textdarstellung(h2)ELIFh2<>q0THENh2:=textdarstellung(h2)END IF ELSEh2:=q0END IF END PROCj1;PROCk1(PROC(TEXT CONST)d1):INT VARt1:=1;REP IFwahl(t1)=0THEN LEAVEk1ELSEfeldlesen(l0,wahl(t1),n0);i2;lastparam(n0);d1(n0)END IF;t1INCR1END REP.i2:IFonlineTHENfensterveraendert(h0);cursor(1,ysize);out(s0);out(text(t1));out(". ");out(textdarstellung(n0))END IF.END PROCk1;LETj2= +#1003#"EDITIEREN: Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ?",k2= +#1004#"ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ?"; +INT VARl2;BOOL VARm2,n2;PROCedit(FILE VARf,FENSTER CONSTfenster,TEXT CONSTo2,BOOL CONSTaendern):INT VARp2,q2,r2,s2;fenstergroesse(fenster,p2,q2,r2,s2);fensterveraendert(fenster);enablestop;t2;m2:=aendern;REPu2;openeditor(groesstereditor+1,f,aendern,p2,q2,r2,s2);edit(groesstereditor,"eqvw19dpgn"9"?hF",PROC(TEXT CONST)v2);w2END REP.t2:IFaendernANDq2<3ANDs2>22ANDp2<14ANDr2>75THENn2:=TRUE ELSEn2:=FALSE END IF.w2:SELECTl2OF CASE0:LEAVEeditCASE1:hilfeanbieten(o2,fenster)CASE2:errorstop(q0)END SELECT.END PROCedit;PROCu2:IFm2THENstatusanzeigen(j2)ELSEstatusanzeigen(k2)END IF END PROCu2;PROCv2(TEXT CONSTx2):l2:=pos("q?h",x2);IFl2>0THENl2DECR1;quitELIFn2CANDx2="F"THENdo("feldnamen anzeigen");u2ELSEstdkommandointerpreter(x2);u2;bildschirmneuEND IF END PROCv2;BOOL VARy2;PROCsetcommanddialoguefalse:y2:=commanddialogue;commanddialogue(FALSE)END PROCsetcommanddialoguefalse;PROCresetcommanddialogue:commanddialogue(y2)END PROCresetcommanddialogue;LETz2= +#1005#" Bitte warten.. ",a3= +#1006#" neu einrichten"; +PROCbittewarten:statusanzeigen(z2)END PROCbittewarten;PROCfrageobeinrichten(TEXT CONSTd2):IF NOTja(textdarstellung(d2)+a3,"JA/einrichten")THENerrorstop(q0)END IF END PROCfrageobeinrichten;END PACKETeudasdialoghilfen; + + diff --git a/app/eudas/5.3/src/eudas.4 b/app/eudas/5.3/src/eudas.4 new file mode 100644 index 0000000..7170f43 --- /dev/null +++ b/app/eudas/5.3/src/eudas.4 @@ -0,0 +1,134 @@ +PACKETeudassteuerungDEFINESeudas,einzelsicherung,suchen,aendern,einfuegen,prueffehlereditieren,feldstruktur,feldnamenanzeigen,formatierenautomatisch,arbeitsbereichbestimmen,dateiverwaltung,archivverwaltung:INT VARb0:=1003,c0:=3243;IFd0THENb0:=1004END IF.d0:maxintDIV2>17000.;LETe0="",f0=" ",g0=""4"",h0=""5"";FILE VARi0;DATASPACE VARj0;INT VARk0,l0:=dateiversion-1;TEXT VARm0;BOOL VARn0:=FALSE;LETo0= +#1101#"EUDAS.Öffnen",p0= +#1102#"EUDAS.Einzelsatz",q0= +#1103#"EUDAS.Gesamtdatei",r0= +#1104#"EUDAS.Drucken",s0= +#1105#"EUDAS.Dateien",t0= +#1106#"EUDAS.Archiv"; +LETu0= +#1107#"EUDAS kann nicht unter EUDAS aufgerufen werden",v0= +#1108#"Suchbedingung einstellen",w0= +#1109#"Alle Sätze drucken",x0= +#1110#"Alle markierten Sätze drucken",y0= +#1111#"Aktuellen Satz drucken",z0= +#1112#"Mit neuer Auswahl noch einmal",a1= +#1113#""15"Akt.Datei "14"",b1= +#1114#""15"Datum "14""; +PROCeudas:IFaktuellereditor>0THENc1ELIFn0THENerrorstop(u0)ELSEd1END IF.d1:fenstergroessenbestimmen;page;bildschirmneu;k0:=heapsize;disablestop;n0:=TRUE;menueanbieten(ROW6TEXT:(o0,p0,q0,r0,s0,t0),fensterlinks,TRUE,PROC(INT CONST,INT CONST)e1);n0:=FALSE;enablestop;f1;page;bildschirmneuEND PROCeudas;PROCc1:TEXT VARg1:=e0;h1;f1;IFi1THEN LEAVEc1END IF;j1(FALSE);aufsatz(1);k1(g1);REPl1;uebersicht(g1,PROCm1);h1;n1UNTILo1END REP;dateienloeschen(FALSE).i1:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFinhaltveraendert(p1)THEN LEAVEi1WITH TRUE END IF END REP;FALSE.l1:IFja(v0,"JA/Suchmuster")THENsuchen;allesneuEND IF.n1:IFmarkiertesaetze=0CANDq1THENr1(s1,b0,PROC(TEXT CONST)t1)ELIFmarkiertesaetze>0CANDu1THENr1(s1,b0,PROC(TEXT CONST)t1);markierungenloeschenELIFv1THENmarkierungenloeschen;markierungaendern;r1(s1,b0,PROC(TEXT CONST)t1);markierungenloeschenEND IF.q1:ja(w0,"JA/alle Saetze",FALSE).u1:ja(x0,"JA/alle markierten").v1:ja(y0,"JA/Einzelsatz drucken").o1:NOTja(z0,"JA/noch einmal",FALSE).END PROCc1; +PROCh1:bildschirmneu;cursor(1,1);out(g0)END PROCh1;PROCt1(TEXT CONSTw1):x1;disablestop;drucke(w1);y1;h1END PROCt1;PROCe1(INT CONSTz1,a2):enablestop;SELECTz1OF CASE0:b2CASE1:c2(a2)CASE2:d2(a2)CASE3:e2(a2)CASE4:f2(a2)CASE5:dateiverwaltung(a2)CASE6:archivverwaltung(z1,a2)END SELECT.b2:IFanzahldateien=0THENg2(FALSE);h2(FALSE)ELIF NOTaendernerlaubtTHENh2(FALSE)END IF;i2;fusszeile("","",35,b1,64);fussteil(3,date).END PROCe1;PROCg2(BOOL CONSTj2):INT VARk2;waehlbar(1,4,j2);waehlbar(1,5,j2);waehlbar(1,7,j2);FORk2FROM1UPTO12REPwaehlbar(2,k2,j2)END REP;waehlbar(3,1,j2);waehlbar(3,4,j2);waehlbar(3,6,j2);waehlbar(4,1,j2)END PROCg2;PROCi2:BOOL VARj2:=anzahldateien=1ANDaendernerlaubt;waehlbar(1,6,j2);waehlbar(3,5,j2);j2:=anzahldateien>0ANDanzahldateien<10AND NOTaufkoppeldatei;waehlbar(1,2,j2);waehlbar(1,3,j2)END PROCi2;PROCh2(BOOL CONSTj2):INT VARk2;FORk2FROM8UPTO11REPwaehlbar(2,k2,j2)END REP;waehlbar(3,2,j2);waehlbar(3,3,j2)END PROCh2;LETl2= +#1115#""15"Manager "14"",m2= +#1116#"Manager ausschalten",n2= +#1117#"Keine Sicherung nötig.",o2= +#1118#"Interne Arbeitskopien löschen",p2= +#1119#"Arbeitskopie ",q2= +#1120#" unverändert.",r2= +#1121#" verändert! Optionen zum Sichern:",s2= +#1125#"Sichern unter dem neuen Namen:",t2= +#1126#" überschreiben",u2= +#1127#"Datei wieder sortieren",v2= +#1128#"Notizen",w2= +#1129#"Name Managertask:",x2= +#1130#"Task existiert nicht !",y2= +#1131#"Wollen Sie etwas verändern (eine Arbeitskopie anlegen)",z2= +#1132#"Alle Markierungen gelöscht.",a3= +#1133#"Prüfbedingungen",b3= +#1134#"Feldnamen ändern",c3= +#1135#"Feldtypen ändern",d3= +#1136#"Feldnamen anfügen",e3= +#1137#"Neuer Feldname:",f3= +#1138#"Typwahl für Feld ",g3= +#1139#"Neue Feldnamen",h3= +#1140#"TEXT ",i3= +#1141#" DIN ",j3= +#1142#"ZAHL ",k3= +#1143#"DATUM",l3= +#1144#"Alte Feldreihenfolge ändern",m3= +#1145#""7"ACHTUNG: System voll, Dateien löschen!"; +BOOL VARn3,o3:=FALSE;TASK VARp3:=niltask;TEXT VARq3:=e0;SATZ VARr3;ROW6TEXT VARs3;s3(1):=h3;s3(2):=i3;s3(3):=j3;s3(4):=k3;s3(5):=e0;s3(6):=e0;PROCc2(INT CONSTa2):SELECTa2OF CASE0:t3CASE1:u3CASE2:v3CASE3:w3CASE4:x3CASE5:y3CASE6:z3CASE7:a4CASE8:b4OTHERWISEc4END SELECT;d4;e4.t3:IFanzahldateien=0THENe1(0,0)END IF;f4;fussteil(2,l2,q3).u3:f1;j1(TRUE);IFanzahldateien>0THENpush("2")END IF.v3:g4(PROC(TEXT CONST)h4).w3:g4(PROC(TEXT CONST)i4).x3:IFaendernerlaubtTHENj4ELSEdateienloeschen(FALSE);dialog(n2)END IF;k4.j4:INT VARp1;FORp1FROM1UPTOanzahldateienREPeinzelsicherung(p1)END REP;IFja(o2,"JA/Dateien loeschen")THENl4;dateienloeschen(TRUE)END IF.k4:IFanzahldateien=0THENg2(FALSE);h2(FALSE)END IF;i2;f4.y3:m4;dialogfensterloeschen.z3:zugriff(PROC(EUDAT VAR)feldstruktur).a4:n4;dialogfensterloeschen.b4:TEXT VARo4:="";editget(w2,o4,"","GET/multi task");IFo4=e0THEN IFp4THENq4(e0,FALSE)END IF ELIFexiststask(o4)THENr4(task(o4));q4(o4,TRUE)ELSEerrorstop(x2)END IF.p4:ja(m2,"JA/manager aus").e4:IFheapsize-k0 +>4THENcollectheapgarbage;k0:=heapsizeEND IF.c4:IFa2=-1THENdialogfensterloeschen;LEAVEc2END IF.END PROCc2;PROCg4(PROC(TEXT CONST)s4):ausfuehrung(t4,TRUE,c0,p3,PROC(TEXT CONST)s4);i2;f4END PROCg4;PROCf4:TEXT VARu4:=e0;IFanzahldateien>0THENu4CAT"""";u4CATeudasdateiname(1);u4CAT""""END IF;IFanzahldateien>1THENu4CAT" .."END IF;fussteil(1,a1,u4)END PROCf4;PROCq4(TEXT CONSTv4,BOOL CONSTw4):IFw4THENp3:=task(v4)ELSEp3:=niltaskEND IF;o3:=w4;q3:=v4;fussteil(2,q3)END PROCq4;PROCf1:BOOL VARx4:=FALSE;IFaendernerlaubtTHENy4END IF.y4:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFinhaltveraendert(p1)THENeinzelsicherung(p1);x4:=TRUE;z4END IF END REP.z4:IFp1=1CANDstd=eudasdateiname(1)THENlastparam(e0)END IF.END PROCf1;PROCeinzelsicherung(INT CONSTp1):a5;IFinhaltveraendert(p1)THENb5ELSEdialog(c5)END IF.a5:TEXT VARc5:=p2;c5CATtextdarstellung(eudasdateiname(p1));IFinhaltveraendert(p1)THENc5CATr2ELSEc5CATq2END IF.b5:INT VARd5:=1;auswahlanbieten("WAHL.Sichern",c5,"WAHL/sichere",d5);e5.e5:TEXT VARname:= +eudasdateiname(p1);SELECTd5OF CASE1:f5CASE3:g5END SELECT;IFd5<>2THENh5END IF.f5:forget(name,quiet).g5:editget(s2,name,"","GET/Sicherungsname");IFexists(name)ORi5THENj5END IF.i5:k5(p1)CANDexists(name,herkunft(p1)).j5:IFja(textdarstellung(name)+t2,"JA/ueber",FALSE)THENforget(name,quiet)ELSEeinzelsicherung(p1);LEAVEeinzelsicherungEND IF.h5:sichere(p1,name);l5;m5.l5:EUDAT VARn5;oeffne(n5,name);IFo5CANDp5THENbittewarten;sortiere(n5)END IF.o5:sortierreihenfolge(n5)<>e0CANDunsortiertesaetze(n5)>0.p5:ja(u2,"JA/Sicherungssortierung").m5:IFk5(p1)THENdisablestop;setcommanddialoguefalse;save(name,herkunft(p1));resetcommanddialogue;enablestop;forget(name,quiet)END IF.END PROCeinzelsicherung;PROCj1(BOOL CONSTq5):IFaendernerlaubtTHENl4END IF;dateienloeschen(TRUE);g2(FALSE);h2(FALSE);forget(j0);disablestop;n3:=q5;g4(PROC(TEXT CONST)r5);enablestop;IFanzahldateien>0THENg2(TRUE);h2(aendernerlaubt)END IF END PROCj1;PROCl4:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFk5(p1)THENs5END IF END REP.s5:free( +eudasdateiname(p1),herkunft(p1)).END PROCl4;PROCr5(TEXT CONSTw1):BOOL VARt5;TASK VARu5;v5;oeffne(w1,t5,u5).v5:IFw5ANDn3THENfrageobeinrichten(w1);EUDAT VARn5;oeffne(n5,w1);feldstruktur(n5);t5:=TRUE;u5:=niltaskELSEt5:=n3CANDja(y2,"JA/oeffne",FALSE);x5(w1,t5,u5)END IF.w5:NOTexists(w1)ANDy5.y5:NOTo3COR NOTexists(w1,p3).END PROCr5;PROCh4(TEXT CONSTw1):TASK VARu5;x5(w1,aendernerlaubt,u5);kette(w1,u5)END PROCh4;PROCi4(TEXT CONSTw1):TASK VARu5;x5(w1,aendernerlaubt,u5);kopple(w1,u5)END PROCi4;PROCx5(TEXT CONSTw1,BOOL CONSTz5,TASK VARu5):u5:=niltask;IFo3THENa6END IF.a6:IF NOTexists(w1)CANDexists(w1,p3)THEN IFz5THENlock(w1,p3)END IF;forget(w1,quiet);fetch(w1,p3);u5:=p3END IF.END PROCx5;BOOL PROCk5(INT CONSTp1):NOTisniltask(herkunft(p1))END PROCk5;PROCm4:notizenlesen(3,m0);DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);disablestop;headline(f,v2);c6(f,m0,fensterganz,"EDIT/Notizen");forget(b6);enablestop;IFaendernerlaubtTHENnotizenaendern(3,m0)END IF END PROCm4;PROCc6(FILE VARf,TEXT +VARd6,FENSTER CONSTe6,TEXT CONSTf6):LETg6="#-#";enablestop;h6;i6;j6.h6:INT VARk6:=1,l6;REPl6:=pos(d6,g6,k6);IFl6=0THENputline(f,subtext(d6,k6))ELSEputline(f,subtext(d6,k6,l6-1))END IF;k6:=l6+3UNTILl6=0ORk6>length(d6)END REP.i6:modify(f);edit(f,e6,f6,TRUE).j6:TEXT VARm6;d6:=e0;input(f);WHILE NOTeof(f)REPgetline(f,m6);n6;d6CATm6;d6CATg6END REP.n6:IF(m6SUBlength(m6))=f0THENm6:=subtext(m6,1,length(m6)-1)END IF.END PROCc6;PROCfeldstruktur(EUDAT VARn5):INT VARo6;feldnamenlesen(n5,r3);IFp6THENq6END IF;IFr6THENs6END IF;IFja(c3,"JA/Feldtypen aendern",FALSE)THENt6END IF;feldnamenaendern(n5,r3).p6:felderzahl(r3)>0CANDja(b3,"JA/Feldnamen aendern",FALSE).r6:felderzahl(r3)=0CORja(d3,"JA/feldnamen",FALSE).q6:u6(n5);o6:=1;WHILEwahl(o6)>0REPv6;o6INCR1END REP.v6:TEXT VARw6;feldlesen(r3,wahl(o6),w6);editget(e3,w6,"","GET/feldname");feldaendern(r3,wahl(o6),w6).s6:DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);disablestop;x6(f,r3);forget(b6);enablestop;feldnamenaendern(n5,r3).t6:u6(n5);o6:= +1;WHILEwahl(o6)>0REPy6;o6INCR1END REP.y6:INT VARd5:=feldinfo(n5,wahl(o6))+2;feldlesen(r3,wahl(o6),w6);auswahlanbieten("WAHL.Typen",f3+textdarstellung(w6),"WAHL/Feldtypen",d5);feldinfo(n5,wahl(o6),d5-2).END PROCfeldstruktur;PROCu6(EUDAT CONSTn5):z6;auswahlanbieten("EUDAS-Felder",fensterrechts,"AUSWAHL/Felder",PROC(TEXT VAR,INT CONST)a7).z6:INT VARo6;satzinitialisieren(b7);FORo6FROM1UPTOfelderzahl(r3)REPfeldlesen(r3,o6,m0);feldaendern(b7,o6,c7+m0)END REP.c7:"<"+s3(feldinfo(n5,o6)+2)+"> ".END PROCu6;PROCn4:enablestop;DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);headline(f,a3);notizenlesen(1,m0);disablestop;c6(f,m0,fensterganz,"EDIT/Pruefbed");forget(b6);enablestop;IFaendernerlaubtTHENnotizenaendern(1,m0)END IF.END PROCn4;PROCx6(FILE VARf,SATZ VARd7):enablestop;e7;f7.e7:modify(f);headline(f,g3);edit(f,fensterrechts,"EDIT/Feldnamen",TRUE).f7:INT VARo6:=felderzahl(d7);input(f);WHILE NOTeof(f)REPgetline(f,m0);n6;o6INCR1;feldaendern(d7,o6,m0)END REP.n6:IF(m0SUBlength(m0))=f0 +THENm0:=subtext(m0,1,length(m0)-1)END IF.END PROCx6;PROCd4:INT VARg7,h7;storage(g7,h7);IFh7>g7THENneuerdialog;dialog(m3)END IF END PROCd4;BOOL VARi7,j7:=FALSE,k7:=FALSE;LETl7= +#1146#"SATZ ÄNDERN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",m7= +#1147#"SATZ EINFÜGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",n7= +#1148#"SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",o7= +#1149#"Umschalten auf Koppeldatei ",p7= +#1150#"Koppelfelder übernehmen",q7= +#1151#"Ungültige Satznummer",r7= +#1152#"Neue Satznummer:",s7= +#1153#"wzK",t7= +#1154#"wz"; +PROCd2(INT CONSTa2):SELECTa2OF CASE0:u7CASE1:v7CASE2:w7CASE3:x7CASE4:y7CASE5:z7CASE6:a8CASE7:b8CASE8:c8CASE9:d8CASE10:e8CASE11:f8CASE12:g8CASE13:h8CASE14:i8CASE15:j8CASE16:k8CASE17:l8OTHERWISEm8END SELECT;d4.u7:f4;fussteil(2,"","");exitzeichen(t7).v7:bittewarten;weiter(2);bildausgeben(FALSE).w7:bittewarten;zurueck(2);bildausgeben(FALSE).z7:suchen;bildausgeben(TRUE).a8:suchbedingungloeschen;bildausgeben(FALSE).x7:TEXT VARn8:=e0;editget(r7,n8,"","GET/auf Satz");INT CONSTo8:=int(n8);IFn8=e0THENbildausgeben(FALSE)ELIFlastconversionokTHENaufsatz(o8);bildausgeben(FALSE)ELSEerrorstop(q7)END IF.y7:TEXT VARp8;feldnamenlesen(1,p8);n8:=e0;editget(p8+":",n8,"","GET/auf Schluessel");aufsatz(n8);bildausgeben(FALSE).c8:einfuegen;bildausgeben(TRUE).d8:aendern;bildausgeben(TRUE).b8:markierungaendern;bildausgeben(FALSE).e8:q8;r1(r8,c0,PROC(TEXT CONST)s8);bildausgeben(TRUE).f8:q8;r1(t8,c0,PROC(TEXT CONST)holesatz);bildausgeben(TRUE).g8:TEXT VARu8:=e0;v8(u8,"EUDAS-Anzeigefelder","AUSWAHL/Anzeigefelder"); +IFu8<>e0THENfeldauswahl(u8)END IF;bildausgeben(TRUE).h8:w8;rollen(-23);IFanzahldateien>0THENbildausgeben(FALSE)END IF.i8:w8;rollen(23);IFanzahldateien>0THENbildausgeben(FALSE)END IF.j8:w8;rollen(-9999);IFanzahldateien>0THENbildausgeben(FALSE)END IF.k8:w8;rollen(9999);IFanzahldateien>0THENbildausgeben(FALSE)END IF.l8:IFaufkoppeldateiTHENx8ELSEy8END IF;IFanzahldateien>0THENbildausgeben(TRUE)END IF.x8:IF(k7ORj7)THENz8;a9ELSEaufkoppeldatei(0)END IF;i2.z8:IF NOTdateiendeCANDja(p7,"JA/uebernehmen")THENaufkoppeldatei(1)ELSEaufkoppeldatei(0)END IF.a9:j7:=FALSE;IFk7THENk7:=FALSE;aendernELSEb9(TRUE)END IF.m8:IFa2=-2THEN IFanzahldateien>0THENbildausgeben(FALSE)END IF ELSEdialogfensterloeschenEND IF.END PROCd2;PROCsuchen:disablestop;exitzeichen("");statusanzeigen(n7);suchen(PROCc9);exitzeichen(t7)END PROCsuchen;PROCc9:hilfeanbieten("EDIT/Suchen",fensterrechts)END PROCc9;PROCeinfuegen:b9(FALSE)END PROCeinfuegen;PROCb9(BOOL CONSTd9):BOOL VARe9:=d9;f9;REPstatusanzeigen(m7);IFe9THENaendern(PROCg9);e9 +:=FALSE ELSEeinfuegen(PROCg9)END IF;h9;i9END REP.i9:SELECTpos(s7,exitdurch)OF CASE0:IFi7THENsatzloeschenEND IF;LEAVEb9CASE1:IFi7THENsatzloeschenELSEbittewarten;weiter(2)END IF CASE2:IFi7THENsatzloeschenELSEbittewarten;zurueck(2)END IF CASE3:y8;IFaufkoppeldateiTHENj7:=TRUE;LEAVEb9END IF;e9:=TRUE END SELECT.END PROCb9;PROCg9:hilfeanbieten("EDIT/Einfuegen",fensterrechts)END PROCg9;PROCf9:IFanzahlkoppeldateien>0AND NOTaufkoppeldateiTHENexitzeichen(s7)ELSEexitzeichen(t7)END IF END PROCf9;PROCaendern:f9;kommandoauftastelegen("F","prueffehler editieren");REPstatusanzeigen(l7);aendern(PROCj9);h9;k9END REP.k9:SELECTpos(s7,exitdurch)OF CASE0:IFi7THENsatzloeschenEND IF;LEAVEaendernCASE1:IFi7THENsatzloeschenELSEbittewarten;weiter(2)END IF CASE2:IFi7THENsatzloeschenEND IF;bittewarten;zurueck(2)CASE3:y8;IFaufkoppeldateiTHENk7:=TRUE;LEAVEaendernEND IF END SELECT.END PROCaendern;PROCj9:hilfeanbieten("EDIT/Aendern",fensterrechts)END PROCj9;PROCprueffehlereditieren:IFl0=dateiversionTHENmodify(i0);edit( +i0)END IF END PROCprueffehlereditieren;PROCy8:INT VARp1:=folgedatei(0);WHILEp1>0REP IFl9THENaufkoppeldatei(p1);i2;LEAVEy8END IF;p1:=folgedatei(p1)END REP.l9:ja(o7+textdarstellung(eudasdateiname(p1)),"JA/umschalten").END PROCy8;PROCm9(TEXT CONSTm6,INT CONSTdummy):outsubtext(m6,n9);out(h0).n9:pos(m6,f0,6)+1+dummy-dummy.END PROCm9;PROCh9:feldbearbeiten(1,PROC(TEXT CONST,INT CONST,INT CONST)o9)END PROCh9;PROCo9(TEXT CONSTd7,INT CONSTk6,l6):i7:=k6<3ORk6>length(d7)+l6-l6END PROCo9;PROCw8:cursor(15,24)END PROCw8;PROCs8(TEXT CONSTw1):IFexists(w1)THENp9ELSEfrageobeinrichten(w1)END IF;bittewarten;tragesatz(w1).p9:IFq9(w1)<>0THENerrorstop(r9)END IF.END PROCs8;PROCv8(TEXT VARu8,TEXT CONSTs9,t9):auswahlanbieten(s9,fensterrechts,256,t9,u8,PROC(TEXT VAR,INT CONST)u9);u8:=e0;INT VARn8:=1;WHILEwahl(n8)>0REPu8CATcode(wahl(n8));n8INCR1END REP END PROCv8;LETt4= +#1155#"Name der Datei:",r8= +#1156#"Name der Zieldatei:",v9= +#1157#"Name der Verarbeitungsvorschrift:",s1= +#1158#"Name des Druckmusters:",t8= +#1159#"Name der Quelldatei:"; +LETg8= +#1160#"Angezeigte Felder auswählen",w9= +#1161#" aufsteigend sortieren"; +TEXT VARx9:=e0;INT VARy9:=0;DATASPACE VARz9;PROCe2(INT CONSTa2):SELECTa2OF CASE0:a10CASE1:b10CASE2:c10CASE3:d10CASE4:e10CASE5:f10CASE6:g10OTHERWISEc4END SELECT;d4.a10:f4;fussteil(2,"","").c10:q8;r1(r8,c0,PROC(TEXT CONST)h10).b10:q8;r1(r8,c0,PROC(TEXT CONST)i10);dialogfensterloeschen.d10:ausfuehrung(v9,b0,PROC(TEXT CONST)j10);dialogfensterloeschen.e10:IFdateiversion<>y9THENx9:=e0;y9:=dateiversionEND IF;k1(x9);uebersicht(x9,PROCm1);dialogfensterloeschen.f10:zugriff(PROC(EUDAT VAR)k10).g10:markierungenloeschen;dialog(z2).c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCe2;PROCq8:IFq9(std)<>0THENlastparam(e0)END IF END PROCq8;PROCh10(TEXT CONSTw1):BOOL VARl10;IFexists(w1)THENp9;m10ELSEfrageobeinrichten(w1);l10:=FALSE END IF;BOOL CONSTn10:=ja(o10,"JA/sortieren");bittewarten;p10;trage(w1,i0,l10);q10;IFn10THEN EUDAT VARn5;oeffne(n5,w1);sortiere(n5)END IF.p9:IFq9(w1)<>0THENerrorstop(r9)END IF.m10:l10:=ja(r10,"JA/testen").p10:IFl10THENforget(j0);j0:=nilspace;i0:=sequentialfile(output,j0);l0:= +dateiversionELSEforget(j0);l0:=dateiversion-1END IF.q10:IFl10CANDlines(i0)>0THENdialog(text(lines(i0))+s10)END IF.END PROCh10;PROCj10(TEXT CONSTw1):IF NOTexists(w1)THENt10(w1,"EDIT/Verarbeite")END IF;x1;FILE VARf:=sequentialfile(input,w1);disablestop;verarbeite(f);y1.END PROCj10;PROCk1(TEXT VARx9):IFja(g8,"JA/Ub.Felder")THENv8(x9,"EUDAS-Anzeigefelder","AUSWAHL/Anzeigefelder")END IF END PROCk1;PROCm1:hilfeanbieten("UEBERSICHT",fensterganz)END PROCm1;PROCi10(TEXT CONSTw1):disablestop;z9:=nilspace;u10(w1);forget(z9)END PROCi10;PROCu10(TEXT CONSTw1):TEXT VARv10:="";FILE VARf;EUDAT VARn5;BOOL VARn10:=FALSE;enablestop;IFexists(w1)THENw10ELSEfrageobeinrichten(w1)END IF;editget(x10,v10,"","GET/kopiermuster");IFexists(v10)THENf:=sequentialfile(input,v10)ELSEy10;stdkopiermuster(w1,f)END IF;modify(f);z10;a11.w10:IFq9(w1)<>0THENerrorstop(r9)END IF;oeffne(n5,w1);IFsortierreihenfolge(n5)<>e0THENn10:=ja(o10,"JA/sortieren")END IF.y10:IFv10=e0THENf:=sequentialfile(output,z9)ELSEfrageobeinrichten(v10);f +:=sequentialfile(output,v10)END IF.z10:edit(f,fensterganz,"EDIT/Kopiermuster",TRUE);x1;kopiere(w1,f).a11:IFn10THENoeffne(n5,w1);sortiere(n5)END IF.END PROCu10;INT PROCq9(TEXT CONSTw1):INT VARp1;FORp1FROM1UPTOanzahldateienREP IFeudasdateiname(p1)=w1THEN LEAVEq9WITHp1END IF END REP;0END PROCq9;PROCt10(TEXT CONSTw1,b11):IF NOTexists(w1)THENfrageobeinrichten(w1)END IF;FILE VARf:=sequentialfile(modify,w1);edit(f,fensterganz,b11,TRUE)END PROCt10;PROCx1:bittewarten;cursor(1,2);out(g0);bildschirmneuEND PROCx1;PROCk10(EUDAT VARn5):TEXT VARc11:=sortierreihenfolge(n5);IFc11=e0CORd11THENe11;bittewarten;sortiere(n5,c11)ELSEbittewarten;sortiere(n5)END IF.d11:ja(l3,"JA/Sortierfelder",FALSE).e11:feldnamenlesen(n5,b7);auswahlanbieten("EUDAS-Sortierfelder",fensterrechts,1024,"AUSWAHL/Sortierfelder",c11,PROC(TEXT VAR,INT CONST)a7);INT VARo6:=1;c11:=e0;WHILEwahl(o6)<>0REPc11CATcode(wahl(o6));f11;o6INCR1END REP.f11:feldlesen(b7,wahl(o6),m0);IFja(textdarstellung(m0)+w9,"JA/Sortierrichtung")THENc11CAT"+"ELSE +c11CAT"-"END IF.END PROCk10;PROCu9(TEXT VARname,INT CONSTn8):IFn8<=anzahlfelderTHENfeldnamenlesen(n8,name)ELSEname:=e0END IF END PROCu9;LETg11= +#1163#"Name Ausgabedatei:",h11= +#1210#"Erzeugte Ausgabe ausdrucken",i11= +#1211#"Erzeugte Ausgabe löschen",j11= +#1212#"Richtung der Druckausgabe:",k11= +#1213#"Form der Liste:",l11= +#1214#"Anzahl Zeichen pro Zeile:",m11= +#1215#"Eingabe ist keine gültige Zahl",o10= +#1164#"Zieldatei anschließend sortieren",r10= +#1165#"Prüfbedingungen testen",s10= +#1166#"Prüffehler festgestellt",r9= +#1167#"Zieldatei darf nicht geöffnet sein",x10= +#1168#"Name Kopiermuster (RET=Std):"; +LETn11= +#1169#" zeilenweise formatieren",o11= +#1170#" seitenweise formatieren"; +LETp11=0,q11=1,r11=2;BOOL VARs11:=FALSE,t11:=FALSE;PROCf2(INT CONSTa2):SELECTa2OF CASE0:a10CASE1:u11CASE2:v11CASE3:w11CASE4:x11CASE5:y11CASE6:z11OTHERWISEc4END SELECT;d4.a10:f4;fussteil(2,"","").u11:ausfuehrung(s1,b0,PROC(TEXT CONST)a12);dialogfensterloeschen.v11:INT VARb12:=1;auswahlanbieten("WAHL.Std-Listen",k11,"WAHL/Std-Listen",b12);c12;d12;e12;f12;x1;druckestandardlisten(b12,g12);h12.c12:TEXT VARg12:=e0;v8(g12,"EUDAS-Druckfelder","AUSWAHL/Druckfelder").d12:.e12:TEXT VARi12:=text(stdlistenbreite);editget(l11,i12,"","GET/listenbreite");INT CONSTj12:=int(i12);IF NOTlastconversionokTHENerrorstop(m11)ELSEstdlistenbreite(j12)END IF.w11:INT VARd5:=druckrichtung+1;auswahlanbieten("WAHL.Richtung",j11,"WAHL/Richtung",d5);druckrichtung(d5-1).x11:ausfuehrung(t4,b0,PROC(TEXT CONST)k12);dialogfensterloeschen.y11:ausfuehrung(t4,b0,PROC(TEXT CONST)print).z11:ausfuehrung(t4,b0,PROC(TEXT CONST)l12);dialogfensterloeschen.c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCf2;PROCy1:IFm12THENclearerror +END IF.m12:iserrorCANDerrormessage=e0.END PROCy1;PROCa12(TEXT CONSTw1):IF NOTexists(w1)THENk12(w1)END IF;f12;x1;disablestop;drucke(w1);h12;y1.END PROCa12;PROCf12:IFdruckrichtung=r11THEN TEXT VARw1:=druckdatei;IFpos(w1,"$")>0THENw1:=e0END IF;editget(g11,w1,"","GET/Druckdatei");IFw1<>e0THENdruckdatei(w1)END IF END IF END PROCf12;PROCh12:IF NOTiserrorCANDdruckrichtung=q11CANDexists(druckdatei)THENenablestop;n12END IF.n12:FILE VARo12:=sequentialfile(input,druckdatei);edit(o12,fensterganz,"EDIT/Druckausgabe",TRUE);IFja(h11,"JA/Ausgabe drucken",FALSE)THENprint(druckdatei)END IF;IFja(i11,"JA/Ausgabe loeschen",FALSE)THENforget(druckdatei,quiet)END IF.END PROCh12;PROCk12(TEXT CONSTw1):t10(w1,"EDIT/Druckmuster")END PROCk12;PROCprint(TEXT CONSTw1):do("print ("+textdarstellung(w1)+")")END PROCprint;PROCl12(TEXT CONSTw1):IFja(textdarstellung(w1)+n11,"JA/zeilenform")THENp12END IF;IFja(textdarstellung(w1)+o11,"JA/seitenform")THENseitenformatierenEND IF.p12:IFs11THENautoform(w1)ELSElineform(w1)END IF; +page;bildschirmneu.seitenformatieren:IFt11THENautopageform(w1)ELSEpageform(w1)END IF;bildschirmneu.END PROCl12;PROCformatierenautomatisch(BOOL CONSTq12,r12):s11:=q12;t11:=r12END PROCformatierenautomatisch;INITFLAG VARs12;TEXT VARt12;LETu12= +#1171#""15"Bereich "14"",v12= +#1172#"Neuer Name:",w12= +#1173#"Zieldatei:",x12= +#1174#"belegt ",y12= +#1175#"KB.",z12= +#1176#" existiert nicht.",a13= +#1177#" in dieser Task löschen"; +PROCdateiverwaltung(INT CONSTa2):enablestop;SELECTa2OF CASE0:a10CASE1:b13CASE2:c13CASE3:d13CASE4:e13CASE5:f13CASE6:g13OTHERWISEc4END SELECT;d4.a10:arbeitsbereichbestimmen;fussteil(2,"","").g13:ausfuehrung(PROC(TEXT CONST)h13).d13:ausfuehrung(PROC(TEXT CONST)i13).c13:ausfuehrung(PROC(TEXT CONST)j13).b13:disablestop;DATASPACE VARk13:=nilspace;FILE VARf:=sequentialfile(output,k13);list(f);IF NOTiserrorTHENedit(f,fensterrechts,"SHOW/Uebersicht",FALSE)END IF;forget(k13);enablestop;l13.e13:ausfuehrung(PROC(TEXT CONST)m13).f13:ausfuehrung(PROC(TEXT CONST)n13).c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCdateiverwaltung;PROCarbeitsbereichbestimmen:IF NOTinitialized(s12)THENo13END IF;fussteil(1,u12,t12).o13:IFstation(myself)<>0THENt12:=text(station(myself))+"/"""ELSEt12:=""""END IF;t12CATname(myself);t12CAT"""".END PROCarbeitsbereichbestimmen;PROCl13:WHILEgetcharety<>e0REP END REP END PROCl13;PROCh13(TEXT CONSTw1):bittewarten;IFtype(old(w1))=c0THENreorganisiere(w1)ELSEreorganize(w1)END IF +END PROCh13;PROCi13(TEXT CONSTw1):TEXT VARp13:=w1;IFexists(w1)THENeditget(v12,p13,"","GET/rename")END IF;rename(w1,p13)END PROCi13;PROCj13(TEXT CONSTw1):IFq13THENerrorstop(r9)ELIFexists(w1)CANDr13THENforget(w1,quiet)END IF.q13:q9(w1)<>0.r13:ja(textdarstellung(w1)+a13,"JA/forget",FALSE).END PROCj13;PROCm13(TEXT CONSTw1):TEXT VARs13:=e0;editget(w12,s13,"","GET/copy");copy(w1,s13)END PROCm13;PROCn13(TEXT CONSTw1):dialog(textdarstellung(w1));IFexists(w1)THENout(x12);put(storage(old(w1)));out(y12)ELSEout(z12)END IF END PROCn13;TEXT VARt13:=e0,u13:="ARCHIVE";INT VARv13:=0;THESAURUS VARw13;BOOL VARx13,y13:=TRUE;LETz13= +#1182#""15"Ziel "14"",a14= +#1183#"Archiv heisst ",b14= +#1184#"Name des Archivs:",c14= +#1185#"Name Zielarchiv:",d14= +#1186#"Nr. der Zielstation (od. RETURN):",e14= +#1187#"Art des Zielarchivs:",f14= +#1188#"Diskette neu formatieren",g14= +#1189#"Neuer Archivname:",h14= +#1190#" in dieser Task überschreiben",i14= +#1191#" auf Archiv löschen",j14= +#1192#"Archiv ",k14= +#1193#" überschreiben",l14= +#1194#"Diskette eingelegt",m14= +#1195#" auf Archiv überschreiben",n14= +#1196#"Mögliche Diskettenformate: "; +LETo14= +#1197#"Passwort: ",p14= +#1198#"Passwort stimmt nicht mit der ersten Eingabe überein",q14= +#1199#"Passwort zur Kontrolle bitte nochmal eingeben:",r14= +#1200#"Passwort löschen",s14= +#1201#"Unzulässige Stationsnummer",t14= +#1202#"Angegebene Task ist kein Manager"; +ROW4TEXT VARu14;u14(1):="ARCHIVE";u14(2):="PUBLIC";u14(3):="ARCHIVE360";u14(4):="DOS";PROCarchivverwaltung(INT CONSTz1,a2):enablestop;SELECTa2OF CASE0:v14CASE1:w14CASE2:x14CASE3:y14CASE4:z14CASE5:a15CASE6:b15CASE7:c15CASE8:d15CASE9:e15OTHERWISEf15END SELECT;d4.v14:arbeitsbereichbestimmen;waehlbar(z1,6,y13);waehlbar(z1,9,NOTy13);fussteil(2,z13,g15+u13);x13:=FALSE.z14:IFy13THENh15END IF;bittewarten;w13:=ALLi15;ausfuehrung(PROC(TEXT CONST)j15).y14:disablestop;k15;bittewarten;w13:=ALLi15;IFl15THENw13:=ALLi15END IF;enablestop;aufarchiv(PROC(TEXT CONST)m15,w13).a15:IFy13THENh15END IF;bittewarten;w13:=ALLi15;aufarchiv(PROC(TEXT CONST)a15,w13).w14:k15;disablestop;bittewarten;DATASPACE VARk13:=nilspace;f:=sequentialfile(output,k13);list(f,i15);IFl15THENlist(f,i15)END IF;IF NOTiserrorTHENmodify(f);toline(f,1);writerecord(f,headline(f));headline(f,e0);edit(f,fensterrechts,"SHOW/Uebersicht",FALSE)END IF;forget(k13);l13;enablestop.x14:k15;n15;FILE VARf:=sequentialfile(output,o15);disablestop; +bittewarten;list(f,i15);IFl15THENlist(f,i15)END IF;IFiserrorTHENforget(o15,quiet)END IF;enablestop;modify(f);insertrecord(f);writerecord(f,headline(f));print(o15);forget(o15,quiet).n15:INT VARk2:=0;TEXT VARo15;REPk2INCR1;o15:="Archivliste "+text(k2)UNTIL NOTexists(o15)END REP.b15:k15;IFp15CORq15CANDr15THEN LEAVEb15END IF;BOOL CONSTs15:=ja(f14,"JA/format");t15;u15.p15:NOTja(l14,"JA/eingelegt").q15:reserve("",i15);bittewarten;disablestop;w13:=ALLi15;BOOL CONSTd5:=l15;clearerror;enablestop;d5.r15:NOTja(j14+textdarstellung(t13)+k14,"JA/archiv loeschen").t15:editget(g14,t13,"","GET/Archivname");reserve(t13,i15).u15:IFs15THENv15;w15ELSEx15END IF.x15:bittewarten;disablestop;setcommanddialoguefalse;clear(i15);resetcommanddialogue.v15:INT VARstd:=1;auswahlanbieten("WAHL.Format",n14,"WAHL/format",std);stdDECR1.w15:bittewarten;disablestop;setcommanddialoguefalse;format(std,i15);resetcommanddialogue;enablestop.c15:INT VARy15:=1;IFx13THENrelease(i15);x13:=FALSE END IF;auswahlanbieten("WAHL.Ziel", +e14,"WAHL/zielarchiv",y15);TEXT VARz15:=u14(y15);IFy15>1THENa16END IF;b16;c16;waehlbar(z1,6,y13);waehlbar(z1,9,NOTy13);bildschirmneu;fussteil(2,g15+u13).a16:editget(c14,z15,"","GET/Zielarchiv");IFz15=e0THEN LEAVEc15END IF;u14(y15):=z15.b16:TEXT VARd16:=text(station(myself));IFstation(myself)<>0THENeditget(d14,d16,"","GET/Zielstation")END IF.c16:v13:=int(d16);IF NOTlastconversionokTHENerrorstop(s14)END IF;u13:=z15;y13:=y15=1ORy15=3;r4(i15).g15:IFv13=0THENe0ELSEtext(v13)+"/"END IF.e15:TEXT VARe16:=e0;editget(b14,e16,"","GET/Archivname");reserve(e16,i15);x13:=TRUE.f15:IFa2=-1THEN IFx13THENrelease(i15)END IF;dialogfensterloeschenEND IF.END PROCarchivverwaltung;TASK PROCi15:IFv13=0THENtask(u13)ELSEv13/u13END IF END PROCi15;PROCr4(TASK CONSTf16):INT VARk2;IFstation(f16)=station(myself)THEN FORk2FROM1UPTO5REP IFstatus(f16)=2ORstatus(f16)=6THEN LEAVEr4END IF;pause(10)END REP;errorstop(t14)END IF END PROCr4;PROCh15:TEXT VARg14:=t13;editget(b14,g14,"","GET/Archivname");IF NOTx13ORg14<>t13THEN +reserve(g14,i15);x13:=TRUE END IF;t13:=g14END PROCh15;PROCk15:IF NOTx13ANDy13THENreserve(t13,i15);x13:=TRUE END IF END PROCk15;BOOL PROCl15:IFy13ANDiserrorTHEN TEXT CONSTg16:=errormessage;IFsubtext(g16,1,14)=a14CANDsubtext(g16,16,20)<>"?????"THENclearerror;h16;LEAVEl15WITH TRUE END IF END IF;FALSE.h16:t13:=subtext(g16,16,length(g16)-1);reserve(t13,i15).END PROCl15;PROCj15(TEXT CONSTw1):disablestop;IF NOT(w13CONTAINSw1)CORi16THENj16;bittewarten;setcommanddialoguefalse;save(w1,i15);resetcommanddialogueEND IF.i16:ja(textdarstellung(w1)+m14,"JA/save",FALSE).j16:INT CONSTn8:=q9(w1);IFn8>0CANDaendernerlaubtCANDinhaltveraendert(n8)THENeinzelsicherung(n8)END IF.END PROCj15;PROCm15(TEXT CONSTw1):disablestop;IF NOTexists(w1)CORk16THENbittewarten;setcommanddialoguefalse;fetch(w1,i15);resetcommanddialogueEND IF.k16:ja(textdarstellung(w1)+h14,"JA/fetch",FALSE).END PROCm15;PROCa15(TEXT CONSTw1):disablestop;IF NOT(w13CONTAINSw1)CORa15THENbittewarten;setcommanddialoguefalse;erase(w1,i15); +resetcommanddialogueEND IF.a15:ja(textdarstellung(w1)+i14,"JA/erase",FALSE).END PROCa15;PROCd15:BOUND ROW2TEXT VARl16;DATASPACE VARb6:=nilspace;l16:=b6;disablestop;m16(o14,l16(1));IFl16(1)=e0THENn16ELSEo16END IF;forget(b6).n16:IFja(r14,"JA/pw loeschen")THENsetcommanddialoguefalse;enterpassword(e0);resetcommanddialogueEND IF.o16:m16(q14,l16(2));IFl16(1)<>l16(2)THENerrorstop(p14)ELSEsetcommanddialoguefalse;enterpassword(l16(1));resetcommanddialogueEND IF.END PROCd15;PROCm16(TEXT CONSTp16,TEXT VARq16):enablestop;dialog(p16);getsecretline(q16)END PROCm16;SATZ VARb7;PROCa7(TEXT VARr16,INT CONSTs16):IFs16<=256THENfeldlesen(b7,s16,r16)ELSEr16:=e0END IF END PROCa7;PROCfeldnamenanzeigen:IFanzahlfelder>0THENt16;u16;v16END IF.t16:INT VARo6;satzinitialisieren(b7,anzahlfelder);FORo6FROM1UPTOanzahlfelderREPfeldnamenlesen(o6,m0);feldaendern(b7,o6,m0)END REP.u16:auswahlanbieten("EUDAS-Editfelder",fensterrechts,"AUSWAHL/Feldnamen",PROC(TEXT VAR,INT CONST)a7).v16:INT VARs16:=1;WHILEwahl(s16)>0REP IFs16> +1THENtype(f0)END IF;feldnamenlesen(wahl(s16),m0);type("<");type(m0);type(">");s16INCR1END REP.END PROCfeldnamenanzeigen;PROCr1(TEXT CONSTp16,INT CONSTw16,PROC(TEXT CONST)s4):ausfuehrung(p16,TRUE,w16,PROC(TEXT CONST)s4)END PROCr1;PROCausfuehrung(TEXT CONSTp16,INT CONSTw16,PROC(TEXT CONST)s4):ausfuehrung(p16,FALSE,w16,PROC(TEXT CONST)s4)END PROCausfuehrung;PROCausfuehrung(PROC(TEXT CONST)s4):ausfuehrung(t4,0,PROC(TEXT CONST)s4)END PROCausfuehrung;END PACKETeudassteuerung; + diff --git a/app/eudas/5.3/src/eudas.alt b/app/eudas/5.3/src/eudas.alt new file mode 100644 index 0000000..41ca9b0 --- /dev/null +++ b/app/eudas/5.3/src/eudas.alt @@ -0,0 +1,44 @@ +PACKET eudas alt nach neu + + DEFINES + + eudas alt nach neu : + + +DATASPACE VAR scratch; + +PROC eudas alt nach neu (TEXT CONST datei alt, datei neu) : + + IF exists (datei neu) THEN + errorstop ("Zieldatei existiert bereits") + ELSE + FILE VAR f := sequential file (input, datei alt); + forget (scratch); scratch := nilspace; + BOUND TEXT VAR zeile := scratch; + BOUND SATZ VAR neu := scratch; + zieldatei einrichten; + kopieren; + forget (scratch) + END IF . + +zieldatei einrichten : + getline (f, zeile); + IF (zeile ISUB 1) < 3 OR (zeile ISUB 1) > 256 THEN + errorstop ("Ausgangsdatei ist keine EUDAS-Datei") + END IF; + EUDAT VAR e; + oeffne (e, datei neu); + feldnamen aendern (e, neu) . + +kopieren : + WHILE NOT eof (f) REP + getline (f, zeile); + satz einfuegen (e, neu); + cout (satznr (e)); + weiter (e) + END REP . + +END PROC eudas alt nach neu; + +END PACKET eudas alt nach neu; + diff --git a/app/eudas/5.3/src/eudas.dateien.05 b/app/eudas/5.3/src/eudas.dateien.05 new file mode 100644 index 0000000..b4a57e5 --- /dev/null +++ b/app/eudas/5.3/src/eudas.dateien.05 @@ -0,0 +1,1690 @@ +PACKET eudas dateien + +(*************************************************************************) +(* *) +(* EUDAS-Dateien als indexsequentielle Dateien *) +(* *) +(* Version 05 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 25.04.87 *) +(* *) +(*************************************************************************) + + DEFINES + + EUDAT, +(*dump, Test *) + oeffne, + satznr, + dateiende, + saetze, + auf satz, + weiter, + zurueck, + satz lesen, + satz aendern, + satz loeschen, + satz einfuegen, + feld lesen, + feld aendern, + feld bearbeiten, + felderzahl, + feldnamen lesen, + feldnamen aendern, + notizen lesen, + notizen aendern, + feldinfo, + automatischer schluessel, + dezimalkomma, + wert berechnen, + reorganisiere, + sortiere, + sortierreihenfolge, + unsortierte saetze : + + +LET + maxhash = 531, + maxindex = 121, + maxsatz = 5000, + eudat typ = 3243, + maxeintrag = 64, + dreiviertel maxeintrag = 48; + +LET + INTVEC = TEXT, + + INDEX = STRUCT + (INT vorgaenger, nachfolger, + INT eintraege, stelle, + INTVEC satzindex), + + EINTRAG = STRUCT + (INT vorgaenger, nachfolger, indexblock, attribut, + SATZ satz), + + DATEI = STRUCT + (INT felderzahl, + SATZ feldnamen, + INTVEC feldinfo, + TEXT sortierfelder, + INT letzter index, indexblocks, erster leerindex, + INT erster leersatz, anz satzeintraege, + INT anz saetze, satznr, + INT indexzeiger, indexstelle, satzzeiger, + INT anz unsortierte, schluesselzaehler, + ROW 3 TEXT notizen, + ROW maxhash INT hashliste, + ROW maxindex INDEX index, + ROW maxsatz EINTRAG ablage); + +TYPE EUDAT = BOUND DATEI; + +LET + niltext = ""; + +LET + datei ist keine eudas datei = #201# + "Datei ist keine EUDAS-Datei", + inkonsistente datei = #202# + "inkonsistente EUDAS-Datei", + eudas datei voll = #203# + "EUDAS-Datei voll", + nicht erlaubtes dezimalkomma = #204# + "Nicht erlaubtes Dezimalkomma"; + +TEXT VAR + feldpuffer; + +TEXT VAR + inttext := " "; + +INTVEC CONST + blockreservierung := intvec (maxeintrag, 1); + + +(*************************** Test-Dump ***********************************) +(* +PROC dump (EUDAT CONST datei, TEXT CONST file) : + + FILE VAR f := sequential file (output, file); + idump (CONCR (datei), f) + +END PROC dump; + +PROC idump (DATEI CONST datei, FILE VAR f) : + + put (f, "Felderzahl:"); put (f, datei. felderzahl); line (f); + INT VAR i; putline (f, "feldnamen:"); + FOR i FROM 1 UPTO felderzahl (datei. feldnamen) REP + TEXT VAR feld; feld lesen (datei. feldnamen, i, feld); + write (f, feld); write (f, ",") + END REP; line (f); putline (f, "feldinfo:"); + FOR i FROM 1 UPTO length (datei. feldinfo) DIV 2 REP + put (f, datei. feldinfo ISUB i) + END REP; line (f); + put (f, "letzter index:"); put (f, datei. letzter index); + put (f, "indexblocks:"); put (f, datei. indexblocks); + put (f, "erster leerindex:"); put (f, datei. erster leerindex); line (f); + put (f, "erster leersatz:"); put (f, datei. erster leersatz); + put (f, "anz satzeintraege:"); put (f, datei. anz satzeintraege); line (f); + put (f, "anz saetze:"); put (f, datei. anz saetze); + put (f, "satznr:"); put (f, datei.satznr); line (f); + put (f, "indexzeiger:"); put (f, datei. indexzeiger); + put (f, "indexstelle:"); put (f, datei. indexstelle); + put (f, "satzzeiger:"); put (f, datei. satzzeiger); line (f); + put (f, "anz unsortierte:"); put (f, datei. anz unsortierte); line (f); + ROW 10 INT VAR anzahl ketten; + FOR i FROM 1 UPTO 10 REP anzahl ketten (i) := 0 END REP; + FOR i FROM 1 UPTO maxhash REP + INT VAR laenge := 0; + laenge der hashkette bestimmen; + IF laenge > 10 THEN laenge := 10 END IF; + IF laenge > 0 THEN anzahl ketten (laenge) INCR 1 END IF + END REP; + put (f, "Hash:"); + FOR i FROM 1 UPTO 10 REP put (f, anzahl ketten (i)) END REP; line (f); + FOR i FROM 1 UPTO datei. indexblocks REP + put (f, "INDEX"); put (f, i); put (f, "vor:"); put (f, + datei. index (i). vorgaenger); put (f, "nach:"); put (f, + datei. index (i). nachfolger); put (f, "eintraege:"); put (f, + datei. index (i). eintraege); line (f); INT VAR j; + FOR j FROM 1 UPTO length (datei. index (i). satzindex) DIV 2 REP + put (f, datei. index (i). satzindex ISUB j) + END REP; + line (f) + END REP; + FOR i FROM 1 UPTO datei. anz satzeintraege REP + put (f, "SATZ"); put (f,i); put (f, "vor:"); put (f, + datei. ablage (i). vorgaenger); put (f, "nach:"); put (f, + datei. ablage (i). nachfolger); put (f, "index:"); put (f, + datei. ablage (i). indexblock); put (f, "attr:"); put (f, + datei. ablage (i). attribut); line (f); + FOR j FROM 1 UPTO felderzahl (datei. ablage (i). satz) REP + feld lesen (datei. ablage (i). satz, j, feld); + write (f, feld); write (f, ",") + END REP; cout (i); + line (f) + END REP . + +laenge der hashkette bestimmen : + INT VAR index := datei. hashliste (i); + WHILE index <> 0 REP + index := datei. ablage (index). vorgaenger; + laenge INCR 1 + END REP . + +END PROC i dump; +*) + +(**************************** INTVEC *************************************) + +(* An Stelle von maximal dimensionierten ROW max INT werden an ver- *) +(* schiedenen Stellen TEXTe mit eingeschriebenen Integern verwendet. *) +(* Auf diese Art und Weise werden auch das Einfuegen und Loeschen, sowie *) +(* das Aufsplitten und Zusammenfuegen effizienter realisiert. *) + +LET + empty intvec = ""; + +TEXT VAR + buffer; + +INTVEC PROC intvec (INT CONST length, value) : + + replace (inttext, 1, value); + length * inttext + +END PROC intvec; + +PROC insert (INTVEC VAR vector, INT CONST pos, value) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (vector) + 1 THEN + subscript overflow + ELSE + replace (inttext, 1, value); + buffer := subtext (vector, begin); + vector := subtext (vector, 1, begin - 1); + vector CAT inttext; + vector CAT buffer + END IF + +END PROC insert; + +PROC delete (INTVEC VAR vector, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin >= length (vector) THEN + subscript overflow + ELSE + buffer := subtext (vector, begin + 2); + vector := subtext (vector, 1, begin - 1); + vector CAT buffer + END IF + +END PROC delete; + +INT PROC pos (INTVEC CONST vector, INT CONST value) : + + replace (inttext, 1, value); + INT VAR begin := 1; + REP + begin := pos (vector, inttext, begin) + 1 + UNTIL (begin AND 1) = 0 OR begin = 1 END REP; + begin DIV 2 + +END PROC pos; + +PROC split up (INTVEC VAR source, dest, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (source) + 1 THEN + subscript overflow + ELSE + dest := subtext (source, begin); + source := subtext (source, 1, begin - 1) + END IF + +END PROC split up; + +PROC split down (INTVEC VAR source, dest, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (source) + 1 THEN + subscript overflow + ELSE + dest := subtext (source, 1, begin - 1); + source := subtext (source, begin) + END IF + +END PROC split down; + +. +subscript overflow : + errorstop (9, niltext) . + +subscript underflow : + errorstop (10, niltext) . + + +(************************** Datei oeffnen ********************************) + +PROC initialisiere eudat (DATEI VAR datei) : + + datei. felderzahl := 0; + datei. feldinfo := empty intvec; + satz initialisieren (datei. feldnamen); + datei. sortierfelder := niltext; + datei. letzter index := 1; + datei. indexblocks := 1; + datei. erster leersatz := 0; + datei. erster leerindex := 0; + datei. anz saetze := 0; + datei. anz satzeintraege := 1; + datei. anz unsortierte := 0; + datei. notizen (1) := niltext; + datei. notizen (2) := niltext; + datei. notizen (3) := niltext; + datei. satznr := 1; + datei. indexzeiger := 1; + datei. indexstelle := 1; + datei. satzzeiger := 1; + datei. index (1). satzindex := blockreservierung; + datei. index (1) := INDEX : (0, 0, 1, 1, intvec(1, 1)); + INT VAR i; + FOR i FROM 1 UPTO maxhash REP + datei. hashliste (i) := 0 + END REP; + datei. ablage (1) := EINTRAG : (0, 0, 1, 0, leersatz) . + +leersatz : + datei. feldnamen . + +END PROC initialisiere eudat; + +PROC oeffne (EUDAT VAR datei, TEXT CONST dateiname) : + + enable stop; + IF NOT exists (dateiname) THEN + CONCR (datei) := new (dateiname); + initialisiere eudat (CONCR (datei)); + type (old (dateiname), eudat typ) + ELIF type (old (dateiname)) = eudat typ THEN + CONCR (datei) := old (dateiname) + ELSE + errorstop (datei ist keine eudas datei) + ENDIF + +END PROC oeffne; + +PROC oeffne (EUDAT VAR datei, DATASPACE CONST ds) : + + IF type (ds) < 0 THEN + CONCR (datei) := ds; + initialisiere eudat (CONCR (datei)); + type (ds, eudat typ) + ELIF type (ds) = eudat typ THEN + CONCR (datei) := ds + ELSE + errorstop (datei ist keine eudas datei) + END IF + +END PROC oeffne; + + +(************************* Feldzugriffe **********************************) + +PROC feld lesen (EUDAT CONST datei, INT CONST feldnr, TEXT VAR inhalt) : + + feld lesen (aktueller satz, feldnr, inhalt) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld lesen; + +PROC feld aendern (EUDAT VAR datei, INT CONST feldnr, + TEXT CONST neuer inhalt) : + + IF nicht hinter letztem satz THEN + aktueller satz unsortiert (CONCR (datei)); + moeglicherweise schluessel aendern; + feld aendern (aktueller satz, feldnr, neuer inhalt) + END IF . + +nicht hinter letztem satz : + datei. satzzeiger <> 1 . + +moeglicherweise schluessel aendern : + IF feldnr = 1 THEN + disable stop; + schluessel aendern (CONCR (datei), hashindex (neuer inhalt)) + END IF . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld aendern; + +INT PROC felderzahl (EUDAT CONST datei) : + + datei. felderzahl + +END PROC felderzahl; + +PROC feld bearbeiten (EUDAT CONST datei, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + feld bearbeiten (aktueller satz, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld bearbeiten; + + +(************************* Feldinformationen *****************************) + +(* Jedes Feld der Datei hat einen Namen und eine Typinformation. Die *) +(* Anzahl der vorhandenen Felder richtet sich nach dem hoechsten ver- *) +(* gebenen Feldnamen. 'feldinfo' kann folgende Werte annehmen : *) +(* -1 : normales Textfeld *) +(* 0 : Textfeld, das nach DIN-Norm verglichen wird *) +(* 1 : Zahlfeld (alle irrelevanten Zeichen werden ignoriert) *) +(* 2 : Datum mit einer Laenge von 8 Zeichen *) +(* Das Feldinfo eines noch nicht eingerichteten Feldes fuehrt zu *) +(* einer Fehlermeldung. *) + +PROC feldnamen lesen (EUDAT CONST datei, SATZ VAR namen) : + + namen := datei. feldnamen + +END PROC feldnamen lesen; + +PROC feldnamen aendern (EUDAT VAR datei, SATZ CONST neue namen) : + + datei. feldnamen := neue namen; + INT CONST neue felder := felderzahl (neue namen); + IF neue felder > datei. felderzahl THEN + feldinfo erweitern; + datei. felderzahl := neue felder + END IF . + +feldinfo erweitern : + datei. feldinfo CAT intvec (fehlende zeilen, - 1) . + +fehlende zeilen : + neue felder - length (datei. feldinfo) DIV 2. + +END PROC feldnamen aendern; + +INT PROC feldinfo (EUDAT CONST datei, INT CONST feldnr) : + + datei. feldinfo ISUB feldnr + +END PROC feldinfo; + +PROC feldinfo (EUDAT VAR datei, INT CONST feldnr, zeilen) : + + replace (datei. feldinfo, feldnr, zeilen); + IF pos (datei. sortierfelder, code (feldnr)) > 0 THEN + datei. anz unsortierte := datei. anz saetze + END IF + +END PROC feldinfo; + + +(*************************** Positionsabfragen ***************************) + +INT PROC satznr (EUDAT CONST datei) : + + datei. satznr + +END PROC satznr; + +BOOL PROC dateiende (EUDAT CONST datei) : + + datei. satznr > datei. anz saetze + +END PROC dateiende; + +INT PROC saetze (EUDAT CONST datei) : + + datei. anz saetze + +END PROC saetze; + + +(***************************** Positionieren *****************************) + +(* Positioniert werden kann nach der Satznummer oder nach dem ersten *) +(* Feld. Das erste Feld kann durch eine Hashtabelle schnell gefunden *) +(* werden. In der Hashtabelle sind die Saetze nach absoluten Positionen *) +(* eingetragen und nicht nach Satznummern. Ueber den Rueckverweis auf *) +(* den Indexblock kann die Satznummer zu einem gegebenen Satz gefunden *) +(* werden. *) + +PROC neue satzposition (DATEI VAR datei, INT CONST indexzeiger, stelle, + satznr) : + + IF indexzeiger < 1 OR indexzeiger > datei. indexblocks COR + stelle < 1 OR stelle > datei. index (indexzeiger). eintraege THEN + errorstop (inkonsistente datei) + END IF; + disable stop; + datei. indexzeiger := indexzeiger; + datei. indexstelle := stelle; + datei. satznr := satznr; + datei. satzzeiger := datei. index (indexzeiger). satzindex ISUB stelle + +END PROC neue satzposition; + +PROC auf satz (EUDAT VAR datei, INT CONST nr) : + + INT VAR satznr; + IF nr < 1 THEN + satznr := 1 + ELIF nr > datei. anz saetze THEN + satznr := datei. anz saetze + 1 + ELSE + satznr := nr + END IF; + auf satz intern (CONCR (datei), satznr) + +END PROC auf satz; + +PROC auf satz (EUDAT VAR datei, TEXT CONST muster) : + + auf satz (datei, 1); + IF nicht auf erstem satz THEN + weiter (datei, muster) + END IF . + +nicht auf erstem satz : + feld lesen (datei, 1, feldpuffer); + feldpuffer <> muster . + +END PROC auf satz; + +PROC auf satz intern (DATEI VAR datei, INT CONST satznr) : + + IF von anfang naeher THEN + neue satzposition (datei, 1, 1, 1) + END IF; + INT VAR + indexzeiger := datei. indexzeiger, + erreichter satz := datei. satznr - datei. indexstelle; + IF satznr > datei. satznr THEN + vorwaerts gehen + ELSE + rueckwaerts gehen + END IF; + neue satzposition (datei, indexzeiger, stelle, satznr) . + +von anfang naeher : + satznr + satznr < datei. satznr . + +vorwaerts gehen : + WHILE noch vor satz REP + erreichter satz INCR eintraege; + indexzeiger := datei. index (indexzeiger). nachfolger + END REP . + +noch vor satz : + INT CONST eintraege := datei. index (indexzeiger). eintraege; + erreichter satz + eintraege < satznr . + +rueckwaerts gehen : + WHILE noch hinter satz REP + indexzeiger := datei. index (indexzeiger). vorgaenger; + erreichter satz DECR datei. index (indexzeiger). eintraege + END REP . + +noch hinter satz : + erreichter satz >= satznr . + +stelle : + satznr - erreichter satz . + +END PROC auf satz intern; + +PROC weiter (EUDAT VAR datei) : + + weiter intern (CONCR (datei)) + +END PROC weiter; + +PROC weiter intern (DATEI VAR datei) : + + IF nicht dateiende THEN + naechster satz + END IF . + +nicht dateiende : + datei. satzzeiger <> 1 . + +naechster satz : + INT VAR + indexzeiger := datei. indexzeiger, + stelle := datei. indexstelle; + + IF stelle = index. eintraege THEN + indexzeiger := index. nachfolger; + stelle := 1 + ELSE + stelle INCR 1 + END IF; + neue satzposition (datei, indexzeiger, stelle, datei. satznr + 1) . + +index : + datei. index (indexzeiger) . + +END PROC weiter intern; + +PROC zurueck (EUDAT VAR datei) : + + zurueck intern (CONCR (datei)) + +END PROC zurueck; + +PROC zurueck intern (DATEI VAR datei) : + + IF nicht am anfang THEN + voriger satz + END IF . + +nicht am anfang : + datei. satznr <> 1 . + +voriger satz : + INT VAR + indexzeiger := datei. indexzeiger, + stelle := datei. indexstelle; + + IF stelle = 1 THEN + indexzeiger := indexblock. vorgaenger; + stelle := indexblock. eintraege + ELSE + stelle DECR 1 + END IF; + neue satzposition (datei, indexzeiger, stelle, datei. satznr - 1) . + +indexblock : + datei. index (indexzeiger) . + +END PROC zurueck intern; + +PROC weiter (EUDAT VAR datei, TEXT CONST muster) : + + weiter intern (CONCR (datei), muster) + +END PROC weiter; + +PROC weiter intern (DATEI VAR datei, TEXT CONST muster) : + + stelle in hashkette bestimmen; + WHILE noch weitere saetze CAND muster nicht gefunden REP + eine stelle weiter + END REP; + IF noch weitere saetze THEN + positioniere intern (datei, stelle) + ELSE + auf satz intern (datei, datei. anz saetze + 1) + END IF . + +stelle in hashkette bestimmen : + INT VAR dummy, stelle := datei. satzzeiger; + IF muster nicht gefunden THEN + stelle in hashkette (datei, hashindex (muster), stelle, dummy) + ELSE + eine stelle weiter + END IF . + +noch weitere saetze : + stelle <> 0 . + +muster nicht gefunden : + feld lesen (aktueller satz, 1, feldpuffer); + feldpuffer <> muster . + +aktueller satz : + datei. ablage (stelle). satz . + +eine stelle weiter : + stelle := datei. ablage (stelle). nachfolger . + +END PROC weiter intern; + +PROC zurueck (EUDAT VAR datei, TEXT CONST muster) : + + zurueck intern (CONCR (datei), muster) + +END PROC zurueck; + +PROC zurueck intern (DATEI VAR datei, TEXT CONST muster) : + + stelle in hashkette bestimmen; + WHILE noch weitere saetze CAND muster nicht gefunden REP + eine stelle zurueck + END REP; + IF noch weitere saetze THEN + positioniere intern (datei, stelle) + ELSE + auf satz intern (datei, 1) + END IF . + +stelle in hashkette bestimmen : + INT VAR stelle := datei. satzzeiger, dummy; + IF stelle = 1 OR schluessel stimmt nicht ueberein THEN + stelle in hashkette (datei, hashindex (muster), dummy, stelle) + END IF . + +noch weitere saetze : + stelle <> 0 . + +muster nicht gefunden : + stelle = datei. satzzeiger OR schluessel stimmt nicht ueberein . + +schluessel stimmt nicht ueberein : + feld lesen (aktueller satz, 1, feldpuffer); + feldpuffer <> muster . + +aktueller satz : + datei. ablage (stelle). satz . + +eine stelle zurueck : + stelle := datei. ablage (stelle). vorgaenger . + +END PROC zurueck intern; + +PROC positioniere intern (DATEI VAR datei, INT CONST stelle) : + + INT CONST zielblock := datei. ablage (stelle). indexblock; + INT VAR + indexstelle := 1, + satznr := 0; + WHILE indexstelle <> zielblock REP + satznr INCR datei. index (indexstelle). eintraege; + indexstelle := datei. index (indexstelle). nachfolger + END REP; + indexstelle := pos (datei. index (zielblock). satzindex, stelle); + satznr INCR indexstelle; + neue satzposition (datei, zielblock, indexstelle, satznr) . + +END PROC positioniere intern; + + +(************************* Hashverwaltung ********************************) + +INT VAR index; + +PROC hashindex berechnen (TEXT CONST feld, INT CONST von, bis) : + + INT VAR + zeiger := von; + index := 0; + IF bis - von < 4 THEN + mit faktor 4 streuen + ELSE + mit faktor 2 streuen + END IF; + index := index MOD maxhash + 1 . + +mit faktor 4 streuen : + WHILE zeiger <= bis REP + index := index * 4; + index INCR code (feld SUB zeiger); + zeiger INCR 1 + END REP . + +mit faktor 2 streuen : + WHILE zeiger <= bis REP + index INCR index; + index INCR code (feld SUB zeiger); + IF index > 16000 THEN index := index MOD maxhash END IF; + zeiger INCR 1 + END REP . + +END PROC hashindex berechnen; + +INT PROC hashindex (TEXT CONST feld) : + + hashindex berechnen (feld, 1, length (feld)); + index + +END PROC hashindex; + +INT PROC hashindex (SATZ CONST satz) : + + feld bearbeiten (satz, 1, + PROC (TEXT CONST, INT CONST, INT CONST) hashindex berechnen); + index + +END PROC hashindex; + +PROC stelle in hashkette (DATEI CONST datei, INT CONST hashindex, + INT VAR stelle, vorher) : + + INT VAR indexzeiger := datei. letzter index; + vorher := datei. hashliste (hashindex); + stelle := 0; + BOOL VAR hinter aktuellem satz := TRUE; + WHILE hinter aktuellem satz AND vorher <> 0 REP + stelle untersuchen; + eine stelle weiter + END REP . + +stelle untersuchen : + IF verweis auf aktuellen block THEN + ueberpruefe innerhalb block + ELSE + teste ob aktueller block in indexkette + END IF . + +verweis auf aktuellen block : + datei. ablage (vorher). indexblock = datei. indexzeiger . + +ueberpruefe innerhalb block : + indexzeiger := datei. indexzeiger; + INT CONST stelle in block := pos (satzindex, vorher); + IF stelle in block = 0 THEN + errorstop (inkonsistente datei) + ELIF stelle in block <= aktuelle stelle THEN + hinter aktuellem satz := FALSE + END IF . + +satzindex : + datei. index (indexzeiger). satzindex . + +aktuelle stelle : + datei. indexstelle . + +teste ob aktueller block in indexkette : + WHILE indexzeiger <> datei. ablage (vorher). indexblock REP + IF indexzeiger = datei. indexzeiger THEN + hinter aktuellem satz := FALSE; + LEAVE stelle untersuchen + ELSE + indexzeiger := datei. index (indexzeiger). vorgaenger + END IF + END REP . + +eine stelle weiter : + IF hinter aktuellem satz THEN + stelle := vorher; + vorher := datei. ablage (stelle). vorgaenger + END IF . + +END PROC stelle in hashkette; + +PROC hash ausketten (DATEI VAR datei, INT CONST hashindex) : + + disable stop; + INT CONST + stelle := datei. satzzeiger, + vorgaenger := datei. ablage (stelle). vorgaenger, + nachfolger := datei. ablage (stelle). nachfolger; + + IF nachfolger <> 0 THEN + datei. ablage (nachfolger). vorgaenger := vorgaenger + ELSE + datei. hashliste (hashindex) := vorgaenger + END IF; + IF vorgaenger <> 0 THEN + datei. ablage (vorgaenger). nachfolger := nachfolger + END IF . + +END PROC hash ausketten; + +PROC hash einketten (DATEI VAR datei, INT CONST hashindex, + nachfolger, vorgaenger) : + + disable stop; + INT CONST stelle := datei. satzzeiger; + datei. ablage (stelle). vorgaenger := vorgaenger; + datei. ablage (stelle). nachfolger := nachfolger; + IF vorgaenger <> 0 THEN + datei. ablage (vorgaenger). nachfolger := stelle + END IF; + IF nachfolger <> 0 THEN + datei. ablage (nachfolger). vorgaenger := stelle + ELSE + datei. hashliste (hashindex) := stelle + END IF + +END PROC hash einketten; + + +(************************** Satzzugriffe *********************************) + +PROC satz lesen (EUDAT CONST datei, SATZ VAR satz) : + + satz := datei. ablage (datei. satzzeiger). satz + +END PROC satz lesen; + +PROC satz aendern (EUDAT VAR datei, SATZ CONST neuer satz) : + + IF NOT dateiende (datei) THEN + satz wirklich aendern + END IF . + +satz wirklich aendern : + aktueller satz unsortiert (CONCR (datei)); + disable stop; + schluessel aendern (CONCR (datei), hashindex (neuer satz)); + aktueller satz := neuer satz . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC satz aendern; + +PROC schluessel aendern (DATEI VAR datei, INT CONST neuer hashindex) : + + IF anderer hashindex THEN + in neue hashkette + END IF . + +anderer hashindex : + INT CONST alter hashindex := hashindex (aktueller satz); + alter hashindex <> neuer hashindex . + +in neue hashkette : + in alter kette ausketten; + in neuer kette einketten . + +in alter kette ausketten : + hash ausketten (datei, alter hashindex) . + +in neuer kette einketten : + INT VAR vorgaenger, nachfolger; + stelle in hashkette (datei, neuer hashindex, vorgaenger, nachfolger); + hash einketten (datei, neuer hashindex, vorgaenger, nachfolger) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC schluessel aendern; + +PROC satz loeschen (EUDAT VAR datei) : + + IF NOT dateiende (datei) THEN + satz wirklich loeschen + END IF . + +satz wirklich loeschen : + disable stop; + satzeintrag loeschen (CONCR (datei)); + indexeintrag loeschen (CONCR (datei)); + datei. anz saetze DECR 1 . + +END PROC satz loeschen; + +PROC satzeintrag loeschen (DATEI VAR datei) : + + aktueller satz sortiert (datei); + INT CONST stelle := datei. satzzeiger; + hash ausketten (datei, hashindex (aktueller satz)); + datei. ablage (stelle). nachfolger := datei. erster leersatz; + datei. erster leersatz := stelle . + +aktueller satz : + datei. ablage (stelle). satz . + +END PROC satzeintrag loeschen; + +PROC satz einfuegen (EUDAT VAR datei, SATZ CONST neuer satz) : + + satz einfuegen intern (CONCR (datei), neuer satz) + +END PROC satz einfuegen; + +PROC satz einfuegen intern (DATEI VAR datei, SATZ CONST neuer satz) : + + INT VAR + stelle, + vorgaenger, + nachfolger; + + enable stop; + satzeintrag belegen; + ggf schluessel einfuegen; + disable stop; + datei. anz saetze INCR 1; + indexeintrag einfuegen (datei, stelle); + INT CONST neuer index := hashindex (feldpuffer); + stelle in hashkette (datei, neuer index, nachfolger, vorgaenger); + hash einketten (datei, neuer index, nachfolger, vorgaenger); + aktueller satz unsortiert (datei) . + +satzeintrag belegen : + IF datei. erster leersatz <> 0 THEN + stelle := datei. erster leersatz; + datei. erster leersatz := datei. ablage (stelle). nachfolger + ELIF datei. anz satzeintraege = maxsatz THEN + errorstop (eudas datei voll) + ELSE + datei. anz satzeintraege INCR 1; + stelle := datei. anz satzeintraege + END IF; + datei. ablage (stelle). attribut := 0; + datei. ablage (stelle). satz := neuer satz . + +ggf schluessel einfuegen : + feld lesen (neuer satz, 1, feldpuffer); + IF datei. schluesselzaehler > 0 THEN + IF feldpuffer = "" THEN + neuen schluessel erzeugen; + feld aendern (datei. ablage (stelle). satz, 1, feldpuffer) + END IF + END IF . + +neuen schluessel erzeugen : + feldpuffer := text (datei. schluesselzaehler); + feldpuffer := fuehrende nullen + feldpuffer; + IF datei. schluesselzaehler > 32000 THEN + datei. schluesselzaehler := 1 + ELSE + datei. schluesselzaehler INCR 1 + END IF . + +fuehrende nullen : + (4 - length (feldpuffer)) * "0" . + +END PROC satz einfuegen intern; + +PROC automatischer schluessel (EUDAT VAR eudat, BOOL CONST automatisch) : + + IF automatisch AND eudat. schluesselzaehler < 0 OR + NOT automatisch AND eudat. schluesselzaehler > 0 THEN + eudat. schluesselzaehler := - eudat. schluesselzaehler + END IF + +END PROC automatischer schluessel; + +BOOL PROC automatischer schluessel (EUDAT CONST eudat) : + + eudat. schluesselzaehler > 0 + +END PROC automatischer schluessel; + + +(************************* Indexverwaltung *******************************) + +(* Die logische Reihenfolge der Saetze wird durch einen Index herge- *) +(* stellt. Dieser besteht aus einer Liste von INTVECs. Ein Listenelement *) +(* nimmt Satzeintraege auf, bis die Maximalgroesse erreicht ist. In *) +(* diesem Fall wird ein neues Listenelement eingefuegt. Beim Loeschen *) +(* von Eintraegen wird ueberprueft, ob zwei benachbarte Eintraege kom- *) +(* biniert werden koennen. Steht fuer eine Anforderung kein Eintrag mehr *) +(* zur Verfuegung, wird der ganze Index reorganisiert. Es ist garantiert,*) +(* dass der Index die maximale Anzahl von Satzeintraegen aufnehmen kann. *) + +INTVEC VAR indexpuffer; + + +PROC indexeintrag loeschen (DATEI VAR datei) : + + INT CONST + indexzeiger := datei. indexzeiger, + vorgaenger := index. vorgaenger, + nachfolger := index. nachfolger; + BOOL VAR moeglich; + delete (index. satzindex, datei. indexstelle); + index. eintraege DECR 1; + indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich); + IF NOT moeglich THEN + indizes zusammenlegen (datei, vorgaenger, indexzeiger, moeglich) + END IF; + indexzeiger justieren (datei) . + +index : + datei. index (indexzeiger) . + +END PROC indexeintrag loeschen; + +PROC indizes zusammenlegen (DATEI VAR datei, INT CONST zeiger, folgezeiger, + BOOL VAR moeglich) : + + moeglich := FALSE; + IF zeiger <> 0 AND folgezeiger <> 0 THEN + versuche zusammenzulegen + END IF . + +versuche zusammenzulegen : + INT CONST + eintraege a := index. eintraege, + eintraege b := folgeindex. eintraege; + IF zusammenlegbar THEN + wirklich zusammenlegen; + moeglich := TRUE + END IF . + +zusammenlegbar: + eintraege a + eintraege b <= dreiviertel maxeintrag OR + eintraege a = 0 OR eintraege b = 0 . + +wirklich zusammenlegen : + index. eintraege INCR folgeindex. eintraege; + indexverweise aendern (datei, folgeindex. satzindex, zeiger); + index. satzindex CAT folgeindex. satzindex; + folgeindex ausketten . + +folgeindex ausketten : + index. nachfolger := folgeindex. nachfolger; + IF index. nachfolger <> 0 THEN + datei. index (index. nachfolger). vorgaenger := zeiger + ELSE + datei. letzter index := zeiger + END IF; + folgeindex. nachfolger := datei. erster leerindex; + datei. erster leerindex := folgezeiger . + +index : + datei. index (zeiger) . + +folgeindex : + datei. index (folgezeiger) . + +END PROC indizes zusammenlegen; + +PROC indexzeiger justieren (DATEI VAR datei) : + + INT CONST aktueller satz := datei. satznr; + neue satzposition (datei, 1, 1, 1); + auf satz intern (datei, aktueller satz) + +END PROC indexzeiger justieren; + +PROC indexverweise aendern (DATEI VAR datei, INTVEC CONST satzindex, + INT CONST zeiger) : + + INT VAR i; + FOR i FROM 1 UPTO length (satzindex) DIV 2 REP + datei. ablage (satzindex ISUB i). indexblock := zeiger + END REP + +END PROC indexverweise aendern; + +PROC indexeintrag einfuegen (DATEI VAR datei, INT CONST eintrag) : + + INT VAR indexzeiger := datei. indexzeiger; + IF index. eintraege >= maxeintrag THEN + platz schaffen + END IF; + index. eintraege INCR 1; + insert (index. satzindex, datei. indexstelle, eintrag); + datei. satzzeiger := eintrag; + datei. ablage (eintrag). indexblock := indexzeiger . + +platz schaffen : + INT VAR neuer index := 0; + neuen indexblock besorgen; + IF neuer index <> 0 THEN + index aufsplitten + ELSE + index reorganisieren (datei) + END IF; + indexzeiger justieren (datei); + indexzeiger := datei. indexzeiger . + +neuen indexblock besorgen : + IF datei. erster leerindex <> 0 THEN + neuer index := datei. erster leerindex; + datei. erster leerindex := folgeindex. nachfolger + ELIF datei. indexblocks < maxindex THEN + datei. indexblocks INCR 1; + neuer index := datei. indexblocks; + folgeindex. satzindex := blockreservierung + END IF . + +index aufsplitten : + neuen block einketten; + splitpunkt bestimmen; + folgeindex. eintraege := index. eintraege - halbe eintraege; + split up (index. satzindex, folgeindex. satzindex, halbe eintraege + 1); + index. eintraege := halbe eintraege; + indexverweise aendern (datei, folgeindex. satzindex, neuer index) . + +neuen block einketten : + INT CONST alter nachfolger := index. nachfolger; + IF alter nachfolger <> 0 THEN + datei. index (alter nachfolger). vorgaenger := neuer index + ELSE + datei. letzter index := neuer index + END IF; + folgeindex. nachfolger := alter nachfolger; + folgeindex. vorgaenger := indexzeiger; + index. nachfolger := neuer index . + +splitpunkt bestimmen : + INT VAR halbe eintraege; + IF letzter block THEN + halbe eintraege := dreiviertel maxeintrag + ELSE + halbe eintraege := index. eintraege DIV 2 + 1 + END IF . + +letzter block : + alter nachfolger = 0 . + +index : + datei. index (indexzeiger) . + +folgeindex : + datei. index (neuer index) . + +END PROC indexeintrag einfuegen; + +PROC index reorganisieren (DATEI VAR datei) : + + INT VAR indexzeiger := 1; + REP + index auffuellen; + zum naechsten index + END REP . + +index auffuellen : + BOOL VAR moeglich; + REP + INT CONST nachfolger := index. nachfolger; + indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich) + UNTIL NOT moeglich END REP; + IF nachfolger = 0 THEN + LEAVE index reorganisieren + ELIF noch platz THEN + rest auffuellen + END IF . + +noch platz : + INT CONST platz := dreiviertel maxeintrag - index. eintraege; + platz > 0 . + +rest auffuellen : + split down (folgeindex. satzindex, indexpuffer, platz + 1); + folgeindex. eintraege DECR platz; + indexverweise aendern (datei, indexpuffer, indexzeiger); + index. satzindex CAT indexpuffer; + index. eintraege := dreiviertel maxeintrag . + +zum naechsten index : + indexzeiger := nachfolger . + +index : + datei. index (indexzeiger) . + +folgeindex : + datei. index (nachfolger) . + +END PROC index reorganisieren; + + +(************************* Sortierabfragen *******************************) + +TEXT VAR dez komma := ","; + +LET + sortmask = 1; + +TEXT PROC dezimalkomma : + + dez komma + +END PROC dezimalkomma; + +PROC dezimalkomma (TEXT CONST neues komma) : + + IF length (neues komma) <> 1 THEN + errorstop (nicht erlaubtes dezimalkomma) + ELSE + dez komma := neues komma + ENDIF + +END PROC dezimalkomma; + +INT PROC unsortierte saetze (EUDAT CONST datei) : + + datei. anz unsortierte + +END PROC unsortierte saetze; + +TEXT PROC sortierreihenfolge (EUDAT CONST datei) : + + datei. sortierfelder + +END PROC sortierreihenfolge; + +PROC aktueller satz unsortiert (DATEI VAR datei) : + + IF sortiert (datei) THEN + disable stop; + datei. ablage (datei. satzzeiger). attribut INCR sortmask; + datei. anz unsortierte INCR 1 + END IF + +END PROC aktueller satz unsortiert; + +PROC aktueller satz sortiert (DATEI VAR datei) : + + IF NOT sortiert (datei) THEN + disable stop; + datei. ablage (datei. satzzeiger). attribut DECR sortmask; + datei. anz unsortierte DECR 1 + END IF + +END PROC aktueller satz sortiert; + +BOOL PROC sortiert (DATEI CONST datei, INT CONST stelle) : + + (datei. ablage (stelle). attribut AND sortmask) = 0 + +END PROC sortiert; + +BOOL PROC sortiert (DATEI CONST datei) : + + sortiert (datei, datei. satzzeiger) + +END PROC sortiert; + + +(************************* Sortieren *************************************) + +(* Eine Datei kann in einer beliebigen Feldreihenfolge sortiert werden. *) +(* Dabei wird das Feldinfo beachtet. Wurden seit der letzten Sortierung *) +(* nur wenige Saetze geaendert (deren Plaetze in 'unsortierte' gespei- *) +(* chert sind), werden nur diese Saetze einsortiert. *) + +INTVEC VAR sortierinfo; + +TEXT VAR sortierfelder; + +TEXT VAR l, r; + + +PROC sortiere (EUDAT VAR datei) : + + sortierfelder := datei. sortierfelder; + IF sortierfelder = niltext THEN + standardbelegung + END IF; + sortiere intern (CONCR (datei)) . + +standardbelegung : + INT VAR i; + FOR i FROM 1 UPTO datei. felderzahl REP + sortierfelder CAT code (i) + END REP . + +END PROC sortiere; + +PROC sortiere (EUDAT VAR datei, TEXT CONST felder) : + + sortierfelder := felder; + sortiere intern (CONCR (datei)) + +END PROC sortiere; + +PROC sortiere intern (DATEI VAR datei) : + + IF datei. sortierfelder <> sortierfelder THEN + datei. sortierfelder := sortierfelder; + datei. anz unsortierte := datei. anz saetze + 1 + ELIF datei. anz unsortierte = 0 THEN + LEAVE sortiere intern + END IF; + sortierinfo := datei. feldinfo; + IF mehr als ein drittel THEN + komplett sortieren (datei); + datei. anz unsortierte := 0 + ELSE + einzeln sortieren (datei) + END IF; + auf satz intern (datei, 1) . + +mehr als ein drittel : + datei. anz saetze DIV datei. anz unsortierte < 3 . + +END PROC sortiere intern; + +PROC komplett sortieren (DATEI VAR datei) : + + INT VAR + satzzeiger, + satz := 1, + satz vorher; + + auf satz intern (datei, 1); + aktueller satz sortiert (datei); + satzzeiger := datei. satzzeiger; + WHILE noch satz vorhanden REP + zum naechsten satz; + satz richtig einsortieren; + cout (satz) + END REP; + disable stop; + index reorganisieren (datei); + neue satzposition (datei, 1, 1, 1) . + +noch satz vorhanden : + satz < datei. anz saetze . + +zum naechsten satz : + satz INCR 1; + auf satz intern (datei, satz); + satz vorher := satzzeiger; + satzzeiger := datei. satzzeiger . + +satz richtig einsortieren : + IF satz kleiner als vorgaenger THEN + satz einsortieren (datei, satz, satzzeiger); + satzzeiger := satz vorher + ELSE + aktueller satz sortiert (datei) + END IF . + +satz kleiner als vorgaenger : + datei. ablage (satz vorher). satz GROESSER + datei. ablage (satzzeiger). satz . + +END PROC komplett sortieren; + +PROC einzeln sortieren (DATEI VAR datei) : + + INT VAR i; + FOR i FROM 1 UPTO datei. anz satzeintraege REP + IF NOT sortiert (datei, i) THEN + satz einsortieren (datei, datei. anz saetze + 1, i); + cout (i) + END IF + END REP + +END PROC einzeln sortieren; + +PROC satz einsortieren (DATEI VAR datei, INT CONST satznr, satzzeiger) : + + stelle suchen; + an dieser stelle einfuegen . + +stelle suchen : + INT VAR + anfang := 1, + ende := satznr - 1, + mitte; + WHILE stelle nicht gefunden REP + intervall in der mitte halbieren; + teilintervall auswaehlen + END REP . + +stelle nicht gefunden : + anfang <= ende . + +intervall in der mitte halbieren : + mitte := (anfang + ende) DIV 2; + INT VAR vergleichssatz; + auf satz intern (datei, mitte); + IF NOT sortiert (datei) THEN + passenden vergleichssatz suchen + END IF; + vergleichssatz := datei. satzzeiger . + +passenden vergleichssatz suchen : + WHILE datei. satznr < ende REP + weiter intern (datei); + IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF + END REP; + WHILE datei. satznr > anfang REP + zurueck intern (datei); + IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF + END REP; + LEAVE stelle suchen . + +satz richtig : + sortiert (datei) . + +teilintervall auswaehlen : + IF zu vergleichender satz GROESSER datei. ablage (satzzeiger). satz THEN + ende := mitte - 1 + ELSE + anfang := mitte + 1 + END IF . + +zu vergleichender satz : + datei. ablage (vergleichssatz). satz . + +an dieser stelle einfuegen : + positioniere intern (datei, satzzeiger); + IF datei. satznr < anfang THEN anfang DECR 1 END IF; + disable stop; + aktueller satz sortiert (datei); + in hashkette ausketten; + indexeintrag loeschen (datei); + auf satz intern (datei, anfang); + indexeintrag einfuegen (datei, satzzeiger); + in hashkette einketten . + +in hashkette ausketten : + INT CONST h index := hashindex (aktueller satz); + hash ausketten (datei, h index) . + +in hashkette einketten : + INT VAR vorgaenger, nachfolger; + stelle in hashkette (datei, h index, vorgaenger, nachfolger); + hash einketten (datei, h index, vorgaenger, nachfolger) . + +aktueller satz : + datei. ablage (satzzeiger). satz . + +END PROC satz einsortieren; + +BOOL OP GROESSER (SATZ CONST links, rechts) : + + ungleiches feld suchen; + sortierrichtung feststellen; + SELECT sortierinfo ISUB vergleichsfeld OF + CASE 0 : din vergleich + CASE 1 : zahl vergleich + CASE 2 : datum vergleich + OTHERWISE text vergleich + END SELECT . + +ungleiches feld suchen : + INT VAR nr zeiger := 1; + WHILE nr zeiger < length (sortierfelder) REP + INT CONST vergleichsfeld := code (sortierfelder SUB nr zeiger); + feld lesen (links, vergleichsfeld, l); + feld lesen (rechts, vergleichsfeld, r); + SELECT sortierinfo ISUB vergleichsfeld OF + CASE 0 : din gleich + CASE 1 : zahl gleich + OTHERWISE text gleich + END SELECT; + nr zeiger INCR 2 + END REP; + LEAVE GROESSER WITH FALSE . + +sortierrichtung feststellen : + BOOL VAR aufsteigend; + IF (sortierfelder SUB (nr zeiger + 1)) = "-" THEN + aufsteigend := FALSE + ELSE + aufsteigend := TRUE + END IF . + +zahl gleich : + REAL VAR l wert, r wert; + wert berechnen (l, l wert); + wert berechnen (r, r wert); + IF l wert <> r wert THEN + LEAVE ungleiches feld suchen + END IF . + +din gleich : + IF NOT (l LEXEQUAL r) THEN + LEAVE ungleiches feld suchen + END IF . + +text gleich : + IF l <> r THEN + LEAVE ungleiches feld suchen + END IF . + +zahl vergleich : + IF aufsteigend THEN + l wert > r wert + ELSE + l wert < r wert + END IF . + +din vergleich : + IF aufsteigend THEN + l LEXGREATER r + ELSE + r LEXGREATER l + END IF . + +datum vergleich : + datum umdrehen (l); + datum umdrehen (r); + IF aufsteigend THEN + l > r + ELSE + l < r + END IF . + +textvergleich : + IF aufsteigend THEN + l > r + ELSE + l < r + END IF . + +END OP GROESSER; + +PROC wert berechnen (TEXT CONST zahl, REAL VAR wert) : + + LET ziffern = "0123456789"; + TEXT VAR komma := dez komma, text; + INT VAR stelle; + INT CONST laenge := length (zahl); + anfang bestimmen; + WHILE stelle <= laenge REP + zeichen untersuchen; + stelle INCR 1 + END REP; + wert := real (text) . + +anfang bestimmen : + stelle := pos (zahl, "0", "9", 1); + IF stelle = 0 THEN + wert := 0.0; LEAVE wert berechnen + ELIF pos (zahl, "-", 1, stelle) > 0 THEN + text := "-" + ELSE + text := niltext + END IF; . + +zeichen untersuchen: + TEXT CONST char := zahl SUB stelle; + IF pos (ziffern, char) > 0 THEN + text CAT char + ELIF char = komma THEN + text CAT "."; komma := niltext + END IF . + +END PROC wert berechnen; + +PROC datum umdrehen (TEXT VAR datum) : + + IF length (datum) <> 8 THEN + datum := niltext + ELSE + datum := subtext (datum, 7) + subtext (datum, 4, 5) + + subtext (datum, 1, 2) + END IF + +END PROC datum umdrehen; + + +(**************************** Reorganisieren *****************************) + +PROC reorganisiere (TEXT CONST dateiname) : + + EUDAT VAR datei 1, datei 2; + oeffne (datei 1, dateiname); + disable stop; + DATASPACE VAR ds := nilspace; + oeffne (datei 2, ds); + kopiere eudat (CONCR (datei 1), datei 2); + IF NOT is error THEN + forget (dateiname, quiet); + copy (ds, dateiname) + END IF; + forget (ds) + +END PROC reorganisiere; + +PROC kopiere eudat (DATEI VAR datei 1, EUDAT VAR datei 2) : + + enable stop; + kopiere saetze; + kopiere interna (datei 1, CONCR (datei 2)) . + +kopiere saetze : + auf satz intern (datei 1, 1); + auf satz (datei 2, 1); + WHILE NOT dateiende REP + satz einfuegen (datei 2, kopiersatz); + cout (datei 1. satznr); + weiter intern (datei 1); + weiter (datei 2) + END REP . + +dateiende : + datei 1. satznr > datei 1. anz saetze . + +kopiersatz : + datei 1. ablage (datei 1. satzzeiger). satz . + +END PROC kopiere eudat; + +PROC kopiere interna (DATEI VAR datei 1, datei 2) : + + datei 2. felderzahl := datei 1. felderzahl; + datei 2. feldnamen := datei 1. feldnamen; + datei 2. feldinfo := datei 1. feldinfo; + datei 2. sortierfelder := datei 1. sortierfelder; + datei 2. notizen (1) := datei 1. notizen (1); + datei 2. notizen (2) := datei 1. notizen (2); + datei 2. notizen (3) := datei 1. notizen (3) + +END PROC kopiere interna; + + +(************************* Notizen ***************************************) + +PROC notizen lesen (EUDAT CONST datei, INT CONST nr, TEXT VAR notiztext) : + + notiztext := datei. notizen (nr) + +END PROC notizen lesen; + +PROC notizen aendern (EUDAT VAR datei, INT CONST nr, TEXT CONST notiztext) : + + datei. notizen (nr) := notiztext + +END PROC notizen aendern; + +END PACKET eudas dateien; + diff --git a/app/eudas/5.3/src/eudas.dialoghilfen.04 b/app/eudas/5.3/src/eudas.dialoghilfen.04 new file mode 100644 index 0000000..b204978 --- /dev/null +++ b/app/eudas/5.3/src/eudas.dialoghilfen.04 @@ -0,0 +1,435 @@ +PACKET eudas dialoghilfen + +(*************************************************************************) +(* *) +(* Dialoghilfen für EUDAS *) +(* *) +(* Version 04 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 15.10.88 *) +(* *) +(*************************************************************************) + + DEFINES + + fenstergroessen bestimmen, + fenster links, + fenster rechts, + fenster ganz, + + ausfuehrung, + auf archiv, + bitte warten, + frage ob einrichten, + set command dialogue false, + reset command dialogue, + edit : + + +(**************************** Fenster *************************************) + +LET + breite links = 16; + +INT VAR + last x size := 0, + last y size; + +FENSTER VAR + ganz, + links, + rechts, + fuss; + +fenster initialisieren (fuss); +fenster initialisieren (ganz); +fenster initialisieren (links); +fenster initialisieren (rechts); + + +PROC fenstergroessen bestimmen : + + IF x size <> last x size OR y size <> last y size THEN + neue fenstergroessen; + last x size := x size; + last y size := y size + END IF . + +neue fenstergroessen : + fenstergroesse setzen (ganz, 1, 2, x size - 1, y size - 1); + fenstergroesse setzen (links, 1, 2, breite links, y size - 2); + fenstergroesse setzen (rechts, + breite links + 1, 2, x size - breite links - 1, y size - 2); + fenstergroesse setzen (fuss, 1, y size, x size - 1, 1); + dialogfenster (rechts); + anzeigefenster (rechts); + uebersichtsfenster (ganz) . + +END PROC fenstergroessen bestimmen; + +FENSTER PROC fenster rechts : rechts END PROC fenster rechts; + +FENSTER PROC fenster links : links END PROC fenster links; + +FENSTER PROC fenster ganz : ganz END PROC fenster ganz; + + +(******************** Parameter-Auswahl ***********************************) + +LET + keine datei zur auswahl = #1001# + "Keine Datei zur Auswahl vorhanden.", + name der datei = #1002# + "Name der Datei: "; + +SATZ VAR sammel; + +THESAURUS VAR + zusaetzliche namen; + +TEXT VAR + feldpuffer, + dateiname, + offene; + +LET + niltext = "", + esc z = ""27"z", + cleol = ""5""; + +LET + fetch code = 11, + ack = 0; + +DATASPACE VAR ds; + +INITFLAG VAR init ds; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg; + +PROC ausfuehrung (TEXT CONST prompt, BOOL CONST nur eine, INT CONST typ, + PROC (TEXT CONST) operation) : + + ausfuehrung (prompt, nur eine, typ, niltask, + PROC (TEXT CONST) operation) + +END PROC ausfuehrung; + +PROC ausfuehrung (TEXT CONST prompt, BOOL CONST nur eine, INT CONST typ, + TASK CONST zusatztask, + PROC (TEXT CONST) operation) : + + enable stop; + dateinamen anfordern; + IF dateiname = niltext THEN + errorstop (niltext) + ELIF ist esc z THEN + dateiname := subtext (dateiname, 3); + dateinamen sammeln (all, typ, zusatztask); + auswahl anbieten ("EUDAS-Dateiauswahl", rechts, max wahl, + "AUSWAHL/Datei", + PROC (TEXT VAR, INT CONST) als text); + bitte warten; + operation ausfuehren (PROC (TEXT CONST) operation) + ELSE + last param (dateiname); + operation (dateiname) + END IF . + +dateinamen anfordern : + IF exists (std) AND (typ = 0 COR type (old (std)) = typ) THEN + dateiname := std + ELSE + dateiname := niltext + END IF; + editget (prompt, dateiname, "z", "GET/Dateiname") . + +max wahl : + IF nur eine THEN 1 ELSE 1024 END IF . + +END PROC ausfuehrung; + +PROC auf archiv (PROC (TEXT CONST) operation, THESAURUS CONST archivinhalt) : + + dateiname := niltext; + editget (name der datei, dateiname, "z", "GET/Dateiname"); + IF dateiname = niltext THEN + errorstop (niltext) + ELIF ist esc z THEN + uebersicht zeigen + ELSE + last param (dateiname); + operation (dateiname) + END IF . + +uebersicht zeigen : + dateiname := subtext (dateiname, 3); + dateinamen sammeln (archivinhalt, 0, niltask); + auswahl anbieten ("EUDAS-Archivauswahl", rechts, "AUSWAHL/Archiv", + PROC (TEXT VAR, INT CONST) als text); + operation ausfuehren (PROC (TEXT CONST) operation) . + +END PROC auf archiv; + +PROC dateinamen sammeln (THESAURUS CONST t, INT CONST typ, + TASK CONST zusatztask) : + + BOOL CONST kein pattern := pos (dateiname, "*") = 0; + uebergebene namen sammeln; + offene dateien merken; + zusaetzliche namen dazu; + meldung falls keine datei . + +uebergebene namen sammeln : + INT VAR + stelle := 1, + von := 0; + satz initialisieren (sammel); + REP + get (t, feldpuffer, von); + IF feldpuffer = niltext THEN + LEAVE uebergebene namen sammeln + ELIF richtiger typ AND nach pattern THEN + feld aendern (sammel, stelle, feldpuffer); + stelle INCR 1 + END IF + END REP . + +richtiger typ : + typ = 0 COR type (old (feldpuffer)) = typ . + +nach pattern : + kein pattern COR (feldpuffer LIKE dateiname) . + +offene dateien merken : + offene := niltext; + INT VAR i; + FOR i FROM 1 UPTO anzahl dateien REP + INT CONST t link := feldindex (sammel, eudas dateiname (i)); + IF t link > 0 THEN + offene CAT code (t link) + END IF + END REP . + +zusaetzliche namen dazu : + IF NOT is niltask (zusatztask) THEN + zusaetzliche namen := ALL zusatztask; + zusaetzliche namen nach typ abfragen + END IF . + +zusaetzliche namen nach typ abfragen : + von := 0; + REP + get (zusaetzliche namen, feldpuffer, von); + IF feldpuffer = niltext THEN + LEAVE zusaetzliche namen nach typ abfragen + ELIF nach pattern CAND noch nicht enthalten CAND typ stimmt THEN + feld aendern (sammel, stelle, feldpuffer); + stelle INCR 1 + END IF + END REP . + +noch nicht enthalten : + NOT (t CONTAINS feldpuffer) . + +typ stimmt : + typ = 0 COR tasktyp (feldpuffer, zusatztask) = typ . + +meldung falls keine datei : + IF stelle = 1 THEN + dialog (keine datei zur auswahl); + errorstop (niltext) + END IF . + +END PROC dateinamen sammeln; + +INT PROC tasktyp (TEXT CONST datei, TASK CONST zieltask) : + + enable stop; + INT VAR reply, result; + IF NOT initialized (init ds) THEN ds := nilspace END IF; + forget (ds); ds := nilspace; + msg := ds; + msg. name := datei; + msg. write pass := write password; + msg. read pass := read password; + call (zieltask, fetch code, ds, reply); + IF reply <> ack THEN + result := 0 + ELSE + result := type (ds) + END IF; + forget (ds); + result + +END PROC tasktyp; + +BOOL PROC ist esc z : + + subtext (dateiname, 1, 2) = esc z + +END PROC ist esc z; + +PROC als text (TEXT VAR inhalt, INT CONST stelle) : + + IF stelle < 256 THEN + feld lesen (sammel, stelle, inhalt); + IF pos (offene, code (stelle)) > 0 THEN + inhalt := " " + textdarstellung (inhalt) + ELIF inhalt <> niltext THEN + inhalt := textdarstellung (inhalt) + END IF + ELSE + inhalt := niltext + END IF + +END PROC als text; + +PROC operation ausfuehren (PROC (TEXT CONST) operation) : + + INT VAR + stelle := 1; + REP + IF wahl (stelle) = 0 THEN + LEAVE operation ausfuehren + ELSE + feld lesen (sammel, wahl (stelle), feldpuffer); + meldung in fusszeile; + last param (feldpuffer); + operation (feldpuffer) + END IF; + stelle INCR 1 + END REP . + +meldung in fusszeile : + IF online THEN + fenster veraendert (fuss); + cursor (1, y size); out (cleol); + out (text (stelle)); out (". "); + out (textdarstellung (feldpuffer)) + END IF . + +END PROC operation ausfuehren; + + +(************************** Editor ****************************************) + +LET + edit status = #1003# +"EDITIEREN: Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ?", + show status = #1004# +"ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ?"; + +INT VAR return code; + +BOOL VAR + zeige edit status, + feldanzeige erlaubt; + + +PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe, + BOOL CONST aendern) : + + INT VAR x, y, x l, y l; + fenstergroesse (fenster, x, y, x l, y l); + fenster veraendert (fenster); + enable stop; + feldanzeige erlauben; + zeige edit status := aendern; + REP + edit status anzeigen; + open editor (groesster editor + 1, f, aendern, x, y, x l, y l); + edit (groesster editor, "eqvw19dpgn"9"?hF", PROC (TEXT CONST) kdo); + return code behandeln + END REP . + +feldanzeige erlauben : + IF aendern AND y < 3 AND y l > 22 AND x < 14 AND x l > 75 THEN + feldanzeige erlaubt := TRUE + ELSE + feldanzeige erlaubt := FALSE + END IF . + +return code behandeln : + SELECT return code OF + CASE 0 : LEAVE edit + CASE 1 : hilfe anbieten (hilfe, fenster) + CASE 2 : errorstop (niltext) + END SELECT . + +END PROC edit; + +PROC edit status anzeigen : + + IF zeige edit status THEN + status anzeigen (edit status) + ELSE + status anzeigen (show status) + END IF + +END PROC edit status anzeigen; + +PROC kdo (TEXT CONST zeichen) : + + return code := pos ("q?h", zeichen); + IF return code > 0 THEN + return code DECR 1; + quit + ELIF feldanzeige erlaubt CAND zeichen = "F" THEN + do ("feldnamen anzeigen"); + edit status anzeigen + ELSE + std kommando interpreter (zeichen); + edit status anzeigen; + bildschirm neu + END IF + +END PROC kdo; + + +(**************************** Kommandodialog *******************************) + +BOOL VAR dialogue state; + +PROC set command dialogue false : + + dialogue state := command dialogue; + command dialogue (FALSE) + +END PROC set command dialogue false; + +PROC reset command dialogue : + + command dialogue (dialogue state) + +END PROC reset command dialogue; + + +(************************** Verschiedenes ********************************) + +LET + t bitte warten = #1005# + " Bitte warten.. ", + t neu einrichten = #1006# + " neu einrichten"; + + +PROC bitte warten : + + status anzeigen (t bitte warten) + +END PROC bitte warten; + +PROC frage ob einrichten (TEXT CONST datei) : + + IF NOT ja (textdarstellung (datei) + t neu einrichten, + "JA/einrichten") THEN + errorstop (niltext) + END IF + +END PROC frage ob einrichten; + + +END PACKET eudas dialoghilfen; + diff --git a/app/eudas/5.3/src/eudas.drucken.13 b/app/eudas/5.3/src/eudas.drucken.13 new file mode 100644 index 0000000..b191dc5 --- /dev/null +++ b/app/eudas/5.3/src/eudas.drucken.13 @@ -0,0 +1,2001 @@ +PACKET eudas drucken + +(*************************************************************************) +(* *) +(* Drucken von EUDAS-Dateien nach Druckmuster *) +(* *) +(* Version 13 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 06.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + +(*dump, (* Test *) *) + + drucke, + interpretiere, + gruppentest, + + druckdatei, + direkt drucken, + druckrichtung, + max druckzeilen, + + gruppenwechsel, + lfd nr : + + +(*************************** Musterinterpreter ***************************) + +(* + EXPORTS + + INT max musterspeicher + INT VAR interpretationsmodus + interpretiere (INT CONST erste zeile, erstes muster, + PROC (INT CONST, TEXT VAR) abk) +*) + + +LET + max musterspeicher = 25, + SPEICHER = STRUCT (INT feldanfang, + feldlaenge, + setzmodus, + bearbeitet bis, + TEXT inhalt); + +ROW max musterspeicher SPEICHER VAR musterspeicher; + +INT VAR interpretationsmodus; + +LET + niltext = "", + blank = " ", + fis = "#", + zwei blanks = " "; + +TEXT VAR ausgabezeile; + + +PROC interpretiere (INT CONST erste zeile, erstes muster, + PROC (INT CONST, TEXT VAR) abkuerzungen) : + + INT VAR + kommandoindex, + anzahl leerzeilen := 0, + anzahl wiederholungen := 0, + aktuelles muster := erstes muster; + + muster auf zeile (erste zeile); + WHILE NOT druckmusterende REP + musterzeile lesen; + IF leerzeile THEN + anzahl leerzeilen INCR 1 + ELSE + letzte leerzeilen beruecksichtigen; + zeile auswerten + END IF + END REP . + +zeile auswerten : + IF kommandozeile (kommandoindex) THEN + kommando auswerten + ELSE + zeile interpretieren; + anzahl wiederholungen := 0 + END IF . + +kommando auswerten : + SELECT kommandoindex OF + CASE modus index : modus umstellen + CASE mehr index : anzahl wiederholungen setzen + OTHERWISE LEAVE interpretiere + END SELECT . + +letzte leerzeilen beruecksichtigen : + WHILE anzahl leerzeilen > 0 REP + zeile drucken (blank); + anzahl leerzeilen DECR 1 + END REP . + +modus umstellen : + int param (interpretationsmodus) . + +anzahl wiederholungen setzen : + int param (anzahl wiederholungen) . + +leerzeile : + musterzeile = niltext OR musterzeile = blank . + +zeile interpretieren : + INT VAR + zeilenzaehler := 0, + zu bearbeitende inhalte := 0; + BOOL VAR + blanks dazwischen := FALSE; + + REP + einen zeilendurchgang; + zeilenzaehler INCR 1; + IF interpretationsmodus = 3 THEN + blanks dazwischen := TRUE + END IF + UNTIL zeile fertig bearbeitet END REP . + +zeile fertig bearbeitet : + IF interpretationsmodus <= 2 THEN + TRUE + ELIF anzahl wiederholungen <> 0 THEN + zeilenzaehler = anzahl wiederholungen + ELSE + zu bearbeitende inhalte = 0 + END IF . + +einen zeilendurchgang : + INT VAR + letztes feldende := 1, + reservelaenge := 0, + benoetigte reserve := 0, + einzulesendes muster := 1, + einzusetzendes muster := 1; + + ausgabezeile := niltext; + REP + IF musterinhalt abspeichern THEN + musterinhalt besorgen + END IF; + IF festes muster THEN + zeilenabschnitt ausgeben + END IF; + einsetzdaten sammeln; + einzulesendes muster INCR 1 + END REP . + +musterinhalt abspeichern : + zeilenzaehler = 0 . + +musterinhalt besorgen : + naechstes muster (lesespeicher. feldanfang, lesespeicher. feldlaenge, + lesespeicher. setzmodus); + IF NOT zeilenende THEN + tabellenmodus beruecksichtigen; + musterinhalt lesen + END IF . + +zeilenende : + lesespeicher. feldanfang > length (musterzeile) . + +tabellenmodus beruecksichtigen : + IF linksschieben verboten AND setzmodus variabel THEN + folgende leerzeichen schlucken + END IF . + +setzmodus variabel : + (lesespeicher. setzmodus AND 1) = 0 . + +folgende leerzeichen schlucken : + INT VAR nach name := lesespeicher. feldanfang + lesespeicher. feldlaenge; + IF (musterzeile SUB nach name) = blank THEN + WHILE (musterzeile SUB nach name + 1) = blank REP + nach name INCR 1; + lesespeicher. feldlaenge INCR 1 + END REP + END IF . + +musterinhalt lesen : + INT CONST musterfunktion := musterindex (aktuelles muster); + IF musterfunktion > 0 THEN + feld lesen (musterfunktion, lesespeicher. inhalt) + ELSE + abkuerzungen (-musterfunktion, lesespeicher. inhalt) + END IF; + aktuelles muster INCR 1; + lesespeicher. bearbeitet bis := 0; + IF lesespeicher. inhalt <> niltext THEN + zu bearbeitende inhalte INCR 1 + END IF . + +festes muster : + lesespeicher. setzmodus >= 4 . + +lesespeicher : + musterspeicher (einzulesendes muster) . + +einsetzdaten sammeln : + INT CONST reserve := setzdifferenz (lesespeicher); + IF reserve > 0 THEN + reserve merken + ELSE + benoetigte reserve DECR reserve + END IF . + +reserve merken : + reservelaenge INCR reserve; + IF linksschieben verboten AND reservelaenge > benoetigte reserve THEN + reservelaenge := benoetigte reserve + END IF; + IF kein inhalt mehr einzusetzen AND variabel THEN + loeschbare blanks zaehlen + END IF . + +linksschieben verboten : + interpretationsmodus = 2 OR interpretationsmodus = 4 . + +kein inhalt mehr einzusetzen : + reserve = lesespeicher. feldlaenge . + +variabel : + (lesespeicher. setzmodus AND 1) = 0 . + +loeschbare blanks zaehlen : + IF lesespeicher. feldanfang = 1 COR + (musterzeile SUB (lesespeicher. feldanfang - 1)) = blank THEN + INT VAR ende := feldende (einzulesendes muster); + WHILE (musterzeile SUB ende) = blank REP + ende INCR 1; + lesespeicher. feldlaenge INCR 1; + reservelaenge INCR 1 + END REP + END IF . + +zeilenabschnitt ausgeben : + IF einzulesendes muster = 1 THEN + IF zeilenende THEN + zeile ganz ausgeben + END IF + ELSE + zeile bis dahin zusammenstellen + END IF . + +zeile ganz ausgeben : + IF blanks dazwischen THEN + zeile drucken (blank) + ELSE + zeile drucken (musterzeile) + END IF; + LEAVE einen zeilendurchgang . + +zeile bis dahin zusammenstellen : + INT VAR + blankluecke := 0, + blankpuffer := lesespeicher. feldanfang; + INT CONST + endeluecke := blankpuffer - length (musterzeile); + blankluecke suchen; + alle zwischenliegenden muster in ausgabedatei kopieren; + letzten zwischenraum kopieren; + zeilenende behandeln . + +blankluecke suchen : + IF endeluecke > 0 THEN + reservelaenge INCR endeluecke; + blankpuffer DECR (endeluecke - 1) + END IF; + rueckwaerts zwei blanks suchen . + +rueckwaerts zwei blanks suchen : + INT CONST + ende voriges feld := feldende (einzulesendes muster - 1), + leerstelle := + pos (musterzeile, zwei blanks, ende voriges feld, blankpuffer); + IF leerstelle > 0 THEN + blankpuffer := leerstelle; + groesse der blankluecke bestimmen + ELIF endeluecke < 0 AND (musterzeile SUB (blankpuffer - 1)) <> blank THEN + blankpuffer := ende voriges feld + END IF . + +groesse der blankluecke bestimmen : + INT VAR ende der luecke := blankpuffer + 1; + REP + blankluecke INCR 1; + ende der luecke INCR 1 + UNTIL (musterzeile SUB ende der luecke) <> blank END REP; + reservelaenge INCR blankluecke . + +alle zwischenliegenden muster in ausgabedatei kopieren : + INT VAR verschiebung := 0; + WHILE einzusetzendes muster < einzulesendes muster REP + setzspeicher in einzelvariablen lesen; + musterzwischenraum kopieren; + muster einsetzen; + einzusetzendes muster INCR 1 + END REP . + +setzspeicher in einzelvariablen lesen : + INT CONST + feldanfang := setzspeicher. feldanfang, + feldlaenge := setzspeicher. feldlaenge, + setzmodus := setzspeicher. setzmodus . + +musterzwischenraum kopieren : + zwischenraum (letztes feldende, feldanfang, blanks dazwischen); + letztes feldende := feldanfang + feldlaenge . + +setzspeicher : + musterspeicher (einzusetzendes muster) . + +muster einsetzen : + INT CONST ueberschuss := - setzdifferenz (setzspeicher); + IF ueberschuss = - feldlaenge THEN + leeres feld behandeln + ELIF ueberschuss <= 0 THEN + in voller laenge einsetzen + ELIF variable laenge AND reserve vorhanden THEN + einsetzen und nach rechts schieben + ELSE + bis zur grenze einsetzen + END IF . + +leeres feld behandeln : + IF variable laenge THEN + verschiebung INCR ueberschuss; + IF linksschieben verboten THEN + verschiebung korrigieren + END IF + ELSE + blanks anfuegen (-ueberschuss) + END IF . + +verschiebung korrigieren : + IF verschiebung < 0 THEN + blanks anfuegen (-verschiebung); + verschiebung := 0 + END IF . + +in voller laenge einsetzen : + IF rechtsbuendig THEN + blanks anfuegen (-ueberschuss) + END IF; + musterspeicher ganz ausgeben (setzspeicher); + zu bearbeitende inhalte DECR 1; + IF feste laenge THEN + ggf mit blanks auffuellen + ELSE + verschiebung INCR ueberschuss; + linksschieben korrigieren + END IF . + +rechtsbuendig : + (setzmodus AND 2) = 2 . + +feste laenge : + (setzmodus AND 1) = 1 . + +ggf mit blanks auffuellen : + IF NOT rechtsbuendig THEN + blanks anfuegen (-ueberschuss) + END IF . + +linksschieben korrigieren : + IF linksschieben verboten AND verschiebung < 0 THEN + blanks anfuegen (-verschiebung); + verschiebung := 0 + END IF . + +variable laenge : + NOT feste laenge . + +reserve vorhanden : + ueberschuss <= reservelaenge . + +einsetzen und nach rechts schieben : + musterspeicher ganz ausgeben (setzspeicher); + zu bearbeitende inhalte DECR 1; + verschiebung INCR ueberschuss; + reservelaenge DECR ueberschuss . + +bis zur grenze einsetzen : + INT VAR + umbruchblanks := 0, + anfang := setzspeicher. bearbeitet bis + 1, + setz ende := anfang + feldlaenge - 1, + einsetzlaenge := feldlaenge; + IF variable laenge THEN + setz ende INCR reservelaenge; + einsetzlaenge INCR reservelaenge + END IF; + IF rechtsbuendig AND keine mehrfachzeilen THEN + rechten teil einsetzen + END IF; + textanweisungen beruecksichtigen; + IF mehrfachzeilen erlaubt THEN + umbruch + END IF; + teilfeld ausgeben; + IF variable laenge THEN + verschiebung INCR reservelaenge; + reservelaenge := 0 + END IF . + +rechten teil einsetzen : + INT CONST nach rechts := length (setzspeicher. inhalt) - setz ende; + anfang INCR nach rechts; + setz ende INCR nach rechts . + +textanweisungen beruecksichtigen : + INT VAR mehr platz; + REP + mehr platz := einsetzlaenge - setz ende + anfang - 1 + + kommandolaenge (setzspeicher. inhalt, anfang, setz ende); + IF mehr platz = 0 THEN + LEAVE textanweisungen beruecksichtigen + ELIF rechtsbuendig THEN + anfang DECR mehr platz + ELSE + setz ende INCR mehr platz + END IF + END REP . + +mehrfachzeilen erlaubt : + interpretationsmodus >= 3 . + +keine mehrfachzeilen : + NOT mehrfachzeilen erlaubt . + +teilfeld ausgeben : + IF rechtsbuendig THEN + blanks anfuegen (umbruchblanks) + END IF; + druckausgabe (setzspeicher. inhalt, anfang, setz ende); + IF linksbuendig THEN + blanks anfuegen (umbruchblanks) + END IF . + +linksbuendig : + NOT rechtsbuendig . + +umbruch : + IF pos (setzspeicher. inhalt, blank, anfang, setz ende) > 0 THEN + ende zuruecksetzen + END IF; + INT CONST naechstes wort := + pos (setzspeicher. inhalt, ""33"", ""254"", setz ende + 1); + IF naechstes wort = 0 THEN + setzspeicher. bearbeitet bis := length (setzspeicher. inhalt); + zu bearbeitende inhalte DECR 1 + ELSE + setzspeicher. bearbeitet bis := naechstes wort - 1 + END IF . + +ende zuruecksetzen : + setz ende INCR 1; umbruchblanks DECR 1; + WHILE (setzspeicher. inhalt SUB setz ende) <> blank REP + setz ende DECR 1; + umbruchblanks INCR 1 + END REP; + WHILE (setzspeicher. inhalt SUB setz ende) = blank REP + setz ende DECR 1; + umbruchblanks INCR 1 + UNTIL ende < anfang END REP . + +letzten zwischenraum kopieren : + zwischenraum (letztes feldende, blankpuffer, blanks dazwischen); + IF verschiebung < 0 THEN + IF blankpuffer <= length (musterzeile) THEN + blanks anfuegen (-verschiebung) + END IF; + letztes feldende := blankpuffer + ELSE + letztes feldende := blankpuffer + min (verschiebung, blankluecke) + END IF . + +zeilenende behandeln : + IF endeluecke > 0 THEN + rest der musterzeile drucken; + zeile ausgeben; + LEAVE einen zeilendurchgang + ELSE + folgenden abschnitt vorbereiten + END IF . + +rest der musterzeile drucken : + IF NOT blanks dazwischen THEN + druckausgabe (musterzeile, letztes feldende, length (musterzeile)) + END IF . + +zeile ausgeben : + INT VAR neues ende := length (ausgabezeile); + IF (ausgabezeile SUB neues ende) = blank THEN + REP + neues ende DECR 1 + UNTIL (ausgabezeile SUB neues ende) <> blank END REP; + ausgabezeile := subtext (ausgabezeile, 1, neues ende) + END IF; + IF absatzmarkierung noetig THEN + ausgabezeile CAT blank + END IF; + zeile drucken (ausgabezeile) . + +absatzmarkierung noetig : + (musterzeile SUB LENGTH musterzeile) = blank AND + (interpretationsmodus <> 3 OR zu bearbeitende inhalte = 0) . + +folgenden abschnitt vorbereiten : + reservelaenge := 0; + benoetigte reserve := 0 . + +END PROC interpretiere; + +INT PROC feldende (INT CONST speicherindex) : + + musterspeicher (speicherindex). feldanfang + + musterspeicher (speicherindex). feldlaenge + +END PROC feldende; + +INT PROC setzdifferenz (SPEICHER CONST speicher) : + + speicher. feldlaenge - length (speicher. inhalt) + + kommandolaenge (speicher. inhalt) + speicher. bearbeitet bis + +END PROC setzdifferenz; + +INT PROC kommandolaenge (TEXT CONST inh) : + + kommandolaenge (inh, 1, length (inh)) + +END PROC kommandolaenge; + +INT PROC kommandolaenge (TEXT CONST inh, INT CONST von, bis) : + + INT CONST + first fis := pos (inh, fis, von, bis); + INT VAR + p := first fis, + n, + laenge := 0; + + WHILE p > 0 REP + naechstes fis suchen; + IF kein naechstes THEN + rand korrigieren + ELSE + laenge addieren + END IF; + fis anfang suchen + END REP; + laenge . + +naechstes fis suchen : + n := pos (inh, fis, p + 1, bis) . + +kein naechstes : + n = 0 . + +rand korrigieren : + IF bis = length (inh) THEN + laenge INCR first fis + ELSE + laenge INCR (bis - p + 1) + END IF . + +laenge addieren : + laenge INCR (n - p + 1) . + +fis anfang suchen : + IF n > 0 THEN + p := pos (inh, fis, n + 1, bis) + ELSE + p := 0 + END IF . + +END PROC kommando laenge; + +LET + zehn blanks = " "; + +PROC blanks anfuegen (INT CONST anzahl) : + + INT VAR zaehler := anzahl; + WHILE zaehler >= 10 REP + ausgabezeile CAT zehn blanks; + zaehler DECR 10 + END REP; + WHILE zaehler > 0 REP + ausgabezeile CAT blank; + zaehler DECR 1 + END REP + +END PROC blanks anfuegen; + +PROC musterspeicher ganz ausgeben (SPEICHER VAR speicher) : + + IF speicher. bearbeitet bis = 0 THEN + ausgabezeile CAT speicher. inhalt + ELSE + druckausgabe (speicher. inhalt, speicher. bearbeitet bis + 1, + length (speicher. inhalt)) + END IF; + speicher. bearbeitet bis := length (speicher. inhalt) + +END PROC musterspeicher ganz ausgeben; + +PROC zwischenraum (INT CONST von, bis, BOOL CONST blanks dazwischen) : + + IF blanks dazwischen THEN + blanks anfuegen (bis - von) + ELSE + druckausgabe (musterzeile, von, bis - 1) + END IF + +END PROC zwischenraum; + +TEXT VAR ausgabepuffer; + +PROC druckausgabe (TEXT CONST context, INT CONST von, bis) : + + ausgabepuffer := subtext (context, von, bis); + ausgabezeile CAT ausgabepuffer + +END PROC druckausgabe; + + +(************************* Musterscanner *********************************) + +(* + EXPORTS + + FILE VAR druckmuster + naechstes muster (TEXT VAR mustername) + naechstes muster (INT VAR musteranfang, musterlaenge, setzmodus) + musterzeile lesen + TEXT musterzeile + INT zeilennr + muster auf zeile (INT CONST neue zeile) + BOOL kommandozeile (INT VAR kommandoindex) + int param (INT VAR param) + INT m pos + BOOL druckmusterende + ueberlesen (TEXT CONST zeichen) + INT musterzeilenbreite + standard musterzeilenbreite +*) + + +FILE VAR druckmuster; + +TEXT VAR musterzeile; + +INT VAR m pos; + +LET + keine schliessende klammer = #401# + "keine schliessende Klammer in Feldmuster", + kein kommando in kommandozeile = #402# + "kein Kommando in Kommandozeile", + unbekanntes kommando = #403# + "unbekanntes Kommando"; + +LET + fix symbol = "&", + var symbol = "%", + com symbol = "%", + klammer auf = "<", + klammer zu = ">"; + +LET + kommandos = #404# + " "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN + "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR " + + +LET + vor index = 1, + wdh index = 2, + nach index = 3, + abk index = 4, + gruppe index = 5, + modus index = 6, + mehr index = 7, + do index = 100; + +INT VAR + musterzeilenbreite, + name anfang, + name ende; + +BOOL VAR + druckmusterende, + zeile gelesen; + + +. +zeilennr : + line no (druckmuster) . + +standard musterzeilenbreite : + musterzeilenbreite := maxlinelength (druckmuster) . + + +PROC ueberlesen (TEXT CONST zeichen) : + + REP + m pos INCR 1 + UNTIL (musterzeile SUB m pos) <> zeichen END REP + +END PROC ueberlesen; + +PROC naechstes muster (INT VAR anfang, laenge, setzmodus) : + + m pos auf naechsten anfang; + IF zeilenende THEN + anfang := max (musterzeilenbreite, length (musterzeile)) + 1; + laenge := 0; + setzmodus := 5 + ELSE + anfang := m pos; + muster lesen + END IF . + +m pos auf naechsten anfang : + m pos auf zeichen (fix symbol, var symbol) . + +zeilenende : + m pos > length (musterzeile) . + +muster lesen : + TEXT CONST musterzeichen := musterzeile SUB m pos; + IF musterzeichen = var symbol THEN + setzmodus := 0 + ELSE + setzmodus := 4 + END IF; + anfangszeichen ueberlesen; + feldnamen lesen; + endezeichen ueberlesen . + +anfangszeichen ueberlesen : + ueberlesen (musterzeichen); + IF m pos - 1 > anfang THEN + ist rechtsbuendig + END IF . + +ist rechtsbuendig : + setzmodus INCR 3 . + +feldnamen lesen : + IF (musterzeile SUB m pos) = klammer auf THEN + bis klammer zu lesen + ELSE + bis blank oder muster lesen + END IF; + IF leerer feldname THEN + naechstes muster (anfang, laenge, setzmodus); + LEAVE naechstes muster + END IF . + +leerer feldname : + name anfang > name ende . + +bis klammer zu lesen : + name anfang := m pos + 1; + name ende := pos (musterzeile, klammer zu, name anfang); + IF name ende = 0 THEN + fehler (keine schliessende klammer, subtext (musterzeile, m pos)); + name ende := length (musterzeile) + ELSE + name ende DECR 1 + END IF; + m pos := name ende + 2 . + +bis blank oder muster lesen : + name anfang := m pos; + m pos auf zeichen (blank, var symbol); + INT CONST zwischenpos := pos (musterzeile, fix symbol, name anfang, m pos); + IF zwischenpos > 0 THEN + m pos := zwischenpos + END IF; + name ende := m pos - 1 . + +endezeichen ueberlesen : + IF musterzeichen angetroffen THEN + ist fest; + ueberlesen (musterzeichen) + END IF; + laenge := m pos - anfang . + +musterzeichen angetroffen : + (musterzeile SUB m pos) = musterzeichen . + +ist fest : + setzmodus := setzmodus OR 1 . + +END PROC naechstes muster; + +PROC naechstes muster (TEXT VAR name) : + + INT VAR d1, laenge, d3; + naechstes muster (d1, laenge, d3); + IF laenge > 0 THEN + name := subtext (musterzeile, name anfang, name ende) + ELSE + name := niltext + END IF + +END PROC naechstes muster; + +PROC m pos auf zeichen (TEXT CONST zeichen 1, zeichen 2) : + + INT CONST + pos 1 := pos (musterzeile, zeichen 1, m pos), + pos 2 := pos (musterzeile, zeichen 2, m pos); + m pos := length (musterzeile) + 1; + IF pos 1 > 0 THEN + m pos := pos 1 + END IF; + IF pos 2 > 0 AND pos 2 < m pos THEN + m pos := pos 2 + END IF + +END PROC m pos auf zeichen; + +PROC muster auf zeile (INT CONST zeile) : + + to line (druckmuster, zeile); + zeile gelesen := FALSE; + druckmusterende := eof (druckmuster) + +END PROC muster auf zeile; + +PROC musterzeile lesen : + + IF zeile gelesen THEN + down (druckmuster) + ELSE + zeile gelesen := TRUE + END IF; + read record (druckmuster, musterzeile); + m pos := 1; + druckmusterende := line no (druckmuster) >= lines (druckmuster) + +END PROC musterzeile lesen; + +BOOL PROC kommandozeile (INT VAR kommandoindex) : + + m pos := 1; + IF (musterzeile SUB 1) <> com symbol THEN + FALSE + ELIF (musterzeile SUB 2) <> com symbol THEN + kommando abtrennen; + kommandoindex bestimmen; + TRUE + ELSE + kommandoindex := do index; + TRUE + END IF . + +kommando abtrennen : + TEXT VAR kommando; + ueberlesen (blank); + IF m pos > length (musterzeile) THEN + fehler (kein kommando in kommandozeile, musterzeile); + kommandoindex := 0; + LEAVE kommandozeile WITH TRUE + END IF; + INT CONST blank pos := pos (musterzeile, blank, m pos); + IF blank pos = 0 THEN + kommando := subtext (musterzeile, m pos); + kommando CAT blank; + m pos := length (musterzeile) + 1 + ELSE + kommando := subtext (musterzeile, m pos, blank pos); + m pos := blank pos + END IF . + +kommandoindex bestimmen : + INT CONST wo := pos (kommandos, kommando); + IF wo > 0 CAND (kommandos SUB (wo - 2)) = blank THEN + kommandoindex := code (kommandos SUB (wo - 1)) + ELSE + kommandoindex := 0; + fehler (unbekanntes kommando, kommando); + END IF . + +END PROC kommandozeile; + +PROC int param (INT VAR param) : + + ueberlesen (blank); + INT CONST par anfang := m pos; + WHILE ziffer REP + m pos INCR 1 + END REP; + IF m pos > par anfang THEN + param := int (subtext (musterzeile, par anfang, m pos - 1)) + ELSE + param := -1 + END IF . + +ziffer : + pos ("0123456789", musterzeile SUB m pos) > 0 . + +END PROC int param; + + +(**************************** Codegenerierung ****************************) + +(* + EXPORTS + + FILE VAR programm + BOOL wird uebersetzt + proc name (TEXT CONST name) + end proc + anweisung (TEXT CONST text) + anweisung (TEXT CONST pre, mid, post) + anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post) + interpret anweisung (INT CONST zeile, muster) +*) + +FILE VAR programm; + +TEXT VAR + aktuelle proc; + +BOOL VAR + wird uebersetzt; + + +PROC proc name (TEXT CONST name) : + + aktuelle proc := name; + programmausgabe ("PROC ", name, " :") + +END PROC proc name; + +PROC end proc : + + programmausgabe ("END PROC ", aktuelle proc, ";") + +END PROC end proc; + +PROC anweisung (TEXT CONST programmtext) : + + wird uebersetzt := TRUE; + putline (programm, programmtext) + +END PROC anweisung; + +PROC anweisung (TEXT CONST pre, mid, post) : + + wird uebersetzt := TRUE; + programmausgabe (pre, mid, post) + +END PROC anweisung; + +PROC programmausgabe (TEXT CONST pre, mid, post) : + + write (programm, pre); + write (programm, mid); + write (programm, post); + line (programm) + +END PROC programmausgabe; + +TEXT VAR textpuffer; + +PROC anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post) : + + text puffer := subtext (musterzeile, spalte); + anweisung (pre, textpuffer, post) + +END PROC anweisung; + +PROC interpret anweisung (INT CONST zeile, muster) : + + programmausgabe ("; interpretiere (", + text (zeile) + ", " + text (muster), + ", PROC (INT CONST, TEXT VAR) abk);") + +END PROC interpret anweisung; + + +(************************ Muster uebersetzen *****************************) + +(* + EXPORTS + + druckmuster uebersetzen + ROW 3 ABSCHNITT VAR abschnitte + ROW max muster INT VAR musterindex + fehler (TEXT CONST meldung) + ROW maxgruppen GRUPPE VAR gruppen + +*) + + +LET + vorzeitiges ende = #405# + "kein % WIEDERHOLUNG gefunden", + nur gruppe erlaubt = #406# + "Nur GRUPPE-Anweisung erlaubt", + kein do mehr erlaubt nach gruppen = #407# + "keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition", + illegale gruppennummer = #408# + "illegale Gruppennummer", + gruppe schon definiert = #409# + "diese Gruppe wurde schon definiert", + abkuerzung nicht definiert = #410# + "diese Abkuerzung ist nicht definiert", + abschnitt mehrfach definiert = #411# + "dieser Abschnitt wurde schon einmal definiert", + falscher modus = #412# + "falscher Modus", + im musterteil nicht erlaubt = #413# + "diese Anweisung darf im Musterteil nicht vorkommen", + im abkuerzungsteil nicht erlaubt = #414# + "im Abkuerzungsteil darf keine Anweisung auftreten", + zuviele muster pro zeile = #415# + "in dieser Zeile stehen zu viele Feldmuster", + zuviele muster = #416# + "das Druckmuster enthaelt zu viele Feldmuster", + name der abkuerzung fehlt = #417# + "nach dem ""&"" soll direkt der Name einer Abkuerzung folgen", + kein doppelpunkt nach abkuerzung = #418# + "kein Doppelpunkt nach Abkuerzung", + abkuerzung mehrfach definiert = #419# + "Abkuerzung mehrfach definiert", + zu viele abkuerzungen = #420# + "das Druckmuster enthaelt zu viele Abkuerzungen"; + +LET + max muster = 200, + max gruppen = 4, + max abkuerzungen = 250, + + GRUPPE = STRUCT (BOOL wechsel, + definiert, + TEXT inhalt), + + ABSCHNITT = STRUCT (INT erstes muster, + erste zeile, + TEXT proc name); + + +ROW max muster INT VAR musterindex; + +INT VAR anzahl muster; + +ROW maxgruppen GRUPPE VAR gruppen; + +ROW 3 ABSCHNITT VAR abschnitte; + +SATZ VAR abkuerzungen; + +TEXT VAR + abkuerzungszeile; + +INT VAR + anzahl abkuerzungen; + + +OP CAT (TEXT VAR intvec, INT CONST wert) : + + TEXT VAR platz fuer int := " "; + replace (platz fuer int, 1, wert); + intvec CAT platz fuer int + +END OP CAT; + +PROC druckmuster uebersetzen : + + enable stop; + muster auf zeile (1); + uebersetzungsvariablen initialisieren; + initialisierungsteil uebersetzen; + WHILE NOT druckmusterende REP + einen von drei abschnitten uebersetzen + END REP; + abkuerzungen einsetzen . + +uebersetzungsvariablen initialisieren : + INT VAR kommandoindex; + INT VAR i; + anzahl abkuerzungen := 0; + satz initialisieren (abkuerzungen); + abkuerzungszeile := niltext; + anzahl muster := 0; + wird uebersetzt := FALSE; + abschnitte (1) := ABSCHNITT : (0, 0, "vorspann"); + abschnitte (2) := ABSCHNITT : (0, 0, "wdh"); + abschnitte (3) := ABSCHNITT : (0, 0, "nachspann"); + FOR i FROM 1 UPTO max gruppen REP + gruppen (i). definiert := FALSE + END REP . + +initialisierungsteil uebersetzen : + BOOL VAR + schon gruppendefinition := FALSE; + + REP + IF druckmusterende THEN + fehler (vorzeitiges ende); + LEAVE druckmuster uebersetzen + END IF; + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + initialisierungskommando uebersetzen + END IF + END REP . + +initialisierungskommando uebersetzen : + SELECT kommandoindex OF + + CASE do index : + do kommando kopieren + + CASE gruppe index : + gruppendefinition aufnehmen + + CASE vor index, wdh index, nach index : + IF NOT schon gruppendefinition THEN + proc name ("gruppen") + END IF; + end proc; + LEAVE initialisierungsteil uebersetzen + + OTHERWISE + IF kommandoindex > 0 THEN + fehler (nur gruppe erlaubt) + END IF + + END SELECT . + +do kommando kopieren : + IF schon gruppendefinition THEN + fehler (kein do mehr erlaubt nach gruppen, musterzeile) + ELSE + replace (musterzeile, 1, " "); + anweisung (musterzeile) + END IF . + +gruppendefinition aufnehmen : + IF NOT schon gruppendefinition THEN + proc name ("gruppen"); + schon gruppendefinition := TRUE + END IF; + INT VAR gruppennr; + int param (gruppennr); + IF gruppennr < 1 OR gruppennr > max gruppen THEN + fehler (illegale gruppennummer, musterzeile) + ELIF gruppen (gruppennr). definiert THEN + fehler (gruppe schon definiert, musterzeile) + ELSE + gruppen (gruppennr). definiert := TRUE; + ausdruck uebersetzen + END IF . + +ausdruck uebersetzen : + anweisung ("gruppentest (", text (gruppennr), ", "); + anweisung (" ", m pos, ");") . + +einen von drei abschnitten uebersetzen : + SELECT kommandoindex OF + CASE vor index : vorspann uebersetzen + CASE wdh index : wiederholungsteil uebersetzen + CASE nach index : nachspann uebersetzen + END SELECT . + +vorspann uebersetzen : + abschnitt uebersetzen (abschnitte (1), kommandoindex) . + +wiederholungsteil uebersetzen : + int param (spalten); int param (spaltenbreite); + abschnitt uebersetzen (abschnitte (2), kommandoindex) . + +nachspann uebersetzen : + abschnitt uebersetzen (abschnitte (3), kommandoindex) . + +abkuerzungen einsetzen : + IF wird uebersetzt THEN + fehlende procs definieren; + abk headline + END IF; + abkuerzungen ueberpruefen; + IF wird uebersetzt THEN + abk ende; + druckaufruf + END IF . + +abkuerzungen ueberpruefen : + FOR i FROM 1 UPTO anzahl abkuerzungen REP + IF (abkuerzungszeile ISUB i) > 0 THEN + fehler (abkuerzung nicht definiert, + name der abkuerzung, abkuerzungszeile ISUB i) + ELSE + anweisung in abk proc generieren + END IF + END REP . + +name der abkuerzung : + TEXT VAR puffer; + feld lesen (abkuerzungen, i, puffer); + puffer . + +fehlende procs definieren : + FOR i FROM 1 UPTO 3 REP + IF abschnitte (i). erste zeile = 0 THEN + abschnitt proc definieren + END IF + END REP . + +abschnitt proc definieren : + proc name (abschnitte (i). proc name); + end proc . + +abk headline : + anweisung ("PROC abk (INT CONST nr, TEXT VAR inhalt) :"); + IF anzahl abkuerzungen > 0 THEN + anweisung ("SELECT nr OF") + ELSE + anweisung ("inhalt := text (nr)") + END IF . + +anweisung in abk proc generieren : + TEXT CONST lfd index := text (i); + anweisung ("CASE " + lfd index, " : inhalt := abk", lfd index) . + +abk ende : + IF anzahl abkuerzungen > 0 THEN + anweisung ("END SELECT") + END IF; + anweisung ("END PROC abk;") . + +druckaufruf : + anweisung + ("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)") . + +END PROC druckmuster uebersetzen; + +PROC abschnitt uebersetzen (ABSCHNITT VAR abschnitt, + INT VAR kommandoindex) : + + BOOL VAR war do zeile := TRUE; (* generiert erstes 'interpretiere' *) + proc name (abschnitt. proc name); + abschnitt anfang speichern; + musterteil uebersetzen; + abkuerzungen uebersetzen . + +abschnitt anfang speichern : + IF abschnitt. erste zeile <> 0 THEN + fehler (abschnitt mehrfach definiert, musterzeile) + END IF; + abschnitt. erste zeile := zeilennr + 1; + abschnitt. erstes muster := anzahl muster + 1 . + +musterteil uebersetzen : + WHILE NOT druckmusterende REP + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + abschnitt kommando uebersetzen + ELSE + interpret anweisung generieren; + musterzeile auf feldmuster untersuchen + END IF + END REP; + abschnitt beenden; + LEAVE abschnitt uebersetzen . + +abschnitt kommando uebersetzen : + SELECT kommandoindex OF + + CASE do index : + replace (musterzeile, 1, " "); + anweisung (musterzeile); + war do zeile := TRUE + + CASE vor index, wdh index, nach index : + abschnitt beenden; + LEAVE abschnitt uebersetzen + + CASE abk index : + abschnitt beenden; + LEAVE musterteil uebersetzen + + CASE modus index : + interpret anweisung generieren; + INT VAR parameter; + int param (parameter); + IF parameter < 1 OR parameter > 4 THEN + fehler (falscher modus, musterzeile) + END IF + + CASE mehr index : + interpret anweisung generieren + + OTHERWISE + IF kommandoindex > 0 THEN + fehler (im musterteil nicht erlaubt) + END IF + + END SELECT . + +interpret anweisung generieren : + IF war do zeile THEN + interpret anweisung (zeilennr, anzahl muster + 1); + war do zeile := FALSE + END IF . + +abschnitt beenden : + end proc . + +musterzeile auf feldmuster untersuchen : + TEXT VAR name; + INT VAR muster pro zeile := 0; + + REP + naechstes muster (name); + IF name = niltext THEN + LEAVE musterzeile auf feldmuster untersuchen + END IF; + muster pro zeile INCR 1; + muster uebersetzen + END REP . + +muster uebersetzen : + IF muster pro zeile >= max musterspeicher THEN + fehler (zu viele muster pro zeile) + END IF; + IF anzahl muster = max muster THEN + fehler (zu viele muster) + ELSE + anzahl muster INCR 1 + END IF; + vorlaeufigen musterindex suchen . + +vorlaeufigen musterindex suchen : + INT VAR feldnr := feldnummer (name); + IF feldnr = 0 THEN + feldnr := feldindex (abkuerzungen, name); + IF feldnr = 0 THEN + abkuerzung eintragen (name, zeilennr); + musterindex (anzahl muster) := -anzahl abkuerzungen + ELSE + musterindex (anzahl muster) := -feldnr + END IF + ELSE + musterindex (anzahl muster) := feldnr + END IF . + +abkuerzungen uebersetzen : + BOOL VAR erste abkuerzungszeile := TRUE; + WHILE NOT druckmusterende REP + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + auf ende pruefen + ELIF zeile nicht leer THEN + abkuerzung behandeln + END IF + END REP . + +auf ende pruefen : + SELECT kommandoindex OF + CASE vor index, wdh index, nach index : + LEAVE abkuerzungen uebersetzen + OTHERWISE + IF kommandoindex > 0 THEN + fehler (im abkuerzungsteil nicht erlaubt) + END IF + END SELECT . + +abkuerzung behandeln : + IF erste abkuerzungszeile THEN + anweisung ("."); + erste abkuerzungszeile := FALSE + END IF; + IF erste zeile einer abkuerzung THEN + namen isolieren + ELSE + anweisung (musterzeile) + END IF . + +erste zeile einer abkuerzung : + (musterzeile SUB 1) = fix symbol . + +namen isolieren : + TEXT VAR abkuerzungsname; + naechstes muster (abkuerzungsname); + IF abkuerzungsname = niltext THEN + fehler (name der abkuerzung fehlt, musterzeile); + LEAVE namen isolieren + END IF; + doppelpunkt suchen; + an compiler uebergeben . + +doppelpunkt suchen : + LET doppelpunkt = ":"; + m pos DECR 1; (* wegen 'ueberlesen' *) + ueberlesen (blank); + IF (musterzeile SUB m pos) = doppelpunkt THEN + m pos INCR 1 + ELSE + fehler (kein doppelpunkt nach abkuerzung, musterzeile) + END IF . + +an compiler uebergeben : + abkuerzung eintragen (abkuerzungsname, 0); + anweisung (refinement name, m pos - 1, "") . + +refinement name : + "abk" + text (feldindex (abkuerzungen, abkuerzungsname)) . + +zeile nicht leer : + musterzeile <> niltext AND musterzeile <> blank . + +END PROC abschnitt uebersetzen; + +PROC abkuerzung eintragen (TEXT CONST name, INT CONST zeile) : + + INT CONST vorhanden := feldindex (abkuerzungen, name); + IF vorhanden > 0 THEN + alten eintrag ergaenzen + ELSE + neu anlegen + END IF . + +alten eintrag ergaenzen : + IF (abkuerzungszeile ISUB vorhanden) > 0 THEN + replace (abkuerzungszeile, vorhanden, zeile) + ELIF zeile = 0 THEN + fehler (abkuerzung mehrfach definiert, name) + END IF . + +neu anlegen : + IF anzahl abkuerzungen = max abkuerzungen THEN + fehler (zu viele abkuerzungen) + ELSE + anzahl abkuerzungen INCR 1 + END IF; + abkuerzungszeile CAT zeile; + feld aendern (abkuerzungen, anzahl abkuerzungen, name) . + +END PROC abkuerzung eintragen; + +LET + fehler in = #421# + "FEHLER in Zeile ", + fehler bei = #422# + " bei >>", + fehler ende = #423# + "<<"; + +PROC fehler (TEXT CONST fehlermeldung, bei, INT CONST zeile) : + + LET + blanks = " "; + TEXT VAR + meldung := fehler in; + meldung CAT text (zeile); + IF bei <> niltext THEN + meldung CAT fehler bei; + meldung CAT bei; + meldung CAT fehler ende + END IF; + note (meldung); note line; + note (blanks); note (fehlermeldung); note line; + IF online AND command dialogue THEN + line; + putline (meldung); + put (blanks); putline (fehlermeldung) + END IF + +END PROC fehler; + +PROC fehler (TEXT CONST fehlermeldung) : + + fehler (fehlermeldung, niltext, zeilennr) + +END PROC fehler; + +PROC fehler (TEXT CONST fehlermeldung, bei) : + + fehler (fehlermeldung, bei, zeilennr) + +END PROC fehler; + + +(************************** Drucksteuerung *******************************) + +(* + EXPORTS + + drucke (TEXT CONST dateiname) + drucke (PROC gruppen, PROC vor, PROC wdh, PROC nach) + druckdatei (TEXT CONST dateiname) + direkt drucken (BOOL CONST modus) + BOOL direkt drucken + max druckzeilen (INT CONST zeilen) + BOOL gruppenwechsel (INT CONST gruppennr) + gruppentest (INT CONST gruppe, TEXT CONST merkmal) + TEXT lfd nr + zeile drucken (TEXT CONST zeile) + INT spalten + INT spaltenbreite +*) + + +LET + erzeugtes programm = #424# + "erzeugtes Programm", + keine datei geoeffnet = #425# + "keine Datei geoeffnet", + interner fehler = #426# + "interner Fehler", + druckausgabe steht in = #427# + "Druckausgabe steht in", + zum drucker geschickt = #428# + "zum Drucker geschickt.", + direkt drucken nicht moeglich = #429# + "direkt Drucken nicht moeglich", + eudas ausgabe punkt = #430# + ".a$"; + +TEXT VAR + spaltenpuffer, + druckdateiname := ""; + +BOOL VAR + wechsel erfolgt, + wechsel 0, + externer dateiname, + direkt ausdrucken := FALSE; + +FILE VAR ausgabe; + +INT VAR + spalten, + spaltenbreite, + gedruckte spalten, + gemeinsamer anfang, + gedruckte zeilen, + richtung := 1, + max zeilen := 4000, + satzzaehler; + + +PROC drucke : + + drucke (last param) + +END PROC drucke; + +PROC drucke (TEXT CONST dateiname) : + + enable stop; + last param (dateiname); + druckmuster := sequential file (input, dateiname); + modify (druckmuster); + IF anzahl dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + disable stop; + programmdatei einrichten; + druckmuster uebersetzen; + IF anything noted THEN + note edit (druckmuster) + ELIF wird uebersetzt THEN + programm uebersetzen + ELSE + drucke (PROC dummy gruppentest, + PROC std vor, PROC std wdh, PROC std nach) + END IF; + forget (programmdatei, quiet) . + +programmdatei einrichten : + TEXT VAR programmdatei; + INT VAR i := 0; + REP + i INCR 1; + programmdatei := text (i) + UNTIL NOT exists (programmdatei) END REP; + programm := sequential file (output, programmdatei); + headline (programm, erzeugtes programm) . + +programm uebersetzen : + run (programmdatei); + last param (dateiname) . + +END PROC drucke; + +PROC dummy gruppentest : END PROC dummy gruppentest; + +PROC std vor : + + abschnitt ausfuehren (1) + +END PROC std vor; + +PROC std wdh : + + abschnitt ausfuehren (2) + +END PROC std wdh; + +PROC std nach : + + abschnitt ausfuehren (3) + +END PROC std nach; + +PROC abschnitt ausfuehren (INT CONST nr) : + + IF abschnitte (nr). erste zeile > 0 THEN + interpretiere (abschnitte (nr). erste zeile, + abschnitte (nr). erstes muster, + PROC (INT CONST, TEXT VAR) std abk) + END IF + +END PROC abschnitt ausfuehren; + +PROC std abk (INT CONST nr, TEXT VAR inhalt) : + + errorstop (interner fehler); + inhalt := code (nr) (* Dummy-Anweisung, damit Parameter benutzt *) + +END PROC std abk; + +PROC drucke (PROC grp test, PROC vorspann, PROC wdh, PROC nachspann) : + + INT VAR + modus, + letzter satz, + letzte kombination; + + enable stop; + druckdatei eroeffnen; + auf ersten satz; + gruppen initialisieren; + satzzaehler := 1; + WHILE NOT dateiende REP + bei gruppenwechsel nachspann und vorspann; + cout (satznummer); + wiederholungsteil interpretieren; + weiter (modus); + ende der druckdatei ueberpruefen + END REP; + letzten nachspann drucken; + datei ausdrucken; + auf satz (1) . + +auf ersten satz : + letzter satz := 0; + auf satz (1); + IF markierte saetze > 0 THEN + modus := 3; + IF NOT satz markiert THEN weiter (modus) END IF + ELSE + modus := 2; + IF NOT satz ausgewaehlt THEN weiter (modus) END IF + END IF . + +gruppen initialisieren : + INT VAR i; + FOR i FROM 1 UPTO maxgruppen REP + gruppen (i). inhalt := niltext + END REP . + +bei gruppenwechsel nachspann und vorspann : + IF letzter satz = 0 THEN + grp test; + alle gruppen wechseln; + abschnitt interpretieren (PROC vorspann) + ELSE + wechsel 0 := FALSE; + gruppenwechsel testen; + gruppenwechsel mit nachspann + END IF; + letzter satz := satznummer; + letzte kombination := satzkombination . + +gruppenwechsel testen : + wechsel erfolgt := FALSE; + grp test . + +gruppenwechsel mit nachspann : + IF wechsel erfolgt THEN + nachspann drucken (letzter satz, letzte kombination, PROC nachspann) + END IF; + satzzaehler INCR 1; + IF wechsel erfolgt THEN + abschnitt interpretieren (PROC vorspann) + END IF . + +wiederholungsteil interpretieren : + IF spaltenbreite < 1 THEN + standard musterzeilenbreite + ELSE + musterzeilenbreite := spaltenbreite + END IF; + IF gedruckte spalten < spalten THEN + to line (ausgabe, gemeinsamer anfang) + ELSE + to line (ausgabe, gedruckte zeilen + 1); + gemeinsamer anfang := gedruckte zeilen + 1; + gedruckte spalten := 0 + END IF; + interpretationsmodus := 1; + wdh; + gedruckte spalten INCR 1 . + +ende der druckdatei ueberpruefen : + IF gedruckte zeilen > maxzeilen THEN + datei ausdrucken; + druckdatei eroeffnen + END IF . + +letzten nachspann drucken : + alle gruppen wechseln; + IF letzter satz = 0 THEN + abschnitt interpretieren (PROC nachspann) + ELSE + nachspann drucken (letzter satz, letzte kombination, PROC nachspann) + END IF; + muster auf zeile (1) . + +END PROC drucke; + +PROC alle gruppen wechseln : + + INT VAR i; + FOR i FROM 1 UPTO max gruppen REP + gruppen (i). wechsel := TRUE + END REP; + wechsel 0 := TRUE; + wechsel erfolgt := TRUE + +END PROC alle gruppen wechseln; + +PROC abschnitt interpretieren (PROC abschnitt) : + + gedruckte spalten := spalten; + to line (ausgabe, gedruckte zeilen + 1); + standard musterzeilenbreite; + interpretationsmodus := 1; + abschnitt + +END PROC abschnitt interpretieren; + +PROC nachspann drucken (INT CONST letzter satz, letzte kombination, + PROC nachspann) : + + INT CONST + aktueller satz := satznummer, + aktuelle kombination := satzkombination; + auf satz (letzter satz); + WHILE satzkombination <> letzte kombination REP weiter (1) END REP; + abschnitt interpretieren (PROC nachspann); + auf satz (aktueller satz); + WHILE satzkombination <> aktuelle kombination REP weiter (1) END REP + +END PROC nachspann drucken; + +PROC druckdatei eroeffnen : + + IF aktueller editor > 0 THEN + in editfile schreiben + ELSE + in ausgabedatei schreiben + END IF; + druckanweisungen uebertragen . + +in editfile schreiben : + ausgabe := edit file; + IF col > 1 THEN + split line (ausgabe, col, FALSE); + down (ausgabe); col (ausgabe, 1) + END IF; + gedruckte zeilen := line no (ausgabe) - 1 . + +in ausgabedatei schreiben : + IF NOT externer dateiname THEN + druckdateinamen generieren + END IF; + ausgabe := sequential file (modify, druckdateiname); + max linelength (ausgabe, max linelength (druckmuster)); + gedruckte zeilen := lines (ausgabe) . + +druckdateinamen generieren : + INT VAR zaehler := 0; + REP + zaehler INCR 1; + druckdateiname := + headline (druckmuster) + eudas ausgabe punkt + text (zaehler); + UNTIL NOT exists (druckdateiname) END REP . + +druckanweisungen uebertragen : + muster auf zeile (1); + WHILE NOT druckmusterende REP + zeile uebertragen + END REP . + +zeile uebertragen : + musterzeile lesen; + INT VAR kommandoindex; + IF kommandozeile (kommandoindex) THEN + auf ende testen + ELSE + zeile drucken (musterzeile) + END IF . + +auf ende testen : + IF kommandoindex <> do index AND kommandoindex <> gruppe index THEN + LEAVE druckanweisungen uebertragen + END IF . + +END PROC druckdatei eroeffnen; + +PROC datei ausdrucken : + + IF aktueller editor > 0 THEN + LEAVE datei ausdrucken + ELIF externer dateiname THEN + externer dateiname := FALSE; + ELIF direkt ausdrucken THEN + disable stop; + ausdruck versuchen + ELIF online AND richtung > 1 THEN + line; put (druckausgabe steht in); + putline (textdarstellung (druckdateiname)); + pause (40) + END IF; + to line (ausgabe, 1) . + +ausdruck versuchen : + TEXT CONST param := std; + last param (druckdateiname); + do ("print (std)"); + IF is error THEN + clear error; + errorstop (direkt drucken nicht moeglich) + ELIF online THEN + line; put (textdarstellung (druckdateiname)); + putline (zum drucker geschickt); + forget (druckdateiname, quiet); + pause (40) + END IF; + last param (param) . + +END PROC datei ausdrucken; + +PROC zeile drucken (TEXT CONST zeile) : + + IF gedruckte spalten >= spalten OR gedruckte spalten = 0 THEN + insert record (ausgabe); + write record (ausgabe, zeile); + gedruckte zeilen INCR 1 + ELSE + an zeile anfuegen + END IF; + down (ausgabe) . + +an zeile anfuegen : + IF eof (ausgabe) THEN + spaltenpuffer := niltext; + insert record (ausgabe); + gedruckte zeilen INCR 1 + ELSE + read record (ausgabe, spaltenpuffer) + END IF; + spaltenpuffer verlaengern; + write record (ausgabe, spaltenpuffer) . + +spaltenpuffer verlaengern : + INT CONST ziellaenge := musterzeilenbreite * gedruckte spalten; + WHILE length (spaltenpuffer) < ziellaenge REP + spaltenpuffer CAT blank + END REP; + spaltenpuffer CAT zeile . + +END PROC zeile drucken; + +PROC druckrichtung (INT CONST r) : + + richtung := r; + direkt ausdrucken := (r = 0) + +END PROC druckrichtung; + +INT PROC druckrichtung : + + richtung + +END PROC druckrichtung; + +PROC direkt drucken (BOOL CONST modus) : + + direkt ausdrucken := modus; + IF modus THEN + richtung := 0 + ELIF richtung = 0 THEN + richtung := 1 + END IF + +END PROC direkt drucken; + +BOOL PROC direkt drucken : + + direkt ausdrucken + +END PROC direkt drucken; + +PROC druckdatei (TEXT CONST dateiname) : + + druckdateiname := dateiname; + externer dateiname := TRUE + +END PROC druckdatei; + +TEXT PROC druckdatei : + + druckdateiname + +END PROC druckdatei; + +PROC max druckzeilen (INT CONST zeilen) : + + max zeilen := zeilen + +END PROC max druckzeilen; + +PROC gruppentest (INT CONST gruppennr, TEXT CONST merkmal) : + + IF merkmal <> gruppen (gruppennr). inhalt THEN + gruppen (gruppennr). inhalt := merkmal; + gruppen (gruppennr). wechsel := TRUE; + wechsel erfolgt := TRUE + ELSE + gruppen (gruppennr). wechsel := FALSE + END IF + +END PROC gruppentest; + +BOOL PROC gruppenwechsel (INT CONST gruppennr) : + + IF gruppennr > 0 THEN + gruppen (gruppennr). wechsel + ELSE + wechsel 0 + END IF + +END PROC gruppenwechsel; + +TEXT PROC lfd nr : + + text (satzzaehler) + +END PROC lfd nr; + +(* +PROC dump : + + FILE VAR d := sequential file (output, "EUDAS-DUMP"); + put (d, "anzahl muster :"); put (d, anzahl muster); line (d); + INT VAR i; + FOR i FROM 1 UPTO anzahl muster REP + put (d, musterindex (i)); + END REP; + line (d); + put (d, "anzahl abkuerzungen :"); put (d, anzahl abkuerzungen); + line (d); + FOR i FROM 1 UPTO anzahl abkuerzungen REP + TEXT VAR p; feld lesen (abkuerzungen, i, p); + write (d, """"); write (d, p); write (d, """ "); + put (d, abkuerzungsindex ISUB i) + END REP; + line (d); + FOR i FROM 1 UPTO 3 REP + put (d, abschnitte (i). proc name); put (d, abschnitte (i). erste zeile); + put (d, abschnitte (i). erstes muster); line (d) + END REP; + edit ("EUDAS-DUMP"); + forget ("EUDAS-DUMP") + +END PROC dump; *) + +END PACKET eudas drucken; + diff --git a/app/eudas/5.3/src/eudas.fenster.06 b/app/eudas/5.3/src/eudas.fenster.06 new file mode 100644 index 0000000..cb9578b --- /dev/null +++ b/app/eudas/5.3/src/eudas.fenster.06 @@ -0,0 +1,253 @@ +PACKET fenster + +(*************************************************************************) +(* *) +(* Bildschirmaufteilung in Fenster *) +(* *) +(* Version 06 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 15.01.88 *) +(* *) +(*************************************************************************) + + DEFINES + + FENSTER, + fenster initialisieren, + fenstergroesse setzen, + fenstergroesse, + fenster veraendert, + fensterzugriff, + bildschirm neu : + + +TYPE FENSTER = STRUCT (INT koordinaten, version); + +LET + maxfenster = 16, + BITVEKTOR = INT, + GROESSE = STRUCT (INT x anf, y anf, x laenge, y laenge); + +ROW maxfenster STRUCT (INT referenzen, aktuelle version, + BITVEKTOR ueberschneidungen, + GROESSE groesse) + VAR fenstergroessen; + +INT VAR naechste version := 1; + +BITVEKTOR VAR veraenderungen; + +INT VAR i; +FOR i FROM 2 UPTO maxfenster REP + fenstergroessen (i). referenzen := 0 +END REP; +fenstergroessen (1). referenzen := 1; +fenstergroessen (1). aktuelle version := 0; +fenstergroessen (1). ueberschneidungen := 0; +fenstergroessen (1). groesse := GROESSE : (1, 1, 79, 24); + + +(************************* fenster anfordern *****************************) + +PROC fenster initialisieren (FENSTER VAR f) : + + f. koordinaten := 1; + fenstergroessen (1). referenzen INCR 1; + neue version (f. version) + +END PROC fenster initialisieren; + +PROC neue version (INT VAR version) : + + version := naechste version; + naechste version INCR 1; + IF naechste version >= 32000 THEN naechste version := -32000 END IF + +END PROC neue version; + +PROC fenstergroesse setzen (FENSTER VAR links, FENSTER CONST rechts) : + + neue version (links. version); + fenstergroessen (links. koordinaten). referenzen DECR 1; + links. koordinaten := rechts. koordinaten; + fenstergroessen (rechts. koordinaten). referenzen INCR 1 + +END PROC fenstergroesse setzen; + +PROC fenstergroesse setzen (FENSTER VAR f, + INT CONST x anf, y anf, x laenge, y laenge) : + + INT VAR stelle; + passendes fenster suchen; + IF stelle > maxfenster THEN + freie stelle suchen; + neue koordinaten initialisieren; + ueberschneidungen bestimmen + END IF; + auf referenz setzen . + +passendes fenster suchen : + stelle := 1; + WHILE stelle <= maxfenster REP + IF groesse passt THEN + LEAVE passendes fenster suchen + END IF; + stelle INCR 1 + END REP . + +groesse passt : + g. x anf = x anf AND g. y anf = y anf AND g. x laenge = x laenge AND + g. y laenge = y laenge . + +g : + fenstergroessen (stelle). groesse . + +freie stelle suchen : + stelle := 1; + WHILE stelle <= maxfenster REP + IF fenstergroessen (stelle). referenzen = 0 THEN + LEAVE freie stelle suchen + END IF; + stelle INCR 1 + END REP; + errorstop ("zu viele Fenstergroessen"); + LEAVE fenstergroesse setzen . + +neue koordinaten initialisieren : + fenstergroessen (stelle). referenzen := 0; + fenstergroessen (stelle). aktuelle version := 0; + fenstergroessen (stelle). groesse := + GROESSE : (x anf, y anf, x laenge, y laenge); + fenstergroessen (stelle). ueberschneidungen := 0 . + +ueberschneidungen bestimmen : + INT VAR vergleich; + FOR vergleich FROM 1 UPTO maxfenster REP + IF fenstergroessen (vergleich). referenzen > 0 THEN + vergleiche auf ueberschneidung + END IF + END REP . + +vergleiche auf ueberschneidung : + IF ueberschneidung (neues fenster, vergleichsfenster) THEN + set bit (fenstergroessen (stelle). ueberschneidungen, vergleich); + set bit (fenstergroessen (vergleich). ueberschneidungen, stelle) + ELSE + reset bit (fenstergroessen (vergleich). ueberschneidungen, stelle) + END IF . + +neues fenster : + fenstergroessen (stelle). groesse . + +vergleichsfenster : + fenstergroessen (vergleich). groesse . + +auf referenz setzen : + fenstergroessen (f. koordinaten). referenzen DECR 1; + f. koordinaten := stelle; + fenstergroessen (stelle). referenzen INCR 1 . + +END PROC fenstergroesse setzen; + +BOOL PROC ueberschneidung (GROESSE CONST a, b) : + + ueberschneidung in x richtung AND ueberschneidung in y richtung . + +ueberschneidung in x richtung : + IF a. x anf <= b. x anf THEN + b. x anf < a. x anf + a. x laenge + ELSE + a. x anf < b. x anf + b. x laenge + END IF . + +ueberschneidung in y richtung : + IF a. y anf <= b. y anf THEN + b. y anf < a. y anf + a. y laenge + ELSE + a. y anf < b. y anf + b. y laenge + END IF . + +END PROC ueberschneidung; + +PROC fenstergroesse (FENSTER CONST f, + INT VAR x anf, y anf, x laenge, y laenge) : + + x anf := g. x anf; + y anf := g. y anf; + x laenge := g. x laenge; + y laenge := g. y laenge . + +g : + fenstergroessen (f. koordinaten). groesse . + +END PROC fenstergroesse; + + +(************************** fenster veraendert ***************************) + +PROC fenster veraendert (FENSTER CONST f) : + + fenstergroessen (f. koordinaten). aktuelle version := 0; + veraenderungen := veraenderungen OR meine ueberschneidungen . + +meine ueberschneidungen : + fenstergroessen (f. koordinaten). ueberschneidungen . + +END PROC fenster veraendert; + + +(************************** fensterzugriff *******************************) + +PROC fensterzugriff (FENSTER CONST f, BOOL VAR veraendert) : + + veraendert := bit (veraenderungen, f. koordinaten); + IF fenstergroessen (f. koordinaten). aktuelle version <> f. version THEN + fenstergroessen (f. koordinaten). aktuelle version := f. version; + veraendert := TRUE + END IF; + veraenderungen := veraenderungen OR meine ueberschneidungen; + reset bit (veraenderungen, f. koordinaten) . + +meine ueberschneidungen : + fenstergroessen (f. koordinaten). ueberschneidungen . + +END PROC fensterzugriff; + + +(************************ bildschirm neu *********************************) + +PROC bildschirm neu : + + veraenderungen := - 1 + +END PROC bildschirm neu; + + +(**************************** BITVEKTOR **********************************) + +(* Erforderlich, da 'reset bit' im EUMEL nicht richtig funktionierte. *) + +ROW 16 INT VAR bitwert := ROW 16 INT : + (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1); + +PROC set bit (BITVEKTOR VAR vektor, INT CONST stelle) : + + vektor := vektor OR bitwert (stelle) + +END PROC set bit; + +PROC reset bit (BITVEKTOR VAR vektor, INT CONST stelle) : + + vektor := vektor AND (-1 - bitwert (stelle)) + +END PROC reset bit; + +BOOL PROC bit (BITVEKTOR CONST vektor, INT CONST stelle) : + + (vektor AND bitwert (stelle)) <> 0 + +END PROC bit; + +END PACKET fenster; + diff --git a/app/eudas/5.3/src/eudas.generator b/app/eudas/5.3/src/eudas.generator new file mode 100644 index 0000000..ebafebc --- /dev/null +++ b/app/eudas/5.3/src/eudas.generator @@ -0,0 +1,105 @@ +INT VAR size, used; +BOOL VAR einzeln, sparen, box, l3; +TASK VAR ar; +IF (pcb (9) AND 255) = 1 THEN + errorstop ("Nicht für Single-User-Systeme geeignet") +END IF; +storage (size, used); +einzeln := size - used < 500; +soehne loeschen; +forget ("eudas.generator", quiet); +page; +putline ("EUDAS - automatische Generierung"); +putline ("Version 5.3 vom 06.02.89"); +line; +sparen := no ("Ausfuehrliche Hilfstexte installieren"); +box := yes ("Mit IBM Grafikzeichen"); +l3 := maxint DIV 2 > 17000; +IF l3 THEN ar := /"EUMEL" ELSE ar := archive END IF; +line; +disable stop; +do ("TEXT VARt:=additionalcommands"); +IF is error THEN + clear error; + enable stop; + gen ("dummy.text") +END IF; +enable stop; +IF id (0) < 175 THEN + gen ("pos.173") +END IF; +IF l3 THEN + gen ("isub.replace") +END IF; +IF NOT einzeln THEN + holen ("menues.1"); + holen ("eudas.1"); + holen ("eudas.2"); + holen ("eudas.3"); + holen ("eudas.4"); + holen ("eudas.init.14"); + IF box THEN holen ("boxzeichen") END IF; + release (ar) +END IF; +check off; +gen ("menues.1"); +IF box THEN gen ("boxzeichen") END IF; +gen ("eudas.1"); +gen ("eudas.2"); +gen ("eudas.3"); +gen ("eudas.4"); +IF anything noted THEN + push (""27"q"); note edit; pause (100) +END IF; +holen ("eudas.init.14"); +IF einzeln THEN + release (ar) +END IF; +IF sparen THEN do ("menue loeschen (TRUE)") END IF; +reorg ("eudas.init.14"); +do ("menuedaten einlesen (""eudas.init.14"")"); +forget ("eudas.init.14", quiet); +check on; +do ("global manager"); + +PROC reorg (TEXT CONST dateiname) : + IF l3 CAND type (old (dateiname)) = 1003 THEN + reorganize (dateiname) + END IF +END PROC reorg; + +PROC vom archiv (TEXT CONST datei): + out (""""); out (datei); putline (""" wird geholt."); + fetch (datei, ar) +END PROC vom archiv; + +PROC holen (TEXT CONST datei) : + IF NOT exists (datei) THEN vom archiv (datei) END IF +END PROC holen; + +PROC gen (TEXT CONST datei) : + holen (datei); + cursor (1, 7); out (""4""); + out (""""); out (datei); out (""" wird uebersetzt: "); + reorg (datei); + insert (datei); + forget (datei, quiet) +END PROC gen; + +PROC soehne loeschen : + + command dialogue (TRUE); + access catalogue; + TASK VAR sohn := son (myself); + WHILE NOT is niltask (sohn) REP + TASK CONST naechster := brother (sohn); + IF yes ("Sohntask """ + name (sohn) + """ loeschen") THEN + end (sohn) + ELIF yes ("Generierung abbrechen") THEN + errorstop ("") + END IF; + sohn := naechster + END REP + +END PROC soehne loeschen; + diff --git a/app/eudas/5.3/src/eudas.init.14 b/app/eudas/5.3/src/eudas.init.14 new file mode 100644 index 0000000..69ac8c7 --- /dev/null +++ b/app/eudas/5.3/src/eudas.init.14 @@ -0,0 +1,1625 @@ +% MENUE "EUDAS.Öffnen" +% BILD +EUDAS-Datei +  Öffnen +  Anketten +  Koppeln +- +Arbeitskopie +  Sichern +- +Aktuelle Datei +  Notizen +  Feldstrukt. +  Prüfbeding. +- +Mehrbenutzer +  Manager +% FELD 1 "EUDAS/1O" "oOöÖ" +% FELD 2 "EUDAS/1E" "aA" +% FELD 3 "EUDAS/1K" "kK" +% FELD 4 "EUDAS/1S" "sS" +% FELD 5 "EUDAS/1N" "nN" +% FELD 6 "EUDAS/1F" "fF" +% FELD 7 "EUDAS/1P" "pP" +% FELD 8 "EUDAS/1M" "mM" +% ENDE +% MENUE "EUDAS.Einzelsatz" +% BILD +Positionieren +  Weiter +  Zurück +  Nr. Direkt +  Inh. Direkt +- +Suchbedingung +  Setzen +  Löschen +  Markierung +- +Datensatz +  Einfügen +  Ändern +  Tragen +  Holen +- +  Feldauswahl +% FELD 1 "EUDAS/2W" "wW" +% FELD 2 "EUDAS/2Z" "zZ" +% FELD 3 "EUDAS/2N" "nN" +% FELD 4 "EUDAS/2I" "iI" +% FELD 5 "EUDAS/2S" "sS" +% FELD 6 "EUDAS/2L" "lL" +% FELD 7 "EUDAS/2M" "mM" +% FELD 8 "EUDAS/2E" "eE" +% FELD 9 "EUDAS/2A" "aAäÄ" +% FELD 10 "EUDAS/2T" "tT" +% FELD 11 "EUDAS/2H" "hH" +% FELD 12 "EUDAS/2F" "fF" +% FELD 13 "" ""3"" +% FELD 14 "" ""10"" +% FELD 15 "" "1" +% FELD 16 "" "9" +% FELD 17 "" "K" +% ENDE +% MENUE "EUDAS.Gesamtdatei" +% BILD +Satzauswahl +  Kopieren +  Tragen +  Verändern +  Übersicht +- +Aktuelle Datei +  Sortieren +- +Alle Markier. +  Löschen +% FELD 1 "EUDAS/3K" "kK" +% FELD 2 "EUDAS/3T" "tT" +% FELD 3 "EUDAS/3V" "vV" +% FELD 4 "EUDAS/3U" "uUüÜ" +% FELD 5 "EUDAS/3S" "sS" +% FELD 6 "EUDAS/3L" "lL" +% ENDE +% MENUE "EUDAS.Drucken" +% BILD +Druckausgabe +  Generieren +  Std.-Listen +  Richtung +- +Textdatei +  Editieren +  Drucken +  Nachbearb. +% FELD 1 "EUDAS/4D" "gG" +% FELD 2 "EUDAS/4S" "sS" +% FELD 3 "EUDAS/4R" "rR" +% FELD 4 "EUDAS/4E" "eE" +% FELD 5 "EUDAS/4A" "dD" +% FELD 6 "EUDAS/4N" "nN" +% ENDE +% MENUE "EUDAS.Dateien" +% BILD +Dieser Bereich +  Übersicht +- +Datei +  Löschen +  Namen änd. +  Kopieren +  Platzbedarf +  Aufräumen +% FELD 1 "EUDAS/5U" "UuüÜ" +% FELD 2 "EUDAS/5L" "Ll" +% FELD 3 "EUDAS/5N" "Nn" +% FELD 4 "EUDAS/5K" "Kk" +% FELD 5 "EUDAS/5P" "Pp" +% FELD 6 "EUDAS/5A" "Aa" +% ENDE +% MENUE "EUDAS.Archiv" +% BILD +Dateien Archiv +  Übersicht +  Drucke Übs. +- +Datei +  Kopieren + vom Archiv +  Schreiben + auf Archiv +  Löschen + auf Archiv +- +Archivdiskette +  Init +- +  Zielarchiv +  Passwort +  Reservieren +% FELD 1 "EUDAS/6U" "UuÜü" +% FELD 2 "EUDAS/6D" "Dd" +% FELD 3 "EUDAS/6K" "Kk" +% FELD 4 "EUDAS/6S" "Ss" +% FELD 5 "EUDAS/6L" "Ll" +% FELD 6 "EUDAS/6I" "Ii" +% FELD 7 "EUDAS/6Z" "Zz" +% FELD 8 "EUDAS/6P" "Pp" +% FELD 9 "EUDAS/6R" "Rr" +% ENDE +% MENUE "WAHL.Ja" +% BILD + Ja   +Nein  +% FELD 1 "" "jJ" +% FELD 2 "" "nN" +% ENDE +% MENUE "WAHL.Typen" +% BILD +TEXT   +NDIN   +ZAHL   +DATUM  +% FELD 1 "" "tT" +% FELD 2 "" "nN" +% FELD 3 "" "zZ" +% FELD 4 "" "dD" +% ENDE +% MENUE "WAHL.Sichern" +% BILD +Statt alter Version  +Ignorieren  +Unter neuem Namen  +% FELD 1 "" "sS" +% FELD 2 "" "iI" +% FELD 3 "" "uU" +% ENDE +% MENUE "WAHL.Ziel" +% BILD +Standard  +Dateimanager  +And.Laufwerk  +Fremdformate  +% FELD 1 "" "sS" +% FELD 2 "" "dD" +% FELD 3 "" "aA" +% FELD 4 "" "fF" +% ENDE +% MENUE "WAHL.Format" +% BILD +Standard  +360 KB  +720 KB  +1,2 MB  +% FELD 1 "" "sS" +% FELD 2 "" "3" +% FELD 3 "" "7" +% FELD 4 "" "1" +% ENDE +% MENUE "WAHL.Richtung" +% BILD +Drucker  +Bildschirm  +Textdatei  +% FELD 1 "" "dD" +% FELD 2 "" "bB" +% FELD 3 "" "tT" +% ENDE +% MENUE "WAHL.Std-Listen" +% BILD +Spaltenliste  +Kommaliste  +% FELD 1 "" "kK" +% FELD 2 "" "sS" +% ENDE +% AUSWAHL "EUDAS-Felder" + Bitte die Felder, die geändert werden sollen, ankreuzen: +% ENDE +% AUSWAHL "EUDAS-Sortierfelder" + Bitte die Felder, nach denen sortiert werden soll, + in Reihenfolge ankreuzen: +% ENDE +% AUSWAHL "EUDAS-Anzeigefelder" + Bitte die Felder, die angezeigt werden sollen, + in Reihenfolge ankreuzen: +% ENDE +% AUSWAHL "EUDAS-Editfelder" + Bitte die Felder ankreuzen, die in die Datei übernommen + werden sollen: +% ENDE +% AUSWAHL "EUDAS-Druckfelder" + Bitte die Felder ankreuzen, deren Inhalte gedruckt + werden sollen: +% ENDE +% AUSWAHL "EUDAS-Archivauswahl" + Auswahl der Dateien auf dem Archiv. + Gewünschte Datei(en) bitte ankreuzen: +% ENDE +% AUSWAHL "EUDAS-Dateiauswahl" + Auswahl der vorhandenen Dateien. + Gewünschte Datei(en) bitte ankreuzen: +% ENDE +% HILFE "EUDAS/Allgemein" +% SEITE 1 +MENÜBEDIENUNG: +- +Das Menü dient zur Auswahl von Funktionen. Die Funktionen sind +durch einen vorangestellten Buchstaben gekennzeichnet. Mit den +Pfeiltasten können Sie die Markierung zu einer beliebigen +Position auf und ab bewegen. Diese Funktion können Sie dann +durch Drücken der Leertaste ausführen. Durch ESC '?' +(nacheinander gedrückt) erhalten Sie Informationen zur gerade +markierten Funktion. +Funktionen, die im momentanen Zustand nicht ausgeführt werden +können, sind durch ein Minuszeichen gekennzeichnet. +In der obersten Bildschirmzeile sind weitere Menüs aufgeführt, +die Sie aufrufen können. Das aktuelle Menü ist invers +markiert. Ein anderes Menü wählen Sie durch Drücken der +Pfeiltasten RECHTS oder LINKS. Wollen Sie das Programm wieder +verlassen, drücken Sie die ESC-Taste und 'q' hintereinander. +% ENDE +% HILFE "EUDAS/1O" +% SEITE 1 +Öffnen zum Bearbeiten: +- +Diese Funktion öffnet eine EUDAS-Datei zur anschließenden +Bearbeitung. Sie können angeben, ob Sie die Datei nur ansehen +oder auch ändern wollen. Die vorher geöffnete Datei wird ggf. +gesichert. Wenn Sie eine neue Datei angeben, wird diese +eingerichtet. Dabei müssen Sie die Feldnamen eingeben. + +=> Hinweise zur Menübedienung auf der zweiten Seite (ESC 'w') +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1E" +% SEITE 1 +EUDAS-Datei ketten: +- +Mit dieser Funktion können Sie eine EUDAS-Datei logisch an die +bereits geöffnete Datei anketten. Dazu müssen jedoch die +beiden Dateien in ihrer Feldstruktur übereinstimmen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1N" +% SEITE 1 +Notizen ansehen/ändern: +- +Mit dieser Funktion können Sie der aktuell geöffneten Datei +Notizen zuordnen bzw. sich die vorherigen Notizen ansehen. +Dazu wird der normale Editor verwendet. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1M" +% SEITE 1 +Manager (Mehrbenutzerbetrieb): +- +Mit dieser Funktion können Sie die Task festlegen, aus der +beim Öffnen automatisch EUDAS-Dateien geholt werden können. +Dadurch können mehrere Benutzer auf die gleiche Datei +zugreifen, jedoch immer nur einer ändern. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1F" +% SEITE 1 +Feldstruktur ändern: +- +Mit dieser Funktion können Sie + +1. neue Feldnamen anfügen + Sie können neue Feldnamen der Datei am Ende anfügen. Sie + müssen die Namen untereinander im Editor in der gewünschten + Reihenfolge angeben. Vorher werden Sie jedoch gefragt, ob + Sie diese Funktion überhaupt ausführen wollen. + +2. Feldnamen und Feldtypen ändern + In diesem Teil wird Ihnen eine Auswahl aller vorhandenen + Felder angeboten, in der jeweils auch der Typ angegeben + ist. Wenn Sie diese Funktion nicht ausführen wollen, + beenden Sie die Auswahl einfach mit ESC q. Sonst wählen Sie + die Felder aus, deren Namen oder Typ Sie ändern wollen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1P" +% SEITE 1 +Prüfbedingungen: +- +Bei dieser Funktion können Sie im Editor ein Prüfprogramm +eingeben, das mit der Datei gespeichert wird und beim +Reintragen neuer Sätze ausgeführt wird. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1K" +% SEITE 1 +EUDAS-Datei koppeln: +- +Mit dieser Funktion können Sie eine Datei angeben, die zu den +bisher geöffneten Dateien dazugekoppelt wird. Anschließend +werden zu jedem Satz der existierenden Datei die in den +Koppelfeldern übereinstimmenden Sätze der Koppeldatei gezeigt. +Als Koppelfelder werden dabei die ersten Felder der +Koppeldatei betrachtet, die auch in der geöffneten Datei +vorhanden sind. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3S" +% SEITE 1 +Aktuelle Datei sortieren: +- +Mit dieser Funktion kann die aktuell geöffnete EUDAS-Datei +sortiert werden. Die Reihenfolge, in der die Felder +berücksichtigt werden, kann vorher angegeben werden. Eventuell +müssen zum richtigen Sortieren Feldtypen vergeben werden (s. +"Feldstrukt."). +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1S" +% SEITE 1 +Aktuelle Dateien sichern: +- +EUDAS arbeitet bei Änderungen immer auf Sicherheitskopien der +Dateien. Wenn Ändern erlaubt ist, müssen geänderte +Arbeitskopien mit dieser Funktion gesichert werden. Für eine +veränderte Datei kann dabei auch ein neuer Name angegeben +werden, damit die alte Version erhalten bleibt. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2W" +% SEITE 1 +Satz weiter: +- +Diese Funktion geht zum nächsten Satz und zeigt ihn an. Wenn +eine Suchbedingung eingestellt ist, werden nicht ausgewählte +Sätze übersprungen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2Z" +% SEITE 1 +Satz zurück: +- +Diese Funktion geht zum vorigen Satz. Wenn eine Suchbedingung +eingestellt ist, werden nicht ausgewählte Sätze übersprungen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2S" +% SEITE 1 +Suchbedingung setzen: +- +Mit dieser Funktion kann eine Suchbedingung als Suchmuster +eingegeben werden, die angibt, welche Sätze bearbeitet werden +sollen. Die vorher eingestellte Suchbedingung wird automatisch +gelöscht. Die Bedingungen für die einzelnen Felder können im +Editor eingegeben werden. + +mögliche Bedingungen: + Text identisch mit Text.. größergleich + *Text endet mit ..Text kleiner + Text* beginnt mit Text..Text zwischen + *Text* enthält * nicht leer + + --Bed Verneinung + +Kombination von Bedingungen: + Bedingungen für verschiedene Felder: + UND + Komma zwischen Bedingungen: + lokales ODER (Prio höher als UND) + Semikolon zwischen Bedingungen: + globales ODER (Prio niedriger als UND) +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2L" +% SEITE 1 +Suchbedingung löschen: +- +Mit dieser Funktion kann eine eingestellte Suchbedingung +wieder gelöscht werden, so daß wieder alle Sätze sichtbar +sind. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2N" +% SEITE 1 +auf Satz Nr.: +- +Mit dieser Funktion kann ein bestimmter Satz direkt angewählt +werden. Dazu müssen Sie lediglich dessen Satznummer angeben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2I" +% SEITE 1 +Nach Inhalt direkt positionieren +- +Mit dieser Funktion kann auf einen bestimmten Satz nach dem +Inhalt seines ersten Feldes (Schlüsselfeld) positioniert +werden. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2E" +% SEITE 1 +neuen Satz einfügen: +- +Mit dieser Funktion wird vor dem aktuellen Satz ein neuer Satz +eingefügt. Die Inhalte dieses zunächst leeren Satzes können +Sie mit Hilfe des Editors neben die einzelnen Feldnamen +schreiben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2A" +% SEITE 1 +Satz ändern: +- +Mit dieser Funktion können Sie die Inhalte des aktuellen +Satzes verändern. Am Bildschirm können Sie die Daten mit Hilfe +des Editors ändern, löschen und Neues hinzufügen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2M" +% SEITE 1 +Markierung ein/aus: +- +Mit dieser Funktion können Sie einen Satz markieren, damit +später nur die markierten Sätze bearbeitet werden. Ist der +Satz schon markiert, wird die Markierung wieder gelöscht. Wenn +mindestens ein Satz markiert ist, erscheint die +Markierungsinformation in der Überschrift. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3L" +% SEITE 1 +Alle Markierungen loeschen: +- +Mit dieser Funktion werden alle Markierungen in der Datei +gelöscht. Die Markierungsinformation wird nicht mehr +angezeigt. Die Markierungen werden auch beim neuen Öffnen +gelöscht, da sie nicht permanent in der Datei gespeichert +sind. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2T" +% SEITE 1 +Einzelsatz tragen: +- +Mit dieser Funktion kann der aktuelle Satz in eine andere +Datei transportiert werden. Anschließend wird er gelöscht. Der +Satz wird am Ende der Zieldatei angefügt, wobei diese +gegebenenfalls eingerichtet wird. Den Namen der Zieldatei +können Sie eingeben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2H" +% SEITE 1 +Einzelsatz holen: +- +Diese Funktion holt den letzten Satz einer anderen Datei und +fügt ihn vor dem aktuellen Satz ein. Damit wird das letzte +'Tragen' wieder rückgängig gemacht. Die Dateien müssen gleiche +Felderzahl haben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3U" +% SEITE 1 +Übersicht: +- +Mit dieser Funktion können Sie sich eine Übersicht über +mehrere Sätze verschaffen. Es werden vom aktuellen Satz an +alle durch die Suchbedingung spezifizierten Sätze angezeigt, +jeder Satz in einer Zeile. In dieser Übersicht können Sie +blättern und auch bestimmte Sätze zur späteren Bearbeitung +markieren. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2F" +% SEITE 1 +Auswahl Felder: +- +Mit dieser Funktion kann gewählt werden, welche Felder in +welcher Reihenfolge angezeigt werden sollen. Alle Felder +werden zum Ankreuzen angeboten. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4D" +% SEITE 1 +Drucken nach Muster: +- +Mit dieser Funktion können die Inhalte der Datei nach einem +Druckmuster ausgedruckt werden. Das Druckmuster ist eine +Textdatei und muß vorher erstellt werden. Es gibt die Form des +Ausdrucks an. Über den Aufbau eines Druckmusters lesen Sie am +besten das Benutzerhandbuch. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3T" +% SEITE 1 +Satzauswahl tragen +- +Diese Funktion trägt alle durch die Suchbedingung oder durch +Markierung ausgewählten Sätze in eine andere Datei und löscht +sie danach. Die Zieldatei muß gleiche Felderzahl haben, damit +keine Information verlorengeht. Beim Tragen können auch die +Prüfbedingungen der Zieldatei geprüft werden, wenn Sie die +entsprechende Frage bejahen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4S" +% SEITE 1 +Standard-Listen +- +Mit dieser Funktion können Standard-Listen einer Datei +erzeugt werden, ohne ein Druckmuster zu schreiben. Es stehen +ein Format mit Kommata als Trennzeichen sowie ein +Spaltenformat zur Auswahl. Ansonsten gelten alle Optionen +des normalen Generierens von Ausgaben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4E" +% SEITE 1 +Textdatei erstellen/aendern: +- +Mit dieser Funktion kann eine Textdatei erstellt, geändert +oder angesehen werden. Es wird der normale Editor verwendet. +Mit dieser Funktion werden auch Druckmuster bearbeitet. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3K" +% SEITE 1 +Satzauswahl kopieren: +- +Diese Funktion kopiert alle durch die Suchbedingung oder durch +Markierung ausgewählten Sätze in eine andere Datei. Welche +Felder in welcher Reihenfolge kopiert werden sollen, wird +durch ein Kopiermuster bestimmt, das nach der Struktur der +Zieldatei bestimmt wird und dann von Ihnen noch geändert +werden kann. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4R" +% SEITE 1 +Richtung Ausgabe: +- +Mit dieser Funktion können Sie festlegen, ob die Ausgabe des +Druckvorgangs direkt anschließend ausgedruckt werden soll, +oder in eine Datei gespeichert wird. Sie können den Namen +dieser Datei eingeben, anderenfalls wählt sich EUDAS selbst +einen Namen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4A" +% SEITE 1 +Textdatei ausdrucken: +- +Mit dieser Funktion wird eine Textdatei direkt ausgedruckt. +Die Datei kann Anweisungen zur Druckersteuerung enthalten, die +Sie dem EUMEL-Benutzerhandbuch entnehmen können. Sie können +hiermit Ausgabedateien des Druckprozesses und das Druckmuster +selbst ausdrucken. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3V" +% SEITE 1 +Ändern nach Vorschrift: +- +Diese Funktion ermöglicht es, alle durch die Suchbedingung +oder durch Markierung ausgewählten Sätze nach einer Vorschrift +automatisch zu ändern. Die Art der Änderungen wird dabei durch +ein Verarbeitungsmuster festgelegt, das vorher als Textdatei +erstellt werden muß. Über die Form des Verarbeitungsmusters s. +Benutzerhandbuch. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4N" +% SEITE 1 +Textdatei nachbearbeiten: +- +Mit dieser Funktion können Sie eine Datei zeilenweise und +seitenweise formatieren (lineform/pageform). Dies dient an +dieser Stelle zur Bearbeitung von Druckdateien, die +verschiedene oder Proportionalschriften enthalten. Sie werden +jeweils für jede der beiden Funktionen gefragt, ob Sie sie +ausführen wollen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6S" +% SEITE 1 +Schreiben auf Archiv: +- +Diese Funktion schreibt eine oder mehrere Dateien auf das +Archiv. Der Archivname muß vorher eingegeben werden. Dann kann +entweder der Name der gewünschten Datei eingegeben werden oder +mit ESC 'z' eine Auswahl von Dateien angekreuzt werden. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5A" +% SEITE 1 +Datei aufräumen: +- +Diese Funktion reorganisiert eine Datei, an der viel geändert +wurde, zur Platz- und Zeitersparnis. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5K" +% SEITE 1 +Datei kopieren: +- +Mit dieser Funktion kann eine beliebige Datei logisch kopiert +werden. Die Kopie ist identisch mit dem Original und belegt +den gleichen Platz, erst bei Änderungen werden +unterschiedliche Daten gespeichert. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5P" +% SEITE 1 +Platzbedarf Datei: +- +Diese Funktion gibt an, wieviel Platz eine Datei im System +belegt. Dieser Platz kann aber mit anderen Dateien geteilt +sein. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6D" +% SEITE 1 +Archivübersicht drucken: +- +Diese Funktion druckt die Übersicht der Archivdateien aus. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6I" +% SEITE 1 +Archiv initialisieren: +- +Diese Funktion initialisiert einen Archivträger vor dem +Beschreiben. Sämtliche Daten werden gelöscht. Auf Wunsch kann +der Datenträger auch formatiert werden (falls vom System +unterstützt). +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6Z" +% SEITE 1 +Zielarchiv einstellen: +- +Mit dieser Funktion kann eine Managertask angegeben werden, +auf die die Archivfunktionen angewendet werden. Dies dient +sowohl zur Ansteuerung von mehreren Archiven (z.B. über Netz) +als auch zur Kommunikation mit anderen Managern. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6P" +% SEITE 1 +Passwort: +- +Mit dieser Funktion können Sie das Passwort einstellen, das +beim Versenden von Dateien an andere Tasks verwendet wird. +Beim Schreiben einer Datei wird das Passwort der Datei +mitgegeben und beim Lesen wird überprüft, ob das Passwort +übereinstimmt. Das Passwort kann in der Form +Schreibpasswort/Lesepasswort angegeben werden. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6R" +% SEITE 1 +Reservieren: +- +Mit dieser Funktion können Sie einen Kanalmanager (z.B. +DOS-Task) reservieren. Die Reservierung wird beim Verlassen +des Archivmenüs wieder aufgehoben. Den Parameter zur +Reservierung (Modus bei DOS-Task) können Sie angeben. Bei +normalen Archivtasks wird die Reservierung automatisch +vorgenommen, daher ist diese Funktion dann gesperrt. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6K" +% SEITE 1 +Kopieren vom Archiv: +- +Diese Funktion kopiert eine Datei vom Archiv ins System. Der +Archivname wird automatisch bestimmt. Sie können dann entweder +den gewünschten Dateinamen angeben oder mit ESC 'z' eine +Auswahl aller Dateien auf dem Archiv abrufen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5N" +% SEITE 1 +Datei Namen ändern: +- +Mit dieser Funktion können Sie für eine Datei auf dem System +einen neuen Namen vergeben. Wenn Sie den neuen Namen eingeben, +wird Ihnen der alte Name angeboten. Sie können ihn ändern oder +ganz überschreiben. Dadurch ersparen Sie sich bei kleinen +Änderungen das Neutippen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6L" +% SEITE 1 +Löschen auf Archiv: +- +Diese Funktion ermöglicht es, eine Datei auf dem Archiv zu +löschen. Der Platz dieser Datei wird jedoch nur dann +wiederverwendet, wenn keine Dateien mehr dahinter stehen. Der +Archivname muß eingegeben werden. Sie können bei der Eingabe +des Dateinamens mit ESC 'z' eine Dateiauswahl abrufen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5L" +% SEITE 1 +Datei löschen: +- +Diese Funktion löscht eine Datei auf dem System nach Anfrage. +Sie können den Dateinamen eingeben oder mit ESC 'z' eine +Auswahl aller vorhandenen Dateien abrufen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6U" +% SEITE 1 +Übersicht Archiv: +- +Diese Funktion liefert eine Übersicht der Dateien auf dem +Archiv. Verlassen Sie diese Übersicht mit ESC 'q'. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5U" +% SEITE 1 +Übersicht Dateien: +- +Diese Funktion liefert eine Übersicht über alle im System +vorhandenen Dateien. Verlassen Sie diese Übersicht mit ESC +'q'. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "AUSWAHL/Allgemein" +% SEITE 1 +AUSWAHL: +- +Mit Hilfe der Auswahl ist es möglich, aus einem Angebot einen +Teil auszuwählen. Die gewünschten Namen werden einfach in +beliebiger Reihenfolge angekreuzt und anschließend in dieser +Reihenfolge verwendet. +Die Schreibmarke (Cursor) gibt an, welcher Name gerade +angekreuzt werden kann. Mit den Pfeiltasten kann der Cursor +auf den Kreisen bewegt werden. '+' kreuzt einen Namen an, '-' +löscht die Ankreuzung wieder. +Mit ESC 'q' wird die Auswahl verlassen. ESC 'h' bricht die +Auswahl und die folgende Funktion ab. Falls das Angebot nicht +auf den Bildschirm paßt, wird es gerollt. ESC '1' positioniert +immer auf den Anfang und ESC '9' auf das Ende der Auswahl. Mit +HOP '+' werden alle noch nicht angekreuzten Namen angekreuzt, +mit HOP '-' werden alle Ankreuzungen gelöscht. +Der Balken an der rechten Seite gibt an, welcher Teil der +ganzen Auswahl sichtbar ist, wenn nicht alle Namen auf eine +Seite passen. +% ENDE +% HILFE "AUSWAHL/Felder" +% SEITE 1 +Feldauswahl: +- +Sie können hier alle Felder ankreuzen, die Sie ändern wollen. +Ändern können Sie den Feldnamen bzw. den Feldtyp. Wollen Sie +keine Felder ändern, drücken Sie einfach ESC 'q'. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Sortierfelder" +% SEITE 1 +Auswahl Sortierfelder: +- +Kreuzen Sie hier die Felder an, die bei der Sortierung +berücksichtigt werden sollen. Die Reihenfolge des Ankreuzens +ist wichtig. Beim Vergleich zweier Sätze wird erst das als +erstes angekreuzte Feld verglichen und danach die Einordnung +der Sätze bestimmt. Ist dieses Feld bei beiden gleich, wird +das nächste angekreuzte Feld untersucht usw. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Anzeigefelder" +% SEITE 1 +Auswahl Anzeigefelder: +- +Kreuzen Sie hier alle Felder an, die Sie angezeigt haben +möchten. Die Felder erscheinen in der angekreuzten +Reihenfolge. Für beide Arten der Anzeige können Sie eine +separate Feldauswahl einstellen. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Druckfelder" +% SEITE 1 +Auswahl Druckfelder: +- +Kreuzen Sie hier alle Felder an, die Sie im Ausdruck sehen +möchten. Die Reihenfolge des Ankreuzens bestimmt die +Reihenfolge beim Ausdruck. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Feldnamen" +% SEITE 1 +Auswahl Feldnamen: +- +Durch Blättern in der Auswahl können Sie die Schreibweise der +Feldnamen ansehen. Die Namen, die Sie ankreuzen, werden danach +mit spitzen Klammern in die gerade editierte Datei übernommen. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Archiv" +% SEITE 1 +Auswahl Archivdateien: +- +Diese Auswahl zeigt alle auf dem Archiv vorhandenen Dateien +an. Kreuzen Sie die Dateien an, die Sie bearbeiten möchten. +Die Dateien werden in der angekreuzten Reihenfolge verwendet. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Datei" +% SEITE 1 +Auswahl Dateien: +- +Diese Auswahl zeigt alle Dateien auf dem System, die Sie +verwenden können. Kreuzen Sie die gewünschte(n) Datei(en) an. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "FEHLER/Allgemein" +% SEITE 1 +FEHLERMELDUNGEN: +- +Fehlermeldungen werden von einem Programm abgesetzt, wenn es +seine Funktion nicht durchführen kann. Der Text der Meldung +identifiziert die Ursache des Problems. Zur Zeit liegen noch +keine meldungsspezifischen Informationen vor, schauen Sie ggf. +in das Benutzerhandbuch. +% ENDE +% HILFE "FEHLER/9" +% SEITE 1 +Programmfehler: +- +Diese Fehlermeldung deutet auf einen internen Programmfehler +(wenn Sie nicht selber ein Programm geschrieben haben). Melden +Sie diesen Fehler bitte, damit eine Korrektur vorgenommen +werden kann. Schreiben Sie sich dazu die Begleitumstände auf +(welche Datei haben Sie benutzt, welche Funktion). Versuchen +Sie gegebenenfalls, den Fehler zu wiederholen. Es ist nämlich +z.B. wichtig, ob der Fehler nur bei einer bestimmten Datei +auftritt oder ganz "zufällig". Wenn Sie vermuten, daß der +Fehler an einer bestimmten Datei liegt, sichern Sie diese +Datei bitte auf einer Diskette, um sie eventuell einschicken +zu können. +% ENDE +% HILFE "FEHLER/10" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "FEHLER/11" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "FEHLER/14" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "GET/Allgemein" +% SEITE 1 +EINGABE: +- +Die Eingabe erwartet von Ihnen eine bestimmte Information, die +Sie eingeben sollen. Die Art der Information wird durch den +Anforderungstext angegeben. Wenn Sie sich beim Eintippen +verschrieben haben, können Sie mit den Pfeiltasten zurückgehen +und den Text korrigieren. Eine bereits dastehende Information +können Sie überschreiben. RUBOUT löscht ein Zeichen, RUBIN +schaltet in den Einfügemodus (Zeichen werden nicht mehr +überschrieben). Beenden Sie die Eingabe mit RETURN. ESC 'h' +bricht die Eingabe und die folgende Funktion ab. Wenn in der +Statuszeile angegeben, können Sie mit ESC 'z' eine Auswahl +verfügbarer Namen abrufen, die Sie dann Ankreuzen können. +% ENDE +% HILFE "GET/Sicherungsname" +% SEITE 1 +Neuer Name für Arbeitskopie: +- +Sie können jetzt den Namen angeben, unter dem die Arbeitskopie +gespeichert werden soll. Ihnen wird der alte Name zum +Überschreiben angeboten. Drücken Sie nur RETURN, wird der alte +Name genommen und die alte Version überschrieben. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Dateiname" +% SEITE 1 +Dateiname: +- +Bitte geben Sie den Namen der Datei ein, mit dem die Operation +ausgeführt werden soll. Mit ESC 'z' können Sie sich die zur +Verfügung stehenden Namen auch als Auswahl zeigen lassen. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/feldname" +% SEITE 1 +Feldname: +- +Sie können den Namen des angegebenen Feldes ändern, indem Sie +den alten Namen überschreiben bzw. korrigieren. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/auf Satz" +% SEITE 1 +Satznummer: +- +Sie können hier die Satznummer des Satzes eingeben, den Sie +sehen wollen. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/auf Schluessel" +% SEITE 1 +Inhalt des Schlüsselfeldes: +- +Geben Sie hier den Inhalt des Schlüsselfeldes von dem Satz +an, den Sie suchen. Wenn Sie Suchbedingungen benötigen, +müssen Sie ein Suchmuster einstellen. Direse Funktion prüft +nur auf absolute Identität. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/listenbreite" +% SEITE 1 +Maximale Listenbreite: +- +Geben Sie hier die maximal Anzahl von Zeichen an, die zum +Ausdrucken zur Verfügung stehen. Werden mehr Zeichen für +einen Satz gebraucht, werden Inhalte abgeschnitten. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/copy" +% SEITE 1 +Dateiname für Kopie: +- +Geben Sie hier den Namen für die logische Kopie der Datei an. +Dieser Name darf keine existierende Datei bezeichnen. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Archivname" +% SEITE 1 +Name des Archivs: +- +Geben Sie den Namen des eingelegten Archivs ein (zur +Sicherheit). Der zuletzt verwendete Name wird zum Ändern +angeboten. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/rename" +% SEITE 1 +Neuer Dateiname: +- +Sie können den alten Namen der Datei durch Überschreiben und +Korrigieren ändern. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Druckdatei" +% SEITE 1 +Name der Druckdatei: +- +Geben Sie hier den Namen der Datei ein, in die die Ausgabe des +Druckprozesses geschrieben werden soll. Drücken Sie einfach +RETURN, wenn Sie keinen besonderen Namen wollen. EUDAS erzeugt +einen Namen der Form "druckmuster.a$n" mit 'n' zur +Unterscheidung mehrerer Ausgaben. +Die angegebene Datei wird nur für den nächsten Druckvorgang +verwendet. Sie müssen den Namen also jedes Mal wieder neu +angeben. Existiert die Datei schon, wird die Ausgabe an das +Ende angehängt. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Zielarchiv" +% SEITE 1 +Name Zielarchiv: +- +Geben Sie hier entweder den Namen einer Archivtask ein +(normalerweise "ARCHIVE") oder einer anderen Managertask. Bei +Netzbetrieb können Sie auch die Station anschließend angeben. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Zielstation" +% SEITE 1 +Zielstation: +- +Geben Sie hier die Stationsnummer der Zieltask ein. Wenn sich +die Zieltask in Ihrem eigenen System befindet, brauchen Sie +nur RETURN zu drücken. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/multi task" +% SEITE 1 +Name Managertask: +- +Sie können hier den Namen einer EUDAS-Managertask angeben +(EUDAS muß in dieser Task insertiert sein). Wenn Sie keinen +Namen angeben, werden keine entsprechenden Abfragen beim +Öffnen mehr gemacht. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/kopiermuster" +% SEITE 1 +Name Kopiermuster: +- +Geben Sie den Namen einer Datei ein, in der das Kopiermuster +stehen soll. Drücken Sie einfach RETURN, wenn Sie das Muster +nicht aufbewahren wollen. Wenn die Datei noch nicht existiert, +wird das Standard-Kopiermuster in die Datei geschrieben. +Anschließend kann das Muster noch im Editor geändert werden. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "JA/Allgemein" +% SEITE 1 +FRAGEN: +- +Das Programm stellt Ihnen eine Frage, die Sie bejahen oder +verneinen können. Sie bejahen die Frage, indem Sie 'j' drücken +und verneinen Sie mit 'n' (beides groß oder klein). Mit ESC +'h' können Sie die Funktion abbrechen. +% ENDE +% HILFE "JA/oeffne" +% SEITE 1 +Änderungen vornehmen? +- +Beantworten Sie die Frage mit 'n', wenn Sie die Datei nur +ansehen wollen. In diesem Fall wird keine Sicherheitskopie +erstellt. Verneinen Sie die Frage, wird eine interen Kopie +angelegt, die Sie dann verändern können. Die Kopie muß nach +dem Ändern gesichert werden. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Dateien loeschen" +% SEITE 1 +Arbeitskopien löschen? +- +Beim Sichern hatten Sie Gelegenheit, alle veränderten +Arbeitskopien zu sichern. Die Arbeitskopien können damit +gelöscht werden. Dazu bejahen Sie die Frage. Wenn die Dateien +jedoch noch geöffnet bleiben sollen, oder Sie eine Datei aus +Versehen nicht gesichert haben, müssen Sie diese Frage +verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/ueber" +% SEITE 1 +Datei überschreiben? +- +Sie haben für die Arbeitskopie einen Namen angegeben, der noch +existiert. Bejahen Sie die Frage, wird die alte Datei dieses +Namens überschrieben. Anderenfalls erhalten Sie eine neue +Gelegenheit, einen Namen einzugeben. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sicherungssortierung" +% SEITE 1 +Sortierung wiederherstellen? +- +Die angegebene Datei war früher schon einmal sortiert worden. +Die Sortierung wurde jedoch durch nachfolgende Änderungen +zerstört. Wenn Sie die Datei wieder sortiert haben wollen, +beantworten Sie die Frage mit 'j'. Die Sortierung dauert nicht +lange, wenn nur wenige Sätze verändert wurden. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/feldnamen" +% SEITE 1 +Feldnamen anfügen? +- +Falls Sie neue Felder zu den existierenden anfügen wollen, +müssen Sie diese Frage bejahen. Sie erhalten dann Gelegenheit, +die neuen Namen im Editor einzugeben. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sortierfelder" +% SEITE 1 +Sortierreihenfolge ändern? +- +Die Reihenfolge, in der die Felder bei der Sortierung +berücksichtigt werden, ist in der EUDAS-Datei intern +gespeichert. Wenn Sie diese Reihenfolge, die beim letzten +Sortieren angegeben wurde, ändern möchten, müssen Sie die +Frage bejahen. Sie können dann die neue Feldreihenfolge +auswählen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/sortieren" +% SEITE 1 +Zieldatei sortieren? +- +Wenn Sie diese Frage bejahen, wird die Zieldatei nach +Ausführung der Funktion in ihrer eingestellten Feldreihenfolge +sortiert. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/forget" +% SEITE 1 +Datei löschen? +- +Wenn Sie diese Frage bejahen, wird die Datei wirklich +gelöscht. Wenn Sie die Datei irrtümlich gewählt haben, müssen +Sie die Frage verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/einrichten" +% SEITE 1 +Datei neu einrichten? +- +Sie haben eine Datei angegeben, die noch nicht existiert. Wenn +Sie die Frage bejahen, wird die Datei neu eingerichtet. +Anderenfalls wird die Funktion abgebrochen, so daß Sie +Gelegenheit haben, die Funktion mit einem neuen Namen zu +wiederholen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/testen" +% SEITE 1 +Prüfbedingungen beachten? +- +Wenn Sie diese Frage bejahen, werden beim Tragen die +Prüfbedingungen der Zieldatei abgefragt. Sätze, die diese +Bedingungen nicht erfüllen, werden nicht getragen und können +danach geändert werden. Beim Ändern wird dann jeweils die den +Satz betreffende Meldung ausgegeben. Die Prüfbedingungen der +Zieldatei können Sie mit der Funktion "Feldstruktur aendern" +angeben oder ändern. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/save" +% SEITE 1 +Datei überschreiben? +- +Die angegebene Datei befindet sich bereits auf dem Archiv. +Wenn Sie die Datei überschreiben wollen, müssen Sie die Frage +bejahen. Ansonsten wird die Datei nicht auf das Archiv +geschrieben (keine Wirkung). +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/fetch" +% SEITE 1 +Datei überschreiben? +- +Die angegebene Datei ist bereits im System vorhanden. Wenn Sie +diese Datei überschreiben wollen, müssen Sie die Frage +bejahen. Anderenfalls wird keine Aktion vorgenommen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/erase" +% SEITE 1 +Datei löschen? +- +Zur Sicherheit wird gefragt, ob Sie die angegebene Datei +wirklich auf dem Archiv löschen wollen. Wenn Sie die Frage +verneinen, wird keine Aktion durchgeführt. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/format" +% SEITE 1 +Formatieren? +- +Wenn Ihr Rechner dies unterstützt, können Sie Archivdisketten +vor dem Initialisieren noch physikalisch formatieren. Dies ist +immer dann notwendig, wenn eine Diskette neu ist (vor der +ersten Benutzung) oder wenn Schreibfehler aufgetreten sind, +die sich nicht mehr reparieren lassen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/archiv loeschen" +% SEITE 1 +Archiv löschen? +- +Wenn Sie irrtümlich die falsche Diskette eingelegt haben oder +eine andere Funktion ausführen wollten, können Sie die +Funktion durch Verneinen der Frage abbrechen. Achten Sie auf +den angegebenen Archivnamen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/alle Saetze" +% SEITE 1 +Alle Sätze drucken? +- +Wenn Sie die Frage bejahen, werden anschließend alle Sätze, +die in der Übersicht zu sehen waren, gedruckt. Den Namen des +Druckmusters können Sie dann gleich eingeben. Wenn Sie keinen +oder nur den aktuellen Satz drucken wollen, müssen Sie die +Frage verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/alle markierten" +% SEITE 1 +Alle markierten Sätze drucken? +- +Wenn Sie die Frage bejahen, werden anschließend alle +markierten Sätze gedruckt. Den Namen des Druckmusters können +Sie dann gleich eingeben. Wenn Sie keinen oder nur den +aktuellen Satz drucken wollen, müssen Sie die Frage verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Einzelsatz drucken" +% SEITE 1 +Aktuellen Satz drucken? +- +Wenn Sie die Frage bejahen, wird der aktuelle (markierte) Satz +gedruckt. Den Namen des Druckmusters können Sie dann gleich +eingeben. Wenn Sie keinen Satz drucken wollen, müssen Sie die +Frage verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/noch einmal" +% SEITE 1 +Noch einmal? +- +Wenn Sie die Frage bejahen, können Sie noch einmal die Datei +mit einer neuen Suchbedingung ansehen und erneut drucken. +Sonst kehren Sie wieder in den Editor zurück. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Ub.Felder" +% SEITE 1 +Felder auswählen? +- +Wenn Sie die Frage bejahen, können Sie einzelne Felder in +einer bestimmten Reihenfolge für die Übersichtsanzeige +auswählen. Anderenfalls werden alle Felder angezeigt. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Suchmuster" +% SEITE 1 +Suchbedingung angeben? +- +Wenn Sie die Frage bejahen, können Sie eine Suchbedingung für +die angezeigten Sätze angeben. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/umschalten" +% SEITE 1 +Auf Koppeldatei umschalten? +- +Wenn Sie die Frage bejahen, schalten Sie auf die genannte +Koppeldatei um. Damit wird diese Datei zeitweise als einzige +geöffnete betrachtet. Damit können Sie einen bestimmten Satz +aufsuchen, den Sie später beim Zurückschalten übernehmen +können. Verneinen Sie die Frage, werden Ihnen weitere mögliche +Koppeldateien angeboten, oder Sie kehren ohne Schaden zurück. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/uebernehmen" +% SEITE 1 +Koppelfelder übernehmen? +- +Wenn Sie die Frage bejahen, werden die Koppelfelder des jetzt +ausgewählten Satzes in den aktuellen Satz der ersten Datei +übernommen, an dem Sie dann weiter ändern können. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sortierrichtung" +% SEITE 1 +Aufsteigend sortieren? +- +Wenn Sie die Frage bejahen, wird die Datei nach dem genannten +Feld in aufsteigender Richtung sortiert, anderenfalls in +absteigender. Für weitere Felder können Sie wieder eine andere +Richtung angeben. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/zeilenform" +% SEITE 1 +Zeilenweise formatieren? +- +Wenn Sie die Frage bejahen, wird die angegebene Datei +zeilenweise interaktiv formatiert. Der Text wird unter +Berücksichtigung der Schrifttypen gleichmäßig auf die Zeilen +verteilt. Beachten Sie die Wirkung der Absatzmarken! +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/seitenform" +% SEITE 1 +Seitenweise formatieren? +- +Wenn Sie die Frage bejahen, wird die angegebene Datei +interaktiv seitenweise formatiert. Der Text wird bis zur +angegebenen Seitenlänge auf die Seiten verteilt. Dabei werden +Seitenköpfe und Fußnoten eingefügt. Das Ergebnis steht in der +Datei "xxx.p". +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/pw loeschen" +% SEITE 1 +Passwort löschen? +- +Wenn Sie die Frage bejahen, wird das Passwort gelöscht und das +leere Passwort eingestellt. Anderenfalls bleibt das alte +Passwort erhalten. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/manager aus" +% SEITE 1 +Manager ausschalten? +- +Wenn Sie die Frage bejahen, berücksichtigt EUDAS im weiteren +keine Managertask mehr. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Feldtypen aendern" +% SEITE 1 +Feldtypen ändern? +- +Wenn Sie die Frage bejahen, können Sie den Typ von +existierenden Feldern verändern. Der Feldtyp hat nur +Auswirkungen beim Größenvergleich (Suchen und Sortieren). +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Feldnamen aendern" +% SEITE 1 +Feldnamen ändern? +- +Wenn Sie die Frage bejahen, können Sie existierende Feldnamen +in ihrer Schreibweise verändern. Diese Funktion hat keine +Auswirkung auf die Dateiinhalte. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/eingelegt" +% SEITE 1 +Diskette eingelegt? +- +Legen Sie bitte die gewünschte Diskette ein und bejahen Sie +die Frage. Anderenfalls wird die Funktion ohne Wirkung +beendet. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Ausgabe drucken" +% SEITE 1 +Ausgabe drucken? +- +Wenn Sie die Frage bejahen, wird die gezeigte Datei sofort +ausgedruckt. Anderenfalls können Sie sie ggf. aufbewahren. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Ausgabe loeschen" +% SEITE 1 +Ausgabe löschen? +- +Wenn Sie die Frage bejahen, wird die gezeigte Datei +gelöscht. Anderenfalls wird sie für eine weitere Bearbeitung +aufbewahrt. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "EDIT/Allgemein" +% SEITE 1 +EDITOR: +- +Mit dem Editor können Sie einen Text zeilenweise eingeben. +Dabei können Sie den Cursor mit den Pfeiltasten bewegen. +RUBOUT löscht ein Zeichen, RUBIN schaltet in den Einfügemodus +um. Für weitere Informationen zum Editor s. +EUMEL-Benutzerhandbuch. ESC 'q' verläßt den Editor normal. Mit +ESC 'h' wird die Funktion abgebrochen. +% ENDE +% HILFE "EDIT/Feldnamen" +% SEITE 1 +Neue Feldnamen: +- +Sie können hier die neuen Feldnamen in der gewünschten +Reihenfolge untereinander eingeben. Jeder Feldname muß in +einer Zeile stehen und ohne Anführungsstriche geschrieben +sein. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Pruefbed" +% SEITE 1 +Prüfbedingungen: +- +Sie können hier die Prüfbedingungen der Datei eingeben bzw. +ändern. Die Prüfbedingungen sind ein ELAN-Programm. Da ELAN- +Programme formatfrei sind, kann es sein, daß Ihr Programm beim +nächsten Mal anders erscheint, als Sie es eingegeben haben. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Notizen" +% SEITE 1 +Notizen: +- +Sie können jetzt zu der angegebenen Datei beliebige Notizen +eingeben bzw. ändern. Sie befinden sich im Editor und können +die gleichen Funktionen wie bei der normalen Texteingabe +verwenden. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Suchen" +% SEITE 1 +Suchmuster: +- +Sie können jetzt eine Selektionsbedingung einstellen. Dazu +müssen Sie jeweils neben den Feldnamen eine Bedingung +schreiben. Mögliche Bedingungen sind: + Text muß gleich sein + Text* muß mit Text anfangen + *Text muß mit Text enden + *Text* enthält Text + Text.. muß größer oder gleich Text sein + ..Text muß kleiner als Text sein oder mit Text anfangen + Text1..Text2 liegt zwischen den beiden Texten +"--" verneint eine Bedingung. Weitere Bedingungen und +Kombination von Bedingungen s. EUDAS-Benutzerhandbuch. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Einfuegen" +% SEITE 1 +Satz einfügen: +- +Sie können hier die Inhalte eines neuen Satzes eingeben, der +vor dem aktuellen Satz eingefügt wird. +Spezielle Tastenkombinationen: + ESC RUBOUT Rest der Zeile löschen + ESC RUBIN Zeile aufbrechen + ESC OBEN nach oben blättern + ESC UNTEN nach unten blättern + ESC '1' auf erste Zeile + ESC '9' auf letzte Zeile + ESC 'h' Abbruch, der Satz wird nicht eingefügt + ESC 'w' Beenden und gleich den nächsten Satz einfügen + ESC 'D' aktuelles Tagesdatum schreiben +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Aendern" +% SEITE 1 +Satz ändern: +- +Sie können die Inhalte des aktuellen Satzes hier abändern. +Spezielle Tastenkombinationen: + ESC RUBOUT Rest der Zeile löschen + ESC RUBIN Zeile aufbrechen + ESC OBEN nach oben blättern + ESC UNTEN nach unten blättern + ESC '1' auf erste Zeile + ESC '9' auf letzte Zeile + ESC 'h' Abbruch, der Satz bleibt unverändert + ESC 'w' Beenden und gleich den nächsten Satz ändern + ESC 'D' aktuelles Tagesdatum schreiben +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Druckmuster" +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Verarbeite" +% SEITE 1 +Verarbeitungsvorschrift: +- +Sie können hier eine Verarbeitungsvorschrift eingeben. Die +Verarbeitungsvorschrift ist ein ELAN-Programm. Ein Feld wird +geändert durch den Operator "V": + "Feldname" V "neuer Feldinhalt"; +Statt des neuen Feldinhalts kann auch ein beliebiger +ELAN-Ausdruck angegeben werden. Mit + f ("Feldname") +wird der Inhalt eines Feldes als Text geliefert. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Kopiermuster" +% SEITE 1 +Kopiermuster: +- +Sie können das hier angegebene Kopiermuster verändern. Sollen +Felder nicht kopiert werden, brauchen Sie nur die +entsprechenden Zeilen zu löschen. Soll eine Feld andere +Inhalte bekommen, geben Sie in dem Ausdruck + "Feldname" K f ("Feldname"); +hinter dem K einen anderen ELAN-Ausdruck ein. Die Reihenfolge +der K-Ausdrücke bestimmt die Reihenfolge der Feldnamen in der +Zieldatei, wenn die Zieldatei noch nicht existierte. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Druckausgabe" +% SEITE 1 +Druckausgabe: +- +Sie können hier das Ergebnis der Druckgenerierung ansehen +und ggf. noch verändern. Nach Verlassen des Editors mit ESC +q wird der Text auf Anfrage gedruckt. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "UEBERSICHT" +% SEITE 1 +UEBERSICHT: +- +In diesem Modus können Sie sich alle Sätze der Datei durch +Blättern ansehen. Der aktuelle Satz ist jeweils markiert. Die +eingestellte Suchbedingung wird beachtet. Mit den Pfeiltasten +OBEN und UNTEN bewegen Sie sich vorwärts und rückwärts in der +Datei. Mit HOP OBEN, HOP UNTEN und HOP RETURN blättern Sie wie +im Editor. Mit ESC '1' gelangen Sie an den Anfang, mit ESC '9' +an das Ende der Datei. Mit '+' und '-' können Sie die +Markierung des aktuellen Satzes für spätere Verarbeitung +ändern. Verlassen Sie die Übersicht mit ESC 'q'. +% ENDE +% HILFE "SHOW/Uebersicht" +% SEITE 1 +Dateiübersicht: +- +In der gezeigten Dateiübersicht können Sie mit HOP OBEN und +HOP UNTEN blättern, wenn nicht alle Dateien auf eine Seite +passen. Verlassen Sie die Übersicht mit ESC 'q'. +% ENDE +% HILFE "WAHL/Allgemein" +% SEITE 1 +Horizontale WAHL eines Parameters: +- +Sie können aus den angezeigten Alternativen eine auswaehlen, +indem sie sie mit den Cursortasten RECHTS und LINKS markieren. +Durch RETURN bestätigen Sie die getroffene Wahl. Sie können +ihre Wahl auch durch Eintippen des ersten Buchstabens einer +Option angeben (klein oder groß geschrieben). ESC 'h' bricht +die aktuelle Funktion ab. +% ENDE +% HILFE "WAHL/Feldtypen" +% SEITE 1 +Feldtypen: +- +Sie können hier einen von vier möglichen Typen auswaehlen: + TEXT normaler Text mit Vergleich nach EUMEL-Code. + DIN Text, der nach DIN 5007 verglichen wird (Umlaute + richtig, Groß-/Kleinschreibung und Sonderzeichen ignoriert). + ZAHL Alle nichtnumerischen Zeichen außer Minus und + Dezimalkomma werden beim Vergleichen ignoriert. + DATUM Datum der Form "tt.mm.jj" +Die Feldtypen werden beim Sortieren und Suchen beachtet. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/sichere" +% SEITE 1 +Wahlmöglichkeiten beim Sichern: +- +Sie haben drei Möglichkeiten. +1. Die Arbeitskopie überschreibt die alte Version (Original) +vor den Änderungen. +2. Sie ignoriere die Veränderungen momentan. Die Arbeitskopie +bleibt weiter erhalten, wenn Sie am Ende des Sicherns +nichts anderes angeben. +3. Die geänderte Arbeitskopie kann unter einem neuen Namen +gespeichert werden, so daß das Original erhalten bleibt. +Sie erhalten anschließend Gelegenheit zur Eingabe des neuen +Namens. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/format" +% SEITE 1 +Auswahl des Diskettenformats: +- +Sie haben die Wahl zwischen den angegebenen Diskettenformaten. +Wenn Sie sich damit nicht auskennen, wählen Sie das +Standardformat. Die Angabe bezieht sich nur auf den +Formatiervorgang; beim Lesen wird das Format der Diskette +automatisch erkannt. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/zielarchiv" +% SEITE 1 +Art des Zielarchivs: +- +Sie können wählen zwischen: + +Std-Archiv Normales Archiv +Dateimanager Eine Managertask wie z.B. PUBLIC +Zweites Archiv Zur Bedienung eines zweiten Diskettenlaufwerks +und zum Archivieren über Netz +Formatumsetzer Für andere Diskettenformate, z.B. DOS + +Außer im ersten Fall können Sie anschließend den Namen des +Zielarchivs eingeben. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/Richtung" +% SEITE 1 +Richtung der Druckausgabe +- +Sie können wählen zwischen: + +Drucker Die Druckausgabe wird direkt gedruckt und +dann gelöscht +Bildschirm Die Ausgabe wird im Editor gezeigt und kann +danach auf Anfrage gedruckt und gelöscht werden +Textdatei Die Ausgabe erfolgt in eine Textdatei. Der +Name dieser Datei wird vor jedem Drucken erfragt. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/Std-Listen" +% SEITE 1 +Art der Listen +- +Sie können wählen zwischen: + +Kommaliste Alle Felder werden durch Komma getrennt +aneinandergehängt +Spaltenanordnung Die Felder werden in Spalten angeordnet, +wobei die Spaltenbreite durch einen Durchlauf durch die +Datei ermittelt wird. +% SEITE 1 "WAHL/Allgemein" +% ENDE + diff --git a/app/eudas/5.3/src/eudas.listen.01 b/app/eudas/5.3/src/eudas.listen.01 new file mode 100644 index 0000000..47e7270 --- /dev/null +++ b/app/eudas/5.3/src/eudas.listen.01 @@ -0,0 +1,276 @@ +PACKET eudas std listen + +(*************************************************************************) +(* *) +(* Drucken von Standardlisten ohne Druckmuster *) +(* *) +(* Version 01 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 06.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + drucke standardlisten, + std listenbreite, + std listenlaenge, + std listenfont : + + +LET + listendruckmuster = "******* Listendruckmuster *******"; + +FILE VAR f; + +TEXT VAR puffer, feldname; + +TEXT VAR std font := ""; + +INT VAR + std breite := 70, + std laenge := 60; + + + +PROC std listenbreite (INT CONST breite) : + std breite := breite +END PROC std listenbreite; + +INT PROC std listenbreite : + std breite +END PROC std listenbreite; + +PROC std listenlaenge (INT CONST laenge) : + std laenge := laenge +END PROC std listenlaenge; + +INT PROC std listenlaenge : + std laenge +END PROC std listenlaenge; + +PROC std listenfont (TEXT CONST font) : + std font := font +END PROC std listenfont; + +TEXT PROC std listenfont : + std font +END PROC std listenfont; + +PROC drucke standardlisten (INT CONST listenform, TEXT CONST feldliste) : + + forget (listendruckmuster, quiet); + f := sequential file (output, listendruckmuster); + maxlinelength (f, std breite); + IF kommaliste THEN + generiere komma druckmuster (feldliste) + ELSE + generiere spalten druckmuster (feldliste) + END IF; + TEXT CONST last := std; + drucke (listendruckmuster); + forget (listendruckmuster, quiet); + last param (last) . + +kommaliste : + listenform = 2 . + +END PROC drucke standardlisten; + +ROW 100 INT VAR feld max; + +INT VAR + zeilen pro satz, + zeilenlaenge, + feldlaenge, + druckfelder, + ges max; + +PROC generiere listenkopf : + + IF std font <> "" THEN + putline (f, "#type(" + textdarstellung (std font) + ")#") + END IF; + putline (f, "% GRUPPE 1 seitennummer"); + putline (f, "% VOR"); + put (f, date); put (f, time of day); put (f, "Uhr:"); + put (f, eudas dateiname (1)); + write (f, (std breite - length (eudas dateiname (1)) - 25) * " "); + putline (f, "&&-S"); + line (f) + +END PROC generiere listenkopf; + +PROC generiere seitenvorschub : + + putline (f, "% NACH"); + putline (f, "#page#"); + putline (f, "% ABK"); + putline (f, "&? : lfd nr ."); + putline (f, "&-S : seitennummer ."); + putline (f, "seitennummer :"); + putline (f, " text (int (lfd nr) DIV saetze pro seite + 1) ."); + write (f, "saetze pro seite : "); + put (f, (std laenge - 2) DIV zeilen pro satz - 1); + putline (f, ".") + +END PROC generiere seitenvorschub; + +PROC generiere komma druckmuster (TEXT CONST feldliste) : + + generiere listenkopf; + generiere feldueberschriften; + generiere wiederholungsteil; + generiere seitenvorschub . + +generiere feldueberschriften : + write (f, "Nr. "); + FOR i FROM 1 UPTO length (feldliste) REP + feldnamen lesen (code (feldliste SUB i), feldname); + IF i < length (feldliste) THEN + write (f, feldname + ", ") + ELSE + write (f, feldname) + END IF + END REP; + line (f); + putline (f, maxlinelength (f) * "-"); + zeilen pro satz := 1 . + +generiere wiederholungsteil : + putline (f, "% WDH"); + INT CONST max alt := maxlinelength (f); + INT VAR i; + maxlinelength (f, 10000); + write (f, "&&? "); + FOR i FROM 1 UPTO length (feldliste) REP + ein feldname als muster + END REP; + line (f); + maxlinelength (f, max alt) . + +ein feldname als muster : + write (f, "%<"); + feldnamen lesen (code (feldliste SUB i), feldname); + write (f, feldname); + write (f, ">"); + IF i < length (feldliste) THEN write (f, ", ") END IF . + +END PROC generiere komma druckmuster; + +PROC maxima suchen (TEXT CONST feldliste) : + + INT VAR i; + maxima initialisieren; + auf satz (1); + INT VAR modus; + IF markierte saetze > 0 THEN + modus := 3; + IF NOT satz markiert THEN weiter (3) END IF + ELSE + modus := 2; + IF NOT satz ausgewaehlt THEN weiter (2) END IF + END IF; + + WHILE NOT dateiende REP + einen satz testen; + weiter (modus) + END REP . + +maxima initialisieren : + druckfelder := length (feldliste); + FOR i FROM 1 UPTO druckfelder REP + feld max (i) := 2 + END REP; + ges max := 0 . + +einen satz testen : + INT VAR gesamt := 0; + FOR i FROM 1 UPTO druckfelder REP + feld bearbeiten (code (feldliste SUB i), + PROC (TEXT CONST, INT CONST, INT CONST) fl); + IF feldlaenge > feld max (i) THEN feld max (i) := feldlaenge END IF; + gesamt INCR feldlaenge + END REP; + IF gesamt > ges max THEN ges max := gesamt END IF . + +END PROC maxima suchen; + +PROC fl (TEXT CONST satz, INT CONST von, bis) : + feldlaenge := bis - von + 1 +END PROC fl; + +PROC generiere spalten druckmuster (TEXT CONST feldliste) : + + maxima suchen (feldliste); + generiere listenkopf; + generiere feldueberschriften; + generiere wiederholungsteil; + generiere abkuerzungen; + generiere seitenvorschub . + +generiere feldueberschriften : + TEXT VAR abk felder := ""; + INT VAR i; + zeilenlaenge := 4; + zeilen pro satz := 1; + write (f, "Nr. "); + FOR i FROM 1 UPTO length (feldliste) REP + feldnamen lesen (code (feldliste SUB i), feldname); + IF length (feldname) + 2 >= feld max (i) THEN + abkuerzung einfuehren + END IF; + zeilenlaenge INCR feld max (i) + 1; + IF zeilenlaenge > std breite THEN + line (f); zeilenlaenge := feld max (i) + 1; zeilen pro satz INCR 1 + END IF; + write (f, text (feldname, feld max (i) + 1)) + END REP; + line (f); + putline (f, maxlinelength (f) * "-") . + +abkuerzung einfuehren : + abk felder CAT (feldliste SUB i) . + +generiere wiederholungsteil : + putline (f, "% WDH"); + write (f, "&&? "); + FOR i FROM 1 UPTO length (feldliste) REP + ein feldmuster erzeugen + END REP; + line (f) . + +ein feldmuster erzeugen : + INT CONST abk pos := pos (abk felder, feldliste SUB i); + puffer := "&"; + IF abk pos > 0 THEN + puffer CAT text (code (abk pos + 64), feld max (i)) + ELSE + feldnamen lesen (code (feldliste SUB i), feldname); + puffer CAT text ("<" + feldname + ">", feld max (i)) + END IF; + write (f, puffer) . + +generiere abkuerzungen : + IF abk felder <> "" THEN + putline (f, "% ABK"); + FOR i FROM 1 UPTO length (abk felder) REP + eine abkuerzung generieren + END REP + END IF . + +eine abkuerzung generieren : + write (f, "&"); + write (f, code (i + 64)); + write (f, " : "); + write (f, "f ("); + feldnamen lesen (code (abk felder SUB i), feldname); + write (f, textdarstellung (feldname)); + putline (f, ") .") . + +END PROC generiere spalten druckmuster; + + +END PACKET eudas std listen; + diff --git a/app/eudas/5.3/src/eudas.menues.14 b/app/eudas/5.3/src/eudas.menues.14 new file mode 100644 index 0000000..8ccdd5e --- /dev/null +++ b/app/eudas/5.3/src/eudas.menues.14 @@ -0,0 +1,3157 @@ +PACKET eudas menues + +(*************************************************************************) +(* *) +(* Menue-Manager *) +(* *) +(* Version 14 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 04.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + global manager, + menue manager, + lock, + free, + menuedaten einlesen, + menuenamen, + menue loeschen, + + box zeichen, + waehlbar, + fusszeile, + fussteil, + ausfuehrtaste, + menue anbieten, + zeilenmenue anbieten, + auswahl anbieten, + wahl, + esc hop ausfuehren, + + hilfe anbieten, + viel hilfe, + status anzeigen, + statuszeile, + + dialogfenster, + dialogfenster loeschen, + dialog, + neuer dialog, + ja, + editget, + fehler ausgeben : + + +(***************************** Zeilenanalyse *****************************) + +ROW 7 TEXT VAR kommandotext := + ROW 7 TEXT : ("MENUE", "BILD", "FELD", "ENDE", "AUSWAHL", + "HILFE", "SEITE"); + +LET + menue kommando = 1, + bild kommando = 2, + feld kommando = 3, + ende kommando = 4, + auswahl kommando = 5, + hilfe kommando = 6, + seite kommando = 7; + +LET + bold = 2, + integer = 3, + string = 4, + end of line = 7; + +LET + fehler in zeile = #701# + "FEHLER in Zeile "; + +FILE VAR file; + +TEXT VAR + zeile, + kommando; + + +PROC zeile lesen : + + IF eof (file) THEN + zeile := "%DUMMY" + ELSE + read record (file, zeile); + IF zeile = niltext THEN zeile := blank END IF; + cout (line no (file)); + down (file) + END IF + +END PROC zeile lesen; + +BOOL PROC kommandozeile : + + IF (zeile SUB 1) = kommandozeichen THEN + kommando isolieren + ELSE + FALSE + END IF . + +kommando isolieren : + INT VAR typ; + replace (zeile, 1, blank); + scan (zeile); + replace (zeile, 1, kommandozeichen); + next symbol (kommando, typ); + IF typ <> bold THEN + fehler (kein kommando angegeben); + FALSE + ELSE + TRUE + END IF . + +END PROC kommandozeile; + +BOOL PROC kommando ist (INT CONST identifikation) : + + kommandotext (identifikation) = kommando + +END PROC kommando ist; + +INT PROC int parameter : + + TEXT VAR symbol; + INT VAR typ; + next symbol (symbol, typ); + IF typ = integer THEN + int (symbol) + ELSE + IF typ <> end of line THEN fehler (kein int parameter) END IF; + -1 + END IF + +END PROC int parameter; + +TEXT PROC text parameter : + + TEXT VAR symbol; + INT VAR typ; + next symbol (symbol, typ); + IF typ = string THEN + symbol + ELSE + IF typ <> end of line THEN fehler (kein text parameter) END IF; + niltext + END IF + +END PROC text parameter; + +PROC fehler (TEXT CONST meldung) : + + note (fehler in zeile); note (line no (file) - 1); note line; + note (meldung); note line; + line; putline (meldung) + +END PROC fehler; + + +(***************************** Fensterkoordinaten ************************) + +INT VAR + y laenge, + x laenge, + x pos, + y pos; + +PROC f cursor (INT CONST x, y) : + + cursor (x pos + x - 1, y pos + y - 1) + +END PROC f cursor; + + +(*************************** Box ****************************************) + +TEXT VAR + ecke links oben, + ecke rechts oben, + ecke links unten, + ecke rechts unten, + anschluss links, + anschluss rechts, + strich senkrecht, + strich waagerecht, + trennung waagerecht, + scroll voll, + scroll leer; + +TEXT VAR + blank 120 := 120 * " ", + strich 120, + trennung 120; + +box zeichen ("-:..`'::-", ""15""14"", "X "); + + +PROC box zeichen (TEXT CONST begrenzer, s voll, s leer) : + + scroll voll := s voll; scroll leer := s leer; + IF LENGTH begrenzer = 9 THEN + strich waagerecht := begrenzer SUB 1; + strich senkrecht := begrenzer SUB 2; + ecke links oben := begrenzer SUB 3; + ecke rechts oben := begrenzer SUB 4; + ecke links unten := begrenzer SUB 5; + ecke rechts unten := begrenzer SUB 6; + anschluss links := begrenzer SUB 7; + anschluss rechts := begrenzer SUB 8; + trennung waagerecht := begrenzer SUB 9 + END IF; + strich 120 := 120 * strich waagerecht; + trennung 120 := 120 * trennung waagerecht + +END PROC box zeichen; + +PROC out oben (INT CONST laenge) : + + out (ecke links oben); + outsubtext (strich 120, 1, laenge - 2); + out (ecke rechts oben) + +END PROC out oben; + +PROC out oben (INT CONST laenge, TEXT CONST kopf) : + + out (ecke links oben); + outsubtext (strich 120, 1, laenge - 3 - length (kopf)); + out (kopf); + out (strich waagerecht); out (ecke rechts oben) + +END PROC out oben; + +PROC out mitte (INT CONST laenge) : + + out (anschluss links); + outsubtext (trennung 120, 1, laenge - 2); + out (anschluss rechts) + +END PROC out mitte; + +PROC out unten (INT CONST laenge) : + + out (ecke links unten); + outsubtext (strich 120, 1, laenge - 2); + out (ecke rechts unten) + +END PROC out unten; + +PROC out leer (INT CONST x, laenge) : + + IF x + laenge >= x size THEN + out (cleol) + ELSE + outsubtext (blank 120, 1, laenge) + END IF + +END PROC out leer; + + +(**************************** Einlesen zentral ***************************) + +LET + zeile ohne zusammenhang = #702# + "Zeile ist ohne Zusammenhang", + k menuedaten im speicher = #703# + "K Menuedaten im Speicher"; + +PROC menuedaten einlesen (TEXT CONST dateiname) : + + ggf initialisieren; + file := sequential file (input, dateiname); + modify (file); + to line (file, 1); + WHILE NOT eof (file) REP + zeile lesen; + IF kommandozeile THEN + eventuell verteilen + ELIF NOT anything noted THEN + fehler (zeile ohne zusammenhang) + END IF + END REP; + seiten anzeigen; + IF anything noted THEN + note edit (file) + END IF . + +eventuell verteilen : + IF kommando ist (menue kommando) THEN + menue aus datei lesen + ELIF kommando ist (auswahl kommando) THEN + auswahl aus datei lesen + ELIF kommando ist (hilfe kommando) THEN + hilfe aus datei lesen + ELIF NOT anything noted THEN + fehler (zeile ohne zusammenhang) + END IF . + +seiten anzeigen : + IF online THEN + line; put (anzahl ds k); + putline (k menuedaten im speicher) + END IF . + +anzahl ds k : + storage (menueds (1)) + storage (menueds (2)) + storage (menueds (3)) . + +END PROC menuedaten einlesen; + + +(**************************** TYPE MENUE *********************************) + +TYPE MENUE = STRUCT (SATZ + bild, + hilfen, + kommandos, + TEXT + feldtasten, + feldzeilen); + +BOUND ROW 200 MENUE VAR menues; + + +(************************** Menue Einlesen *******************************) + +TEXT VAR + m feldzeilen, + m feldtasten; + +SATZ VAR + m hilfen, + m kommandos; + +LET + niltext = "", + blank = " ", + feldmarkierung = ""223"", + markierungsspalte = 2, + kommandozeichen = "%", + piep = ""7"", + esc = ""27"", + cleol = ""5""; + +LET + bildkommando erwartet = #704# + "% BILD erwartet", + keine feldnr angegeben = #705# + "Feldnummer beim %FELD-Kommando fehlt", + ende fehlt = #706# + "% ENDE erwartet", + kein name angegeben = #707# + "Name fehlt", + kein kommando angegeben = #708# + "Kommandozeile enthaelt kein Kommando", + kein int parameter = #709# + "Parameter soll eine Zahl sein", + kein text parameter = #710# + "Parameter soll ein TEXT sein"; + + +PROC menue aus datei lesen : + + TEXT VAR name := text parameter; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + INT VAR index; + neues menue einfuegen; + menue aus datei lesen (menues (index)) + END IF . + +neues menue einfuegen : + index := link (thesaurus (2), name); + IF index = 0 THEN + insert (thesaurus (2), name, index) + END IF . + +END PROC menue aus datei lesen; + +PROC menue aus datei lesen (MENUE VAR m) : + + menue initialisieren; + bild einlesen; + felddefinitionen bearbeiten; + auf ende testen; + ergebnis abspeichern . + +menue initialisieren : + satz initialisieren (m. bild); + satz initialisieren (m hilfen); + satz initialisieren (m kommandos); + m feldtasten := niltext; + m feldzeilen := niltext . + +bild einlesen : + teste auf bild kommando; + INT VAR zeilennr := 1; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE bild einlesen + ELSE + bildzeile bearbeiten; + zeilennr INCR 1 + END IF + END REP . + +teste auf bild kommando : + zeile lesen; + IF NOT (kommandozeile CAND kommando ist (bild kommando)) THEN + fehler (bild kommando erwartet) + END IF . + +bildzeile bearbeiten : + IF pos (zeile, feldmarkierung) > 0 THEN + m feldzeilen CAT code (zeilennr + 1); + IF (zeile SUB markierungsspalte) = feldmarkierung THEN + replace (zeile, markierungsspalte, blank) + END IF + END IF; + feld aendern (m. bild, zeilennr, zeile) . + +felddefinitionen bearbeiten : + WHILE kommando ist (feld kommando) REP + eine felddefinition bearbeiten + END REP . + +eine felddefinition bearbeiten : + INT VAR feldnr := int parameter; + IF feldnr = -1 THEN + fehler (keine feldnr angegeben); + feldnr := 100 + END IF; + hilfe text einlesen; + feldtasten einlesen; + kommandos einlesen . + +hilfe text einlesen : + feld aendern (m hilfen, feldnr, text parameter) . + +feldtasten einlesen : + TEXT CONST tasten := text parameter; + INT VAR p; + FOR p FROM 1 UPTO length (tasten) REP + m feldtasten CAT code (feldnr); + m feldtasten CAT (tasten SUB p) + END REP . + +kommandos einlesen : + TEXT VAR k := niltext; + zeile lesen; + WHILE NOT kommandozeile REP + k CAT zeile; + zeile lesen + END REP; + feld aendern (m kommandos, feldnr, k) . + +auf ende testen : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF . + +ergebnis abspeichern : + m. hilfen := m hilfen; + m. kommandos := m kommandos; + m. feldtasten := m feldtasten; + m. feldzeilen := m feldzeilen . + +END PROC menue aus datei lesen; + + +(*************************** Menue anbieten ******************************) + +LET + ausfuehren status = #711# + "Kommando wird ausgeführt ..", + gib kommando = #712# + ""15"Gib Kommando: ", + falsche ausfuehrtaste = #713# + "falsche Ausfuehrtaste", + t existiert nicht = #714# + " existiert nicht."; + +LET + blank 50 = " ", + begin mark = ""15"", + end mark = ""14"", + frage marke = "?"8"", + ausfuehren marke = "*"8""; + +INT VAR + markenpos, + gezeichnete zeilen; + +BOOL VAR + ist zeilenmenue := FALSE, + funktionssperre veraendert, + menue init durchgefuehrt; + +TEXT VAR + menuebalken := niltext, + sperrzeichen, + menuefunktionstasten := ""32""1""2""3""8""10""13""27"", + edit kommando, + altes kommando := niltext; + +ROW 6 TEXT VAR + funktionssperre := ROW 6 TEXT : ("", "", "", "", "", ""), + fusstexte := funktionssperre; + +FENSTER VAR + balkenfenster, + fussfenster; + +fenster initialisieren (balkenfenster); +fenster initialisieren (fussfenster); + + +PROC waehlbar (INT CONST menue, funktion, BOOL CONST moeglich) : + + IF moeglich THEN + ggf sperre aufheben + ELSE + sperre setzen + END IF; + funktionssperre veraendert := TRUE . + +ggf sperre aufheben : + IF length (funktionssperre (menue)) >= funktion THEN + replace (funktionssperre (menue), funktion, " ") + END IF . + +sperre setzen : + WHILE length (funktionssperre (menue)) < funktion REP + funktionssperre (menue) CAT " " + END REP; + replace (funktionssperre (menue), funktion, "-") . + +END PROC waehlbar; + +PROC ausfuehrtaste (TEXT CONST taste) : + + IF length (taste) <> 1 COR taste schon belegt THEN + errorstop (falsche ausfuehrtaste) + ELSE + replace (menuefunktionstasten, 1, taste) + END IF . + +taste schon belegt : + taste <> ""13"" AND pos (menuefunktionstasten, taste, 2) > 0 . + +END PROC ausfuehrtaste; + +PROC fusszeile (TEXT CONST prompt1, + TEXT CONST prompt2, INT CONST pos2, + TEXT CONST prompt3, INT CONST pos3) : + + fusstexte (1) := code (1) + prompt1; + fusstexte (4) := niltext; + fusstexte (2) := code (pos2) + prompt2; + fusstexte (5) := niltext; + fusstexte (3) := code (pos3) + prompt3; + fusstexte (6) := niltext; + fenster veraendert (fussfenster) + +END PROC fusszeile; + +PROC fussteil (INT CONST index, TEXT CONST prompt, inhalt) : + + fusszeile ausgeben; + fusstexte (index) := (fusstexte (index) SUB 1) + prompt; + cursor (code (fusstexte (index) SUB 1), y size); + outsubtext (fusstexte (index), 2); + fussteil (index, inhalt) + +END PROC fussteil; + +PROC fussteil (INT CONST index, TEXT CONST inhalt) : + + INT VAR erlaubte laenge; + IF index = 3 THEN + erlaubte laenge := x size + ELSE + erlaubte laenge := code (fusstexte (index + 1) SUB 1) + END IF; + INT CONST verbrauchte laenge := + code (fusstexte (index) SUB 1) + length (fusstexte (index)) - 1; + erlaubte laenge DECR verbrauchte laenge; + fusstexte (index + 3) := subtext (inhalt, 1, erlaubte laenge); + fusszeile ausgeben; + cursor (verbrauchte laenge, y size); + outsubtext (inhalt, 1, erlaubte laenge); + outsubtext (blank 120, 1, erlaubte laenge - length (fusstexte (index + 3))) + +END PROC fussteil; + +PROC fusszeile ausgeben : + + BOOL VAR veraendert; + fensterzugriff (fussfenster, veraendert); + IF veraendert CAND fusstexte (1) <> niltext THEN + zeile ausgeben + END IF . + +zeile ausgeben : + INT VAR i; + cursor (1, y size); out (cleol); + FOR i FROM 1 UPTO 3 REP + cursor (code (fusstexte (i) SUB 1), y size); + outsubtext (fusstexte (i), 2); + out (fusstexte (i + 3)) + END REP . + +END PROC fusszeile ausgeben; + +PROC menue anbieten (ROW 6 TEXT CONST menuenamen, + FENSTER CONST f, BOOL CONST esc erlaubt, + PROC (INT CONST, INT CONST) interpreter) : + + ROW 6 INT VAR + m anfang, + m ende, + m wahl; + + INT VAR + menuenr intern, + leistenindex := 0, + neuer leistenindex := 1, + leave code := 0, + besetzte menues; + + TEXT VAR + balken; + + ROW 6 TEXT VAR + sperre, + fuss; + + BOOL VAR + save zeilenmenue; + + ggf initialisieren; + andere initialisierungen; + disable stop; + REP + menuebalken und sperre aktualisieren; + menue aufrufen; + funktion ausfuehren + END REP . + +andere initialisierungen : + fenstergroesse bestimmen; + rekursive werte sichern; + menuebalken aufbauen; + funktionssperre aufbauen . + +fenstergroesse bestimmen : + fenstergroesse setzen (balkenfenster, 1, 1, x size - 1, 1); + fenstergroesse setzen (fussfenster, 1, y size, x size - 1, 1) . + +rekursive werte sichern : + save zeilenmenue := ist zeilenmenue; + ist zeilenmenue := FALSE; + balken := menuebalken; + sperre := funktionssperre; + fuss := fusstexte . + +menuebalken aufbauen : + menuebalken := ""6""0""0""; + identifikation extrahieren; + weitere menues anfuegen; + menuebalken CAT cl eol . + +identifikation extrahieren : + INT VAR ppos := pos (menuenamen (1), "."); + IF ppos > 0 THEN + menuebalken CAT subtext (menuenamen (1), 1, ppos - 1) + END IF; + menuebalken CAT ": " . + +weitere menues anfuegen : + besetzte menues := 0; + WHILE besetzte menues < 6 CAND noch ein menue vorhanden REP + besetzte menues INCR 1; + ein weiteres menue; + m wahl (besetzte menues) := 1 + END REP . + +noch ein menue vorhanden : + menuenamen (besetzte menues + 1) <> niltext . + +ein weiteres menue : + m anfang (besetzte menues) := length (menuebalken); + ppos := pos (menuenamen (besetzte menues), "."); + IF ppos = 0 THEN + menuebalken CAT menuenamen (besetzte menues) + ELSE + menuebalken CAT subtext (menuenamen (besetzte menues), ppos + 1) + END IF; + menuebalken CAT " "; + m ende (besetzte menues) := length (menuebalken) - 1 . + +funktionssperre aufbauen : + INT VAR i; + FOR i FROM 1 UPTO 6 REP + funktionssperre (i) := niltext; + fusstexte (i) := niltext + END REP; + funktionssperre veraendert := TRUE; + interpreter (0, 0) . + +menuebalken und sperre aktualisieren : + IF neuer leistenindex > 0 THEN + altes menue demarkieren; + neues menue markieren; + leistenindex := neuer leistenindex; + neuer leistenindex := 0; + neues menue auswaehlen + END IF . + +altes menue demarkieren : + IF leistenindex > 0 THEN + replace (menuebalken, m anfang (leistenindex), " "); + replace (menuebalken, m ende (leistenindex), " "); + IF menue init durchgefuehrt THEN + interpreter (leistenindex, -1) + END IF + END IF . + +neues menue markieren : + replace (menuebalken, m anfang (neuer leistenindex), begin mark); + replace (menuebalken, m ende (neuer leistenindex), end mark); + fenster veraendert (balkenfenster); + menuebalken anzeigen . + +neues menue auswaehlen : + menuenr intern := link (thesaurus (2), menuenamen (leistenindex)); + IF menuenr intern = 0 THEN + existiert nicht (menuenamen (leistenindex)); + LEAVE menue anbieten + END IF; + menue init durchgefuehrt := FALSE; + fenster veraendert (f) . + +menue aufrufen : + leave code := leistenindex; + anbieten (menues (menuenr intern), f, leave code, m wahl (leistenindex), + PROC (INT CONST, INT CONST) interpreter) . + +funktion ausfuehren : + SELECT leave code OF + CASE 0 : menue verlassen + CASE 1 : kommandodialog + CASE 2 : menuewechsel nach rechts + CASE 3 : menuewechsel nach links + CASE 4 : wahl behandeln + OTHERWISE direkte menuewahl + END SELECT . + +menuewechsel nach rechts : + IF leistenindex < besetzte menues THEN + neuer leistenindex := leistenindex + 1 + ELSE + neuer leistenindex := 1 + END IF . + +menuewechsel nach links : + IF leistenindex > 1 THEN + neuer leistenindex := leistenindex - 1 + ELSE + neuer leistenindex := besetzte menues + END IF . + +direkte menuewahl : + leave code := leave code - 10; + IF leave code <= besetzte menues THEN + neuer leistenindex := leave code + END IF . + +kommandodialog : + IF esc erlaubt THEN + BOOL VAR bild veraendert := FALSE; + REP + editget kommando; + kommando ausfuehren + UNTIL erfolgreich END REP; + IF bild veraendert THEN + bildschirm neu; + dialogfenster loeschen; + fusszeile ausgeben; + interpreter (leistenindex, -2) + END IF + END IF . + +kommando ausfuehren : + IF echtes kommando THEN + bild veraendert := TRUE; + status anzeigen (ausfuehren status); + cursor (1, 2); out (cl eop); + do (edit kommando) + END IF . + +echtes kommando : + pos (edit kommando, ""33"", ""254"", 1) > 0 . + +erfolgreich : + NOT is error . + +menue verlassen : + IF menue init durchgefuehrt THEN + interpreter (leistenindex, -1) + END IF; + fenster veraendert (f); + rekursive werte wiederherstellen; + LEAVE menue anbieten . + +rekursive werte wiederherstellen : + ist zeilenmenue := save zeilenmenue; + menuebalken := balken; + fenster veraendert (balkenfenster); + funktionssperre := sperre; + funktionssperre veraendert := TRUE; + fusstexte := fuss; + fenster veraendert (fussfenster) . + +wahl behandeln : + IF m wahl (leistenindex) > 0 THEN + interpreter (leistenindex, m wahl (leistenindex)) + ELSE + m wahl (leistenindex) := - m wahl (leistenindex) + END IF; + fusszeile ausgeben . + +END PROC menue anbieten; + +PROC menuebalken anzeigen : + + BOOL VAR veraendert; + fensterzugriff (balkenfenster, veraendert); + IF veraendert THEN out (menuebalken) END IF + +END PROC menuebalken anzeigen; + +PROC anbieten (MENUE CONST m, FENSTER CONST f, INT VAR menuenr, wahl, + PROC (INT CONST, INT CONST) interpreter) : + + INT VAR + tastenzustand := 0; + + fehler behandeln; + neuen fensterzugriff anmelden (f); + IF gezeichnete zeilen = 0 THEN + markenpos := 0 + END IF; + neuer dialog; + geaenderte funktionssperre beruecksichtigen; + REP + menuebalken anzeigen; + auf eingabe warten; + menuefunktion + END REP . + +fehler behandeln : + IF wahl > length (m. feldzeilen) THEN + wahl := markenpos; + ELIF is error THEN + fehler ausgeben; + interpreter (menuenr, -2); + END IF . + +geaenderte funktionssperre beruecksichtigen : + IF funktionssperre veraendert THEN + sperrzeichen setzen (menuenr, m); + bereits angezeigte funktionen korrigieren; + funktionssperre veraendert := FALSE + END IF . + +bereits angezeigte funktionen korrigieren : + INT VAR f index; + FOR f index FROM 1 UPTO length (m. feldzeilen) REP + INT CONST funktionszeile := code (m. feldzeilen SUB f index); + IF funktionszeile > gezeichnete zeilen THEN + LEAVE bereits angezeigte funktionen korrigieren + END IF; + erstes zeichen ausgeben (m. bild, funktionszeile) + END REP . + +auf eingabe warten : + REP + ausgabe und zeichen annehmen; + IF is error THEN + halt vom terminal behandeln + ELSE + LEAVE auf eingabe warten + END IF + END REP . + +ausgabe und zeichen annehmen : + TEXT VAR eingabe; + BOOL VAR menue jetzt fertig ausgegeben := FALSE; + WHILE gezeichnete zeilen < y laenge REP + eingabe := getcharety; + eventuell eine zeile ausgeben + END REP; + bildschirm update; + cursor positionieren (m, wahl); + getchar mit enable stop (eingabe) . + +eventuell eine zeile ausgeben : + IF eingabe = niltext THEN + ggf init durchfuehren; + gezeichnete zeilen INCR 1; + menuezeile markiert oder nicht markiert ausgeben + ELSE + LEAVE ausgabe und zeichen annehmen + END IF . + +ggf init durchfuehren : + IF NOT menue init durchgefuehrt AND gezeichnete zeilen = 0 THEN + interpreter (menuenr, 0); + sperrzeichen setzen (menuenr, m); + menue init durchgefuehrt := TRUE + END IF . + +menuezeile markiert oder nicht markiert ausgeben : + IF gezeichnete zeilen = code (m. feldzeilen SUB wahl) THEN + menuezeile ausgeben (m. bild, gezeichnete zeilen, TRUE); + markenpos := wahl + ELSE + menuezeile ausgeben (m. bild, gezeichnete zeilen, FALSE) + END IF; + IF gezeichnete zeilen = y laenge THEN + menue jetzt fertig ausgegeben := TRUE + END IF . + +bildschirm update : + IF menue jetzt fertig ausgegeben AND NOT is error THEN + fusszeile ausgeben; + interpreter (menuenr, -2); + IF is error THEN clear error END IF + END IF . + +halt vom terminal behandeln : + fehler ausgeben; + menuebalken anzeigen; + gezeichnete zeilen := 0 . + +menuefunktion : + INT VAR posi; + SELECT tastenzustand OF + CASE 0 : normale funktion + CASE 1 : hop funktion + CASE 2 : esc funktion + END SELECT . + +normale funktion : + SELECT pos (menuefunktionstasten, eingabe) OF + CASE 1 : leerzeichen ausfuehren + CASE 2 : tastenzustand := 1 + CASE 3 : rechts ausfuehren + CASE 4 : oben ausfuehren + CASE 5 : links ausfuehren + CASE 6 : unten ausfuehren + CASE 7 : return ausfuehren + CASE 8 : tastenzustand := 2 + OTHERWISE sondertaste + END SELECT . + +hop funktion : + SELECT pos (""1""3""10"", eingabe) OF + CASE 1 : hop hop ausfuehren + CASE 2 : hop oben ausfuehren + CASE 3 : hop unten ausfuehren + OTHERWISE out (piep) + END SELECT; + tastenzustand := 0 . + +esc funktion : + SELECT pos (""1""27"?qh", eingabe) OF + CASE 1 : esc hop ausfuehren + CASE 2 : esc esc ausfuehren + CASE 3 : esc fragezeichen ausfuehren + CASE 4, 5 : esc q ausfuehren + OTHERWISE belegte taste + END SELECT; + tastenzustand := 0 . + +rechts ausfuehren : + leave code := 2; + LEAVE anbieten . + +oben ausfuehren : + IF wahl > 1 THEN + wahl DECR 1 + ELSE + wahl := length (m. feldzeilen) + END IF . + +links ausfuehren : + leave code := 3; + LEAVE anbieten . + +unten ausfuehren : + IF wahl < length (m. feldzeilen) THEN + wahl INCR 1 + ELSE + wahl := 1 + END IF . + +return ausfuehren : + unten ausfuehren . + +sondertaste : + IF menuewahl THEN + menuewahl bearbeiten + ELIF wahl fuer bestimmtes feld THEN + feld waehlen + ELIF eingabe <= ""32"" THEN + push (esc + eingabe) + END IF . + +menuewahl : + pos ("123456", eingabe) > 0 . + +menuewahl bearbeiten : + leave code := code (eingabe) - 38; + LEAVE anbieten . + +wahl fuer bestimmtes feld : + posi := 0; + REP + posi := pos (m. feldtasten, eingabe, posi + 1) + UNTIL (posi MOD 2) = 0 END REP; + posi > 0 AND feld mit bildschirmposition . + +feld mit bildschirmposition : + code (m. feldtasten SUB posi - 1) <= length (m. feldzeilen) . + +feld waehlen : + wahl := code (m. feldtasten SUB posi - 1); + cursor positionieren (m, wahl); + IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN + wahl getroffen (m, wahl); + leave code := 4; + LEAVE anbieten + END IF . + +hop hop ausfuehren : + wahl := 1 . + +hop oben ausfuehren : + wahl := 1 . + +hop unten ausfuehren : + wahl := length (m. feldzeilen) . + +belegte taste : + IF esc sonderfunktion THEN + wahl := code (m. feldtasten SUB posi - 1); + leave code := 4; + LEAVE anbieten + ELSE + push (lernsequenz auf taste (eingabe)) + END IF . + +esc sonderfunktion : + posi := 0; + REP + posi := pos (m. feldtasten, eingabe, posi + 1) + UNTIL (posi MOD 2) = 0 CAND + (posi = 0 COR feld ohne bildschirmposition) END REP; + posi > 0 . + +feld ohne bildschirmposition : + code (m. feldtasten SUB posi - 1) > length (m. feldzeilen) . + +esc esc ausfuehren : + leave code := 1; + LEAVE anbieten . + +esc fragezeichen ausfuehren : + TEXT VAR hilfe name; + wahl demarkieren (m, wahl, frage marke); + feld lesen (m. hilfen, wahl, hilfe name); + hilfe anbieten (hilfe name, d fenster); + IF is error THEN fehler ausgeben END IF; + interpreter (menuenr, -2); + neuen fensterzugriff anmelden (f) . + +esc q ausfuehren : + leave code := 0; + LEAVE anbieten . + +leerzeichen ausfuehren : + IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN + wahl getroffen (m, wahl); + leave code := 4; + LEAVE anbieten + END IF . + +leave code : + menuenr . + +END PROC anbieten; + +PROC neuen fensterzugriff anmelden (FENSTER CONST f) : + + BOOL VAR veraendert; + fensterzugriff (f, veraendert); + fenstergroesse (f, x pos, y pos, x laenge, y laenge); + IF veraendert THEN + gezeichnete zeilen := 0; + f cursor (1, 1) + END IF + +END PROC neuen fensterzugriff anmelden; + +PROC sperrzeichen setzen (INT CONST menuenr, MENUE CONST m) : + + sperrzeichen := blank 50; + INT VAR i; + FOR i FROM 1 UPTO length (funktionssperre (menuenr)) REP + replace (sperrzeichen, code (m. feldzeilen SUB i), + funktionssperre (menuenr) SUB i) + END REP + +END PROC sperrzeichen setzen; + +PROC cursor positionieren (MENUE CONST m, INT CONST wahl) : + + INT CONST wahlzeile := code (m. feldzeilen SUB wahl); + IF markenpos > 0 AND markenpos <> wahl THEN + INT CONST markenzeile := code (m. feldzeilen SUB markenpos); + menuezeile ausgeben (m. bild, markenzeile, FALSE) + END IF; + menuezeile ausgeben (m. bild, wahlzeile, TRUE); + markenpos := wahl; + f cursor (2, wahlzeile) + +END PROC cursor positionieren; + +PROC getchar mit enable stop (TEXT VAR z) : + + enable stop; + getchar (z) + +END PROC getchar mit enable stop; + +PROC wahl getroffen (MENUE CONST m, INT VAR wahl) : + + wahl demarkieren (m, wahl, ausfuehren marke); + TEXT VAR k; + feld lesen (m. kommandos, wahl, k); + IF k <> niltext AND k <> blank THEN + do (k); + bildschirm neu; + wahl := - wahl + END IF . + +END PROC wahl getroffen; + +PROC wahl demarkieren (MENUE CONST m, INT CONST wahl, TEXT CONST m zeichen) : + + INT CONST y pos := code (m. feldzeilen SUB wahl); + IF gezeichnete zeilen >= y pos THEN + menuezeile ausgeben (m. bild, y pos, FALSE); + f cursor (2, y pos); + out (m zeichen) + END IF . + +END PROC wahl demarkieren; + +PROC esc hop ausfuehren : + + TEXT VAR + puffer := ""0"", + ausgang; + lernsequenz auf taste legen (""0"", niltext); + push (""27""1""0""0""); + editget (puffer, 1, 1, ""0"", "", ausgang); + out (""8""); + puffer := lernsequenz auf taste (""0""); + IF puffer <> niltext THEN + gelerntes auf richtige taste legen + ELSE + letzten nullcode auslesen + END IF . + +gelerntes auf richtige taste legen : + REP + getchar (ausgang) + UNTIL pos (""1""2""8""11""12"", ausgang) = 0 END REP; + lernsequenz auf taste legen (ausgang, puffer) . + +letzten nullcode auslesen : + getchar (ausgang) . + +END PROC esc hop ausfuehren; + + +BOOL VAR + ist trennung; + +INT VAR + anfang, + ende, + mark ende; + +PROC erstes zeichen ausgeben (SATZ CONST bild, INT CONST bildzeile) : + + f cursor (2, bildzeile); + IF (sperrzeichen SUB bildzeile) <> blank THEN + out (sperrzeichen SUB bildzeile) + ELSE + feld bearbeiten (bild, bildzeile - 1, + PROC (TEXT CONST, INT CONST, INT CONST) zeichen 1) + END IF + +END PROC erstes zeichen ausgeben; + +PROC zeichen 1 (TEXT CONST satz, INT CONST anfang, ende) : + + out (satz SUB anfang + ende - ende) + +END PROC zeichen 1; + +PROC menuezeile ausgeben (SATZ CONST bild, + INT CONST zeilennr, BOOL CONST markiert) : + + enable stop; + f cursor (1, zeilennr); + IF markiert THEN + ist trennung := FALSE; + out (strich senkrecht); + erstes zeichen ausgeben (bild, zeilennr); + out (begin mark); + anfang := 3; mark ende := 1; + bildzeile ausgeben (bild, zeilennr - 1) + ELIF zeilennr = 1 THEN + out oben (x laenge) + ELIF zeilennr = y laenge THEN + out unten (x laenge) + ELIF zeilennr = felderzahl (bild) + 2 THEN + out mitte (x laenge) + ELSE + auf trennung pruefen; + IF (sperrzeichen SUB zeilennr) = "-" THEN + out ("-"); anfang := 2 + ELSE + anfang := 1 + END IF; + mark ende := 0; + bildzeile ausgeben (bild, zeilennr - 1) + END IF . + +auf trennung pruefen : + feld bearbeiten (bild, zeilennr - 1, + PROC (TEXT CONST, INT CONST, INT CONST) trennung feststellen) . + +END PROC menuezeile ausgeben; + +PROC trennung feststellen (TEXT CONST satz, INT CONST von, bis) : + + ist trennung := (satz SUB von + bis - bis) = "-"; + IF NOT ist trennung THEN + out (strich senkrecht) + END IF + +END PROC trennung feststellen; + +PROC menuezeile ausgeben (SATZ CONST bild, INT CONST zeilennr) : + + feld bearbeiten (bild, zeilennr - 1, + PROC (TEXT CONST, INT CONST, INT CONST) trennung feststellen); + anfang := 1; mark ende := 0; + bildzeile ausgeben (bild, zeilennr - 1) + +END PROC menuezeile ausgeben; + +PROC bildzeile ausgeben (SATZ CONST bild, INT CONST zeilennr) : + + IF ist trennung THEN + out mitte (x laenge) + ELSE + zeileninhalt ausgeben + END IF . + +zeileninhalt ausgeben : + feld bearbeiten (bild, zeilennr, + PROC (TEXT CONST, INT CONST, INT CONST) abschnitt ausgeben); + zeilenrest ausgeben . + +zeilenrest ausgeben : + outsubtext (blank 120, 1, x laenge - ende - mark ende - 2); + ggf endemarkierung; + rechte begrenzung . + +ggf endemarkierung : + IF mark ende > 0 THEN + out (end mark) + END IF . + +rechte begrenzung : + out (strich senkrecht) . + +END PROC bildzeile ausgeben; + +PROC abschnitt ausgeben (TEXT CONST t, INT CONST von, bis) : + + INT CONST offset := von - 1; + anfang INCR offset; + ende := min (bis, x laenge + offset - mark ende - 2); + outsubtext (t, anfang, ende); + ende DECR offset + +END PROC abschnitt ausgeben; + +PROC editget kommando : + + LET esc k = ""27"k"; + TEXT VAR + exit char; + fenster veraendert (balkenfenster); + bei fehler altes kommando wiederholen; + markierte zeile ausgeben; + REP + kommando editieren + UNTIL exit char <> esc k END REP; + IF pos (edit kommando , ""33"", ""254"", 1) > 0 THEN + altes kommando := edit kommando + END IF . + +bei fehler altes kommando wiederholen : + IF is error THEN + fehler ausgeben; + edit kommando := altes kommando + ELSE + edit kommando := niltext + END IF . + +markierte zeile ausgeben : + cursor (1, 1); + out (gib kommando); + outsubtext (blank 120, 1, x laenge - 15); + out (end mark) . + +kommando editieren : + cursor (16, 1); + editget (edit kommando, 32000, 62, "", "kh", exit char); + IF is error THEN + clear error + ELIF exit char = esc k THEN + edit kommando := altes kommando + ELIF exit char = esc h THEN + edit kommando := niltext + END IF . + +END PROC edit get kommando; + +PROC existiert nicht (TEXT CONST dateiname) : + + errorstop ("""" + dateiname + """" + t existiert nicht) + +END PROC existiert nicht; + + +(*************************** Auswahl Einlesen ****************************) + +TYPE AUSWAHL = STRUCT (SATZ kopf); + +BOUND ROW 200 AUSWAHL VAR auswahlen; + + +PROC auswahl aus datei lesen : + + TEXT VAR name := text parameter; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + INT VAR index := link (thesaurus (3), name); + IF index = 0 THEN + insert (thesaurus (3), name, index) + END IF; + auswahl aus datei lesen (auswahlen (index)) + END IF + +END PROC auswahl aus datei lesen; + +PROC auswahl aus datei lesen (AUSWAHL VAR a) : + + menue initialisieren; + kopf einlesen; + teste auf ende . + +menue initialisieren : + satz initialisieren (a. kopf) . + +kopf einlesen : + INT VAR zeilennr := 1; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE kopf einlesen + ELSE + kopfzeile bearbeiten; + zeilennr INCR 1 + END IF + END REP . + +kopfzeile bearbeiten : + feld aendern (a. kopf, zeilennr, zeile) . + +teste auf ende : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF . + +END PROC auswahl aus datei lesen; + + +(*************************** Auswahl anbieten ****************************) + +LET + unten = ""10"", + plus esc q = "+"27"q"; + +LET + fenster zu klein = #715# + "Fenster zu klein", + auswahlstatus = #716# +"AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ?"; + +INT VAR + s anfang, + s ende, + wahlen, + kopfzeilen, + max wahllaenge, + gerollt; + +BOOL VAR + mit reihenfolge; + +LET INTVEC = TEXT; + +INTVEC VAR gewaehlt; + + +PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) : + + auswahl anbieten (name, f, 1024, hilfe, niltext, + PROC (TEXT VAR, INT CONST) inhalt) + +END PROC auswahl anbieten; + +PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, INT CONST max wahl, + TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) : + + auswahl anbieten (name, f, max wahl, hilfe, niltext, + PROC (TEXT VAR, INT CONST) inhalt) + +END PROC auswahl anbieten; + +PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, INT CONST max wahl, + TEXT CONST hilfe, anfangswahl, + PROC (TEXT VAR, INT CONST) inhalt) : + + ggf initialisieren; + INT CONST index := link (thesaurus (3), name); + IF index = 0 THEN + existiert nicht (name) + ELSE + anfangswahl initialisieren; + anbieten (auswahlen (index), f, hilfe, max wahl, + PROC (TEXT VAR, INT CONST) inhalt) + END IF . + +anfangswahl initialisieren : + INT VAR i; + gewaehlt := niltext; + FOR i FROM 1 UPTO length (anfangswahl) REP + gewaehlt CAT code (anfangswahl SUB i) + END REP . + +END PROC auswahl anbieten; + +PROC anbieten (AUSWAHL CONST a, FENSTER CONST f, TEXT CONST hilfe, + INT CONST max wahl, + PROC (TEXT VAR, INT CONST) inhalt) : + + INT VAR + gezeichnete zeilen := 0, + tastenzustand := 0; + enable stop; + fensterzugriff durchfuehren; + status anzeigen (auswahlstatus); + anzahl der wahlen feststellen; + bildparameter berechnen; + auswahl initialisieren; + REP + auf eingabe warten; + auswahlfunktion durchfuehren + END REP . + +fensterzugriff durchfuehren : + BOOL VAR dummy; + fensterzugriff (f, dummy); + fenstergroesse (f, x pos, y pos, x laenge, y laenge) . + +anzahl der wahlen feststellen : + INT VAR + schritt := 1024; + wahlen := schritt; + REP + schritt := schritt DIV 2; + inhalt (zeile, wahlen); + IF zeile = niltext THEN + wahlen DECR schritt + ELSE + wahlen INCR schritt + END IF + UNTIL schritt = 1 END REP; + inhalt (zeile, wahlen); + IF zeile = niltext THEN wahlen DECR 1 END IF . + +bildparameter berechnen : + kopfzeilen := felderzahl (a. kopf) + 2; + gerollt := 0; + scroll bar berechnen; + IF kopfzeilen >= y laenge THEN + errorstop (fenster zu klein) + END IF . + +auswahl initialisieren : + INT VAR + akt zeile := kopfzeilen + 1, + alte akt zeile, + akt wahl := 1; + mit reihenfolge := max wahl > 1 . + +auf eingabe warten : + REP + ausgabe und zeichen annehmen; + IF is error THEN + clear error; + gezeichnete zeilen := 0 + ELSE + LEAVE auf eingabe warten + END IF + END REP . + +ausgabe und zeichen annehmen : + TEXT VAR eingabe; + WHILE gezeichnete zeilen < y laenge REP + eingabe := getcharety; + eventuell eine zeile ausgeben + END REP; + cursor positionieren; + getchar mit enable stop (eingabe) . + +eventuell eine zeile ausgeben : + IF eingabe = niltext THEN + IF gezeichnete zeilen = kopfzeilen THEN + alte akt zeile := 999; + max wahllaenge := 10 + END IF; + gezeichnete zeilen INCR 1; + entsprechende zeile ausgeben + ELSE + LEAVE ausgabe und zeichen annehmen + END IF . + +entsprechende zeile ausgeben : + f cursor (1, gezeichnete zeilen); + IF gezeichnete zeilen <= kopfzeilen THEN + kopfzeile ausgeben + ELSE + wiederholungszeile ausgeben + END IF . + +kopfzeile ausgeben : + IF gezeichnete zeilen = 1 THEN + out oben (x laenge) + ELIF gezeichnete zeilen = kopfzeilen THEN + out mitte (x laenge) + ELSE + menuezeile ausgeben (a. kopf, gezeichnete zeilen) + END IF . + +wiederholungszeile ausgeben : + INT CONST tatsaechliche zeile := + gezeichnete zeilen + gerollt - kopfzeilen; + IF gezeichnete zeilen = y laenge THEN + out unten (x laenge) + ELIF tatsaechliche zeile <= wahlen THEN + auswahlzeile ausgeben (tatsaechliche zeile, + scroll on zeile, FALSE, + PROC (TEXT VAR, INT CONST) inhalt); + max wahllaenge := max (max wahllaenge, length (zeile)) + ELIF tatsaechliche zeile = wahlen + 1 THEN + out mitte (x laenge) + ELSE + out (strich senkrecht); + outsubtext (blank 120, 1, x laenge - 2); + out (strich senkrecht) + END IF . + +scroll on zeile : + gezeichnete zeilen >= s anfang AND gezeichnete zeilen <= s ende . + +cursor positionieren : + IF akt zeile <> alte akt zeile THEN + IF alte akt zeile <= gezeichnete zeilen THEN + alte zeile demarkieren + END IF; + neue zeile markieren + END IF; + cursor (1, 1) . +(* f cursor (5, akt zeile) .*) + +alte zeile demarkieren : + f cursor (5, alte akt zeile); + auswahlzeile ausgeben (alte akt zeile + gerollt - kopfzeilen, FALSE, + PROC (TEXT VAR, INT CONST) inhalt) . + +neue zeile markieren : + f cursor (5, akt zeile); + auswahlzeile ausgeben (akt wahl, TRUE, + PROC (TEXT VAR, INT CONST) inhalt); + alte akt zeile := akt zeile . + +auswahlfunktion durchfuehren : + SELECT tastenzustand OF + CASE 0 : normale funktion + CASE 1 : hop funktion + CASE 2 : esc funktion + END SELECT . + +normale funktion : + SELECT pos (""1""3""10""13""27" +x-o", eingabe) OF + CASE 1 : tastenzustand := 1 + CASE 2 : oben ausfuehren + CASE 3 : unten ausfuehren + CASE 4 : return ausfuehren + CASE 5 : tastenzustand := 2 + CASE 6 : leertaste ausfuehren + CASE 7, 8 : plus ausfuehren + CASE 9, 10 : minus ausfuehren + OTHERWISE sondertaste + END SELECT . + +hop funktion : + SELECT pos (""3""10"+x-o", eingabe) OF + CASE 1 : hop oben ausfuehren + CASE 2 : hop unten ausfuehren + CASE 3, 4 : hop plus ausfuehren + CASE 5, 6 : hop minus ausfuehren + OTHERWISE out (piep) + END SELECT; + tastenzustand := 0 . + +esc funktion : + SELECT pos (""1"19?qh", eingabe) OF + CASE 1 : esc hop ausfuehren + CASE 2 : esc 1 ausfuehren + CASE 3 : esc 9 ausfuehren + CASE 4 : esc fragezeichen ausfuehren + CASE 5 : esc q ausfuehren + CASE 6 : errorstop (niltext) + OTHERWISE belegte taste + END SELECT; + tastenzustand := 0 . + +oben ausfuehren : + IF akt wahl > 1 THEN + akt zeile DECR 1; + akt wahl DECR 1; + IF akt zeile <= kopfzeilen THEN + akt zeile INCR 1; + gerollt DECR 1; + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF + END IF . + +unten ausfuehren : + IF akt wahl < wahlen THEN + akt zeile INCR 1; + akt wahl INCR 1; + IF akt zeile >= y laenge THEN + akt zeile DECR 1; + gerollt INCR 1; + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF + END IF . + +return ausfuehren : + push (unten) . + +leertaste ausfuehren : + push (plus esc q) . + +plus ausfuehren : + IF wahlpos (akt wahl) = 0 AND akt wahl <= wahlen THEN + wahl aufnehmen; + wahl sichtbar machen + END IF . + +wahl aufnehmen : + BOOL CONST an grenze := abs (max wahl) <= length (gewaehlt) DIV 2; + IF an grenze THEN + gewaehlt := subtext (gewaehlt, 3) + END IF; + gewaehlt CAT akt wahl . + +wahl sichtbar machen : + IF an grenze THEN + wahlpositionen ausgeben + ELIF akt zeile <= gezeichnete zeilen THEN + wahlnummer (akt zeile, length (gewaehlt) DIV 2) + END IF . + +minus ausfuehren : + INT CONST alte pos := wahlpos (akt wahl); + IF alte pos > 0 THEN + wahl entfernen; + wahlpositionen ausgeben + END IF . + +wahl entfernen : + change (gewaehlt, 2 * alte pos - 1, 2 * alte pos, niltext) . + +sondertaste : + IF eingabe < blank THEN + push (lernsequenz auf taste (eingabe)) + ELSE + out (piep) + END IF . + +hop oben ausfuehren : + IF akt zeile = kopfzeilen + 1 THEN + nach oben rollen + ELSE + nach oben + END IF . + +nach oben rollen : + INT VAR um := min (y laenge - kopfzeilen - 1, gerollt); + gerollt DECR um; + akt wahl DECR um; + IF um > 0 THEN + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF . + +nach oben : + um := akt zeile - kopfzeilen - 1; + akt zeile DECR um; + akt wahl DECR um . + +hop unten ausfuehren : + IF akt zeile = y laenge - 1 THEN + nach unten rollen + ELSE + nach unten + END IF . + +nach unten rollen : + um := min (y laenge - kopfzeilen - 1, wahlen - akt wahl); + gerollt INCR um; + akt wahl INCR um; + IF um > 0 THEN + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF . + +nach unten : + um := min (wahlen - akt wahl, y laenge - akt zeile - 1); + akt zeile INCR um; + akt wahl INCR um . + +hop plus ausfuehren : + IF wahlen > abs (max wahl) THEN + out (piep); LEAVE hop plus ausfuehren + END IF; + INT VAR w; + FOR w FROM 1 UPTO wahlen REP + IF wahlpos (w) = 0 THEN + gewaehlt CAT w + END IF + END REP; + wahlpositionen ausgeben . + +hop minus ausfuehren : + gewaehlt := niltext; + wahlpositionen ausgeben . + +esc fragezeichen ausfuehren : + hilfe anbieten (hilfe, f); + status anzeigen (auswahlstatus); + gezeichnete zeilen := 0 . + +esc q ausfuehren : + LEAVE anbieten . + +belegte taste : + push (lernsequenz auf taste (eingabe)) . + +esc 1 ausfuehren : + akt zeile := kopfzeilen + 1; + akt wahl := 1; + gerollt := 0; + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) . + +esc 9 ausfuehren : + INT CONST letzte zeile := kopfzeilen + wahlen; + IF letzte zeile < y laenge THEN + akt zeile := letzte zeile; + gerollt := 0 + ELSE + akt zeile := y laenge - 1; + gerollt := letzte zeile - y laenge + 1; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF; + scroll bar berechnen; + akt wahl := wahlen . + +END PROC anbieten; + +PROC wahlpositionen ausgeben : + + INT VAR z, w; + w := erste angezeigte wahl; + FOR z FROM erste wahlzeile UPTO letzte wahlzeile REP + wahlnummer (z, wahlpos (w)); + w INCR 1 + END REP . + +erste angezeigte wahl : + gerollt + 1 . + +erste wahlzeile : + kopfzeilen + 1 . + +letzte wahlzeile : + min (y laenge - 1, kopfzeilen + wahlen) . + +END PROC wahlpositionen ausgeben; + +PROC scrollbar berechnen : + + INT CONST s laenge := y laenge - kopfzeilen - 1; + IF gerollt = 0 THEN + s anfang := 1 + ELSE + s anfang := max (1, gerollt * s laenge DIV wahlen) + 1 + END IF; + IF wahlen <= s laenge THEN + s ende := wahlen + ELIF wahlen - gerollt = s laenge THEN + s ende := s laenge + ELSE + s ende := min (s anfang + s laenge * s laenge DIV wahlen, s laenge - 1) + END IF; + s anfang INCR kopfzeilen; + s ende INCR kopfzeilen + +END PROC scrollbar berechnen; + + +TEXT VAR zwei bytes := "xx"; + +INT PROC wahlpos (INT CONST feld) : + + replace (zwei bytes, 1, feld); + INT VAR p := 0; + REP + p := pos (gewaehlt, zwei bytes, p + 1) + UNTIL p = 0 OR p MOD 2 = 1 END REP; + (p + 1) DIV 2 + +END PROC wahlpos; + +OP CAT (INTVEC VAR intvec, INT CONST wert) : + + replace (zwei bytes, 1, wert); + intvec CAT zwei bytes + +END OP CAT; + +PROC auswahlzeile ausgeben (INT CONST erste wahl, + BOOL CONST scroll ein, markiert, + PROC (TEXT VAR, INT CONST) inhalt) : + + out (strich senkrecht); + position ausgeben; + auswahlzeile ausgeben (erste wahl, markiert, + PROC (TEXT VAR, INT CONST) inhalt); + scrollbar ausgeben; + out (strich senkrecht) . + +position ausgeben : + INT CONST n := wahlpos (erste wahl); + IF n = 0 THEN + out (" ") + ELIF mit reihenfolge THEN + out (text (n, 3)); + ELSE + out (" x ") + END IF . + +scrollbar ausgeben : + IF scroll ein THEN out (scroll voll) ELSE out (scroll leer) END IF . + +END PROC auswahlzeile ausgeben; + +PROC auswahlzeile ausgeben (INT CONST erste wahl, BOOL CONST markiert, + PROC (TEXT VAR, INT CONST) inhalt) : + + inhalt (zeile, erste wahl); + INT VAR f laenge := min (x laenge - 8, length (zeile)); + IF markiert THEN + f laenge := min (f laenge, x laenge - 9); + out (""15"") + ELSE + out (" ") + END IF; + outsubtext (zeile, 1, f laenge); + zeilenrest loeschen . + +zeilenrest loeschen : + IF markiert THEN + outsubtext (blank 120, 1, max wahllaenge - f laenge + 1); + out (""14""); + outsubtext (blank 120, 1, x laenge - max wahllaenge - 10) + ELSE + outsubtext (blank 120, 1, x laenge - f laenge - 8) + END IF . + +END PROC auswahlzeile ausgeben; + +PROC wahlnummer (INT CONST zeile, wert) : + + f cursor (2, zeile); + IF wert = 0 THEN + out (" ") + ELIF mit reihenfolge THEN + out (text (wert, 3)) + ELSE + out (" x ") + END IF + +END PROC wahlnummer; + +INT PROC wahl (INT CONST stelle) : + + IF stelle + stelle <= length (gewaehlt) THEN + gewaehlt ISUB stelle + ELSE + 0 + END IF + +END PROC wahl; + + +(************************ Hilfen *****************************************) + +LET + maxgebiete = 200, + maxseiten = 5000; + +LET HILFE = STRUCT ( + INT anzahl seiten, + ROW maxgebiete THESAURUS hilfsnamen, + ROW maxgebiete SATZ seitenindex, + ROW maxseiten SATZ seiten); + +BOUND HILFE VAR h; + +INT VAR hx, hy, hxl, hyl; + +BOOL VAR hilfen sparen := FALSE; + +TEXT VAR zeilenpuffer; + + +(************************* Hilfe einlesen ********************************) + +LET + hilfsgebiet existiert bereits = #717# + "Das Hilfsgebiet existiert bereits", + seite existiert nicht = #718# + "Diese Seite ist in der anderen Hilfe nicht vorhanden"; + + +PROC hilfe aus datei lesen : + + TEXT VAR name := text parameter; + BOOL VAR hilfe ueberspringen; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + eintrag reservieren; + seiten einlesen; + hilfe abspeichern + END IF . + +eintrag reservieren : + INT CONST trennung := pos (name, "/"); + TEXT VAR gebiet; + IF trennung = 0 THEN + gebiet := name + ELSE + gebiet := subtext (name, 1, trennung - 1) + END IF; + gebietsindex bestimmen; + einzelindex bestimmen . + +gebietsindex bestimmen : + INT VAR gebietsindex := link (thesaurus (1), gebiet); + hilfe ueberspringen := FALSE; + IF gebietsindex = 0 THEN + insert (thesaurus (1), gebiet, gebietsindex); + h. hilfsnamen (gebietsindex) := empty thesaurus; + satz initialisieren (h. seitenindex (gebietsindex)); + ELIF trennung = 0 THEN + fehler (hilfsgebiet existiert bereits); + LEAVE hilfe aus datei lesen + ELIF hilfen sparen THEN + hilfe ueberspringen := TRUE + END IF . + +einzelindex bestimmen : + INT VAR einzelindex; + TEXT VAR einzelname := subtext (name, trennung + 1); + IF trennung = 0 THEN + einzelindex := 1 + ELSE + einzelindex := link (h. hilfsnamen (gebietsindex), einzelname); + IF einzelindex = 0 AND NOT hilfe ueberspringen THEN + insert (h. hilfsnamen (gebietsindex), einzelname, einzelindex) + END IF + END IF . + +seiten einlesen : + INT VAR vorlaeufige seiten := h. anzahl seiten; + IF vorlaeufige seiten < 0 THEN + vorlaeufige seiten := 0 + END IF; + TEXT VAR alle seiten := niltext; + zeile lesen; + WHILE kommandozeile CAND kommando ist (seite kommando) REP + eine seite einlesen + END REP . + +eine seite einlesen : + INT CONST seitennr := int parameter; + TEXT CONST referenz := text parameter; + IF referenz <> niltext THEN + seitenreferenz besorgen; + zeile lesen + ELSE + neue seite einlesen + END IF . + +seitenreferenz besorgen : + TEXT VAR referenzseiten; + seiten bestimmen (referenz, referenzseiten); + IF seitennr + seitennr <= length (referenzseiten) THEN + alle seiten CAT (referenzseiten ISUB seitennr) + ELIF NOT (anything noted OR hilfe ueberspringen) THEN + fehler (seite existiert nicht) + END IF . + +neue seite einlesen : + INT VAR zeilennr := 1; + IF NOT hilfe ueberspringen THEN + vorlaeufige seiten INCR 1; + alle seiten CAT vorlaeufige seiten; + satz initialisieren (h. seiten (vorlaeufige seiten)) + END IF; + zeilenpuffer := niltext; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE neue seite einlesen + ELIF NOT hilfe ueberspringen THEN + zeile in hilfe einfuegen + END IF + END REP . + +zeile in hilfe einfuegen : + zeilenpuffer CAT zeile; + feld aendern (h. seiten (vorlaeufige seiten), zeilennr, zeilenpuffer); + IF absatzzeile THEN + zeilennr INCR 1; + zeilenpuffer := niltext + ELSE + zeilenpuffer CAT blank + END IF . + +absatzzeile : + (zeilenpuffer SUB LENGTH zeilenpuffer) = blank . + +hilfe abspeichern : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF; + IF NOT (anything noted OR hilfe ueberspringen) THEN + feld aendern (h. seitenindex (gebietsindex), einzelindex, alle seiten); + h. anzahl seiten := vorlaeufige seiten + END IF . + +END PROC hilfe aus datei lesen; + +PROC seiten bestimmen (TEXT CONST name, TEXT VAR alle seiten) : + + INT CONST trennung := pos (name, "/"); + INT VAR + gebiet, + einzelindex := 0; + IF trennung = 0 THEN + gebiet := link (thesaurus (1), name) + ELSE + gebiet := link (thesaurus (1), subtext (name, 1, trennung - 1)); + einzelindex suchen + END IF; + IF einzelindex = 0 THEN + einzelindex := 1 + END IF; + IF gebiet = 0 THEN + errorstop (hilfe existiert nicht) + ELSE + feld lesen (h. seitenindex (gebiet), einzelindex, alle seiten) + END IF . + +einzelindex suchen : + IF gebiet > 0 THEN + einzelindex := + link (h. hilfsnamen (gebiet), subtext (name, trennung + 1)) + END IF . + +END PROC seiten bestimmen; + + +(************************* Hilfe anbieten ********************************) + +LET + hilfe existiert nicht = #719# + "Hilfe existiert nicht", + hilfe ist leer = #720# + "Hilfe ist leer", + t seite nr = #721# + " Seite ", + t seite von = #722# + " von ", + hilfe status = #723# +"HILFE: Beenden: ESC q Seite weiter: ESC UNTEN Seite zurueck: ESC OBEN"; + + +TEXT VAR seitenkopf; + +INT VAR + einrueckbreite, + hilfszeilennr, + hilfsanfang; + +BOOL VAR ausfuehrliche hilfe := TRUE; + + +PROC viel hilfe (BOOL CONST wirklich) : + ausfuehrliche hilfe := wirklich +END PROC viel hilfe; + +BOOL PROC viel hilfe : ausfuehrliche hilfe END PROC viel hilfe; + + +PROC hilfe anbieten (TEXT CONST name, FENSTER CONST f) : + + enable stop; + ggf initialisieren; + TEXT VAR alle seiten; + fensterzugriff anmelden; + seiten bestimmen (name, alle seiten); + IF alle seiten = niltext THEN + errorstop (hilfe ist leer) + ELSE + seiten ausgeben + END IF . + +fensterzugriff anmelden : + fenster veraendert (f); + fenstergroesse (f, hx, hy, hxl, hyl) . + +seiten ausgeben : + INT CONST hilfeseiten := length (alle seiten) DIV 2; + tastenpuffer loeschen; + status anzeigen (hilfe status); + INT VAR seitenindex := 1; + REP + eine seite ausgeben; + kommando annehmen + END REP . + +eine seite ausgeben : + INT CONST tatsaechliche seite := alle seiten ISUB seitenindex; + seitenkopf := t seite nr + text (seitenindex) + t seite von; + seitenkopf CAT text (hilfeseiten); seitenkopf CAT " "; + IF length (seitenkopf) + 2 > hxl THEN seitenkopf := niltext END IF; + seite ausgeben (h. seiten (tatsaechliche seite)) . + +kommando annehmen : + TEXT VAR eingabe; + REP + getchar (eingabe); + IF eingabe = esc THEN + getchar (eingabe); + kommando ausfuehren; + LEAVE kommando annehmen + ELSE + out (piep) + END IF + END REP . + +kommando ausfuehren : + SELECT pos ("q"10""3"?"1"", eingabe) OF + CASE 1 : LEAVE hilfe anbieten + CASE 2 : eine seite weiter + CASE 3 : eine seite zurueck + CASE 4 : an anfang + CASE 5 : esc hop ausfuehren + OTHERWISE out (piep) + END SELECT . + +eine seite weiter : + IF seitenindex < hilfeseiten THEN + seitenindex INCR 1 + END IF . + +eine seite zurueck : + IF seitenindex > 1 THEN + seitenindex DECR 1 + END IF . + +an anfang : + seitenindex := 1 . + +END PROC hilfe anbieten; + +PROC seite ausgeben (SATZ CONST seite) : + + INT VAR zeilennr; + hilfszeilennr := 1; + hilfsanfang := 0; + kopfzeile ausgeben; + einrueckbreite := 0; + FOR zeilennr FROM 1 UPTO hyl - 2 REP + cursor (hx, hy + zeilennr); + feld bearbeiten (seite, hilfszeilennr, + PROC (TEXT CONST, INT CONST, INT CONST) zeile ausgeben) + END REP; + letzte zeile ausgeben . + +kopfzeile ausgeben : + cursor (hx, hy); + out oben (hxl, seitenkopf) . + +letzte zeile ausgeben : + cursor (hx, hy + hyl - 1); + out unten (hxl); + cursor (1, 1) . + +END PROC seite ausgeben; + +PROC zeile ausgeben (TEXT CONST bild, INT CONST von, bis) : + + ende := min (hilfsanfang + von + hxl - 3 - einrueckbreite, bis); + IF von <= bis CAND (bild SUB von) = "-" THEN + out mitte (hxl); + hilfszeilennr INCR 1; + einrueckbreite := 0 + ELSE + umbruch; + wirklich ausgeben; + naechsten zeilenanfang setzen + END IF . + +umbruch : + IF ende < bis THEN + IF umbruch noetig CAND umbruch moeglich THEN + ende zuruecksetzen + END IF + END IF . + +umbruch noetig : + (bild SUB ende + 1) <> " " AND (bild SUB ende) <> " " . + +umbruch moeglich : + pos (bild, " ", hilfsanfang + von, ende) > 0 . + +ende zuruecksetzen : + WHILE (bild SUB ende) <> " " REP ende DECR 1 END REP . + +wirklich ausgeben : + out (strich senkrecht); + outsubtext (blank 120, 1, einrueckbreite); + outsubtext (bild, von + hilfsanfang, ende); + outsubtext (blank 120, 1, + hxl + von + hilfsanfang - einrueckbreite - ende - 3); + out (strich senkrecht) . + +naechsten zeilenanfang setzen : + IF ende < bis THEN + ggf einrueckbreite setzen; + hilfsanfang := ende - von + 1; + ende INCR 1; + WHILE (bild SUB ende) = " " REP + hilfsanfang INCR 1; ende INCR 1 + END REP + ELSE + hilfsanfang := 0; + hilfszeilennr INCR 1; + einrueckbreite := 0 + END IF . + +ggf einrueckbreite setzen : + IF einrueckbreite = 0 CAND hilfsanfang = 0 THEN + einrueckbreite := pos (bild, " ", von, ende); + IF einrueckbreite > 0 THEN + einrueckbreite auf wortanfang + END IF + END IF . + +einrueckbreite auf wortanfang : + WHILE (bild SUB einrueckbreite) = " " REP + einrueckbreite INCR 1 + END REP; + einrueckbreite DECR von . + +END PROC zeile ausgeben; + + +(*********************** Statuszeile *************************************) + +BOOL VAR status zeigen := TRUE; + +PROC statuszeile (BOOL CONST modus) : + status zeigen := modus +END PROC statuszeile; + +BOOL PROC statuszeile : + status zeigen +END PROC statuszeile; + + +PROC status anzeigen (TEXT CONST status) : + + IF status zeigen THEN + cursor (1, 1); out (" "); + out (status); + out (cl eol); + fenster veraendert (balkenfenster) + END IF + +END PROC status anzeigen; + + +(***************************** Basisauswahl *******************************) + +LET max funktionen = 20; + +ROW max funktionen INT VAR w anf; + +INT VAR + position, + gesamtlaenge, + h zeile, + p zeile, + cursor x alt, + cursor y alt; + +TEXT VAR prompt; + + +PROC basisauswahl (MENUE CONST m, INT CONST x anf, INT VAR wahl) : + + enable stop; + BOOL VAR menue ausgegeben := FALSE; + REP + IF NOT menue ausgegeben THEN + menue ausgeben + END IF; + zeichen annehmen; + kommando ausfuehren + END REP . + +menue ausgeben : + INT VAR i; + cursor (x anf, h zeile); + position := x anf; + w anf (1) := position; + FOR i FROM 1 UPTO felderzahl (m. bild) REP + out (" "); position INCR 1; + feld bearbeiten (m. bild, i, + PROC (TEXT CONST, INT CONST, INT CONST) m out incr); + out (" "); position INCR 1; + w anf (i + 1) := position; + END REP; + gesamtlaenge := position; + menue ausgegeben := TRUE; + aktuelle wahl markieren (m. bild, wahl) . + +zeichen annehmen : + TEXT VAR zeichen; + getchar (zeichen) . + +kommando ausfuehren : + SELECT pos (""2""8""13" "1""27"", zeichen) OF + CASE 1 : neue wahl (m. bild, wahl, wahl + 1) + CASE 2 : neue wahl (m. bild, wahl, wahl - 1) + CASE 3, 4 : exit wahl (m. bild, wahl); LEAVE basisauswahl + CASE 5 : hop kommando + CASE 6 : esc kommando + OTHERWISE direkte wahl + END SELECT . + +direkte wahl: + INT VAR d pos := 0; + REP + d pos := pos (m. feldtasten, zeichen, d pos + 1) + UNTIL (d pos MOD 2) = 0 END REP; + IF d pos = 0 THEN + IF zeichen < ""32"" THEN push (""27"" + zeichen) ELSE out (""7"") END IF + ELSE + neue wahl (m. bild, wahl, code (m. feldtasten SUB d pos - 1)); + exit wahl (m. bild, wahl); + LEAVE basisauswahl + END IF . + +esc kommando : + TEXT VAR zweites; + getchar (zweites); + SELECT pos (""1"qh?"27"", zweites) OF + CASE 1 : esc hop ausfuehren + CASE 2 : wahl := 0; LEAVE basisauswahl + CASE 3 : errorstop ("") + CASE 4 : exit wahl (m. bild, wahl); wahl := - wahl; + LEAVE basisauswahl + CASE 5 : wahl := - 32000; LEAVE basisauswahl + OTHERWISE push (lernsequenz auf taste (zweites)) + END SELECT . + +hop kommando : + getchar (zweites); + SELECT pos (""8""2"", zweites) OF + CASE 1 : neue wahl (m. bild, wahl, 1) + CASE 2 : neue wahl (m. bild, wahl, felderzahl (m. bild)) + OTHERWISE out (""7"") + END SELECT . + +END PROC basisauswahl; + +PROC menueheader (SATZ CONST bild, INT CONST wahl) : + + IF p zeile > 0 THEN + cursor (1, p zeile); + out (""15""); out (prompt); position := length (prompt) + 1; + feld bearbeiten (bild, wahl, + PROC (TEXT CONST, INT CONST, INT CONST) m out rechts); + out (" "14"") + END IF + +END PROC menueheader; + +PROC aktuelle wahl markieren (SATZ CONST bild, INT CONST wahl) : + + menueheader (bild, wahl); + cursor (w anf (wahl), h zeile); + out (""15""); + feld bearbeiten (bild, wahl, + PROC (TEXT CONST, INT CONST, INT CONST) m out); + out (" "14""); + cursor (cursor x alt, cursor y alt) + +END PROC aktuelle wahl markieren; + +PROC neue wahl (SATZ CONST bild, INT VAR wahl, INT CONST neu) : + + alte wahl demarkieren; + wahl := neu; + IF wahl < 1 THEN + wahl := felderzahl (bild) + ELIF wahl > felderzahl (bild) THEN + wahl := 1 + END IF; + aktuelle wahl markieren (bild, wahl) . + +alte wahl demarkieren : + cursor (w anf (wahl), h zeile); + out (" "); + feld bearbeiten (bild, wahl, + PROC (TEXT CONST, INT CONST, INT CONST) m out); + out (" ") . + +END PROC neue wahl; + +PROC exit wahl (SATZ CONST bild, INT CONST wahl) : + + cursor (w anf (1), h zeile); + w anf (wahl) - w anf (1) + 1 TIMESOUT " "; + feld bearbeiten (bild, wahl, + PROC (TEXT CONST, INT CONST, INT CONST) m out); + gesamtlaenge - w anf (wahl + 1) + 2 TIMESOUT " " + +END PROC exit wahl; + +PROC m out incr (TEXT CONST satz, INT CONST von, bis) : + + INT VAR grenze := pos (satz, " ", von) - 1; + IF grenze < 0 THEN grenze := bis END IF; + outsubtext (satz, von, grenze); + position INCR grenze - von + 1 + +END PROC m out incr; + +PROC m out (TEXT CONST satz, INT CONST von, bis) : + + INT VAR grenze := pos (satz, " ", von) - 1; + IF grenze < 0 THEN grenze := bis END IF; + outsubtext (satz, von, grenze) + +END PROC m out; + +PROC m out rechts (TEXT CONST satz, INT CONST von, bis) : + + INT VAR grenze := pos (satz, " ", von) + 1; + IF grenze < 2 THEN grenze := bis + 1 END IF; + x size - 5 - position - bis + grenze TIMESOUT " "; + outsubtext (satz, grenze, bis) + +END PROC m out rechts; + +PROC zeilenmenue anbieten (TEXT CONST m name, BOOL CONST esc erlaubt, + PROC (INT CONST) kommandos) : + + BOOL VAR save zeilenmenue := ist zeilenmenue; + INT VAR m index := link (thesaurus (2), m name); + IF m index = 0 THEN + existiert nicht (m name); LEAVE zeilenmenue anbieten + END IF; + h zeile := y size; p zeile := y size - 1; + get cursor (cursor x alt, cursor y alt); + prompt := m name; + disable stop; + ist zeilenmenue := TRUE; + auswahl durchfuehren; + kommando ausfuehren; + ist zeilenmenue := save zeilenmenue . + +auswahl durchfuehren : + INT VAR wahl := 1; + REP + basisauswahl (menues (m index), 1, wahl); + IF wahl >= 0 THEN + LEAVE auswahl durchfuehren + ELIF wahl = -32000 THEN + IF esc erlaubt THEN LEAVE auswahl durchfuehren END IF + ELSE + wahl := - wahl; + TEXT VAR hilfsname; + feld lesen (menues (m index). hilfen, wahl, hilfsname); + hilfe anbieten (hilfsname, d fenster) + END IF + UNTIL is error END REP . + +kommando ausfuehren : + IF wahl > 0 THEN + exec im enable stop (wahl, PROC (INT CONST) kommandos) + ELIF wahl = - 32000 THEN + gib kommando im menue + END IF . + +gib kommando im menue : + cursor (1, y size - 1); + out (""4""); out (gib kommando); out (""14""); + TEXT VAR dummy := ""; + editget (dummy); + IF dummy <> "" THEN + do (dummy) + END IF . + +END PROC zeilenmenue anbieten; + +PROC exec im enable stop (INT CONST wahl, PROC (INT CONST) kommandos) : + + enable stop; + kommandos (wahl) + +END PROC exec im enable stop; + + +(******************************* Dialog **********************************) + +LET + cleop = ""4"", + esc fragezeichen = ""27"?", + esc q = ""27"q", + esc h = ""27"h"; + +LET +(*ja text = #724# + " Ja ", + nein text = #725# + "Nein",*) + fragezeichen = #726# + " ?", + horizontal auswahl status = #727# +"WAHL: Wählen: <-, -> Bestätigen: RETURN Abbruch: ESC h Hilfe: ESC ?", + ja status = #728# +"FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ?", + editget status ohne esc z = #729# +"EINGABE: Bestätigen: RETURN Abbrechen: ESC h Hilfe: ESC ?", + editget status mit esc z = #730# +"EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbruch: ESC h Hilfe: ESC ?", + fehler status = #731# +""15"!!! FEHLER !!! "14" Quittieren: ESC q Hilfe zur Meldung: ESC ?"; + +FENSTER VAR d fenster; +fenster initialisieren (d fenster); + +INT VAR + dialogzeile, + dx, + dy, + dxl, + dyl; + + +PROC dialogfenster (FENSTER CONST fe) : + + fenstergroesse (fe, dx, dy, dxl, dyl); + fenstergroesse setzen (d fenster, fe) + +END PROC dialogfenster; + +FENSTER PROC dialogfenster : + + d fenster + +END PROC dialogfenster; + +PROC neuer dialog : + + dialogzeile := dyl + +END PROC neuer dialog; + +PROC dialog box : + + BOOL VAR veraendert; + fensterzugriff (d fenster, veraendert); + dialogzeile INCR 3; + IF dialogzeile + 3 > dyl OR veraendert THEN + loeschvorgang dialogfenster; + dialogzeile := 1 + END IF; + rahmen zeichnen; + cursor (dx + 1, dy + dialogzeile) . + +rahmen zeichnen : + cursor (dx, dy + dialogzeile - 1); + out oben (dxl); + cursor (dx, dy + dialogzeile); + leere boxzeile; + cursor (dx, dy + dialogzeile + 1); + leere boxzeile; + cursor (dx, dy + dialogzeile + 2); + out unten (dxl) . + +END PROC dialog box; + +PROC leere boxzeile : + + out (strich senkrecht); + outsubtext (blank 120, 1, dxl - 2); + out (strich senkrecht) + +END PROC leere boxzeile; + +PROC dialog (TEXT CONST ausgabe) : + + dialog box; + outsubtext (ausgabe, 1, dxl - 2); + cursor (dx + 1, dy + dialogzeile + 1) + +END PROC dialog; + +PROC dialogfenster loeschen : + + fenster veraendert (d fenster); + loeschvorgang dialogfenster + +END PROC dialogfenster loeschen; + +PROC loeschvorgang dialogfenster : + + BOOL CONST bis zeilenende := dx + dxl >= x size; + dialogzeile := 0; + REP + cursor (dx, dy + dialogzeile); + IF bis zeilenende THEN + out (cleol) + ELSE + outsubtext (blank 120, 1, dxl) + END IF; + dialogzeile INCR 1 + UNTIL dialogzeile >= dyl END REP + +END PROC loeschvorgang dialogfenster; + +PROC auswahl anbieten (TEXT CONST m name, prompt, hilfe, INT VAR ergebnis) : + + INT VAR auswahl nr := link (thesaurus (2), m name); + IF auswahl nr = 0 THEN + existiert nicht (m name); LEAVE auswahl anbieten + END IF; + REP + status anzeigen (horizontal auswahl status); + dialog box; + outsubtext (prompt, 1, dxl - 2); + auswahl durchfuehren + END REP . + +auswahl durchfuehren : + INT CONST alte wahl := ergebnis; + h zeile := dy + dialogzeile + 1; p zeile := 0; + cursor x alt := 1; cursor y alt := 1; + basisauswahl (menues (auswahl nr), dx + 1, ergebnis); + IF ergebnis >= 0 THEN + IF ergebnis = 0 THEN ergebnis := alte wahl END IF; + LEAVE auswahl anbieten + ELIF ergebnis = - 32000 THEN + ergebnis := 1 + ELSE + hilfe anbieten (hilfe, d fenster); + neuer dialog; + ergebnis := - ergebnis + END IF . + +END PROC auswahl anbieten; + +BOOL PROC ja (TEXT CONST frage, hilfe) : + + ja (frage, hilfe, TRUE) + +END PROC ja; + +BOOL PROC ja (TEXT CONST frage, hilfe, BOOL CONST default) : + + INT VAR wahl; + IF default THEN wahl := 1 ELSE wahl := 2 END IF; + REP + status anzeigen (ja status); + IF ist zeilenmenue THEN + cursor (1, y size); + INT CONST fragelaenge := min (length (frage), x size - 16); + outsubtext (frage, 1, fragelaenge); out (""5"") + ELSE + dialog box; + outsubtext (frage, 1, dxl - 4); + END IF; + out (fragezeichen); + tastenpuffer loeschen; + ja auswahl durchfuehren + END REP; + FALSE . + +ja auswahl durchfuehren : + basisauswahl initialisieren; + basisauswahl (ja auswahl, auswahl anfang, wahl); + IF wahl = 1 THEN + LEAVE ja WITH TRUE + ELIF wahl = 2 THEN + LEAVE ja WITH FALSE + ELIF wahl = -32000 THEN + wahl := 1 + ELIF wahl = 0 THEN + errorstop ("") + ELSE + hilfe anbieten (hilfe, d fenster); + neuer dialog; + wahl := - wahl + END IF . + +basisauswahl initialisieren : + INT VAR auswahl anfang; + IF ist zeilenmenue THEN + h zeile := y size; p zeile := 0; + auswahl anfang := fragelaenge + 4 + ELSE + h zeile := dy + dialogzeile + 1; p zeile := 0; + cursor x alt := 1; cursor y alt := 1; + auswahl anfang := dx + 1 + END IF . + +ja auswahl : + menues (link (thesaurus (2), "WAHL.Ja")) . + +END PROC ja; + +PROC editget (TEXT CONST prompt, TEXT VAR eingabe, TEXT CONST res, hilfe) : + + TEXT VAR exit char; + passenden status anzeigen; + IF ist zeilenmenue THEN + cursor (1, y size); out (""5""); put (prompt); + ELSE + dialog (prompt); +(* cursor (dx + 1, dy + dialogzeile + 1); out (">"); + cursor (dx + dxl - 2, dy + dialogzeile + 1); out ("<");*) + cursor (dx + 1, dy + dialogzeile + 1) + END IF; + editget (eingabe, 1000, editlaenge, "", "?hq" + res, exit char); + cursor (1, 1); + IF exit char = esc fragezeichen THEN + hilfe anbieten (hilfe, d fenster); + neuer dialog; + editget (prompt, eingabe, res, hilfe) + ELIF exit char = esc h OR exit char = esc q THEN + errorstop (niltext) + ELIF length (exit char) = 2 THEN + eingabe := exit char + eingabe + END IF . + +passenden status anzeigen : + IF pos (res, "z") > 0 THEN + status anzeigen (editget status mit esc z) + ELSE + status anzeigen (editget status ohne esc z) + END IF . + +editlaenge : + IF ist zeilenmenue THEN + x size - length (prompt) - 2 + ELSE + dxl - 4 + END IF . + +END PROC editget; + +PROC fehler ausgeben : + + TEXT CONST meldung := errormessage; + IF error code = 1 THEN + page; bildschirm neu + END IF; + clear error; + tastenpuffer loeschen; + IF meldung <> niltext THEN + status anzeigen (fehler status); + meldung ausgeben; + eingabe abwarten; + neuer dialog + END IF . + +meldung ausgeben : + dialog box; + out (piep); out (">>> "); + cursor (dx + 1, dy + dialogzeile + 1); + outsubtext (errormessage, 1, dxl - 2) . + +eingabe abwarten : + TEXT VAR eingabe; + cursor (1, 1); + getchar (eingabe); + IF eingabe = esc THEN + esc funktionen + END IF . + +esc funktionen : + getchar (eingabe); + IF eingabe = "?" THEN + hilfe anbieten ("FEHLER/" + text (errorcode), d fenster) + ELIF eingabe = ""1"" THEN + esc hop ausfuehren + END IF . + +END PROC fehler ausgeben; + +PROC tastenpuffer loeschen : + + WHILE getcharety <> niltext REP END REP + +END PROC tastenpuffer loeschen; + + +(************************** Menue Manager ********************************) + +LET + max ds = 3, + save order = 12, + erase order = 14, + fetch order = 1070, + lock order = 1068, + free order = 1069, + ack = 0, + error nak = 2; + +ROW maxds DATASPACE VAR menue ds; + +ROW maxds THESAURUS VAR thesaurus; + +BOOL VAR vater ist menuemanager := FALSE; + +INITFLAG VAR menueinitialisierung; + + +PROC ggf initialisieren : + + IF NOT initialized (menueinitialisierung) THEN + initialisierung durchfuehren + END IF . + +initialisierung durchfuehren : + BOOL VAR erfolgreich := vater ist menuemanager; + datenraeume holen; + IF erfolgreich THEN + ankoppeln + ELSE + menue loeschen (FALSE) + END IF . + +datenraeume holen : + INT VAR nr; + FOR nr FROM 1 UPTO maxds + WHILE erfolgreich REP + versuche zu holen + END REP . + +versuche zu holen : + INT VAR + reply, + retries; + FOR retries FROM 1 UPTO 10 REP + forget (menue ds (nr)); + menue ds (nr) := nilspace; + pingpong (father, fetch order + nr, menue ds (nr), reply); + IF reply = ack THEN + LEAVE versuche zu holen + ELIF reply <> error nak THEN + pause (15) + END IF + UNTIL reply = error nak END REP; + forget (menue ds (nr)); + menue ds (nr) := nilspace; + erfolgreich := FALSE . + +END PROC ggf initialisieren; + +THESAURUS PROC menuenamen (INT CONST nr) : + + ggf initialisieren; + IF nr < 0 THEN + h. hilfsnamen (- nr) + ELSE + thesaurus (nr) + END IF + +END PROC menuenamen; + +PROC menue loeschen (TEXT CONST name, INT CONST nr) : + + ggf initialisieren; + IF nr < 0 THEN + loeschen (name, h. hilfsnamen (- nr)) + ELSE + loeschen (name, thesaurus (nr)) + END IF + +END PROC menue loeschen; + +PROC loeschen (TEXT CONST name, THESAURUS VAR t) : + + INT CONST index := link (t, name); + IF index > 0 THEN + delete (t, index) + END IF + +END PROC loeschen; + +PROC menue loeschen (BOOL CONST hilfen reduzieren) : + + INT VAR nr; + menueinitialisierung := TRUE; + hilfen sparen := hilfen reduzieren; + FOR nr FROM 1 UPTO max ds REP + forget (menue ds (nr)); + menue ds (nr) := nilspace; + thesaurus (nr) := empty thesaurus + END REP; + ankoppeln + +END PROC menue loeschen; + +PROC ankoppeln : + + h := menue ds (1); + menues := menue ds (2); + auswahlen := menue ds (3) + +END PROC ankoppeln; + + +LET + lock aktiv = #732# + "Datei wird von anderer Task geaendert.", + auftrag nur fuer soehne = #733# + "Auftrag nur fuer Soehne erlaubt"; + +THESAURUS VAR locks := empty thesaurus; + +ROW 200 TASK VAR lock owner; + +TEXT VAR save file name; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg; + +PROC menue manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + + enable stop; + vater ist menue manager := TRUE; + IF order >= lock order AND order <= fetch order + max ds THEN + menue auftrag + ELSE + IF order = save order OR order = erase order THEN + save pre + END IF; + free manager (ds, order, phase, order task) + END IF . + +menue auftrag : + IF order = lock order THEN + lock ausfuehren + ELIF order = free order THEN + free ausfuehren + ELSE + menue fetch + END IF . + +lock ausfuehren : + msg := ds; + set lock (msg. name, order task); + send (order task, ack, ds) . + +free ausfuehren : + msg := ds; + reset lock (msg. name); + send (order task, ack, ds) . + +save pre : + IF phase = 1 THEN + lock ueberpruefen + ELIF order = erase order THEN + reset lock (save file name) + END IF . + +lock ueberpruefen : + msg := ds; + save file name := msg. name; + IF gesperrt und task ungleich THEN + errorstop (lock aktiv) + END IF . + +gesperrt und task ungleich : + INT VAR stelle := link (locks, save file name); + stelle > 0 CAND NOT (lock owner (stelle) = order task) . + +menue fetch : + IF order task < myself THEN + ggf initialisieren; + forget (ds); ds := menue ds (order - fetch order); + send (order task, ack, ds) + ELSE + errorstop (auftrag nur fuer soehne) + END IF . + +END PROC menue manager; + +PROC set lock (TEXT CONST dateiname, TASK CONST owner) : + + INT VAR i := link (locks, dateiname); + IF i = 0 THEN + insert (locks, dateiname, i); + ggf reorganisieren; + lock owner (i) := owner + ELIF exists (lock owner (i)) THEN + IF NOT (lock owner (i) = owner) THEN + errorstop (lock aktiv) + END IF + ELSE + lock owner (i) := owner + END IF . + +ggf reorganisieren : + IF i = 0 THEN + locks reorganisieren; + insert (locks, dateiname, i) + END IF . + +locks reorganisieren : + TEXT VAR eintrag; + i := 0; + REP + get (locks, eintrag, i); + IF i = 0 THEN + LEAVE locks reorganisieren + END IF; + IF NOT exists (eintrag) OR NOT exists (lock owner (i)) THEN + delete (locks, i) + END IF + END REP . + +END PROC set lock; + +PROC reset lock (TEXT CONST dateiname) : + + INT VAR i; + delete (locks, dateiname, i) + +END PROC reset lock; + +PROC global manager : + + global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, + TASK CONST) menue manager) + +END PROC global manager; + +PROC lock (TEXT CONST dateiname, TASK CONST manager) : + + call (lock order, dateiname, manager) + +END PROC lock; + +PROC free (TEXT CONST dateiname, TASK CONST manager) : + + call (free order, dateiname, manager) + +END PROC free; + +END PACKET eudas menues; + diff --git a/app/eudas/5.3/src/eudas.saetze.03 b/app/eudas/5.3/src/eudas.saetze.03 new file mode 100644 index 0000000..d3f53f1 --- /dev/null +++ b/app/eudas/5.3/src/eudas.saetze.03 @@ -0,0 +1,271 @@ +PACKET eudas satzzugriffe + +(*************************************************************************) +(* *) +(* Feldstrukturierung von Texten *) +(* *) +(* Version 03 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 17.04.87 *) +(* *) +(*************************************************************************) + + DEFINES + + SATZ, + := , + satz initialisieren, + felderzahl, + feld lesen, + feld bearbeiten, + feld aendern, + feldindex : + + +LET + maximale felderzahl = 256, + zeigerlaenge = 2; + +LET + blank = " ", + niltext = ""; + +LET + illegale feldnummer = #101# + " ist keine Feldnummer"; + +TEXT VAR + raum fuer ein int := zeigerlaenge * blank; + + +(**************************** Typ SATZ ***********************************) + +TYPE SATZ = TEXT; + +OP := (SATZ VAR links, SATZ CONST rechts) : + + CONCR (links) := CONCR (rechts) + +END OP := ; + + +(************************ Satz initialisieren ****************************) + +PROC satz initialisieren (SATZ VAR satz) : + + satz initialisieren (satz, 0) + +END PROC satz initialisieren; + +PROC satz initialisieren (SATZ VAR satz, INT CONST felder) : + + replace (raum fuer ein int, 1, 2 * felder + 3); + INT VAR i; + CONCR (satz) := niltext; + FOR i FROM 1 UPTO felder + 1 REP + CONCR (satz) CAT raum fuer ein int + END REP + +END PROC satz initialisieren; + + +(*************************** Felderzahl **********************************) + +INT PROC felderzahl (SATZ CONST satz) : + + INT VAR letzter zeiger := (CONCR (satz) ISUB 1) DIV 2; + INT CONST satzende := CONCR (satz) ISUB letzter zeiger; + REP + letzter zeiger DECR 1 + UNTIL letzter zeiger <= 0 COR kein leeres feld END REP; + letzter zeiger . + +kein leeres feld : + (CONCR (satz) ISUB letzter zeiger) <> satzende . + +END PROC felderzahl; + + +(************************** Feld lesen ***********************************) + +PROC feld lesen (SATZ CONST satz, INT CONST feldnr, TEXT VAR inhalt) : + + feldgrenzen bestimmen (CONCR (satz), feldnr); + IF NOT is error THEN + inhalt := subtext (CONCR (satz), feldanfang, feldende) + END IF + +END PROC feld lesen; + +PROC feld bearbeiten (SATZ CONST satz, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + feldgrenzen bestimmen (CONCR (satz), feldnr); + IF NOT is error THEN + bearbeite (CONCR (satz), feldanfang, feldende) + END IF + +END PROC feld bearbeiten; + + +(************************ Feldgrenzen bestimmen **************************) + +INT VAR + feldanfang, + feldende; + +PROC feldgrenzen bestimmen (TEXT CONST satz, INT CONST feldnr) : + + IF illegales feld THEN + errorstop (text (feldnr) + illegale feldnummer) + ELIF vorhandenes feld THEN + feldanfang := satz ISUB feldnr; + feldende := (satz ISUB feldnr + 1) - 1 + ELSE + feldanfang := 1; feldende := 0 + END IF . + +illegales feld : + feldnr <= 0 OR feldnr > maximale felderzahl . + +vorhandenes feld : + feldnr + feldnr < (satz ISUB 1) - 1 . + +END PROC feldgrenzen bestimmen; + + +(*************************** Feld aendern ********************************) + +TEXT VAR puffer; + +PROC feld aendern (SATZ VAR satz, INT CONST feldnr, TEXT CONST inhalt) : + + INT VAR zeigerstelle; + INT CONST satzfelder := ((CONCR (satz) ISUB 1) - 2) DIV 2; + IF normales feld THEN + normal ersetzen + ELSE + errorstop (text (feldnr) + illegale feldnummer) + END IF . + +normales feld : + feldnr > 0 AND feldnr <= maximale felderzahl . + +normal ersetzen : + INT CONST fehlende zeiger := feldnr - satzfelder; + IF fehlende zeiger <= 0 THEN + vorhandenes feld ersetzen + ELIF inhalt <> niltext THEN + neues feld anfuegen + END IF . + +neues feld anfuegen : + INT CONST endezeiger := CONCR (satz) ISUB (satzfelder + 1); + puffer := subtext (CONCR (satz), erstes feld, endezeiger - 1); + CONCR (satz) := subtext (CONCR (satz), 1, satzfelder + satzfelder); + korrigiere zeiger (CONCR (satz), 1, satzfelder, platz fuer zeiger); + neue zeiger anfuegen; + endezeiger anfuegen; + CONCR (satz) CAT puffer; + CONCR (satz) CAT inhalt . + +platz fuer zeiger : + fehlende zeiger + fehlende zeiger . + +neue zeiger anfuegen : + INT CONST neuer zeiger := endezeiger + platz fuer zeiger; + FOR zeigerstelle FROM satzfelder + 1 UPTO feldnr REP + zeiger anfuegen (CONCR (satz), neuer zeiger) + END REP . + +endezeiger anfuegen : + zeiger anfuegen (CONCR (satz), neuer zeiger + length (inhalt)) . + +erstes feld: + CONCR (satz) ISUB 1 . + +vorhandenes feld ersetzen : + INT CONST + feldanfang := CONCR (satz) ISUB feldnr, + naechster feldanfang := CONCR (satz) ISUB (feldnr + 1); + IF feldanfang > length (CONCR (satz)) THEN + optimiere leerfelder + ELSE + ersetze beliebig + END IF . + +optimiere leerfelder : + korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1, + length (inhalt)); + CONCR (satz) CAT inhalt . + +ersetze beliebig : + puffer := subtext (CONCR (satz), naechster feldanfang); + CONCR (satz) := subtext (CONCR (satz), 1, feldanfang - 1); + korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1, + laengendifferenz); + CONCR (satz) CAT inhalt; + CONCR (satz) CAT puffer . + +laengendifferenz : + length (inhalt) - feldlaenge . + +feldlaenge : + naechster feldanfang - feldanfang . + +END PROC feld aendern; + +PROC zeiger anfuegen (TEXT VAR satz, INT CONST zeigerwert) : + + replace (raum fuer ein int, 1, zeigerwert); + satz CAT raum fuer ein int + +END PROC zeiger anfuegen; + +PROC korrigiere zeiger (TEXT VAR satz, INT CONST anfang, ende, differenz) : + + INT VAR zeigerstelle; + FOR zeigerstelle FROM anfang UPTO ende REP + replace (satz, zeigerstelle, alter zeiger + differenz) + END REP . + +alter zeiger : + satz ISUB zeigerstelle . + +END PROC korrigiere zeiger; + + +(*************************** 'feldindex' *********************************) + +INT PROC feldindex (SATZ CONST satz, TEXT CONST muster) : + + INT VAR + anfang := (CONCR (satz) ISUB 1) - 1, + zeigerstelle := 1; + + REP + anfang := pos (CONCR (satz), muster, anfang + 1); + IF anfang = 0 THEN + LEAVE feldindex WITH 0 + END IF; + durchsuche zeiger ob feldanfang + UNTIL zeiger zeigt auf anfang CAND naechster zeiger hinter ende END REP; + zeigerstelle . + +durchsuche zeiger ob feldanfang : + WHILE (CONCR (satz) ISUB zeigerstelle) < anfang REP + zeigerstelle INCR 1 + END REP . + +zeiger zeigt auf anfang : + (CONCR (satz) ISUB zeigerstelle) = anfang . + +naechster zeiger hinter ende : + (CONCR (satz) ISUB (zeigerstelle + 1)) = anfang + length (muster) . + +END PROC feldindex; + + +END PACKET eudas satzzugriffe; + diff --git a/app/eudas/5.3/src/eudas.satzanzeige.12 b/app/eudas/5.3/src/eudas.satzanzeige.12 new file mode 100644 index 0000000..0fc5cd9 --- /dev/null +++ b/app/eudas/5.3/src/eudas.satzanzeige.12 @@ -0,0 +1,1007 @@ +PACKET satzanzeige + +(*************************************************************************) +(* *) +(* Anzeige von EUDAS-Saetzen *) +(* *) +(* Version 12 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 05.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + anzeigefenster, + bild ausgeben, + aendern, + einfuegen, + suchen, + feldauswahl, + rollen, + exit durch, + exit zeichen : + + +LET + maxfelder = 256; + +LET + blank = " ", + niltext = "", + cleol = ""5"", + begin mark = ""15"", + blank end mark = " "14"", + blank end mark blank = " "14" "; + +ROW maxfelder STRUCT (INT feldnr, anfang) VAR zeilen; + +INT VAR + anzahl zeilen, + erste zeile, + laenge := 24, + breite := 79, + zeilen anf := 1, + spalten anf := 1, + feldnamenlaenge, + inhaltsbreite, + zuletzt angezeigter satz := 0, + letzte kombi := 0, + anzeigeversion := dateiversion - 1, + anzeigedateien := 0; + +BOOL VAR + neues fenster := TRUE, + bis zeilenende := TRUE, + save ds voll := FALSE, + namen ausgeben; + +FENSTER VAR fenster; +fenster initialisieren (fenster); + +DATASPACE VAR + save ds, + edit ds; + +FILE VAR edit file; + +TEXT VAR + ueberschrift, + zeilenpuffer; + +LET + fenster zu klein = #801# + "Anzeigefenster zu klein"; + + +PROC anzeigefenster (FENSTER CONST fe) : + + INT VAR x anf, y anf, x laenge, y laenge; + fenstergroesse (fe, x anf, y anf, x laenge, y laenge); + IF x laenge >= 39 THEN + fenstergroesse setzen (fenster, fe); + bis zeilenende := x anf + x laenge >= x size; + breite := x laenge; laenge := y laenge; + spalten anf := x anf; + zeilen anf := y anf; + neues fenster := TRUE + ELSE + errorstop (fenster zu klein) + END IF + +END PROC anzeigefenster; + +FENSTER PROC anzeigefenster : + fenster +END PROC anzeigefenster; + +PROC fensterzugriff anmelden : + + BOOL VAR fenster veraendert; + fensterzugriff (fenster, fenster veraendert); + IF fenster veraendert THEN + namen ausgeben := TRUE + END IF + +END PROC fensterzugriff anmelden; + +PROC zeilendeskriptor aktualisieren : + + IF neue datei seit letztem mal OR neues fenster THEN + neue feldnummern uebernehmen; + feldnamenlaenge bestimmen; + ueberschrift generieren; + fuer bildausgabe sorgen; + edit datei loeschen; + veraenderungsstatus merken + END IF . + +neue datei seit letztem mal : + anzeigeversion <> dateiversion . + +neue feldnummern uebernehmen : + anzahl zeilen := 0; + WHILE anzahl zeilen < anzahl felder REP + anzahl zeilen INCR 1; + zeilen (anzahl zeilen). feldnr := anzahl zeilen + END REP; + erste zeile := 1 . + +feldnamenlaenge bestimmen : + INT VAR feldnr; + feldnamenlaenge := 11; + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen bearbeiten (feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) namen max) + END REP; + feldnamenlaenge := min (feldnamenlaenge, breite DIV 3); + inhaltsbreite := breite - feldnamenlaenge - 3 . + +fuer bildausgabe sorgen : + namen ausgeben := TRUE . + +edit datei loeschen : + forget (edit ds); + edit ds := nilspace; + IF neue datei seit letztem mal AND save ds voll THEN + forget (save ds); + save ds voll := FALSE + END IF . + +veraenderungsstatus merken : + anzeigeversion := dateiversion; + anzeigedateien := anzahl dateien; + neues fenster := FALSE . + +END PROC zeilendeskriptor aktualisieren; + +PROC namen max (TEXT CONST satz, INT CONST von, bis) : + + feldnamenlaenge INCR length (satz) - length (satz); + (* damit Parameter benutzt *) + feldnamenlaenge := max (feldnamenlaenge, bis - von + 1) + +END PROC namen max; + +PROC rollen (INT CONST vektor) : + + erste zeile := erste zeile + vektor; + IF erste zeile < 1 THEN + erste zeile := 1 + ELIF erste zeile > letzte zeile THEN + erste zeile := max (letzte zeile, 1) + END IF; + namen ausgeben := TRUE . + +letzte zeile : + anzahl zeilen - laenge + 3 . + +END PROC rollen; + +PROC feldauswahl (TEXT CONST wahlvektor) : + + zeilendeskriptor aktualisieren; + feldnummern uebernehmen; + namen ausgeben := TRUE . + +feldnummern uebernehmen : + anzahl zeilen := length (wahlvektor); + INT VAR zeilennr; + FOR zeilennr FROM 1 UPTO anzahl zeilen REP + zeilen (zeilennr). feldnr := code (wahlvektor SUB zeilennr) + END REP; + erste zeile := 1 . + +END PROC feldauswahl; + + +(**************************** editfile ***********************************) + +INT VAR gelesene zeile; + +PROC edit file loeschen : + + type (edit ds, - 1); + edit file := sequential file (modify, edit ds); + edit info (edit file, -1); + to line (editfile, 1); + col (editfile, 1); + maxlinelength (edit file, 10000); + gelesene zeile := 1 + +END PROC edit file loeschen; + +. +noch zeile zu bearbeiten : + gelesene zeile <= anzahl zeilen . + +PROC naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) bearbeite) : + + zu bearbeitende zeilen bestimmen; + IF eof (editfile) THEN + bearbeite ("", feldnr) + ELIF mehrere zeilen THEN + zeilen verketten; + blanks abschneiden; + bearbeite (zeilenpuffer, feldnr) + ELIF blanks am ende THEN + read record (edit file, zeilenpuffer); + blanks abschneiden; + bearbeite (zeilenpuffer, feldnr); + down (edit file) + ELSE + exec (PROC (TEXT CONST, INT CONST) bearbeite, edit file, feldnr); + down (edit file) + END IF . + +zu bearbeitende zeilen bestimmen : + INT CONST + von := gelesene zeile, + feldnr := zeilen (von). feldnr; + REP + gelesene zeile INCR 1 + UNTIL gelesene zeile > anzahl zeilen COR neues feld END REP . + +neues feld : + zeilen (gelesene zeile). feldnr <> feldnr . + +mehrere zeilen : + gelesene zeile - von > 1 . + +zeilen verketten : + zeilenpuffer := ""; + REP + exec (PROC (TEXT CONST, INT CONST) verkette, + edit file, length (zeilenpuffer)); + down (edit file) + UNTIL eof (edit file) OR line no (edit file) = gelesene zeile END REP . + +blanks am ende : + INT CONST ende := len (edit file); + subtext (edit file, ende, ende) = blank . + +END PROC naechste zeile bearbeiten; + +PROC verkette (TEXT CONST edit zeile, INT CONST pufferlaenge) : + + IF pufferlaenge > 0 CAND (zeilenpuffer SUB pufferlaenge) <> blank + CAND (edit zeile SUB 1) <> blank THEN + zeilenpuffer CAT blank + END IF; + zeilenpuffer CAT edit zeile + +END PROC verkette; + +PROC blanks abschneiden : + + INT VAR ende := length (zeilenpuffer); + WHILE (zeilenpuffer SUB ende) = blank REP + ende DECR 1 + END REP; + zeilenpuffer := subtext (zeilenpuffer, 1, ende) + +END PROC blanks abschneiden; + + +(*************************** Funktionen **********************************) + + +BOOL VAR aus einfuegen; + +PROC einfuegen (PROC hilfe) : + + enable stop; + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + editieren (PROC hilfe); + satz einfuegen; + aus einfuegen := TRUE; + felder aendern + END IF + +END PROC einfuegen; + +PROC felder aendern : + + WHILE noch zeile zu bearbeiten REP + naechste zeile bearbeiten + (PROC (TEXT CONST, INT CONST) ein feld aendern) + END REP; + aenderungen eintragen + +END PROC felder aendern; + +PROC ein feld aendern (TEXT CONST inhalt, INT CONST feldnr) : + + IF NOT aus einfuegen COR inhalt <> niltext THEN + feld aendern (feldnr, inhalt) + END IF + +END PROC ein feld aendern; + +PROC aendern (PROC hilfe) : + + enable stop; + IF dateiende THEN + einfuegen (PROC hilfe) + ELSE + wirklich aendern + END IF . + +wirklich aendern : + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + bild aufbauen (namen ausgeben); + feldinhalte eintragen; + editieren (PROC hilfe); + aus einfuegen := FALSE; + felder aendern + END IF . + +feldinhalte eintragen : + kopierzeile := 1; + WHILE kopierzeile <= anzahl zeilen REP + feld bearbeiten (zeilen (kopierzeile). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) inhalt kopieren); + insert record (edit file); + write record (edit file, zeilenpuffer); + down (edit file); + kopierzeile INCR 1 + END REP; + to line (edit file, 1) . + +END PROC aendern; + +INT VAR kopierzeile; + +PROC inhalt kopieren (TEXT CONST satz, INT CONST von, bis) : + + zeilenpuffer := subtext (satz, feldanfang, feldende) . + +feldanfang : + von + zeilen (kopierzeile). anfang . + +feldende : + IF keine fortsetzung THEN + bis + ELSE + von + zeilen (kopierzeile + 1). anfang - 1 + END IF . + +keine fortsetzung : + kopierzeile = anzahl zeilen COR + zeilen (kopierzeile + 1). feldnr <> zeilen (kopierzeile). feldnr . + +END PROC inhalt kopieren; + +PROC suchen (PROC hilfe) : + + enable stop; + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + IF such version <> 0 THEN + altes suchmuster eintragen + END IF; + editieren (PROC hilfe); + suchbedingung einstellen + END IF . + +altes suchmuster eintragen : + kopierzeile := 1; + WHILE kopierzeile <= anzahl zeilen REP + insert record (edit file); + suchmusterzeile eintragen; + down (edit file); + kopierzeile INCR 1 + END REP; + to line (edit file, 1) . + +suchmusterzeile eintragen : + IF zeilen (kopierzeile). anfang = 0 THEN + suchbedingung lesen (zeilen (kopierzeile). feldnr, zeilenpuffer); + write record (edit file, zeilenpuffer) + END IF . + +suchbedingung einstellen : + suchbedingung loeschen; + WHILE noch zeile zu bearbeiten REP + naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) zeilenbedingung) + END REP . + +END PROC suchen; + +PROC zeilenbedingung (TEXT CONST zeile, INT CONST feldnr) : + + suchbedingung (feldnr, zeile) + +END PROC zeilenbedingung; + +PROC bild ausgeben (BOOL CONST datei veraendert) : + + enable stop; + zeilendeskriptor aktualisieren; + fensterzugriff anmelden; + IF datei veraendert OR namen ausgeben OR anderer satz THEN + bild aufbauen (namen ausgeben); + zuletzt angezeigter satz := satznummer; + letzte kombi := satzkombination; + einzelbild ausgeben (TRUE) + ELSE + ueberschrift ausgeben (TRUE) + END IF . + +anderer satz : + satznummer <> zuletzt angezeigter satz OR letzte kombi <> satzkombination . + +END PROC bild ausgeben; + + +(*************************** Bild aufbauen *******************************) + +INT VAR anfang; + +BOOL VAR fertig; + + +PROC bild aufbauen (BOOL CONST kuerzen erlaubt) : + + INT VAR + zeilennr := 1, + alte feldnr := 0; + fertig := TRUE; + WHILE zeilennr <= anzahl zeilen OR NOT fertig REP + eine zeile behandeln + END REP . + +eine zeile behandeln : + IF fertig CAND zeilen (zeilennr). feldnr = alte feldnr THEN + eventuell zusammenruecken + ELSE + IF altes feld beendet THEN + feldwechsel + END IF; + zeilen (zeilennr). anfang := anfang; + feld bearbeiten (zeilen (zeilennr). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) laenge bestimmen); + zeilennr INCR 1 + END IF . + +eventuell zusammenruecken : + IF kuerzen erlaubt THEN + zeile loeschen (zeilennr) + ELSE + zeilen (zeilennr). anfang := anfang; + zeilennr INCR 1 + END IF . + +altes feld beendet : + zeilennr > anzahl zeilen COR zeilen (zeilennr). feldnr <> alte feldnr . + +feldwechsel : + IF fertig THEN + neues feld anfangen + ELSE + zeile einfuegen (zeilennr); + zeilen (zeilennr). feldnr := alte feldnr + END IF . + +neues feld anfangen : + alte feldnr := zeilen (zeilennr). feldnr; + anfang := 0 . + +END PROC bild aufbauen; + +PROC laenge bestimmen (TEXT CONST satz, INT CONST von, bis) : + + INT CONST restlaenge := bis - von - anfang + 1; + IF restlaenge > inhaltsbreite - 2 THEN + anfang INCR inhaltsbreite - 2; + rueckwaerts blank suchen; + fertig := FALSE + ELSE + anfang INCR restlaenge; + fertig := TRUE + END IF . + +rueckwaerts blank suchen : + INT VAR stelle := von + anfang - 1; + IF trennung im wort AND blanks vorhanden THEN + WHILE (satz SUB stelle) <> blank REP + stelle DECR 1; anfang DECR 1 + END REP + END IF . + +trennung im wort : + (satz SUB stelle) <> blank . + +blanks vorhanden : + pos (satz, blank, stelle - inhaltsbreite + 3, stelle - 1) > 0 . + +END PROC laenge bestimmen; + +PROC zeile einfuegen (INT CONST zeilennr) : + + INT VAR i; + FOR i FROM anzahl zeilen DOWNTO zeilennr REP + zeilen (i+1) := zeilen (i) + END REP; + anzahl zeilen INCR 1; + namen ausgeben := TRUE + +END PROC zeile einfuegen; + +PROC zeile loeschen (INT CONST zeilennr) : + + INT VAR i; + FOR i FROM zeilennr + 1 UPTO anzahl zeilen REP + zeilen (i-1) := zeilen (i) + END REP; + anzahl zeilen DECR 1; + namen ausgeben := TRUE + +END PROC zeile loeschen; + + +(************************** Editieren ************************************) + +INT VAR rueckkehrcode; + +TEXT VAR + zeilenrest, + zeile vorher, + zeile nachher, + quit zeichen := "", + quit durch; + +LET + hinweiszeile = #802# + ""15" Bild verschoben ! ESC 1 druecken ! "14""; + +LET + eudas res = ""3""10"19"11""12""13"q?hpg"; + +LET + oben = 1, + unten = 2, + eins = 3, + neun = 4, + rubin = 5, + rubout = 6, + return = 7, + edit ende = 8, + frage = 9, + abbruch = 10, + double = 11, + esc get = 12; + + +PROC editieren (PROC hilfe) : + + INT VAR alte zeilennr := erste zeile; + lernsequenz auf taste legen ("D", date); + REP + einzelbild ausgeben (FALSE); + file verlaengern; + erste und letzte zeile markieren; + file editieren; + nachbehandeln + UNTIL wirklich verlassen END REP; + to line (edit file, 1); + col (edit file, 1) . + +file verlaengern : + IF lines (edit file) < anzahl zeilen + 1 THEN + output (edit file); + line (editfile, anzahl zeilen - lines (editfile) + 2); + modify (edit file) + END IF . + +erste und letzte zeile markieren : + IF erste zeile <> 1 THEN + einsetzen (erste zeile - 1, zeile vorher) + END IF; + einsetzen (zeile nach bildschirm, zeile nachher); + to line (edit file, alte zeilennr) . + +zeile nach bildschirm : + min (anzahl zeilen + 1, erste zeile + laenge - 1) . + +file editieren : + open editor (groesster editor + 1, edit file, TRUE, + spalten anf + feldnamenlaenge + 3, zeilen anf, + inhaltsbreite, editlaenge); + edit (groesster editor, eudas res + quit zeichen, + PROC (TEXT CONST) eudas interpreter); + auf lernwarnmeldung achten . + +auf lernwarnmeldung achten : + INT VAR test x, test y; + get cursor (test x, test y); + IF test x <> 1 THEN bildschirm neu END IF . + +editlaenge : + min (anzahl zeilen - erste zeile + 2, laenge) . + +nachbehandeln : + alte zeilennr := line no (edit file); + hinweiszeilen entfernen; + SELECT rueckkehrcode OF + CASE oben : nach oben rollen + CASE unten : nach unten rollen + CASE eins : auf erste zeile + CASE neun : auf letzte zeile + CASE rubin : zeile umbrechen + CASE rubout : zeile entfernen + CASE return : aktuelle zeile als anfang + CASE frage : hilfe; namen ausgeben := TRUE + CASE abbruch : errorstop (niltext) + CASE double : in save ds kopieren + CASE esc get : aus save ds holen + END SELECT . + +hinweiszeilen entfernen : + INT CONST spalte := col (edit file); + col (edit file, 1); + IF erste zeile <> 1 THEN + entfernen (erste zeile - 1, zeile vorher) + END IF; + entfernen (zeile nach bildschirm, zeile nachher); + col (edit file, spalte) . + +nach oben rollen : + INT VAR abstand; + abstand := alte zeilennr - erste zeile; + rollen (-laenge + 1); + alte zeilennr := erste zeile + abstand . + +nach unten rollen : + abstand := alte zeilennr - erste zeile; + rollen (laenge - 1); + alte zeilennr := min (erste zeile + abstand, anzahl zeilen) . + +auf erste zeile : + rollen (-999); + alte zeilennr := 1 . + +auf letzte zeile : + abstand := alte zeilennr - erste zeile; + rollen (999); + alte zeilennr := min (erste zeile + abstand, anzahl zeilen) . + +zeile umbrechen : + to line (edit file, alte zeilennr); + aktuelle zeile aufsplitten; + zeile einfuegen (alte zeilennr) . + +aktuelle zeile aufsplitten : + read record (edit file, zeilenpuffer); + zeilenrest := subtext (zeilenpuffer, spalte); + zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1); + write record (edit file, zeilenpuffer); + down (edit file); + insert record (edit file); + write record (edit file, zeilenrest) . + +zeile entfernen : + to line (edit file, alte zeilennr); + IF spalte = 1 AND + (nicht letzte zeile CAND noch gleiche dahinter OR + nicht erste zeile CAND noch gleiche davor) THEN + ganz loeschen + ELSE + nur ueberschreiben + END IF . + +nicht letzte zeile : + alte zeilennr <> anzahl zeilen . + +noch gleiche dahinter : + zeilen (alte zeilennr + 1). feldnr = zeilen (alte zeilennr). feldnr . + +nicht erste zeile : + alte zeilennr <> 1 . + +noch gleiche davor : + zeilen (alte zeilennr - 1). feldnr = zeilen (alte zeilennr). feldnr . + +ganz loeschen : + delete record (edit file); + zeile loeschen (alte zeilennr); + IF alte zeilennr > anzahl zeilen THEN + alte zeilennr := anzahl zeilen + END IF . + +nur ueberschreiben : + read record (edit file, zeilenpuffer); + zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1); + write record (edit file, zeilenpuffer) . + +aktuelle zeile als anfang : + abstand := alte zeilennr - erste zeile; + rollen (abstand) . + +in save ds kopieren : + forget (save ds); + save ds := edit ds; + save ds voll := TRUE . + +aus save ds holen : + IF save ds voll THEN + forget (edit ds); + edit ds := save ds; + edit file := sequential file (modify, edit ds) + END IF . + +wirklich verlassen : + rueckkehrcode = edit ende . + +END PROC editieren; + +PROC eudas interpreter (TEXT CONST zeichen) : + + enable stop; + set busy indicator; + rueckkehrcode := pos (eudas res, zeichen); + IF rueckkehrcode > 0 THEN + quit durch := zeichen; + quit + ELIF pos (quit zeichen, zeichen) > 0 THEN + rueckkehrcode := edit ende; + quit durch := zeichen; + quit + ELIF kommando auf taste (zeichen) <> niltext THEN + std kommando interpreter (zeichen) + ELSE + nichts neu + END IF + +END PROC eudas interpreter; + +PROC einsetzen (INT CONST zeilennr, TEXT VAR speicher) : + + to line (edit file, zeilennr); + read record (edit file, speicher); + write record (edit file, hinweiszeile) + +END PROC einsetzen; + +PROC entfernen (INT CONST zeilennr, TEXT CONST speicher) : + + to line (edit file, zeilennr); + IF eof (edit file) COR pos (edit file, hinweiszeile, 1) = 0 THEN + to line (edit file, 1); + down (edit file, hinweiszeile); + IF eof (edit file) THEN + to line (edit file, zeilennr); + insert record (edit file) + END IF + END IF; + write record (edit file, speicher) + +END PROC entfernen; + +PROC exit zeichen (TEXT CONST zeichenkette) : + + quit zeichen := zeichenkette + +END PROC exit zeichen; + +TEXT PROC exit durch : + + quit durch + +END PROC exit durch; + + +(****************************** Ausgabe **********************************) + +INT VAR ausgabezeile; + +LET + t ende = #803# + "ENDE.", + t such plus = #804# + "SUCH+", + t such minus = #805# + "SUCH-", + t mark plus = #806# + "MARK+", + t mark minus = #807# + "MARK-", + t feld = #808# + " Zeile "14" ", + t satz = #809# + " Satz ", + t koppel = #810# + ""; + +LET + fuenf punkte = ".....", + sieben blanks = " "; + + +PROC einzelbild ausgeben (BOOL CONST auch inhalte) : + + INT VAR + bildschirmzeile := zeilen anf + 1, + aktuelles feld := 0; + INT CONST letzte ausgabezeile := erste zeile + laenge - 2; + ueberschrift ausgeben (auch inhalte); + ausgabezeile := erste zeile; + WHILE ausgabezeile <= letzte ausgabezeile REP + feldnamen ausgeben; + feldinhalt ausgeben; + evtl unterbrechung; + bildschirmzeile INCR 1; + ausgabezeile INCR 1 + END REP; + namen ausgeben := FALSE . + +feldnamen ausgeben : + IF namen ausgeben THEN + cursor (spalten anf, bildschirmzeile); + IF ausgabezeile <= anzahl zeilen THEN + namen tatsaechlich ausgeben + ELIF ausgabezeile = anzahl zeilen + 1 THEN + endebalken ausgeben + ELSE + bildschirmzeile loeschen + END IF + END IF . + +namen tatsaechlich ausgeben : + out (begin mark); + IF zeilen (ausgabezeile). feldnr = aktuelles feld THEN + feldnamenlaenge TIMESOUT blank + ELSE + aktuelles feld := zeilen (ausgabezeile). feldnr; + feldnamen bearbeiten (aktuelles feld, + PROC (TEXT CONST, INT CONST, INT CONST) randanzeige) + END IF; + out (blank end mark) . + +endebalken ausgeben : + out (begin mark); + breite - 4 TIMESOUT "."; + out (blank end mark blank) . + +bildschirmzeile loeschen : + IF bis zeilenende THEN + out (cleol) + ELSE + breite TIMESOUT blank + END IF . + +feldinhalt ausgeben : + IF auch inhalte AND ausgabezeile <= anzahl zeilen THEN + cursor (spalten anf + feldnamenlaenge + 3, bildschirmzeile); + feld bearbeiten (zeilen (ausgabezeile). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) feldteil ausgeben) + END IF . + +evtl unterbrechung : + IF NOT namen ausgeben THEN + TEXT CONST input := getcharety; + IF input <> niltext THEN + push (input); + IF pos (quit zeichen, input) > 0 THEN + zuletzt angezeigter satz := 0; + LEAVE einzelbild ausgeben + END IF + END IF + END IF . + +END PROC einzelbild ausgeben; + +PROC ueberschrift ausgeben (BOOL CONST auch inhalte) : + + satznummer bestimmen; + satznummer in ueberschrift; + cursor (spalten anf, zeilen anf); + IF NOT auch inhalte THEN + outsubtext (ueberschrift, 1, feldnamenlaenge + 3); + LEAVE ueberschrift ausgeben + END IF; + replace (ueberschrift, feldnamenlaenge + 7, auswahlzeichen); + replace (ueberschrift, feldnamenlaenge + 14, markzeichen); + out (ueberschrift); + cursor (spalten anf + breite - 5, zeilen anf); + out (text (erste zeile)) . + +satznummer bestimmen : + TEXT VAR satznr; + satznr := text (satznummer); + IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN + satznr CAT "-"; + satznr CAT text (satzkombination) + END IF . + +satznummer in ueberschrift : + replace (ueberschrift, 7, sieben blanks); + replace (ueberschrift, 7, satznr) . + +auswahlzeichen : + IF such version = 0 THEN + fuenf punkte + ELIF satz ausgewaehlt THEN + t such plus + ELSE + t such minus + END IF . + +markzeichen : + IF dateiende THEN + t ende + ELIF markierte saetze = 0 THEN + fuenf punkte + ELIF satz markiert THEN + t mark plus + ELSE + t mark minus + END IF . + +END PROC ueberschrift ausgeben; + +PROC randanzeige (TEXT CONST satz, INT CONST von, bis) : + + IF bis - von >= feldnamenlaenge THEN + outsubtext (satz, von, von + feldnamenlaenge - 1) + ELSE + outsubtext (satz, von, bis); + feldnamenlaenge - bis + von - 1 TIMESOUT blank + END IF + +END PROC randanzeige; + +PROC feldteil ausgeben (TEXT CONST satz, INT CONST von, bis) : + + INT VAR ende; + IF ausgabezeile = anzahl zeilen COR letzte feldzeile THEN + ende := bis + ELSE + ende := von + zeilen (ausgabezeile + 1). anfang - 1 + END IF; + outsubtext (satz, von + zeilen (ausgabezeile). anfang, ende); + IF bis zeilenende THEN + out (cleol) + ELSE + laenge bis zum rand TIMESOUT blank + END IF . + +letzte feldzeile : + zeilen (ausgabezeile + 1). feldnr <> zeilen (ausgabezeile). feldnr . + +laenge bis zum rand : + inhaltsbreite - ende + von + zeilen (ausgabezeile). anfang - 1 . + +END PROC feldteil ausgeben; + +PROC ueberschrift generieren : + + ueberschrift := text (t satz, feldnamenlaenge + 3); + ueberschrift CAT begin mark; + INT VAR i; + INT CONST punktlaenge := breite - length (ueberschrift) - 12; + FOR i FROM 1 UPTO punktlaenge REP + ueberschrift CAT "." + END REP; + ueberschrift CAT t feld; + ggf koppel in ueberschrift . + +ggf koppel in ueberschrift : + IF auf koppeldatei THEN + replace (ueberschrift, feldnamenlaenge + 22, t koppel) + END IF . + +END PROC ueberschrift generieren; + + +END PACKET satzanzeige; + diff --git a/app/eudas/5.3/src/eudas.steuerung.14 b/app/eudas/5.3/src/eudas.steuerung.14 new file mode 100644 index 0000000..f96047b --- /dev/null +++ b/app/eudas/5.3/src/eudas.steuerung.14 @@ -0,0 +1,2535 @@ +PACKET eudas steuerung + +(*************************************************************************) +(* *) +(* Menuesteuerung von EUDAS *) +(* *) +(* Version 14 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 06.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + eudas, + + einzelsicherung, + suchen, + aendern, + einfuegen, + prueffehler editieren, + feldstruktur, + feldnamen anzeigen, + formatieren automatisch, + + arbeitsbereich bestimmen, + dateiverwaltung, + archivverwaltung : + + + +(**************************** Variablen ***********************************) + +INT VAR + file typ := 1003, + eudas typ := 3243; + +IF l3 THEN file typ := 1004 END IF . + +l3 : maxint DIV 2 > 17000 . +; + +LET + niltext = "", + blank = " ", + cleop = ""4"", + cleol = ""5""; + +FILE VAR test file; + +DATASPACE VAR test ds; + +INT VAR + belegter heap, + test version := dateiversion - 1; + +TEXT VAR + feldpuffer; + + +(*************************** EUDAS ***************************************) + +BOOL VAR + eudas schon aktiv := FALSE; + +LET + menue 1 = #1101# + "EUDAS.Öffnen", + menue 2 = #1102# + "EUDAS.Einzelsatz", + menue 3 = #1103# + "EUDAS.Gesamtdatei", + menue 4 = #1104# + "EUDAS.Drucken", + menue 5 = #1105# + "EUDAS.Dateien", + menue 6 = #1106# + "EUDAS.Archiv"; + +LET + kein rekursiver aufruf = #1107# + "EUDAS kann nicht unter EUDAS aufgerufen werden", + suchmuster eingeben = #1108# + "Suchbedingung einstellen", + alle saetze drucken = #1109# + "Alle Sätze drucken", + alle markierten saetze drucken = #1110# + "Alle markierten Sätze drucken", + einzelsatz drucken = #1111# + "Aktuellen Satz drucken", + uebersicht wiederholen = #1112# + "Mit neuer Auswahl noch einmal", + akt datei = #1113# + ""15"Akt.Datei "14"", + datum doppelpunkt = #1114# + ""15"Datum "14""; + + +PROC eudas : + + IF aktueller editor > 0 THEN + eudas kurzabfrage + ELIF eudas schon aktiv THEN + errorstop (kein rekursiver aufruf) + ELSE + eudas aufrufen + END IF . + +eudas aufrufen : + fenstergroessen bestimmen; + page; bildschirm neu; + belegter heap := heap size; + disable stop; + eudas schon aktiv := TRUE; + menue anbieten (ROW 6 TEXT : (menue 1, menue 2, menue 3, + menue 4, menue 5, menue 6), + fenster links, TRUE, + PROC (INT CONST, INT CONST) eudas interpreter); + eudas schon aktiv := FALSE; + enable stop; + auf sicherung ueberpruefen; + page; bildschirm neu + +END PROC eudas; + +PROC eudas kurzabfrage : + + TEXT VAR gewaehlte feldnamen := niltext; + bild frei; + auf sicherung ueberpruefen; + IF nicht alle gesichert THEN + LEAVE eudas kurzabfrage + END IF; + oeffnen im menue (FALSE); + auf satz (1); + feldauswahl fuer uebersicht (gewaehlte feldnamen); + REP + ggf suchmuster eingeben; + uebersicht (gewaehlte feldnamen, PROC uebersicht hilfe); + bild frei; + saetze drucken + UNTIL nicht noch einmal END REP; + dateien loeschen (FALSE) . + +nicht alle gesichert : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF inhalt veraendert (datei nr) THEN + LEAVE nicht alle gesichert WITH TRUE + END IF + END REP; + FALSE . + +ggf suchmuster eingeben : + IF ja (suchmuster eingeben, "JA/Suchmuster") THEN + suchen; alles neu + END IF . + +saetze drucken : + IF markierte saetze = 0 CAND alle drucken THEN + einzelausfuehrung (name des druckmusters, file typ, + PROC (TEXT CONST) drucke uebersicht) + ELIF markierte saetze > 0 CAND alle markierten drucken THEN + einzelausfuehrung (name des druckmusters, file typ, + PROC (TEXT CONST) drucke uebersicht); + markierungen loeschen + ELIF einzelsatz THEN + markierungen loeschen; markierung aendern; + einzelausfuehrung (name des druckmusters, file typ, + PROC (TEXT CONST) drucke uebersicht); + markierungen loeschen + END IF . + +alle drucken : + ja (alle saetze drucken, "JA/alle Saetze", FALSE) . + +alle markierten drucken : + ja (alle markierten saetze drucken, "JA/alle markierten") . + +einzelsatz : + ja (einzelsatz drucken, "JA/Einzelsatz drucken") . + +nicht noch einmal : + NOT ja (uebersicht wiederholen, "JA/noch einmal", FALSE) . + +END PROC eudas kurzabfrage; + +PROC bild frei : + + bildschirm neu; + cursor (1, 1); + out (cleop) + +END PROC bild frei; + +PROC drucke uebersicht (TEXT CONST dateiname) : + + bild frei fuer uebersetzung; + disable stop; + drucke (dateiname); + uebersetzungsfehler behandeln; + bild frei + +END PROC drucke uebersicht; + +PROC eudas interpreter (INT CONST menuenr, wahl nr) : + + enable stop; + SELECT menuenr OF + CASE 0 : waehlbarkeit setzen + CASE 1 : oeffnen interpreter (wahl nr) + CASE 2 : anzeigen interpreter (wahl nr) + CASE 3 : bearbeiten interpreter (wahl nr) + CASE 4 : drucken interpreter (wahl nr) + CASE 5 : dateiverwaltung (wahl nr) + CASE 6 : archivverwaltung (menuenr, wahl nr) + END SELECT . + +waehlbarkeit setzen : + IF anzahl dateien = 0 THEN + oeffnen sperre (FALSE); + aendern sperre (FALSE) + ELIF NOT aendern erlaubt THEN + aendern sperre (FALSE) + END IF; + ketten koppeln sperre; + fusszeile ("", "", 35, datum doppelpunkt, 64); + fussteil (3, date) . + +END PROC eudas interpreter; + +PROC oeffnen sperre (BOOL CONST wie) : + + INT VAR i; + waehlbar (1, 4, wie); + waehlbar (1, 5, wie); + waehlbar (1, 7, wie); + FOR i FROM 1 UPTO 12 REP + waehlbar (2, i, wie) + END REP; + waehlbar (3, 1, wie); + waehlbar (3, 4, wie); + waehlbar (3, 6, wie); + waehlbar (4, 1, wie) + +END PROC oeffnen sperre; + +PROC ketten koppeln sperre : + + BOOL VAR wie := anzahl dateien = 1 AND aendern erlaubt; + waehlbar (1, 6, wie); + waehlbar (3, 5, wie); + wie := anzahl dateien > 0 AND anzahl dateien < 10 AND NOT auf koppeldatei; + waehlbar (1, 2, wie); + waehlbar (1, 3, wie) + +END PROC ketten koppeln sperre; + +PROC aendern sperre (BOOL CONST wie) : + + INT VAR i; + FOR i FROM 8 UPTO 11 REP + waehlbar (2, i, wie) + END REP; + waehlbar (3, 2, wie); + waehlbar (3, 3, wie) + +END PROC aendern sperre; + + +(**************************** Menue 'Oeffnen' *****************************) + +LET + p manager = #1115# + ""15"Manager "14"", + t manager ausschalten = #1116# + "Manager ausschalten", + keine sicherung noetig = #1117# + "Keine Sicherung nötig.", + arbeitskopien loeschen = #1118# + "Interne Arbeitskopien löschen", + t arbeitskopie = #1119# + "Arbeitskopie ", + t unveraendert = #1120# + " unverändert.", + t veraendert = #1121# + " verändert! Optionen zum Sichern:", +(*t alte ersetzen = #1122# + "Statt alter Version", + t sichern neuer name = #1123# + "Unter neuem Namen", + t vergessen = #1124# + "Ignorieren",*) + unter dem namen = #1125# + "Sichern unter dem neuen Namen:", + ueberschreiben = #1126# + " überschreiben", + sortierung wiederherstellen = #1127# + "Datei wieder sortieren", + t notizen ansehen = #1128# + "Notizen", + name task = #1129# + "Name Managertask:", + task existiert nicht = #1130# + "Task existiert nicht !", + wollen sie etwas veraendern = #1131# + "Wollen Sie etwas verändern (eine Arbeitskopie anlegen)", + markierungen geloescht = #1132# + "Alle Markierungen gelöscht.", + t pruefbedingungen = #1133# + "Prüfbedingungen", + t feldnamen aendern = #1134# + "Feldnamen ändern", + t feldtypen aendern = #1135# + "Feldtypen ändern", + t feldnamen anfuegen = #1136# + "Feldnamen anfügen", + neuer feldname = #1137# + "Neuer Feldname:", + t feldtypen = #1138# + "Typwahl für Feld ", + neue feldnamen eingeben = #1139# + "Neue Feldnamen", + id text = #1140# + "TEXT ", + id din = #1141# + " DIN ", + id zahl = #1142# + "ZAHL ", + id datum = #1143# + "DATUM", + alte feldreihenfolge aendern = #1144# + "Alte Feldreihenfolge ändern", + speicherengpass = #1145# + ""7"ACHTUNG: System voll, Dateien löschen!"; + +BOOL VAR + nach aendern fragen, + multi user manager eingestellt := FALSE; + +TASK VAR multi user manager := niltask; + +TEXT VAR + manager taskname := niltext; + +SATZ VAR feldersatz; + +ROW 6 TEXT VAR typen auswahl; + typen auswahl (1) := id text; + typen auswahl (2) := id din; + typen auswahl (3) := id zahl; + typen auswahl (4) := id datum; + typen auswahl (5) := niltext; + typen auswahl (6) := niltext; + +PROC oeffnen interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : auf geschlossene datei pruefen + CASE 1 : neue datei oeffnen + CASE 2 : datei ketten + CASE 3 : datei koppeln + CASE 4 : aktuelle datei sichern + CASE 5 : notizen editieren + CASE 6 : feldstruktur aendern + CASE 7 : pruefbedingungen aendern + CASE 8 : multi user manager einstellen + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren; + heap kontrollieren . + +auf geschlossene datei pruefen : + IF anzahl dateien = 0 THEN + eudas interpreter (0, 0) + END IF; + akt dateiname in fuss; + fussteil (2, p manager, manager taskname) . + +neue datei oeffnen : + auf sicherung ueberpruefen; + oeffnen im menue (TRUE); + IF anzahl dateien > 0 THEN push ("2") END IF . + +datei ketten : + oeffnen op (PROC (TEXT CONST) ketten) . + +datei koppeln : + oeffnen op (PROC (TEXT CONST) koppeln) . + +aktuelle datei sichern : + IF aendern erlaubt THEN + einzeldateien abfragen + ELSE + dateien loeschen (FALSE); + dialog (keine sicherung noetig) + END IF; + sperre setzen . + +einzeldateien abfragen : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + einzelsicherung (datei nr) + END REP; + IF ja (arbeitskopien loeschen, "JA/Dateien loeschen") THEN + dateien aus manager zuruecksichern; + dateien loeschen (TRUE) + END IF . + +sperre setzen : + IF anzahl dateien = 0 THEN + oeffnen sperre (FALSE); + aendern sperre (FALSE) + END IF; + ketten koppeln sperre; + akt dateiname in fuss . + +notizen editieren : + notizen ansehen; + dialogfenster loeschen . + +feldstruktur aendern : + zugriff (PROC (EUDAT VAR) feldstruktur) . + +pruefbedingungen aendern : + pruefbedingungen; + dialogfenster loeschen . + +multi user manager einstellen : + TEXT VAR edit manager name := ""; + editget (name task, edit manager name, "", "GET/multi task"); + IF edit manager name = niltext THEN + IF manager ausschalten THEN set manager (niltext, FALSE) END IF + ELIF exists task (edit manager name) THEN + teste auf manager (task (edit manager name)); + set manager (edit manager name, TRUE) + ELSE + errorstop (task existiert nicht) + END IF . + +manager ausschalten : + ja (t manager ausschalten, "JA/manager aus") . + +heap kontrollieren : + IF heap size - belegter heap > 4 THEN + collect heap garbage; + belegter heap := heap size + END IF . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen; + LEAVE oeffnen interpreter + END IF . + +END PROC oeffnen interpreter; + +PROC oeffnen op (PROC (TEXT CONST) operation) : + + ausfuehrung (name der datei, TRUE, eudas typ, multi user manager, + PROC (TEXT CONST) operation); + ketten koppeln sperre; + akt dateiname in fuss + +END PROC oeffnen op; + +PROC akt dateiname in fuss : + + TEXT VAR f text := niltext; + IF anzahl dateien > 0 THEN + f text CAT """"; + f text CAT eudas dateiname (1); + f text CAT """" + END IF; + IF anzahl dateien > 1 THEN + f text CAT " .." + END IF; + fussteil (1, akt datei, f text) + +END PROC akt dateiname in fuss; + +PROC set manager (TEXT CONST m name, BOOL CONST an) : + + IF an THEN + multi user manager := task (m name) + ELSE + multi user manager := niltask + END IF; + multi user manager eingestellt := an; + manager taskname := m name; + fussteil (2, manager taskname) + +END PROC set manager; + +PROC auf sicherung ueberpruefen : + + BOOL VAR notwendig := FALSE; + IF aendern erlaubt THEN + wirklich pruefen + END IF . + +wirklich pruefen : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF inhalt veraendert (datei nr) THEN + einzelsicherung (datei nr); + notwendig := TRUE; + ggf last param korrigieren + END IF + END REP . + +ggf last param korrigieren : + IF datei nr = 1 CAND std = eudas dateiname (1) THEN + last param (niltext) + END IF . + +END PROC auf sicherung ueberpruefen; + +PROC einzelsicherung (INT CONST datei nr) : + + frage zusammenbauen; + IF inhalt veraendert (datei nr) THEN + sicherung durchfuehren + ELSE + dialog (frage) + END IF . + +frage zusammenbauen : + TEXT VAR frage := t arbeitskopie; + frage CAT textdarstellung (eudas dateiname (datei nr)); + IF inhalt veraendert (datei nr) THEN + frage CAT t veraendert + ELSE + frage CAT t unveraendert + END IF . + +sicherung durchfuehren : + INT VAR ergebnis := 1; + auswahl anbieten ("WAHL.Sichern", frage, "WAHL/sichere", ergebnis); + ergebnis auswerten . + +ergebnis auswerten : + TEXT VAR name := eudas dateiname (datei nr); + SELECT ergebnis OF + CASE 1 : alte version ueberschreiben + CASE 3 : unter neuem namen sichern + END SELECT; + IF ergebnis <> 2 THEN + unter namen sichern + END IF . + +alte version ueberschreiben : + forget (name, quiet) . + +unter neuem namen sichern : + edit get (unter dem namen, name, "", "GET/Sicherungsname"); + IF exists (name) OR im manager vorhanden THEN + eventuell ueberschreiben + END IF . + +im manager vorhanden : + manager herkunft (dateinr) CAND exists (name, herkunft (datei nr)) . + +eventuell ueberschreiben : + IF ja (textdarstellung (name) + ueberschreiben, "JA/ueber", FALSE) THEN + forget (name, quiet) + ELSE + einzelsicherung (datei nr); + LEAVE einzelsicherung + END IF . + +unter namen sichern : + sichere (datei nr, name); + eventuell sortierung wiederherstellen; + ggf in manager sichern . + +eventuell sortierung wiederherstellen : + EUDAT VAR eudat; + oeffne (eudat, name); + IF war sortiert CAND soll sortiert werden THEN + bitte warten; + sortiere (eudat) + END IF . + +war sortiert : + sortierreihenfolge (eudat) <> niltext CAND unsortierte saetze (eudat) > 0 . + +soll sortiert werden : + ja (sortierung wiederherstellen, "JA/Sicherungssortierung") . + +ggf in manager sichern : + IF manager herkunft (datei nr) THEN + disable stop; + set command dialogue false; + save (name, herkunft (datei nr)); + reset command dialogue; + enable stop; + forget (name, quiet) + END IF . + +END PROC einzelsicherung; + +PROC oeffnen im menue (BOOL CONST aendern fragen) : + + IF aendern erlaubt THEN + dateien aus manager zuruecksichern + END IF; + dateien loeschen (TRUE); + oeffnen sperre (FALSE); + aendern sperre (FALSE); + forget (test ds); + disable stop; + nach aendern fragen := aendern fragen; + oeffnen op (PROC (TEXT CONST) oeffnen); + enable stop; + IF anzahl dateien > 0 THEN + oeffnen sperre (TRUE); + aendern sperre (aendern erlaubt) + END IF + +END PROC oeffnen im menue; + +PROC dateien aus manager zuruecksichern : + + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF manager herkunft (datei nr) THEN + free an manager + END IF + END REP . + +free an manager : + free (eudas dateiname (datei nr), herkunft (datei nr)) . + +END PROC dateien aus manager zuruecksichern; + +PROC oeffnen (TEXT CONST dateiname) : + + BOOL VAR auch aendern; + TASK VAR ursprung; + eventuell neu einrichten; + oeffne (dateiname, auch aendern, ursprung) . + +eventuell neu einrichten : + IF datei existiert nicht AND nach aendern fragen THEN + frage ob einrichten (dateiname); + EUDAT VAR eudat; + oeffne (eudat, dateiname); + feldstruktur (eudat); + auch aendern := TRUE; + ursprung := niltask + ELSE + auch aendern := nach aendern fragen CAND + ja (wollen sie etwas veraendern, "JA/oeffne", FALSE); + aus manager besorgen (dateiname, auch aendern, ursprung) + END IF . + +datei existiert nicht : + NOT exists (dateiname) AND auch nicht im manager . + +auch nicht im manager : + NOT multi user manager eingestellt COR + NOT exists (dateiname, multi user manager) . + +END PROC oeffnen; + +PROC ketten (TEXT CONST dateiname) : + + TASK VAR ursprung; + aus manager besorgen (dateiname, aendern erlaubt, ursprung); + kette (dateiname, ursprung) + +END PROC ketten; + +PROC koppeln (TEXT CONST dateiname) : + + TASK VAR ursprung; + aus manager besorgen (dateiname, aendern erlaubt, ursprung); + kopple (dateiname, ursprung) + +END PROC koppeln; + +PROC aus manager besorgen (TEXT CONST dateiname, BOOL CONST mit lock, + TASK VAR ursprung) : + + ursprung := niltask; + IF multi user manager eingestellt THEN + manager abfragen + END IF . + +manager abfragen : + IF NOT exists (dateiname) CAND exists (dateiname, multi user manager) THEN + IF mit lock THEN + lock (dateiname, multi user manager) + END IF; + forget (dateiname, quiet); + fetch (dateiname, multi user manager); + ursprung := multi user manager + END IF . + +END PROC aus manager besorgen; + +BOOL PROC manager herkunft (INT CONST dateinr) : + + NOT is niltask (herkunft (dateinr)) + +END PROC manager herkunft; + +PROC notizen ansehen : + + notizen lesen (3, feldpuffer); + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + disable stop; + headline (f, t notizen ansehen); + notizen anbieten (f, feldpuffer, fenster ganz, "EDIT/Notizen"); + forget (ds); + enable stop; + IF aendern erlaubt THEN + notizen aendern (3, feldpuffer) + END IF + +END PROC notizen ansehen; + +PROC notizen anbieten (FILE VAR f, TEXT VAR puffer, + FENSTER CONST edit fenster, TEXT CONST hilfsname) : + + LET trennzeichen = "#-#"; + enable stop; + notizen in datei; + datei editieren; + notizen aus datei . + +notizen in datei : + INT VAR + von := 1, + bis; + REP + bis := pos (puffer, trennzeichen, von); + IF bis = 0 THEN + putline (f, subtext (puffer, von)) + ELSE + putline (f, subtext (puffer, von, bis - 1)) + END IF; + von := bis + 3 + UNTIL bis = 0 OR von > length (puffer) END REP . + +datei editieren : + modify (f); + edit (f, edit fenster, hilfsname, TRUE) . + +notizen aus datei : + TEXT VAR zeile; + puffer := niltext; + input (f); + WHILE NOT eof (f) REP + getline (f, zeile); + blank entfernen; + puffer CAT zeile; + puffer CAT trennzeichen + END REP . + +blank entfernen : + IF (zeile SUB length (zeile)) = blank THEN + zeile := subtext (zeile, 1, length (zeile) - 1) + END IF . + +END PROC notizen anbieten; + +PROC feldstruktur (EUDAT VAR eudat) : + + INT VAR feldnr; + feldnamen lesen (eudat, feldersatz); + IF feldnamen auch aendern THEN + feldnamen anbieten und aendern + END IF; + IF feldnamen anfuegen THEN + feldnamen editieren + END IF; + IF ja (t feldtypen aendern, "JA/Feldtypen aendern", FALSE) THEN + feldtypen anbieten und aendern + END IF; + feldnamen aendern (eudat, feldersatz) . + +feldnamen auch aendern : + felderzahl (feldersatz) > 0 CAND + ja (t feldnamen aendern, "JA/Feldnamen aendern", FALSE) . + +feldnamen anfuegen : + felderzahl (feldersatz) = 0 COR + ja (t feldnamen anfuegen, "JA/feldnamen", FALSE) . + +feldnamen anbieten und aendern : + felder anbieten (eudat); + feldnr := 1; + WHILE wahl (feldnr) > 0 REP + einen feldnamen aendern; + feldnr INCR 1 + END REP . + +einen feldnamen aendern : + TEXT VAR feldname; + feld lesen (feldersatz, wahl (feldnr), feldname); + editget (neuer feldname, feldname, "", "GET/feldname"); + feld aendern (feldersatz, wahl (feldnr), feldname) . + +feldnamen editieren : + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + disable stop; + feldnamen anbieten (f, feldersatz); + forget (ds); + enable stop; + feldnamen aendern (eudat, feldersatz) . + +feldtypen anbieten und aendern : + felder anbieten (eudat); + feldnr := 1; + WHILE wahl (feldnr) > 0 REP + einen feldtyp aendern; + feldnr INCR 1 + END REP . + +einen feldtyp aendern : + INT VAR ergebnis := feldinfo (eudat, wahl (feldnr)) + 2; + feld lesen (feldersatz, wahl (feldnr), feldname); + auswahl anbieten ("WAHL.Typen", + t feldtypen + textdarstellung (feldname), + "WAHL/Feldtypen", ergebnis); + feldinfo (eudat, wahl (feldnr), ergebnis - 2) . + +END PROC feldstruktur; + +PROC felder anbieten (EUDAT CONST eudat) : + + feldtypen dazuschreiben; + auswahl anbieten ("EUDAS-Felder", fenster rechts, "AUSWAHL/Felder", + PROC (TEXT VAR, INT CONST) aus sammel) . + +feldtypen dazuschreiben : + INT VAR feldnr; + satz initialisieren (sammel); + FOR feldnr FROM 1 UPTO felderzahl (feldersatz) REP + feld lesen (feldersatz, feldnr, feldpuffer); + feld aendern (sammel, feldnr, info + feldpuffer) + END REP . + +info : + "<" + typen auswahl (feldinfo (eudat, feldnr) + 2) + "> " . + +END PROC felder anbieten; + +PROC pruefbedingungen : + + enable stop; + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + headline (f, t pruefbedingungen); + notizen lesen (1, feldpuffer); + disable stop; + notizen anbieten (f, feldpuffer, fenster ganz, "EDIT/Pruefbed"); + forget (ds); + enable stop; + IF aendern erlaubt THEN + notizen aendern (1, feldpuffer) + END IF . + +END PROC pruefbedingungen; + +PROC feldnamen anbieten (FILE VAR f, SATZ VAR satz) : + + enable stop; + neue namen editieren; + neue namen zurueckschreiben . + +neue namen editieren : + modify (f); + headline (f, neue feldnamen eingeben); + edit (f, fenster rechts, "EDIT/Feldnamen", TRUE) . + +neue namen zurueckschreiben : + INT VAR feldnr := felderzahl (satz); + input (f); + WHILE NOT eof (f) REP + getline (f, feldpuffer); + blank entfernen; + feldnr INCR 1; + feld aendern (satz, feldnr, feldpuffer) + END REP . + +blank entfernen : + IF (feldpuffer SUB length (feldpuffer)) = blank THEN + feldpuffer := subtext (feldpuffer, 1, length (feldpuffer) - 1) + END IF . + +END PROC feldnamen anbieten; + +PROC storage kontrollieren : + + INT VAR size, used; + storage (size, used); + IF used > size THEN + neuer dialog; + dialog (speicherengpass) + END IF + +END PROC storage kontrollieren; + + +(************************* Menue 'Einzelsatz' *****************************) + +BOOL VAR + satz leer, + umgeschaltet aus einfuegen := FALSE, + umgeschaltet aus aendern := FALSE; + +LET + aendern status = #1146# +"SATZ ÄNDERN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + einfuegen status = #1147# +"SATZ EINFÜGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + suchen status = #1148# +"SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + umschalten auf = #1149# + "Umschalten auf Koppeldatei ", + koppelfelder uebernehmen = #1150# + "Koppelfelder übernehmen", + ungueltige satznummer = #1151# + "Ungültige Satznummer", + neue satznummer = #1152# + "Neue Satznummer:", + wzk = #1153# + "wzK", + wz = #1154# + "wz"; + +PROC anzeigen interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : anzeige einschalten + CASE 1 : einen satz weiter + CASE 2 : einen satz zurueck + CASE 3 : direkt auf satz + CASE 4 : auf satz nach schluessel + CASE 5 : saetze auswaehlen + CASE 6 : auswahlbedingung loeschen + CASE 7 : aktuelle markierung aendern + CASE 8 : neuen satz einfuegen + CASE 9 : aktuellen satz aendern + CASE 10: einzelsatz tragen + CASE 11: einzelsatz holen + CASE 12: felder auswaehlen + CASE 13: esc oben + CASE 14: esc unten + CASE 15: esc 1 + CASE 16: esc 9 + CASE 17: esc k + OTHERWISE anzeige update + END SELECT; + storage kontrollieren . + +anzeige einschalten : + akt dateiname in fuss; + fussteil (2, "", ""); + exit zeichen (wz) . + +einen satz weiter : + bitte warten; + weiter (2); + bild ausgeben (FALSE) . + +einen satz zurueck : + bitte warten; + zurueck (2); + bild ausgeben (FALSE) . + +saetze auswaehlen : + suchen; + bild ausgeben (TRUE) . + +auswahlbedingung loeschen : + suchbedingung loeschen; + bild ausgeben (FALSE) . + +direkt auf satz : + TEXT VAR nr := niltext; + editget (neue satznummer, nr, "", "GET/auf Satz"); + INT CONST ziel := int (nr); + IF nr = niltext THEN + bild ausgeben (FALSE) + ELIF last conversion ok THEN + auf satz (ziel); + bild ausgeben (FALSE) + ELSE + errorstop (ungueltige satznummer) + END IF . + +auf satz nach schluessel : + TEXT VAR name schluesselfeld; + feldnamen lesen (1, name schluesselfeld); + nr := niltext; + editget (name schluesselfeld + ":", nr, "", "GET/auf Schluessel"); + auf satz (nr); + bild ausgeben (FALSE) . + +neuen satz einfuegen : + einfuegen; + bild ausgeben (TRUE) . + +aktuellen satz aendern : + aendern; + bild ausgeben (TRUE) . + +aktuelle markierung aendern : + markierung aendern; + bild ausgeben (FALSE) . + +einzelsatz tragen : + last param darf nicht geoeffnet sein; + einzelausfuehrung (name der zieldatei, eudas typ, + PROC (TEXT CONST) trage satz und frage); + bild ausgeben (TRUE) . + +einzelsatz holen : + last param darf nicht geoeffnet sein; + einzelausfuehrung (name der quelldatei, eudas typ, + PROC (TEXT CONST) hole satz); + bild ausgeben (TRUE) . + +felder auswaehlen : + TEXT VAR wahlvektor := niltext; + felder waehlen lassen (wahlvektor, + "EUDAS-Anzeigefelder", "AUSWAHL/Anzeigefelder"); + IF wahlvektor <> niltext THEN + feldauswahl (wahlvektor) + END IF; + bild ausgeben (TRUE) . + +esc oben : + rollcursor; + rollen (-23); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc unten : + rollcursor; + rollen (23); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc 1 : + rollcursor; + rollen (-9999); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc 9 : + rollcursor; + rollen (9999); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc k : + IF auf koppeldatei THEN + zurueckschalten + ELSE + auf koppeldatei umschalten + END IF; + IF anzahl dateien > 0 THEN + bild ausgeben (TRUE) + END IF . + +zurueckschalten : + IF (umgeschaltet aus aendern OR umgeschaltet aus einfuegen) THEN + fragen ob koppelfelder uebernehmen; + wieder in alte operation + ELSE + auf koppeldatei (0) + END IF; + ketten koppeln sperre . + +fragen ob koppelfelder uebernehmen : + IF NOT dateiende CAND ja (koppelfelder uebernehmen, "JA/uebernehmen") THEN + auf koppeldatei (1) + ELSE + auf koppeldatei (0) + END IF . + +wieder in alte operation : + umgeschaltet aus einfuegen := FALSE; + IF umgeschaltet aus aendern THEN + umgeschaltet aus aendern := FALSE; + aendern + ELSE + einfuegen intern (TRUE) + END IF . + +anzeige update : + IF wahl nr = -2 THEN + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF + ELSE + dialogfenster loeschen + END IF . + +END PROC anzeigen interpreter; + +PROC suchen : + + disable stop; + exit zeichen (""); + status anzeigen (suchen status); + suchen (PROC suchen hilfe); + exit zeichen (wz) + +END PROC suchen; + +PROC suchen hilfe : + + hilfe anbieten ("EDIT/Suchen", fenster rechts) + +END PROC suchen hilfe; + +PROC einfuegen : + + einfuegen intern (FALSE) + +END PROC einfuegen; + +PROC einfuegen intern (BOOL CONST nach umschalten) : + + BOOL VAR weiter aendern := nach umschalten; + exit zeichen setzen; + REP + status anzeigen (einfuegen status); + IF weiter aendern THEN + aendern (PROC einfuegen hilfe); + weiter aendern := FALSE + ELSE + einfuegen (PROC einfuegen hilfe) + END IF; + satz untersuchen; + exit zeichen bei einfuegen behandeln + END REP . + +exit zeichen bei einfuegen behandeln : + SELECT pos (wzk, exit durch) OF + CASE 0 : IF satz leer THEN + satz loeschen + END IF; + LEAVE einfuegen intern + CASE 1 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; weiter (2) + END IF + CASE 2 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; zurueck (2) + END IF + CASE 3 : auf koppeldatei umschalten; + IF auf koppeldatei THEN + umgeschaltet aus einfuegen := TRUE; + LEAVE einfuegen intern + END IF; + weiter aendern := TRUE + END SELECT . + +END PROC einfuegen intern; + +PROC einfuegen hilfe : + + hilfe anbieten ("EDIT/Einfuegen", fenster rechts) + +END PROC einfuegen hilfe; + +PROC exit zeichen setzen : + + IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN + exit zeichen (wzk) + ELSE + exit zeichen (wz) + END IF + +END PROC exit zeichen setzen; + +PROC aendern : + + exit zeichen setzen; + kommando auf taste legen ("F", "prueffehler editieren"); + REP + status anzeigen (aendern status); + aendern (PROC aendern hilfe); + satz untersuchen; + exit zeichen bei aendern behandeln + END REP . + +exit zeichen bei aendern behandeln : + SELECT pos (wzk, exit durch) OF + CASE 0 : IF satz leer THEN + satz loeschen + END IF; + LEAVE aendern + CASE 1 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; weiter (2) + END IF + CASE 2 : IF satz leer THEN + satz loeschen + END IF; + bitte warten; zurueck (2) + CASE 3 : auf koppeldatei umschalten; + IF auf koppeldatei THEN + umgeschaltet aus aendern := TRUE; + LEAVE aendern + END IF + END SELECT . + +END PROC aendern; + +PROC aendern hilfe : + + hilfe anbieten ("EDIT/Aendern", fenster rechts) + +END PROC aendern hilfe; + +PROC prueffehler editieren : + + IF test version = datei version THEN + modify (test file); + edit (test file) + END IF + +END PROC prueffehler editieren; + +PROC auf koppeldatei umschalten : + + INT VAR datei nr := folgedatei (0); + WHILE datei nr > 0 REP + IF auf diese datei schalten THEN + auf koppeldatei (datei nr); + ketten koppeln sperre; + LEAVE auf koppeldatei umschalten + END IF; + datei nr := folgedatei (datei nr) + END REP . + +auf diese datei schalten : + ja (umschalten auf + textdarstellung (eudas dateiname (datei nr)), + "JA/umschalten") . + +END PROC auf koppeldatei umschalten; + +PROC zeilenrest ausgeben (TEXT CONST zeile, INT CONST dummy) : + + outsubtext (zeile, anfang); out (cleol) . + +anfang : + pos (zeile, blank, 6) + 1 + dummy - dummy . + +END PROC zeilenrest ausgeben; + +PROC satz untersuchen : + + feld bearbeiten (1, PROC (TEXT CONST, INT CONST, INT CONST) ob leer) + +END PROC satz untersuchen; + +PROC ob leer (TEXT CONST satz, INT CONST von, bis) : + + satz leer := von < 3 OR von > length (satz) + bis - bis + +END PROC ob leer; + +PROC rollcursor : + + cursor (15, 24) + +END PROC rollcursor; + +PROC trage satz und frage (TEXT CONST dateiname) : + + IF exists (dateiname) THEN + teste auf offen + ELSE + frage ob einrichten (dateiname) + END IF; + bitte warten; + trage satz (dateiname) . + +teste auf offen : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF . + +END PROC trage satz und frage; + +PROC felder waehlen lassen (TEXT VAR wahlvektor, + TEXT CONST name auswahl, name hilfe) : + + auswahl anbieten (name auswahl, fenster rechts, 256, name hilfe, + wahlvektor, + PROC (TEXT VAR, INT CONST) gib namen); + wahlvektor := niltext; + INT VAR nr := 1; + WHILE wahl (nr) > 0 REP + wahlvektor CAT code (wahl (nr)); + nr INCR 1 + END REP + +END PROC felder waehlen lassen; + + +(************************* Menue 'Gesamtdatei' ***************************) + +LET + name der datei = #1155# + "Name der Datei:", + name der zieldatei = #1156# + "Name der Zieldatei:", + name der verarbeitungsvorschrift = #1157# + "Name der Verarbeitungsvorschrift:", + name des druckmusters = #1158# + "Name des Druckmusters:", + name der quelldatei = #1159# + "Name der Quelldatei:"; + +LET + felder auswaehlen = #1160# + "Angezeigte Felder auswählen", + aufsteigend sortieren = #1161# + " aufsteigend sortieren"; + +TEXT VAR + uebersichtsauswahl := niltext; + +INT VAR + version uebersicht := 0; + +DATASPACE VAR + kopier ds; + + +PROC bearbeiten interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : saetze kopieren + CASE 2 : saetze tragen + CASE 3 : nach vorschrift aendern + CASE 4 : uebersicht ausgeben + CASE 5 : datei sortieren + CASE 6 : alle markierungen loeschen + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +fusszeile aktualisieren : + akt dateiname in fuss; + fussteil (2, "", "") . + +saetze tragen : + last param darf nicht geoeffnet sein; + einzelausfuehrung (name der zieldatei, eudas typ, + PROC (TEXT CONST) trage saetze) . + +saetze kopieren : + last param darf nicht geoeffnet sein; + einzelausfuehrung (name der zieldatei, eudas typ, + PROC (TEXT CONST) kopiere saetze); + dialogfenster loeschen . + +nach vorschrift aendern : + ausfuehrung (name der verarbeitungsvorschrift, file typ, + PROC (TEXT CONST) verarbeite mit edit); + dialogfenster loeschen . + +uebersicht ausgeben : + IF dateiversion <> version uebersicht THEN + uebersichtsauswahl := niltext; + version uebersicht := dateiversion + END IF; + feldauswahl fuer uebersicht (uebersichtsauswahl); + uebersicht (uebersichtsauswahl, PROC uebersicht hilfe); + dialogfenster loeschen . + +datei sortieren : + zugriff (PROC (EUDAT VAR) einzelsortiere) . + +alle markierungen loeschen : + markierungen loeschen; + dialog (markierungen geloescht) . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen + END IF . + +END PROC bearbeiten interpreter; + +PROC last param darf nicht geoeffnet sein : + + IF index der arbeitskopie (std) <> 0 THEN + last param (niltext) + END IF + +END PROC last param darf nicht geoeffnet sein; + +PROC trage saetze (TEXT CONST dateiname) : + + BOOL VAR mit test; + IF exists (dateiname) THEN + teste auf offen; + frage ob testen + ELSE + frage ob einrichten (dateiname); + mit test := FALSE + END IF; + BOOL CONST mit sortieren := ja (sortierfrage, "JA/sortieren"); + bitte warten; + ggf datei initialisieren; + trage (dateiname, test file, mit test); + fehlerzahl ausgeben; + IF mit sortieren THEN + EUDAT VAR eudat; + oeffne (eudat, dateiname); + sortiere (eudat) + END IF . + +teste auf offen : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF . + +frage ob testen : + mit test := ja (pruefbedingungen testen, "JA/testen") . + +ggf datei initialisieren : + IF mit test THEN + forget (test ds); + test ds := nilspace; + test file := sequential file (output, test ds); + test version := datei version + ELSE + forget (test ds); + test version := datei version - 1 + END IF . + +fehlerzahl ausgeben : + IF mit test CAND lines (test file) > 0 THEN + dialog (text (lines (test file)) + prueffehler festgestellt) + END IF . + +END PROC trage saetze; + +PROC verarbeite mit edit (TEXT CONST dateiname) : + + IF NOT exists (dateiname) THEN + edit unten (dateiname, "EDIT/Verarbeite") + END IF; + bild frei fuer uebersetzung; + FILE VAR f := sequential file (input, dateiname); + disable stop; + verarbeite (f); + uebersetzungsfehler behandeln . + +END PROC verarbeite mit edit; + +PROC feldauswahl fuer uebersicht (TEXT VAR uebersichtsauswahl) : + + IF ja (felder auswaehlen, "JA/Ub.Felder") THEN + felder waehlen lassen (uebersichtsauswahl, + "EUDAS-Anzeigefelder", "AUSWAHL/Anzeigefelder") + END IF + +END PROC feldauswahl fuer uebersicht; + +PROC uebersicht hilfe : + + hilfe anbieten ("UEBERSICHT", fenster ganz) + +END PROC uebersicht hilfe; + +PROC kopiere saetze (TEXT CONST dateiname) : + + disable stop; + kopier ds := nilspace; + kopiere saetze intern (dateiname); + forget (kopier ds) + +END PROC kopiere saetze; + +PROC kopiere saetze intern (TEXT CONST dateiname) : + + TEXT VAR mustername := ""; + FILE VAR f; + EUDAT VAR eudat; + BOOL VAR mit sortieren := FALSE; + + enable stop; + IF exists (dateiname) THEN + teste auf offen und sortieren + ELSE + frage ob einrichten (dateiname) + END IF; + editget (name kopiermuster, mustername, "", "GET/kopiermuster"); + IF exists (mustername) THEN + f := sequential file (input, mustername) + ELSE + ggf kopiermuster einrichten; + std kopiermuster (dateiname, f) + END IF; + modify (f); + wirklich kopieren; + ggf sortieren . + +teste auf offen und sortieren : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF; + oeffne (eudat, dateiname); + IF sortierreihenfolge (eudat) <> niltext THEN + mit sortieren := ja (sortierfrage, "JA/sortieren") + END IF . + +ggf kopiermuster einrichten : + IF mustername = niltext THEN + f := sequential file (output, kopier ds) + ELSE + frage ob einrichten (mustername); + f := sequential file (output, mustername) + END IF . + +wirklich kopieren : + edit (f, fenster ganz, "EDIT/Kopiermuster", TRUE); + bild frei fuer uebersetzung; + kopiere (dateiname, f) . + +ggf sortieren : + IF mit sortieren THEN + oeffne (eudat, dateiname); + sortiere (eudat) + END IF . + +END PROC kopiere saetze intern; + +INT PROC index der arbeitskopie (TEXT CONST dateiname) : + + INT VAR dateinr; + FOR dateinr FROM 1 UPTO anzahl dateien REP + IF eudas dateiname (dateinr) = dateiname THEN + LEAVE index der arbeitskopie WITH dateinr + END IF + END REP; + 0 + +END PROC index der arbeitskopie; + +PROC edit unten (TEXT CONST dateiname, hilfe) : + + IF NOT exists (dateiname) THEN + frage ob einrichten (dateiname) + END IF; + FILE VAR f := sequential file (modify, dateiname); + edit (f, fenster ganz, hilfe, TRUE) + +END PROC edit unten; + +PROC bild frei fuer uebersetzung : + + bitte warten; + cursor (1, 2); + out (cl eop); + bildschirm neu + +END PROC bild frei fuer uebersetzung; + +PROC einzelsortiere (EUDAT VAR eudat) : + + TEXT VAR reihenfolge := sortierreihenfolge (eudat); + IF reihenfolge = niltext COR alte reihenfolge aendern THEN + sortierreihenfolge aendern; + bitte warten; + sortiere (eudat, reihenfolge) + ELSE + bitte warten; + sortiere (eudat) + END IF . + +alte reihenfolge aendern : + ja (alte feldreihenfolge aendern, "JA/Sortierfelder", FALSE) . + +sortierreihenfolge aendern : + feldnamen lesen (eudat, sammel); + auswahl anbieten ("EUDAS-Sortierfelder", fenster rechts, 1024, + "AUSWAHL/Sortierfelder", reihenfolge, + PROC (TEXT VAR, INT CONST) aus sammel); + INT VAR feldnr := 1; + reihenfolge := niltext; + WHILE wahl (feldnr) <> 0 REP + reihenfolge CAT code (wahl (feldnr)); + nach richtung fragen; + feldnr INCR 1 + END REP . + +nach richtung fragen : + feld lesen (sammel, wahl (feldnr), feldpuffer); + IF ja (textdarstellung (feldpuffer) + aufsteigend sortieren, + "JA/Sortierrichtung") THEN + reihenfolge CAT "+" + ELSE + reihenfolge CAT "-" + END IF . + +END PROC einzelsortiere; + +PROC gib namen (TEXT VAR name, INT CONST nr) : + + IF nr <= anzahl felder THEN + feldnamen lesen (nr, name) + ELSE + name := niltext + END IF + +END PROC gib namen; + + +(************************* Menue 'Drucken' ********************************) + +LET +(*direkt ausgabe = #1162# + "Ausgabe automatisch zum Drucker",*) + name druckzieldatei = #1163# + "Name Ausgabedatei:", + zwischendatei drucken = #1210# + "Erzeugte Ausgabe ausdrucken", + zwischendatei loeschen = #1211# + "Erzeugte Ausgabe löschen", + welche richtung = #1212# + "Richtung der Druckausgabe:", + welche listenform = #1213# + "Form der Liste:", + t max listenbreite = #1214# + "Anzahl Zeichen pro Zeile:", + keine zahl angegeben = #1215# + "Eingabe ist keine gültige Zahl", + sortierfrage = #1164# + "Zieldatei anschließend sortieren", + pruefbedingungen testen = #1165# + "Prüfbedingungen testen", + prueffehler festgestellt = #1166# + "Prüffehler festgestellt", + nicht in offene datei = #1167# + "Zieldatei darf nicht geöffnet sein", + name kopiermuster = #1168# + "Name Kopiermuster (RET=Std):"; + +LET + z form = #1169# + " zeilenweise formatieren", + s form = #1170# + " seitenweise formatieren"; + +LET + m drucke direkt = 0, + m drucke auf schirm = 1, + m drucke in datei = 2; + +BOOL VAR + zeilen automatisch := FALSE, + seiten automatisch := FALSE; + + +PROC drucken interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : nach muster drucken + CASE 2 : standardlisten + CASE 3 : ausgaberichtung umschalten + CASE 4 : musterdatei aendern + CASE 5 : textdatei drucken + CASE 6 : nachbearbeiten + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +fusszeile aktualisieren : + akt dateiname in fuss; + fussteil (2, "", "") . + +nach muster drucken : + ausfuehrung (name des druckmusters, file typ, + PROC (TEXT CONST) drucke mit edit); + dialogfenster loeschen . + +standardlisten : + INT VAR listenform := 1; + auswahl anbieten ("WAHL.Std-Listen", welche listenform, "WAHL/Std-Listen", + listenform); + feldliste erfragen; + listenfont erfragen; + listenbreite erfragen; + ausgabedatei erfragen; + bild frei fuer uebersetzung; + drucke standardlisten (listenform, feldliste); + ergebnis anbieten . + +feldliste erfragen : + TEXT VAR feldliste := niltext; + felder waehlen lassen (feldliste, + "EUDAS-Druckfelder", "AUSWAHL/Druckfelder") . + +listenfont erfragen : + . + +listenbreite erfragen : + TEXT VAR edit zahl := text (std listenbreite); + editget (t max listenbreite, edit zahl, "", "GET/listenbreite"); + INT CONST neue breite := int (edit zahl); + IF NOT last conversion ok THEN + errorstop (keine zahl angegeben) + ELSE + std listenbreite (neue breite) + END IF . + +ausgaberichtung umschalten : + INT VAR ergebnis := druckrichtung + 1; + auswahl anbieten ("WAHL.Richtung", welche richtung, "WAHL/Richtung", + ergebnis); + druckrichtung (ergebnis - 1) . + +musterdatei aendern : + ausfuehrung (name der datei, file typ, + PROC (TEXT CONST) muster edit); + dialogfenster loeschen . + +textdatei drucken : + ausfuehrung (name der datei, file typ, + PROC (TEXT CONST) print) . + +nachbearbeiten : + ausfuehrung (name der datei, file typ, + PROC (TEXT CONST) nachbearbeitung); + dialogfenster loeschen . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen + END IF . + +END PROC drucken interpreter; + +PROC uebersetzungsfehler behandeln : + + IF uebersetzungsfehler THEN + clear error + END IF . + +uebersetzungsfehler : + is error CAND errormessage = niltext . + +END PROC uebersetzungsfehler behandeln; + +PROC drucke mit edit (TEXT CONST dateiname) : + + IF NOT exists (dateiname) THEN + muster edit (dateiname) + END IF; + ausgabedatei erfragen; + bild frei fuer uebersetzung; + disable stop; + drucke (dateiname); + ergebnis anbieten; + uebersetzungsfehler behandeln . + +END PROC drucke mit edit; + +PROC ausgabedatei erfragen : + + IF druckrichtung = m drucke in datei THEN + TEXT VAR dateiname := druckdatei; + IF pos (dateiname, "$") > 0 THEN dateiname := niltext END IF; + editget (name druckzieldatei, dateiname, "", "GET/Druckdatei"); + IF dateiname <> niltext THEN + druckdatei (dateiname) + END IF + END IF + +END PROC ausgabedatei erfragen; + +PROC ergebnis anbieten : + + IF NOT is error CAND druckrichtung = m drucke auf schirm CAND + exists (druckdatei) THEN + enable stop; + zwischendatei zeigen + END IF . + +zwischendatei zeigen : + FILE VAR ausgabefile := sequential file (input, druckdatei); + edit (ausgabefile, fenster ganz, "EDIT/Druckausgabe", TRUE); + IF ja (zwischendatei drucken, "JA/Ausgabe drucken", FALSE) THEN + print (druckdatei) + END IF; + IF ja (zwischendatei loeschen, "JA/Ausgabe loeschen", FALSE) THEN + forget (druckdatei, quiet) + END IF . + +END PROC ergebnis anbieten; + +PROC muster edit (TEXT CONST dateiname) : + + edit unten (dateiname, "EDIT/Druckmuster") + +END PROC muster edit; + +PROC print (TEXT CONST dateiname) : + + do ("print (" + textdarstellung (dateiname) + ")") + +END PROC print; + +PROC nachbearbeitung (TEXT CONST dateiname) : + + IF ja (textdarstellung (dateiname) + z form, "JA/zeilenform") THEN + zeilen formatieren + END IF; + IF ja (textdarstellung (dateiname) + s form, "JA/seitenform") THEN + seiten formatieren + END IF . + +zeilen formatieren : + IF zeilen automatisch THEN + autoform (dateiname) + ELSE + lineform (dateiname) + END IF; + page; + bildschirm neu . + +seiten formatieren : + IF seiten automatisch THEN + autopageform (dateiname) + ELSE + pageform (dateiname) + END IF; + bildschirm neu . + +END PROC nachbearbeitung; + +PROC formatieren automatisch (BOOL CONST za, sa) : + + zeilen automatisch := za; + seiten automatisch := sa + +END PROC formatieren automatisch; + + +(********************** Menue 'Dateien' ***********************************) + +INITFLAG VAR diese task; + +TEXT VAR arbeitsbereich; + +LET + p task = #1171# + ""15"Bereich "14"", + t neuer name = #1172# + "Neuer Name:", + t zieldatei = #1173# + "Zieldatei:", + t belegt = #1174# + "belegt ", + t kb = #1175# + "KB.", + t existiert nicht = #1176# + " existiert nicht.", + t loeschen = #1177# + " in dieser Task löschen"; + +PROC dateiverwaltung (INT CONST wahl nr) : + + enable stop; + SELECT wahl nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : dateiuebersicht + CASE 2 : datei loeschen + CASE 3 : datei umbenennen + CASE 4 : datei kopieren + CASE 5 : speicherbelegung datei + CASE 6 : datei reorganisieren + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +fusszeile aktualisieren : + arbeitsbereich bestimmen; + fussteil (2, "", "") . + +datei reorganisieren : + ausfuehrung (PROC (TEXT CONST) aufraeumen) . + +datei umbenennen : + ausfuehrung (PROC (TEXT CONST) umbenennen) . + +datei loeschen : + ausfuehrung (PROC (TEXT CONST) loeschen) . + +dateiuebersicht : + disable stop; + DATASPACE VAR list ds := nilspace; + FILE VAR f := sequential file (output, list ds); + list (f); + IF NOT is error THEN + edit (f, fenster rechts, "SHOW/Uebersicht", FALSE) + END IF; + forget (list ds); + enable stop; + tastenpuffer loeschen . + +datei kopieren : + ausfuehrung (PROC (TEXT CONST) ds kopieren) . + +speicherbelegung datei : + ausfuehrung (PROC (TEXT CONST) speicherbelegung) . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen + END IF . + +END PROC dateiverwaltung; + +PROC arbeitsbereich bestimmen : + + IF NOT initialized (diese task) THEN + neu bestimmen + END IF; + fussteil (1, p task, arbeitsbereich) . + +neu bestimmen : + IF station (myself) <> 0 THEN + arbeitsbereich := text (station (myself)) + "/""" + ELSE + arbeitsbereich := """" + END IF; + arbeitsbereich CAT name (myself); + arbeitsbereich CAT """" . + +END PROC arbeitsbereich bestimmen; + +PROC tastenpuffer loeschen : + + WHILE getcharety <> niltext REP END REP + +END PROC tastenpuffer loeschen; + +PROC aufraeumen (TEXT CONST dateiname) : + + bitte warten; + IF type (old (dateiname)) = eudas typ THEN + reorganisiere (dateiname) + ELSE + reorganize (dateiname) + END IF + +END PROC aufraeumen; + +PROC umbenennen (TEXT CONST dateiname) : + + TEXT VAR neuer name := dateiname; + IF exists (dateiname) THEN + editget (t neuer name, neuer name, "", "GET/rename") + END IF; + rename (dateiname, neuer name) + +END PROC umbenennen; + +PROC loeschen (TEXT CONST dateiname) : + + IF offene datei THEN + errorstop (nicht in offene datei) + ELIF exists (dateiname) CAND frage bejaht THEN + forget (dateiname, quiet) + END IF . + +offene datei : + index der arbeitskopie (dateiname) <> 0 . + +frage bejaht : + ja (textdarstellung (dateiname) + t loeschen, "JA/forget", FALSE) . + +END PROC loeschen; + +PROC ds kopieren (TEXT CONST dateiname) : + + TEXT VAR zieldatei := niltext; + editget (t zieldatei, zieldatei, "", "GET/copy"); + copy (dateiname, zieldatei) + +END PROC ds kopieren; + +PROC speicherbelegung (TEXT CONST dateiname) : + + dialog (textdarstellung (dateiname)); + IF exists (dateiname) THEN + out (t belegt); + put (storage (old (dateiname))); + out (t kb) + ELSE + out (t existiert nicht) + END IF + +END PROC speicherbelegung; + + +(*********************** Menue 'Archiv' ***********************************) + +TEXT VAR + letzter archivname := niltext, + zielarchiv := "ARCHIVE"; + +INT VAR zielstation := 0; + +THESAURUS VAR archivinhalt; + +BOOL VAR + archivzugriff, + ziel ist manager := TRUE; + +LET + p zielarchiv = #1182# + ""15"Ziel "14"", + archiv heisst = #1183# + "Archiv heisst ", + name des archivs = #1184# + "Name des Archivs:", + name zielarchiv = #1185# + "Name Zielarchiv:", + nr zielstation = #1186# + "Nr. der Zielstation (od. RETURN):", + t zielmodus = #1187# + "Art des Zielarchivs:", + diskette formatieren = #1188# + "Diskette neu formatieren", + neuer archivname = #1189# + "Neuer Archivname:", + t im system ueberschreiben = #1190# + " in dieser Task überschreiben", + t auf archiv loeschen = #1191# + " auf Archiv löschen", + t archiv = #1192# + "Archiv ", + t ueberschreiben = #1193# + " überschreiben", + diskette eingelegt = #1194# + "Diskette eingelegt", + t auf archiv ueberschreiben = #1195# + " auf Archiv überschreiben", + t formatparameter = #1196# + "Mögliche Diskettenformate: "; + +LET + t passwort = #1197# + "Passwort: ", + passwortwiederholung falsch = #1198# + "Passwort stimmt nicht mit der ersten Eingabe überein", + bitte passwort wiederholen = #1199# + "Passwort zur Kontrolle bitte nochmal eingeben:", + passwort loeschen = #1200# + "Passwort löschen", + falsche stationsnr = #1201# + "Unzulässige Stationsnummer", + task ist kein manager = #1202# + "Angegebene Task ist kein Manager"; + +ROW 4 TEXT VAR archivtask; + archivtask (1) := "ARCHIVE"; + archivtask (2) := "PUBLIC"; + archivtask (3) := "ARCHIVE360"; + archivtask (4) := "DOS"; + + +PROC archivverwaltung (INT CONST menue nr, wahl nr) : + + enable stop; + SELECT wahl nr OF + CASE 0 : eintritt + CASE 1 : archivuebersicht + CASE 2 : uebersicht drucken + CASE 3 : datei vom archiv holen + CASE 4 : datei auf archiv sichern + CASE 5 : auf archiv loeschen + CASE 6 : archiv initialisieren + CASE 7 : zielarchiv einstellen + CASE 8 : passwort einstellen + CASE 9 : reservieren + OTHERWISE verlassen + END SELECT; + storage kontrollieren . + +eintritt : + arbeitsbereich bestimmen; + waehlbar (menue nr, 6, ziel ist manager); + waehlbar (menue nr, 9, NOT ziel ist manager); + fussteil (2, p zielarchiv, stationsnr + zielarchiv); + archivzugriff := FALSE . + +datei auf archiv sichern : + IF ziel ist manager THEN + archivnamen holen + END IF; + bitte warten; + archivinhalt := ALL eudas archiv; + ausfuehrung (PROC (TEXT CONST) archivieren) . + +datei vom archiv holen : + disable stop; + archiv anmelden; + bitte warten; + archivinhalt := ALL eudas archiv; + IF falscher name THEN archivinhalt := ALL eudas archiv END IF; + enable stop; + auf archiv (PROC (TEXT CONST) holen, archivinhalt) . + +auf archiv loeschen : + IF ziel ist manager THEN + archivnamen holen + END IF; + bitte warten; + archivinhalt := ALL eudas archiv; + auf archiv (PROC (TEXT CONST) auf archiv loeschen, archivinhalt) . + +archivuebersicht : + archiv anmelden; + disable stop; + bitte warten; + DATASPACE VAR list ds := nilspace; + f :=sequential file (output, list ds); + list (f, eudas archiv); + IF falscher name THEN list (f, eudas archiv) END IF; + IF NOT is error THEN + modify (f); to line (f, 1); + write record (f, headline (f)); + headline (f, niltext); + edit (f, fenster rechts, "SHOW/Uebersicht", FALSE) + END IF; + forget (list ds); + tastenpuffer loeschen; + enable stop . + +uebersicht drucken : + archiv anmelden; + namen generieren; + FILE VAR f := sequential file (output, list name); + disable stop; + bitte warten; + list (f, eudas archiv); + IF falscher name THEN list (f, eudas archiv) END IF; + IF is error THEN forget (list name, quiet) END IF; + enable stop; + modify (f); + insert record (f); + write record (f, headline (f)); + print (list name); + forget (list name, quiet) . + +namen generieren : + INT VAR i := 0; + TEXT VAR list name; + REP + i INCR 1; + list name := "Archivliste " + text (i) + UNTIL NOT exists (list name) END REP . + +archiv initialisieren : + archiv anmelden; + IF keine diskette COR benanntes archiv CAND loeschen verneint THEN + LEAVE archiv initialisieren + END IF; + BOOL CONST mit format := ja (diskette formatieren, "JA/format"); + neuen namen erfragen; + tatsaechlich initialisieren . + +keine diskette : + NOT ja (diskette eingelegt, "JA/eingelegt") . + +benanntes archiv : + reserve ("", eudas archiv); + bitte warten; + disable stop; + archivinhalt := ALL eudas archiv; + BOOL CONST ergebnis := falscher name; + clear error; + enable stop; + ergebnis . + +loeschen verneint : + NOT ja (t archiv + textdarstellung (letzter archivname) + t ueberschreiben, + "JA/archiv loeschen") . + +neuen namen erfragen : + editget (neuer archivname, letzter archivname, "", "GET/Archivname"); + reserve (letzter archivname, eudas archiv) . + +tatsaechlich initialisieren : + IF mit format THEN + formatparameter abrufen; + archiv formatieren + ELSE + clear aufrufen + END IF . + +clear aufrufen : + bitte warten; + disable stop; + set command dialogue false; + clear (eudas archiv); + reset command dialogue . + +formatparameter abrufen : + INT VAR std := 1; + auswahl anbieten ("WAHL.Format", t formatparameter, "WAHL/format", std); + std DECR 1 . + +archiv formatieren : + bitte warten; + disable stop; + set command dialogue false; + format (std, eudas archiv); + reset command dialogue; + enable stop . + +zielarchiv einstellen : + INT VAR zielmodus := 1; + IF archivzugriff THEN + release (eudas archiv); archivzugriff := FALSE + END IF; + auswahl anbieten ("WAHL.Ziel", t zielmodus, "WAHL/zielarchiv", zielmodus); + TEXT VAR zieltaskname := archivtask (zielmodus); + IF zielmodus > 1 THEN + namen des zielarchivs erfragen + END IF; + zielstation einlesen; + werte uebertragen; + waehlbar (menue nr, 6, ziel ist manager); + waehlbar (menue nr, 9, NOT ziel ist manager); + bildschirm neu; + fussteil (2, stationsnr + zielarchiv) . + +namen des zielarchivs erfragen : + editget (name zielarchiv, zieltaskname, "", "GET/Zielarchiv"); + IF zieltaskname = niltext THEN + LEAVE zielarchiv einstellen + END IF; + archivtask (zielmodus) := zieltaskname . + +zielstation einlesen : + TEXT VAR rechner := text (station (myself)); + IF station (myself) <> 0 THEN + editget (nr zielstation, rechner, "", "GET/Zielstation") + END IF . + +werte uebertragen : + zielstation := int (rechner); + IF NOT last conversion ok THEN + errorstop (falsche stationsnr) + END IF; + zielarchiv := zieltaskname; + ziel ist manager := zielmodus = 1 OR zielmodus = 3; + teste auf manager (eudas archiv) . + +stationsnr : + IF zielstation = 0 THEN + niltext + ELSE + text (zielstation) + "/" + END IF . + +reservieren : + TEXT VAR parameter := niltext; + editget (name des archivs, parameter, "", "GET/Archivname"); + reserve (parameter, eudas archiv); + archivzugriff := TRUE . + +verlassen : + IF wahl nr = -1 THEN + IF archivzugriff THEN + release (eudas archiv) + END IF; + dialogfenster loeschen + END IF . + +END PROC archivverwaltung; + +TASK PROC eudas archiv : + + IF zielstation = 0 THEN + task (zielarchiv) + ELSE + zielstation / zielarchiv + END IF + +END PROC eudas archiv; + +PROC teste auf manager (TASK CONST t) : + + INT VAR i; + IF station (t) = station (myself) THEN + FOR i FROM 1 UPTO 5 REP + IF status (t) = 2 OR status (t) = 6 THEN + LEAVE teste auf manager + END IF; + pause (10) + END REP; + errorstop (task ist kein manager) + END IF + +END PROC teste auf manager; + +PROC archivnamen holen : + + TEXT VAR neuer archivname := letzter archivname; + editget (name des archivs, neuer archivname, "", "GET/Archivname"); + IF NOT archivzugriff OR neuer archivname <> letzter archivname THEN + reserve (neuer archivname, eudas archiv); + archivzugriff := TRUE + END IF; + letzter archivname := neuer archivname + +END PROC archivnamen holen; + +PROC archiv anmelden : + + IF NOT archivzugriff AND ziel ist manager THEN + reserve (letzter archivname, eudas archiv); + archivzugriff := TRUE + END IF + +END PROC archiv anmelden; + +BOOL PROC falscher name : + + IF ziel ist manager AND is error THEN + TEXT CONST meldung := errormessage; + IF subtext (meldung, 1, 14) = archiv heisst CAND + subtext (meldung, 16, 20) <> "?????" THEN + clear error; + nochmal anmelden; + LEAVE falscher name WITH TRUE + END IF + END IF; + FALSE . + +nochmal anmelden : + letzter archivname := subtext (meldung, 16, length (meldung) - 1); + reserve (letzter archivname, eudas archiv) . + +END PROC falscher name; + +PROC archivieren (TEXT CONST dateiname) : + + disable stop; + IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv ueberschreiben THEN + vorher eventuell sichern; + bitte warten; + set command dialogue false; + save (dateiname, eudas archiv); + reset command dialogue + END IF . + +auf archiv ueberschreiben : + ja (textdarstellung (dateiname) + t auf archiv ueberschreiben, + "JA/save", FALSE) . + +vorher eventuell sichern : + INT CONST nr := index der arbeitskopie (dateiname); + IF nr > 0 CAND aendern erlaubt CAND inhalt veraendert (nr) THEN + einzelsicherung (nr) + END IF . + +END PROC archivieren; + +PROC holen (TEXT CONST dateiname) : + + disable stop; + IF NOT exists (dateiname) COR eigene datei ueberschreiben THEN + bitte warten; + set command dialogue false; + fetch (dateiname, eudas archiv); + reset command dialogue + END IF . + +eigene datei ueberschreiben : + ja (textdarstellung (dateiname) + t im system ueberschreiben, + "JA/fetch", FALSE) . + +END PROC holen; + +PROC auf archiv loeschen (TEXT CONST dateiname) : + + disable stop; + IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv loeschen THEN + bitte warten; + set command dialogue false; + erase (dateiname, eudas archiv); + reset command dialogue + END IF . + +auf archiv loeschen : + ja (textdarstellung (dateiname) + t auf archiv loeschen, + "JA/erase", FALSE) . + +END PROC auf archiv loeschen; + +PROC passwort einstellen : + + BOUND ROW 2 TEXT VAR pw; + DATASPACE VAR ds := nilspace; + pw := ds; + disable stop; + passwort holen (t passwort, pw (1)); + IF pw (1) = niltext THEN + fragen ob loeschen + ELSE + doppelt eingeben + END IF; + forget (ds) . + +fragen ob loeschen : + IF ja (passwort loeschen, "JA/pw loeschen") THEN + set command dialogue false; + enter password (niltext); + reset command dialogue + END IF . + +doppelt eingeben : + passwort holen (bitte passwort wiederholen, pw (2)); + IF pw (1) <> pw (2) THEN + errorstop (passwortwiederholung falsch) + ELSE + set command dialogue false; + enter password (pw (1)); + reset command dialogue + END IF . + +END PROC passwort einstellen; + +PROC passwort holen (TEXT CONST prompt, TEXT VAR wort) : + + enable stop; + dialog (prompt); + get secret line (wort) + +END PROC passwort holen; + + +(********************** Auswahlinterface **********************************) + +SATZ VAR + sammel; + +PROC aus sammel (TEXT VAR inhalt, INT CONST stelle) : + + IF stelle <= 256 THEN + feld lesen (sammel, stelle, inhalt) + ELSE + inhalt := niltext + END IF + +END PROC aus sammel; + +PROC feldnamen anzeigen : + + IF anzahl felder > 0 THEN + feldnamen sammeln; + sammlung zur auswahl anbieten; + ergebnis in editor uebernehmen + END IF . + +feldnamen sammeln : + INT VAR feldnr; + satz initialisieren (sammel, anzahl felder); + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldpuffer); + feld aendern (sammel, feldnr, feldpuffer) + END REP . + +sammlung zur auswahl anbieten : + auswahl anbieten ("EUDAS-Editfelder", fenster rechts, + "AUSWAHL/Feldnamen", + PROC (TEXT VAR, INT CONST) aus sammel) . + +ergebnis in editor uebernehmen : + INT VAR stelle := 1; + WHILE wahl (stelle) > 0 REP + IF stelle > 1 THEN type (blank) END IF; + feldnamen lesen (wahl (stelle), feldpuffer); + type ("<"); type (feldpuffer); type (">"); + stelle INCR 1 + END REP . + +END PROC feldnamen anzeigen; + +PROC einzelausfuehrung (TEXT CONST prompt, INT CONST typ, + PROC (TEXT CONST) operation) : + + ausfuehrung (prompt, TRUE, typ, PROC (TEXT CONST) operation) + +END PROC einzelausfuehrung; + +PROC ausfuehrung (TEXT CONST prompt, INT CONST typ, + PROC (TEXT CONST) operation) : + + ausfuehrung (prompt, FALSE, typ, PROC (TEXT CONST) operation) + +END PROC ausfuehrung; + +PROC ausfuehrung (PROC (TEXT CONST) operation) : + + ausfuehrung (name der datei, 0, PROC (TEXT CONST) operation) + +END PROC ausfuehrung; + +END PACKET eudas steuerung; + diff --git a/app/eudas/5.3/src/eudas.uebersicht.04 b/app/eudas/5.3/src/eudas.uebersicht.04 new file mode 100644 index 0000000..be597da --- /dev/null +++ b/app/eudas/5.3/src/eudas.uebersicht.04 @@ -0,0 +1,404 @@ +PACKET uebersichtsanzeige + +(*************************************************************************) +(* *) +(* Anzeige von EUDAS-Dateien als Übersicht *) +(* *) +(* Version 04 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 14.01.88 *) +(* *) +(*************************************************************************) + + DEFINES + + uebersicht, + uebersichtsfenster : + + +ROW 24 INT VAR zeilensatz; + +ROW 24 INT VAR zeilenkombi; + +FENSTER VAR fenster; +fenster initialisieren (fenster); + +INT VAR + laenge := 24, + breite := 79, + zeilen anf := 1, + spalten anf := 1, + freier rest, + feldversion := -1; + +BOOL VAR + bis zeilenende; + +TEXT VAR + feldnummern; + +LET + niltext = "", + begin mark = ""15"", + end mark = ""14"", + blank = " ", + piep = ""7"", + cleol = ""5""; + +LET + t satznr = #901# + ""15"Satznr. ", + t dateiende = #902# + " << DATEIENDE >>", + uebersicht status = #903# +"UEBERSICHT: Rollen: HOP OBEN, HOP UNTEN Beenden: ESC q Hilfe: ESC ?"; + + +PROC uebersichtsfenster (FENSTER CONST fe) : + + fenstergroesse (fe, spalten anf, zeilen anf, breite, laenge); + fenstergroesse setzen (fenster, fe); + bis zeilenende := spalten anf + breite >= x size + +END PROC uebersichtsfenster; + +FENSTER PROC uebersichtsfenster : + fenster +END PROC uebersichtsfenster; + +PROC uebersicht (TEXT CONST nummern, PROC hilfe) : + + TEXT VAR eingabezeichen; + BOOL VAR dummy; + INT VAR + angezeigter satz := 1, + ausgegebene zeilen := 0, + eingabezustand := 1; + + fensterzugriff (fenster, dummy); + status anzeigen (uebersicht status); + feldnummern bestimmen; + aktueller satz wird erster; + REP + kommando annehmen und zeile ausgeben; + cursor auf zeilenanfang; + kommando interpretieren + END REP . + +feldnummern bestimmen : + IF nummern = niltext THEN + ggf alte auswahl uebernehmen + ELSE + feldnummern := nummern; + feldversion := dateiversion + END IF . + +ggf alte auswahl uebernehmen : + IF feldversion <> dateiversion THEN + alle felder anzeigen; + feldversion := dateiversion + END IF . + +alle felder anzeigen : + INT VAR i; + feldnummern := niltext; + FOR i FROM 1 UPTO anzahl felder REP + feldnummern CAT code (i) + END REP . + +kommando annehmen und zeile ausgeben : + WHILE ausgegebene zeilen < laenge REP + eingabezeichen := getcharety; + IF eingabezeichen <> "" THEN + LEAVE kommando annehmen und zeile ausgeben + END IF; + eine zeile ausgeben; + ausgegebene zeilen INCR 1 + END REP; + aktuellen satz markieren und einnehmen; + getchar (eingabezeichen) . + +eine zeile ausgeben : + IF ausgegebene zeilen = 0 THEN + ueberschrift ausgeben + ELIF ausgegebene zeilen = 1 THEN + erste zeile ausgeben + ELSE + weitere zeile ausgeben + END IF . + +ueberschrift ausgeben : + cursor (spalten anf, zeilen anf); + out (t satznr); + freier rest := breite - length (t satznr) - 1; + INT VAR feldindex; + FOR feldindex FROM 1 UPTO length (feldnummern) + WHILE freier rest > 0 REP + feldnamen bearbeiten (code (feldnummern SUB feldindex), + PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest) + END REP; + zeilenrest loeschen; + cursor (spalten anf + breite - 1, zeilen anf); + out (end mark) . + +erste zeile ausgeben : + auf uebersichtssatz (1); + satznummer in zeile (1); + satz als zeile ausgeben . + +weitere zeile ausgeben : + cursor (spalten anf, zeilen anf + ausgegebene zeilen); + IF dateiende THEN + zeilensatz (ausgegebene zeilen) := 0; + freier rest := breite; + zeilenrest loeschen + ELSE + naechsten satz einnehmen; + satznummer in zeile (ausgegebene zeilen); + satz als zeile ausgeben + END IF . + +naechsten satz einnehmen : + weiter (2); + auf abbruch testen; + zeilensatz (ausgegebene zeilen) := satznummer; + zeilenkombi (ausgegebene zeilen) := satzkombination . + +auf abbruch testen : + IF NOT (satz ausgewaehlt OR dateiende) THEN + LEAVE uebersicht + END IF . + +cursor auf zeilenanfang : + cursor (spalten anf, zeilen anf + angezeigter satz) . + +aktuellen satz markieren und einnehmen : + WHILE zeilensatz (angezeigter satz) = 0 REP + angezeigter satz DECR 1 + END REP; + auf uebersichtssatz (angezeigter satz); + cursor (spalten anf + 6, zeilen anf + angezeigter satz) . + +kommando interpretieren : + SELECT eingabezustand OF + CASE 1 : normales kommando interpretieren + CASE 2 : hop kommando interpretieren + CASE 3 : esc kommando interpretieren + END SELECT . + +normales kommando interpretieren : + SELECT pos (""3""10""1""27"+-", eingabezeichen) OF + CASE 1 : zeile nach oben + CASE 2 : zeile nach unten + CASE 3 : eingabezustand := 2 + CASE 4 : eingabezustand := 3 + CASE 5 : markieren + CASE 6 : demarkieren + OTHERWISE out (piep) + END SELECT . + +hop kommando interpretieren : + SELECT pos (""3""10""13"", eingabezeichen) OF + CASE 1 : seite nach oben + CASE 2 : seite nach unten + CASE 3 : hop return + OTHERWISE out (piep) + END SELECT; + eingabezustand := 1 . + +esc kommando interpretieren : + SELECT pos ("19qh?", eingabezeichen) OF + CASE 1 : esc 1 + CASE 2 : esc 9 + CASE 3, 4 : esc q + CASE 5 : hilfestellung + OTHERWISE out (piep) + END SELECT; + eingabezustand := 1 . + +zeile nach oben : + IF angezeigter satz > 1 THEN + angezeigter satz DECR 1; + ELSE + nach oben rollen (1); + ausgegebene zeilen := 1 + END IF . + +zeile nach unten : + IF NOT dateiende THEN + IF angezeigter satz < laenge - 1 THEN + angezeigter satz INCR 1 + ELSE + zeilensatz (1) := zeilensatz (2); + zeilenkombi (1) := zeilenkombi (2); + ausgegebene zeilen := 1 + END IF + END IF . + +markieren : + IF NOT satz markiert THEN + markierung aendern; + IF angezeigter satz < ausgegebene zeilen THEN + satznummer in zeile (angezeigter satz) + END IF + END IF . + +demarkieren : + IF satz markiert THEN + markierung aendern; + IF angezeigter satz < ausgegebene zeilen THEN + satznummer in zeile (angezeigter satz) + END IF + END IF . + +seite nach oben : + IF angezeigter satz > 1 THEN + angezeigter satz := 1 + ELSE + nach oben rollen (laenge - 1); + ausgegebene zeilen := 1 + END IF . + +seite nach unten : + IF angezeigter satz = laenge - 1 AND NOT dateiende THEN + weiter (2); + aktueller satz wird erster; + ausgegebene zeilen := 1 + ELSE + angezeigter satz := laenge - 1 + END IF . + +hop return : + IF angezeigter satz <> 1 THEN + zeilensatz (1) := zeilensatz (angezeigter satz); + zeilenkombi (1) := zeilenkombi (angezeigter satz); + angezeigter satz := 1; + ausgegebene zeilen := 1 + END IF . + +esc 1 : + auf satz (1); + IF NOT satz ausgewaehlt THEN + weiter (2) + END IF; + aktueller satz wird erster; + angezeigter satz := 1; + ausgegebene zeilen := 1 . + +esc 9 : + auf satz (32767); + aktueller satz wird erster; + nach oben rollen (laenge - 2); + ausgegebene zeilen := 1 . + +esc q : + LEAVE uebersicht . + +hilfestellung : + hilfe; + status anzeigen (uebersicht status); + ausgegebene zeilen := 0 . + +END PROC uebersicht; + +PROC nach oben rollen (INT CONST gerollt) : + + INT VAR i; + auf uebersichtssatz (1); + FOR i FROM 1 UPTO gerollt + WHILE satznummer > 1 REP + zurueck (2) + END REP; + aktueller satz wird erster + +END PROC nach oben rollen; + +PROC auf uebersichtssatz (INT CONST zeile) : + + auf satz (zeilensatz (zeile)); + WHILE satzkombination <> zeilenkombi (zeile) REP + weiter (1) + END REP + +END PROC auf uebersichtssatz; + +PROC aktueller satz wird erster : + + zeilensatz (1) := satznummer; + zeilenkombi (1) := satzkombination + +END PROC aktueller satz wird erster; + +BOOL PROC uebereinstimmung (INT CONST zeile) : + + satznummer = zeilensatz (zeile) CAND satzkombination = zeilenkombi (zeile) + +END PROC uebereinstimmung; + +PROC feld bis rest (TEXT CONST satz, INT CONST von, bis) : + + INT CONST laenge := min (freier rest, bis - von + 1); + outsubtext (satz, von, von + laenge - 1); + freier rest DECR laenge; + IF freier rest >= 2 THEN + out (", "); freier rest DECR 2 + ELIF freier rest = 1 THEN + out (","); freier rest := 0 + END IF + +END PROC feld bis rest; + +PROC satznummer in zeile (INT CONST zeile) : + + cursor (spalten anf, zeilen anf + zeile); + IF satz markiert THEN + out (begin mark) + ELSE + out (blank) + END IF; + outtext (text (satznummer), 1, 5); + IF satz markiert THEN + out (end mark) + ELSE + out (blank) + END IF; + freier rest := breite - 7 + +END PROC satznummer in zeile; + +PROC zeilenrest loeschen : + + IF bis zeilenende THEN + out (cleol) + ELSE + freier rest TIMESOUT blank + END IF + +END PROC zeilenrest loeschen; + +PROC satz als zeile ausgeben : + + IF satz ausgewaehlt THEN + felder ausgeben + ELIF dateiende THEN + out (t dateiende); + freier rest DECR length (t dateiende) + ELSE + out ("<< >>"); + freier rest DECR 5 + END IF; + zeilenrest loeschen . + +felder ausgeben : + INT VAR feldindex; + FOR feldindex FROM 1 UPTO length (feldnummern) + WHILE freier rest > 0 REP + feld bearbeiten (code (feldnummern SUB feldindex), + PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest) + END REP . + +END PROC satz als zeile ausgeben; + +END PACKET uebersichtsanzeige; + diff --git a/app/eudas/5.3/src/eudas.verarbeiten.06 b/app/eudas/5.3/src/eudas.verarbeiten.06 new file mode 100644 index 0000000..8d91407 --- /dev/null +++ b/app/eudas/5.3/src/eudas.verarbeiten.06 @@ -0,0 +1,745 @@ +PACKET verarbeitung + +(*************************************************************************) +(* *) +(* Automatische Verarbeitung von EUDAS-Dateien *) +(* *) +(* Version 06 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 04.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + kopiere, + std kopiermuster, + verarbeite, + trage, + eindeutige felder, + pruefe, + wertemenge, + feldmaske, + trage satz, + hole satz, + K, + V, + f, + wert, + zahltext, + textdarstellung : + + +SATZ VAR + zielfeldnamen, + kopierfeldnamen, + kopiersatz; + +INT VAR kopierindex; + +BOOL VAR erstes mal; + +LET + niltext = "", + INTVEC = TEXT; + +INTVEC VAR kopiervektor; + +TEXT VAR zwei bytes := " "; + + +OP CAT (INTVEC VAR intvec, INT CONST zahl) : + + replace (zwei bytes, 1, zahl); + intvec CAT zwei bytes + +END OP CAT; + +PROC std kopiermuster (TEXT CONST dateiname, FILE VAR kopiermuster) : + + teste ob datei vorhanden; + INT VAR zielfelder; + dateien oeffnen; + feldnamen bestimmen; + INT VAR feldnr; + FOR feldnr FROM 1 UPTO zielfelder REP + feldnamen auslesen; + IF feld vorhanden THEN + direkt kopieren + ELSE + leer kopieren + END IF + END REP . + +dateien oeffnen : + output (kopiermuster); + EUDAT VAR eudas datei; + IF exists (dateiname) THEN + oeffne (eudas datei, dateiname) + END IF . + +feldnamen bestimmen : + IF exists (dateiname) CAND felderzahl (eudas datei) > 0 THEN + feldnamen lesen (eudas datei, zielfeldnamen); + zielfelder := felderzahl (eudas datei) + ELSE + quellfeldnamen kopieren; + zielfelder := anzahl felder + END IF . + +quellfeldnamen kopieren : + TEXT VAR feldname; + satz initialisieren (zielfeldnamen); + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldname); + feld aendern (zielfeldnamen, feldnr, feldname) + END REP . + +feld vorhanden : + feldnummer (feldname) > 0 . + +feldnamen auslesen : + feld lesen (zielfeldnamen, feldnr, feldname); + put (kopiermuster, textdarstellung (feldname)) . + +direkt kopieren : + write (kopiermuster, "K f("); + write (kopiermuster, textdarstellung (feldname)); + putline (kopiermuster, ");") . + +leer kopieren : + putline (kopiermuster, "K """";") . + +END PROC std kopiermuster; + +PROC kopiere (TEXT CONST dateiname, FILE VAR kopiermuster) : + + programmfunktion (kopieraufruf, kopiermuster) . + +kopieraufruf : + "kopiere (" + textdarstellung (dateiname) + ", " . + +END PROC kopiere; + +PROC programmfunktion (TEXT CONST aufruf, FILE VAR muster) : + + programmdatei einrichten; + write (programm, aufruf); + putline (programm, "PROC programmfunktion);"); + putline (programm, "PROC programmfunktion:"); + muster kopieren; + putline (programm, "END PROC programmfunktion"); + programm ausfuehren; + forget (programm datei, quiet) . + +programmdatei einrichten : + TEXT VAR programmdatei; + INT VAR i := 0; + REP + i INCR 1; + programmdatei := text (i) + UNTIL NOT exists (programmdatei) END REP; + disable stop; + FILE VAR programm := sequential file (output, programm datei); + headline (programm, erzeugtes programm) . + +muster kopieren : + TEXT VAR zeile; + input (muster); + WHILE NOT eof (muster) REP + getline (muster, zeile); + putline (programm, zeile) + END REP . + +programm ausfuehren : + TEXT CONST alter last param := std; + run (programmdatei); + last param (alter last param) . + +END PROC programm funktion; + +PROC kopiere (TEXT CONST dateiname, PROC kopierfunktion) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + IF dateiende THEN + auf satz (1); + LEAVE kopiere + ELSE + zieldatei einrichten + END IF; + + WHILE NOT dateiende REP + satz initialisieren (kopiersatz); + kopierindex := 1; + kopierfunktion; + evtl feldnamen einrichten; + satz einfuegen (eudas datei, kopiersatz); + weiter (eudas datei); + weiter (modus) + END REP; + auf satz (1) . + +zieldatei einrichten : + erstes mal := TRUE; + EUDAT VAR eudas datei; + oeffne (eudas datei, dateiname); + auf satz (eudas datei, saetze (eudas datei) + 1); + feldnamen lesen (eudas datei, kopierfeldnamen); + kopiervektor := niltext . + +evtl feldnamen einrichten : + IF erstes mal THEN + feldnamen aendern (eudas datei, kopierfeldnamen); + erstes mal := FALSE + END IF + +END PROC kopiere; + +OP K (TEXT CONST feldname, ausdruck) : + + IF erstes mal THEN + kopiervektor erstellen; + END IF; + feld aendern (kopiersatz, kopiervektor ISUB kopierindex, ausdruck); + kopierindex INCR 1 . + +kopiervektor erstellen : + INT VAR aktueller index := feldindex (kopierfeldnamen, feldname); + IF aktueller index = 0 THEN + aktueller index := felderzahl (kopierfeldnamen) + 1; + feld aendern (kopierfeldnamen, aktueller index, feldname); + END IF; + kopiervektor CAT aktueller index . + +END OP K; + +PROC verarbeite (FILE VAR verarbeitungsmuster) : + + programmfunktion ("verarbeite (", verarbeitungsmuster) + +END PROC verarbeite; + +PROC verarbeite (PROC verarbeitungsfunktion) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + + WHILE NOT dateiende REP + verarbeitungsfunktion; + weiter (modus) + END REP; + auf satz (1) + +END PROC verarbeite; + +OP V (TEXT CONST feldname, ausdruck) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname) + ELSE + feld aendern (nr, ausdruck) + END IF + +END OP V; + +PROC auf ersten satz (INT VAR modus) : + + teste ob datei vorhanden; + auf satz (1); + IF markierte saetze > 0 THEN + modus := 3; + IF NOT satz markiert THEN weiter (modus) END IF + ELSE + modus := 2; + IF NOT satz ausgewaehlt THEN weiter (modus) END IF + END IF + +END PROC auf ersten satz; + +PROC teste ob datei vorhanden : + + IF anzahl dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF . + +END PROC teste ob datei vorhanden; + + +(******************************** Zugriffe *******************************) + +TEXT VAR + feldpuffer, + werttext; + +LET quote = """"; + + +TEXT PROC f (TEXT CONST feldname) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname); + feldpuffer := niltext + ELSE + feld lesen (nr, feldpuffer) + END IF; + feldpuffer + +END PROC f; + +REAL PROC wert (TEXT CONST feldname) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname); + 0.0 + ELSE + feld lesen (nr, feldpuffer); + REAL VAR ergebnis; + wert berechnen (feldpuffer, ergebnis); + ergebnis + END IF + +END PROC wert; + +REAL PROC wert (TEXT CONST feldname, INT CONST kommastellen) : + + round (wert (feldname), kommastellen) + +END PROC wert; + +TEXT PROC zahltext (REAL CONST feldwert, INT CONST kommastellen) : + + REAL CONST w := round (abs (feldwert), kommastellen); + INT VAR stellen := exponent der zahl + kommastellen + 2; + IF feldwert < 0.0 THEN + werttext := "-" + ELSE + werttext := niltext + END IF; + IF w < 1.0 AND w <> 0.0 THEN + werttext CAT "0"; + stellen DECR 1 + ENDIF; + werttext CAT text (w, stellen, kommastellen); + IF kommastellen > 0 THEN + change (werttext, ".", dezimalkomma) + ELSE + change (werttext, ".", niltext) + END IF; + werttext . + +exponent der zahl : + max (0, decimal exponent (w)) . + +END PROC zahltext; + +TEXT PROC zahltext (TEXT CONST feldname, INT CONST kommastellen) : + + zahltext (wert (feldname), kommastellen) + +END PROC zahltext; + +TEXT PROC textdarstellung (TEXT CONST anzeigetext) : + + feldpuffer := anzeigetext; + change all (feldpuffer, quote, quote + quote); + steuerzeichen umwandeln; + insert char (feldpuffer, quote, 1); + feldpuffer CAT quote; + feldpuffer . + +steuerzeichen umwandeln : + INT VAR stelle := 1; + WHILE steuerzeichen vorhanden REP + change (feldpuffer, stelle, stelle, steuertext) + END REP . + +steuerzeichen vorhanden : + stelle := pos (feldpuffer, ""0"", ""31"", stelle); + stelle > 0 . + +steuertext : + quote + text (code (feldpuffer SUB stelle)) + quote . + +END PROC textdarstellung; + +PROC unbekannt (TEXT CONST feldname) : + + errorstop (t das feld + textdarstellung (feldname) + + nicht definiert) + +END PROC unbekannt; + + +(****************************** Tragen ***********************************) + +SATZ VAR tragsatz; + +EUDAT VAR zieldatei; + +LET + erzeugtes programm = #501# + "erzeugtes Programm", + keine datei geoeffnet = #502# + "keine Datei geoeffnet", + kein satz vorhanden = #503# + "Kein Satz zum Tragen vorhanden", + falsche felderzahl = #504# + "Zieldatei hat falsche Felderzahl", + existiert nicht = #505# + " existiert nicht", + verletzt die pruefbedingung = #506# + " verletzt die Pruefbedingung.", + bereits vorhanden = #507# + " ist in der Zieldatei bereits vorhanden.", + nicht definiert = #508# + " ist nicht definiert.", + nicht in wertemenge = #509# + " ist nicht in der Wertemenge.", + passt nicht zu maske = #510# + " stimmt nicht mit der Maske ueberein.", + t satz = #511# + "Satz ", + t das feld = #512# + "Das Feld "; + +INT VAR + anzahl eindeutiger felder; + +FILE VAR protokoll; + +BOOL VAR + testen := FALSE, + test erfolgreich, + uebereinstimmung; + +TEXT VAR testprogramm; + + +PROC trage (TEXT CONST dateiname, FILE VAR protokoll file, BOOL CONST test) : + + disable stop; + testen := test; + IF testen THEN + protokoll := protokoll file; + output (protokoll) + END IF; + trage intern (dateiname); + testen := FALSE + +END PROC trage; + +PROC trage intern (TEXT CONST dateiname) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + tragen vorbereiten (dateiname); + + INT VAR satzzaehler := 0; + REP + IF NOT ausgewaehlt THEN + weiter (modus) + ELSE + cout (satznummer + satzzaehler) + END IF; + IF dateiende THEN auf satz (1); LEAVE trage intern END IF; + satz testen und tragen + END REP . + +ausgewaehlt : + IF modus = 3 THEN satz markiert ELSE satz ausgewaehlt END IF . + +satz testen und tragen : + test erfolgreich := TRUE; + IF testen THEN + notizen lesen (zieldatei, 1, testprogramm); + do (testprogramm) + END IF; + IF test erfolgreich THEN + trage einzelsatz; + IF test erfolgreich THEN + satz loeschen; + satzzaehler INCR 1 + END IF + END IF; + IF NOT test erfolgreich THEN + weiter (modus) + END IF . + +END PROC trage intern; + +PROC tragen vorbereiten (TEXT CONST dateiname) : + + IF dateiende THEN + errorstop (kein satz vorhanden) + END IF; + oeffne (zieldatei, dateiname); + anzahl eindeutiger felder := 0; + IF felderzahl (zieldatei) = 0 THEN + zieldatei einrichten + ELIF felderzahl (zieldatei) <> anzahl felder THEN + errorstop (falsche felderzahl) + END IF; + auf satz (zieldatei, saetze (zieldatei) + 1) . + +zieldatei einrichten : + satz initialisieren (tragsatz, anzahl felder); + INT VAR feldnr; + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldpuffer); + feld aendern (tragsatz, feldnr, feldpuffer) + END REP; + feldnamen aendern (zieldatei, tragsatz); + feldinfo kopieren; + notizen kopieren . + +feldinfo kopieren : + FOR feldnr FROM 1 UPTO anzahl felder REP + feldinfo (zieldatei, feldnr, feldinfo (feldnr)) + END REP . + +notizen kopieren : + INT VAR i; + FOR i FROM 1 UPTO 3 REP + notizen lesen (i, feldpuffer); + notizen aendern (zieldatei, i, feldpuffer) + END REP . + +END PROC tragen vorbereiten; + +PROC trage einzelsatz : + + IF anzahl eindeutiger felder > 0 CAND schon vorhanden THEN + protokolliere ("", bereits vorhanden) + ELSE + tragsatz aufbauen; + satz einfuegen (zieldatei, tragsatz); + weiter (zieldatei) + END IF . + +tragsatz aufbauen : + satz initialisieren (tragsatz, anzahl felder); + INT VAR feldnr; + FOR feldnr FROM 1 UPTO anzahl felder REP + feld lesen (feldnr, feldpuffer); + feld aendern (tragsatz, feldnr, feldpuffer) + END REP . + +schon vorhanden : + TEXT VAR muster; + INT CONST alte satznummer := satznr (zieldatei); + feld lesen (1, muster); + uebereinstimmung := FALSE; + auf satz (zieldatei, muster); + WHILE NOT dateiende (zieldatei) REP + teste auf uebereinstimmung; + weiter (zieldatei, muster) + UNTIL uebereinstimmung END REP; + auf satz (zieldatei, alte satznummer); + uebereinstimmung . + +teste auf uebereinstimmung : + INT VAR i; + uebereinstimmung := TRUE; + FOR i FROM 2 UPTO anzahl eindeutiger felder REP + feld lesen (zieldatei, i, feldpuffer); + feld bearbeiten (i, + PROC (TEXT CONST, INT CONST, INT CONST) felduebereinstimmung); + IF NOT uebereinstimmung THEN + LEAVE teste auf uebereinstimmung + END IF + END REP . + +END PROC trage einzelsatz; + +PROC felduebereinstimmung (TEXT CONST satz, INT CONST von, bis) : + + IF laengen ungleich COR + (length (feldpuffer) > 0 CAND text ungleich) THEN + uebereinstimmung := FALSE + END IF . + +laengen ungleich : + (bis - von + 1) <> length (feldpuffer) . + +text ungleich : + pos (satz, feldpuffer, von, bis + 1) <> von . + +END PROC felduebereinstimmung; + +PROC protokolliere (TEXT CONST feld, meldung) : + + IF testen THEN + in protokoll + ELSE + errorstop (meldung) + END IF . + +in protokoll : + put (protokoll, t satz); put (protokoll, satznummer); + IF feld <> "" THEN + write (protokoll, t das feld); + write (protokoll, textdarstellung (feld)) + END IF; + putline (protokoll, meldung); + test erfolgreich := FALSE . + +END PROC protokolliere; + +PROC eindeutige felder (INT CONST anzahl) : + + anzahl eindeutiger felder := anzahl + +END PROC eindeutige felder; + +PROC pruefe (TEXT CONST feld, BOOL CONST bedingung) : + + IF NOT bedingung THEN + protokolliere (feld, verletzt die pruefbedingung) + END IF + +END PROC pruefe; + +PROC wertemenge (TEXT CONST feld, menge) : + + INT CONST nr := feldnummer (feld); + IF nr = 0 THEN + protokolliere (feld, nicht definiert) + ELSE + pruefe ob enthalten + END IF . + +pruefe ob enthalten : + INT VAR stelle := 0; + LET komma = ","; + feld lesen (nr, feldpuffer); + IF ist letztes element THEN + LEAVE pruefe ob enthalten + END IF; + feldpuffer CAT komma; + REP + stelle := pos (menge, feldpuffer, stelle + 1); + IF stelle = 1 OR + stelle > 1 CAND (menge SUB stelle - 1) = komma THEN + LEAVE pruefe ob enthalten + END IF + UNTIL stelle = 0 END REP; + protokolliere (feld, nicht in wertemenge) . + +ist letztes element : + INT CONST letzter anfang := length (menge) - length (feldpuffer); + (menge SUB letzter anfang) = komma AND + pos (menge, feldpuffer, letzter anfang + 1) > 0 . + +END PROC wertemenge; + +PROC feldmaske (TEXT CONST feld, maske) : + + INT CONST nr := feldnummer (feld); + IF nr = 0 THEN + protokolliere (feld, nicht definiert) + ELSE + feld lesen (nr, feldpuffer); + mit maske vergleichen + END IF . + +mit maske vergleichen : + INT VAR stelle; + TEXT CONST ende := code (length (maske) + 1); + TEXT VAR moegliche positionen := ""1""; + FOR stelle FROM 1 UPTO length (feldpuffer) REP + TEXT CONST zeichen := feldpuffer SUB stelle; + zeichen vergleichen + UNTIL moegliche positionen = "" END REP; + IF nicht erfolgreich THEN + protokolliere (feld, passt nicht zu maske) + END IF . + +zeichen vergleichen : + INT VAR moeglich := 1; + WHILE moeglich <= length (moegliche positionen) REP + INT CONST position := code (moegliche positionen SUB moeglich); + IF (maske SUB position) = "*" THEN + stern behandeln + ELIF vergleich trifft zu THEN + replace (moegliche positionen, moeglich, code (position + 1)); + moeglich INCR 1 + ELSE + delete char (moegliche positionen, moeglich) + END IF + END REP . + +stern behandeln : + IF position = length (maske) THEN + LEAVE feldmaske + END IF; + moeglich INCR 1; + IF pos (moegliche positionen, code (position + 1)) = 0 THEN + insert char (moegliche positionen, code (position + 1), moeglich) + END IF . + +vergleich trifft zu : + SELECT pos ("9XAa", maske SUB position) OF + CASE 1 : pos ("0123456789", zeichen) > 0 + CASE 2 : TRUE + CASE 3 : pos ("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ", zeichen) > 0 + CASE 4 : pos ("abcdefghijklmnopqrstuvwxyzäöüß", zeichen) > 0 + OTHERWISE (maske SUB position) = zeichen + END SELECT . + +nicht erfolgreich : + (moegliche positionen = "" COR pos (moegliche positionen, ende) = 0) + AND nicht gerade stern am ende . + +nicht gerade stern am ende : + (maske SUB length (maske)) <> "*" OR + pos (moegliche positionen, code (length (maske))) = 0 . + +END PROC feldmaske; + +PROC trage satz (TEXT CONST dateiname) : + + tragen vorbereiten (dateiname); + INT CONST alter satz := satznr (zieldatei); + trage einzelsatz; + satz loeschen; + auf satz (zieldatei, alter satz) + +END PROC trage satz; + +PROC hole satz (TEXT CONST dateiname) : + + teste ob datei vorhanden; + IF NOT exists (dateiname) THEN + errorstop (textdarstellung (dateiname) + existiert nicht) + END IF; + oeffne (zieldatei, dateiname); + IF felderzahl (zieldatei) <> anzahl felder THEN + errorstop (falsche felderzahl) + ELIF saetze (zieldatei) = 0 THEN + errorstop (kein satz vorhanden) + END IF; + auf satz (zieldatei, saetze (zieldatei)); + satz lesen (zieldatei, tragsatz); + tragsatz einfuegen; + satz loeschen (zieldatei) . + +tragsatz einfuegen : + satz einfuegen; + INT VAR feldnr; + FOR feldnr FROM 1 UPTO felderzahl (tragsatz) REP + feld lesen (tragsatz, feldnr, feldpuffer); + feld aendern (feldnr, feldpuffer) + END REP . + +END PROC hole satz; + +END PACKET verarbeitung; + diff --git a/app/eudas/5.3/src/eudas.verwaltung.11 b/app/eudas/5.3/src/eudas.verwaltung.11 new file mode 100644 index 0000000..9fc1393 --- /dev/null +++ b/app/eudas/5.3/src/eudas.verwaltung.11 @@ -0,0 +1,2047 @@ +PACKET datenverwaltung + +(*************************************************************************) +(* *) +(* Verwaltung der aktuellen EUDAS-Dateien *) +(* *) +(* Version 11 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 04.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + oeffne, + kopple, + kette, + zugriff, + sichere, + dateien loeschen, + auf koppeldatei, + + anzahl koppeldateien, + anzahl dateien, + aendern erlaubt, + inhalt veraendert, + eudas dateiname, + folgedatei, + herkunft, + + dateiversion, + + anzahl felder, + feldnamen lesen, + feldnamen bearbeiten, + feldnummer, + feldinfo, + notizen lesen, + notizen aendern, + + feld lesen, + feld bearbeiten, + feld aendern, + + satznummer, + satzkombination, + dateiende, + weiter, + zurueck, + auf satz, + + satz einfuegen, + satz loeschen, + aenderungen eintragen, + + suchbedingung, + suchbedingung lesen, + suchbedingung loeschen, + suchversion, + satz ausgewaehlt, + markierung aendern, + satz markiert, + markierungen loeschen, + markierte saetze : + + +LET + INTVEC = TEXT, + + DATEI = STRUCT + (TEXT name, + SATZ feldnamen, + INTVEC koppelfelder, + INT anz koppelfelder, + INT naechste datei, + INT alte koppelposition, + TASK ursprung, + DATASPACE ds, + EUDAT eudat, + SATZ satzpuffer, + BOOL gepuffert, + BOOL veraendert, datei veraendert, koppelfeld veraendert, + TEXT muster, + INTVEC marksaetze, + INT markzeiger), + + VERWEIS = STRUCT (INT datei, feld); + +LET + niltext = "", + empty intvec = ""; + +LET + maxint = 32767, + maxdateien = 10, + maxfelder = 256, + maxkoppeln = 32; + +ROW maxdateien DATEI VAR daten; + +INT VAR + anz dateien := 0, + anz koppeldateien := 0, + hauptdatei, + erste koppeldatei := 0, + felderzahl der ersten datei, + anz felder := 0, + satznummer offset, + kombination, + markierungen, + laufzaehler := 0; + +BOOL VAR + ende der datei := TRUE, + aenderungserlaubnis, + globales muster vorhanden; + +TEXT VAR globales muster; + +ROW maxfelder VERWEIS VAR verweis; + +ROW maxkoppeln VERWEIS VAR koppeln; + +INT VAR koppeleintraege; + +LET + zuviel dateien = #301# + "Zuviel Dateien geoeffnet", + datei existiert nicht = #302# + "Datei existiert nicht", + nicht im umgeschalteten zustand = #303# + "Nicht moeglich, wenn auf Koppeldatei geschaltet", + zu viele felder = #304# + "Zu viele Felder", + zu viele koppelfelder = #305# + "Zu viele Koppelfelder", + keine koppelfelder = #306# + "keine Koppelfelder vorhanden", + kein zugriff bei ketten oder koppeln = #307# + "kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien", + keine datei geoeffnet = #308# + "keine Datei geoeffnet", + datei nicht gesichert = #309# + "Datei nicht gesichert", + suchmuster zu umfangreich = #310# + "Suchmuster zu umfangreich"; + +TEXT VAR feldpuffer; + + +(***************************** INTVEC ************************************) + +TEXT VAR raum fuer ein int := " "; + +INTVEC VAR puffer; + +OP CAT (INTVEC VAR text, INT CONST wert) : + + replace (raum fuer ein int, 1, wert); + text CAT raum fuer ein int + +END OP CAT; + +PROC insert (INTVEC VAR vector, INT CONST stelle, wert) : + + INT CONST trennung := stelle + stelle - 2; + puffer := subtext (vector, trennung + 1); + vector := subtext (vector, 1, trennung); + vector CAT wert; + vector CAT puffer + +END PROC insert; + +PROC delete (INTVEC VAR vector, INT CONST stelle) : + + INT CONST trennung := stelle + stelle - 2; + puffer := subtext (vector, trennung + 3); + vector := subtext (vector, 1, trennung); + vector CAT puffer + +END PROC delete; + +PROC inkrement (INTVEC VAR vector, INT CONST ab, um) : + + INT VAR i; + FOR i FROM ab UPTO length (vector) DIV 2 - 1 REP + replace (vector, i, (vector ISUB i) + um) + END REP + +END PROC inkrement; + + +(***************************** Dateien eintragen *************************) + +EUDAT VAR eudas datei; + +SATZ VAR namen; + +PROC datei testen (TEXT CONST dateiname) : + + IF anz dateien = maxdateien THEN + errorstop (zuviel dateien) + END IF; + IF NOT exists (dateiname) THEN + errorstop (datei existiert nicht) + END IF; + IF umgeschaltet THEN + errorstop (nicht im umgeschalteten zustand) + END IF; + oeffne (eudas datei, dateiname) + +END PROC datei testen; + +PROC datei eintragen (DATEI VAR datei, TEXT CONST dateiname, + TASK CONST manager) : + + IF aenderungserlaubnis OR NOT is niltask (manager) THEN + datei. ds := old (dateiname); + oeffne (datei. eudat, datei. ds); + IF NOT aenderungserlaubnis THEN forget (dateiname, quiet) END IF + ELSE + oeffne (datei. eudat, dateiname) + END IF; + datei. ursprung := manager; + datei. naechste datei := 0; + datei. veraendert := FALSE; + datei. datei veraendert := FALSE; + datei. name := dateiname; + mark loeschen (datei) + +END PROC datei eintragen; + +PROC in dateikette (INT CONST anfang) : + + INT VAR dateiindex := anfang; + WHILE daten (dateiindex). naechste datei <> 0 REP + dateiindex := daten (dateiindex). naechste datei + END REP; + daten (dateiindex). naechste datei := anz dateien + +END PROC in dateikette; + +PROC anfangsposition einnehmen : + + IF dateiende (daten (1). eudat) THEN + auf satz (1) + ELSE + auf satz (satznr (daten (1). eudat)) + END IF + +END PROC anfangsposition einnehmen; + +PROC felder anlegen : + + felderzahl der ersten datei := felderzahl (daten (1). eudat); + anz felder := felderzahl der ersten datei; + feldnamen lesen (daten (1). eudat, daten (1). feldnamen); + koppeleintraege := 0; + INT VAR i; + FOR i FROM 1 UPTO anz felder REP + verweis (i). datei := 0 + END REP + +END PROC felder anlegen; + +PROC laufzaehler erhoehen : + + laufzaehler INCR 1; + IF laufzaehler > 32000 THEN + laufzaehler := - 32000 + END IF + +END PROC laufzaehler erhoehen; + +PROC oeffne (TEXT CONST dateiname, BOOL CONST auch aendern) : + + oeffne (dateiname, auch aendern, niltask) + +END PROC oeffne; + +PROC oeffne (TEXT CONST dateiname, BOOL CONST auch aendern, + TASK CONST manager) : + + enable stop; + dateien loeschen (FALSE); + suchbedingung loeschen; + datei testen (dateiname); + aenderungserlaubnis := auch aendern; + status setzen; + datei eintragen (daten (anz dateien), dateiname, manager); + anfangsposition einnehmen; + felder anlegen . + +status setzen : + anz dateien := 1; + laufzaehler erhoehen; + markierungen := 0 . + +END PROC oeffne; + +PROC kopple (TEXT CONST dateiname) : + + kopple (dateiname, niltask) + +END PROC kopple; + +PROC kopple (TEXT CONST dateiname, TASK CONST manager) : + + enable stop; + IF anz dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + datei testen (dateiname); + koppelfelder bestimmen; + platz in feldtabellen belegen; + in kette der koppeldateien einfuegen; + datei eintragen (daten (anz dateien), dateiname, manager); + koppelstatus setzen . + +koppelfelder bestimmen : + feldnamen lesen (eudas datei, namen); + INT VAR koppelfelder := 0; + INTVEC VAR koppelfeldnr := empty intvec; + WHILE koppelfelder < felderzahl (eudas datei) REP + feld lesen (namen, koppelfelder + 1, feldpuffer); + INT CONST index := feldindex (daten (1). feldnamen, feldpuffer); + IF index > 0 THEN + koppelfelder INCR 1; + koppelfeldnr CAT index + END IF + UNTIL index = 0 END REP . + +platz in feldtabellen belegen : + IF anz felder + felderzahl (eudas datei) - koppelfelder > maxfelder THEN + errorstop (zu viele felder) + ELIF koppeleintraege + koppelfelder > maxkoppeln THEN + errorstop (zu viele koppelfelder) + ELIF koppelfelder = 0 THEN + errorstop (keine koppelfelder) + END IF; + anz dateien INCR 1; + daten (anz dateien). feldnamen := namen; + daten (anz dateien). koppelfelder := koppelfeldnr; + daten (anz dateien). anz koppelfelder := koppelfelder; + INT VAR feldnr := koppelfelder; + WHILE feldnr < felderzahl (eudas datei) REP + anz felder INCR 1; feldnr INCR 1; + verweis (anz felder). datei := anz dateien; + verweis (anz felder). feld := feldnr + END REP; + FOR feldnr FROM 1 UPTO koppelfelder REP + koppelfeld eintragen + END REP . + +koppelfeld eintragen : + INT CONST koppelfeld := koppelfeldnr ISUB feldnr; + IF verweis (koppelfeld). datei = 0 THEN + neues koppelfeld eintragen + ELSE + alten eintrag erweitern + END IF . + +neues koppelfeld eintragen : + koppeleintraege INCR 1; + koppeln (koppeleintraege). datei := anz dateien; + koppeln (koppeleintraege). feld := feldnr; + verweis (koppelfeld). datei := koppeleintraege; + verweis (koppelfeld). feld := 1 . + +alten eintrag erweitern : + INT CONST eintragposition := + verweis (koppelfeld). datei + verweis (koppelfeld). feld; + folgende eintraege hochschieben; + verweis (koppelfeld). feld INCR 1; + koppeln (eintragposition). datei := anz dateien; + koppeln (eintragposition). feld := feldnr . + +folgende eintraege hochschieben : + INT VAR eintrag; + FOR eintrag FROM koppeleintraege DOWNTO eintragposition REP + koppeln (eintrag + 1) := koppeln (eintrag) + END REP; + koppeleintraege INCR 1; + FOR eintrag FROM 1 UPTO felderzahl der ersten datei REP + IF verweis (eintrag). datei >= eintragposition THEN + verweis (eintrag). datei INCR 1 + END IF + END REP . + +in kette der koppeldateien einfuegen : + anz koppeldateien INCR 1; + IF erste koppeldatei = 0 THEN + erste koppeldatei := anz dateien + ELSE + in dateikette (erste koppeldatei) + END IF . + +koppelstatus setzen : + laufzaehler erhoehen; + daten (anz dateien). gepuffert := FALSE; + daten (anz dateien). koppelfeld veraendert := FALSE; + daten (anz dateien). alte koppelposition := satznr (eudas datei); + koppeldatei aktualisieren (daten (anz dateien)) . + +END PROC kopple; + +PROC kette (TEXT CONST dateiname) : + + kette (dateiname, niltask) + +END PROC kette; + +PROC kette (TEXT CONST dateiname, TASK CONST manager) : + + enable stop; + IF anz dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + datei testen (dateiname); + anz dateien INCR 1; + datei eintragen (daten (anz dateien), dateiname, manager); + in dateikette (1); + IF ende der datei THEN auf satz (satznummer) END IF + +END PROC kette; + +PROC zugriff (PROC (EUDAT VAR) bearbeitung) : + + IF anz dateien > 1 OR umgeschaltet THEN + errorstop (kein zugriff bei ketten oder koppeln) + ELSE + aenderungen eintragen; + bearbeitung (daten (1). eudat); + laufzaehler erhoehen; + anfangsposition einnehmen; + felder anlegen; + daten (1). datei veraendert := TRUE + ENDIF + +END PROC zugriff; + +PROC sichere (INT CONST dateinummer, TEXT CONST dateiname) : + + aenderungen eintragen; + notizen aendern (daten (dateinummer). eudat, 2, date); + IF aenderungserlaubnis THEN + forget (dateiname, quiet); + copy (daten (dateinummer). ds, dateiname) + END IF; + daten (dateinummer). datei veraendert := FALSE + +END PROC sichere; + +PROC dateien loeschen (BOOL CONST auch geaenderte) : + + aenderungen eintragen; + IF umgeschaltet THEN auf koppeldatei (0) END IF; + kontrollvariablen loeschen; + dateien einzeln loeschen . + +kontrollvariablen loeschen : + anz koppeldateien := 0; + erste koppeldatei := 0; + daten (1). naechste datei := 0; + anz felder := 0; + ende der datei := TRUE . + +dateien einzeln loeschen : + WHILE anz dateien > 0 REP + IF wirklich veraendert AND NOT auch geaenderte THEN + errorstop (datei nicht gesichert); + LEAVE dateien loeschen + END IF; + forget (daten (anz dateien). ds); + anz dateien DECR 1 + END REP . + +wirklich veraendert : + aenderungserlaubnis AND daten (anz dateien). datei veraendert . + +END PROC dateien loeschen; + + +(*********************** Umschalten Koppeldatei **************************) + +INT VAR + save hauptdatei, + save felderzahl der ersten datei, + save anz felder, + save satznummer offset, + save kombination, + save markierungen, + save erste koppeldatei, + save naechste koppeldatei; + +BOOL VAR + save globales muster vorhanden; + +INTVEC VAR + save oder anfang; + +SATZ VAR + save muster gespeichert; + + +BOOL VAR + umgeschaltet := FALSE; + +INT VAR + anzahl hauptmuster := 0, + feldnamendatei := 1; + + +BOOL PROC auf koppeldatei : + + umgeschaltet + +END PROC auf koppeldatei; + +PROC auf koppeldatei (INT CONST nr) : + + disable stop; + laufzaehler erhoehen; + IF umgeschaltet THEN + alte variablen wiederherstellen; + umgeschaltet := FALSE; + ggf koppelfelder uebernehmen; + fuer korrekten zustand sorgen + ELSE + alte variablen sichern; + umgeschaltet := TRUE; + neuen zustand herstellen + END IF . + +alte variablen wiederherstellen : + hauptdatei := save hauptdatei; + felderzahl der ersten datei := save felderzahl der ersten datei; + anz felder := save anz felder; + satznummer offset := save satznummer offset; + markierungen := save markierungen; + erste koppeldatei := save erste koppeldatei; + daten (feldnamendatei). naechste datei := save naechste koppeldatei; + anzahl muster := anzahl hauptmuster; + globales muster vorhanden := save globales muster vorhanden; + oder anfang := save oder anfang; + muster gespeichert := save muster gespeichert; + IF anzahl muster > 0 THEN + erster musterindex := 1 + ELSE + erster musterindex := -1 + END IF . + +fuer korrekten zustand sorgen : + anzahl hauptmuster := 0; + feldnamendatei := 1; + enable stop; + auf satz (satznummer); + WHILE kombination <> save kombination REP + weiter (1) + END REP . + +ggf koppelfelder uebernehmen : + daten (feldnamendatei). alte koppelposition := + satznr (daten (feldnamendatei). eudat); + IF nr = 1 AND NOT dateiende (daten (hauptdatei). eudat) THEN + alle koppelfelder in hauptdatei uebernehmen + END IF . + +alle koppelfelder in hauptdatei uebernehmen : + INT VAR koppel nr; + FOR koppel nr FROM 1 UPTO daten (feldnamendatei). anz koppelfelder REP + feld aendern (daten (hauptdatei). eudat, feld nr koppelfeld, + feldinhalt koppelfeld) + END REP; + save kombination := 1 . + +feld nr koppelfeld : + daten (feldnamendatei). koppelfelder ISUB koppel nr . + +feldinhalt koppelfeld : + feld lesen (daten (feldnamendatei). eudat, koppel nr, feldpuffer); + feldpuffer . + +alte variablen sichern : + save hauptdatei := hauptdatei; + save felderzahl der ersten datei := felderzahl der ersten datei; + save anz felder := anz felder; + save satznummer offset := satznummer offset; + save kombination := kombination; + save markierungen := markierungen; + save erste koppeldatei := erste koppeldatei; + save naechste koppeldatei := daten (nr). naechste datei; + save globales muster vorhanden := globales muster vorhanden; + save oder anfang := oder anfang; + save muster gespeichert := muster gespeichert . + +neuen zustand herstellen : + hauptdatei := nr; + anzahl hauptmuster := anzahl muster; + feldnamendatei := nr; + felderzahl der ersten datei := felderzahl (daten (nr). eudat); + anz felder := felderzahl der ersten datei; + satznummer offset := 0; + markierungen := (length (daten (nr). marksaetze) - 1) DIV 2; + erste koppeldatei := 0; + daten (nr). naechste datei := 0; + suchbedingung loeschen; + auf satz (daten (nr). alte koppelposition) . + +END PROC auf koppeldatei; + + +(************************** Dateiabfragen ********************************) + +INT PROC anzahl koppeldateien : + + anz koppeldateien + +END PROC anzahl koppeldateien; + +INT PROC anzahl dateien : + + anz dateien + +END PROC anzahl dateien; + +BOOL PROC aendern erlaubt : + + aenderungserlaubnis + +END PROC aendern erlaubt; + +BOOL PROC inhalt veraendert (INT CONST dateinr) : + + aenderungen eintragen; + daten (dateinr). datei veraendert + +END PROC inhalt veraendert; + +TEXT PROC eudas dateiname (INT CONST dateinr) : + + daten (dateinr). name + +END PROC eudas dateiname; + +INT PROC folgedatei (INT CONST dateinr) : + + IF dateinr = 0 THEN + erste koppeldatei + ELSE + daten (dateinr). naechste datei + END IF + +END PROC folgedatei; + +TASK PROC herkunft (INT CONST dateinr) : + + daten (dateinr). ursprung + +END PROC herkunft; + + +(*************************** Dateiversion ********************************) + +(* Die Dateiversion wird bei jedem neuen 'oeffne' hochgezaehlt. Sie *) +(* dient dazu, ein neues 'oeffne' festzustellen, um eventuell als *) +(* Optimierung gespeicherte Daten als ungueltig zu kennzeichnen. *) + +INT PROC dateiversion : + + laufzaehler + +END PROC dateiversion; + + +(******************************* Felder **********************************) + +INT PROC anzahl felder : + + anz felder + +END PROC anzahl felder; + +PROC feldnamen lesen (INT CONST feldnr, TEXT VAR name) : + + IF feldnr <= felderzahl der ersten datei THEN + feld lesen (daten (feldnamendatei). feldnamen, feldnr, name) + ELSE + feld lesen (dateiverweis, feldverweis, name) + END IF . + +dateiverweis : + daten (verweis (feldnr). datei). feldnamen . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldnamen lesen; + +PROC feldnamen bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + IF feldnr <= felderzahl der ersten datei THEN + feld bearbeiten (daten (feldnamendatei). feldnamen, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + feld bearbeiten (dateiverweis, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + END IF . + +dateiverweis : + daten (verweis (feldnr). datei). feldnamen . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldnamen bearbeiten; + +INT PROC feldnummer (TEXT CONST feldname) : + + INT VAR + offset := felderzahl der ersten datei, + nr := feldindex (daten (feldnamendatei). feldnamen, feldname), + dateiindex := erste koppeldatei; + WHILE nr = 0 AND dateiindex <> 0 REP + nr := feldindex (daten (dateiindex). feldnamen, feldname); + offset oder nr erhoehen; + dateiindex := daten (dateiindex). naechste datei + END REP; + nr . + +offset oder nr erhoehen : + INT CONST zahl der koppelfelder := daten (dateiindex). anz koppelfelder; + IF nr = 0 THEN + offset INCR felderzahl (daten (dateiindex). eudat); + offset DECR zahl der koppelfelder + ELSE + nr INCR offset; + nr DECR zahl der koppelfelder + END IF . + +END PROC feldnummer; + +INT PROC feldinfo (INT CONST feldnr) : + + IF feldnr <= felderzahl der ersten datei THEN + feldinfo (daten (feldnamendatei). eudat, feldnr) + ELSE + feldinfo (daten (dateiverweis). eudat, feldverweis) + END IF . + +dateiverweis : + verweis (feldnr). datei . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldinfo; + +PROC notizen lesen (INT CONST nr, TEXT VAR inhalt) : + + notizen lesen (daten (feldnamendatei). eudat, nr, inhalt) + +END PROC notizen lesen; + +PROC notizen aendern (INT CONST nr, TEXT CONST inhalt) : + + notizen aendern (daten (feldnamendatei). eudat, nr, inhalt); + daten (feldnamendatei). datei veraendert := TRUE + +END PROC notizen aendern; + + +(*************************** Feldzugriffe ********************************) + +PROC feld lesen (INT CONST feldnr, TEXT VAR inhalt) : + + IF feldnr <= felderzahl der ersten datei THEN + feld lesen (daten (hauptdatei). eudat, feldnr, inhalt) + ELSE + in koppeldatei lesen + END IF . + +in koppeldatei lesen : + INT CONST dateiverweis := verweis (feldnr). datei; + IF daten (dateiverweis). gepuffert THEN + feld lesen (daten (dateiverweis). satzpuffer, feldverweis, inhalt) + ELSE + feld lesen (daten (dateiverweis). eudat, feldverweis, inhalt) + END IF . + +feldverweis : + verweis (feldnr). feld . + +END PROC feld lesen; + +PROC feld bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + IF feldnr <= felderzahl der ersten datei THEN + feld bearbeiten (daten (hauptdatei). eudat, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + in koppeldatei bearbeiten + END IF . + +in koppeldatei bearbeiten : + INT CONST dateiverweis := verweis (feldnr). datei; + IF daten (dateiverweis). gepuffert THEN + feld bearbeiten (daten (dateiverweis). satzpuffer, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + feld bearbeiten (daten (dateiverweis). eudat, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + END IF . + +feldverweis : + verweis (feldnr). feld . + +END PROC feld bearbeiten; + +PROC feld aendern (INT CONST feldnr, TEXT CONST inhalt) : + + INT CONST dateiverweis := verweis (feldnr). datei; + IF feldnr <= felderzahl der ersten datei THEN + in hauptdatei aendern + ELSE + in koppeldatei aendern + END IF . + +in hauptdatei aendern : + daten (hauptdatei). datei veraendert := TRUE; + IF ist koppelfeld CAND wirklich veraenderung THEN + weitere dateien aktualisieren + END IF; + feld aendern (daten (hauptdatei). eudat, feldnr, inhalt) . + +ist koppelfeld : + NOT umgeschaltet CAND dateiverweis > 0 . + +wirklich veraenderung : + feld lesen (daten (hauptdatei). eudat, feldnr, feldpuffer); + feldpuffer <> inhalt . + +weitere dateien aktualisieren : + INT VAR + koppelzaehler := feldverweis, + koppelverweis := dateiverweis; + REP + satzpuffer aktualisieren (daten (koppeldatei)); + daten (koppeldatei). koppelfeld veraendert := TRUE; + feld aendern (daten (koppeldatei). satzpuffer, koppelfeld, inhalt); + koppelverweis INCR 1; + koppelzaehler DECR 1 + UNTIL koppelzaehler = 0 END REP . + +in koppeldatei aendern : + satzpuffer aktualisieren (daten (dateiverweis)); + IF koppeldatei wirklich veraendert THEN + daten (dateiverweis). veraendert := TRUE; + feld aendern (daten (dateiverweis). satzpuffer, feldverweis, inhalt) + END IF . + +koppeldatei wirklich veraendert : + feld lesen (daten (dateiverweis). satzpuffer, feldverweis, feldpuffer); + feldpuffer <> inhalt . + +feldverweis : + verweis (feldnr). feld . + +koppeldatei : + koppeln (koppelverweis). datei . + +koppelfeld : + koppeln (koppelverweis). feld . + +END PROC feld aendern; + +PROC satzpuffer aktualisieren (DATEI VAR datei) : + + IF NOT datei. gepuffert THEN + datei. gepuffert := TRUE; + satzpuffer lesen + END IF . + +satzpuffer lesen : + IF dateiende (datei. eudat) THEN + satz initialisieren (datei. satzpuffer, datei. anz koppelfelder); + koppelfelder in satzpuffer schreiben + ELSE + satz lesen (datei. eudat, datei. satzpuffer) + END IF . + +koppelfelder in satzpuffer schreiben : + INT VAR i; + FOR i FROM 1 UPTO datei. anz koppelfelder REP + feld lesen (datei. koppelfelder ISUB i, feldpuffer); + feld aendern (datei. satzpuffer, i, feldpuffer) + END REP . + +END PROC satzpuffer aktualisieren; + +PROC koppeldatei aktualisieren (DATEI VAR datei) : + + muster lesen; + koppeldatei positionieren . + +muster lesen : + feld lesen (daten (hauptdatei). eudat, musterfeld, muster) . + +musterfeld : + datei. koppelfelder ISUB 1 . + +muster : + datei. muster . + +koppeldatei positionieren : + auf satz (datei. eudat, muster); + WHILE NOT koppelfelder gleich (datei) REP + weiter (datei. eudat, muster) + END REP; + IF dateiende (datei. eudat) THEN + satzpuffer aktualisieren (datei) + ELSE + datei. gepuffert := FALSE + END IF . + +END PROC koppeldatei aktualisieren; + +PROC koppeldateien aktualisieren : + + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + koppeldatei aktualisieren (daten (dateiindex)); + dateiindex := daten (dateiindex). naechste datei + END REP; + kombination := 1 + +END PROC koppeldateien aktualisieren; + +BOOL PROC koppelfelder gleich (DATEI CONST datei) : + + IF NOT dateiende (datei. eudat) THEN + koppelfelder vergleichen + END IF; + TRUE . + +koppelfelder vergleichen : + INT VAR koppelindex; + FOR koppelindex FROM 2 UPTO datei. anz koppelfelder REP + feld lesen (daten (hauptdatei). eudat, koppelfelder ISUB koppelindex, + feldpuffer); + feld bearbeiten (datei. eudat, koppelindex, + PROC (TEXT CONST, INT CONST, INT CONST) feld vergleichen); + IF NOT vergleich erfolgreich THEN + LEAVE koppelfelder gleich WITH FALSE + END IF + END REP . + +koppelfelder : + datei. koppelfelder . + +END PROC koppelfelder gleich; + +BOOL VAR vergleich erfolgreich; + +PROC feld vergleichen (TEXT CONST satz, INT CONST anfang, ende) : + + vergleich erfolgreich := length (feldpuffer) + anfang = ende + 1 CAND + pos (satz, feldpuffer, anfang, ende + 1) = anfang + +END PROC feld vergleichen; + + +(**************************** Anhalten ***********************************) + +LET + halt error = 22101, + halt zeichen = "h", + esc = ""27""; + +BOOL VAR esc zustand; + + +PROC halt abfrage starten : + + TEXT VAR z; + esc zustand := FALSE; + REP + z := incharety; type (z) + UNTIL z = niltext END REP + +END PROC halt abfrage starten; + +PROC halt abfrage beenden : + + IF esc zustand THEN + type (esc) + END IF + +END PROC halt abfrage beenden; + +BOOL PROC angehalten : + + TEXT VAR z; + REP + z := incharety; + IF z = niltext THEN + LEAVE angehalten WITH FALSE + ELSE + zeichen behandeln + END IF + END REP; + FALSE . + +zeichen behandeln : + IF esc zustand THEN + esc zustand := FALSE; + auf halt zeichen testen + ELSE + auf esc testen + END IF . + +auf halt zeichen testen : + IF z = halt zeichen THEN + tastenpuffer loeschen; + errorstop (halt error, niltext); + LEAVE angehalten WITH TRUE + ELSE + type (esc); type (z) + END IF . + +auf esc testen : + IF z = esc THEN + esc zustand := TRUE + ELSE + type (z) + END IF . + +tastenpuffer loeschen : + REP UNTIL getcharety = niltext END REP . + +END PROC angehalten; + + +(************************** Positionieren ********************************) + +PROC weiter (INT CONST modus) : + + IF NOT ende der datei THEN + aenderungen eintragen; + nach modus weiter gehen + END IF . + +nach modus weitergehen : + SELECT modus OF + CASE 1 : einen satz weiter + CASE 2 : weiter bis ausgewaehlt + CASE 3 : weiter bis markiert + END SELECT . + +einen satz weiter : + weiter gehen (FALSE) . + +weiter bis ausgewaehlt : + halt abfrage starten; + REP + weiter gehen (globales muster vorhanden); + cout (satznummer) + UNTIL satz ausgewaehlt OR ende der datei OR angehalten END REP; + halt abfrage beenden . + +weiter bis markiert : + INT VAR satzpos := satznr (daten (hauptdatei). eudat); + WHILE kein markierter satz mehr AND naechste datei <> 0 REP + eine datei weiter; + satzpos := 1 + END REP; + auf satz (daten (hauptdatei). eudat, naechster markierter satz); + cout (satznummer); + koppeldateien aktualisieren; + ende der datei := dateiende (daten (hauptdatei). eudat); + suchbedingung auswerten . + +kein markierter satz mehr : + mark stelle (daten (hauptdatei), satzpos + 1); + INT CONST naechster markierter satz := + daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger; + naechster markierter satz = maxint . + +naechste datei : + daten (hauptdatei). naechste datei . + +END PROC weiter; + +PROC zurueck (INT CONST modus) : + + IF satznummer > 1 THEN + aenderungen eintragen; + nach modus zurueckgehen + END IF . + +nach modus zurueckgehen : + SELECT modus OF + CASE 1 : einen satz zurueck + CASE 2 : zurueck bis ausgewaehlt + CASE 3 : zurueck bis markiert + END SELECT . + +einen satz zurueck : + zurueck gehen (FALSE) . + +zurueck bis ausgewaehlt : + halt abfrage starten; + REP + zurueck gehen (globales muster vorhanden); + cout (satznummer) + UNTIL satz ausgewaehlt OR satznummer = 1 OR angehalten END REP; + halt abfrage beenden . + +zurueck bis markiert : + INT VAR satzpos := satznr (daten (hauptdatei). eudat); + WHILE kein markierter satz mehr AND hauptdatei <> 1 REP + eine datei zurueck; + satzpos := maxint - 1 + END REP; + auf satz (daten (hauptdatei). eudat, neuer satz); + cout (satznummer); + koppeldateien aktualisieren; + ende der datei := FALSE; + suchbedingung auswerten . + +kein markierter satz mehr : + INT VAR neuer satz; + mark stelle (daten (hauptdatei), satzpos); + IF daten (hauptdatei). markzeiger = 1 THEN + neuer satz := 1; + TRUE + ELSE + neuer satz := daten (hauptdatei). marksaetze ISUB + (daten (hauptdatei). markzeiger - 1); + FALSE + END IF . + +END PROC zurueck; + +PROC weiter gehen (BOOL CONST muster vorgegeben) : + + neue kombination suchen; + IF keine kombination mehr THEN + einen satz weiter; + koppeldateien aktualisieren + ELSE + kombination INCR 1 + END IF; + suchbedingung auswerten . + +neue kombination suchen : + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex > 0 REP + in koppeldatei weitergehen; + dateiindex := daten (dateiindex). naechste datei + END REP . + +in koppeldatei weitergehen : + BOOL VAR match gefunden; + kombination suchen (daten (dateiindex), match gefunden); + IF match gefunden THEN + LEAVE neue kombination suchen + END IF . + +keine kombination mehr : + dateiindex = 0 . + +einen satz weiter : + IF muster vorgegeben THEN + weiter (daten (hauptdatei). eudat, globales muster) + ELSE + weiter (daten (hauptdatei). eudat) + END IF; + WHILE dateiende (daten (hauptdatei). eudat) REP + auf naechste datei + UNTIL ende der datei END REP . + +auf naechste datei : + IF daten (hauptdatei). naechste datei <> 0 THEN + eine datei weiter; + auf ersten satz der naechsten datei + ELSE + ende der datei := TRUE + END IF . + +auf ersten satz der naechsten datei : + auf satz (daten (hauptdatei). eudat, 1) . + +END PROC weiter gehen; + +PROC kombination suchen (DATEI VAR datei, BOOL VAR match gefunden) : + + IF dateiende (datei. eudat) THEN + match gefunden := FALSE + ELSE + in datei weitergehen + END IF . + +in datei weitergehen : + match gefunden := TRUE; + REP + weiter (datei. eudat, datei. muster); + IF dateiende (datei. eudat) THEN + match gefunden := FALSE; + auf satz (datei. eudat, datei. muster) + END IF + UNTIL koppelfelder gleich (datei) END REP . + +END PROC kombination suchen; + +PROC zurueck gehen (BOOL CONST muster vorgegeben) : + + WHILE satznr (daten (hauptdatei). eudat) = 1 CAND satznummer > 1 REP + eine datei zurueck; + auf dateiende (daten (hauptdatei). eudat) + END REP; + IF muster vorgegeben THEN + zurueck (daten (hauptdatei). eudat, globales muster) + ELSE + zurueck (daten (hauptdatei). eudat) + END IF; + ende der datei := FALSE; + koppeldateien aktualisieren; + suchbedingung auswerten + +END PROC zurueck gehen; + +PROC eine datei weiter : + + satznummer offset INCR saetze (daten (hauptdatei). eudat); + hauptdatei := daten (hauptdatei). naechste datei + +END PROC eine datei weiter; + +PROC eine datei zurueck : + + INT VAR neuer index := 1; + WHILE daten (neuer index). naechste datei <> hauptdatei REP + neuer index := daten (neuer index). naechste datei + END REP; + satznummer offset DECR saetze (daten (neuer index). eudat); + hauptdatei := neuer index + +END PROC eine datei zurueck; + +PROC aenderungen eintragen : + + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + koppeldatei betrachten; + dateiindex := daten (dateiindex). naechste datei + END REP . + +koppeldatei betrachten : + IF daten (dateiindex). gepuffert THEN + datei aktualisieren (daten (dateiindex)) + END IF . + +END PROC aenderungen eintragen; + +PROC datei aktualisieren (DATEI VAR datei) : + + IF alter satz geaendert AND NOT koppelfelder veraendert THEN + satz in koppeldatei aendern + ELIF nicht nur koppelfelder belegt AND irgendwas veraendert THEN + neuen satz in koppeldatei einfuegen + ELIF koppelfelder veraendert THEN + koppeldatei aktualisieren (datei) + END IF; + puffer deaktivieren; + veraendert := FALSE; + koppelfelder veraendert := FALSE . + +alter satz geaendert : + NOT dateiende (datei. eudat) AND veraendert . + +nicht nur koppelfelder belegt : + felderzahl (satzpuffer) > datei. anz koppelfelder . + +irgendwas veraendert : + koppelfelder veraendert OR veraendert . + +neuen satz in koppeldatei einfuegen : + datei veraendert := TRUE; + feld lesen (satzpuffer, 1, datei. muster); + satz einfuegen (datei. eudat, satzpuffer) . + +puffer deaktivieren : + datei. gepuffert := FALSE . + +satz in koppeldatei aendern : + datei veraendert := TRUE; + satz aendern (datei. eudat, satzpuffer) . + +veraendert : + datei. veraendert . + +koppelfelder veraendert : + datei. koppelfeld veraendert . + +satzpuffer : + datei. satzpuffer . + +datei veraendert : + datei. datei veraendert . + +END PROC datei aktualisieren; + +PROC auf dateiende (EUDAT VAR eudat) : + + auf satz (eudat, saetze (eudat) + 1) + +END PROC auf dateiende; + +PROC auf satz (INT CONST satznr) : + + aenderungen eintragen; + hauptdatei := feldnamendatei; + satznummer offset := 0; + WHILE ueber datei hinaus AND noch weitere datei REP + eine datei weiter + END REP; + auf satz (daten (hauptdatei). eudat, satznr - satznummer offset); + koppeldateien aktualisieren; + ende der datei := dateiende (daten (hauptdatei). eudat); + suchbedingung auswerten . + +ueber datei hinaus : + satznr - satznummer offset > saetze (daten (hauptdatei). eudat) . + +noch weitere datei : + daten (hauptdatei). naechste datei <> 0 . + +END PROC auf satz; + +PROC auf satz (TEXT CONST schluesseltext) : + + aenderungen eintragen; + auf satz intern (schluesseltext, ende der datei); + koppeldateien aktualisieren; + suchbedingung auswerten + +END PROC auf satz; + +PROC auf satz intern (TEXT CONST schluesseltext, BOOL CONST am ende) : + + IF am ende THEN auf satz (1) END IF; + REP + auf satz (daten (hauptdatei). eudat, schluesseltext); + IF NOT dateiende (daten (hauptdatei). eudat) THEN + ende der datei := FALSE; + LEAVE auf satz intern + ELIF daten (hauptdatei). naechste datei = 0 THEN + ende der datei := TRUE; + IF NOT am ende THEN auf satz intern (schluesseltext, TRUE) END IF; + LEAVE auf satz intern + END IF; + eine datei weiter + END REP + +END PROC auf satz intern; + +INT PROC satznummer : + + satznummer offset + satznr (daten (hauptdatei). eudat) + +END PROC satznummer; + +INT PROC satzkombination : + + kombination + +END PROC satzkombination; + +BOOL PROC dateiende : + + ende der datei + +END PROC dateiende; + + +(*************************** Satzverwaltung ******************************) + +SATZ VAR leersatz; +satz initialisieren (leersatz); + +PROC satz einfuegen : + + aenderungen eintragen; + mark satz einfuegen; + satz einfuegen (daten (hauptdatei). eudat, leersatz); + daten (hauptdatei). datei veraendert := TRUE; + alle koppeldateien ans ende; + ende der datei := FALSE; + suchbedingung auswerten . + +mark satz einfuegen : + mark stelle (daten (hauptdatei), satznr (daten (hauptdatei). eudat)); + inkrement (daten (hauptdatei). marksaetze, + daten (hauptdatei). markzeiger, 1) . + +alle koppeldateien ans ende : + kombination := 1; + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + auf dateiende (daten (dateiindex). eudat); + dateiindex := daten (dateiindex). naechste datei + END REP . + +END PROC satz einfuegen; + +PROC satz loeschen : + + IF NOT ende der datei THEN + aenderungen eintragen; + mark satz loeschen; + satz loeschen (daten (hauptdatei). eudat); + daten (hauptdatei). datei veraendert := TRUE; + auf satz (satznummer) + END IF . + +mark satz loeschen : + IF satz markiert THEN + delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger); + markierungen DECR 1 + END IF; + inkrement (daten (hauptdatei). marksaetze, + daten (hauptdatei). markzeiger, -1) . + +END PROC satz loeschen; + + +(*************************** Suchmuster **********************************) + +LET + maxmuster = 100; + +ROW maxmuster STRUCT (INT feld, relator, true exit, false exit, + TEXT muster) + VAR bedingung; + +SATZ VAR muster gespeichert; + +INT VAR + anzahl muster, + erster musterindex, + versionszaehler := 1; + +BOOL VAR + bereits ausgewertet, + erfuellt; + +suchbedingung loeschen; + +INT VAR + muster index; + +LET + gleich test = 1, + beginn test = 2, + endet test = 3, + enthalten test = 4, + kleiner test = 5, + groesser test = 6, + nicht leer test = 7, + markiert test = 8, + true test = 9; + + +PROC suchbedingung auswerten : + + IF ende der datei THEN + erfuellt := FALSE + ELSE + kette verfolgen; + erfuellt := in true exit + END IF . + +kette verfolgen : + musterindex := erster musterindex; + WHILE muster index > 0 REP + gegenfeld bearbeiten; + feld bearbeiten (suchfeld, + PROC (TEXT CONST, INT CONST, INT CONST) bedingung ueberpruefen) + END REP . + +gegenfeld bearbeiten : + INT VAR verwendeter relator := bedingung (musterindex). relator; + IF verwendeter relator >= 256 THEN + gegenfeld lesen; + bei datum umdrehen + END IF . + +gegenfeld lesen : + feld lesen ((verwendeter relator AND 255) + 1, feldpuffer) . + +bei datum umdrehen : + IF jeweiliges feldinfo = 2 THEN + feldpuffer drehen + END IF; + bedingung (musterindex). muster := feldpuffer . + +suchfeld : + bedingung (musterindex). feld . + +in true exit : + musterindex < 0 . + +END PROC suchbedingung auswerten; + +PROC bedingung ueberpruefen (TEXT CONST satz, INT CONST von, bis) : + + INT VAR verwendeter relator := bedingung (musterindex). relator; + IF verwendeter relator >= 256 THEN + verwendeter relator := verwendeter relator DIV 256 + END IF; + IF bedingung trifft zu THEN + musterindex := bedingung (musterindex). true exit + ELSE + musterindex := bedingung (musterindex). false exit + END IF . + +bedingung trifft zu : + SELECT verwendeter relator OF + CASE gleich test : ist gleich + CASE beginn test : beginnt mit + CASE endet test : endet mit + CASE enthalten test : ist enthalten + CASE kleiner test : ist kleiner + CASE groesser test : ist groesser + CASE nicht leer test : ist nicht leer + CASE markiert test : ist markiert + CASE true test : ist true + OTHERWISE FALSE + END SELECT . + +ist gleich : + SELECT jeweiliges feldinfo OF + CASE 0 : feldpuffer als subtext; feldpuffer LEXEQUAL muster + CASE 1 : feldpuffer als subtext; feldwert = musterwert + OTHERWISE length (muster) = bis - von + 1 AND text gleich + END SELECT . + +text gleich : + von > bis COR beginnt mit . + +beginnt mit : + pos (satz, muster, von, bis) = von . + +endet mit : + pos (satz, muster, bis + 1 - length (muster), bis) > 0 . + +ist enthalten : + pos (satz, muster, von, bis) > 0 . + +ist kleiner : + feldpuffer als subtext; + SELECT jeweiliges feldinfo OF + CASE 0 : muster LEXGREATER feldpuffer + CASE 1 : feldwert < musterwert + CASE 2 : feldpuffer drehen; feldpuffer < muster + OTHERWISE feldpuffer < muster + END SELECT . + +ist groesser : + feldpuffer als subtext; + SELECT jeweiliges feldinfo OF + CASE 0 : feldpuffer LEXGREATEREQUAL muster + CASE 1 : feldwert >= musterwert + CASE 2 : feldpuffer drehen; feldpuffer >= muster + OTHERWISE feldpuffer >= muster + END SELECT . + +ist nicht leer : + von <= bis . + +ist markiert : + satz markiert . + +ist true : + TRUE . + +feldpuffer als subtext : + feldpuffer := subtext (satz, von, bis) . + +END PROC bedingung ueberpruefen; + +TEXT PROC muster : + + bedingung (musterindex). muster + +END PROC muster; + +PROC feldpuffer drehen : + + IF length (feldpuffer) = 8 THEN + TEXT CONST jahr := subtext (feldpuffer, 7, 8); + replace (feldpuffer, 7, subtext (feldpuffer, 1, 2)); + replace (feldpuffer, 1, jahr) + ELSE + feldpuffer := niltext + END IF + +END PROC feldpuffer drehen; + +INT PROC jeweiliges feldinfo : + feldinfo (bedingung (musterindex). feld) +END PROC jeweiliges feldinfo; + +REAL PROC feldwert : + + REAL VAR r; + wert berechnen (feldpuffer, r); + r + +END PROC feldwert; + +REAL PROC musterwert : + + REAL VAR r; + wert berechnen (muster, r); + r + +END PROC musterwert; + + +LET + grosses oder = ";", + kleines oder = ",", + intervall symbol = "..", + markierungssymbol = "++", + negation = "--", + stern = "*"; + +BOOL VAR + neue alternative, + neue disjunktion, + verneinung; + +INT VAR + erstes feldmuster, + oder index, + naechster oder anfang, + anfang der disjunktion, + bearbeitetes feld; + +INTVEC VAR oder anfang; + + +PROC suchbedingung (INT CONST feldnr, TEXT CONST bedingung) : + + INT VAR + anfang := 1, + semi pos := 0; + INT CONST + bedingung ende := length (bedingung) + 1; + oder index := 0; + bearbeitetes feld := feldnr; + erstes feldmuster := anzahl muster + 1; + WHILE anfang < bedingung ende REP + feldende feststellen; + bedingung eintragen; + anfang := ende + 2 + END REP; + feld aendern (muster gespeichert, feldnr, bedingung) . + +feldende feststellen : + INT VAR + oder pos := pos (bedingung, kleines oder, anfang); + IF oder pos = 0 THEN oder pos := bedingung ende END IF; + IF semi pos < anfang THEN + neue alternative beginnen + END IF; + INT CONST ende := min (oder pos, semi pos) - 1 . + +neue alternative beginnen : + oder index INCR 1; + neue alternative := TRUE; + IF oder index > 1 THEN globales muster vorhanden := FALSE END IF; + semi pos := pos (bedingung, grosses oder, anfang); + IF semi pos = 0 THEN semi pos := bedingung ende END IF . + +bedingung eintragen : + verneinung testen; + neue disjunktion := TRUE; + INT CONST + intervall pos := pos (bedingung, intervall symbol, anfang, ende + 1); + IF leere bedingung THEN + eintragen (niltext, true test, - oder index) + ELIF intervall pos = 0 THEN + textvergleich + ELSE + groessenvergleich + END IF . + +verneinung testen : + IF subtext (bedingung, anfang, anfang + 1) = negation THEN + anfang INCR 2; verneinung := TRUE + ELSE + verneinung := FALSE + END IF . + +leere bedingung : + anfang > ende . + +text vergleich : + IF test auf markierung THEN + test auf markierung eintragen + ELSE + sterne suchen + END IF . + +test auf markierung : + anfang + 1 = ende CAND + subtext (bedingung, anfang, ende) = markierungssymbol . + +test auf markierung eintragen : + eintragen (niltext, markiert test, - oder index) . + +sterne suchen : + INT VAR stern pos := pos (bedingung, stern, anfang, ende + 1); + IF stern pos = 0 THEN + teste ob feld gleich + ELIF anfang = ende THEN + test auf nichtleeres feld + ELSE + relator bestimmen; + REP + teste auf enthalten sein + END REP + END IF . + +teste ob feld gleich : + IF globales muster moeglich THEN + globales muster vorhanden := TRUE; + globales muster := bedingung + END IF; + eintragen (subtext (bedingung, anfang, ende), gleich test, - oder index) . + +globales muster moeglich : + feldnr = 1 AND anfang = 1 AND ende = bedingung ende - 1 AND + noch keine globalen alternativen AND NOT umgeschaltet AND + (bedingung SUB 1) <> "&" . + +noch keine globalen alternativen : + length (oder anfang) <= 2 . + +test auf nichtleeres feld : + eintragen (niltext, nichtleer test, - oder index) . + +relator bestimmen : + INT VAR relator; + IF stern pos = anfang THEN + relator := gleich test + ELSE + relator := beginn test + END IF . + +teste auf enthalten sein : + IF relator <> gleich test THEN + teilmuster eintragen + END IF; + anfang := stern pos + 1; + stern pos := pos (bedingung, stern, anfang, ende + 1); + IF stern pos = 0 THEN + stern pos := ende + 1; + relator := endet test + ELSE + relator := enthalten test + END IF . + +teilmuster eintragen : + TEXT CONST muster := subtext (bedingung, anfang, stern pos - 1); + IF verneinung OR letztes feld THEN + IF verneinung THEN neue disjunktion := TRUE END IF; + eintragen (muster, relator, - oder index); + IF letztes feld THEN LEAVE sterne suchen END IF + ELSE + eintragen (muster, relator, anzahl muster + 2) + END IF . + +letztes feld : + stern pos >= ende . + +groessenvergleich : + TEXT CONST + muster 1 := subtext (bedingung, anfang, intervall pos - 1), + muster 2 := subtext (bedingung, intervall pos + 2, ende); + IF intervall pos = anfang THEN + eintragen (muster 2, kleiner test, - oder index) + ELIF intervall pos = ende - 1 THEN + eintragen (muster 1, groesser test, - oder index) + ELSE + intervall eintragen + END IF . + +intervall eintragen : + IF verneinung THEN + eintragen (muster 1, groesser test, - oder index); + neue disjunktion := TRUE + ELSE + eintragen (muster 1, groesser test, anzahl muster + 2) + END IF; + eintragen (muster 2, kleiner test, - oder index) . + +END PROC suchbedingung; + +PROC eintragen (TEXT CONST textmuster, INT CONST relator, true exit) : + + musterstatus verwalten; + musterplatz belegen; + IF neue alternative THEN + alte false exits auf neuen anfang setzen; + alte true exits auf diesen platz setzen; + anfang der disjunktion := anzahl muster + ELIF neue disjunktion THEN + false exits der letzten disjunktion anketten + END IF; + vergleichsdaten eintragen; + textmuster eintragen . + +musterstatus verwalten : + bereits ausgewertet := FALSE; + IF anzahl muster = anzahl hauptmuster THEN + versionszaehler INCR 1; + IF versionszaehler > 32000 THEN versionszaehler := 1 END IF + END IF . + +musterplatz belegen : + IF anzahl muster = maxmuster THEN + suchbedingung loeschen; + errorstop (suchmuster zu umfangreich) + ELSE + anzahl muster INCR 1; + erster musterindex := anzahl hauptmuster + 1 + END IF . + +alte false exits auf neuen anfang setzen : + IF oder index > length (oder anfang) DIV 2 THEN + oder anfang CAT anzahl muster; + setze verkettung (erster musterindex, 0, anzahl muster) + END IF; + IF oder index = length (oder anfang) DIV 2 THEN + naechster oder anfang := 0 + ELSE + naechster oder anfang := oder anfang ISUB (oder index + 1) + END IF . + +alte true exits auf diesen platz setzen : + setze verkettung (erster musterindex, - oder index, anzahl muster); + neue alternative := FALSE; + neue disjunktion := FALSE . + +false exits der letzten disjunktion anketten : + setze verkettung (anfang der disjunktion, naechster oder anfang, + anzahl muster); + anfang der disjunktion := anzahl muster; + neue disjunktion := FALSE . + +vergleichsdaten eintragen : + bedingung (anzahl muster). relator := relator; + bedingung (anzahl muster). feld := bearbeitetes feld; + IF verneinung THEN + bedingung (anzahl muster). true exit := naechster oder anfang; + bedingung (anzahl muster). false exit := true exit + ELSE + bedingung (anzahl muster). true exit := true exit; + bedingung (anzahl muster). false exit := naechster oder anfang + END IF . + +textmuster eintragen : + IF textmuster ist gegenfeld THEN + feldnummer des gegenfelds eintragen + ELSE + textmuster original eintragen + END IF . + +textmuster ist gegenfeld : + (textmuster SUB 1) = "&" CAND gueltiges feld . + +gueltiges feld : + INT CONST nr gegenfeld := feldnummer (subtext (textmuster, 2)); + nr gegenfeld > 0 . + +feldnummer des gegenfelds eintragen : + bedingung (anzahl muster). relator := nr gegenfeld - 1 + 256 * relator . + +textmuster original eintragen : + INT CONST info := feldinfo (bearbeitetes feld); + IF info = 2 AND (relator = kleiner test OR relator = groesser test) THEN + feldpuffer := textmuster; + feldpuffer drehen; + bedingung (anzahl muster). muster := feldpuffer + ELSE + bedingung (anzahl muster). muster := textmuster + END IF . + +END PROC eintragen; + +PROC setze verkettung (INT CONST von, wert, durch) : + + INT VAR i; + FOR i FROM von UPTO anzahl muster - 1 REP + IF bedingung (i). true exit = wert THEN + bedingung (i). true exit := durch + ELIF bedingung (i). false exit = wert THEN + bedingung (i). false exit := durch + END IF + END REP + +END PROC setze verkettung; + +PROC suchbedingung lesen (INT CONST feldnr, TEXT VAR bedingung) : + + feld lesen (muster gespeichert, feldnr, bedingung) + +END PROC suchbedingung lesen; + +PROC suchbedingung loeschen : + + disable stop; + IF umgeschaltet THEN + anzahl muster := anzahl hauptmuster + ELSE + anzahl hauptmuster := 0; + anzahl muster := 0 + END IF; + erster musterindex := -1; + oder anfang := empty intvec; + satz initialisieren (muster gespeichert); + globales muster vorhanden := FALSE; + bereits ausgewertet := TRUE; + erfuellt := NOT ende der datei + +END PROC suchbedingung loeschen; + +BOOL PROC satz ausgewaehlt : + + IF NOT bereits ausgewertet THEN + suchbedingung auswerten; + bereits ausgewertet := TRUE + END IF; + erfuellt + +END PROC satz ausgewaehlt; + +INT PROC suchversion : + + IF anzahl muster = anzahl hauptmuster THEN + 0 + ELSE + versionszaehler + END IF + +END PROC suchversion; + + +(*************************** Markierung **********************************) + +PROC mark stelle (DATEI VAR datei, INT CONST satz) : + + IF (datei. marksaetze ISUB datei. markzeiger) < satz THEN + vorwaerts gehen + ELSE + rueckwaerts gehen + END IF . + +vorwaerts gehen : + REP + datei. markzeiger INCR 1 + UNTIL (datei. marksaetze ISUB datei. markzeiger) >= satz END REP . + +rueckwaerts gehen : + WHILE datei. markzeiger > 1 CAND + (datei. marksaetze ISUB (datei. markzeiger - 1)) >= satz REP + datei. markzeiger DECR 1 + END REP . + +END PROC mark stelle; + +PROC markierung aendern : + + disable stop; + IF satz markiert THEN + delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger); + markierungen DECR 1 + ELSE + insert (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger, + satznr (daten (hauptdatei). eudat)); + markierungen INCR 1 + END IF + +END PROC markierung aendern; + +BOOL PROC satz markiert : + + INT CONST satz := satznr (daten (hauptdatei). eudat); + mark stelle (daten (hauptdatei), satz); + satz = + (daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger) + +END PROC satz markiert; + +INT PROC markierte saetze : + + markierungen + +END PROC markierte saetze; + +PROC markierungen loeschen : + + disable stop; + IF umgeschaltet THEN + mark loeschen (daten (hauptdatei)) + ELSE + in allen geketteten dateien loeschen + END IF; + markierungen := 0 . + +in allen geketteten dateien loeschen : + INT VAR dateiindex := 1; + REP + mark loeschen (daten (dateiindex)); + dateiindex := daten (dateiindex). naechste datei + UNTIL dateiindex = 0 END REP . + +END PROC markierungen loeschen; + +PROC mark loeschen (DATEI VAR datei) : + + datei. marksaetze := niltext; + datei. marksaetze CAT maxint; + datei. markzeiger := 1 + +END PROC mark loeschen; + + +END PACKET datenverwaltung; + diff --git a/app/eudas/5.3/src/isub.replace b/app/eudas/5.3/src/isub.replace new file mode 100644 index 0000000..3c48009 --- /dev/null +++ b/app/eudas/5.3/src/isub.replace @@ -0,0 +1,19 @@ +PACKET isub replace DEFINES ISUB, replace : + +INT OP ISUB (TEXT CONST t, INT CONST i) : + + INT CONST ii := i + i; + code (t SUB ii - 1) + 256 * code (t SUB ii) + +END OP ISUB; + +PROC replace (TEXT VAR t, INT CONST i, wert) : + + INT CONST ii := i + i; + replace (t, ii - 1, code (wert MOD 256)); + replace (t, ii, code (wert DIV 256 MOD 256)) + +END PROC replace + +END PACKET isub replace; + diff --git a/app/eudas/5.3/src/menues.1 b/app/eudas/5.3/src/menues.1 new file mode 100644 index 0000000..58b0769 --- /dev/null +++ b/app/eudas/5.3/src/menues.1 @@ -0,0 +1,75 @@ +PACKETeudassatzzugriffeDEFINES SATZ,:=,satzinitialisieren,felderzahl,feldlesen,feldbearbeiten,feldaendern,feldindex:LETb0=256,c0=2;LETd0=" ",e0="";LETf0= +#101#" ist keine Feldnummer"; +TEXT VARg0:=c0*d0;TYPE SATZ=TEXT;OP:=(SATZ VARh0,SATZ CONSTi0):CONCR(h0):=CONCR(i0)END OP:=;PROCsatzinitialisieren(SATZ VARj0):satzinitialisieren(j0,0)END PROCsatzinitialisieren;PROCsatzinitialisieren(SATZ VARj0,INT CONSTk0):replace(g0,1,2*k0+3);INT VARl0;CONCR(j0):=e0;FORl0FROM1UPTOk0+1REP CONCR(j0)CATg0END REP END PROCsatzinitialisieren;INT PROCfelderzahl(SATZ CONSTj0):INT VARm0:=(CONCR(j0)ISUB1)DIV2;INT CONSTn0:=CONCR(j0)ISUBm0;REPm0DECR1UNTILm0<=0CORo0END REP;m0.o0:(CONCR(j0)ISUBm0)<>n0.END PROCfelderzahl;PROCfeldlesen(SATZ CONSTj0,INT CONSTp0,TEXT VARq0):r0(CONCR(j0),p0);IF NOTiserrorTHENq0:=subtext(CONCR(j0),s0,t0)END IF END PROCfeldlesen;PROCfeldbearbeiten(SATZ CONSTj0,INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):r0(CONCR(j0),p0);IF NOTiserrorTHENu0(CONCR(j0),s0,t0)END IF END PROCfeldbearbeiten;INT VARs0,t0;PROCr0(TEXT CONSTj0,INT CONSTp0):IFv0THENerrorstop(text(p0)+f0)ELIFw0THENs0:=j0ISUBp0;t0:=(j0ISUBp0+1)-1ELSEs0:=1;t0:=0END IF.v0:p0<=0ORp0>b0.w0:p0+p0<(j0ISUB1)-1.END +PROCr0;TEXT VARx0;PROCfeldaendern(SATZ VARj0,INT CONSTp0,TEXT CONSTq0):INT VARy0;INT CONSTz0:=((CONCR(j0)ISUB1)-2)DIV2;IFa1THENb1ELSEerrorstop(text(p0)+f0)END IF.a1:p0>0ANDp0<=b0.b1:INT CONSTc1:=p0-z0;IFc1<=0THENd1ELIFq0<>e0THENe1END IF.e1:INT CONSTf1:=CONCR(j0)ISUB(z0+1);x0:=subtext(CONCR(j0),g1,f1-1);CONCR(j0):=subtext(CONCR(j0),1,z0+z0);h1(CONCR(j0),1,z0,i1);j1;k1;CONCR(j0)CATx0;CONCR(j0)CATq0.i1:c1+c1.j1:INT CONSTl1:=f1+i1;FORy0FROMz0+1UPTOp0REPm1(CONCR(j0),l1)END REP.k1:m1(CONCR(j0),l1+length(q0)).g1:CONCR(j0)ISUB1.d1:INT CONSTs0:=CONCR(j0)ISUBp0,n1:=CONCR(j0)ISUB(p0+1);IFs0>length(CONCR(j0))THENo1ELSEp1END IF.o1:h1(CONCR(j0),p0+1,z0+1,length(q0));CONCR(j0)CATq0.p1:x0:=subtext(CONCR(j0),n1);CONCR(j0):=subtext(CONCR(j0),1,s0-1);h1(CONCR(j0),p0+1,z0+1,q1);CONCR(j0)CATq0;CONCR(j0)CATx0.q1:length(q0)-r1.r1:n1-s0.END PROCfeldaendern;PROCm1(TEXT VARj0,INT CONSTs1):replace(g0,1,s1);j0CATg0END PROCm1;PROCh1(TEXT VARj0,INT CONSTt1,u1,v1):INT VARy0;FORy0FROMt1UPTOu1REPreplace(j0,y0,w1+v1) +END REP.w1:j0ISUBy0.END PROCh1;INT PROCfeldindex(SATZ CONSTj0,TEXT CONSTx1):INT VARt1:=(CONCR(j0)ISUB1)-1,y0:=1;REPt1:=pos(CONCR(j0),x1,t1+1);IFt1=0THEN LEAVEfeldindexWITH0END IF;y1UNTILz1CANDa2END REP;y0.y1:WHILE(CONCR(j0)ISUBy0)=32000THENn0:=-32000END IF END PROCq0;PROCfenstergroessesetzen(FENSTER VARr0,FENSTER CONSTs0):q0(r0.c0);m0(r0.b0).i0DECR1;r0.b0:=s0.b0;m0(s0.b0).i0INCR1END PROCfenstergroessesetzen;PROCfenstergroessesetzen(FENSTER VARf,INT CONSTe0,f0,g0,h0):INT VARt0;u0;IFt0>d0THENv0;w0;x0END IF;y0.u0:t0:=1;WHILEt0<=d0REP IFz0THEN LEAVEu0END IF;t0INCR1END REP.z0:a1.e0=e0ANDa1.f0=f0ANDa1.g0=g0ANDa1.h0=h0.a1:m0(t0).l0.v0:t0:=1;WHILEt0<=d0REP IFm0(t0).i0=0THEN LEAVE +v0END IF;t0INCR1END REP;errorstop("zu viele Fenstergroessen");LEAVEfenstergroessesetzen.w0:m0(t0).i0:=0;m0(t0).j0:=0;m0(t0).l0:=GROESSE:(e0,f0,g0,h0);m0(t0).k0:=0.x0:INT VARb1;FORb1FROM1UPTOd0REP IFm0(b1).i0>0THENc1END IF END REP.c1:IFd1(e1,f1)THENsetbit(m0(t0).k0,b1);setbit(m0(b1).k0,t0)ELSEresetbit(m0(b1).k0,t0)END IF.e1:m0(t0).l0.f1:m0(b1).l0.y0:m0(f.b0).i0DECR1;f.b0:=t0;m0(t0).i0INCR1.END PROCfenstergroessesetzen;BOOL PROCd1(GROESSE CONSTa,g1):h1ANDi1.h1:IFa.e0<=g1.e0THENg1.e0f.c0THENm0(f.b0).j0:=f.c0;k1:=TRUE END IF;o0:=o0ORj1;resetbit(o0,f.b0).j1:m0(f.b0).k0.END +PROCfensterzugriff;PROCbildschirmneu:o0:=-1END PROCbildschirmneu;ROW16INT VARl1:=ROW16INT:(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1);PROCsetbit(BITVEKTOR VARm1,INT CONSTt0):m1:=m1ORl1(t0)END PROCsetbit;PROCresetbit(BITVEKTOR VARm1,INT CONSTt0):m1:=m1AND(-1-l1(t0))END PROCresetbit;BOOL PROCbit(BITVEKTOR CONSTm1,INT CONSTt0):(m1ANDl1(t0))<>0END PROCbit;END PACKETfenster; +PACKETeudasmenuesDEFINESglobalmanager,menuemanager,lock,free,menuedateneinlesen,menuenamen,menueloeschen,boxzeichen,waehlbar,fusszeile,fussteil,ausfuehrtaste,menueanbieten,zeilenmenueanbieten,auswahlanbieten,wahl,eschopausfuehren,hilfeanbieten,vielhilfe,statusanzeigen,statuszeile,dialogfenster,dialogfensterloeschen,dialog,neuerdialog,ja,editget,fehlerausgeben:ROW7TEXT VARb0:=ROW7TEXT:("MENUE","BILD","FELD","ENDE","AUSWAHL","HILFE","SEITE");LETc0=1,d0=2,e0=3,f0=4,g0=5,h0=6,i0=7;LETj0=2,integer=3,k0=4,l0=7;LETm0= +#701#"FEHLER in Zeile "; +FILE VARn0;TEXT VARo0,p0;PROCq0:IFeof(n0)THENo0:="%DUMMY"ELSEreadrecord(n0,o0);IFo0=r0THENo0:=s0END IF;cout(lineno(n0));down(n0)END IF END PROCq0;BOOL PROCt0:IF(o0SUB1)=u0THENv0ELSE FALSE END IF.v0:INT VARw0;replace(o0,1,s0);scan(o0);replace(o0,1,u0);nextsymbol(p0,w0);IFw0<>j0THENx0(y0);FALSE ELSE TRUE END IF.END PROCt0;BOOL PROCz0(INT CONSTa1):b0(a1)=p0END PROCz0;INT PROCb1:TEXT VARc1;INT VARw0;nextsymbol(c1,w0);IFw0=integerTHENint(c1)ELSE IFw0<>l0THENx0(d1)END IF;-1END IF END PROCb1;TEXT PROCe1:TEXT VARc1;INT VARw0;nextsymbol(c1,w0);IFw0=k0THENc1ELSE IFw0<>l0THENx0(f1)END IF;r0END IF END PROCe1;PROCx0(TEXT CONSTg1):note(m0);note(lineno(n0)-1);noteline;note(g1);noteline;line;putline(g1)END PROCx0;INT VARh1,i1,j1,k1;PROCl1(INT CONSTm1,n1):cursor(j1+m1-1,k1+n1-1)END PROCl1;TEXT VARo1,p1,q1,r1,s1,t1,u1,v1,w1,x1,y1;TEXT VARz1:=120*" ",a2,b2;boxzeichen("-:..`'::-",""15""14"","X ");PROCboxzeichen(TEXT CONSTc2,d2,e2):x1:=d2;y1:=e2;IF LENGTHc2=9THENv1:=c2SUB1;u1:=c2SUB2;o1:=c2SUB3;p1:=c2SUB4; +q1:=c2SUB5;r1:=c2SUB6;s1:=c2SUB7;t1:=c2SUB8;w1:=c2SUB9END IF;a2:=120*v1;b2:=120*w1END PROCboxzeichen;PROCf2(INT CONSTg2):out(o1);outsubtext(a2,1,g2-2);out(p1)END PROCf2;PROCf2(INT CONSTg2,TEXT CONSTh2):out(o1);outsubtext(a2,1,g2-3-length(h2));out(h2);out(v1);out(p1)END PROCf2;PROCi2(INT CONSTg2):out(s1);outsubtext(b2,1,g2-2);out(t1)END PROCi2;PROCj2(INT CONSTg2):out(q1);outsubtext(a2,1,g2-2);out(r1)END PROCj2;PROCk2(INT CONSTm1,g2):IFm1+g2>=xsizeTHENout(l2)ELSEoutsubtext(z1,1,g2)END IF END PROCk2;LETm2= +#702#"Zeile ist ohne Zusammenhang",n2= +#703#"K Menuedaten im Speicher"; +PROCmenuedateneinlesen(TEXT CONSTo2):p2;n0:=sequentialfile(input,o2);modify(n0);toline(n0,1);WHILE NOTeof(n0)REPq0;IFt0THENq2ELIF NOTanythingnotedTHENx0(m2)END IF END REP;r2;IFanythingnotedTHENnoteedit(n0)END IF.q2:IFz0(c0)THENs2ELIFz0(g0)THENt2ELIFz0(h0)THENu2ELIF NOTanythingnotedTHENx0(m2)END IF.r2:IFonlineTHENline;put(v2);putline(n2)END IF.v2:storage(w2(1))+storage(w2(2))+storage(w2(3)).END PROCmenuedateneinlesen;TYPE MENUE=STRUCT(SATZx2,y2,z2,TEXTa3,b3);BOUND ROW200MENUE VARc3;TEXT VARd3,e3;SATZ VARf3,g3;LETr0="",s0=" ",h3=" ",i3=2,u0="%",j3=""7"",k3=""27"",l2=""5"";LETl3= +#704#"% BILD erwartet",m3= +#705#"Feldnummer beim %FELD-Kommando fehlt",n3= +#706#"% ENDE erwartet",o3= +#707#"Name fehlt",y0= +#708#"Kommandozeile enthaelt kein Kommando",d1= +#709#"Parameter soll eine Zahl sein",f1= +#710#"Parameter soll ein TEXT sein"; +PROCs2:TEXT VARname:=e1;IFname=r0THENx0(o3)ELSE INT VARindex;p3;s2(c3(index))END IF.p3:index:=link(q3(2),name);IFindex=0THENinsert(q3(2),name,index)END IF.END PROCs2;PROCs2(MENUE VARr3):s3;t3;u3;v3;w3.s3:satzinitialisieren(r3.x2);satzinitialisieren(f3);satzinitialisieren(g3);e3:=r0;d3:=r0.t3:x3;INT VARy3:=1;REPq0;IFt0THEN LEAVEt3ELSEz3;y3INCR1END IF END REP.x3:q0;IF NOT(t0CANDz0(d0))THENx0(l3)END IF.z3:IFpos(o0,h3)>0THENd3CATcode(y3+1);IF(o0SUBi3)=h3THENreplace(o0,i3,s0)END IF END IF;feldaendern(r3.x2,y3,o0).u3:WHILEz0(e0)REPa4END REP.a4:INT VARb4:=b1;IFb4=-1THENx0(m3);b4:=100END IF;c4;d4;e4.c4:feldaendern(f3,b4,e1).d4:TEXT CONSTf4:=e1;INT VARg4;FORg4FROM1UPTOlength(f4)REPe3CATcode(b4);e3CAT(f4SUBg4)END REP.e4:TEXT VARh4:=r0;q0;WHILE NOTt0REPh4CATo0;q0END REP;feldaendern(g3,b4,h4).v3:IF NOTz0(f0)THENx0(n3)END IF.w3:r3.y2:=f3;r3.z2:=g3;r3.a3:=e3;r3.b3:=d3.END PROCs2;LETi4= +#711#"Kommando wird ausgeführt ..",j4= +#712#""15"Gib Kommando: ",k4= +#713#"falsche Ausfuehrtaste",l4= +#714#" existiert nicht."; +LETm4=" ",n4=""15"",o4=""14"",p4="?"8"",q4="*"8"";INT VARr4,s4;BOOL VARt4:=FALSE,u4,v4;TEXT VARw4:=r0,x4,y4:=" "1""2""3""8""10""13""27"",z4,a5:=r0;ROW6TEXT VARb5:=ROW6TEXT:("","","","","",""),c5:=b5;FENSTER VARd5,e5;fensterinitialisieren(d5);fensterinitialisieren(e5);PROCwaehlbar(INT CONSTf5,g5,BOOL CONSTh5):IFh5THENi5ELSEj5END IF;u4:=TRUE.i5:IFlength(b5(f5))>=g5THENreplace(b5(f5),g5," ")END IF.j5:WHILElength(b5(f5))1CORl5THENerrorstop(k4)ELSEreplace(y4,1,k5)END IF.l5:k5<>""13""ANDpos(y4,k5,2)>0.END PROCausfuehrtaste;PROCfusszeile(TEXT CONSTm5,TEXT CONSTn5,INT CONSTo5,TEXT CONSTp5,INT CONSTq5):c5(1):=code(1)+m5;c5(4):=r0;c5(2):=code(o5)+n5;c5(5):=r0;c5(3):=code(q5)+p5;c5(6):=r0;fensterveraendert(e5)END PROCfusszeile;PROCfussteil(INT CONSTindex,TEXT CONSTr5,s5):t5;c5(index):=(c5(index)SUB1)+r5;cursor(code(c5(index)SUB1),ysize); +outsubtext(c5(index),2);fussteil(index,s5)END PROCfussteil;PROCfussteil(INT CONSTindex,TEXT CONSTs5):INT VARu5;IFindex=3THENu5:=xsizeELSEu5:=code(c5(index+1)SUB1)END IF;INT CONSTv5:=code(c5(index)SUB1)+length(c5(index))-1;u5DECRv5;c5(index+3):=subtext(s5,1,u5);t5;cursor(v5,ysize);outsubtext(s5,1,u5);outsubtext(z1,1,u5-length(c5(index+3)))END PROCfussteil;PROCt5:BOOL VARw5;fensterzugriff(e5,w5);IFw5CANDc5(1)<>r0THENx5END IF.x5:INT VARy5;cursor(1,ysize);out(l2);FORy5FROM1UPTO3REPcursor(code(c5(y5)SUB1),ysize);outsubtext(c5(y5),2);out(c5(y5+3))END REP.END PROCt5;PROCmenueanbieten(ROW6TEXT CONSTmenuenamen,FENSTER CONSTf,BOOL CONSTz5,PROC(INT CONST,INT CONST)a6):ROW6INT VARb6,c6,d6;INT VARe6,f6:=0,g6:=1,h6:=0,i6;TEXT VARj6;ROW6TEXT VARk6,l6;BOOL VARm6;p2;n6;disablestop;REPo6;p6;q6END REP.n6:r6;s6;t6;u6.r6:fenstergroessesetzen(d5,1,1,xsize-1,1);fenstergroessesetzen(e5,1,ysize,xsize-1,1).s6:m6:=t4;t4:=FALSE;j6:=w4;k6:=b5;l6:=c5.t6:w4:=""6""0""0"";v6;w6;w4CATl2.v6:INT VARx6:=pos(menuenamen(1), +".");IFx6>0THENw4CATsubtext(menuenamen(1),1,x6-1)END IF;w4CAT": ".w6:i6:=0;WHILEi6<6CANDy6REPi6INCR1;z6;d6(i6):=1END REP.y6:menuenamen(i6+1)<>r0.z6:b6(i6):=length(w4);x6:=pos(menuenamen(i6),".");IFx6=0THENw4CATmenuenamen(i6)ELSEw4CATsubtext(menuenamen(i6),x6+1)END IF;w4CAT" ";c6(i6):=length(w4)-1.u6:INT VARy5;FORy5FROM1UPTO6REPb5(y5):=r0;c5(y5):=r0END REP;u4:=TRUE;a6(0,0).o6:IFg6>0THENa7;b7;f6:=g6;g6:=0;c7END IF.a7:IFf6>0THENreplace(w4,b6(f6)," ");replace(w4,c6(f6)," ");IFv4THENa6(f6,-1)END IF END IF.b7:replace(w4,b6(g6),n4);replace(w4,c6(g6),o4);fensterveraendert(d5);d7.c7:e6:=link(q3(2),menuenamen(f6));IFe6=0THENe7(menuenamen(f6));LEAVEmenueanbietenEND IF;v4:=FALSE;fensterveraendert(f).p6:h6:=f6;f7(c3(e6),f,h6,d6(f6),PROC(INT CONST,INT CONST)a6).q6:SELECTh6OF CASE0:g7CASE1:h7CASE2:i7CASE3:j7CASE4:k7OTHERWISEl7END SELECT.i7:IFf61THENg6:=f6-1ELSEg6:=i6END IF.l7:h6:=h6-10;IFh6<=i6THENg6:=h6END IF.h7:IFz5THEN BOOL VARm7:=FALSE;REPn7;o7UNTILp7END + REP;IFm7THENbildschirmneu;dialogfensterloeschen;t5;a6(f6,-2)END IF END IF.o7:IFq7THENm7:=TRUE;statusanzeigen(i4);cursor(1,2);out(r7);do(z4)END IF.q7:pos(z4,"!","�",1)>0.p7:NOTiserror.g7:IFv4THENa6(f6,-1)END IF;fensterveraendert(f);s7;LEAVEmenueanbieten.s7:t4:=m6;w4:=j6;fensterveraendert(d5);b5:=k6;u4:=TRUE;c5:=l6;fensterveraendert(e5).k7:IFd6(f6)>0THENa6(f6,d6(f6))ELSEd6(f6):=-d6(f6)END IF;t5.END PROCmenueanbieten;PROCd7:BOOL VARw5;fensterzugriff(d5,w5);IFw5THENout(w4)END IF END PROCd7;PROCf7(MENUE CONSTr3,FENSTER CONSTf,INT VARt7,wahl,PROC(INT CONST,INT CONST)a6):INT VARu7:=0;v7;w7(f);IFs4=0THENr4:=0END IF;neuerdialog;x7;REPd7;y7;z7END REP.v7:IFwahl>length(r3.b3)THENwahl:=r4;ELIFiserrorTHENfehlerausgeben;a6(t7,-2);END IF.x7:IFu4THENa8(t7,r3);b8;u4:=FALSE END IF.b8:INT VARc8;FORc8FROM1UPTOlength(r3.b3)REP INT CONSTd8:=code(r3.b3SUBc8);IFd8>s4THEN LEAVEb8END IF;e8(r3.x2,d8)END REP.y7:REPf8;IFiserrorTHENg8ELSE LEAVEy7END IF END REP.f8:TEXT VARh8;BOOL VARi8:=FALSE;WHILEs41THENwahlDECR1ELSEwahl:=length(r3.b3)END IF.x8:h6:=3;LEAVEf7.y8:IFwahl0.j9:h6:=code(h8)-38;LEAVEf7.k9:q8:=0;REPq8 +:=pos(r3.a3,h8,q8+1)UNTIL(q8MOD2)=0END REP;q8>0ANDm9.m9:code(r3.a3SUBq8-1)<=length(r3.b3).l9:wahl:=code(r3.a3SUBq8-1);l8(r3,wahl);IF(b5(t7)SUBwahl)<>"-"THENn9(r3,wahl);h6:=4;LEAVEf7END IF.b9:wahl:=1.c9:wahl:=1.d9:wahl:=length(r3.b3).h9:IFo9THENwahl:=code(r3.a3SUBq8-1);h6:=4;LEAVEf7ELSEpush(lernsequenzauftaste(h8))END IF.o9:q8:=0;REPq8:=pos(r3.a3,h8,q8+1)UNTIL(q8MOD2)=0CAND(q8=0CORp9)END REP;q8>0.p9:code(r3.a3SUBq8-1)>length(r3.b3).e9:h6:=1;LEAVEf7.f9:TEXT VARq9;r9(r3,wahl,p4);feldlesen(r3.y2,wahl,q9);hilfeanbieten(q9,s9);IFiserrorTHENfehlerausgebenEND IF;a6(t7,-2);w7(f).g9:h6:=0;LEAVEf7.u8:IF(b5(t7)SUBwahl)<>"-"THENn9(r3,wahl);h6:=4;LEAVEf7END IF.h6:t7.END PROCf7;PROCw7(FENSTER CONSTf):BOOL VARw5;fensterzugriff(f,w5);fenstergroesse(f,j1,k1,i1,h1);IFw5THENs4:=0;l1(1,1)END IF END PROCw7;PROCa8(INT CONSTt7,MENUE CONSTr3):x4:=m4;INT VARy5;FORy5FROM1UPTOlength(b5(t7))REPreplace(x4,code(r3.b3SUBy5),b5(t7)SUBy5)END REP END PROCa8;PROCl8(MENUE CONSTr3,INT CONSTwahl):INT CONSTt9:=code(r3.b3SUB +wahl);IFr4>0ANDr4<>wahlTHEN INT CONSTu9:=code(r3.b3SUBr4);p8(r3.x2,u9,FALSE)END IF;p8(r3.x2,t9,TRUE);r4:=wahl;l1(2,t9)END PROCl8;PROCm8(TEXT VARv9):enablestop;getchar(v9)END PROCm8;PROCn9(MENUE CONSTr3,INT VARwahl):r9(r3,wahl,q4);TEXT VARh4;feldlesen(r3.z2,wahl,h4);IFh4<>r0ANDh4<>s0THENdo(h4);bildschirmneu;wahl:=-wahlEND IF.END PROCn9;PROCr9(MENUE CONSTr3,INT CONSTwahl,TEXT CONSTw9):INT CONSTk1:=code(r3.b3SUBwahl);IFs4>=k1THENp8(r3.x2,k1,FALSE);l1(2,k1);out(w9)END IF.END PROCr9;PROCeschopausfuehren:TEXT VARx9:=""0"",y9;lernsequenzauftastelegen(""0"",r0);push(""27""1""0""0"");editget(x9,1,1,""0"","",y9);out(""8"");x9:=lernsequenzauftaste(""0"");IFx9<>r0THENz9ELSEa10END IF.z9:REPgetchar(y9)UNTILpos(""1""2""8""11""12"",y9)=0END REP;lernsequenzauftastelegen(y9,x9).a10:getchar(y9).END PROCeschopausfuehren;BOOL VARb10;INT VARc10,d10,e10;PROCe8(SATZ CONSTx2,INT CONSTf10):l1(2,f10);IF(x4SUBf10)<>s0THENout(x4SUBf10)ELSEfeldbearbeiten(x2,f10-1,PROC(TEXT CONST,INT CONST,INT CONST)g10)END IF END +PROCe8;PROCg10(TEXT CONSTh10,INT CONSTc10,d10):out(h10SUBc10+d10-d10)END PROCg10;PROCp8(SATZ CONSTx2,INT CONSTy3,BOOL CONSTi10):enablestop;l1(1,y3);IFi10THENb10:=FALSE;out(u1);e8(x2,y3);out(n4);c10:=3;e10:=1;j10(x2,y3-1)ELIFy3=1THENf2(i1)ELIFy3=h1THENj2(i1)ELIFy3=felderzahl(x2)+2THENi2(i1)ELSEk10;IF(x4SUBy3)="-"THENout("-");c10:=2ELSEc10:=1END IF;e10:=0;j10(x2,y3-1)END IF.k10:feldbearbeiten(x2,y3-1,PROC(TEXT CONST,INT CONST,INT CONST)l10).END PROCp8;PROCl10(TEXT CONSTh10,INT CONSTm10,n10):b10:=(h10SUBm10+n10-n10)="-";IF NOTb10THENout(u1)END IF END PROCl10;PROCp8(SATZ CONSTx2,INT CONSTy3):feldbearbeiten(x2,y3-1,PROC(TEXT CONST,INT CONST,INT CONST)l10);c10:=1;e10:=0;j10(x2,y3-1)END PROCp8;PROCj10(SATZ CONSTx2,INT CONSTy3):IFb10THENi2(i1)ELSEo10END IF.o10:feldbearbeiten(x2,y3,PROC(TEXT CONST,INT CONST,INT CONST)p10);q10.q10:outsubtext(z1,1,i1-d10-e10-2);r10;s10.r10:IFe10>0THENout(o4)END IF.s10:out(u1).END PROCj10;PROCp10(TEXT CONSTt10,INT CONSTm10,n10):INT CONSTu10:=m10-1;c10INCRu10;d10:= +min(n10,i1+u10-e10-2);outsubtext(t10,c10,d10);d10DECRu10END PROCp10;PROCn7:LETv10=""27"k";TEXT VARw10;fensterveraendert(d5);x10;y10;REPz10UNTILw10<>v10END REP;IFpos(z4,"!","�",1)>0THENa5:=z4END IF.x10:IFiserrorTHENfehlerausgeben;z4:=a5ELSEz4:=r0END IF.y10:cursor(1,1);out(j4);outsubtext(z1,1,i1-15);out(o4).z10:cursor(16,1);editget(z4,32000,62,"","kh",w10);IFiserrorTHENclearerrorELIFw10=v10THENz4:=a5ELIFw10=a11THENz4:=r0END IF.END PROCn7;PROCe7(TEXT CONSTo2):errorstop(""""+o2+""""+l4)END PROCe7;TYPE AUSWAHL=STRUCT(SATZh2);BOUND ROW200AUSWAHL VARb11;PROCt2:TEXT VARname:=e1;IFname=r0THENx0(o3)ELSE INT VARindex:=link(q3(3),name);IFindex=0THENinsert(q3(3),name,index)END IF;t2(b11(index))END IF END PROCt2;PROCt2(AUSWAHL VARa):s3;c11;d11.s3:satzinitialisieren(a.h2).c11:INT VARy3:=1;REPq0;IFt0THEN LEAVEc11ELSEe11;y3INCR1END IF END REP.e11:feldaendern(a.h2,y3,o0).d11:IF NOTz0(f0)THENx0(n3)END IF.END PROCt2;LETf11=""10"",g11="+"27"q";LETh11= +#715#"Fenster zu klein",i11= +#716#"AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ?"; +INT VARj11,k11,l11,m11,n11,o11;BOOL VARp11;LET INTVEC=TEXT;INTVEC VARq11;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,TEXT CONSTr11,PROC(TEXT VAR,INT CONST)s5):auswahlanbieten(name,f,1024,r11,r0,PROC(TEXT VAR,INT CONST)s5)END PROCauswahlanbieten;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,INT CONSTs11,TEXT CONSTr11,PROC(TEXT VAR,INT CONST)s5):auswahlanbieten(name,f,s11,r11,r0,PROC(TEXT VAR,INT CONST)s5)END PROCauswahlanbieten;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,INT CONSTs11,TEXT CONSTr11,t11,PROC(TEXT VAR,INT CONST)s5):p2;INT CONSTindex:=link(q3(3),name);IFindex=0THENe7(name)ELSEu11;f7(b11(index),f,r11,s11,PROC(TEXT VAR,INT CONST)s5)END IF.u11:INT VARy5;q11:=r0;FORy5FROM1UPTOlength(t11)REPq11CATcode(t11SUBy5)END REP.END PROCauswahlanbieten;PROCf7(AUSWAHL CONSTa,FENSTER CONSTf,TEXT CONSTr11,INT CONSTs11,PROC(TEXT VAR,INT CONST)s5):INT VARs4:=0,u7:=0;enablestop;v11;statusanzeigen(i11);w11;x11;y11;REPy7;z11END REP.v11:BOOL VARdummy;fensterzugriff(f,dummy); +fenstergroesse(f,j1,k1,i1,h1).w11:INT VARa12:=1024;l11:=a12;REPa12:=a12DIV2;s5(o0,l11);IFo0=r0THENl11DECRa12ELSEl11INCRa12END IF UNTILa12=1END REP;s5(o0,l11);IFo0=r0THENl11DECR1END IF.x11:m11:=felderzahl(a.h2)+2;o11:=0;b12;IFm11>=h1THENerrorstop(h11)END IF.y11:INT VARc12:=m11+1,d12,e12:=1;p11:=s11>1.y7:REPf8;IFiserrorTHENclearerror;s4:=0ELSE LEAVEy7END IF END REP.f8:TEXT VARh8;WHILEs4=j11ANDs4<=k11.l8:IFc12<>d12THEN IFd12<=s4THENl12END IF;m12END IF;cursor(1,1).l12:l1(5,d12);j12(d12+o11-m11,FALSE,PROC(TEXT VAR,INT CONST)s5).m12:l1(5,c12);j12(e12,TRUE,PROC( +TEXT VAR,INT CONST)s5);d12:=c12.z11:SELECTu7OF CASE0:r8CASE1:s8CASE2:t8END SELECT.r8:SELECTpos(""1""3""10""13""27" +x-o",h8)OF CASE1:u7:=1CASE2:w8CASE3:y8CASE4:z8CASE5:u7:=2CASE6:n12CASE7,8:o12CASE9,10:p12OTHERWISEa9END SELECT.s8:SELECTpos(""3""10"+x-o",h8)OF CASE1:c9CASE2:d9CASE3,4:q12CASE5,6:r12OTHERWISEout(j3)END SELECT;u7:=0.t8:SELECTpos(""1"19?qh",h8)OF CASE1:eschopausfuehrenCASE2:s12CASE3:t12CASE4:f9CASE5:g9CASE6:errorstop(r0)OTHERWISEh9END SELECT;u7:=0.w8:IFe12>1THENc12DECR1;e12DECR1;IFc12<=m11THENc12INCR1;o11DECR1;b12;s4:=min(s4,m11)END IF END IF.y8:IFe12=h1THENc12DECR1;o11INCR1;b12;s4:=min(s4,m11)END IF END IF.z8:push(f11).n12:push(g11).o12:IFu12(e12)=0ANDe12<=l11THENv12;w12END IF.v12:BOOL CONSTx12:=abs(s11)<=length(q11)DIV2;IFx12THENq11:=subtext(q11,3)END IF;q11CATe12.w12:IFx12THENy12ELIFc12<=s4THENz12(c12,length(q11)DIV2)END IF.p12:INT CONSTa13:=u12(e12);IFa13>0THENb13;y12END IF.b13:change(q11,2*a13-1,2*a13,r0).a9:IFh80THENb12;s4:=min(s4,m11)END IF.d13:e13:=c12-m11-1;c12DECRe13;e12DECRe13.d9:IFc12=h1-1THENf13ELSEg13END IF.f13:e13:=min(h1-m11-1,l11-e12);o11INCRe13;e12INCRe13;IFe13>0THENb12;s4:=min(s4,m11)END IF.g13:e13:=min(l11-e12,h1-c12-1);c12INCRe13;e12INCRe13.q12:IFl11>abs(s11)THENout(j3);LEAVEq12END IF;INT VARh13;FORh13FROM1UPTOl11REP IFu12(h13)=0THENq11CATh13END IF END REP;y12.r12:q11:=r0;y12.f9:hilfeanbieten(r11,f);statusanzeigen(i11);s4:=0.g9:LEAVEf7.h9:push(lernsequenzauftaste(h8)).s12:c12:=m11+1;e12:=1;o11:=0;b12;s4:=min(s4,m11).t12:INT CONSTi13:=m11+l11;IFi13r0THENd15;q0ELSEe15END IF.d15:TEXT VARf15;g15(c15,f15);IFb15+b15<=length(f15)THENz14CAT(f15ISUBb15)ELIF NOT(anythingnotedORn14)THENx0(m14)END IF.e15:INT VARy3:=1;IF NOTn14THENy14INCR1;z14CATy14;satzinitialisieren(e14.d14(y14))END IF;k14:=r0;REPq0;IFt0THEN LEAVEe15ELIF NOTn14THENh15END IF END REP.h15:k14CATo0; +feldaendern(e14.d14(y14),y3,k14);IFi15THENy3INCR1;k14:=r0ELSEk14CATs0END IF.i15:(k14SUB LENGTHk14)=s0.q14:IF NOTz0(f0)THENx0(n3)END IF;IF NOT(anythingnotedORn14)THENfeldaendern(e14.c14(v14),w14,z14);e14.a14:=y14END IF.END PROCu2;PROCg15(TEXT CONSTname,TEXT VARz14):INT CONSTr14:=pos(name,"/");INT VARs14,w14:=0;IFr14=0THENs14:=link(q3(1),name)ELSEs14:=link(q3(1),subtext(name,1,r14-1));j15END IF;IFw14=0THENw14:=1END IF;IFs14=0THENerrorstop(k15)ELSEfeldlesen(e14.c14(s14),w14,z14)END IF.j15:IFs14>0THENw14:=link(e14.b14(s14),subtext(name,r14+1))END IF.END PROCg15;LETk15= +#719#"Hilfe existiert nicht",l15= +#720#"Hilfe ist leer",m15= +#721#" Seite ",n15= +#722#" von ",o15= +#723#"HILFE: Beenden: ESC q Seite weiter: ESC UNTEN Seite zurueck: ESC OBEN"; +TEXT VARp15;INT VARq15,r15,s15;BOOL VARt15:=TRUE;PROCvielhilfe(BOOL CONSTu15):t15:=u15END PROCvielhilfe;BOOL PROCvielhilfe:t15END PROCvielhilfe;PROChilfeanbieten(TEXT CONSTname,FENSTER CONSTf):enablestop;p2;TEXT VARz14;v15;g15(name,z14);IFz14=r0THENerrorstop(l15)ELSEw15END IF.v15:fensterveraendert(f);fenstergroesse(f,f14,g14,h14,i14).w15:INT CONSTx15:=length(z14)DIV2;y15;statusanzeigen(o15);INT VARc14:=1;REPz15;a16END REP.z15:INT CONSTb16:=z14ISUBc14;p15:=m15+text(c14)+n15;p15CATtext(x15);p15CAT" ";IFlength(p15)+2>h14THENp15:=r0END IF;c16(e14.d14(b16)).a16:TEXT VARh8;REPgetchar(h8);IFh8=k3THENgetchar(h8);o7;LEAVEa16ELSEout(j3)END IF END REP.o7:SELECTpos("q"10""3"?"1"",h8)OF CASE1:LEAVEhilfeanbietenCASE2:d16CASE3:e16CASE4:f16CASE5:eschopausfuehrenOTHERWISEout(j3)END SELECT.d16:IFc141THENc14DECR1END IF.f16:c14:=1.END PROChilfeanbieten;PROCc16(SATZ CONSTg16):INT VARy3;r15:=1;s15:=0;g12;q15:=0;FORy3FROM1UPTOi14-2REPcursor(f14,g14+y3);feldbearbeiten(g16,r15, +PROC(TEXT CONST,INT CONST,INT CONST)x5)END REP;h16.g12:cursor(f14,g14);f2(h14,p15).h16:cursor(f14,g14+i14-1);j2(h14);cursor(1,1).END PROCc16;PROCx5(TEXT CONSTx2,INT CONSTm10,n10):d10:=min(s15+m10+h14-3-q15,n10);IFm10<=n10CAND(x2SUBm10)="-"THENi2(h14);r15INCR1;q15:=0ELSEi16;j16;k16END IF.i16:IFd10" "AND(x2SUBd10)<>" ".m16:pos(x2," ",s15+m10,d10)>0.n16:WHILE(x2SUBd10)<>" "REPd10DECR1END REP.j16:out(u1);outsubtext(z1,1,q15);outsubtext(x2,m10+s15,d10);outsubtext(z1,1,h14+m10+s15-q15-d10-3);out(u1).k16:IFd100THENp16END IF END IF.p16:WHILE(x2SUBq15)=" "REPq15INCR1END REP;q15DECRm10.END PROCx5;BOOL VARq16:=TRUE;PROCstatuszeile(BOOL CONSTr16):q16:=r16END PROCstatuszeile;BOOL PROCstatuszeile:q16END PROCstatuszeile;PROCstatusanzeigen(TEXT CONSTstatus):IFq16THENcursor( +1,1);out(" ");out(status);out(l2);fensterveraendert(d5)END IF END PROCstatusanzeigen;LETs16=20;ROWs16INT VARt16;INT VARu16,v16,w16,x16,y16,z16;TEXT VARr5;PROCa17(MENUE CONSTr3,INT CONSTb17,INT VARwahl):enablestop;BOOL VARc17:=FALSE;REP IF NOTc17THENd17END IF;e17;o7END REP.d17:INT VARy5;cursor(b17,w16);u16:=b17;t16(1):=u16;FORy5FROM1UPTOfelderzahl(r3.x2)REPout(" ");u16INCR1;feldbearbeiten(r3.x2,y5,PROC(TEXT CONST,INT CONST,INT CONST)f17);out(" ");u16INCR1;t16(y5+1):=u16;END REP;v16:=u16;c17:=TRUE;g17(r3.x2,wahl).e17:TEXT VARh17;getchar(h17).o7:SELECTpos(""2""8""13" "1""27"",h17)OF CASE1:i17(r3.x2,wahl,wahl+1)CASE2:i17(r3.x2,wahl,wahl-1)CASE3,4:j17(r3.x2,wahl);LEAVEa17CASE5:k17CASE6:l17OTHERWISEm17END SELECT.m17:INT VARn17:=0;REPn17:=pos(r3.a3,h17,n17+1)UNTIL(n17MOD2)=0END REP;IFn17=0THEN IFh17<" "THENpush(""27""+h17)ELSEout(""7"")END IF ELSEi17(r3.x2,wahl,code(r3.a3SUBn17-1));j17(r3.x2,wahl);LEAVEa17END IF.l17:TEXT VARo17;getchar(o17);SELECTpos(""1"qh?"27"",o17)OF CASE1:eschopausfuehren +CASE2:wahl:=0;LEAVEa17CASE3:errorstop("")CASE4:j17(r3.x2,wahl);wahl:=-wahl;LEAVEa17CASE5:wahl:=-32000;LEAVEa17OTHERWISEpush(lernsequenzauftaste(o17))END SELECT.k17:getchar(o17);SELECTpos(""8""2"",o17)OF CASE1:i17(r3.x2,wahl,1)CASE2:i17(r3.x2,wahl,felderzahl(r3.x2))OTHERWISEout(""7"")END SELECT.END PROCa17;PROCp17(SATZ CONSTx2,INT CONSTwahl):IFx16>0THENcursor(1,x16);out(""15"");out(r5);u16:=length(r5)+1;feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)q17);out(" "14"")END IF END PROCp17;PROCg17(SATZ CONSTx2,INT CONSTwahl):p17(x2,wahl);cursor(t16(wahl),w16);out(""15"");feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);out(" "14"");cursor(y16,z16)END PROCg17;PROCi17(SATZ CONSTx2,INT VARwahl,INT CONSTs17):t17;wahl:=s17;IFwahl<1THENwahl:=felderzahl(x2)ELIFwahl>felderzahl(x2)THENwahl:=1END IF;g17(x2,wahl).t17:cursor(t16(wahl),w16);out(" ");feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);out(" ").END PROCi17;PROCj17(SATZ CONSTx2,INT CONSTwahl):cursor( +t16(1),w16);t16(wahl)-t16(1)+1TIMESOUT" ";feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);v16-t16(wahl+1)+2TIMESOUT" "END PROCj17;PROCf17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)-1;IFu17<0THENu17:=n10END IF;outsubtext(h10,m10,u17);u16INCRu17-m10+1END PROCf17;PROCr17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)-1;IFu17<0THENu17:=n10END IF;outsubtext(h10,m10,u17)END PROCr17;PROCq17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)+1;IFu17<2THENu17:=n10+1END IF;xsize-5-u16-n10+u17TIMESOUT" ";outsubtext(h10,u17,n10)END PROCq17;PROCzeilenmenueanbieten(TEXT CONSTv17,BOOL CONSTz5,PROC(INT CONST)z2):BOOL VARm6:=t4;INT VARw17:=link(q3(2),v17);IFw17=0THENe7(v17);LEAVEzeilenmenueanbietenEND IF;w16:=ysize;x16:=ysize-1;getcursor(y16,z16);r5:=v17;disablestop;t4:=TRUE;x17;o7;t4:=m6.x17:INT VARwahl:=1;REPa17(c3(w17),1,wahl);IFwahl>=0THEN LEAVEx17ELIFwahl=-32000THEN IFz5THEN LEAVEx17END IF ELSEwahl:=-wahl;TEXT VARy17;feldlesen(c3(w17).y2, +wahl,y17);hilfeanbieten(y17,s9)END IF UNTILiserrorEND REP.o7:IFwahl>0THENz17(wahl,PROC(INT CONST)z2)ELIFwahl=-32000THENa18END IF.a18:cursor(1,ysize-1);out(""4"");out(j4);out(""14"");TEXT VARdummy:="";editget(dummy);IFdummy<>""THENdo(dummy)END IF.END PROCzeilenmenueanbieten;PROCz17(INT CONSTwahl,PROC(INT CONST)z2):enablestop;z2(wahl)END PROCz17;LETr7=""4"",b18=""27"?",c18=""27"q",a11=""27"h";LETd18= +#726#" ?",e18= +#727#"WAHL: Wählen: <-, -> Bestätigen: RETURN Abbruch: ESC h Hilfe: ESC ?",f18= +#728#"FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ?",g18= +#729#"EINGABE: Bestätigen: RETURN Abbrechen: ESC h Hilfe: ESC ?",h18= +#730#"EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbruch: ESC h Hilfe: ESC ?",i18= +#731#""15"!!! FEHLER !!! "14" Quittieren: ESC q Hilfe zur Meldung: ESC ?"; +FENSTER VARs9;fensterinitialisieren(s9);INT VARj18,k18,l18,m18,n18;PROCdialogfenster(FENSTER CONSTo18):fenstergroesse(o18,k18,l18,m18,n18);fenstergroessesetzen(s9,o18)END PROCdialogfenster;FENSTER PROCdialogfenster:s9END PROCdialogfenster;PROCneuerdialog:j18:=n18END PROCneuerdialog;PROCp18:BOOL VARw5;fensterzugriff(s9,w5);j18INCR3;IFj18+3>n18ORw5THENq18;j18:=1END IF;r18;cursor(k18+1,l18+j18).r18:cursor(k18,l18+j18-1);f2(m18);cursor(k18,l18+j18);s18;cursor(k18,l18+j18+1);s18;cursor(k18,l18+j18+2);j2(m18).END PROCp18;PROCs18:out(u1);outsubtext(z1,1,m18-2);out(u1)END PROCs18;PROCdialog(TEXT CONSTt18):p18;outsubtext(t18,1,m18-2);cursor(k18+1,l18+j18+1)END PROCdialog;PROCdialogfensterloeschen:fensterveraendert(s9);q18END PROCdialogfensterloeschen;PROCq18:BOOL CONSTu18:=k18+m18>=xsize;j18:=0;REPcursor(k18,l18+j18);IFu18THENout(l2)ELSEoutsubtext(z1,1,m18)END IF;j18INCR1UNTILj18>=n18END REP END PROCq18;PROCauswahlanbieten(TEXT CONSTv17,r5,r11,INT VARv18):INT VARw18:=link(q3(2),v17);IFw18=0THEN +e7(v17);LEAVEauswahlanbietenEND IF;REPstatusanzeigen(e18);p18;outsubtext(r5,1,m18-2);x17END REP.x17:INT CONSTx18:=v18;w16:=l18+j18+1;x16:=0;y16:=1;z16:=1;a17(c3(w18),k18+1,v18);IFv18>=0THEN IFv18=0THENv18:=x18END IF;LEAVEauswahlanbietenELIFv18=-32000THENv18:=1ELSEhilfeanbieten(r11,s9);neuerdialog;v18:=-v18END IF.END PROCauswahlanbieten;BOOL PROCja(TEXT CONSTy18,r11):ja(y18,r11,TRUE)END PROCja;BOOL PROCja(TEXT CONSTy18,r11,BOOL CONSTz18):INT VARwahl;IFz18THENwahl:=1ELSEwahl:=2END IF;REPstatusanzeigen(f18);IFt4THENcursor(1,ysize);INT CONSTa19:=min(length(y18),xsize-16);outsubtext(y18,1,a19);out(""5"")ELSEp18;outsubtext(y18,1,m18-4);END IF;out(d18);y15;b19END REP;FALSE.b19:c19;a17(d19,e19,wahl);IFwahl=1THEN LEAVEjaWITH TRUE ELIFwahl=2THEN LEAVEjaWITH FALSE ELIFwahl=-32000THENwahl:=1ELIFwahl=0THENerrorstop("")ELSEhilfeanbieten(r11,s9);neuerdialog;wahl:=-wahlEND IF.c19:INT VARe19;IFt4THENw16:=ysize;x16:=0;e19:=a19+4ELSEw16:=l18+j18+1;x16:=0;y16:=1;z16:=1;e19:=k18+1END IF.d19:c3(link(q3(2), +"WAHL.Ja")).END PROCja;PROCeditget(TEXT CONSTr5,TEXT VARh8,TEXT CONSTf19,r11):TEXT VARw10;g19;IFt4THENcursor(1,ysize);out(""5"");put(r5);ELSEdialog(r5);cursor(k18+1,l18+j18+1)END IF;editget(h8,1000,h19,"","?hq"+f19,w10);cursor(1,1);IFw10=b18THENhilfeanbieten(r11,s9);neuerdialog;editget(r5,h8,f19,r11)ELIFw10=a11ORw10=c18THENerrorstop(r0)ELIFlength(w10)=2THENh8:=w10+h8END IF.g19:IFpos(f19,"z")>0THENstatusanzeigen(h18)ELSEstatusanzeigen(g18)END IF.h19:IFt4THENxsize-length(r5)-2ELSEm18-4END IF.END PROCeditget;PROCfehlerausgeben:TEXT CONSTg1:=errormessage;IFerrorcode=1THENpage;bildschirmneuEND IF;clearerror;y15;IFg1<>r0THENstatusanzeigen(i18);i19;j19;neuerdialogEND IF.i19:p18;out(j3);out(">>> ");cursor(k18+1,l18+j18+1);outsubtext(errormessage,1,m18-2).j19:TEXT VARh8;cursor(1,1);getchar(h8);IFh8=k3THENk19END IF.k19:getchar(h8);IFh8="?"THENhilfeanbieten("FEHLER/"+text(errorcode),s9)ELIFh8=""1""THENeschopausfuehrenEND IF.END PROCfehlerausgeben;PROCy15:WHILEgetcharety<>r0REP END REP END PROCy15 +;LETl19=3,m19=12,n19=14,o19=1070,p19=1068,q19=1069,r19=0,s19=2;ROWl19DATASPACE VARw2;ROWl19THESAURUS VARq3;BOOL VARt19:=FALSE;INITFLAG VARu19;PROCp2:IF NOTinitialized(u19)THENv19END IF.v19:BOOL VARp7:=t19;w19;IFp7THENx19ELSEmenueloeschen(FALSE)END IF.w19:INT VARy19;FORy19FROM1UPTOl19WHILEp7REPz19END REP.z19:INT VARa20,b20;FORb20FROM1UPTO10REPforget(w2(y19));w2(y19):=nilspace;pingpong(father,o19+y19,w2(y19),a20);IFa20=r19THEN LEAVEz19ELIFa20<>s19THENpause(15)END IF UNTILa20=s19END REP;forget(w2(y19));w2(y19):=nilspace;p7:=FALSE.END PROCp2;THESAURUS PROCmenuenamen(INT CONSTy19):p2;IFy19<0THENe14.b14(-y19)ELSEq3(y19)END IF END PROCmenuenamen;PROCmenueloeschen(TEXT CONSTname,INT CONSTy19):p2;IFy19<0THENc20(name,e14.b14(-y19))ELSEc20(name,q3(y19))END IF END PROCmenueloeschen;PROCc20(TEXT CONSTname,THESAURUS VARt10):INT CONSTindex:=link(t10,name);IFindex>0THENdelete(t10,index)END IF END PROCc20;PROCmenueloeschen(BOOL CONSTd20):INT VARy19;u19:=TRUE;j14:=d20;FORy19FROM1UPTOl19REPforget(w2(y19) +);w2(y19):=nilspace;q3(y19):=emptythesaurusEND REP;x19END PROCmenueloeschen;PROCx19:e14:=w2(1);c3:=w2(2);b11:=w2(3)END PROCx19;LETe20= +#732#"Datei wird von anderer Task geaendert.",f20= +#733#"Auftrag nur fuer Soehne erlaubt"; +THESAURUS VARg20:=emptythesaurus;ROW200TASK VARh20;TEXT VARi20;BOUND STRUCT(TEXTname,j20,k20)VARl20;PROCmenuemanager(DATASPACE VARm20,INT CONSTn20,o20,TASK CONSTp20):enablestop;t19:=TRUE;IFn20>=p19ANDn20<=o19+l19THENq20ELSE IFn20=m19ORn20=n19THENr20END IF;freemanager(m20,n20,o20,p20)END IF.q20:IFn20=p19THENs20ELIFn20=q19THENt20ELSEu20END IF.s20:l20:=m20;v20(l20.name,p20);send(p20,r19,m20).t20:l20:=m20;w20(l20.name);send(p20,r19,m20).r20:IFo20=1THENx20ELIFn20=n19THENw20(i20)END IF.x20:l20:=m20;i20:=l20.name;IFy20THENerrorstop(e20)END IF.y20:INT VARx13:=link(g20,i20);x13>0CAND NOT(h20(x13)=p20).u20:IFp20");putline(" Anzahl Dateien erster Index Max DatID 1. Freier Eintrag" +);putline(" "+text(anzdateien)+" "+text(firstindex)+" "+text(maxdatid)+" "+text(firstfree));uuuuyu;uuuuwv:=2; WHILE +uuuuwv");pause;page ELSEsysout(""); IFuuuuvu="printer" THENprint(uuuuvu+".dd");forget(uuuuvu+".dd",quiet); FI FI.uuuuyy:uuuuxz;putline +(" Datei: "+name(uuuuwv)+" (DatID: "+text(datid(uuuuwv))+")");uuuuwy:=compress(text(uuuuuv(uuuuwv),15,0));uuuuwy:=subtext(uuuuwy,1,length(uuuuwy)-1);putline(" Anzahl Schlüsselfelder: " ++text(anzkey(uuuuwv))+" Befugnis: "+text(befugnis(uuuuwv))+" Datensätze: "+uuuuwy);putline(" Feld Typ Länge XN YN XF YF Befug 1234567890123456" +);uuuuwv INCR1;uuuuwx:=1; WHILEuuuuwv23 THENwrite(text(name(uuuuwv),23)+"<") ELSEwrite +(text(name(uuuuwv),23)+" ") FI;write(code(feldtyp(uuuuwv))+" "); IFfeldtyp(uuuuwv)=realfeld THENuuuuwy:=text(einglaenge(uuuuwv))+"."+text(nachkomma(uuuuwv));write +(text("",5-length(uuuuwy)));write(uuuuwy+" ") ELSEwrite(text(einglaenge(uuuuwv),5)+" ") FI;write(text(posxname(uuuuwv),2)+" ");write(text(posyname(uuuuwv),2)+" ") +;write(text(posxfeld(uuuuwv),2)+" ");write(text(posyfeld(uuuuwv),2)+" ");write(text(befugnis(uuuuwv),5)+" ");uuuwuy;line;uuuuwv INCR1; END REP;uuuuyu.uuuwvv:3*" " +.uuuuzw:uuuuyu;line;write("INITIALISIERUNGEN");line;line;uuuuwv:=3; WHILEuuuuwv"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv ++"zu Feld "+text(text(uuuuwv),4)+": "+initialisierung(uuuuwv),76)) FI;uuuuwv INCR1 PER;line.uuuuzx:uuuuyu;line;write("PLAUSIBILITÄTEN");line;line;uuuuwv:=3; WHILE +uuuuwv"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv+"zu Feld "+text(text(uuuuwv),4)+": "+plausi(uuuuwv),76)) FI;uuuuwv INCR1 PER; +line.uuuuzy:uuuuyu;line;write("HILFSTEXTNUMMERN");line;line;uuuuwv:=3; WHILEuuuuwv0 THENputline(uuuwvv+"zu Feld "+text(text(uuuuwv +),4)+": "+text(hilfstextnr(uuuuwv))) FI;uuuuwv INCR1 PER;line.uuuuzz:uuuuyu;line;write("STANDARD-AKTIONEN");line;line;uuuuwv:=3; WHILEuuuuwv1 CANDwas(uuuyuz)<>dateieintrag CANDwas(uuuyuz)<>indexeintrag ENDPROCuuuwwv; ENDPACKETddinfopacket; + diff --git a/app/eumelbase/2.2.1-schulis/src/db ersatz.sc b/app/eumelbase/2.2.1-schulis/src/db ersatz.sc new file mode 100644 index 0000000..bb8121d --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db ersatz.sc @@ -0,0 +1,9 @@ + PACKETdbersatz DEFINESinitsavedupdateposition,getsavedupdateposition,saveupdateposition,restoreupdateposition,changeindex,createdb,destroydb,updatedb,fetchdb,fetchdd +,restoredb,postfix,db,definedserverstation: INT PROCdefinedserverstation:station(myself) ENDPROCdefinedserverstation; PROCfetchdb( TEXT CONSTuuuuuy): ENDPROCfetchdb +; PROCfetchdd( TEXT CONSTuuuuuy): ENDPROCfetchdd; PROCrestoredb( TEXT CONSTuuuuuy): ENDPROCrestoredb; TEXT VARuuuuwu:=".archive"; TEXT PROCpostfix:uuuuwu ENDPROCpostfix +; PROCpostfix( TEXT CONSTuuuuuy):uuuuwu:=uuuuuy ENDPROCpostfix; THESAURUS PROCdb:emptythesaurus ENDPROCdb; PROCinitsavedupdateposition( INT CONSTuuuuyu):putplausi +(uuuuyu,"") ENDPROCinitsavedupdateposition; PROCgetsavedupdateposition( INT CONSTuuuuyu):puttupel(plausi(uuuuyu)); ENDPROCgetsavedupdateposition; PROCrestoreupdateposition +( INT CONSTuuuuyu):puttupel(plausi(uuuuyu));putplausi(uuuuyu,"") ENDPROCrestoreupdateposition; PROCsaveupdateposition( INT CONSTuuuuyu):putplausi(uuuuyu,gettupel) + ENDPROCsaveupdateposition; BOOL PROCcreatedb( TEXT CONSTuuuvuz): TRUE ENDPROCcreatedb; BOOL PROCupdatedb( TEXT CONSTuuuvuz): TRUE ENDPROCupdatedb; BOOL PROCdestroydb +( TEXT CONSTuuuvuz):cleardb(uuuvuz); TRUE ENDPROCdestroydb; PROCchangeindex: ENDPROCchangeindex; ENDPACKETdbersatz; + diff --git a/app/eumelbase/2.2.1-schulis/src/db kernel.sc b/app/eumelbase/2.2.1-schulis/src/db kernel.sc new file mode 100644 index 0000000..7d6d1cd --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db kernel.sc @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + +� +#����# diff --git a/app/eumelbase/2.2.1-schulis/src/db manager.sc b/app/eumelbase/2.2.1-schulis/src/db manager.sc new file mode 100644 index 0000000..edba990 --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db manager.sc @@ -0,0 +1,18 @@ + PACKETdbmanager DEFINESgeneratedbmanager: LETuuuuuv=0,uuuuuw=1,uuuuux=2,#uuuuuy=3,uuuuuz=4,#uuuuvu=5,uuuuvv=12,uuuuvw=30,uuuuvx=31,uuuuvy=32,uuuuvz=33,uuuuwu=100 +; DATASPACE VARuuuuwv:=nilspace,uuuuww:=nilspace; TASK VARuuuuwx:=niltask,uuuuwy:=niltask; INT VARuuuuwz,uuuuxu:=0,uuuuxv; BOOL VARuuuuxw:= FALSE; BOUND TEXT VARuuuuxx +; BOUND STRUCT( TEXTname,uuuuxy,uuuuxz) VARuuuuyu; TEXT VARuuuuyv:=""; PROCuuuuyw: IFiserror THENforget(uuuuwv);uuuuwv:=nilspace;uuuuxx:=uuuuwv; CONCR(uuuuxx):=errormessage +;clearerror;send(uuuuwx,uuuuux,uuuuwv) FI ENDPROCuuuuyw; PROCgeneratedbmanager:break;setautonom;disablestop; REPwait(uuuuwv,uuuuwz,uuuuwx);#continue(2);write("Order :" ++text(uuuuwz)+" O-Task :"+name(uuuuwx));pause;break;# IFuuuuxw CANDuuuuwx<>uuuuwy THENuuuvvx ELSEcontrol FI;uuuvvy PER.uuuvvy: IFheapsize>uuuuxu+2 THENcollectheapgarbage +;uuuuxu:=heapsize FI. ENDPROCgeneratedbmanager; PROCcontrol:commanddialogue( FALSE);#enablestop;# SELECTuuuuwz OF CASEuuuuvw:uuuvwz CASEuuuuvx:uuuvxv CASEuuuuvz:uuuvxx + CASEuuuuvy:uuuvxz CASEuuuuvu,uuuuvv:uuuvyw OTHERWISE: IFuuuuwz>=uuuuwu ANDuuuuwx=supervisor THENforget(uuuuwv);uuuvzv ELSEerrorstop("Falscher Auftrag fuer EUMELbase-Manager-Task ""MM""!" +);uuuuyw FI; END SELECT.uuuvxz:uuuuww:=uuuuwv;forget(uuuuwv); IFuuuwuv<>niltask THENerrorstop("Datenbank-Server bereits vorhanden");uuuuyw ELSEuuuwux;uuuuxw:= TRUE +;uuuwuz FI.uuuvxv:uuuuww:=uuuuwv;forget(uuuuwv); IFuuuwuv<>niltask THENend(uuuwuv) FI;uuuwuz.uuuvwz:uuuuxw:= FALSE;send(uuuwuv,uuuuuv,uuuuww,uuuuxv); IFuuuuxv<>uuuuuv + THENforget(uuuuww) FI.uuuvyw: IF NOTuuuuxw THENuuuuyu:=uuuuwv;uuuuyv:=uuuuyu.name; IFexists(uuuuyv) THENforget(uuuuyv,quiet) FI;uuuuwy:=uuuuwx;send(uuuuwx,uuuuvu +,uuuuwv);uuuuxw:= TRUE ELSEuuuuxw:= FALSE;copy(uuuuwv,uuuuyv);uuuwuz FI.uuuvxx:uuuuww:=uuuuwv;forget(uuuuwv); IFuuuwuv<>niltask THEN REPsend(uuuwuv,uuuuvz,uuuuww, +uuuuxv) UNTILuuuuxv=uuuuuv PER; ELSEuuuvxz FI;uuuwuz. END PROCcontrol; TASK PROCuuuwuv: TASK VARuuuxxu;disablestop;clearerror;uuuxxu:=task(uuuxxw); IFiserror THEN +uuuxxu:=niltask FI;clearerror;enablestop;uuuxxu ENDPROCuuuwuv; TEXT PROCuuuxxw:forget("X",quiet);copy(uuuuww,"X"); IFdbopen("X") THENname(1) ELSE"???" FI ENDPROCuuuxxw +; PROCuuuwux:begin(uuuxxw, PROCautonomserver,uuuuwy) END PROCuuuwux; PROCuuuwuz:forget(uuuuwv);uuuuwv:=nilspace;send(uuuuwx,uuuuuv,uuuuwv) END PROCuuuwuz; PROCuuuvvx +:forget(uuuuwv);uuuuwv:=nilspace;send(uuuuwx,uuuuuw,uuuuwv) END PROCuuuvvx; TEXT VARuuuyvx:=""; PROCuuuvzv:enablestop;continue(uuuuwz-uuuuwu);disablestop; REPcommanddialogue +( TRUE);getcommand("Gib DB-Kommando (NUR AUTHORISIERTES PERSONAL !):",uuuyvx);do(uuuyvx) UNTIL NOTonline PER;commanddialogue( FALSE);break(quiet);setautonom END PROC +uuuvzv; BOOL OP<>( TASK CONSTuuuywy,uuuywz): NOT(uuuywy=uuuywz) ENDOP<>; ENDPACKETdbmanager; + diff --git a/app/eumelbase/2.2.1-schulis/src/db memory.sc b/app/eumelbase/2.2.1-schulis/src/db memory.sc new file mode 100644 index 0000000..7d6d1cd --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db memory.sc @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + +� +#����# diff --git a/app/eumelbase/2.2.1-schulis/src/db q.sc b/app/eumelbase/2.2.1-schulis/src/db q.sc new file mode 100644 index 0000000..c1e1d4f --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db q.sc @@ -0,0 +1,100 @@ +#$ IFmitinternerquery THEN# PACKETqueryparser DEFINES QUERY,query,getscanbedingung,getdnr,getinr,getanzahlverbunde,getselpointer,getstopbedpointer,getquery,putquery +,setzeschluessel,getanzahltupel,getswanzfld,getswnachfld,getswvonfld,getswallefelder,getswfwert,getsohnverb,getbruderverb,geterstestupel,puterstestupel,selektionerfuellt +,initquery,:=,baumdurchlauf,listeschluessel,putletzterverbund,getletzterverbund,puttid,gettid,getbruder,putbruder,tidfeld,updatefnr,updateausdruck,queryart,anzupdatefelder +: TYPE UPDSTACK= STRUCT( INTuuuuuv, TEXTuuuuuw); BOUND ROW100 UPDSTACK VARuuuuux; TYPE VERBELEMENT= STRUCT( TEXTuuuuuy,uuuuuz, BOOLuuuuvu, INTuuuuvv,uuuuvw,uuuuvx +,uuuuvy,uuuuvz,uuuuwu); TYPE VERBUND= ROWuuuuwv VERBELEMENT; TYPE QUERY= STRUCT( INTuuuuww,uuuuwx,uuuuwy, TEXTuuuuwz,uuuuxu, SELEKTIONuuuuxv, VERBUNDuuuuxw, SCHLUESSEL +uuuuxx); TYPE SWERT= STRUCT( INTuuuuxy,uuuuxz, TEXTwert); TYPE SCHLUESSELWERTE= STRUCT( BOOLuuuuyu, INTuuuuyv, ROWuuuuyw SWERTuuuuyx); TYPE SCHLUESSEL= ROWuuuuwv SCHLUESSELWERTE +; LETuuuuyz=0,uuuuzu=1,uuuuzv=2,uuuuzw=3,uuuuzx=6,uuuuzy=5,uuuuzz=7,uuuvuu=7,uuuvuv=4,uuuvuw="BY",uuuvux="UPDATE",uuuvuy="DELETE",uuuvuz=".query",uuuvvu=";",uuuvvv +="(",uuuvvw=")",#uuuvvx=",",uuuvvy="=",uuuvvz=">=",uuuvwu="<=",#uuuvwv="/",uuuvww="""",uuuvwx=".",uuuvwy=":",uuuvwz=" ",uuuvxu=":=",uuuvxv="<",uuuuwv=10,uuuvxx=20 +,uuuuyw=10,uuuvxz=80,uuuvyu=1,uuuvyv=2,uuuvyw=3; INT VARuuuvyx:=-5,uuuvyy:=-33,uuuvyz; DATASPACE VARuuuvzu:=nilspace; INT VARuuuvzv:=0; INT PROCtidfeld:uuuvyy ENDPROC +tidfeld; FILE VARuuuvzz; TEXT VARuuuwuu:="",uuuwuv:="",uuuwuw:="",uuuwux:=""; INT VARuuuwuy,uuuwuz,uuuwvu; BOOL VARuuuwvv,uuuwvw; INT VARuuuwvx:=0,uuuwvy,uuuwvz; ROW +uuuvxx TEXT VARuuuwwv; OP:=( QUERY VARuuuwww, QUERY CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; OP:=( VERBELEMENT VARuuuwww, VERBELEMENT CONSTuuuwwx): CONCR +(uuuwww):= CONCR(uuuwwx) ENDOP:=; OP:=( VERBUND VARuuuwww, VERBUND CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; INT PROCupdatefnr( INT CONSTuuuwyx):uuuuux +[uuuwyx].uuuuuv ENDPROCupdatefnr; TEXT PROCupdateausdruck( INT CONSTuuuwyx):uuuuux[uuuwyx].uuuuuw ENDPROCupdateausdruck; INT PROCqueryart:uuuvzv ENDPROCqueryart; PROC +queryart( INT CONSTuuuxvu):uuuvzv:=uuuxvu ENDPROCqueryart; INT PROCanzupdatefelder:uuuvyz ENDPROCanzupdatefelder; PROCinitquery( QUERY VARuuuxww):uuuxwx;uuuxww.uuuuww +:=0;uuuxww.uuuuwx:=0;uuuxww.uuuuwz:="";uuuxww.uuuuxu:="";initselektionen(uuuxww.uuuuxv);uuuxyw(uuuxww.uuuuxw);uuuxyz(uuuxww.uuuuxx) ENDPROCinitquery; PROCuuuxwx:forget +(uuuvzu);uuuvzu:=nilspace;uuuuux:=uuuvzu ENDPROCuuuxwx;initquery(uuuyuy); PROCuuuxyw( VERBUND VARuuuyvu): FORuuuwvy FROM1 UPTOuuuuwv REPuuuyvx(uuuyvu[uuuwvy]) PER + ENDPROCuuuxyw; PROCuuuyvx( VERBELEMENT VARuuuyww):uuuyww.uuuuuy:="";uuuyww.uuuuuz:="" ENDPROCuuuyvx;# BOUND QUERY VARuuuyuy;# QUERY VARuuuyuy; PROCgetquery( QUERY + VARuuuxww): CONCR(uuuxww):= CONCR(uuuyuy) ENDPROCgetquery; PROCputquery( QUERY CONSTuuuxww): CONCR(uuuyuy):= CONCR(uuuxww) ENDPROCputquery; PROCquery:query(lastparam +) ENDPROCquery; PROCuuuyzz( TEXT CONSTuuuzuu): TEXT VARuuuzuv:="",uuuzuw:="",uuuzux:="",uuuwuv:=""; INT VARuuuzuz;uuuxwx;uuuzvv;nextsymbol;queryparser(uuuzvx);uuuzvy +;uuuzvz;uuuzwu;uuuzwv;baumdurchlauf;.uuuzvy:nextsymbol; WHILEuuuwuy<>uuuuzz REPuuuzxu;nextsymbol PER.uuuzxu:uuuzuw:=""; IFuuuwuy<>uuuuzu THENuuuzxz("Refinementname erwartet: " ++uuuwuu) ELSEuuuzuv:=uuuwuu;nextsymbol; IFuuuwuu<>uuuvwy THENuuuzxz(uuuvww+uuuvwy+uuuvww+" erwartet: "+uuuwuu) ELSEuuuzzy;putref(uuuzuv,uuuzuw) FI FI.uuuzzy:nextsymbol +; WHILEuuuwuy<>uuuuzz CANDuuuwuu<>uuuvwx REPuuuzuw:=uuuzuw+uuvuvw;nextsymbol PER; IFuuuwuy=uuuuzz THENuuuzxz("Refinement nicht mit ""."" abgeschlossen") FI.uuuzvv +:enablestop;uuuvzz:=sequentialfile(input,uuuzuu); IFexists(uuuzuu+uuuvuz) THENforget(uuuzuu+uuuvuz,quiet) FI;#uuuyuy:=new(uuuzuu+uuuvuz);#lastparam(uuuzuu);uuvuxz +(0);uuuwvx:=0;clearrefs;scan(uuuvzz);.uuuzwu: FORuuuzuz FROM1 UPTOuuuwvx REPuuuzux:="";uuuwuv:=uuvuzv(uuuzuz);scan(uuuwuv);nextsymbol(uuuwuu,uuuwuy); WHILEuuuwuy<> +uuuuzz REP IFuuuwuy=uuuuzu THENuuuzux:=uuuzux+getreftext(uuuwuu) ELSEuuuzux:=uuuzux+uuvuvw FI;nextsymbol(uuuwuu,uuuwuy) PER;uuvvwu(uuuzux,uuuzuz) PER.uuuzwv: INT VAR +uuvvwy;initsel(uuuyuy.uuuuxv); FORuuuzuz FROM1 UPTOgetanzahlverbunde REPuuvvxx;uuvvxy PER.uuvvxx:uuvvwy:=getstopbedpointer(uuuzuz); IFuuvvwy>uuuuyz THENuuuwuv:=uuvuzv +(uuvvwy);uuvvzw(baueselektionauf(uuuyuy.uuuuxv,uuuwuv),uuuzuz) FI.uuvvxy:uuvvwy:=getselpointer(uuuzuz); IFuuvvwy>uuuuyz THENuuuwuv:=uuvuzv(uuvvwy);uuvwvy(baueselektionauf +(uuuyuy.uuuuxv,uuuwuv),uuuzuz) FI. ENDPROCuuuyzz; PROCuuuzvz: INT VARuuuzuz:=1; BOOL VARuuvwxu:= FALSE; TEXT VARuuuzux:=""; WHILEuuuzuz<=getanzahlverbunde REPuuuzux +:="";uuuwuv:=getscanbedingung(uuuzuz);scan(uuuwuv);nextsymbol(uuuwuu,uuuwuy); WHILEuuuwuy<>uuuuzz REP IFuuuwuy=uuuuzu THENuuuzux:=uuuzux+getreftext(uuuwuu) ELSEuuuzux +:=uuuzux+uuvuvw FI;nextsymbol(uuuwuu,uuuwuy) PER; IFgetdnr(uuuzuz)=uuuvyx THENqueryparser(uuuzux,uuuzuz);uuvwxu:= TRUE ELSEuuvxwu(uuuzux,uuuzuz) FI;uuuzuz INCR1 PER +; IFuuvwxu THENuuuzvz FI ENDPROCuuuzvz; PROCqueryparser( TEXT CONSTuuuwuv, INT CONSTuuvxxx): INT VARuuvxxy;scan(uuuwuv);nextsymbol;uuvxyu;queryparser(uuvxxx);uuvxyx +.uuvxyu:uuvxxy:=getbruderverb(uuvxxx);.uuvxyx:uuvxzx(uuvxxy,uuvxxx). ENDPROCqueryparser; PROCqueryparser( INT CONSTuuvxxx): TEXT VARuuvyux:=""; BOOL VARuuvyuy:= FALSE +;uuuvzv:=0; REPuuvyvu; UNTILuuvyuy PER;uuvyvw;uuvyvx;uuvyvy;uuvyvz; SELECTuuuvzv OF CASEuuuvyv,uuuvyu:uuvywx; IFuuvxxx=1 THENuuvywz FI CASEuuuvyw:uuvyxv ENDSELECT +.uuvyvu: IFuuuwuy=uuuvuv THENuuvyxz(dateinr(uuuwuu),uuvxxx); IFuuuvzv<1 THENuuuvzv:=uuuvyu FI;uuvyuy:= TRUE ELSE IFuuuwuy=uuuuzv THEN IFuuuwuu=uuuvux THENnextsymbol +;uuuvzv:=uuuvyw ELIFuuuwuu=uuuvuy THENnextsymbol;uuuvzv:=uuuvyv ELSEuuuzxz("Dateiname nicht gefunden: "+uuuwuu) FI FI FI.uuvyvw:nextsymbol; IFuuuwuy=uuuuzv CANDuuuwuu +=uuuvuw THENuuvzvz;uuvzwu ELSE IFuuuwuy=uuuuzx CANDuuuwuu=uuuvvv THENuuvzwz(#getdnr(uuvxxx)#0,uuvxxx) ELSEuuuzxz("Indexname bzw. ""("" fehlt") FI FI.uuvzvz:nextsymbol +; IFuuuwuy=uuuvuv THENuuvzwz(indexnr(uuuwuu),uuvxxx) ELSEuuuzxz("Indexname nicht gefunden: "+uuuwuu) FI.uuvzwu:nextsymbol; IF NOT(uuuwuy=uuuuzx CANDuuuwuu=uuuvvv) + THENuuuzxz(uuuvww+uuuvvv+uuuvww+" erwartet") FI.uuvyvx:uuwuuy(uuuwuv);uuvxwu(uuuwuv,uuvxxx);.uuvyvy: BOOL VARstop:= TRUE;uuwuvy.uuvyvz:stop:= FALSE;uuwuvy.uuwuvy +: INT VARuuvvwy;uuuwuw:=""; IF NOTuuuwvv THENuuwuuy(uuuwuw); IFuuuwuw="" THEN IFstop THENuuvvzw(uuuuyz,uuvxxx) ELSEuuvwvy(uuuuyz,uuvxxx) FI ELSEuuvvwy:=uuwuyx; IF +stop THENuuvvzw(uuvvwy,uuvxxx) ELSEuuvwvy(uuvvwy,uuvxxx) FI;uuvvwu(uuuwuw,uuvvwy) FI ELSEuuvwvy(uuuuyz,uuvxxx) FI.uuvywx: INT VARuuwvuz; IF NOTuuuwvv THENuuwvvv(uuvxxx +,uuwvuz);uuwvvy(uuwvuz,uuvxxx);uuvxzx(uuuuyz,uuvxxx) FI.uuvywz:nextsymbol; IFuuuwuy=uuuuzx ORuuuwuy=uuuuzz ORuuuwuy=uuuuzy THEN IFuuuwuu<>uuuvwv THENuuwvyv FI;uuuuwx +;uuwvyx ELSEuuuzxz(uuuvww+uuuvwv+uuuvww+" bzw. "+uuuvww+uuuvvu+uuuvww+uuuvwv+uuuvww+uuuvwx+uuuvww+" erwartet") FI.uuwvyv: IFuuuwuu=uuuvvu ORuuuwuu=uuuvwx ORuuuwuy +=uuuuzz THENuuwwvy(0); LEAVEuuvywz ELSEuuuzxz("Falscher Tupelzahl-Operator: "+uuuwuu) FI.uuuuwx:nextsymbol; IFuuuwuy=uuuuzw THENuuwwvy(int(uuuwuu)); ELSEuuuzxz("Keine Zahlenangabe: " ++uuuwuu) FI.uuwvyx:nextsymbol; IFuuuwuy<>uuuuzz CAND( NOT(uuuwuu=uuuvvu CORuuuwuu=uuuvwx)) THENuuuzxz("""."" oder "";"" erwartet") FI.uuvyxv:uuuvyz:=0;nextsymbol; + WHILE NOTuuuwvv REPuuuvyz INCR1;uuwwzx;uuwwzy;uuwwzz; PER.uuwwzx: IFuuuwuy=uuuuzu THENuuwxux ELSEuuwxuy FI.uuwxux:uuuzxz("Zur Zeit keine Refinements in Update-Liste erlaubt!" +).uuwxuy:uuuuux[uuuvyz].uuuuuv:=feldnr(uuuwuu); IFuuuuux[uuuvyz].uuuuuv<3 THENuuuzxz("Falscher Feldname: "+uuuwuu) FI;nextsymbol.uuwwzy: IF NOT(uuuwuy=uuuuzy CAND +uuuwuu=uuuvxu) THENuuuzxz("Keine Zuweisung: "+uuuwuu) FI.uuwwzz:uuwxyv(uuvyux);uuuuux[uuuvyz].uuuuuw:=uuvyux;nextsymbol. ENDPROCqueryparser; PROCuuwxyv( TEXT VARuuwxzx +): INT VARuuwxzy:=0,uuwxzz:=0;uuwxzx:="";uuuwuu:="";uuuwuy:=0; REPuuwxzx:=uuwxzx+uuvuvw;uuwxzy:=uuuwuy;nextsymbol UNTILuuwyvw PER.uuwyvw: IF(uuuwuy=uuuuzx CAND(uuuwuu +=uuuvvu COR(uuuwuu=uuuvvw CANDuuwxzz=0))) THENuuuwvv:=uuuwuu=uuuvvw; TRUE ELSE IFuuuwuy=uuuuzz THENuuuzxz("Vorzeitiges END OF FILE!"); FALSE ELSE IFuuuwuy=uuuuzx THEN + IFuuuwuu=uuuvvv THENuuwxzz INCR1 FI; IFuuuwuu=uuuvvw THENuuwxzz DECR1 FI; FI; FALSE FI FI. ENDPROCuuwxyv; PROCuuwvvv( INT CONSTuuvxxx, INT VARuuwvuz): INT VARuuwyzz +:=uuuuyz;uuwvuz:=uuuuyz;nextsymbol; IFuuuwuy=uuuuzx CANDuuuwuu=uuuvvw THENuuuwvv:= TRUE; LEAVEuuwvvv ELIFuuuwuy=uuuuzu THENuuwvuz:=uuuzvx;uuvxwu(uuuwuu,uuwvuz);uuvwvy +(uuuuyz,uuwvuz);uuvyxz(uuuvyx,uuwvuz);uuwvvv(uuwvuz,uuwyzz);uuvxzx(uuwyzz,uuwvuz) ELIFuuuwuy=uuuvuv THENuuwvuz:=uuuzvx;queryparser(uuwvuz);uuuwvv:= FALSE;uuwvvv(uuwvuz +,uuwyzz);uuvxzx(uuwyzz,uuwvuz) ELIF(uuuwuy=uuuuzx CANDuuuwuu=uuuvvu) THENuuwvvv(uuvxxx,uuwvuz) ELSEuuuzxz("Verbund-Fehler bei : "+uuuwuu) FI ENDPROCuuwvvv; PROCuuwuuy +( TEXT VARuuwxzx): INT VARuuwxzy:=0;uuwxzx:="";uuuwuu:="";uuuwuy:=0;uuuwvv:= FALSE; REPuuwxzx:=uuwxzx+uuvuvw;uuwxzy:=uuuwuy;nextsymbol UNTILuuxuyx PER.uuxuyx: IF( +uuuwuy=uuuuzy CANDuuuwuu=uuuvwv) THEN TRUE ELSE IFuuuwuy=uuuuzz THENuuuzxz(uuuvww+uuuvwv+uuuvww+" fehlt"); FALSE ELSE FALSE FI FI. ENDPROCuuwuuy; TEXT PROCuuvuvw: + IFuuuwuy=uuuvuv THENuuuvww+uuuwuu+uuuvww ELIFuuuwuy=uuuuzv THENuuuvwz+uuuwuu+uuuvwz ELSEuuuwuu FI ENDPROCuuvuvw; PROCnextsymbol:nextsymbol(uuuvzz,uuuwuu,uuuwuy); + ENDPROCnextsymbol; PROCuuuzxz( TEXT CONSTuuxvxx):errorstop("Zeile "+text(lineno(uuuvzz))+" : "+uuxvxx) ENDPROCuuuzxz; PROCputerstestupel( TEXT CONSTuuxvyw):uuuyuy +.uuuuwz:=uuxvyw ENDPROCputerstestupel; TEXT PROCgeterstestupel:uuuyuy.uuuuwz ENDPROCgeterstestupel; PROCuuxvzz( TEXT CONSTuuxvyw):uuuyuy.uuuuxu:=uuxvyw ENDPROCuuxvzz +; TEXT PROCuuxwuz:uuuyuy.uuuuxu ENDPROCuuxwuz; PROCuuwwvy( INT CONSTuuxwvy):uuuyuy.uuuuwx:=uuxwvy ENDPROCuuwwvy; INT PROCgetanzahltupel:uuuyuy.uuuuwx ENDPROCgetanzahltupel +; PROCputletzterverbund( INT CONSTuuxwxw):uuuyuy.uuuuwy:=uuxwxw ENDPROCputletzterverbund; INT PROCgetletzterverbund:uuuyuy.uuuuwy ENDPROCgetletzterverbund; PROCputtid +( INT CONSTuuxwzu, TEXT CONSTuuxwzv):uuuyuy.uuuuxw[uuxwzu].uuuuuz:=uuxwzv ENDPROCputtid; TEXT PROCgettid( INT CONSTuuxwzu):uuuyuy.uuuuxw[uuxwzu].uuuuuz ENDPROCgettid +; PROCputbruder( INT CONSTuuxwzu, BOOL CONSTuuxxvz):uuuyuy.uuuuxw[uuxwzu].uuuuvu:=uuxxvz ENDPROCputbruder; BOOL PROCgetbruder( INT CONSTuuxwzu):uuuyuy.uuuuxw[uuxwzu +].uuuuvu ENDPROCgetbruder; PROCuuvxwu( TEXT CONSTuuxxyw, INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuuy:=uuxxyw ENDPROCuuvxwu; TEXT PROCgetscanbedingung( INT CONST +uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuuy ENDPROCgetscanbedingung; PROCuuvyxz( INT CONSTuuxyvu,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvv:=uuxyvu ENDPROCuuvyxz; PROCuuvzwz( INT + CONSTuuxywx,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvw:=uuxywx ENDPROCuuvzwz; INT PROCgetdnr( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvv ENDPROCgetdnr; INT PROCgetinr +( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvw ENDPROCgetinr; PROCuuvwvy( INT CONSTuuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvx:=uuxzuw ENDPROCuuvwvy; INT PROCgetselpointer +( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvx ENDPROCgetselpointer; PROCuuvvzw( INT CONSTuuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvy:=uuxzuw ENDPROCuuvvzw; INT PROC +getstopbedpointer( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvy ENDPROCgetstopbedpointer; PROCuuvxzx( INT CONSTuuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvz:=uuxzuw + ENDPROCuuvxzx; INT PROCgetbruderverb( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvz ENDPROCgetbruderverb; PROCuuwvvy( INT CONSTuuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz +].uuuuwu:=uuxzuw ENDPROCuuwvvy; INT PROCgetsohnverb( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuwu ENDPROCgetsohnverb; PROCuuvuxz( INT CONSTuuyuzu):uuuyuy.uuuuww:= +uuyuzu ENDPROCuuvuxz; INT PROCgetanzahlverbunde:uuuyuy.uuuuww ENDPROCgetanzahlverbunde; INT PROCuuuzvx: INT VARuuyuzu:=getanzahlverbunde+1;uuvuxz(uuyuzu);uuvxzx(uuuuyz +,uuyuzu);uuwvvy(uuuuyz,uuyuzu);uuvxwu("",uuyuzu);uuyuzu ENDPROCuuuzvx; INT PROCuuwuyx:uuuwvx INCR1;uuuwvx ENDPROCuuwuyx; PROCuuvvwu( TEXT CONSTuuuwuw, INT CONSTuuvvwy +):uuuwwv[uuvvwy]:=uuuwuw ENDPROCuuvvwu; TEXT PROCuuvuzv( INT CONSTuuvvwy):uuuwwv[uuvvwy] ENDPROCuuvuzv; PROCbaumdurchlauf: IFmittestausgaben THENuuyvzz FI.uuyvzz: + INT VARuuywuv; FORuuywuv FROM1 UPTOgetanzahlverbunde REPnote("Verbund : "+text(uuywuv));noteline;note(" Datei : "+text(getdnr(uuywuv)));noteline;note(" Index : " ++text(getinr(uuywuv)));noteline;note(" Scan : "+getscanbedingung(uuywuv));noteline;note(" Bruder: "+text(getbruderverb(uuywuv)));noteline;note(" Sohn : "+ +text(getsohnverb(uuywuv)));noteline;note(" SelPoi: "+text(getselpointer(uuywuv)));noteline;noteline; PER;checkselektion(uuuyuy.uuuuxv). ENDPROCbaumdurchlauf; PROC +setzeschluessel( INT CONSTuuxwzu): TEXT VARuuywxy:=getscanbedingung(uuxwzu);scan(uuywxy);nextsymbol;uuywyw;uuywyx;uuywyy;uuywyz; WHILEuuuwuy<>uuuvuu REP IFuuuwuu= +uuuvxv THENnextsymbol;uuywzy(uuxwzu,uuyxuu,uuuwuu);uuyxuw(uuxwzu,uuyxuu,uuyxuz);uuyxvu(uuxwzu,uuyxuu,0); ELIFuuuwuy=uuuvuv THENuuywzy(uuxwzu,uuyxuu,"");uuyxuw(uuxwzu +,uuyxuu,uuyxuz);uuyxvu(uuxwzu,uuyxuu,feldnr(uuuwuu)); ELIFuuuwuu=uuuvvu THENuuyxyu FI;nextsymbol PER;uuyxyv.uuywyx: IFuuuwuy=uuuvuv CANDfeldtyp(feldnr(uuuwuu))=uuuvxz + THENuuywzy(uuxwzu,1,"");uuyxuw(uuxwzu,1,tidfeld);uuyxvu(uuxwzu,1,feldnr(uuuwuu));uuyyux(uuxwzu, TRUE);uuyyuz(uuxwzu,1); LEAVEsetzeschluessel FI;.uuywyz:uuywzy(uuxwzu +,1,"");uuyxuw(uuxwzu,1,0);uuyxvu(uuxwzu,1,0).uuyxyu: IFuuuwvw THENuuyxuz INCR1 ELSEuuuwuz:=uuuwvu+1;uuuwvu:=pos(uuuwux,uuuvvu,uuuwuz);uuyxuz:=uuxyvu+int(subtext(uuuwux +,uuuwuz,uuuwvu-1)) FI;uuyxuu INCR1.uuywyw: INT VARuuyyzv:=getinr(uuxwzu),uuxyvu:=getdnr(uuxwzu),uuyxuz; IFuuyyzv=0 THENuuuwvw:= TRUE;uuyxuz:=uuxyvu+1 ELSEuuuwux:= +zugriff(uuyyzv);uuuwvu:=pos(uuuwux,uuuvvu);uuyxuz:=int(subtext(uuuwux,1,uuuwvu-1))+uuxyvu;uuuwvw:= FALSE FI.uuyzwy: IFuuuwvw THEN(uuyxuz-uuxyvu)=anzkey(uuxyvu) ELSE +uuuwvu=length(uuuwux) FI.uuywyy: INT VARuuyxuu:=1; IFuuuwuy=uuuvuu THENuuyxuu:=0 FI.uuyxyv:uuyyux(uuxwzu,uuyzwy CAND(uuyxuu>0));uuyyuz(uuxwzu,uuyxuu). ENDPROCsetzeschluessel +; PROCuuyxvu( INT CONSTuuxwzu,uuzuux,uuyxuz):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxy:=uuyxuz ENDPROCuuyxvu; PROCuuyxuw( INT CONSTuuxwzu,uuzuux,uuyxuz):uuuyuy. +uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxz:=uuyxuz ENDPROCuuyxuw; INT PROCgetswvonfld( INT CONSTuuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxy ENDPROCgetswvonfld +; INT PROCgetswnachfld( INT CONSTuuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxz ENDPROCgetswnachfld; PROCuuywzy( INT CONSTuuxwzu,uuzuux, TEXT CONSTuuzvwu +):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].wert:=uuzvwu ENDPROCuuywzy; TEXT PROCgetswfwert( INT CONSTuuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].wert ENDPROCgetswfwert +; PROCuuyyux( INT CONSTuuxwzu, BOOL CONSTuuzvzv):uuuyuy.uuuuxx[uuxwzu].uuuuyu:=uuzvzv ENDPROCuuyyux; BOOL PROCgetswallefelder( INT CONSTuuxwzu):uuuyuy.uuuuxx[uuxwzu +].uuuuyu ENDPROCgetswallefelder; PROCuuyyuz( INT CONSTuuxwzu,uuzwvz):uuuyuy.uuuuxx[uuxwzu].uuuuyv:=uuzwvz ENDPROCuuyyuz; INT PROCgetswanzfld( INT CONSTuuxwzu):uuuyuy +.uuuuxx[uuxwzu].uuuuyv ENDPROCgetswanzfld; PROCquery( TEXT CONSTuuzwyw): INT VARuuuzuz;uuuyzz(uuzwyw); FORuuuzuz FROM1 UPTOgetanzahlverbunde REPsetzeschluessel(uuuzuz +) PER;listeschluessel ENDPROCquery; OP:=( SCHLUESSELWERTE VARuuuwww, SCHLUESSELWERTE CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; OP:=( SWERT VARuuuwww, SWERT + CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; OP:=( SCHLUESSEL VARuuuwww, SCHLUESSEL CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; PROClisteschluessel +: IF NOTmittestausgaben THEN LEAVElisteschluessel FI; INT VARuuuzuz,uuywuv; FORuuuzuz FROM1 UPTOgetanzahlverbunde REPnoteline;note("Verbund : "+text(uuuzuz));noteline +;note("=============");noteline;noteline;note("ANZAHL FLD: "+text(getswanzfld(uuuzuz)));noteline;note("ALLE : "+uuzxxx);noteline;noteline; FORuuywuv FROM1 UPTO +getswanzfld(uuuzuz) REPnote(" VON : "+text(getswvonfld(uuuzuz,uuywuv)));noteline;note(" NACH: "+text(getswnachfld(uuuzuz,uuywuv)));noteline;note(" WERT: "+getswfwert +(uuuzuz,uuywuv));noteline; PER PER.uuzxxx: IFgetswallefelder(uuuzuz) THEN"vollständiger Schlüssel" ELSE"unvollständiger Schlüssel" FI. ENDPROClisteschluessel; BOOL + PROCselektionerfuellt( INT CONSTuuzyux):werteselektionaus(uuuyuy.uuuuxv,uuzyux) ENDPROCselektionerfuellt; PROCuuuxyz( SCHLUESSEL VARuuzyvx): FORuuuwvy FROM1 UPTO +uuuuwv REP FORuuuwvz FROM1 UPTOuuuuyw REPuuzyvx[uuuwvy].uuuuyx[uuuwvz].wert:="" PER PER ENDPROCuuuxyz; ENDPACKETqueryparser;#$ FI# + diff --git a/app/eumelbase/2.2.1-schulis/src/db ref.sc b/app/eumelbase/2.2.1-schulis/src/db ref.sc new file mode 100644 index 0000000..1b38c98 --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db ref.sc @@ -0,0 +1,10 @@ +#$ IFmitinternerquery THEN# PACKETqueryref DEFINESputref,getreftext,anzahlrefs,listerefs,clearrefs: LETuuuuuv=50,uuuuuw=1,uuuuux=2; LET REFELEMENT= ROW2 TEXT; TYPE + REFINEMENT= STRUCT( INTuuuuuy, ROWuuuuuv REFELEMENTuuuuvu); REFINEMENT VARuuuuvv; PROCputref( TEXT CONSTuuuuvw,uuuuvx): INT VARuuuuvy; FORuuuuvy FROM1 UPTOuuuuvv +.uuuuuy REP IFuuuuvv.uuuuvu[uuuuvy][uuuuuw]=uuuuvw THENuuuuvv.uuuuvu[uuuuvy][uuuuuw]:=uuuuvx; LEAVEputref FI PER; IFuuuuvv.uuuuuy=uuuuuv THENerrorstop("Zuviele Refinements!" +) FI;uuuuvv.uuuuuy INCR1;uuuuvv.uuuuvu[uuuuvv.uuuuuy][uuuuuw]:=uuuuvw;uuuuvv.uuuuvu[uuuuvv.uuuuuy][uuuuux]:=uuuuvx ENDPROCputref; TEXT PROCgetreftext( TEXT CONSTuuuuvw +): INT VARuuuuvy; FORuuuuvy FROM1 UPTOuuuuvv.uuuuuy REP IFuuuuvv.uuuuvu[uuuuvy][uuuuuw]=uuuuvw THEN LEAVEgetreftext WITHuuuuvv.uuuuvu[uuuuvy][uuuuux] FI PER;uuuuvw + ENDPROCgetreftext; PROCclearrefs: INT VARuuuuvy; FORuuuuvy FROM1 UPTOuuuuvv.uuuuuy REPuuuuvv.uuuuvu[uuuuvy][uuuuuw]:="";uuuuvv.uuuuvu[uuuuvy][uuuuux]:="" PER;uuuuvv +.uuuuuy:=0 ENDPROCclearrefs; INT PROCanzahlrefs:uuuuvv.uuuuuy ENDPROCanzahlrefs; PROClisterefs: INT VARuuuwuu;note("Liste der Refinements :");noteline;note("=======================" +);noteline;noteline; FORuuuwuu FROM1 UPTOanzahlrefs REPnote(text(uuuuvv.uuuuvu[uuuwuu][uuuuuw],30)+":"+uuuuvv.uuuuvu[uuuwuu][uuuuux]);noteline PER ENDPROClisterefs +; ENDPACKETqueryref;#$ FI# + diff --git a/app/eumelbase/2.2.1-schulis/src/db sel.sc b/app/eumelbase/2.2.1-schulis/src/db sel.sc new file mode 100644 index 0000000..285e84e --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db sel.sc @@ -0,0 +1,58 @@ + PACKETqueryselektion DEFINES SELEKTION,#putoptyp,putrechts,putlinks,putselwert,#optyp,rechts,links,selwert,fnrlinks,fnrrechts,#allocselelement,#:=,checkselektion +,baueselektionauf,werteselektionaus,mittestausgaben,initselektionen,initsel,initialisiereselektion,lex,lexon,lexoff: LETuuuuuv=0,uuuuuw=1,uuuuux=2,uuuuuy=6,uuuuuz +=7,uuuuvu=8,uuuuvv=9,#uuuuvw=1,uuuuvx=3,#uuuuvy=2,uuuuvz=4,uuuuwu=5,uuuuwv=10,uuuuww=11,uuuuwx=12,uuuuwy=13,uuuuwz=14,uuuuxu=15,uuuuxv=16,uuuuxw=17,uuuuxx=18,uuuuxy +=19,uuuuxz=20,uuuuyu=30,uuuuyv=73,uuuuyw=82,uuuuyx=68,uuuuyy=84; TYPE NODE= STRUCT( INTuuuuyz,uuuuzu,uuuuzv, TEXTselwert); TYPE SELEKTION= STRUCT( INTuuuuzx, ROWuuuuyu + NODEexp); INT VARuuuuzz,uuuvuu,uuuvuv; REAL VARuuuvuw,uuuvux; TEXT VARuuuvuy,uuuvuz; INT VARuuuvvu; TEXT VARuuuvvv:=""; BOOL VARuuuvvw:= FALSE,lexsort:= FALSE; BOOL + PROClex:lexsort ENDPROClex; PROClexon:lexsort:= TRUE ENDPROClexon; PROClexoff:lexsort:= FALSE ENDPROClexoff; PROCmittestausgaben( BOOL CONSTuuuvwy):uuuvvw:=uuuvwy + ENDPROCmittestausgaben; BOOL PROCmittestausgaben:uuuvvw ENDPROCmittestausgaben; OP:=( NODE VARuuuvxz, NODE CONSTuuuvyu): CONCR(uuuvxz):= CONCR(uuuvyu) ENDOP:=; OP +:=( SELEKTION VARuuuvxz, SELEKTION CONSTuuuvyu): CONCR(uuuvxz):= CONCR(uuuvyu) ENDOP:=; PROCinitsel( SELEKTION VARuuuvzw):uuuvzw.uuuuzx:=0 ENDPROCinitsel; PROCinitselektionen +( SELEKTION VARuuuwuv): INT VARuuuwuw; FORuuuwuw FROM1 UPTOuuuuyu REPuuuwuv.exp[uuuwuw].selwert:="" PER ENDPROCinitselektionen; PROCinitialisiereselektion( SELEKTION + VARuuuvzw):initsel(uuuvzw);initselektionen(uuuvzw) ENDPROCinitialisiereselektion; PROCuuuwwy( SELEKTION VARuuuvzw, INT CONSTuuuwxu):uuuvzw.exp[uuuwxu].uuuuyz:=uuuuxy +;uuuvzw.exp[uuuwxu].uuuuzv:=0;uuuvzw.exp[uuuwxu].uuuuzu:=0;uuuvzw.exp[uuuwxu].selwert:="" ENDPROCuuuwwy; INT PROCallocselelement( SELEKTION VARuuuvzw):uuuvzw.uuuuzx + INCR1;uuuwwy(uuuvzw,uuuvzw.uuuuzx);uuuvzw.uuuuzx ENDPROCallocselelement; PROCputoptyp( SELEKTION VARuuuvzw, INT CONSTuuuxvy,optyp):uuuvzw.exp[uuuxvy].uuuuyz:=optyp + ENDPROCputoptyp; PROCuuuxwz( SELEKTION VARuuuvzw, INT CONSTuuuxvy,uuuxxw):uuuvzw.exp[uuuxvy].uuuuzv:=uuuxxw ENDPROCuuuxwz; PROCputrechts( SELEKTION VARuuuvzw, INT + CONSTuuuxvy,uuuxyz):uuuvzw.exp[uuuxvy].uuuuzv:=uuuxyz ENDPROCputrechts; PROCuuuxzz( SELEKTION VARuuuvzw, INT CONSTuuuxvy,uuuxxw):uuuvzw.exp[uuuxvy].uuuuzu:=uuuxxw + ENDPROCuuuxzz; PROCputlinks( SELEKTION VARuuuvzw, INT CONSTuuuxvy,uuuwuw):uuuvzw.exp[uuuxvy].uuuuzu:=uuuwuw ENDPROCputlinks; PROCputselwert( SELEKTION VARuuuvzw, + INT CONSTuuuxvy, TEXT CONSTuuuyxw):uuuvzw.exp[uuuxvy].selwert:=uuuyxw ENDPROCputselwert; INT PROCoptyp( SELEKTION VARuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy]. +uuuuyz ENDPROCoptyp; INT PROCfnrrechts( SELEKTION VARuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy].uuuuzv ENDPROCfnrrechts; INT PROCfnrlinks( SELEKTION VARuuuvzw, INT + CONSTuuuxvy):uuuvzw.exp[uuuxvy].uuuuzu ENDPROCfnrlinks; INT PROCrechts( SELEKTION CONSTuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy].uuuuzv ENDPROCrechts; INT PROC +links( SELEKTION CONSTuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy].uuuuzu ENDPROClinks; TEXT PROCselwert( SELEKTION VARuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy]. +selwert ENDPROCselwert; INT PROCbaueselektionauf( SELEKTION VARuuuzzx, TEXT CONSTuuuzzy): IFcompress(uuuzzy)<>"" THENscan(uuuzzy);uuvuuv(uuuzzx) ELSE0 FI ENDPROCbaueselektionauf +; INT PROCuuvuuv( SELEKTION VARuuuzzx): INT VARuuuwuw,uuvuvv;uuuwuw:=uuvuvx(uuuzzx);nextsymbol; IFuuvuvz=uuuuxx ORuuvuvz=uuuuxv THENuuvuvv:=allocselelement(uuuzzx +);putoptyp(uuuzzx,uuvuvv,uuvuvz);putlinks(uuuzzx,uuvuvv,uuuwuw);putrechts(uuuzzx,uuvuvv,uuvuuv(uuuzzx));uuvuvv ELSEuuuwuw FI ENDPROCuuvuuv; INT PROCuuvuvx( SELEKTION + VARuuuzzx): INT VARuuvvuu;nextsymbol; SELECTuuvuvz OF CASEuuuuuw:uuvvuu:=uuvuuv(uuuzzx);#nextsymbol;# IFuuvuvz<>uuuuux THENerrorstop("Klammer zu fehlt! Gefunden: " ++uuuvvv) FI; CASEuuuuxw:uuvvuu:=allocselelement(uuuzzx);putoptyp(uuuzzx,uuvvuu,uuvuvz);putlinks(uuuzzx,uuvvuu,uuvuvx(uuuzzx)); CASEuuuuuy: CASEuuuuvu:uuvvuu:=allocselelement +(uuuzzx);uuvvyx;uuvvyy;nextsymbol;uuvvyz CASEuuuuvv:uuvvuu:=allocselelement(uuuzzx);uuvvzy;uuvvzz;uuvwuu CASEuuuuuz: OTHERWISE:errorstop("Falsches Symbol: "+uuuvvv ++text(uuuvvu)) ENDSELECT;uuvvuu.uuvvyx:nextsymbol; IFuuuvvu<>uuuuvz THENuuvwvw("Falsche Wertangabe") ELSEputselwert(uuuzzx,uuvvuu,uuuvvv);nextsymbol; IFuuuvvu<>uuuuwu + CANDuuuvvv<>">" THENuuvwvw(""">"" bei Wertangabe fehlt!") FI FI.uuvvzz:nextsymbol; IFuuuvvu<>uuuuwu THENuuvwvw("Falscher Operator: "+uuuvvv) FI;putoptyp(uuuzzx,uuvvuu +,uuvwyv).uuvvyy:nextsymbol; IF(uuuvvu=uuuuwu) COR(uuuvvu=uuuuvy CANDuuuvvv="IN") THENputoptyp(uuuzzx,uuvvuu,uuvwyv) ELSEuuvwvw("Falscher Operator: "+uuuvvv) FI;.uuvvyz +:uuuxwz(uuuzzx,uuvvuu,feldnr(uuuvvv)).uuvvzy:uuuxzz(uuuzzx,uuvvuu,feldnr(uuuvvv)).uuvwuu:nextsymbol; IFuuvuvz=uuuuvu THENuuvvyx ELSEuuvvyz FI. ENDPROCuuvuvx; INT PROC +uuvwyv: IFuuuvvv=">" THENuuuuwz ELIFuuuvvv="<" THENuuuuxu ELIFuuuvvv="=" THENuuuuwv ELIFuuuvvv=">=" THENuuuuwy ELIFuuuvvv="<=" THENuuuuwx ELIFuuuvvv="<>" THENuuuuww + ELIFuuuvvv="IN" THENuuuuxz ELSEuuuuxy FI ENDPROCuuvwyv; PROCnextsymbol:nextsymbol(uuuvvv,uuuvvu) ENDPROCnextsymbol; INT PROCuuvuvz: IFuuuvvv="(" THENuuuuuw ELIFuuuvvv +=")" THENuuuuux ELIFuuuvvv="NOT" ORuuuvvv="NICHT" THENuuuuxw ELIFuuuvvv="AND" ORuuuvvv="UND" THENuuuuxv ELIFuuuvvv="OR" ORuuuvvv="ODER" THENuuuuxx ELIFuuuvvu=13 THEN +uuuuuy ELIFuuuvvu=uuuuwu CANDuuuvvv="<" THENuuuuvu ELIFuuuvvu=uuuuvz THENuuuuvv ELIFuuuvvu=7 THENuuuuuz ELSEuuuuuv FI ENDPROCuuvuvz; PROCuuvwvw( TEXT CONSTuuvyyz) +:errorstop("FEHLERHAFTER AUSDRUCK: "+uuvyyz) ENDPROCuuvwvw; PROCcheckselektion( SELEKTION CONSTuuuzzx): INT VARuuvyzy,uuvyzz:=uuuzzx.uuuuzx;note("Anzahl Knoten: " ++text(text(uuvyzz),5));noteline;noteline;noteline; FORuuvyzy FROM1 UPTOuuvyzz REPnote("Knoten: "+text(uuvyzy));noteline;note(" Operat: "+uuvzvu(uuuzzx.exp[uuvyzy +]));noteline;note(" links : "+text(links(uuuzzx,uuvyzy)));noteline;note(" rechts: "+text(rechts(uuuzzx,uuvyzy)));noteline;note(" Wert : "+">"+uuuzzx. +exp[uuvyzy].selwert+"<");noteline PER ENDPROCcheckselektion; TEXT PROCuuvzvu( NODE CONSTuuuvzw): SELECTuuuvzw.uuuuyz OF CASEuuuuwv:"=" CASEuuuuww:"<>" CASEuuuuwx: +"<=" CASEuuuuwy:">=" CASEuuuuwz:">" CASEuuuuxu:"<" CASEuuuuxw:"NOT" CASEuuuuxv:"AND" CASEuuuuxx:"OR" CASEuuuuxz:"IN" OTHERWISE:"UNDEFINED OPERATOR" ENDSELECT ENDPROC +uuvzvu; BOOL PROCwerteselektionaus( SELEKTION VARuuuvzw, INT CONSTuuvyzy): IFuuvyzy=0 THEN LEAVEwerteselektionaus WITH TRUE FI;uuwuux; SELECTuuwuuy OF CASEuuuuxx: +uuwuvu ORuuwuvv CASEuuuuxv:uuwuvu ANDuuwuvv CASEuuuuxw: NOTuuwuvu CASEuuuuwx:uuwuww CASEuuuuwy:uuwuwy CASEuuuuww:uuwuxu CASEuuuuwv:uuwuxw CASEuuuuxu:uuwuxy CASEuuuuwz +:uuwuyu CASEuuuuxz:uuwuyw OTHERWISE: FALSE ENDSELECT.uuwuvu:werteselektionaus(uuuvzw,links(uuuvzw,uuvyzy)).uuwuvv:werteselektionaus(uuuvzw,rechts(uuuvzw,uuvyzy)). +uuwuux: IFuuwuuy=uuuuxx CORuuwuuy=uuuuxv CORuuwuuy=uuuuxw THEN LEAVEuuwuux ELSEuuwvvz;uuwvwu FI.uuwvvz: IFfnrlinks(uuuvzw,uuvyzy)=0 THEN SELECTuuwvwz OF CASEuuuuyv +:uuuvuu:=int(selwert(uuuvzw,uuvyzy));uuuuzz:=uuuuyv CASEuuuuyw:uuuvuw:=real(selwert(uuuvzw,uuvyzy));uuuuzz:=uuuuyw CASEuuuuyx:uuuvuw:=date(selwert(uuuvzw,uuvyzy)) +;uuuuzz:=uuuuyw OTHERWISE:uuuvuy:=selwert(uuuvzw,uuvyzy);uuuuzz:=uuuuyy ENDSELECT ELSE SELECTfeldtyp(fnrlinks(uuuvzw,uuvyzy)) OF CASEuuuuyv:uuuvuu:=intwert(fnrlinks +(uuuvzw,uuvyzy));uuuuzz:=uuuuyv CASEuuuuyw:uuuvuw:=realwert(fnrlinks(uuuvzw,uuvyzy));uuuuzz:=uuuuyw CASEuuuuyx:uuuvuw:=date(datumwert(fnrlinks(uuuvzw,uuvyzy)));uuuuzz +:=uuuuyw OTHERWISE:uuuvuy:=wert(fnrlinks(uuuvzw,uuvyzy));uuuuzz:=uuuuyy ENDSELECT FI.uuwvwu: IFfnrrechts(uuuvzw,uuvyzy)=0 THEN SELECTuuwxvv OF CASEuuuuyv:uuuvuv:= +int(selwert(uuuvzw,uuvyzy)) CASEuuuuyw:uuuvux:=real(selwert(uuuvzw,uuvyzy)) CASEuuuuyx:uuuvux:=date(selwert(uuuvzw,uuvyzy)) OTHERWISE:uuuvuz:=selwert(uuuvzw,uuvyzy +) ENDSELECT ELSE SELECTfeldtyp(fnrrechts(uuuvzw,uuvyzy)) OF CASEuuuuyv:uuuvuv:=intwert(fnrrechts(uuuvzw,uuvyzy)) CASEuuuuyw:uuuvux:=realwert(fnrrechts(uuuvzw,uuvyzy +)) CASEuuuuyx:uuuvux:=date(datumwert(fnrrechts(uuuvzw,uuvyzy))) OTHERWISE:uuuvuz:=wert(fnrrechts(uuuvzw,uuvyzy)) ENDSELECT FI.uuwxvv: IFfnrlinks(uuuvzw,uuvyzy)=0 THEN +uuuuyy ELSEfeldtyp(fnrlinks(uuuvzw,uuvyzy)) FI.uuwvwz: IFfnrrechts(uuuvzw,uuvyzy)=0 THENuuuuyy ELSEfeldtyp(fnrrechts(uuuvzw,uuvyzy)) FI.uuwuuy:optyp(uuuvzw,uuvyzy +). ENDPROCwerteselektionaus; BOOL PROCuuwuww: SELECTuuuuzz OF CASEuuuuyv:uuuvuu<=uuuvuv CASEuuuuyw:uuuvuw<=uuuvux OTHERWISE:uuuvuy<=uuuvuz ENDSELECT ENDPROCuuwuww +; BOOL PROCuuwuwy: SELECTuuuuzz OF CASEuuuuyv:uuuvuu>=uuuvuv CASEuuuuyw:uuuvuw>=uuuvux OTHERWISE:uuuvuy>=uuuvuz ENDSELECT ENDPROCuuwuwy; BOOL PROCuuwuxy: SELECTuuuuzz + OF CASEuuuuyv:uuuvuuuuuvuv CASEuuuuyw:uuuvuw>uuuvux OTHERWISE: IFlexsort THENuuuvuy LEXGREATERuuuvuz ELSEuuuvuy>uuuvuz FI ENDSELECT ENDPROC +uuwuyu; BOOL PROCuuwuxw: SELECTuuuuzz OF CASEuuuuyv:uuuvuu=uuuvuv CASEuuuuyw:uuuvuw=uuuvux OTHERWISE: IFlexsort THENuuuvuy LEXEQUALuuuvuz ELSEuuuvuy=uuuvuz FI ENDSELECT + ENDPROCuuwuxw; BOOL PROCuuwuxu: SELECTuuuuzz OF CASEuuuuyv:uuuvuu<>uuuvuv CASEuuuuyw:uuuvuw<>uuuvux OTHERWISE: IFlexsort THEN NOT(uuuvuy LEXEQUALuuuvuz) ELSEuuuvuy +<>uuuvuz FI ENDSELECT ENDPROCuuwuxu; BOOL PROCuuwuyw: IFuuuuzz=uuuuyy THENpos(uuuvuz,uuuvuy)>0 ELSE FALSE FI ENDPROCuuwuyw; ENDPACKETqueryselektion; + diff --git a/app/eumelbase/2.2.1-schulis/src/db snd query.sc b/app/eumelbase/2.2.1-schulis/src/db snd query.sc new file mode 100644 index 0000000..2d14756 --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db snd query.sc @@ -0,0 +1,18 @@ +#$ IFmitinternerquery THEN# PACKETdbsndquery DEFINESauswertung,auswertungfortsetzen,qsucc,endofscan,ordernewstack,puttiefennr,gettiefennr,endqueryserver: LETuuuuuv +=25,uuuuuw=0,uuuuux=1,uuuuuy=2,uuuuuz=2,uuuuvu=37,uuuuvv=10,uuuuvw=39,uuuuvx=40,uuuuvy=41,uuuuvz=1; INT CONSTendofscan:=8,ordernewstack:=9; INT VARuuuuwu,uuuuwv; DATASPACE + VARuuuuww; BOUND QUERY VARuuuuwx; BOUND TEXT VARuuuuwy; ROWuuuuvv INT VARuuuuxu; TYPE TUPEL= STRUCT( INTuuuuxv,uuuuxw,uuuuxx, TEXTuuuuxy); TYPE QUERYSTACK= STRUCT +( INTuuuuxz, TASKuuuuyu, ROWuuuuuv TUPELuuuuyw); INT VARuuuuyx:=getanzahltupel,uuuuyy; TEXT VARuuuuyz:="",uuuuzu:=""; PROCendqueryserver:forget(uuuuww);uuuuww:=nilspace +;send(uuuuzy,uuuuvx,uuuuww) ENDPROCendqueryserver; TASK VARuuuuzy; BOUND QUERYSTACK VARuuuvux; OP:=( TUPEL VARuuuvuy, TUPEL CONSTuuuvuz): CONCR(uuuvuy):= CONCR(uuuvuz +) ENDOP:=; OP:=( QUERYSTACK VARuuuvuy, QUERYSTACK CONSTuuuvuz): CONCR(uuuvuy):= CONCR(uuuvuz) ENDOP:=; INT PROCgettiefennr( INT CONSTuuuvwv): IFuuuvwv=0 THEN0 ELSE +uuuuxu[uuuvwv] FI ENDPROCgettiefennr; PROCputtiefennr( INT CONSTuuuvwv,uuuvxw):uuuuxu[uuuvwv]:=uuuvxw ENDPROCputtiefennr; PROCauswertung( TEXT CONSTuuuvyv):uuuuyy +:=0;query(uuuvyv); IFqueryart=uuuuvz THENuuuvyz ELSEuuuvzu FI.uuuvyz:uuuvzw;forget(uuuuww);uuuuww:=nilspace;uuuuwx:=uuuuww;getquery(uuuuwx);call(/name(1),uuuuvu,uuuuww +,uuuuwu);uuuwuz;uuuvux:=uuuuww;uuuuzy:=uuuvux.uuuuyu.uuuvzu:forget(uuuuww);uuuuww:=old(uuuvyv);call(/name(1),uuuuvy,uuuuww,uuuuwu);uuuwuz. ENDPROCauswertung; PROC +uuuvzw:uuuuwv:=0;uuuwxx(1) ENDPROCuuuvzw; PROCuuuwxx( INT CONSTuuuwyu):uuuuwv INCR1;puttiefennr(uuuwyu,uuuuwv); IFgetsohnverb(uuuwyu)<>uuuuuw THENuuuwxx(getsohnverb +(uuuwyu)) FI; IFgetbruderverb(uuuwyu)<>uuuuuw THENuuuwxx(getbruderverb(uuuwyu)) FI ENDPROCuuuwxx; PROCauswertung( QUERY VARuuuvyv):queryart(uuuuvz);uuuvzw;uuuuyy:= +0;forget(uuuuww);uuuuww:=nilspace;uuuuwx:=uuuuww;uuuuwx:=uuuvyv;call(/name(1),uuuuvu,uuuuww,uuuuwu);uuuwuz;uuuvux:=uuuuww;uuuuzy:=uuuvux.uuuuyu ENDPROCauswertung; + PROCauswertungfortsetzen:uuuuyy:=0;forget(uuuuww);uuuuww:=nilspace;call(uuuuzy,uuuuvw,uuuuww,uuuuwu);uuuwuz;uuuvux:=uuuuww ENDPROCauswertungfortsetzen; PROCuuuwuz +: IFuuuuwu=uuuuuz THENdbstatus(dberror);uuuuwy:=uuuuww;forget(uuuuww);errorstop(uuuuwy) ELSEdbstatus(uuuuwu) FI ENDPROCuuuwuz; PROCqsucc( INT VARuuuwyu,uuuyuz):uuuuyy + INCR1; IFuuuuyy>uuuvux.uuuuxz THENuuuwyu:=0;uuuyuz:=0;dbstatus(endoffile) ELSEuuuyuz:=uuuvux.uuuuyw[uuuuyy].uuuuxw;#uuuywz(uuuvux.uuuuyw[uuuuyy].uuuuxy[uuuuux]); +uuuyxz(uuuvux.uuuuyw[uuuuyy].uuuuxy[uuuuuy]);#parsetupel(uuuyuz,uuuyzu); IFuuuyzv THENdbstatus(endofscan) ELSEdbstatus(ok) FI FI.uuuyzu:uuuvux.uuuuyw[uuuuyy].uuuuxy +.uuuyzv:uuuwyu:=uuuvux.uuuuyw[uuuuyy].uuuuxv; IFuuuwyu<0 THENuuuwyu:=abs(uuuwyu); TRUE ELSE FALSE FI. ENDPROCqsucc; ENDPACKETdbsndquery;#$ FI# + diff --git a/app/eumelbase/2.2.1-schulis/src/db utils.sc b/app/eumelbase/2.2.1-schulis/src/db utils.sc new file mode 100644 index 0000000..7d6d1cd --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/db utils.sc @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + + + +���� +���� +���� +���� +���� +���� + + + +���� +���� +���� + + +� +#����# diff --git a/app/eumelbase/2.2.1-schulis/src/isp archive manager.sc b/app/eumelbase/2.2.1-schulis/src/isp archive manager.sc new file mode 100644 index 0000000..0a70651 --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/isp archive manager.sc @@ -0,0 +1,79 @@ + PACKETisparchivemanager DEFINESisparchivemanager,archivechannel: LETuuuuuv=128,uuuuuw=100,uuuuux=1,uuuuuy=2,uuuuuz=200,uuuuvu=100,uuuuvv=12,uuuuvw=0,#uuuuvx=1,uuuuvy +=2,#uuuuvz=5,uuuuwu=25,uuuuwv=26,#uuuuww=28,uuuuwx=19,uuuuwy=20,#uuuuwz=34,uuuuxu=35,uuuuxv=36,uuuuxw=37,uuuuxx=39,uuuuxy=40,uuuuxz=41,uuuuyu=42,uuuuyv=43,uuuuyw= +44,uuuuyx=45,uuuuyy=46,uuuuyz=47,uuuuzu=48,uuuuzv=10,uuuuzw=5,uuuuzx=7; LET ARCHIVECONTROL= STRUCT( INTuuuuzy, BOOLuuuuzz); BOUND ARCHIVECONTROL VARuuuvuu; TYPE HEADER += STRUCT( TEXTname,date, INTtype, TEXTuuuvuv, INTuuuvuw,uuuvux,uuuvuy,uuuvuz); TYPE DSNAMEN= STRUCT( INTuuuvvu, ROWuuuuuz TEXTuuuvvw); ROWuuuuuz DATASPACE VARuuuvvy +;uuuvvz( TRUE); BOUND DSNAMEN VARuuuvwu; TYPE FILEHEADER= STRUCT( TEXTuuuvwv, INTuuuvww,uuuvwx,uuuvwy, ROWuuuuuv INTuuuvxu); BOUND FILEHEADER VARuuuvxv; BOUND TEXT + VARuuuvxw; BOUND INT VARuuuvxx; BOUND HEADER VARuuuvxy; DATASPACE VARuuuvxz:=nilspace,uuuvyu:=nilspace,uuuvyv:=nilspace,uuuvyw:=nilspace,uuuvyx:=nilspace,uuuvyy:= +nilspace;uuuvyz; INT VARuuuvzu,uuuvzv,uuuvzw,uuuvzx,uuuvzy,uuuvzz,uuuwuu,uuuwuv,uuuwuw,uuuwux,uuuwuy,uuuwuz,uuuwvu,uuuwvv:=1; BOOL VARuuuwvw:= TRUE,uuuwvx:= FALSE +,uuuwvy:= FALSE; INT VARuuuwvz,uuuwwu,uuuwwv,uuuwww,uuuwwx,uuuwwy; TASK VARuuuwwz,uuuwxu:=niltask; BOUND STRUCT( TEXTname,uuuwxv,uuuwxw) VARuuuwxx; FILE VARuuuwxy +; TEXT VARuuuwxz:="",uuuwyu:="",uuuwyv:=""; REAL VARuuuwyw:=clock(1); INT VARuuuwyx:=31; INT PROCarchivechannel:uuuwyx ENDPROCarchivechannel; PROCarchivechannel( INT + CONSTuuuwzw):uuuwyx:=uuuwzw ENDPROCarchivechannel; PROCuuuvyz:forget(uuuvxz);forget(uuuvyu);forget(uuuvyv);forget(uuuvyw);forget(uuuvyx);forget(uuuvyy); ENDPROCuuuvyz +; PROCuuuvvz( BOOL CONSTuuuxvx): INT VARuuuwvz; FORuuuwvz FROM1 UPTOuuuuuz REP IFuuuxvx THENuuuvvy[uuuwvz]:=nilspace FI;forget(uuuvvy[uuuwvz]) PER ENDPROCuuuvvz; PROC +uuuxxv( DATASPACE VARuuuvyw, INT CONSTpage, INT CONSTuuuwuv): INT VARuuuxxy:=0,uuuxxz:=0,uuuxyu; REPblockin(uuuvyw,page,0,uuuwuv,uuuxxy); IFuuuxxy<>0 THENuuuxxz INCR +1;uuuxzu FI UNTILuuuxxy<>2 ORuuuxxz=uuuuzv PER;uuuxzy(uuuxxy,uuuwuv).uuuxzu: IFuuuxxz=uuuuzw THENblockin(uuuvyw,page,0,0,uuuxxy);uuuxxy:=2 FI;. ENDPROCuuuxxv; PROC +uuuyvw( DATASPACE VARuuuvyw, INT CONSTpage, INT CONSTuuuwuv): INT VARuuuxxy:=0,uuuxxz:=0,uuuxyu; REP FORuuuwvz FROM1 UPTOuuuwvv REPblockout(uuuvyw,page,0,uuuwuv,uuuxxy +); UNTILuuuxxy<>0 PER; IFuuuwvy CANDuuuxxy=0 THENblockin(uuuvyw,page,0,uuuwuv,uuuxxy); FI; IFuuuxxy<>0 THENuuuxxz INCR1;uuuxzu FI UNTILuuuxxy<>2 ORuuuxxz=uuuuzv PER +;uuuxzy(uuuxxy,uuuwuv).uuuxzu: IFuuuxxz=uuuuzw THENdisablestop;uuuvyy:=nilspace;blockin(uuuvyy,2,0,0,uuuxxy);forget(uuuvyy);clearerror;enablestop;uuuxxy:=2 FI;. ENDPROC +uuuyvw; PROCuuuxzy( INT CONSTuuuxxy,uuuzvx): SELECTuuuxxy OF CASE0: CASE1:errorstop("Schreiben/Lesen des Archives unmöglich") CASE2:errorstop("Schreib/Lese-Fehler:" ++text(uuuzvx)) CASE3:errorstop("Archive-Overflow") OTHERWISE:errorstop("Unbekannter Archive-Fehler:"+text(uuuxxy)+"/"+text(uuuzvx)) ENDSELECT ENDPROCuuuxzy; PROCuuuzwx +: INT VARuuuwvz:=1,uuuxxy;forget(uuuvyy);uuuvyy:=nilspace;uuuzxw( TRUE);uuuzxx(text(uuuwvz)); FORuuuwvz FROM1 UPTOarchiveblocks-1 REP IF(uuuwvz MOD50)=0 THENuuuzxx +(text(uuuwvz)); FI;blockin(uuuvyy,1,0,uuuwvz,uuuxxy);uuuxzy(uuuxxy,uuuwvz) PER;uuuzxx(text(uuuwvz));forget(uuuvyy) ENDPROCuuuzwx; PROCuuvuuv:uuuzxw( TRUE);forget( +uuuvxy.name,quiet);uuuwxy:=sequentialfile(output,uuuvxy.name); IFuuuwvw THENuuvuvv ELSEuuvuvw FI;forget(uuuvyw);forget(uuuvyu);uuuvyu:=old(uuuvxy.name);uuuvyw:=uuuvyu +;forget(uuuvyu);forget(uuuvxy.name,quiet);.uuvuvv:uuvuvw; REPuuvuxv;putline(uuuwxy,"! "+text(uuuvxv.uuuvwv,27)+"! "+text(text(uuuvxv.uuuvww),10)+"! "+text(text +(uuuwuw),7)+"! "+text(text(uuuvxv.uuuvwx),11)+"!");uuvuyy;uuuwuw:=uuuwuw+uuuwuz+1;uuuwuv:=uuuwuw+1 UNTILuuvuzy PER.uuvuvw:uuvvuu;putline(uuuwxy,"");putline(uuuwxy +," ARCHIVE: "+text(uuuvxy.name,20)+"erstellt am : "+text(uuuvxy.date,10));putline(uuuwxy,"");putline(uuuwxy,10*" "+" Disketten-Nr. : "+uuvvvv);putline(uuuwxy, +10*" "+" vorige Diskette der Sicherung : "+uuvvvx);putline(uuuwxy,10*" "+" nächste Diskette der Sicherung: "+uuvvvz);putline(uuuwxy,"");putline(uuuwxy,10*" "+" Blöcke insgesamt : " ++text(archiveblocks-1));putline(uuuwxy,10*" "+" Erster freier Block: "+text(uuuvxy.uuuvuw));putline(uuuwxy,"");putline(uuuwxy,"");uuvvxv.uuvvxv:putline(uuuwxy,"! Filename ! Anzahl Blöcke ! ab Block ! erste DS-Seite !" +);putline(uuuwxy,"+----------------------------+---------------+----------+----------------+");uuvuyy.uuvuyy:putline(uuuwxy,"! ! ! ! !" +);.uuvvvv:text(uuuvxy.uuuvuz).uuvvvz:text(uuuvxy.uuuvuy).uuvvvx:text(uuuvxy.uuuvux).uuvuzy:uuuwuv>=uuuvxy.uuuvuw.uuvuxv:uuvwuy;. ENDPROCuuvuuv; PROCuuvwuy:forget( +uuuvxz);uuuvxz:=nilspace;uuuxxv(uuuvxz,1,uuuwuw);uuuvxv:=uuuvxz;uuuwuz:=uuuvxv.uuuvww;uuuwvu:=uuuvxv.uuuvwx ENDPROCuuvwuy; PROCuuvwxx( TEXT CONSTuuvwxy):forget(uuuvyv +);uuuvyv:=nilspace;uuuvxy:=uuuvyv;uuuvxy.name:=uuvwxy;uuuvxy.uuuvuz:=0;uuuvxy.uuuvuy:=0;uuuvxy.uuuvux:=0;uuuvxy.uuuvuw:=-1;uuuvxy.date:=date;uuvxuw ENDPROCuuvwxx; + PROCuuvxuy:uuvvuu;uuuvxy.uuuvuz:=0;uuuvxy.uuuvuy:=0;uuuvxy.uuuvux:=0;uuuvxy.uuuvuw:=-1;uuuvxy.date:=date;uuvxuw ENDPROCuuvxuy; PROCuuuzxw( BOOL CONSTuuvxxu):uuuwvw +:= TRUE;uuvvuu;uuvxxx.uuvxxx: IFuuuvxy.uuuvuw<=0 THENuuuwvw:= FALSE;uuuvxy.uuuvuw:=uuuuuy FI; IFuuvxxu THENuuuwuw:=uuuuuy;uuuvxy.date:=date ELSEuuuwuw:=uuuvxy.uuuvuw + FI;uuuwuv:=uuuwuw+1#;note("Erster freier Block : "+text(uuuvxy.uuuvuw));noteline;note("Startblock : "+text(uuuwuw));noteline;#. ENDPROCuuuzxw; PROCuuvvuu:forget( +uuuvyv);uuuvyv:=nilspace;uuuxxv(uuuvyv,1,uuuuux);uuuvxy:=uuuvyv ENDPROCuuvvuu; PROCuuvxuw:uuuyvw(uuuvyv,nextdspage(uuuvyv,-1),uuuuux) ENDPROCuuvxuw; PROCuuvyxx:uuuwxz +:=uuuuuw*code(0);uuvyyu(1) ENDPROCuuvyxx; PROCuuvyyw:uuuwyu:=uuuuuw*code(0) ENDPROCuuvyyw; PROCuuvyzu( INT CONSTuuvyzv):uuvyzw(uuuwyu,uuvyzv) ENDPROCuuvyzu; INT PROC +uuvzuu( INT CONSTuuvyzv):uuvyzv MOD8 ENDPROCuuvzuu; INT PROCuuvzuy( INT CONSTuuvyzv):(uuvyzv DIV8)+1 ENDPROCuuvzuy; PROCuuvyyu( INT CONSTuuvyzv):uuvyzw(uuuwxz,uuvyzv +) ENDPROCuuvyyu; BOOL PROCuuvzww:uuuwyu=uuuwxz ENDPROCuuvzww; PROCuuvyzw( TEXT VARuuvzxv, INT CONSTuuvyzv): INT VARuuvzxx,bit,uuvzxy;uuvzxx:=uuvzuy(uuvyzv);bit:=uuvzuu +(uuvyzv);uuvzxy:=code(uuvzxv SUBuuvzxx);setbit(uuvzxy,bit);change(uuvzxv,uuvzxx,uuvzxx,code(uuvzxy)) ENDPROCuuvyzw; PROCuuwuuv: IFuuwuuw THENuuwuux ELSEuuwuuy FI. +uuwuuw:uuuwwx=uuuuwz.uuwuux:#uuuwux:=1;#uuuvuu:=uuuvyw;uuuwvv:=uuuvuu.uuuuzy;uuuwvy:=uuuvuu.uuuuzz;uuuwwy:=archiveblocks-1;uuuwwu:=0;uuuwww:=0;uuuwwv:=nextdspage( +uuuvyu,-1);uuwuxz; IFuuuwuv>uuuwwu THENerrorstop("Archive voll!") FI;uuwuyw.uuwuuy:uuuwwy:=archiveblocks-1;uuwuxz;uuwuzu;uuwuzv;uuwuyw.uuwuyw: WHILEuuuwwv>=0 REPuuwuzz +;uuwuzv PER;uuwvuv;uuwvuw;uuvxuw;forget(uuuvyu);uuwvuz.uuwuzz: IFuuuwuv>uuuwwu THENuuwvvx FI;uuwuzu.uuwuzu:#uuuzxx("Block "+text(uuuwuv)+" wird geschrieben !");#uuuyvw +(uuuvyu,uuuwwv,uuuwuv);uuuwww INCR1;uuuvxy.uuuvuw INCR1;uuwvxx;uuuwuv INCR1.uuwvxx:uuwvyu;uuwvyv.uuwvyu:uuuvzu:=uuuwwv-uuuvxv.uuuvwx+1;uuuvzw:=(uuuvzu DIV16)+1;uuuvzv +:=(uuuvzu) MOD16#;note("Seite : "+text(uuuwwv));noteline;note(" rel. Seite : "+text(uuuvzu));noteline;note(" Zeichen : "+text(uuuvzw));noteline;note(" Bit : " ++text(uuuvzv));noteline;#.uuwvyv:setbit(uuuvxv.uuuvxu[uuuvzw],uuuvzv).uuwuzv:uuuwwv:=nextdspage(uuuvyu,uuuwwv).uuwvuw:uuuwwv:=nextdspage(uuuvxz,-1);uuwwwx.uuwwwx: +uuuyvw(uuuvxz,1#uuuwwv#,uuuwuw);uuuvxy.uuuvuw INCR1.uuwwxz:forget(uuuvxz);uuuvxz:=nilspace;uuuvxv:=uuuvxz;uuuvxv.uuuvwy:=type(uuuvyu);uuuvxv.uuuvwx:=uuuwwv;uuuwww +:=0;#note("Erste Seite : "+text(uuuwwv));# FORuuuwvz FROM1 UPTOuuuuuv REPuuuvxv.uuuvxu[uuuwvz]:=0 PER.uuwvuv:uuuvxv.uuuvwv:=uuuwyv;#uuuzxx(uuuwyv+" wird archiviert !" +);#uuuvxv.uuuvww:=uuuwww;#note("Weggeschr. Seiten : "+text(uuuwww));noteline#.uuwvvx:uuwxwy;uuwxwz;#uuwuxz#.uuwxwz:uuwxxw; LEAVEuuwuuv.uuwxwy:uuwvuv;uuwwwx;uuuwux + INCR1;uuuvxy.uuuvuy:=uuuwux;uuvxuw.uuwuxz:uuuzxw( FALSE); IFuuwuuw THENuuwxzx FI;uuuvxy.uuuvuz:=uuuwux;uuuvxy.uuuvux:=uuuwux-1;uuuvxy.uuuvuy:=0;uuuwwu:=archiveblocks +-1;uuwwxz;.uuwxzx: IFuuuvxy.uuuvuz<=0 THENuuuwux:=1 ELSEuuuwux:=uuuvxy.uuuvuz FI. ENDPROCuuwuuv; PROCuuwywy( INT CONSTuuwywz): IFuuwywz=1 THENuuwyxv ELSEuuwyxw FI +.uuwyxv:uuuwxx:=uuuvyw;uuuwyv:=uuuwxx.name;uuwyyw.uuwyxw:forget(uuuwyv,quiet);forget(uuuvyu);uuuvyu:=uuuvyw;uuwyzw. ENDPROCuuwywy; PROCuuwyzy: INT VARuuwyzz,uuwzuu +; SELECTuuuwwx OF CASEuuuuxz:uuwzux CASEuuuuyu:uuwzuz CASEuuuuyv:uuwzvv ENDSELECT.#uuwuuw:uuuwwx=uuuuxz.#uuwzux:uuuwwy:=archiveblocks-1;uuuvzx:=1;uuuvzy:=-1;uuuvzz +:=0;forget(uuuvyx);uuuvyx:=nilspace;uuuvwu:=uuuvyx;uuuwuu:=0;uuvyxx;uuvyyw;uuwuyw.uuwzuz:uuuwwy:=archiveblocks-1;uuwuyw.uuwuyw:uuuzxw( TRUE);uuwzyz; REP REPuuvuxv +;uuwzzv; FORuuuwvz FROM1 UPTOuuuwuz REPuuwzzy PER;uuuwuw:=uuuwuv;uuuwuv:=uuuwuw+1 UNTILuuxuux PER; UNTILuuxuuy PER;uuxuuz;uuxuvu;uuwvuz.uuxuvu:uuuvwu.uuuvvu:=uuuvzz +;forget(uuuvyw);uuuvyw:=uuuvyx;forget(uuuvyx).uuwzvv:uuuvxx:=uuuvyw;uuuwuy:=uuuvxx;forget(uuuvyw);uuuvyw:=uuuvvy[uuuwuy];forget(uuuvvy[uuuwuy]);uuwvuz.uuxuuy: IF NOT +uuvzww THENuuwxwz; FALSE ELSE TRUE FI.uuwxwz:uuwxxw; LEAVEuuwyzy.uuxuux:uuuwuv>=uuuvxy.uuuvuw.uuwzzy:uuuxxv(uuuvvy[uuuwuu],uuxvvu,uuuwuv);uuuwuv INCR1.uuxvvu: REP + FORuuwyzz FROMuuuvzy+1 UPTO15 REP IFbit(uuuvxv.uuuvxu[uuuvzx],uuwyzz) THENuuuvzy:=uuwyzz;#;note("gelesene Seite : "+text(uuxvxu)+"Bit : "+text(uuwyzz));note(" akt. Zeichen : " ++text(uuuvzx));noteline;note(" akt. Bit : "+text(uuuvzy));noteline;# LEAVEuuxvvu WITHuuxvxu FI PER;uuuvzy:=-1;uuuvzx INCR1 UNTILuuuvzx>=uuuuuv PER;-1.uuxvxu +:((uuuvzx-1)*16+uuuvzy)+(uuuwvu-1).uuvuxv:uuvwuy;uuxvzy;uuuvwu.uuuvvw[uuuwuu]:=uuuvxv.uuuvwv;uuuzxx(""""+uuuvxv.uuuvwv+""" wird gelesen!").uuwzzv:type(uuuvvy[uuuwuu +],uuuvxv.uuuvwy);uuuvzx:=1;uuuvzy:=-1.uuxvzy: FORuuwzuu FROM1 UPTOuuuvzz REP IFuuuvxv.uuuvwv=uuuvwu.uuuvvw[uuwzuu] THENuuuwuu:=uuwzuu; LEAVEuuxvzy FI PER;uuuvzz INCR +1;uuuvvy[uuuvzz]:=nilspace;uuuwuu:=uuuvzz.uuwzyz:uuvyzu(uuuvxy.uuuvuz); IFuuuvxy.uuuvux>0 THENuuvyyu(uuuvxy.uuuvux) FI; IFuuuvxy.uuuvuy>0 THENuuvyyu(uuuvxy.uuuvuy +) FI. ENDPROCuuwyzy; PROCuuwyzw:send(uuuwwz,uuuuvw,uuuvyw);forget(uuuvyw) ENDPROCuuwyzw; PROCuuwyyw:send(uuuwwz,uuuuvz,uuuvyw);forget(uuuvyw) ENDPROCuuwyyw; PROCuuwvuz +:forget(uuuvyv);forget(uuuvxz);send(uuuwwz,uuuuxx,uuuvyw);forget(uuuvyw) ENDPROCuuwvuz; PROCuuwxxw:send(uuuwwz,uuuuxv,uuuvyw);forget(uuuvyw) ENDPROCuuwxxw; PROCuuuzxx +( TEXT CONSTuuxyuu): DATASPACE VARuuxyuv:=nilspace;uuuvxw:=uuxyuv;uuuvxw:=uuxyuu;send(uuuwwz,uuuuxw,uuxyuv);forget(uuxyuv);pause(5) ENDPROCuuuzxx; PROCuuxyvz: IFchannel +(myself)<>archivechannel THENarchive("");release(archive);continue(archivechannel) FI ENDPROCuuxyvz; PROCisparchivemanager:globalmanager( PROC( DATASPACE VAR, INT + CONST, INT CONST, TASK CONST)isparchivemanager) ENDPROCisparchivemanager; PROCisparchivemanager( DATASPACE VARuuxyxv, INT CONSTuuxyxw,uuxyxx, TASK CONSTuuxyxy): IF +uuxyxw>=uuuuvu THENforget(uuxyxv);uuxyyw(uuxyxw) ELSEclearerror;enablestop;uuxyyy;forget(uuuvyy);forget(uuuvyw);uuuvyw:=uuxyxv;forget(uuxyxv);uuuwwx:=uuxyxw;uuuwwz +:=uuxyxy; SELECTuuuwwx OF CASEuuuuwu:uuvxuy;uuwvuz CASEuuuuyz:uuuvxw:=uuuvyw;uuvwxx(uuuvxw);uuwvuz CASEuuuuzu:uuuzwx;uuwvuz CASEuuuuwv:uuvuuv;uuwvuz CASEuuuuvv:uuwywy +(uuxyxx) CASEuuuuwz,uuuuxu:uuwuuv CASEuuuuxz,uuuuyu,uuuuyv:uuwyzy CASEuuuuxy:uuxzyz;uuxzzu;uuwvuz CASEuuuuyw:uuuvvz( FALSE);forget(uuuvyw);break(quiet) CASEuuuuyx +:uuuvvz( FALSE);uuxyvz;uuuwxu:=uuuwwz;uuwvuz CASEuuuuyy:uuuvvz( FALSE);uuuwxu:=niltask;break(quiet);uuwvuz OTHERWISE:errorstop("Falscher Auftrag!") ENDSELECT;uuuwyw +:=clock(1) FI.uuxzzu:break(quiet);archive(uuyuvz);commanddialogue( FALSE);disablestop; SELECTuuyuwu OF CASE0:format(archive) CASE1:format(uuyuwu,archive) CASE2:format +(uuyuwu,archive) CASE3:format(uuyuwu,archive) OTHERWISE:errorstop("Falscher Formatcode: "+text(uuyuwu)) ENDSELECT;uuuwvx:=iserror;clearerror;commanddialogue( TRUE +);release(archive);uuxyvz; IFuuuwvx THENerrorstop(errormessage) FI;enablestop;uuvwxx(uuyuvz).uuyuvz:subtext(uuuvxw,2,length(uuuvxw)).uuyuwu:code(uuuvxw SUB1).uuxzyz +:uuuvxw:=uuuvyw.uuxyyy:uuyuzv;uuyuzw;uuuwyw:=clock(1).uuyuzw: IF NOT(uuuwxu=uuxyxy) CANDuuxyxw<>uuuuyx CANDuuxyxw<>uuuuyy CANDuuxyxw<>uuuuyw THENerrorstop("Archive nicht angemeldet" +) FI.uuyuzv: IF NOTuuyvvw THENerrorstop("EUMELbase-Archive wird von Task "+name(uuuwxu)+" benutzt") FI.uuyvvw:uuxyxy=uuuwxu ORuuuwxu=niltask OR NOTexists(uuuwxu) OR +uuyvwx.uuyvwx:abs(uuuwyw-clock(1))>600.0. ENDPROCisparchivemanager; PROCuuxyyw( INT CONSTuuuwwx): TEXT VARuuyvxx:="";enablestop;break(quiet);continue(uuuwwx-uuuuvu +);disablestop; REPcommanddialogue( TRUE);getcommand("Gib ISP-ARCHIVE-Kommando:",uuyvxx);do(uuyvxx) UNTIL NOTonline PER;commanddialogue( FALSE);break(quiet);setautonom + END PROCuuxyyw; PROCuuyvyx( TEXT CONSTtext):break(quiet);continue(1);out(text);continue(archivechannel) ENDPROCuuyvyx; PROCuuxuuz:forget(uuuvyw);uuuvyw:=nilspace + ENDPROCuuxuuz; ENDPACKETisparchivemanager; + diff --git a/app/eumelbase/2.2.1-schulis/src/isp archive.sc b/app/eumelbase/2.2.1-schulis/src/isp archive.sc new file mode 100644 index 0000000..f608a95 --- /dev/null +++ b/app/eumelbase/2.2.1-schulis/src/isp archive.sc @@ -0,0 +1,35 @@ + PACKETisparchive DEFINESarchivefiles,archivesize,savetoarchive,fetchfromarchive,initarchive,cleararchive,cleararchivetask,checkarchive,listarchive,formatarchive, +channelfree,logonarchive,logoffarchive,cleareacharchive,writefactor,readafterwrite,kf: LETuuuuuv=1,uuuuuw=2,uuuuux=34,uuuuuy=35,uuuuuz=25,uuuuvu=26,uuuuvv=36,uuuuvw +=37,uuuuvx=39,uuuuvy=40,uuuuvz=41,uuuuwu=42,uuuuwv=43,uuuuww=44,uuuuwx=45,uuuuwy=46,uuuuwz=47,uuuuxu=48,uuuuxv=200,uuuuxw="�",fehlertext="ARCHIVE-Fehler: "; LET ARCHIVECONTROL += STRUCT( INTuuuuxx, BOOLuuuuxy); BOUND ARCHIVECONTROL VARuuuuxz; INT VARuuuuyu,uuuuyv,uuuuyw,uuuuyx:=1; THESAURUS VARuuuuyy; TEXT VARuuuuyz:=""; BOOL VARuuuuzu:= + FALSE,uuuuzv:= FALSE,uuuuzw:= FALSE; BOUND STRUCT( INTuuuuzx, ROWuuuuxv TEXTuuuuzz) VARuuuvuu; DATASPACE VARuuuvuv; PROCkf( BOOL CONSTuuuvux):uuuuzw:=uuuvux ENDPROC +kf; PROCreadafterwrite( BOOL CONSTuuuuxy):uuuuzv:=uuuuxy ENDPROCreadafterwrite; BOOL PROCreadafterwrite:uuuuzv ENDPROCreadafterwrite; PROCwritefactor( INT CONSTuuuuxy +):uuuuyx:=uuuuxy ENDPROCwritefactor; INT PROCwritefactor:uuuuyx ENDPROCwritefactor; BOOL PROCcleareacharchive:uuuuzu ENDPROCcleareacharchive; PROCcleareacharchive +( BOOL CONSTuuuvyx):uuuuzu:=uuuvyx ENDPROCcleareacharchive; PROCcleararchivetask:logoffarchive;logonarchive ENDPROCcleararchivetask; THESAURUS PROCarchivefiles:uuuuyy + ENDPROCarchivefiles; INT PROCarchivesize:archivesize( SOMEmyself) ENDPROCarchivesize; INT PROCarchivesize( THESAURUS CONSTuuuwvu):uuuuyy:=uuuwvu;uuuuyu:=0;uuuuyv +:=1;uuuuyw:=0;get(uuuuyy,uuuuyz,uuuuyu); WHILEuuuuyu>0 REPuuuuyw INCRstorage(old(uuuuyz));uuuuyv INCR1;get(uuuuyy,uuuuyz,uuuuyu) PER;uuuuyw ENDPROCarchivesize; TASK + PROCuuuwyu:/"isp.archive" ENDPROCuuuwyu; BOUND TEXT VARuuuwyw; BOUND INT VARuuuwyx; DATASPACE VARuuuwyy; INT VARuuuwyz; TASK VARuuuwzu:=niltask; PROCformatarchive +( TEXT CONSTuuuwzw):formatarchive(0,uuuwzw) ENDPROCformatarchive; PROCformatarchive( INT CONSTuuuxuv, TEXT CONSTuuuwzw): IFpos("0123",text(uuuxuv))>0 THENuuuxuy(uuuuvy +,code(uuuxuv)+uuuwzw, TRUE) FI ENDPROCformatarchive; PROCsavetoarchive( THESAURUS CONSTuuuwvu): IFuuuuzu THENcleararchive; FI;do( PROC( TEXT CONST)uuuxwv,uuuwvu); + ENDPROCsavetoarchive; PROCfetchfromarchive:uuuxwz;uuuxxu;uuuxxv.uuuxwz:uuuxxx;call(uuuwyu,uuuuvz,uuuwyy,uuuwyz).uuuxxu: INT VARuuuxyx:=uuuuvz; WHILEuuuwyz<>uuuuvx + REPuuuxzv; IFuuuwyz=uuuuvw THENuuuxzy ELSEuuuxxx;call(uuuwyu,uuuxyx,uuuwyy,uuuwyz) FI PER.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop( +fehlertext+uuuwyw) CASEuuuuvw: IFcommanddialogue THENuuuyvz;uuuwyw:=uuuwyy;out(uuuwyw) FI CASEuuuuvv:uuuyvz; IFuuuywz THENerrorstop("Archivieren inkonsistent abgebrochen" +) FI;uuuxyx:=uuuuwu ENDSELECT.uuuxxv: INT VARuuuyxx;forget(uuuvuv);uuuvuv:=uuuwyy;uuuvuu:=uuuvuv; FORuuuyxx FROM1 UPTOuuuvuu.uuuuzx REP#out("<"+uuuvuu.uuuuzz[uuuyxx +]+">");uuuyvz;#uuuyzy PER;forget(uuuvuv).uuuyzy:uuuxxx;uuuwyx:=uuuwyy;uuuwyx:=uuuyxx;call(uuuwyu,uuuuwv,uuuwyy,uuuwyz);forget(uuuvuu.uuuuzz[uuuyxx],quiet);copy(uuuwyy +,uuuvuu.uuuuzz[uuuyxx]). ENDPROCfetchfromarchive; BOOL PROCuuuywz: REPuuuyvz; IFonline THENout(2*uuuuxw) FI; IFyes("Nachfolgende Archive-Diskette eingelegt") THEN + LEAVEuuuywz WITH FALSE FI UNTILuuuuzw COR( NOTuuuuzw CANDyes("Sicherung wirklich abbrechen")) PER; TRUE ENDPROCuuuywz; PROCuuuxwv( TEXT CONSTuuuzyw#, BOOL PROCuuuzyx +#):save(uuuzyw,uuuwyu); IFcommanddialogue THENuuuyvz;out(""""+uuuzyw+""" wird gesichert!");#uuuyvz# FI;uuuzzx;uuuzzy.uuuzzx:uuuxxx;uuuuxz:=uuuwyy;uuuuxz.uuuuxx:=uuuuyx +;uuuuxz.uuuuxy:=uuuuzv;call(uuuwyu,uuuuux,uuuwyy,uuuwyz);uuvuwv.uuvuwv: WHILEuuuwyz<>uuuuvv REPuuuxzv;uuuxzy PER.uuuzzy: REP IFuuuwyz=uuuuvv THENuuuyvz; IFuuuywz THEN +errorstop("Sichern eventuell inkonsistent abgebrochen!"); LEAVEuuuxwv ELSE IFuuuuzu THENcleararchive; FI;out(""""+uuuzyw+""" wird gesichert!"); FI ELSEuuuxzv FI;uuuxxx +; IF NOTuuvuzu THENcall(uuuwyu,uuuuuy,uuuwyy,uuuwyz) ELSEuuuxzy FI; PER.uuvuzu:uuuwyz=uuuuvw.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop +(fehlertext+uuuwyw) CASEuuuuvx: LEAVEuuuxwv CASEuuuuvw: IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz;out(uuuwyw); FI ENDSELECT. ENDPROCuuuxwv; PROCinitarchive( TEXT + CONSTuuvvxu):uuuxuy(uuuuwz,uuvvxu, TRUE) ENDPROCinitarchive; PROCcheckarchive:uuuxuy(uuuuxu) ENDPROCcheckarchive; PROCcleararchive:uuuxuy(uuuuuz) ENDPROCcleararchive +; PROClistarchive:uuuxuy(uuuuvu);forget("ISP-Archive",quiet);type(uuuwyy,1003);copy(uuuwyy,"ISP-Archive");show("ISP-Archive");forget("ISP-Archive",quiet) ENDPROClistarchive +; PROClogonarchive:uuuxuy(uuuuwx,"", FALSE) ENDPROClogonarchive; PROClogoffarchive:uuuxuy(uuuuwy,"", FALSE) ENDPROClogoffarchive; PROCuuuxuy( INT CONSTuuvwvy):uuuxuy +(uuvwvy,"", FALSE) ENDPROCuuuxuy; PROCuuuxuy( INT CONSTuuvwvy, TEXT CONSTuuvwwy, BOOL CONSTuuvwwz):uuvwxu; WHILEuuvwxv REPuuvwxw;uuuxzy PER.uuvwxv:uuuwyz<>uuuuvx. +uuvwxu:uuuxxx; IFuuvwwz THENuuuwyw:=uuuwyy;uuuwyw:=uuvwwy FI;call(uuuwyu,uuvwvy,uuuwyy,uuuwyz).uuvwxw: IFuuuwyz=uuuuvw THEN IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz +;out(uuuwyw) FI ELIFuuuwyz=uuuuuw THENuuuwyw:=uuuwyy;enablestop;errorstop(fehlertext+uuuwyw) FI. ENDPROCuuuxuy; PROCuuuxzy: REPforget(uuuwyy);wait(uuuwyy,uuuwyz,uuuwzu +); IF NOT(uuuwzu=uuuwyu) THEN#note("IN WARTE: "+text(uuuwyz)+"/"+name(uuuwzu));noteline;#uuvxxy FI UNTILuuuwzu=uuuwyu PER ENDPROCuuuxzy; PROCuuvxxy:send(uuuwzu,uuuuuv +,uuuwyy) ENDPROCuuvxxy; PROCchannelfree: DATASPACE VARuuvxzw:=nilspace;send(uuuwyu,uuuuww,uuvxzw);forget(uuvxzw) ENDPROCchannelfree; PROCuuuxxx:forget(uuuwyy);uuuwyy +:=nilspace ENDPROCuuuxxx; PROCuuuyvz: IFonline THENline; FI ENDPROCuuuyvz; ENDPACKETisparchive; + diff --git a/app/flint/0.4/doc/Zusammenstellung b/app/flint/0.4/doc/Zusammenstellung new file mode 100644 index 0000000..cad83c0 --- /dev/null +++ b/app/flint/0.4/doc/Zusammenstellung @@ -0,0 +1,62 @@ +Task "MENUE" unter "UR" +----------------------- + +"menues.1" = "eudas.satzzugriffe" + "eudas.fenster" + "eudas.menues" +"offline.1" = "offline.manager" +IF ibm grafik THEN run ("boxzeichen") END IF +global manager + + +Task "OPMENUE" unter "SYSUR" +---------------------------- + +"menues.1" +"offline.1" +"operator.1" = "operator.spoolcmd" + "operator.manager" + "operator" +menuedaten einlesen ("operator.init") +IF ibm grafik THEN run ("boxzeichen") END IF +global manager + + +Task "OP" unter "OPMENUE" +------------------------- + + +Task "EUDAS" unter "MENUE" (oder auch in "FLINT") +------------------------------------------------- + +"eudas.1" = "eudas.dateistruktur" + "eudas.datenverwaltung" +"eudas.2" = "eudas.verarbeitung" + "eudas.drucken" +"eudas.3" = "eudas.satzanzeige" + "eudas.uebersicht" +"eudas.4" = "eudas.dialoghilfen" + "eudas.steuerung" +menuedaten einlesen ("eudas.init") +global manager + + +Task "FLINT" unter "EUDAS" +-------------------------- + +"flint.1" = "klartextbelegung" + "editormenue" + "eudas.manager" + "flint.manager" + "flint" +menuedaten einlesen ("flint.init") +global manager + + + +Hinweise für L3: + +- Vor "menues.1" muß jeweils "isub.replace" insertiert werden. +- In "offline.1" ist das Vorkommen von "PROCA" zu entfernen. +- Vor "operator.1" muß eine Dummy-Prozedur 'configurate' insertiert werden. + diff --git a/app/flint/0.4/doc/flint.kurzanleitung b/app/flint/0.4/doc/flint.kurzanleitung new file mode 100644 index 0000000..25608c3 --- /dev/null +++ b/app/flint/0.4/doc/flint.kurzanleitung @@ -0,0 +1,141 @@ +Hinweise zur FLINT-Testversion 0.4 +---------------------------------- + +1. Installation + +Die Installation läuft in folgenden Schritten ab: + +- Task "OPMENUE" als Sohn von "SYSUR" einrichten. + Dort "OPMENUE.gen" vom Archiv holen und starten. + Warten bis zur Tapete. + +- Task "MENUE" als Sohn von "UR" einrichten. + Dort "MENUE.gen" vom Archiv holen und starten. + Warten bis zur Tapete. + + +2. Kurzanleitung + +Arbeitstasks unter "FLINT" einrichten. Beim Einrichten vom Supervisor aus +koppelt sich die neue Task sofort ab und muß mit 'continue' wieder ange­ +koppelt werden. Es erscheint das FLINT-Hauptmenue. + +Zur Bedienung der Menüs s. EUDAS-Handbuch. Hilfestellungen zu jeder +Funktion mit ESC '?'. + +Die Punkte im ersten Menü führen jeweils in Unterapplikationen. Der Punkt +'Systemsteuerung' koppelt automatisch die Task "OP" an und zeigt dort das +Operatormenü. Bei ESC 'q' erfolgt Rückkehr in die eigene Task. + +Wechsel in eine andere Task (mit Einrichten bei Bedarf) geschieht mit dem +Menüpunkt 'Wechsel' im dritten Menü. Dies funktioniert aber nur mit Nach­ +fahren von FLINT. Falls niltext als Name angegeben wird, kann man die Task +abkoppeln. + +Im Operatormenü führt 'Beenden' zu einem Shutup mit anschließender Rückkehr +in die aufrufende Task. Einige Funktionen sind derzeit noch nicht implemen­ +tiert. + + +3. Textverarbeitung + +Unter dem Hauptmenüpunkt 'Textverarbeitung' wird ein Menü aufgerufen, das +die Kommandos der EUMEL-Textverarbeitung als Menüpunkte aufführt. Welche +Kommandos jeweils gemeint sind, ist durch ESC '?' zu erfragen bzw. auszu­ +probieren (eine genauere Beschreibung liegt aus Zeitmangel noch nicht vor). + + +4. Menüs im Editor + +Zur Unterstützung der Arbeit im Editor kann man auch dort Menüs aufrufen, +und zwar über ESC 'm' (Edit-Menü) und ESC 't' (Text-Menü). Bei den Menüs +handelt es sich um Zeilenmenüs, die am unteren Bildrand autauchen, um die +Sicht auf die Datei möglichst wenig einzuengen. Eine Funktion kann mit den +Cursortasten ausgewählt und mit Leertaste (oder RETURN) ausgeführt werden. +Alternativ Aufruf über Anfangsbuchstaben. Das Menü kann mit ESC 'q' ohne +Wirkung verlassen werden. + + +5. Edit-Menü + +Hier stehen Funktionen zur Verfügung, die normalerweise nach ESC ESC als +Kommandos formuliert werden. Die Funktionen zum Suchen und Ersetzen werden +nach Ausführung auf 'f' gelegt, so daß sie mit ESC 'f' wiederholt werden +können. + +Als Zusatz steht eine Funktion zur Verfügung, mit der Lernsequenzen im +Klartext editiert werden können. Die Funktionstasten werden dabei durch +Namen in spitzen Klammern geschrieben (erlaubt sind u.a. + ). +Leerzeichen werden beachtet, aber Zeilenübergänge ignoriert. + +Ebenfalls neu sind Funktionen zum Markieren von Wörten und Sätzen (von Wort +bis Satzende), die für die folgende Einstellung von Modifikationen verwen­ +det werden können. + +'Kopiere' ruft entweder PUT oder GET auf, je nachdem, ob ein Block markiert +ist oder nicht. Die Funktion kann mit ESC 'h' abgebrochen werden. + +Mit 'Fenster' kann ein zweites Editorfenster in der unteren Hälfte eröffnet +werden (geplant ist später, daß die Unterteilung des Schirms sowohl hori­ +zontal als auch vertikal erfolgen kann). + + +6. Text-Menü + +Dieses Menü hilft bei der Formulierung von Textkosmetik-Anweisungen. Die +entsprechenden Anweisungen werden an der Cursorposition oder, falls notwen­ +dig, am Zeilenanfang eingefügt. + +Die Funktion zum Einstellen von Modifikationen hat zwei verschiedene Mög­ +lichkeiten: Falls kein Text markiert ist, werden die angekreuzten Modifi­ +kationen ein- oder ausgeschaltet (je nachdem, ob "Aus" angekreuzt ist). +Falls ein Text markiert ist, werden alle Modifikationsanweisungen am Anfang +und Ende des Bereichs entfernt und die angekreuzten Modifikationen für +diesen Bereich eingestellt, wenn nicht "Aus" angekreuzt ist. + +Die globalen Einstellungen für eine Datei werden an den Anfang geschrieben, +wobei die vorherigen Einstellungen ggf. entfernt werden können. + +Der markierte Ausschnitt einer Datei kann mit 'lineform' bearbeitet und +auch mit vorheriger Formatierung gedruckt werden. + + +7. Literatur + +Kann als Zusatzmodul insertiert werden. Dazu "litmenue" insertieren und +anschließend 'menuedaten einlesen ("litmenue.init")' aufrufen. Das Menü +steht dann durch Aufruf von 'literatur' im Editor zur Verfügung (kann und +sollte auf eine Funktionstaste gelegt werden). + +Die zu verwendenden Literaturdateien müssen vorher in EUDAS eingerichtet und +gewartet werden. Einzige Bedingung zur Verwendung ist, daß das erste Feld +als Signatur für einen bestimmten Titel verwendet werden kann. Der Inhalt +dieses Feldes sollte zur Zeit aus technischen Gründen keine +Suchmuster-Steuerzeichen (,;*--++..) enthalten. Diese Einschränkung wird +später aufgehoben. + +Die Funktion 'Literatur' dient dazu, eine bestimmte EUDAS-Datei als +Literaturdatei einzustellen. Geänderte EUDAS-Dateien beliebiger Art müssen +vor Aufruf des Literaturmenüs gesichert werden! + +Durch 'Zeigen' wird in der unteren Bildschirmhälfte eine Übersicht +angeboten, in der geblättert werden kann. Durch 'Direkt' kann ein bestimmter +Satz nach Signatur angesteuert werden. + +Die Funktion 'Referenzen' dient dazu, die in der editierten Datei +vorkommenden Literaturreferenzen in der Literaturdatei zu markieren. Dazu +müssen die Referenzen als Macro \#lit ("Signatur")\# in der Datei angegeben +werden. Als Option beim Sammeln der Referenzen können diese durch ein +anderes Macro und den Inhalt eines beliebigen Feldes der EUDAS-Datei ersetzt +werden. Diese beiden Angaben werden erfragt. Referenzen, die in der +Literaturdatei nicht vorkommen, werden als Dummy-Einträge an das Ende der +Literaturdatei geschrieben, so daß sie später in EUDAS ausgefüllt werden +können. + +Mit der Funktion 'Verzeichnis' können dann die markierten Sätze +(zwischendurch keine neue Datei öffnen!) als Literaturverzeichnis an das +Ende der Datei gebracht werden. Dazu muß ein vorher erstelltes Druckmuster +angegeben werden, das die Form der Literatureinträge angibt. + + diff --git a/app/flint/0.4/source-disk b/app/flint/0.4/source-disk new file mode 100644 index 0000000..3c86110 --- /dev/null +++ b/app/flint/0.4/source-disk @@ -0,0 +1 @@ +eudas/flint-0.4.img diff --git a/app/flint/0.4/src/MENUE.gen b/app/flint/0.4/src/MENUE.gen new file mode 100644 index 0000000..327438c --- /dev/null +++ b/app/flint/0.4/src/MENUE.gen @@ -0,0 +1,93 @@ +page; +putline ("Generierung MENUE 0.5"); +BOOL CONST box := yes ("Mit IBM Grafikzeichen"); +BOOL CONST l3 := maxint DIV 2 > 17000; +TASK VAR dummy, ar; +IF l3 THEN ar := /"EUMEL" ELSE ar := archive END IF; +INT VAR kanal := channel; +fetch ("eudas.satzzugriffe", ar); +fetch ("eudas.fenster", ar); +fetch ("eudas.menues", ar); +fetch ("offline.1", ar); +fetch ("eudas.1", ar); +fetch ("eudas.2", ar); +fetch ("eudas.3", ar); +fetch ("eudas.dialoghilfen", ar); +fetch ("flint.init", ar); +IF yes ("Ggf zweites Archiv eingelegt") THEN END IF; +fetch ("eudas.steuerung", ar); +fetch ("eudas.init", ar); +fetch ("klartextbelegung", ar); +fetch ("editormenue", ar); +fetch ("eudas.manager", ar); +fetch ("flint.manager", ar); +fetch ("flint", ar); +IF l3 THEN fetch ("isub.replace", ar) END IF; +IF box THEN fetch ("boxzeichen", ar) END IF; +release (ar); +check off; +IF l3 THEN do (PROC (TEXT CONST) reorganize, all) END IF; +IF l3 THEN insert ("isub.replace"); forget ("isub.replace", quiet) END IF; +insert ("eudas.satzzugriffe"); forget ("eudas.satzzugriffe", quiet); +insert ("eudas.fenster"); forget ("eudas.fenster", quiet); +insert ("eudas.menues"); forget ("eudas.menues", quiet); +IF l3 THEN + TEXT VAR zeile; FILE VAR f; + f := sequential file (modify, "offline.1"); + to line (f, 1); + read record (f, zeile); + INT CONST pp := pos (zeile, ",PROCA"); + change (zeile, pp, pp + 7, ""); + write record (f, zeile) +END IF; +insert ("offline.1"); forget ("offline.1", quiet); +IF box THEN run ("boxzeichen"); forget ("boxzeichen", quiet) END IF; +do ("ausfuehrtaste (""""13"""")"); +begin ("FLINT", PROC flint init, dummy); +do ("global manager"); + +PROC flint init : + + disable stop; + fetch ("eudas.init"); + fetch ("flint.init"); + continue (kanal); + command dialogue (FALSE); + page; + i ("eudas.1"); + i ("eudas.2"); + i ("eudas.3"); + i ("eudas.dialoghilfen"); + i ("eudas.steuerung"); + i ("klartextbelegung"); + i ("editormenue"); + i ("eudas.manager"); + i ("flint.manager"); + i ("flint"); + do ("menue loeschen (FALSE)"); + do ("menuedaten einlesen (""eudas.init"")"); + forget ("eudas.init", quiet); + erase ("eudas.init"); + do ("menuedaten einlesen (""flint.init"")"); + forget ("flint.init", quiet); + erase ("flint.init"); + erase ("MENUE.gen"); + command dialogue (TRUE); + check on; + do ("begin (""OP"", ""OPMENUE"")"); + do ("global manager") + +END PROC flint init; + +PROC i (TEXT CONST name) : + + fetch (name); + insert (name); + IF is error THEN + put error; clear error; pause (1000); do ("global manager") + END IF; + forget (name); + erase (name) + +END PROC i; + diff --git a/app/flint/0.4/src/OPMENUE.gen b/app/flint/0.4/src/OPMENUE.gen new file mode 100644 index 0000000..28304a6 --- /dev/null +++ b/app/flint/0.4/src/OPMENUE.gen @@ -0,0 +1,42 @@ +page; +putline ("Generierung OPMENUE 0.5"); +BOOL CONST box := yes ("Mit IBM-Grafikzeichen"); +BOOL CONST l3 := maxint DIV 2 > 17000; +TASK VAR ar; +IF l3 THEN ar := /"EUMEL" ELSE ar := archive END IF; +IF l3 THEN fetch ("isub.replace", ar) END IF; +fetch ("eudas.satzzugriffe", ar); +fetch ("eudas.fenster", ar); +fetch ("eudas.menues", ar); +fetch ("offline.1", ar); +IF l3 THEN fetch ("dummy.configurate", ar) END IF; +fetch ("operator.1", ar); +fetch ("operator.init", ar); +IF box THEN fetch ("boxzeichen", ar) END IF; +release (ar); +IF l3 THEN do (PROC (TEXT CONST) reorganize, all) END IF; +IF l3 THEN insert ("isub.replace"); forget ("isub.replace", quiet) END IF; +insert ("eudas.satzzugriffe"); forget ("eudas.satzzugriffe", quiet); +insert ("eudas.fenster"); forget ("eudas.fenster", quiet); +insert ("eudas.menues"); forget ("eudas.menues", quiet); +do ("ausfuehrtaste (""""13"""")"); +IF l3 THEN + TEXT VAR zeile; FILE VAR f; + f := sequential file (modify, "offline.1"); + to line (f, 1); + read record (f, zeile); + INT CONST pp := pos (zeile, ",PROCA"); + change (zeile, pp, pp + 7, ""); + write record (f, zeile) +END IF; +insert ("offline.1"); forget ("offline.1", quiet); +IF l3 THEN + insert ("dummy.configurate"); forget ("dummy.configurate", quiet) +END IF; +insert ("operator.1"); forget ("operator.1", quiet); +do ("menuedaten einlesen (""operator.init"")"); +forget ("operator.init", quiet); +IF box THEN run ("boxzeichen"); forget ("boxzeichen", quiet) END IF; +forget ("OPMENUE.gen", quiet); +do ("global manager"); + diff --git a/app/flint/0.4/src/boxzeichen b/app/flint/0.4/src/boxzeichen new file mode 100644 index 0000000..12c3bb8 --- /dev/null +++ b/app/flint/0.4/src/boxzeichen @@ -0,0 +1,3 @@ +box zeichen (""205""186""201""187""200""188""199""182""196"", + ""15""14"", ""178" ") + diff --git a/app/flint/0.4/src/dummy.configurate b/app/flint/0.4/src/dummy.configurate new file mode 100644 index 0000000..2834684 --- /dev/null +++ b/app/flint/0.4/src/dummy.configurate @@ -0,0 +1,6 @@ +PACKET dummy configurate DEFINES configurate : +PROC configurate : + errorstop ("Für L3 nicht implementiert") +END PROC configurate; +END PACKET dummy configurate; + diff --git a/app/flint/0.4/src/editormenue b/app/flint/0.4/src/editormenue new file mode 100644 index 0000000..5ab94f1 --- /dev/null +++ b/app/flint/0.4/src/editormenue @@ -0,0 +1,1008 @@ +PACKET edit menue (* Autor: Thomas Berlage *) + (* Stand: 16.10.88 *) + DEFINES + + edit, + edit status anzeigen, + zeilenmenue anbieten, + editfile setzen, + edit menue, + element markieren, + text menue, + ausschnitt drucken, + gewaehlte schriftarten einstellen : + + +(************************* Zeilenmenue *************************************) + +LET + menue status = +"MENUE: Wählen: <-,-> Ausführen: LEER,RET Abbruch: ESC h Hilfe: ESC ?"; + + +PROC zeilenmenue anbieten (TEXT CONST menuename, + PROC (INT CONST) kommandos) : + + bild vorbereiten; + zeilenmenue anbieten (menuename, TRUE, PROC (INT CONST) kommandos); + bild nachbereiten . + +bild vorbereiten : + INT VAR x, y; + get cursor (x, y); + cursor (1, y size); out (""5""); + status anzeigen (menue status); + cursor (x, y); + IF aktueller editor > 0 THEN + get editcursor (x, y); + y := line no (editfile) + y size - y; + abschnitt neu (y - 1, y) + END IF . + +bild nachbereiten : + IF aktueller editor > 0 THEN + IF mark (editfile) THEN + bild neu + ELSE + abschnitt neu (y - 1, y) + END IF + END IF; + cursor (1, y size - 1); out (""4"") . + +END PROC zeilenmenue anbieten; + +PROC eget (TEXT CONST prompt, TEXT VAR inhalt) : + + editget (prompt, inhalt, "", "GET/Allgemein") + +END PROC eget; + +BOOL PROC eja (TEXT CONST frage) : + + ja (frage, "JA/Allgemein", TRUE) + +END PROC eja; + + +(* EDIT MENUE *) + +TEXT VAR + param, + fensterdatei := ""; + +FENSTER VAR zweitfenster; +fenster initialisieren (zweitfenster); + +PROC edit menue : + + zeilenmenue anbieten ("EDIT MENUE:", + PROC (INT CONST) edit menue kommandos) + +END PROC edit menue; + +PROC edit menue kommandos (INT CONST wahl) : + + SELECT wahl OF + CASE 1 : springen auf zeile + CASE 2 : suchen nach text + CASE 3 : suchen und ersetzen + CASE 4, 5 : markieren + CASE 6 : kopieren oder lesen + CASE 7 : fenster editieren + CASE 8 : limit einstellen + CASE 9 : tastenbelegung + END SELECT . + +springen auf zeile : + TEXT VAR z := ""; + eget ("Zeilennummer:", z); + IF z <> "" THEN + INT CONST auf zeile := int (z); + IF last conversion ok THEN + edit file setzen; T auf zeile + ELSE + errorstop ("Zeilennummer ist keine Zahl") + END IF + END IF . + +suchen nach text : + param := ""; + eget ("Text:", param); + IF param = "" THEN + ELIF eja ("Vorwärts") THEN + ek ("D" + textdarstellung (param)) + ELSE + ek ("U" + textdarstellung (param)) + END IF . + +suchen und ersetzen : + param := ""; + eget ("Suchtext:", param); + IF param <> "" THEN + z := ""; eget ("Ersetzen durch:", z); + IF z <> "" THEN + IF eja ("Nur einmal") THEN + ek (textdarstellung (param) + "C" + textdarstellung (z)) + ELSE + editfile setzen; + param CA z + END IF + END IF + END IF . + +markieren : + element markieren (wahl = 5) . + +kopieren oder lesen : + param := ""; + editfile setzen; + IF mark THEN + eget ("Zieldatei (RET = Speicher):", param); + PUT param + ELSE + eget ("Quelldatei (RET = Speicher):", param); + GET param + END IF . + +fenster editieren : + INT VAR xa, ya, xl, yl; + get window (xa, ya, xl, yl); + IF groesster editor >= 2 THEN + errorstop ("Nur zwei Fenster") + ELSE + fenstergroesse setzen (zweitfenster, + xa, ya + yl DIV 2, xl, yl - yl DIV 2); + eget ("Name der Datei:", fensterdatei); + IF NOT exists (fensterdatei) CAND + NOT eja ("""" + fensterdatei + """ neu einrichten") THEN + errorstop ("") + END IF; + FILE VAR eff := sequential file (modify, fensterdatei); + edit (eff, zweitfenster, "EDIT/Allgemein") + END IF . + +limit einstellen : + z := text (limit); + REP + eget ("Zeilenbreite bis Umbruch (limit) in Zeichen:", z); + INT CONST l := int (z); + UNTIL last conversion ok OR z = "" PER; + IF z <> "" THEN limit (l) END IF . + +tastenbelegung : + TEXT VAR taste; + status anzeigen (""); + cursor (1, 24); + put ("Gewünschte Taste drücken (ESC = Abbruch):"5""); + getchar (taste); + IF taste <> ""27"" THEN + put (""13"Sequenz ggf editieren, dann ESC q"5""); + lernsequenz editieren (taste) + END IF . + +END PROC edit menue kommandos; + +PROC ek (TEXT CONST kom) : + + kommando auf taste legen ("f", kom); + std kommando interpreter ("f") + +END PROC ek; + +PROC editfile setzen : + + kommando auf taste legen (""27"", ""); + std kommando interpreter (""27"") + +END PROC editfile setzen; + +DATASPACE VAR ds; + +PROC lernsequenz editieren (TEXT CONST taste) : + + disable stop; + ds := nilspace; + editieren (taste); + forget (ds) + +END PROC lernsequenz editieren; + +PROC element markieren (BOOL CONST bis satzende) : + + FILE VAR edfile := editfile; + INT VAR spalte := col (edfile); + IF NOT mark (edfile) THEN + zeile lesen; + cursor zuruecksetzen; + mark (edfile, line no (edfile), spalte) + ELSE + zeile lesen + END IF; + IF bis satzende THEN + position auf satzende + ELSE + position auf wortende + END IF . + +zeile lesen : + read record (edfile, param) . + +cursor zuruecksetzen : + WHILE spalte > 1 CAND (param SUB spalte - 1) <> " " REP + spalte DECR 1 + END REP . + +position auf satzende : + WHILE pos (param, ".", spalte) = 0 CAND kein absatz REP + down (edfile); + zeile lesen; + spalte := 1 + END REP; + spalte := pos (param, ".", spalte); + IF spalte = 0 THEN spalte := length (param) ELSE spalte INCR 1 END IF; + col (edfile, spalte) . + +kein absatz : + (spalte = LENGTH param OR (param SUB LENGTH param) <> " ") + AND NOT eof (edfile) . + +position auf wortende : + spalte DECR 1; + REP + spalte INCR 1; + spalte := pos (param, ""33"", ""255"", spalte); + IF spalte = 0 THEN + IF eof (edfile) THEN + spalte := length (param) + ELSE + down (edfile); + zeile lesen + END IF + END IF + UNTIL spalte > 0 END REP; + spalte := pos (param, " ", spalte); + IF spalte = 0 THEN spalte := length (param) END IF; + col (edfile, spalte) . + +END PROC element markieren; + +TEXT VAR sequenz, aenderung; + +PROC editieren (TEXT CONST taste) : + + enable stop; + FILE VAR f := sequential file (output, ds); + maxlinelength (f, 37); + sequenz := lernsequenz auf taste (taste); + klartext in file (f, sequenz); + alles neu; + abgrenzung zeichnen; + editstatus anzeigen; + edit (f, 42, 2, x size - 42, y size - 3); + klartext aus file (f, aenderung); + IF aenderung <> sequenz CAND wirklich aendern THEN + lernsequenz auf taste legen (taste, aenderung) + END IF . + +abgrenzung zeichnen : + cursor (40, 1); + y size - 3 TIMESOUT ""10""15""14""8""8"" . + +wirklich aendern : + eja ("Lernsequenz aendern") . + +END PROC editieren; + + +(* TEXT MENUE *) + +PROC text menue : + + zeilenmenue anbieten ("TEXT MENUE:", + PROC (INT CONST) text menue kommandos) + +END PROC text menue; + +FENSTER VAR fontfenster, modfenster; +fenster initialisieren (fontfenster); +fenster initialisieren (modfenster); +fenstergroesse setzen (fontfenster, 40, 2, 40, 21); +fenstergroesse setzen (modfenster, 55, 13, 25, 10); + +TEXT VAR + ezeile, + format macro := ""; + + +PROC text menue kommandos (INT CONST mwahl) : + + SELECT mwahl OF + CASE 1 : schrifttyp einstellen + CASE 2 : schriftart einstellen + CASE 3 : neue seite beginnen + CASE 4 : zwischenraum freilassen + CASE 5 : globaleinstellung + CASE 6 : zeilenweise formatieren + CASE 7 : ausschnitt drucken + END SELECT . + +schrifttyp einstellen : + TEXT VAR typname; + schrifttyp auswaehlen (typname); + IF typname <> "" THEN + textanweisung einfuegen ("type", schriftname, FALSE) + END IF . + +schriftname : + textdarstellung (typname) . + +schriftart einstellen : + schriftart auswaehlen; + gewaehlte schriftarten einstellen (gewaehlte modifikationen) . + +schriftart auswaehlen : + alles neu; + auswahl anbieten ("TEXT.Modwahl", modfenster, -10, "AUSWAHL/Allgemein", + PROC (TEXT VAR, INT CONST) modname) . + +neue seite beginnen : + param := ""; + eget ("Nummer der nächsten Seite (RET = +1):", param); + IF param = "" THEN + textanweisung einfuegen ("page", "", TRUE) + ELSE + INT CONST seitennr := int (param); + IF last conversion ok THEN + textanweisung einfuegen ("page", text (seitennr), TRUE) + ELSE + errorstop ("Seitennummer keine Zahl") + END IF + END IF . + +zwischenraum freilassen : + param := ""; + eget ("Zwischenraum in cm:", param); + IF param <> "" THEN + change all (param, ",", "."); + REAL CONST wert := real (param); + IF last conversion ok THEN + textanweisung einfuegen ("free", text (wert), TRUE) + ELSE + errorstop ("kein Zahlenwert") + END IF + END IF . + +zeilenweise formatieren : + editfile setzen; + lineform; ueberschrift neu . + +globaleinstellung : + einstellung erfragen; + einstellung eintragen . + +END PROC text menue kommandos; + +LET zwischendatei = "&&Druckabschnitt"; + +PROC ausschnitt drucken : + + LET ende der seite = "Ende der Seite "; + FILE VAR ef := editfile; + INT VAR pageform anfang; + auf pageform datei testen; + IF pageform anfang > 0 THEN + editfile setzen; + IF mark (ef) THEN + markierten pageform abschnitt drucken + ELSE + nach seiten fragen und drucken + END IF; + print (zwischendatei); + forget (zwischendatei, quiet) + ELIF mark (ef) THEN + abschnitt formatieren und drucken + ELSE + errorstop ("kein Abschnitt markiert") + END IF; + alte position einnehmen . + +auf pageform datei testen : + INT VAR + zeile := line no (ef), + spalte := col (ef); + to line (ef, 1); col (ef, 1); + pageform anfang := 0; + WHILE NOT eof (ef) CAND kommando in zeile REP + IF pos (ef, ende der seite, 8) > 0 THEN + pageform anfang := line no (ef); + END IF; + down (ef) + UNTIL pageform anfang > 0 END REP; + to line (ef, zeile); col (ef, spalte) . + +kommando in zeile : + pos (ef, "#", 1) = 1 . + +markierten pageform abschnitt drucken : + markierten abschnitt kopieren; + pageform anfang kopieren (ef, pageform anfang) . + +nach seiten fragen und drucken : + anfang erfragen; + ende erfragen; + markierten abschnitt kopieren; + pageform anfang kopieren (ef, pageform anfang); + mark (ef, 0, 0) . + +anfang erfragen : + TEXT VAR seitennr := ""; + eget ("Erste Seite:", seitennr); + IF seitennr = "" THEN + mark (ef, pageform anfang + 1, 1) + ELSE + to line (ef, 1); + down (ef, ende der seite + text (int (seitennr) - 1)); + IF eof (ef) THEN + mark (ef, pageform anfang + 1, 1) + ELSE + down (ef); + mark (ef, line no (ef), 1) + END IF + END IF . + +ende erfragen : + eget ("Letzte Seite:", seitennr); + IF seitennr <> "" THEN + to line (ef, mark line no (ef)); + down (ef, ende der seite + seitennr); + IF NOT eof (ef) THEN down (ef) END IF + ELSE + to eof (ef) + END IF; + col (ef, 1) . + +abschnitt formatieren und drucken : + macro einfuegen; + editfile setzen; + ueberschrift neu; + IF eja ("Zeilenweise formatieren") THEN + lineform; page; ueberschrift zeigen; bild zeigen; + markierte schlusszeile + END IF; + markierten abschnitt kopieren; + IF eja ("Seitenweise formatieren") THEN + pageform (zwischendatei); + alles neu; + print (zwischendatei + ".p"); + forget (zwischendatei + ".p", quiet) + ELSE + print (zwischendatei) + END IF; + forget (zwischendatei, quiet); + macro entfernen . + +markierte schlusszeile : + cursor (1, y size - 1); + out (""15""); x size - 5 TIMESOUT " "; out (""14""4"") . + +macro einfuegen : + eget ("Format-Makro:", format macro); + IF format macro <> "" THEN + to line (ef, mark line no (ef)); + read record (ef, ezeile); + change (ezeile, mark col (ef), mark col (ef) - 1, + "#" + format macro + "#"); + write record (ef, ezeile); + to line (ef, zeile); col (ef, spalte) + END IF . + +macro entfernen : + IF format macro <> "" THEN + zeile := line no (ef); spalte := col (ef); + to line (ef, mark line no (ef)); + read record (ef, ezeile); + change (ezeile, mark col (ef), mark col (ef) + length (format macro) + 1, + ""); + write record (ef, ezeile) + END IF; + alte position einnehmen . + +alte position einnehmen : + to line (ef, zeile); col (ef, spalte) . + +END PROC ausschnitt drucken; + +PROC markierten abschnitt kopieren : + + IF exists (zwischendatei) THEN + IF eja ("""" + zwischendatei + """ löschen") THEN + forget (zwischendatei, quiet) + ELSE + errorstop ("") + END IF + END IF; + bitte warten; + PUT zwischendatei + +END PROC markierten abschnitt kopieren; + +PROC pageform anfang kopieren (FILE VAR ef, INT CONST zeilen) : + + FILE VAR zwischen := sequential file (modify, zwischendatei); + INT VAR i; + to line (zwischen, 1); + to line (ef, 1); + FOR i FROM 1 UPTO zeilen REP + read record (ef, ezeile); + insert record (zwischen); + write record (zwischen, ezeile); + down (ef); down (zwischen) + END REP + +END PROC pageform anfang kopieren; + +PROC schrifttyp auswaehlen (TEXT VAR typname) : + + alles neu; + auswahl anbieten ("TEXT.Fontwahl", fontfenster, 1, "AUSWAHL/Allgemein", + PROC (TEXT VAR, INT CONST) aus fonttab); + IF wahl (1) <> 0 THEN + typname := font (wahl (1)) + ELSE + typname := "" + END IF + +END PROC schrifttyp auswaehlen; + +PROC aus fonttab (TEXT VAR name, INT CONST stelle) : + + IF stelle > 49 THEN + name := "" + ELSE + name := font (stelle) + END IF + +END PROC aus fonttab; + +PROC gewaehlte schriftarten einstellen (TEXT CONST mod) : + + INT VAR + zeile := line no (editfile), + spalte := col (editfile); + FILE VAR edfile := editfile; + read record (edfile, ezeile); + IF mark (edfile) THEN + modifikationen nachher behandeln; + modifikationen vorher behandeln + ELSE + gewaehlte modifikationen einstellen + END IF . + +modifikationen nachher behandeln : + BOOL VAR geloescht; + ueber blanks zuruecksetzen; + ueber zeilenanfang zuruecksetzen; + modifikationen am ende beseitigen; + modifikationen am ende einfuegen . + +ueber blanks zuruecksetzen : + WHILE spalte > 1 CAND (ezeile SUB (spalte - 1)) = " " REP + spalte DECR 1 + END REP . + +ueber zeilenanfang zuruecksetzen : + INT VAR stelle; + IF spalte = 1 CAND zeile > 1 THEN + up (edfile); + read record (edfile, ezeile); + stelle := length (ezeile); + IF (ezeile SUB stelle) = " " THEN stelle DECR 1 END IF + ELSE + stelle := max (spalte - 1, 1) + END IF . + +modifikationen am ende beseitigen : + WHILE (ezeile SUB stelle) = "#" REP + ggf anweisung entfernen + END REP . + +ggf anweisung entfernen : + INT VAR anw anf := stelle - 1; + WHILE anw anf > 1 CAND (ezeile SUB anw anf) <> "#" REP + anw anf DECR 1 + END REP; + anweisung entfernen ("off", anw anf, stelle, geloescht); + IF geloescht THEN + spalte DECR (stelle - anw anf + 1) + END IF; + stelle := anw anf - 1 . + +modifikationen am ende einfuegen : + IF pos (mod, "a") = 0 THEN + neue modifikationen nachher + END IF; + write record (edfile, ezeile) . + +neue modifikationen nachher : + FOR i FROM length (mod) DOWNTO 1 REP + change (ezeile, spalte, spalte - 1, mod param off); + spalte INCR mod param laenge + END REP . + +modifikationen vorher behandeln : + to line (edfile, mark line no (edfile)); + col (edfile, mark col (edfile)); + read record (edfile, ezeile); + stelle := col (edfile); + WHILE (ezeile SUB stelle) = "#" REP + ggf anfangsanweisung entfernen + END REP; + neue modifikationen am anfang einfuegen; + write record (edfile, ezeile); + to line (edfile, zeile); + col (edfile, spalte); + abschnitt neu (mark line no (edfile), zeile); + mark (edfile, 0, 0) . + +ggf anfangsanweisung entfernen : + INT VAR anw ende := pos (ezeile, "#", stelle + 1); + anweisung entfernen ("on", stelle, anw ende, geloescht); + IF geloescht THEN + IF line no (edfile) = zeile THEN + spalte DECR (anw ende - stelle + 1) + END IF + ELSE + stelle := anw ende + 1 + END IF . + +neue modifikationen am anfang einfuegen : + IF pos (mod, "a") = 0 THEN + neue modifikationen vorher + END IF . + +neue modifikationen vorher : + FOR i FROM length (mod) DOWNTO 1 REP + change (ezeile, stelle, stelle - 1, mod param on); + IF line no (edfile) = zeile THEN + spalte INCR mod param laenge + END IF + END REP . + +gewaehlte modifikationen einstellen : + INT VAR i; + BOOL VAR mod aus; + mod aus := pos (mod, "a") > 0; + FOR i FROM length (mod) DOWNTO 1 REP + IF (mod SUB i) = "a" THEN + ELIF mod aus THEN + change (ezeile, spalte, spalte - 1, mod param off) + ELSE + change (ezeile, spalte, spalte - 1, mod param on) + END IF + END REP; + write record (edfile, ezeile); + abschnitt neu (zeile, zeile) . + +mod param on : + TEXT VAR + mod zeichen := mod SUB i, + mod text; + IF mod zeichen = "h" THEN + mod text := "#u#" + ELIF mod zeichen = "t" THEN + mod text := "#d#" + ELSE + mod text := "#on(""" + mod zeichen + """)#" + END IF; + mod text . + +mod param off : + mod zeichen := mod SUB i; + IF mod zeichen = "h" OR mod zeichen = "t" THEN + mod text := "#e#" + ELSE + mod text := "#off(""" + mod zeichen + """)#" + END IF; + mod text . + +mod param laenge : + length (mod text) . + +END PROC gewaehlte schriftarten einstellen; + +PROC modname (TEXT VAR name, INT CONST stelle) : + + SELECT stelle OF + CASE 1 : name := "Fett" + CASE 2 : name := "Kursiv" + CASE 3 : name := "Unterstrichen" + CASE 4 : name := "Hoch" + CASE 5 : name := "Tief" + CASE 6 : name := "Aus" + OTHERWISE name := "" + END SELECT + +END PROC modname; + +TEXT PROC gewaehlte modifikationen : + + TEXT VAR ergebnis := ""; + INT VAR stelle := 1; + WHILE wahl (stelle) > 0 REP + wahl merken; + stelle INCR 1 + END REP; + ergebnis . + +wahl merken : + SELECT wahl (stelle) OF + CASE 1 : ergebnis CAT "b" + CASE 2 : ergebnis CAT "i" + CASE 3 : ergebnis CAT "u" + CASE 4 : ergebnis CAT "h" + CASE 5 : ergebnis CAT "t" + CASE 6 : ergebnis CAT "a" + END SELECT . + +END PROC gewaehlte modifikationen; + +PROC anweisung entfernen (TEXT CONST anw name, INT CONST beginn, ende, + BOOL VAR geloescht) : + + geloescht := FALSE; + IF beginn > 0 AND ende > 0 + CAND (ezeile SUB beginn) = "#" CAND (ezeile SUB ende) = "#" THEN + INT CONST vorkommen := pos (ezeile, anw name, beginn, ende); + IF vorkommen > 0 AND vorkommen < beginn + 4 + OR up down anweisung THEN + change (ezeile, beginn, ende, ""); + geloescht := TRUE + END IF + END IF . + +up down anweisung : + IF ende = beginn + 2 THEN + TEXT CONST alte anweisung := ezeile SUB beginn + 1; + IF anw name = "on" THEN + alte anweisung = "u" OR alte anweisung = "d" + ELSE + alte anweisung = "e" + END IF + ELSE + FALSE + END IF . + +END PROC anweisung entfernen; + +PROC textanweisung einfuegen (TEXT CONST anweisung, param, + BOOL CONST ab anfang) : + + FILE VAR edfile := editfile; + IF ab anfang THEN col (edfile, 1) END IF; + INT CONST ce := col (edfile); + read record (edfile, ezeile); + IF (ezeile SUB ce) = "#" CAND gleiche anweisung THEN + anweisung ersetzen + ELIF ce = 1 THEN + neue zeile einfuegen + ELSE + an stelle einfuegen + END IF . + +gleiche anweisung : + INT CONST apos := pos (ezeile, anweisung, ce); + apos > 0 AND pos (ezeile, "#", ce + 1) > a pos AND + (param = "" OR pos (ezeile, "(", ce) > a pos) . + +anweisung ersetzen : + IF param <> "" THEN + INT CONST anf := pos (ezeile, "(", ce), + end := pos (ezeile, ")", anf); + IF anf > 0 AND end > 0 AND anf < end THEN + change (ezeile, anf + 1, end - 1, param); + write record (edfile, ezeile); + abschnitt neu (line no (edfile), line no(edfile)) + END IF + END IF . + +neue zeile einfuegen : + insert record (edfile); + IF param <> "" THEN + write record (edfile, "#" + anweisung + "(" + param + ")# ") + ELSE + write record (edfile, "#" + anweisung + "# ") + END IF; + abschnitt neu (line no (edfile), 9999) . + +an stelle einfuegen : + IF param <> "" THEN + change (ezeile, ce, ce - 1, "#" + anweisung + "(" + param + ")#") + ELSE + change (ezeile, ce, ce - 1, "#" + anweisung + "#") + END IF; + write record (edfile, ezeile); + abschnitt neu (line no (edfile), line no (edfile)) . + +END PROC textanweisung einfuegen; + +LET + global anfang = + "#- Globale Einstellungen, nicht verschieben -# ", + global ende = + "#- Ende der globalen Einstellungen ----------# "; + +TEXT VAR + e type := "", + e limit := "16.0", + e x start := "2.5", + e y start := "2.25", + e pagelength := "25.0", + e linefeed := "1.0"; + +PROC einstellung erfragen : + + REP + schrifttyp auswaehlen (e type); + IF e type = "" CAND + eja ("Typ muß gewaehlt werden, Funktion abbrechen") THEN + errorstop ("") + END IF + UNTIL e type <> "" END REP; + eget ("Breite des Schreibfelds in cm:", e limit); + eget ("Länge des Schreibfelds in cm:", e pagelength); + eget ("Oberer Rand in cm:", e y start); + eget ("Linker Rand in cm:", e x start); + eget ("Zeilenabstand als relativer Faktor:", e linefeed) + +END PROC einstellung erfragen; + +PROC einstellung eintragen : + + FILE VAR edfile := editfile; + INT VAR + zeile := line no (edfile), + spalte := col (edfile); + col (edfile, 1); + to line (edfile, 1); + read record (edfile, ezeile); + IF pos (ezeile, "type") > 0 THEN + down (edfile); + read record (edfile, ezeile); + alte einstellung suchen + END IF; + ab hier einfuegen; + an alte stelle . + +alte einstellung suchen : + IF ezeile = global anfang THEN + down (edfile, global ende); + IF eof (edfile) THEN + to line (edfile, 2) + ELSE + down (edfile) + END IF + END IF . + +ab hier einfuegen : + IF line no (edfile) > 1 CAND eja ("Alte Einstellung loeschen") THEN + INT CONST zu loeschen := line no (edfile) - 1; + to line (edfile, 1); + INT VAR i; + FOR i FROM 1 UPTO zu loeschen REP + delete record (edfile) + END REP; + zeile DECR zu loeschen + END IF; + typ und limit einfuegen; + global anfang einfuegen; + seitenlaenge einfuegen; + start einfuegen; + linefeed einfuegen; + global ende einfuegen . + +typ und limit einfuegen : + insert record (edfile); + write record (edfile, + "#type (""" + etype + """)##limit (" + e limit + ")# "); + down (edfile) . + +global anfang einfuegen : + insert record (edfile); + write record (edfile, global anfang); + down (edfile) . + +seitenlaenge einfuegen : + insert record (edfile); + write record (edfile, "#pagelength (" + e pagelength + ")# "); + down (edfile) . + +start einfuegen : + insert record (edfile); + write record (edfile, + "#start (" + e x start + ", " + e y start + ")# "); + down (edfile) . + +linefeed einfuegen : + insert record (edfile); + write record (edfile, "#linefeed (" + e linefeed + ")# "); + down (edfile) . + +global ende einfuegen : + insert record (edfile); + write record (edfile, global ende); + zeile INCR 6 . + +an alte stelle : + to line (edfile, zeile); + col (edfile, spalte) . + +END PROC einstellung eintragen; + + +(* Editor im EUDAS-Fenster *) + +INT VAR return code; + +LET + edit status = #1003# +"EDIT: Menü: ESC m, ESC t Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ?"; + +BOOL VAR status frei; + + +PROC edit status anzeigen : + status anzeigen (edit status) +END PROC edit status anzeigen; + +PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe) : + + INT VAR x, y, x l, y l; + fenstergroesse (fenster, x, y, x l, y l); + fenster veraendert (fenster); + enable stop; + fenster datei := ""; + IF groesster editor = 0 THEN status frei := y > 1 END IF; + REP + IF status frei THEN status anzeigen (edit status) END IF; + open editor (groesster editor + 1, f, TRUE, x, y, x l, y l); + edit (groesster editor, "eqvw19dpgn"9"?hFmt", PROC (TEXT CONST) kdo); + return code behandeln + END REP . + +return code behandeln : + SELECT return code OF + CASE 0 : LEAVE edit + CASE 1 : hilfe anbieten (hilfe, fenster) + CASE 2 : errorstop ("") + END SELECT . + +END PROC edit; + +PROC kdo (TEXT CONST zeichen) : + + return code := pos ("q?h", zeichen); + IF return code > 0 THEN + return code DECR 1; + quit + ELIF zeichen = "m" THEN + edit menue; + IF status frei THEN status anzeigen (edit status) END IF; + ELIF zeichen = "t" THEN + text menue; + IF status frei THEN status anzeigen (edit status) END IF; + ELSE + std kommando interpreter (zeichen); + IF status frei THEN status anzeigen (edit status) END IF; + END IF + +END PROC kdo; + + +END PACKET edit menue; +(* +FENSTER VAR fe; fenster initialisieren (fe); +fenstergroesse setzen (fe, 1, 2, 79, 23); +FILE VAR f := sequential file (modify, "testdatei"); +edit (f, fe, "EDIT/Allgemein") +*) + diff --git a/app/flint/0.4/src/eudas.manager b/app/flint/0.4/src/eudas.manager new file mode 100644 index 0000000..802a507 --- /dev/null +++ b/app/flint/0.4/src/eudas.manager @@ -0,0 +1,216 @@ +PACKET eudas manager (* Autor: Thomas Berlage *) + (* Stand: 20.01.88 *) + DEFINES + + eudas manager, + setze partner, + abhaengige task, + end partner : + + +LET + code dateien = 190, + code felder = 191, + code positioniere = 192, + code satz = 193, + end myself code = 197, + set controlled code = 198, + ask partner code = 200; + +LET + ack = 0; + +LET + COM = STRUCT (INT int info, + BOOL bool info, + TEXT text info, + SATZ satz info); + +BOUND COM VAR p; + +ROW 4 TEXT VAR partner vater; + partner vater (1) := ""; + partner vater (2) := ""; + partner vater (3) := ""; + partner vater (4) := ""; + +TEXT VAR puffer; + +LET + kein partner = + "Kein Partner"; + + +PROC setze partner (INT CONST nr, TEXT CONST name des vaters) : + + partner vater (nr) := name des vaters + +END PROC setze partner; + +PROC eudas manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + + enable stop; + SELECT order OF + CASE code dateien : code dateien ausfuehren + CASE code felder : code felder ausfuehren + CASE code positioniere : code positioniere ausfuehren + CASE code satz : code satz ausfuehren + OTHERWISE andere codes + END SELECT . + +andere codes : + IF order > ask partner code AND order < ask partner code + 4 THEN + ask partner code ausfuehren + ELSE + menue manager (ds, order, phase, order task) + END IF . + +code dateien ausfuehren : + p := ds; + p. int info := dateiversion; + dateinamen anlegen; + send (order task, ack, ds) . + +dateinamen anlegen : + satz initialisieren (p. satz info); + FOR i FROM 1 UPTO anzahl dateien REP + feld aendern (p. satz info, i, eudas dateiname (i)) + END REP . + +code felder ausfuehren : + p := ds; + feldinfo anlegen; + feldnamen anlegen; + send (order task, ack, ds) . + +feldinfo anlegen : + INT VAR i; + TEXT VAR rep := " "; + p. text info := ""; + FOR i FROM 1 UPTO anzahl felder REP + replace (rep, 1, feldinfo (i)); + p. text info CAT rep + END REP . + +feldnamen anlegen : + satz initialisieren (p. satz info, anzahl felder); + FOR i FROM 1 UPTO anzahl felder REP + feldnamen lesen (i, puffer); + feld aendern (p. satz info, i, puffer) + END REP . + +code positioniere ausfuehren : + p := ds; + positionieren; + ergebnis ablegen; + send (order task, ack, ds) . + +positionieren : + IF p. bool info THEN + relativ positionieren + ELSE + auf satz (p. int info) + END IF . + +relativ positionieren : + IF p. int info > 0 THEN + weiter (p. int info) + ELIF p. int info < 0 THEN + zurueck (- p. int info) + END IF . + +ergebnis ablegen : + p. int info := satznummer; + p. bool info := dateiende . + +code satz ausfuehren : + p := ds; + p. int info := satzkombination; + p. bool info := satz ausgewaehlt; + satz aufbauen; + send (order task, ack, ds) . + +satz aufbauen : + satz initialisieren (p. satz info, anzahl felder); + FOR i FROM 1 UPTO anzahl felder REP + feld lesen (i, puffer); + feld aendern (p. satz info, i, puffer) + END REP . + +ask partner code ausfuehren : + INT VAR p nr := order - ask partner code; + forget (ds); ds := nilspace; + BOUND TASK VAR c task := ds; + CONCR (c task) := partner mit einrichten (p nr, task index); + send (order task, ack, ds) . + +task index : + FOR i FROM 2 UPTO 4 REP + IF partner task (i) = order task THEN + LEAVE task index WITH i + END IF + END REP; + errorstop (kein partner); + 1 . + +END PROC eudas manager; + +TASK PROC abhaengige task (INT CONST p nr) : + + partner mit einrichten (p nr, 1) + +END PROC abhaengige task; + +TASK PROC partner mit einrichten (INT CONST p nr, p von) : + + enable stop; + IF NOT exists (partner task (p nr)) THEN + partner einrichten + END IF; + partner task (p nr) . + +partner einrichten : + TEXT CONST neuer name := name (myself) + "-p" + text (p nr - 1); + begin (neuer name, partner vater (p nr)); + partner task (p nr, task (neuer name)); + abhaengig setzen . + +abhaengig setzen : + DATASPACE VAR send ds := nilspace; + BOUND STRUCT (INT von, TASK pt) VAR m := send ds; + m. von := p von; + m. pt := partner task (p von); + INT VAR i, reply; + FOR i FROM 1 UPTO 5 REP + pingpong (partner task (p nr), set controlled code, send ds, reply); + IF reply = -2 THEN pause (5) END IF + UNTIL reply <> -2 END REP; + forget (send ds) . + +END PROC partner mit einrichten; + +PROC end partner (INT CONST p nr) : + + IF exists (partner task (p nr)) THEN + end code senden + END IF . + +end code senden : + DATASPACE VAR send ds := nilspace; + INT VAR i, reply; + FOR i FROM 1 UPTO 10 REP + send (partner task (p nr), end myself code, send ds, reply); + IF reply = ack THEN + LEAVE end code senden + END IF; + pause (3) + END REP; + forget (send ds); + errorstop ("END nicht angenommen") . + +END PROC end partner; + + +END PACKET eudas manager; + diff --git a/app/flint/0.4/src/flint b/app/flint/0.4/src/flint new file mode 100644 index 0000000..14e0fe1 --- /dev/null +++ b/app/flint/0.4/src/flint @@ -0,0 +1,808 @@ +PACKET flint + +(*************************************************************************) +(* *) +(* EUMEL Menue-Monitor *) +(* *) +(* Version 05 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 16.10.88 *) +(* *) +(*************************************************************************) + + DEFINES + + flint : + + +TEXT CONST flint vater := name (myself); + +setze partner (2, "KAKTUS"); +setze partner (3, "CHART"); + + +PROC flint : + + page; + fenstergroessen bestimmen; + disable stop; + REP + menue anbieten (ROW 6 TEXT : + ("FLINT.Standard", "FLINT.Eigene", "FLINT.System", + "EUDAS.Dateien", "EUDAS.Archiv", ""), + fenster links, TRUE, + PROC (INT CONST, INT CONST) flint inter); + bereich wechseln + END REP + +END PROC flint; + +PROC fusszeile aktualisieren : + + arbeitsbereich bestimmen; + fussteil (2, "", "") + +END PROC fusszeile aktualisieren; + + +(*************************** FLINT Interpreter *****************************) + +LET + t datum = #1300# + ""15"Datum "14"", + kb von = #1301# + " KB von ", + sind belegt = #1302# + " KB sind belegt.", + p taskname = #1303# + "Name des Arbeitsbereichs:", + existiert nicht als task = #1304# + " ist kein Name eines Bereiches", + t loeschen = #1305# + " verlassen und löschen", + t speicher = #1306# + "Speicher:", + t cpu zeit = #1307# + " KB CPU-Zeit : ", + t zustand = #1308# + "Zustand : ", + t prio = #1309# + " Priorität: ", + t kanal = #1310# + " Kanal: ", + t busy = #1311# + "Arbeit", + t io = #1312# + "EinAus", + t wait = #1313# + "Warten", + t busy blocked = #1314# + "B(Arb)", + t io blocked = #1315# + "B(E/A)", + t wait blocked = #1316# + "B(Wrt)", + t dead = #1317# + ">>TOT<", + bereich neu einrichten = #1318# + "Bereich existiert nicht. Neu einrichten", + p name vater = #1319# + "Unter welchem Vaterbereich (RET -> FLINT):", + weitermachen in = #1320# + "Weitermachen in Bereich:", + task ganz abkoppeln = #1321# + "Eigenen Bereich ganz abkoppeln"; + +TEXT VAR + wechsel taskname := ""; + +SATZ VAR sammel; + + +PROC flint inter (INT CONST menuenr, f nr) : + + SELECT menuenr OF + CASE 0: sperren setzen + CASE 1: standard interpreter + CASE 2: eigene interpreter + CASE 3: system interpreter + CASE 4: dateiverwaltung (f nr) + CASE 5: archivverwaltung (menuenr, f nr) + END SELECT . + +sperren setzen : + fusszeile ("", "", 35, t datum, 64); + fussteil (3, date) . + +standard interpreter : + enable stop; + SELECT f nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : textverarbeitung + CASE 2 : eudas + CASE 3 : kaktus + CASE 4 : dgs superchart + CASE 5 : programme + CASE 6 : systemsteuerung + OTHERWISE ggf dialogfenster loeschen + END SELECT . + +kaktus : + continue (abhaengige task (2)); + page; bildschirm neu . + +dgs superchart : + continue (abhaengige task (3)); + page; bildschirm neu . + +systemsteuerung : + continue (task ("OP")); + page; bildschirm neu . + +ggf dialogfenster loeschen : + IF f nr = -1 THEN dialogfenster loeschen END IF . + +eigene interpreter : + enable stop; + SELECT f nr OF + CASE 0 : fusszeile aktualisieren + OTHERWISE ggf dialogfenster loeschen + END SELECT . + +system interpreter : + enable stop; + SELECT f nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : bereich wechseln + CASE 2 : bereichsuebersicht + CASE 3 : speicherbelegung + CASE 4 : eigener status + CASE 5 : fremder taskstatus + CASE 6 : task info (3); bildschirm neu; dialogfenster loeschen + CASE 7 : task loeschen + OTHERWISE ggf dialogfenster loeschen + END SELECT . + +bereichsuebersicht : + disable stop; + bitte warten; + DATASPACE VAR list ds := nilspace; + FILE VAR f := sequential file (output, list ds); + task info (1, f); + IF NOT is error THEN + edit (f, fenster rechts, "SHOW/Taskinfo", FALSE) + END IF; + forget (list ds); + enable stop . + +speicherbelegung : + INT VAR size, used; + storage (size, used); + size := int (real (size + 24) * 64.0 / 63.0); + IF l3 THEN + size := size DIV 1024; + used := used DIV 1024 + END IF; + dialog (text (used) + kb von + text (size) + sind belegt) . + +eigener status : + task zustand (myself) . + +fremder taskstatus : + TEXT VAR taskname := ""; + editget (p taskname, taskname, "GET/Taskname", ""); + TASK VAR status task := task (task name); + IF exists (status task) THEN + task zustand (status task) + ELSE + errorstop (textdarstellung (taskname) + existiert nicht als task) + END IF . + +task loeschen : + IF ja (textdarstellung (name (myself)) + t loeschen, + "JA/Task loeschen", FALSE) THEN + end partner (2); end partner (3); + deferred end; + bereich wechseln + END IF . + +END PROC flint inter; + +PROC bereich wechseln : + + enable stop; + editget (weitermachen in, wechsel taskname, "z", "GET/wtaskname"); + IF subtext (wechsel taskname, 1, 2) = ""27"z" THEN + bereich auswaehlen + ELIF wechsel taskname <> "" THEN + ggf task einrichten + ELIF ganz abkoppeln THEN + continue (niltask) + END IF; + fenstergroessen bestimmen; + page; + bildschirm neu . + +bereich auswaehlen : + bitte warten; + alle tasknamen sammeln; + auswahl anbieten ("FLINT.Taskauswahl", fenster rechts, 1, + "AUSWAHL/Tasks", PROC (TEXT VAR, INT CONST) aus sammel); + IF wahl (1) <> 0 THEN + feld lesen (sammel, wahl (1), wechsel taskname); + continue (task (wechsel taskname)) + END IF . + +alle tasknamen sammeln : + access catalogue; + satz initialisieren (sammel); + wechsel taskname := subtext (wechsel taskname, 3); + pattern feststellen; + IF exists task (flint vater) THEN + sammel tasks (task (flint vater), pattern) + ELSE + sammel tasks (father, pattern) + END IF . + +pattern feststellen : + TEXT VAR pattern; + IF pos (wechsel taskname, "*") = 0 THEN + pattern := "" + ELSE + pattern := wechsel taskname + END IF . + +ggf task einrichten : + IF NOT exists task (wechsel taskname) THEN + IF ja (bereich neu einrichten, "JA/task einrichten") THEN + vater erfragen; + begin (wechsel taskname, name vater); + continue (task (wechsel taskname)) + END IF + ELSE + continue (task (wechsel taskname)) + END IF . + +vater erfragen : + TEXT VAR name vater := ""; + editget (p name vater, name vater, "", "GET/Vatertask"); + IF name vater = "" THEN + name vater := flint vater + END IF . + +ganz abkoppeln : + ja (task ganz abkoppeln, "JA/abkoppeln") . + +END PROC bereich wechseln; + +PROC aus sammel (TEXT VAR inhalt, INT CONST pos) : + + IF pos > 200 THEN + inhalt := "" + ELSE + feld lesen (sammel, pos, inhalt) + END IF + +END PROC aus sammel; + +PROC sammel tasks (TASK CONST vater, TEXT CONST pattern) : + + TASK VAR naechste := son (vater); + WHILE NOT is niltask (naechste) REP + ggf task sammeln; + sammel tasks (naechste, pattern); + naechste := brother (naechste) + END REP . + +ggf task sammeln : + IF naechste = myself THEN + ELIF pattern = "" COR (name (naechste) LIKE pattern) THEN + feld aendern (sammel, felderzahl (sammel) + 1, name (naechste)) + END IF . + +END PROC sammel tasks; + +PROC task zustand (TASK CONST status task) : + + dialog (t speicher + speicher + t cpu zeit + cpu zeit); + out (t zustand); out status; out (t prio); out prio; + out (t kanal); out kanal . + +speicher : + text (storage (status task), 5) . + +cpu zeit : + disable stop; + TEXT VAR result := subtext (time (clock (status task), 12), 1, 10); + IF is error THEN + clear error; result := "**********" + END IF; + result . + +out status : + SELECT status (status task) OF + CASE 0 : out (t busy) + CASE 1 : out (t io) + CASE 2 : out (t wait) + CASE 4 : out (t busy blocked) + CASE 5 : out (t io blocked) + CASE 6 : out (t wait blocked) + OTHERWISE out (t dead) + END SELECT . + +out prio : + out (text (pcb (status task, 6))) . + +out kanal : + IF channel (status task) = 0 THEN + out (" -") + ELSE + out (text (channel (status task), 2)) + END IF . + +END PROC task zustand; + + +(**************************** Textverarbeitung ****************************) + +LET + t ausnahmen = #1400# + "Ausnahmen", + t druckertask = #1401# + "Name Druckertask: ", + task existiert nicht = #1402# + "Task existiert nicht", + t stationsnummer = #1403# + "Stationsnummer der Druckertask: ", + falsche stationsnummer = #1404# + "Falsche Stationsnummer", + t trennfaktor = #1405# + "Trennfaktor (4 bis 20): ", + t ersten kopf unterdruecken = #1406# + "Ersten Kopfteil unterdrücken", + t letzten fuss unterdruecken = #1407# + "Letzten Fußteil unterdrücken", + t fussabstand = #1408# + "Anzahl Leerzeilen vor Fußnoten (0 bis 9): ", + lineform manuell = #1409# + "Trennungen manuell bestimmen", + pageform manuell = #1410# + "Seitenaufteilung manuell bestimmen", + falscher trennfaktor = #1411# + "Falscher Trennfaktor (nur 4 bis 20)", + name fonttabelle = #1412# + "Name der Fonttabelle: ", + t neu einrichten = #1413# + " neu einrichten", + name der datei = #1414# + "Name der Datei: "; + +LET + font file typ = 3009; + +INT VAR + file typ := 1003; + +IF l3 THEN file typ := 1004 END IF . + +l3 : maxint DIV 2 > 17000 . +; + +BOOL VAR + zeilen manuell := TRUE, + seiten manuell := TRUE; + +TEXT VAR + druckertask := "PRINTER"; + +INT VAR + druckerstation := station (myself); + + +PROC textverarbeitung : + + page; bildschirm neu; + BOOL CONST alter umbruch := word wrap; + word wrap (TRUE); + menue anbieten (ROW 6 TEXT : + ("TEXTE.Erstellen", "TEXTE.Bearbeiten", "TEXTE.Einstellungen", + "EUDAS.Dateien", "EUDAS.Archiv", ""), + fenster links, TRUE, + PROC (INT CONST, INT CONST) text inter); + word wrap (alter umbruch); + page; bildschirm neu + +END PROC textverarbeitung; + +PROC text inter (INT CONST menuenr, f nr) : + + SELECT menuenr OF + CASE 0: sperren setzen + CASE 1: erstellen interpreter + CASE 2: bearbeiten interpreter + CASE 3: einstellungen interpreter + CASE 4: dateiverwaltung (f nr) + CASE 5: archivverwaltung (menuenr, f nr) + END SELECT . + +sperren setzen : + fusszeile ("", "", 35, t datum, 64); + fussteil (3, date) . + +erstellen interpreter : + enable stop; + SELECT f nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : editieren + CASE 2 : drucken + CASE 3 : zeilen formatieren + CASE 4 : seiten formatieren + CASE 5 : automatik + OTHERWISE ggf dialogfenster loeschen + END SELECT . + +editieren : + ausfuehrung (PROC (TEXT CONST) editiere); + dialogfenster loeschen . + +drucken : + ausfuehrung (PROC (TEXT CONST) drucke) . + +zeilen formatieren : + bildschirm neu; + IF zeilen manuell THEN + ausfuehrung (PROC (TEXT CONST) lineform) + ELSE + ausfuehrung (PROC (TEXT CONST) autoform) + END IF; + dialogfenster loeschen . + +seiten formatieren : + bildschirm neu; + IF seiten manuell THEN + ausfuehrung (PROC (TEXT CONST) pageform) + ELSE + ausfuehrung (PROC (TEXT CONST) autopageform) + END IF; + dialogfenster loeschen . + +automatik : + zeilen manuell := ja (lineform manuell, + "JA/lineform manuell", zeilen manuell); + seiten manuell := ja (pageform manuell, + "JA/pageform manuell", seiten manuell) . + +ggf dialogfenster loeschen : + IF f nr = -1 THEN dialogfenster loeschen END IF . + +bearbeiten interpreter : + enable stop; + SELECT f nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : index anlegen + CASE 2 : outline anlegen + CASE 3 : file sortieren + CASE 4 : macros laden + CASE 5 : macros anzeigen + CASE 6 : ausnahmen erweitern + OTHERWISE ggf dialogfenster loeschen + END SELECT . + +index anlegen : + ausfuehrung (PROC (TEXT CONST) index); + bildschirm neu; dialogfenster loeschen . + +outline anlegen : + ausfuehrung (PROC (TEXT CONST) outline); + bildschirm neu; dialogfenster loeschen . + +file sortieren : + bitte warten; + ausfuehrung (PROC (TEXT CONST) sort) . + +macros laden : + page; + einzelausfuehrung (PROC (TEXT CONST) load macros); + bildschirm neu; dialogfenster loeschen . + +macros anzeigen : + bitte warten; + list macros; + bildschirm neu; dialogfenster loeschen . + +ausnahmen erweitern : + TEXT VAR zwischendatei := t ausnahmen; + WHILE exists (zwischendatei) REP zwischendatei CAT " " END REP; + create (zwischendatei); + bitte warten; + entlade ausnahmen (zwischendatei); + edit (zwischendatei); + bitte warten; + lade ausnahmen (zwischendatei); + forget (zwischendatei, quiet) . + +einstellungen interpreter : + enable stop; + SELECT f nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : fonttabelle laden + CASE 2 : fonts anzeigen + CASE 3 : druckertask verstellen + CASE 4 : trennfaktor einstellen + CASE 5 : briefmodus einstellen + CASE 6 : abstand fussnoten einstellen + OTHERWISE ggf dialogfenster loeschen + END SELECT . + +fonttabelle laden : + TASK VAR fonttask; + IF exists task ("configurator") THEN + fonttask := task ("configurator") + ELSE + fonttask := niltask + END IF; + ausfuehrung (name fonttabelle, TRUE, font file typ, fonttask, + PROC (TEXT CONST) font table) . + +fonts anzeigen : + bitte warten; + list fonts; + bildschirm neu; dialogfenster loeschen . + +druckertask verstellen : + editget (t druckertask, druckertask, "GET/Druckertask", ""); + IF NOT exists task (druckertask) THEN + errorstop (task existiert nicht) + ELIF station (myself) <> 0 THEN + erfrage station + ELSE + druckerstation := station (myself) + END IF . + +erfrage station : + TEXT VAR st := text (druckerstation); + editget (t stationsnummer, st, "GET/Druckstation", ""); + IF int (st) >= 0 AND last conversion ok THEN + druckerstation := int (st) + ELSE + errorstop (falsche stationsnummer) + END IF . + +trennfaktor einstellen : + TEXT VAR faktor := ""; + editget (t trennfaktor, faktor, "GET/Trennfaktor", ""); + IF faktor <> "" THEN + INT CONST fa := int (faktor); + IF fa < 4 OR fa > 20 THEN + errorstop (falscher trennfaktor); + ELSE + hyphenation width (fa) + END IF + END IF . + +briefmodus einstellen : + first head (NOT ja (t ersten kopf unterdruecken, "JA/firsthead", FALSE)); + last bottom (NOT ja (t letzten fuss unterdruecken, "JA/lastbottom", FALSE)) . + +abstand fussnoten einstellen : + TEXT VAR anzahl := ""; + editget (t fussabstand, anzahl, "GET/Fussabstand", ""); + IF anzahl <> "" THEN + number empty lines before foot (int (anzahl)) + END IF . + +END PROC text inter; + +PROC drucke (TEXT CONST dateiname) : + + save (dateiname, druckerstation / druckertask) + +END PROC drucke; + +PROC editiere (TEXT CONST dateiname) : + + IF exists (dateiname) COR neu einrichten THEN + IF NOT exists (dateiname) THEN vorher einrichten END IF; + FILE VAR f := sequential file (modify, dateiname); + edit (f, fenster ganz, "EDIT/Text") + END IF . + +neu einrichten : + ja (textdarstellung (dateiname) + t neu einrichten, + "JA/einrichten") . + +vorher einrichten : + FILE VAR dummy := sequential file (modify, dateiname) . + +END PROC editiere; + +PROC ausfuehrung (PROC (TEXT CONST) operation) : + + ausfuehrung (name der datei, FALSE, file typ, PROC (TEXT CONST) operation) + +END PROC ausfuehrung; + +PROC einzelausfuehrung (PROC (TEXT CONST) operation) : + + ausfuehrung (name der datei, TRUE, file typ, PROC (TEXT CONST) operation) + +END PROC einzelausfuehrung; + + +(*************************** Programme ***********************************) + +LET + p name prozedur = #1500# + "Name der Prozedur:", + p name paket = #1501# + "Name des Pakets:", + t weiter mit taste = #1502# + "*** Weiter mit Taste ***"; + + +PROC programme : + + page; bildschirm neu; + BOOL CONST alter umbruch := word wrap; + word wrap (FALSE); + menue anbieten (ROW 6 TEXT : ("ELAN.Erstellen", "ELAN.Permanent", + "EUDAS.Dateien", "EUDAS.Archiv", "", ""), + fenster links, TRUE, + PROC (INT CONST, INT CONST) prog interpreter); + word wrap (alter umbruch); + page; bildschirm neu + +END PROC programme; + +PROC prog interpreter (INT CONST menuenr, f nr) : + + SELECT menuenr OF + CASE 0 : sperren setzen + CASE 1 : erstellen interpreter + CASE 2 : permanent interpreter + CASE 3 : dateiverwaltung (f nr) + CASE 4 : archivverwaltung (menuenr, f nr) + END SELECT . + +sperren setzen : + fusszeile ("", "", 35, t datum, 64); + fussteil (3, date) . + +erstellen interpreter : + enable stop; + SELECT f nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : editieren + CASE 2 : ausfuehren + CASE 3 : wiederholen + CASE 4 : drucken + CASE 5 : testinstallation + OTHERWISE ggf dialogfenster loeschen + END SELECT . + +ggf dialogfenster loeschen : + IF f nr = -1 THEN dialogfenster loeschen END IF . + +editieren : + ausfuehrung (PROC (TEXT CONST) editiere); + dialogfenster loeschen . + +drucken : + ausfuehrung (PROC (TEXT CONST) drucke) . + +ausfuehren : + ausfuehrung (PROC (TEXT CONST) page and run); + dialogfenster loeschen . + +wiederholen : + page; + bildschirm neu; + runagain; + warten auf antwort; + dialogfenster loeschen . + +testinstallation : + ausfuehrung (PROC (TEXT CONST) page check on insert); + dialogfenster loeschen . + +permanent interpreter : + SELECT f nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : installieren + CASE 2 : prozedurhilfe + CASE 3 : pakethilfe + CASE 4 : alle pakete + OTHERWISE ggf dialogfenster loeschen + END SELECT . + +installieren : + ausfuehrung (PROC (TEXT CONST) page check off insert); + dialogfenster loeschen . + +prozedurhilfe : + TEXT VAR prozedurname := ""; + editget (p name prozedur, prozedurname, "", "GET/prozedurname"); + IF prozedurname <> "" THEN + bildschirm neu; + bitte warten; + help (prozedurname); + dialogfenster loeschen + END IF . + +pakethilfe : + prozedurname := ""; + editget (p name paket, prozedurname, "", "GET/paketname"); + IF prozedurname <> "" THEN + bildschirm neu; + bitte warten; + bulletin (prozedurname); + dialogfenster loeschen + END IF . + +alle pakete : + bildschirm neu; + bitte warten; + packets; + dialogfenster loeschen . + +END PROC prog interpreter; + +PROC warten auf antwort : + + TEXT VAR taste; + line; put (t weiter mit taste); + inchar (taste); + line + +END PROC warten auf antwort; + +PROC page and run (TEXT CONST dateiname) : + + bildschirm neu; + page; bitte warten; + check on; + run (dateiname); + warten auf antwort + +END PROC page and run; + +PROC page check on insert (TEXT CONST dateiname) : + + bildschirm neu; + page; bitte warten; + check on; + insert (dateiname); + warten auf antwort + +END PROC page check on insert; + +PROC page check off insert (TEXT CONST dateiname) : + + bildschirm neu; + page; bitte warten; + check off; + insert (dateiname); + warten auf antwort + +END PROC page check off insert; + + +END PACKET flint; + +PACKET flint monitor DEFINES + + monitor : + + +PROC monitor : + + disable stop; + partner task (1, myself); + continue (niltask); + flint + +END PROC monitor; + +END PACKET flint monitor; + diff --git a/app/flint/0.4/src/flint.init b/app/flint/0.4/src/flint.init new file mode 100644 index 0000000..a743f52 --- /dev/null +++ b/app/flint/0.4/src/flint.init @@ -0,0 +1,603 @@ +% MENUE "FLINT.Standard" +% BILD +Untermenüs +Version 0.5 +- +  Textverarb. +- +  Datenbank +- +  Kalkulation +- +  Grafiken +- +  ELAN +- +  Steuerung +% FELD 1 "FLINT/1T" "tT" +% FELD 2 "FLINT/1D" "dD" +% FELD 3 "FLINT/1K" "kK" +% FELD 4 "FLINT/1G" "gG" +% FELD 5 "FLINT/1P" "eE" +% FELD 6 "FLINT/1S" "sS" +% ENDE +% MENUE "FLINT.Eigene" +% BILD +Eigene Fkt. +   + +   + +   + +   + +% FELD 1 "" "aA" +% FELD 2 "" "bB" +% FELD 3 "" "cC" +% FELD 4 "" "dD" +% ENDE +% MENUE "FLINT.System" +% BILD +Arbeitsbereich +  Wechseln +- +Übersicht +  Bereiche +  Speicher +- +Taskzustand +  Eigene +  Fremde +  Alle +- +Eigene Task +  Löschen +% FELD 1 "FLINT/3W" "wW" +% FELD 2 "FLINT/3B" "bB" +% FELD 3 "FLINT/3S" "sS" +% FELD 4 "FLINT/3E" "eE" +% FELD 5 "FLINT/3F" "fF" +% FELD 6 "FLINT/3A" "aA" +% FELD 7 "FLINT/3L" "lL" +% ENDE +% MENUE "TEXTE.Erstellen" +% BILD +Textdatei +  Eingeben +  Drucken +- +Formatieren +  Zeilenweise +  Seitenweise +  Automatik +% FELD 1 "TEXTE/1E" "eE" +% FELD 2 "TEXTE/1D" "dD" +% FELD 3 "TEXTE/1Z" "zZ" +% FELD 4 "TEXTE/1S" "sS" +% FELD 5 "TEXTE/1A" "aA" +% ENDE +% MENUE "TEXTE.Bearbeiten" +% BILD +Extrahieren +  Index +  Gliederung +- +Textdatei +  Sortieren +- +Makros +  Laden +  Anzeigen +- +Ausnahmen +  Erweitern +% FELD 1 "TEXTE/2I" "iI" +% FELD 2 "TEXTE/2G" "gG" +% FELD 3 "TEXTE/2S" "sS" +% FELD 4 "TEXTE/2L" "lL" +% FELD 5 "TEXTE/2A" "aA" +% FELD 6 "TEXTE/2E" "eE" +% ENDE +% MENUE "TEXTE.Einstellungen" +% BILD +Schrifttypen +  Typtabelle +  Zeige Typen +- +  Drucker +- +Silbentrennung +  Faktor +- +Kopf/Fuß +  Briefmodus +- +Fußnoten +  Abstand +% FELD 1 "TEXTE/3T" "tT" +% FELD 2 "TEXTE/3Z" "zZ" +% FELD 3 "TEXTE/3D" "dD" +% FELD 4 "TEXTE/3F" "fF" +% FELD 5 "TEXTE/3B" "bB" +% FELD 6 "TEXTE/3A" "aA" +% ENDE +% MENUE "ELAN.Erstellen" +% BILD +ELAN-Programm +  Editieren +  Ausführen +  Wiederholen +  Drucken +  Installiern + testweise +% FELD 1 "PROG/1E" "eE" +% FELD 2 "PROG/1A" "aA" +% FELD 3 "PROG/1W" "wW" +% FELD 4 "PROG/1D" "dD" +% FELD 5 "PROG/1T" "iI" +% ENDE +% MENUE "ELAN.Permanent" +% BILD +Programm +  Installiern +- +Auskunft +  Einzelproz. +  GanzesPaket +  Paketnamen +% FELD 1 "PROG/2I" "iI" +% FELD 2 "PROG/2P" "eE" +% FELD 3 "PROG/2A" "gG" +% FELD 4 "PROG/2N" "pP" +% ENDE +% MENUE "EDIT MENUE:" +% BILD +Zeile Springen auf Zeile nach Nummer +Such Suchen nach Text +Ersetze Text suchen und ersetzen +WortMark Aktuelles Wort markieren +MarkSatz Aktuellen Satz bis Ende markieren +Kopiere Block kopieren oder einfügen (PUT, GET) +Fenster Datei in Teilfenster eröffnen +Breite Maximale Zeilenbreite (limit) einstellen +Taste Tastenbelegung abfragen und ändern +% FELD 1 "" "zZ" +% FELD 2 "" "sS" +% FELD 3 "" "eE" +% FELD 4 "" "wW" +% FELD 5 "" "mM" +% FELD 6 "" "kK" +% FELD 7 "" "fF" +% FELD 8 "" "bB" +% FELD 9 "" "tT" +% ENDE +% MENUE "TEXT MENUE:" +% BILD +Typ Schrifttyp einstellen (type) +Modifikation Schriftart für markierten Bereich festlegen (on, off) +Seite Neue Seite beginnen (page) +Raum Zwischenraum freilassen (free) +Einstellung Format für diese Datei einstellen +Formatiere Markierten Abschnitt zeilenweise formatieren +Drucke Markierten Abschnitt formatieren und drucken +% FELD 1 "" "tT" +% FELD 2 "" "mM" +% FELD 3 "" "sS" +% FELD 4 "" "rR" +% FELD 5 "" "eE" +% FELD 6 "" "fF" +% FELD 7 "" "dD" +% ENDE +% AUSWAHL "FLINT.Taskauswahl" +Bitte kreuzen Sie den gewünschten Bereich an. +% ENDE +% AUSWAHL "TEXT.Fontwahl" +Bitte Typ auswählen und ankreuzen: +% ENDE +% AUSWAHL "TEXT.Modwahl" +Art(en) ankreuzen: +% ENDE +% HILFE "FLINT/Allgemein" +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "FLINT1/T" +% SEITE 1 +Textverarbeitung +- +Aufruf der EUMEL-Textverarbeitung mit Menü. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/1D" +% SEITE 1 +EUDAS +- +Aufruf des Datenverwaltungssystems EUDAS. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/1K" +% SEITE 1 +KAKTUS +- +Aufruf der Tabellenkalkulation KAKTUS. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/1G" +% SEITE 1 +dgs-CHART +- +Aufruf des Geschäftsgrafikprogramms dgs-Superchart. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/1P" +% SEITE 1 +Programmerstellung +- +Aufruf eines Menüs zur Programmierung in ELAN. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/1S" +% SEITE 1 +Systemsteuerung +- +Aufruf eines Menüs zur Systemsteuerung (Abschalten, +Druckersteuerung, Konfiguration usw.). +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/3B" +% SEITE 1 +Übersicht Arbeitsbereiche +- +Verlassen der Übersicht mit ESC 'q'. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/3S" +% SEITE 1 +Speicherbelegung +- +Anzeige des belegten Hintergrundspeichers. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/3E" +% SEITE 1 +Eigener Taskzustand +- +Ausgabe des Zustands des eigenen Arbeitsbereichs. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/3F" +% SEITE 1 +Fremder Taskzustand +- +Ausgabe des Zustandes eines anderen Arbeitsbereichs. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "FLINT/3A" +% SEITE 1 +Taskzustand aller Bereiche +- +Verlassen mit ESC 'q'. +% SEITE 1 "FLINT/Allgemein" +% ENDE +% HILFE "TEXTE/Allgemein" +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "TEXTE/1E" +% SEITE 1 +Textdatei eingeben +- +Aufruf des Editors. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/1D" +% SEITE 1 +Textdatei drucken +- +Erstellte Datei ausdrucken lassen. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/1Z" +% SEITE 1 +Zeilenweise formatieren +- +Aufruf von 'lineform' oder 'autoform', je nach Einstellung. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/1S" +% SEITE 1 +Seitenweise formatieren +- +Aufruf von 'pageform' oder 'autopageform', je nach +Einstellung. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/1A" +% SEITE 1 +Einstellen automatische Formatierung +- +Abfrage, ob Zeilen- bzw. Seitenformatierung automatisch oder +interaktiv erfolgen sollen. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/2I" +% SEITE 1 +Index extrahieren +- +Aufruf von 'index' +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/2G" +% SEITE 1 +Gliederung extrahieren +- +Aufruf von 'outline' +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/2S" +% SEITE 1 +Textdatei sortieren +- +Aufruf von 'sort' bzw. 'lexsort'. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/2L" +% SEITE 1 +Makros laden +- +Aufruf von 'load macros'. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/2A" +% SEITE 1 +Makros anzeigen +- +Aufruf von 'list macros' +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/2E" +% SEITE 1 +Ausnahmen erweitern +- +Anzeigen des Ausnahmelexikons für die Silbentrennung und +Erfassung neuer Ausnahmen +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/3T" +% SEITE 1 +Schrifttypentabelle einstellen +- +Einstellen der Schrifttyptabelle für den Drucker, mit dem +der Text ausgedruckt werden soll. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/3Z" +% SEITE 1 +Schrifttypen zeigen +- +Anzeige der zur Verfügung stehenden Schriften. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/3D" +% SEITE 1 +Drucker einstellen +- +Einstellen der Druckertask, auf der ausgedruckt werden soll. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/3F" +% SEITE 1 +Trennfaktor Silbentrennung +- +Setzt 'hyphenation width'. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/3B" +% SEITE 1 +Briefmodus Kopf/Fußzeilen +- +Erfragt ob der erste Kopf und der letzte Fuß wie in einem +Brief unterdrückt werden sollen. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "TEXTE/3A" +% SEITE 1 +Abstand Fußnoten +- +Setzt Anzahl Zeilen zwischen Text und Fußnoten. +% SEITE 1 "TEXTE/Allgemein" +% ENDE +% HILFE "PROG/Allgemein" +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "PROG/1E" +% SEITE 1 +Programm editieren +- +Erstellen und Ändern im Editor. +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "PROG/1A" +% SEITE 1 +Programm ausführen +- +'run' +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "PROG/1W" +% SEITE 1 +Programmausführeung wiederholen +- +'runagain' +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "PROG/1D" +% SEITE 1 +Programm drucken +- +'print' +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "PROG/1T" +% SEITE 1 +Testinstallation +- +'insert' mit check on. +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "PROG/2I" +% SEITE 1 +Programm installieren +- +'insert' mit check off +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "PROG/2P" +% SEITE 1 +Übersicht Prozeduren +- +'help (TEXT)' +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "PROG/2A" +% SEITE 1 +Übersicht Paket +- +'bulletin (TEXT)' +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "PROG/2N" +% SEITE 1 +Übersicht Paketnamen +- +packets +% SEITE 1 "PROG/Allgemein" +% ENDE +% HILFE "AUSWAHL/Tasks" +% SEITE 1 +Auswahl der Arbeitsbereiche +- +Den Bereich ankreuzen, in dem forgefahren werden soll. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "GET/Taskname" +% SEITE 1 +Name des Bereichs: +- +Namen des Bereichs eingeben, dessen Status abgefragt werden +soll. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/wtaskname" +% SEITE 1 +Name des Bereichs, in dem weitergemacht werden soll: +- +Existiert der Bereich noch nicht, wird er nach Anfrage +eingerichtet. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Vatertask" +% SEITE 1 +Name des Vaterbereichs: +- +Jeder Bereich muß einen Vaterbereich haben, der angibt, +welche Programme zur Verfügung stehen. Geben Sie keinen +Namen an, wird FLINT als der allgemeine Vater genommen. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Druckertask" +% SEITE 1 +Name der Druckertask: +- +Ist normalerweise PRINTER. Die Station bei Netzbetrieb kann +später eingegeben werden. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Druckstation" +% SEITE 1 +Stationsnummer der Druckertask: +- +Bei Netzbetrieb zum Drucken auf einem anderen Rechner. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Trennfaktor" +% SEITE 1 +Trennfaktor: +- +s. 'hyphenation width' +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Fussabstand" +% SEITE 1 +Leerzeilen vor Fuß: +- +s. 'no empty lines before foot' +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/prozedurname" +% SEITE 1 +Name der Prozedur: +- +kann auch '*' enthalten. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/paketname" +% SEITE 1 +Name des Paketes: +- +Angabe des Namens eines insertierten Pakets. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "JA/Task loeschen" +% SEITE 1 +Bereich verlassen und löschen ? +- +Bei Bejahen wird ein neuer Bereich erfragt und der jetzige +Bereich nach dem Verlassen mit allen Dateien und Söhnen +gelöscht. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/task einrichten" +% SEITE 1 +Bereich neu einrichten ? +- +Bei Tippfehler oder Irrtum verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/abkoppeln" +% SEITE 1 +Ganz abkoppeln ? +- +Bei Tippfehler oder Irrtum verneinen. Ansonsten weiter mit +SV. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/lineform manuell" +% SEITE 1 +Zeilen manuell formatieren ? +- +Bei Bejahen muß jede Trennung von Hand bestätigt werden. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/pageform manuell" +% SEITE 1 +Seiten manuell formatieren ? +- +Bei Bejahen muß jede Seitentrennung von Hand bestätigt +werden. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/firsthead" +% SEITE 1 +Ersten Kopf unterdrücken ? +- +s. 'firsthead' +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/lastbottom" +% SEITE 1 +Letzten Fuß unterdrücken ? +- +s. 'last bottom' +% SEITE 1 "JA/Allgemein" +% ENDE + diff --git a/app/flint/0.4/src/flint.manager b/app/flint/0.4/src/flint.manager new file mode 100644 index 0000000..610d70f --- /dev/null +++ b/app/flint/0.4/src/flint.manager @@ -0,0 +1,16 @@ +PACKET flint manager (* Autor: Thomas Berlage *) + (* Stand: 15.01.88 *) + DEFINES + + continue : + + +PROC continue (TASK CONST t) : + + continue (t, + PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) eudas manager) + +END PROC continue; + +END PACKET flint manager; + diff --git a/app/flint/0.4/src/isub.replace b/app/flint/0.4/src/isub.replace new file mode 100644 index 0000000..3c48009 --- /dev/null +++ b/app/flint/0.4/src/isub.replace @@ -0,0 +1,19 @@ +PACKET isub replace DEFINES ISUB, replace : + +INT OP ISUB (TEXT CONST t, INT CONST i) : + + INT CONST ii := i + i; + code (t SUB ii - 1) + 256 * code (t SUB ii) + +END OP ISUB; + +PROC replace (TEXT VAR t, INT CONST i, wert) : + + INT CONST ii := i + i; + replace (t, ii - 1, code (wert MOD 256)); + replace (t, ii, code (wert DIV 256 MOD 256)) + +END PROC replace + +END PACKET isub replace; + diff --git a/app/flint/0.4/src/klartextbelegung b/app/flint/0.4/src/klartextbelegung new file mode 100644 index 0000000..efe4b08 --- /dev/null +++ b/app/flint/0.4/src/klartextbelegung @@ -0,0 +1,304 @@ +(*************************************************************************) +(* *) +(* K L A R T E X T *) +(* =============== *) +(* *) +(* Tastenbelegungen im Klartext fuer Steuertasten *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 27.04.88 *) +(* Version 1.0 *) +(* *) +(* Zweck: Lernsequenzen koennen editiert werden, wobei fuer *) +(* die Steuertasten symbolische Namen in spitzen *) +(* Klammern verwendet werden. Folgende Namen sind *) +(* zulaessig: *) +(* *) +(* *) +(* *) +(* *) +(* Aufruf: *) +(* PROC lernsequenz editieren (TEXT CONST taste) *) +(* *) +(**************************************************************************) +PACKET case conversion (* Stand: 07.02.88 *) + + DEFINES + + to lowercase, + to uppercase : + + +PROC to uppercase (TEXT VAR line) : + + INT VAR p := 0; + REP + p := pos (line, "a", "z", p + 1); + IF p = 0 THEN LEAVE to uppercase END IF; + replace (line, p, code (code (line SUB p) - 32)) + END REP + +END PROC to uppercase; + +PROC to lowercase (TEXT VAR line) : + + INT VAR p := 0; + REP + p := pos (line, "A", "Z", p + 1); + IF p = 0 THEN LEAVE to lowercase END IF; + replace (line, p, code (code (line SUB p) + 32)) + END REP + +END PROC to lowercase; + +END PACKET case conversion; + +PACKET klartextbelegung + + DEFINES + + sieben bit modus, + klartext, + kodierung : + + +BOOL VAR sieben bit := TRUE; + +ROW 33 TEXT CONST tasten := ROW 33 TEXT : ( + "nul", "hop", "rechts", "oben", "-(4)", "fkt1", "fkt2", "-(7)", "links", + "tab", "unten", "rubin", "rubout", "return", "fkt3", "fkt4", "mark", + "-(17)", "-(18)", "-(19)", "-(20)", "fkt5", "fkt6", "-(23)", "fkt7", + "fkt8", "fkt9", "esc", "fkt10", "fkt11", "fkt12", "fkt13", "blank"); + +LET + separator anfang = "<", + separator ende = ">"; + +TEXT VAR ergebnis; + + +BOOL PROC sieben bit modus : + + sieben bit + +END PROC sieben bit modus; + +PROC sieben bit modus (BOOL CONST modus) : + + sieben bit := modus + +END PROC sieben bit modus; + +TEXT PROC klartext (TEXT CONST t) : + + INT VAR i; + ergebnis := ""; + FOR i FROM 1 UPTO length (t) REP + klartext eines zeichens bestimmen + END REP; + ergebnis . + +klartext eines zeichens bestimmen : + INT CONST c := code (t SUB i); + IF c < 33 THEN + ergebnis CAT separator anfang + tasten (c + 1) + separator ende + ELIF c >= 127 CAND sieben bit CAND kein umlaut THEN + ergebnis CAT separator anfang + text (c) + separator ende + ELSE + ergebnis CAT code (c) + END IF . + +kein umlaut : + pos (eumel sonderzeichen, code (c)) = 0 . + +eumel sonderzeichen : + ""214""215""216""217""218""219""220""221""222""223""251""252"" . + +END PROC klartext; + +TEXT PROC kodierung (TEXT CONST t) : + + INT VAR + sep pos := pos (t, separator anfang), + sep ende := 0; + + enable stop; + ergebnis := ""; + WHILE sep pos > 0 REP + text vor separator uebernehmen; + separiertes zeichen behandeln; + sep pos := pos (t, separator anfang, sep ende) + END REP; + restliche zeichen uebernehmen; + ergebnis . + +text vor separator uebernehmen : + ergebnis CAT subtext (t, sep ende + 1, sep pos - 1) . + +separiertes zeichen behandeln : + sep ende := pos (t, separator ende, sep pos); + IF sep ende = 0 THEN + errorstop ("""" + separator ende + """ fehlt.") + ELSE + separiertes zeichen kodieren + END IF . + +separiertes zeichen kodieren : + TEXT VAR bezeichnung := subtext (t, sep pos + 1, sep ende - 1); + change all (bezeichnung, " ", ""); + to lowercase (bezeichnung); + INT VAR c := int (bezeichnung); + IF keine zahl THEN + mit tabelle vergleichen + END IF; + ergebnis CAT code (c) . + +keine zahl : + NOT last conversion ok . + +mit tabelle vergleichen : + INT VAR i; + FOR i FROM 1 UPTO 33 REP + IF bezeichnung = tasten (i) THEN + c := i - 1; + LEAVE mit tabelle vergleichen + END IF + END REP; + errorstop ("unbekannte Tastenbezeichnung: """ + bezeichnung + """") . + +restliche zeichen uebernehmen : + ergebnis CAT subtext (t, sep ende + 1) . + +END PROC kodierung; + +END PACKET klartextbelegung; + +PACKET klartext anwendung + + DEFINES + + klartext auf taste, + klartext auf taste legen, + klartext aus file, + klartext in file, + lernsequenz editieren : + + +LET + separator anfang = "<", + separator ende = ">"; + +TEXT VAR + zeile, + sequenz, + aenderung; + +DATASPACE VAR + ds; + + +TEXT PROC klartext auf taste (TEXT CONST taste) : + + klartext (lernsequenz auf taste (kodierung (taste))) + +END PROC klartext auf taste; + +PROC klartext auf taste legen (TEXT CONST taste, belegung) : + + lernsequenz auf taste legen (kodierung (taste), kodierung (belegung)) + +END PROC klartext auf taste legen; + +PROC klartext in file (FILE VAR f, TEXT CONST belegung) : + + INT VAR + ende, + anfang := 1; + + output (f); + zeile := klartext (belegung); + REP + ende der zeile bestimmen; + putline (f, subtext (zeile, anfang, ende - 1)); + anfang := ende + UNTIL anfang > length (zeile) END REP . + +ende der zeile bestimmen : + TEXT CONST zeichen := subtext (zeile, anfang, anfang + 4); + IF zeichen = "" OR zeichen = "" THEN + ende := pos (zeile, separator anfang, anfang + 6) + ELSE + ende := pos (zeile, separator anfang, anfang + 1) + END IF; + IF ende = 0 THEN ende := length (zeile) + 1 END IF; + ende := min (anfang + maxlinelength (f), ende) . +(* + IF (ende - anfang) > maxlinelength (f) THEN + ende := anfang + maxlinelength (f) + ELIF ende > 5 THEN + letzten separator bestimmen + END IF . + +letzten separator bestimmen : + TEXT CONST zeichen := subtext (zeile, ende - 4, ende - 2); + IF zeichen = "esc" OR zeichen = "hop" THEN + ende verschieben + ELSE + ende := pos (zeile, separator ende, ende) + END IF . + +ende verschieben : + IF (zeile SUB ende + 5) = separator anfang THEN + ende := pos (zeile, separator ende, ende + 5); + IF ende = 0 THEN ende := length (zeile) END IF + ELSE + ende := ende + 5 + END IF . + *) +END PROC klartext in file; + +PROC klartext aus file (FILE VAR f, TEXT VAR belegung) : + + input (f); + belegung := ""; + WHILE NOT eof (f) REP + getline (f, zeile); + IF (zeile SUB LENGTH zeile) = " " THEN + zeile := subtext (zeile, 1, length (zeile) - 1) + END IF; + belegung CAT kodierung (zeile) + END REP . + +END PROC klartext aus file; + +PROC lernsequenz editieren (TEXT CONST taste) : + + disable stop; + ds := nilspace; + editieren (taste); + forget (ds) + +END PROC lernsequenz editieren; + +PROC editieren (TEXT CONST taste) : + + enable stop; + FILE VAR f := sequential file (output, ds); + sequenz := lernsequenz auf taste (taste); + klartext in file (f, sequenz); + headline (f, "Tastenbelegung"); + edit (f); + klartext aus file (f, aenderung); + IF aenderung <> sequenz CAND wirklich aendern THEN + lernsequenz auf taste legen (taste, aenderung) + END IF . + +wirklich aendern : + yes ("Lernsequenz aendern") . + +END PROC editieren; + +END PACKET klartext anwendung; + + + diff --git a/app/flint/0.4/src/offline.1 b/app/flint/0.4/src/offline.1 new file mode 100644 index 0000000..0e3e097 --- /dev/null +++ b/app/flint/0.4/src/offline.1 @@ -0,0 +1,5 @@ +PACKETofflinemanagerDEFINESbegin,deferredend,owntaskpassword,continuedfrom,continue,partnertask:LETb0=0,c0=1,d0=2,e0=5,f0=6,g0=4,h0=9,i0=100,j0=199;LETk0="Taskname ungültig",l0="Vater antwortet nicht",m0="Zieltask kann nicht direkt angekoppelt werden",n0="Passwort:",o0="Falsches Passwort",p0="Ankoppeln nur für Partnertasks",q0="Nur Partner können angekoppelt werden";BOOL VARr0:=FALSE,s0:=FALSE;TEXT VARt0:="";DATASPACE VARu0:=nilspace;INT VARv0,w0,x0,y0,z0;BOUND TEXT VARa1;BOUND STRUCT(TEXTb1,c1,TASKtask,PROCAd1)VARe1;TASK VARf1,g1:=niltask;ROW4TASK VARh1;INITFLAG VARi1;PROCbegin(TEXT CONSTj1,k1):enablestop;l1;IFj1="-"THENerrorstop(k0)END IF;m1;IFv0=h0THENe1:=u0;n1;call(task(k1),g0,u0,v0)END IF;IFv0=b0THEN TASK CONSTo1:=task(j1);forget(u0);p1ELIFv0=d0THENa1:=u0;disablestop;errorstop(CONCR(a1));forget(u0)ELSEforget(u0)END IF.m1:INT VARq1;forget(u0);u0:=nilspace;e1:=u0;CONCR(e1).b1:=j1;CONCR(e1).c1:="";FORq1FROM1UPTO5REPpingpong(task(k1),g0,u0,v0);IFv0=-2THENpause(5)END IF UNTILv0<>-2END +REP;IFv0=-2THENerrorstop(l0)END IF.n1:dialog(n0);getsecretline(CONCR(e1).c1);covertracks.p1:WHILEstatus(o1)<>2REPpause(10)END REP.END PROCbegin;PROCdeferredend:s0:=TRUE END PROCdeferredend;PROCowntaskpassword(TEXT CONSTword):t0:=length(t0)*" ";t0:=word;covertracksEND PROCowntaskpassword;TASK PROCcontinuedfrom:g1END PROCcontinuedfrom;PROCr1(TASK CONSTs1,PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)t1):enablestop;IFisniltask(s1)THENbreak;disablestopELSEu1END IF;v1;WHILE NOTonlineREPw1;x1;y1END REP;z1.u1:INT CONSTa2:=channel;b2;break(quiet);c2.b2:INT VARq1;forget(u0);u0:=nilspace;FORq1FROM1UPTO5REPpingpong(s1,j0,u0,v0);IFv0=-2THENpause(5)END IF UNTILv0<>-2END REP;d2;IFv0=f0THENe2ELIFv0=b0THENf2ELSEerrorstop(m0)END IF.d2:forget(u0);u0:=nilspace;a1:=u0.e2:dialog(n0);getsecretline(CONCR(a1));covertracks.f2:CONCR(a1):="".c2:FORq1FROM1UPTO5REPpingpong(s1,i0+a2,u0,v0);IFv0=-2THENpause(5)END IF UNTILv0<>-2END REP;disablestop;forget(u0);IFv0<>b0THENcontinue(a2)END IF.v1:IFs0OR(r0CAND NOT +exists(h1(1)))THENend(myself)END IF.w1:TEXT VARg2;IFiserrorTHENg2:=errormessage;clearerrorELSEg2:=""END IF.x1:setautonom;commanddialogue(FALSE);INT VARh2:=heapsize;g1:=niltask.y1:DATASPACE VARi2:=nilspace;REPwait(i2,w0,f1);IFw0<>e0THENj2;k2ELIFf1=g1THENl2;t1(i2,w0,z0,f1)ELSEm2END IF;n2;o2END REP.j2:z0:=1;y0:=w0;g1:=f1.l2:z0INCR1;w0:=y0.m2:forget(i2);i2:=nilspace;send(f1,c0,i2).n2:IFiserrorTHENforget(i2);i2:=nilspace;a1:=i2;CONCR(a1):=errormessage;clearerror;send(f1,d0,i2)END IF.o2:IFheapsize>h2+8THENcollectheapgarbage;h2:=heapsizeEND IF.k2:IFw0=j0THENp2ELIFw0>i0ANDw0"".q2:s2;t2;call(supervisor,w0,i2,v0);IF NOT(f1=supervisor)THENsend(f1,v0,i2)END IF;IFv0=b0THENforget(i2);LEAVEy1END IF.s2:IFr0CAND NOTu2(f1)ORx0>0CANDw0-i0<>x0THENerrorstop(p0);LEAVEq2END IF.t2:IF NOT(f1=supervisor)THENa1:=i2;IF CONCR(a1)<>t0THENerrorstop(o0);LEAVEq2END IF END IF.z1:IFg2<>""THENerrorstop(g2)END IF;commanddialogue +(TRUE).END PROCr1;PROCcontinue(TASK CONSTs1,PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)t1):enablestop;l1;x0:=0;IFs1=myselfTHEN ELIFr0THEN IF NOTu2(s1)THENerrorstop(q0)END IF ELIFu2(s1)THENx0:=channelEND IF;r1(s1,PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)t1)END PROCcontinue;BOOL PROCu2(TASK CONSTs1):NOTisniltask(s1)CAND(s1=h1(1)ORs1=h1(2)ORs1=h1(3)ORs1=h1(4))END PROCu2;TASK PROCpartnertask(INT CONSTindex):l1;h1(index)END PROCpartnertask;PROCpartnertask(INT CONSTindex,TASK CONSTs1):l1;h1(index):=s1;IFindex=1CAND NOT(s1=myself)THENr0:=TRUE END IF END PROCpartnertask;PROCl1:IF NOTinitialized(i1)THENv2END IF.v2:h1(1):=niltask;h1(2):=niltask;h1(3):=niltask;h1(4):=niltask.END PROCl1;END PACKETofflinemanager; + diff --git a/app/flint/0.4/src/offline.manager b/app/flint/0.4/src/offline.manager new file mode 100644 index 0000000..7f97421 --- /dev/null +++ b/app/flint/0.4/src/offline.manager @@ -0,0 +1,383 @@ +PACKET offline manager (* Autor: Thomas Berlage *) + (* Stand: 20.01.88 *) + DEFINES + + begin, + deferred end, + own task password, + continued from, + continue, + partner task : + + +LET + ack = 0, + nak = 1, + error nak = 2, + second phase ack = 5, + password ack = 6, + + begin code = 4, + password code = 9, + + continue code = 100, + ask for password code = 199; + +LET + taskname invalid = + "Taskname ungültig", + task not ready = + "Vater antwortet nicht", + direct continue impossible = + "Zieltask kann nicht direkt angekoppelt werden", + t password = + "Passwort:", + t wrong password = + "Falsches Passwort", + order task no partner = + "Ankoppeln nur für Partnertasks", + continue not partner = + "Nur Partner können angekoppelt werden"; + + +BOOL VAR + controlled mode := FALSE, + end myself := FALSE; + +TEXT VAR + own password := ""; + +DATASPACE VAR ds := nilspace; + +INT VAR + reply, + order, + control channel, + last order, + phase number; + +BOUND TEXT VAR reply message; + +BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg; + +TASK VAR + order task, + last order task := niltask; + +ROW 4 TASK VAR pt; + +INITFLAG VAR pt init; + + + +PROC begin (TEXT CONST task name, father name) : + + enable stop; + init partner; + IF task name = "-" THEN + errorstop (taskname invalid) + END IF; + call begin code; + IF reply = password code THEN + sv msg := ds; + get password; + call (task (father name), begin code, ds, reply) + END IF; + IF reply = ack THEN + TASK CONST new task := task (task name); + forget (ds); + wait for init + ELIF reply = error nak THEN + reply message := ds; + disable stop; + errorstop (CONCR (reply message)); + forget (ds) + ELSE + forget (ds) + END IF . + +call begin code : + INT VAR i; + forget (ds); ds := nilspace; + sv msg := ds; + CONCR (sv msg). tname := task name; + CONCR (sv msg). tpass := ""; + FOR i FROM 1 UPTO 5 REP + pingpong (task (father name), begin code, ds, reply); + IF reply = -2 THEN pause (5) END IF + UNTIL reply <> -2 END REP; + IF reply = -2 THEN + errorstop (task not ready) + END IF . + +get password : + dialog (t password); + get secret line (CONCR (sv msg). tpass); + cover tracks . + +wait for init : + WHILE status (new task) <> 2 REP pause (10) END REP . + +END PROC begin; + +PROC deferred end : + + end myself := TRUE + +END PROC deferred end; + +PROC own task password (TEXT CONST word) : + + own password := length (own password) * " "; + own password := word; + cover tracks + +END PROC own task password; + +TASK PROC continued from : + + last order task + +END PROC continued from; + +PROC i continue (TASK CONST t, + PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) manager) : + + enable stop; + IF is niltask (t) THEN + break; + disable stop + ELSE + ask for continue + END IF; + end if required; + WHILE NOT online REP + remember error message; + prepare manager; + wait for order + END REP; + repeat error message . + +ask for continue : + INT CONST my channel := channel; + ask if password required; + break (quiet); + send continue request . + +ask if password required : + INT VAR i; + forget (ds); ds := nilspace; + FOR i FROM 1 UPTO 5 REP + pingpong (t, ask for password code, ds, reply); + IF reply = -2 THEN pause (5) END IF + UNTIL reply <> -2 END REP; + init password ds; + IF reply = password ack THEN + get password from user + ELIF reply = ack THEN + set password empty + ELSE + errorstop (direct continue impossible) + END IF . + +init password ds : + forget (ds); + ds := nilspace; + reply message := ds . + +get password from user : + dialog (t password); + get secret line (CONCR (reply message)); + cover tracks . + +set password empty : + CONCR (reply message) := "" . + +send continue request : + FOR i FROM 1 UPTO 5 REP + pingpong (t, continue code + my channel, ds, reply); + IF reply = -2 THEN pause (5) END IF + UNTIL reply <> -2 END REP; + disable stop; + forget (ds); + IF reply <> ack THEN + continue (my channel) + END IF . + +end if required : + IF end myself OR (controlled mode CAND NOT exists (pt (1))) THEN + end (myself) + END IF . + +remember error message : + TEXT VAR stored error; + IF is error THEN + stored error := error message; + clear error + ELSE + stored error := "" + END IF . + +prepare manager : + set autonom; + command dialogue (FALSE); + INT VAR old heap size := heap size; + last order task := niltask . + +wait for order : + DATASPACE VAR local ds := nilspace; + REP + wait (local ds, order, order task); + IF order <> second phase ack THEN + prepare first phase; + manager with end check + ELIF order task = last order task THEN + prepare second phase; + manager (local ds, order, phase number, order task) + ELSE + send nak + END IF; + send error if necessary; + collect heap garbage if necessary + END REP . + +prepare first phase : + phase number := 1; + last order := order; + last order task := order task . + +prepare second phase : + phase number INCR 1; + order := last order . + +send nak : + forget (local ds); + local ds := nilspace; + send (order task, nak, local ds) . + +send error if necessary : + IF is error THEN + forget (local ds); + local ds := nilspace; + reply message := local ds; + CONCR (reply message) := error message; + clear error; + send (order task, error nak, local ds) + END IF . + +collect heap garbage if necessary : + IF heap size > old heap size + 8 THEN + collect heap garbage; + old heap size := heap size + END IF . + +manager with end check : + IF order = ask for password code THEN + answer if password required + ELIF order > continue code AND order < continue code + 16 THEN + try continue channel + ELSE + manager (local ds, order, phase number, order task) + END IF . + +answer if password required : + IF password required THEN + send (order task, password ack, local ds) + ELSE + send (order task, ack, local ds) + END IF . + +password required : + own password <> "" . + +try continue channel : + check control; + check password; + call (supervisor, order, local ds, reply); + IF NOT (order task = supervisor) THEN + send (order task, reply, local ds) + END IF; + IF reply = ack THEN + forget (local ds); + LEAVE wait for order + END IF . + +check control : + IF controlled mode CAND NOT is partner (order task) OR + control channel > 0 CAND order - continue code <> control channel THEN + errorstop (order task no partner); + LEAVE try continue channel + END IF . + +check password : + IF NOT (order task = supervisor) THEN + reply message := local ds; + IF CONCR (reply message) <> own password THEN + errorstop (t wrong password); + LEAVE try continue channel + END IF + END IF . + +repeat error message : + IF stored error <> "" THEN errorstop (stored error) END IF; + command dialogue (TRUE) . + +END PROC i continue; + +PROC continue (TASK CONST t, + PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) manager) : + + enable stop; + init partner; + control channel := 0; + IF t = myself THEN + (* do nothing *) + ELIF controlled mode THEN + IF NOT is partner (t) THEN errorstop (continue not partner) END IF + ELIF is partner (t) THEN + control channel := channel + END IF; + i continue (t, + PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) manager) + +END PROC continue; + +BOOL PROC is partner (TASK CONST t) : + + NOT is niltask (t) CAND + (t = pt (1) OR t = pt (2) OR t = pt (3) OR t = pt (4)) + +END PROC is partner; + +TASK PROC partner task (INT CONST index) : + + init partner; + pt (index) + +END PROC partner task; + +PROC partner task (INT CONST index, TASK CONST t) : + + init partner; + pt (index) := t; + IF index = 1 CAND NOT (t = myself) THEN + controlled mode := TRUE + END IF + +END PROC partner task; + +PROC init partner : + + IF NOT initialized (pt init) THEN + do init + END IF . + +do init : + pt (1) := niltask; pt (2) := niltask; + pt (3) := niltask; pt (4) := niltask . + +END PROC init partner; + + +END PACKET offline manager; + diff --git a/app/flint/0.4/src/operator b/app/flint/0.4/src/operator new file mode 100644 index 0000000..029b32c --- /dev/null +++ b/app/flint/0.4/src/operator @@ -0,0 +1,381 @@ +PACKET operator DEFINES (* Autor: Thomas Berlage *) + (* Stand: 15.01.88 *) + operator : + + + +LET + p neuer taskname = #2001# + "Weitermachen in Bereich:", + p name vater = #2002# + "Unter welchem Vater:", + t bereich = #2003# + ""15"Bereich "14"", + t datum = #2004# + ""15"Datum "14"", + f ganz abkoppeln = #2005# + "Arbeitsbereich ganz abkoppeln", + f arbeitsbereich neu einrichten = #2006# + "Arbeitsbereich existiert nicht. Neu einrichten", + f trotzdem abschalten = #2007# + "Nicht auf Terminal 1. Trotzdem abschalten", + kb von = #2008# + " KB von ", + sind belegt = #2009# + " KB sind belegt.", + p taskname = #2010# + "Name des Arbeitsbereichs:", + existiert nicht als task = #2011# + " ist kein Name eines Bereiches", + t loeschen = #2012# + " löschen", + t speicher = #2013# + "Speicher:", + t cpu zeit = #2014# + " KB CPU-Zeit : ", + t zustand = #2015# + "Zustand : ", + t prio = #2016# + " Priorität: ", + t kanal = #2017# + " Kanal: ", + t busy = #2018# + "Arbeit", + t io = #2019# + "EinAus", + t wait = #2020# + "Warten", + t busy blocked = #2021# + "B(Arb)", + t io blocked = #2022# + "B(E/A)", + t wait blocked = #2023# + "B(Wrt)", + t dead = #2024# + ">>TOT<", + t gestoppt = #2025# + "Druckertreiber gestoppt.", + t gestartet = #2026# + "Druckertreiber gestartet.", + t angehalten = #2027# + "Druckertreiber angehalten.", + f auf anhalten warten = #2028# + "Auf Anhalten des Treibers warten", + t drucker = #2029# + ""15"Drucker "14"", + p neuer printer = #2030# + "Welche Druckertask soll eingestellt werden:", + t bitte warten = #2031# + "Bitte warten .. "; + + +FENSTER VAR links, rechts; +fenster initialisieren (links);; +fenstergroesse setzen (links, 1, 2, 16, 22); +fenster initialisieren (rechts); +fenstergroesse setzen (rechts, 17, 2, 63, 22); +dialogfenster (rechts); + +TEXT VAR + druckertask := "PRINTER"; + + +PROC operator : + + TASK VAR letzte task; + TEXT VAR neuer name := ""; + continue (niltask); + REP + letzte task := continued from; + page; bildschirm neu; + disable stop; + operatormenue; + umschalten auf letzte task + END REP . + +operatormenue : + menue anbieten (ROW 6 TEXT : + ("OPERATOR.Abschalten", "OPERATOR.Systemzustand", "OPERATOR.Drucker", + "OPERATOR.Netz", "OPERATOR.Konfiguration", ""), + links, TRUE, PROC (INT CONST, INT CONST) op interpreter) . + +umschalten auf letzte task : + BOOL VAR first try; + IF exists (letzte task) CAND NOT (letzte task = supervisor) THEN + first try := TRUE; + continue (letzte task) + ELSE + first try := FALSE + END IF; + IF is error OR NOT first try THEN + REP + IF is error THEN fehler ausgeben END IF; + nach neuer task fragen; + zurueck in task + UNTIL NOT is error END REP + END IF . + +nach neuer task fragen : + REP + editget (p neuer taskname, neuer name, "", "GET/neuer taskname"); + UNTIL taskname akzeptiert END REP . + +taskname akzeptiert : + IF neuer name = "" THEN + ganz abkoppeln + ELSE + exists task (neuer name) COR neu einrichten + END IF . + +zurueck in task : + IF neuer name = "" THEN + continue (niltask) + ELIF exists task (neuer name) THEN + continue (task (neuer name)) + ELSE + TEXT VAR vater := ""; + editget (p name vater, vater, "", "GET/name vatertask"); + begin (neuer name, vater); + continue (task (neuer name)) + END IF . + +ganz abkoppeln : + ja (f ganz abkoppeln, "JA/ganz") . + +neu einrichten : + ja (f arbeitsbereich neu einrichten, "JA/task einrichten") . + +END PROC operator; + +PROC op interpreter (INT CONST menue nr, f nr) : + + enable stop; + SELECT menuenr OF + CASE 0 : sperren setzen + CASE 1 : abschalten inter + CASE 2 : systemzustand inter + CASE 3 : drucker inter + CASE 4 : netz inter + CASE 5 : konfiguration inter + END SELECT; + IF f nr = -1 THEN dialogfenster loeschen END IF . + +sperren setzen : + fusszeile (t bereich, "", 35, t datum, 64); + fussteil (1, name (myself)); + fussteil (3, date) . + +abschalten inter : + SELECT f nr OF + CASE 1 : abschalten + CASE 2 : (* nach DOS *) ni + CASE 3 : page; bildschirm neu; set date; dialogfenster loeschen + CASE 4 : page; bildschirm neu; save system + END SELECT . + +abschalten : + IF channel = 1 COR trotzdem abschalten THEN + page; + cursor (20, 11); out (t bitte warten); + cursor (20, 13); + shutup; + fenster veraendert (links); + push (""27"q") + END IF . + +trotzdem abschalten : + ja (f trotzdem abschalten, "JA/trotz shutup") . + +systemzustand inter : + SELECT f nr OF + CASE 1 : bereichsuebersicht + CASE 2 : speicherbelegung + CASE 3 : fremder taskstatus + CASE 4 : zustandsuebersicht + CASE 5 : task loeschen + END SELECT . + +bereichsuebersicht : + bitte warten; + disable stop; + DATASPACE VAR list ds := nilspace; + FILE VAR f := sequential file (output, list ds); + task info (1, f); + IF NOT is error THEN + show (f); bildschirm neu + END IF; + forget (list ds); + enable stop; + dialogfenster loeschen . + +speicherbelegung : + INT VAR size, used; + storage (size, used); + size := int (real (size + 24) * 64.0 / 63.0); + dialog (text (used) + kb von + text (size) + sind belegt) . + +fremder taskstatus : + TEXT VAR taskname := ""; + editget (p taskname, taskname, "GET/Taskname", ""); + TASK VAR status task := task (task name); + IF exists (status task) THEN + task zustand (status task) + ELSE + errorstop ("""" + taskname + """" + existiert nicht als task) + END IF . + +zustandsuebersicht : + bitte warten; task info (3); bildschirm neu; dialogfenster loeschen . + +task loeschen : + taskname := ""; + editget (p taskname, taskname, "GET/Taskname", ""); + IF ja ("""" + taskname + """" + t loeschen, + "JA/Task loeschen", FALSE) THEN + end (task (taskname)) + END IF . + +drucker inter : + SELECT f nr OF + CASE 0 : druckertask in fuss + CASE 1 : start (task (druckertask)); dialog (t gestartet) + CASE 2 : stop (task (druckertask)); dialog (t gestoppt) + CASE 3 : halt kommando + CASE 4 : list (task (druckertask)); bildschirm neu; dialogfenster loeschen + CASE 5 : first (task (druckertask)) + CASE 6 : killer (task (druckertask)) + CASE 7 : druckertask setzen + OTHERWISE ggf druckertask aus fuss + END SELECT . + +druckertask in fuss : + fussteil (2, t drucker, druckertask) . + +halt kommando : + IF ja (f auf anhalten warten, "JA/halt warten", FALSE) THEN + wait for halt (task (druckertask)) + ELSE + halt (task (druckertask)) + END IF; + dialog (t angehalten) . + +druckertask setzen : + TEXT VAR neuer printer := druckertask; + editget (p neuer printer, neuer printer, "", "GET/neuer printer"); + TASK CONST dummy := task (neuer printer); + druckertask := neuer printer; + fussteil (2, druckertask) . + +ggf druckertask aus fuss : + IF f nr = -1 THEN + fussteil (2, "", "") + END IF . + +netz inter : + SELECT f nr OF + CASE 1 : (* start *) ni + CASE 2 : (* stop *) ni + CASE 3 : (* zustand *) ni + CASE 4 : (* list (net.io) *) ni + END SELECT . + +konfiguration inter : + SELECT f nr OF + CASE 1 : konfigurieren + CASE 2 : (* drucker installieren *) ni + CASE 3 : (* netz installieren *) ni + CASE 4 : (* anwendung installieren *) ni + CASE 5 : (* systemprogramm installieren *) ni + END SELECT . + +konfigurieren : + THESAURUS VAR conf := ALL /"configurator"; + page; bildschirm neu; + forget quiet (conf); + fetch (conf, /"configurator"); + configurate; + line; + save ("configuration", /"configurator"); + forget quiet (conf); + dialogfenster loeschen . + +END PROC op interpreter; + +PROC task zustand (TASK CONST status task) : + + dialog (t speicher + speicher + t cpu zeit + cpu zeit); + out (t zustand); out status; out (t prio); out prio; + out (t kanal); out kanal . + +speicher : + text (storage (status task), 5) . + +cpu zeit : + disable stop; + TEXT VAR result := subtext (time (clock (status task), 12), 1, 10); + IF is error THEN + clear error; result := "**********" + END IF; + result . + +out status : + SELECT status (status task) OF + CASE 0 : out (t busy) + CASE 1 : out (t io) + CASE 2 : out (t wait) + CASE 4 : out (t busy blocked) + CASE 5 : out (t io blocked) + CASE 6 : out (t wait blocked) + OTHERWISE out (t dead) + END SELECT . + +out prio : + out (text (pcb (status task, 6))) . + +out kanal : + IF channel (status task) = 0 THEN + out (" -") + ELSE + out (text (channel (status task), 2)) + END IF . + +END PROC task zustand; + +PROC forget quiet (TEXT CONST datei) : + forget (datei, quiet) +END PROC forget quiet; + +PROC forget quiet (THESAURUS CONST t) : + do (PROC (TEXT CONST) forget quiet, t) +END PROC forget quiet; + +PROC bitte warten : + + cursor (1, 1); + out (t bitte warten); + out (""5"") + +END PROC bitte warten; + +PROC ni : + + dialog ("Zur Zeit nicht implementiert.") + +END PROC ni; + +END PACKET operator; + +PACKET operator monitor + + DEFINES + + monitor : + + +PROC monitor : + disable stop; + operator +END PROC monitor; + +END PACKET operator monitor; + diff --git a/app/flint/0.4/src/operator.1 b/app/flint/0.4/src/operator.1 new file mode 100644 index 0000000..b2235b2 --- /dev/null +++ b/app/flint/0.4/src/operator.1 @@ -0,0 +1,39 @@ +PACKEToperatormanagerDEFINESoperatormanager,continue:LETb0="Nur für Systemtasks zugelassen";PROCoperatormanager(DATASPACE VARc0,INT CONSTd0,e0,TASK CONSTf0):enablestop;IFf0=supervisorORf00.w0:ja(l0.k0+s0,"JA/spool control",t0).x0:call(q0,r0,j0,n0);IFn0=b0THENm0:=j0;errorstop(m0);FI;IFt0THEN LEAVEp0FI;END PROCp0;PROCkiller(TASK CONSTq0):p0(q0,d0," loeschen",FALSE)END PROCkiller;PROCfirst(TASK CONSTq0):p0(q0,e0," als erstes",TRUE)END PROCfirst;PROCstart(TASK CONSTq0):call(g0,"",q0);call(f0,"",q0);END PROCstart;PROCstop(TASK CONSTq0):call(g0,"",q0);END PROCstop;PROChalt(TASK CONSTq0):call(h0,"",q0);END PROChalt;PROCwaitforhalt(TASK CONSTq0):call(i0,"",q0);END PROCwaitforhalt;END PACKETspoolcmd; +PACKEToperatorDEFINESoperator:LETb0= +#2001#"Weitermachen in Bereich:",c0= +#2002#"Unter welchem Vater:",d0= +#2003#""15"Bereich "14"",e0= +#2004#""15"Datum "14"",f0= +#2005#"Arbeitsbereich ganz abkoppeln",g0= +#2006#"Arbeitsbereich existiert nicht. Neu einrichten",h0= +#2007#"Nicht auf Terminal 1. Trotzdem abschalten",i0= +#2008#" KB von ",j0= +#2009#" KB sind belegt.",k0= +#2010#"Name des Arbeitsbereichs:",l0= +#2011#" ist kein Name eines Bereiches",m0= +#2012#" löschen",n0= +#2013#"Speicher:",o0= +#2014#" KB CPU-Zeit : ",p0= +#2015#"Zustand : ",q0= +#2016#" Priorität: ",r0= +#2017#" Kanal: ",s0= +#2018#"Arbeit",t0= +#2019#"EinAus",u0= +#2020#"Warten",v0= +#2021#"B(Arb)",w0= +#2022#"B(E/A)",x0= +#2023#"B(Wrt)",y0= +#2024#">>TOT<",z0= +#2025#"Druckertreiber gestoppt.",a1= +#2026#"Druckertreiber gestartet.",b1= +#2027#"Druckertreiber angehalten.",c1= +#2028#"Auf Anhalten des Treibers warten",d1= +#2029#""15"Drucker "14"",e1= +#2030#"Welche Druckertask soll eingestellt werden:",f1= +#2031#"Bitte warten .. "; +FENSTER VARg1,h1;fensterinitialisieren(g1);;fenstergroessesetzen(g1,1,2,16,22);fensterinitialisieren(h1);fenstergroessesetzen(h1,17,2,63,22);dialogfenster(h1);TEXT VARi1:="PRINTER";PROCoperator:TASK VARj1;TEXT VARk1:="";continue(niltask);REPj1:=continuedfrom;page;bildschirmneu;disablestop;l1;m1END REP.l1:menueanbieten(ROW6TEXT:("OPERATOR.Abschalten","OPERATOR.Systemzustand","OPERATOR.Drucker","OPERATOR.Netz","OPERATOR.Konfiguration",""),g1,TRUE,PROC(INT CONST,INT CONST)n1).m1:BOOL VARo1;IFexists(j1)CAND NOT(j1=supervisor)THENo1:=TRUE;continue(j1)ELSEo1:=FALSE END IF;IFiserrorOR NOTo1THEN REP IFiserrorTHENfehlerausgebenEND IF;p1;q1UNTIL NOTiserrorEND REP END IF.p1:REPeditget(b0,k1,"","GET/neuer taskname");UNTILr1END REP.r1:IFk1=""THENs1ELSEexiststask(k1)CORt1END IF.q1:IFk1=""THENcontinue(niltask)ELIFexiststask(k1)THENcontinue(task(k1))ELSE TEXT VARu1:="";editget(c0,u1,"","GET/name vatertask");begin(k1,u1);continue(task(k1))END IF.s1:ja(f0,"JA/ganz").t1:ja(g0,"JA/task einrichten").END +PROCoperator;PROCn1(INT CONSTv1,w1):enablestop;SELECTv1OF CASE0:x1CASE1:y1CASE2:z1CASE3:a2CASE4:b2CASE5:c2END SELECT;IFw1=-1THENdialogfensterloeschenEND IF.x1:fusszeile(d0,"",35,e0,64);fussteil(1,name(myself));fussteil(3,date).y1:SELECTw1OF CASE1:d2CASE2:e2CASE3:page;bildschirmneu;setdate;dialogfensterloeschenCASE4:page;bildschirmneu;savesystemEND SELECT.d2:IFchannel=1CORf2THENpage;cursor(20,11);out(f1);cursor(20,13);shutup;fensterveraendert(g1);push(""27"q")END IF.f2:ja(h0,"JA/trotz shutup").z1:SELECTw1OF CASE1:g2CASE2:h2CASE3:i2CASE4:j2CASE5:k2END SELECT.g2:bittewarten;disablestop;DATASPACE VARl2:=nilspace;FILE VARf:=sequentialfile(output,l2);taskinfo(1,f);IF NOTiserrorTHENshow(f);bildschirmneuEND IF;forget(l2);enablestop;dialogfensterloeschen.h2:INT VARm2,n2;storage(m2,n2);m2:=int(real(m2+24)*64.0/63.0);dialog(text(n2)+i0+text(m2)+j0).i2:TEXT VARo2:="";editget(k0,o2,"GET/Taskname","");TASK VARp2:=task(o2);IFexists(p2)THENq2(p2)ELSEerrorstop(""""+o2+""""+l0)END IF.j2:bittewarten; +taskinfo(3);bildschirmneu;dialogfensterloeschen.k2:o2:="";editget(k0,o2,"GET/Taskname","");IFja(""""+o2+""""+m0,"JA/Task loeschen",FALSE)THENend(task(o2))END IF.a2:SELECTw1OF CASE0:r2CASE1:start(task(i1));dialog(a1)CASE2:stop(task(i1));dialog(z0)CASE3:s2CASE4:list(task(i1));bildschirmneu;dialogfensterloeschenCASE5:first(task(i1))CASE6:killer(task(i1))CASE7:t2OTHERWISEu2END SELECT.r2:fussteil(2,d1,i1).s2:IFja(c1,"JA/halt warten",FALSE)THENwaitforhalt(task(i1))ELSEhalt(task(i1))END IF;dialog(b1).t2:TEXT VARv2:=i1;editget(e1,v2,"","GET/neuer printer");TASK CONSTdummy:=task(v2);i1:=v2;fussteil(2,i1).u2:IFw1=-1THENfussteil(2,"","")END IF.b2:SELECTw1OF CASE1:e2CASE2:e2CASE3:e2CASE4:e2END SELECT.c2:SELECTw1OF CASE1:w2CASE2:e2CASE3:e2CASE4:e2CASE5:e2END SELECT.w2:THESAURUS VARx2:=ALL/"configurator";page;bildschirmneu;y2(x2);fetch(x2,/"configurator");configurate;line;save("configuration",/"configurator");y2(x2);dialogfensterloeschen.END PROCn1;PROCq2(TASK CONSTp2):dialog(n0+z2+o0+a3);out(p0);b3 +;out(q0);c3;out(r0);d3.z2:text(storage(p2),5).a3:disablestop;TEXT VARe3:=subtext(time(clock(p2),12),1,10);IFiserrorTHENclearerror;e3:="**********"END IF;e3.b3:SELECTstatus(p2)OF CASE0:out(s0)CASE1:out(t0)CASE2:out(u0)CASE4:out(v0)CASE5:out(w0)CASE6:out(x0)OTHERWISEout(y0)END SELECT.c3:out(text(pcb(p2,6))).d3:IFchannel(p2)=0THENout(" -")ELSEout(text(channel(p2),2))END IF.END PROCq2;PROCy2(TEXT CONSTf3):forget(f3,quiet)END PROCy2;PROCy2(THESAURUS CONSTg3):do(PROC(TEXT CONST)y2,g3)END PROCy2;PROCbittewarten:cursor(1,1);out(f1);out(""5"")END PROCbittewarten;PROCe2:dialog("Zur Zeit nicht implementiert.")END PROCe2;END PACKEToperator;PACKEToperatormonitorDEFINESmonitor:PROCmonitor:disablestop;operatorEND PROCmonitor;END PACKEToperatormonitor; + diff --git a/app/flint/0.4/src/operator.init b/app/flint/0.4/src/operator.init new file mode 100644 index 0000000..99d7c08 --- /dev/null +++ b/app/flint/0.4/src/operator.init @@ -0,0 +1,390 @@ +% MENUE "OPERATOR.Abschalten" +% BILD +Arbeit +  Beenden +- +Umschalten +  Neustart +- +Zeit/Datum +  Einstellen +- +Systemzustand +  Sichern auf + Diskette +% FELD 1 "OP/1B" "bB" +% FELD 2 "OP/1D" "nN" +% FELD 3 "OP/1E" "eE" +% FELD 4 "OP/1S" "sS" +% ENDE +% MENUE "OPERATOR.Systemzustand" +% BILD +Übersicht +  Bereiche +  Speicher +- +Taskzustand +  Ein Bereich +  Alle Tasks +- +Arbeitsbereich +  Löschen +% FELD 1 "OP/2B" "bB" +% FELD 2 "OP/2S" "sS" +% FELD 3 "OP/2E" "eE" +% FELD 4 "OP/2A" "aA" +% FELD 5 "OP/2L" "lL" +% ENDE +% MENUE "OPERATOR.Drucker" +% BILD +Druckertreiber +  Starten +  Abbrechen +  Halten +- +Aufträge +  Übersicht +  Vorziehen +  Löschen +- +Zieltreiber +  Einstellen +% FELD 1 "OP/3S" "sS" +% FELD 2 "OP/3A" "aA" +% FELD 3 "OP/3H" "hH" +% FELD 4 "OP/3U" "uUüÜ" +% FELD 5 "OP/3V" "vV" +% FELD 6 "OP/3L" "lL" +% FELD 7 "OP/3E" "eE" +% ENDE +% MENUE "OPERATOR.Netz" +% BILD +Netztreiber +  Starten +  Abbrechen +  Zustand +- +Übertragungen +  Übersicht +% FELD 1 "OP/4S" "sS" +% FELD 2 "OP/4A" "aA" +% FELD 3 "OP/4Z" "zZ" +% FELD 4 "OP/4U" "uUüÜ" +% ENDE +% MENUE "OPERATOR.Konfiguration" +% BILD +Konfigurieren +  Kanäle +- +Installieren +  Drucker +  Netz +  Anwendung +  Systemprog +% FELD 1 "OP/5K" "kK" +% FELD 2 "OP/5D" "dD" +% FELD 3 "OP/5N" "nN" +% FELD 4 "OP/5A" "aA" +% FELD 5 "OP/5S" "sS" +% ENDE +% HILFE "OP/Allgemein" +% SEITE 1 +MENÜBEDIENUNG +- +Das Menü dient zur Auswahl von Funktionen. Die Funktionen +sind durch einen vorangestellten Buchstaben gekennzeichnet. +Mit den Pfeiltasten können Sie die Markierung zu einer be­ +liebigen Position auf und ab bewegen. Diese Funktion können +Sie dann durch Drücken der Leertaste ausführen. Durch ESC '?' +(nachein-ander gedrückt) erhalten Sie Informationen zur +gerade markierten Funktion. +Funktionen, die im momentanen Zustand nicht ausgeführt werden +können, sind durch ein Minuszeichen gekennzeichnet. +In der obersten Bildschirmzeile sind weitere Menüs aufge­ +führt, die Sie aufrufen können. Das aktuelle Menü ist invers +markiert. Ein anderes Menü wählen Sie durch Drücken der +Pfeiltasten RECHTS oder LINKS. Wollen Sie das Programm wieder +verlassen, drücken Sie die ESC-Taste und 'q' hintereinander. +% ENDE +% HILFE "GET/Allgemein" +% SEITE 1 +EINGABE: +- +Die Eingabe erwartet von Ihnen eine bestimmte Information, +die Sie eingeben sollen. Die Art der Information wird durch +den Anforderungstext angegeben. Wenn Sie sich beim Eintippen +verschrieben haben, können Sie mit den Pfeiltasten zurück­ +gehen und den Text korrigieren. Eine bereits dastehende +Information können Sie überschreiben. RUBOUT löscht ein +Zeichen, RUBIN schaltet in den Einfügemodus (Zeichen werden +nicht mehr überschrieben). Beenden Sie die Eingabe mit +RETURN. ESC 'h' bricht die Eingabe und die folgende Funktion +ab. Wenn in der Statuszeile angegeben, können Sie mit ESC 'z' +eine Auswahl verfügbarer Namen abrufen, die Sie dann Ankreu­ +zen können. +% ENDE +% HILFE "FEHLER/Allgemein" +% SEITE 1 +FEHLERMELDUNGEN: +- +Fehlermeldungen werden von einem Programm abgesetzt, wenn es +seine Funktion nicht durchführen kann. Der Text der Meldung +identifiziert die Ursache des Problems. Zur Zeit liegen noch +keine meldungsspezifischen Informationen vor, schauen Sie +ggf. in das Benutzerhandbuch. +% ENDE +% HILFE "JA/Allgemein" +% SEITE 1 +FRAGEN: +- +Das Programm stellt Ihnen eine Frage, die Sie bejahen oder +verneinen können. Sie bejahen die Frage, indem Sie 'j' drük­ +ken und verneinen Sie mit 'n' (beides groß oder klein). Mit +ESC 'h' können Sie die Funktion abbrechen. +% ENDE +% HILFE "OP/1B" +% SEITE 1 +Arbeit Beenden +- +Führt 'shutup' aus. Nach dem Neustart wird das Operatormenü +automatisch verlassen und die Arbeit im letzten Bereich +wieder aufgenommen. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/1D" +% SEITE 1 +Umschalten nach DOS +- +Macht 'shutup' mit gleichzeitigem Neustart einer +DOS-Partition. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/1E" +% SEITE 1 +Zeit/Datum einstellen +- +Aufruf von 'set date'. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/1S" +% SEITE 1 +Sichern auf Diskette +- +Aufruf von 'save system'. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/2B" +% SEITE 1 +Übersicht Bereiche +- +Aufruf von 'task info'. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/2S" +% SEITE 1 +Übersicht Speicher +- +wie 'storage info'. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/2E" +% SEITE 1 +Taskzustand einer Task +- +'task status' einer Task. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/2A" +% SEITE 1 +Taskzustand aller Tasks +- +'task info (3)'. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/2L" +% SEITE 1 +Arbeitsbereich löschen +- +'end' +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/3S" +% SEITE 1 +Druckertreiber starten +- +'start' für die angezeigte Druckertask. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/3A" +% SEITE 1 +Druckertreiber abbrechen +- +'stop' für die angezeigte Druckertask +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/3H" +% SEITE 1 +Druckertreiber anhalten +- +'halt' bzw. 'wait for halt' für die angezeigte Druckertask. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/3U" +% SEITE 1 +Aufträge Übersicht +- +Übersicht über die Warteschlange der angezeigten +Druckertask. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/3V" +% SEITE 1 +Auftrag Vorziehen +- +'first' +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/3L" +% SEITE 1 +Auftrag Löschen +- +'killer' +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/3E" +% SEITE 1 +Zieltreiber einstellen +- +Angabe der Spooltask, die mit den Kommandos dieses Menüs +gesteuert werden soll. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/4S" +% SEITE 1 +Netztreiber starten +- +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/4A" +% SEITE 1 +Netztreiber Abbrechen +- +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/4Z" +% SEITE 1 +Zustand des Netztreibers +- +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/4U" +% SEITE 1 +Übersicht der laufenden Übertragungen +- +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/5K" +% SEITE 1 +Kanäle Konfigurieren +- +'configurate', ohne "configurator" zu betreten. +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/5D" +% SEITE 1 +Drucker Installieren +- +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/5N" +% SEITE 1 +Netz Installieren +- +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/5A" +% SEITE 1 +Anwendungsprogramm Installieren +- +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "OP/5S" +% SEITE 1 +Systemprogramm Installieren +- +% SEITE 1 "OP/Allgemein" +% ENDE +% HILFE "GET/neuer taskname" +% SEITE 1 +Name des gewünschten Arbeitsbereichs +- +Geben Sie den Namen des Arbeitsbereichs an, in dem Sie +arbeiten wollen. Falls der Bereich noch nicht existiert, +kann er eingerichtet werden. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/name vatertask" +% SEITE 1 +Name des Vaterbereichs +- +Ein neuer Arbeitsbereich muß unterhalb eines existierenden +Bereichs eingerichtet werden, der die zur Verfügung +stehenden Programme festlegt. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Taskname" +% SEITE 1 +Name des Arbeitsbereichs +- +Geben Sie den Namen des Arbeitsbereichs ein, dessen Status +Sie erfahren wollen. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/neuer printer" +% SEITE 1 +Name der Druckertask +- +Geben Sie den Namen des Bereichs an, der durch die Befehle +dieses menüs gesteuert werden kann. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "JA/ganz" +% SEITE 1 +Ganz abkoppeln ? +- +Wenn Sie keinen neuen Arbeitsbereich wollen oder spezielle +Arbeitsbereiche betreten wollen, können Sie sich jetzt +abkoppeln. Sie müssen dann mit SV fortfahren. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/task einrichten" +% SEITE 1 +Arbeitsbereich existiert nicht. Neu einrichten ? +- +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/trotz shutup" +% SEITE 1 +Nicht auf Kanal 1. +- +Wenn Sie nicht auf Kanal 1 abschalten, meldet sich das +System später auch wieder auf dem jetzigen Kanal. Das kann +Sie dann irritieren. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Task loeschen" +% SEITE 1 +Arbeitsbereich wirklich löschen +- +Zur Kontrolle. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/halt warten" +% SEITE 1 +Auf Anhalten warten ? +- +Wenn Sie die Frage bejahen, wartet das Programm bis zur +Abarbeitung des aktuellen Druckauftrags. +% SEITE 1 "JA/Allgemein" +% ENDE + diff --git a/app/flint/0.4/src/operator.manager b/app/flint/0.4/src/operator.manager new file mode 100644 index 0000000..fc9c31a --- /dev/null +++ b/app/flint/0.4/src/operator.manager @@ -0,0 +1,34 @@ +PACKET operator manager (* Autor: Thomas Berlage *) + (* Stand: 14.01.88 *) + DEFINES + + operator manager, + continue : + + +LET + only privileged = + "Nur für Systemtasks zugelassen"; + + +PROC operator manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + + enable stop; + IF order task = supervisor OR order task < supervisor THEN + menue manager (ds, order, phase, order task) + ELSE + errorstop (only privileged) + END IF + +END PROC operator manager; + +PROC continue (TASK CONST t) : + + continue (t, + PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) operator manager) + +END PROC continue; + +END PACKET operator manager; + diff --git a/app/flint/0.4/src/operator.spoolcmd b/app/flint/0.4/src/operator.spoolcmd new file mode 100644 index 0000000..921f1e3 --- /dev/null +++ b/app/flint/0.4/src/operator.spoolcmd @@ -0,0 +1,113 @@ +PACKET spool cmd (* Autor: R. Ruland *) + (* Stand: 01.04.86 *) + DEFINES killer, (* Be 14.01.88 *) + first, (* Umstellung Menue *) + start, + stop, + halt, + wait for halt : + +LET error nak = 2 , + + entry line code = 23 , + killer code = 24 , + first code = 25 , + start code = 26 , + stop code = 27 , + halt code = 28 , + wait for halt code = 29 ; + +DATASPACE VAR ds; + +BOUND STRUCT (TEXT entry line, INT index) VAR control msg; +BOUND TEXT VAR error msg ; + +INT VAR reply; + +INITFLAG VAR in this task := FALSE; + + +PROC control spool (TASK CONST spool, INT CONST control code, + TEXT CONST question, BOOL CONST leave) : + + enable stop; + initialize control msg; + WHILE valid spool entry + REP IF control question THEN control spool entry FI PER; + + . initialize control msg : + IF NOT initialized (in this task) THEN ds := nilspace FI; + forget (ds); ds := nilspace; control msg := ds; + control msg. entry line := ""; + control msg. index := 0; + (* say (""13""10"");*) + + . valid spool entry : + call (spool, entry line code, ds, reply); + IF reply = error nak + THEN error msg := ds; + errorstop (error msg); + FI; + control msg. index <> 0 + + . control question : + (* say (control msg. entry line); + yes (question) *) + ja (control msg. entry line + question, "JA/spool control", leave) + + . control spool entry : + call (spool, control code, ds, reply); + IF reply = error nak + THEN error msg := ds; + errorstop (error msg); + FI; + IF leave THEN LEAVE control spool FI; + +END PROC control spool; + + +PROC killer (TASK CONST spool) : + + control spool (spool, killer code, " loeschen", FALSE) + +END PROC killer; + + +PROC first (TASK CONST spool) : + + control spool (spool, first code, " als erstes", TRUE) + +END PROC first; + + +PROC start (TASK CONST spool) : + + call (stop code, "", spool); + call (start code, "", spool); + +END PROC start; + + +PROC stop (TASK CONST spool) : + + call (stop code, "", spool); + +END PROC stop; + + +PROC halt (TASK CONST spool) : + + call (halt code, "", spool); + +END PROC halt; + + +PROC wait for halt (TASK CONST spool) : + + call (wait for halt code, "", spool); + +END PROC wait for halt; + + +END PACKET spool cmd; + diff --git a/app/gs.dialog/1.2/doc/gs-dialog handbuch.impressum b/app/gs.dialog/1.2/doc/gs-dialog handbuch.impressum new file mode 100644 index 0000000..b470fe4 --- /dev/null +++ b/app/gs.dialog/1.2/doc/gs-dialog handbuch.impressum @@ -0,0 +1,89 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#gs-Dialog + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# + +#free (4.0)##on("b")# +#center#gs-Dialog + + +#center#Benutzerhandbuch + + +#center#Version 1.0 + + +#off("b")##center#copyright +#center#Eva Latta-Weber +#center#Software- und Hardware-Systeme, 1988 +#center#ERGOS GmbH, 1990 +#page# +#block# +#center#____________________________________________________________________________ + + +Copyright:  ERGOS GmbH   März 1990 + + Alle Rechte vorbehalten. Insbesondere ist die Überführung in + maschinenlesbare Form sowie das Speichern in Informations­ + systemen, auch auszugsweise, nur mit schriftlicher Einwilligung + der ERGOS GmbH gestattet. + + +#center#____________________________________________________________________________ + +Es kann keine Gewähr übernommen werden, daß das Programm für eine +bestimmte Anwendung geeignet ist. Die Verantwortung dafür liegt beim +Anwender. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrektheit und +Vollständigkeit der Angaben kann keine Gewähr übernommen werden. Das +Handbuch kann jederzeit ohne Ankündigung geändert werden. + +Texterstellung :  Dieser Text wurde mit der ERGOS-L3 Textverarbeitung + erstellt und aufbereitet und auf einem Kyocera Laser­ + drucker gedruckt. + + + + +#center#___________________________________________________________________________ + + + +Ergonomic Office Software GmbH + +Bergstr. 7 Telefon: (02241) 63075 +5200 Siegburg Teletex: 2627-2241413=ERGOS + Telefax: (02241) 63078 + + +#center#____________________________________________________________________________ + + diff --git a/app/gs.dialog/1.2/doc/gs-dialog-1 b/app/gs.dialog/1.2/doc/gs-dialog-1 new file mode 100644 index 0000000..59b98c3 --- /dev/null +++ b/app/gs.dialog/1.2/doc/gs-dialog-1 @@ -0,0 +1,107 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (3)# +#headodd# +#center#gs-DIALOG#right#% + +#end# +#headeven# +%#center#gs-DIALOG + +#end# + +#center#1 + +#center#Was kann gs-DIALOG? + + + + In diesem Kapitel wollen wir Ihnen erläutern, was +#on("b")#gs-DIALOG#off("b")# Ihnen für Vorteile bringen soll. Sie haben +sicher schon mit einem Computer gearbeitet und sich +mehrfach darüber geärgert, daß Sie mit jedem neuen Pro­ +gramm auch eine neue Bedienung erlernen müssen. Zwar +sind Sie als EUMEL-Anwender schon sehr verwöhnt, da das +System sehr homogen ist und bestimmte Systemelemente, +wie z.B. der Editor, mit immer gleicher Bedienung immer +wieder auftauchen. Für die jeweiligen Anwendungspro­ +gramme aber gibt es eine Reihe von Kommandos und Tasten­ +folgen, die Sie sich für die Bedienung merken müssen. +Brauchen Sie Informationen zu den einzelnen Programm­ +teilen, so müssen Sie zumeist in (den gerade nicht griff­ +bereiten) Handbüchern nachschlagen. + Und der Anfänger? Er ist am härtesten betroffen! Er +muß sich nicht nur mit der neuen Maschine auseinander­ +setzen, die technische Handhabung erlernen - von ihm +erwartet man, daß er sich innerhalb kurzer Zeit eine Rei­ +he von Kommandos einprägt, die für die Bedienung des +Grundsystems notwendig sind - und darüber hinaus noch +die Kommandos für die verschiedenen Anwendungsprogram­ +me. Viele resignieren nach den ersten Gehversuchen. + Und der Programmierer? Viele Anwender haben keine +Vorstellung davon, welche Arbeit in einem Programm +steckt. Einen großen Teil seiner Arbeit verwendet der +Programmierer darauf, die Benutzerschnittstelle zu ge­ +stalten - den Teil des Programms, mit dem der Anwender in +Kontakt kommt, über den er mit dem Programm kommuni­ +ziert, einen Dialog führt. Die Gestaltung und Pflege der +Benutzerschnittstelle kann dabei bis zu 50% der Gesamt­ +arbeit an einem Programm ausmachen. + + #on("b")#gs-DIALOG#off("b")# ist entwickelt worden, um diese Nachteile zu +beheben bzw. zumindest zu verringern. Grundelemente von +#on("b")#gs-DIALOG#off("b")# sind die Pull-Down-Menus (Klappmenus), in de­ +nen die zur Verfügung stehenden Funktionen übersicht­ +lich zur Auswahl angeboten werden. So ist es möglich, daß +eine Vielzahl von Funktionen verwaltet werden - ohne +daß der Anwender den Überblick verliert. Dabei können zu +jeder angebotenen Funktion noch Informationen abge­ +rufen werden, so daß ein Blättern in Handbüchern sich +zumeist erübrigt. + Zunächst einmal ist #on("b")#gs-DIALOG#off("b")# gar kein eigenständiges +Programm. Es ist vielmehr ein Baukastensystem, auf das +andere Programme zugreifen können. Davon können sowohl +der Programmierer und erst recht der Anwender profi­ +tieren: + Der Programmierer wird bei seiner Arbeit - insbeson­ +dere bei der Gestaltung der Benutzerschnittstelle we­ +sentlich entlastet, da er auf vorgefertigte Komponenten +zurückgreifen kann. Er kann sich mehr auf die inhalt­ +liche Ausgestaltung seiner Programme konzentrieren. + Sie als Anwender profitieren von der #on("u")#einfachen#off("u")# und +#on("u")#immer einheitlichen Bedienung#off("u")# solcher Programme. Aus +den Menupunkten können Sie auf einfache Weise auswählen +und den gewünschten Teil des Programms zur Ausführung +bringen. Durch diese Bedienung wird der Aufwand, sich in +ein neues Programmsystem einzuarbeiten, erheblich redu­ +ziert. Die zur Verfügung stehenden Programmfunktionen +können effektiver ausgenutzt werden, da sie jederzeit +offensichtlich sind. Informationen zu den einzelnen Pro­ +grammpunkten können Sie jederzeit abrufen, d.h. zumeist +können Sie auf ein Nachschlagen in den Handbüchern ver­ +zichten. + #on("b")#gs-DIALOG#off("b")# ist aber nicht nur ein Baukastensystem, auf +das andere Programme zugreifen können. Bei nahezu jeder +Anwendung ist es notwendig, Dateien auf das Archiv zu +schreiben oder von dort zu holen. Aus diesem Grunde ist +eine leistungsfähige, komfortable Archivbehandlung in +das Programmsystem integriert. + Ein Austausch von Dateien ist aber nicht nur mit dem +Archiv möglich. Sie können auch mit anderen Tasks inner­ +halb Ihres Systems (z.B. mit der Vatertask) oder sogar - +sofern installiert - mit einer Task irgendwo innerhalb +des EUMEL-Netzes Dateien austauschen. Daneben werden +noch Funktionen angeboten, die den Umgang mit den Da­ +teien vereinfachen (Verzeichnis, Umbenennen, Kopieren, +Löschen, Aufräumen etc.). + Diese Funktionen stehen Ihnen unabhängig von ande­ +ren Programmen zu Verfügung, sobald Sie #on("b")#gs-DIALOG#off("b")# in­ +stalliert haben. Andererseits finden Sie diese Funktionen +in immer gleicher Form auch in den meisten Programmen, +die auf der Basis von #on("b")#gs-DIALOG#off("b")# entwickelt worden sind +und entwickelt werden. + + + + + diff --git a/app/gs.dialog/1.2/doc/gs-dialog-2 b/app/gs.dialog/1.2/doc/gs-dialog-2 new file mode 100644 index 0000000..a25d35d --- /dev/null +++ b/app/gs.dialog/1.2/doc/gs-dialog-2 @@ -0,0 +1,215 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (6)# +#headodd# +#center#gs-DIALOG#right#% + +#end# +#headeven# +%#center#gs-DIALOG + +#end# + +#center#2 + +#center#Installation von gs-DIALOG + + + + Bevor Sie #on("b")#gs-DIALOG#off("b")# auf Ihrem System benutzen kön­ +nen, müssen Sie das Programm zunächst installieren. Wenn +#on("b")#gs-DIALOG#off("b")# auf Ihrem System schon zur Verfügung steht, +können Sie dieses Kapitel ruhig überspringen. + + +2.1 Voraussetzungen: + + Um #on("b")#gs-DIALOG#off("b")# auf Ihrem Computer betreiben zu können, +muß das EUMEL-Betriebssystem installiert sein. #on("b")#gs-DIALOG#off("b")# +setzt die Multi-User-Version voraus und ist lauffähig ab +Version 1.7.5. + + +2.2 Lieferumfang + + #on("b")#gs-DIALOG#off("b")# wird auf einer Diskette geliefert, die alle +notwendigen Programme enthält. Um den Inhalt der Dis­ +kette feststellen zu können, starten Sie Ihr System und +bringen es dazu, daß 'gib kommando:' erscheint. Dann legen +Sie die Diskette ein und geben das Kommando: + + archive ("gs-DIALOG"); list (archive); + release (archive) + + Anschließend erscheint eine Übersicht der auf dem +Archiv vorhandenen Programme. Folgende Programme soll­ +ten sich in der Übersicht befinden: + + "gs-DIALOG MENUKARTEN MANAGER" + "gs-DIALOG MM/gen" + "gs-DIALOG 1" + "gs-DIALOG 2" + "gs-DIALOG 3" + "gs-DIALOG 4" + "gs-DIALOG 5" + "gs-DIALOG 6" + "gs-DIALOG 7" + "gs-MENUKARTE:Archiv" + "gs-DIALOG/gen" + + Eventuell können noch weitere Namen auf der Diskette +vorhanden sein. Wenn Sie den Inhalt der Diskette kon­ +trolliert haben und diese Programme auf der Diskette +vorhanden sind, können Sie #on("b")#gs-DIALOG#off("b")# installieren. + Sollten Sie statt der Übersicht eine Fehlermeldung +erhalten, überprüfen Sie bitte, ob die Diskette das rich­ +tige Format besitzt oder ob ihr Diskettenlaufwerk Pro­ +bleme macht. Sollten dagegen Programme fehlen, so rekla­ +mieren Sie die Diskette. + + +2.3 Installation + +Die Installation erfolgt in #on("u")#zwei Schritten#off("u")#: + #on("u")#Zunächst#off("u")# muß eine Task eingerichtet werden, in der +später alle Menukarten aufbewahrt werden. Diese Menu­ +karten enthalten alle Informationen, die #on("b")#gs-DIALOG#off("b")# für +den Aufbau und den Umgang mit den Menus benötigt. #on("u")#Der +Name dieser Task ist vorgegeben#off("u")# ('gs-MENUKARTEN'), da +#on("b")#gs-DIALOG#off("b")# später auf diese Task zugreift. Sollten Sie +hier einen anderen Namen wählen, so wird die Task vom +Generierungsprogramm automatisch umbenannt, um die +Funktionsfähigkeit von #on("b")#gs-DIALOG#off("b")# zu garantieren! + #on("u")#Anschließend#off("u")# kann das Programmsystem selbst in einer +anderen Task installiert werden. Wie nehmen hier an, daß +die Task den Namen 'MENU' erhalten soll. (Sie können für +diese Task auch einen beliebigen anderen Namen wählen.) + + +1) #on("u")#Einrichten der 'Menukarten - Task'#off("u")# + +#on("b")# + (Supervisor - Taste) +#off("b")# + + --> gib supervisor kommando: + +#on("b")# + begin ("gs-MENUKARTEN") +#off("b")# + + --> gib kommando: + + + (Arbeiten mehrere Personen mit dem Computer, dann ist +es sinnvoll, diese Task vor unbefugtem Zugriff durch ein +Passwort zu schützen. Wie das gemacht wird, können Sie in +Ihrem EUMEL-Benutzerhandbuch erfahren.) + Legen Sie dann die Archivdiskette ein, auf der sich +#on("b")#gs-DIALOG#off("b")# befindet, und geben Sie die folgenden Komman­ +dos: + +#on("b")# + archive("gs-DIALOG") + + fetch("gs-DIALOG MM/gen",archive) + + run +#off("b")# + + Sie haben damit das Generatorprogramm gestartet; die +Installation wird automatisch durchgeführt. Lassen Sie +während des gesamten Vorgangs die Archivdiskette einge­ +legt. Die Generierung ist beendet, wenn der EUMEL- +Eingangsbildschirm erscheint. + +2) #on("u")#Installation des Programmsystems#off("u")# + + +#on("b")# + (Supervisor - Taste) +#off("b")# + + --> gib supervisor kommando: + +#on("b")# + begin ("MENU") +#off("b")# + + --> gib kommando: + + + (Sichern Sie, wenn gewünscht, auch diese Task durch +ein Passwort vor unbefugtem Zugriff.) + Legen Sie die #on("b")#gs-DIALOG#off("b")#-Archivdiskette ein und geben +Sie die folgenden Kommandos: + +#on("b")# + archive("gs-DIALOG") + + fetch("gs-DIALOG/gen",archive) + + run +#off("b")# + + Sie haben damit das Generatorprogramm gestartet. Die +Generierung benötigt jetzt aber wesentlich mehr Zeit als +die zuvor! Lassen Sie während des gesamten Vorgangs die +Archivdiskette eingelegt. Die Generierung ist beendet, +wenn der EUMEL-Eingangsbildschirm erscheint. Die Task, +in der die Generierung stattfindet, wird automatisch zur +Managertask, das heißt, daß Söhne von ihr eingerichtet +werden können. Damit ist die Installation von #on("b")#gs-DIALOG#off("b")# +abgeschlossen - in allen Sohn- und Enkeltasks können +Sie nun mit dem Kommando: + +#on("b")# + archiv +#off("b")# + +die Archivverwaltung aufrufen. + + +2.4 Nutzung der 'Semi-Graphik-Zeichen' + + #on("b")#gs-DIALOG#off("b")# verwendet beim Aufbau der Rahmen inner­ +halb der Menus nur solche Zeichen, die auf jedem Computer +zur Verfügung stehen. Die meisten Computer/Terminals +verfügen aber über einen Zeichensatz, der es erlaubt, +solche Rahmen "schöner" darzustellen. #on("b")#gs-DIALOG#off("b")# ist dar­ +auf vorbereitet, diese Eigenschaften auszunutzen. + Allerdings ist der Aufruf dieser Graphikzeichen nicht +einheitlich festgelegt. Verfügen Sie über einen Computer, +der 'IBM - kompatibel' ist, oder über ein Terminal 'Beehive +FT20', dann können Sie die Graphikzeichen ganz einfach +nutzen, denn dafür sind im Programm bereits Befehle vor­ +bereitet. + +ibm  graphic char - Mit diesem Befehl stel­ + len Sie für #on("b")#gs-DIALOG#off("b")# + den 'IBM - Graphikzei­ + chensatz' ein. + +ft20 graphic char - Mit diesem Befehl stel­ + len Sie für #on("b")#gs-DIALOG#off("b")# + den 'Beehive FT20 - + Graphikzeichensatz' + ein. + +std  graphic char - Mit diesem Befehl stel­ + len Sie wieder den + 'Standard - Graphik­ + zeichensatz' ein. + + Nehmen Sie eine solche Einstellung in einer Task vor, +so erben alle Sohn- und Enkeltasks diese Einstellung. Sie +können auch in verschiedenen Task unterschiedliche Ein­ +stellungen wählen. + + Verfügen Sie über andere Computer- oder Terminalty­ +pen, die Grapikzeichen darstellen können, so können Sie +diese ebenfalls nutzen. Sie müßten sich allerdings ein +kleines ELAN-Programm schreiben. Aber auch das ist ganz +einfach, da #on("b")#gs-DIALOG#off("b")# auch darauf vorbereitet ist. Wie +das gemacht wird, wird aber erst in Kapitel 5 erläutert. + diff --git a/app/gs.dialog/1.2/doc/gs-dialog-3 b/app/gs.dialog/1.2/doc/gs-dialog-3 new file mode 100644 index 0000000..044720b --- /dev/null +++ b/app/gs.dialog/1.2/doc/gs-dialog-3 @@ -0,0 +1,683 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (12)# +#headodd# +#center#gs-DIALOG#right#% + +#end# +#headeven# +%#center#gs-DIALOG + +#end# + +#center#3 + +#center#Umgang mit den Menus + + +#center#Eine Beispielsitzung + + + Wie schon oben erwähnt, ist in #on("b")#gs-DIALOG#off("b")# eine Archiv­ +verwaltung integriert. Anhand dieses Programms möchten +wir den Umgang mit und die Arbeitsweise von #on("b")#gs-DIALOG#off("b")# +vorstellen. Als Beispiel wollen wir eine Datei von einer +Ihrer Archivdisketten ins System holen. + Zunächst zu den Begriffen: Die Disketten, die Sie in den +Rechner einlegen können, um z.B. Dateien (und Programme) +von anderen Computern übernehmen zu können, bezeichnet +man als #on("u")#Archiv#off("u")#. Das Archiv (die Diskette) wird benutzt, um +Daten und Programme vor Beschädigung und Verlust zu +sichern. Es ist sehr wichtig, daß Sie Ihre Programme und +Daten auf Archivdisketten sichern, denn ein einziger +Hardwarefehler könnte die Arbeit von vielen Stunden +zunichte machen. + Da man diese Operationen, d.h. Programme und Daten +auf Disketten zu sichern und wieder von dort zu holen, +sehr häufig benötigt, ist die Archivbehandlung fest in +das #on("b")#gs-DIALOG#off("b")#-Programmsystem integriert und Bestandteil +nahezu jeden Programms, das unter #on("b")#gs-DIALOG#off("b")# entwickelt +wird. Unabhängig von anderen Programmen kann die +Archivbehandlung aber auch benutzt werden, sobald +#on("b")#gs-DIALOG#off("b")# installiert ist. Das wollen wir jetzt auspro­ +bieren. + + +3.1 Aufruf der Archivverwaltung: + + Richten Sie eine Task als Sohn der Task ein, in der Sie +#on("b")#gs-DIALOG#off("b")# installiert haben. Nehmen wir hier an, die neue +Task soll den Namen 'TEST' erhalten - die Task, in der +#on("b")#gs-DIALOG#off("b")# installiert ist, habe den Namen 'MENU'. + +#on("b")# + (Supervisor - Taste) +#off("b")# + --> gib supervisor kommando: +#on("b")# + begin ("TEST","MENU") +#off("b")# + + --> gib kommando: +#on("b")# + archiv +#off("b")# + + Mit dem Befehl 'archiv' können Sie jederzeit die Archiv­ +behandlung aufrufen - es erscheint dann folgendes Menu: + + +#on("b")# +ARCHIV: Dateien Archiv +-+-------------------+---------------------------------------------------- + | v Verzeichnis | + | --------------- | + | l Löschen | + | d Drucken | + | --------------- | + | k Kopieren | + | u Umbenennen | + | --------------- | + | s Speicherplatz | + | a Aufräumen | + +-------------------+ + + + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + + +3.2 Bedienung des Menusystems + +- Aufbau der Menus (Bildschirmaufbau) + + Ein Menu ist ein Angebot von Funktionen, die ein Pro­ +gramm ausführen kann. Aus diesem Angebot kann der Pro­ +grammbenutzer auswählen. In diesem Sinne ist ein solches +Menu durchaus vergleichbar mit einer Speisenkarte in +einem Restaurant. + Jedes Menu unter #on("b")#gs-DIALOG#off("b")# besitzt eine 'Kopfzeile' +und eine 'Fußzeile'. In der Kopfzeile ist ganz links der +Name des Programms angegeben, mit dem Sie gerade arbei­ +ten. Daneben enthält die Kopfzeile die 'Oberbegriffe', mit +denen die einzelnen Untermenus angesprochen werden +können. Maximal können hier zehn Oberbegriffe auftau­ +chen - in unserem Beispiel sind es nur zwei. + Besondere Bedeutung für die Bedienung der Menus +kommt der Fußzeile zu. Einerseits wird hier jeweils ange­ +zeigt, welche Tasten Sie zum jeweiligen Zeitpunkt benut­ +zen können, andererseits erhalten Sie über diese Fußzeile +auch Informationen, wenn #on("b")#gs-DIALOG#off("b")# "mit sich selbst be­ +schäftigt ist", d.h. Operationen ausführt. Wissen Sie also +nicht mehr weiter, so schauen Sie zuerst auf die Fußzeile +und beachten Sie die hier stehenden Informationen. + Im Bereich zwischen der Kopf- und Fußzeile werden die +Untermenus ausgegeben. Dieser Bereich wird auch dazu +benutzt, um Informationen an den Benutzer einzublenden, +Fragen an ihn zu richten, ihn aus einem Angebot (z.B. von +Dateien) auswählen zu lassen und vieles mehr. + Treiben wir den Vergleich mit der Speisenkarte in ei­ +nem Restaurant noch ein wenig weiter. Bei einem großen +Angebot kann eine Speisenkarte recht umfangreich wer­ +den. Denken Sie beispielsweise an eine Speisenkarte in +einem chinesischen Restaurant. Dazu sind neben den an­ +gebotenen Gerichten oft noch Zusatzinformationen (Zube­ +reitungsart, Zutaten etc.) angegeben. Um dem Gast die Aus­ +wahl zu erleichtern, ist die Speisenkarte aber zumeist +untergliedert; man findet Suppen, warme Vorspeisen, kalte +Vorspeisen, Gerichte mit Schweinefleisch, mit Rindfleisch, +mit Geflügel, mit Fisch etc. + Ein Computerprogramm kann, ebenso wie ein Restau­ +rant, dem Benutzer ein großes Angebot (an Programmfunk­ +tionen) machen. Von großem Nachteil ist allerdings, daß +ein Computerbildschirm - im Gegensatz zu einer umfang­ +reichen Speisenkarte - viel zu klein ist, um alle Angebote +und Informationen gleichzeitig darstellen zu können. +Außerdem würde ein nahezu vollständig beschriebener +Bildschirm sehr unübersichtlich sein. + Aus diesem Grunde haben wir uns entschlossen, immer +nur einen Teil des vorhandenen Angebotes an Funktionen +und der vorhandenen Informationen anzuzeigen - immer +nur soviel, daß Sie sich auf dem Bildschirm orientieren +können und den Überblick nicht verlieren. Dazu haben Sie +die Möglichkeit, jeweils zu bestimmen, auf welche Infor­ +mationen Sie Ihre Aufmerksamkeit richten wollen, was Sie +angezeigt bekommen möchten. + + +- Auswahl der Menupunkte + + Zu jedem Oberbegriff in der Kopfzeile gehört eine +Liste von Funktionen, die das Programm dazu zur Auswahl +anbietet. Allerdings ist immer nur eine Liste (ein Unter­ +menu) sichtbar. Das sichtbare Untermenu gehört immer zu +dem Oberbegriff in der Kopfzeile, der invers dargestellt +ist. Wir wollen uns zunächst das Untermenu zum zweiten +Oberbegriff ('Archiv') anzeigen lassen. Zum Wechsel zwi­ +schen den Oberbegriffen in der Kopfzeile benutzt man die +Pfeiltasten oder . Probieren Sie es einmal +aus. Es erscheint das folgende Bild auf dem Bildschirm: + + +#on("b")# +ARCHIV: Dateien Archiv +-------+-------------------------+---------------------------------------- + | r Reservieren | + | - Neue Diskette | + | --------------------- | + | - Schreiben | + | - Checken | + | - Kombination | + | - Holen/Lesen | + | - Löschen | + | --------------------- | + | - Verzeichnis | + | - Drucken | + | --------------------- | + | i Initialisieren | + | z Zieltask einstellen | + +-------------------------+ +---------------------+ + | Dateiaustausch mit: | + | Archiv | + | Archivname: | + | --- | + +---------------------+ +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + + + Sie können jetzt sehen, daß ein anderer Oberbegriff in +der Kopfzeile aktiviert, d.h. invers dargestellt ist. Dane­ +ben wurde noch das sichtbare Untermenu "eingeklappt" +und ein anderes "ausgeklappt". Man könnte die Unterme­ +nus deshalb auch als 'Klappmenus' bezeichnen - gebräuch­ +lich ist allerdings die Bezeichnung 'Pull-Down-Menus', an +die wir uns auch halten wollen. + + Sicher haben Sie bemerkt, daß es einen Augenblick +gedauert hat, bis das Pull-Down-Menu unter dem Menu­ +punkt 'Archiv' erschien. Das hat auch seine Ursache, denn +#on("b")#gs-DIALOG#off("b")# muß einige Einstellungen vornehmen, die etwas +Zeit in Anspruch nehmen. Neben dem Pull-Down-Menu ist +unten rechts auf dem Bildschirm noch ein 'Kasten' sicht­ +bar geworden. Er dient Ihnen zur Information. Da +#on("b")#gs-DIALOG#off("b")# nicht nur den Austausch von Dateien mit dem +Archiv, sondern auch mit anderen Tasks ermöglicht, wird +hier immer angezeigt, mit welcher Task der Dateiaus­ +tausch zur Zeit erfolgt. Ist das Archiv eingestellt, so +wird auch noch der Name der Diskette angezeigt - aber +erst wenn das Archiv angemeldet worden ist, was ja mo­ +mentan noch nicht der Fall ist. Deshalb werden nur drei +Striche ausgegeben. + Sicher ist Ihnen das Grundprinzip der Menubehand­ +lung schon klar geworden: Sie müssen sich zuerst inner­ +halb der Kopfzeile für einen Oberbegriff entscheiden. +Zum gewählten Oberbegriff wird dann jeweils das Angebot +an zugehörigen Programmfunktionen im darunterstehen­ +den Pull-Down-Menu angezeigt. Dieses Vorgehen hat den +Vorteil, daß man den kleinen Bildschirm im Prinzip "mehr­ +fach nutzen kann". Die Pull-Down-Menus können sich ja +ruhig überlappen. Sie merken es gar nicht, da ja nicht +alle gleichzeitig angezeigt werden. + Noch ein Vorteil ist da, Sie können sich auf den Teil +konzentrieren, für den Sie sich gerade interessieren und +werden nicht durch andere Informationen abgelenkt. An­ +dererseits können Sie jederzeit auch an die Funktionen +und Informationen gelangen, die gerade nicht sichtbar +sind. + Sie haben sicher bemerkt, daß nicht nur innerhalb der +Kopfzeile ein Begriff invers dargestellt ist, sondern +auch einer innerhalb jedes Pull-Down-Menus. Nachdem man +sich für einen Oberbegriff entschieden hat, kann man +nämlich noch zwischen den Funktionen innerhalb des +Pull-Down-Menus wählen. + Da das Pull-Down-Menu zum Oberbegriff 'Archiv' noch +einige Besonderheiten aufweist, wollen wir uns die Funk­ +tionsweise zuerst am Pull-Down-Menu unter dem Oberbe­ +griff 'Dateien' verdeutlichen. Bitte wechseln Sie deshalb +durch Betätigung der Pfeiltaste oder zum +ersten Pull-Down-Menu zurück. + Ähnlich wie in der Kopfzeile, können Sie auch inner­ +halb des Pull-Down-Menus zu einem anderen Punkt wech­ +seln. Das geschieht durch die Pfeiltasten und +. Dabei werden 'Trennlinien' innerhalb des Pull- +Down-Menus, die nur der Untergliederung dienen, über­ +sprungen. Vom obersten Menupunkt gelangt man direkt +zum untersten und umgekehrt. Probieren Sie es einmal +aus. + + +- Informationen zu einem Menupunkt. + + Zu jedem Punkt eines Pull-Down-Menus können Sie In­ +formationen abrufen. Das ist ganz einfach, denn Sie +brauchen sich nur auf den gewünschten Menupunkt zu +begeben (die Pfeiltasten so betätigen, bis der betreffende +Menupunkt im Pull-Down-Menu invers dargestellt wird). +Anschließend betätigen Sie die Fragezeichentaste (). + Auf dem Bildschirm erscheint ein Kasten in den die +Informationen zum Menupunkt eingetragen sind. Zwar wird +dadurch ein Teil des Bildschirms überschrieben, doch kei­ +ne Angst - sobald Sie auf irgendeine Taste tippen, wird +der alte Bildschirmzustand wieder hergestellt! Ebenso wie +die Pull-Down-Menus sind diese Informationen normaler­ +weise verborgen. Auf Anforderung werden sie aber sicht­ +bar - ja es wäre gar nicht möglich alle vorhandenen In­ +formationen gleichzeitig auf dem Bildschirm darzustel­ +len. Es wäre auch unsinnig, denn man benötigt diese In­ +formationen zumeist nur, wenn man sich in das Programm +einarbeitet. Später, wenn Ihnen der Umgang mit dem Pro­ +gramm vertraut ist, sind diese Informationen überflüssig +und würden, wenn sie immer sichtbar wären, nur stören. + + +- Informationen zur Bedienung des Menus + + Alles das, was hier ausführlich beschrieben ist, kön­ +nen Sie auch in Kurzform auf dem Bildschirm erfahren, +denn auch die Informationen, wie das Menu bedient wird, +sind jeweils im Menu vorhanden. Möchten Sie diese Infor­ +mationen auf dem Bildschirm sehen, so tippen Sie die +Tastenfolge , d.h. erst die Taste 'ESC' und dann die +Fragezeichentaste. Danach erscheint folgender Kasten +auf dem Bildschirm: + +#on("b")# + +---------------------------------------+ + | gs-DIALOG | + | | + | e ... Erläuterungen (allgemein) | + | w ... Wahl eines Menupunktes | + | a ... Aktivieren des Menupunktes | + | b ... Besondere Tasten / Menuende | + | | + | z ... Zurück in das Menu | + | | + | e w a b z | + +---------------------------------------+ +#off("b")# + + Wenngleich die Informationen kurz gefaßt sind, so +haben sie doch nicht alle gleichzeitig auf dem Bildschirm +Platz. Aus diesem Grunde werden Sie aufgefordert, sich +weiter zu entscheiden, welche Informationen Sie haben +möchten. Sie können zwischen mehreren Alternativen wäh­ +len. Die Reihenfolge spielt keine Rolle; Sie können auch +Informationen mehrmals aufrufen. + Der Aufruf kann auf zweierlei Weise erfolgen: Entwe­ +der Sie bewegen mit den Pfeiltasten oder +die Markierung in der letzten Zeile des Kastens auf den +Buchstaben, der vor dem von Ihnen gewünschten Punkt +steht und tippen anschließend auf die -Taste +oder Sie tippen direkt die entsprechende Buchstabentaste +(z.B. ). Beide Vorgehensweisen sind zulässig und haben +die gleiche Wirkung. + Daraufhin werden die gewünschten Informationen +sichtbar. Durch Tippen irgendeiner Taste verschwinden +die Informationen wieder vom Bildschirm und sichtbar +wird wieder der oben abgebildete 'Verteiler'. Erst wenn +man den Punkt 'z ... Zurück in das Menu' wählt, verschwin­ +det auch dieser Kasten und man gelangt zurück in das +Menu. + + +- Aktivierbare und nicht aktivierbare Menupunkte + + Wir wollen jetzt endlich unserer Absicht nachgehen, +eine Datei vom Archiv zu holen. Dazu wechseln wir zuerst +wieder zum Oberbegriff 'Archiv' in der Kopfzeile. Nach +kurzer Zeit erscheint das Ihnen schon bekannte Pull- +Down-Menu. Wenn Sie hier versuchen, die einzelnen Menu­ +punkte innerhalb des Pull-Down-Menus anzusteuern, so +werden Sie feststellen, daß das nicht möglich ist. Alle +Menupunkte, die ein Minuszeichen ('-') vor der Bezeichnung +haben, können nicht angewählt werden. Diese Menupunkte +sind zur Zeit nicht aktivierbar. Solche Menupunkte kön­ +nen in Menus häufiger auftreten. + Das kann mehrere Ursachen haben: Einerseits könnte +auf diese Weise ein Programmierer ein komplettes Menu +entwerfen, das schon alle Funktionen zeigt, wenn auch die +zugehörigen Programme dazu noch nicht fertig sind. Das +ist aber in unserem Falle nicht so. Hier ist die Ursache +eine andere: Bevor man im EUMEL-System auf das Archiv­ +laufwerk zugreifen kann, muß man es erst für sich re­ +servieren. Dadurch wird sichergestellt, daß nicht gleich­ +zeitig mehrere Benutzer auf eine Archivdiskette zugrei­ +fen und ggf. Dateien unbeabsichtigt zerstören. Erst wenn +das Laufwerk reserviert worden ist, kann man auf die +Diskette zugreifen. Das wird im Menu durch die nicht ak­ +tivierbaren Punkte zum Ausdruck gebracht. + + +- Aktivieren von Menupunkten + + Wir müssen also zuerst das Archiv reservieren. Auch +hier gibt es (zumeist) zwei Möglichkeiten, den gewünsch­ +ten Menupunkt zu aktivieren. Entweder Sie sorgen durch +Bedienung der Pfeiltasten dafür, daß der gewünschte +Menupunkt invers dargestellt wird und betätigen an­ +schließend die -Taste oder - sofern vor dem Me­ +nupunkt ein einzelner Buchstabe oder eine Ziffer aufge­ +listet ist - tippen Sie einfach auf die zugehörige Buch­ +staben- oder Zifferntaste. Tippen Sie hier die Taste . + Warten Sie einen Moment, denn es wird überprüft, ob +das Laufwerk von einer anderen Task benutzt wird. Ist +dies der Fall, erhalten Sie darüber auf dem Bildschirm +eine Meldung. Ansonsten wird an Sie die Frage gerichtet, +ob die Diskette eingelegt ist. Wenn diese Frage erscheint, +befindet sich das Laufwerk schon "in Ihrem Besitz". Erst +jetzt ist es sinnvoll, wenn auch andere auf das Laufwerk +zugreifen können, die Diskette in das Laufwerk zu legen. +Erst wenn die Frage auf dem Bildschirm erscheint, können +Sie sicher sein, daß keine andere Task mehr auf das Lauf­ +werk zugreifen kann. Legen Sie also beim Erscheinen der +Frage eine Ihrer EUMEL-Archivdisketten in das Laufwerk +und bejahen Sie anschließend die gestellte Frage, indem +Sie die Taste tippen. (Sie können aber auch - wie schon +in vorausgehenden Situationen - die Inversdarstellung +innerhalb des Kastens, in dem die Frage auf dem Bild­ +schirm dargestellt wird, auf das 'Ja' positionieren und +anschließend die -Taste tippen.) + #on("b")#gs-DIALOG#off("b")# ermittelt jetzt den Namen der eingelegten +Diskette und zeigt diesen im Kasten rechts unten auf dem +Bildschirm an. Außerdem werden die zuvor nicht aktiver­ +baren Punkte aktivierbar gemacht. Das kann man daran +erkennen, daß auf dem Bildschirm die Minuszeichen vor +den betreffenden Menupunkten verschwinden (und Buch­ +staben sichtbar werden). + Lassen Sie sich zunächst ein Inhaltsverzeichnis der +Diskette anzeigen. Dazu brauchen Sie nur den Menupunkt +'v Verzeichnis' wählen. Wie das gemacht wird wissen Sie ja +schon. Sie können dabei beobachten, daß vor dem Menu­ +punkt das bisherige Zeichen verschwindet und ein Stern +(*) sichtbar wird. Daran kann man erkennen, daß #on("b")#gs-DIALOG#off("b")# +den Auftrag bereits ausführt. + Es dauert einen Moment, bis das Verzeichnis erstellt +ist - anschließend wird es auf dem Bildschirm ausgegeben. +Paßt das Verzeichnis nicht vollständig auf den Bild­ +schirm, so können Sie sich darin bewegen, blättern etc., +wie Sie es aus dem Editor gewohnt sind. Ebenso wird das +Verzeichnis auch wie der Editor verlassen - durch die +Tastenfolge (das wird übrigens auch auf dem +Bildschirm angezeigt!). + + +- Dateiauswahl + + Sie sollen jetzt eine Datei von der Archivdiskette in +das System holen, d.h. genauer gesagt von der Diskette +kopieren. Aktivieren Sie also auf gewohnte Weise den +Menupunkt 'h Holen/Lesen'. Warten Sie anschließend einen +Moment, denn #on("b")#gs-DIALOG#off("b")# erstellt eine Liste aller vorhan­ +denen Dateien auf der Diskette und bietet Sie Ihnen an­ +schließend so an, daß Sie komfortabel eine Auswahl tref­ +fen können. + Haben Sie die #on("b")#gs-DIALOG#off("b")#-Archivdiskette eingelegt, so +zeigt sich etwa der folgende Bildschirm: + + +#on("b")# +ARCHIV: Dateien Archiv +-------+-------------------------+-------------------------------------- + +--------------------------------------------------------------------+ + | Dateien holen/lesen (Archiv) | + | | + | Bitte alle Dateien ankreuzen, die 'geholt' werden sollen! | + |====================================================================| + | Auswahl m e h r e r e r Dateien durch Ankreuzen | + |....................................................................| + |==> o gs-DIALOG MENUKARTEN MANAGER" | + | o gs-DIALOG MM/gen | + | o gs-DIALOG 1 | + | o gs-DIALOG 2 | + | o gs-DIALOG 3 | + | o gs-DIALOG 4 | + | o gs-DIALOG 5 | + | o gs-DIALOG 6 | + | o gs-DIALOG 7 | + | o gs-MENUKARTE:Archiv | + |..................................................Weitere Dateien!..| + +--------------------------------------------------------------------+ +--|Info: Fertig: Abbrechen: | +In+--------------------------------------------------------------------+ +#off("b")# + + + Auf dem Archiv sind mehrere Dateien vorhanden. Alle +werden Ihnen zur Auswahl angeboten. In der obersten +Zeile wird zur Kontrolle die Funktion angezeigt, die Sie +gerade gewählt haben. Sie können jetzt die Dateien, auf +die sich die Operation beziehen sollen, in beliebiger Rei­ +henfolge ankreuzen. Wenn Sie abschließend die Auswahl +verlassen, werden die Dateien in der Ankreuzreihenfolge +bearbeitet (hier in die Task geholt). + Die Handhabung der Dateiauswahl ist ganz einfach. Der +Pfeil gibt jeweils an, welche Datei aktuell behandelt +wird. Zunächst wird vor den Namen jeweils nur ein 'o' aus­ +gegeben. Mit den Pfeiltasten und können +Sie nun mit dem Pfeil vor den Namen fahren, den Sie an­ +kreuzen möchten. Tippen Sie dann die Taste oder +, so erscheint in der Anzeige ein 'x' vor dem Na­ +men und eine Zahl, die angibt, die wievielte Datei Sie an­ +gekreuzt haben. Haben Sie sich versehen, so können Sie +das Kreuz auch wieder löschen. Dazu fahren Sie einfach +erneut vor den betreffenden Namen, wo ja jetzt ein 'x' +steht, und tippen die Taste (kleines 'o') oder . +Dadurch wird das Kreuz entfernt und gegebenenfalls eine +Umnumerierung der schon angekreuzten Dateinamen vor­ +genommen. Verlassen Sie jetzt die Auswahl mit der Tasten­ +folge , so werden die Dateien nacheinander in der +von Ihnen angekreuzten Reihenfolge in die Task kopiert. + Neben dieser Auswahl, in der #on("u")#m e h r e r e#off("u")# Dateien an­ +gekreuzt (ausgewählt) werden können, gibt es auch eine +Auswahl, in der nur jeweils #on("u")#e i n e#off("u")# Datei angekreuzt wer­ +den darf. Das ist durch die entsprechende Beschriftung +auf dem Bildschirm kenntlich gemacht. In einem solchen +Fall wird die Auswahl nach Ankreuzen eines Namens #on("u")#auto­ +matisch#off("u")# verlassen, d.h. man braucht nicht zu tip­ +pen!. + In einer Dateiauswahl können bis zu 200 Dateien ver­ +waltet werden. Da aber nicht alle Namen gleichzeitig auf +dem Bildschirm angezeigt werden können, wird jeweils in +der gepunkteten Zeile angezeigt, ob noch #on("u")#weitere Dateien#off("u")# +in der Liste vorausgehen oder folgen. In unserem Beispiel +geht als keine Datei voraus, es folgen aber noch weitere +Dateien hinter der zuletzt angezeigten Datei. + Damit Sie noch komfortabler mit dieser Dateiauswahl +arbeiten können, gibt es weitere Tastenfolgen die nütz­ +lich sein können. Wenn Sie die Fragezeichentaste () tip­ +pen, werden Sie auf dem Bildschirm angezeigt. Durch Tip­ +pen irgendeiner weiteren Taste können Sie weiterblättern +bzw. in die Auswahl zurückgelangen. Folgende Tastenkom­ +mandos stehen Ihnen zur Verfügung: + + + Positionierungen: + + hoch : zum vorausgehenden Namen + runter : zum folgenden Namen + HOP hoch : auf den ersten Namen der Seite + HOP runter : auf den letzten Namen der Seite + ESC 1 : auf den ersten Namen der Liste + ESC 9 : auf den letzten Namen der Liste + + + Auswahl treffen: + + RETURN / x : diesen Namen ankreuzen +(RUBOUT / o : Kreuz vor dem Namen löschen ) +(HOP RETURN/HOP x: alle folgenden Namen ankreuzen) +(HOP RUBOUT/HOP o: alle folgenden Namen löschen ) + + + Auswahl verlassen: + + ESC q : Auswahl verlassen + ESC h : Auswahl abbrechen + + + + Die in Klammern gesetzten Tastenfunktionen kann man +nur verwenden, wenn die Auswahl #on("u")#mehrerer#off("u")# Dateien zuge­ +lassen ist. + Wie Sie sehen, orientiert sich die Bedienung an den +Tastenfunktionen, die Ihnen schon aus dem Editor be­ +kannt sind. Haben Sie aus Versehen einen Menupunkt ge­ +wählt, so daß Ihnen eine solche Auswahl angeboten wird, +so können Sie die Auswahl durch (für 'halt') ab­ +brechen. + + +- Ja/Nein - Fragen + + An verschiedenen Stellen werden Fragen an Sie ge­ +richtet, die Sie mit 'ja' oder 'nein' beantworten müssen. +Tippen Sie dazu entsprechend je nach Entscheidung die +Taste (für 'ja') bzw. (für 'nein'). + + +- Eingaben + + An einigen Stellen werden Sie aufgefordert, eine Ein­ +gabe zu machen (z.B. einen Dateinamen einzugeben). Sofern +möglich wird Ihnen auch ein Vorschlag für die Eingabe +gemacht (z.B. wenn Sie Dateien kopieren oder umbenennen +wollen). Wenn Sie den gemachten Vorschlag akzeptieren, +dann brauchen Sie zur Bestätigung nur die - +Taste zu tippen. + Gefällt Ihnen der Vorschlag nicht oder wird Ihnen +kein Vorschlag gemacht, so machen Sie bitte die ge­ +wünschte Angabe. Zum Schreiben stehen Ihnen alle aus dem +Editor bekannten Funktionen zur Verfügung. Mit der +Taste können Sie Buchstaben löschen, mit + einfügen. Die Eingabe wird durch Tippen der +-Taste abgeschlossen. + Ist der von Ihnen gewünschte Name schon in Ihrer Task +vorhanden und steht in der Fußzeile der Hinweis 'Zeigen: +', dann können Sie sich auch alle vorhandenen +Namen zur Auswahl anbieten lassen und durch Ankreuzen +den beabsichtigten Namen auswählen. + + +- Alternativen + + Ihnen können auch mehrere Alternativen angeboten +werden, zwischen denen Sie wählen müssen. In der unter­ +sten Zeile eines solchen Kastens, in denen Ihnen die Al­ +ternativen auf dem Bildschirm eingeblendet werden, sind +die Möglichkeiten aufgeführt, die darüber beschreiben +sind. Mit den Pfeiltasten können sie die Markierung auf +die gewünschte Alternative positionieren und dann durch +die -Taste zur Ausführung bringen. (Manchmal +ist das auch durch Tippen der den Alternativen vorange­ +stellten Buchstaben oder Ziffern möglich). + + +- Verlassen des Menus + + Das Menu kann insgesamt mit der Tastenfolge +verlassen werden. Damit das nicht versehentlich ge­ +schieht, wird zur Sicherheit die Frage gestellt, ob Sie das +Menu tatsächlich verlassen wollen. Verneinen Sie die +Frage, verbleiben Sie im Menu, ansonsten gelangen Sie +zurück in die 'gib kommando:' - Ebene. + + Mit dieser Beispielsitzung haben Sie jetzt schon fast +alle Arten des Umgangs mit #on("b")#gs-DIALOG#off("b")# kennengelernt. +Sicher ist dies beim ersten Mal sehr verwirrend. Mit den +folgenden vier grundsätzlichen Regeln können Sie +#on("b")#gs-DIALOG#off("b")# aber immer bedienen: + + 1. Achten Sie darauf, welche Tastenkombinationen in + der Fußzeile angegeben sind. Halten Sie sich daran! + + 2. Rufen Sie - sofern vorhanden - die Hilfsfunktio­ + nen mit oder auf. Damit erhalten Sie + weitere Informationen. + + 3. Funktioniert eine Tastenkombination nicht (geben + Sie dem Rechner eine kurze Zeit zum Reagieren), + versuchen Sie die Tastenkombination (Ver­ + lassen) oder (Abbruch). Falls sich darauf­ + hin etwas ändert, verfahren Sie wie unter 1). + + 4. Erfolgt noch immer keine Reaktion, tippen Sie die + -Taste und versuchen Sie das Programm mit + 'halt' zu stoppen. Führt auch das nicht zum Erfolg, + hat sich der Rechner "aufgehängt". Wenn Sie keine + Erfahrungen mit einer solchen Situation haben, + wenden Sie sich an Ihren Systembetreuer. + + +3.3 Zusammenfassung/Kurzbeschreibung + +Menu: Sie können jede (aktive) Funktion inner­ + halb eines Pull-Down-Menus mit den + Pfeiltasten anwählen und durch Tippen + der -Taste zur Ausführung + bringen. (Ersatzweise kann - sofern vor + dem Menupunkt ein Buchstabe oder eine + Ziffer angegeben ist - die Funktion + durch Tippen der entsprechenden Taste + direkt zur Ausführung gebracht werden.) + Zu jeder Funktion kann durch Tippen der + Fragezeichentaste eine Hilfestellung + angefordert werden. Gibt man die Tasten­ + folge , so wird die Bedienung des + Menus auf dem Bildschirm kurz erläutert. + Mit der Tastenfolge wird das + Menu (nach einer Sicherheitsabfrage) + verlassen. + +Dateiauswahl: Hier können Sie die gewünschten Namen + mit ankreuzen und das Kreuz mit + wieder entfernen. Die Auswahl - sofern + mehrere Dateien ausgewählt werden kön­ + nen - wird durch die Tastenfolge + verlassen. Alle Möglichkeiten + der Bedienung werden angezeigt, wenn die + Fragezeichentaste getippt wird. Die Aus­ + wahl wird abgebrochen (ohne Kreuze!), + wenn die Tastenfolge eingege­ + ben wird. + +Eingabe: Hier können Sie eine Zeile eingeben oder + eine Vorgabe ändern (wie im Editor). Ein­ + fügen und Löschen mit RUBIN und RUBOUT. + Ist in der Fußzeile die Tastenfolge + ': Zeigen' angegeben, so können + Sie darüber auch eine Auswahl anfor­ + dern, in der Sie bereits vorhandene Na­ + men nur anzukreuzen brauchen. Zumeist + ist auch ein Abbruch der Eingabe durch + die Tastenfolge möglich. + +Frage: Beantworten Sie die an Sie gerichtete + Frage mit oder . Sie können auch + auf dem Bildschirm die Markierung auf + die gewünschte Antwort setzten und an­ + schließend die -Taste tippen. + +Alternativen: Aus den angegebenen Möglichkeiten kön­ + nen Sie eine auswählen, indem Sie entwe­ + der die der Alternative vorangestellte + Taste tippen oder in der letzten Zeile des + Kastens die Markierung auf die ge­ + wünschte Kennzeichnung positionieren + und anschließend die -Taste + tippen. + +Fehler: Die Meldung muß durch Tippen einer be­ + liebigen Taste quittiert werden. + +Bitte warten: Der Rechner ist beschäftigt - keine + Taste tippen! + + diff --git a/app/gs.dialog/1.2/doc/gs-dialog-4 b/app/gs.dialog/1.2/doc/gs-dialog-4 new file mode 100644 index 0000000..03d8dc4 --- /dev/null +++ b/app/gs.dialog/1.2/doc/gs-dialog-4 @@ -0,0 +1,672 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (30)# +#headodd# +#center#gs-DIALOG#right#% + +#end# +#headeven# +%#center#gs-DIALOG + +#end# +#center#4 + +#center#Beschreibung der Menufunktionen + + +4.1 Menufunktionen zum Oberbegriff 'Dateien' + + In diesem Kapitel werden alle die Menufunktionen be­ +schrieben, die Ihnen unter dem Obergeriff 'Dateien' im +Menu angeboten werden. + +#on("u")##on("b")#v Verzeichnis#off("b")##off("u")# + Mit dieser Funktion können Sie sich einen Über­ + blick über die in Ihrer Task vorhandenen Dateien ver­ + schaffen. + Nach Aufruf dieser Funktion wird eine Liste der + Dateien auf dem Bildschirm ausgegeben, die sich in + Ihrer Task befinden. Da die Liste selbst eine Datei ist, + kann sie mit der Tastenkombination verlassen + werden - hierauf wird auch in der Kopfzeile der Datei + hingewiesen. Falls nicht alle Dateien auf den Bild­ + schirm passen, können Sie das Fenster mit + bzw. rollen. + +#on("u")##on("b")#l Löschen#off("b")##off("u")# + Mit dieser Funktion können Sie Dateien, die Sie + nicht mehr benötigen, die unnötig Platz belegen, lö­ + schen. Aber Vorsicht! Die Dateien verschwinden durch + diese Funktion unwiederbringlich! + Zunächst wird der Dateiname der Datei erfragt, die + gelöscht werden soll. Hier können Sie direkt den be­ + treffenden Namen eingeben und die Eingabe mit + abschließen. Sie können sich aber auch durch + die Tastenfolge (für 'zeigen') alle in der Task + vorhandenen Dateien zur Auswahl anbieten lassen und + dort einfach einen Namen ankreuzen. + Für jede einzelne Datei wird noch einmal zur + Sicherheit angefragt, ob diese auch tatsächlich ge­ + löscht werden soll. Zur Bestätigung tippen Sie bitte + die Taste ('ja') - zur Verhinderung die Taste + ('nein'). + + Fehlerfälle: + - Eine Datei mit dem angegebenen Namen existiert + nicht. + +#on("u")##on("b")#d Drucken#off("b")##off("u")# + Mit dieser Funktion können Sie Dateien über einen + angeschlossenen Drucker ausdrucken lassen. + Zunächst wird der Dateiname der Datei erfragt, die + gedruckt werden soll. Hier können Sie direkt den be­ + treffenden Namen eingeben und die Eingabe mit + abschließen. Sie können sich aber auch durch + die Tastenfolge (für 'zeigen') alle in der Task + vorhandenen Dateien zur Auswahl anbieten lassen und + dort einfach einen Namen ankreuzen. + Die Datei(en) wird/werden anschließend zum Drucker + geschickt. Der Vorgang wird auf dem Bildschirm proto­ + kolliert. + + Fehlerfälle: + - Eine Datei mit dem angegebenen Namen existiert + nicht. + - Die Druckdatei hat einen falschen Typ zum Drucken + (ist nicht editierbar). + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' be­ + trieben. + - Auf Ihrem System werden die Druckkosten abge­ + rechnet. Sie müssen sich mit einer Codenummer + identifizieren. + +#on("u")##on("b")#k Kopieren#off("b")##off("u")# + Mit dieser Funktion können Sie sich eine (logische) + Kopie einer bereits im System vorhandenen Datei anle­ + gen. Das ist z.B. dann sinnvoll, wenn Sie sich einen + bestimmten Stand einer Datei aufbewahren wollen. + Zunächst wird der Dateiname der Datei erfragt, die + kopiert werden soll. Hier können Sie direkt den be­ + treffenden Namen eingeben und die Eingabe mit + abschließen. Sie können sich aber auch durch + die Tastenfolge (für 'zeigen') alle in der Task + vorhandenen Dateien zur Auswahl anbieten lassen und + dort einfach einen Namen ankreuzen. + Anschließend wird dieser Name angezeigt und der + Name für die Kopie erfragt. Es muß ein Name eingetra­ + gen werden, der in dieser Task noch nicht für eine + Datei vergeben wurde; ansonsten erfolgt ein Hinweis + darauf und es wird nicht kopiert! + Da man aber oft für die Kopie einen ähnlichen Na­ + men wie für das Original wählt, wird der 'alte' Name + vorgeschlagen. Aus genannten Gründen muß er aber + verändert werden. Sie können diesen Namen mit den + üblichen Editierfunktionen verändern oder mit + löschen und ganz neu eingeben. Auf + diese Weise sparen Sie aber eine Menge Tipparbeit, + wenn Sie einen langen Namen nur an einer Stelle än­ + dern wollen. + + Fehlerfälle: + - Eine Datei mit dem angegebenen Namen existiert + nicht. + - Eine Datei mit dem gewünschten Namen existiert + bereits in der Task. + +#on("u")##on("b")#u Umbenennen#off("b")##off("u")# + Mit dieser Funktion können Sie einer bereits vor­ + handenen Datei einen neuen Namen geben. + Zunächst wird der Dateiname der Datei erfragt, die + umbenannt werden soll. Hier können Sie direkt den + betreffenden Namen eingeben und die Eingabe mit + abschließen. Sie können sich aber auch durch + die Tastenfolge (für 'zeigen') alle in der Task + vorhandenen Dateien zur Auswahl anbieten lassen und + dort einfach einen Namen ankreuzen. + Anschließend wird dieser Name angezeigt und der + zukünftige Name für die Datei erfragt. Es muß ein + Name eingetragen werden, der in dieser Task noch + nicht für eine Datei vergeben wurde; ansonsten er­ + folgt ein Hinweis darauf und die Datei wird nicht + umbenannt! + Da man aber oft den 'neuen' Namen in Anlehnung an + den 'alten' Namen wählt, wird der 'alte' Name vorge­ + schlagen. Aus genannten Gründen muß er aber verän­ + dert werden. Sie können diesen Namen mit den üblichen + Editierfunktionen verändern oder mit + löschen und ganz neu eingeben. Auf diese Weise sparen + Sie aber eine Menge Tipparbeit, wenn Sie einen langen + Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Datei mit dem angegebenen Namen existiert + nicht. + - Eine Datei mit dem gewünschten Namen existiert + bereits in der Task. + +#on("u")##on("b")#s Speicherplatz#off("b")##off("u")# + Mit dieser Funktionen können Sie sich zu Ihrer + Information den Speicherbedarf anzeigen lassen, den + eine Datei auf dem Speichermedium einnimmt. + Zunächst wird der Dateiname der Datei erfragt, + deren Speicherplatz ermittelt werden soll. Hier kön­ + nen Sie direkt den betreffenden Namen eingeben und + die Eingabe mit abschließen. Sie können sich + aber auch durch die Tastenfolge (für 'zeigen') + alle in der Task vorhandenen Dateien zur Auswahl + anbieten lassen und dort einfach einen Namen ankreu­ + zen. + Anschließend wird der belegte Speicherplatz der + ausgewählten Datei(en) auf dem Bildschirm angezeigt. + Die Größe wird in KB (Kilobyte) angegeben. Ein KB ent­ + spricht etwa 1000 Zeichen, also einer halb vollge­ + schriebenen Bildschirmseite. + + Fehlerfälle: + - Eine Datei mit dem angegebenen Namen existiert + nicht. + +#on("u")##on("b")#a Aufräumen#off("b")##off("u")# + Wenn in einer Datei viel geändert wurde, wird der + Platzbedarf dieser Datei erheblich vergrößert ("Text­ + leichen"). Dies tritt vor allem dann auf, wenn sehr + häufig eingefügt wurde. Da der Platzbedarf der Datei + zunimmt, sind mehr Speicherzugriffe notwendig, als es + dem Inhalt entspricht. Zudem führt die interne Orga­ + nisation einer solchen Datei zu Einbußen bei der Bear­ + beitungsgeschwindigkeit. + Mit dieser Funktion wird die Datei in eine "fri­ + sche" Datei gewandelt. Diesen Vorgang nennt man 'Re­ + organisieren' (Aufräumen). Anschließend belegt die + Datei zumeist (erheblich) weniger Speicherplatz als + zuvor. + Diese Funktion ist allerdings nur mit einer Ein­ + schränkung nutzbar. Sie läßt sich nur auf Textdateien + anwenden, nicht auf andere Dateitypen. Das System + nimmt aber die Unterscheidung in Dateitypen automa­ + tisch vor - allerdings kann es vorkommen, daß Sie den + Hinweis erhalten: "... kann nicht aufgeräumt werden!". + Zunächst wird der Dateiname der Datei erfragt, die + aufgeräumt (reorganisiert werden soll. Hier können + Sie direkt den betreffenden Namen eingeben und die + Eingabe mit abschließen. Sie können sich + aber auch durch die Tastenfolge (für 'zeigen') + alle in der Task vorhandenen Dateien zur Auswahl + anbieten lassen und dort einfach einen Namen ankreu­ + zen. + Anschließend wird/werden die ausgewählte(n) Da­ + tei(en) aufgeräumt (reorganisert). #on("u")#Achtung! Die Funk­ + tion ist zeitaufwendig!#off("u")# + + Fehlerfälle: + - Eine Datei mit dem angegebenen Namen existiert + nicht. +#page# +4.2 Menufunktionen zum Oberbegriff 'Archiv' + + In diesem Kapitel werden alle die Menufunktionen be­ +schrieben, die Ihnen unter dem Oberbegriff 'Archiv' im +Menu angeboten werden. Mit den Funktionen in diesem +Menu können Sie aber nicht nur Dateien auf dem Archiv +behandeln, sondern auch in anderen Tasks im Multi- +User-System oder über das EUMEL-Netz sogar auf anderen +Rechnern! + Wenn Sie das Pull-Down-Menu (siehe Seite 12) gerade +aufgeschlagen haben, sind nicht alle Funktionen akti­ +vierbar! Um weitere Funktionen zu aktivieren, muß erst +einer der aktivierbaren Menupunkte ausgeführt werden. + +#on("u")##on("b")#r Reservieren#off("b")##off("u")# (des Archivlaufwerks) + Im EUMEL-Multi-User-System haben normalerweise + mehrere Personen das Zugriffsrecht auf das Archiv­ + laufwerk. Allerdings muß der Zugriff so geregelt wer­ + den, daß sich die Beteiligten dabei nicht gegenseitig + "in die Quere kommen". Ein Zugriff auf das Archiv­ + laufwerk erfordert zunächst eine Anmeldung. Ist diese + Anmeldung erfolgt, kann von den anderen Beteiligten + nicht mehr auf das Laufwerk zugegriffen werden - bis + es wieder freigegeben worden ist. + Diese Anmeldung des Archivlaufwerkes erfolgt + über die Menufunktion 'r Reservieren'. Greift bereits + eine andere Task auf das Laufwerk zu, so erhalten Sie + darüber einen Hinweis auf dem Bildschirm. Ansonsten + wird an Sie die Frage gestellt, ob die Diskette einge­ + legt und das Laufwerk geschlossen ist. + Erst zu diesem Zeitpunkt ist sichergestellt, daß Sie + den alleinigen Zugriff auf das Laufwerk haben. Des­ + halb sollten Sie, wenn Sie mit mehreren Personen am + Computer arbeiten, erst zum Zeitpunkt der Fragestel­ + lung die Diskette ins Laufwerk einlegen. + Nachdem Sie die Diskette eingelegt und die Frage + bejaht haben, ermittelt das System selbständig den + Namen der eingelegten Diskette, zeigt den Namen auf + dem Bildschirm (im kleinen Kasten rechts unten) an und + aktiviert die anderen Menupunkte des Pull-Down- + Menus. + #on("u")#Beim Verlassen des Pull-Down-Menus, wenn eine + andere Zieltask eingestellt wird oder wenn das Menu + gänzlich verlassen wird, wird die Reservierung auto­ + matisch aufgehoben!#off("u")# + + Fehlerfälle: + - Das Laufwerk ist von einer anderen Task belegt. + - Die Diskette ist falsch eingelegt oder das Lauf­ + werk ist nicht richtig geschlossen. + - Die Diskette ist nicht formatiert bzw. initiali­ + siert. + - Die Diskette kann nicht gelesen werden (keine + EUMEL-Diskette, Diskette hat ein falsches Format, + Diskette ist verschmutzt...). + +#on("u")##on("b")#n Neue Diskette#off("b")##off("u")# (anmelden) + Der Dateiaustausch mit einer Diskette ist nur dann + möglich, wenn der im System eingestellte Diskettenna­ + me (auf dem Bildschirm im kleinen Kasten unten rechts + sichtbar) mit dem tatsächlichen Namen der Diskette + übereinstimmt. Nach einem Diskettenwechsel ist das + aber in der Regel nicht mehr der Fall. Greift man dann + auf die neu eingelegte Diskette zu, so erscheint die + Fehlermeldung: 'Falscher Archivname! Bitte neue Dis­ + kette anmelden!'. + Das Anmelden einer neuen Diskette - ohne einen + neuen Reserviervorgang - wird durch diese Menufunk­ + tion ermöglicht. Nach Aktivieren dieses Menupunktes + wird der Name der eingelegten Diskette ermittelt, im + System eingestellt und auf dem Bildschirm angezeigt. + Im Gegensatz zur Menufunktion 'r Reservieren' + greift #on("b")#gs-DIALOG#off("b")# ohne Anfrage an den Benutzer auf + das Archivlaufwerk zu (die Reservierung bleibt ja + bestehen). Ist das Archivlaufwerk reserviert, so ist + die Neuanmeldung einer Diskette über diese Menufunk­ + tion weniger zeitaufwendig. + + Fehlerfälle: + - wie unter 'r Reservieren' + +#on("u")##on("b")#s Schreiben#off("b")##off("u")# (Kopieren) + Alle Dateien der eigenen Task werden zur Auswahl + angeboten. Wenn Sie die Auswahl durch die Tastenfolge + verlassen, überprüft #on("b")#gs-DIALOG#off("b")# zunächst, ob + die Dateien in der eingestellten Zietask schon vor­ + handen sind. Ist das der Fall, erfragt #on("b")#gs-DIALOG#off("b")#, ob + die dort vorhandenen Dateien überschrieben, d.h. ge­ + löscht werden dürfen (s.u.). Anschließend werden alle + angekreuzten Dateien in der Reihenfolge, in der Sie + sie angekreuzt haben, in die eingestellte Zieltask + kopiert. Der Vorgang wird auf dem Bildschirm proto­ + kolliert. Die Originaldateien in der eigenen Task + bleiben dabei erhalten. + Wenn in der Zieltask schon eine Datei existiert, die + den gleichen Namen hat wie eine Datei, die Sie dorthin + kopieren möchten, so wird angefragt, ob die vorher + schon existierende Datei überschrieben (gelöscht!) + werden soll. Bejahen Sie diese Frage, so wird die be­ + reits in der Zieltask existierende Datei (unwieder­ + bringlich) gelöscht und die gewünschte Datei dorthin + transportiert. Ein Überschreiben aus Versehen ist + nicht möglich, wenn Sie die an Sie gestellte Frage + sorgfältig beantworten. + Verneinen Sie die Frage, so wird die Datei auch + nicht hinübertransportiert! Sie können die Datei aber + umbenennen (Menufunktion 'u Umbenennen' unter dem + Oberbegriff 'Dateien') und anschließend mit anderem + Namen hinüberschreiben. + Beachten Sie, daß beim Überschreiben einer Datei + auf einer Archivdiskette der Speicherplatz der alten + (überschriebenen) Version im allgemeinen nicht wie­ + derverwendet werden kann. In einem solchen Fall + könnte die Diskette voll geschrieben werden, obwohl + eigentlich genügend Platz vorhanden wäre. Zur Opti­ + mierung überprüft #on("b")#gs-DIALOG#off("b")# deshalb zuerst, ob die + angekreuzten Dateien schon in der Zieltask vorhanden + sind und löscht diese, wenn Sie Ihr Einverständnis + geben. Erst anschließend werden die Dateien insgesamt + kopiert. + Normalerweise ist als Zieltask das Archivlaufwerk + der eigenen Station eingestellt. Mit der Menufunktion + 'z Zieltask einstellen' kann diese Einstellung aber + verändert werden. + + Fehlerfälle: + - Die Diskette ist falsch eingelegt oder beschädigt. + - Die Diskette kann nicht beschrieben werden + (Schreibfehler) + - Die Diskette ist voll. + - Sehen Sie auch unter 'r Reservieren' + 'z Zieltask einstellen' + +#on("u")##on("b")#c Checken#off("b")##off("u")# + Diese Menufunktion kann nur ausgeführt werden, + wenn der Dateiaustausch mit einem Archiv(manager) + erfolgt - ansonsten ist diese Menufunktion auch + nicht aktivierbar. Die Menufunktion dient dazu, auf + Diskette geschriebene Dateien auf Lesefehler hin zu + prüfen. Es empfiehlt sich, diese Prüfroutine auf neu + auf die Diskette geschriebene Dateien anzuwenden. + Sehen Sie dazu auch 'k Kombination' + Alle Dateien der eingestellten Zieltask (Archiv) + werden zur Auswahl angeboten. Wenn Sie die Auswahl + durch die Tastenfolge verlassen, werden alle + angekreuzten Dateien in der Reihenfolge, in der Sie + sie angekreuzt haben, "gecheckt", d.h. auf Lesefehler + hin überprüft. Der Vorgang wird auf dem Bildschirm + protokolliert. + + Fehlerfälle: + - Lesefehler auf dem Archiv + - Sehen Sie auch unter 'r Reservieren' + +#on("u")##on("b")#k Kombination#off("b")##off("u")# + Diese Menufunktion ist eine Kombination aus den + beiden Menufunktionen 's Schreiben' und 'c Checken' + (Sehen Sie weitere Informationen auch dort!). + Alle Dateien der eigenen Task werden zur Auswahl + angeboten. Wenn Sie die Auswahl durch die Tastenfolge + verlassen, werden alle angekreuzten Dateien + in der Reihenfolge, in der Sie sie angekreuzt haben, + in die eingestellte Zieltask kopiert (gegebenenfalls + müssen bereits vorhandene Dateien gleichen Namens in + der Zieltask gelöscht werden). Anschließend werden + alle Dateien, die gerade geschrieben wurden, gecheckt, + d.h. auf Lesefehler hin untersucht. Beide Vorgänge + werden auf dem Bildschirm protokolliert. + Da die 'Check' - Operation nur bei Archivmanagern + zulässig ist, ist diese Menufunktion ebenfalls nur bei + Archivmanagern aktivierbar. Zur Erläuterung sehen + Sie bitte auch unter 'z Zieltask einstellen'. + +#on("u")##on("b")#h Holen/Lesen#off("b")##off("u")# + Die Menufunktion dient dazu, Dateien, die bereits + auf einer Archivdiskette oder in einer anderen Task + existieren, in die eigene Task zu kopieren. + Alle Dateien der eingestellten Zieltask werden zur + Auswahl angeboten. Anschließend werden Kopien der + angekreuzten Dateien in der Reihenfolge des Ankreu­ + zens in die eigene Task geholt. Das Original in der + Zieltask bleibt dabei unverändert! Der Vorgang wird + auf dem Bildschirm protokolliert. + Sind in der eigenen Task schon Dateien mit glei­ + chem Namen vorhanden, so wird gefragt, ob die 'alten' + Dateien überschrieben (gelöscht) werden dürfen. Nur + wenn Sie zustimmen, werden die in Ihrer Task existie­ + renden Dateien (unwiederbringlich!) gelöscht und Ko­ + pien der gleichnamigen Dateien aus der Zieltask ange­ + fertigt. + Stimmen Sie dem Löschvorgang nicht zu, dann blei­ + ben die bisherigen Dateien in Ihrer Task erhalten - + die Dateien aus der Zieltask werden dann aber auch + nicht in Ihre Task kopiert! Um dennoch die Kopien zu + erhalten, können Sie die namensgleichen Dateien in + Ihrer Task umbenennen und dann erst die Dateien aus + der anderen Task anfordern. + Normalerweise werden die Dateien vom Archiv der + eigenen Station geholt. Mit dem Menupunkt 'z Zieltask + einstellen' kann diese Einstellung verändert werden. + + Fehlerfälle: + - Lesefehler auf dem Archiv + - Sehen Sie auch unter 'r Reservieren' + 's Schreiben' + 'z Zieltask einstellen' + +#on("u")##on("b")#l Löschen#off("b")##off("u")# + Die Menufunktion dient dazu, Dateien in der Ziel­ + task (unwiederbringlich!) zu löschen. Dazu werden alle + Dateien der eingestellten Zieltask zur Auswahl ange­ + boten. Anschließend werden die angekreuzten Dateien + in der Reihenfolge ihres Ankreuzens gelöscht. Zur + Sicherheit muß noch einmal für jede einzelne Datei + bestätigt werden, daß sie auch tatsächlich gelöscht + werden soll. + Beachten Sie, daß beim Löschen einer Datei auf ei­ + ner Archivdiskette der Speicherplatz im allgemeinen + nicht wieder verwendet werden kann. In einem solchen + Fall könnte die Diskette voll geschrieben werden, + obwohl eigentlich genügend Platz vorhanden wäre. + Diese Probleme treten bei anderen Tasks, die keine + Archivmanager sind, nicht auf, da deren Speicherplatz + intelligenter verwaltet wird. + Normalerweise ist als Zieltask das Archiv der eige­ + nen Station eingestellt. Mit dem Menupunkt 'z Zieltask + einstellen' kann diese Einstellung verändert werden. + + Fehlerfälle: + - Sehen Sie auch unter 'r Reservieren' + 's Schreiben' + 'z Zieltask einstellen' + +#on("u")##on("b")#v Verzeichnis#off("b")##off("u")# + Mit dieser Menufunktion können Sie sich einen + Überblick über die in der Zieltask (z.B. auf dem Archiv) + vorhandenen Dateien verschaffen. + Nach Aufruf der Funktion wird eine Liste der Da­ + teien auf dem Bildschirm ausgegeben, die sich in der + Zieltask (z.B. auf dem Archiv) befinden. Ist die Zieltask + ein Archiv(manager), so wird auch angezeigt, wieviel + Platz auf der Diskette belegt ist. Da die Liste selbst + eine Datei ist, kann sie mit der Tastenkombination + verlassen werden. Falls nicht alle Dateinamen + auf den Bildschirm passen, können Sie das Fenster mit + und rollen. + + Fehlerfälle: + - Sehen Sie unter 'z Zieltask einstellen' + +#on("u")##on("b")#d Drucken#off("b")##off("u")# + Das Verzeichnis der Dateien in der Zieltask, das + man mit der Menufunktion 'v Verzeichnis' auf dem Bild­ + schirm angezeigt bekommt, kann mit dieser Menufunk­ + tion ausgedruckt werden. + Zur Sicherheit fragt #on("b")#gs-DIALOG#off("b")# an, ob wirklich ein + solches Dateiverzeichnis der Zieltask gedruckt werden + soll. Bejaht man die Frage, so wird ein Dateiverzeich­ + nis erstellt und zum Drucker geschickt. + + Fehlerfälle: + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' be­ + trieben. + - Auf Ihrem System werden die Druckkosten abge­ + rechnet. Sie müssen sich mit einer Codenummer + identifizieren. + +#on("u")##on("b")#i Initialisieren#off("b")##off("u")# + Diese Menufunktion gestattet es, frische Disketten + zu formatieren, zu initialisieren bzw. beschriebene + Disketten vollständig zu löschen und ggf. dabei umzu­ + benennen. Bei Aufruf dieser Menufunktion wird - so­ + fern noch nicht geschehen - das Archivlaufwerk auto­ + matisch reserviert. + Wenn Sie eine fabrikneue Diskette aus der Verpak­ + kung nehmen, müssen Sie diese zunächst #on("u")#formatieren#off("u")#. + Dabei wird die Diskette auf ein festgelegtes physika­ + lisches Format eingestellt. Ohne daß diese Operation + vorausgegangen ist, kann eine Diskette weder be­ + schrieben noch gelesen werden. + Prinzipiell braucht eine Diskette nur ein einziges + Mal formatiert zu werden. Sie können Sie jedoch jeder­ + zeit wieder formatieren - z.B. wenn Sie Disketten ha­ + ben, von denen Sie nicht genau wissen, für welche + Zwecke sie zuvor verwendet wurden. + Wenn Sie diese Menufunktion aktivieren, werden Sie + zunächst gefragt, ob Sie die Diskette auch formatie­ + ren wollen. Bejahen Sie die Frage, so werden Ihnen + mehrere Formate zur Auswahl angeboten: + +#on ("b")# + +------------------------------------+ + | Formatieren einer Diskette | + | | + | Dies sind die möglichen Formate: | + | | + | 1 ..... 40 Spur - 360 KB | + | 2 ..... 80 Spur - 720 KB | + | 3 ..... 5 1/4" - 1,2 MB | + | 4 ..... 3 1/2" - 1,4 MB | + | s ..... Standard - Format | + | | + | 1 2 3 4 s | + +------------------------------------+ +#off("b")# + + Erkundigen Sie sich bei Ihrem Händler, welches + Format Sie bei Ihrem Rechner und den von Ihnen ver­ + wendeten Disketten einstellen müssen. Manche Rechner + unterstützen diese Operation innerhalb des EUMEL- + Systems auch gar nicht, das Formatieren muß dann ir­ + gendwie anders außerhalb des EUMEL-Systems gesche­ + hen. + Wenn Sie die Formatierung abgeschlossen oder auch + übersprungen haben, beginnt die eigentliche Initiali­ + sierung der Diskette. Dabei wird als erstes der Ar­ + chivname auf die Diskette geschrieben. Alle alten Da­ + ten, die sich ggf. auf der Diskette befinden, werden + auch bei diesem Vorgang unwiederbringlich (!) ge­ + löscht. + Zur Sicherheit überprüft #on("b")#gs-DIALOG#off("b")# in jedem Falle, + ob es sich um eine EUMEL - Diskette handelt, und er­ + fragt Ihr Einverständnis, ob die Diskette wirklich + initialisiert werden soll. Geben Sie hierzu Ihr Ein­ + verständnis, dann erfragt #on("b")#gs-DIALOG#off("b")# noch den (neuen) + Archivnamen. Hatte die Diskette schon einen Namen, + dann wird dieser zum Überschreiben angeboten. Wollen + Sie den alten Archivnamen beibehalten, so brauchen + Sie nur die -Taste zu tippen, ansonsten kön­ + nen Sie den Namen auch zuvor verändern oder einen + ganz neuen Namen hinschreiben. Anhand des ausgege­ + benen Namens können Sie auch überprüfen, ob Sie die + richtige Diskette eingelegt haben. + Das Initialisieren funktioniert natürlich nur, + wenn Sie als Zieltask einen Archivmanager eingestellt + haben - ansonsten ist diese Menufunktion gesperrt + (nicht aktivierbar!). + + Fehlerfälle: + - Formatieren ist nicht auf dem System möglich + - Sehen Sie auch unter 'r Reservieren' + 'z Zieltask einstellen' + +#on("u")##on("b")#z Zieltask einstellen#off("b")##off("u")# + Mit dieser Menufunktion können Sie festlegen, mit + welcher Zieltask Sie kommunizieren, d.h. z.B. Dateien + austauschen möchten. Normalerweise ist hier das Archiv + am eigenen Rechner eingestellt. Das wird auch nach + Aufklappen des Pull-Down-Menus im Kasten rechts + unten angezeigt. + Sie können aber auch eine andere Task einstellen + (z.B. die Vatertask oder die Task 'PUBLIC'), um mit diesen + Dateien auszutauschen oder um sich auch nur einen + Überblick über die dort vorhandenen Dateien zu ver­ + schaffen. Wenn Sie mit Ihrem Rechner in ein EUMEL-Netz + integriert sind, können Sie auch auf Tasks anderer + Rechner zugreifen oder auch Disketten von Laufwerken + anderer Rechner einlesen (z.B. wenn Sie Disketten ande­ + rer Formate haben, die von Ihrem Rechner nicht gelesen + werden können). + Dabei werden zwei Anforderungen an die Zieltask + gestellt: Sie muß existieren und bereit für den Datei­ + austausch sein, d.h es muß eine Managertask sein, auf + die Sie Zugriff haben. Versuchen Sie auf andere Tasks + zuzugreifen, so erhalten Sie entsprechende (Fehler-)­ + Meldungen. + Zu beachten ist noch, daß es im EUMEL-System ver­ + schiedene Arten von Managertasks gibt - Archivmana­ + ger und normale Dateimanager. Der Unterschied besteht + darin, daß ein Archivmanager vom Benutzer vor dem + Zugriff reserviert werden muß - anschließend hat nur + dieser Benutzer (bis zur Aufgabe der Reservierung) ein + Zugriffsrechts auf den Manager. Normale Dateimanager + können dagegen von mehreren Benutzern in beliebiger + Reihenfolge angesprochen werden. + Ein Archivmanager kann auch auf bestimmte Disket­ + tenformate spezialisert sein (z.B. auf das Lesen von + DOS-Disketten). Manche Rechner haben auch mehrere + Archivmanager für verschiedene Laufwerke etc. Durch + Einstellen unterschiedlicher Archivmanager können + Sie dann auf verschiedenen Laufwerken archivieren. + Nach Aktivieren dieses Menupunktes werden Ihnen + die folgenden Alternativen angeboten: + +#on ("b")# + +-------------------------------------------+ + | Dateiaustausch gewünscht mit: | + | | + | a ... Archiv (Eigene Station) | + | | + | v ... Vatertask | + | | + | p ... 'PUBLIC' (Eigene Station) | + | | + | s ... Sonstige Task | + | | + | | + | Archiv Vatertask PUBLIC Sonstige | + +-------------------------------------------+ +#off("b")# + + Da der Dateiaustausch mit dem Standardarchiv der + eigenen Station (Task: 'ARCHIVE'), mit der Vatertask + und der Task 'PUBLIC' recht häufig in Anspruch genom­ + men wird, sind diese drei Optionen unter den Alterna­ + tiven direkt angegeben. Entscheiden Sie sich für eine + dieser drei Tasks, so nimmt #on("b")#gs-DIALOG#off("b")# alle notwendi­ + gen Einstellungen vor. Möchten Sie dagegen in Kon­ + takt mit einer anderen Task treten, so wählen Sie die + Alternative 's ... Sonstige Task'. + + In diesem Falle haben Sie noch 3 Angaben zu machen: + + - Zunächst werden Sie nach dem Namen der Zieltask + gefragt. Geben Sie den Namen der Zieltask - ohne + Anführungsstriche (!) - ein und schließen Sie die + Eingabe mit der -Taste ab. (Den ausgegebe­ + nen Namen der z.Z. eingestellten Task können Sie + dabei verändern bzw. überschreiben.) + - Dann wird die Nummer der Station im EUMEL-Netz + erfragt, auf der sich die Zieltask befindet. Die + Nummer Ihrer Station wird als Vorschlag ausgege­ + ben. Wollen Sie mit einer Task auf Ihrem Rechner + kommunizieren, so brauchen Sie diesen Vorschlag + nur durch Drücken der -Taste zu bestäti­ + gen; ansonsten tragen Sie zuvor die entsprechende + Stationsnummer ein. Ist Ihr Rechner nicht in ein + EUMEL-Netz integriert, so wird die Stationsnummer + 0 (Null) ausgegeben. Bitte bestätigen Sie diese Sta­ + tionsnummer durch Tippen der -Taste. + - Zum Abschluß müssen Sie noch angeben, ob die ein­ + gestellte Zieltask ein Archivmanager ist oder + nicht. + + #on("b")#gs-DIALOG#off("b")# versucht dann den Kontakt herzustellen. + Je nachdem, welche Einstellung Sie vorgenommen ha­ + ben, sind bestimmte Funktionen innerhalb des Menus + nicht aktivierbar. #on("b")#gs-DIALOG#off("b")# läßt nur die Funktionen + zu, die aufgrund Ihrer Einstellungen zulässig sind. + Im Kasten rechts unten auf dem Bildschirm wird + jeweils angezeigt, welche Zieltask eingestellt ist. + Erscheint in diesem Kasten auch ein Hinweis auf den + Archivnamen, so haben Sie einen Archivmanager einge­ + stellt. Ist dagegen vor dem Namen der Zieltask noch + eine Zahl und ein Schrägstrich angegeben, so haben + Sie eine Zieltask auf einem anderen Rechner einge­ + stellt. + Bedenken Sie, daß Operationen mit Tasks auf ande­ + ren Stationen länger andauern können - werden Sie + nicht ungeduldig! + Sie können die Einstellung der Zieltask jederzeit + wieder verändern! + + Fehlerfälle: + - Die eingestellte Zieltask existiert nicht. + - Die eingestellte Zieltask existiert zwar, ist aber + nicht empfangsbereit, d.h. ein Zugriff von Ihrer + Task aus ist nicht möglich! + - Das Netz ist nicht funktionsbereit (Collector-Task + fehlt). + - Die Kommunikation war nicht erfolgreich. + - Die gewünschte Operation kann mit der eingestell­ + ten Zieltask nicht ausgeführt werden (Zieltask ist + z.B. gar kein Archivmanager - Sie aber versuchen, + das Laufwerk zu reservieren) + diff --git a/app/gs.dialog/1.2/doc/gs-dialog-5 b/app/gs.dialog/1.2/doc/gs-dialog-5 new file mode 100644 index 0000000..f2b17cf --- /dev/null +++ b/app/gs.dialog/1.2/doc/gs-dialog-5 @@ -0,0 +1,176 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (49)# +#headodd# +#center#gs-DIALOG#right#% + +#end# +#headeven# +%#center#gs-DIALOG + +#end# +#center#5 + +#center#Informationen für Lehrer/Programmierer + + +5.1 "Verschlüsselung" der Dateien auf der Diskette + + Wenn Sie sich die Inhalte der Dateien angesehen haben, +in denen die Programme für #on("b")#gs-DIALOG#off("b")# enthalten sind, +werden Sie festgestellt haben, daß der Code dicht gepackt +ist. Das war notwendig, um die gesamten Programme auf +einer Diskette unterzubringen. + Allerdings ist der Code #on("u")#nicht#off("u")# verschlüsselt - nur +dichter gepackt. Auf der gelieferten Diskette befindet +sich eine Datei mit Namen "gs-DIALOG decompress". In die­ +ser Datei ist das (einfache) Komprimier- und Dekompri­ +mierprogramm enthalten. Insertieren Sie dieses Programm +in einer Task. Anschließend stehen Ihnen zwei Befehle zur +Verfügung: + +PROC komprimiere (TEXT CONST dateiname): + Die angegebene Datei wird komprimiert; die Datei steht + anschließend unter gleichem Namen zur Verfügung. + +PROC dekomprimiere (TEXT CONST dateiname): + Eine zuvor mit 'komprimiere' bearbeitete Datei wird - + bis auf die Leerzeilen - in den Ursprungszustand über­ + führt. Die Datei steht anschließend wieder unter glei­ + chem Namen zur Verfügung. + + Dieser 'Service' ist vornehmlich für Lehrer gedacht. +So können Programmteile im Unterricht Gegenstand von +Betrachtungen sein; Schüler können nach optimaleren +Algorithmen für Teillösungen suchen - ggf. Anregungen +geben. Sinnvoll ist es, das eigentliche Programm nicht zu +verändern, um die Lauffähigkeit der unter #on("b")#gs-DIALOG#off("b")# +entwickelten Software nicht zu gefährden. + + +5.2 Nutzung der Graphikzeichen auf anderen Rechnern/ +Terminals + + Wie schon unter "2.4 Nutzung der 'Semi - Graphik - +Zeichen'" erwähnt, ist #on("b")#gs-DIALOG#off("b")# darauf vorbereitet, für +'IBM - kompatible Rechner' und für Terminals 'Beehive +FT20' die Umrahmungen der Kästen als durchgezogene Li­ +nien auszugeben - dadurch gewinnt die Bildschirmdar­ +stellung. + #on("b")#gs-DIALOG#off("b")# ist aber hinsichtlich der Graphikzeichen +nur für diese Endgeräte vorbereitet und benutzt in allen +anderen Fällen Zeichen des normalen Zeichensatzes. + Sie können sich aber, sofern Ihr Rechner/Terminal +über solche Semi - Graphikzeichen verfügt, leicht selbst +eine Anpassung dafür erstellen. Auch darauf ist +#on("b")#gs-DIALOG#off("b")# schon vorbereitet. Keine Angst, versuchen Sie +es ruhig einmal. Sie können nichts falsch machen; denn +sollte es Ihnen nicht gelingen, so können Sie jederzeit +mit dem Befehl 'std graphic char' und einem anschließen­ +den die Standardeinstellung wieder vornehmen. + Informieren Sie sich in Ihrer Terminal-/Rechner­ +beschreibung, welche Codes ausgegeben werden müssen, um +die Grahpikzeichen darzustellen. Folgende Zeichen werden +benötigt: + + Ecke oben links : ω (f) + Ecke oben rechts : � (g) + Ecke unten links : � (e) + Ecke unten rechts : � (h) + + Balken oben : � (n) + Balken unten : ̂ (o) + Balken links : ̄ (m) + Balken rechts : ̃ (l) + Kreuz : ̗ (i) + + waagerechte Linie : ̇ (k) + senkrechte Linie : � (j) + + --------------------------------------------- + + ( Cursor sichtbar : ( ESC . 1 ) ) + ( Cursor unsichtbar : ( ESC . 0 ) ) + + + #on("b")#gs-DIALOG#off("b")# müssen nun die speziellen Codes Ihres Rech­ +ners/Terminals mitgeteilt werden. Dafür stehen die fol­ +genden Prozeduren zur Verfügung: + +PROC ecke oben links (TEXT CONST zeichenkette); +PROC ecke oben rechts (TEXT CONST zeichenkette); +PROC ecke unten links (TEXT CONST zeichenkette); +PROC ecke unten rechts (TEXT CONST zeichenkette); +PROC balken oben (TEXT CONST zeichenkette); +PROC balken unten (TEXT CONST zeichenkette); +PROC balken links (TEXT CONST zeichenkette); +PROC balken rechts (TEXT CONST zeichenkette); +PROC waagerecht (TEXT CONST zeichenkette); +PROC senkrecht (TEXT CONST zeichenkette); +PROC kreuz (TEXT CONST zeichenkette); + +PROC cursor on (TEXT CONST zeichenkette); +PROC cursor off (TEXT CONST zeichenkette); + + Sofern möglich, kann auch noch ein Code eingegeben +werden, damit der Cursor auf dem Bildschirm sichtbar bzw. +unsichtbar ist. + Wie man sich selbst eine Anpassung schreiben kann, +wollen wir hier an einem Beispiel aufzeigen. Wir schrei­ +ben dazu eine Anpassung für das Terminal 'Ampex 210+'. + In der Terminalbeschreibung ist angegeben, wie das +Terminal konfiguriert sein muß - diese Konfiguartion +haben wir eingestellt. Weiterhin ist angegeben, daß auf +die Grapikzeichen durch die Zeichenfolge 'ESC $' umge­ +schaltet und durch die Zeichenfolge 'ESC %' auf den nor­ +malen Zeichensatz zurückgeschaltet wird. Für die jeweils +speziellen Graphikzeichen sind bestimmte Buchstaben an­ +zugeben (z.B. für die 'Ecke oben links' der Buchstabe 'f'). +Die Zeichen für dieses Terminal sind oben hinter den Gra­ +phikzeichen in Klammern angegeben. Für 'ESC' muß der Code +'27' ausgegeben werden. + +PACKET eigene graphikanpassung DEFINES + + private graphic char: + +PROC private graphic char: + ecke oben links (""27"$f"27"%"); + ecke oben rechts (""27"$g"27"%"); + ecke unten links (""27"$e"27"%"); + ecke unten rechts (""27"$h"27"%"); + balken oben (""27"$n"27"%"); + balken rechts (""27"$l"27"%"); + balken links (""27"$m"27"%"); + balken unten (""27"$o"27"%"); + waagerecht (""27"$k"27"%"); + senkrecht (""27"$j"27"%"); + kreuz (""27"$i"27"%"); + cursor on (""27".1"); + cursor off (""27".0"); +END PROC private graphic char; + +END PACKET eigene graphikanpassung; + + Nachdem das Programm insertiert und der Befehl +'private graphic char' gegeben ist, steht in dieser Task +und allen Söhnen davon die Graphikanpassung für das +Terminal 'Ampex 210+' zur Verfügung. + + +5.3 Fehlerbehandlung + + Haben Sie z.B. das Menu durch Tippen der -Taste +verlassen, so kann es vorkommen, daß anschließend das +Menu auf dem Bildschirm nicht ordnungsgemäß aufgebaut +wird. Verlassen Sie dann die Menuebene durch die Tasten­ +folge . + +Wenn 'gib kommando:' erscheint, geben Sie den Befehl + + reset dialog + + Dadurch wird das Menusystem in den Anfangszustand +gesetzt. Anschließend können Sie das von Ihnen ge­ +wünschte Programm (wieder) aufrufen. + diff --git a/app/gs.dialog/1.2/doc/gs-dialog-Inhaltsverzeichnis b/app/gs.dialog/1.2/doc/gs-dialog-Inhaltsverzeichnis new file mode 100644 index 0000000..741744f --- /dev/null +++ b/app/gs.dialog/1.2/doc/gs-dialog-Inhaltsverzeichnis @@ -0,0 +1,45 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +Inhaltsverzeichnis + + +1 Was kann gs-DIALOG 3 + +2 Installation von gs-DIALOG 6 +2.1 Voraussetzungen 6 +2.2 Lieferumfang 6 +2.3 Installation 6 +2.4 Nutzung der 'Semi-Graphik-Zeichen' 10 + +3 Umgang mit den Menus; Eine Beispielsitzung 12 +3.1 Aufruf der Archivverwaltung 12 +3.2 Bedienung des Menusystems 14 + - Aufbau der Menus (Bildschirmaufbau) 14 + - Auswahl der Menupunkte 15 + - Informationen zu einem Menupunkt 18 + - Informationen zur Bedienung des Menus 19 + - Aktivierbare und nicht aktivierbare + Menupunkte 20 + - Aktivieren von Menupunkten 21 + - Dateiauswahl 22 + - Ja/Nein - Fragen 26 + - Eingaben 26 + - Alternativen 26 + - Verlassen des Menus 27 +3.3 Zusammenfassung/Kurzbeschreibung 28 + +4 Beschreibung der Menufunktionen 30 +4.1 Menufunktionen zum Oberbegriff 'Dateien' 30 +4.2 Menufunktionen zum Oberbegriff 'Archiv' 36 + +5 Informationen für Lehrer/Programmierer 49 +5.1 "Verschlüsselung" der Dateien auf der + Diskette 49 +5.2 Nutzung der Graphikzeichen auf andere + Rechnern/Terminals 50 +5.3 Fehlerbehandlung 53 + + + + + diff --git a/app/gs.dialog/1.2/source-disk b/app/gs.dialog/1.2/source-disk new file mode 100644 index 0000000..daf7d81 --- /dev/null +++ b/app/gs.dialog/1.2/source-disk @@ -0,0 +1 @@ +informatikpaket/05_gs.dialog.img diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 1 b/app/gs.dialog/1.2/src/ls-DIALOG 1 new file mode 100644 index 0000000..974bcda --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG 1 @@ -0,0 +1,60 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG 1 ** + ** ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) +PACKET ls dialog 1 DEFINES + ecke oben links, balken oben,{} ecke oben rechts, balken rechts,{} ecke unten links, balken links,{} ecke unten rechts, balken unten,{} waagerecht, senkrecht, kreuz,{} cursor on, cursor off,{} clear buffer, clear buffer and count,{} center, invers, page, page up,{} out frame, out menuframe, erase frame,{} std graphic char, ft20 graphic char,{} ibm graphic char, AREA, :=, fill,{} areax, areay, areaxsize, areaysize,{} cursor, get cursor, out, out invers,{} + out with beam, out invers with beam,{} erase, erase invers, erase with beam:{}TYPE AREA = STRUCT (INT x, y, xsize, ysize);{}LET blank = " ",{} mark ein = ""15"",{} mark aus = ""14"",{} cleol = ""5"";{}TEXT CONST fehlermeldung :: "Unzulässige Größen!";{}TEXT VAR eol := "+", eor := "+", eul := "+", eur := "+",{} bo := "+", br := "+", bl := "+", bu := "+",{} waa := "-", sen := "|", kr := "+",{} cursor sichtbar := "", cursor unsichtbar := "";{} +TEXT PROC ecke oben links : eol END PROC ecke oben links ;{}TEXT PROC ecke oben rechts: eor END PROC ecke oben rechts ;{}TEXT PROC ecke unten links : eul END PROC ecke unten links ;{}TEXT PROC ecke unten rechts: eur END PROC ecke unten rechts ;{}TEXT PROC balken oben : bo END PROC balken oben ;{}TEXT PROC balken links : bl END PROC balken links ;{}TEXT PROC balken rechts : br END PROC balken rechts ;{}TEXT PROC balken unten : bu END PROC balken unten ;{} +TEXT PROC waagerecht : waa END PROC waagerecht ;{}TEXT PROC senkrecht : sen END PROC senkrecht ;{}TEXT PROC kreuz : kr END PROC kreuz ;{}PROC ecke oben links (TEXT CONST t): eol := t END PROC ecke oben links ;{}PROC ecke oben rechts (TEXT CONST t): eor := t END PROC ecke oben rechts ;{}PROC ecke unten links (TEXT CONST t): eul := t END PROC ecke unten links ;{}PROC ecke unten rechts (TEXT CONST t): eur := t END PROC ecke unten rechts ;{} +PROC balken oben (TEXT CONST t): bo := t END PROC balken oben ;{}PROC balken links (TEXT CONST t): bl := t END PROC balken links ;{}PROC balken rechts (TEXT CONST t): br := t END PROC balken rechts ;{}PROC balken unten (TEXT CONST t): bu := t END PROC balken unten ;{}PROC waagerecht (TEXT CONST t): waa := t END PROC waagerecht ;{}PROC senkrecht (TEXT CONST t): sen := t END PROC senkrecht ;{}PROC kreuz (TEXT CONST t): kr := t END PROC kreuz ;{} +PROC std graphic char:{} ecke oben links ("+"); ecke oben rechts ("+");{} ecke unten links ("+"); ecke unten rechts ("+");{} balken oben ("+"); balken rechts ("+");{} balken links ("+"); balken unten ("+");{} waagerecht ("-"); senkrecht ("|");{} kreuz ("+");{} cursor sichtbar := ""; cursor unsichtbar := ""{}END PROC std graphic char;{}PROC ft20 graphic char:{} ecke oben links (""27"R�"27"S"); ecke oben rechts (""27"RD"27"S");{} ecke unten links (""27"RH"27"S"); ecke unten rechts (""27"RL"27"S");{} + balken oben (""27"RP"27"S"); balken rechts (""27"RT"27"S");{} balken links (""27"RX"27"S"); balken unten (""27"R\"27"S");{} waagerecht (""27"R`"27"S"); senkrecht (""27"Rd"27"S");{} kreuz (""27"Rh"27"S");{} cursor sichtbar := ""27"-1" ; cursor unsichtbar := ""27"-0" ;{} ft20 statuszeilen aus{}END PROC ft20 graphic char;{}PROC ft 20 statuszeilen aus: out (""27".A") END PROC ft 20 statuszeilen aus;{}PROC ft 20 statuszeilen an : out (""27".�") END PROC ft 20 statuszeilen an ;{} +PROC ibm graphic char:{} ecke oben links (""201""); ecke oben rechts (""187"");{} ecke unten links (""200""); ecke unten rechts (""188"");{} balken oben (""203""); balken rechts (""185"");{} balken links (""204""); balken unten (""202"");{} waagerecht (""205""); senkrecht (""186"");{} kreuz (""206"");{} cursor sichtbar := "" ; cursor unsichtbar := ""{}END PROC ibm graphic char;{}PROC cursor on : out (cursor sichtbar ) END PROC cursor on ;{} +PROC cursor off : out (cursor unsichtbar) END PROC cursor off;{}PROC cursor on (TEXT CONST t): cursor sichtbar := t END PROC cursor on ;{}PROC cursor off (TEXT CONST t): cursor unsichtbar := t END PROC cursor off;{}PROC clear buffer:{} REP UNTIL incharety = "" PER{}END PROC clear buffer;{}INT PROC clear buffer and count (TEXT CONST zeichen):{} INT VAR zaehler :: 0;{} TEXT VAR zeichenkette :: "", ch;{} IF zeichen = "" THEN clear buffer; LEAVE clear buffer and count WITH 0 FI;{} + ermittle die zeichenkette;{} untersuche auf vorhandene zeichen;{} zaehler.{} ermittle die zeichenkette:{} REP{} ch := incharety (1);{} zeichenkette CAT ch{} UNTIL ch = "" PER.{} untersuche auf vorhandene zeichen:{} INT VAR i;{} FOR i FROM 1 UPTO length (zeichenkette) REP{} IF pos (subtext (zeichenkette, i), zeichen) = 1{} THEN zaehler INCR 1{} FI{} PER.{}END PROC clear buffer and count;{}TEXT PROC center (INT CONST xsize, TEXT CONST t):{} TEXT VAR zeile :: compress (t);{} + zeile := ((xsize - length (zeile)) DIV 2) * blank + zeile;{} zeile CAT (xsize - length (zeile)) * blank;{} zeile{}END PROC center;{}TEXT PROC center (TEXT CONST t):{} center (79, t){}END PROC center;{}TEXT PROC invers (TEXT CONST t):{} TEXT VAR neu :: mark ein; neu CAT t; neu CAT " "; neu CAT mark aus;{} neu{}END PROC invers;{}PROC page (INT CONST x, y, xsize, ysize):{} INT VAR zeiger;{} IF x + xsize = 80{} THEN in einem streich{} ELSE putze vorsichtig{} FI;{} cursor (x, y).{} + in einem streich:{} FOR zeiger FROM y UPTO y + ysize - 1 REP{} cursor (x, zeiger); out (cleol){} PER.{} putze vorsichtig:{} FOR zeiger FROM y UPTO y + ysize - 1 REP{} cursor (x, zeiger); xsize TIMESOUT blank{} PER.{}END PROC page;{}PROC page (AREA CONST a):{} page (a.x, a.y, a.xsize, a.ysize){}END PROC page;{}PROC page up (INT CONST x, y, xsize, ysize):{} INT VAR zeiger;{} IF x + xsize = 80{} THEN in einem streich{} ELSE putze vorsichtig{} + FI.{} in einem streich:{} FOR zeiger FROM y + ysize - 1 DOWNTO y REP{} cursor (x, zeiger); out (cleol){} PER.{} putze vorsichtig:{} FOR zeiger FROM y + ysize - 1 DOWNTO y REP{} cursor (x, zeiger); xsize TIMESOUT blank{} PER.{}END PROC page up;{}PROC page up (AREA CONST a):{} page up (a.x, a.y, a.xsize, a.ysize){}END PROC page up;{}PROC out frame (INT CONST x, y, xsize, ysize):{} INT VAR zeiger;{} IF x < 1 COR y < 1 COR xsize < 8 COR ysize < 3 COR{} x + xsize > 80 COR y + ysize > 25{} + THEN LEAVE out frame{} FI;{} male oben;{} male seiten;{} male unten.{} male oben:{} cursor (x, y);{} out (ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke oben rechts).{} male seiten:{} FOR zeiger FROM 1 UPTO ysize - 2 REP{} cursor (x, y + zeiger); out (senkrecht);{} cursor (x + xsize - 1, y + zeiger); out (senkrecht){} PER.{} male unten:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} + out (ecke unten rechts){}END PROC out frame;{}PROC out frame (AREA CONST a):{} IF a.x - 1 < 1 OR a.y - 1 < 1{} OR a.xsize + 2 > 79 OR a.ysize + 2 > 24{} OR a.x + a.xsize + 1 > 80{} OR a.y + a.ysize + 1 > 25{} THEN LEAVE out frame{} FI;{} out frame (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2){}END PROC out frame;{}PROC out menuframe (INT CONST x, y, xsize, ysize):{} INT VAR i;{} untersuche angaben;{} schreibe rahmen.{} untersuche angaben:{} IF x < 0 COR y < 0 COR x + xsize > 81 COR y + ysize > 26{} + THEN LEAVE out menuframe{} FI.{} schreibe rahmen:{} IF x = 0 COR y = 0 COR xsize = 81 COR ysize = 26{} THEN zeichne reduzierten rahmen{} ELSE zeichne vollen rahmen{} FI.{} zeichne reduzierten rahmen:{} zeichne oberlinie;{} zeichne unterlinie.{} zeichne oberlinie:{} cursor (1, 2);{} 79 TIMESOUT waagerecht.{} zeichne unterlinie:{} cursor (1, 23);{} 79 TIMESOUT waagerecht.{} zeichne vollen rahmen:{} schreibe kopf; schreibe rumpf; schreibe fuss;{} + schreibe kopfleiste; schreibe fussleiste.{} schreibe kopf:{} cursor (x, y);{} out (ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke oben rechts).{} schreibe rumpf:{} FOR i FROM y + 1 UPTO y + ysize - 2 REP{} cursor (x, i); out (senkrecht);{} cursor (x + xsize - 1, i); out (senkrecht){} PER.{} schreibe fuss:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} + schreibe kopfleiste:{} cursor (x, y + 2 ); schreibe balkenlinie.{} schreibe fussleiste:{} cursor (x, y + ysize - 3); schreibe balkenlinie.{} schreibe balkenlinie:{} out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts).{}END PROC out menuframe;{}PROC out menuframe (AREA CONST a):{} out menuframe (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2){}END PROC out menuframe;{}PROC erase frame (INT CONST x, y, xsize, ysize):{} INT VAR zeiger;{} loesche oben; loesche seiten; loesche unten.{} + loesche oben:{} cursor (x, y); xsize TIMESOUT blank.{} loesche seiten:{} FOR zeiger FROM 1 UPTO ysize - 2 REP{} cursor (x, y + zeiger); out (blank);{} cursor (x + xsize - 1, y + zeiger); out (blank){} PER.{} loesche unten:{} cursor (x, y + ysize - 1); xsize TIMESOUT blank.{}END PROC erase frame;{}OP := (AREA VAR ziel, AREA CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC fill (AREA VAR ziel, INT CONST a, b, c, d):{} IF a < 1 COR b < 1 COR a > 79 COR b > 24 COR c < 8 COR d < 3{} + COR c > 79 COR d > 24 COR a + c > 80 COR b + d > 25{} THEN errorstop (fehlermeldung){} FI;{} ziel.x := a; ziel.y := b; ziel.xsize := c; ziel.ysize := d{}END PROC fill;{}INT PROC areax (AREA CONST a): a.x END PROC areax;{}INT PROC areay (AREA CONST a): a.y END PROC areay;{}INT PROC areaxsize (AREA CONST a): a.xsize END PROC areaxsize;{}INT PROC areaysize (AREA CONST a): a.ysize END PROC areaysize;{}PROC out (TEXT CONST t, INT CONST breite):{} outtext (t, 1, breite){} +END PROC out;{}PROC erase (INT CONST breite):{} breite TIMESOUT blank{}END PROC erase;{}PROC cursor (AREA CONST a, INT CONST spa, zei):{} cursor (a.x + spa - 1, a.y + zei - 1){}END PROC cursor;{}PROC get cursor (AREA CONST a, INT VAR spalte, zeile):{} INT VAR x, y;{} get cursor (x, y);{} spalte := x - a.x + 1; zeile := y - a.y + 1{}END PROC get cursor;{}PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{} ueberpruefe cursorangaben; positioniere cursor;{} IF text ist zu lang{} THEN verkuerzte ausgabe{} + ELSE out (t){} FI.{} ueberpruefe cursorangaben:{} IF spa > xsize COR zei > a.ysize COR spa < 1 COR zei < 1{} THEN LEAVE out{} FI.{} positioniere cursor:{} cursor (a.x + spa - 1, a.y + zei - 1).{} text ist zu lang:{} length (t) > a.xsize - spa + 1.{} verkuerzte ausgabe:{} outsubtext (t, 1, a.xsize - spa + 1){}END PROC out;{}PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} + THEN verkuerzte ausgabe{} ELSE outtext (t, 1, laenge){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1{} THEN LEAVE out{} FI.{} positioniere cursor:{} cursor (a.x + spa - 1, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa + 1.{} verkuerzte ausgabe:{} outtext (t, 1, a.xsize - spa + 1){}END PROC out;{}PROC erase (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} + IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE erase (laenge){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1{} THEN LEAVE erase{} FI.{} positioniere cursor:{} cursor (a.x + spa - 1, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa + 1.{} verkuerzte ausgabe:{} erase (a.xsize - spa + 1){}END PROC erase;{}PROC out invers (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{} ueberpruefe cursorangaben; positioniere cursor;{} + IF text ist zu lang{} THEN verkuerzte ausgabe{} ELSE out (mark ein); out (t); out (blank); out (mark aus){} FI.{} ueberpruefe cursorangaben:{} IF spa > (xsize - 4) COR zei > ysize COR spa < 2 COR zei < 1{} THEN LEAVE out invers{} FI.{} positioniere cursor:{} cursor (a.x + spa - 2, a.y + zei - 1).{} text ist zu lang:{} length (t) > a.xsize - spa - 1.{} verkuerzte ausgabe:{} out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);{} out (blank); out (mark aus){}END PROC out invers;{} +PROC out invers (AREA CONST a, INT CONST spa, zei,{} TEXT CONST t, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE out (mark ein); outtext (t, 1, laenge); out (blank); out (mark aus){} FI.{} ueberpruefe cursorangaben:{} IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1{} THEN LEAVE out invers{} FI.{} positioniere cursor:{} cursor (a.x + spa - 2, a.y + zei - 1).{} + laenge ist zu gross:{} laenge > a.xsize - spa - 1.{} verkuerzte ausgabe:{} out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);{} out (blank); out (mark aus){}END PROC out invers;{}PROC erase invers (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE erase (laenge + 3){} FI.{} ueberpruefe cursorangaben:{} IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1{} + THEN LEAVE erase invers{} FI.{} positioniere cursor:{} cursor (a.x + spa - 2, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa - 1.{} verkuerzte ausgabe:{} erase ( a.xsize - spa + 2).{}END PROC erase invers;{}PROC out with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{} ueberpruefe cursorangaben; positioniere cursor;{} IF text ist zu lang{} THEN verkuerzte ausgabe{} ELSE out (senkrecht); out (blank); out (blank);{} out (t);{} out (blank); out (blank); out (senkrecht){} + FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{} THEN LEAVE out with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} text ist zu lang:{} length (t) > a.xsize - spa - 2.{} verkuerzte ausgabe:{} out (senkrecht); out (blank); out (blank);{} outsubtext (t, 1, a.xsize - spa - 2);{} out (blank); out (blank); out (senkrecht){}END PROC out with beam;{}PROC out with beam (AREA CONST a, INT CONST spa, zei,{} + TEXT CONST t, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE out (senkrecht); out (blank); out (blank);{} outtext (t, 1,laenge);{} out (blank); out (blank); out (senkrecht){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{} THEN LEAVE out with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} + laenge ist zu gross:{} laenge > a.xsize - spa - 2.{} verkuerzte ausgabe:{} out (senkrecht); out (blank); out (blank);{} outsubtext (t, 1, a.xsize - spa - 2);{} out (blank); out (blank); out (senkrecht){}END PROC out with beam;{}PROC erase with beam (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE erase (laenge + 6){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{} + THEN LEAVE erase with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa - 2.{} verkuerzte ausgabe:{} erase (a.xsize - spa + 4).{}END PROC erase with beam;{}PROC out invers with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{} ueberpruefe cursorangaben; positioniere cursor;{} IF text ist zu lang{} THEN verkuerzte ausgabe{} ELSE out (senkrecht); out (blank); out (mark ein);{} out (t);{} + out (blank); out (mark aus); out (senkrecht){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{} THEN LEAVE out invers with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} text ist zu lang:{} length (t) > a.xsize - spa - 2.{} verkuerzte ausgabe:{} out (senkrecht); out (blank); out (mark ein);{} outsubtext (t, 1, a.xsize - spa - 2);{} out (blank); out (mark aus); out (senkrecht){} +END PROC out invers with beam;{}PROC out invers with beam (AREA CONST a, INT CONST spa, zei,{} TEXT CONST t, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE out (senkrecht); out (blank); out (mark ein);{} outtext (t, 1, laenge);{} out (blank); out (mark aus); out (senkrecht){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{} + THEN LEAVE out invers with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa - 2.{} verkuerzte ausgabe:{} out (senkrecht); out (blank); out (mark ein);{} outsubtext (t, 1, a.xsize - spa - 2);{} out (blank); out (mark aus); out (senkrecht){}END PROC out invers with beam;{}END PACKET ls dialog 1;{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 2 b/app/gs.dialog/1.2/src/ls-DIALOG 2 new file mode 100644 index 0000000..1750162 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG 2 @@ -0,0 +1,77 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG 2 ** + ** ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) +PACKET ls dialog 2 DEFINES + some,{} one,{} infix namen,{} ohne praefix,{} not empty:{}LET maxentries = 200;{}LET zeichenstring = ""1""27""3""10""13""12"xo?",{} oben unten return rubout kreuz kringel = ""3""10""13""12"xo",{} q eins neun h = "q19h";{}LET zurueck = ""8"",{} piep = ""7"";{}LET hop = 1,{} esc = 2,{} oben = 3,{} unten = 4,{} return = 5,{} rubout = 6,{} + kreuz = 7,{} kringel = 8,{} frage = 9;{}LET punkt = ".",{} gleich = "=",{} blank = " ";{}INT VAR x,{} y,{} xsize,{} ysize,{} maxeintraege,{} anzahl,{} erste auswahlzeile,{} virtueller cursor,{} reeller cursor;{}TEXT VAR kennzeile 1,{} kennzeile 2,{} registrierkette :: "";{}BOOL VAR abbruch,{} auswahlende;{}BOUND ROW max entries TEXT VAR eintrag;{}ROW 2 TEXT CONST fehlermeldung :: ROW 2 TEXT : ({} + "Unzulässige Cursorwerte bei der Auswahl",{} "Fenster für Auswahl zu klein (x < 56 / y < 15)");{}ROW 24 TEXT CONST hinweis :: ROW 24 TEXT : ({} " Bitte warten... Ich sortiere und räume auf!",{} " Info: Fertig: Abbrechen: ",{} " Zum Weitermachen bitte irgendeine Taste tippen!",{} "Weitere Dateien!",{} "INFORMATIONEN: Auswahl mehrerer Dateien",{} "INFORMATIONEN: Auswahl einer Datei",{} " "15"Positionierungen: "14"",{} " hoch : zum vorausgehenden Namen",{} + " runter : zum folgenden Namen",{} " HOP hoch : auf den ersten Namen der Seite", (***********){} " HOP runter : auf den letzten Namen der Seite", (* bitte *){} " ESC 1 : auf den ersten Namen der Liste", (* diese *){} " ESC 9 : auf den letzten Namen der Liste", (* Länge *){} " "15"Auswahl treffen: "14"", (* nicht *){} " RETURN / x : diesen Namen ankreuzen ", (* über- *){} + " RUBOUT / o : Kreuz vor dem Namen loeschen", (* schrei-*){} " HOP RETURN / HOP x : alle folgende Namen ankreuzen", (* ten! *){} " HOP RUBOUT / HOP o : alle folgende Kreuze loeschen", (***********){} " "15"Auswahl verlassen: "14"",{} " ESC q : Auswahl verlassen",{} " ESC h : Auswahl abbrechen",{} " Auswahl m e h r e r e r Dateien durch Ankreuzen",{} " Auswahl e i n e r Datei durch Ankreuzen",{} " Bitte warten... Ich breche die Auswahl ab!"{} + );{}THESAURUS PROC auswahl (THESAURUS CONST t,{} BOOL CONST mehrere moeglich,{} TEXT CONST t1, t2):{} werte initialisieren;{} namen besorgen;{} bildschirm aufbauen;{} auswaehlen lassen;{} abgang vorbereiten.{} werte initialisieren:{} THESAURUS VAR ausgabe :: empty thesaurus;{} DATASPACE VAR ds := nilspace;{} eintrag := ds;{} kennzeile 1 := t1;{} kennzeile 2 := t2;{} abbruch := FALSE;{} + erste auswahlzeile := y + 7;{} anzahl := 0;{} maxeintraege := ysize - 11;{} virtueller cursor := 1;{} reeller cursor := 1.{} namen besorgen:{} fische die namen aus dem thesaurus;{} IF kein eintrag vorhanden{} THEN LEAVE auswahl WITH ausgabe{} FI.{} bildschirm aufbauen:{} schreibe kopfzeile;{} gib hinweis aus (kennzeile 1, kennzeile 2);{} gib erklaerungszeile aus (mehrere moeglich);{} baue bildschirm auf (1);{} footnote (x, y, xsize, ysize, hinweis [2]);{} + schreibe fusszeile;{} reellen cursor setzen .{} schreibe kopfzeile:{} cursor (x, y);{} out(ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out(ecke oben rechts).{} schreibe fusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} auswaehlen lassen:{} kreuze an (mehrere moeglich).{} abgang vorbereiten:{} IF abbruch{} THEN change footnote (x, y, xsize, ysize, hinweis [24]){} + ELSE change footnote (x, y, xsize, ysize, hinweis [ 1]){} FI;{} cursor (x + 1, y + ysize - 1);{} ausgabe erzeugen;{} forget (ds);{} ausgabe.{} fische die namen aus dem thesaurus:{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO highest entry (t) REP{} IF name (t, zeiger) <> ""{} THEN anzahl INCR 1;{} eintrag [anzahl] := name (t, zeiger){} FI{} PER.{} kein eintrag vorhanden:{} anzahl = 0.{} ausgabe erzeugen:{} TEXT VAR nummer;{} WHILE registrierkette <> "" REP{} + nummer := subtext (registrierkette, 1, 3);{} registrierkette := subtext (registrierkette, 5);{} insert (ausgabe, eintrag [ int (nummer)]){} PER.{}END PROC auswahl;{}PROC reellen cursor setzen:{} cursor (x + 1, erste auswahlzeile + reeller cursor - 1);{} out (marke (virtueller cursor, TRUE) + (8 * zurueck)){}END PROC reellen cursor setzen;{}PROC baue bildschirm auf (INT CONST anfang):{} gib kopfzeile aus;{} gib namenstabelle aus;{} gib fusszeile aus;{} loesche ggf restbereich.{} + gib kopfzeile aus:{} cursor (x, erste auswahlzeile - 1); out (senkrecht);{} IF reeller cursor = virtueller cursor{} THEN (xsize - 2) TIMESOUT punkt{} ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;{} out (invers (hinweis [4])){} FI;{} out (senkrecht);{} line.{} gib namenstabelle aus:{} INT VAR zeiger, zaehler :: -1;{} FOR zeiger FROM anfang UPTO grenze REP{} zaehler INCR 1;{} cursor (x, erste auswahlzeile + zaehler);{} out (senkrecht); out (marke (zeiger, FALSE));{} + outtext (subtext (eintrag [zeiger], 1, xsize - 10), 1, xsize - 10);{} out (senkrecht);{} PER.{} gib fusszeile aus:{} cursor (x, erste auswahlzeile + zaehler + 1);{} out (senkrecht);{} IF NOT ((virtueller cursor + maxeintraege - reeller cursor) < anzahl){} THEN (xsize - 2) TIMESOUT punkt{} ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;{} out (invers (hinweis [4])){} FI;{} out (senkrecht).{} loesche ggf restbereich:{} IF zaehler + 1 < maxeintraege{} + THEN loesche bildschirmrest{} FI.{} loesche bildschirmrest:{} FOR zeiger FROM restanfang UPTO restende REP{} cursor (x, zeiger); out (senkrecht);{} (xsize - 2) TIMESOUT blank;{} out (senkrecht){} PER.{} restanfang:{} erste auswahlzeile + zaehler + 2.{} restende:{} erste auswahlzeile + maxeintraege.{} grenze:{} min (anzahl, anfang + max eintraege - 1).{}END PROC baue bildschirm auf;{}TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor):{} + INT VAR platz := nr (zeiger);{} IF platz = 0{} THEN leer{} ELSE mit zahl{} FI.{} mit zahl:{} IF mit cursor{} THEN "==>" + (3 - length (text (platz))) * blank + text (platz) + "x "{} ELSE " " + (3 - length (text (platz))) * blank + text (platz) + "x "{} FI.{} leer:{} IF mit cursor{} THEN "==> o "{} ELSE " o "{} FI.{}END PROC marke;{}INT PROC nr (INT CONST zeiger):{} IF pos (registrierkette, textstring (zeiger)) = 0{} THEN 0{} ELSE (pos (registrierkette, textstring (zeiger)) DIV 4) + 1{} + FI{}END PROC nr;{}TEXT PROC textstring (INT CONST nr):{} text (nr, 3) + "!"{}END PROC textstring;{}PROC info (BOOL CONST mehrere):{} notiere hinweisueberschrift;{} notiere positionierhinweise;{} IF noch platz vorhanden{} THEN notiere auswahlmoeglichkeiten auf alter seite{} ELSE wechsle auf naechste seite;{} notiere hinweisueberschrift;{} notiere auswahlmoeglichtkeiten auf neuer seite{} FI;{} stelle alten bildschirmzustand wieder her.{} notiere hinweisueberschrift:{} + cursor (x + 1, y + 1);{} IF mehrere{} THEN out (center(xsize - 2, invers (hinweis [5]))){} ELSE out (center(xsize - 2, invers (hinweis [6]))){} FI;{} cursor (x + 1, y + 2); out ("", xsize - 2).{} notiere positionierhinweise:{} cursor (x + 1, y + 3); out (hinweis [ 7], xsize - 2);{} cursor (x + 1, y + 4); out (hinweis [ 8], xsize - 2);{} cursor (x + 1, y + 5); out (hinweis [ 9], xsize - 2);{} cursor (x + 1, y + 6); out (hinweis [10], xsize - 2);{} cursor (x + 1, y + 7); out (hinweis [11], xsize - 2);{} + cursor (x + 1, y + 8); out (hinweis [12], xsize - 2);{} cursor (x + 1, y + 9); out (hinweis [13], xsize - 2).{} notiere auswahlmoeglichkeiten auf alter seite:{} cursor (x + 1, y + 10); out ("", xsize - 2);{} cursor (x + 1, y + 11); out (hinweis [14], xsize - 2);{} cursor (x + 1, y + 12); out (hinweis [15], xsize - 2);{} IF mehrere{} THEN gib alle auswahlmoeglichkeiten auf der alten seite an{} ELSE gib eine auswahlmoeglichkeit auf der alten seite an{} FI;{} + notiere verlassmoeglichkeiten auf der alten seite;{} loesche die restlichen zeilen;{} change footnote (x, y, xsize, ysize, hinweis [3]);{} cursor in ruhestellung;{} clear buffer.{} gib alle auswahlmoeglichkeiten auf der alten seite an:{} cursor (x + 1, y + 13); out (hinweis [16], xsize - 2);{} cursor (x + 1, y + 14); out (hinweis [17], xsize - 2);{} cursor (x + 1, y + 15); out (hinweis [18], xsize - 2).{} gib eine auswahlmoeglichkeit auf der alten seite an:{} cursor (x + 1, y + 13); out ("", xsize - 2);{} + cursor (x + 1, y + 14); out ("", xsize - 2);{} cursor (x + 1, y + 15); out ("", xsize - 2).{} notiere verlassmoeglichkeiten auf der alten seite:{} cursor (x + 1, y + 16); out ("", xsize - 2);{} cursor (x + 1, y + 17); out (hinweis [19], xsize - 2);{} cursor (x + 1, y + 18); out (hinweis [20], xsize - 2);{} cursor (x + 1, y + 19); out (hinweis [21], xsize - 2).{} loesche die restlichen zeilen:{} IF ysize = 24{} THEN cursor (x + 1, y + 20); out ("", xsize - 2){} FI.{} + wechsle auf naechste seite:{} loesche seitenrest;{} change footnote (x, y, xsize, ysize, hinweis [3]);{} cursor in ruhestellung;{} clear buffer;{} pause.{} loesche seitenrest:{} INT VAR zaehler;{} FOR zaehler FROM 10 UPTO ysize - 4 REP{} cursor (x + 1, y + zaehler); out ("", xsize - 2){} PER.{} notiere auswahlmoeglichtkeiten auf neuer seite:{} cursor (x + 1, y + 3); out (hinweis [14], xsize - 2);{} cursor (x + 1, y + 4); out (hinweis [15], xsize - 2);{} IF mehrere{} + THEN gib alle auswahlmoeglichkeiten auf der neuen seite an{} ELSE gib eine auswahlmoeglichkeit auf der neuen seite an{} FI;{} notiere verlassmoeglichkeiten auf der neuen seite.{} gib alle auswahlmoeglichkeiten auf der neuen seite an:{} cursor (x + 1, y + 5); out (hinweis [16], xsize - 2);{} cursor (x + 1, y + 6); out (hinweis [17], xsize - 2);{} cursor (x + 1, y + 7); out (hinweis [18], xsize - 2).{} gib eine auswahlmoeglichkeit auf der neuen seite an:{} cursor (x + 1, y + 5); out ("", xsize - 2);{} + cursor (x + 1, y + 6); out ("", xsize - 2);{} cursor (x + 1, y + 7); out ("", xsize - 2).{} notiere verlassmoeglichkeiten auf der neuen seite:{} cursor (x + 1, y + 8); out ("", xsize - 2);{} cursor (x + 1, y + 9); out (hinweis [19], xsize - 2);{} cursor (x + 1, y + 10); out (hinweis [20], xsize - 2);{} cursor (x + 1, y + 11); out (hinweis [21], xsize - 2);{} cursor in ruhestellung.{} cursor in ruhestellung:{} cursor (x + 1, y + ysize - 2).{} stelle alten bildschirmzustand wieder her:{} + clear buffer;{} pause;{} gib hinweis aus (kennzeile 1, kennzeile 2);{} gib erklaerungszeile aus (mehrere);{} virtueller cursor := 1;{} reeller cursor := 1;{} baue bildschirm auf (1);{} change footnote (x, y, xsize, ysize, hinweis [2]);{} reellen cursor setzen.{} noch platz vorhanden:{} (ysize - 4) > 18.{}END PROC info;{}PROC kreuze an (BOOL CONST mehrere):{} auswahlende := FALSE;{} REP{} zeichen lesen; zeichen interpretieren{} UNTIL auswahlende PER.{} zeichen lesen:{} + TEXT VAR zeichen;{} getchar (zeichen).{} zeichen interpretieren:{} SELECT pos (zeichenstring, zeichen) OF{} CASE hop : hop kommando verarbeiten (mehrere){} CASE esc : esc kommando verarbeiten{} CASE oben : nach oben{} CASE unten : nach unten{} CASE kreuz : ankreuzen; evtl aufhoeren{} CASE return : ankreuzen weiter; evtl aufhoeren{} CASE rubout : auskreuzen weiter{} CASE kringel : auskreuzen{} CASE frage : info (mehrere){} + OTHERWISE out (piep){} END SELECT.{} evtl aufhoeren:{} IF NOT mehrere{} THEN LEAVE kreuze an{} FI.{}END PROC kreuze an;{}PROC hop kommando verarbeiten (BOOL CONST mehrere):{} zweites zeichen lesen;{} zeichen interpretieren.{} zweites zeichen lesen:{} TEXT VAR zweites zeichen;{} getchar(zweites zeichen).{} zeichen interpretieren:{} SELECT pos (oben unten return rubout kreuz kringel, zweites zeichen) OF{} CASE 1 : hop nach oben{} CASE 2 : hop nach unten{} + CASE 3, 5 : IF mehrere THEN alle darunter ankreuzen FI{} CASE 4, 6 : IF mehrere THEN alle darunter loeschen FI{} OTHERWISE out (piep){} END SELECT.{} alle darunter ankreuzen:{} INT VAR i;{} FOR i FROM virtueller cursor UPTO anzahl REP{} IF nr (i) = 0{} THEN ankreuzen{} FI{} PER;{} bild aktualisieren ;{} reellen cursor setzen .{} ankreuzen:{} registrierkette CAT textstring (i).{} alle darunter loeschen:{} INT VAR j, position;{} FOR j FROM virtueller cursor UPTO anzahl REP{} + position := nr (j);{} IF position > 0{} THEN rausschmeissen;{} FI{} PER;{} bild aktualisieren;{} reellen cursor setzen.{} rausschmeissen:{} registrierkette := subtext (registrierkette, 1, (4 * position) - 4) +{} subtext (registrierkette, (4 * position) + 1).{} hop nach oben:{} IF ganz oben{} THEN out (piep){} ELIF oben auf der seite{} THEN raufblaettern{} ELSE top of page{} FI.{} ganz oben:{} virtueller cursor = 1.{} + oben auf der seite:{} reeller cursor = 1.{} raufblaettern:{} virtueller cursor DECR max eintraege;{} virtueller cursor := max (virtueller cursor, 1);{} baue bildschirm auf (virtueller cursor);{} reellen cursor setzen.{} top of page:{} loesche marke;{} virtueller cursor DECR (reeller cursor - 1);{} reeller cursor := 1;{} reellen cursor setzen.{} hop nach unten:{} IF ganz unten{} THEN out (piep){} ELIF unten auf der seite{} THEN runterblaettern{} + ELSE bottom of page{} FI.{} ganz unten:{} virtueller cursor = anzahl.{} unten auf der seite:{} reeller cursor > max eintraege - 1.{} runterblaettern:{} INT VAR alter virtueller cursor :: virtueller cursor;{} virtueller cursor INCR max eintraege;{} virtueller cursor := min (virtueller cursor, anzahl);{} reeller cursor := virtueller cursor - alter virtueller cursor;{} baue bildschirm auf (alter virtueller cursor + 1);{} reellen cursor setzen.{} bottom of page:{} + loesche marke;{} alter virtueller cursor := virtueller cursor;{} virtueller cursor INCR (max eintraege - reeller cursor);{} virtueller cursor := min (anzahl, virtueller cursor);{} reeller cursor INCR (virtueller cursor - alter virtueller cursor);{} reellen cursor setzen.{}END PROC hop kommando verarbeiten;{}PROC esc kommando verarbeiten:{} TEXT VAR zweites zeichen;{} getchar (zweites zeichen);{} SELECT pos (q eins neun h, zweites zeichen) OF{} CASE 1 : auswahlende := TRUE{} + CASE 2 : zeige anfang{} CASE 3 : zeige ende{} CASE 4 : abbruch := TRUE;{} auswahlende := TRUE;{} registrierkette := ""{} OTHERWISE out (piep){} END SELECT.{} zeige anfang:{} IF virtueller cursor = 1{} THEN out (piep){} ELIF virtueller cursor = reeller cursor{} THEN loesche marke;{} virtueller cursor := 1;{} reeller cursor := 1;{} reellen cursor setzen{} ELSE virtueller cursor := 1;{} + reeller cursor := 1;{} baue bildschirm auf (1);{} reellen cursor setzen{} FI.{} zeige ende:{} IF virtueller cursor = anzahl{} THEN out (piep){} ELIF ende auf bildschirm{} THEN loesche marke;{} reeller cursor INCR (anzahl - virtueller cursor);{} virtueller cursor := anzahl;{} reellen cursor setzen{} ELSE virtueller cursor := anzahl;{} reeller cursor := max eintraege;{} + baue bildschirm auf (anzahl - (max eintraege - 1));{} reellen cursor setzen{} FI.{} ende auf bildschirm:{} (reeller cursor + anzahl - virtueller cursor) < max eintraege + 1.{}END PROC esc kommando verarbeiten;{}PROC ankreuzen:{} INT VAR platz :: nr (virtueller cursor);{} IF platz <> 0{} THEN out (piep);{} LEAVE ankreuzen{} FI;{} registrierkette CAT textstring (virtueller cursor);{} reellen cursor setzen{}END PROC ankreuzen;{}PROC ankreuzen weiter:{} + INT VAR platz :: nr (virtueller cursor);{} IF platz <> 0{} THEN out (piep);{} LEAVE ankreuzen weiter{} FI;{} registrierkette CAT textstring (virtueller cursor);{} IF virtueller cursor < anzahl{} THEN nach unten{} FI;{} IF virtueller cursor = anzahl{} THEN reellen cursor setzen{} FI{}END PROC ankreuzen weiter;{}PROC auskreuzen weiter:{} INT VAR position :: nr (virtueller cursor);{} IF position = 0{} THEN out (piep);{} LEAVE auskreuzen weiter{} FI;{} rausschmeissen;{} + IF virtueller cursor < anzahl{} THEN nach unten{} ELSE loesche marke{} FI;{} bild aktualisieren;{} reellen cursor setzen.{} rausschmeissen:{} registrierkette := subtext (registrierkette, 1, 4 * position - 4) +{} subtext (registrierkette, 4 * position + 1).{}END PROC auskreuzen weiter;{}PROC auskreuzen:{} INT VAR position :: nr (virtueller cursor);{} IF position = 0{} THEN out (piep);{} LEAVE auskreuzen{} FI;{} rausschmeissen;{} loesche marke;{} + bild aktualisieren;{} reellen cursor setzen.{} rausschmeissen:{} registrierkette := subtext (registrierkette, 1, 4 * position - 4) +{} subtext (registrierkette, 4 * position + 1).{}END PROC auskreuzen;{}PROC bild aktualisieren:{} INT VAR ob, un, i, zaehler :: -1;{} ob := virtueller cursor - reeller cursor + 1;{} un := min (ob + max eintraege - 1, anzahl);{} FOR i FROM ob UPTO un REP{} zaehler INCR 1;{} cursor (x + 1, erste auswahlzeile + zaehler);{} out (marke (i,FALSE)) PER{} +END PROC bild aktualisieren;{}PROC nach oben:{} IF noch nicht oben (*virtuell*){} THEN gehe nach oben{} ELSE out (piep){} FI.{} noch nicht oben:{} virtueller cursor > 1.{} gehe nach oben:{} IF reeller cursor = 1 THEN scroll down ELSE cursor up FI.{} scroll down:{} virtueller cursor DECR 1;{} baue bildschirm auf (virtueller cursor);{} reellen cursor setzen.{} cursor up:{} loesche marke;{} virtueller cursor DECR 1;{} reeller cursor DECR 1;{} reellen cursor setzen{} +END PROC nach oben;{}PROC nach unten:{} IF noch nicht unten (*virtuell*){} THEN gehe nach unten{} ELSE out (piep){} FI.{} noch nicht unten:{} virtueller cursor < anzahl.{} gehe nach unten:{} IF reeller cursor > max eintraege - 1 THEN scroll up ELSE cursor down FI.{} scroll up:{} virtueller cursor INCR 1;{} baue bildschirm auf (virtueller cursor - (max eintraege - 1));{} reellen cursor setzen.{} cursor down:{} loesche marke;{} virtueller cursor INCR 1;{} reeller cursor INCR 1;{} + reellen cursor setzen{}END PROC nach unten;{}PROC loesche marke:{} out (marke (virtueller cursor, FALSE)){}END PROC loesche marke;{}PROC footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):{} cursor (x, y + ysize - 3);{} out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts);{} change footnote (x, y, xsize, ysize, text){}END PROC footnote;{}PROC change footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):{} cursor (x, y + ysize - 2);{} out (senkrecht); outtext (text, 1, xsize - 2); out (senkrecht){} +END PROC change footnote;{}PROC gib hinweis aus (TEXT CONST t1, t2):{} cursor (x, y + 1); out (senkrecht);{} out (center (xsize - 2, invers (t1)));{} out (senkrecht);{} cursor (x, y + 2); out (senkrecht);{} out ("", xsize - 2);{} out (senkrecht);{} cursor (x, y + 3); out (senkrecht);{} out (center (xsize - 2, t2));{} out (senkrecht){}END PROC gib hinweis aus;{}PROC gib erklaerungszeile aus (BOOL CONST mehrere):{} + cursor (x, y + 4); out (senkrecht);{} out ((xsize - 2) * gleich);{} out (senkrecht);{} cursor (x, y + 5); out (senkrecht);{} IF mehrere{} THEN out (erklaerungszeile mehrere){} ELSE out (erklaerungszeile eine){} FI;{} out (senkrecht).{} erklaerungszeile mehrere:{} invers (text 1 + (rest1 * blank)).{} erklaerungszeile eine:{} invers (text 2 + (rest2 * blank)).{} + text1:{} hinweis [22].{} text2:{} hinweis [23].{} rest1: (***************************){} xsize - length (text1) - 5. (* durch 'invers' wird ein *){} (* Blank angehängt und zu- *){} rest2: (* sätzlich noch durch *){} xsize - length (text2) - 5. (* 'relativcenter' - außer-*){}END PROC gib erklaerungszeile aus; (* dem nimmt die Markierung*){} (* selbst eine Position ein*){} + (***************************){}THESAURUS PROC infix namen (THESAURUS CONST t, TEXT CONST infix):{} THESAURUS VAR tt :: empty thesaurus;{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} TEXT VAR eintrag :: name (t,i);{} IF eintrag enthaelt infix{} THEN insert (tt, eintrag){} FI{} PER;{} tt.{} eintrag enthaelt infix:{} pos (eintrag, infix) <> 0{}END PROC infix namen;{}THESAURUS PROC infix namen (THESAURUS CONST t, INT CONST dateityp):{} + THESAURUS VAR tt :: empty thesaurus;{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} TEXT VAR eintrag :: name (t,i);{} IF eintrag enthaelt infix{} THEN insert (tt, eintrag){} FI{} PER;{} tt.{} eintrag enthaelt infix:{} type (old (eintrag)) = dateityp.{}END PROC infix namen;{}THESAURUS PROC infix namen (THESAURUS CONST t,{} TEXT CONST infix 1, INT CONST dateityp):{} THESAURUS VAR tt :: empty thesaurus;{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} + TEXT VAR eintrag :: name (t,i);{} IF eintrag enthaelt infix{} THEN insert (tt, eintrag){} FI{} PER;{} tt.{} eintrag enthaelt infix:{} (pos (eintrag, infix 1) <> 0) AND (type (old (eintrag)) = dateityp).{}END PROC infix namen;{}THESAURUS PROC infix namen (THESAURUS CONST t,{} TEXT CONST infix 1, infix 2):{} THESAURUS VAR tt :: empty thesaurus;{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} TEXT VAR eintrag :: name (t,i);{} IF eintrag enthaelt infix{} + THEN insert (tt, eintrag){} FI{} PER;{} tt.{} eintrag enthaelt infix:{} (pos (eintrag, infix 1) <> 0) OR (pos (eintrag, infix 2) <> 0){}END PROC infix namen;{}THESAURUS PROC infix namen (TEXT CONST infix):{} infix namen (ALL myself, infix){}END PROC infix namen;{}THESAURUS PROC infix namen (TEXT CONST infix 1, infix 2):{} infix namen (ALL myself, infix 1, infix 2){}END PROC infix namen;{}THESAURUS PROC ohne praefix (THESAURUS CONST thesaurus, TEXT CONST praefix):{} THESAURUS VAR t :: empty thesaurus;{} + INT VAR zaehler;{} FOR zaehler FROM 1 UPTO highest entry (thesaurus) REP{} IF name (thesaurus, zaehler) <> ""{} AND pos (name (thesaurus, zaehler), praefix) = 1{} THEN insert (t, subtext (name (thesaurus, zaehler),{} length (praefix) + 1)){} FI;{} PER;{} t{}END PROC ohne praefix;{}BOOL PROC not empty (THESAURUS CONST t):{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} IF name (t, i) <> ""{} THEN LEAVE not empty WITH TRUE{} + FI{} PER;{} FALSE{}END PROC not empty;{}PROC untersuche bildschirmmasszahlen (TEXT CONST t1, t2):{} IF unzulaessige cursorwerte{} THEN errorstop (fehlermeldung [1]){} ELIF fenster ist zu klein{} THEN errorstop (fehlermeldung [2]){} FI.{} unzulaessige cursorwerte:{} (x + xsize) > 80 COR (y + ysize) > 25 COR x < 1 COR y < 1{} COR xsize > 79 COR ysize > 24.{} fenster ist zu klein:{} (xsize) < 56 COR (ysize) < 15{} COR length (t1) > (xsize - 5) COR length (t2) > (xsize - 5).{} +END PROC untersuche bildschirmmasszahlen;{}TEXT PROC ggf gekuerzter text (TEXT CONST text):{} IF length (text) > (xsize - 5){} THEN subtext (text, 1, xsize - 7) + ".."{} ELSE text{} FI{}END PROC ggf gekuerzter text;{}THESAURUS PROC some (INT CONST spa, zei, breite, hoehe,{} THESAURUS CONST t,{} TEXT CONST t1, t2):{} TEXT VAR text 1, text 2;{} x := spa;{} y := zei;{} xsize := breite;{} ysize := hoehe;{} text 1 := ggf gekuerzter text (t1);{} + text 2 := ggf gekuerzter text (t2);{} untersuche bildschirmmasszahlen (text 1, text 2);{} auswahl (t, TRUE, text 1, text 2){}END PROC some;{}THESAURUS PROC some (INT CONST spa, zei,{} THESAURUS CONST t,{} TEXT CONST t1, t2):{} some (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2){}END PROC some;{}THESAURUS PROC some (THESAURUS CONST t,{} TEXT CONST t1, t2):{} some (1, 1, 79, 24, t, t1, t2){}END PROC some;{}TEXT PROC one (INT CONST spa, zei, breite, hoehe,{} + THESAURUS CONST t,{} TEXT CONST t1, t2):{} TEXT VAR text 1, text 2;{} x := spa;{} y := zei;{} xsize := breite;{} ysize := hoehe;{} text 1 := ggf gekuerzter text (t1);{} text 2 := ggf gekuerzter text (t2);{} untersuche bildschirmmasszahlen (text 1, text 2);{} name (auswahl (t, FALSE, text 1, text 2), 1){}END PROC one;{}TEXT PROC one (INT CONST spa, zei,{} THESAURUS CONST t,{} TEXT CONST t1, t2):{} one (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2){} +END PROC one;{}TEXT PROC one (THESAURUS CONST t, TEXT CONST t1, t2):{} one (1, 1, 79, 24, t, t1, t2){}END PROC one;{}END PACKET ls dialog 2;{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 3 b/app/gs.dialog/1.2/src/ls-DIALOG 3 new file mode 100644 index 0000000..dce6507 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG 3 @@ -0,0 +1,48 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG 3 ** + ** ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls dialog 3 DEFINES{} WINDOW, :=, window,{} show, page, erase,{} line, remaining lines,{} cursor, get cursor,{} out frame, out menuframe,{} out, put, putline, editget,{} get, getline, yes, no,{} edit, center, stop,{} area, areax, areay,{} areaxsize, areaysize:{}LET piep = ""7"",{} cr = ""13"";{}LET janeinkette = "jJyYnN",{} blank = " ",{} niltext = "";{}TYPE WINDOW = STRUCT (AREA fenster,{} + INT cspalte, czeile, belegbare zeilen,{} BOOL fensterende erreicht);{}ROW 3 TEXT CONST aussage :: ROW 3 TEXT : ({} " 'Window' ungültig!",{} " (j/n) ?",{} " Zum Weitermachen bitte irgendeine Taste tippen!"{} );{}TEXT VAR number word, exit char;{}OP := (WINDOW VAR links, WINDOW CONST rechts):{} CONCR (links) := CONCR (rechts){}END OP :=;{}WINDOW PROC window (INT CONST x, y, xsize, ysize):{} WINDOW VAR w;{} fill (w.fenster, x, y, xsize, ysize);{} IF fenster ungueltig (w){} + THEN errorstop (aussage [1]){} FI;{} initialize (w);{} w{}END PROC window;{}PROC initialize (WINDOW VAR w):{} w.czeile := 1;{} w.cspalte := 1;{} w.fensterende erreicht := FALSE;{} w.belegbare zeilen := areaysize (w.fenster){}END PROC initialize;{}BOOL PROC fenster ungueltig (WINDOW CONST w):{} IF areax (w.fenster) < 1 COR areax (w.fenster) > 79{} COR areay (w.fenster) < 1 COR areay (w.fenster) > 24{} COR areaxsize (w.fenster) < 6 COR areaysize (w.fenster) < 3{} + COR areax (w.fenster) + areaxsize (w.fenster) > 80{} COR areay (w.fenster) + areaysize (w.fenster) > 25{} THEN TRUE{} ELSE FALSE{} FI.{}END PROC fenster ungueltig;{}PROC show (WINDOW VAR w):{} zeige rahmen;{} fenster putzen.{} zeige rahmen:{} out frame (w.fenster).{} fenster putzen:{} page (w).{}END PROC show;{}PROC page (WINDOW VAR w):{} initialize (w);{} page (w, FALSE){}END PROC page;{}PROC page (WINDOW CONST w, BOOL CONST mit rahmen ):{} IF areax (w) = 1 AND areay (w) = 1 AND{} + areaxsize (w) = 79 AND areaysize (w) = 24{} THEN page;{} ELSE loesche bereich{} FI.{} loesche bereich:{} IF mit rahmen{} THEN page (areax (w) - 1, areay (w) - 1,{} areaxsize (w) + 2, areaysize (w) + 2){} ELSE page (area (w)){} FI{}END PROC page;{}PROC erase (WINDOW VAR w):{} page (w, TRUE){}END PROC erase;{}PROC line (WINDOW VAR w):{} w.cspalte := 1;{} IF w.czeile < w.belegbare zeilen{} THEN w.czeile INCR 1;{} ELSE w.czeile := 1;{} + w.fensterende erreicht := TRUE{} FI;{} cursor (w, w.cspalte, w.czeile){}END PROC line;{}PROC line (WINDOW VAR w, INT CONST anzahl):{} INT VAR i; FOR i FROM 1 UPTO anzahl REP line (w) PER{}END PROC line;{}INT PROC remaining lines (WINDOW CONST w):{} INT VAR spalte, zeile;{} get cursor (w, spalte, zeile);{} IF spalte = 0 OR zeile = 0{} THEN 0{} ELSE w.belegbare zeilen - w.czeile{} FI{}END PROC remaining lines;{}PROC cursor (WINDOW VAR w, INT CONST spalte, zeile):{} IF spalte < 1 OR zeile < 1 OR spalte > areaxsize (w) OR zeile > areaysize (w){} + THEN page (w);{} ELSE w.cspalte := spalte; w.czeile := zeile;{} FI;{} cursor (w.fenster, w.cspalte, w.czeile){}END PROC cursor;{}PROC get cursor (WINDOW CONST w, INT VAR spalte, zeile):{} IF (w.cspalte < 1) OR (w.cspalte > areaxsize (w.fenster)){} OR{} (w.czeile < 1) OR (w.czeile > areaysize (w.fenster)){} THEN spalte := 0; zeile := 0{} ELSE spalte := w.cspalte; zeile := w.czeile{} FI{}END PROC get cursor;{}PROC out (WINDOW VAR w, TEXT CONST text):{} + INT VAR restlaenge;{} IF (w.cspalte >= 1) AND (w.cspalte <= areaxsize (w.fenster)){} AND{} (w.czeile >= 1) AND (w.czeile <= w.belegbare zeilen){} THEN putze ggf fenster;{} cursor (w.fenster, w.cspalte, w.czeile);{} outtext (text, 1, textende);{} setze fenstercursor neu;{} setze ausgabe ggf in naechster zeile fort{} FI.{} putze ggf fenster:{} IF w.fensterende erreicht{} THEN page (w);{} w.fensterende erreicht := FALSE{} + FI.{} textende:{} restlaenge := areaxsize (w.fenster) - w.cspalte + 1;{} min (length (text), restlaenge).{} setze fenstercursor neu:{} IF length (text) >= restlaenge{} THEN w.cspalte := 1;{} w.czeile INCR 1;{} schlage ggf neue seite auf{} ELSE w.cspalte INCR length (text){} FI.{} schlage ggf neue seite auf:{} IF w.czeile > w.belegbare zeilen{} THEN page (w);{} w.czeile := 1{} FI.{} setze ausgabe ggf in naechster zeile fort:{} + IF length (text) > restlaenge{} THEN out (w, subtext (text, restlaenge + 1)){} FI.{}END PROC out;{}PROC out frame (WINDOW VAR w):{} out frame (area (w)){}END PROC out frame;{}PROC out menuframe (WINDOW VAR w):{} out menu frame (area (w)){}END PROC out menuframe;{}PROC put (WINDOW VAR w, TEXT CONST word):{} out (w, word); out (w, blank){}END PROC put;{}PROC put (WINDOW VAR w, INT CONST number):{} put (w, text (number)){}END PROC put;{}PROC put (WINDOW VAR w, REAL VAR number):{} put (w, text (number)){} +END PROC put;{}PROC putline (WINDOW VAR w, TEXT CONST textline):{} out (w, textline); line (w){}END PROC putline;{}PROC editget (WINDOW VAR w, TEXT VAR ausgabe,{} INT CONST max laenge, scroll,{} TEXT CONST sep, res, TEXT VAR exit char):{} INT VAR spalte, zeile;{} ggf zur naechsten zeile;{} get cursor (spalte, zeile); cursor on; cursor (spalte, zeile);{} editget (ausgabe, max laenge, min (scroll, restlaenge),{} sep, res, exitchar);{} get cursor (spalte, zeile); cursor off; cursor (spalte, zeile).{} + ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{}END PROC editget;{}PROC editget (WINDOW VAR w, TEXT VAR ausgabe):{} TEXT VAR dummy;{} editget (w, ausgabe, 79, 79, "", "", dummy){}END PROC editget;{}PROC get (WINDOW VAR w, TEXT VAR word):{} INT VAR spa, zei;{} ggf zur naechsten zeile;{} get cursor (spa, zei); cursor on; cursor (spa, zei);{} REP{} word := "";{} editget (word, maxtextlength, restlaenge, " ", "", exit char);{} + out (w, subtext (word, 1, restlaenge));{} IF compress (word) <> ""{} THEN echoe exit char (w){} FI{} UNTIL word <> niltext AND word <> blank PER;{} get cursor (spa, zei); cursor off; cursor (spa, zei);{} delete leading blanks.{} ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{} delete leading blanks:{} WHILE (word SUB 1) = blank REP word := subtext (word, 2) PER.{}END PROC get;{}PROC get (WINDOW VAR w, TEXT VAR word, TEXT CONST separator):{} + INT VAR spa, zei;{} ggf zur naechsten zeile;{} get cursor (spa, zei); cursor on; cursor (spa, zei);{} REP{} word := "";{} editget (word, maxtextlength, restlaenge, separator, "", exit char);{} out (w, subtext (word, 1, restlaenge));{} echoe exit char (w);{} UNTIL word <> niltext AND word <> blank PER;{} get cursor (spa, zei); cursor off; cursor (spa, zei).{} ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{} +END PROC get;{}PROC get (WINDOW VAR w, TEXT VAR word, INT CONST length):{} INT VAR spa, zei;{} ggf zur naechsten zeile;{} get cursor (spa, zei); cursor on; cursor (spa, zei);{} REP{} word := "";{} editget (word, maxtextlength, laenge, "", "", exit char);{} out (w, subtext (word, 1, laenge));{} echoe exit char (w){} UNTIL word <> niltext AND word <> blank PER;{} get cursor (spa, zei); cursor off; cursor (spa, zei).{} ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} + restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{} laenge:{} min (length, restlaenge).{}END PROC get;{}PROC get (WINDOW VAR w, INT VAR number):{} get (w, number word);{} number := int (number word){}END PROC get;{}PROC get (WINDOW VAR w, REAL VAR number):{} get (w, number word);{} number := real (number word){}END PROC get;{}PROC getline (WINDOW VAR w, TEXT VAR textline):{} INT VAR spa, zei;{} ggf zur naechsten zeile;{} get cursor (spa, zei); cursor on; cursor (spa, zei);{} REP{} + textline := "";{} editget (textline, maxtextlength, restlaenge, "", "", exit char);{} out (w, subtext (word, 1, restlaenge));{} echoe exit char (w);{} UNTIL textline <> niltext AND textline <> blank PER;{} get cursor (spa, zei); cursor off; cursor (spa, zei).{} ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{}END PROC getline;{}PROC echoe exit char (WINDOW VAR fenster):{} IF exit char = cr{} THEN line (fenster){} + ELSE out (fenster, exit char){} FI{}END PROC echoe exit char;{}TEXT PROC center (WINDOW CONST w, TEXT CONST text):{} IF length (text) >= areaxsize (w.fenster){} THEN subtext (text, 1, areaxsize (w.fenster)){} ELSE center (areaxsize (w.fenster), text){} FI{}END PROC center;{}BOOL PROC yes (WINDOW VAR w, TEXT CONST frage):{} TEXT VAR zeichen, interne frage :: frage;{} interne frage CAT aussage [2];{} wechsel ggf auf neue seite;{} out (w, interne frage);{} hole eingabezeichen;{} + werte zeichen aus.{} wechsel ggf auf neue seite:{} IF remaining lines (w) < 1{} THEN page (w){} FI.{} hole eingabezeichen:{} cursor on; clear buffer;{} REP{} inchar (zeichen);{} piepse ggf{} UNTIL pos (janeinkette, zeichen) > 0 PER;{} out (w, blank + zeichen);{} cursor off; line (w).{} piepse ggf:{} IF pos (janeinkette, zeichen) = 0 THEN out (piep) FI.{} werte zeichen aus:{} IF pos (janeinkette, zeichen) < 5{} THEN TRUE{} ELSE FALSE{} FI.{} +END PROC yes;{}PROC edit (WINDOW VAR w, FILE VAR f):{} out frame (w.fenster);{} loesche rechte spalten (w);{} cursor on;{} edit (f, areax (w.fenster), areay (w.fenster),{} areaxsize (w.fenster) - 1, areaysize (w.fenster));{} cursor off{}END PROC edit;{}PROC edit (WINDOW VAR w, TEXT CONST dateiname):{} FILE VAR f :: sequential file (modify, dateiname);{} to line (f, 1);{} edit (w, f){}END PROC edit;{}PROC show (WINDOW VAR w, FILE VAR f):{} out frame (w.fenster);{} loesche rechte spalten (w);{} + open editor (groesster editor + 1, f, FALSE,{} areax (w.fenster), areay (w.fenster),{} areaxsize (w.fenster) - 1, areaysize (w.fenster));{} cursor on;{} edit (groesster editor, "eqvw19dpgn"9"",{} PROC (TEXT CONST) std kommando interpreter);{} cursor off{}END PROC show;{}PROC show (WINDOW VAR w, TEXT CONST dateiname):{} FILE VAR f :: sequential file (modify, dateiname);{} to line (f, 1);{} show (w, f){}END PROC show;{}PROC loesche rechte spalten (WINDOW VAR w):{} + INT VAR i;{} FOR i FROM 1 UPTO areaysize (w.fenster) REP{} cursor (w, areaxsize (w.fenster) - 2, i); out (3 * blank){} PER{}END PROC loesche rechte spalten;{}BOOL PROC no (WINDOW VAR w, TEXT CONST frage):{} NOT yes (w, frage){}END PROC no;{}PROC stop (WINDOW VAR w):{} stop (w, 2){}END PROC stop;{}PROC stop (WINDOW VAR w, INT CONST zeilenzahl):{} INT VAR i; FOR i FROM 1 UPTO zeilenzahl REP line (w) PER;{} out (w, aussage [3]);{} pause{}END PROC stop;{}AREA PROC area (WINDOW CONST w):{} + w.fenster{}END PROC area;{}INT PROC areax (WINDOW CONST w):{} areax (w.fenster){}END PROC areax;{}INT PROC areay (WINDOW CONST w):{} areay (w.fenster){}END PROC areay;{}INT PROC areaxsize (WINDOW CONST w):{} areaxsize (w.fenster){}END PROC areaxsize;{}INT PROC areaysize (WINDOW CONST w):{} areaysize (w.fenster){}END PROC areaysize;{}END PACKET ls dialog 3;{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 4 b/app/gs.dialog/1.2/src/ls-DIALOG 4 new file mode 100644 index 0000000..7c9d9c4 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG 4 @@ -0,0 +1,71 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG 4 ** + ** ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls dialog 4 DEFINES{} boxinfo,{} boxnotice,{} boxalternative,{} boxyes,{} boxno,{} boxanswer,{} boxone,{} boxanswerone,{} boxsome,{} boxanswersome,{} out footnote,{} erase footnote:{}LET mark ein = ""15"",{} mark aus = ""14"",{} delimiter = ""13"",{} piep = ""7"",{} rechts links esc return = ""2""8""27""13"",{} + rechts links null return = ""2""8""0""13"" ,{} blank = " ",{} niltext = "",{} janeintasten = "jJyYnN";{}ROW 8 TEXT CONST aussage :: ROW 8 TEXT : ({}" Zum Weitermachen bitte irgendeine Taste tippen!",{}" Ändern: Bestätigen: Abbruch: ",{}" Ändern: Bestätigen: Ja: Nein: ",{}" Ändern: Bestätigen: ",{}" Fertig: Zeigen: Abbruch: ",{} +" Fertig: Abbruch: ",{}"Ja"13"Nein",{}" Eingabe: "{});{}PROC boxinfo (WINDOW VAR w, TEXT CONST t,{} INT CONST position, timelimit,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} schreibe box (w, t, position, timelimit, x, y, xsize, ysize);{} cursor (w, spa, zei);{}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position,{} timelimit, BOOL CONST trennlinie weg):{} INT VAR x, y, xsize, ysize, spa, zei;{} + get cursor (w, spa, zei);{} schreibe box (w, t, position, timelimit, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei){}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, timelimit):{} boxinfo (w, t, position, timelimit, TRUE){}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t):{} boxinfo (w, t, 5, maxint, TRUE){}END PROC boxinfo;{} +PROC boxnotice (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} schreibe notiz (w, t, position, x, y, xsize, ysize);{} cursor (w, spa, zei){}END PROC boxnotice;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,{} auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch,{} INT VAR x, y, xsize, ysize):{} + INT VAR ergebnis, spa, zei;{} get cursor (w, spa, zei);{} schreibe alternativen (w, t, auswahlliste, zusatztasten, position,{} mit abbruch, x, y, xsize, ysize, ergebnis);{} cursor (w, spa, zei);{} ergebnis{}END PROC boxalternative;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, auswahlliste,{} zusatztasten, INT CONST position,{} BOOL CONST mit abbruch, trennlinie weg):{} INT VAR x, y, xsize, ysize, ergebnis, spa, zei;{} + get cursor (w, spa, zei);{} ergebnis := boxalternative (w, t, auswahlliste, zusatztasten, position,{} mit abbruch, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei);{} ergebnis{}END PROC boxalternative;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,{} auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch):{} + boxalternative (w, t, auswahlliste, zusatztasten,{} position, mit abbruch, TRUE){}END PROC boxalternative;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} BOOL CONST wert :: ja (w, t, position, x, y, xsize, ysize);{} cursor (w, spa, zei);{} wert{}END PROC boxyes;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t,{} INT CONST position, BOOL CONST trennlinie weg):{} + INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} BOOL VAR wert :: ja (w, t, position, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE);{} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxyes;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position):{} boxyes (w, t, position, TRUE){}END PROC boxyes;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position,{} + INT VAR x, y, xsize, ysize):{} NOT boxyes (w, t, position, x, y, xsize, ysize){}END PROC boxno;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t,{} INT CONST position, BOOL CONST trennlinie weg):{} NOT boxyes (w, t, position, trennlinie weg){}END PROC boxno;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position):{} boxno (w, t, position){}END PROC boxno;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, INT VAR x, y, xsize, ysize):{} + INT VAR spa, zei;{} TEXT VAR wert;{} get cursor (w, spa, zei);{} wert := hole antwort (w, t, vorgabe, position, FALSE, x, y, xsize, ysize);{} cursor (spa, zei);{} wert{}END PROC boxanswer;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, BOOL CONST trennlinie weg):{} INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, t, vorgabe, position, FALSE,{} x, y, xsize, ysize);{} + page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxanswer;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position):{} boxanswer (w, t, vorgabe, position, TRUE){}END PROC boxanswer;{}TEXT PROC boxone (WINDOW VAR w, THESAURUS CONST thesaurus,{} TEXT CONST text1, text2, BOOL CONST mit reinigung):{} + INT VAR spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert :: one (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2,{} thesaurus, text1, text2);{} IF mit reinigung{} THEN page up (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2);{} erase footnote (w){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxone;{}TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe,{} + THESAURUS CONST thesaurus, TEXT CONST t1, t2,{} BOOL CONST mit reinigung, trennlinie weg):{} INT VAR x,y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,{} x, y, xsize, ysize);{} IF wert = ""27"z"{} THEN lasse auswaehlen{} ELSE uebernimm den wert{} FI;{} cursor (w, spa, zei);{} wert.{} lasse auswaehlen:{} IF mit reinigung{} THEN wert := boxone (w, thesaurus, t1, t2, TRUE ){} + ELSE wert := boxone (w, thesaurus, t1, t2, FALSE){} FI.{} uebernimm den wert:{} IF mit reinigung{} THEN page up (x, y, xsize, ysize);{} entferne ggf die trennlinie{} FI.{} entferne ggf die trennlinie:{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI.{}END PROC boxanswer one;{}TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus, TEXT CONST t1, t2,{} + BOOL CONST mit reinigung):{} boxanswerone (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE){}END PROC boxanswer one;{}THESAURUS PROC boxsome (WINDOW VAR w, THESAURUS CONST thesaurus,{} TEXT CONST text1, text2,{} BOOL CONST mit reinigung):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} THESAURUS VAR wert :: some (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2,{} + thesaurus, text1, text2);{} IF mit reinigung{} THEN page up (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2);{} erase footnote (w){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxsome;{}THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus,{} TEXT CONST t1, t2,{} BOOL CONST mit reinigung, trennlinie weg):{} + THESAURUS VAR ergebnis :: empty thesaurus;{} INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,{} x, y, xsize, ysize);{} IF wert = ""27"z"{} THEN lasse auswaehlen{} ELSE uebernimm den wert{} FI;{} cursor (w, spa, zei);{} ergebnis.{} lasse auswaehlen:{} IF mit reinigung{} THEN ergebnis := boxsome (w, thesaurus, t1, t2, TRUE ){} ELSE ergebnis := boxsome (w, thesaurus, t1, t2, FALSE){} + FI.{} uebernimm den wert:{} IF wert <> niltext{} THEN insert (ergebnis, wert){} FI;{} IF mit reinigung{} THEN page up (x, y, xsize, ysize);{} entferne ggf die trennlinie{} FI.{} entferne ggf die trennlinie:{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI.{}END PROC boxanswer some;{}THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus,{} + TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{} boxanswersome (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE){}END PROC boxanswersome;{}PROC out footnote (WINDOW VAR w, BOOL CONST mit trennlinie, TEXT CONST text):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} IF mit trennlinie{} THEN cursor (w, 1, areaysize (w) - 1);{} areaxsize (w) TIMESOUT waagerecht{} FI;{} cursor (w, 1, areaysize (w));{} outtext (text, 1, areaxsize (w));{} + cursor (w, spa, zei){}END PROC out footnote;{}PROC out footnote (WINDOW VAR w, TEXT CONST t):{} out footnote (w, TRUE, t){}END PROC out footnote;{}PROC erase footnote (WINDOW VAR w, BOOL CONST auch trennlinie):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} IF auch trennlinie{} THEN cursor (w, 1, areaysize (w) - 1);{} outtext ("", 1, areaxsize (w)){} FI;{} cursor (w, 1, areaysize (w));{} outtext ("", 1, areaxsize (w));{} cursor (w, spa, zei){}END PROC erase footnote;{}PROC erase footnote (WINDOW VAR w):{} + erase footnote (w, TRUE){}END PROC erase footnote;{}PROC schreibe boxtext (WINDOW VAR w, TEXT CONST t,{} INT CONST position, zusatzlaenge,{} mindestbreite, mindesthoehe,{} INT VAR x, y, xsize, ysize):{} ermittle boxbreite und boxhoehe;{} ermittle rahmenwerte;{} schreibe boxkopf;{} schreibe boxrumpf.{} ermittle boxbreite und boxhoehe:{} TEXT VAR intern :: t + delimiter;{} entferne fuehrende delimiter;{} INT VAR anfang :: 1,{} + ende :: pos (intern, delimiter, anfang) - 1;{} xsize := 0;{} ysize := 0;{} WHILE ende > 0 REP{} ysize INCR 1;{} lege ggf boxbreite fest;{} bestimme neue positionen{} PER.{} entferne fuehrende delimiter:{} WHILE (intern SUB 1) = delimiter REP{} intern := subtext (intern, 2){} PER.{} lege ggf boxbreite fest:{} IF length (subtext (intern, anfang, ende)) > xsize{} THEN xsize := length (subtext (intern, anfang, ende)){} FI.{} bestimme neue positionen:{} + anfang := ende + 2;{} ende := pos (intern, delimiter, anfang) - 1.{} ermittle rahmenwerte:{} schlage notwendige groessen auf;{} kill ueberlaengen;{} lege bildschirmpositionen fest.{} schlage notwendige groessen auf:{} IF xsize < mindestbreite{} THEN xsize := mindestbreite{} FI;{} IF ysize < mindesthoehe{} THEN ysize := mindesthoehe{} FI;{} ysize INCR zusatzlaenge;{} ysize INCR 2; (* Für den Rahmen *){} xsize INCR 2. (* Für den Rahmen *){} kill ueberlaengen:{} + IF ysize > (areaysize (w) - 4){} THEN ysize := areaysize (w) - 4{} FI;{} IF xsize > (areaxsize (w) - 4){} THEN xsize := areaxsize (w) - 4{} FI.{} lege bildschirmpositionen fest:{} SELECT position OF{} CASE 1: plazierung links oben{} CASE 2: plazierung rechts oben{} CASE 3: plazierung links unten{} CASE 4: plazierung rechts unten{} OTHERWISE plazierung im zentrum{} END SELECT.{} plazierung links oben:{} x := areax (w) + 2;{} y := areay (w) + 2.{} + plazierung rechts oben:{} x := areax (w) + areaxsize (w) - xsize - 2;{} y := areay (w) + 2.{} plazierung links unten:{} x := areax (w) + 2;{} y := areay (w) + areaysize (w) - ysize - 2.{} plazierung rechts unten:{} x := areax (w) + areaxsize (w) - xsize - 2;{} y := areay (w) + areaysize (w) - ysize - 2.{} plazierung im zentrum:{} x := areax (w) + ((areaxsize (w) - (xsize + 2)) DIV 2) + 1;{} y := areay (w) + ((areaysize (w) - ysize) DIV 2).{} schreibe boxkopf:{} + cursor (x, y);{} out (ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke oben rechts).{} schreibe boxrumpf:{} INT VAR i;{} intern := t + delimiter;{} entferne fuehrende delimiter;{} anfang := 1;{} ende := pos (intern, delimiter, anfang) - 1;{} FOR i FROM y + 1 UPTO y + ysize - zusatzlaenge - 2 REP{} cursor (x, i);{} out (senkrecht);{} outtext (subtext (intern, anfang, ende), 1, xsize - 2);{} out (senkrecht);{} anfang := ende + 2;{} + ende := pos (intern, delimiter, anfang) - 1{} PER{}END PROC schreibe boxtext;{}PROC schreibe boxfuss (WINDOW VAR w,{} INT CONST x, y, xsize, ysize, limit):{} schreibe abschlusszeile;{} out footnote (w, aussage [1]);{} cursor in position und warten.{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} cursor in position und warten:{} cursor parken (w);{} + clear buffer;{} pause (limit){}END PROC schreibe boxfuss;{}PROC cursor parken (WINDOW VAR w):{} cursor (w, 1, 2){}END PROC cursor parken;{}PROC schreibe box (WINDOW VAR w, TEXT CONST t,{} INT CONST position, timelimit,{} INT VAR x, y, xsize, ysize):{} schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);{} schreibe boxfuss (w, x, y, xsize, ysize, timelimit){}END PROC schreibe box;{}PROC schreibe notizfuss (WINDOW VAR w, INT CONST x, y, xsize, ysize):{} + schreibe abschlusszeile;{} cursor parken (w).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{}END PROC schreibe notizfuss;{}PROC schreibe notiz (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);{} schreibe notizfuss (w, x, y, xsize, ysize){}END PROC schreibe notiz;{}PROC schreibe alternativen (WINDOW VAR w, TEXT CONST t, altzeile, sonst,{} + INT CONST position, BOOL CONST mit abbruch,{} INT VAR x, y, xsize, ysize, ergebnis):{} ROW 10 STRUCT (TEXT alternat, INT anfang, laenge) VAR altliste;{} normiere alternativen;{} untersuche alternativen;{} schreibe boxtext (w, textintern, position, 2, altbreite,{} 0, x, y, xsize, ysize);{} schreibe alternativenfuss;{} lasse auswaehlen;{} liefere ergebnis.{} textintern:{} IF sonst = janeintasten{} THEN TEXT VAR zwischen;{} + zwischen := t;{} kuerze um folgende blanks;{} zwischen + "? "{} ELSE t{} FI.{} kuerze um folgende blanks:{} WHILE (zwischen SUB (length (zwischen))) = blank REP{} zwischen := subtext (zwischen , 1, length (zwischen) - 1){} PER.{} normiere alternativen:{} TEXT VAR altintern :: altzeile;{} altintern CAT delimiter.{} untersuche alternativen:{} INT VAR altanzahl :: 1, altbreite, first :: - 2, anfang :: 1,{} ende :: pos (altintern, delimiter, anfang) - 1;{} + WHILE ende > 0 AND altanzahl <= 10 REP{} trage alternative ein;{} trage alternativenanfang ein;{} trage alternativenlaenge ein;{} setze neue positionen fest{} PER;{} ermittle gesamtalternativenbreite.{} trage alternative ein:{} altliste [altanzahl].alternat :={} compress (subtext (altintern, anfang, ende)).{} trage alternativenanfang ein:{} first INCR 3;{} altliste [altanzahl].anfang := first.{} trage alternativenlaenge ein:{} + altliste [altanzahl].laenge := length (altliste [altanzahl].alternat);{} first INCR altliste [altanzahl].laenge.{} setze neue positionen fest:{} anfang := ende + 2;{} ende := pos (altintern, delimiter, anfang) - 1;{} altanzahl INCR 1.{} ermittle gesamtalternativenbreite:{} altanzahl DECR 1;{} altbreite := altliste [altanzahl].anfang;{} altbreite INCR (altliste [altanzahl].laenge + 3);{} IF altbreite > areaxsize (w) - 6{} THEN LEAVE schreibe alternativen{} + FI.{} schreibe alternativenfuss:{} schreibe leerzeile;{} schreibe antwortmoeglichkeiten;{} schreibe abschlusszeile;{} IF mit abbruch{} THEN out footnote (w, aussage [2]){} ELSE beruecksichtige ja nein hinweis{} FI.{} schreibe leerzeile:{} cursor (x, y + ysize - 3);{} out (senkrecht);{} (xsize - 2) TIMESOUT blank;{} out (senkrecht).{} schreibe antwortmoeglichkeiten:{} cursor (x, y + ysize - 2);{} out (senkrecht);{} einrueckbreite TIMESOUT blank;{} + out (antwortleiste);{} rest TIMESOUT blank;{} out (senkrecht).{} einrueckbreite:{} (xsize - 2 - length (antwortleiste)) DIV 2.{} antwortleiste:{} INT VAR zeiger; TEXT VAR ausgabe :: "";{} FOR zeiger FROM 1 UPTO altanzahl REP{} ausgabe CAT altliste [zeiger].alternat;{} ausgabe CAT " "{} PER;{} compress (ausgabe).{} rest:{} xsize - 2 - einrueckbreite - length (antwortleiste).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} + (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} beruecksichtige ja nein hinweis:{} IF sonst = janeintasten{} THEN out footnote (w, aussage [3]){} ELSE out footnote (w, aussage [4]){} FI.{} lasse auswaehlen:{} INT VAR altzeiger :: 1;{} stelle erste alternative invers dar;{} REP{} hole eingabe;{} werte eingabe aus und reagiere{} UNTIL alternative gefunden PER.{} stelle erste alternative invers dar:{} cursor (x + einrueckbreite, y + ysize - 2);{} + out (mark ein);{} out (altliste [altzeiger].alternat); out (blank);{} out (mark aus);{} cursor (x + einrueckbreite, y + ysize - 2).{} hole eingabe:{} TEXT VAR moegliche, eingabe;{} IF mit abbruch{} THEN moegliche := rechts links esc return + sonst{} ELSE moegliche := rechts links null return + sonst{} FI;{} clear buffer;{} REP{} inchar (eingabe);{} piepse bei unzulaessiger eingabe{} UNTIL pos (moegliche, eingabe) > 0 PER.{} piepse bei unzulaessiger eingabe:{} + IF pos (moegliche, eingabe) = 0 THEN out (piep) FI.{} werte eingabe aus und reagiere:{} SELECT pos (moegliche, eingabe) OF{} CASE 1: zur naechsten alternative{} CASE 2: zur vorausgehenden alternative{} CASE 3: esc kommando verarbeiten{} END SELECT.{} zur naechsten alternative:{} loesche aktuelle alternative;{} ermittle rechte alternative;{} stelle neue alternative invers dar.{} zur vorausgehenden alternative:{} loesche aktuelle alternative;{} ermittle linke alternative;{} + stelle neue alternative invers dar.{} loesche aktuelle alternative:{} cursor (alternativenanfang - 1, y + ysize - 2);{} out (blank);{} out (altliste [altzeiger].alternat);{} out (2 * blank).{} alternativenanfang:{} x + einrueckbreite + altliste [altzeiger].anfang.{} ermittle rechte alternative:{} IF altzeiger = altanzahl{} THEN altzeiger := 1{} ELSE altzeiger INCR 1{} FI.{} ermittle linke alternative:{} IF altzeiger = 1{} THEN altzeiger := altanzahl{} + ELSE altzeiger DECR 1{} FI.{} stelle neue alternative invers dar:{} cursor (alternativenanfang - 1, y + ysize - 2);{} out (mark ein);{} out (altliste [altzeiger].alternat); out (blank);{} out (mark aus);{} cursor (alternativenanfang - 1, y + ysize - 2).{} esc kommando verarbeiten:{} inchar (eingabe);{} IF eingabe = "h"{} THEN ergebnis := 0;{} LEAVE schreibe alternativen{} ELSE out (piep); eingabe := ""{} FI.{} alternative gefunden:{} pos (moegliche, eingabe) > 3.{} + liefere ergebnis:{} IF pos (moegliche, eingabe) = 4{} THEN ergebnis := altzeiger{} ELSE ergebnis := 100 + pos (sonst, eingabe){} FI.{}END PROC schreibe alternativen;{}BOOL PROC ja (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR ergebnis;{} schreibe alternativen (w, t, aussage [7], janeintasten, position,{} FALSE, x, y, xsize, ysize, ergebnis);{} SELECT ergebnis OF{} CASE 2, 105, 106: FALSE{} OTHERWISE TRUE{} + END SELECT.{}END PROC ja;{}TEXT PROC hole antwort (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, BOOL CONST mit auswahl,{} INT VAR x, y, xsize, ysize):{} TEXT VAR eingabe :: compress (vorgabe);{} schreibe boxtext (w, t, position, 2, length (aussage [8]) + 12, 2,{} x, y, xsize, ysize);{} schreibe antwortfuss;{} clear buffer;{} REP{} IF eingabe = "break"{} THEN eingabe := ""{} FI;{} lasse eintragen{} + UNTIL eingabe <> "break" PER;{} liefere ergebnis.{} schreibe antwortfuss:{} schreibe leerzeile;{} schreibe eingabezeile;{} schreibe abschlusszeile;{} IF mit auswahl{} THEN out footnote (w, aussage [5]){} ELSE out footnote (w, aussage [6]){} FI.{} schreibe leerzeile:{} cursor (x, y + ysize - 3);{} out (senkrecht);{} (xsize - 2) TIMESOUT blank;{} out (senkrecht).{} schreibe eingabezeile:{} cursor (x, y + ysize - 2);{} out (senkrecht);{} out (aussage [8]);{} + (xsize - 2 - length (aussage [8])) TIMESOUT blank;{} out (senkrecht).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} lasse eintragen:{} TEXT VAR exit :: "";{} cursor on;{} cursor (x + length (aussage [8]) + 1, y + ysize - 2);{} IF mit auswahl{} THEN editget (eingabe, maxtextlength, textlaenge, "", "hz", exit){} ELSE editget (eingabe, maxtextlength, textlaenge, "", "h", exit){} + FI;{} cursor off;{} IF exit = ""27"h"{} THEN eingabe := ""{} ELIF mit auswahl AND (exit = ""27"z"){} THEN eingabe := ""27"z"{} ELSE eingabe := compress (eingabe){} FI.{} textlaenge:{} xsize - 2 - length (aussage [8]).{} liefere ergebnis:{} eingabe.{}END PROC hole antwort;{}END PACKET ls dialog 4;{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 5 b/app/gs.dialog/1.2/src/ls-DIALOG 5 new file mode 100644 index 0000000..1772b99 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG 5 @@ -0,0 +1,118 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG 5 ** + ** ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls dialog 5 DEFINES{} menufootnote, old menufootnote,{} menuinfo,menualternative,{} menuyes, menuno, menuone,{} menusome,menuanswer,{} menuanswerone, menuanswersome,{} install menu, handle menu,{} refresh submenu, deactivate,{} regenerate menuscreen, activate,{} write menunotice, erase menunotice,{} menubasistext, anwendungstext,{} show menuwindow, menuwindowpage,{} menuwindowout, menuwindowget,{} menuwindoweditget, menuwindowedit,{} + menuwindowshow, menuwindowline,{} menuwindowyes, menuwindowno,{} menuwindowcursor, get menuwindowcursor,{} remaining menuwindowlines,{} menuwindowcenter, menuwindowstop,{} editorinformationen,stdinfoedit,{} menukartenname, current menuwindow,{} reset dialog, only intern, ausstieg,{} direktstart:{}LET systemkuerzel = "ls-DIALOG",{} menutafeltaskname = "ls-MENUKARTEN",{} menutafeltype = 1954,{} menutafelpraefix = "ls-MENUKARTE:",{} + stdmenukartenname = "ls-MENUKARTE:Archiv",{} versionsnummer = "1.1",{} copyright1 = " (C) 1987/88 Eva Latta-Weber",{} copyright2 = " (C) 1988 ERGOS GmbH";{}LET maxmenus = 6,{} maxmenutexte = 300,{} maxinfotexte = 2000,{} maxhauptmenupunkte = 10,{} maxuntermenupunkte = 15,{} erste untermenuzeile = 3;{}LET blank = " ",{} piep = ""7"",{} + cleol = ""5"",{} cleop = ""4"",{} trennzeilensymbol = "###",{} bleibt leer symbol = "***",{} hauptmenuluecke = " ";{}LET auswahlstring1 = ""8""2""10""3""13""27"?";{}TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,{} punktname,{} procname,{} boxtext,{} BOOL aktiv,{} angewaehlt),{} + EINZELMENU = STRUCT (INT belegt,{} TEXT ueberschrift,{} INT anfangsposition,{} maxlaenge,{} ROW maxuntermenupunkte MENUPUNKT menupunkt,{} INT aktueller untermenupunkt,{} TEXT startprozedurname,{} leaveprozedurname),{} MENU = STRUCT (TEXT menuname,{} INT anzahl hauptmenupunkte,{} + ROW maxhauptmenupunkte EINZELMENU einzelmenu,{} TEXT menueingangsprozedur,{} menuausgangsprozedur,{} menuinfo,{} lizenznummer,{} versionsnummer,{} INT hauptmenuzeiger,{} untermenuanfang,{} untermenuzeiger),{} INFOTEXT = STRUCT (INT anzahl infotexte,{} + ROW maxinfotexte TEXT stelle),{} MENUTEXT = STRUCT (INT anzahl menutexte,{} ROW maxmenutexte TEXT platz),{} MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,{} ROW maxmenus MENU menu,{} MENUTEXT menutext,{} INFOTEXT infotext);{}BOUND MENULEISTE VAR menuleiste;{}DATASPACE VAR ds;{}WINDOW VAR menuwindow, schreibfenster, editorinfofenster;{} +INITFLAG VAR in this task :: FALSE;{}INT VAR anzahl offener menus :: 0;{}INT VAR menunotizx, menunotizxsize,{} menunotizy, menunotizysize,{} menunotizposition;{}TEXT VAR angekoppelte menutafel :: "",{} permanent footnote :: "",{} menunotiztext;{}BOOL VAR menunotiz ist gesetzt :: FALSE,{} nur interne verwendung :: FALSE,{} mit ausstieg :: FALSE;{}REAL VAR zeitpunkt :: clock (1);{} +ROW 13 TEXT CONST fehlermeldung :: ROW 13 TEXT : ({}"Die Task '" + menutafeltaskname + "' existiert nicht!",{}"Die Menukarte '",{}"' existiert nicht in der Task '" + menutafeltaskname + "'!",{}"' hat falschen Typ/Bezeichnung (keine 'MENUKARTE')!",{}"Das Menu '",{}"' ist nicht in der angekoppelten Menukarte!",{}"Zu viele geoeffnete Menus ( > 2 )!",{}"Kein Menu geoeffnet!",{}"Menu enthaelt keine Menupunkte!",{}"Menupunkt ist nicht im Menu enthalten!",{}"Kein Text vorhanden!",{}"Zugriff unmöglich!",{} +"Einschränkung unzulässig!"{});{}ROW 1 TEXT CONST vergleichstext :: ROW 1 TEXT : ({}"gibt es nicht"{});{}ROW 3 TEXT CONST hinweis :: ROW 3 TEXT : ({}"Info:/ Wahl: Ausführen: Verlassen:",{}" Zum Weitermachen bitte irgendeine Taste tippen!",{}"Bitte warten ... Ich räume auf!"{});{}ROW 3 TEXT CONST infotext :: ROW 3 TEXT : ({}" Für diesen Menupunkt ist (noch) keine "13""13" Funktion eingetragen!",{}" Möchten Sie dieses Menu tatsächlich verlassen",{}" Leider ist zu diesem Menupunkt "13""13" kein Info - Text eingetragen!"{} + );{}PROC install menu (TEXT CONST menutafelname):{} installmenu (menutafelname, TRUE){}END PROC install menu;{}PROC install menu (TEXT CONST menutafelname, BOOL CONST mit kennung):{} TEXT VAR letzter parameter;{} IF mit kennung{} THEN zeige menukennung{} FI;{} initialisiere menu ggf;{} IF menutafel noch nicht angekoppelt{} THEN letzter parameter := std;{} hole menutafel;{} kopple menutafel an;{} last param (letzter parameter){} FI.{} initialisiere menu ggf:{} + IF NOT initialized (in this task){} THEN angekoppelte menutafel := "";{} anzahl offener menus := 0;{} menunotiz ist gesetzt := FALSE;{} nur interne verwendung := FALSE{} FI.{} menutafel noch nicht angekoppelt:{} menutafelname <> angekoppelte menutafel.{} hole menutafel:{} IF NOT exists task (menutafeltaskname){} THEN bereinige situation; cursor on;{} errorstop (fehlermeldung [1]){} FI;{} disable stop;{} fetch (menutafelname, /menutafeltaskname);{} + IF is error AND pos (errormessage, vergleichstext [1]) > 0{} THEN clear error; enable stop;{} bereinige situation; cursor on;{} errorstop (fehlermeldung [2] + menutafelname +{} fehlermeldung [3]){} ELIF is error{} THEN clear error; enable stop;{} bereinige situation; cursor on;{} errorstop (errormessage){} ELSE enable stop{} FI.{} kopple menutafel an:{} IF type (old (menutafelname)) = menutafeltype{} + AND pos (menutafelname,menutafelpraefix) = 1{} THEN forget (ds);{} ds := old (menutafelname);{} menuleiste := ds;{} angekoppelte menutafel := menutafelname;{} forget (menutafelname, quiet){} ELSE bereinige situation; cursor on;{} errorstop ("'" + menutafelname + fehlermeldung [4]){} FI.{}END PROC install menu;{}PROC only intern (BOOL CONST wert):{} nur interne verwendung := wert{}END PROC only intern;{} +PROC ausstieg (BOOL CONST wert):{} mit ausstieg := wert{}END PROC ausstieg;{}TEXT PROC menukartenname:{} IF NOT initialized (in this task){} THEN angekoppelte menutafel := "";{} anzahl offener menus := 0;{} menunotiz ist gesetzt := FALSE;{} FI;{} angekoppelte menutafel{}END PROC menukartenname;{}PROC handle menu (TEXT CONST menuname):{} nur interne verwendung := FALSE;{} mit ausstieg := TRUE;{} handle menu (menuname, ""){}END PROC handle menu;{} +PROC handle menu (TEXT CONST menuname, ausstiegsproc):{} cursor off;{} IF nur interne verwendung{} THEN oeffne menu (menuname){} ELSE biete menu an{} FI;{} lasse menupunkte auswaehlen;{} IF nur interne verwendung{} THEN do (ausstiegsproc);{} anzahl offener menus DECR 1;{} IF anzahl offener menus < 1 THEN erase menunotice FI;{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1,1,79, 24);{} nur interne verwendung := FALSE;{} + mit ausstieg := TRUE;{} cursor on{} ELSE schliesse menu;{} leere ggf den bildschirm{} FI.{} biete menu an:{} REAL VAR zwischenzeit :: clock (1) - zeitpunkt;{} IF zwischenzeit < 2.0{} THEN pause (20 - int (10.0 * zwischenzeit)){} FI;{} oeffne menu (menuname).{} leere ggf den bildschirm:{} IF anzahl offener menus < 1{} THEN erase menunotice;{} page; cursor on{} FI.{} lasse menupunkte auswaehlen:{} TEXT VAR kuerzelkette :: "";{} + starte aktuelle untermenuoperationen;{} REP{} cursor in warteposition;{} ermittle aktuelle kuerzelkette;{} nimm zeichen auf;{} interpretiere zeichen;{} UNTIL menu verlassen gewuenscht PER.{} nimm zeichen auf:{} TEXT CONST erlaubte zeichen ::auswahlstring1 + kuerzelkette;{} TEXT VAR eingabezeichen;{} INT VAR zeichenposition;{} REP{} inchar (eingabezeichen);{} zeichenposition := pos (erlaubte zeichen, eingabezeichen);{} piepse ggf{} UNTIL zeichenposition > 0 PER.{} + piepse ggf:{} IF zeichenposition = 0 THEN out (piep) FI.{} menu verlassen gewuenscht:{} zeichenposition = 6 AND (zweites zeichen = "q").{} interpretiere zeichen:{} SELECT zeichenposition OF{} CASE 1: gehe einen hauptmenupunkt nach links{} CASE 2: gehe einen hauptmenupunkt nach rechts{} CASE 3: gehe einen untermenupunkt nach unten{} CASE 4: gehe einen untermenupunkt nach oben{} CASE 5: fuehre aktuellen menupunkt aus{} CASE 6: hole esc sequenz{} CASE 7: zeige erklaerungstext im menu an{} + OTHERWISE werte kuerzeleingabe aus{} END SELECT.{} gehe einen hauptmenupunkt nach links:{} INT VAR anzahl schritte :: 1;{} beende aktuelle untermenuoperationen;{} loesche aktuelles untermenu auf bildschirm;{} loesche alte hauptmenumarkierung;{} anzahl schritte INCR clear buffer and count (""8"");{} ermittle linke menuposition;{} stelle aktuellen hauptmenupunkt invers dar;{} starte aktuelle untermenuoperationen;{} schreibe aktuelles untermenu auf bildschirm.{} gehe einen hauptmenupunkt nach rechts:{} + anzahl schritte := 1;{} beende aktuelle untermenuoperationen;{} loesche aktuelles untermenu auf bildschirm;{} loesche alte hauptmenumarkierung;{} anzahl schritte INCR clear buffer and count (""2"");{} ermittle rechte menuposition;{} stelle aktuellen hauptmenupunkt invers dar;{} starte aktuelle untermenuoperationen;{} schreibe aktuelles untermenu auf bildschirm.{} loesche alte hauptmenumarkierung:{} erase invers (area (menuwindow), startpos, 1, ueberschriftlaenge);{} + out (area (menuwindow), startpos, 1, ueberschrifttext).{} startpos:{} aktuelles untermenu.anfangsposition.{} ueberschriftlaenge:{} length (ueberschrifttext).{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} ermittle linke menuposition:{} INT VAR positionszaehler;{} FOR positionszaehler FROM 1 UPTO anzahl schritte REP{} + drehe die menuposition um einen wert runter{} PER.{} ermittle rechte menuposition:{} FOR positionszaehler FROM 1 UPTO anzahl schritte REP{} drehe die menuposition um einen wert hoch{} PER.{} drehe die menuposition um einen wert runter:{} IF aktuelles menu.hauptmenuzeiger > 1{} THEN aktuelles menu.hauptmenuzeiger DECR 1{} ELSE aktuelles menu.hauptmenuzeiger{} := aktuelles menu.anzahl hauptmenupunkte{} FI.{} drehe die menuposition um einen wert hoch:{} + IF aktuelles menu.hauptmenuzeiger{} < aktuelles menu.anzahl hauptmenupunkte{} THEN aktuelles menu.hauptmenuzeiger INCR 1{} ELSE aktuelles menu.hauptmenuzeiger := 1{} FI.{} gehe einen untermenupunkt nach unten:{} INT VAR naechster aktiver := folgender aktiver untermenupunkt;{} nimm ummarkierung vor.{} gehe einen untermenupunkt nach oben:{} naechster aktiver := vorausgehender aktiver untermenupunkt;{} nimm ummarkierung vor.{} nimm ummarkierung vor:{} IF ueberhaupt aktive menupunkte vorhanden{} + THEN demarkiere aktuellen untermenupunkt;{} gehe zum folgenden untermenupunkt;{} markiere aktuellen untermenupunkt{} FI.{} ueberhaupt aktive menupunkte vorhanden:{} (aktuelles untermenu.belegt > 0) CAND (naechster aktiver > 0).{} gehe zum folgenden untermenupunkt:{} aktuelles menu.untermenuzeiger := naechster aktiver.{} stelle aktuellen hauptmenupunkt invers dar:{} out invers (area (menuwindow), startpos, 1, ueberschrifttext).{} fuehre aktuellen menupunkt aus:{} + IF nur interne verwendung AND mit ausstieg{} THEN kennzeichne als angetickt;{} disable stop;{} do (ausstiegsproc);{} do (menuanweisung);{} aktueller menupunkt.angewaehlt := FALSE;{} IF is error THEN put error; clear error FI;{} enable stop;{} anzahl offener menus DECR 1;{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1,1,79, 24);{} nur interne verwendung := FALSE;{} + cursor on;{} LEAVE handle menu{} ELSE kennzeichne als angetickt;{} fuehre operation aus (menuanweisung);{} nimm kennzeichnung zurueck{} FI.{} kennzeichne als angetickt:{} aktueller menupunkt.angewaehlt := TRUE;{} markiere aktuellen untermenupunkt.{} nimm kennzeichnung zurueck:{} aktueller menupunkt.angewaehlt := FALSE;{} markiere aktuellen untermenupunkt.{} menuanweisung:{} compress (aktueller menupunkt.procname).{} aktueller menupunkt:{} + aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].{} hole esc sequenz:{} TEXT VAR zweites zeichen;{} inchar (zweites zeichen);{} SELECT pos ("q?$", zweites zeichen) OF{} CASE 1: erfrage abbruch{} CASE 2: zeige menubedienhinweise{} CASE 3: gib info aus{} OTHERWISE out (piep){} END SELECT.{} erfrage abbruch:{} IF menuno (infotext [2], 5){} THEN zweites zeichen := "n" (* gleichgültig, nur nicht 'q' *){} FI.{} zeige menubedienhinweise:{} + INT VAR gewaehlt;{} REP{} gewaehlt := menualternative ( alttext, altwahl, altzusatz, 5, FALSE);{} erfuelle den wunsch{} UNTIL ausstieg aus bedienhinweisen gewuenscht PER.{} alttext:{} menuleiste.menutext.platz [1].{} altwahl:{} menuleiste.menutext.platz [2].{} altzusatz:{} menuleiste.menutext.platz [3].{} erfuelle den wunsch:{} SELECT gewaehlt OF{} CASE 1,101,106: menuinfo (menuleiste.menutext.platz [4], 5, maxint){} CASE 2,102,107: menuinfo (menuleiste.menutext.platz [5], 5, maxint){} + CASE 3,103,108: menuinfo (menuleiste.menutext.platz [6], 5, maxint){} CASE 4,104,109: menuinfo (menuleiste.menutext.platz [7], 5, maxint){} END SELECT.{} ausstieg aus bedienhinweisen gewuenscht:{} gewaehlt = 5 OR gewaehlt = 105 OR gewaehlt = 110.{} gib info aus:{} menuinfo (menuleiste.menutext.platz [20]).{} zeige erklaerungstext im menu an:{} IF compress (erklaerungstext) = ""{} THEN menuinfo (infotext [3]){} ELSE menuinfo (erklaerungstext){} FI.{} erklaerungstext:{} + aktueller menupunkt.boxtext.{} werte kuerzeleingabe aus:{} naechster aktiver := pos (kuerzelkette, eingabezeichen);{} nimm ummarkierung vor;{} fuehre aktuellen menupunkt aus.{} starte aktuelle untermenuoperationen:{} ermittle aktuelle kuerzelkette;{} IF startoperation <> ""{} THEN fuehre operation aus (startoperation){} FI.{} startoperation:{} compress (aktuelles untermenu.startprozedurname).{} ermittle aktuelle kuerzelkette:{} kuerzelkette := "";{} INT VAR kuerzelzeiger;{} + FOR kuerzelzeiger FROM 1 UPTO aktuelles untermenu.belegt REP{} IF compress (aktuelles punktkuerzel) = ""{} THEN kuerzelkette CAT ""0"" { beliebiger Code der Länge 1 }{} ELSE haenge ggf kuerzel an{} FI{} PER.{} aktuelles punktkuerzel:{} aktuelles untermenu.menupunkt [kuerzelzeiger].punktkuerzel.{} haenge ggf kuerzel an:{} IF betrachteter punkt ist aktiv{} THEN kuerzelkette CAT aktuelles punktkuerzel{} ELSE kuerzelkette CAT ""0""{} FI.{} betrachteter punkt ist aktiv:{} + aktuelles untermenu.menupunkt [kuerzelzeiger].aktiv.{} beende aktuelle untermenuoperationen:{} kuerzelkette := "".{}END PROC handle menu;{}PROC oeffne menu (TEXT CONST menuname):{} cursor off;{} suche eingestelltes menu;{} IF menu existiert nicht{} THEN cursor on;{} page;{} errorstop (fehlermeldung [5] + menuname + fehlermeldung [6]){} FI;{} anzahl offener menus INCR 1;{} ggf neue seite aufschlagen;{} ueberpruefe anzahl offener menus;{} lege ggf aktuelles menu auf eis;{} + initialisiere den menubildschirm;{} IF NOT nur interne verwendung{} THEN aktuelles menu.hauptmenuzeiger := 1;{} aktuelles menu.untermenuzeiger := 0;{} aktuelles menu.untermenuanfang := 0;{} FI;{} show menu;{} fuehre ggf menueingangsprozedur aus;{} zeige ggf menukenndaten an.{} suche eingestelltes menu:{} INT VAR i, suchzeiger;{} BOOL VAR gefunden :: FALSE;{} FOR i FROM 1 UPTO menuleiste.belegt REP{} IF menuleiste.menu [i].menuname = menuname{} + THEN gefunden := TRUE;{} suchzeiger := i;{} FI{} UNTIL menuleiste.menu [i].menuname = menuname PER.{} menu existiert nicht:{} NOT gefunden.{} ueberpruefe anzahl offener menus:{} IF anzahl offener menus > 2{} THEN anzahl offener menus := 0; cursor on;{} errorstop (fehlermeldung [7]){} FI.{} lege ggf aktuelles menu auf eis:{} IF anzahl offener menus = 2{} THEN menuleiste.zeigerhintergrund := menuleiste.zeigeraktuell{} FI;{} menuleiste.zeigeraktuell := suchzeiger.{} + initialisiere den menubildschirm:{} IF anzahl offener menus = 2{} THEN menuwindow := window (6, 4, 73, 20){} ELSE menuwindow := window (1, 1, 79, 24);{} FI.{} fuehre ggf menueingangsprozedur aus:{} IF aktuelles menu.menueingangsprozedur <> ""{} THEN fuehre operation aus (aktuelles menu.menueingangsprozedur){} FI.{} ggf neue seite aufschlagen:{} IF anzahl offener menus = 1 THEN page FI.{} zeige ggf menukenndaten an:{} IF anzahl offener menus = 1 AND aktuelles menu.menuinfo <> bleibt leer symbol{} + THEN write menunotice (vollstaendiger infotext, 4);{} pause (100);{} erase menunotice{} FI.{} vollstaendiger infotext:{} aktuelles menu.menuinfo +{} aktuelles menu.lizenznummer +{} aktuelles menu.versionsnummer.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{}END PROC oeffne menu;{}PROC show menu:{} ueberpruefe menudaten;{} stelle hauptmenuleiste zusammen;{} zeige hauptmenu an;{} stelle aktuellen hauptmenupunkt invers dar;{} schreibe aktuelles untermenu auf bildschirm;{} + zeige informationszeile an.{} ueberpruefe menudaten:{} IF anzahl offener menus = 0{} THEN errorstop (fehlermeldung [8]){} ELIF aktuelles menu.anzahl hauptmenupunkte < 1{} THEN errorstop (fehlermeldung [9]){} FI.{} stelle hauptmenuleiste zusammen:{} TEXT VAR hauptmenuzeile :: "";{} INT VAR zeiger;{} hauptmenuzeile CAT aktuelles menu.menuname;{} hauptmenuzeile CAT ":";{} FOR zeiger FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP{} haenge hauptmenupunkt an{} + PER.{} haenge hauptmenupunkt an:{} hauptmenuzeile CAT hauptmenuluecke;{} hauptmenuzeile CAT hauptmenupunktname.{} hauptmenupunktname:{} aktuelles menu.einzelmenu [zeiger].ueberschrift.{} zeige hauptmenu an:{} page (menuwindow, TRUE);{} out menuframe (area (menuwindow));{} cursor (menuwindow, 1, 1);{} out (menuwindow, hauptmenuzeile).{} stelle aktuellen hauptmenupunkt invers dar:{} cursor (menuwindow, startposition, 1);{} out (menuwindow, invers (ueberschrifttext)).{} + startposition:{} aktuelles untermenu.anfangsposition - 1.{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} zeige informationszeile an:{} write permanent footnote (hinweis [1]).{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC show menu;{}PROC schreibe aktuelles untermenu auf bildschirm:{} ermittle linke obere ecke des untermenukastens;{} wirf untermenu aus;{} + show menunotice;{} cursor in warteposition.{} ermittle linke obere ecke des untermenukastens:{} aktuelles menu.untermenuanfang := menumitte - halbe menubreite;{} achte auf randextrema.{} menumitte:{} startposition + (length (ueberschrifttext) DIV 2) - 1.{} startposition:{} aktuelles untermenu.anfangsposition.{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} halbe menubreite:{} aktuelles untermenu.maxlaenge DIV 2.{} achte auf randextrema:{} gleiche ggf linken rand aus;{} + gleiche ggf rechten rand aus.{} gleiche ggf linken rand aus:{} IF aktuelles menu.untermenuanfang < 4{} THEN aktuelles menu.untermenuanfang := 4{} FI.{} gleiche ggf rechten rand aus:{} IF (aktuelles menu.untermenuanfang + aktuelles untermenu.maxlaenge) >{} (areaxsize (menuwindow) - 3){} THEN aktuelles menu.untermenuanfang{} := areaxsize (menuwindow) - aktuelles untermenu.maxlaenge - 3{} FI.{} wirf untermenu aus:{} IF aktuelles menu.untermenuzeiger = 0{} + THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt{} FI;{} wirf untermenukopfzeile aus;{} wirf untermenurumpf aus;{} wirf untermenufusszeile aus;{} markiere aktuellen untermenupunkt.{} wirf untermenukopfzeile aus:{} cursor (menuwindow, spalte, anfangszeile);{} out (balken oben); striche; out (balken oben).{} wirf untermenufusszeile aus:{} cursor (menuwindow, spalte, endezeile);{} out (ecke unten links); striche; out (ecke unten rechts).{} spalte:{} + aktuelles menu.untermenuanfang - 3.{} anfangszeile:{} erste untermenuzeile - 1.{} endezeile:{} erste untermenuzeile + aktuelles untermenu.belegt.{} striche:{} (aktuelles untermenu.maxlaenge + 5) TIMESOUT waagerecht.{} wirf untermenurumpf aus:{} INT VAR laufvar;{} INT CONST aktuelle punktlaenge :: aktuelles untermenu.maxlaenge + 1;{} FOR laufvar FROM 1 UPTO aktuelles untermenu.belegt REP{} wirf eine einzelne menuzeile aus{} PER.{} wirf eine einzelne menuzeile aus:{} + out with beam (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge).{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile + laufvar - 1.{} aktueller punktname:{} untermenubezeichnung (laufvar).{} laenge:{} aktuelle punktlaenge.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC schreibe aktuelles untermenu auf bildschirm;{} +PROC loesche aktuelles untermenu auf bildschirm:{} beende aktuelle untermenuoperationen;{} loesche untermenu auf bildschirm;{} schreibe balken wieder hin;{} aktuelles menu.untermenuzeiger := 1.{} beende aktuelle untermenuoperationen:{} IF leaveoperation <> ""{} THEN fuehre operation aus (leaveoperation){} FI.{} leaveoperation:{} compress (aktuelles untermenu.leaveprozedurname).{} loesche untermenu auf bildschirm:{} INT VAR laufvar;{} FOR laufvar FROM aktuelles untermenu.belegt + 1 DOWNTO 1 REP{} + loesche eine einzelne menuzeile{} PER.{} loesche eine einzelne menuzeile:{} erase with beam (area (menuwindow), menuspalte, menuzeile, laenge).{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile + laufvar - 1.{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{} schreibe balken wieder hin:{} + cursor (menuwindow, spalte, anfangszeile);{} (aktuelles untermenu.maxlaenge + 7) TIMESOUT waagerecht.{} spalte:{} aktuelles menu.untermenuanfang - 3.{} anfangszeile:{} erste untermenuzeile - 1.{}END PROC loesche aktuelles untermenu auf bildschirm;{}PROC markiere aktuellen untermenupunkt:{} IF aktuelles menu.untermenuzeiger <> 0{} THEN laufe ggf zum naechsten aktiven menupunkt;{} out invers with beam (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge){} + FI.{} laufe ggf zum naechsten aktiven menupunkt:{} IF NOT aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].aktiv{} THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt{} FI.{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.{} aktueller punktname:{} untermenubezeichnung (aktuelles menu.untermenuzeiger).{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{} + menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC markiere aktuellen untermenupunkt;{}PROC demarkiere aktuellen untermenupunkt:{} IF aktuelles menu.untermenuzeiger <> 0{} THEN erase invers (area (menuwindow), menuspalte, menuzeile, laenge);{} out (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge){} FI.{} menuspalte:{} aktuelles menu.untermenuanfang.{} + menuzeile:{} erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.{} aktueller punktname:{} untermenubezeichnung (aktuelles menu.untermenuzeiger).{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC demarkiere aktuellen untermenupunkt;{}INT PROC folgender aktiver untermenupunkt:{} INT VAR anzahl aktiver menupunkte :: 0;{} + untersuche anzahl aktiver menupunkte;{} IF kein aktiver menupunkt vorhanden{} THEN 0{} ELIF nur ein aktiver menupunkt vorhanden{} THEN liefere einzigen aktiven menupunkt{} ELSE liefere naechsten aktiven menupunkt{} FI.{} untersuche anzahl aktiver menupunkte:{} INT VAR zaehler, position;{} FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP{} IF aktuelles untermenu.menupunkt [zaehler].aktiv{} THEN anzahl aktiver menupunkte INCR 1;{} position := zaehler{} + FI{} UNTIL anzahl aktiver menupunkte > 1 PER.{} kein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 0.{} nur ein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 1.{} liefere einzigen aktiven menupunkt:{} position.{} liefere naechsten aktiven menupunkt:{} INT VAR interner zeiger;{} stelle internen zeiger auf den naechsten menupunkt;{} WHILE NOT punkt ist aktiv REP{} untersuche naechsten menupunkt{} PER;{} ergebnis.{} stelle internen zeiger auf den naechsten menupunkt:{} + IF aktuelles menu.untermenuzeiger = letzter untermenupunkt{} THEN interner zeiger := 1{} ELSE interner zeiger := aktuelles menu.untermenuzeiger + 1{} FI.{} letzter untermenupunkt:{} aktuelles untermenu.belegt.{} punkt ist aktiv:{} aktuelles untermenu.menupunkt [interner zeiger].aktiv.{} untersuche naechsten menupunkt:{} IF interner zeiger = letzter untermenupunkt{} THEN interner zeiger := 1{} ELSE interner zeiger INCR 1{} FI.{} + ergebnis:{} interner zeiger.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC folgender aktiver untermenupunkt;{}INT PROC vorausgehender aktiver untermenupunkt:{} INT VAR anzahl aktiver menupunkte :: 0;{} untersuche anzahl aktiver menupunkte;{} IF kein aktiver menupunkt vorhanden{} THEN 0{} ELIF nur ein aktiver menupunkt vorhanden{} THEN liefere einzigen aktiven menupunkt{} + ELSE liefere vorausgehenden aktiven menupunkt{} FI.{} untersuche anzahl aktiver menupunkte:{} INT VAR zaehler, position;{} FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP{} IF aktuelles untermenu.menupunkt [zaehler].aktiv{} THEN anzahl aktiver menupunkte INCR 1;{} position := zaehler{} FI{} UNTIL anzahl aktiver menupunkte > 1 PER.{} kein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 0.{} nur ein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 1.{} + liefere einzigen aktiven menupunkt:{} position.{} liefere vorausgehenden aktiven menupunkt:{} INT VAR interner zeiger;{} stelle internen zeiger auf vorausgehenden menupunkt;{} WHILE NOT punkt ist aktiv REP{} untersuche vorausgehenden menupunkt{} PER;{} ergebnis.{} stelle internen zeiger auf vorausgehenden menupunkt:{} IF aktuelles menu.untermenuzeiger <= 1{} THEN interner zeiger := letzter untermenupunkt{} ELSE interner zeiger := aktuelles menu.untermenuzeiger - 1{} + FI.{} letzter untermenupunkt:{} aktuelles untermenu.belegt.{} punkt ist aktiv:{} aktuelles untermenu.menupunkt [interner zeiger].aktiv.{} untersuche vorausgehenden menupunkt:{} IF interner zeiger = 1{} THEN interner zeiger := letzter untermenupunkt{} ELSE interner zeiger DECR 1{} FI.{} ergebnis:{} interner zeiger.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{} +END PROC vorausgehender aktiver untermenupunkt;{}PROC cursor in warteposition:{} cursor (areax (menuwindow), areay (menuwindow) + 1){}END PROC cursor in warteposition;{}TEXT PROC untermenubezeichnung (INT CONST position):{} TEXT VAR bezeichnung :: "";{} bezeichnung CAT kennzeichnung;{} bezeichnung CAT punktkennung;{} bezeichnung.{} kennzeichnung:{} IF aktueller menupunkt.aktiv{} AND aktueller menupunkt.angewaehlt{} THEN "*"{} ELIF aktueller menupunkt.aktiv{} + AND aktueller menupunkt.punktkuerzel <> ""{} THEN aktueller menupunkt.punktkuerzel{} ELIF aktueller menupunkt.aktiv{} AND aktueller menupunkt.punktkuerzel = ""{} THEN blank{} ELSE "-"{} FI.{} punktkennung:{} IF menupunkt ist trennzeile{} THEN strichellinie{} ELSE aktueller menupunkt.punktname{} FI.{} menupunkt ist trennzeile:{} aktueller menupunkt.punktname = (blank + trennzeilensymbol).{} strichellinie:{} + (aktuelles untermenu.maxlaenge + 1) * "-".{} aktueller menupunkt:{} aktuelles untermenu.menupunkt [position].{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC untermenubezeichnung;{}PROC fuehre operation aus (TEXT CONST operation):{} disable stop;{} IF operation = ""{} THEN menuinfo (infotext [1]);{} LEAVE fuehre operation aus{} FI;{} do (operation);{} + IF is error{} THEN menuinfo (errormessage, 5);{} clear error{} FI;{} old menufootnote;{} enable stop;{} cursor off{}END PROC fuehre operation aus;{}PROC veraendere aktivierung (TEXT CONST unterpunkt, BOOL CONST eintrag):{} INT VAR unterpunktposition :: 0, zeiger;{} suche unterpunkt;{} aendere aktivierung.{} suche unterpunkt:{} FOR zeiger FROM 1 UPTO untermenuende REP{} IF untermenupunkt = blank + compress (unterpunkt){} THEN unterpunktposition := zeiger;{} LEAVE suche unterpunkt{} + FI{} PER;{} LEAVE veraendere aktivierung.{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} untermenupunkt:{} aktuelles untermenu.menupunkt [zeiger].punktname.{} aendere aktivierung:{} aktuelles untermenu.menupunkt [unterpunktposition].aktiv := eintrag.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere aktivierung;{} +PROC veraendere aktivierung (INT CONST punktnummer, BOOL CONST eintrag):{} IF punktnummer >= 1 AND punktnummer <= untermenuende{} THEN aktuelles untermenu.menupunkt [punktnummer].aktiv := eintrag{} FI.{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere aktivierung;{}PROC veraendere anwahl (TEXT CONST unterpunkt, BOOL CONST eintrag):{} + INT VAR unterpunktposition :: 0, zeiger;{} suche unterpunkt;{} aendere anwahl.{} suche unterpunkt:{} FOR zeiger FROM 1 UPTO untermenuende REP{} IF untermenupunkt = blank + compress (unterpunkt){} THEN unterpunktposition := zeiger;{} LEAVE suche unterpunkt{} FI{} PER;{} enable stop;{} errorstop (fehlermeldung [10]).{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} untermenupunkt:{} aktuelles untermenu.menupunkt [zeiger].punktname.{} + aendere anwahl:{} aktuelles untermenu.menupunkt [unterpunktposition].angewaehlt := eintrag.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere anwahl;{}PROC activate (TEXT CONST unterpunkt):{} enable stop;{} veraendere aktivierung (unterpunkt, TRUE){}END PROC activate;{}PROC activate (INT CONST punktnummer):{} enable stop;{} veraendere aktivierung (punktnummer, TRUE){} +END PROC activate;{}PROC deactivate (TEXT CONST unterpunkt):{} enable stop;{} veraendere aktivierung (unterpunkt, FALSE){}END PROC deactivate;{}PROC deactivate (INT CONST punktnummer):{} enable stop;{} veraendere aktivierung (punktnummer, FALSE){}END PROC deactivate;{}PROC select (TEXT CONST unterpunkt):{} enable stop;{} veraendere anwahl (unterpunkt, TRUE){}END PROC select;{}PROC deselect (TEXT CONST unterpunkt):{} enable stop;{} veraendere anwahl (unterpunkt, FALSE){}END PROC deselect;{} +PROC schliesse menu:{} IF aktuelles menu.menuausgangsprozedur <> ""{} THEN menufootnote (hinweis [3]);{} fuehre operation aus (aktuelles menu.menuausgangsprozedur){} FI;{} anzahl offener menus DECR 1;{} IF anzahl offener menus = 1{} THEN aktiviere das auf eis gelegte menu{} FI.{} aktiviere das auf eis gelegte menu:{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1, 1, 79, 24);{} show menu.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} +END PROC schliesse menu;{}PROC refresh submenu:{} schreibe aktuelles untermenu auf bildschirm;{} show menunotice;{}END PROC refresh submenu;{}PROC regenerate menuscreen:{} IF anzahl offener menus = 0{} THEN errorstop (fehlermeldung [8]){} ELIF anzahl offener menus = 1{} THEN page;{} show menu;{} show menunotice{} ELSE zeige erstes menu an;{} zeige zweites menu an;{} show menunotice{} FI.{} zeige erstes menu an:{} INT VAR menuzeiger :: menuleiste.zeigeraktuell;{} + menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1, 1, 79, 24);{} anzahl offener menus := 1;{} show menu.{} zeige zweites menu an:{} menuleiste.zeigeraktuell := menuzeiger;{} menuwindow := window (6, 4, 73, 20);{} anzahl offener menus := 2;{} show menu.{}END PROC regenerate menuscreen;{}PROC menuinfo (TEXT CONST t, INT CONST position, timelimit):{} boxinfo (menuwindow, t, position, timelimit, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{} + old menufootnote{}END PROC menuinfo;{}PROC menuinfo (TEXT CONST t, INT CONST position):{} menuinfo (t, position, maxint){}END PROC menuinfo;{}PROC menuinfo (TEXT CONST t):{} menuinfo (t, 5, maxint){}END PROC menuinfo;{}INT PROC menualternative (TEXT CONST t, auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch):{} INT VAR ergebnis := boxalternative (menuwindow, t, auswahlliste,{} zusatztasten, position, mit abbruch, FALSE);{} + schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} ergebnis{}END PROC menualternative;{}BOOL PROC menuyes (TEXT CONST frage, INT CONST position):{} BOOL VAR wert := boxyes (menuwindow, frage, position, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} wert{}END PROC menuyes;{}BOOL PROC menuno (TEXT CONST frage, INT CONST position):{} NOT menuyes (frage, position){}END PROC menuno;{}TEXT PROC menuone (THESAURUS CONST thes, TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{} + TEXT CONST wert :: boxone (menuwindow, thes, t1, t2, mit reinigung);{} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuone;{}THESAURUS PROC menusome (THESAURUS CONST thes, TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{} THESAURUS CONST thesaurus :: boxsome (menuwindow, thes, t1, t2,{} mit reinigung);{} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} + old menufootnote{} FI;{} thesaurus{}END PROC menusome;{}TEXT PROC menuanswer (TEXT CONST t, vorgabe, INT CONST position):{} TEXT VAR wert :: boxanswer (menuwindow, t, vorgabe, position, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} wert{}END PROC menuanswer;{}TEXT PROC menuanswerone (TEXT CONST t, vorgabe, THESAURUS CONST thes,{} TEXT CONST t1, t2, BOOL CONST mit reinigung):{} TEXT VAR wert :: boxanswerone (menuwindow, t, vorgabe, thes, t1, t2,{} + mit reinigung, FALSE){} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuanswer one;{}THESAURUS PROC menuanswersome (TEXT CONST t, vorgabe, THESAURUS CONST thes,{} TEXT CONST t1, t2, BOOL CONST mit reinigung):{} THESAURUS VAR wert :: boxanswersome (menuwindow, t, vorgabe,{} thes, t1, t2, mit reinigung, FALSE){} + IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuanswersome;{}PROC menufootnote (TEXT CONST t):{} cursor (menuwindow, 1, areaysize (menuwindow) - 1);{} areaxsize (menuwindow) TIMESOUT waagerecht;{} cursor (menuwindow, 1, areaysize (menuwindow));{} outtext (t, 1, areaxsize (menuwindow)){}END PROC menufootnote;{}PROC old menufootnote:{} menufootnote (permanent footnote){}END PROC old menufootnote;{}TEXT PROC menubasistext (INT CONST nummer):{} + IF nummer <= 20{} THEN fehlermeldung [12]{} ELIF nummer > menuleiste.menutext.anzahl menutexte{} THEN fehlermeldung [11]{} ELSE menuleiste.menutext.platz [nummer]{} FI{}END PROC menubasistext;{}TEXT PROC anwendungstext (INT CONST nummer):{} IF nummer > menuleiste.infotext.anzahl infotexte{} THEN fehlermeldung [11]{} ELSE menuleiste.infotext.stelle [nummer]{} FI{}END PROC anwendungstext;{}PROC zeige menukennung:{} IF anzahl offener menus = 0{} THEN zeige angaben und emblem;{} + FI.{} zeige angaben und emblem:{} ROW 5 WINDOW VAR w;{} w [ 1] := window (40, 3, 30, 9);{} w [ 2] := window (36, 5, 30, 9);{} w [ 3] := window (30, 7, 30, 9);{} w [ 4] := window (22, 9, 30, 9);{} w [ 5] := window (12, 11, 30, 9);{} page;{} show (w [1]); out (w [1], center (w [1], invers (systemkuerzel)));{} show (w [2]); out (w [2], " Version " + versionsnummer);{} show (w [3]); out (w [3], copyright1);{} show (w [4]); out (w [4], copyright2);{} show (w [5]);{} + cursor (w [5], 1, 2);out (w [5], " lll sssssssss ");{} cursor (w [5], 1, 3);out (w [5], " lll sss sss ");{} cursor (w [5], 1, 4);out (w [5], " lll sss ");{} cursor (w [5], 1, 5);out (w [5], " lll sssssssss ");{} cursor (w [5], 1, 6);out (w [5], " lll sss ");{} cursor (w [5], 1, 7);out (w [5], " lll latta soft sss ");{} cursor (w [5], 1, 8);out (w [5], " lllllllll sssssssss ");{} cursor (79, 24);{} + zeitpunkt := clock (1);{}END PROC zeige menukennung;{}PROC reset dialog:{} angekoppelte menutafel := "";{} anzahl offener menus := 0{}END PROC reset dialog;{}PROC write permanent footnote (TEXT CONST t):{} permanent footnote := t;{} cursor (menuwindow, 1, areaysize (menuwindow));{} outtext (t, 1, areaxsize (menuwindow)){}END PROC write permanent footnote;{}PROC write menunotice (TEXT CONST t, INT CONST position):{} erase menunotice;{} boxnotice (menuwindow, t, position, menunotizx, menunotizy,{} + menunotizxsize, menunotizysize);{} menunotiztext := t;{} menunotizposition := position;{} menunotiz ist gesetzt := TRUE{}END PROC write menunotice;{}PROC show menunotice:{} IF menunotiz ist gesetzt{} THEN boxnotice (menuwindow, menunotiztext, menunotizposition,{} menunotizx, menunotizy, menunotizxsize, menunotizysize);{} FI{}END PROC show menunotice;{}PROC erase menunotice:{} INT VAR spa, zei;{} get cursor (spa, zei);{} + IF menunotiz ist gesetzt{} THEN page up (menunotizx, menunotizy, menunotizxsize, menunotizysize);{} menunotiz ist gesetzt := FALSE;{} cursor (spa, zei){} FI{}END PROC erase menunotice;{}PROC initialize menuwindow:{} schreibfenster := window (areax (menuwindow) + 1,{} areay (menuwindow) + 3,{} areaxsize (menuwindow) - 2,{} areaysize (menuwindow) - 4){}END PROC initialize menuwindow;{} +PROC show menuwindow:{} initialize menuwindow;{} show (schreibfenster);{}END PROC show menuwindow;{}PROC menuwindow page:{} initialize menuwindow;{} page (schreibfenster){}END PROC menuwindow page;{}PROC menuwindowout (TEXT CONST text):{} out (schreibfenster, text){}END PROC menuwindow out;{}PROC menuwindowget (TEXT VAR text):{} get (schreibfenster, text){}END PROC menuwindowget;{}PROC menuwindoweditget (TEXT VAR text):{} editget (schreibfenster, text){}END PROC menuwindoweditget;{}PROC menuwindowedit (TEXT CONST dateiname):{} + initialize menuwindow;{} edit (schreibfenster, dateiname){}END PROC menuwindowedit;{}PROC menuwindowedit (FILE VAR f):{} initialize menuwindow;{} edit (schreibfenster, f){}END PROC menuwindowedit;{}PROC menuwindowshow (TEXT CONST dateiname):{} initialize menuwindow;{} show (schreibfenster, dateiname){}END PROC menuwindowshow;{}PROC menuwindowshow (FILE VAR f):{} initialize menuwindow;{} show (schreibfenster, f){}END PROC menuwindowshow;{}BOOL PROC menuwindowyes (TEXT CONST frage):{} yes (schreibfenster, frage){} +END PROC menuwindowyes;{}BOOL PROC menuwindowno (TEXT CONST frage):{} no (schreibfenster, frage){}END PROC menuwindowno;{}PROC menuwindowline:{} menuwindowline (1){}END PROC menuwindowline;{}PROC menuwindowline (INT CONST anzahl):{} line (schreibfenster, anzahl){}END PROC menuwindowline;{}PROC menuwindowcursor (INT CONST spa, zei):{} cursor (schreibfenster, spa, zei){}END PROC menuwindowcursor;{}PROC get menuwindowcursor (INT VAR spa, zei):{} get cursor (schreibfenster, spa, zei){}END PROC get menuwindowcursor;{} +INT PROC remaining menuwindowlines:{} remaining lines (schreibfenster){}END PROC remaining menuwindowlines;{}TEXT PROC menuwindowcenter (TEXT CONST t):{} center (schreibfenster, t){}END PROC menuwindowcenter;{}PROC menuwindowstop:{} menuwindowstop (2){}END PROC menuwindowstop;{}PROC menuwindowstop (INT CONST anzahl):{} stop (schreibfenster, anzahl){}END PROC menuwindowstop;{}WINDOW PROC current menuwindow:{} initialize menuwindow;{} schreibfenster{}END PROC current menuwindow;{}PROC stdinfoedit (FILE VAR f, INT CONST oberste zeile):{} + IF oberste zeile < 1 OR oberste zeile > 3{} THEN errorstop (fehlermeldung [13]);{} FI;{} garantiere menukarte;{} cursor (1, oberste zeile); out (cleop);{} cursor (1, 23); out(79 * waagerecht);{} cursor (1, 24); outtext (menubasistext (141), 1, 79);{} editorinfofenster := window (1, oberste zeile + 1, 79, 24 - oberste zeile);{} kommando auf taste legen ("?", "editorinformationen");{} command dialogue (FALSE);{} cursor on; edit (f, 1, oberste zeile, 79, 23 - oberste zeile);{} command dialogue (TRUE);{} + kommando auf taste legen ("?", "").{} garantiere menukarte:{} TEXT VAR name := compress (menukartenname);{} IF name = ""{} THEN install menu (stdmenukartenname, FALSE){} FI.{}END PROC stdinfoedit;{}PROC stdinfoedit (FILE VAR f):{} stdinfoedit (f, 1){}END PROC stdinfoedit;{}PROC stdinfoedit (TEXT CONST dateiname, INT CONST oberste zeile):{} FILE VAR f :: sequential file (modify, dateiname);{} stdinfoedit (f, oberste zeile);{}END PROC stdinfoedit;{}PROC stdinfoedit (TEXT CONST dateiname):{} + stdinfoedit (dateiname, 1){}END PROC stdinfoedit;{}PROC editorinformationen:{} BOOL VAR ende gewuenscht :: FALSE; INT VAR z;{} FOR z FROM startwert UPTO 22 REP{} cursor (1, z); out (cleol);{} PER;{} REP{} INT VAR erg := boxalternative (editorinfofenster,{} menubasistext (149),{} menubasistext (150),{} menubasistext (151),{} 5, FALSE, FALSE);{} erfuelle den wunsch{} + UNTIL ende gewuenscht PER;{} cursor (2, 23); 77 TIMESOUT waagerecht;{} cursor (1, 24); outtext (menubasistext (141), 1, 79).{} startwert:{} areay (editorinfofenster) + 1.{} erfuelle den wunsch:{} SELECT erg OF{} CASE 1, 101, 109: boxinfo (editorinfofenster, menubasistext (142), 5, maxint, FALSE){} CASE 2, 102, 110: boxinfo (editorinfofenster, menubasistext (143), 5, maxint, FALSE){} CASE 3, 103, 111: boxinfo (editorinfofenster, menubasistext (144), 5, maxint, FALSE){} CASE 4, 104, 112: boxinfo (editorinfofenster, menubasistext (145), 5, maxint, FALSE){} + CASE 5, 105, 113: boxinfo (editorinfofenster, menubasistext (146), 5, maxint, FALSE){} CASE 6, 106, 114: boxinfo (editorinfofenster, menubasistext (147), 5, maxint, FALSE){} CASE 7, 107, 115: boxinfo (editorinfofenster, menubasistext (148), 5, maxint, FALSE){} CASE 8, 108, 116: ende gewuenscht := TRUE{} OTHERWISE (*tue nichts*){} END SELECT{}END PROC editorinformationen;{}PROC bereinige situation:{} page;{} forget (ds);{} reset dialog{}END PROC bereinige situation;{} +PROC direktstart (TEXT CONST procname, BOOL CONST autoloeschen):{} TEXT VAR datname := "Selbststartergenerierungsdatei", letzter := std;{} kopple archivmenukarte an;{} schreibe programm;{} insertiere programm;{} abkoppeln.{} kopple archivmenukarte an:{} install menu (stdmenukartenname, FALSE).{} schreibe programm:{} forget (datname, quiet);{} FILE VAR f :: sequential file (output, datname);{} putline (f, menubasistext (191));{} putline (f, "do (""reset dialog; erase menunotice; " + procname + """);");{} + putline (f, menubasistext (192));{} IF autoloeschen{} THEN putline (f, menubasistext (193)){} ELSE putline (f, menubasistext (194)){} FI;{} putline (f, menubasistext (195));{} putline (f, menubasistext (196)).{} insertiere programm:{} TEXT VAR t := "insert (""" + datname + """)"; do (t).{} abkoppeln:{} forget (datname, quiet); last param (letzter);{} reset dialog;{} global manager.{}END PROC direktstart;{}END PACKET ls dialog 5;{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 6 b/app/gs.dialog/1.2/src/ls-DIALOG 6 new file mode 100644 index 0000000..b27eae2 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG 6 @@ -0,0 +1,102 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG 6 ** + ** Archiv-/Taskhandling ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls dialog 6 DEFINES{} menu archiv notizort setzen,{} menu archiv grundeinstellung,{} menu archiv zieltask einstellen,{} menu archiv zieltask aendern,{} menu archiv reservieren,{} menu archiv neue diskette,{} menu archiv schreiben,{} menu archiv checken,{} menu archiv schreibcheck,{} menu archiv holen,{} menu archiv loeschen,{} menu archiv verzeichnis,{} menu archiv verzeichnis drucken,{} menu archiv initialisieren,{} + menu archiv reservierung aufgeben,{} archiv:{}LET menukartenname = "ls-MENUKARTE:Archiv";{}LET ack = 0,{} schreiben = 1,{} checken = 2,{} schreibcheck = 3,{} holen = 4,{} loeschen = 5,{} list code = 15,{} reserve code = 19;{}BOOL VAR zieltask ist archivmanager :: TRUE,{} archiv gehoert mir :: FALSE,{} fehlerfall :: FALSE,{} kontakt mit zieltask erfolgt :: FALSE;{} +TEXT VAR zieltaskname :: "ARCHIVE",{} aktueller archivname :: "";{}INT VAR stationsnummer :: station (myself),{} letzte funktion :: 11,{} notizort :: 3;{}PROC archiv:{} install menu (menukartenname, FALSE);{} handle menu ("ARCHIV"){}END PROC archiv;{}PROC melde zieltaskerror (TEXT CONST meldung):{} IF meldung = menubasistext (47){} THEN menuinfo (menubasistext (123)){} ELIF meldung = menubasistext (46){} + THEN menuinfo (menubasistext (124)){} ELIF pos (meldung, "inkonsistent") > 0{} THEN menuinfo (menubasistext (125)){} ELIF pos (meldung, "Lesen unmoeglich") > 0{} COR pos (meldung, "Schreiben unmoeglich") > 0{} THEN menuinfo (menubasistext (126)){} ELIF pos (meldung, "Archiv heisst") > 0 AND pos (meldung, "?????") > 0{} THEN menuinfo (menubasistext (127)){} ELIF pos (meldung, "Archiv heisst") > 0{} THEN menuinfo (menubasistext (128)){} ELIF pos (meldung, "Schreibfehler") > 0 CAND pos (meldung, "Archiv") > 0{} + THEN menuinfo (menubasistext (129)){} ELIF pos (meldung, "Lesefehler") > 0{} THEN menuinfo (menubasistext (130)){} ELIF pos (meldung, "Kommando") > 0 AND pos (meldung, "unbekannt") > 0{} THEN menuinfo (menubasistext (131)){} ELIF pos (meldung, "falscher Auftrag fuer Task") > 0{} THEN menuinfo (menubasistext (132)){} ELIF meldung = menubasistext (41){} THEN menuinfo (menubasistext (133)){} ELIF meldung = menubasistext (42){} THEN menuinfo (menubasistext (134)){} + ELIF pos (meldung, "Collector") > 0 AND pos(meldung, "fehlt") > 0{} THEN menuinfo (menubasistext (135)){} ELIF pos (meldung, "kein Zugriffsrecht auf Task") > 0{} THEN menuinfo (menubasistext (132)){} ELIF pos (meldung, "nicht initialisiert") > 0{} THEN menuinfo (menubasistext (136)){} ELIF pos (meldung, "ungueltiger Format-Code") > 0{} THEN menuinfo (menubasistext (137)){} ELSE menuinfo (invers (meldung)){} FI{}END PROC melde zieltaskerror;{}PROC menu archiv notizort setzen (INT CONST wert):{} + SELECT wert OF{} CASE 1,2,3,4,5 : notizort := wert{} OTHERWISE notizort := 3{} END SELECT{}END PROC menu archiv notizort setzen;{}PROC menu archiv grundeinstellung (INT CONST ort):{} menu archiv zieltask aendern ("ARCHIVE", station (myself), TRUE);{} menu archiv notizort setzen (ort);{} zieltask anzeigen{}END PROC menu archiv grundeinstellung;{}PROC menu archiv zieltask einstellen:{} TEXT VAR taskname :: "";{} INT VAR stationsnr, auswahl;{} BOOL VAR ist amanager;{} erfrage daten;{} + kontrolliere daten;{} menu archiv zieltask aendern (taskname, stationsnr, ist amanager);{} refresh submenu;{} zieltask anzeigen.{} erfrage daten:{} auswahl := menualternative (menubasistext (51), menubasistext (52),{} menubasistext (53), 5, TRUE);{} SELECT auswahl OF{} CASE 1, 101 : menu archiv zieltask aendern{} ("ARCHIVE", station (myself), TRUE );{} ausstieg{} CASE 2, 102 : menu archiv zieltask aendern{} + (name (father), station (myself), FALSE);{} ausstieg{} CASE 3, 103 : menu archiv zieltask aendern{} ("PUBLIC", station (myself), FALSE);{} ausstieg{} CASE 4, 104 : handeinstellung{} OTHERWISE ausstieg{} END SELECT.{} ausstieg:{} refresh submenu;{} zieltask anzeigen;{} LEAVE menu archiv zieltask einstellen.{} handeinstellung:{} taskname := menuanswer (menubasistext (81), zieltaskname, 5);{} + stationsnr := int (menuanswer (menubasistext (82),{} text (station (myself)), 5));{} ist amanager := menuyes (menubasistext (83), 5).{} kontrolliere daten:{} IF compress (taskname) = ""{} OR compress (taskname) = "-"{} OR taskname = name (myself){} THEN menuinfo (menubasistext (64));{} LEAVE menu archiv zieltask einstellen{} FI.{}END PROC menu archiv zieltask einstellen;{}PROC menu archiv zieltask aendern (TEXT CONST taskname,{} + INT CONST stationsnr,{} BOOL CONST ist archivmanager):{} menufootnote (menubasistext (21) + menubasistext (23));{} gib ggf archiv frei;{} IF ist archivmanager{} THEN archivmanager einstellen{} ELSE sonstige task einstellen{} FI;{} aktiviere gueltige archivmenupunkte.{} gib ggf archiv frei:{} IF archiv gehoert mir{} THEN archivreservierung aufgeben{} FI.{} archivmanager einstellen:{} zieltask ist archivmanager := TRUE;{} + zieltaskname := taskname;{} stationsnummer := stationsnr;{} kontakt mit zieltask erfolgt := FALSE;{} aktueller archivname := "";{} archiv gehoert mir := FALSE;{} letzte funktion := 11.{} sonstige task einstellen:{} zieltask ist archivmanager := FALSE;{} zieltaskname := taskname;{} stationsnummer := stationsnr;{} aktueller archivname := "";{} archiv gehoert mir := FALSE;{} + letzte funktion := 6.{}END PROC menu archiv zieltask aendern;{}PROC menu archiv reservieren:{} TEXT VAR archivname :: "", meldung :: "";{} kontrolliere einstellung;{} menufootnote (menubasistext (21) + menubasistext (24));{} versuche archiv zu reservieren (meldung);{} werte meldung aus;{} archiv anmelden (archivname, meldung, TRUE);{} IF archivname = ""{} THEN behandle archivfehler{} ELSE aktueller archivname := archivname{} FI;{} aktiviere gueltige archivmenupunkte;{} + refresh submenu;{} zieltask anzeigen.{} kontrolliere einstellung:{} IF NOT zieltask ist archivmanager{} THEN aktiviere gueltige archivmenupunkte;{} refresh submenu;{} LEAVE menu archiv reservieren{} ELIF NOT kontakt mit zieltask erfolgt{} THEN versuche kontakt herzustellen{} FI.{} versuche kontakt herzustellen:{} TEXT VAR fehler :: "";{} IF NOT task ist kommunikativ (fehler){} THEN melde zieltaskerror (fehler);{} melde rigoros ab;{} + LEAVE menu archiv reservieren{} ELSE kontakt mit zieltask erfolgt := TRUE{} FI.{} werte meldung aus:{} IF meldung <> ""{} THEN melde zieltaskerror (meldung);{} melde rigoros ab;{} LEAVE menu archiv reservieren{} FI.{} behandle archivfehler:{} melde zieltaskerror (meldung);{} archivreservierung aufgeben;{} melde rigoros ab{}END PROC menu archiv reservieren;{}PROC melde rigoros ab:{} aktueller archivname := "";{} archiv gehoert mir := FALSE;{} + kontakt mit zieltask erfolgt := FALSE{}END PROC melde rigoros ab;{}PROC versuche archiv zu reservieren (TEXT VAR fehler):{} IF NOT kontakt mit zieltask erfolgt{} THEN fehler := menubasistext (44);{} archiv gehoert mir := FALSE;{} LEAVE versuche archiv zu reservieren{} FI;{} disable stop;{} IF eigene station{} THEN reserve ("beknackter archivename",/zieltaskname ){} ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname){} FI;{} IF is error{} THEN fehler := errormessage;{} + melde rigoros ab;{} clear error{} ELSE archiv gehoert mir := TRUE;{} fehler := "";{} FI;{} enable stop{}END PROC versuche archiv zu reservieren;{}PROC archiv anmelden (TEXT VAR archivname, fehler, BOOL CONST mit anfrage):{} ueberpruefe archivbesitz;{} fuehre archivanmeldung aus.{} ueberpruefe archivbesitz:{} IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt{} THEN fehler := menubasistext (45);{} melde rigoros ab;{} LEAVE archiv anmelden{} + FI.{} fuehre archivanmeldung aus:{} IF mit anfrage{} THEN frage nach eingelegter diskette und melde an{} ELSE melde archiv unter richtigem namen an{} FI.{} frage nach eingelegter diskette und melde an:{} IF menuyes (menubasistext (84), 5){} THEN menufootnote (menubasistext (21) + menubasistext (25));{} melde archiv unter richtigem namen an{} ELSE fehler := menubasistext (46);{} aktueller archivname := "";{} LEAVE archiv anmelden{} + FI.{} melde archiv unter richtigem namen an:{} disable stop;{} IF eigene station{} THEN reserve ("beknackter archivename",/zieltaskname);{} list (/zieltaskname);{} ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname);{} list (stationsnummer/zieltaskname){} FI;{} IF is error{} THEN fehler := errormessage;{} behandle die fehlermeldung{} ELSE archivname := "beknackter archivename";{} fehler := "";{} enable stop{} + FI.{} behandle die fehlermeldung:{} IF subtext (fehler, 1, 14) = menubasistext (61){} CAND subtext (fehler, 16, 20) <> menubasistext (62){} THEN clear error; enable stop;{} archivname := subtext (fehler, 16, length (fehler) - 1);{} melde archiv nun wirklich richtig an;{} fehler := "";{} enable stop{} ELIF subtext (fehler, 1, 14) = menubasistext (61){} CAND subtext (fehler, 16, 20) = menubasistext (62){} THEN clear error; enable stop;{} + archivname := "";{} fehler := menubasistext (62){} ELSE clear error; enable stop;{} archivname := ""{} FI.{} melde archiv nun wirklich richtig an:{} IF eigene station{} THEN reserve (archivname,/zieltaskname);{} ELSE reserve (archivname, stationsnummer/zieltaskname){} FI.{}END PROC archiv anmelden;{}PROC menu archiv neue diskette:{} ueberpruefe reservierung;{} melde neue diskette an.{} ueberpruefe reservierung:{} IF NOT (archiv gehoert mir AND kontakt mit zieltask erfolgt){} + THEN melde zieltaskerror (menubasistext (47));{} LEAVE menu archiv neue diskette{} FI.{} melde neue diskette an:{} TEXT VAR archivname :: "", meldung :: "";{} menufootnote (menubasistext (21) + menubasistext (26));{} archiv anmelden (archivname, meldung, FALSE);{} IF archivname = ""{} THEN behandle archivfehler{} ELSE aktueller archivname := archivname{} FI;{} zieltask anzeigen.{} behandle archivfehler:{} melde zieltaskerror (meldung);{} aktueller archivname := "".{} +END PROC menu archiv neue diskette;{}PROC menu archiv schreiben:{} dateioperation mit zieltask (schreiben);{} regenerate menuscreen{}END PROC menu archiv schreiben;{}PROC menu archiv checken:{} dateioperation mit zieltask (checken);{} regenerate menuscreen{}END PROC menu archiv checken;{}PROC menu archiv schreibcheck:{} dateioperation mit zieltask (schreibcheck);{} regenerate menuscreen{}END PROC menu archiv schreibcheck;{}PROC menu archiv holen:{} dateioperation mit zieltask (holen);{} regenerate menuscreen{} +END PROC menu archiv holen;{}PROC menu archiv loeschen:{} dateioperation mit zieltask (loeschen);{} regenerate menuscreen{}END PROC menu archiv loeschen;{}PROC dateioperation mit zieltask (INT CONST wahl):{} ueberpruefe kommunikationsbasis und sinnhaftigkeit;{} lasse dateien auswaehlen;{} operiere mit ausgewaehlten dateien.{} ueberpruefe kommunikationsbasis und sinnhaftigkeit:{} IF unzulaessiger zieltaskname{} THEN LEAVE dateioperation mit zieltask{} ELIF zieltaskname = name (myself){} + THEN melde zieltaskerror (menubasistext (48));{} LEAVE dateioperation mit zieltask{} ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{} THEN melde zieltaskerror (menubasistext (47));{} LEAVE dateioperation mit zieltask{} ELIF NOT zieltask ist archivmanager{} AND (wahl = checken OR wahl = schreibcheck){} THEN gib hinweis auf unmoeglich;{} LEAVE dateioperation mit zieltask{} ELIF NOT zieltask ist archivmanager{} + THEN stelle kontakt mit zieltask her{} ELIF wahl < schreiben OR wahl > loeschen{} THEN LEAVE dateioperation mit zieltask{} FI.{} stelle kontakt mit zieltask her:{} TEXT VAR fehler :: "";{} IF task ist kommunikativ (fehler){} THEN kontakt mit zieltask erfolgt := TRUE{} ELSE melde zieltaskerror (fehler);{} LEAVE dateioperation mit zieltask{} FI.{} gib hinweis auf unmoeglich:{} menuinfo (menubasistext (121) + taskname + menubasistext (122)).{} + taskname:{} IF eigene station{} THEN zieltaskname{} ELSE text (stationsnummer) + "/" + zieltaskname{} FI.{} lasse dateien auswaehlen:{} THESAURUS VAR angekreuzte;{} disable stop;{} IF wahl = schreiben OR wahl = schreibcheck{} THEN angekreuzte := menusome (ALL myself, operationshinweis,{} ankreuzhinweis, FALSE){} ELSE angekreuzte := menusome (zieltaskthesaurus, operationshinweis,{} ankreuzhinweis, FALSE){} + FI;{} fehlerbehandlung.{} zieltaskthesaurus:{} IF eigene station{} THEN ALL /zieltaskname{} ELSE ALL (stationsnummer/zieltaskname){} FI.{} ankreuzhinweis:{} menubasistext (91) + operationskennzeichnung (wahl) + menubasistext (92).{} operationshinweis:{} operationsbezeichnung (wahl) + zieltaskhinweis.{} operiere mit ausgewaehlten dateien:{} bereite bildschirm vor;{} steige ggf bei leerem thesaurus aus;{} IF wahl = schreiben OR wahl = schreibcheck{} THEN zuerst loeschen{} + FI;{} IF wahl = schreibcheck{} THEN fehlerfall := FALSE;{} dateioperation ausfuehren (angekreuzte, schreiben, FALSE);{} IF NOT fehlerfall{} THEN dateioperation ausfuehren (angekreuzte, checken, TRUE){} FI{} ELSE dateioperation ausfuehren (angekreuzte, wahl, TRUE){} FI.{} bereite bildschirm vor:{} show menuwindow.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} + menuwindowstop;{} LEAVE dateioperation mit zieltask{} FI.{} zuerst loeschen:{} menuwindowout (menuwindowcenter (menubasistext (21) + menubasistext (31)));{} menuwindowline;{} IF not empty (angekreuzte){} THEN disable stop;{} THESAURUS CONST zu loeschende ::{} angekreuzte / zieltaskthesaurus;{} fehlerbehandlung;{} biete ggf dateien zum loeschen an{} ELSE menuwindowpage{} FI.{} biete ggf dateien zum loeschen an:{} + IF not empty (zu loeschende){} THEN menuwindowout (menuwindowcenter (invers (menubasistext (108))));{} menuwindowline;{} menuwindowout (menuwindowcenter (menubasistext (109)));{} menuwindowline (2);{} dateien rausschmeissen{} ELSE menuwindowpage{} FI.{} dateien rausschmeissen:{} command dialogue (FALSE);{} biete dateien einzeln zum loeschen an;{} menuwindowpage;{} command dialogue (TRUE).{} biete dateien einzeln zum loeschen an:{} + INT VAR z, index;{} FOR z FROM 1 UPTO highest entry (zu loeschende) REP{} disable stop;{} IF name (zu loeschende, z) <> ""{} THEN stelle frage und fuehre aus{} FI;{} fehlerbehandlung{} PER.{} stelle frage und fuehre aus:{} IF menuwindowyes ("'" + name (zu loeschende, z) + "' "{} + menubasistext (111)){} THEN erase (name (zu loeschende, z), task (zieltaskname)){} ELSE menuwindowout (menubasistext (110));{} menuwindowline;{} + delete (angekreuzte, name (zu loeschende, z), index);{} pause (20){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} melde zieltaskerror (errormessage);{} clear error; enable stop;{} LEAVE dateioperation mit zieltask{} FI.{}END PROC dateioperation mit zieltask;{}PROC dateioperation ausfuehren (THESAURUS CONST angekreuzte,{} INT CONST wahl,{} BOOL CONST mit schlussbemerkung):{} + INT VAR spalte :: 1, zeile :: 3, k, anzahl :: 0;{} menuwindowout (menuwindowcenter (invers (operationsbezeichnung (wahl){} + zieltaskhinweis)));{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} IF mit schlussbemerkung{} THEN schreibe schlussbemerkung{} ELSE menuwindowpage{} FI.{} fuehre einzelne operationen aus:{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) <> ""{} + THEN disable stop;{} bildschirmausgabe;{} operation ausfuehren;{} anzahl INCR 1;{} fehlerbehandlung{} FI{} PER.{} bildschirmausgabe:{} spalte := 1;{} IF remaining menuwindowlines < 2{} THEN menuwindowpage; zeile := 1{} ELSE zeile INCR 1{} FI;{} menuwindowcursor (spalte, zeile);{} ergaenzter dateiname.{} ergaenzter dateiname:{} INT VAR windowcolumn, windowrow;{} SELECT wahl OF{} CASE schreiben : menuwindowout (menubasistext (105) + dateiname){} + CASE checken : get menuwindowcursor (windowcolumn, windowrow);{} menuwindowout (dateiname + menubasistext (106));{} menuwindowcursor (windowcolumn, windowrow);{} CASE holen : menuwindowout (menubasistext (107) + dateiname){} END SELECT.{} dateiname:{} " """ + name (angekreuzte, k) + """ ".{} operation ausfuehren:{} IF eigene station{} THEN fuehre eigenstationoperation aus{} ELSE fuehre fremdstationoperation aus{} FI.{} + fuehre eigenstationoperation aus:{} SELECT wahl OF{} CASE schreiben : save (name (angekreuzte, k), /zieltaskname){} CASE checken : check (name (angekreuzte, k), /zieltaskname);{} bestaetige{} CASE holen : ueberschreiben erfragen eigene station{} CASE loeschen : loeschen erfragen eigene station{} END SELECT.{} ueberschreiben erfragen eigene station:{} IF exists (name (angekreuzte, k)){} THEN menuwindowline;{} IF menuwindowyes (dateiname + menubasistext (112)){} + THEN zeile INCR 2;{} menuwindowline;{} forget (name (angekreuzte, k), quiet);{} fetch (name (angekreuzte, k), /zieltaskname){} FI{} ELSE fetch (name (angekreuzte, k), /zieltaskname){} FI.{} loeschen erfragen eigene station:{} IF menuwindowyes (dateiname + menubasistext (111)){} THEN erase (name (angekreuzte, k), /zieltaskname){} FI.{} fuehre fremdstationoperation aus:{} SELECT wahl OF{} CASE schreiben : save (name (angekreuzte, k), ziel){} + CASE checken : check (name (angekreuzte, k), ziel); bestaetige{} CASE holen : ueberschreiben erfragen fremde station{} CASE loeschen : loeschen erfragen fremde station{} END SELECT.{} ueberschreiben erfragen fremde station:{} IF exists (name (angekreuzte, k)){} THEN menuwindowline;{} IF menuwindowyes (dateiname + menubasistext (112)){} THEN zeile INCR 2;{} menuwindowline;{} forget (name (angekreuzte, k), quiet);{} + fetch (name (angekreuzte, k), ziel){} FI{} ELSE fetch (name (angekreuzte, k), ziel){} FI.{} loeschen erfragen fremde station:{} IF menuwindowyes (dateiname + menubasistext (111)){} THEN erase (name (angekreuzte, k), ziel){} FI.{} ziel:{} stationsnummer/zieltaskname.{} bestaetige:{} IF NOT is error{} THEN menuwindowout (dateiname + menubasistext (114)){} FI.{} schreibe schlussbemerkung:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} + ELSE menuwindowline (2){} FI;{} IF anzahl > 0{} THEN menuwindowout (menubasistext (93) +{} operationskennzeichnung (wahl)){} ELSE menuwindowout (menubasistext (94)){} FI;{} menuwindowstop.{} fehlerbehandlung:{} IF is error{} THEN fehlerfall := TRUE;{} regenerate menuscreen;{} melde zieltaskerror (errormessage);{} clear error; enable stop;{} LEAVE dateioperation ausfuehren{} FI.{}END PROC dateioperation ausfuehren;{} +TEXT PROC operationsbezeichnung (INT CONST nr):{} SELECT nr OF{} CASE schreiben : menubasistext (95){} CASE checken : menubasistext (97){} CASE schreibcheck : menubasistext (99){} CASE holen : menubasistext (101){} CASE loeschen : menubasistext (103){} OTHERWISE ""{} END SELECT{}END PROC operationsbezeichnung;{}TEXT PROC operationskennzeichnung (INT CONST nr):{} SELECT nr OF{} CASE schreiben : menubasistext (96){} CASE checken : menubasistext (98){} + CASE schreibcheck : menubasistext (100){} CASE holen : menubasistext (102){} CASE loeschen : menubasistext (104){} OTHERWISE ""{} END SELECT{}END PROC operationskennzeichnung;{}BOOL PROC not empty (THESAURUS CONST t):{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} IF name (t, i) <> ""{} THEN LEAVE not empty WITH TRUE{} FI{} PER;{} FALSE{}END PROC not empty;{}TEXT PROC zieltaskhinweis:{} IF zieltaskname = "ARCHIVE"{} THEN "(" + menubasistext (78) + ")"{} + ELIF zieltaskname = name (father){} THEN "(" + menubasistext (79) + ")"{} ELSE menubasistext (80) + zieltaskname + ")"{} FI{}END PROC zieltaskhinweis;{}PROC menu archiv verzeichnis:{} forget("Interne Dateiliste bei Archivoperation", quiet);{} ueberpruefe kommunikationsbasis;{} liste dateien der zieltask auf;{} regenerate menuscreen.{} ueberpruefe kommunikationsbasis:{} IF unzulaessiger zieltaskname{} THEN LEAVE menu archiv verzeichnis{} ELIF zieltaskname = name (myself){} + THEN LEAVE ueberpruefe kommunikationsbasis{} ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{} THEN melde zieltaskerror (menubasistext (47));{} LEAVE menu archiv verzeichnis{} ELIF NOT zieltask ist archivmanager{} THEN stelle kontakt mit zieltask her{} FI.{} stelle kontakt mit zieltask her:{} TEXT VAR fehler :: "";{} IF task ist kommunikativ (fehler){} THEN kontakt mit zieltask erfolgt := TRUE{} ELSE melde zieltaskerror (fehler);{} + LEAVE menu archiv verzeichnis{} FI.{} liste dateien der zieltask auf:{} erstelle liste;{} gib liste aus;{} forget ("Interne Dateiliste bei Archivoperation", quiet).{} erstelle liste:{} menufootnote (menubasistext (21) + menubasistext (28));{} FILE VAR f :: sequential file (output, "Interne Dateiliste bei Archivoperation");{} disable stop;{} IF eigene station{} THEN list (f, /zieltaskname){} ELSE list (f, stationsnummer/zieltaskname){} FI;{} IF is error{} + THEN melde zieltaskerror (errormessage);{} forget ("Interne Dateiliste bei Archivoperation", quiet);{} clear error; enable stop;{} LEAVE menu archiv verzeichnis{} FI;{} enable stop.{} gib liste aus:{} modify (f);{} IF NOT (zieltaskname = name (myself)){} THEN to line (f, 1);{} insert record (f);{} notiere kopfzeile;{} headline (f, menubasistext (43));{} ELSE entferne eigenen namen aus der liste{} FI;{} + to line (f, 1);{} cursor on; menuwindowshow (f); cursor off.{} notiere kopfzeile:{} IF zieltask ist archivmanager{} THEN write record (f, headline (f));{} ELSE write record (f, zieltaskbezeichnung){} FI.{} entferne eigenen namen aus der liste:{} TEXT VAR zeile :: ""; INT VAR i;{} FOR i FROM lines (f) DOWNTO 1 REP{} to line (f, i);{} read record (f, zeile);{} IF pos (zeile, "Interne Dateiliste bei Archivoperation") > 0{} THEN delete record (f);{} + LEAVE entferne eigenen namen aus der liste{} FI{} PER{}END PROC menu archiv verzeichnis;{}PROC menu archiv verzeichnis drucken:{} forget ("Interne Dateiliste bei Archivoperation", quiet);{} ueberpruefe kommunikationsbasis;{} erstelle listing;{} drucke listing aus.{} ueberpruefe kommunikationsbasis:{} IF unzulaessiger zieltaskname{} THEN LEAVE menu archiv verzeichnis drucken{} ELIF zieltaskname = name (myself){} THEN LEAVE ueberpruefe kommunikationsbasis{} + ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{} THEN melde zieltaskerror (menubasistext (47));{} LEAVE menu archiv verzeichnis drucken{} ELIF NOT zieltask ist archivmanager{} THEN stelle kontakt mit zieltask her{} FI.{} stelle kontakt mit zieltask her:{} TEXT VAR fehler :: "";{} IF task ist kommunikativ (fehler){} THEN kontakt mit zieltask erfolgt := TRUE{} ELSE melde zieltaskerror (fehler);{} LEAVE menu archiv verzeichnis drucken{} + FI.{} erstelle listing:{} LET dummy name pos = 18;{} FILE VAR listfile; INT VAR i; TEXT VAR record :: "";{} TEXT CONST head :: 70 * "=", end :: 70 * "-";{} IF menuno (menubasistext (90), 5){} THEN LEAVE menu archiv verzeichnis drucken{} FI;{} menufootnote (menubasistext (21) + menubasistext (29));{} disable stop;{} listfile := sequential file (output, "Interne Dateiliste bei Archivoperation");{} IF eigene station{} THEN list (listfile, /zieltaskname){} ELSE list (listfile, stationsnummer/zieltaskname){} + FI;{} IF is error{} THEN melde zieltaskerror (errormessage);{} forget ("Interne Dateiliste bei Archivoperation", quiet);{} clear error; enable stop;{} LEAVE menu archiv verzeichnis drucken{} FI;{} enable stop.{} drucke listing aus:{} schreibe dateikopf;{} loesche dummy names;{} schreibe fuss;{} drucke und loesche listing.{} schreibe dateikopf:{} modify (listfile);{} to line (listfile, 1);{} FOR i FROM 1 UPTO 6 REP insert record (listfile) PER;{} + to line (listfile, 1);{} write record (listfile, "#type (""elanlist"")#"); down (listfile);{} write record (listfile, "#start (2.5,0.0)##limit (20,5)#"{} + "#pagelength (26.0)#"); down (listfile);{} write record (listfile, head); down (listfile);{} schreibe erkennungszeile; down (listfile);{} write record (listfile, " Listing vom " + date + ", "{} + time of day + " Uhr"); down (listfile);{} write record (listfile, head).{} + schreibe erkennungszeile:{} IF zieltask ist archivmanager{} THEN write record (listfile, "Archiv: " + headline (listfile)){} ELSE write record (listfile, "Task : " + taskbezeichnung){} FI.{} taskbezeichnung:{} IF eigene station{} THEN zieltaskname{} ELSE text (stationsnummer) + "/" + zieltaskname{} FI.{} loesche dummy names:{} to line (listfile, 8);{} WHILE NOT eof (listfile) REP{} read record (listfile, record);{} IF (record SUB dummy name pos) = "-"{} + OR pos (record, "Interne Dateiliste bei Archivoperation") > 0{} THEN delete record (listfile){} ELSE down (listfile){} FI{} PER.{} schreibe fuss:{} output (listfile);{} putline (listfile, end).{} drucke und loesche listing:{} menufootnote (menubasistext (21) + menubasistext (30));{} disable stop;{} print ("Interne Dateiliste bei Archivoperation");{} IF is error{} THEN melde zieltaskerror (errormessage);{} clear error; enable stop;{} + forget ("Interne Dateiliste bei Archivoperation", quiet);{} LEAVE menu archiv verzeichnis drucken{} FI;{} enable stop;{} forget ("Interne Dateiliste bei Archivoperation", quiet){}END PROC menu archiv verzeichnis drucken;{}TEXT PROC zieltaskbezeichnung:{} IF eigene station{} THEN menubasistext (77) + taskbezeichnung{} ELSE menubasistext (76) + text (stationsnummer) + " " +{} menubasistext (77) + zieltaskname{} FI.{} taskbezeichnung:{} IF zieltaskname = "ARCHIVE"{} + THEN menubasistext (78){} ELIF zieltaskname = name (father){} THEN menubasistext (79) + " (" + zieltaskname + ")"{} ELSE zieltaskname{} FI{}END PROC zieltaskbezeichnung;{}BOOL PROC unzulaessiger zieltaskname:{} IF compress (zieltaskname) = "" OR compress (zieltaskname) = "-"{} THEN TRUE{} ELSE FALSE{} FI{}END PROC unzulaessiger zieltaskname;{}PROC menu archiv initialisieren:{} TEXT VAR archivname :: "", meldung :: "";{} klaere zieltaskart;{} formatiere ggf;{} + initialisiere ggf.{} klaere zieltaskart:{} IF NOT zieltask ist archivmanager{} THEN menuinfo (menubasistext (121) + zieltaskname +{} menubasistext (122));{} LEAVE menu archiv initialisieren{} FI.{} formatiere ggf:{} IF menuyes (menubasistext (85), 5){} THEN nimm archiv in beschlag;{} fuehre formatierung aus{} FI.{} nimm archiv in beschlag:{} stelle archivbesitz sicher;{} IF aktueller archivname <> ""{} THEN archivname := aktueller archivname{} + ELSE archivname := menubasistext (75){} FI;{} IF eigene station{} THEN reserve (archivname,/zieltaskname){} ELSE reserve (archivname, stationsnummer/zieltaskname){} FI;{} aktueller archivname := archivname;{} archiv gehoert mir := TRUE;{} zieltask anzeigen.{} stelle archivbesitz sicher:{} IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt{} THEN versuche kommunikation;{} versuche archiv zu reservieren (meldung);{} werte meldung aus{} + FI.{} versuche kommunikation:{} TEXT VAR fehler :: "";{} IF NOT task ist kommunikativ (fehler){} THEN melde zieltaskerror (fehler);{} melde rigoros ab;{} LEAVE menu archiv initialisieren{} ELSE kontakt mit zieltask erfolgt := TRUE{} FI.{} werte meldung aus:{} IF meldung <> ""{} THEN melde zieltaskerror (meldung);{} aktueller archivname := "";{} zieltask anzeigen;{} LEAVE menu archiv initialisieren{} FI.{} + fuehre formatierung aus:{} INT VAR auswahl :: menualternative (menubasistext (54),{} menubasistext (55),{} menubasistext (56), 5, TRUE);{} IF auswahl = 0{} THEN LEAVE fuehre formatierung aus{} FI;{} IF auswahl > 100{} THEN auswahl DECR 100{} FI;{} command dialogue (FALSE);{} disable stop;{} menufootnote (menubasistext (21) + menubasistext (27));{} IF eigene station{} THEN formatiere auf eigener station{} + ELSE formatiere auf fremder station{} FI;{} IF is error{} THEN melde zieltaskerror (errormessage);{} clear error; enable stop;{} command dialogue (TRUE);{} LEAVE formatiere ggf{} ELSE enable stop;{} command dialogue (TRUE);{} aktiviere gueltige archivmenupunkte;{} refresh submenu;{} zieltask anzeigen{} FI.{} formatiere auf eigener station:{} IF auswahl < 5{} THEN format (auswahl, /zieltaskname){} + ELSE format (/zieltaskname){} FI.{} formatiere auf fremder station:{} IF auswahl < 5{} THEN format (auswahl, stationsnummer/zieltaskname){} ELSE format (stationsnummer/zieltaskname){} FI.{} initialisiere ggf:{} stelle archivbesitz sicher;{} archiv anmelden (archivname, meldung, FALSE);{} IF archivname <> ""{} THEN aktueller archivname := archivname;{} archiv gehoert mir := TRUE;{} aktiviere gueltige archivmenupunkte;{} refresh submenu;{} + zieltask anzeigen;{} frage nach ueberschreiben{} ELIF meldung = menubasistext (63) OR meldung = menubasistext (62){} THEN frage nach initialisieren{} ELSE melde zieltaskerror (meldung);{} aktueller archivname := "";{} zieltask anzeigen;{} LEAVE menu archiv initialisieren{} FI.{} frage nach ueberschreiben:{} IF menuyes (menubasistext (86) + archivname + menubasistext (87), 5){} THEN erfrage neuen namen und initialisiere{} + ELSE LEAVE menu archiv initialisieren{} FI.{} frage nach initialisieren:{} IF menuyes (menubasistext (88), 5){} THEN erfrage neuen namen und initialisiere{} ELSE LEAVE menu archiv initialisieren{} FI.{} erfrage neuen namen und initialisiere:{} TEXT VAR neuer name := compress(menuanswer (menubasistext (89),{} aktueller archivname, 5));{} IF neuer name <> ""{} THEN archivname := neuer name{} ELIF neuer name = "" AND archivname = ""{} + THEN archivname := menubasistext (75){} FI;{} command dialogue (FALSE);{} disable stop;{} IF eigene station{} THEN reserve (archivname, /zieltaskname);{} clear (/zieltaskname){} ELSE reserve (archivname, stationsnummer/zieltaskname);{} clear (stationsnummer/zieltaskname){} FI;{} IF is error{} THEN melde zieltaskerror (errormessage);{} clear error; enable stop;{} command dialogue (TRUE);{} melde rigoros ab;{} + archivreservierung aufgeben;{} aktiviere gueltige archivmenupunkte;{} refresh submenu;{} zieltask anzeigen;{} LEAVE menu archiv initialisieren{} ELSE enable stop; command dialogue (TRUE);{} aktueller archivname := archivname;{} archiv gehoert mir := TRUE;{} aktiviere gueltige archivmenupunkte;{} refresh submenu;{} zieltask anzeigen{} FI{}END PROC menu archiv initialisieren;{}PROC archive (TEXT CONST archive name,task, INT CONST station):{} + call (reserve code, archive name, station/task){}END PROC archive;{}PROC menu archiv reservierung aufgeben:{} IF archiv gehoert mir{} THEN menufootnote (menubasistext (21) + menubasistext (22));{} archivreservierung aufgeben;{} FI;{} erase menunotice;{} old menufootnote{}END PROC menu archiv reservierung aufgeben;{}PROC archivreservierung aufgeben:{} command dialogue (FALSE);{} disable stop;{} IF eigene station{} THEN release (/zieltaskname){} ELSE release (stationsnummer/zieltaskname);{} + FI;{} IF is error{} THEN clear error{} FI;{} enable stop;{} command dialogue (TRUE);{} archiv gehoert mir := FALSE;{} aktueller archivname := ""{}END PROC archivreservierung aufgeben;{}BOOL PROC eigene station:{} IF stationsnummer = 0 OR stationsnummer = station (myself){} THEN TRUE{} ELSE FALSE{} FI{}END PROC eigene station;{}PROC aktiviere gueltige archivmenupunkte:{} IF zieltask ist archivmanager AND NOT archiv gehoert mir{} THEN aktiviere nur grundfunktionen{} + ELSE aktiviere alle momentan gueltigen punkte{} FI.{} aktiviere alle momentan gueltigen punkte:{} IF letzte funktion = 11{} THEN activate (1); activate (2);{} activate (4); activate (5); activate (6); activate (7); activate (8);{} activate (10); activate (11);{} activate (13); activate (14);{} ELIF letzte funktion = 6{} THEN deactivate (1); deactivate (2);{} activate (4); deactivate (5); deactivate (6); activate (7); activate (8);{} + activate (10); activate (11);{} deactivate (13); activate (14);{} FI.{} aktiviere nur grundfunktionen:{} activate (1); deactivate (2);{} deactivate (4); deactivate (5); deactivate (6); deactivate (7); deactivate (8);{} deactivate (10); deactivate (11);{} activate (13); activate (14).{}END PROC aktiviere gueltige archivmenupunkte;{}PROC zieltask anzeigen:{} IF zieltask ist archivmanager{} THEN schreibe taskname und archivname{} ELSE schreibe taskname{} + FI.{} schreibe taskname:{} write menunotice (menubasistext (59) + ""13"" + name der task, notizort).{} schreibe taskname und archivname:{} write menunotice (menubasistext (59) + ""13"" + name der task +{} ""13"" + menubasistext (60) + ""13"" + archivname,{} notizort).{} name der task:{} IF zieltaskname = "ARCHIVE" AND eigene station{} THEN " " + menubasistext (71){} ELIF zieltaskname = "PUBLIC" AND eigene station{} THEN " " + menubasistext (72){} + ELIF zieltaskname = name (father){} THEN " " + menubasistext (73){} ELSE " " + ggf gekuerzter zieltaskname{} FI.{} ggf gekuerzter zieltaskname:{} TEXT VAR interner name;{} IF eigene station{} THEN interner name := zieltaskname;{} ELSE interner name := text (stationsnummer) + "/" + zieltaskname{} FI;{} IF length (interner name) < 20{} THEN ""15"" + interner name + " "14""{} ELSE ""15"" + subtext (interner name, 1 , 18) + ".." + " "14""{} FI.{} + archivname:{} IF NOT archiv gehoert mir OR aktueller archivname = ""{} THEN " " + menubasistext (74){} ELSE " "15"" + ggf gekuerzter archivname + " "14""{} FI.{} ggf gekuerzter archivname:{} IF eigene station AND length (aktueller archivname) > 20{} THEN subtext (aktueller archivname, 1, 18) + ".."{} ELIF NOT eigene station AND length (aktueller archivname) > 17{} THEN subtext (aktueller archivname, 1, 15) + ".."{} ELSE aktueller archivname{} FI.{} +END PROC zieltask anzeigen;{}BOOL PROC task ist kommunikativ (TEXT VAR fehler):{} INT VAR antwort;{} DATASPACE VAR dummy space := nilspace;{} IF zieltask ist archivmanager{} THEN schicke reservierungscode{} ELSE schicke listcode{} FI.{} schicke reservierungscode:{} disable stop;{} IF eigene station{} THEN pingpong (/zieltaskname, reserve code, dummy space, antwort);{} ELSE pingpong (stationsnummer/zieltaskname, reserve code,{} dummy space, antwort){} + FI;{} werte antwort aus.{} schicke listcode:{} disable stop;{} IF eigene station{} THEN pingpong (/zieltaskname, list code, dummy space, antwort);{} ELSE pingpong (stationsnummer/zieltaskname, list code,{} dummy space, antwort){} FI;{} werte antwort aus.{} werte antwort aus:{} IF is error{} THEN clear error{} FI;{} BOUND TEXT VAR inhalt := dummy space;{} enable stop;{} IF antwort = 0 THEN fehler := ""{} ELIF antwort = -1 THEN fehler := menubasistext (41){} + ELIF antwort = -2 THEN fehler := menubasistext (42){} ELSE fehler := inhalt{} FI;{} forget (dummy space);{} IF antwort = ack{} THEN kontakt mit zieltask erfolgt := TRUE; TRUE{} ELSE kontakt mit zieltask erfolgt := FALSE; FALSE{} FI{}END PROC task ist kommunikativ;{}END PACKET ls dialog 6;{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 7 b/app/gs.dialog/1.2/src/ls-DIALOG 7 new file mode 100644 index 0000000..467f531 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG 7 @@ -0,0 +1,54 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG 7 ** + ** Dateihandling ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls dialog 7 DEFINES{} menu dateien verzeichnis,{} menu dateien loeschen,{} menu dateien drucken,{} menu dateien kopieren,{} menu dateien umbenennen,{} menu dateien speicherplatz,{} menu dateien aufraeumen:{}LET filetype = 1003,{} maxlaenge = 60,{} breite = 40,{} niltext = "";{}TEXT CONST dateibez :: "Dateiliste bei internen Operationen";{}PROC menu dateien verzeichnis:{} forget (dateibez, quiet);{} liste dateien auf;{} + regenerate menuscreen.{} liste dateien auf:{} erstelle liste;{} gib liste aus;{} forget (dateibez, quiet).{} erstelle liste:{} menufootnote (menubasistext (21) + menubasistext (28));{} FILE VAR f :: sequential file (output, dateibez);{} list (f); modify (f);{} headline (f, menubasistext (43));{} to line (f, 1); insert record (f);{} write record (f, menubasistext (161));{} entferne eigenen namen aus der liste.{} entferne eigenen namen aus der liste:{} TEXT VAR zeile :: ""; INT VAR i;{} + FOR i FROM lines (f) DOWNTO 1 REP{} to line (f, i); read record (f, zeile);{} IF pos (zeile, dateibez) > 0{} THEN delete record (f);{} LEAVE entferne eigenen namen aus der liste{} FI{} PER.{} gib liste aus:{} to line (f, 1); cursor on; menuwindowshow (f); cursor off{}END PROC menu dateien verzeichnis;{}PROC menu dateien loeschen:{} lasse dateien auswaehlen;{} loesche ausgewaehlte dateien;{} regenerate menuscreen.{} lasse dateien auswaehlen:{} IF NOT not empty (ALL myself){} + THEN noch keine datei;{} LEAVE menu dateien loeschen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} THESAURUS VAR angekreuzte :={} menuanswersome ( center (breite, invers (menubasistext(162))) +{} menubasistext (163), "", ALL myself,{} menubasistext (162), menubasistext (91) +{} menubasistext (104) + menubasistext (92), FALSE).{} loesche ausgewaehlte dateien:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} + menuwindowout (menuwindowcenter (invers (menubasistext (162))));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operation aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (menubasistext (93) + menubasistext (104));{} menuwindowstop.{} fuehre einzelne operation aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) = niltext{} THEN LEAVE fuehre einzelne operation aus{} + ELIF NOT exists (name (angekreuzte, k)){} THEN menuwindowout (" """ + name (angekreuzte, k) + """");{} menuwindowline;{} menuwindowout (menubasistext (188)); menuwindowline;{} LEAVE fuehre einzelne operation aus{} ELSE disable stop;{} IF menuwindowyes (" """ + name (angekreuzte, k) + """ "{} + menubasistext (111)){} THEN forget (name (angekreuzte, k), quiet){} FI;{} + fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE menu dateien loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} + THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE menu dateien loeschen{} FI{}END PROC menu dateien loeschen;{}PROC menu dateien drucken:{} lasse programme auswaehlen;{} drucke programme;{} regenerate menuscreen.{} lasse programme auswaehlen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} + THESAURUS VAR angekreuzte :={} menuanswersome ( center (breite, invers (menubasistext(164))) +{} menubasistext (163), "", ALL myself,{} menubasistext (164), menubasistext (91) +{} menubasistext (165) + menubasistext (92), FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (menubasistext (164))));{} menuwindowline (2);{} command dialogue (FALSE);{} + fuehre einzelne operation aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (menubasistext (93) + menubasistext (165));{} menuwindowstop.{} fuehre einzelne operation aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) = niltext{} THEN LEAVE fuehre einzelne operation aus{} ELIF NOT exists (name (angekreuzte, k)){} THEN menuwindowout (" """ + name (angekreuzte, k) + """");{} + menuwindowline;{} menuwindowout (menubasistext (188)); menuwindowline;{} LEAVE fuehre einzelne operation aus{} ELSE disable stop;{} menuwindowout ( " """ + name (angekreuzte, k) + """ "{} + menubasistext (166));{} menuwindowline;{} print (name (angekreuzte, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} + THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE menu dateien drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} + LEAVE menu dateien drucken{} FI.{}END PROC menu dateien drucken;{}PROC menu dateien kopieren:{} ermittle alten dateinamen;{} erfrage neuen dateinamen;{} kopiere ggf die datei.{} ermittle alten dateinamen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien kopieren{} ELSE hole den namen{} FI.{} hole den namen:{} TEXT VAR alter name :={} menuanswerone ( center (breite, invers (menubasistext(167))) +{} menubasistext (163), "", ALL myself,{} + menubasistext (167), menubasistext (168) +{} menubasistext (169) + menubasistext (170), TRUE);{} IF alter name = niltext{} THEN LEAVE menu dateien kopieren{} ELIF NOT exists (alter name){} THEN menuinfo (menubasistext (188));{} LEAVE menu dateien kopieren{} FI.{} erfrage neuen dateinamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + menubasistext (171) + bisheriger name{} + + menubasistext (172).{} ueberschrift:{} center (maxlaenge, invers (menubasistext (167))) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} kopiere ggf die datei:{} IF neuer name = niltext{} THEN menuinfo (invers (menubasistext (173)));{} LEAVE menu dateien kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE menu dateien kopieren{} ELSE copy (alter name, neuer name){} + FI.{} mache vorwurf:{} menuinfo (menubasistext (174)).{}END PROC menu dateien kopieren;{}PROC menu dateien umbenennen:{} ermittle alten dateinamen;{} erfrage neuen dateinamen;{} benenne ggf die datei um.{} ermittle alten dateinamen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien umbenennen{} ELSE hole den namen{} FI.{} hole den namen:{} TEXT VAR alter name :={} menuanswerone ( center (breite, invers (menubasistext(175))) +{} + menubasistext (163), "", ALL myself,{} menubasistext (175), menubasistext (168) +{} menubasistext (176) + menubasistext (170), TRUE);{} IF alter name = niltext{} THEN LEAVE menu dateien umbenennen{} ELIF NOT exists (alter name){} THEN menuinfo (menubasistext (188));{} LEAVE menu dateien umbenennen{} FI.{} erfrage neuen dateinamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} + ueberschrift + menubasistext (171) + bisheriger name{} + menubasistext (177).{} ueberschrift:{} center (maxlaenge, invers (menubasistext (175))) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} benenne ggf die datei um:{} IF neuer name = niltext{} THEN menuinfo (invers (menubasistext (173)));{} LEAVE menu dateien umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE menu dateien umbenennen{} + ELSE rename (alter name, neuer name){} FI.{} mache vorwurf:{} menuinfo (menubasistext (174)).{}END PROC menu dateien umbenennen;{}PROC menu dateien speicherplatz:{} lasse dateinamen auswaehlen;{} ermittle den speicherplatz;{} regenerate menuscreen.{} lasse dateinamen auswaehlen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien speicherplatz{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} THESAURUS VAR angekreuzte :={} + menuanswersome ( center (breite, invers (menubasistext(178))) +{} menubasistext (163), "", ALL myself,{} menubasistext (178), menubasistext (179), FALSE).{} ermittle den speicherplatz:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (menubasistext (178))));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operation aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} + menuwindowout (menubasistext (180));{} menuwindowstop.{} fuehre einzelne operation aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) = niltext{} THEN LEAVE fuehre einzelne operation aus{} ELIF NOT exists (name (angekreuzte, k)){} THEN menuwindowout (" """ + name (angekreuzte, k) + """");{} menuwindowline;{} menuwindowout (menubasistext (188)); menuwindowline;{} LEAVE fuehre einzelne operation aus{} + ELSE disable stop;{} menuwindowout ( " """ + name (angekreuzte, k) + """ "{} + menubasistext (181){} + speicherplatz (name (angekreuzte, k)));{} menuwindowline;{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} menuwindowstop;{} regenerate menuscreen;{} + LEAVE menu dateien speicherplatz{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE menu dateien speicherplatz{} FI.{}END PROC menu dateien speicherplatz;{}TEXT PROC speicherplatz (TEXT CONST dateiname):{} + DATASPACE VAR ds :: old (dateiname);{} INT CONST platz :: storage (ds);{} forget (ds);{} " " + text (platz) + menubasistext (182){}END PROC speicherplatz;{}PROC menu dateien aufraeumen:{} lasse dateinamen auswaehlen;{} raeume die dateien auf;{} regenerate menuscreen.{} lasse dateinamen auswaehlen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien aufraeumen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} THESAURUS VAR angekreuzte :={} + menuanswersome ( center (breite, invers (menubasistext(183))) +{} menubasistext (163), "", ALL myself,{} menubasistext (183), menubasistext (91) +{} menubasistext (184) + menubasistext (92), FALSE).{} raeume die dateien auf:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (menubasistext (183))));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operation aus;{} + command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (menubasistext (93) + menubasistext (184));{} menuwindowstop.{} fuehre einzelne operation aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) = niltext{} THEN LEAVE fuehre einzelne operation aus{} ELIF NOT exists (name (angekreuzte, k)){} THEN menuwindowout (" """ + name (angekreuzte, k) + """");{} menuwindowline;{} menuwindowout (menubasistext (188)); menuwindowline;{} + LEAVE fuehre einzelne operation aus{} ELIF dateityp ist ok{} THEN disable stop;{} menuwindowline;{} menuwindowout ( " """ + name (angekreuzte, k) + """ "{} + menubasistext (185) );{} menuwindowline; menuwindowout (" ");{} reorganize (name (angekreuzte, k));{} fehlerbehandlung{} ELSE menuwindowout ( " """ + name (angekreuzte, k) + """ "{} + menubasistext (186)){} + FI{} PER.{} dateityp ist ok:{} type (old (name (angekreuzte, k))) = filetype.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE menu dateien aufraeumen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} + FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE menu dateien aufraeumen{} FI.{}END PROC menu dateien aufraeumen;{}PROC noch keine datei:{} menuinfo (menubasistext ( 187)){}END PROC noch keine datei;{}END PACKET ls dialog 7;{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG MENUKARTEN MANAGER b/app/gs.dialog/1.2/src/ls-DIALOG MENUKARTEN MANAGER new file mode 100644 index 0000000..67799ea --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG MENUKARTEN MANAGER @@ -0,0 +1,28 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG ** + ** MENUKARTEN-MANAGER ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls dialog manager DEFINES{} ls dialog manager:{}LET fetch code = 11,{} save code = 12,{} exists code = 13,{} list code = 15,{} continue code = 100;{}LET mm taskname = "ls-MENUKARTEN",{} gibt es schon = "Die Task 'ls-MENUKARTEN' existiert schon!",{} verweis = "Unzulässiger Zugriff auf die Task 'ls-MENUKARTEN'!";{}PROC ls dialog manager:{} stelle richtigen tasknamen ein;{} global manager{} (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) ls dialog manager){} +END PROC ls dialog manager;{}PROC stelle richtigen tasknamen ein:{} IF name (myself) <> mm taskname{} THEN nimm umbenennung vor{} FI.{} nimm umbenennung vor:{} IF NOT exists task (mm taskname){} THEN rename myself (mm taskname){} ELSE errorstop (gibt es schon){} FI.{}END PROC stelle richtigen tasknamen ein;{}PROC ls dialog manager (DATASPACE VAR ds, INT CONST order, phase,{} TASK CONST order task):{} IF order task = supervisor{} OR order = fetch code{} + OR order = save code{} OR order = exists code{} OR order = list code{} OR order = continue code{} THEN free manager (ds, order, phase, order task){} ELSE errorstop (verweis){} FI{}END PROC ls dialog manager;{}END PACKET ls dialog manager;{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG MM-gen b/app/gs.dialog/1.2/src/ls-DIALOG MM-gen new file mode 100644 index 0000000..ef05853 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG MM-gen @@ -0,0 +1,27 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG ** + ** MENUKARTEN MANAGER ** + ** Generator-Programm ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +LET dateiname = "ls-DIALOG MENUKARTEN MANAGER",{} archivname = "gs-dialog";{}gib bildschirmhinweis;{}hole generatordatei vom archiv;{}insertiere die datei;{}do ("ls dialog manager").{}gib bildschirmhinweis:{} page;{} putline (" "15"ls-DIALOG MENUKARTEN MANAGER - Generierung "14"").{}hole generatordatei vom archiv:{} IF NOT exists (dateiname){} THEN cursor (1, 5); out (""4"");{} putline ("Bitte warten... Ich hole eine Datei von der Diskette!");{} archive (archivname);{} + fetch (dateiname, archive);{} release (archive){} FI.{}insertiere die datei:{} cursor (1, 5); out (""4"");{} putline ("Bitte warten... Ich insertiere!");{} check off; insert (dateiname); check on;{} forget ("ls-DIALOG MM/gen", quiet);{} forget (dateiname, quiet).{} + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG decompress b/app/gs.dialog/1.2/src/ls-DIALOG decompress new file mode 100644 index 0000000..96d9340 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG decompress @@ -0,0 +1,150 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG - DECOMPRESS ** + ** ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) +PACKET ls dialog decompress DEFINES + + komprimiere, + dekomprimiere: + +LET verweis = "Angegebene Datei existiert nicht!", + falscher typ = "Angegebenen Datei hat falschen Typ!", + filetype = 1003; + +PROC komprimiere (TEXT CONST dateiname): + INT VAR zeiger; + ueberpruefe existenz; + ueberpruefe dateityp; + initialisiere; + FOR zeiger FROM 1 UPTO 24 REP + getline (ein, eingabezeile); + putline (aus, eingabezeile); + PER; + WHILE NOT eof (ein) REP + getline (ein, eingabezeile); + zaehler INCR 1; cout (zaehler); + zwischenzeile := abgeschnitten (eingabezeile); + haenge zeilentrenner an; + haenge zwischenzeile an ausgabezeile; + schreibe ausgabezeile ggf weg + PER; + schreibe ausgabezeile weg; + mache ausgabedatei zur eingabedatei. + + ueberpruefe existenz: + IF NOT exists (dateiname) + THEN errorstop (verweis); + FI. + + ueberpruefe dateityp: + IF type (old (dateiname)) <> filetype + THEN errorstop (falscher typ) + FI. + + initialisiere: + FILE VAR ein := sequential file (input, dateiname); + FILE VAR aus := sequential file (output, "KOMPRIM"); + maxlinelength (aus, 600); + INT VAR zaehler :: 1; + TEXT VAR eingabezeile :: "", zwischenzeile :: "", ausgabezeile :: "". + + haenge zeilentrenner an: + IF zwischenzeile <> "" + THEN zwischenzeile CAT "{}" + FI. + + haenge zwischenzeile an ausgabezeile: + ausgabezeile CAT zwischenzeile. + + schreibe ausgabezeile ggf weg: + IF length (ausgabezeile) > 500 + THEN schreibe ausgabezeile weg + FI. + + schreibe ausgabezeile weg: + IF ausgabezeile <> "" + THEN putline (aus, ausgabezeile); + ausgabezeile := "" + FI. + +mache ausgabedatei zur eingabedatei: + forget (dateiname, quiet); + rename ("KOMPRIM", dateiname). +END PROC komprimiere; + +TEXT PROC abgeschnitten (TEXT CONST zeile): + TEXT VAR t :: zeile; + WHILE (t SUB length (t)) = " " REP + t := subtext (t, 1, length (t) - 1) + PER; + t +END PROC abgeschnitten; + +PROC dekomprimiere (TEXT CONST dateiname): + INT VAR zeiger; + ueberpruefe existenz; + ueberpruefe dateityp; + initialisiere; + FOR zeiger FROM 1 UPTO 24 REP + getline (ein, eingabezeile); + putline (aus, eingabezeile); + PER; + WHILE NOT eof (ein) REP + getline (ein, eingabezeile); + zerlege zeile + PER; + forget (dateiname, quiet); + rename ("DEKOMPRIM", dateiname). + + ueberpruefe existenz: + IF NOT exists (dateiname) + THEN errorstop (verweis) + FI. + + ueberpruefe dateityp: + IF type (old (dateiname)) <> filetype + THEN errorstop (falscher typ) + FI. + + initialisiere: + FILE VAR ein := sequential file (input, dateiname); + FILE VAR aus := sequential file (output, "DEKOMPRIM"); + INT VAR zaehler :: 1; + TEXT VAR eingabezeile :: "", ausgabezeile :: "". + + zerlege zeile: + WHILE eingabezeile <> "" REP + nimm das erste stueck und schreibe es weg; + entferne den zeilentrenner + PER. + + nimm das erste stueck und schreibe es weg: + ausgabezeile := subtext (eingabezeile, 1, pos (eingabezeile, "{}") - 1); + putline (aus, ausgabezeile); + zaehler INCR 1; + cout (zaehler). + + entferne den zeilentrenner: + eingabezeile := subtext (eingabezeile, pos (eingabezeile, "{}") + 2). +END PROC dekomprimiere; +END PACKET ls dialog decompress; + diff --git a/app/gs.dialog/1.2/src/ls-DIALOG-gen b/app/gs.dialog/1.2/src/ls-DIALOG-gen new file mode 100644 index 0000000..e085616 --- /dev/null +++ b/app/gs.dialog/1.2/src/ls-DIALOG-gen @@ -0,0 +1,34 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-DIALOG ** + ** GENERATORPROGRAMM ** + ** Version 1.2 ** + ** ** + ** (Stand: 04.11.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +LET mm taskname = "ls-MENUKARTEN",{} datei 1 = "ls-DIALOG 1",{} datei 2 = "ls-DIALOG 2",{} datei 3 = "ls-DIALOG 3",{} datei 4 = "ls-DIALOG 4",{} datei 5 = "ls-DIALOG 5",{} datei 6 = "ls-DIALOG 6",{} datei 7 = "ls-DIALOG 7",{} menukarte = "ls-MENUKARTE:Archiv";{}PROC stelle existenz des mm sicher:{} cursor (1, 5); out (""4"");{} IF NOT exists (task (mm taskname)){} THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");{} FI{} +END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{} cursor (1,5); out (""4"");{} out (" """); out (datei); putline (""" wird geholt.");{} fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{} IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{} hole (datei);{} cursor (1, 5); out (""4"");{} out (" """); out (datei); out (""" wird übersetzt: ");{} insert (datei);{} forget (datei, quiet);{}END PROC in;{} +PROC schicke (TEXT CONST datei):{} cursor (1, 5); out (""4"");{} out (" """); out(datei);{} out (""" wird zum MENUKARTEN-MANAGER geschickt!");{} command dialogue (FALSE);{} save (datei, task (mm taskname));{} command dialogue (TRUE);{} forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-DIALOG/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{} +mache global manager aus der task.{}wirf kopfzeile aus:{} page;{} putline (" "15"ls-DIALOG - Automatische Generierung "14"").{}hole die dateien:{} IF NOT exists (datei 1) COR NOT exists (datei 2){} COR NOT exists (datei 3) COR NOT exists (datei 4){} COR NOT exists (datei 5) COR NOT exists (datei 6){} COR NOT exists (datei 7) COR NOT exists (menukarte){} THEN hole dateien vom archiv{} FI.{}hole dateien vom archiv:{} cursor (1,3);{} IF yes ("Ist das Archiv angemeldet und die 'ls-DIALOG' - Diskette eingelegt"){} + THEN lese ein{} ELSE line (2);{} errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){} FI.{}lese ein:{} cursor (1, 3); out (""4"");{} out (" "15"Bitte die Diskette eingelegt lassen! "14"");{} IF NOT einzeln{} THEN hole (datei 1);{} hole (datei 2);{} hole (datei 3);{} hole (datei 4);{} hole (datei 5);{} hole (datei 6);{} hole (datei 7);{} hole (menukarte);{} cursor (1, 3); out(""4"");{} + out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} release (archive){} FI.{}insertiere die dateien:{} check off;{} in (datei 1);{} in (datei 2);{} in (datei 3);{} in (datei 4);{} in (datei 5);{} in (datei 6);{} in (datei 7);{} schicke (menukarte);{} IF einzeln THEN release (archive) FI;{} check on.{}mache global manager aus der task:{} global manager.{} + + + + diff --git a/app/gs.dialog/1.2/src/ls-MENUKARTE:Archiv b/app/gs.dialog/1.2/src/ls-MENUKARTE:Archiv new file mode 100644 index 0000000..c859d22 Binary files /dev/null and b/app/gs.dialog/1.2/src/ls-MENUKARTE:Archiv differ diff --git a/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Inhaltsverzeichnis b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Inhaltsverzeichnis new file mode 100644 index 0000000..5726636 --- /dev/null +++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Inhaltsverzeichnis @@ -0,0 +1,45 @@ +#limit (11.5)##pagelength (16.5)# +#start (1.8,1.0)# +Inhaltsverzeichnis + + + +1 Was kann gs-Herbert und Robbi 3 + +2 Allgemeines zum Hamster-/Robotermodell 6 +2.1 Entstehung 6 +2.2 Kurzbeschreibung des Hamster-/Roboter- + Modells 7 +2.2.1 Befehle und Tests 7 +2.2.2 Landschafts-/Arbeitsfeldgestaltung 9 +2.3 Einsatzbereich 11 +2.4 Hinweise für den Einsatz in der Ausbildung 12 +2.5 Aufgabenmaterial 14 +2.6 Erfahrungen mit dem Hamster-/Roboter-Modell 14 + +3 Installation von gs-Herbert und Robbi 17 +3.1 Voraussetzungen 17 +3.2 Lieferumfang 17 +3.3 Installation 18 +3.4 Direktstart des Medells 20 + +4 Beschreibung der Menufunktionen 22 +4.1 Kurzhinweise zur Bedienung des Menus 23 +4.2 Menufunktionen zum Oberbegriff 'Info' 27 +4.3 Menufunktionen zum Oberbegriff 'Landschaft' 29 + Menufunktionen zum Oberbegriff 'Arbeitsfeld' 29 +4.4 Menufunktionen zum Oberbegriff 'Programm' 35 +4.5 Menufunktionen zum Oberbegriff 'Lauf' 41 +4.6 Menufunktionen zum Oberbegriff 'Archiv' 46 + +5 Detailbeschreibung der Basisbefehle 61 + +6 Zusätzliche Kommandos 66 + + + + + + + + diff --git a/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 1 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 1 new file mode 100644 index 0000000..73c95f9 --- /dev/null +++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 1 @@ -0,0 +1,93 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (3)# +#headodd# +#center#gs-Herbert und Robbi#right#% + +#end# +#headeven# +%#center#gs-Herbert und Robbi + +#end# +#center#1 + +#center#Was +#center#kann +#center#gs-Herbert und Robbi + + + Mit #on("b")#gs-Herbert und Robbi#off("b")# liegt das von Lothar Oppor +entwickelte und von Wolfgang Weber weiterentwickelte +Hamster-Modell nun eingebettet in die komfortable, +menuorientierte Benutzerschnittstelle #on("b")#gs-DIALOG#off("b")# vor. Das +Programm stellt eine wesentliche Erweiterung des 'alten' +Hamster - Modells dar. Neben einer zweiten Modellvarian­ +te (Roboter) wurden eine Reihe nützlicher Funktionen in +das Modell integriert. Sämtlich Funktionen werden über +ein übersichtliches Menu angeboten, was gerade dem An­ +fänger die Arbeit mit dem Computer erleichtert. + + #on("b")#gs-Herbert und Robbi#off("b")# kann zur Einführung in das al­ +gorithmische Problemlösen eingesetzt werden und soll +dazu dienen, Programmierung #on("u")#einfach#off("u")# und #on("u")#spielerisch#off("u")# zu +erlernen - ohne Ablenkung durch Betriebssystem oder gar +Hardware-Eigenheiten. + + Das Modell ist so einfach und überschaubar, daß ein +Anfänger schon nach einer halben Stunde in der Lage ist, +sich selbst kleine Aufgaben zu stellen und diese zu lösen. +Die Modellumgebung ist so komfortabel, daß der Anfänger +nach einer kurzen Einweisung selbständig mit dem Compu­ +termodell umgehen kann. + +- Durch die Menuführung sind nur noch wenige Be­ + triebssystemkommandos zur Bedienung des Systems + notwendig. + +- Der Benutzer kann jederzeit Informationen anfordern + über: + - den zur Verfügung stehenden Befehlsumfang, + - die Möglichkeiten, den Lauf des Hamsters/Robo­ + ters zu beeinflussen, + - die Möglichkeiten hinsichtlich der Landschafts­ + gestaltung/Arbeitsfeldgestaltung + - die Bedienung des Menusystems + - die Wirkung der einzelnen Menufunktionen + - die Möglichkeiten/Bedienung des Editors + +- Neben der Steuerung des Hamsters/Roboters durch + Programme kann der Hamster/Roboter auch interaktiv + gesteuert werden; dabei wird ein Protokoll der ausge­ + führten Aktionen in Form eines ablauffähigen ELAN- + Programms angelegt. Dieses Protokoll (Programm) kann + jederzeit eingesehen werden. Natürlich kann anschlie­ + ßend der Hamster/Roboter die gleichen Aktionen, die + zuvor von Hand ausgeführt wurden, auch nach diesem + Programm ausführen. + +- Durch den (optional) erweiterbaren Befehlssatz kann + #on("b")#gs-Herbert und Robbi#off("b")# den Erfordernissen und der Lei­ + stungsfähigkeit der Lernenden leicht angepaßt wer­ + den. + +- Auch das Editieren und Drucken von Programmen sowie + Landschaften/Arbeitsfeldern erfolgt vom Menu aus. + +- Die Archivoperationen, die gerade Anfängern zunächst + große Probleme bereiten, können sämtlichst komforta­ + bel vom Menu aus gehandhabt werden. Dabei werden + Anfragen an den Benutzer gestellt, die zumeist nur + mit 'ja' oder 'nein' zu beantworten sind; oder der Be­ + nutzer hat in einer Auswahlliste die gewünschten Da­ + teinamen anzukreuzen. + +- Die Archivoperationen stehen dem Benutzer auch unab­ + hängig vom Hamster-/Robotermodell unter #on("b")#gs-DIALOG#off("b")# + zur Verfügung, so daß beim Verlassen der Modellum­ + gebung "kein Bruch zu befürchten ist". + +- Die Fehlermeldungen sind detailliert und leicht ver­ + ständlich, so daß auch Anfänger die Fehlerquelle(n) + zumeist ohne zusätzliche Hilfen lokalisieren und be­ + seitigen können. + diff --git a/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 2 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 2 new file mode 100644 index 0000000..52526d6 --- /dev/null +++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 2 @@ -0,0 +1,389 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (6)# +#headodd# +#center#gs-Herbert und Robbi#right#% + +#end# +#headeven# +%#center#gs-Herbert und Robbi + +#end# +#center#2 + +#center#Allgemeines +#center#zum +#center#Hamster-/Robotermodell + + +2.1 Entstehung + + Das Hamster - Modell wurde in der Gesellschaft für +Mathematik und Datenverarbeitung (GMD), einer Großfor­ +schungseinrichtung des Bundes und des Landes Nord­ +rhein-Westfalen, von Lothar Oppor in Anlehnung an das +Modell 'Karel the Robot' von Richard E. Pattis (Stanford +University, USA) entwickelt und zunächst innerhalb der +GMD und schon bald im Schulbereich eingesetzt. + Wolfgang Weber, Lehrer an der Gesamtschule Leopolds­ +höhe bei Bielefeld, entwickelte in Zusammenhang mit sei­ +ner Arbeit am Landesinstitut für Schule und Weiterbil­ +dung in Soest dieses Modell seit 1984 weiter. Sein Ziel war +es, das Modell um solche Komponenten zu erweitern, daß es +auch für Schüler der Sekundarstufe I im Anfangsunter­ +richt eingesetzt werden kann. Besondere Bedeutung kam +dabei der Entwicklung einer komfortablen, einfach zu be­ +dienenden Benutzerschnittstelle zu, die es dem Anfänger +ermöglicht, sich von Beginn an mit der eigentlichen Pro­ +blemstellung auseinanderzusetzen, ohne von Betriebssy­ +stem oder gar Hardware-Eigenheiten abgelenkt zu werden. + Mit dem vorliegenden Programm #on("b")#gs-Herbert und Robbi#off("b")#, +das in die komfortable, menuorientierte Benutzer­ +schnittstelle #on("b")#gs-DIALOG#off("b")# eingebettet ist, dürfte diese Ar­ +beit vorerst zu einem Abschluß gebracht sein. Mit diesem +Programm liegt nun eine Modellumgebung vor, die den +gestellten Anforderungen gerecht wird. + + +2.2 Kurzbeschreibung des Hamster-/Roboter-Modells + + Das Hamster- und das Roboter - Modell sind analog +aufgebaut und in Art und Umfang der Befehle identisch. +Im ersten Modell kann 'Herbert der Hamster', im zweiten +Modell 'Robbi der Roboter' auf dem Bildschirm durch vier +sogenannte Basisbefehle gesteuert werden - 'Herbert' in +einer 'Landschaft', 'Robbi' auf einem 'Arbeitsfeld' - beides +Ebenen, die aus 23 x 40 Kacheln bestehen. + Auf dieser Ebene können sich noch Hindernisse und +'Körner' (für Herbert) oder 'Werkstücke' (für Robbi) befin­ +den. Die Hindernisse stellen auf dem Bildschirm Barrieren +dar, die umgangen werden müssen. Die Körner bzw. Werk­ +stücke können von Herbert in seinen 'Backentaschen' bzw. +von Robbi in seinem 'Behälter' aufgenommen oder daraus +(wieder) abgelegt werden. + + +2.2.1 Befehle und Tests + + Für die Steuerung von Herbert bzw.Robbi stehen vier +Basisbefehle zur Verfügung (die in beiden Modellvarian­ +ten gleich sind): + +#on("u")#vor#off("u")# + Gehe eine Kachel (einen Schritt) in Laufrichtung vor. + +#on("u")#links um#off("u")# + Drehe Dich, wo Du stehst, um 90 Grad nach links. + +#on("u")#nimm#off("u")# + Nimm da, wo Du stehst, ein Korn/Werkstück auf. + +#on("u")#gib#off("u")# + Lege da, wo Du stehst, aus den Backentaschen/dem Be­ + hälter ein Korn/Werkstück ab. + + Da nur dort ein Korn/Werkstück aufgenommen werden +kann, wo auch eines vorhanden ist oder nur vorgegangen +werden kann, wenn die nächste Kachel noch zur Land­ +schaft/zum Arbeitsfeld gehört und nicht blockiert ist, +sind die Befehle 'nimm', 'gib' und 'vor' nicht uneinge­ +schränkt ausführbar. Aus diesem Grunde sind noch die +folgenden #on("u")#Basistests#off("u")# definiert: + +#on("u")#vorn frei#off("u")# + testet, ob die vor ihm liegende Kachel frei ist. + +#on("u")#korn da / werkstueck da#off("u")# + testet, ob auf der Kachel, auf der er steht, mindestens + ein Korn/Werkstück liegt. + +#on("u")#backen leer /behaelter leer#off("u")# + testet, ob kein Korn/Werkstück in den Backentaschen/im + Behälter ist. + + Darüberhinaus können Sie bei der Installation des +Systems noch festlegen, ob die folgenden #on("u")#Zusatztests#off("u")# zur +Verfügung stehen sollen oder nicht: + +#on("u")#links frei#off("u")# + testet, ob die Kachel links neben ihm frei ist. + +#on("u")#rechts frei#off("u")# + testet, ob die Kachel rechts neben ihm frei ist. + +#on("u")#hinten frei#off("u")# + testet, ob die Kachel hinter ihm frei ist. + +#on("u")#korn vorn / werkstueck vorn#off("u")# + testet, ob auf der Kachel vor ihm mindestens ein Korn/ + Werkstück liegt. + +#on("u")#korn links / werkstueck links#off("u")# + testet, ob auf der Kachel links neben ihm mindestens + ein Korn/ Werkstück liegt. + +#on("u")#korn rechts / werkstueck rechts#off("u")# + testet, ob auf der Kachel rechts neben ihm mindestens + ein Korn/Werkstück liegt + +#on("u")#korn hinten / werkstueck hinten#off("u")# + testet, ob auf der Kachel hinter ihm mindestens ein + Korn/Werkstück liegt. + + Es gibt #on("u")#keinen#off("u")# Testbefehl, mit dem überprüft werden +kann, ob der Rand der Ebene erreicht ist. + + +2.2.2 Landschaftsgestaltung/Arbeitsfeldgestaltung + + Der Benutzer kann selber Landschaften/Arbeitsfelder +erstellen, auf denen Herbert bzw. Robbi bewegt werden +kann. Es können aber auch fertige Ebenen verändert wer­ +den. + Eine Landschaft/ein Arbeitsfeld ist eine Ebene aus +23 x 40 Kacheln. Eine Kachel kann auf dem Bildschirm so +aussehen: + + Leere Kachel : Blank und Punkt (" .") + Kornkachel : Blank und kleines o (" o") + Hindernis : zwei Nummernzeichen ("\#\#") + + In dieser Landschaft steht auf einer der Kacheln Her­ +bert bzw. Robbi: + + "A" mit Blickrichtung nach oben + ">" mit Blickrichtung nach rechts + "V" mit Blickrichtung nach unten + "<" mit Blickrichtung nach links + + +#on("u")#Beispiel:#off("u")# Ausschnitt aus einer Landschaft: + +#on("b")# + . . . . . . . . . . . . . . . . . . . . + . . o o o o o o o o o o . . . . . . . . + . . o . . . . . . . . o . . . . . . . . + . . o . . . . . . . . o . . . . . . . . + . o o .\#\#\#\#\#\#\#\#\#\#\#\# . o . . . . . . . . + . o . .\#\# .V. . .\#\# . o o o o o o o . . + . o . .\#\# . o . .\#\# . . . . . . . o . . + . o o o o o o . .\#\# . . . o o o o o . . + . . . .\#\# . . . .\#\# . . . o . . . . . . + . . . .\#\# . . . .\#\# . . . o o o o . . . + . . . .\#\#\#\#\#\#\#\#\#\#\#\# . . . . . . o o . . + . . . . . . . . . . . . . . . . . . . . + +Während der Landschaftsgestaltung wirken folgende +Tasten: + + halt, beende die Landschafts-/Arbeitsfeld­ + gestaltung +<\#> setze ein Hindernis und gehe ein Feld + weiter + leere das Feld und gehe ein Feld weiter + lege hier ein Korn/Werkstück ab + nimm ein Korn/Werkstück auf (falls hier + welche liegen) + zeige, wie viele Körner/Werkstücke hier + liegen + ersetze diese Landschaft/diese Arbeitsfeld + durch die Kopie einer bereits vorhandenen + anderen Landschaft/eines bereits vorhan­ + denen anderen Arbeitsfeldes + +- Durch Drücken der Fragezeichentaste () während der + Landschafts-/Arbeitsfeldgestaltung, können Sie sich + diese Hinweise auch auf dem Bildschirm einblenden + lassen. + +- Mit den Pfeiltasten kann Herbert/Robbi bewegt und + seine Richtung verändert werden. + +- Die Landschaftsgestaltung wird durch Tippen der + Taste abgeschlossen. Die Position und die Blick­ + richtung, die Herbert bzw. Robbi zu diesem Zeitpunkt + innehat, wird als Startposition vermerkt. + +- Auf dem Bildschirm wird dann noch die Zahl der Kör­ + ner/Werkstücke erfragt, die Herbert bzw.Robbi zu Be­ + ginn des Laufes in seinen Backentaschen/in seinem + Behälter haben soll. Hier muß eine Zahl zwischen 0 und + 32767 eingegeben werden. + + +2.3 Einsatzbereich + + Das Hamster-/Roboter-Modell soll dazu dienen, die +Grundelemente des algorithmischen Problemlösens (Folge, +Auswahl, Wiederholung etc.) #on("u")#einfach#off("u")# und #on("u")#spielerisch#off("u")# zu +erlernen und sie in der Programmiersprache ELAN zu co­ +dieren. In der Bildschirmdarstellung erinnert das Ham­ +ster-/Roboter-Modell zunächst an ein einfaches Tele­ +spiel, eine Anwendung des Computers, die sicher bekannt +ist. Darüberhinaus lassen sich leicht Bezüge zur Steue­ +rung von Industrierobotern herstellen. + Durch die komfortable Benutzerschnittstelle wird dem +Anwender in der Anfangsphase eine Auseinandersetzung +mit dem Betriebssystem "erspart". Die Arbeit mit dem Mo­ +dell setzt #on("u")#keine Vorerfahrungen und Kenntnisse#off("u")# voraus. +Das Modell ist schon nach weniger als einer halben Stun­ +de für den Anfänger überschaubar. Er kann dann schon +Aufgaben lösen, sich selbst Aufgaben stellen bzw. die +gegebene Aufgabenstellung erweitern. + Das Modell zielt auf die Aktivierung des Lernenden +und die Mitarbeit in allen Punkten: Aufgabenstellung, +Lösungsgestaltung, Lösungstest und -verifizierung. Der +Lernfortschritt kann in stärkerem Maße als im "herkömm­ +lichen Programmierunterricht" von den Lernenden selbst +bestimmt werden. Der spielerische Anfang, die Veran­ +schaulichung der Programmausführung auf dem Bild­ +schirm, die Möglichkeit Fehler direkt und eigenständig +zu erkennen, fördern die Motivation, die Kreativität und +die Fehler- und Frustrationstoleranz. + + +2.4 Hinweise für den Einsatz in der Ausbildung + + Das Hamster-/Roboter-Modell ist angelegt für "Pro­ +grammieren" mit Bleistift und (kariertem) Papier. Für die +Überlegungen, die anzustellen sind, ist der Computer +selbst in der Anfangsphase #on("u")#nicht notwendig#off("u")#. Man kann +Kachel-Landschaften / Kachel-Arbeitsfelder aufzeich­ +nen und vorgegebene oder sich selbst gestellte Aufgaben +lösen. Die erstellten Programme werden ausgeführt, indem +man z.B. eine kleine Büroklammer als Hamster/Roboter auf +dem Papier oder der Folie dem Programm entsprechend ver­ +schiebt. Heftzwecken oder Pfennigstücke können als Kör­ +ner/ Werkstücke und Streichholzstücke als Hindernisse +dienen. + #on("b")#gs-Herbert und Robbi#off("b")# verfügt auch über die Möglich­ +keit, den Hamster/Roboter interaktiv zu steuern. Auch +hierüber ist ein Einstieg in den Umgang mit dem Modell +möglich. Bei der interaktiven Steuerung kann der Ham­ +ster/Roboter von Hand durch Tastendruck auf dem Bild­ +schirm bewegt werden. Dabei können nur die vier Basisbe­ +fehle ('vor', 'links um', 'nimm' und 'gib') verwendet werden. +Während der Steuerung von Hand wird ein "Protokoll" der +ausgeführten Befehle angelegt - und zwar gleich in Form +eines ablauffähigen ELAN-Programms. Dadurch hat der +Benutzer einerseits die Möglichkeit, die Anweisungen, die +durch Tastendruck gegeben wurden, zu kontrollieren, +andererseits kann anschließend die Folge der eingegebe­ +nen Anweisungen auch als Programm vom Computer ausge­ +führt werden ('Teach in'). + + Nach diesem "ersten Kennenlernen des Modells" sollte +man dann aber bei Problemstellungen, die ein systemati­ +sches Vorgehen erfordern, die Arbeit mit dem Computer +unterbrechen und die Algorithmen jeweils auf dem Papier +entwerfen. Auf die Ausführung der erstellten Anwei­ +sungsfolgen von Hand auf Papier/Folie sollte man #on("u")#auf +keinen Fall gänzlich verzichten#off("u")# - auch, um den Lernen­ +den zu verdeutlichen, daß die Befehlsfolgen sowohl vom +"Prozessor Mensch" als auch vom "Prozessor Computer" +ausgeführt werden können; der Computer also nur ein +Hilfswerkzeug ist. + Erst wenn das Bilden eigener benannter Anweisungen +(Refinements/Prozeduren) den Lernenden hinreichend ver­ +traut ist, ist es sinnvoll, umfangreichere Problemstel­ +lungen anzugehen. Da dann auch die Programmausführung +von Hand mühsam wird und ihren Reiz verliert, sollte man +(wieder) zum Computermodell übergehen, um mit dessen Hil­ +fe die Programme auszuführen und zu überprüfen. + Nachdem die Lernenden die Basisbefehle sicher beherr­ +schen und eigene benannte Anweisungen unter Verwendung +der Basisbefehle konstruieren können, können dann nach +und nach die vorgegebenen Tests und damit auch die ande­ +ren Elemente der Algorithmenentwicklung (Auswahl, Wie­ +derholung etc.) in den Unterricht eingebracht werden. + Als notwendig hat es sich erwiesen, von Anfang an auf +eine saubere Strukturierung und Modularisierung der +Algorithmen zu achten. Gerade Lernende mit "Program­ +miererfahrung" neigen dazu, möglichst "kurze" Program­ +me schreiben zu wollen. Besonderen Wert sollten Sie auf +eine treffende Namensgebung der einzelnen Module legen, +selbst wenn die Lernenden das oft als "lästige Schreibar­ +beit" empfinden. Aufgaben können ein Einzel-, Partner- +und Gruppenarbeit bearbeitet werden. Dabei hat sich die +Arbeit in kleinen Gruppen als besonders effektiv erwie­ +sen. Die Lernenden sind untereinander zumeist sehr kri­ +tisch und fordern sich gegenseitig auf, "lesbare" Pro­ +gramme zu schreiben. Ein Austausch der Programme unter +den Gruppen kann diesen Anspruch noch zusätzlich för­ +dern. + + +2.5 Aufgabenmaterial + + Zum Hamster-Roboter-Modell sind inzwischen eine Rei­ +he von Aufgaben / Aufgabensystemen enstanden. An dieser +Stelle soll auf zwei Veröffentlichungen hingewiesen +werden, in denen Sie solche Aufgaben / Aufgabensysteme +finden können: + +Weber, Wolfgang et al., Das Hamster-/Roboter-Modell, + in: Landesinstitut für Schule und Weiterbildung + (Hrsg.), Materialien zur Lehrerfortbildung in + Nordrhein-Westfalen, Heft 1, Neue Technologien + - Informations- und Kommunikationstechnologi­ + sche Inhalte im Wahlpflichtunterricht der Klas­ + sen 9/10, Soest, 1986 + +Ambros, Wolfgang, Der Hamster, Programmieren lernen in + einer Modellwelt, J.B. Metzlersche Verlagsbuch­ + handlung, Stuttgart, 1987 + + +2.6 Erfahrungen mit dem Hamster-/Roboter-Modell + + Seit 1982 wird das Hamster - Modell in der GMD zur +Programmierausbildung eingesetzt. Die Ergebnisse sind +hervorragend: Die Teilnehmer bewältigen in derselben +Zeit erheblich mehr Inhalte als früher ohne Modell. Moti­ +vation, Selbständigkeit und Initiative prägen sich er­ +heblich früher und merklich stärker aus. Außerdem sind +die am Modell erworbenen Kenntnisse tiefer und sicherer. + Seit 1983 wird das Hamster - Modell auch in mehreren +Schulen mit sehr gutem Erfolg eingesetzt. Der Erfolg ist +am größten im Blockunterricht (3 - 5 Tage z.B. in Projekt­ +wochen, Schullandheimaufenthalten etc.). Aber auch im +stundenweisen Unterricht wird das Hamster-/Roboter- +Modell mit gutem Erfolg eingesetzt. + Beide Zugänge, der Einstieg über das Arbeiten mit +Bleistift und Papier und der Einstieg über die interakti­ +ve Steuerung des Hamsters/Roboters, haben sich als prak­ +tikabel erwiesen. Der Zugang über die interaktive Steue­ +rung bietet den Vorteil, die zumeist sehr hohe Motivation +der Lernenden, "endlich mit dem Computer arbeiten zu +können", auszunutzen. Sie lernen dabei das Computermo­ +dell auf einfache Weise kennen und haben einen ersten +Umgang mit Bildschirm und Tastatur. Kleine, einfache +Problemstellungen können von ihnen durch die interak­ +tive Steuerung schnell und sicher bearbeitet werden. +"Nebenbei" lernen sie, neben der Wirkung der Basisbefeh­ +le, durch das mitgeführte Protokoll auch die Codierung +in der Programmiersprache kennen. Allerdings verliert +die interaktive Steuerung relativ schnell ihren Reiz, +wenn die Lernenden erkennen, daß nur sehr einfache Pro­ +blemstellungen damit bearbeitet werden können. Dann +sollte aber zur Arbeit mit Papier und Bleistift überge­ +gangen werden. + Die Entscheidung, ganz auf das Arbeiten mit Papier +und Bleistift zu verzichten, hat sich als sehr nachteilig +erwiesen. Die Lernenden "hacken" die Programme in die +Maschine und handeln eher nach dem "Prinzip von Versuch +und Irrtum" als nach sorgfältigen Überlegungen. Bei +komplexeren Problemstellungen scheitern diese Teilneh­ +mer zumeist. + Erfahrungsgemäß nimmt nach einiger Zeit der Wunsch +stark zu, eigene Ausgaben auf dem Bildschirm zu erzeugen +und andere Problembereiche zu bearbeiten (zum "richtigen +Programmieren" überzugehen). Sie sollten diesen Schritt +dann auch nicht zu lange hinauszögern und das Modell +auf keinen Fall überstrapazieren. Da das Modell selbst +und auch der Umgang damit sehr einfach ist, besteht auch +später die Möglichkeit, zum Modell zurückzukehren, um +hieran weitere Elemente der Algorithmenentwicklung in +einfacher und anschaulicher Form einzuführen. + + diff --git a/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 3 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 3 new file mode 100644 index 0000000..c34b752 --- /dev/null +++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 3 @@ -0,0 +1,199 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (17)# +#headodd# +#center#gs-Herbert und Robbi#right#% + +#end# +#headeven# +%#center#gs-Herbert und Robbi + +#end# +#center#3 + +#center#Installation +#center#von +#center#gs-Herbert und Robbi + + + Bevor Sie #on("b")#gs-Herbert und Robbi#off("b")# auf Ihrem Computer +benutzen können, müssen Sie das Programm zunächst in­ +stallieren. Wenn #on("b")#gs-Herbert und Robbi#off("b")# auf Ihrem System +schon zur Verfügung steht, können Sie dieses Kapitel +ruhig überspringen. + + +3.1 Voraussetzungen + + Um #on("b")#gs-Herbert und Robbi#off("b")# auf Ihrem Computer betreiben +zu können, muß das EUMEL-Betriebssystem installiert +sein. #on("b")#gs-Herbert und Robbi#off("b")# setzt die Multi-User-Version +voraus und ist lauffähig ab Version 1.7.5. #on("b")#gs-Herbert und +Robbi#off("b")# setzt weiterhin voraus, daß auf Ihrem Computer +bereits das Programm #on("b")#gs-DIALOG#off("b")# installiert ist. + + +3.2 Lieferumfang + + #on("b")#gs-Herbert und Robbi#off("b")# wird auf einer Diskette gelie­ +fert, die alle notwendigen Programme enthält (die Instal­ +lation von #on("b")#gs-DIALOG#off("b")# wird dabei vorausgesetzt!). Um den +Inhalt der Diskette feststellen zu können, starten Sie +Ihr System und bringen es dazu, daß 'gib kommando:' er­ +scheint. Dann legen Sie die Diskette ein und geben das +Kommando: + +archive("gs-Herbert und Robbi");list(archive); +release(archive) + + Anschließend erscheint eine Übersicht der auf dem +Archiv vorhandenen Programme. Folgende Programme soll­ +ten sich in der Übersicht befinden: + + "gs-Herbert und Robbi 1" + "gs-Herbert und Robbi 2" + "gs-Herbert und Robbi 3" + "gs-MENUKARTE:Herbert und Robbi" + "gs-Herbert und Robbi/gen" + + Eventuell können noch weitere Namen auf der Diskette +vorhanden sein. Wenn Sie den Inhalt der Diskette kon­ +trolliert haben und diese Programme auf der Diskette +vorhanden sind, können Sie #on("b")#gs-Herbert und Robbi#off("b")# instal­ +lieren. + Sollten Sie statt der Übersicht eine Fehlermeldung +erhalten, überprüfen Sie bitte, ob die Diskette das rich­ +tige Format besitzt oder ob Ihr Diskettenlaufwerk Pro­ +bleme macht. Sollten dagegen Programme fehlen, so rekla­ +mieren Sie die Diskette. + + +3.3 Installation + + #on("b")#gs-Herbert und Robbi#off("b")# muß in einer Task installiert +werden, in der bereits das Programm #on("b")#gs-DIALOG#off("b")# zur Ver­ +fügung steht. Alle Söhne und Enkel der neuen Task kön­ +nen anschließend das Hamster-/ Roboter-Modell aufrufen. +Richten Sie also eine Task als Sohn der Task ein, in der +auf Ihrem Computer bereits #on("b")#gs-DIALOG#off("b")# installiert ist. Wir +nehmen hier an, daß #on("b")#gs-DIALOG#off("b")# in der Task 'MENU' instal­ +liert ist und die neue Task den Namen 'HAMSTER' erhalten +soll. (Sie können für die Task auch einen beliebigen an­ +deren Namen wählen): + +#on("b")# + (Supervisor - Taste) + +#off("b")# + --> gib supervisor kommando: +#on("b")# + begin ("HAMSTER","MENU") +#off("b")# + + --> gib kommando: + + (Arbeiten mehrere Personen mit dem Computer, dann ist +es sinnvoll, diese Task vor unbefugtem Zugriff durch ein +Passwort zu schützen. Wie das gemacht wird, können Sie in +Ihrem EUMEL-Benutzerhandbuch erfahren.) + + Legen Sie dann die Archivdiskette ein, auf der sich +#on("b")#gs-Herbert und Robbi#off("b")# befindet, und geben Sie das folgen­ +de Kommando: + +#on("b")# + archive("gs-Herbert und Robbi") + + fetch("gs-Herbert und Robbi/gen",archive) + + run +#off("b")# + + Sie haben damit das Generatorprogramm gestartet. +Zunächst werden Sie gefragt, ob Sie den erweiterten Be­ +fehlssatz (mit Zusatztests) für den Hamster und Roboter +zur Verfügung gestellt haben möchten. Beantworten Sie +diese Frage je nach Wunsch mit 'ja' oder 'nein' durch Tip­ +pen der Taste bzw. . + Daraufhin wird die Installation automatisch durchge­ +führt. Lassen Sie während des gesamten Vorgangs die Ar­ +chivdiskette eingelegt. Die Generierung ist beendet, wenn +der EUMEL-Eingangsbildschirm erscheint. Die Task, in der +die Generierung stattfindet, wird automatisch zur Mana­ +gertask, das heißt, daß Söhne von ihr eingerichtet werden +können. + Richten Sie sich gleich eine Sohntask (z.B mit dem Na­ +men 'hamster1') ein, dann können Sie das System sofort +ausprobieren. Gehen Sie dazu folgendermaßen vor: + +#on("b")# + (Supervisor - Taste) + +#off("b")# + --> gib supervisor kommando: +#on("b")# + begin ("hamster1","HAMSTER") +#off("b")# + + --> gib kommando: + + +Mit dem Kommando + +#center##on("b")#hamster bzw. roboter #off("b")# + +rufen Sie nun das + +#center#Hamster-Modell bzw. Roboter-Modell + +auf. + + +3.4 Direktstart des Modells + (Steht erst ab gs-DIALOG Version 1.1 zur Verfügung) + + In Kapitel 3.3 haben wir Ihnen gezeigt, wie sie eine +Sohntask einrichten und hier durch das Kommando 'ham­ +ster' bzw. 'roboter' das System aufrufen können. Wenn Sie +immer nur mit einer Modellvariante arbeiten oder vor dem +Benutzer die 'gib kommando:'-Ebene verbergen wollen, +können Sie das System auch so einrichten, daß sich sofort +nach Einrichten des Arbeitsbereichs das Menusystem mel­ +det. Für den Anfänger kann das die Arbeit durchaus er­ +leichtern. + Gehen Sie dazu in die Task, unterhalb der die Sohntasks +eingerichtet werden sollen: + +#on("b")# + (Supervisor - Taste) + +#off("b")# + --> gib supervisor kommando: +#on("b")# + continue ("HAMSTER") +#off("b")# + + --> gib kommando: +#on("b")# + direktstart ("hamster", TRUE) +#off("b")# + + Durch das Kommando haben Sie festgelegt, daß sich +alle Sohntasks direkt mit dem Hamstermenu melden. Möch­ +ten Sie lieber mit dem Roboter-Modell arbeiten, ist nur +'hamster' durch 'roboter' zu ersetzen. + Durch den zweiten Parameter 'TRUE' legen Sie fest, daß +in den Sohntasks nach Verlassen des Menus die jeweilige +Task automatisch gelöscht wird. Statt 'TRUE' können Sie +hier auch den Wert 'FALSE' eintragen. Dann wird nach Ver­ +lassen des Menus angefragt, ob die Task gelöscht werden +soll. Wird die Frage bejaht, wird gelöscht - sonst wird die +Task abgekoppelt (break) und kann durch 'continue' wieder +angekoppelt werden. + Anmerkung: In der Task, in der Sie das Kommando +'direktbefehl' gegeben haben, sollte nicht das Kommando +'monitor' gegeben werden, da Sie durch dieses Kommando +auch diese Task zu einer Task machen, die sich direkt mit +dem Menu meldet und ggf. bei Verlassen des Menus automa­ +tisch gelöscht wird! + diff --git a/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 4 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 4 new file mode 100644 index 0000000..4f2d79a --- /dev/null +++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 4 @@ -0,0 +1,1312 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (22)# +#headodd# +#center#gs-Herbert und Robbi#right#% + +#end# +#headeven# +%#center#gs-Herbert und Robbi + +#end# +#center#4 + +#center#Beschreibung +#center#der +#center#Menufunktionen + + + Nach Aufruf meldet sich #on("b")#gs-Herbert und Robbi mit +#on("u")#einem#off("u")# der folgenden Menus: + + +#on("b")# +HAMSTER: Info Landschaft Programm Lauf Archiv ++---------------------------+-------------------------------------------- +| l Landschaftsgestaltung | +| b Befehlsvorrat | +| s Steuerung des Laufs | ++---------------------------+ + + + + + + + + + + + + +------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +#on("u")#oder#off("u")# + +#on("b")# +ROBOTER: Info Arbeitsfeld Programm Lauf Archiv ++----------------------------+-------------------------------------------- +| a Arbeitsfeldgestaltung | +| b Befehlsvorrat | +| s Steuerung des Laufs | ++----------------------------+ + + + + + + + + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + + Beide Varianten sind, wie schon gesagt, analog auf­ +gebaut. Aus diesem Grunde werden wir uns in den folgen­ +den Ausführungen auf die Beschreibung der Hamster - +Variante beschränken. + + +4.1 Kurzhinweise zur Bedienung des Menus + + Die Bedienung des Menus ist sehr einfach. Eine aus­ +führliche Beschreibung dazu finden Sie in den Unterla­ +gen zum Programmsystem #on("b")#gs-DIALOG#off("b")#. An dieser Stelle sol­ +len nur die wesentlichen Bedienungsvorgänge beschrieben +werden. + +- Mit der Tastenfolge können Sie sich Informa­ + tionen zur Bedienung des Menusystems in das Menu + einblenden lassen + +- Mit den Pfeiltasten und können Sie + zwischen den "Oberbegriffen" in der Kopfzeile wählen. + Der aktuelle Oberbegriff ist jeweils invers darge­ + stellt. Das ausgeklappte 'Pull-Down-Menu' bezieht sich + auf diesen invers dargestellten Oberbegriff. + +- Mit den Pfeiltasten und können Sie + zwischen den Menufunktionen wählen, die Ihnen im + aktuellen Pull-Down-Menu zur Auswahl angeboten + werden. Die aktuell angewählte Menufunktion wird + jeweils invers dargestellt. Die Trennlinien, die in + einigen Pull-Down-Menus sichtbar sind, dienen nur + der optischen Untergliederung; sie können nicht an­ + gewählt werden und werden deshalb automatisch über­ + sprungen. Die einzelnen Menupunkte sind "zyklisch + miteinander verknüpft", das heißt, man gelangt vom + untersten Menupunkt wieder zum obersten und umge­ + kehrt. Menupunkte, vor denen ein Minuszeichen steht + ('-'), sind (zur Zeit) nicht aktivierbar; auch sie können + nicht angewählt werden und werden einfach über­ + sprungen. + +- Durch Tippen der Fragezeichentaste () können Sie + sich jeweils zur aktuellen Menufunktion (invers im + Pull-Down-Menu) Informationen in das Menu einblen­ + den lassen. + +- Um eine Menufunktion ausführen zu lassen, bewegen + Sie sich mit den Pfeiltasten auf die gewünschte Menu­ + funktion im aktuellen Pull-Down-Menu und tippen + dann die -Taste. Steht vor dem gewünschten + Menupunkt ein einzelner Buchstabe oder eine Ziffer, + so kann durch Tippen der entsprechenden Taste diese + Menufunktion dadurch direkt aufgerufen werden. So­ + bald eine Menufunktion aufgerufen worden ist, er­ + scheint davor ein Stern ('*'). Daraus können Sie ent­ + nehmen, daß das System bereits den Auftrag ausführt. + +- An verschiedenen Stellen werden Fragen an Sie ge­ + richtet, die Sie mit 'ja' oder 'nein' beantworten müssen. + Tippen Sie dazu entsprechend der Entscheidung die + Taste (für 'ja') bzw. (für 'nein'). + +- Werden Ihnen vom Menu aus Dateinamen zur Auswahl + angeboten, so können Sie den auf dem Bildschirm + sichtbaren Pfeil vor den gewünschten Namen positio­ + nieren. Mit den Tasten oder können Sie + den Namen ankreuzen. Ist die Auswahl mehrerer Datein­ + amen möglich, so können Sie den Vorgang wiederholen. + Mit den Tasten oder können Sie auch ein + Kreuz vor einem Namen wieder löschen. Daneben gibt es + noch einige Tastenfunktionen, die für die Bedienung + recht hilfreich sein können. Tippen Sie während der + Auswahl die Fragezeichentaste (), so werden Ihnen + alle Bedienungsmöglichkeiten auf dem Bildschirm an­ + gezeigt. Eine Auswahl, in der mehrere Dateien ange­ + kreuzt werden dürfen, wird durch die Tastenfolge + verlassen. Anschließend wird die eingestellte + Operation mit den angekreuzten Dateien ausgeführt. + Sind Sie versehentlich in eine solche Auswahl ge­ + langt, so können Sie den Vorgang durch die Tasten­ + kombination abbrechen. + +- An einigen Stellen werden Sie aufgefordert, eine Ein­ + gabe zu machen (z.B. einen Dateinamen einzugeben). Wird + Ihnen hier ein Vorschlag gemacht, den Sie akzeptieren, + so brauchen Sie zur Bestätigung nur die - + Taste zu tippen. Gefällt Ihnen der Vorschlag nicht + oder wird Ihnen kein Vorschlag gemacht, so machen Sie + bitte die gewünschte Eingabe. Zum Schreiben stehen + Ihnen alle aus dem Editor bekannten Funktionen zur + Verfügung. Mit der Taste können Sie Buch­ + staben löschen, mit einfügen. Die Eingabe wird + durch Tippen der -Taste abgeschlossen. Ist + der von Ihnen gewünschte Name schon in Ihrer Task + vorhanden und steht in der Fußzeile der Hinweis 'Zei­ + gen: ', dann können Sie sich auch alle vorhan­ + denen Namen zur Auswahl anbieten lassen und durch + Ankreuzen den beabsichtigten Namen auswählen. + +- Ihnen können auch mehrere Alternativen angeboten + werden, zwischen denen Sie wählen müssen. In der un­ + tersten Zeile eines solchen Kastens, in denen Ihnen die + Alternativen auf dem Bildschirm eingeblendet werden, + sind die Möglichkeiten aufgeführt, die darüber be­ + schrieben sind. Mit den Pfeiltasten können sie die + Markierung auf die gewünschte Alternative positio­ + nieren und dann durch die -Taste zur Aus­ + führung bringen. (Manchmal ist das auch durch Tippen + der den Alternativen vorangestellten Buchstaben oder + Ziffern möglich). + +- Durch die Tastenfolge kann das Menu insge­ + samt verlassen werden. Damit das nicht versehentlich + geschieht, wird jeweils die Frage gestellt, ob Sie das + Menu tatsächlich verlassen wollen. Diese Frage beant­ + worten Sie bitte je nach Wunsch mit 'ja' oder 'nein' + durch Tippen der Tasten bzw. . + +#page# +4.2 Menufunktionen zum Oberbegriff 'Info' + + Das auf dem Bildschirm sichtbare Pull-Down-Menu ist +oben abgebildet. + +#on("u")##on("b")#l Landschaftsgestaltung (a Arbeitsfeldgestaltung)#off("b")##off("u")# + Mit dieser Funktion können Sie sich alle Tasten, + die bei der Landschafts-/Arbeitsfeldgestaltung + wirksam sind, anzeigen lassen. + In der Anzeige wird die jeweilige Tastenfunktion + erläutert. Während der Landschafts-/Arbeitsfeld­ + gestaltung können Sie sich diese Informationen + durch Tippen der Fragezeichentaste () ebenfalls + einblenden lassen. + +#on("u")##on("b")#b Befehlsvorrat#off("b")##off("u")# + Mit dieser Funktion können Sie sich die Befehle, + die Ihnen vom jeweiligen Modell zur Verfügung ge­ + stellt werden, auf dem Bildschirm anzeigen lassen. + Anhand dieser Informationen können Sie auch + feststellen, ob in dem System, das Ihnen zur Verfü­ + gung steht, der "eingeschränkte" oder "erweiterte" + Befehlssatz hinsichtlich der Tests realisiert ist. + +#on("u")##on("b")#s Steuerung des Laufs#off("b")##off("u")# + Mit dieser Funktion können Sie sich die Möglich­ + keiten anzeigen lassen, wie Sie auf einen Hamster- + /Roboterlauf durch Tastendruck Einfluß nehmen + können: + + : beende den Lauf (Programmabbruch + durch Tastendruck) + : zeige diese Information (während des + Programmablaufs!) + + 0 : Einzelschritt (dazu beliebige Taste + drücken) + 1 : geringste Geschwindigkeit + 9 : höchste Geschwindigkeit + 2 ... 8 : dazwischenliegende Geschwindigkeiten + + <+> : laufe schneller + <-> : laufe langsamer + + Zu Beginn eines Laufes ist die Geschwindigkeit '5' + eingestellt. +#page# +4.3 Menufunktionen zum Oberbegriff 'Landschaft'(Ar­ + beitsfeld) + +#on("b")# +HAMSTER: Info Landschaft Programm Lauf Archiv +----------+--------------------+------------------------------------------ + | n Neu erstellen | + | a Ansehen/Ändern | + | ---------------- | + | v Verzeichnis | + | ---------------- | + | l Löschen | + | d Drucken | + | ---------------- | + | k Kopieren | + | u Umbenennen | + +--------------------+ + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +#on("u")##on("b")#n Neu erstellen#off("b")##off("u")# + Mit dieser Funktion können Sie eine neue Land­ + schaft/ein neues Arbeitsfeld unter einem neuen + Namen anlegen und gestalten. + Sie werden zunächst nach einem Namen für die + #on("u")#neue#off("u")# Landschaft/das #on("u")#neue#off("u")# Arbeitsfeld gefragt. Ge­ + ben Sie einen beliebigen Namen (#on("u")#ohne Anführungs­ + zeichen (!)#off("u")# und #on("u")#ohne das Präfix 'Flaeche:' (!)#off("u")#) ein und + schließen Sie die Eingabe durch ab. Dar­ + aufhin wird Ihnen auf dem Bildschirm eine leere + Landschaft/ein leeres Arbeitsfeld angeboten. + Sollte schon eine Landschaft/ein Arbeitsfeld + mit diesem Namen in der Task vorhanden sein, so + werden Sie darauf aufmerksam gemacht. Sie können + sich während der Landschaftsgestaltung auch je­ + derzeit eine Aufstellung der wirksamen Tasten mit + Beschreibung der Funktionen auf den Bildschirm + ausgeben lassen. Drücken Sie dazu die Fragezeichen­ + taste (). + + Fehlerfälle: + - Eine Landschaft/ein Arbeitsfeld mit dem vorge­ + schlagenen Namen existiert schon. + +#on("u")##on("b")#a Ansehen/Ändern#off("b")##off("u")# + Mit dieser Funktion können Sie schon in Ihrer + Task existierende Landschaften/Arbeitsfelder zur + Ansicht oder zur Überarbeitung anfordern. + Sie werden zunächst gefragt, ob Sie #on("u")#die zuletzt + bearbeitete Landschaft#off("u")#/#on("u")#das zuletzt bearbeitete Ar­ + beitsfeld#off("u")# ansehen bzw. verändern möchten (sofern + Sie schon vorher mit dem Modell in der Task gear­ + beitet haben). + Bejahen Sie diese Frage, dann wird Ihnen diese + Landschaft/dieses Arbeitsfeld zur Bearbeitung + angeboten. Verneinen Sie die Frage dagegen, so ge­ + langen Sie in die 'Auswahl' (d.h es werden Ihnen alle + Landschaften/Arbeitsfelder in der Task zur Auswahl + angeboten). Nachdem Sie einen der Namen angekreuzt + haben, wird Ihnen die ausgewählte Landschaft/das + ausgewählte Arbeitsfeld zur Bearbeitung auf dem + Bildschirm angeboten. Ihnen stehen die Tastenfunk­ + tionen wie bei der Neuerstellung zur Verfügung. + + Fehlerfälle: + - In der Task existiert noch keine Landschaft/kein + Arbeitsfeld. + +#on("u")##on("b")#v Verzeichnis#off("b")##off("u")# + Mit dieser Funktion können Sie sich einen Über­ + blick über die in Ihrer Task vorhandenen Land­ + schaften/Arbeitsfelder verschaffen. + Nach Aufruf dieser Funktion wird eine Liste der + Landschaften/Arbeitsfelder auf dem Bildschirm + ausgegeben, die sich in Ihrer Task befinden. Da die + Liste selbst eine Datei ist, kann Sie mit der Tasten­ + kombination verlassen werden - hierauf + wird auch in der Kopfzeile der Datei hingewiesen. + Falls nicht alle Namen auf den Bildschirm passen, + können Sie das Fenster mit und + verschieben. + +#on("u")##on("b")#l Löschen#off("b")##off("u")# + Mit dieser Funktion können Sie Landschaften/ + Arbeitsfelder, die Sie nicht mehr benötigen, die + unnötig Platz belegen, löschen. Aber Vorsicht! Die + Landschaften/Arbeitsfelder verschwinden durch + diese Funktion unwiederbringlich! + Nach Aufruf dieser Funktion werden Ihnen alle + Landschaften/Arbeitsfelder, die sich in Ihrer Task + befinden, zur Auswahl angeboten. Hier können Sie + die gewünschten Namen ankreuzen. Die Auswahl wird + dann durch die Tastenfolge verlassen. + Für jede einzelne Landschaft/jedes einzelne Ar­ + beitsfeld wird noch einmal zur Sicherheit gefragt, + ob sie/es auch tatsächlich gelöscht werden soll. Zur + Bestätigung tippen Sie bitte die Taste ('ja') - zur + Verhinderung ('nein'). + + Fehlerfälle: + - In der Task exsitiert noch keine Landschaft/ + kein Arbeitsfeld. + +#on("u")##on("b")#d Drucken#off("b")##off("u")# + Mit dieser Funktion können Sie Landschaften/ + Arbeitsfelder über einen angeschlossenen Drucker + ausgeben lassen. + Nach Aufruf dieser Funktion werden Ihnen alle + Landschaften/Arbeitsfelder, die sich in Ihrer Task + befinden, zur Auswahl angeboten. Hier können Sie + die gewünschten Namen ankreuzen. Die Auswahl wird + dann durch die Tastenfolge verlassen. + Die angekreuzten Landschaften/Arbeitsfelder + werden anschließend zum Drucker geschickt. Der + Vorgang wird auf dem Bildschirm protokolliert. + + Fehlerfälle: + - In der Task existiert noch keine Landschaft/ + kein Arbeitsfeld. + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' + betrieben. + - Auf Ihrem System werden die Druckkosten abge­ + rechnet. Sie müssen sich mit einer Codenummer + identifizieren. + +#on("u")##on("b")#k Kopieren#off("b")##off("u")# + Mit dieser Funktion können Sie sich eine Kopie + einer/eines bereits in der Task vorhandenen Land­ + schaft/Arbeitsfeldes anlegen. Das ist z.B. dann + sinnvoll, wenn Sie sich einen bestimmten 'Stand' + aufbewahren wollen oder wenn Sie eine Land­ + schaft/ein Arbeitsfeld gestalten wollen, das einem + bereits vorhandenen ähnelt. + Nach Aufruf dieser Funktion werden Ihnen alle + Landschaften/Arbeitsfelder, die sich in Ihrer Task + befinden, zur Auswahl angeboten. Nach Ankreuzen + eines Namens wird die Auswahl automatisch verlas­ + sen. + Anschließend wird der angekreuzte Name ange­ + zeigt und der Name für die Kopie erfragt. Es muß ein + Name eingetragen werden, der in dieser Task noch + nicht für eine Landschaft/ein Arbeitsfeld verge­ + ben wurde - ansonsten erfolgt ein Hinweis darauf + und es wird nicht kopiert! + Da man aber oft für die Kopie einen ähnlichen + Namen wie für das Original wählt, wird der 'alte' + Name vorgeschlagen. Aus genannten Gründen muß er + aber verändert werden. Sie können diesen Namen mit + den üblichen Editierfunktionen verändern oder mit + löschen und ganz neu eingeben. Sie + sparen aber eine Menge Tipparbeit, wenn Sie einen + langen Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Landschaft/ein Arbeitsfeld mit dem ge­ + wünschten Namen existiert bereits in der Task. + +#on("u")##on("b")#u Umbenennen#off("b")##off("u")# + Mit dieser Funktion können Sie einer bereits + vorhandenen Landschaft/einem bereits vorhandenen + Arbeitsfeld einen neuen Namen geben. + Nach Aufruf dieser Funktion werden Ihnen alle + Landschaften/Arbeitsfelder, die sich in Ihrer Task + befinden, zur Auswahl angeboten. Nach Ankreuzen + eines Namens wird die Auswahl automatisch verlas­ + sen. + Anschließend wird dieser Name angezeigt und der + zukünftige Name für die Landschaft/das Arbeitsfeld + erfragt. Es muß ein Name eingetragen werden, der in + dieser Task noch nicht für eine Landschaft/ein Ar­ + beitsfeld vergeben wurde - ansonsten erfolgt ein + Hinweis darauf und die Landschaft/das Arbeitsfeld + wird nicht umbenannt! + Da man aber oft den 'neuen' Namen in Anlehnung + an den 'alten' Namen wählt, wird der 'alte' Name vor­ + geschlagen. Aus genannten Gründen muß er aber + verändert werden. Sie können diesen Namen mit den + üblichen Editierfunktionen verändern oder mit + löschen und ganz neu eingeben. Sie + sparen aber eine Menge Tipparbeit, wenn Sie einen + langen Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Datei mit dem gewünschten Namen existiert + bereits in der Task. +#page# +4.4 Menufunktionen zum Oberbegriff 'Programm' + +#on("b")# +HAMSTER: Info Landschaft Programm Lauf Archiv +---------------------+--------------------+------------------------------- + | n Neu erstellen | + | a Ansehen/Ändern | + | ---------------- | + | v Verzeichnis | + | ---------------- | + | l Löschen | + | d Drucken | + | ---------------- | + | k Kopieren | + | u Umbenennen | + +--------------------+ + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +#on("u")##on("b")#n Neu erstellen#off("b")##off("u")# + Mit dieser Funktion können Sie eine neue Pro­ + grammdatei anlegen und beschreiben. + Sie werden zunächst nach einem Namen für die + #on("u")#neue#off("u")# Programmdatei gefragt. Geben Sie einen belie­ + bigen Namen (#on("u")#ohne Anführungszeichen (!)#off("u")#) ein und + schließen Sie die Eingabe durch ab. Dar­ + aufhin wird Ihnen auf dem Bildschirm eine neue Da­ + tei zum Beschreiben angeboten. + Sollte schon eine Programmdatei mit diesem Na­ + men in der Task vorhanden sein, so werden Sie dar­ + auf aufmerksam gemacht. + Sie können sich während des Schreibens die + wichtigsten Tastenfunktionen des Editers einblen­ + den lassen. Tippen Sie dazu die Tastenfolge . + Es erscheint dann das folgende Angebot aus dem Sie + auswählen können: + + #on("b")# + +--------------------------------------------------+ + | Der EUMEL - Editor | + | | + | b ... Beschreibung des Editors | + | w ... Wichtige Tasten | + | p ... Positionieren der Schreibmarke | + | k ... Korrigieren im Text (Einfügen/Löschen) | + | m ... Markierte Textpassagen bearbeiten | + | l ... Lernen im Editor | + | a ... Anweisungen im Editor (Kommandodialog) | + | | + | z ... Zurück in den Schreibmodus | + | | + | b w p k m l a z | + +--------------------------------------------------+ +#off("b")# + + Fehlerfälle: + - Eine Datei mit dem vorgeschlagenen Namen exi­ + stiert schon. + +#on("u")##on("b")#a Ansehen/Ändern#off("b")##off("u")# + Mit dieser Funktion können Sie sich Dateien, die + schon in Ihrer Task existieren, ansehen oder auch + verändern. + Sie werden zunächst gefragt, ob Sie #on("u")#die zuletzt + bearbeitete Programmdatei#off("u")# ansehen bzw. verändern + möchten (sofern Sie schon vorher mit dem Modell in + der Task gearbeitet haben). + Bejahen Sie diese Frage, dann wird Ihnen diese + Programmdatei zur Bearbeitung angeboten. Vernei­ + nen Sie die Frage dagegen, so gelangen Sie in die + 'Auswahl' (d.h es werden Ihnen alle Programmdateien + in der Task zur Auswahl angeboten). Nachdem Sie + einen der Namen angekreuzt haben, wird Ihnen die + ausgewählte Programmdatei zur Bearbeitung auf dem + Bildschirm angeboten. + + Fehlerfälle: + - In der Task existiert noch keine Programmdatei. + +#on("u")##on("b")#v Verzeichnis#off("b")##off("u")# + Mit dieser Funktion können Sie sich einen Über­ + blick über die in Ihrer Task vorhandenen Programm­ + dateien verschaffen. + Nach Aufruf dieser Funktion wird eine Liste der + Programmdateien auf dem Bildschirm ausgegeben, die + sich in Ihrer Task befinden. Da die Liste selbst eine + Datei ist, kann Sie mit der Tastenkombination + verlassen werden - hierauf wird auch in + der Kopfzeile der Datei hingewiesen. Falls nicht + alle Namen auf den Bildschirm passen, können Sie + das Fenster mit und ver­ + schieben. + +#on("u")##on("b")#l Löschen#off("b")##off("u")# + Mit dieser Funktion können Sie Programmdateien, + die Sie nicht mehr benötigen, die unnötig Platz be­ + legen, löschen. Aber Vorsicht! Die Programmdateien + verschwinden durch diese Funktion unwieder­ + bringlich! + Nach Aufruf dieser Funktion werden Ihnen alle + Programmdateien, die sich in Ihrer Task befinden, + zur Auswahl angeboten. Hier können Sie die ge­ + wünschten Namen ankreuzen. Die Auswahl wird dann + durch die Tastenfolge verlassen. + Für jede einzelne Programmdatei wird noch ein­ + mal zur Sicherheit gefragt, ob sie auch tatsächlich + gelöscht werden soll. Zur Bestätigung tippen Sie + bitte die Taste ('ja') - zur Verhinderung + ('nein'). + + Fehlerfälle: + - In der Task exsitiert noch keine Programmdatei + +#on("u")##on("b")#d Drucken#off("b")##off("u")# + Mit dieser Funktion können Sie Programmdateien + über einen angeschlossenen Drucker ausgeben las­ + sen. + Nach Aufruf dieser Funktion werden Ihnen alle + Programmdateien, die sich in Ihrer Task befinden, + zur Auswahl angeboten. Hier können Sie die ge­ + wünschten Namen ankreuzen. Die Auswahl wird dann + durch die Tastenfolge verlassen. + Die angekreuzten Programmdateien werden an­ + schließend zum Drucker geschickt. Der Vorgang wird + auf dem Bildschirm protokolliert. + + Fehlerfälle: + - In der Task existiert noch keine Programmdatei. + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' + betrieben. + - Auf Ihrem System werden die Druckkosten abge­ + rechnet. Sie müssen sich mit einer Codenummer + identifizieren. + +#on("u")##on("b")#k Kopieren#off("b")##off("u")# + Mit dieser Funktion können Sie sich eine Kopie + einer bereits in der Task vorhandenen Programmda­ + tei anlegen. Das ist z.B. dann sinnvoll, wenn Sie sich + einen bestimmten 'Stand' aufbewahren wollen oder + wenn Sie ein Programm schreiben wollen, das einem + bereits vorhandenen ähnelt. + Nach Aufruf dieser Funktion werden Ihnen alle + Programmdateien, die sich in Ihrer Task befinden, + zur Auswahl angeboten. Nach Ankreuzen eines Na­ + mens wird die Auswahl automatisch verlassen. + Anschließend wird der angekreuzte Name ange­ + zeigt und der Name für die Kopie erfragt. Es muß ein + Name eingetragen werden, der in dieser Task noch + nicht für eine Programmdatei vergeben wurde; an­ + sonsten erfolgt ein Hinweis darauf und es wird + nicht kopiert! + Da man aber oft für die Kopie einen ähnlichen + Namen wie für das Original wählt, wird der 'alte' + Name vorgeschlagen. Aus genannten Gründen muß er + aber verändert werden. Sie können diesen Namen mit + den üblichen Editierfunktionen verändern oder mit + löschen und ganz neu eingeben. Sie + sparen aber eine Menge Tipparbeit, wenn Sie einen + langen Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Programmdatei mit dem gewünschten Namen + existiert bereits in der Task. + +#on("u")##on("b")#u Umbenennen#off("b")##off("u")# + Mit dieser Funktion können Sie einer bereits + vorhandenen Programmdatei einen neuen Namen ge­ + ben. + Nach Aufruf dieser Funktion werden Ihnen alle + Programmdateien, die sich in Ihrer Task befinden, + zur Auswahl angeboten. Nach Ankreuzen eines Na­ + mens wird die Auswahl automatisch verlassen. + Anschließend wird dieser Name angezeigt und der + zukünftige Name für die Programmdatei erfragt. Es + muß ein Name eingetragen werden, der in dieser Task + noch nicht für eine Programmdatei vergeben wurde - + ansonsten erfolgt ein Hinweis darauf und die Pro­ + grammdatei wird nicht umbenannt! + Da man aber oft den 'neuen' Namen in Anlehnung + an den 'alten' Namen wählt, wird der 'alte' Name vor­ + geschlagen. Aus genannten Gründen muß er aber + verändert werden. Sie können diesen Namen mit den + üblichen Editierfunktionen verändern oder mit + löschen und ganz neu eingeben. Sie + sparen aber eine Menge Tipparbeit, wenn Sie einen + langen Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Programmdatei mit dem gewünschten Namen + existiert bereits in der Task. +#page# +4.5 Menufunktionen zum Oberbegriff 'Lauf' + +#on("b")# +HAMSTER: Info Landschaft Programm Lauf Archiv +---------------------------+------------------------+--------------------- + | l Lauf nach Programm | + | h Handsteuerung | + +------------------------+ + + + + + + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +#on("u")##on("b")#l Lauf nach Programm#off("b")##off("u")# + Mit dieser Menufunktion können Sie den Ham­ + ster/Roboter nach einem Programm in einer Land­ + schaft/einem Arbeitsfeld laufen lassen. Sowohl das + Programm als auch die Landschaft/das Arbeitsfeld + müssen bereits existieren. + Sie werden zunächst gefragt, ob der Hamster/ + Roboter #on("u")#das zuletzt bearbeitete Programm#off("u")# ausführen + soll. Bejahen Sie die Frage, so wird dieses Programm + ausgeführt; verneinen Sie die Frage dagegen, so + gelangen Sie in die 'Auswahl'. Nach Ankreuzen des + gewünschten Programmnamens wird das ausgewählte + Programm ausgeführt. + Nach der Abfrage bezüglich des Programmnamens + erfolgt dann eine weitere Abfrage nach dem Namen + der Landschaft/ des Arbeitsfeldes, in der/dem der + Hamster/Roboter nach dem zuvor ausgewählten Pro­ + gramm laufen soll. Auch hier werden Sie zunächst + gefragt, ob Sie #on("u")#die zuletzt benutzte Landschaft/das + zuletzt benutzte Arbeitsfeld#off("u")# verwenden möchten. + Bejahen Sie die Frage, so wird das Programm in + dieser Landschaft/in diesem Arbeitsfeld ausge­ + führt; verneinen Sie dagegen die Frage, so werden + Ihnen alle in der Task vorhandenen Landschaften/ + Arbeitsfelder zur Auswahl angeboten. Durch An­ + kreuzen eines Landschafts-/Arbeitsfeldnamens wird + die betreffende Landschaft/das betreffende Ar­ + beitsfeld ausgewählt und das Programm in dieser + Landschaft/in diesem Arbeitsfeld ausgeführt. + Daneben haben Sie auch die Möglichkeit, im Pro­ + gramm selbst als erste Anweisung den Befehl 'lands­ + chaft ("Name");' oder 'arbeitsfeld ("Name");' anzuge­ + ben. Für 'Name' muß dann natürlich der gewünschte + Landschafts-/Arbeitsfeldname eingetragen sein. Ist + eine solche Anweisung #on("u")#am Programmanfang#off("u")# vorhan­ + den, so wird an Sie #on("u")#keine#off("u")# Abfrage bezüglich des + Landschafts-/Arbeitsfeldnamens gestellt; das Pro­ + gramm wird in der #on("u")#angegebenen#off("u")# Landschaft/im #on("u")#ange­ + gebenen#off("u")# Arbeitsfeld ausgeführt. + Sind im Programm noch Fehler enthalten, so wer­ + den das Programm und die Fehlermeldungen gleich­ + zeitig auf dem Bildschirm dargestellt (Paralleledi­ + tor) und zur Korrektur angeboten. Für die Pro­ + grammkorrektur stehen ebenfalls alle Editorfunk­ + tionen zur Verfügung. + Während des Hamster-/Roboterlaufs können Sie + durch Tastendruck Einfluß nehmen (Geschwindigkeit + verändern, Programm abbrechen etc). Sehen Sie dazu + auch die Menufunktion 's Steuerung des Laufs' unter + dem Oberbegriff 'Info'. Standardmäßig beginnt ein + solcher Lauf immer mit einer mittleren Geschwin­ + digkeit. + Ist der Hamster-/Roboterlauf ohne Fehler been­ + det worden, werden Sie gefragt, ob Sie die Land­ + schaft/das Arbeitsfeld in dem zuletzt angezeigten + Zustand aufbewahren wollen. Bejahen Sie diese Fra­ + ge, so wird die Landschaft/das Arbeitsfeld in eine + Datei geschrieben. Die neue Landschaft/das neue + Arbeitsfeld erhält den Namen der alten Land­ + schaft/des alten Arbeitsfeldes und das Zusatzkenn­ + zeichen '.x'. + Sollte Ihnen beim Programmieren ein Fehler un­ + terlaufen sein (z.B. eine Endlosschleife, so kann mit + der Taste der Hamster-/Roboterlauf abgebro­ + chen werden ("Notbremse"). + +#on("u")##on("b")#h Handsteuerung#off("b")##off("u")# + Mit dieser Funktion können Sie den Hamster/ + Roboter in einer/einem vorbereiteten Landschaft/ + Arbeitsfeld durch Tasten steuern. Alle gültigen + Tastenbefehle werden in einem Protokoll festgehal­ + ten. Da das entstehende Protokoll ein ELAN- + Programm ist, kann der Hamster/Roboter anschlie­ + ßend die gleichen Aktionen anhand des Programms + wiederholt ausführen ('Teach In'). + Sie werden zunächst gefragt, ob die Land­ + schaft/das Arbeitsfeld, in dem der Hamster/Roboter + gesteuert werden soll, schon existiert. Beantworten + Sie die Frage mit 'nein', so werden Sie aufgefordert, + zunächst die Landschaft/das Arbeitsfeld zu gestal­ + ten. Bejahen Sie die Frage, werden Ihnen alle in Ih­ + rer Task vorhandenen Landschaften/Arbeitsfelder + zur Auswahl angeboten. Sie brauchen nur die ge­ + wünschte Landschaft/das gewünschte Arbeitsfeld + anzukreuzen. Die/das angekreuzte Landschaft/Ar­ + beitsfeld erscheint dann in folgender Darstellung + auf dem Bildschirm: + +#on("b")# +#on("u")#Beispiel#off("u")#: + + or inks um imm ib

rotokoll nde +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . V . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . o\#\# o . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . .\#\# . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . o\#\# . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . .\#\# o . . . o . . . . . . . . . . . . . . . +. . . . . . . . . . . . o\#\#\#\#\#\#\#\#\#\#\#\# o . . . . . . . . . . . . . . +. . . . . . . . . . . . . . o . o .\#\# . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . o\#\# . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . .\#\# . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . o\#\#o. . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +Gib Hamster-Befehl: letzter Befehl: + +#off("b")# + Durch Tastendruck können Sie nun den Hamster/ + Roboter steuern ( - vor, - links um, - + nimm, - gib). Sofern die Aktion ausführbar ist, + wird sie auf dem Bildschirm auch ausgeführt. Wird + dagegen eine Aktion verlangt, die nicht ausgeführt + werden kann (z.B. , wenn der Hamster/Roboter + direkt vor einem Hindernis steht), so erscheint eine + entsprechende Fehlermeldung in der untersten Zeile + des Bildschirms. Nach einer kurzen Pause können + dann weitere Eingaben gemacht werden. Eine Fehlbe­ + dienung führt also #on("u")#nicht#off("u")# zu einem Programmabbruch! + In der untersten Bildschirmzeile wird auch jeweils + der letzte Befehl zur Kontrolle angezeigt. + Alle korrekten Eingaben werden protokolliert. + Durch Drücken der Taste

(- protokoll) können Sie + sich jederzeit das während der Ausführung angeleg­ + te Protokoll zeigen lassen. Es entsteht nämlich + automatisch im Hintergrund ein ablauffähiges + ELAN-Programm. Im Anschluß an eine solche Hand­ + steuerung können Sie den Hamster/Roboter dann in + der gleichen Landschaft/im gleichen Arbeitsfeld + nach diesem Protokoll (Dateiname: PROTOKOLL) vom + Programm aus gesteuert laufen lassen. +#page# +4.6 Menufunktionen zum Oberbegriff 'Archiv' + +#on("b")# +HAMSTER: Info Landschaft Programm Lauf Archiv +---------------------------------+-------------------------+-------------- + | r Reservieren | + | - Neue Diskette | + | --------------------- | + | - Schreiben | + | - Checken | + | - Kombination | + | - Holen/Lesen | + | - Löschen | + | --------------------- | + | - Verzeichnis | + | - Drucken | + | --------------------- | + | i Initialisieren | + | z Zieltask einstellen | + +---------------------+ +-------------------------+ + | Dateiaustausch mit: | + | Archiv | + | Archivname: | + | --- | + +---------------------+ +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + + In diesem Kapitel werden alle die Menufunktionen be­ +schrieben, die Ihnen unter dem Oberbegriff 'Archiv' im +Menu angeboten werden. Mit den Funktionen in diesem +Menu können Sie aber nicht nur Dateien auf dem Archiv +behandeln, sondern auch in anderen Tasks im Multi- +User-System oder über das EUMEL-Netz sogar auf anderen +Rechnern! + Wenn Sie dieses Pull-Down-Menu gerade aufgeschlagen +haben, sind nicht alle Funktionen aktivierbar! Um weitere +Funktionen zu aktivieren, muß erst einer der aktivierba­ +ren Menupunkte gewählt werden. + Bei der Archivbehandlung werden Ihnen jeweils alle in +der Task vorhandenen Dateien zur Auswahl angeboten. Das +System unterscheidet nicht von sich aus - wie unter den +Oberbegriffen 'Landschaft'/'Arbeitsfeld' und 'Programm' - +zwischen Landschaften/Arbeitsfeldern und Programmda­ +teien. In den hier gezeigten Listen können Sie aber Land­ +schaften/Arbeitsfelder daran erkennen, daß ihnen das +Präfix 'Flaeche:' vorangestellt ist. + +#on("u")##on("b")#r Reservieren#off("b")##off("u")# (des Archivlaufwerks) + Im EUMEL-Multi-User-System haben normalerwei­ + se mehrere Personen das Zugriffsrecht auf das Ar­ + chivlaufwerk. Allerdings muß der Zugriff so gere­ + gelt werden, daß sich die Beteiligten dabei nicht + gegenseitig "in die Quere kommen". Ein Zugriff auf + das Archivlaufwerk erfordert zunächst eine Anmel­ + dung. Ist diese Anmeldung erfolgt, kann von den an­ + deren Beteiligten so lange nicht mehr auf das Lauf­ + werk zugegriffen werden - bis es wieder freigege­ + ben worden ist. + Diese Anmeldung des Archivlaufwerkes erfolgt + über die Menufunktion 'r Reservieren'. Greift be­ + reits eine andere Task auf das Laufwerk zu, so er­ + halten Sie darüber einen Hinweis auf dem Bild­ + schirm. Ansonsten wird an Sie die Frage gestellt, ob + die Diskette eingelegt und das Laufwerk geschlos­ + sen ist. + Erst zu diesem Zeitpunkt ist sichergestellt, daß + Sie den alleinigen Zugriff auf das Laufwerk haben. + Deshalb sollten Sie, wenn Sie mit mehreren Personen + am Computer arbeiten, erst zum Zeitpunkt der Frage­ + stellung die Diskette ins Laufwerk einlegen. + Nachdem Sie die Diskette eingelegt und die Frage + bejaht haben, ermittelt das System selbständig den + Namen der eingelegten Diskette, zeigt den Namen auf + dem Bildschirm (im kleinen Kasten links unten) an + und aktiviert die anderen Menupunkte des Pull- + Down-Menus. + Beim Verlassen des Pull-Down-Menus, wenn eine + andere Zieltask eingestellt wird oder wenn das Menu + gänzlich verlassen wird, wird die Reservierung au­ + tomatisch aufgehoben! + + Fehlerfälle: + - Das Laufwerk ist von einer anderen Task belegt. + - Die Diskette ist falsch eingelegt oder das Lauf­ + werk ist nicht richtig geschlossen. + - Die Diskette ist nicht formatiert bzw. initiali­ + siert. + - Die Diskette kann nicht gelesen werden (keine + EUMEL-Diskette, Diskette hat ein falsches For­ + mat, Diskette ist verschmutzt...). + +#on("u")##on("b")#n Neue Diskette#off("b")##off("u")# (anmelden) + Der Dateiaustausch mit einer Diskette ist nur + dann möglich, wenn der im System eingestellte Dis­ + kettenname (auf dem Bildschirm im kleinen Kasten + unten links sichtbar) mit dem tatsächlichen Namen + der Diskette übereinstimmt. Nach einem Disketten­ + wechsel ist das aber in der Regel nicht mehr der + Fall. Greift man dann auf die neu eingelegte Dis­ + kette zu, so erscheint die Fehlermeldung: 'Falscher + Archivname! Bitte neue Diskette anmelden!'. + Das Anmelden einer neuen Diskette - ohne einen + neuen Reserviervorgang - wird durch diese Menu­ + funktion ermöglicht. Nach Aktivieren dieses Menu­ + punktes wird der Name der eingelegten Diskette er­ + mittelt, im System eingestellt und auf dem Bild­ + schirm angezeigt. + Im Gegensatz zur Menufunktion 'r Reservieren' + greift das System ohne Anfrage an den Benutzer auf + das Archivlaufwerk zu (die Reservierung bleibt ja + bestehen). Ist das Archivlaufwerk reserviert, so ist + die Neuanmeldung einer Diskette über diese Menu­ + funktion weniger zeitaufwendig. + + Fehlerfälle: + - wie unter 'r Reservieren'. + +#on("u")##on("b")#s Schreiben#off("b")##off("u")# (Kopieren) + Alle Dateien der eigenen Task werden zur Aus­ + wahl angeboten. Wenn Sie die Auswahl durch die + Tastenfolge verlassen, überprüft das Sy­ + stem zunächst, ob die Dateien in der eingestellten + Zieltask schon vorhanden sind. Ist das der Fall, + wird erfragt, ob die dort vorhandenen Dateien über­ + schrieben, d.h. gelöscht werden dürfen (s.u.). An­ + schließend werden alle angekreuzten Dateien in der + Reihenfolge, in der Sie sie angekreuzt haben, in die + eingestellte Zieltask kopiert. Der Vorgang wird auf + dem Bildschirm protokolliert. Die Originaldateien + in der eigenen Task bleiben dabei erhalten. + Wenn in der Zieltask schon eine Datei existiert, + die den gleichen Namen hat wie eine Datei, die Sie + dorthin kopieren möchten, so wird angefragt, ob die + vorher schon existierende Datei überschrieben (ge­ + löscht!) werden soll. Bejahen Sie diese Frage, so wird + die bereits in der Zieltask existierende Datei (un­ + wiederbringlich) gelöscht und die gewünschte Datei + dorthin transportiert. Ein Überschreiben aus Ver­ + sehen ist nicht möglich, wenn Sie die an Sie gestell­ + te Frage sorgfältig beantworten. + Verneinen Sie die Frage, so wird die Datei auch + nicht hinübertransportiert! Sie können die Datei + aber umbenennen (Menufunktion 'u Umbenennen' un­ + ter den Oberbegriffen 'Landschaft'/Arbeitsfeld' bzw. + 'Programm') und anschließend mit anderem Namen + hinüberschreiben. + Beachten Sie, daß beim Überschreiben einer Datei + auf einer Archivdiskette der Speicherplatz der al­ + ten (überschriebenen) Version im allgemeinen nicht + wiederverwendet werden kann. In einem solchen Fall + könnte die Diskette voll geschrieben werden, obwohl + eigentlich genügend Platz vorhanden wäre. Zur Op­ + timierung wird deshalb zuerst überprüft, ob die + angekreuzten Dateien schon in der Zieltask vorhan­ + den sind und löscht diese, wenn Sie Ihr Einver­ + ständnis geben. Erst anschließend werden die Datei­ + en insgesamt kopiert. + Normalerweise ist als Zieltask das Archivlauf­ + werk der eigenen Station eingestellt. Mit der Menu­ + funktion 'z Zieltask einstellen' kann diese Einstel­ + lung aber verändert werden. + + Fehlerfälle: + - Die Diskette ist falsch eingelegt oder beschä­ + digt. + - Die Diskette kann nicht beschrieben werden + (Schreibfehler). + - Die Diskette ist voll. + - Sehen Sie auch unter 'r Reservieren' + 'z Zieltask einstellen'. + +#on("u")##on("b")#c Checken#off("b")##off("u")# + Diese Menufunktion kann nur ausgeführt werden, + wenn der Dateiaustausch mit einem Archiv(manager) + erfolgt - ansonsten ist diese Menufunktion auch + nicht aktivierbar. Die Menufunktion dient dazu, auf + Diskette geschriebene Dateien auf Lesefehler hin zu + prüfen. Es empfiehlt sich, diese Prüfroutine auf + neu auf die Diskette geschriebene Dateien anzuwen­ + den. Sehen Sie dazu auch 'k Kombination'. + Alle Dateien der eingestellten Zieltask (Archiv) + werden zur Auswahl angeboten. Wenn Sie die Auswahl + durch die Tastenfolge verlassen, werden + alle angekreuzten Dateien in der Reihenfolge, in + der Sie sie angekreuzt haben, "gecheckt", d.h. auf + Lesefehler hin überprüft. Der Vorgang wird auf dem + Bildschirm protokolliert. + + Fehlerfälle: + - Lesefehler auf dem Archiv. + - Sehen Sie auch unter 'r Reservieren'. + +#on("u")##on("b")#k Kombination#off("b")##off("u")# + Diese Menufunktion ist eine Kombination aus den + beiden Menufunktionen 's Schreiben' und 'c Checken' + (Sehen Sie weitere Informationen auch dort!). + Alle Dateien der eigenen Task werden zur Aus­ + wahl angeboten. Wenn Sie die Auswahl durch die Ta­ + stenfolge verlassen, werden alle ange­ + kreuzten Dateien in der Reihenfolge, in der Sie sie + angekreuzt haben, in die eingestellte Zieltask ko­ + piert (gegebenenfalls müssen bereits vorhandene + Dateien gleichen Namens in der Zieltask gelöscht + werden). Anschließend werden alle Dateien, die gera­ + de geschrieben wurden, gecheckt, d.h. auf Lesefehler + hin untersucht. Beide Vorgänge werden auf dem + Bildschirm protokolliert. + Da die 'Check' - Operation nur bei Archivmana­ + gern zulässig ist, ist diese Menufunktionen eben­ + falls nur bei Archivmanagern aktivierbar. Zur Er­ + läuterung sehen Sie bitte auch unter 'z Zieltask + einstellen'. + +#on("u")##on("b")#h Holen/Lesen#off("b")##off("u")# + Die Menufunktion dient dazu, Dateien, die bereits + auf einer Archivdiskette oder in einer anderen Task + existieren, in die eigene Task zu kopieren. + Alle Dateien der eingestellten Zieltask werden + zur Auswahl angeboten. Anschließend werden Kopien + der angekreuzten Dateien in der Reihenfolge des + Ankreuzens in die eigene Task geholt. Das Original + in der Zieltask bleibt dabei unverändert! Der Vor­ + gang wird auf dem Bildschirm protokolliert. + Sind in der eigenen Task schon Dateien mit glei­ + chem Namen vorhanden, so wird gefragt, ob die 'al­ + ten' Dateien überschrieben (gelöscht) werden dürfen. + Nur wenn Sie zustimmen, werden die in Ihrer Task + existierenden Dateien (unwiederbringlich!) gelöscht + und Kopien der gleichnamigen Dateien aus der Ziel­ + task angefertigt. + Stimmen Sie dem Löschvorgang nicht zu, dann + bleiben die bisherigen Dateien in Ihrer Task erhal­ + ten - die Dateien aus der Zieltask werden dann aber + auch nicht in Ihre Task kopiert! Um dennoch die Ko­ + pien zu erhalten, können Sie die namensgleichen + Dateien in Ihrer Task umbenennen und dann erst die + Dateien aus der anderen Task anfordern. + Normalerweise werden die Dateien vom Archiv der + eigenen Station geholt. Mit dem Menupunkt 'z Ziel­ + task einstellen' kann diese Einstellung verändert + werden. + + Fehlerfälle: + - Lesefehler auf dem Archiv. + - Sehen Sie auch unter 'r Reservieren' + 's Schreiben' + 'z Zieltask einstellen'. + +#on("u")##on("b")#l Löschen#off("b")##off("u")# + Die Menufunktion dient dazu, Dateien in der + Zieltask (unwiederbringlich!) zu löschen. Dazu wer­ + den alle Dateien der eingestellten Zieltask zur Aus­ + wahl angeboten. Anschließend werden die angekreuz­ + ten Dateien in der Reihenfolge ihres Ankreuzens + gelöscht. Zur Sicherheit muß noch einmal für jede + einzelne Datei bestätigt werden, daß sie auch tat­ + sächlich gelöscht werden soll. + Beachten Sie, daß beim Löschen einer Datei auf + einer Archivdiskette der Speicherplatz im allgemei­ + nen nicht wieder verwendet werden kann. In einem + solchen Fall könnte die Diskette voll geschrieben + werden, obwohl eigentlich genügend Platz vorhan­ + den wäre. Diese Probleme treten bei anderen Tasks, + die keine Archivmanager sind, nicht auf, da deren + Speicherplatz intelligenter verwaltet wird. + Normalerweise ist als Zieltask das Archiv der + eigenen Station eingestellt. Mit dem Menupunkt 'z + Zieltask einstellen' kann diese Einstellung verän­ + dert werden. + + Fehlerfälle: + - Sehen Sie auch unter 'r Reservieren' + 's Schreiben' + 'z Zieltask einstellen'. + +#on("u")##on("b")#v Verzeichnis#off("b")##off("u")# + Mit dieser Menufunktion können Sie sich einen + Überblick über die in der Zieltask (z.B. auf dem Ar­ + chiv) vorhandenen Dateien verschaffen. + Nach Aufruf der Funktion wird eine Liste der + Dateien auf dem Bildschirm ausgegeben, die sich in + der Zieltask (z.B. auf dem Archiv) befinden. Ist die + Zieltask ein Archiv(manager), so wird auch ange­ + zeigt, wieviel Platz auf der Diskette belegt ist. Da + die Liste selbst eine Datei ist, kann sie mit der Ta­ + stenkombination verlassen werden. Falls + nicht alle Dateinamen auf den Bildschirm passen, + können Sie das Fenster mit und + verschieben. + + Fehlerfälle: + - Sehen Sie unter 'z Zieltask einstellen'. + +#on("u")##on("b")#d Drucken#off("b")##off("u")# + Das Verzeichnis der Dateien in der Zieltask, das + man mit der Menufunktion 'v Verzeichnis' auf dem + Bildschirm angezeigt bekommt, kann mit dieser Me­ + nufunktion ausgedruckt werden. + Zur Sicherheit wird angefragt, ob wirklich ein + solches Dateiverzeichnis der Zieltask gedruckt wer­ + den soll. Bejaht man die Frage, so wird ein Dateiver­ + zeichnis erstellt und zum Drucker geschickt. + + Fehlerfälle: + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' + betrieben. + - Auf Ihrem System werden die Druckkosten abge­ + rechnet. Sie müssen sich mit einer Codenummer + identifizieren. + +#on("u")##on("b")#i Initialisieren#off("b")##off("u")# + Diese Menufunktion gestattet es, frische Disket­ + ten zu formatieren, zu initialisieren bzw. be­ + schriebene Disketten vollständig zu löschen und + ggf. dabei umzubenennen. Bei Aufruf dieser Menu­ + funktion wird - sofern noch nicht geschehen - das + Archivlaufwerk automatisch reserviert. + Wenn Sie eine fabrikneue Diskette aus der Ver­ + packung nehmen, müssen Sie diese zunächst #on("u")#forma­ + tieren#off("u")#. Dabei wird die Diskette auf ein festgelegtes + physikalisches Format eingestellt. Ohne daß diese + Operation vorausgegangen ist, kann eine Diskette + weder beschrieben noch gelesen werden. + Prinzipiell braucht eine Diskette nur ein einzi­ + ges Mal formatiert zu werden. Sie können Sie jedoch + jederzeit wieder formatieren - z.B. wenn Sie Disket­ + ten haben, von denen Sie nicht genau wissen, für + welche Zwecke sie zuvor verwendet wurden. + Wenn Sie diese Menufunktion aktivieren, werden + Sie so zunächst gefragt, ob Sie die Diskette auch + formatieren wollen. Bejahen Sie die Frage, so werden + Ihnen mehrere Formate zur Auswahl angeboten: + +#on ("b")# + +------------------------------------+ + | Formatieren einer Diskette | + | | + | Dies sind die möglichen Formate: | + | | + | 1 ..... 40 Spur - 360 KB | + | 2 ..... 80 Spur - 720 KB | + | 3 ..... 5 1/4" - 1,2 MB | + | 4 ..... 3 1/2" - 1,4 MB | + | s ..... Standard - Format | + | | + | 1 2 3 4 s | + +------------------------------------+ +#off("b")# + + Erkundigen Sie sich bei Ihrem Händler, welches + Format Sie bei Ihrem Rechner und den von Ihnen + verwendeten Disketten einstellen müssen. Manche + Rechner unterstützen diese Operation innerhalb des + EUMEL-Systems auch gar nicht, das Formatieren muß + dann irgendwie anders außerhalb des EUMEL-Systems + geschehen. + Wenn Sie die Formatierung abgeschlossen oder + auch übersprungen haben, beginnt die eigentliche + Initialisierung der Diskette. Dabei wird als erstes + der Archivname auf die Diskette geschrieben. Alle + alten Daten, die sich ggf. auf der Diskette befinden, + werden bei diesem Vorgang unwiederbringlich (!) + gelöscht. + Zur Sicherheit überprüft das System in jedem + Falle, ob es sich um eine EUMEL - Diskette handelt, + und erfragt Ihr Einverständnis, ob die Diskette + wirklich initialisiert werden soll. Geben Sie hierzu + Ihr Einverständnis, dann wird noch der (neue) Ar­ + chivname erfragt. Hatte die Diskette schon einen + Namen, dann wird dieser zum Überschreiben angebo­ + ten. Wollen Sie den alten Archivnamen beibehalten, + so brauchen Sie nur die -Taste zu tippen, + ansonsten können Sie den Namen auch zuvor verän­ + dern oder einen ganz neuen Namen hinschreiben. + Anhand des ausgegebenen Namens können Sie auch + überprüfen, ob Sie die richtige Diskette eingelegt + haben. + Das Initialisieren funktioniert natürlich nur, + wenn Sie als Zieltask einen Archivmanager einge­ + stellt haben - ansonsten ist diese Menufunktion + gesperrt (nicht aktivierbar!). + + Fehlerfälle: + - Formatieren ist nicht auf dem System möglich. + - Sehen Sie auch unter 'r Reservieren' + 'z Zieltask einstellen'. + +#on("u")##on("b")#z Zieltask einstellen#off("b")##off("u")# + Mit dieser Menufunktion können Sie festlegen, + mit welcher Zieltask Sie kommunizieren, d.h. z.B. Da­ + teien austauschen möchten. Normalerweise ist hier + das Archiv am eigenen Rechner eingestellt. Das wird + auch nach Aufklappen des Pull-Down-Menus im Ka­ + sten links unten angezeigt. + Diese Menufunktion kann im Unterricht z.B. dazu + genutzt werden, um fertiggestellte Hausaufgaben in + eine bestimmte Task zu schicken (Vatertask) oder um + von dort z.B. vorgefertigte Landschaften oder/und + Programme abzuholen. + Sie können aber auch eine andere Task einstellen + (z.B. die Vatertask oder die Task 'PUBLIC'), um mit die­ + sen Dateien auszutauschen oder um sich auch nur ei­ + nen Überblick über die dort vorhandenen Dateien zu + verschaffen. Wenn Sie mit Ihrem Rechner in ein + EUMEL-Netz integriert sind, können Sie auch auf + Tasks anderer Rechner zugreifen oder auch Disketten + von Laufwerken anderer Rechner einlesen (z.B. wenn + Sie Disketten anderer Formate haben, die von Ihrem + Rechner nicht gelesen werden können). + Dabei werden zwei Anforderungen an die Zieltask + gestellt: Sie muß existieren und bereit für den Da­ + teiaustausch sein, d.h es muß eine Managertask sein, + auf die Sie Zugriff haben. Versuchen Sie auf andere + Tasks zuzugreifen, so erhalten Sie entsprechende + (Fehler-)Meldungen. + Zu beachten ist noch, daß es im EUMEL-System ver­ + schiedene Arten von Managertasks gibt - Archivma­ + nager und normale Dateimanager. Der Unterschied + besteht darin, daß ein Archivmanager vom Benutzer + vor dem Zugriff reserviert werden muß - anschlie­ + ßend hat nur dieser Benutzer (bis zur Aufgabe der + Reservierung) ein Zugriffsrecht auf den Manager. + Normale Dateimanager können dagegen von mehreren + Benutzern in beliebiger Reihenfolge angesprochen + werden. + Ein Archivmanager kann auch auf bestimmte Dis­ + kettenformate spezialisert sein (z.B. auf das Lesen + von DOS-Disketten). Manche Rechner haben auch meh­ + rere Archivmanager für verschiedene Laufwerke etc. + Durch Einstellen unterschiedlicher Archivmanager + können Sie dann auf verschiedenen Laufwerken ar­ + chivieren. + Nach Aktivieren dieses Menupunktes werden Ihnen + die folgenden Alternativen angeboten: + +#on ("b")# + +-------------------------------------------+ + | Dateiaustausch gewünscht mit: | + | | + | a ... Archiv (Eigene Station) | + | | + | v ... Vatertask | + | | + | p ... 'PUBLIC' (Eigene Station) | + | | + | s ... Sonstige Task | + | | + | | + | Archiv Vatertask PUBLIC Sonstige | + +-------------------------------------------+ + + Da der Dateiaustausch mit dem Standardarchiv + der eigenen Station (Task: 'ARCHIVE'), mit der Vater­ + task und der Task 'PUBLIC' recht häufig in Anspruch + genommen wird, sind diese drei Optionen unter den + Alternativen direkt angegeben. Entscheiden Sie sich + für eine dieser drei Tasks, so nimmt das System alle + notwendigen Einstellungen vor. Möchten Sie dage­ + gen in Kontakt mit einer anderen Task treten, so + wählen Sie die Alternative 's ... Sonstige Task'. + In diesem Falle haben Sie noch 3 Angaben zu machen: + + - Zunächst werden Sie nach dem Namen der Zieltask + gefragt. Geben Sie den Namen der Zieltask - ohne + Anführungsstriche (!) - ein und schließen Sie die + Eingabe mit der -Taste ab. (Den ausge­ + gebenen Namen der z.Z. eingestellten Task können + Sie dabei verändern bzw. überschreiben.) + + - Dann wird die Nummer der Station im EUMEL-Netz + erfragt, auf der sich die Zieltask befindet. Die + Nummer Ihrer Station wird als Vorschlag ausge­ + geben. Wollen Sie mit einer Task auf Ihrem Rech­ + ner kommunizieren, so brauchen Sie diesen Vor­ + schlag nur durch Drücken der -Taste + bestätigen - ansonsten tragen Sie zuvor die ent­ + sprechende Stationsnummer ein. Ist Ihr Rechner + nicht in ein EUMEL-Netz integriert, so wird die + Stationsnummer 0 (Null) ausgegeben. Bitte bestä­ + tigen Sie diese Stationsnummer durch Tippen der + -Taste. + + - Zum Abschluß müssen Sie noch angeben, ob die + eingestellte Zieltask ein Archivmanager ist oder + nicht. + + Das System versucht dann den Kontakt herzu­ + stellen. Je nachdem, welche Einstellung Sie vorge­ + nommen haben, sind bestimmte Funktionen innerhalb + des Menus nicht aktivierbar. Das System läßt nur + die Funktionen zu, die aufgrund Ihrer Einstellun­ + gen zulässig sind. + Im Kasten links unten auf dem Bildschirm wird + jeweils angezeigt, welche Zieltask eingestellt ist. + Erscheint in diesem Kasten auch ein Hinweis auf den + Archivnamen, so haben Sie einen Archivmanager ein­ + gestellt. Ist dagegen vor dem Namen der Zieltask + noch eine Zahl und ein Schrägstrich angegeben, so + haben Sie eine Zieltask auf einem anderen Rechner + eingestellt. + Bedenken Sie, daß Operationen mit Tasks auf an­ + deren Stationen länger andauern können - werden + Sie nicht ungeduldig! + Sie können die Einstellung der Zieltask jeder­ + zeit wieder verändern! + + Fehlerfälle: + - Die eingestellte Zieltask existiert nicht. + - Die eingestellte Zieltask existiert zwar, ist aber + nicht empfangsbereit, d.h. ein Zugriff von Ihrer + Task aus ist nicht möglich! + - Das Netz ist nicht funktionsbereit (Collector- + Task fehlt). + - Die Kommunikation war nicht erfolgreich. + - Die gewünschte Operation kann mit der einge­ + stellten Zieltask nicht ausgeführt werden (Ziel­ + task ist z.B. gar kein Archivmanager - Sie aber + versuchen, das Laufwerk zu reservieren). + diff --git a/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 5 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 5 new file mode 100644 index 0000000..bb4a67b --- /dev/null +++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 5 @@ -0,0 +1,167 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (61)# +#headodd# +#center#gs-Herbert und Robbi#right#% + +#end# +#headeven# +%#center#gs-Herbert und Robbi + +#end# +#center#5 + +#center#Detailbeschreibung +#center#der +#center#Basisbefehle + + +#on("u")#'vor' bewirkt:#off("u")# + - ein Eingabezeichen wird von der Tastatur gelesen + und ausgewertet. + - es wird je nach Verzögerungsfaktor (eine vorgege­ + bene Wartezeit, die auch während des Programmlaufs + verändert werden kann) gewartet. + - falls die Kachel vor dem Hamster/Roboter noch frei + ist und zur Landschaft/zum Arbeitsfeld gehört, + geht der Hamster/ Roboter um eine Kachel in der + augenblicklichen Richtung vorwärts. + - falls vor dem Hamster/Roboter ein Hindernis liegt, + oder wenn er im Begriff ist, aus der Landschaft/aus + dem Arbeitsfeld herauszulaufen, wird das Programm + mit entsprechender Fehlermeldung abgebrochen. + +#on("u")#'links um' bewirkt:#off("u")# + - wie bei 'vor': Annahme eines Tastendruckes und + Warten. + - eine Drehung des Hamsters/Roboters um 90 Grad ge­ + gen den Uhrzeigersinn. + +#on("u")#'nimm' bewirkt:#off("u")# + - wie bei 'vor': Annahme eines Tastendruckes und + Warten. + - falls auf der Kachel, auf der der Hamster/Roboter + steht, kein Korn/Werkstück liegt, wird das Programm + mit entsprechender Fehlermeldung abgebrochen. + - falls dort genau ein Korn/ein Werkstück liegt, wird + dieses auf dem Bildschirm entfernt. Es wird zu denen + in den Backentaschen/im Behälter addiert. Auf dem + Bildschirm erscheint an der Stelle (" ."). + - falls mehrere Körner/Werkstücke dort liegen, wird + eines zu denen in den Backentaschen/im Behälter + addiert und von denen auf der Kachel subtrahiert. + Auf dem Bildschirm erscheint weiterhin an der Stel­ + le (" o"). + +#on("u")#'gib' bewirkt:#off("u")# + - wie bei 'vor': Annahme eines Tastendruckes und + Warten. + - falls die Backentaschen/der Behälter leer sind/ist, + wird das Programm mit entsprechender Fehlermel­ + dung abgebrochen. + - falls auf der Kachel schon ein Korn/Werkstück oder + mehrere Körner/Werkstücke liegen, wird zu ihnen + eines addiert und von denen in den Backentaschen/ + im Behälter subtrahiert. Der Bildschirm ändert sich + nicht. + - falls noch kein Korn/Werkstück auf dieser Kachel + liegt, wird auf dem Bildschirm ein (" o") ausgegeben + und von den Körnern/Werkstücken in den Backenta­ + schen/im Behälter ein Korn/Werkstück subtrahiert. + +#on("u")#'vorn frei'#off("u")# + - liefert den Wahrheitswert TRUE, wenn vor dem Ham­ + ster/ Roboter keine Hinderniskachel liegt, #on("u")#also + auch dann, wenn der Hamster/Roboter im Begriff ist, + über die Landschafts-/Arbeitsfeldgrenze (den + Bildschirmrand) hinauszulaufen!#off("u")# Wenn vor dem Ham­ + ster/Roboter eine Hinderniskachel liegt, wird der + Wahrheitswert FALSE geliefert. + +#on("u")#'links frei'#off("u")# + - liefert den Wahrheitswert TRUE, wenn in Laufrich­ + tung links vom Hamster/ Roboter keine Hindernis­ + kachel liegt, #on("u")#also auch dann, wenn links vom Ham­ + ster/Roboter die Landschafts-/Arbeitsfeldgrenze + (der Bildschirmrand) ist!#off("u")# Wenn links vom Hamster/ + Roboter eine Hinderniskachel liegt, wird der Wahr­ + heitswert FALSE geliefert. + +#on("u")#'rechts frei'#off("u")# + - liefert den Wahrheitswert TRUE, wenn in Laufrich­ + tung rechts vom Hamster/Roboter keine Hindernis­ + kachel liegt, #on("u")#also auch dann, wenn rechts vom Ham­ + ster/Roboter die Landschafts-/Arbeitsfeldgrenze + (der Bildschirmrand) ist!#off("u")# Wenn rechts vom Hamster/ + Roboter eine Hinderniskachel liegt, wird der Wahr­ + heitswert FALSE geliefert. + +#on("u")#'hinten frei'#off("u")# + - liefert den Wahrheitswert TRUE, wenn in Laufrich­ + tung hinter dem Hamster/Roboter keine Hindernis­ + kachel liegt, #on("u")#also auch dann, wenn hinter dem Ham­ + ster/Roboter die Landschafts-/Arbeitsfeldgrenze + (der Bildschirmrand) ist!#off("u")# Wenn hinter dem Hamster/ + Roboter eine Hinderniskachel liegt, wird der Wahr­ + heitswert FALSE geliefert. + +#on("u")#'korn da' und 'werkstueck da'#off("u")# + - liefern den Wahrheitswert TRUE, wenn auf der + Kachel, auf der der Hamster/Roboter steht, minde­ + stens ein Korn/Werkstück liegt. Ansonsten wird der + Wahrheitswert FALSE geliefert. + +#on("u")#'korn vorn' und 'werkstueck vorn'#off("u")# + - liefern den Wahrheitswert TRUE, wenn auf der + Kachel, die in Laufrichtung vor dem Hamster/Robo­ + ter liegt, mindestens ein Korn/Werkstück liegt. An­ + sonsten wird der Wahrheitswert FALSE geliefert. + - Zur "Untersuchung" wird die vor ihm liegende + Kachel - sofern dort kein Hindernis ist - von ihm + betreten. Wenn er im Begriff ist, aus der Land­ + schaft/dem Arbeitsfeld herauszulaufen, wird das + Programm mit entsprechender Fehlermeldung abge­ + brochen. + +#on("u")#'korn links' und 'werkstueck links'#off("u")# + - liefern den Wahrheitswert TRUE, wenn auf der + Kachel, die in Laufrichtung links vom Hamster/ + Roboter liegt, mindestens ein Korn/Werkstück liegt. + Ansonsten wird der Wahrheitswert FALSE geliefert. + - Zur "Untersuchung" wird die links neben ihm lie­ + gende Kachel - sofern dort kein Hindernis ist - von + ihm betreten. Wenn er im Begriff ist, aus der Land­ + schaft/dem Arbeitsfeld herauszulaufen, wird das + Programm mit entsprechender Fehlermeldung abge­ + brochen. + +#on("u")#'korn rechts' und 'werkstueck rechts'#off("u")# + - liefern den Wahrheitswert TRUE, wenn auf der + Kachel, die in Laufrichtung rechts vom Hamster/ + Roboter liegt, mindestens ein Korn/Werkstück liegt. + Ansonsten wird der Wahrheitswert FALSE geliefert. + - Zur "Untersuchung" wird die rechts neben ihm lie­ + gende Kachel - sofern dort kein Hindernis ist - von + ihm betreten. Wenn er im Begriff ist, aus der Land­ + schaft/dem Arbeitsfeld herauszulaufen, wird das + Programm mit entsprechender Fehlermeldung abge­ + brochen. + +#on("u")#'korn hinten' und 'werkstueck hinten'#off("u")# + - liefern den Wahrheitswert TRUE, wenn auf der + Kachel, die in Laufrichtung hinter dem Hamster/ + Roboter liegt, mindestens ein Korn/Werkstück liegt. + Ansonsten wird der Wahrheitswert FALSE geliefert. + - Zur "Untersuchung" wird die hinter ihm liegende + Kachel - sofern dort kein Hindernis ist - von ihm + betreten. Wenn er im Begriff ist, aus der Land­ + schaft/dem Arbeitsfeld herauszulaufen, wird das + Programm mit entsprechender Fehlermeldung abge­ + brochen. + +#on("u")#'backen leer' und 'behaelter leer'#off("u")# + - liefern den Wahrheitswert TRUE, wenn kein Korn/ + kein Werkstück in den Backentaschen/im Behälter + notiert ist. Ansonsten wird der Wahrheitswert FALSE + geliefert. + diff --git a/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 6 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 6 new file mode 100644 index 0000000..0aeeff0 --- /dev/null +++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 6 @@ -0,0 +1,73 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (66)# +#headodd# +#center#gs-Herbert und Robbi#right#% + +#end# +#headeven# +%#center#gs-Herbert und Robbi + +#end# +#center#6 + +#center#Zusätzliche Kommandos + + +PROC landschaft (TEXT CONST landschaftsname) +PROC arbeitsfeld (TEXT CONST arbeitsfeldname) + Steht einer dieser Prozeduraufrufe innerhalb eines + Hamster-/ Roboterprogramms vor dem ersten Befehl (am + Anfang der Datei), so wird die Anfrage nach einem Land­ + schafts-/Arbeitsfeldnamen zu Beginn des Laufs über­ + gangen. Außerdem ist es möglich, den Hamster/Roboter + in einem Programm durch meherere Landschaften/Ar­ + beitsfelder laufen zu lassen. Beachten Sie bitte, daß + der Landschaftsname / Arbeitsfeldname hier in Anfüh­ + rungszeichen, aber #on("u")#ohne#off("u")# das Präfix 'Flaeche:' angegeben + werden muß! + +PROC geschwindigkeit (INT CONST wert) + Möchte man von einem Programm aus eine bestimmte + Geschwindigkeit des Hamsters/Roboters bei der Pro­ + grammausführung festlegen oder die Geschwindigkeit + vom Programm aus verändern, so kann man diese Proze­ + dur verwenden. Zulässig sind für 'wert' nur Werte zwi­ + schen 0 und 9. Dabei bedeuten: + 0: Einzelschrittmodus - Ausführung des nächsten + Schritts auf Tastendruck + 1: geringste Geschwindigkeit (Wartezeit : ca. + 50 Zehntelsekunden ) + 9: höchste Geschwindigkeit (Wartezeit : + keine) + 2 - 8 sind dazwischenliegende Geschwindigkeiten + +TEXT PROC taste + Diese Prozedur liefert jeweils ein eingetipptes + Zeichen. Die Taste , welche zum Programmabbruch + dient, wirkt sich schon aus, bevor hier ein Zeichen ge­ + liefert werden könnte. + +PROC druckereinstellung fuer flaechenausdruck + Für den Landschafts-/Arbeitsfeldausdruck ist der + Standardschrifttyp des Druckers voreingestellt. Dabei + müssen 80 Druckpositionen in einer Zeile Platz haben. + Außerdem sind voreingestellt : \#limit (20.5)\#, \#on("b")\# + (Fettdruck) und \#start (0.0,0.0)\#. Zur Darstellung der + Hinderniskacheln wird das Zeichen '\#\#' (Code 222) ver­ + wendet. Kann Ihr Drucker dieses Zeichen nicht darstel­ + len (z.B. Typenraddrucker mit deutschem Zeichenzatz), so + können Sie hier ein #on("u")#anderes Zeichen#off("u")# auswählen. Weiter­ + hin können Sie mit dieser Prozedur einen #on("u")#anderen + Schrifttyp#off("u")# und eine #on("u")#andere Startposition#off("u")# (linker obe­ + rer Eckpunkt des Druckfeldes) einstellen. Nachdem Sie + das Kommando gegeben haben, wird zunächst der ge­ + wünschte Schrifttyp erfragt. Geben Sie hier einen in + Ihrer Installation vorhandenen Schrifttyp an (nur den + Namen - ohne Anführungszeichen!). Anschließend werden + Sie nacheinander nach den beiden Startwerten (erst die + x-Richtung und dann die y-Richtung) gefragt. Geben + Sie hier jeweils einen Wert (als REAL) ein. Bedenken Sie + dabei, daß die 80 Druckpositionen nebeneinander Platz + haben müssen! + diff --git a/app/gs.hamster/1.1/doc/gs-Herbert und Robbi handbuch.impressum b/app/gs.hamster/1.1/doc/gs-Herbert und Robbi handbuch.impressum new file mode 100644 index 0000000..4c8e79d --- /dev/null +++ b/app/gs.hamster/1.1/doc/gs-Herbert und Robbi handbuch.impressum @@ -0,0 +1,87 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#gs-Herbert und Robbi + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# + +#free (4.0)##on("b")# +#center#gs-Herbert und Robbi + + +#center#Benutzerhandbuch + + +#center#Version 1.0 + + +#off("b")##center#copyright +#center#Eva Latta-Weber +#center#Software- und Hardware-Systeme, 1988 +#center#ERGOS GmbH, 1990 +#page# +#block# +#center#____________________________________________________________________________ + + +Copyright:  ERGOS GmbH   März 1990 + + Alle Rechte vorbehalten. Insbesondere ist die Überführung in + maschinenlesbare Form sowie das Speichern in Informations­ + systemen, auch auszugsweise, nur mit schriftlicher Einwilliging + Einwilligung der ERGOS GmbH gestattet. + +#center#____________________________________________________________________________ + +Es kann keine Gewähr übernommen werden, daß das Programm für eine +bestimmte Anwendung geeignet ist. Die Verantwortung dafür liegt beim +Anwender. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrektheit und +Vollständigkeit der Angaben kann keine Gewähr übernommen werden. Das +Handbuch kann jederzeit ohne Ankündigung geändert werden. + +Texterstellung :  Dieser Text wurde mit der ERGOS-L3 Textverarbeitung + erstellt und aufbereitet und auf einem Kyocera Laser­ + drucker gedruckt. + + + + +#center#___________________________________________________________________________ + + + +Ergonomic Office Software GmbH + +Bergstr. 7 Telefon: (02241) 63075 +5200 Siegburg Teletex: 2627-2241413=ERGOS + Telefax: (02241) 63078 + + +#center#____________________________________________________________________________ + diff --git a/app/gs.hamster/1.1/source-disk b/app/gs.hamster/1.1/source-disk new file mode 100644 index 0000000..bd6ad37 --- /dev/null +++ b/app/gs.hamster/1.1/source-disk @@ -0,0 +1 @@ +informatikpaket/03_gs.hamster.img diff --git a/app/gs.hamster/1.1/src/ls-Herbert und Robbi 1 b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 1 new file mode 100644 index 0000000..ed19e98 --- /dev/null +++ b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 1 @@ -0,0 +1,84 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-Herbert und Robbi 1 ** + ** ** + ** Version 1.1 ** + ** ** + ** (Stand: 30.03.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls herbert und robbi 1 DEFINES{} sei ein hamster, ist hamster,{} sei ein roboter, ist roboter,{} landschaft, arbeitsfeld,{} vor, links um, nimm, gib,{} korn da, werkstueck da,{} backen leer, behaelter leer,{} vorn frei, lauf,{} hamsterinter, roboterinter,{} geschwindigkeit, taste,{} befehlssatz erweitern,{} befehlssatz ist erweitert,{} drucke landschaft,{} hamster druckerstart einstellen,{} hamster drucker xstart,{} + hamster drucker ystart,{} hamster landschaftsschrifttyp einstellen,{} hamster landschaftsschrifttyp,{} druckereinstellung fuer flaechenausdruck,{} landschaftsauskunftstext,{} testauskunftstext 1, testauskunftstext 2,{} befehlsauskunftstext, laufauskunftstext,{} kommandomodus, hamstermodus,{} zeige landschaft, lege landschaft ab:{}TYPE LOCATION = STRUCT (INT x, y);{}LET menukarte = "ls-MENUKARTE:Herbert und Robbi",{} richtung = ""3""8""10""2"",{} + erscheinungsform = "A",{} praefix = "Flaeche:",{} flaechentype = 1007,{} neutral = 0,{} erzeuge = 1,{} hamsterlauf = 2,{} interaktiv = 3,{} kommandostufe = 99,{} west = ""8"",{} ost = ""2"",{} cleol = ""5"",{} piep = ""7"",{} + mark ein = ""15"",{} mark aus = ""14"",{} escape = ""27"",{} blank = " ",{} niltext = "",{} hindernis = "#",{} korn = "o",{} hinderniskachel = "##",{} blankkachel = " .",{} kornkachel = " o",{} protokollname = "PROTOKOLL";{}LET max x = 40,{} + max y = 23;{}LET FLAECHE = ROW max x ROW max y INT;{}LET LANDSCHAFT = STRUCT (INT xpos, ypos, blickrichtung,{} anzahl koerner, FLAECHE flaeche);{}LET HAMSTER = STRUCT (LOCATION stelle, INT koerner, form);{}BOUND LANDSCHAFT VAR aktuelle landschaft;{}FLAECHE VAR land;{}HAMSTER VAR hamster;{}FILE VAR protokoll;{}INT CONST besetzt :: -1,{} frei :: 0;{} +TEXT CONST kornsymbole ::{} "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";{}INT CONST maxkornzahl :: LENGTH kornsymbole;{}BOOL VAR hamster eingestellt :: TRUE,{} befehlssatz erweitert :: FALSE;{}TEXT VAR eingabezeichen :: niltext,{} archivlandschaftsname :: niltext,{} hinderniszeichen :: "\#\#",{} schrifttyp :: niltext;{}INT VAR verzoegerungsfaktor :: 5,{} + modus :: kommandostufe,{} a, b, c, d;{}REAL VAR xstart :: 0.0,{} ystart :: 0.0;{}WINDOW VAR fenster :: window (1, 1, 79, 24);{}INITFLAG VAR in this task :: FALSE;{}OP := (LOCATION VAR l, LOCATION CONST r):{} l.x := r.x; l.y := r.y{}END OP :=;{}PROC initialize hamstersystem:{} IF NOT initialized (in this task){} THEN install menu (menukarte);{} FI{}END PROC initialize hamstersystem;{} +PROC sei ein hamster:{} hamster eingestellt := TRUE{}END PROC sei ein hamster;{}BOOL PROC ist hamster:{} hamster eingestellt{}END PROC ist hamster;{}PROC sei ein roboter:{} hamster eingestellt := FALSE{}END PROC sei ein roboter;{}BOOL PROC ist roboter:{} NOT hamster eingestellt{}END PROC ist roboter;{}PROC hole landschaft (TEXT CONST name):{} aktuelle landschaft := old (praefix + name);{} land := aktuelle landschaft.flaeche;{} hamster.form := aktuelle landschaft.blickrichtung;{} + hamster.stelle.x := aktuelle landschaft.xpos;{} hamster.stelle.y := aktuelle landschaft.ypos;{} hamster.koerner := aktuelle landschaft.anzahl koerner{}END PROC hole landschaft;{}PROC lege landschaft ab (TEXT CONST name):{} IF exists (praefix + name){} THEN forget (praefix + name, quiet){} FI;{} aktuelle landschaft := new (praefix + name);{} aktuelle landschaft.flaeche := land;{} aktuelle landschaft.blickrichtung := hamster.form;{} aktuelle landschaft.xpos := hamster.stelle.x;{} + aktuelle landschaft.ypos := hamster.stelle.y;{} aktuelle landschaft.anzahl koerner := hamster.koerner;{} type( old(praefix + name), flaechentype){}END PROC lege landschaft ab;{}PROC hamstermodus:{} modus := neutral{}END PROC hamstermodus;{}PROC kommandomodus:{} modus := kommandostufe{}END PROC kommandomodus;{}PROC erzeugemodus:{} modus := erzeuge{}END PROC erzeugemodus;{}PROC intermodus:{} modus := interaktiv{}END PROC intermodus;{}PROC laufmodus:{} modus := hamsterlauf{} +END PROC laufmodus;{}BOOL PROC vorn frei:{} kontrolliere modus;{} LOCATION VAR hier :: hamster.stelle;{} SELECT hamster.form OF{} CASE 1: IF hamster.stelle.y < 2 THEN protestiere FI;{} hier.y DECR 1{} CASE 2: IF hamster.stelle.x < 2 THEN protestiere FI;{} hier.x DECR 1{} CASE 3: IF hamster.stelle.y >= max y THEN protestiere FI;{} hier.y INCR 1{} CASE 4: IF hamster.stelle.x >= max x THEN protestiere FI;{} hier.x INCR 1{} OTHERWISE modus := kommandostufe;{} + IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){} FI{} END SELECT;{} IF modus = erzeuge{} THEN TRUE{} ELSE land[hier.x] [hier.y] <> besetzt{} FI{}END PROC vorn frei;{}BOOL PROC korn da:{} kontrolliere modus;{} kornzahl > 0{}END PROC korn da;{}INT PROC kornzahl:{} land [hamster.stelle.x] [hamster.stelle.y]{}END PROC kornzahl;{}BOOL PROC werkstueck da:{} korn da{}END PROC werkstueck da;{}BOOL PROC backen leer:{} + kontrolliere modus;{} hamster.koerner <= 0 AND (modus = hamsterlauf OR modus = interaktiv){}END PROC backen leer;{}BOOL PROC behaelter leer:{} backen leer{}END PROC behaelter leer;{}PROC protestiere:{} IF modus = erzeuge{} THEN out(piep); eins zurueck{} ELSE verzoegere 10 mal; zeige("X"); verzoegere 10 mal;{} kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 6)){} ELSE errorstop(nachricht(13)){} FI;{} FI.{} eins zurueck:{} + SELECT hamster.form OF{} CASE 1: hamster.stelle.y INCR 1{} CASE 2: hamster.stelle.x INCR 1{} CASE 3: hamster.stelle.y DECR 1{} CASE 4: hamster.stelle.x DECR 1{} OTHERWISE kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){} FI;{} END SELECT.{} verzoegere 10 mal:{} INT VAR j;{} FOR j FROM 1 UPTO 10 REP{} verzoegere{} PER{}END PROC protestiere;{} +PROC verzoegere:{} IF modus <> hamsterlauf{} THEN LEAVE verzoegere{} FI;{} eingabezeichen := incharety (verzoegerungsfaktor);{} IF eingabezeichen = escape{} THEN kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 4)){} ELSE errorstop(nachricht(11)){} FI{} ELIF eingabezeichen = "-" THEN verlangsame{} ELIF eingabezeichen = "+" THEN beschleunige{} ELIF eingabezeichen = "?" THEN boxinfo (fenster, laufauskunftstext,{} 5, maxint, a, b, c, d);{} + cursor on; zeige landschaft{} ELIF pos ("0123456789", eingabezeichen) > 0{} THEN geschwindigkeit (int (eingabezeichen)){} FI.{} verlangsame:{} IF verzoegerungsfaktor > 31 THEN (* lass es dabei *){} ELIF verzoegerungsfaktor < 1{} THEN verzoegerungsfaktor INCR 1{} ELSE verzoegerungsfaktor INCR verzoegerungsfaktor{} FI.{} beschleunige:{} IF verzoegerungsfaktor < 1{} THEN verzoegerungsfaktor := -1{} ELSE verzoegerungsfaktor := verzoegerungsfaktor DIV 2{} + FI{}END PROC verzoegere;{}PROC geschwindigkeit (INT CONST faktor):{} SELECT faktor OF{} CASE 0 : verzoegerungsfaktor := 20000;{} CASE 1 : verzoegerungsfaktor := 50;{} CASE 2 : verzoegerungsfaktor := 20;{} CASE 3 : verzoegerungsfaktor := 10;{} CASE 4 : verzoegerungsfaktor := 8;{} CASE 5 : verzoegerungsfaktor := 5;{} CASE 6 : verzoegerungsfaktor := 2;{} CASE 7 : verzoegerungsfaktor := 1;{} CASE 8 : verzoegerungsfaktor := 0;{} CASE 9 : verzoegerungsfaktor := -1;{} + OTHERWISE (*belasse es dabei*){} END SELECT{}END PROC geschwindigkeit;{}PROC vor:{} kontrolliere modus;{} IF vorn frei{} THEN zeige(kachel);{} bilde neue hamsterkoordinaten;{} zeige(erscheinungsform SUB hamster.form);{} verzoegere{} ELSE modus := kommandostufe;{} zeige("X");{} IF ist hamster{} THEN errorstop(nachricht(1)){} ELSE errorstop(nachricht(8)){} FI{} FI.{} kachel:{} INT CONST z :: land [hamster.stelle.x] [hamster.stelle.y];{} + IF z = besetzt THEN hinderniskachel{} ELIF z = frei THEN blankkachel{} ELSE kornkachel{} FI.{} bilde neue hamsterkoordinaten:{} SELECT hamster.form OF{} CASE 1 :hamster.stelle.y DECR 1{} CASE 2 :hamster.stelle.x DECR 1{} CASE 3 :hamster.stelle.y INCR 1{} CASE 4 :hamster.stelle.x INCR 1{} OTHERWISE modus:=kommandostufe;{} IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){} + FI{} END SELECT.{}END PROC vor;{}PROC nimm:{} kontrolliere modus;{} IF korn da{} THEN variiere kornzahl (-1);{} IF kornzahl < 1 THEN zeige (ost + blank) FI{} ELSE modus := kommandostufe;{} zeige("X");{} IF ist hamster{} THEN errorstop(nachricht(2)){} ELSE errorstop(nachricht(9)){} FI{} FI;{} verzoegere{}END PROC nimm;{}PROC gib:{} kontrolliere modus;{} IF backen leer{} THEN modus := kommandostufe;{} zeige ("X");{} + IF ist hamster{} THEN errorstop(nachricht( 3)){} ELSE errorstop(nachricht(10)){} FI{} ELSE variiere kornzahl (+1);{} zeige(ost + korn){} FI;{} verzoegere{}END PROC gib;{}PROC links um:{} kontrolliere modus;{} hamster.form := hamster.form MOD 4 + 1;{} (* da hamster.form der Werte 1,2,3,4 faehig ist und linksdreht *){} zeige (subjekt);{} verzoegere.{} subjekt:{} erscheinungsform SUB hamster.form.{}END PROC links um;{}PROC variiere kornzahl (INT CONST delta):{} + IF delta * delta <> 1{} THEN LEAVE variiere kornzahl{} FI; (* als delta kommen nur +1 und -1 vor *){} INT VAR k;{} IF kornzahl = -1 AND delta = 1{} THEN k := 1{} ELSE k := kornzahl + delta{} FI;{} IF k <= 0{} THEN land [hamster.stelle.x] [hamster.stelle.y] := frei{} ELSE land [hamster.stelle.x] [hamster.stelle.y] := min (k,maxkornzahl){} FI;{} IF modus = hamsterlauf OR modus = interaktiv{} THEN hamster.koerner DECR delta{} FI{}END PROC variiere kornzahl;{}PROC kontrolliere modus:{} + initialize hamstersystem;{} SELECT modus OF{} CASE neutral : erzeugemodus;{} landschaft;{} laufmodus{} CASE erzeuge,{} interaktiv,{} hamsterlauf: (* nichts *){} OTHERWISE kommandomodus;{} line;{} IF ist hamster{} THEN sage(anwendungstext (21));pause(20);{} errorstop(nachricht( 5)){} ELSE sage(anwendungstext (22));pause(20);{} + errorstop(nachricht(12)){} FI{} END SELECT{}END PROC kontrolliere modus;{}PROC zeige (TEXT CONST was):{} cursor (2 * hamster.stelle.x - 1, hamster.stelle.y);{} IF hamster.stelle.x >= max x AND hamster.stelle.y > max y{} THEN out ((was SUB 1)); out(west){} ELSE out(was); (LENGTH was) TIMESOUT west{} FI.{}END PROC zeige;{}PROC sage (TEXT CONST aussage):{} cursor(1,24); out(aussage + cleol){}END PROC sage;{}TEXT PROC nachricht (INT CONST nummer):{} + inv (text (anwendungstext (nummer), 65)) + piep{}END PROC nachricht;{}TEXT PROC inv (TEXT CONST text):{} TEXT VAR aus :: mark ein + text + blank + mark aus;{} aus{}END PROC inv;{}PROC zeige landschaft:{} initialize hamstersystem;{} INT VAR y;{} FOR y FROM 1 UPTO max y REP{} setze zeile zusammen;{} cursor (1,y); out (zeile){} PER;{} cursor(1,24); out(cleol);{} IF modus = interaktiv{} THEN gib befehlszeile aus{} FI;{} zeige hamster; cursor on.{} setze zeile zusammen:{} TEXT VAR zeile :: niltext;{} + INT VAR x;{} FOR x FROM 1 UPTO max x REP{} zeile CAT kachel{} PER.{} kachel:{} INT CONST z :: land [x] [y];{} IF z = besetzt THEN hinderniskachel{} ELIF z = frei THEN blankkachel{} ELSE kornkachel{} FI.{} gib befehlszeile aus:{} cursor(1,1); write(cleol); write (anwendungstext (62)){}END PROC zeige landschaft;{}PROC zeige hamster:{} zeige (erscheinungsform SUB hamster.form){}END PROC zeige hamster;{}PROC landschaft (TEXT CONST kandidat):{} + initialize hamstersystem;{} archivlandschaftsname := kandidat;{} IF exists (praefix + kandidat){} CAND type (old (praefix + kandidat)) = flaechentype{} THEN behandle existierende landschaft{} ELIF exists (praefix + kandidat){} THEN forget (praefix + kandidat, quiet);{} behandle neue landschaft{} ELSE behandle neue landschaft{} FI.{} behandle existierende landschaft:{} hole landschaft (kandidat);{} SELECT modus OF{} CASE hamsterlauf,{} interaktiv,{} + neutral : zeige landschaft;{} laufmodus{} CASE erzeuge : modifiziere eventuell{} CASE kommandostufe : modifiziere landschaft{} OTHERWISE errorstop (anwendungstext (15)){} END SELECT.{} behandle neue landschaft:{} SELECT modus OF{} CASE hamsterlauf,{} interaktiv,{} neutral,{} erzeuge : erschaffe landschaft;{} modifiziere landschaft;{} zeige landschaft;{} + laufmodus{} CASE kommandostufe : erschaffe landschaft;{} modifiziere landschaft;{} OTHERWISE errorstop (anwendungstext (15)){} END SELECT.{} modifiziere eventuell:{} IF ist hamster{} THEN IF boxyes (fenster, anwendungstext (41), 5, a, b, c, d){} THEN cursor on; modifiziere landschaft{} FI{} ELSE IF boxyes (fenster, anwendungstext (42), 5, a, b, c, d){} THEN cursor on; modifiziere landschaft{} + FI{} FI;{} zeige landschaft.{} erschaffe landschaft:{} INT VAR j;{} FOR j FROM 1 UPTO max y REP{} INT VAR k;{} FOR k FROM 1 UPTO max x REP{} land [k] [j] := frei{} PER{} PER;{} hamster.form := 4;{} hamster.stelle.x := 20;{} hamster.stelle.y := 12;{} hamster.koerner := 0.{}END PROC landschaft;{}PROC landschaft:{} initialize hamstersystem;{} IF ist hamster{} THEN landschaft (erfragter landschaftsname (anwendungstext (36))){} + ELSE landschaft (erfragter landschaftsname (anwendungstext (37))){} FI{}END PROC landschaft;{}TEXT PROC erfragter landschaftsname (TEXT CONST satz):{} TEXT VAR landschaftsname :: archivlandschaftsname;{} REP{} page; line (3); out (satz + cleol); line (2);{} editget (landschaftsname);{} landschaftsname := compress (landschaftsname);{} IF landschaftsname = niltext{} THEN line (2); out (anwendungstext (18) + piep);{} line (2); out (anwendungstext (38)); pause{} FI{} + UNTIL landschaftsname <> niltext PER;{} landschaftsname{}END PROC erfragter landschaftsname;{}PROC arbeitsfeld (TEXT CONST kandidat):{} landschaft (kandidat){}END PROC arbeitsfeld;{}PROC arbeitsfeld:{} landschaft{}END PROC arbeitsfeld;{}PROC modifiziere landschaft:{} INT CONST modalibi :: modus;{} erzeugemodus;{} zeige landschaft;{} informiere;{} zeige hamster;{} nimm ein eingabezeichen;{} WHILE nicht endewunsch REP{} erfuelle fortschreibungswunsch;{} nimm ein eingabezeichen{} PER;{} + erfrage koernerzahl;{} lege landschaft ab (archivlandschaftsname);{} modus := modalibi.{} nimm ein eingabezeichen:{} inchar (eingabezeichen).{} nicht endewunsch:{} pos ("hH", eingabezeichen) = 0.{} erfuelle fortschreibungswunsch:{} INT CONST r :: pos (richtung, eingabezeichen){} IF r > 0{} THEN IF hamster.form = r{} THEN vor{} ELSE hamster.form := r;{} zeige hamster{} FI{} ELIF eingabezeichen = "?" THEN boxinfo (fenster, landschaftsauskunftstext,{} + 5, maxint, a, b, c, d);{} cursor on; zeige landschaft; informiere{} ELIF eingabezeichen = "k" THEN kopiere landschaft;{} zeige landschaft; informiere{} ELIF eingabezeichen = "g" THEN gib{} ELIF eingabezeichen = "n" THEN IF korn da THEN nimm ELSE out (piep) FI{} ELIF eingabezeichen = "z" THEN zeige (text (kornzahl, 2)){} ELIF eingabezeichen = hindernis{} THEN land [hamster.stelle.x] [hamster.stelle.y] := besetzt; vor{} + ELIF eingabezeichen = blank{} THEN land [hamster.stelle.x] [hamster.stelle.y] := frei; vor{} ELSE out (piep){} FI.{} kopiere landschaft:{} TEXT VAR kopie;{} IF NOT not empty (alle landschaften){} THEN IF ist hamster{} THEN boxinfo (fenster, anwendungstext (196), 5, maxint){} ELSE boxinfo (fenster, anwendungstext (197), 5, maxint){} FI{} ELSE lasse original auswaehlen{} FI.{} lasse original auswaehlen:{} + IF ist hamster{} THEN kopie := boxone (fenster, alle landschaften,{} anwendungstext (23), anwendungstext (24),{} FALSE){} ELSE kopie := boxone (fenster, alle landschaften,{} anwendungstext (25), anwendungstext (26),{} FALSE){} FI;{} cursor on; hole landschaft (kopie).{} alle landschaften:{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{} + erfrage koernerzahl:{} TEXT VAR eingabe; BOOL VAR ist ok; INT VAR zahl;{} cursor (1,23); 79 TIMESOUT waagerecht;{} REP{} ist ok := TRUE;{} IF ist hamster{} THEN eingabe := boxanswer (fenster, anwendungstext (43),{} text (hamster.koerner),{} 5, a, b, c, d){} ELSE eingabe := boxanswer (fenster, anwendungstext (44),{} text (hamster.koerner),{} + 5, a, b, c, d){} FI;{} disable stop;{} IF eingabe = "" THEN eingabe := "0" FI;{} zahl := int (eingabe);{} IF zahl < 0 OR zahl > maxint THEN ist ok := FALSE FI;{} IF is error THEN ist ok := FALSE; clear error FI;{} enable stop;{} UNTIL last conversion ok AND ist ok PER;{} cursor on;{} hamster.koerner := zahl.{} informiere:{} cursor (1,1);{} IF ist hamster{} THEN out (anwendungstext (27)){} + ELSE out (anwendungstext (28)){} FI{}END PROC modifiziere landschaft;{}PROC lauf (TEXT CONST dateiname):{} initialize hamstersystem;{} IF NOT exists (dateiname){} THEN errorstop (anwendungstext (16) + dateiname + anwendungstext (17)){} FI;{} hamstermodus;{} disable stop;{} run (dateiname);{} kommandomodus;{} cursor (1, 24);{} IF is error{} THEN IF length (errormessage) > 1{} THEN sage (errormessage); pause;{} FI{} ELSE sage (anwendungstext (29)); pause; konserviere landschaft{} + FI;{} clear error;{} enable stop{}END PROC lauf;{}PROC lauf:{} lauf (last param){}END PROC lauf;{}PROC konserviere landschaft:{} TEXT VAR neuer landschaftsname;{} IF ist hamster{} THEN stelle landschaftsfrage{} ELSE stelle arbeitsfeldfrage{} FI; cursor on.{} stelle landschaftsfrage:{} IF boxyes (fenster, anwendungstext (45), 5){} THEN bewahre landschaft auf{} FI.{} stelle arbeitsfeldfrage:{} IF boxyes (fenster, anwendungstext (46), 5){} THEN bewahre landschaft auf{} + FI.{} bewahre landschaft auf:{} neuer landschaftsname := archivlandschaftsname + ".x";{} lege landschaft ab (neuer landschaftsname);{} gib hinweis auf neuen namen.{} gib hinweis auf neuen namen:{} IF ist hamster{} THEN boxinfo (fenster, anwendungstext (30){} + inv (neuer landschaftsname), 5, maxint, a, b, c, d){} ELSE boxinfo (fenster, anwendungstext (31){} + inv (neuer landschaftsname), 5, maxint, a, b, c, d){} FI{}END PROC konserviere landschaft;{} +PROC hamsterinter (TEXT CONST landschaftsname):{} initialize hamstersystem;{} sei ein hamster;{} steuere interaktiv (landschaftsname);{} cursor on{}END PROC hamsterinter;{}PROC hamsterinter:{} initialize hamstersystem;{} hamsterinter (erfragter landschaftsname (anwendungstext (39))){}END PROC hamsterinter;{}PROC roboterinter (TEXT CONST landschaftsname):{} initialize hamstersystem;{} sei ein roboter;{} steuere interaktiv (landschaftsname);{} cursor on{}END PROC roboterinter;{}PROC roboterinter:{} + initialize hamstersystem;{} roboterinter (erfragter landschaftsname (anwendungstext (40))){}END PROC roboterinter;{}PROC steuere interaktiv (TEXT CONST landschaftsname):{} forget (protokollname, quiet);{} protokoll := sequential file (output, protokollname);{} intermodus;{} landschaft (landschaftsname);{} TEXT VAR befehl :: niltext, letzter befehl :: niltext;{} REP{} arbeiten{} PER.{} arbeiten:{} intermodus;{} hole befehl;{} fuehre befehl aus.{} hole befehl:{} TEXT VAR befehlszeichen;{} + TEXT CONST befehlskette :: "vlngpeVLNGPE";{} INT VAR befehlsposition;{} zeige (hamsterform);{} cursor (1,24);{} IF ist hamster{} THEN out (cleol + anwendungstext (32) + letzter befehl){} ELSE out (cleol + anwendungstext (33) + letzter befehl){} FI;{} cursor(24,24);{} inchar (befehlszeichen);{} befehlsposition := pos(befehlskette,befehlszeichen);{} IF befehlsposition = 0{} THEN out(piep);{} LEAVE arbeiten{} FI;{} SELECT befehlsposition OF{} + CASE 1, 7: befehl := "vor";{} out("vor");{} letzter befehl := "vor"{} CASE 2, 8: befehl := "links um";{} out("links um");{} letzter befehl := "links um"{} CASE 3, 9: befehl := "nimm";{} out("nimm");{} letzter befehl := "nimm"{} CASE 4,10: befehl := "gib";{} out("gib");{} letzter befehl := "gib"{} + CASE 5,11: out("protokoll");{} letzter befehl := "protokoll";{} FILE VAR p :: sequential file (modify,protokollname);{} headline(p, protokollname + " (Verlassen: )");{} cursor on; show(p); cursor off;{} zeige landschaft; befehl := "";{} output(protokoll);{} LEAVE arbeiten{} CASE 6,12: out("ende"); kommandomodus; befehl := "";{} LEAVE steuere interaktiv{} + END SELECT.{} hamsterform:{} erscheinungsform SUB hamster.form.{} fuehre befehl aus:{} BOOL VAR korrekt;{} disable stop;{} do (befehl);{} cursor (1,24);{} korrekt := NOT is error;{} IF is error{} THEN IF errormessage > ""{} THEN out (inv (text (errormessage, 65)) + piep);{} pause(30);{} FI;{} clear error{} FI;{} IF korrekt AND befehl <> ""{} THEN protokolliere (befehl){} FI;{} enable stop;{} +END PROC steuere interaktiv;{}PROC protokolliere (TEXT CONST befehl):{} putline (protokoll, befehl + ";"){}END PROC protokolliere;{}PROC drucke landschaft (TEXT CONST landschaftsname):{} initialize hamstersystem;{} ROW max y TEXT VAR drucklandschaft;{} BOUND LANDSCHAFT VAR al;{} INT VAR i, hamsterx, hamstery;{} TEXT VAR hamsterzeichen;{} landschaftsdatei holen;{} drucklandschaft erzeugen;{} hamster in drucklandschaft einsetzen;{} druckdatei erzeugen;{} disable stop;{} TEXT VAR datname := std;{} + do ("print (""druckdatei"")");{} IF is error{} THEN menuinfo (inv (errormessage));{} clear error;{} FI;{} last param (datname);{} enable stop;{} druckdatei loeschen;{} cursor on.{} landschaftsdatei holen:{} IF exists (praefix + landschaftsname) AND{} (type (old (praefix + landschaftsname)) = flaechentype){} THEN hole landschaft;{} ELSE LEAVE drucke landschaft{} FI.{} hole landschaft:{} al := old (praefix + landschaftsname);{} hamsterx := al.xpos;{} + hamstery := al.ypos;{} hamsterzeichen := erscheinungsform SUB al.blickrichtung.{} drucklandschaft erzeugen:{} TEXT VAR zeile; INT VAR x;{} FOR i FROM 1 UPTO max y REP{} zeile := "";{} FOR x FROM 1 UPTO maxx REP{} zeile erzeugen{} PER;{} drucklandschaft[i] := zeile{} PER.{} zeile erzeugen:{} INT CONST zeichen :: al.flaeche [x] [i];{} IF zeichen = besetzt THEN zeile CAT hinderniszeichen{} ELIF zeichen = frei THEN zeile CAT " ."{} + ELSE zeile CAT " o"{} FI.{} hamster in drucklandschaft einsetzen:{} change (drucklandschaft [hamstery], hamsterx*2-1, hamsterx*2-1,{} hamsterzeichen).{} druckdatei erzeugen:{} FILE VAR p::sequential file(output, "druckdatei");{} INT VAR blankzahl;{} line(p);{} putline(p,"#type (""" + schrifttyp + """)#");{} putline(p,"#start(" + text(xstart) + "," + text(ystart) + ")#");{} putline(p,"#limit(20.8)#");{} blankzahl := ( 80 - (8 + length (landschaftsname))) DIV 2;{} + putline(p, blankzahl * " " + praefix + landschaftsname + " ");{} putline(p, "  ");{} FOR i FROM 1 UPTO maxy REP{} putline(p, drucklandschaft[i] + " "){} PER.{} druckdatei loeschen:{} forget("druckdatei", quiet){}END PROC drucke landschaft;{}PROC drucke landschaft:{} initialize hamstersystem;{} IF ist hamster{} THEN drucke landschaft (erfragter landschaftsname (anwendungstext (36))){} ELSE drucke landschaft (erfragter landschaftsname (anwendungstext (37))){} FI;{} cursor on{} +END PROC drucke landschaft;{}PROC druckereinstellung fuer flaechenausdruck:{} initialize hamstersystem;{} page;{} IF ist hamster{} THEN putline (center (invers (anwendungstext (71)))){} ELSE putline (center (invers (anwendungstext (72)))){} FI;{} line (3);{} put (anwendungstext (73));{} editget (schrifttyp);{} line (2);{} schrifttyp := compress (schrifttyp);{} putline (anwendungstext (74));{} putline (anwendungstext (75)); line (2);{} putline (anwendungstext (76) + text (xstart) + "," + text (ystart) +{} + anwendungstext (77)); line;{} put (anwendungstext (78)); get (xstart); line;{} put (anwendungstext (79)); get (ystart); line (2);{} IF yes (anwendungstext (80) + hinderniszeichen + anwendungstext (81)){} THEN line;{} put (anwendungstext (82)); inchar (hinderniszeichen); line (2);{} hinderniszeichen CAT hinderniszeichen;{} IF hinderniszeichen = "##"{} THEN hinderniszeichen := "\#\#"{} FI{} FI;{} line;{} put (anwendungstext (83)){}END PROC druckereinstellung fuer flaechenausdruck;{} +PROC hamster druckerstart einstellen (REAL CONST xpos, ypos):{} xstart := xpos; ystart := ypos{}END PROC hamster druckerstart einstellen;{}REAL PROC hamster drucker xstart:{} xstart{}END PROC hamster drucker xstart;{}REAL PROC hamster drucker ystart:{} ystart{}END PROC hamster drucker ystart;{}PROC hamster landschaftsschrifttyp einstellen (TEXT CONST typ):{} schrifttyp := typ{}END PROC hamster landschaftsschrifttyp einstellen;{}TEXT PROC hamster landschaftsschrifttyp:{} schrifttyp{}END PROC hamster landschaftsschrifttyp;{} +PROC drucke arbeitsfeld (TEXT CONST arbeitsfeldname):{} drucke landschaft (arbeitsfeldname){}END PROC drucke arbeitsfeld;{}PROC drucke arbeitsfeld:{} drucke landschaft{}END PROC drucke arbeitsfeld;{}TEXT PROC taste:{} eingabezeichen{}END PROC taste;{}TEXT PROC landschaftsauskunftstext:{} initialize hamstersystem;{} IF ist hamster{} THEN anwendungstext (52){} ELSE anwendungstext (53){} FI{}END PROC landschaftsauskunftstext;{}TEXT PROC laufauskunftstext:{} initialize hamstersystem;{} + anwendungstext (51){}END PROC laufauskunftstext;{}TEXT PROC befehlsauskunftstext:{} initialize hamstersystem;{} IF ist hamster{} THEN anwendungstext (54){} ELSE anwendungstext (55){} FI{}END PROC befehlsauskunftstext;{}TEXT PROC testauskunftstext 1:{} initialize hamstersystem;{} IF befehlssatz erweitert{} THEN langer testauskunftstext{} ELSE kurzer testauskunftstext{} FI.{} kurzer testauskunftstext:{} IF ist hamster{} THEN anwendungstext (56){} ELSE anwendungstext (57){} + FI.{} langer testauskunftstext:{} IF ist hamster{} THEN anwendungstext (58){} ELSE anwendungstext (60){} FI.{}END PROC testauskunftstext 1;{}TEXT PROC testauskunftstext 2:{} initialize hamstersystem;{} IF befehlssatz erweitert{} THEN eintragung{} ELSE niltext{} FI.{} eintragung:{} IF ist hamster{} THEN anwendungstext (59){} ELSE anwendungstext (61){} FI{}END PROC testauskunftstext 2;{}PROC befehlssatz erweitern (BOOL CONST status):{} befehlssatz erweitert := status{} +END PROC befehlssatz erweitern;{}BOOL PROC befehlssatz ist erweitert:{} befehlssatz erweitert{}END PROC befehlssatz ist erweitert;{}END PACKET ls herbert und robbi 1;{} + diff --git a/app/gs.hamster/1.1/src/ls-Herbert und Robbi 2 b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 2 new file mode 100644 index 0000000..7394932 --- /dev/null +++ b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 2 @@ -0,0 +1,31 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-Herbert und Robbi 2 ** + ** ** + ** Version 1.1 ** + ** ** + ** (Stand: 30.03.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls herbert und robbi 2 DEFINES{} rechts frei,{} links frei,{} hinten frei,{} korn vorn, werkstueck vorn,{} korn links, werkstueck links,{} korn rechts, werkstueck rechts,{} korn hinten, werkstueck hinten:{}BOOL PROC rechts frei:{} rechts um;{} IF vorn frei{} THEN links um; TRUE{} ELSE links um; FALSE{} FI{}END PROC rechts frei;{}BOOL PROC links frei:{} links um;{} IF vorn frei{} THEN rechts um; TRUE{} ELSE rechts um; FALSE{} + FI{}END PROC links frei;{}BOOL PROC hinten frei:{} kehrt;{} IF vorn frei{} THEN kehrt; TRUE{} ELSE kehrt; FALSE{} FI{}END PROC hinten frei;{}BOOL PROC korn vorn:{} IF vorn frei{} THEN untersuche feld vor dir{} ELSE FALSE{} FI.{} untersuche feld vor dir:{} vor;{} IF korn da{} THEN mache vorwaertsgehen rueckgaengig; TRUE{} ELSE mache vorwaertsgehen rueckgaengig; FALSE{} FI.{} mache vorwaertsgehen rueckgaengig:{} kehrt; vor; kehrt{}END PROC korn vorn;{} +BOOL PROC korn links:{} links um;{} IF vorn frei{} THEN untersuche feld links{} ELSE rechts um; FALSE{} FI.{} untersuche feld links:{} vor;{} IF korn da{} THEN mache linkswende rueckgaengig; TRUE{} ELSE mache linkswende rueckgaengig; FALSE{} FI.{} mache linkswende rueckgaengig:{} kehrt; vor; links um{}END PROC korn links;{}BOOL PROC korn rechts:{} rechts um;{} IF vorn frei{} THEN untersuche feld rechts{} ELSE links um; FALSE{} FI.{} untersuche feld rechts:{} + vor;{} IF korn da{} THEN mache rechtswende rueckgaengig; TRUE{} ELSE mache rechtswende rueckgaengig; FALSE{} FI.{} mache rechtswende rueckgaengig:{} kehrt; vor; rechts um{}END PROC korn rechts;{}BOOL PROC korn hinten:{} kehrt;{} IF vorn frei{} THEN untersuche feld hinter dir{} ELSE kehrt; FALSE{} FI.{} untersuche feld hinter dir:{} vor;{} IF korn da{} THEN mache kehrtwende rueckgaengig; TRUE{} ELSE mache kehrtwende rueckgaengig; FALSE{} FI.{} + mache kehrtwende rueckgaengig:{} kehrt; vor{}END PROC korn hinten;{}PROC kehrt:{} links um; links um{}END PROC kehrt;{}PROC rechts um:{} links um; links um; links um{}END PROC rechts um;{}BOOL PROC werkstueck vorn:{} korn vorn{}END PROC werkstueck vorn;{}BOOL PROC werkstueck links:{} korn links{}END PROC werkstueck links;{}BOOL PROC werkstueck rechts:{} korn rechts{}END PROC werkstueck rechts;{}BOOL PROC werkstueck hinten:{} korn hinten{}END PROC werkstueck hinten;{}END PACKET ls herbert und robbi 2;{} +befehlssatz erweitern (TRUE){} + diff --git a/app/gs.hamster/1.1/src/ls-Herbert und Robbi 3 b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 3 new file mode 100644 index 0000000..e5db408 --- /dev/null +++ b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 3 @@ -0,0 +1,84 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-Herbert und Robbi 3 ** + ** ** + ** Version 1.1 ** + ** ** + ** (Stand: 30.03.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls herbert und robbi 3 DEFINES{} hamsterbefehlsauskunft,{} hamsterlaufauskunft,{} hamsterlandschaftsauskunft,{} hamsterlandschaft verzeichnis,{} hamsterlandschaft neu erstellen,{} hamsterlandschaft ansehen,{} hamsterlandschaft drucken,{} hamsterlandschaft kopieren,{} hamsterlandschaft umbenennen,{} hamsterlandschaft loeschen,{} hamsterprogramm verzeichnis,{} hamsterprogramm neu erstellen,{} hamsterprogramm ansehen,{} hamsterprogramm kopieren,{} hamsterprogramm umbenennen,{} + hamsterprogramm loeschen,{} hamsterprogramm drucken,{} hamster laufen lassen,{} hamsterinteraktiv laufen lassen,{} hamster, roboter:{}LET menukarte = "ls-MENUKARTE:Herbert und Robbi",{} praefix = "Flaeche:",{} flaechentype = 1007,{} niltext = "",{} maxlaenge = 60,{} maxnamenslaenge = 50;{}TEXT VAR flaechenname :: "",{} programmname :: "";{}INITFLAG VAR in this task :: FALSE;{}PROC initialize hamster:{} + IF NOT initialized (in this task){} THEN flaechenname := "";{} programmname := ""{} FI{}END PROC initialize hamster;{}PROC hamster:{} sei ein hamster;{} initialize hamster;{} install menu (menukarte);{} handle menu ("HAMSTER"){}END PROC hamster;{}PROC roboter:{} sei ein roboter;{} initialize hamster;{} install menu (menukarte);{} handle menu ("ROBOTER");{}END PROC roboter;{}PROC hamsterlaufauskunft:{} menuinfo (laufauskunftstext){}END PROC hamsterlaufauskunft;{}PROC hamsterlandschaftsauskunft:{} + menuinfo (landschaftsauskunftstext){}END PROC hamsterlandschaftsauskunft;{}PROC hamsterbefehlsauskunft:{} menuinfo (befehlsauskunftstext);{} menuinfo (testauskunftstext 1);{} IF testauskunftstext 2 <> ""{} THEN menuinfo (testauskunftstext 2){} FI{}END PROC hamsterbefehlsauskunft;{}PROC hamsterlandschaft verzeichnis:{} THESAURUS VAR landschaften ::{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} forget ("Interne Thesaurusdateiliste", quiet);{} FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");{} + f FILLBY landschaften;{} headline (f, anwendungstext (204)); modify (f);{} to line (f, 1); insert record (f); write record (f, kenntext);{} to line (f, 2); insert record (f);{} to line (f, 1); menuwindowshow (f);{} forget ("Interne Thesaurusdateiliste", quiet);{} regenerate menuscreen.{} kenntext:{} IF ist hamster THEN anwendungstext (121) ELSE anwendungstext (151) FI.{}END PROC hamsterlandschaft verzeichnis;{}PROC hamsterprogramm verzeichnis:{} THESAURUS VAR programme :: ALL myself - infix namen (ALL myself, praefix, flaechentype);{} + forget ("Interne Thesaurusdateiliste", quiet);{} FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");{} f FILLBY programme;{} headline (f, anwendungstext (204)); modify (f);{} to line (f, 1); insert record (f); write record (f, anwendungstext (181));{} to line (f, 2); insert record (f);{} to line (f, 1); menuwindowshow (f);{} forget ("Interne Thesaurusdateiliste", quiet);{} regenerate menuscreen{}END PROC hamsterprogramm verzeichnis;{}PROC hamsterlandschaft neu erstellen:{} + hole flaechenname;{} kontrolliere den flaechennamen;{} kommandomodus;{} landschaft (flaechenname);{} regenerate menuscreen.{} hole flaechenname:{} IF ist hamster{} THEN flaechenname := menuanswer (anwendungstext (101) +{} anwendungstext (102), "", 5){} ELSE flaechenname := menuanswer (anwendungstext (131) +{} anwendungstext (132), "", 5){} FI.{} kontrolliere den flaechennamen:{} IF flaechenname = niltext{} + THEN LEAVE hamsterlandschaft neu erstellen{} ELIF length (flaechenname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} flaechenname := niltext;{} LEAVE hamsterlandschaft neu erstellen{} ELIF exists (praefix + flaechenname){} THEN meckere existierende flaeche an;{} LEAVE hamsterlandschaft neu erstellen{} FI{}END PROC hamsterlandschaft neu erstellen;{}PROC hamsterprogramm neu erstellen:{} hole programmname;{} kontrolliere den programmnamen;{} + command dialogue (FALSE);{} cursor on;{} stdinfoedit (programmname);{} cursor off;{} command dialogue (TRUE);{} regenerate menuscreen.{} hole programmname:{} programmname := menuanswer (anwendungstext (161) +{} anwendungstext (162), "", 5).{} kontrolliere den programmnamen:{} IF programmname = niltext{} THEN LEAVE hamsterprogramm neu erstellen{} ELIF length (programmname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} programmname := niltext;{} + LEAVE hamsterprogramm neu erstellen{} ELIF exists (programmname){} THEN meckere existierendes programm an;{} LEAVE hamsterprogramm neu erstellen{} FI{}END PROC hamsterprogramm neu erstellen;{}PROC hamsterlandschaft ansehen:{} IF flaechenname <> niltext CAND exists (praefix + flaechenname){} THEN frage nach dieser flaeche{} ELSE lasse flaeche auswaehlen{} FI;{} kommandomodus;{} landschaft (flaechenname);{} regenerate menuscreen.{} frage nach dieser flaeche:{} + IF menuno (ueberschrift + text 1 + name + text 2, 5){} THEN lasse flaeche auswaehlen{} FI.{} ueberschrift:{} IF ist hamster{} THEN center (maxlaenge, invers (anwendungstext (105))) + ""13""13""{} ELSE center (maxlaenge, invers (anwendungstext (135))) + ""13""13""{} FI.{} text 1:{} IF ist hamster THEN anwendungstext (103) ELSE anwendungstext (133) FI.{} name:{} ""13""13" " + invers (flaechenname) + ""13""13"".{} text 2:{} IF ist hamster THEN anwendungstext (104) ELSE anwendungstext (134) FI.{} + lasse flaeche auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} IF ist hamster{} THEN flaechenname := menuone (verfuegbare, anwendungstext (105),{} anwendungstext (106), FALSE){} ELSE flaechenname := menuone (verfuegbare, anwendungstext (135),{} + anwendungstext (136), FALSE){} FI;{} IF flaechenname = niltext{} THEN regenerate menuscreen;{} LEAVE hamsterlandschaft ansehen{} FI.{}END PROC hamsterlandschaft ansehen;{}PROC hamsterprogramm ansehen:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI;{} cursor on;{} stdinfoedit (programmname);{} cursor off;{} regenerate menuscreen.{} frage nach diesem programm:{} + IF menuno (ueberschrift + anwendungstext (163) + name{} + anwendungstext (164), 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers (anwendungstext (165))) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} + LEAVE hamsterprogramm ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, anwendungstext (165),{} anwendungstext (166), FALSE);{} IF programmname = niltext{} THEN regenerate menuscreen;{} LEAVE hamsterprogramm ansehen{} FI.{}END PROC hamsterprogramm ansehen;{}PROC hamsterlandschaft drucken:{} lasse flaechen auswaehlen;{} drucke flaechen;{} regenerate menuscreen.{} lasse flaechen auswaehlen:{} + THESAURUS VAR verfuegbare;{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} IF ist hamster{} THEN verfuegbare := menusome (verfuegbare, anwendungstext (107),{} anwendungstext (108), FALSE){} ELSE verfuegbare := menusome (verfuegbare, anwendungstext (137),{} + anwendungstext (138), FALSE){} FI.{} drucke flaechen:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (bezeichnung)));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (schlussbemerkung);{} menuwindowstop.{} bezeichnung:{} IF ist hamster THEN anwendungstext (107) ELSE anwendungstext (137) FI.{} + schlussbemerkung:{} IF ist hamster THEN anwendungstext (110) ELSE anwendungstext (140) FI.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " """ + name (verfuegbare, k) + """ "{} + anwendungstext (201));{} menuwindowline;{} drucke landschaft (name (verfuegbare, k));{} fehlerbehandlung{} + FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} IF ist hamster{} THEN menuwindowout (anwendungstext (109)){} ELSE menuwindowout (anwendungstext (139)){} FI;{} menuwindowstop;{} regenerate menuscreen;{} LEAVE hamsterlandschaft drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} + ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE hamsterlandschaft drucken{} FI.{}END PROC hamsterlandschaft drucken;{}PROC hamsterprogramm drucken:{} lasse programme auswaehlen;{} drucke programme;{} regenerate menuscreen.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{} + IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE hamsterprogramm drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, anwendungstext (167),{} anwendungstext (168), FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (anwendungstext (167))));{} menuwindowline (2);{} command dialogue (FALSE);{} + fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (anwendungstext (170));{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " """ + name (verfuegbare, k) + """ "{} + anwendungstext (201));{} menuwindowline;{} + print (name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (anwendungstext (169));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE hamsterprogramm drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} + FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE hamsterprogramm drucken{} FI.{}END PROC hamsterprogramm drucken;{}PROC hamsterlandschaft kopieren:{} ermittle alten flaechennamen;{} erfrage neuen flaechennamen;{} kopiere ggf die flaeche.{} ermittle alten flaechennamen:{} IF NOT not empty (bestand){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft kopieren{} + ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);{} IF alter name = niltext{} THEN LEAVE hamsterlandschaft kopieren{} FI.{} bestand:{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{} text1:{} IF ist hamster THEN anwendungstext (111) ELSE anwendungstext (141) FI.{} text2:{} IF ist hamster THEN anwendungstext (112) ELSE anwendungstext (142) FI.{} erfrage neuen flaechennamen:{} + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{} ueberschrift:{} IF ist hamster{} THEN center (maxlaenge, invers (anwendungstext (111))) + ""13""13""{} ELSE center (maxlaenge, invers (anwendungstext (141))) + ""13""13""{} FI.{} hinweis auf alt:{} IF ist hamster THEN anwendungstext (113) ELSE anwendungstext (143) FI.{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} + aufforderung:{} anwendungstext (202).{} kopiere ggf die flaeche:{} IF neuer name = niltext{} THEN menuinfo (invers (anwendungstext (192)));{} LEAVE hamsterlandschaft kopieren{} ELIF exists (praefix + neuer name){} THEN mache vorwurf;{} LEAVE hamsterlandschaft kopieren{} ELSE copy (praefix + alter name, praefix + neuer name){} FI.{} mache vorwurf:{} IF ist hamster{} THEN menuinfo (anwendungstext (193)){} ELSE menuinfo (anwendungstext (194)){} + FI.{}END PROC hamsterlandschaft kopieren;{}PROC hamsterprogramm kopieren:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} kopiere ggf das programm.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} THEN noch kein programm;{} LEAVE hamsterprogramm kopieren{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, anwendungstext (171),{} anwendungstext (172), TRUE);{} + IF alter name = niltext{} THEN LEAVE hamsterprogramm kopieren{} FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, flaechentype).{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + anwendungstext (173) + bisheriger name{} + anwendungstext (202).{} ueberschrift:{} center (maxlaenge, invers (anwendungstext (171))) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} + kopiere ggf das programm:{} IF neuer name = niltext{} THEN menuinfo (invers (anwendungstext (192)));{} LEAVE hamsterprogramm kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE hamsterprogramm kopieren{} ELSE copy (alter name, neuer name){} FI.{} mache vorwurf:{} menuinfo (anwendungstext (195)).{}END PROC hamsterprogramm kopieren;{}PROC hamsterlandschaft umbenennen:{} ermittle alten flaechennamen;{} erfrage neuen flaechennamen;{} + benenne ggf die flaeche um.{} ermittle alten flaechennamen:{} IF NOT not empty (bestand){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);{} IF alter name = niltext{} THEN LEAVE hamsterlandschaft umbenennen{} FI.{} bestand:{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{} text1:{} IF ist hamster THEN anwendungstext (114) ELSE anwendungstext (144) FI.{} + text2:{} IF ist hamster THEN anwendungstext (115) ELSE anwendungstext (145) FI.{} erfrage neuen flaechennamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{} ueberschrift:{} IF ist hamster{} THEN center (maxlaenge, invers (anwendungstext (114))) + ""13""13""{} ELSE center (maxlaenge, invers (anwendungstext (144))) + ""13""13""{} FI.{} hinweis auf alt:{} IF ist hamster THEN anwendungstext (116) ELSE anwendungstext (146) FI.{} + bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} aufforderung:{} IF ist hamster THEN anwendungstext (117) ELSE anwendungstext (147) FI.{} benenne ggf die flaeche um:{} IF neuer name = niltext{} THEN menuinfo (invers (anwendungstext (192)));{} LEAVE hamsterlandschaft umbenennen{} ELIF exists (praefix + neuer name){} THEN mache vorwurf;{} LEAVE hamsterlandschaft umbenennen{} ELSE rename (praefix + alter name, praefix + neuer name);{} + flaechenname := neuer name{} FI.{} mache vorwurf:{} IF ist hamster{} THEN menuinfo (anwendungstext (193)){} ELSE menuinfo (anwendungstext (194)){} FI.{}END PROC hamsterlandschaft umbenennen;{}PROC hamsterprogramm umbenennen:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} benenne ggf das programm um.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} THEN noch kein programm;{} LEAVE hamsterprogramm umbenennen{} ELSE biete auswahl an{} + FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, anwendungstext (174),{} anwendungstext (175), TRUE);{} IF alter name = niltext{} THEN LEAVE hamsterprogramm umbenennen{} FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, flaechentype).{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + anwendungstext (176) + bisheriger name{} + anwendungstext (177).{} + ueberschrift:{} center (maxlaenge, invers (anwendungstext (174))) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} benenne ggf das programm um:{} IF neuer name = niltext{} THEN menuinfo (invers (anwendungstext (192)));{} LEAVE hamsterprogramm umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE hamsterprogramm umbenennen{} ELSE rename (alter name, neuer name);{} programmname := neuer name{} + FI.{} mache vorwurf:{} menuinfo (anwendungstext (195)).{}END PROC hamsterprogramm umbenennen;{}PROC hamsterlandschaft loeschen:{} lasse flaechen auswaehlen;{} loesche flaechen;{} regenerate menuscreen.{} lasse flaechen auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft loeschen{} ELSE biete auswahl an{} + FI.{} biete auswahl an:{} IF ist hamster{} THEN verfuegbare := menusome (verfuegbare, anwendungstext (118),{} anwendungstext (119), FALSE){} ELSE verfuegbare := menusome (verfuegbare, anwendungstext (148),{} anwendungstext (149), FALSE){} FI.{} loesche flaechen:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (bezeichnung)));{} menuwindowline (2);{} + command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (schlussbemerkung);{} menuwindowstop.{} bezeichnung:{} IF ist hamster THEN anwendungstext (118) ELSE anwendungstext (148) FI.{} schlussbemerkung:{} IF ist hamster THEN anwendungstext (120) ELSE anwendungstext (150) FI.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} + THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k) + """ "{} + anwendungstext (203)){} THEN forget (praefix + name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} flaechenname := "".{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} IF ist hamster{} THEN menuwindowout (anwendungstext (109)){} + ELSE menuwindowout (anwendungstext (139)){} FI;{} menuwindowstop;{} regenerate menuscreen;{} LEAVE hamsterlandschaft loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} + LEAVE hamsterlandschaft loeschen{} FI.{}END PROC hamsterlandschaft loeschen;{}PROC hamsterprogramm loeschen:{} lasse programme auswaehlen;{} loesche programme;{} regenerate menuscreen.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE hamsterprogramm loeschen{} ELSE biete auswahl an{} FI.{} + biete auswahl an:{} verfuegbare := menusome (verfuegbare, anwendungstext (178),{} anwendungstext (179), FALSE).{} loesche programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (anwendungstext (178))));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (anwendungstext (180));{} + menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k) + """ "{} + anwendungstext (203)){} THEN forget (name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} programmname := "".{} steige ggf bei leerem thesaurus aus:{} + IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (anwendungstext (169));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE hamsterprogramm loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} + clear error; enable stop;{} LEAVE hamsterprogramm loeschen{} FI.{}END PROC hamsterprogramm loeschen;{}PROC hamsterinteraktiv laufen lassen:{} frage nach neuer flaeche;{} cursor on;{} IF ist hamster{} THEN hamsterinter (flaechenname){} ELSE roboterinter (flaechenname){} FI;{} programmname := "PROTOKOLL";{} cursor off;{} regenerate menuscreen.{} frage nach neuer flaeche:{} IF menuyes (ueberschrift + fragetext, 5){} THEN lasse flaeche auswaehlen{} ELSE weise auf landschaftsgestaltung hin;{} + LEAVE hamsterinteraktiv laufen lassen{} FI.{} ueberschrift:{} IF ist hamster{} THEN center (laenge, invers (anwendungstext (122))) + ""13""13""{} ELSE center (laenge, invers (anwendungstext (152))) + ""13""13""{} FI.{} fragetext:{} IF ist hamster{} THEN center (laenge, anwendungstext (123)){} ELSE center (laenge, anwendungstext (153)){} FI.{} laenge:{} IF ist hamster{} THEN max (length (anwendungstext (122)),{} length (anwendungstext (123))) + 5{} + ELSE max (length (anwendungstext (152)),{} length (anwendungstext (153))) + 5{} FI.{} lasse flaeche auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF ist hamster{} THEN flaechenname := menuone (verfuegbare, anwendungstext (122),{} anwendungstext (106), FALSE){} ELSE flaechenname := menuone (verfuegbare, anwendungstext (152),{} anwendungstext (136), FALSE){} + FI;{} IF flaechenname = niltext{} THEN weise auf landschaftsgestaltung hin;{} regenerate menuscreen;{} LEAVE hamsterinteraktiv laufen lassen{} FI.{} weise auf landschaftsgestaltung hin:{} WINDOW VAR mfenster := current menuwindow;{} IF ist hamster{} THEN boxinfo (mfenster, anwendungstext (124), 5, maxint){} ELSE boxinfo (mfenster, anwendungstext (154), 5, maxint){} FI.{}END PROC hamsterinteraktiv laufen lassen;{}PROC hamster laufen lassen:{} + programmname ermitteln;{} BOOL VAR namen eingesetzt :: FALSE;{} untersuche programmdatei auf flaechennamen;{} page;{} geschwindigkeit (5);{} cursor on;{} lauf (programmname);{} cursor off;{} IF namen eingesetzt{} THEN entferne flaechennamen aus programmdatei{} FI;{} regenerate menuscreen.{} programmname ermitteln:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI.{} frage nach diesem programm:{} + IF menuno (ueberschrift + anwendungstext (163) + name + anwendungstext (164), 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} IF ist hamster{} THEN center (maxlaenge, invers (anwendungstext (125))) + ""13""13""{} ELSE center (maxlaenge, invers (anwendungstext (155))) + ""13""13""{} FI.{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{} + IF ist hamster{} THEN programmname := menuone (verfuegbare, anwendungstext (125),{} anwendungstext (166), TRUE){} ELSE programmname := menuone (verfuegbare, anwendungstext (155),{} anwendungstext (166), TRUE){} FI;{} IF programmname = niltext{} THEN LEAVE hamster laufen lassen{} FI.{} untersuche programmdatei auf flaechennamen:{} FILE VAR a :: sequential file (modify, programmname);{} TEXT VAR zeile;{} + to line (a, 1);{} REP{} read record (a, zeile);{} zeile := compress (zeile);{} IF NOT eof (a) THEN down (a) FI{} UNTIL zeile <> "" OR eof (a) PER;{} IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0{} THEN ermittle flaechennamen;{} setze flaechennamen in datei ein{} FI.{} ermittle flaechennamen:{} IF flaechenname <> ""{} THEN frage nach altem flaechennamen{} ELSE lasse flaeche auswaehlen{} FI.{} frage nach altem flaechennamen:{} + IF ist hamster{} THEN frage nach alter landschaft{} ELSE frage nach altem arbeitsfeld{} FI.{} frage nach alter landschaft:{} IF menuno (ueberschrift + anwendungstext (103){} + fname + anwendungstext (104), 5){} THEN lasse flaeche auswaehlen{} FI.{} frage nach altem arbeitsfeld:{} IF menuno (ueberschrift + anwendungstext (133){} + fname + anwendungstext (134), 5){} THEN lasse flaeche auswaehlen{} FI.{} fname:{} ""13""13" " + invers (flaechenname) + ""13""13"".{} + lasse flaeche auswaehlen:{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF ist hamster{} THEN flaechenname := menuone (verfuegbare, anwendungstext (125),{} anwendungstext (106), FALSE){} ELSE flaechenname := menuone (verfuegbare, anwendungstext (155),{} anwendungstext (136), FALSE){} FI;{} IF flaechenname = niltext{} THEN regenerate menuscreen;{} landschaftsfehler anzeigen;{} + LEAVE hamster laufen lassen{} FI.{} landschaftsfehler anzeigen:{} IF ist hamster{} THEN menuinfo (anwendungstext (124)){} ELSE menuinfo (anwendungstext (154)){} FI.{} setze flaechennamen in datei ein:{} to line (a, 1);{} zeile := "landschaft (""" + flaechenname + """);";{} insert record (a);{} write record (a, zeile);{} namen eingesetzt := TRUE.{} entferne flaechennamen aus programmdatei:{} FILE VAR b :: sequential file (modify, programmname);{} + to line (b, 1);{} REP{} read record (b, zeile);{} IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0{} THEN IF NOT eof (b) THEN down (b) FI{} FI{} UNTIL zeile <> "" OR eof (b) PER;{} IF pos (zeile, "landschaft") > 0 OR pos (zeile, "arbeitsfeld") > 0{} THEN delete record (b){} FI{}END PROC hamster laufen lassen;{}PROC meckere zu langen namen an:{} menuinfo (anwendungstext (191)){}END PROC meckere zu langen namen an;{}PROC meckere existierende flaeche an:{} + IF ist hamster{} THEN menuinfo (anwendungstext (193)){} ELSE menuinfo (anwendungstext (194)){} FI{}END PROC meckere existierende flaeche an;{}PROC meckere existierendes programm an:{} menuinfo (anwendungstext (195)){}END PROC meckere existierendes programm an;{}PROC noch keine flaeche:{} IF ist hamster{} THEN menuinfo (anwendungstext (196)){} ELSE menuinfo (anwendungstext (197)){} FI{}END PROC noch keine flaeche;{}PROC noch kein programm:{} menuinfo (anwendungstext (198)){} +END PROC noch kein programm;{}END PACKET ls herbert und robbi 3;{} + diff --git a/app/gs.hamster/1.1/src/ls-Herbert und Robbi-gen b/app/gs.hamster/1.1/src/ls-Herbert und Robbi-gen new file mode 100644 index 0000000..ae21ddb --- /dev/null +++ b/app/gs.hamster/1.1/src/ls-Herbert und Robbi-gen @@ -0,0 +1,33 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-Herbert und Robbi ** + ** GENERATORPROGRAMM ** + ** Version 1.1 ** + ** ** + ** (Stand: 30.03.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +LET mm taskname = "ls-MENUKARTEN",{} datei1 = "ls-Herbert und Robbi 1",{} datei2 = "ls-Herbert und Robbi 2",{} datei3 = "ls-Herbert und Robbi 3",{} menukarte = "ls-MENUKARTE:Herbert und Robbi";{}PROC stelle existenz des mm sicher:{} cursor (1, 5); out (""4"");{} IF NOT exists (task (mm taskname)){} THEN errorstop ("Unbedingt erst den 'MENUKARTEN MANAGER' generieren!");{} FI{}END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{} cursor (1,5); out (""4"");{} + out (" """); out (datei); putline (""" wird geholt.");{} fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{} IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{} hole (datei);{} cursor (1, 5); out (""4"");{} out (" """); out (datei); out (""" wird übersetzt: ");{} insert (datei);{} forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{} cursor (1, 5); out (""4"");{} out (" """); out(datei);{} out (""" wird zum MENUKARTEN-MANAGER geschickt!");{} + command dialogue (FALSE);{} save (datei, task (mm taskname));{} command dialogue (TRUE);{} forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln, mit erweiterung :: FALSE;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-Herbert und Robbi/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{} page;{} putline (" "15"ls-Herbert und Robbi - Automatische Generierung "14"");{} + line (2);{} putline (" Bitte beantworten Sie noch die folgende Frage:");{} line;{} put(" Sollen neben den 'Standardtests' auch die folgenden 'Tests':");{} line (2);{} putline(" Für den Hamster: Für den Roboter:");{} putline(" links frei links frei");{} putline(" rechts frei rechts frei");{} putline(" hinten frei hinten frei");{} putline(" korn vorn werkstueck vorn");{} + putline(" korn links werkstueck links");{} putline(" korn rechts werkstueck rechts");{} putline(" korn hinten werkstueck hinten");{} line;{} IF yes(" zur Verfügung gestellt werden"){} THEN mit erweiterung := TRUE{} FI.{}hole die dateien:{} IF NOT exists (datei 1){} COR NOT exists (datei 3){} COR NOT exists (menukarte){} THEN hole dateien vom archiv; LEAVE hole die dateien{} + FI;{} IF mit erweiterung AND NOT exists (datei 2){} THEN hole dateien vom archiv{} FI.{}hole dateien vom archiv:{} cursor (1,3); out (""4"");{} IF yes ("Ist das Archiv angemeldet und die Diskette eingelegt"){} THEN lese ein{} ELSE line (2);{} errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){} FI.{}lese ein:{} cursor (1, 3); out (""4"");{} out (" "15"Bitte die Diskette eingelegt lassen! "14"");{} IF NOT einzeln{} THEN hole (datei 1);{} + hole (datei 3);{} hole (menukarte);{} IF mit erweiterung{} THEN hole (datei 2){} FI;{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} release (archive){} FI.{}insertiere die dateien:{} check off;{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} in (datei 1);{} IF mit erweiterung{} THEN in (datei 2){} + FI;{} in (datei 3);{} schicke (menukarte);{} IF einzeln THEN release (archive) FI;{} check on.{}mache global manager aus der task:{} global manager.{} + diff --git a/app/gs.hamster/1.1/src/ls-MENUKARTE:Herbert und Robbi b/app/gs.hamster/1.1/src/ls-MENUKARTE:Herbert und Robbi new file mode 100644 index 0000000..2e9629c Binary files /dev/null and b/app/gs.hamster/1.1/src/ls-MENUKARTE:Herbert und Robbi differ diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.1 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.1 new file mode 100644 index 0000000..c190c0a --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.1 @@ -0,0 +1,100 @@ +#type ("prop.lq")##limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (3)# +#headodd# +#center#ls-Menu-Generator#right#% + +#end# +#headeven# +%#center#ls-Menu-Generator + +#end# +#type ("prop.breit.lq")# +#center#1 + +#center#Was +#center#kann +#center#ls-Menu-Generator +#type ("prop.lq")# + + + In diesem Kapitel wollen wir Ihnen erläutern, was Sie +mit #on("b")#ls-Menu-Generator#off("b")# anfangen können. Wir gehen davon +aus, daß Ihnen die Benutzerschnittstelle #on("b")#ls-DIALOG#off("b")# be­ +kannt ist und daß Sie bereits mit einigen Anwendungen +unter #on("b")#ls-DIALOG#off("b")# gearbeitet haben. Weiterhin setzen wir +voraus, daß Sie Programmierkenntnisse (EUMEL/ELAN) be­ +sitzen. + Bisher war es Ihnen nur möglich, von uns fertigge­ +stellte Programme unter der komfortablen Benutzer­ +schnittstelle #on("b")#ls-DIALOG#off("b")# laufen zu lassen. Sie haben aber +sicher erkannt, welche Vorteile es bietet, Programme un­ +ter einer einheitlichen Benutzeroberfläche zu realisie­ +ren: + Zunächst profitiert natürlich der Anwender von der +einfachen und immer einheitlichen Bedienung solcher +Programme. Der Aufwand, sich in neue Programmsysteme +einzuarbeiten, wird erheblich reduziert. #on("b")#ls-DIALOG#off("b")# wurde +ja auch speziell für den Unterricht konzipiert und ent­ +wickelt: Ziel war es, Computerlaien einen Zugang zum +Computer zu verschaffen und den Umgang mit dem Compu­ +ter zu vereinfachen. + + #on("b")#ls-Menu-Generator#off("b")#ist nun aber kein weiteres Anwen­ +dungsprogramm! #on("b")#ls-Menu-Generator#off("b")# ist stattdessen für +den Programmierer gedacht, der selbst unter #on("b")#ls-DIALOG#off("b")# +Anwendungssysteme entwickeln möchte. #on("u")#Wir erhoffen uns +durch die Bereitstellung dieses Werkzeuges, daß sich auch +andere engagierte Personen daran beteiligen, qualitativ +hochwertige Software insbesondere für den Schulbereich +unter #on("b")#ls-DIALOG#off("b")# zu entwickeln.#off("u")# + + Mit #on("b")#ls-Menu-Generator#off("b")# haben Sie zwei Komponenten +erworben: Das Generator-Programm zur Erzeugung von +Menukarten und eine umfangreichen Dokumentation. Dabei +enthält die Dokumentation nicht nur Informationen dar­ +über, wie Sie mit dem Generator-Programm arbeiten kön­ +nen - das natürlich auch. Darüberhinaus werden Ihnen +alle Möglichkeiten, die #on("b")#ls-DIALOG#off("b")# zur Programmgestal­ +tung bietet, ausführlich erläutert - das macht den we­ +sentlichen Teil der Dokumentation aus! + + #on("b")#ls-DIALOG#off("b")# ist eigentlich ein "Baukastensystem", auf +das andere Programme zugreifen können. Sie wissen si­ +cherlich, wieviel Arbeit bei jedem Programm aufzuwen­ +den ist, um die Benutzerschnittstelle zu realisieren. Die +Gestaltung und Pflege der Benutzerschnittstelle kann +bis zu 50% der Gesamtarbeit an einem Programm ausmachen. +#on("b")#ls-Menu-Generator#off("b")# soll Ihnen helfen, diese Arbeit zu +verringern. + + Alle Informationen, die ein Menu betreffen, sind in +der sogenannten 'Menukarte' abgelegt. Wird nun ein Pro­ +gramm unter #on("b")#ls-DIALOG#off("b")# aufgerufen, so wird die entspre­ +chende Menukarte aus der "Menukarten - Sammeltask" ('ls- +MENUKARTEN') geholt und an das System angekoppelt. An­ +schließend wird dem Anwender das Menu auf dem Bildschirm +angeboten. + Das Erstellen solcher Menukarten ist mit dem Genera­ +torprogramm sehr einfach - es wird in Kapitel 4 beschrie­ +ben. Allerdings sollten Sie nicht die Arbeit unterschät­ +zen, die Sie für eine sorgfältig erstellte, mit allen In­ +formationtexten gefüllte Menukarte aufwenden müssen! + + Bei den meisten Programmmen reicht aber ein einfaches +Menu nicht aus. Bei vielen Verarbeitungsfunktionen ist +es notwendig, mit dem Anwender einen Dialog zu führen: +z.B. muß ein Dateiname erfragt, eine Information ausgege­ +ben und bestätigt, eine Auswahl oder eine Entscheidung +getroffen werden. Alle Möglichkeiten, die #on("b")#ls-DIALOG#off("b")# dazu +bereitstellt, sind in Kapitel 5 dokumentiert. + + Einige Reihe von Verarbeitungsfunktionen treten in +nahezu jeder Anwendung auf (Datei- und Archivhandling). +Hier stellt #on("b")#ls-DIALOG#off("b")# schon vorgefertigte Module zur +Verfügung. In Kapitel 6 zeigen wir Ihnen, wie Sie auf die­ +se Module zugreifen und sie in Ihr Programmsystem ein­ +binden können. In Kapitel 7 zeigen wir Ihnen außerdem, +wie Sie eigene Fenster definieren können und welche Ope­ +rationen auf diesen Fenstern zur Verfügung stehen. + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.2 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.2 new file mode 100644 index 0000000..696ed28 --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.2 @@ -0,0 +1,87 @@ +#type ("prop.lq")##limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (6)# +#headodd# +#center#ls-Menu-Generator#right#% + +#end# +#headeven# +%#center#ls-Menu-Generator + +#end# +#type ("prop.breit.lq")# +#center#2 + +#center#Installation +#center#von +#center#ls-Menu-Generator +#type ("prop.lq")# + + + Bevor Sie #on("b")#ls-Menu-Generator#off("b")# auf Ihrem System benut­ +zen können, müssen Sie das Programm zunächst installie­ +ren. Wenn #on("b")#ls-Menu-Generator#off("b")# auf Ihrem System schon zur +Verfügung steht, können Sie dieses Kapitel ruhig über­ +springen. + + +2.1 Voraussetzungen + + Um #on("b")#ls-Menu-Generator#off("b")# auf Ihrem Computer betreiben +zu können, muß das EUMEL-Betriebssystem (Multi-User- +Version) installiert und das Programmpaket #on("b")#ls-DIALOG#off("b")# +(Version 1.1) bereits insertiert sein. + + +2.2 Lieferumfang + + #on("b")#ls-Menu-Generator#off("b")# wird auf einer Diskette geliefert, +die alle notwendigen Programme enthält. Folgende Dateien +sollten sich auf der Diskette befinden: + + "fonttab.ls-Menu-Generator" + "ls-MENUBASISTEXTE" + "Generatordatei: Archivmenu" + "ls-Menu-Generator 1" + "ls-Menu-Generator 2" + "ls-Menu-Generator/gen" + + Eventuell können noch weitere Namen auf der Diskette +vorhanden sein. + + +2.3 Installation + +Die Installation erfolgt in #on("u")#zwei Schritten#off("u")#: + + #on("u")#Zunächst#off("u")# muß die mitgelieferte Fonttabelle +('fonttab.ls-Menu-Generator') in die Task 'configurator' +geholt werden. Da Sie aus dem 'UR-Zweig' des EUMEL- +Systems keinen schreibenden Zugriff auf die Task +'configurator' haben, müssen Sie die Task 'configurator' +an Ihr Terminal koppeln und die Datei 'fonttab.ls-Menu- +Generator' von der Diskette in die Task kopieren. + #on("u")#Anschließend#off("u")# kann #on("b")#ls-Menu-Generator#off("b")# in einer Task +installiert werden, in der bereits das Programm #on("b")#ls-DIALOG#off("b")# +zur Verfügung steht. Richten Sie also eine Task als Sohn +der Task ein, in der auf Ihrem Computer bereits #on("b")#ls-DIALOG#off("b")# +installiert ist. Legen Sie dann die Archivdiskette ein, +auf der sich #on("b")#ls-Menu-Generator#off("b")# befindet und geben Sie +die folgenden Kommandos: + + archive("ls-Menu-Generator") + + fetch("ls-Menu-Generator/gen",archive) + + run + + Sie haben damit das Generatorprogramm gestartet; die +Installation wird automatisch durchgeführt. Lassen Sie +während des gesamten Vorgangs die Archivdiskette einge­ +legt. Die Generierung ist beendet, wenn der EUMEL-Ein­ +gangsbildschirm erscheint. Die Task, in der die Generie­ +rung stattfindet, wird automatisch zur Managertask, das +heißt, daß Söhne von ihr eingerichtet werden können. + + + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.3 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.3 new file mode 100644 index 0000000..e982988 --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.3 @@ -0,0 +1,155 @@ +#block##pageblock# +#pagenr("%",1)##setcount(1)##count per page# +#headeven# +gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#headodd# +#right#gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +3 - % #right#ERGOS +#end# +#bottomodd# +#center#____________________________________________________________ +ERGOS #right# 3 - % +#end# +#ib#3 Die Arbeitsweise von gs-DIALOG#ie# + + +In diesem Kapitel soll die grundsätzliche Arbeitsweise von gs-DIALOG erläutert +werden. Sie erfahren, wie das Menusystem aufgebaut ist, wie man Menukarten an­ +koppelt und Menus zur Ausführung bringt. Ebenso wird erläutert, wie eine Menukarte +aufgebaut ist. +Wenn Sie die hier beschriebenen Vorgänge auf ihrem System nachvollziehen wollen, +so muß in Ihrer Task das Programm 'gs-DIALOG' zur Verfügung stehen! + + +#ib#3.1 Ankoppeln einer Menukarte - Ausführen eines Menus#ie# + +Vereinfacht gesagt ist eine Menukarte ein Datenraum, in dem alle Informationen, die +zum Menu (zu den Menus) gehören, abgelegt sind. Der genaue Aufbau einer solchen +Menukarte wird in Kapitel 3.2 beschrieben. +Alle Menukarten, die auf einem System zur Verfügung stehen, werden in einer zentra­ +len Task ('gs-MENUKARTEN') bereitgehalten. Die Menukarten können von hier +angefordert werden. +Lassen Sie sich in Ihrem System eine Übersicht der vorhandenen Menukarten geben +(list (/"gs-MENUKARTEN") ). Darauf wird Ihnen gegebenenfalls folgen­ +de Übersicht angeboten: + + 01.09.87 "gs-MENUKARTE:Archiv" + 01.09.87 "gs-MENUKARTE:Herbert und Robbi" + 01.09.87 "gs-MENUKARTE:MP-BAP" + ... + +Zumindest die erste Menukarte müßte - sofern die gs-DIALOG-Basissoftware instal­ +liert ist - auf Ihrem System vorhanden sein. Die beiden anderen Menukarten sind +natürlich nur dann vorhanden, wenn Sie die Programme 'gs-Herbert und Robbi' +und 'gs-MP BAP' installiert haben. + +In einer weiteren Task (z.B. 'DIALOG') sind die Programme installiert, die es ermög­ +lichen, diese Menukarten zu handhaben. Alle Sohntasks dieser Task "erben" natür­ +lich diese Fähigkeiten. Von einer solchen Task aus kann nun eine Menukarte ange­ +fordert und ein darin enthaltenes Menu zur Ausführung gebracht werden. Das haben +Sie sicher schon oft gemacht, z.B. wenn Sie den Befehl 'archiv' gegeben haben. Was +hinter diesem Befehl steckt, sollen Sie sich jetzt klar machen: + +Wenn Sie den Befehl 'archiv' geben, wird zunächst die Menukarte +'gs-MENUKARTE:Archiv' aus der Task 'gs-MENUKARTEN' angefordert und in Ihre +Task kopiert. Davon merken Sie normalerweise nichts, denn nachdem die Ankopp­ +lung des Datenraumes (als unbenannter Datenraum) erfolgt ist, wird die Daten­ +raumkopie gelöscht; daher taucht der Name auch nie in Ihrer Dateiliste auf. Intern +vermerkt das System, welche Menukarte aktuell angekoppelt ist. Soll wiederholt +dieselbe Menukarte angekoppelt werden, so erübrigt sich das Kopieren aus der zen­ +tralen Bereitstellungstask. + +Nach dem Ankoppeln der Menukarte können Sie auf die in der Menukarte enthalte­ +nen Informationen zugreifen. Da in einer Menukarte mehrere Menus enthalten sein +können, müssen Sie dem System noch mitteilen, welches Menu aktiviert werden soll. +In der Menukarte 'gs-MENUKARTE:Archiv' ist nur ein Menu enthalten, das den +Namen 'ARCHIV' hat (der Name des Menus erscheint übrigens bei der Präsentation +immer oben links in der Kopfzeile). + +Sie sollen jetzt, ohne den Befehl 'archiv' zu verwenden, das Menu zur Ausführung +bringen. Geben Sie dazu die folgenden Kommandos in der 'gib kommando:'- Ebene: + + #ib#install menu#ie# ("gs-MENUKARTE:Archiv"); + #ib#handle menu#ie# ("ARCHIV") + +Mit dem ersten Befehl koppeln Sie die genannte Menukarte an, mit dem zweiten +Befehl bringen Sie das darin enthaltene Menu 'ARCHIV' zur Ausführung. +Allerdings stellen Sie sicher auch einen Unterschied zur Ausführung des Befehls +'archiv' fest, denn dort erscheint nicht erst unser "Software - Emblem" auf dem +Bildschirm, sondern direkt das Menu. + +Wenn Ihnen eines der Programme 'gs-Herbert und Robbi' oder 'gs-MP BAP' +bekannt ist, haben Sie unser Emblem aber sicher schon gesehen - wir verwenden es +immer, um unsere Softwareprodukte kenntlich zu machen. Da man aber das Archiv­ +programm sehr häufig benötigt und es dann nur störend wirkt kann die Ausgabe +unterdrückt werden. Daher gibt es den Befehl 'install menu' in zwei Versionen. +Versuchen Sie es gleich einmal: + + install menu ("gs-MENUKARTE:Archiv", FALSE); + handle menu ("ARCHIV") + +Die Präsentation des Menus erfolgt gleich aus zwei Gründen schneller als beim ersten +Mal: einerseits wurde auf die Ausgabe unseres Software - Emblems verzichtet, ande­ +rerseits brauchte die Menukarte nicht erneut aus der Task 'gs-MENUKARTEN' kopiert +zu werden, da sie ja schon angekoppelt war. +Damit sind Sie nun in der Lage, Menukarten anzukoppeln und Menus zur Ausfüh­ +rung zu bringen. + + +#ib#3.2 Aufbau/Inhalt einer Menukarte#ie# + +Eine Menukarte ist eine komplexe Datenstruktur, die bis zu 6 vollständige Menus +aufnehmen kann. Weiterhin sind eine Reihe von Texten in jeder Menukarte abgelegt, +auf die gs-DIALOG zurückgreift. Darüberhinaus kann der Anwendungsprogram­ +mierer bis zu 2000 Texte in die Menukarte auslagern, um so beim Insertieren seiner +Programme den Umfang an Paketdaten geringer zu halten. +Auf den ersten Blick scheint es wenig Sinn zu machen, mehrere Menus in einer +Menukarte zu verwalten. Nehmen wir aber als Beispiel das Programmsystem +gs-Herbert und Robbi. Hier ist ein Programm in zwei unterschiedlichen Ausprä­ +gungen zu behandeln. Sowohl das Hamster- als auch das Robotermenu befinden sich +in einer Menukarte. Bei einem Wechsel zwischen den Modellen braucht also keine +neue Menukarte angefordert, sondern nur ein neues Menu aus der aktuellen Menu­ +karte aktiviert zu werden. +Zum anderen ist gs-DIALOG schon auf umfangreichere Programmsysteme vorberei­ +tet: Es ist nämlich möglich, von einem Menu aus ein weiteres Menu aus der aktuellen +Menukarte zu aktivieren. Auf dem Bildschirm werden die beiden Menus dann ge­ +schachtelt (das zuletzt aktivierte vor dem aufrufenden Menu) angezeigt. Nach Verlas­ +sen der zweiten Menuebene gelangt der Benutzer automatisch in das Ausgangsmenu +zurück. +Zwar ist es nicht möglich, mehr als zwei Menus gleichzeitig zu aktivieren (geschach­ +telt auf dem Bildschirm darzustellen), doch können an verschiedenen Stellen des +Ausgangsmenus ja unterschiedliche Menus aus der aktuellen Menukarte aktiviert +werden. + +Jedes Menu in der Menukarte wird durch einen Namen gekennzeichnet. Dieser Name +erscheint in der Kopfzeile oben links. Über diesen Namen kann das Menu aktiviert +werden. +Ein Menu besteht aus den sogenannten 'Oberbegriffen', die in der Kopfzeile angezeigt +werden. In einer Kopfzeile können bis zu 10 Oberbegriffe verwaltet werden. Da zu +jedem Oberbegriff bis zu 15 Verarbeitungsfunktionen (in den Pull-Down-Menus) +verwaltet werden können, ist es möglich, in einem Menu bis zu 150 Verarbeitungs­ +funktionen abzulegen. Nutzt man alle 6 Menus einer Menukarte, so können maximal +bis zu 900 Verarbeitungsfunktionen in einer Menukarte verwaltet werden. + +Eine Verarbeitungsfunktion besteht aus der/dem + + - 'Ein-Zeichen-Kennung' - die angibt, durch welche Taste die Verarbei­ + tungsfunktion ggf. aktiviert werden kann; + - 'Menupunktbezeichnung' - die im Pull-Down-Menu als Name für die + Verarbeitungsfunktion erscheint; + - 'Funktionsaufruf' - dem Namen der Prozedur, die bei der Aktivie­ + rung des Menupunktes zur Ausführung ge­ + bracht wird; + - 'Informationstext' - der zur aktuellen Verarbeitungsfunktion durch + Tippen der -Taste abgerufen werden + kann. + + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.4 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.4 new file mode 100644 index 0000000..97e7491 --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.4 @@ -0,0 +1,424 @@ +#block##pageblock# +#pagenr("%",1)##setcount(1)##count per page# +#headeven# +gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#headodd# +#right#gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +4 - % #right#ERGOS +#end# +#bottomodd# +#center#____________________________________________________________ +ERGOS #right# 4 - % +#end# +#ib#4 Erstellen einer neuen Menukarte#ie# + + +Aus Kapitel 3 wissen Sie, wie man eine fertige Menukarte ankoppelt und wie man ein +darin enthaltenes Menu zur Ausführung bringen kann. Außerdem wissen Sie bereits, +welche Informationen in einer Menukarte untergebracht werden können. In diesem +Kapitel nun wollen wir Ihnen zeigen, wie Sie eine eigene Menukarte entwickeln +können. +Damit Sie sich die Abläufe besser vorstellen können, werden wir die Vorgänge an +einem Beispiel aufzeigen: Wir wollen eine 'kleine Textverarbeitung' schaffen, deren +Verarbeitungsfunktionen über ein Menu angeboten werden. +Es sei aber darauf hingewiesen, daß es nicht darum geht, eine voll funktionsfähige +Textverarbeitung auszuarbeiten - vielmehr sollen die Erstellung der Menukarte und +das Nutzen der durch gs-DIALOG bereitgestellten Werkzeuge exemplarisch auf +gezeigt werden. + + +#ib#4.1  Eintragen der Menupunkte#ie# + +Unsere Menukarte soll den Namen 'Kleine Textverarbeitung' erhalten, das darin +enthaltene Menu den Namen 'SCRIPT'. Unter dem Oberbegriff 'Bearbeiten' sollen 5 +Verarbeitungsfunktionen angeboten werden. Insgesamt soll unser neues Menu fol +genden Aufbau haben: + +SCRIPT: Bearbeiten + + n Neu erstellen + a Ansehen/Ändern + ---------------- + v Verzeichnis + ---------------- + z Zeilenformtierung + s Seitenformatierung + + + +Zur Erzeugung der zugehörigen Menukarte schreiben Sie folgendes Pro­ +gramm in eine Datei: + + +oeffne menukarte ("Kleine Textverarbeitung"); +oeffne menu ("SCRIPT"); + +oberbegriff ("Bearbeiten"); + +menufunktion ("n", "Neu erstellen", "neue datei editieren",""); +menufunktion ("a", "Ansehen/Ändern", "alte datei editieren",""); +trennlinie; +menufunktion ("v", "Verzeichnis", "verzeichnis ausgeben",""); +trennlinie; +menufunktion ("z", "Zeilenformatierung", "zeilen formatieren",""); +menufunktion ("s", "Seitenformatierung", "seiten formatieren",""); + +schliesse menu; +schliesse menukarte; + + +Bevor wir Ihnen die Einzelheiten erklären, sollten Sie zuerst einmal Ihr neu erstelltes +Menu ausprobieren. Verlassen Sie dazu die Datei und geben Sie das Kommando 'run'. +Nachdem das von Ihnen geschriebene Programm übersetzt worden ist, meldet sich +der Menu-Generator. +Die an Sie gestellte Frage 'Sollen auch Anwendungs texte in die Menukarte aufge­ +nommen werden (j/n)?' beantworten Sie einfach mit n(ein). Auf dem Bildschirm +wird angezeigt, wie die Menukarte erstellt wird. Auf das Ende der Menukartengenerie­ +rung wird hingewiesen. Wenn Sie sich jetzt die Dateiliste Ihrer Task anzeigen lassen, +taucht dort eine Datei mit Namen 'gs-MENUKARTE:Kleine Textverarbeitung' auf - das +ist die neue Menukarte. +Sie möchten sicher gleich ausprobieren, ob das Menu Ihren Vorstellungen entspricht. +Geben Sie dazu das Kommando 'testinstallation ("gs-MENUKARTE:Kleine Textver­ +arbeitung")'. Bitte geben Sie den Text genauso ein wie hier angegeben! +Nach kurzer Zeit erscheint der Hinweis 'Installation abgeschlossen!'. Geben Sie nun +den Befehl 'handle menu ("SCRIPT")'; hierdurch aktivieren Sie das von Ihnen neu +erstellte Menu - es erscheint auf dem Bildschirm. + +Über den Befehl '#ib#testinstallation#ie#' haben Sie sich sicher gewundert. Ihnen ist ja +schon der Befehl '#ib#install menu#ie#' bekannt. Dieser Befehl aber kann hier nicht ein­ +fach angewendet werden - er ist für den (späteren) "regulären Betrieb" vorgesehen. +Bedenken Sie bitte zweierlei: Die Menukarte befindet sich nur in Ihrer Task, 'install +menu' fordert die Menukarte aber aus der Task 'gs-MENU KARTEN' an. Ist eine +Menukarte schon angekoppelt gewesen, so wird nicht erneut angekoppelt, sondern +auf die angekoppelte Menukarte zurückgegriffen. Dies alles können wir bei der +Menukartenerstellung nicht gebrauchen! +Der Befehl 'testinstallation' sendet automatisch die Menukarte zur Task +'gs-MENUKARTEN' und kennzeichnet Sie noch durch den eigenen Tasknamen (da +durch können sich beim Multiuserbetrieb unterschiedliche Anwender mit gleichem +Menukartennamen nicht gegenseitig stören). Die Menukarte wird anschließend in +jedem Falle 'frisch' angekoppelt, so daß Sie nach dem Befehl immer die aktuelle +Menukarte angekoppelt haben. Außerdem bleibt die Menukarte in Ihrer Task erhal­ +ten! + +Doch nun zur Erläuterung des oben notierten Programms: + +Ein Programm zur Erstellung einer Menukarte muß immer mit dem Befehl '#ib#oeffne +menukarte#ie#' beginnen und mit dem Befehl '#ib#schliesse menukarte#ie#' abgeschlos­ +sen werden. Der Befehl 'oeffne menukarte' hat einen Parameter (TEXT CONST) - +hierdurch wird festgelegt, welchen Namen die Menukarte haben soll. Durch das +Kommando 'oeffne menu karte ("Menu 1")' entsteht also die Menukarte 'gs-MENU +KARTE:Menu 1". +In die Menukarte können jetzt bis zu 6 Menus eingetragen werden. Jeder Eintrag +eines Menus beginnt mit dem Befehl '#ib#oeffne menu#ie#' und endet mit dem Befehl +'#ib#schliesse menu#ie#'. Der Befehl 'oeffne menu' hat hier einen Parameter (TEXT +CONST) - hierdurch wird festgelegt, welchen Namen das Menu erhalten soll. Unter +diesem Namen kann später das Menu angesprochen werden (z.B. 'handle menu +("SCRIPT")'. + +Den Befehl 'oeffne menu' gibt es noch in zwei weiteren Ausführungen: +Mit drei Textparametern - neben dem Namen des Menus können hier noch zwei +Prozedurnamen angegeben werden. Diese Prozeduren werden beim Einstieg in das +Menu bzw. beim Verlassen des Menus aufgerufen. Hiervon wird z.B. Gebrauch ge­ +macht, wenn das Archiv-Menu in eine Menukarte integriert ist: Wenn das Menu +verlassen wird, soll sichergestellt sein, daß das Archiv automatisch freigege ben wird. +Mehr hierüber erfahren Sie im Kapitel 6.1, in dem aufgezeigt wird, wie das Archiv- +Menu in andere Menus eingebunden wird. +Mit sechs Textparametern - neben den eben genannten drei Parametern können noch +drei Texte übergeben werden. Diese Texte werden beim Aufruf des Menus unten +rechts auf dem Bildschirm ausgegeben. Bei unseren Software-Produkten (z.B. +'gs-Herbert und Robbi') machen wir davon Gebrauch, um Hinweise auf das +Produkt, die Versionsnummer etc. zu geben. Die Hinweise bleiben nur kurz auf dem +Bildschirm und verschwinden nach kurzer Zeit automatisch, oder wenn Sie irgen +deine Taste tippen. Bei der Notation der Texte müssen Sie sich allerdings an einige +Regeln halten (sehen Sie dazu Kapitel 5.12). + +Zwischen den Befehlen 'oeffne menu' und 'schliesse menu' werden nun die Oberbe­ +griffe (Kopfzeile) und die zugehörigen Verarbeitungsfunktionen eingetragen. Dabei +müssen Sie sich genau an folgende Abfolge halten: +Zuerst wird jeweils der Oberbegriff genannt, der in der Kopfzeile auftauchen soll. +Direkt unter dem jeweiligen Oberbegriff werden die Menufunktionen eingetragen, die +im zugehörigen 'Pull-Down-Menu' als Verarbeitungsfunktionen angeboten werden +sollen. Die einzelnen Oberbegriffe mit Ihren zugehörigen Verarbeitungsfunktionen +werden blockweise hintereinander notiert. Dadurch ergibt sich die folgende Struktur: + + +oeffne menu ("Menuname"); + +oberbegriff ("Oberbegriff 1"); + +menufunktion ("1", "Verarbeitungsfunktion 1", "", ""); +menufunktion ("2", "Verarbeitungsfunktion 2", "", ""); +... + +oberbegriff ("Oberbegriff 2"); + +menufunktion ("1", "Verarbeitungsfunktion 1", "", ""); +menufunktion ("2", "Verarbeitungsfunktion 2", "", ""); +... + +oberbegriff ("Oberbegriff 3"); + +menufunktion ("1", "Verarbeitungsfunktion 1", "", ""); +menufunktion ("2", "Verarbeitungsfunktion 2", "", ""); +... + +... schliesse menu; + + +Die Oberbegriffe werden in die Kopfzeile von links nach rechts eingetragen. Maximal +können 10 Oberbegriffe eingetragen werden. Wählen Sie die Bezeichnungen nicht zu +lang, denn sie müssen alle neben dem Namen des Menus in der Kopfzeile Platz +finden (Ansonsten erhalten Sie hierauf bei der Menukartengenerierung einen Hin­ +weis, die Generierung wird abgebrochen!)! + +Den Befehl '#ib#oberbegriff#ie#' gibt es in zwei Versionen: +In der hier aufgezeigten Version mit einem (TEXT-) Parameter: Hierdurch wird der +Oberbegriff in der Kopfzeile festgelegt. In der zweiten Version hat der Befehl drei +(TEXT-)Parameter: Durch den ersten wird - wie eben - die Kopfzeilenbezeichnung +festgelegt. Daneben können noch zwei Prozedurnamen angegeben werden. Die +Prozedur mit dem erstgenannten Namen wird beim Einstieg (vor dem "Ausklappen" +des Pull-Down-Menus) ausgeführt, die Prozedur mit dem zweitgenannten Namen vor +dem Ausstieg ("Einklappen"). Beim 'Archiv-Pull-Down-Menu' machen wir hiervon +Gebrauch. Beim Einstieg wird dafür gesorgt, daß nur bestimmte Verarbeitungsfunk­ +tionen aktivierbar sind; beim Ausstieg wird sichergestellt, daß das Archivlaufwerk +automatisch freigegeben wird. + +Unter einem Oberbegriff können Sie bis zu 15 Verarbeitungsfunktionen in ein Pull- +Down-Menu eintragen. Die Verarbeitungsfunktionen können Sie optisch vonein ander +trennen. Dafür steht der Befehl '#ib#trennlinie#ie#' zur Verfügung. Aber beachten Sie, er +belegt den gleichen Platz wie eine Verarbeitungsfunktion. + +Zum Eintragen einer Verarbeitungsfunktion steht der Befehl '#ib#menufunktion#ie#' zur +Verfügung. Der Befehl besitzt vier (TEXT-)Parameter. Die ersten beiden Parameter +werden auch auf dem Bildschirm ausgegeben. +Der erste Parameter legt fest, über welche Taste diese Verarbeitungsfunktion direkt +zur Ausführung gebracht werden kann. Wenn eine Eintragung erfolgt, muß diese aus +genau einem Zeichen bestehen. Innerhalb eines Pull-Down-Menus muß dieses +Zeichen eindeutig sein, d.h. es darf nur einmal verwendet werden. Ansonsten er­ +scheint bei der Menugenerierung eine Fehlermeldung. +Der zweite Parameter ist die Bezeichnung der Verarbeitungsfunktion, die dem Be­ +nutzer im Pull-Down-Menu angeboten wird. Wählen Sie die Bezeichnung bitte immer +prägnant und möglichst mit dem Buchstaben beginnend, den Sie auch als ersten +Parameter angegeben haben! Der Länge dieser Bezeichnung ist nur durch die Bild­ +schirmbreite (nicht mehr als 60 Zeichen) begrenzt, allerdings wählt gs-DIALOG die +Breite des Pull-Down-Menus nach der längsten Bezeichnung, die im jeweiligen Pull- +Down-Menu auftritt. Wenn die Bezeichnungen ganz unterschiedlich lang sind, sieht +das nicht sonderlich gut aus, aber probieren Sie es ruhig einmal aus und entscheiden +Sie selbst. + +Der dritte Parameter ist der Name der Prozedur, die bei der Aktivierung der Verarbei­ +tungsfunktion ausgewählt werden soll. Zum Zeitpunkt der Erstellung und des Testens +des Menusystems braucht diese Prozedur noch nicht zu existieren. Damit ist es +möglich, die Menuentwicklung völlig unabhängig von der Entwicklung der Verarbei­ +tungsfunktionen zu betreiben; Sie brauchen nur die späteren Namen der aufzurufen­ +den Prozeduren festzulegen! Aktivieren Sie eine solche Verarbeitungsfunktion im +Pull-Down-Menu, die noch nicht fertiggestellt ist, so erscheint der Hinweis 'unbe­ +kanntes Kommando' - das kann aber auch geschehen, wenn die Verarbeitungsfunk­ +tion schon existiert, Sie aber bei der Eintragung einen (Schreib-)Fehler gemacht +haben! + +Der vierte Parameter ist der Text, der als sogenannter Infotext ausgegeben wird wenn +Sie auf die entsprechende Verarbeitungsfunktion positioniert haben und hier die +-Taste tippen. In unserem Beispiel haben wir keinen Infotext eingetragen. +Versuchen Sie im Menu jetzt die -Taste zu tippen, so erscheint der Hinweis +'Leider ist zu diesem Menupunkt kein Info-Text eingetragen!'. Für die Handhabung +des Menus sind diese Informationstexte nicht wichtig, sie dienen ausschließlich der +Information des Benutzers. +Die Arbeit zur Formulierung/Abfassung dieser Texte sollten Sie nicht unterschätzen. +Sie sollten sich bei einer ernsthaften Anwendung aber diese Arbeit machen. Gerade +der Anfänger, der mit Ihrem Menusystem arbeitet, wird Ihnen diese Arbeit danken. +Wie Sie diese Texte komfortabel erstellen und in die Menutafel einbinden können, +erklären wir Ihnen im nächsten Kapitel. + + +#ib#4.2 Erstellung und Einbinden von Informationstexten#ie# + +Bisher haben wir noch keine Informationstexte zu den Menupunkten in die Menu­ +karte eingetragen. Diese Eintragung erfolgt über den vierten Parameter des Befehls +'menufunktion'. Möchten Sie dort nur einige wenige Worte eintragen, so kann das +direkt geschehen. Meist aber sind die Informationen zu einem Menupunkt doch +länger, sie erstrecken sich über mehrere Zeilen. +Zur Übergabe des Informationstextes steht aber nur ein Textparameter zur Verfügung. +Würde man längere Texte direkt eintragen, wäre das bei der Menukartenerstellung +sicher sehr unübersichtlich. Zum anderen benötigt gs-DIALOG den Text schon in +aufbereiteter Form, d.h. es müssen z.B. Zeilenenden etc. kenntlich gemacht wer den. +Damit Sie sich nun nicht alle Regeln der Texterstellung für gs-DIALOG merken +müssen, bietet Ihnen gs-Menu-Generator eine komfortable Möglichkeit, diese +Informationstexte zu entwickeln. Wir wollen das an einem Beispiel verdeutlichen: + +Erzeugen Sie sich eine Datei mit dem Namen 'Textprobe' und schreiben Sie z.B. +folgenden Text, der ein Informationstext zum Menupunkt 'Neu erstellen' sein könnte, +hinein: + +Text neu erstellen + +Das System erfragt zunächst den Namen für die Datei, in die +der neue Text geschrieben werden soll. Anschließend wird eine +leere Datei mit dem gewünschten Namen zum Beschreiben +angeboten. +Das Schreiben in eine solche Datei wird durch viele Hilfen +erleichtert. Deshalb ist es ratsam, sich nach und nach mit +den Möglichkeiten, die der Editor bietet, vertraut zu machen. +Die Möglichkeiten sind im EUMEL-Benutzerhandbuch ausführlich +beschrieben. + +Verlassen Sie nun die Datei und geben Sie in der 'gib kommando:'-Ebene folgendes +Kommando: + + #ib#textprozedur#ie# ("Textprobe", "mein erster infotext") + +Auf dem Bildschirm erscheint zunächst der Hinweis 'Bitte warten ...', anschließend +werden Sie - wie aus der Textverarbeitung (lineform) bekannt - aufgefordert, entspre­ +chende Trennungen vorzunehmen. +Das eben eingegebene Kommando bewirkt nämlich, daß der in der Datei 'Textprobe' +enthaltene Text für gs-DIALOG so aufbereitet wird, daß er in einer Box innerhalb des +Menus eingeblendet werden kann. Die Zeilen werden auf die entsprechende Länge +zugeschnitten und der Text in den Zeilen wird geblockt, soweit Sie keine Absatzmarke +() gesetzt haben. +Der so den Regeln von gs-DIALOG entsprechend aufbereitete Text wird automatisch +in eine Textprozedur "verpackt", die den von Ihnen als zweiten Parameter übergebe­ +nen Namen erhält. Beachten Sie deshalb bei der Festlegung des Namens, daß er mit +einem Kleinbuchstaben beginnt und weiterhin nur Kleinbuchstaben, Ziffern und +Leerzeichen enthält! +Diese Textprozedur finden Sie anschließend in der Datei 'Textprobe.a'. An der En­ +dung '.a' können Sie erkennen, daß in dieser Datei ein "aufbereiteter" Text enthalten +ist. +Wenn Sie sich, nachdem auf dem Bildschirm der Hinweis 'Textprozedur ist erstellt!' +erschienen ist, die Datei 'Textprobe.a' ansehen, so hat diese folgenden Inhalt: + + +TEXT PROC mein erster infotext: +" Text neu erstellen "13"" + +" "13"" + +" Das System erfragt zunächst den Namen für die Datei, in die der "13""+ +" neue Text geschrieben werden soll. Anschließend wird eine leere "13""+ +" Datei mit dem gewünschten Namen zum Beschreiben angeboten. "13""+ +" Das Schreiben in eine solche Datei wird durch viele Hilfen er-"13""+ +" leichtert. Deshalb ist es ratsam, sich nach und nach mit den Mög-"13""+ +" lichkeiten, die der Editor bietet, vertraut zu machen. "13"" + +" Die Möglichkeiten sind im EUMEL-Benutzerhandbuch ausführlich be-"13""+ +" schrieben. " +END PROC mein erster infotext; + + +Kopieren Sie nun den Inhalt der Datei 'Textprobe.a' in die Datei, in die Sie das Pro­ +gramm zur Generierung Ihrer Menukarte geschrieben haben und ergänzen Sie die +Ein tragung beim ersten Menupunkt in folgender Weise: + + +TEXT PROC mein erster infotext: +" Text neu erstellen "13"" + +" "13"" + +" Das System erfragt zunächst den Namen für die Datei, in die der"13""+ +" neue Text geschrieben werden soll. Anschließend wird eine leere"13""+ +" Datei mit dem gewünschten Namen zum Beschreiben angeboten. "13""+ +" Das Schreiben in eine solche Datei wird durch viele Hilfen er-"13""+ +" leichtert. Deshalb ist es ratsam, sich nach und nach mit den Mög-"13""+ +" lichkeiten, die der Editor bietet, vertraut zu machen. "13""+ +" Die Möglichkeiten sind im EUMEL-Benutzerhandbuch ausführlich be-"13""+ +" schrieben. " +END PROC mein erster infotext; + +oeffne menukarte ("Kleine Textverarbeitung"); +oeffne menu ("SCRIPT"); + +oberbegriff ("Bearbeiten"); + +menufunktion ("n", "Neu erstellen", "neue datei editieren", + mein erster infotext); +menufunktion ("a", "Ansehen/Ändern","alte datei editieren", ""); +trennlinie; +menufunktion ("v", "Verzeichnis", "verzeichnis ausgeben", ""); +trennlinie; +menufunktion ("z", "Zeilenformatierung", "zeilen formatieren", ""); +menufunktion ("s", "Seitenformatierung", "seiten formatieren", ""); + +schliesse menu; +schliesse menukarte; + + +Starten Sie erneut das Programm mit 'run' und erstellen Sie dadurch eine neue +Menukarte. Installieren Sie anschließend die neue Menukarte mit dem Kommando +'test installation ("gs-MENUKARTE:Kleine Textverarbeitung")' und bringen Sie das +Menu mit dem Kommando 'handle menu ("SCRIPT")' zur Ausführung. Wenn Sie jetzt +auf dem Menu punkt 'n Neu erstellen' die -Taste tippen, erscheint der von +Ihnen eingegebene Infotext in einer Box innerhalb des Menus. Die Größe der Box +wird automatisch durch den Text bestimmt. Die Box ist maximal 65 Zeichen breit +und 14 Zeilen hoch. + +Nachdem Sie nun in der Lage sind, solche Informationstexte zu erstellen und sie in +die Menukarte einzubinden, möchten wir Ihnen noch einige Möglichkeiten der +"Kosmetik solcher Informationstexte" aufzeigen. +Häufig möchte man die Überschrift eines solchen Informationstextes zentriert über +dem Text dargestellt haben. Das läßt sich auch hier einfach bewerkstelligen: Schrei­ +ben Sie dazu als erstes Zeichen der Zeile, die zentriert werden soll, das Zeichen '%' +und schließen Sie die Zeile mit einer Absatzmarke () ab. +Möchten Sie innerhalb des Textes eine Textpassage invers dargestellt haben, so kenn­ +zeichnen Sie den Anfang der Inversdarstellung durch das Zeichen '$' und das Ende +der Inversdarstellung durch das Zeichen '&'. Der Text wird anschließend entspre­ +chend aufbereitet. Allerdings sollte die Textpassage nicht über Zeilengrenzen hinaus­ +gehen! +Möchten Sie in unserem Beispiel die Überschrift zentriert und invers dargestellt +haben, so ersetzen Sie die erste Zeile der Datei 'Textprobe' durch die Zeile: %$Text +neu erstellen&. Wenn Sie anschließend den gesamten oben beschriebenen Vorgang +wiederholen, erscheint die Überschift zentriert und invers dargestellt innerhalb der +Box im Menu. + + +#ib#4.3 Auslagerung von anwendungsbezogenen Texten in die +Menukarte#ie# + +Wie schon in Kapitel 3.2 erwähnt, kann der Anwendungsprogrammierer bis zu 2000 +Texte aus seinen Programmen in die Menukarte auslagern, um so den Umfang an +Paketdaten geringer zu halten, allerdings darf die Gesamtkapazität einer Menukarte +(eines Datenraumes) dabei nicht überschritten werden. + +Die Texte müssen in einer Datei zeilenweise notiert sein. Sie müssen (wie TEXT-Deno­ +ter) in Anführungsstriche eingefaßt sein, allerdings dürfen die Texte länger als +(normale) TEXT-Denoter (255 Zeichen) sein. Innerhalb der Textzeile dürfen auch die +Ausgabecodes "4", "5", "7", "10", "13", "14", und "15" verwendet werden. Innerhalb +der Textzeile darzustellende Anführungszeichen unterliegen den gleichen Besonder­ +heiten wie sonst auch bei TEXT-Denotern. +Machen wir ein Beispiel! Schreiben Sie in eine Datei mit Namen 'Neue Texte' die +folgenden Zeilen: + +"Dieses ist der erste eingetragene Text!" +"Hier ist eine "15"Markierung"14" im Text!" +"Dieses ist die letzte Zeile!" + +Um diese Texte in die Menukarte einzubinden, starten Sie jetzt noch einmal Ihr +Generierungprogramm für die Menukarte. Auf die Frage 'Sollen auch Anwendungstex­ +te in die Menukarte aufgenommen werden (j/n) ?' antworten Sie jetzt allerdings mit +j(a). Daraufhin werden Ihnen die in Ihrer Task vorhandenen Dateien zur Auswahl +angeboten. Kreuzen Sie die Datei 'Neue Texte' an, in der ja die eben genannten Texte +eingetragen sind. +Bei der Menukartengenerierung werden die Texte aus der Datei in die Menukarte +eingebunden. Sollten Sie bei Notierung der Texte in der Datei formale Fehler gemacht +haben, so werden Sie darauf hingewiesen. +Um nun auf die eingelagerten Texte zurückgreifen zu können, muß erst einmal die +neue Menukarte angekoppelt werden. Wie das geht, wissen Sie ja schon ('testin stalla­ +tion'). +Mit dem Befehl '#ib#anwendungstext#ie# (INT CONST zeilennummer)' (1 <= zeilen­ +nummer <= 2000) wird Ihnen nun der Text, der in der angegebenen Zeile steht, +geliefert. Probieren Sie es doch gleich an Ihrer Menukarte aus: 'put (anwendungs­ +text (1))', 'put (anwendungstext (2))' usw.. Die eingelagerten Texte müßten jetzt auf +dem Bildschirm erscheinen. Geben Sie eine Zeilennummer an, die nicht belegt ist, so +wird der Text 'Kein Text vorhanden!' geliefert. + +Es können natürlich auch Texte abgelegt werden, die von gs-DIALOG aus aufgegrif­ +fen werden. Zur Konvertierung von Informationstexten steht die Prozedur '#ib#text zeile#ie# +(TEXT CONST dateiname)' zur Verfügung. Diese Prozedur arbeitet genauso wie die +Prozedur 'textprozedur', nur wird in der Ausgabedatei ('dateiname.a') der formatierte +Text nicht als Textprozedur, sondern als einzeiliger Text geliefert. Sie können aber +auch für gs-DIALOG Texte "von Hand" gestalten. Dazu müssen Sie sich an die +Regeln für die Texte für gs-DIALOG halten, die in Kapitel 5.12 erläutert sind. + + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.5 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.5 new file mode 100644 index 0000000..c002f1a --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.5 @@ -0,0 +1,975 @@ +#block##pageblock# +#pagenr("%",1)##setcount(1)##count per page# +#headeven# +gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#headodd# +#right#gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +5 - % #right#ERGOS +#end# +#bottomodd# +#center#____________________________________________________________ +ERGOS #right# 5 - % +#end# +#ib#5  Dialoge innerhalb des Menus#ie# + + +In Kapitel 4 haben Sie erfahren, wie Sie eine eigene Menukarte entwickeln können; +sicher haben Sie das schon ausprobiert und sich Ihr selbstgestaltetes Menu auf dem +Bildschirm angesehen. Bislang erscheint aber noch der Hinweis 'unbekanntes Kom­ +mando', wenn Sie eine Menufunktion aktivieren - denn die Prozeduren, die Sie bei +der Aktivierung der Menufunktion aufrufen, sind ja noch nicht fertiggestellt! +Bei vielen Menufunktionen ist es notwendig, mit dem Benutzer noch einen Dialog zu +führen: z.B. muß ein Dateiname erfragt, eine Information ausgegeben und bestätigt, +eine Auswahl oder eine Entscheidung getroffen werden. In diesem Kapitel sollen +Ihnen nun die Möglichkeiten vorgestellt werden, die Ihnen zur Verfügung stehen, um +einen solchen Dialog mit dem Benutzer zu führen. Dieser Dialog wird innerhalb des +Menus geführt. Alle Prozeduren, die sich auf diesen Menu-Dialog beziehen, enthalten +deshalb den Wortbestandteil 'menu'. + +Hier noch einige Tips! Damit Sie Ihre Menu-Dialoge testen können, empfiehlt +sich folgendes Vorgehen: Sie erstellen zuerst Ihre Menukarte und tragen schon die +Namen für die jeweils aufzurufenden Prozeduren ein - wie wir es in Kapitel 4 ge­ +macht haben. Mit 'testinstallation' installieren Sie dann in Ihrer Task die neue Menu­ +karte. +Nun schreiben Sie Ihre Prozeduren, die Sie unter das Menu legen wollen. Ist eine +Prozedur "testreif", so müssen Sie sie zunächst insertieren, denn das Menusystem gs- +DIALOG kann nur auf insertierte Prozeduren zugreifen. Anschließend rufen Sie das +Menu (z.B. 'SCRIPT') aus der Menukarte mit dem Befehl 'handle menu ("SCRIPT")' +(Hier ist der jeweilige Menuname einzusetzen!) auf. Wenn Sie den entsprechenden +Menupunkt aktivieren, müßte Ihr Programm ablaufen. +Es ist günstig, eine eigene Task zum Testen der Prozeduren anzulegen, damit diese +hin und wieder gelöscht werden kann. + + +#ib#5.1 Eingabe eines Textes/Namens#ie# ('#ib#menuanswer#ie#') + +Wenn der Benutzer in unserem Beispiel die Menufunktion 'Neu erstellen' aktiviert +hat, muß der Name der Datei erfragt werden, die neu erstellt werden soll. Dafür steht +die Prozedur 'menuanswer' zur Verfügung. Die in die Menukarte eingetragene Proze­ +dur 'neue datei editieren' (Siehe Kapitel 4.1) könnte dann folgendermaßen aussehen: + + +PROC neue datei editieren: + TEXT VAR dateiname := menuanswer ("Bitte den gewünschten Dateinamen:", + "", 5); + IF dateiname <> "" AND NOT exists (dateiname) + THEN command dialogue (FALSE); #ib#cursor on#ie#; + edit (dateiname); + #ib#cursor off#ie#; command dialogue (TRUE); + regenerate menuscreen (* sehen Sie dazu Kapitel 5.10 *) + FI +END PROC neue datei editieren; + + +Schauen wir uns zuerst die Prozedur 'menuanswer' an. Die Prozedur hat drei Para­ +meter. Mit dem ersten Parameter legen Sie den Text fest, der innerhalb der Box +ausgegeben wird, die auf dem Bildschirm erscheint. Der Text dient ausschließlich der +Information des Anwenders. +Mit dem zweiten Parameter können Sie dem Benutzer einen Vorschlag für die Einga­ +be machen, der zum Editieren ausgegeben wird. Da eine solche Vorgabe aber in die­ +ser Situation sinnlos wäre, verzichten wir darauf (""). + +Die auf dem Bildschirm erscheinende Box hat folgendes Aussehen: + + +-------------------------------------+ + I Bitte den gewünschten Dateinamen: I + I I + I I + I Eingabe: I + +-------------------------------------+ + + +Die Boxbreite und -höhe wird vom System automatisch anhand des von Ihnen als +ersten Parameter übergebenen Textes festgelegt. Sie haben noch verschiedene Mög­ +lichkeiten, diesen Text zu gestalten (mehrere Zeilen, Inversdarstellung etc.) - auf +diese Möglichkeiten gehen wir in Kapitel 5.13 detailliert ein. +In unserem Beispiel erscheint die Box in der Mitte des Menubildschirms. Diese +Festlegung treffen wir durch die Angabe der Position '5' als dritten Parameter. Sie +können hier zwischen 5 verschiedenen Positionen wählen: 1 - oben links, 2 - oben +rechts, 3 - unten links, 4 - unten rechts, 5 - zentral im Menubildschirm - mehr dazu +in Kapitel 5.12. + +Mit dem Erscheinen der obigen Box auf dem Bildschirm ändert sich automatisch +auch die Fußzeile im Menu, über die der Benutzer Informationen zur Bedienung +erhält. Hier erscheint der Hinweis: 'Fertig:   Abbruch: '. +Um diese Hinweise brauchen Sie sich aber nicht zu kümmern , da sie alle automa­ +tisch gesetzt werden. +Die Prozedur 'menuanswer' hat noch folgende Besonderheit: Es ist nicht möglich, +den Namen 'break' einzugeben! Diese Eingabe wird automatisch abgefangen. Es hat +sich gezeigt, daß Anwender manchmal versuchen, über die Eingabe +zu verlassen. In diesem Falle entstünde hier eine Datei mit Namen 'break' - was aber +nicht sinnvoll wäre. +Nach der Eingabe liefert die Prozedur 'menuanswer' als Wert den vom Benutzer +eingegebenen Text - dabei sind führende und folgende Leerzeichen schon abgeschnit­ +ten ('compress'). Wurde die Prozedur mit verlassen, so wird niltext +geliefert. + +Wird in obiger Prozedur die Eingabe mit abgebrochen oder existiert +bereits eine Datei mit dem eingegebenen Namen, so verschwindet die Box, und der +Menubildschirm wird automatisch in den alten Zustand gebracht. +Wenn schon eine Datei mit dem Namen existiert, dann wäre es sinnvoll, den Benutzer +darauf aufmerksam zu machen. Wie ein solcher Hinweis in das Menu eingeblendet +werden kann, erklären wir im Kapitel 5.2. + +gs-DIALOG ist so geschrieben, daß der Cursor möglichst wenig störend wirkt. Aus +diesem Grunde wird der Cursor immer an einer Stelle "geparkt". Sofern Ihr System es +zuläßt und eine entsprechende Anpassung vorliegt, wird der Cursor ganz ausgeschal­ +tet. Denken Sie bitte daran, auch wenn er auf Ihrem Bildschirm ständig sichtbar ist! +Wenn also jetzt eine Eingabe erfolgen soll, ist es notwendig, den Cursor anzuschalten. +Wenn Sie wieder in das Menu zurückkehren, sollte der Cursor wieder ausgeschal­ +tet werden, damit er dort nicht stört. +Wenn Sie die Prozedur 'edit' mit einem neuen Namen als Parameter aufrufen, erfragt +das System, ob die Datei neu eingerichtet werden soll. Diese Anfrage muß hier unter­ +drückt werden, damit nicht irgendwelche Texte in den Menubildschirm geschrieben +werden. Das Unterdrücken der Abfrage erreichen Sie durch Ausschalten des Kom­ +mandodialoges. Nach Einrichten der Datei muß der Kommandodialog aber wieder +eingeschaltet werden, da gs-DIALOG das Eingeschaltetsein für eine fehlerfreie Funk­ +tion voraussetzt! + +Mit dem Befehl '#ib#regenerate menuscreen#ie#' (sehen Sie dazu auch Kapitel 5.10) wird der +aktuelle Menubildschirm erneut vollständig auf den Bildschirm geschrieben (repro­ +duziert). Das ist notwendig, weil die Prozedur 'edit' den Bildschirm benutzt hat. +Durch diesen Befehl wird der Menubildschirm exakt in der Form hergestellt, wie er +zuletzt ausgesehen hat. Auch wenn Sie geschachtelte Menubildschirme haben, wer­ +den diese durch den einen Befehl reproduziert. So können Sie in Ihren Verarbei­ +tungsfunktionen mit dem Bildschirm "machen was Sie wollen" - Sie kehren mit dem +letztgenannten Befehl immer wieder so in das Menu zurück, wie Sie es verlassen +haben. + + +#ib#5.2 Ausgabe einer Information#ie# ('#ib#menuinfo#ie#') + +In der Prozedur 'neue datei editieren' (Kapitel 5.1) wäre es sinnvoll, den Benutzer zu +informieren, wenn bereits eine Datei mit dem eingegebenen Namen existiert. Hierfür +steht die Prozedur 'menuinfo' zur Verfügung. + +Beispiel: + +menuinfo (" Eine Datei mit dem Namen "13" existiert schon!"); + +Dadurch wird folgende Box ins Menu geschrieben: + + +----------------------------+ + I I + I Eine Datei mit dem Namen I + I existiert schon I + I I + +----------------------------+ + +Die Box erscheint in der Mitte des Menus (Position 5); in der Fußzeile wird der Hin­ +weis ausgegeben 'Zum Weitermachen bitte irgendeine Taste tippen!'. Dann wartet das +System so lange, bis eine Taste gedrückt wird. Anschließend wird der aktuelle Menu­ +schirm wiederhergestellt. +Die Prozedur 'menuinfo' gibt es noch in zwei weiteren Versionen, nämlich mit zwei +bzw. drei Parametern. Im ersten Fall kann über den zweiten Parameter noch die +Position (1, 2, 3, 4, 5) innerhalb des Menubildschirmes festgelegt werden (sehen Sie +dazu Kapitel 5.12). Mit dem dritten Parameter kann ggf. noch die Wartezeit festgelegt +werden, die das System maximal verstreichen läßt, bevor es von sich aus das Pro­ +gramm fortsetzt. + +'menuinfo (" Eine Datei mit dem Namen "13" existiert schon!", 3, 40)' + +gibt die oben gezeigte Box aus, aber links unten in der Ecke des Menubildschirms +(Position 3). Das System wartet (maximal) 4 Sekunden (40 Zehntel) und setzt dann - +auch ohne Tastendruck - das Programm fort. Diese Prozedur mit gesondert angege­ +bener Wartezeit verwendet man dann, wenn man nicht unbedingt die Kenntnisnahme +der Information durch den Benutzer bestätigt haben möchte. + + +#ib#5.3 Auswahl eines Namen durch Ankreuzen#ie# ('#ib#menuone#ie#') + +Während bei der Neuerstellung einer Datei ein Name neu erfragt werden muß, kann +man beim Menupunkt 'Ansehen/Ändern' auf schon vorhandene Dateien zugreifen. +Sie können dem Benutzer z.B. alle Dateien in der Task zur Auswahl anbieten. Sobald +der Benutzer einen Namen angekreuzt hat, soll die entsprechende Datei geöffnet wer­ +den. Dafür steht der Befehl 'menuone' zur Verfügung: + + +PROC alte datei editieren: + TEXT CONST kopf :: "Textdatei ansehen/ändern", + hinweis :: "Bitte gewünschte Datei ankreuzen"; + TEXT VAR dateiname := menuone (ALL myself, kopf, hinweis, FALSE); + IF dateiname <> "" + THEN #ib#cursor on#ie#; + edit (dateiname); + #ib#cursor off#ie#; + FI; + regenerate menuscreen +END PROC alte datei editieren; + + +Die Prozedur 'menuone' hat 4 Parameter: Als erster Parameter ist ein Thesaurus zu +übergeben, in dem die zur Auswahl stehenden Namen enthalten sind. Zum Thesau­ +rushandling werden noch einige zusätzliche Funktionen zur Verfügung gestellt (z.B. +daß nur Dateien eines bestimmten Typs zur Auswahl angeboten werden können) - +diese Funktionen werden in Kapitel 5.14 erläutert. In unserem Beispiel werden alle +Dateien zur Auswahl angeboten, die in der Task zur Verfügung stehen. +Die beiden Texte, die als 2. und 3. Parameter übergeben werden, erscheinen zur +Kennzeichnung im Kopf der Auswahlliste. Der als zweiter Parameter übergebene Text +erscheint zentriert und invers dargestellt auf dem Bildschirm, der als dritter Parame­ +ter übergebene Text nur zentriert. Es ist sinnvoll, mit dem ersten Text (2.Parame­ +ter) die zur Zeit aktivierte Menufunktion anzuzeigen, denn der Menubildschirm wird +ja durch die Auswahlliste überschrieben. So kann sich der Benutzer besser im Menu­ +system orientieren. +Mit dem 4. Parameter wird festgelegt, ob der Bildschirm nach der Auswahl "ge­ +reinigt", d.h. der alte Menubildschirm wiederhergestellt werden soll. Da in unserem +Falle normalerweise im Anschluß an die Auswahl eine Datei auf dem Bildschirm +editiert wird, verzichten wir auf die "automatische Regenerierung" des Menubild­ +schirms. Dieses besorgen wir nach dem Editieren durch das Kommando 'regenerate +menuscreen' "von Hand". +Auf das Fenster, das für die Auswahl auf dem Bildschirm angezeigt wird, können Sie +keinen Einfluß nehmen - es wird vom System selbständig festgelegt. Dadurch können +Sie die Auswahl, wie auch die anderen Dialogkomponenten ebenso in geschachteleten +Menus aufrufen, ohne daß es zu Problemen kommt. + + +#ib#5.4 Auswahl mehrerer Namen durch Ankreuzen#ie# ('#ib#menusome#ie#') + +Es ist nicht immer sinnvoll, daß der Benutzer nur einen Namen auswählen, d.h. +ankreuzen kann. Bei der Zeilenformatierung könnte man z.B. zulassen, daß gleich +mehrere Dateinamen angekreuzt werden können. Im Anschluß an die Auswahl sollen +dann alle angekreuzten Dateien mit 'lineform' bearbeitet werden. Für diesen Zweck +steht die Prozedur 'menusome' zur Verfügung. Sie hat die gleichen Parameter wie die +in 5.3 erläuterte Prozedur 'menuone' - nur daß hier die Auswahl mehrerer Namen +möglich ist. Verläßt der Benutzer die Auswahl durch , so wird ein +Thesaurus mit allen angekreuzten Namen geliefert; bei Verlassen mit +ein leerer Thesaurus. Beispiel: + + +PROC zeilen formatieren: + TEXT CONST kopf :: "Textdateien zeilenweise formatieren", + hinweis :: "Bitte gewünschte Dateien ankreuzen"; + THESAURUS VAR dateinamen := menusome (ALL myself, kopf, hinweis, + FALSE); + cursor on; + formatiere dateien; + cursor off; + regenerate menuscreen. + + formatiere dateien: + INT VAR zaehler; + FOR zaehler FROM 1 UPTO highest entry (dateinamen) REP + IF name (dateinamen, zaehler) <> "" + THEN lineform (name (dateinamen, zaehler)) + FI + PER +END PROC zeilen formatieren; + + + +#ib#5.5 Eingabe eines Textes/Namens - alternativ: Auswahl + durch Ankreuzen#ie# ('#ib#menuanswerone#ie#','#ib#menuanswersome#ie#') + +Sehr häufig kommt es vor, daß der Benutzer auf die zuletzt bearbeitete Datei zurück­ +greifen will. In Kapitel 5.3 haben wir dem Benutzer bei der Menufunktion 'Anse­ +hen/Ändern' gleich alle Dateien zur Auswahl angeboten. Hier wäre es vielleicht gün­ +stiger gewesen, ihm die zuletzt bearbeitete Datei anzubieten und erst auf Wunsch die +Liste aller Dateien zum Ankreuzen. Das läßt sich auf verschiedene Weise realisieren - +wir werden Ihnen in diesem und in den folgenden Kapiteln verschiedene Möglich­ +keiten aufzeigen: + +Sie können z.B. mit der Prozedur 'menuanswerone' arbeiten. Wie Sie schon aus dem +Namen entnehmen können, handelt es sich dabei um eine Prozedur, die eigentlich +aus zwei Prozeduren, nämlich 'menuanswer' und 'menuone' zusammengesetzt ist. +Stellen Sie sich vor, sie führen den Namen der zuletzt bearbeiteten Datei in Ihrem +Programm unter der Variablen 'letzte datei'. Dann könnte die Prozedur 'alte datei +editieren' aus Kapitel 5.3 auch folgendermaßen geschrieben werden: + + +TEXT VAR letzte datei; +... + + +PROC alte datei editieren: + TEXT CONST hinweis letzte :: "Zuletzt bearbeitete Datei:", + kopf :: "Textdatei ansehen/ändern", + hinweis :: "Bitte gewünschte Datei ankreuzen"; + TEXT VAR dateiname := menuanswerone (hinweis letzte, + letzte datei, + ALL myself, kopf, + hinweis, FALSE); + IF dateiname <> "" + THEN cursor on; + edit (dateiname); + letzte datei := dateiname; + cursor off; + FI; + regenerate menuscreen +END PROC alte datei editieren; + + +Insgesamt hat die Prozedur 6 Parameter: Die ersten beiden Parameter beziehen sich +auf die Eingabe ('menuanswer'). Wie dort kann auch hier der Text festgelegt werden, +der in der Box auf dem Bildschirm erscheint. +Der zweite Parameter ist der Text, der dem Benutzer zum Editieren angeboten wird - +hier der zuletzt benutzte Dateiname. Möchte der Benutzer auf die Datei mit dem an­ +gebotenen Namen zugreifen, braucht er nur mit zu bestätigen. +Möchte er die Auswahl zum Ankreuzen angeboten bekommen, so braucht er nur die +Tastenfolge (für 'Zeigen') zu tippen. Auf diese Auswahl beziehen sich +die letzten 4 Parameter, die die gleiche Bedeutung haben wie bei der Prozedur +'menuone'. Auf die Möglichkeit, durch eine Auswahl angeboten zu +bekommen, wird in der Fußzeile des Menus hingewiesen. + +Aber Achtung! Sie sollten sich einer "Gefahr" bei diesem Vorgehen bewußt sein. Der +Benutzer hat natürlich so die Möglichkeit, auch einen anderen Namen als den vorge­ +schlagenen anzugeben - einen Namen, der noch nicht in der Dateiliste enthalten ist. +In einem solchen Falle würde Ihnen bei obiger Prozedur der Menubildschirm "ka­ +puttgeschrieben", denn das System fragt (bei eingeschaltetem Kommandodialog) an, +ob eine Datei mit dem Namen eingerichtet werden soll. Für diesen Fall sollten Sie also +unbedingt eine Vorsorge treffen (z.B. indem Sie den Benutzer darauf hinweisen, daß +der eingegebene Name nicht akzeptiert wird)! + +Sie vermuten sicher schon ganz richtig, daß es entsprechend auch die Prozedur +'menuanswersome' gibt, die zunächst einen Dateinamen erfragt und auf Wunsch +eine Auswahl anbietet, in der mehrere Dateinamen angekreuzt werden können. Die +Prozedur hat ebenfalls 6 Parameter, die identisch zur Prozedur 'menuanswerone' +sind. Allerdings liefert die Prozedur 'menuanswersome' in jedem Fall einen Thesau­ +rus; wurde die Auswahl mit abgebrochen, so liefert sie einen leeren +Thesaurus. + + +#ib# 5.6 Die Ja/Nein - Entscheidung#ie# ('#ib#menuyes#ie#','#ib#menuno#ie#') + +In Kapitel 5.5 trat das Problem auf, daß der Benutzer einen "unzulässigen" Namen +eingeben konnte. Dieses Problem können wir umgehen: Wir fragen den Benutzer ein­ +fach, ob er mit der zuletzt bearbeiteten Datei arbeiten will und lassen Ihm nur die +Chance, mit 'Ja' oder 'Nein' zu antworten. Im ersten Fall bieten wir ihm eben diese +Datei an - ansonsten die Auswahl zum Ankreuzen. + +Hierfür stehen die Prozeduren 'menuyes' und 'menuno' zur Verfügung, die von Ihrer +Funktion her den Ihnen bekannten Prozeduren 'yes' und 'no' gleichen. Die beiden +Menu-Prozeduren haben jeweils zwei Parameter: + + +TEXT VAR letzte datei; +... + +PROC alte datei editieren: + TEXT CONST kopf :: "Textdatei ansehen/ändern", + hinweis :: "Bitte gewünschte Datei ankreuzen"; + TEXT VAR dateiname; + IF menuyes (" Wollen Sie mit der Datei "13"" + + " '" +letzte datei+ "'"13" arbeiten", 5) + THEN editiere letzte datei + ELSE dateiname := menuone (ALL myself, kopf, hinweis, FALSE); + editiere ausgewaehlte datei + FI; + regenerate menuscreen. + + editiere letzte datei: + cursor on; edit (letzte datei); cursor off. + + editiere ausgewaehlte datei: + IF dateiname <> "" + THEN cursor on; edit (dateiname); cursor off; + letzte datei := dateiname + FI +END PROC alte datei editieren; + + +Über den zweiten Parameter legen Sie die Position auf dem Bildschirm innerhalb des +Menus fest (1, 2, 3, 4, 5; sehen Sie auch Kapitel 5.12). Der erste Parameter ist ein +Text, welcher der gs-DIALOG-Syntax gehorchen muß (die Codes "13" bewirken +einen Zeilenvorschub; sehen Sie auch Kapitel 5.13). Er wird in einer Box auf den +Bildschirm geschrieben und durch 'Ja  Nein' ergänzt: + + + +-----------------------------+ + I I + I Wollen Sie mit der Datei I + I 'Dateiname' I + I arbeiten? I + I I + I Ja    Nein I + I I + +-----------------------------+ + +Für 'Dateiname' ist auf Ihrem Bildschirm dann natürlich der aktuelle Inhalt von +'letzte datei' eingetragen. +Die Prozedur 'menuyes' liefert TRUE, wenn mit 'Ja' geantwortet wurde und FALSE, +wenn mit 'Nein' geantwortet wurde. Die Prozedur 'menuno' wirkt wie 'NOT menuyes'. +Nach Eingabe von 'Ja', 'Nein' (durch Tippen der Anfangsbuchstaben oder Positionie­ +rung auf die Antwort und anschließendem ) wird der Menubildschirm +automatisch regeneriert. Auch die entsprechenden Hinweise in der Fußzeile werden +natürlich automatisch gesetzt. + + +#ib#5.7 Die Alternativentscheidung#ie# ('#ib#menualternative#ie#') + +Im letzten Kapitel haben wir Ihnen die Prozeduren 'menuyes' und 'menuno' in Ihrer +Wirkungsweise erläutert. Eigentlich sind die beiden Prozeduren nur ein (häufig +benötigter) Spezialfall der Prozedur 'menualternative'. Die Funktionsweise der Proze­ +dur 'menualternative' dürfte Ihnen schon aus dem 'Archivmenu' bekannt sein: Wenn +Sie eine neue Zieltask einstellen, werden Ihnen nämlich vier Alternativen zur Auswahl +angeboten (Archiv, Vatertask, PUBLIC, Sonstige Task). +Auf unsere Textverarbeitung bezogen könnten wir z.B. vor der Zeilenformatierung +(lineform) über die Alternativentscheidung den gewünschten Schrifttyp abfragen. Wir +wollen dem Benutzer in diesem Beispiel fünf Schrifttypen (schmal, elite, pica, letter, +groß) zur Auswahl anbieten: + + + +TEXT VAR schrifttyp; +... + +PROC schrifttyp waehlen: + TEXT CONST info :: " Auswahl der Schrifttypen: "13""13"" + + " s ... schmal (17 Zeichen pro Zoll) "13"" + + " e ... elite (12 Zeichen pro Zoll) "13"" + + " p ... pica (10 Zeichen pro Zoll) "13"" + + " l ... letter (Proportionalschrift) "13"" + + " g ... groß ( 5 Zeichen pro Zoll) ", + + liste :: "schmal"13"elite"13"pica"13"letter"13"groß", + tasten :: "seplgSEPLG"; + + INT VAR auswahl := menualternative (info, liste, tasten, 5, TRUE); + SELECT auswahl OF + CASE 1, 101, 106: schrifttyp := "17" + CASE 2, 102, 107: schrifttyp := "12" + CASE 3, 103, 108: schrifttyp := "10" + CASE 4, 104, 109: schrifttyp := "prop" + CASE 5, 105, 110: schrifttyp := "5" + OTHERWISE (* behalte alten Schrifttyp bei *) + END SELECT +END PROC schrifttyp waehlen; + + +Hätten wir diese Prozedur in unsere Prozedur 'zeilen formatieren' eingebunden, so +zeigte sich bei Aktivierung folgende Einblendung in den Menubildschirm: + + + + +---------------------------------------+ + I I + I Auswahl der Schrifttypen: I + I I + I s ... schmal (17 Zeichen pro Zoll) I + I e ... elite (12 Zeichen pro Zoll) I + I p ... pica (10 Zeichen pro Zoll) I + I l ... letter (Proportionalschrift) I + I g ... groß ( 5 Zeichen pro Zoll) I + I I + I schmal elite pica letter groß I + I I + +---------------------------------------+ + +Die Prozedur 'menualternative' besitzt insgesamt 5 Parameter. Wie Ihnen schon von +von anderen Prozeduren bekannt ist, wird mit dem vorletzten (4.) Parameter die +Position innerhalb des Menubildschirms bestimmt - hier also die Plazierung in die +Mitte des Menubildschirms. +Mit dem 5. Parameter können Sie noch festlegen, ob der Benutzer die Möglichkeit +haben soll, die Alternativauswahl mit abzubrechen (bei TRUE, wie im +Beispiel) oder eben nicht. + +Mit dem 1. Parameter wird der Informationstext festgelegt, der auf dem Bildschirm +innerhalb der Box erscheinen soll. Für die Funktion der Alternativauswahl ist die­ +ser Inhalt völlig belanglos - er dient ausschließlich der Information des Benutzers. +Der Text kann - wie hier - z.B. durch eine Einteilung in Zeilen gestaltet werden +(durch den Code "13"). +Der Text in den Zeilen sollte nicht zu breit sein, da er noch in eine Box innerhalb des +Menubildschirms hineinpassen muß! Damit es auch bei geschachtelten Menus zu +keinen Problemen kommt, sollte eine Zeile nicht breiter als 64 Zeichen sein. Aber +keine Angst: Sie können gs-DIALOG durch zu lange Texte nicht durcheinanderbrin­ +gen - wenn Ihr Text zu breit ist, wird er rigoros abgeschnitten und einfach nicht +angezeigt. + +Mit dem 2. Parameter übergeben Sie die Auswahlliste, die in der letzten Zeile der Box +dargestellt wird. Hier dürfen insgesamt bis zu 10 Alternativen angegeben werden - +bedenken Sie dabei aber unbedingt, daß diese Liste ebenfalls nicht zu lang werden +darf (ebenfalls höchstens 64 Zeichen). +Zwischen jeder von Ihnen notierten Alternative muß zur Kennung der Code "13" +eingetragen werden - wie oben im Beispiel gezeigt. Da nachher in der Box zwischen +den einzelnen Alternativen je drei Leerzeichen eingefügt werden, können Sie sich +immer an der von Ihnen übergebenen Zeichenkette orientieren. Hat Ihre Auswahlliste +nicht mehr als 64 Zeichen, dann ist sie in jedem Falle auf dem Bildschirm darstell­ +bar. +Über diese Auswahlliste erfolgt normalerweise die Auswahl. Mit den Cursortasten links +und rechts kann der Benutzer auf die gewünschte Alternative positionieren (auf dem +Bildschirm invers dargestellt) und dann die -Taste tippen. +Die Prozedur 'menualternative liefert dann einen Zahlenwert, nämlich die Position +der gewählten Alternative in der als 2. Parameter übergebenen Liste (wird in unse­ +rem Beispiel die Alternative 'letter' gewählt, so liefert die Prozedur den Wert 4). +Haben Sie den Abbruch durch zugelassen (5. Parameter), so wird im +Falle eines solchen Abbruchs der Wert '0' geliefert. + +Mit dem 3. Parameter können Sie noch festlegen, über welche Tasten eine Auswahl +erfolgen soll. Wenn Sie hier niltext ("") angeben, ist eine Auswahl über die Tasten +nicht möglich. Im Beispiel haben wir hier die Anfangsbuchstaben der im Text ge­ +nannten Schrifttypen gewählt und als Eingabe sowohl Klein- als auch Großbuchsta­ +ben gestattet. Erfolgt nun die Auswahl über das Tippen einer zugelassenen Taste, +dann wird Ihre Position in der im 3. Parameter übergebenen Zeichenkette ermittelt +und der Wert '100' dazuaddiert. Tippt in unserem Falle der Benutzer die Taste +, wird der Wert '109' geliefert. + +Es erfolgt übrigens kein Hinweis in der Fußzeile, ob eine Auswahl über das Tippen +einer Taste möglich ist! Wenn Sie von der Möglichkeit Gebrauch machen, sollten Sie +dieses durch die Gestaltung Ihres Informationstextes andeuten - wie wir es im Bei­ +spiel auch getan haben. + + +#ib#5.8 Die Menunotiz#ie# ('#ib#write menunotice#ie#', '#ib#erasemenunotice#ie#') + +Innerhalb des Menus können Sie für den Benutzer auch eine Notiz ablegen. Wir +machen z.B. bei der Archivverwaltung Gebrauch davon. Dort wird nämlich ständig +angezeigt, mit welcher Task kommuniziert wird und - sofern es sich um einen Ar­ +chivmanager handelt - wie die (angemeldete) Diskette heißt. Wenn Sie z.B. dem +Benutzer das aktuelle Datum im Menu anzeigen wollen, insertieren Sie die folgende +Prozedur: + + +PROC datum anzeigen: + write menunotice ("Datum: " + date, 4) +END PROC datum anzeigen; + + +Die Prozedur 'write menunotice' besitzt zwei Parameter. Mit dem ersten Parameter +wird der Text übergeben, der in der Box ausgegeben werden soll. Er unterliegt eben­ +falls der gs-DIALOG-Syntax für Texte. Durch den zweiten Parameter wird wieder die +Position innerhalb des Menus festgelegt (hier rechts unten: Position 4). + +Wenn Sie jetzt in Ihrer Menukarte die Prozedur 'oberbegriff  ("Bearbeiten")' in fol­ +gender Weise abändern: + + + oberbegriff ("Bearbeiten", "datum anzeigen", "erase menunotice") + + +dann wird jedesmal, wenn das Pull-Down-Menu unter dem Oberbegriff 'Bearbeiten' +aufgefaltet wird, unten rechts (Position 4) das aktuelle Datum in einer Box ange­ +zeigt. Diese Notiz verschwindet, wenn in ein anderes Pull-Down-Menu gewechselt +wird. + +Auf den ersten Eindruck scheinen die Prozeduren 'write menunotice' und 'menuinfo' +gleich zu sein - das ist aber nicht der Fall: Bei 'menuinfo' wird der Text in einer Box +ausgegeben und so lange gewartet, bis der Benutzer eine Taste getippt hat (oder die +angegebene Zeit verstrichen ist). Bei 'write menunotice' wird ebenfalls ein Text in +einer Box auf den Menubildschirm geschrieben. Diese Box bleibt aber über längere +Zeit bestehen (auf Erscheinen und Verschwinden kann der Benutzer selbst keinen +Einfluß nehmen!) - und zwar solange, bis die Notiz gelöscht wird (mit 'erase menu­ +notice'; in unserem Beispiel, wenn das Pull-Down-Menu gewechselt wird) oder durch +ein neues 'write menunotice' überschrieben wird. In einem Menu kann nämlich zu +einem Zeitpunkt nur eine Menunotiz abgelegt werden. +Wenn der Bildschirm durch gs-DIALOG-Prozeduren überschrieben wird, wird die +Menunotiz ebenfalls ständig mitaufgefrischt, und auch, wenn Sie den Befehl 'regene­ +rate menuscreen' oder 'refresh submenu' geben. + + +#ib#5.9 Fußzeilen im Menu#ie# ('#ib#menufootnote#ie#', '#ib#oldmenufootnote#ie#') + +In den Fußzeilen innerhalb des Menus werden dem Benutzer Bedienhinweise ange­ +zeigt. Die Fußzeile wird aber auch dazu benutzt, den Benutzer über Prozesse zu +informieren, die im Hintergrund ablaufen - erst recht dann, wenn Sie einige Zeit in +Anspruch nehmen. Sie zeigen dem Benutzer an, daß er nicht "unruhig" zu werden +braucht, sondern das System "mit sich" beschäftigt ist. +Im allgemeinen braucht sich der Programmierer um diese Fußnoten nicht zu küm­ +mern, denn sie werden von den einzelnen Komponenten des Systems automatisch +gesetzt. Wir können aber z.B. dem Benutzer einen Hinweis geben, wenn unter dem +Menupunkt 'Verzeichnis' eine Liste erstellt wird. Die Prozedur könnte dann folgen­ +dermaßen notiert werden: + + +PROC verzeichnis ausgeben: + menufootnote ("Bitte warten... Ich erstelle eine Dateiliste"); + FILE VAR f :: sequential file (output, "Dateiliste"); + list (f); modify (f); + old menufootnote; + entferne eigenen namen; + zeige liste an; + forget ("Dateiliste", quiet). + + entferne eigenen namen: + TEXT VAR zeile :: ""; INT VAR i; + FOR i FROM lines (f) DOWNTO 1 REP + to line (f, i); + read record (f, zeile); + UNTIL pos (zeile, "Dateiliste") > 0 PER; + delete record (f). + + zeige liste an: + to line (f, 1); + menuwindowshow (f) (* Sehen Sie Kapitel 5.11.1*) +END PROC verzeichnis ausgeben; + + +Beachten Sie, daß der Text nicht länger als 64 Zeichen ist, damit er auch bei ge­ +schachtelten Menus vollständig ausgegeben werden kann. Sollte der Text dennoch zu +lang sein, wird er vom System auf die entsprechende Länge gestutzt. +Haben Sie mit 'menufootnote' eine eigene Fußzeile gesetzt, so können Sie die da­ +durch gelöschte Zeile durch den Befehl 'old menufootnote' wieder hinschreiben. +Ansonsten wird Ihre Fußzeile von der nächsten automatisch (d.h. vom System) ge­ +setzten Fußnote überschrieben. In dem obigen Beispiel hätten Sie also gut auf den +Befehl 'old menufootnote' verzichten können. + +Durch 'old menufootnote' wird die letzte Fußnote, die automatisch vom System ge­ +setzt wurde, reproduziert. Der in der obigen Prozedur verwendete Befehl 'menuwin­ +dowshow' ist bisher noch nicht erläutert. Sehen Sie dazu bitte das Kapitel 5.11.1. + + +#ib#5.10 Wiederherstellung des Menubildschirms#ie# ('#ib#regenerate + menuscreen#ie#','#ib#refresh submenu#ie#') + +Der Befehl 'regenerate menuscreen' ist Ihnen schon aus diversen Beispielprogram­ +men dieses Handbuches bekannt. Ist der Menubildschirm "kaputtgeschrieben" oder +der Bildschirm für andere Zwecke benutzt worden, so läßt sich durch diesen Befehl +der Menubildschirm in seinem letzten Zustand reproduzieren (auch bei geschachtel­ +ten Menus!). Durch den Befehl wird der Bildschirm gelöscht und komplett neu +aufgebaut. + +Ein vollständiger Bildschirmaufbau ist aber gar nicht immer nötig. Wenn Sie sicher +sind, daß durch Ihre Operationen nur der Bereich zwischen den beiden durchgezo­ +genen Linien, die die Kopf- und Fußzeile abtrennen, betroffen ist, brauchen Sie nur +den Befehl 'refresh submenu' zu geben. Hierdurch wird das aktuelle Pull-Down- +Menu neu aufgebaut und - sofern gesetzt - die Menunotiz. Wenn möglich, ist er dem +Befehl 'regenerate menuscreen vorzuziehen, da hierfür weniger Zeit benötigt wird +und weniger "Unruhe" auf dem Bildschirm entsteht. +Sorgen Sie aber unbedingt dafür, daß der von Ihnen benutzte Bildschirmbereich +zuvor "gereinigt" wird, denn das besorgt 'refresh subnmenu' nicht! + + +#ib#5.11 Arbeiten im Menufenster#ie# + +Neben den vorab aufgezeigten Möglichkeiten können Sie innerhalb des Menus auch +noch ein Fenster öffnen. Innerhalb dieses Fensters stehen Ihnen alle Möglichkei­ +ten zur Verfügung, die Sie auch sonst zum Beschreiben des gesamten Bildschirms +haben - und noch einiges mehr. +Wir machen z.B. intensiv beim Archivhandling Gebrauch davon. So werden Ihnen +Verzeichnisse angezeigt, Sie können verfolgen, wie die einzelnen Dateien vom Archiv +geholt werden oder dorthin geschrieben werden und einiges mehr. In diesem Kapitel +wollen wir Ihnen die Möglichkeiten aufzeigen, die Sie innerhalb des Menufensters +haben. + +Auf die Größe des Menufensters haben Sie keinen Einfluß, sie wird vom System ge­ +setzt ("normales" Menu: 77 Zeichen breit und 20 Zeichen hoch; geschachteltes +Menu: 71 Zeichen breit und 16 Zeichen hoch). Hierdurch ist sichergestellt, daß alle +Operationen auch in geschachtelten Menus ohne Probleme ausführbar sind. Alle +Prozeduren, die sich auf Aktionen im Menufenster beziehen, enthalten die Silbe +'menuwindow'. +Sie können mit den hier beschriebenen Prozeduren ähnlich arbeiten, wie mit den +entsprechenden Prozeduren ohne den Wortbestandteil 'menuwindow' auf dem +ganzen Bildschirm. Allerdings gibt es einige Unterschiede, auf die Sie achten sollten! + + +5.11.1 Datei anzeigen/editieren + ('#ib#menuwindowshow#ie#', '#ib#menuwindowedit#ie#') + +Von der Prozedur 'menuwindowshow (FILE VAR f)' haben wir im letzten Kapitel +schon Gebrauch gemacht, um das Verzeichnis der Dateien in der Task innerhalb des +Menus anzuzeigen. Die Prozedur gibt es in zwei Versionen mit je einem Parameter. +Einmal kann, wie im vorigen Kapitel, ein FILE angegeben werden, andererseits kann +auch der Name der anzuzeigenden Datei als Text übergeben werden ('menuwindow­ +show (TEXT CONST dateiliste)'). Durch den Befehl wird innerhalb des Menus ein +umrandetes Fenster geöffnet, in der das angegebene File/die Datei angezeigt wird. Bei +'menuwindowshow' kann die Datei nur eingesehen, nicht aber schreibend verändert +werden. +Die Prozedur 'menuwindowedit' gibt es ebenfalls in den zwei Ausprägungen. Sie +verhält sich zur vorgenannten identisch - nur kann hier auch die Datei schreibend +verändert werden. + + +5.11.2 Menufenster öffnen/anzeigen ('#ib#show menuwindow#ie#') + +Wenn Sie eigene Operationen in einem Fenster im Menu ausführen lassen wollen, +muß dieses Fenster zunächst auf dem Bildschirm angezeigt werden. Durch den +Befehl 'show menuwindow' wird ein entsprechender Rahmen innerhalb des Menus +ausgegeben und der Bereich innerhalb dieses Rahmens (das Fenster) gelöscht. +Auf die Größe des Fensters innerhalb des aktuellen Menus können Sie - wie bereits +eingangs gesagt - keinen Einfluß nehmen. +Zu einem Zeitpunkt kann immer nur ein Menufenster geöffnet sein, da das Fenster +schon den größtmöglichen sinnvollen Bereich des aktuellen Menus belegt. Ein er­ +neutes 'show menuwindow' hätte die gleiche Wirkung wie das nachfolgend beschrie­ +bene 'menuwindowpage' - nur wird hier zusätzlich noch der Rahmen des Fensters +mitausgegeben. + + +5.11.3 Menufenster löschen (putzen) ('#ib#menuwindowpage#ie#') + +Durch den Befehl 'menuwindowpage' wird das Fenster innerhalb des aktuellen +Menus gelöscht; der Rahmen des Fensters bleibt bestehen, da er nicht mit zum ei­ +gentlichen Fenster gehört. Durch den Befehl wird der Menubildschirm nicht(!) +rekonstruiert! + + +5.11.4 Positionierungen im Menufenster + ('#ib#menuwindowline#ie#', '#ib#menuwindowcursor#ie#') + +Mit 'menuwindowline' wird, wie auch sonst auf dem Bildschirm, an den Anfang der +nächsten Zeile positioniert. Diesen Befehl gibt es, ebenso wie den Befehl 'line' (der +auf dem Gesamtbildschirm operiert) ohne und mit einem Parameter. Durch 'menu­ +windowline (3)' wird an den Anfang der "drittnächsten" Zeile innerhalb des Menu­ +fensters positioniert. + +Aber Achtung! Der Befehl 'menuwindowline' weist einen deutlichen Unterschied zum +Ihnen bekannten Befehl 'line' auf. Wird nämlich die untere Fenstergrenze überschrit­ +ten, so rollt (scrollt) der Bildschirm nicht um die entsprechenden Zeilen nach oben, +wie Sie es von 'line' gewohnt sind - statt dessen wird der Fensterinhalt gelöscht und +wieder oben im Fenster zu schreiben begonnen. Es erscheint, als ob auf ein neues +Fenster positioniert würde. +Innerhalb des Fensters können Sie auch den Cursor positionieren, wie Sie es vom +Bildschirm gewohnt sind - allerdings nur innerhalb der aktuell gültigen Grenzen. In +einem Menu ist das Fenster 77 Zeichen breit und 20 Zeichen hoch; in einem ge­ +schachtelten Menu 71 Zeichen breit und 16 Zeichen hoch. +Wird außerhalb des aktuellen Menufensters positioniert, wird das Fenster gelöscht +und die Fensterposition (1, 1) angenommen. + + +5.11.5 Informationen über die aktuelle Menu-Fenster position ('#ib#get +menuwindowcursor#ie#', '#ib#remaining menuwindowlines#ie#') + +Mit der Prozedur 'get menuwindowcursor (INT VAR spalte, zeile)' kann die aktuelle +Position des Cursors innerhalb des Menufensters erfragt werden. Die Prozedur hat +zwei Parameter, die als 'INT VAR' deklariert sein müssen. Der erste Parameter enthält +anschließend die aktuelle Spalte, der zweite die aktuelle Zeile. + +Mit der werteliefernden Prozedur 'remaining menuwindowlines' kann die Anzahl der +noch verbleibenden Zeilen innerhalb des aktuellen Menufensters erfragt werden. Die +Prozedur wurde deshalb zur Verfügung gestellt, weil der Fensterinhalt - im Gegensatz +zum normalen Bildschirm - nicht gescrollt werden kann. So können Sie sich vorab +informieren, ob der Text, der von Ihnen ausgegeben werden soll, noch Platz findet, so +daß während der Ausgabe nicht plötzlich der Fensterinhalt gelöscht wird. + + +5.11.6 Ausgabe/Eingabe innerhalb des Menufensters + ('#ib#menuwindowout#ie#', '#ib#menuwindowget#ie#', + '#ib#menuwindoweditget#ie#', '#ib#menuwindowyes#ie#', + '#ib#menuwindowno#ie#') + +Innerhalb des Menufensters können mit der Prozedur 'menuwindowout' Texte ausge­ +geben werden - die Prozedur hat einen TEXT-Parameter. Sollen INTEGER- oder REAL- +Werte ausgegeben werden, so müssen diese Werte zuerst in Texte konvertiert werden. +Bitte beachten Sie unbedingt, daß innerhalb des Fensters nicht gescrollt wird und +auch kein Zeilenumbruch stattfindet! Ist ein Text länger als die verbleibende Restzei­ +le, so wird der Text bis zum Fensterende ausgegeben und die Ausgabe am Anfang der +nächsten Zeile fortgesetzt. So ist sichergestellt, daß in keinem Falle die Fenstergren­ +zen überschritten werden. +Sobald die letzte Position des aktuellen Menufensters beschrieben ist (unten rechts in +der Fensterecke), wird der Fensterinhalt komplett gelöscht und die Ausgabe in der +ersten Zeile des "neuen" Fensters fortgesetzt. Auf Zeilenumbruch und Scrolling wurde +verzichtet, da der Realisierungsaufwand dafür zu hoch gewesen wäre. + +Mit der Prozedur 'menuwindowget (TEXT VAR text)' können Sie auch Texte innerhalb +des Menufensters einlesen - INTEGER-/ REAL-Werte müssen ggf. von Hand konvertiert +werde. Die Eingabe wird durch abgeschlossen. Es muß mindestens ein +Zeichen (ungleich Leerzeichen) eingegeben werden. Von der Eingabe werden die +führenden Leerzeichen abgeschnitten. +Ist der einzugebende Text länger als die noch verbleibende Restzeile, so wird der Text +in der Restzeile gescrollt. Sind in der aktuellen Zeile weniger als 7 Zeichen für die +Eingabe vorhanden, so wird automatisch für die Eingabe an den Anfang der nächsten +Zeile positioniert. + +Ab gs-DIALOG-Version 1.1 steht auch die Prozedur 'menuwindoweditget (TEXT VAR +text)' zur Verfügung, durch die ein Text zum Editieren vorgegeben werden kann. Es +ist allerdings darauf zu achten, daß der Text in jedem Falle initialisiert wird! + +Die beiden Prozeduren 'menuwindowyes' und 'menuwindowno' ähneln den Ihnen +bekannten Prozeduren 'yes' und 'no'. Sie operieren nur auf dem Menufenster. Be­ +denken Sie aber bitte, daß, wenn bei der Ausgabe des Textes die Fenstergrenze über­ +schritten wird, der Resttext in der nächsten Zeile ausgegeben wird. Wird dabei sogar +die untere Fenstergrenze überschritten, so wird der komplette Fensterinhalt gelöscht +und die Ausgabe in der linken oberen Ecke des "neuen Fensters" fortgesetzt! + + +5.11.7 Weiter Prozeduren ('#ib#menuwindowcenter#ie#', + '#ib#menuwindowstop#ie#') + +Es werden noch zwei weitere Prozeduren für das Menufenster zur Verfügung gestellt, +die bei der Programmentwicklung ganz nützlich sein können. +Mit 'menuwindowcenter (TEXT CONST text)' werden vor und hinter dem übergebe­ +nen Text so viele Leerzeichen angefügt, daß der Text zentriert in der Menufenster-Zei­ +le ausgegeben wird. Bevor Sie den Text mit 'menuwindowout' ausgeben, müssen Sie +an den Anfang einer Zeile positionieren, denn die Anzahl der vorangestellten Blanks +wird unter Annahme dieser Zeilenposition ermittelt! Innerhalb der Zeile werden ggf. +vorhandene Texte überschrieben. + +Durch die Prozedur 'menuwindowstop' wird an den Anfang der übernächsten Zeile +positionert und der Text 'Zum Weitermachen bitte irgendeine Taste tippen!' ausgege­ +ben. Danach wird so lange gewartet, bis eine Taste getippt wird. Mit 'menuwindow­ +stop (INT CONST zeilenzahl) kann auch noch die Anzahl der Zeilen bestimmt wer­ +den, die vorwärtspositioniert werden soll (Standard: 2 Zeilen). + + +#ib#5.12 Festlegung der Boxpositionen innerhalb des Menus#ie# + +In vielen Fällen kann der Programmierer noch entscheiden, an welcher Position +innerhalb des Menus die Box erscheinen soll (z. B. bei 'menuanswer', 'menuinfo', +'menuyes', 'menuno', 'menunotice' etc.). Die Positionen sind von 1 bis 5 durchnu­ +meriert und haben folgende Bedeutung: + ++----------------------------------------+ +I I ++----------------------------------------+ +I I +I +-----+ +-----+ I +I I 1 I I 2 I I +I +-----+ +-----+ I +I I +I +-----+ I +I I 5 I I +I +-----+ I +I I +I +-----+ +-----+ I +I I 3 I I 4 I I +I +-----+ +-----+ I +I I ++----------------------------------------+ +I I ++----------------------------------------+ +#page# +#ib#5.13 gs-DIALOG-Syntax (Regeln zur Erstellung von Texten)#ie# + +Werden Texte als Parameter übergeben, die in einer Box ausgegeben werden sollen, +so kann dieser Text durch Einfügen von Steuerzeichen noch gestaltet werden, z.B. +kann der Programmierer so den Zeilenaufbau bestimmen. +Das System analysiert den eingegebenen Text. Jedesmal, wenn innerhalb des Textes +der Code "13" erscheint, wird innerhalb der Box auf den nächsten Zeilenanfang +positioniert. So ist eine Einteilung eines Textes in Zeilen leicht möglich. Soll eine +Leerzeile eingefügt werden, so geben Sie einfach zweimal den Code "13" ("13""13"). +Bei der Textanalyse wird die jeweilige Zeilenlänge vermerkt. Die Box wird vom System +gerade so breit gewählt, daß die längste vorkommende "Zeile" im Text gerade noch in +die Box paßt. +Aber Vorsicht! Die jeweilige Box kann innerhalb des Menus nur eine Maximalgröße +annehmen (64 Zeichen breit und 14 Zeilen hoch). Wird von einer "Zeile" diese +Maximalgröße überschritten, so wird die Zeile abgeschnitten und nur bis zur Maxi­ +malbreite der Box ausgegeben. + +Ein Text für eine solche Box könnte z.B. so aussehen: + + +menuinfo (" Informationstexte "13" sind meist"13" zu +lang!") + + +das ergibt folgende Ausgabe in der Box: + + + +-----------------------+ + I I + I Informationstexte I + I sind meist I + I zu lang I + I I + +-----------------------+ + +Es ist auch möglich, in solchen Texten Textpassagen invers darzustellen. Dazu wer­ +den in den Text die Codes zum Ein- ("15") und Ausschalten ("14") der Markierung +eingefügt. Solche markierten Textpassagen dürfen aber nicht über interne Zeilen­ +grenzen (Code "13") hinausgehen. Sie müßten dann am Zeilenende aus- und am +nächsten Zeilenanfang wiedereingeschaltet werden. +Soll in der obigen Box das Wort 'Informationstexte' invers dargestellt werden, so wäre +z.B. folgendes Kommando zu geben: + + +menuinfo (" "15"Informationstexte"14" "13"" + + " sind meist"13" zu lang!") + + +#ib#5.14 Thesaurushandling#ie# + +Neben den allgemein zur Verfügung gestellten Thesaurusoperationen stellt +gs-DIALOG einige weitere bereit. Mit der Prozedur 'THESAURUS PROC #ib#infix namen#ie# +(THESAURUS CONST thes, TEXT CONST infix)' werden aus allen Dateinamen des +angegebenen Thesaurus die herausgefiltert, die den Wortbestandteil 'infix' enthalten - +und zwar gleichgültig, an welcher Position! Die herausgefilterten Dateinamen werden +in einem Thesaurus geliefert. Im Programmsystem 'gs-Herbert und Robbi' mach­ +en wir z.B. Gebrauch davon, wenn wir nur die Landschaften der eigenen Task zur +Auswahl anbieten wollen: + + +THESAURUS VAR thes :: infix namen (ALL myself, "Flaeche:") + + +Daneben gibt es eine ähnliche Prozedur, mit der man die Dateien eines bestimmten +Dateityps herausfiltern kann. Mit + + +THESAURUS VAR thes :: infix namen (ALL myself, 1003) + + +werden alle Dateien mit dem Typ '1003' (normale Textfiles) herausgefiltert. Neben +den beiden gibt es auch noch eine Prozedur, die beide Fälle miteinander koppelt: + + +THESAURUS VAR thes :: infix namen (ALL myself, "gs-MENUKARTE:", 1954) + + +Mit der folgenden Prozedur: + + +THESAURUS VAR thes :: #ib#ohne praefix#ie# (ALL myself, "Flaeche:") + + +wird aus den Dateinamen im angegebenen Thesaurus jeweils der führende Wortbe­ +standteil entfernt. Wir machen z.B. in gs-Herbert und Robbi davon Gebrauch, um +die Landschaften/Arbeitsfelder anbieten zu können, ohne jeweils den Wortbestandteil +'Flaeche:' miterscheinen zu lassen. + +Ganz nützlich ist auch noch die folgende Informationsprozedur '#ib#not empty#ie# +(THESAURUS CONST thes)', mit der man z.B. feststellen kann, ob eine Auswahl ohne +Ankreuzen oder mit abgebrochen wurde: + + + +PROC zeilen formatieren: + TEXT CONST kopf :: "Textdateien zeilenweise formatieren", + hinweis :: "Bitte gewünschte Dateien ankreuzen"; + THESAURUS VAR dateinamen := menusome (ALL myself, kopf, hinweis, + FALSE); + + IF not empty (dateinamen) + THEN cursor on; + formatiere dateien; + cursor off; + FI; + regenerate menuscreen. + + formatiere dateien: + INT VAR zaehler; + FOR zaehler FROM 1 UPTO highest entry (dateinamen) REP + IF name (dateinamen, zaehler) <> "" + THEN lineform (name (dateinamen, zaehler)) + FI + PER +END PROC zeilen formatieren; + + + +#ib#5.15 Aktivieren und Deaktivieren von Menupunkten#ie# + +Daß Verarbeitungsfunktionen aktiviert und deaktiviert werden können, haben Sie +schon in unserem Archiv-Pull-Down-Menu gesehen. Deaktivierte Menupunkte sind +durch ein vorgestelltes '-'-Zeichen gekennzeichnet; diese Menufunktionen werden +übersprungen, wenn Sie versuchen, darauf zu positionieren. + +Zur Aktivierung und Deaktivierung von Menupunkten stehen die Prozeduren '#ib#activate#ie# +(TEXT CONST menupunktname)' und '#ib#deactivate#ie# (TEXT CONST menupunktname)' +zur Verfügung. Zu beachten ist, daß diese Prozeduren nicht ständig aufrufbar sind - +der jeweils angegebene 'menupunktname' muß sich nämlich auf das aktuelle Pull- +Down-Menu beziehen! Als Menupunktname muß jeweils der Name angegeben wer­ +den, der bei der entsprechenden Menufunktion als 2. Parameter übergeben wurde. +Ist der angegebene 'menupunktname' im aktuellen Pull-Down-Menu nicht enthalten, +so wird die Anweisung ignoriert! + +Auch bei den Prozeduren' activate (INT CONST punktnummer)' und 'deactivate (INT +CONST punktnummer)' gilt diese Einschränkung. Die beiden Prozeduren arbeiten +schneller als die eben aufgezeigten, denn es muß im aktuellen Pull-Down-menu +nicht mehr nach der jeweiligen Position gesucht werden. Die Positionen werden von +oben nach unten durchgezählt. Beachten Sie aber unbedingt, daß die Trennlinien +mitgezählt werden müssen! +Die Prozeduren "zeigen nur dann Wirkung", wenn sie von einer Verarbeitungsfunk­ +tion des aktuell entfalteten Pull-Down-Menus aus aufgerufen werden (das geschieht +im Archivmenu z.B. aus den beiden Menufunktionen 'Reservieren' und 'Initialisieren' +heraus) oder wenn Sie beim Einstieg in ein Pull-Down-Menu bzw. beim Ausstieg +daraus aufgerufen werden; d.h. aus einer Prozedur heraus, die bei 'oberbegriff' als +2./3. Parameter in das Menukarten-Generierungsprogramm eingetragen ist. Beim +Archiv-Pull-Down-Menu besorgt das die Prozedur 'menu archiv grundeinstellung' +(sehen Sie dazu auch Kapitel 6.1). + + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.6 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.6 new file mode 100644 index 0000000..a0dd3b5 --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.6 @@ -0,0 +1,235 @@ +#block##pageblock# +#pagenr("%",1)##setcount(1)##count per page# +#headeven# +gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#headodd# +#right#gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +6 - % #right#ERGOS +#end# +#bottomodd# +#center#____________________________________________________________ +ERGOS #right# 6 - % +#end# +#ib#6  Einbinden der Datei- und Archivoperationen#ie# + + +Sie haben bereits erfahren, wie Sie eine Menukarte generieren und ankoppeln kön­ +nen. Im letzten Kapitel haben wir Ihnen die Möglichkeiten aufgezeigt, innerhalb des +Menus einen Dialog mit dem Benutzer zu führen. Sie sind somit in der Lage, Ihre +eigenen Anwendungen unter der Benutzeroberfläche gs-DIALOG zu erstellen. +Wie sich gezeigt hat, treten eine Reihe von Verarbeitungsfunktionen in nahezu jeder +Anwendung auf. Im EUMEL-System benötigt man bei fast allen Anwendungspro­ +grammen auch die Möglichkeiten, Dateien auf dem Archiv zu sichern oder von dort +zu holen; auch Umbenennen, Kopieren, Drucken, Reorganisieren ... von Dateien +zählen sicher zu den häufig benötigten Verarbeitungsfunktionen. Wünschenswert ist +es natürlich, daß in allen Programmen unter einer Benutzeroberfläche die "Stan­ +dard-Verarbeitungsfunktionen" in immer gleicher Weise zur Verfügung stehen! + +Dieser Vorteil liegt sogar nicht nur auf der Seite des Anwenders - auch der Anwen­ +dungsprogrammierer profitiert davon: Dann nämlich, wenn er diese Standard-Verar­ +beitungsfunktionen nicht immer neu schreiben muß, sondern auf vorgefertigte +Prozeduren und natürlich auch auf die zugehörigen Informationstexte zurückgreift. + +Wir haben uns deshalb entschlossen, diese Standard-Verarbeitungsfunktionen zum +Datei- und Archivhandling bereits in das Basissystem gs-DIALOG zu integrieren und +Ihnen mit gs-Menu-Generator Dateien zur Verfügung zu stellen, in denen die +Programme zur Einbindung dieser Prozeduren in Ihre eigenen Programmsysteme +ebenso enthalten sind wie alle dazugehörigen Informationstexte. +In diesem Kapitel soll nun beschrieben werden, wie Sie diese vorgefertigten Module in +Ihre Menukarten/Programme einbinden können und was Sie dabei beachten müs­ +sen. + + +#ib#6.1 Einbinden der Archivoperationen#ie# + +Auf der von uns gelieferten Diskette 'gs-Menu-Generator', befindet sich auch die +Datei 'Generatordatei: Archivmenu'. Darin ist das vollständige Menukarten-Generie­ +rungs-Programm zur Generierung der Menukarte 'gs-MENUKARTE: Archiv' inclusive +aller Informationstexte enthalten. U.a. befindet sich darin eben das folgende Pro­ +gramm: + + +oeffne menukarte ("Archiv"); +oeffne menu ("ARCHIV", "", "menu archiv reservierung aufgeben"); + + +oberbegriff ("Dateien"); + +menufunktion ("v", "Verzeichnis", "menu dateien verzeichnis", + dateiverzeichnistext); +trennlinie; +menufunktion ("l", "Löschen", "menu dateien loeschen", + dateiloeschentext); +menufunktion ("d", "Drucken", "menu dateien drucken", + dateidruckentext); +trennlinie; +menufunktion ("k", "Kopieren", "menu dateien kopieren", + dateikopierentext); +menufunktion ("u", "Umbenennen", "menu dateien umbenen­ + nen", + dateiumbenennentext); +trennlinie; +menufunktion ("s", "Speicherplatz", "menu dateien speicherplatz", + dateispeicherplatztext); +menufunktion ("a", "Aufräumen", "menu dateien aufraeumen", + dateiaufraeumtext); + + +oberbegriff ("Archiv", "menu archiv grundeinstellung (4)", + "menu archiv reservierung aufgeben"); + +menufunktion ("r", "Reservieren", "menu archiv reservieren", + archivreserviertext); +menufunktion ("n", "Neue Diskette", "menu archiv neue diskette", + neuediskettetext); +trennlinie; +menufunktion ("s", "Schreiben", "menu archiv schreiben", + archivschreibtext); +menufunktion ("c", "Checken", "menu archiv checken", + archivchecktext); +menufunktion ("k", "Kombination", "menu archiv schreibcheck", + archivkombinationstext); +menufunktion ("h", "Holen/Lesen", "menu archiv holen", + archivholtext); +menufunktion ("l", "Löschen", "menu archiv loeschen", + archivloeschtext); +trennlinie; +menufunktion ("v", "Verzeichnis", "menu archiv verzeichnis", + archivverzeichnistext); +menufunktion ("d", "Drucken", "menu archiv verzeichnis + drucken", + archivdruckentext); +trennlinie; +menufunktion ("i", "Initialisieren", "menu archivinitialisieren", + archivinitialisiertext); +menufunktion ("z", "Zieltask einstellen", "menu archiv zieltask + einstellen", + archivzieltasktext); +schliesse menu; +schliesse menukarte; + + +Wie schon oben erwähnt, sind auch alle Informationstexte in der Datei enthalten, die +jeweils über den 4. Parameter der Prozeduren 'menufunktion' in die Menukarte +eingebunden werden. Wir haben Sie hier nicht extra abgedruckt; Sie können ja die +entsprechende Datei auf der Diskette einsehen! + +Zu dem Programm möchten wir jedoch noch einige wichtige Anmerkungen machen, +damit Sie die entsprechenden Verarbeitungsfunktionen in Ihre Menukarte einbinden +können. + +Wenden wir uns zunächst den Archivoperationen zu. gs-DIALOG stellt die folgenden +Verarbeitungsfunktionen bereit: + + + PROC #ib#menu archiv reservieren#ie#, + PROC #ib#menu archiv neue diskette#ie#, + PROC #ib#menu archiv schreiben#ie#, + PROC #ib#menu archiv checken#ie#, + PROC #ib#menu archiv schreibcheck#ie#, + PROC #ib#menu archiv holen#ie#, + PROC #ib#menu archiv loeschen#ie#, + PROC #ib#menu archiv verzeichnis#ie#, + PROC #ib#menu archiv verzeichnis drucken#ie#, + PROC #ib#menu archiv initialisieren#ie#, + PROC #ib#menu archiv zieltask einstellen#ie#, + + +Durch diese elf Prozeduren werden die entsprechenden Menufunktionen ausgeführt. + +Außerdem werden noch folgende Prozeduren bereitgestellt: + + + PROC #ib#menu archiv grundeinstellung#ie# (INT CONST ort) + PROC #ib#menu archiv reservierung aufgeben#ie# + + +Diesen beiden Prozeduren sollten Sie bei der Einbindung der Archivfunktionen in +Ihre Menukarten besondere Beachtung schenken. Wie Sie im Programm auf der Seite +zuvor sehen, taucht die Prozedur 'menu archiv reservierung aufgeben' gleich zweimal +auf: einmal als 3.Parameter der Prozedur 'oberbegriff' und einmal als 3.Parameter +der Prozedur 'oeffne menu' - und das aus folgendem Grund: + +Wenn der Benutzer die Archivoperationen verläßt, dann sollte automatisch das Archiv +freigegeben werden, um so - auch bei Multi-User-Betrieb - ein einwandfreies Archiv­ +handling zu gewährleisten. Nun kann der Benutzer das Pull-Down-Menu 'Archiv' aber +eben auf zweierlei Weise verlassen: Einmal durch den Wechsel in ein anderes Pull- +Down-Menu der gleichen Menukarte - oder aber er verläßt insgesamt das Menu. Im +ersten Falle wird das Archiv abgemeldet, weil ja die als 3.Parameter bei 'oberbegriff' +eingetragene Prozedur ausgeführt wird - im zweiten Falle, weil die als 3.Parameter +bei 'oeffne menu' eingetragene Prozedur ausgeführt wird. Diese Eintragungen sollten +Sie auf keinen Fall bei der Einbindung der Archivoperationen vergessen. + +Die Prozedur 'menu archiv grundeinstellung (INT CONST ort)' sollte bei den Archiv­ +operationen immer als 2. Parameter in der Prozedur 'oberbegriff' übergeben wer­ +den. Nur wenn diese Prozedur beim Entfallten des Archiv-Pull-Down-Menus ausge­ +führt wird, ist die einwandfreie Funktion des Archivsystems sichergestellt. Dadurch +geschieht nämlich folgendes: + + 1) Als Zieltask wird das Archiv der eigenen Station eingestellt - unabhängig + davon, mit welcher Einstellung das Menu zuvor verlassen wurde. + + 2) Es wird die Zieltask auf dem Bildschirm angezeigt. + + 3) Die entsprechenden Menupunkte werden aktiviert bzw. deaktiviert. + + 4) Es wird festgelegt, an welcher Stelle innerhalb des Menus die Menunotiz zur + Anzeige der Zieltask (und ggf. des Archivnamens) ausgegeben wird. + +Im Programm oben ist hierfür die Position 4 (rechts unten in der Ecke) gewählt. Wir +haben diese Festlegung deswegen so getroffen, weil das Archiv-Pull-Down-Menu +ziemlich weit links auf dem Bildschirm erscheint (es sind nur zwei Oberbegriffe +eingetragen!). So stören sich Archiv-Pull-Down-Menu und die Menunotiz nicht gegen­ +seitig. In unseren Anwendungssystemen 'gs-Herbert und Robbi' und +'gs-MP-BAP' haben wir dagegen die Position '3' eingetragen, damit die Menunotiz +unten links in der Ecke erscheint, weil das Archiv-Pull-Down-Menu ganz rechts auf +dem Bildschirm entfaltet wird. + +Achtung! Uns ist es sehr, sehr wichtig, daß zumindest die Archivfunktionen in allen +Anwendungen unter gs-DIALOG in gleicher Weise zur Verfügung gestellt werden. Um +das sicherzustellen, sind die Funktionen so in gs-DIALOG integriert, daß das System +nur dann reibungslos funktioniert, wenn Sie sich an die eben aufgezeigten Regeln für +die Einbindung in Ihr Anwendungssystem halten! Für die korrekte Funktionsweise +muß im Archiv-Pull-Down-Menu auch immer exakt die Reihenfolge (der Aufbau) der +Verarbeitungsfunktionen eingehalten werden. Auch die Namen sollten immer gleich +gewählt werden! + +Wir hoffen, daß Sie als Programmierer für diese doch etwas rigorose Maßnahme +Verständnis haben - dafür versichern wir Ihnen, daß wir sehr viel Gedanken und +Arbeit in die Konstruktion des Archivsystems investiert haben! + +Auf eine Einschränkung muß allerdings noch hingewiesen werden:Das Archiv- +Pull-Down-Menu kann aus technischen Gründen nicht das erste, ganz links in einem +Menu stehende sein; es kann frühestens unter dem zweiten Oberbegriff in das Menu +aufgenommen werden! Es ist z.Z. nicht möglich, im ganz links stehenden Pull- +Down-Menu deaktivierte Menupunkte zu behandeln. + + +#ib#6.2 Einbinden der Dateiopertionen#ie# + +gs-DIALOG stellt neben den Archivoperationen standardmäßig auch einige Dateiope­ +rationen bereit. Folgende Prozeduren stehen zur Verfügung: + + + PROC #ib#menu dateien verzeichnis#ie#, + PROC #ib#menu dateien loeschen#ie#, + PROC #ib#menu dateien drucken#ie#, + PROC #ib#menu dateien kopieren#ie#, + PROC #ib#menu dateien umbenennen#ie#, + PROC #ib#menu dateien speicherplatz#ie#, + PROC #ib#menu dateien aufraeumen#ie#. + + +Die Prozeduren bedürfen in Ihrer Wirkung sicher kaum einer Erklärung. Die Wir­ +kungsweise können Sie einfach ausprobieren, indem Sie die entsprechenden Ver­ +arbeitungsfunktionen im Archiv-Menu einfach einmal aktivieren. + + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.7 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.7 new file mode 100644 index 0000000..2e6f0ba --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.7 @@ -0,0 +1,367 @@ +#block##pageblock# +#pagenr("%",1)##setcount(1)##count per page# +#headeven# +gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#headodd# +#right#gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +7 - % #right#ERGOS +#end# +#bottomodd# +#center#____________________________________________________________ +ERGOS #right# 7 - % +#end# +#ib#7  Eigene Fenster und Fensteroperationen #ie# + + +In Kapitel 5.11 haben wir Ihnen gezeigt, wie Sie innerhalb des Menus ein Fenster +(das Menufenster) öffnen können. Innerhalb dieses Bereichs stehen Ihnen die +wesentlichen Ein- und Ausgabeoperationen zur Verfügung, die Sie auch sonst vom +Bildschirm her kennen. Auf die Größe des Menufensters können Sie allerdings keinen +Einfluß nehmen, da die Fenstergröße automatisch vom System (gs-DIALOG) festge­ +legt wird - je nachdem, ob Sie mit einem Menu oder mit geschachtelten Menus +arbeiten. +Auf die Einschränkungen bzw. Abweichungen gegenüber den Möglichkeiten, die Sie +bei Benutzung des ganzen Bildschirms haben, haben wir Sie ausdrücklich hingewie­ +sen: So ist es nicht möglich, den Text innerhalb eines Fensters zu rollen (scrolling); +statt dessen wird bei Überschreiten der unteren Fenstergrenze der Fensterinhalt +gelöscht und die Ausgabe oben im "neuen" Fenster fortgesetzt. +Als wir gs-DIALOG konzipierten und die ersten Anwendungen unter dieser Benutzer­ +schnittstelle entwarfen, fiel uns auf, daß es sehr günstig für die Strukturierung des +Bildschirms innerhalb der Anwendungsprogramme ist, wenn man den Bildschirm in +Bereiche (Fenster) einteilen und den Fenstern entsprechende Funktionen zuweisen +kann (z.B. Eingabe-, Informations-, Kontroll-Fenster etc.). Sinnvoll ist es dann, auch +die entsprechenden Ein-/Ausgaberoutinen zur Verfügung zu haben, die sich auf die +einzelnen Fenster beziehen. + +In diesem Kapitel werden wir Ihnen zeigen, wie Sie eigene Fenster definieren und +darin Ein- und Ausgaben realisieren können. Für die Fenster gelten die gleichen +Einschränkungen wie für das Menufenster - d.h. ein Rollen des Textes (scrolling) ist +nicht möglich. Die Fensterposition und -größe innerhalb des Bildschirms können Sie +aber festlegen. + + +#ib#7.1 Definition von Fenstern ('window')#ie# + +Das Fensterkonzept in gs-DIALOG ist sehr einfach gehalten: Durch die Definition +des Fenters werden nur Bereiche auf dem Bildschirm festgelegt, auf die sich +bestimmte Ein-/Ausgabeprozeduren beziehen. + +Wir wollen Ihnen die Verwendung von Fenstern wieder an einem kleinen Beispiel +verdeutlichen - bleiben wir dazu bei unserer Textverarbeitung: Für die Seitenforma­ +tierung müßte der Benutzer den oberen und linken Rand, die Schreibfeldbreite und +die Schreibfeldlänge festlegen. Dazu wollen wir dem Benutzer die aktuellen Werte +anzeigen und ggf. eine Neueinstellung vornehmen lassen. Ein Programm dazu könnte +so aussehen: + + +WINDOW VAR info :: window ( 2, 2, 32, 9), + frage :: window (36, 2, 40, 3), + daten :: window (36, 7, 40, 4); + +TEXT VAR oberer rand :: " 2.54", + linker rand :: " 2.54", + feldbreite :: "16.00", + feldlaenge :: "24.50"; + + +zeige aktuelle werte an; +frage nach neueinstellung. + +zeige aktuelle werte an: + page; show (info); + out (info, center (info, invers ("Aktuell eingestellte Werte:"))); + cursor (info, 2, 4); + out (info, "Oberer Rand : " + oberer rand + " cm"); + cursor (info, 2, 5); + out (info, "Linker Rand : " + linker rand + " cm"); + cursor (info, 2, 7); + out (info, "Schreibfeldbreite : " + feldbreite + " cm"); + cursor (info, 2, 8); + out (info, "Schreibfeldlänge : " + feldlaenge + " cm"). + +frage nach neueinstellung: + show (frage); + cursor (frage, 1, 1); + out (frage, center (frage, invers ("Papierformat einstellen:"))); + cursor (frage, 2, 3); + IF yes ("Neueinstellung vornehmen") + THEN neue werte erfragen + FI. + +neue werte erfragen: + show (daten); + erfrage oberen rand; + erfrage linken rand; + erfrage feldbreite; + erfrage feldlaenge. + +erfrage oberen rand: + REAL VAR neuer oberer rand; + cursor (daten, 1, 1); + out (daten, center (daten, invers ("Oberen Rand einstellen:"))); + cursor (daten, 2, 3); + out (daten, "Bitte den neuen Wert: "); + get (daten, neuer oberer rand); + oberer rand := text (neuer oberer rand, 5, 2); + cursor (info, 23, 4); + out (info, oberer rand). + +erfrage linken rand: + (* analog zu 'erfrage oberen rand *). + +erfrage feldbreite: + (* analog zu 'erfrage oberen rand *). + +erfrage feldlaenge: + (* analog zu 'erfrage oberen rand *). + + + +Am Anfang des Programms werden drei Fenster definiert. Das "Infofenster" erscheint +links oben auf dem Bildschirm, in ihm werden die aktuell eingestellten Werte ange­ +zeigt. Das "Fragefenster" erscheint neben dem ersten Fenster oben rechts auf dem +Bildschirm. +Beantwortet der Benutzer die dort ausgegebene Frage 'Neueinstellung vornehmen +(j/n)?' mit 'ja', dann erscheint unter dem zweiten Fenster ein drittes +("Datenfenster"). Innerhalb dieses Fensters können nacheinander die neuen Werte +eingelesen werden (nicht alle Prozeduren sind hier ausgeführt!). + +Die Definition eines Fensters erfolgt in folgender Weise: + + #ib#WINDOW#ie# VAR fenstername :: #ib#window#ie# ( x, y, xsize, ysize); + +Der Fenstervariablen wird durch 'window' eine Größe zugeordnet. Mit den ersten +beiden Werten legen Sie die linke obere Ecke des Fensters ('x' bezeichnet die Spalten, +'y' die Zeilen) auf dem Gesamtbildschirm fest. Mit 'xsize' bestimmen Sie die Fenster­ +breite (Spaltenzahl), mit 'ysize' die Höhe des Fensters (Zeilenzahl). Der Fenster­ +cursor hat die Position (1,1). +Die linke obere Ecke des ersten Fensters im Programm hat also die Position ( 2, 2). +Das Fenster ist 32 Spalten breit und 9 Zeilen hoch; es kann unter dem Namen 'info' +angesprochen werden. +Bei der Festlegung der Fenstermaße ist der Rahmen des Fensters nicht berücksich­ +tigt - er gehört nicht zum Fenster dazu! Haben Sie die Absicht, das Fenster mit +Rahmen auszugeben, dann sollten Sie das bei der Fensterdefinition berücksichtigen. +Wir haben es im Beispielprogramm auch gemacht: Die linke obere Ecke hat gerade +die Position (2,2) erhalten, damit noch der Rahmen Platz hat. Mit Rahmen ist unser +Fenster also 34 Spalten breit und 11 Zeilen hoch. Die linke obere Ecke des zweiten +Fensters ('frage') legen wir deshalb in die 36. Spalte und 2. Zeile, damit auch hier +Platz für den Rahmen bleibt. +Eine wichtige Einschränkung sollten Sie unbedingt berücksichtigen: Da manche +Terminals mit Beschreiben der Position (80,24) automatisch den Bildschirm +löschen, haben wir die maximale Ausdehnung eines umrandeten Fensters auf (2, 2, +77, 22) festgelegt. Überschreiten Sie irgendwo diese Grenzen, dann wird kein Rah­ +men mehr erzeugt. Der Rahmen wird auch dann nicht erzeugt, wenn er in der 0. +Zeile, 0.Spalte, 25 Zeile oder 80 Spalte zu liegen käme - erst recht natürlich nicht, +wenn diese Werte noch unter- bzw. überschritten werden. + + +#ib#7.2 Anzeigen/Löschen von Fenstern#ie# + ('#ib#show#ie#', '#ib#page#ie#', '#ib#erase#ie#', '#ib#out frame#ie#') + +Mit dem Befehl 'show (WINDOW VAR w)' wird das Fenster 'w' angezeigt. Der Fenster­ +variablen müssen natürlich zuvor die Maße des Fensters zugewiesen sein. Durch den +Befehl wird um den angegebenen Fensterbereich ein Rahmen gezogen und der +"Innenbereich" des Fensters gelöscht. Möchten Sie das Fenster ohne Rahmen ange­ +zeigt haben, so verwenden Sie nur den Befehl 'page (WINDOW VAR w)'. Durch die­ +sen Befehl wird nur der "Innenbereich" des Fensters gelöscht. +Haben Sie das Fenster einmal mit 'show' ausgegeben und wollen den Fensterinhalt +löschen, so verwenden Sie auch hier den Befehl 'page (WINDOW VAR w)', denn der +Rahmen braucht ja nicht erneut ausgegeben zu werden. +Möchten Sie ein Fenster und den zugehörigen Rahmen löschen, dann steht Ihnen der +Befehl 'erase (WINDOW VAR w) zur Verfügung: Durch den Befehl wird sowohl der +"Innenbereich" des Fensters als auch der Rahmen gelöscht. +Sie können natürlich auch selbst einen Rahmen um ein Fenster setzen. Dafür steht +der Befehl 'out frame (WINDOW VAR w)' zur Verfügung. Der Rahmen wird ebenfalls +um den durch 'w' bestimmten Fensterbereich gezogen - der "Innenbereich" bleibt +unberührt! + +Sollten Sie ein Fenster mit dem Befehl 'show' ausgeben (oder mit 'out frame' einen +Rahmen erzeugen) wollen, aber kein Rahmen auf dem Bildschirm erscheint, so +haben Sie die zulässigen Fenstergrenzen überschritten. Sehen Sie dazu auch Kapitel +7.1. + + +#ib#7.3 Operationen innerhalb des Fensters#ie# + +Innerhalb des selbstdefinierten Fensters stehen Ihnen die gleichen Operationen zur +Verfügung wie innerhalb des Menufensters. Bezieht sich eine Operation auf ein +Fenster, so wird der interne Fensterbezeichner als erster Parameter übergeben. + + +#ib#7.3.1 Datei anzeigen/editieren #ie#('#ib#edit#ie#', '#ib#show#ie#') + +Zum Anzeigen einer Datei steht die Prozedur 'show' zur Verfügung. Dabei kann +einmal ein FILE angegeben werden ('show (WINDOW VAR w, FILE VAR f)') oder aber +der Name der anzuzeigenden Datei ('show (WINDOW VAR w, TEXT VAR dateiname)'). +Die Datei kann nur eingesehen, nicht aber schreibend verändert werden. +Die Prozedur 'edit' gibt es ebenfalls in den zwei Ausprägungen. Hier kann die Datei +im Gegensatz zu 'show' auch schreibend verändert werden. +Durch diesen Befehl wird jeweils innerhalb des angegebenen Fensters die Datei +ausgegeben. Sofern die Lage des Fensters es zuläßt, wird automatisch ein Rahmen +um das Dateifenster gezogen. + + +#ib#7.3.2 Positionierungen im Fenster#ie# + ('#ib#cursor#ie#', '#ib#get cursor#ie#', '#ib#line#ie#', '#ib#remaining lines#ie#') + +Mit 'cursor (WINDOW VAR w, INT CONST spalte, zeile)' können Sie den Cursor inner­ +halb des angegebenen Fensters positionieren. Werden dabei die Fenstergrenzen über- +oder unterschritten, so wird der Fensterinhalt gelöscht und auf die Position (1, 1) +innerhalb des Fensters positioniert. +Mit der Prozedur 'get cursor (WINDOW VAR w, INT VAR spalte, zeile)' können Sie die +aktuelle Cursorposition innerhalb des angegebenen Fensters erfragen. +Wollen Sie an den Anfang der nächsten Zeile positionieren, dann verwenden Sie den +Befehl 'line (WINDOW VAR w)' - wollen Sie gleich mehrere Zeilen vorwärtspositionie­ +ren, dann benutzen Sie den Befehl 'line (WINDOW VAR w, INT VAR anzahl zeilen)'. +Wird allerdings bei einem der beiden letzten Befehle die untere Fenstergrenze über­ +schritten, so wird der Fensterinhalt gelöscht und die Operation in der ersten Zeile des +neuen Fensters fortgesetzt. +Die Informations-Prozedur 'remaining lines (WINDOW VAR w)' liefert Ihnen die +Anzahl der unterhalb der aktuellen Zeile noch im Fenster vorhanden Zeilen. + + +#ib#7.3.3 Ein- und Ausgaben innerhalb des Fensters#ie# + ('#ib#out#ie#', '#ib#put#ie#', '#ib#putline#ie#', '#ib#get#ie#', '#ib#getline#ie#', '#ib#yes#ie#', '#ib#no#ie#') + +Mit der Prozedur 'out (WINDOW VAR w, TEXT CONST text)' können Sie einen Text +innerhalb des angegebenen Fensters ausgeben. Paßt der Text nicht mehr in die +aktuelle Zeile, so wird er in der nächsten Zeile fortgesetzt. +Bedenken Sie, daß innerhalb der Fenster kein Wortumbruch realisiert ist. Ebenso­ +wenig ist das Rollen (scrolling) des Fensterinhalts möglich: Erfolgt die Ausgabe eines +Textes über die untere Fenstergrenze hinaus, so wird der Fensterinhalt gelöscht und +die Ausgabe an der Position (1, 1) des Fensters fortgesetzt. +Zur Ausgabe von Texten stehen noch die beiden Prozeduren 'put (WINDOW VAR w, +TEXT CONST text)' und 'putline (WINDOW VAR w, TEXT CONST text)' zur Verfügung. +Bei erstgenannter Prozedur wird gegenüber 'out' an die Ausgabe noch ein Leerzei­ +chen angehängt, bei der zweiten wird zusätzlich an den Anfang der nächsten Zeile +positioniert. +Zahlenwerte können mit den Prozeduren 'put (WINDOW VAR w, INT CONST intwert)' +und 'put (WINDOW VAR w, REAL CONST realwert)' ausgegeben werden. An die +Zahlenwerte wird jeweils ein Leerzeichen angehängt. + +Für das Einlesen von Werten steht die Prozedur 'get' in mehreren Varianten zur +Verfügung. Mit 'get (WINDOW VAR w, TEXT VAR text)' kann ein Text an der aktuellen +Position des Fensters eingelesen werden. Stehen in der aktuellen Zeile des Fensters +weniger als 5 Zeichenpositionen für die Eingabe zur Verfügung, so wird automatisch +auf den Anfang der nächsten Zeile innerhalb des Fensters positioniert. +Über einen dritten Parameter können noch zusätzliche Festlegungen getroffen wer­ +den: Soll die Eingabe noch durch weitere Zeichen (außer Positionierungszeichen) +abgeschlossen werden können, so werden die Zeichen als TEXT übergeben( 'get +(WINDOW VAR w, TEXT VAR text, TEXT CONST separator)'), soll die Maximallänge des +einzugebenden Textes festgelegt sein, so wird diese als INT übergeben ('get (WINDOW +VAR w, TEXT VAR text, INT CONST laenge)'). + +Mit den Prozeduren 'get (WINDOW VAR w, INT VAR intwert)' und 'get (WINDOW VAR +w, INT VAR realwert)' können auch Zahlenwerte innerhalb des Fensters eingelesen +werden. + +Damit dem Anwender auch Vorschläge für der Eingabe gemacht werden können, +steht die Prozedur 'editget' in zwei Variationen zur Verfügung. Bei 'editget' (WINDOW +VAR w, TEXT VAR ausgabe) wird 'ausgabe zum Editieren ausgegeben. Daneben +existiert noch ein 'editget' mit 7 Parametern, der detailliert bei der Zusammenstel­ +lung der Befehle erläutert ist. + +Ebenso wie auf dem Gesamtbildschirm und innerhalb des Menufensters stehen auch +hier die beiden Prozeduren 'yes (WINDOW VAR w, TEXT CONST frage)' und 'no +(WINDOW VAR w, TEXT CONST frage)' zur Verfügung. + + +#ib#7.3.4 Weitere Prozeduren #ie#('#ib#center#ie#', '#ib#stop#ie#') + +Mit 'center (WINDOW VAR w, TEXT CONST text)' werden vor dem angegebenen Text +so viele Leerzeichen angehängt, daß der Text zentriert in der aktuellen Fensterzeile +ausgegeben wird - wenn der Cursur bei der Ausgabe auf der ersten Position der Zeile +steht. Dabei werden aber bereits vorhandene Zeileninhalte überschrieben. + +Durch die Prozedur 'stop (WINDOW VAR w)' wird innerhalb des angegebenen Fen­ +sters an den Anfang der übernächsten Zeile positioniert und der Text " Zum Weiter­ +machen bitte irgendeine Taste tippen!" ausgegeben. Möchten Sie nicht an den Anfang +der übernächsten Zeile positionieren, so können Sie die Anzahl der Zeilen auch +explizit festlegen durch 'stop (WINDOW VAR w, INT CONST zeilenzahl). + + +#ib#7.4 Boxoperationen#ie# + +Innerhalb des Menufensters (sehen Sie Kapitel 5) stehen Ihnen die Prozeduren +'menuanswer', 'menuinfo', 'menuone', 'menusome', 'menuanswerone', +'menuanswersome', 'menuyes', 'menuno', 'menualternative', 'write menunotice' und +'menufootnote' zur Verfügung. Alle diese Prozeduren bezogen sich auf das von +gs-DIALOG automatisch gesetzte Menufenster. +Auch innerhalb der von Ihnen selbst definierten Fenster können Sie auf ähnliche +Prozeduren zurückgreifen. Da wir die eben genannten Prozeduren in Kapitel 5 sehr +detailliert beschrieben haben, werden wir hier nur auf die entsprechenden +Beschreibungen verweisen und ggf. die Besonderheiten/Abweichnungen erwähnen. +Zu beachten ist, daß innerhalb des Fensters weder die oberen noch die unteren zwei +Zeilen von der "Box" beschrieben werden. Die oberen bleiben ständig frei - die unter­ +en werden zur Ausgabe der zugehörigen Benutzerinformation (Fußnote) benutzt - +das sollten Sie bei der Festlegung der Fenstergröße bzw. bei der Länge der zu über­ +gebenden Texte berücksichtigen. Bei der Übergabe der Texte müssen Sie sich an die +gs-DIALOG Syntax-Regeln halten, die in Kapitel 5.12 beschrieben sind. + +Die Prozedur '#ib#boxanswer#ie# (WINDOW VAR w, TEXT CONST ausgabetext, antwortvorgabe, +INT CONST position)' arbeitet wie die Prozedur 'menuanswer (TEXT CONST ausgabe­ +text, antwortvorgabe, INT CONST position)' nur innerhalb des Fensters 'w' (sehen Sie +auch Kapitel 5.1). + +Die Prozedur '#ib#boxinfo#ie#' gibt es in zwei Ausführungen: 'boxinfo (WINDOW VAR w, TEXT +CONST text)' arbeitet wie 'menuinfo (TEXT CONST text)', allerdings auf dem angege­ +benen Fenster. Bei 'boxinfo (WINDOW VAR w, TEXT CONST text, INT CONST position, +timelimit)' kann über den dritten Parameter noch die relative Position im angegebe­ +nen Fenster (sehen Sie dazu Kapitel 5.12) und über den vierten Parameter die Zeit­ +spanne festgelegt werden, für die die Information erscheint (sehen Sie auch Kap. +5.2). + +Die Prozedur '#ib#boxone#ie# (WINDOW VAR w, THESAURUS CONST thesaurus, TEXT CONST +text1, text2, BOOL CONST mit reinigung)' arbeitet wie die Prozedur 'menuone +(THESAURUS CONST thesaurus, TEXT CONST text1, text2, BOOL CONST mit reini­ +gung)'. Zu bedenken ist hier, daß die Auswahl innerhalb des Fensters Platz finden +muß. Der Aufruf dieser Prozedur ist daher nur möglich, wenn das angegebene Fen­ +ster mindestens 60 Spalten breit und 17 Zeilen hoch ist. Ansonsten kommt es zu +einer Fehlermeldung (sehen Sie auch Kap. 5.3). + +Die Prozedur '#ib#boxsome#ie# (WINDOW VAR w, THESAURUS CONST thesaurus, TEXT +CONST text1, text2, BOOL CONST mit reinigung)' arbeitet wie die Prozedur +'menusome (THESAURUS CONST thesaurus, TEXT CONST text1, text2, BOOL CONST +mit reinigung)'. Hinsichtlich der Fenstergröße gelten die gleichen Einschränkungen +wie bei 'boxone' (sehen Sie auch Kap. 5.4). + +Die Prozeduren '#ib#boxanswerone#ie#' und '#ib#boxanswersome#ie#' entsprechen den Prozeduren +'menuanswerone' und 'menuanswersome'; es wird nur zusätzlich jeweils als erster +Parameter das aktuelle Fenster übergeben. Hinsichtlich der Fenstergröße gelten die +gleichen Einschränkungen wie bei 'boxone' (sehen Sie auch Kap. 5.5). + +Die Prozeduren '#ib#boxyes#ie#', '#ib#boxno#ie#' und '#ib#boxalternative#ie#' entsprechen den Prozeduren +'menuyes', 'menuno' und 'menualternative'; es wird nur zusätzlich jeweils als erster +Parameter das aktuelle Fenster übergeben (sehen Sie auch Kap. 5.6 und 5.7). + +Die Prozedur '#ib#boxnotice#ie#' unterscheidet sich von der Prozedur 'write menunotice' +erheblich: Letztgenannte Prozedur hat zwei Parameter. Durch den ersten wird der +Ausgabetext übergeben, mit dem zweiten wird die relative Position innerhalb des +Menubildschirms festgelegt. Sowohl Text als auch Position werden vom System ge­ +speichert. Bei jedem Neuaufbau eines Pull-Down-Menus oder des Menubildschirms +wird die Notiz neu mitaufgebaut. +Die Prozedur 'boxnotice (WINDOW VAR w, TEXT CONST text, INT CONST position, INT +VAR x, y, xsize, ysize) dagegen hat sieben Parameter. Über den ersten wird das aktuel­ +le Fenster festgelegt. Die beiden nächsten Parameter entsprechen den beiden Para­ +metern von 'write menunotice'. Über die letzten vier Parameter werden die Posi­ +tion/Maße der Box geliefert, die ja erst durch das Aussehen der übergebenen Texte +festgelegt werden. Weder Text noch Position der Boxnotiz werden vermerkt. Wollen Sie +die Notiz löschen, so verwenden Sie eine der Prozeduren '#ib#page#ie# (INT CONST x, y, xsize, +ysize)' oder '#ib#page up#ie# (INT CONST x, y, xsize, ysize)'. Im ersten Falle erscheint es dem +Betrachter, als ob die Box von oben nach unten "aufgerollt" würde, im zweiten Falle +von unten nach oben. + +Mit den Prozeduren '#ib#out footnote#ie# (WINDOW VAR w, TEXT CONST text)' wird in der +untersten Zeile des Fensters 'w' der angegebene Text ausgegeben. In der vorletzten +Zeile des Fensters wird eine Trennlinie ausgegeben. Die Fußnote incl. der Trennline +kann durch den Befehl '#ib#erase footnote#ie#' gelöscht werden. + + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.8 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.8 new file mode 100644 index 0000000..66eb6cf --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.8 @@ -0,0 +1,1676 @@ +#block##pageblock# +#pagenr("%",1)##setcount(1)##count per page# +#headeven# +gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#headodd# +#right#gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +8 - % #right#ERGOS +#end# +#bottomodd# +#center#____________________________________________________________ +ERGOS #right# 8 - % +#end# +#ib#8  Kurzbeschreibung der Befehle #ie# + + +Durch #u#(*)#e# gekennzeichnete Prozeduren stehen (zumindest in der hier dokumentier­ +ten Form) erst ab gs-DIALOG Version 1.1 zur Verfügung! + + +#ib#activate#ie# +PROC activate (TEXT CONST punktname): + +Zweck: Mit der Prozedur kann ein (deaktivierter) Menupunkt im aktuellen + Pull-Down-Menu aktiviert, d.h. zur Ausführung freigegeben werden. Das + '-'-Zeichen vor der Punktbezeichnung verschwindet auf dem Bildschirm, + statt dessen erscheint das Zeichen, über den die Menufunktion direkt + aktivierbar ist. 'punktname' muß eine Punktbezeichnung sein, die genau + in der angegebenen Schreibweise im aktuellen Pull-Down-Menu vorhan­ + den ist (über den 2. Parameter der Prozedur 'menufunktion' in die + Menukarte eingetragen wurde) - ansonsten wird diese Anweisung igno­ + riert. Die Prozedur "zeigt nur dann Wirkung", wenn sie aus einer Verar­ + beitungsfunktion des aktuell entfalteten Pull-Down-Menus heraus oder + durch die "Startprozedur"/"Leaveprozedur" des aktuellen Pull-Down- + Menus (sehen Sie auch 'oberbegriff') aufgerufen wird. + Die Veränderung wird nicht sofort auf dem Bildschirm angezeigt, sondern + erst, wenn das Pull-Down-Menu das nächste Mal vom System regeneriert + wird; ansonsten muß das Kommando 'refresh submenu' gegeben werden. + + +PROC activate (INT CONST punktposition):#u#(*)#e# +Zweck: arbeitet wie obiges 'activate', allerdings werden die Menupunkte nicht + über ihre Bezeichnung, sondern über ihre Position im (aktuellen) Pull- + Down-Menu identifiziert. Die Positionen sind von oben nach unten durch­ + numeriert. Beachten Sie, daß Trennlinien eine Position belegen und + mitgezählt werden. Die Prozedur arbeitet schneller als obige! + + +#ib#anwendungstext#ie# +TEXT PROC anwendungstext (INT CONST zeilennummer): + +Zweck: Mit diesem Befehl können Texte angesprochen (geholt) werden, die in die + Menukarte ausgelagert wurden. Es wird der Text aus der angekoppelten + Menukarte geliefert, der bei der "Einlagerung" in der Zeile 'zeilen­ + nummer' stand. +Fehler: Kein Text vorhanden! (In der angekoppelten Menukarte ist unter der + 'zeilennummer' kein Anwendungstext eingetragen.) + Bitte achten Sie auf folgendes: Wenn Sie eine neue Menukarte generiert + haben, muß diese erst an die aktuelle Task gekoppelt werden, bevor Sie + auf die dort eingetragenen (Anwendungs-)Texte zugreifen können (z.B. + mit 'testinstallation'). + + +#ib#areax#ie# +INT PROC areax (WINDOW VAR w) +Zweck: Liefert den Wert 'x' des Fensters w. + + +#ib#areaxsize#ie# +INT PROC areaxsize (WINDOW VAR w) +Zweck: Liefert den den Wert 'xsize' des Fensters w. + + +#ib#areay#ie# +INT PROC areay (WINDOW VAR w) +Zweck: Liefert den den Wert 'y' des Fensters w. + + +#ib#areaysize#ie# +INT PROC areaysize (WINDOW VAR w) +Zweck: Liefert den den Wert 'ysize' des Fensters w. + + +#ib#balken links#ie# +TEXT PROC balken links: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" als "linker + Balken" (̄) ausgegeben wird. + + +PROC balken links (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" als "linker Balken" ausgegeben werden soll. + + +#ib#balken oben#ie# +TEXT PROC balken oben: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" als "oberer + Balken" (�) ausgegeben wird. + + +PROC balken oben (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" als "oberer Balken" ausgegeben werden soll. + + +#ib#balken rechts#ie# +TEXT PROC balken rechts: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" als "rechter + Balken" (̃) ausgegeben wird. + + +PROC balken rechts (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" als "rechter Balken" ausgegeben werden soll. + + +#ib#balken unten#ie# +TEXT PROC balken unten: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" als "unterer + Balken" (̂) ausgegeben wird. + + +PROC balken unten (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" als "unterer Balken" ausgegeben werden soll. + + +#ib#boxalternative#ie# +INT PROC boxalternative (WINDOW VAR w, + TEXT CONST infotext, + auswahlliste, + zusatztasten, + INT CONST position, + BOOL CONST mit abbruch): + +Zweck: Vergl. 'menualternative'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menualternative' automatisch gesetzt wird. Der 'infotext' muß + den gs-DIALOG-Syntax-Regel gehorchen! Die 'auswahlliste' muß nach + festen Regeln erstellt werden (sehen Sie Kap. 5.7) + + +#ib#boxanswer#ie# +TEXT PROC boxanswer (WINDOW VAR w, + TEXT CONST infotext, + vorgabe, + INT CONST  position): + +Zweck: Vergl. 'menuanswer'. Hier wird nur zusätzlich das Fenster festgelegt, das + bei 'menuanswer' automatisch gesetzt wird. Der 'infotext' muß den + gs-DIALOG-Syntax-Regel gehorchen! + + +#ib#boxanswerone#ie# +TEXT PROC boxanswerone (WINDOW VAR w, + TEXT CONST infotext, + vorgabe, + THESAURUS CONST thes, + TEXT CONST ueberschrift, + hinweis, + BOOL CONST mit reinigung): + +Zweck: Vergl. 'menuanswerone'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuanswerone' automatisch gesetzt wird. +Fehler: Fenster für Auswahl zu klein (x < 56, y < 15) + + +#ib#boxanswersome#ie# +THESAURUS PROC boxanswersome (WINDOW VAR w, + TEXT CONST infotext, + vorgabe, + THESAURUS CONST thes, + TEXT CONST ueberschrift, + hinweis, + BOOL CONST mit reinigung): + +Zweck: Vergl. 'menuanswersome'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuanswersome' automatisch gesetzt wird. +Fehler: Fenster für Auswahl zu klein (x < 56, y < 15) + + +#ib#boxinfo#ie# +PROC boxinfo (WINDOW VAR w, TEXT CONST infotext, + INT CONST position, timelimit): + +Zweck: Vergl. 'menuinfo'. Hier wird nur zusätzlich das Fenster festgelegt, das bei + 'menuinfo' automatisch gesetzt wird. Der 'infotext' muß den gs-DIALOG- + Syntax-Regel gehorchen! + + +PROC boxinfo (WINDOW VAR w, TEXT CONST infotext): + + wirkt wie: boxinfo (w, infotext, 5, maxint) + + +#ib#boxno#ie# +BOOL PROC boxno (WINDOW VAR w, + TEXT CONST frage, + INT CONST  position): + + wirkt wie: NOT boxyes (w, frage, position) + + +#ib#boxnotice#ie# +PROC boxnotice (WINDOW VAR w, + TEXT CONST infotext, + INT CONST  position + INT VAR x, y, xsize, ysize): + +Zweck: Mit 'w' wird das aktuelle Fenster festgelegt. In 'infotext' wird der Text + übergeben, der als Notiz ausgegeben werden soll, der Text muß den + gs-DIALOG-Syntax-Regeln entsprechen. Mit 'position' wird die relative + Lage innerhalb des Fensters 'w' bestimmt. Über die letzten vier Parameter + werden die Position/Maße der Box geliefert. Weder Text noch Position + werden vermerkt. + + +#ib#boxone#ie# +TEXT PROC boxone (WINDOW VAR w, + THESAURUS CONST thes, + TEXT CONST ueberschrift, + hinweis, + BOOL CONST mit reinigung): + +Zweck: Vergl. 'menuone'. Hier wird nur zusätzlich das Fenster festgelegt, das bei + 'menuone' automatisch gesetzt wird. +Fehler: Fenster für Auswahl zu klein (x < 56, y < 15) + + +#ib#boxsome#ie# +THESAURUS PROC boxsome (WINDOW VAR w, + THESAURUS CONST thes, + TEXT CONST ueberschrift, + hinweis, + BOOL CONST mit reinigung): + +Zweck: Vergl. 'menusome'. Hier wird nur zusätzlich das Fenster festgelegt, das + bei 'menusome' automatisch gesetzt wird. +Fehler: Fenster für Auswahl zu klein (x < 56, y < 15) + + +#ib#boxyes#ie# +BOOL PROC boxyes (WINDOW VAR w, + TEXT CONST frage, + INT CONST  position): + +Zweck: Vergl. 'menuyes'. Hier wird nur zusätzlich das Fenster festgelegt, das bei + 'menuyes' automatisch gesetzt wird. Die 'frage' muß den gs-DIALOG- + Syntax-Regel gehorchen! + + +#ib#center#ie# +TEXT PROC center (WINDOW VAR w, TEXT CONST text): + +Zweck: Vergl. 'menuwindowcenter'. Hier wird nur zusätzlich das Fenster festge­ + legt, das bei 'menuwindowcenter' automatisch gesetzt wird. + + +TEXT PROC center (INT CONST laenge, + TEXT CONST text): + +Zweck: "Ummantelt" 'text' mit Leerzeichen, so daß 'text' etwa in der Mitte zu + stehen kommt. Der gelieferte Text hat die Länge 'laenge'. + + +TEXT PROC center (TEXT CONST text): + + wirkt wie: center (79, text) + + +#ib#clear buffer#ie# +PROC clear buffer + +Zweck: Leert den Zeichenpuffer + + +#ib#clear buffer and count#ie# +INT PROC clear buffer and count (TEXT CONST + zeichen): + +Zweck: Leert den Zeichenpuffer und liefert die Häufigkeit des Vorkommens von + 'zeichen' im Zeichenpuffer. + + +#ib#current menuwindow#ie# +WINDOW PROC current menuwindow: + +Zweck: liefert das aktuelle Menufenster (die Einzelwerte können dann mit + 'areax', 'areay', 'areaxsize' und 'areaysize' erfragt werden). + + +#ib#cursor#ie# +PROC cursor (WINDOW VAR w, INT CONST spalte, + zeile): + +Zweck: Vergl. 'menuwindowcursor'. Hier wird nur zusätzlich das Fenster festge­ + legt, das bei 'menuwindowcursor' automatisch gesetzt wird. + + +#ib#cursor off#ie# +PROC cursor off: + +Zweck: Sofern die EUMEL-Installation die Möglichkeit bietet, wird der Cursor aus + dem Bildschirm ausgeblendet. + Wenn neue Verarbeitungsfunktionen entwickelt werden, sollte zu Beginn + der Cursor eingeschaltet und nach Abschluß der Cursor wieder ausge­ + schaltet werden (sehen Sie auch Kap. 5.1). + + +PROC cursor off (TEXT CONST zeichenkette): + +Zweck: Neufestlegung der 'zeichenkette', die ausgegeben werden soll, um bei der + aktuellen EUMEL-Installation den Cursor auf den Befehl 'cursor off' hin + auszuschalten. + + +#ib#cursor on#ie# +PROC cursor on: + +Zweck: Sofern die EUMEL-Installation die Möglichkeit bietet, wird der Cursor auf + dem Bildschirm angezeigt. Wenn neue Verarbeitungsfunktionen entwik­ + kelt werden, sollte zu Beginn der Cursor eingeschaltet und nach Abschluß + der Cursor wieder ausgeschaltet werden (sehen Sie auch Kap. 5.1). + + +PROC cursor on (TEXT CONST zeichenkette): + +Zweck: Neufestlegung der 'zeichenkette', die ausgegeben werden soll, um bei der + aktuellen EUMEL-Installation den Cursor auf den Befehl 'cursor on' hin + anzuschalten. + + +#ib#deactivate#ie# +PROC deactivate (TEXT CONST punktname): + +Zweck: Vergl. 'activate (TEXT CONST punktname)'. + Im Gegensatz zu der Prozedur wird hier 'punktname' deaktiviert und + beim (nächsten) Erscheinen der Menupunktbezeichnung ein '-'Zeichen + vorangestellt. Es gelten die gleichen Einschränkungen wie bei 'activate'! + + +PROC deactivate (INT CONST punktposition):#u#(*)#e# +Zweck: arbeitet wie obiges 'deactivate', allerdings werden die Menupunkte nicht + über ihre Bezeichnung, sondern über ihre Position im (aktuellen) Pull- + Down-Menu identifiziert. Die Positionen sind von oben nach unten durch­ + numeriert. Beachten Sie, daß Trennlinien eine Position belegen und + mitgezählt werden. Die Prozedur arbeitet schneller als obige! + + +#ib#direktstart#ie# +PROC direktstart (TEXT CONST prozedurname, + BOOL CONST mit loeschen):#u#(*)#e# +Zweck: Macht aus der aktuellen Task eine Manager-Task ('global manager'). + Werden neue Sohntasks eingerichtet, so melden sich diese nicht - wie + gewohnt - mit der 'gib kommando:'-Ebene. Statt dessen wird die Prozedur + 'prozedurname' ausgeführt. Das Kommando ist dann sinnvoll, wenn sich + die Sohntask gleich mit einem Menu melden soll. In der Prozedur + 'prozedurname' muß dann die entsprechende Menukarte angekoppelt + und das gewünschte Menu zur Ausführung gebracht werden. Hat 'mit + loeschen den Wert 'TRUE', so wird nach Verlassen der Menuebene die + Task automatisch gelöscht; bei 'FALSE' wird noch angefragt, ob die Task + gelöscht werden soll. Wird die Frage bejaht, wird gelöscht; sonst wird die + Task abgekoppelt (break) und kann durch 'continue' wieder angekoppelt + werden. + In der Task, in der das Kommando 'direktbefehl' gegeben wurde, sollte + nicht das Kommando 'monitor' gegeben werden, da dadurch auch die­ + se Task zu einer Task gemacht würde, die sich direkt mit dem Menu + meldet und ggf. bei Verlassen des Menus automatisch gelöscht wird! Die + 'gib kommando:'-Ebene ist dadurch unzugänglich! + + +#ib#ecke oben links#ie# +TEXT PROC ecke oben links: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" links oben in der + Ecke (ω) ausgegeben wird. + + +PROC ecke oben links (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" links oben in der Ecke ausgegeben werden soll. + + +#ib#ecke oben rechts#ie# +TEXT PROC ecke oben rechts: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" rechts oben in + der Ecke (�) ausgegeben wird. + + +PROC ecke oben rechts (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" rechts oben in der Ecke ausgegeben werden soll. + + +#ib#ecke unten links#ie# +TEXT PROC ecke unten links: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" links unten in + der Ecke (�) ausgegeben wird. + + +PROC ecke unten links (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" links unten in der Ecke ausgegeben werden soll. + + +#ib#ecke unten rechts#ie# +TEXT PROC ecke unten rechts: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" rechts unten in + der Ecke (�) ausgegeben wird. + + +PROC ecke unten rechts (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" rechts unten in der Ecke ausgegeben werden soll. + + +#ib#edit#ie# +PROC edit (WINDOW VAR w, TEXT CONST dateiname): + +Zweck: Vergl. 'menuwindowedit'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowedit' automatisch gesetzt wird. + + +PROC edit (WINDOW VAR w, FILE VAR f): + +Zweck: Vergl. 'menuwindowedit'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowedit' automatisch gesetzt wird. + + +#ib#editget#ie# +PROC editget (WINDOW VAR w, TEXT VAR text):#u#(*)#e# +Zweck: Eingabe mit Editiermöglichkeit von 'text'. 'text' wird ausgegeben. Die + Eingabe wird mit RETURN beendet. 'text' darf höchstens 79 Zeichen + lang sein! Fehler: Text nicht initialisiert. + + +PROC editget (WINDOW VAR w, TEXT VAR text, + INT CONST max laenge, scroll, + TEXT CONST sep, res, + TEXT VAR exit char):#u#(*)#e# +Zweck: Wie oben. Über 'max laenge' kann festgelegt werden , wie lang der einzu­ + gebende Text ('text') maximal sein darf. Über 'scroll' wird die Breite des + Zeilenfensters festgelegt, bevor gerollt wird (jedoch nicht über die rech­ + te Fenstergrenze hinaus). Über 'sep' können Zeichen bestimmt werden, + bei denen die Eingabe (zusätzlich zu RETURN) beendet werden soll. Über + 'res' können reservierte Tasten angegeben werden. Wird eine dieser + Tasten mit ESC betätigt, wird die Eingabe beendet. In 'exit char' steht + dann ESC und das Zeichen, mit dem der Editor verlassen wurde. +Fehler: Text nicht initialisiert. + + +#ib#erase#ie# +PROC erase (WINDOW VAR fenster): + +Zweck: Der durch 'fenster' beschrieben Bildschirmbereich wird gelöscht - ein­ + schließlich des Rahmens, der den Fensterbereich umgibt (vergl. Sie auch + 'page')! + + +#ib#erase footnote#ie# +PROC erase footnote (WINDOW VAR fenster): + +Zweck: Die letzten beiden Zeilen in 'fenster' (in der die Fußnote nebst Trennlinie + eingetragen sind) werden gelöscht (vergl. Sie auch 'out footnote')! + + +#ib#erase menunotice#ie# +PROC erase menunotice: + +Zweck: Sofern zuvor mit 'write menunotice' (sehen Sie auch dort) eine Menunotiz + gesetzt wurde, wird diese gelöscht, ansonsten hat die Prozedur keine + Wirkung. + + +#ib#get#ie# +PROC get (WINDOW VAR w, TEXT CONST eingabe): + +Zweck: Vergl. 'menuwindowget'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowget' automatisch gesetzt wird. + + +PROC get (WINDOW VAR w, INT CONST wert): + +Zweck: Vergl. 'get (WINDOW VAR w, TEXT CONST eingabe)'. Der eingelesene Wert + wird anschließend entsprechend konvertiert. + + + +PROC get (WINDOW VAR w, REAL CONST wert): + +Zweck: Vergl. 'get (WINDOW VAR w, TEXT CONST eingabe)'. Der eingelesene Wert + wird anschließend entsprechend konvertiert. + + +PROC get (WINDOW VAR w, TEXT CONST eingabe, + INT CONST laenge): + +Zweck: Vergl. 'get (WINDOW VAR w, TEXT CONST eingabe)'. Zusätzlich wird die + Eingabe beendet, wenn der eingegebene Text die Länge 'laenge' erreicht + hat. + + +PROC get (WINDOW VAR w, TEXT CONST eingabe, + TEXT CONST separator): + +Zweck: Vergl. 'get (WINDOW VAR w, TEXT CONST eingabe)'. Zusätzlich werden + über 'separtor' die Zeichen festgelegt, die zusätzlich zu den Positionie­ + rungszeichen die Eingabe beenden. + + +#ib#get cursor#ie# +PROC get cursor (WINDOW VAR w, INT VAR spalte, + zeile): + +Zweck: Vergl. 'get menuwindowcursor'. Hier wird nur zusätzlich das Fenster + festgelegt, das bei 'get menuwindowcursor' automatisch gesetzt wird. + + +#ib#getline#ie# +PROC getline (WINDOW VAR w, TEXT CONST eingabe): + +Zweck: Vergl. 'get (WINDOW VAR w, TEXT CONST eingabe). Nur wird hier die + Eingabe ausschließlich über die Positionierungstasten - nicht aber über + das Leerzeichen beendet. + + +#ib#get menuwindowcursor#ie# +PROC get menuwindowcursor (INT VAR spalte, zeile): + +Zweck: Mit der Prozedur wird die aktuelle Cursorposition innerhalb des Menu­ + fensters erfragt. + + +#ib#handle menu#ie# +PROC handle menu (TEXT CONST menuname): + +Zweck: Bringt das in der angekoppelten Menukarte enthaltene Menu mit dem + Namen 'menuname' zur Ausführung, d.h. das entsprechende Menu wird + auf dem Bildschirm präsentiert und kann mit den üblichen Tastenfunk­ + tionen gehandhabt werden. + (Anmerkung: Die Menufunktionen können natürlich nur dann ausge­ + führt werden, wenn die zugehörigen Programme in der aktuellen Task + zuvor insertiert wurden - ansonsten erscheint auf dem Bildschirm jeweils + der Hinweis 'unbekanntes Kommando'!) +Fehler: Das Menu 'menuname' ist nicht in der angekoppelten Menukarte! + + +#ib#infix namen#ie# +THESAURUS PROC infix namen (THESAURUS CONST thes, + TEXT CONST infix): + +Zweck: Die Prozedur liefert einen Thesaurus, in dem alle Namen enthalten sind, + die in 'thes' übergeben wurden und die den Wortbestandteil 'infix' enthal­ + ten (gleichgültig an welcher Position). + + +THESAURUS PROC infix namen (THESAURUS CONST thes, + INT CONST dateityp): + +Zweck: Die Prozedur liefert einen Thesaurus, in dem alle Dateinamen enthalten + sind, die in 'thes' übergeben wurden und die den Dateityp 'dateityp' + haben. + + +THESAURUS PROC infix namen (THESAURUS CONST thes, + TEXT CONST infix, + INT CONST dateityp): + + wirkt wie: infix namen (infix namen (thes, infix), dateityp) + + +#ib#install menu#ie# +PROC install menu (TEXT CONST menukartenname, + BOOL CONST mit emblem): + +Zweck: Mit diesem Befehl wird die Menukarte mit dem Namen 'menukarten­ + name' aus der Task 'gs-MENUKARTEN' in die aktuelle Task kopiert. Die + Menukarte wird als unbenannter Datenraum an die Task gekoppelt. Der + benannte Datenraum wird gelöscht. Der Name der angekoppelten Menu­ + karte wird vermerkt. + Stimmt der Name der angekoppelten Menukarte mit dem Namen der + angeforderten Menukarte überein, dann wird nicht erneut eine Kopie + angefordert, sondern auf der bereits angekoppelten Menukarte gearbeitet. + Hat 'mit emblem' den Wert 'TRUE', dann wird unser 'Software-Emblem' + während des Ankoppelvorgangs auf dem Bildschirm ausgegeben, bei + 'FALSE' nicht. +Fehler: Die Menukarte 'menukartenname' existiert nicht in der Task + 'gs-MENUKARTEN'. + + +PROC install menu (TEXT CONST menukartenname): + + wirkt wie: install menu (TEXT CONST menukartenname, TRUE) + + +#ib#invers#ie# +TEXT PROC invers (TEXT CONST text): + +Zweck: Liefert den Text 'text' invers dargestellt. An den Text wird zuvor ein Leer­ + zeichen angehängt. + + +#ib#kreuz#ie# +TEXT PROC kreuz: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" als "Kreuz" (̗) + ausgegeben wird. + + +PROC kreuz (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" als "Kreuz" ausgegeben werden soll. + + +#ib#line#ie# +PROC line (WINDOW VAR w, INT CONST anzahl): + +Zweck: Vergl. 'menuwindowline'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowline' automatisch gesetzt wird. + + +PROC line (WINDOW VAR w): + + wirkt wie: line (w, 1) + + +#ib#menualternative#ie# +INT PROC menualternative (TEXT CONST infotext, + auswahlliste, + zusatztasten, + INT CONST position, + BOOL CONST mit abbruch): + +Zweck: Mit der Prozedur können dem Benutzer innerhalb des Menubildschirms + mehrere Alternativen zur Entscheidung angeboten werden, von denen er + sich für eine entscheiden kann. + Auf dem Bildschirm wird innerhalb des Menus eine Box ausgegeben. + Boxbreite und -höhe werden vom System automatisch anhand des über­ + gebenen 'infotext'es (bzw. der 'auswahlliste') festgelegt. Der in 'infotext' + übergebene Text wird innerhalb der Box angezeigt. Der Text muß den + gs-DIALOG-Syntax-Regeln (sehen Sie Kap. 5.13) entsprechen - er dient + ausschließlich der Information des Benutzers. + In der letzten Zeile der Box wird die 'auswahlliste' angeboten. Zwischen + jeder notierten Alternative muß in 'auswahlliste' der code "13" eingetra­ + gen sein. In der Box werden zwischen den Alternativen je drei Leerzei­ + chen eingefügt. Es können maximal 10 Alternativen angegeben werden, + die aber incl. der eingefügten Leerzeichen eine Gesamtbreite von 64 + Zeichen nicht überschreiten dürfen. Über diese Liste erfolgt durch Posi­ + tionierung und anschließendem die Entscheidung für eine + Alternative. Die Prozedur liefert dann als Zahlenwert die Position der + gewählten Alternative in der übergebenen Auswahlliste. + Über 'mit abbruch' wird festgelegt, ob die Alternativentscheidung durch + die Tastenfolge abgebrochen werden kann oder nicht. Ist + das zulässig und geschehen, dann wird der Wert 0 geliefert. + Über 'zusatztasten' kann noch festgelegt werden, ob die Entscheidung + auch durch Tippen bestimmter Tasten angegeben werden kann. Sind hier + Zeichen angegeben und erfolgt die Entscheidung über das Tippen einer + zugelassenen Taste, dann wird die Position der getippten Taste in der + unter 'zusatztasten' übergebenen Zeichenkette ermittelt und der Wert 100 + hinzuaddiert (sehen Sie dazu auch Kap. 5.7). + Nach der Entscheidung wird der Menubildschirm automatisch in den + Ausgangszustand versetzt. + + +#ib#menuanswer#ie# +TEXT PROC menuanswer (TEXT CONST infotext, + vorgabe, + INT CONST position): + +Zweck: Die Prozedur ermöglicht den Dialog mit dem Benutzer innerhalb des + Menus. Sie liefert einen vom Benutzer eingegebenen (bzw. modifizierten) + Text/Namen. + Auf dem Bildschirm wird innerhalb des Menus eine Box ausgegeben. + Boxbreite und -höhe werden vom System automatisch anhand des über­ + gebenen 'infotext'es festgelegt. Der in 'infotext' übergebene Text wird + innerhalb der Box angezeigt. Der Text muß den gs-DIALOG-Syntax-Regeln + (sehen Sie Kap. 5.13) entsprechen. + In der letzten Zeile der ausgegebenen Box erscheint der Text "Eingabe:". + Über 'vorgabe' kann dem Benutzer ein Text zum Editieren angeboten + werden. Mit 'position' wird die relative Lage der Box innerhalb des Menu­ + bildschirms festgelegt (1, 2, 3, 4, 5: sehen Sie dazu Kap. 5.12). + Die Eingabe kann durch abgeschlossen oder durch + abgebrochen werden, in letzterem Falle wird niltext ("") + geliefert. + Der gelieferte Wert ist von führenden und folgenden Leerzeichen befreit + (compress). Es ist nicht möglich, den Namen 'break' einzugeben (sehen + Sie dazu Kap.5.1). + + +#ib#menuanswerone#ie# +TEXT PROC menuanswerone (TEXT CONST infotext, + vorgabe, THESAURUS CONST thesaurus, + TEXT CONST ueberschrift, hinweis, + BOOL CONST mit reinigung): + +Zweck: Die Prozedur ist aus den zwei Prozeduren 'menuanswer' und 'menuone' + zusammengesetzt (sehen Sie auch dort). In einer Box innerhalb des + Menus wird der 'infotext' ausgegeben und eine Eingabe erwartet; ggf. + kann ein Text in 'vorgabe' zum Editieren ausgegeben werden. Wird die + Eingabe mit abgeschlossen, wird der eingegebene Text + geliefert. Statt der Eingabe kann der Benutzer sich durch die Tastenfolge + auch die in 'thesaurus' übergebenen Namen zur Auswahl + anbieten lassen. Wird ein Name angekreuzt, wird dieser geliefert; wird die + Auswahl durch abgebrochen, wird niltext ("") geliefert. +Fehler: Fenster für Auswahl zu klein (x < 56, y < 15) + + +#ib#menuanswersome#ie# +THESAURUS PROC menuanswersome (TEXT CONST + infotext, vorgabe, + THESAURUS CONST thesaurus, + TEXT CONST ueberschrift, hinweis, + BOOL CONST mit reinigung): + +Zweck: Die Prozedur ist aus den zwei Prozeduren 'menuanswer' und 'menusome' + zusammengesetzt (sehen Sie auch dort). In einer Box innerhalb des + Menus wird der 'infotext' ausgegeben und eine Eingabe erwartet; ggf. + kann ein Text in 'vorgabe' zum Editieren ausgegeben werden. Wird die + Eingabe mit abgeschlossen, wird der eingegebene Text in + einem Thesaurus geliefert. Statt der Eingabe kann der Benutzer sich + durch die Tastenfolge auch die in 'thesaurus' übergebenen + Namen zur Auswahl anbieten lassen. Werden Namen angekreuzt, werden + diese in einem Thesaurus geliefert; wird die Auswahl durch + abgebrochen, wird ein leerer Thesaurus geliefert. +Fehler: Fenster für Auswahl zu klein (x < 56, y < 15) + + +#ib#menu archiv checken#ie# +PROC menu archiv checken: + +Zweck: Über diese Prozedur kann das "Checken" von Dateien auf dem Archiv in + das Archiv-Pull-Down-Menu eingebunden werden. Sehen Sie dazu unbe­ + dingt Kap. 6.1! + + +#ib#menu archiv grundeinstellung#ie# +PROC menu archiv grundeinstellung (INT CONST ort): + +Zweck: Hierüber wird die Grundeinstellung des Archivpakets vorgenommen: Dazu + wird als Zieltask das Archiv der eigenen Station eingestellt. Dieses wird + auch über eine Menunotiz im Menu angezeigt. Die entsprechenden Menu­ + punkte werden aktiviert bzw. deaktiviert. Sehen Sie dazu unbedingt Kap. + 6.1! + Über 'ort' wird festgelegt, an welcher Stelle innerhalb des Menus die + Menunotiz zur Anzeige der Zieltask (und ggf. des Archivnamens) ausge­ + geben wird (sehen Sie dazu Kap. 5.12). + + +#ib#menu archiv holen#ie# +PROC menu archiv holen: + +Zweck: Über diese Prozedur kann das Holen von Dateien vom Archiv in das + Archiv-Pull-Down-Menu eingebunden werden. Sehen Sie dazu unbedingt + Kap. 6.1! + + +#ib#menu archiv initialisieren#ie# +PROC menu archiv initialisieren: + +Zweck: Über diese Prozedur kann das Formatieren/ Initialisieren eines Archivs in + das Archiv-Pull-Down-Menu eingebunden werden. Sehen Sie dazu unbe­ + dingt Kap. 6.1! + + +#ib#menu archiv loeschen#ie# +PROC menu archiv loeschen: + +Zweck: Über diese Prozedur kann das Löschen von Dateien auf dem Archiv in das + Archiv-Pull-Down-Menu eingebunden werden. Sehen Sie dazu unbedingt + Kap. 6.1! + + +#ib#menu archiv neue diskette#ie# +PROC menu archiv neue diskette: + +Zweck: Über diese Prozedur kann das Anmelden einer neuen Diskette bei schon + reserviertem Archiv in das Archiv-Pull-Down-Menu eingebunden werden. + Sehen Sie dazu unbedingt Kap. 6.1! + + +#ib#menu archiv reservieren#ie# +PROC menu archiv reservieren: + +Zweck: Über diese Prozedur kann die Archivreservierung in das Archiv-Pull- + Down-Menu eingebunden werden. Sehen Sie dazu unbedingt Kap. 6.1! + + +#ib#menu archiv reservierung aufgeben#ie# +PROC menu archiv reservierung aufgeben: + +Zweck: Über diese Prozedur kann eine bestehende Archivreservierung aus dem + Menu heraus aufgegeben werden. Sehen Sie dazu unbedingt Kap. 6.1! + + +#ib#menu archiv schreibcheck#ie# +PROC menu archiv schreibcheck: + +Zweck: Über diese Prozedur kann das Schreiben von Dateien auf das Archiv und + das sich automatisch daran anschließende "Checken" der zuvor geschrie­ + benen Dateien in das Archiv-Pull-Down-Menu eingebunden werden. + Sehen Sie dazu unbedingt Kap. 6.1! + + +#ib#menu archiv schreiben#ie# +PROC menu archiv schreiben: + +Zweck: Über diese Prozedur kann das Schreiben von Dateien auf das Archiv in + das Archiv-Pull-Down-Menu eingebunden werden. Sehen Sie dazu unbe­ + dingt Kap. 6.1! + + +#ib#menu archiv verzeichnis#ie# +PROC menu archiv verzeichnis: + +Zweck: Über diese Prozedur kann die Ausgabe eines Inhaltsverzeichnisses des + Archivs auf dem Bildschirm in das Archiv-Pull-Down-Menu eingebunden + werden. Sehen Sie dazu unbedingt Kap. 6.1! + + +#ib#menu archiv verzeichnis drucken#ie# +PROC menu archiv verzeichnis drucken: + +Zweck: Über diese Prozedur kann die Ausgabe eines Inhaltsverzeichnisses des + Archivs über den Drucker in das Archiv-Pull-Down-Menu eingebunden + werden. Sehen Sie dazu unbedingt Kap. 6.1! + + +#ib#menu archiv zieltask einstellen#ie# +PROC menu archiv zieltask einstellen: + +Zweck: Über diese Prozedur kann die Festlegung der Zieltask, mit der die Inter­ + taskkommunikation abgewickelt werden soll, in das Archiv-Pull-Down- + Menu eingebunden werden. Sehen Sie dazu unbedingt Kap. 6.1! + + +#ib#menu dateien aufraeumen#ie# +PROC menu dateien aufraeumen: + +Zweck: Durch diese Prozedur wird innerhalb des aktuellen Menus der Name der + Datei erfragt, die aufgeräumt, d.h. reorganisiert werden soll. Existiert + keine Datei mit dem angegebenen Namen, so erfolgt ein Hinweis darauf. + Statt der Eingabe des Dateinamens kann auch die Tastenfolge + getippt werden. Daraufhin werden alle Dateinamen der + Task zur Auswahl angeboten. Hier können die gewünschten Dateinamen + angekreuzt werden. Anschließend werden die angekreuzten Dateien + reorganisiert. Der Vorgang wird auf dem Bildschirm protokolliert. Am + Ende des Vorgangs wird der Menubildschirm automatisch regeneriert. Es + können natürlich nur Dateien des Typs 1003 (Textfiles) reorganisiert + werden; sofern andere Dateien ausgewählt werden, erfolgt ein Hinweis + darauf. + + +#ib#menu dateien drucken#ie# +PROC menu dateien drucken: + +Zweck: Durch diese Prozedur wird innerhalb des aktuellen Menus (auch bei + geschachtelten(!)) der Name der Datei erfragt, die gedruckt werden soll. + Anschließend wird die Datei mit dem angegebenen Namen gedruckt. + Existiert keine Datei mit dem angegebenen Namen, so erfolgt ein Hinweis + darauf. + Statt der Eingabe des Dateinamens kann auch die Tastenfolge + getippt werden. Daraufhin werden alle Dateinamen der + Task zur Auswahl angeboten. Alle angekreuzten Dateien werden an­ + schließend gedruckt. Der Vorgang wird auf dem Bildschirm protokolliert. + Am Ende wird der Menubildschirm automatisch regeneriert. + + +#ib#menu dateien kopieren#ie# +PROC menu dateien kopieren: + +Zweck: Durch diese Prozedur wird innerhalb des aktuellen Menus der Name der + Datei erfragt, die kopiert werden soll. Existiert keine Datei mit dem + angegebenen Namen, so erfolgt ein Hinweis darauf. Statt der Eingabe des + Dateinamens kann auch die Tastenfolge getippt werden. + Daraufhin werden alle Dateinamen der Task zur Auswahl angeboten. Hier + kann ein Dateiname angekreuzt werden. Nun wird der Name erfragt, den + die Kopie erhalten soll. Existiert der Name bereits, erfolgt ein Hinweis + darauf, sonst wird die Datei kopiert. Der Menubildschirm wird automa­ + tisch regeneriert. + + +#ib#menu dateien loeschen#ie# +PROC menu dateien loeschen: + +Zweck: Durch diese Prozedur wird innerhalb des aktuellen Menus der Name der + Datei erfragt, die gelöscht werden soll. Anschließend wird die Datei mit + dem angegebenen Namen gelöscht, sofern die Sicherheitsabfrage zum + Löschen mit 'Ja' beantwortet wurde. Existiert keine Datei mit dem ange­ + gebenen Namen, so erfolgt ein Hinweis darauf. Statt der Eingabe des + Dateinamens kann auch die Tastenfolge getippt werden. + Daraufhin werden alle Dateinamen der Task zur Auswahl angeboten. Alle + angekreuzten Dateien werden anschließend (nach jeweiliger Sicherheits­ + anfrage) gelöscht. Der Vorgang wird auf dem Bildschirm protokolliert. Am + Ende wird der Menubildschirm automatisch regeneriert. + + +#ib#menu dateien speicherplatz#ie# +PROC menu dateien speicherplatz: + +Zweck: Durch diese Prozedur wird innerhalb des aktuellen Menus der Name der + Datei erfragt, deren Speicherplatz ermittelt werden soll. Existiert keine + Datei mit dem angegebenen Namen, so erfolgt ein Hinweis darauf. Statt + der Eingabe des Dateinamens kann auch die Tastenfolge + getippt werden. Daraufhin werden alle Dateinamen der Task zur Aus­ + wahl angeboten. Hier können die gewünschten Dateinamen angekreuzt + werden. Anschließend wird der Speicherplatz der angekreuzten Datei(en) + ermittelt und im Menufenster ausgegeben. Im Anschluß an die Anzeige + wird der Menubildschirm automatisch regeneriert. + + +#ib#menu dateien umbenennen#ie# +PROC menu dateien umbenennen: + +Zweck: Durch diese Prozedur wird innerhalb des aktuellen Menus der Name der + Datei erfragt, die umbenannt werden soll. Existiert keine Datei mit dem + angegebenen Namen, so erfolgt ein Hinweis darauf. Statt der Eingabe des + Dateinamens kann auch die Tastenfolge getippt werden. + Daraufhin werden alle Dateinamen der Task zur Auswahl angeboten. Hier + kann ein Dateiname angekreuzt werden. Nun wird der Name erfragt, den + die Datei anschließend erhalten soll. Existiert der Name bereits, erfolgt ein + Hinweis darauf, sonst wird die Datei umbenannt. Der Menubildschirm + wird automatisch regeneriert. + + +#ib#menu dateien verzeichnis#ie# +PROC menu dateien verzeichnis + +Zweck: Mit der Prozedur kann innerhalb des aktuellen Menus ein Verzeichnis der + Dateien der eigenen Task ausgegeben werden. Nach Verlassen des Ver­ + zeichnisses durch wird der Menubildschirm automatisch + regeneriert. + + +#ib#menufootnote#ie# +PROC menufootnote (TEXT CONST fussnotentext): + +Zweck: Mit der Prozedur kann der Text in der "Fußzeile" des aktuellen Menubild­ + schirms (zumeist Hinweise an den Benutzer) ersetzt werden. Der vorhan­ + dene Text wird gelöscht und stattdessen 'fussnotentext' notiert. Der Text + bleibt so lange erhalten, bis er durch eine andere selbstgesetzte Fußnote + ('menufootnote') oder durch die alte vom System gesetzte Fußnote ('old + menufootnote'; sehen Sie auch dort) überschrieben wird. Sofern + gs-DIALOG-Prozeduren aufgerufen werden, die selbst Ausgaben in der + Fußzeile machen, wird die durch 'menufootnote' gesetzte Fußnote eben­ + falls überschrieben. Wenn der Text länger als die aktuelle Menubild­ + schirmbreite ist,wird der Text abgeschnitten. Damit der Text auch in + geschachtelten Menus vollständig ausgegeben werden kann, sollte er nicht + länger als 69 Zeichen sein. + + +#ib#menufunktion#ie# +PROC menufunktion (TEXT CONST kuerzel, + punktbezeichnung, + prozedurname, + infotext): + +Zweck: Der Befehl wird für die Generierung von Menukarten benötigt. Mit diesem + Befehl wird in das aktuell geöffnete Menu unter dem aktuellen Oberbe­ + griff eine Verarbeitungsfunktion eingetragen. Mit 'kuerzel' wird die Taste + bestimmt, über die die Verarbeitungsfunktion direkt aktiviert werden + kann. 'kuerzel' muß innerhalb eines Pull-Down-Menus eindeutig gewählt + sein! Unter 'punktbezeichnung' wird der Text eingetragen, der im Pull- + Down-Menu ausgegeben werden soll. In 'prozedurname' steht der Name + der Prozedur (als Text(!)), die bei Aktivierung des Menupunktes ausge­ + führt werden soll. In 'infotext' steht der Text, der als Information zu + diesem Menupunkt bei Tippen der -Taste angezeigt werden soll. +Fehler: Menupunkt-Kürzel ist länger als ein Zeichen. + Menupunktkürzel kommt mehrfach vor. + Menupunktbezeichnung ist zu lang (> 60 Zeichen). + Zu viele Menupunkte in einem Pull-Down-Menu (> 15). + + +#ib#menuinfo#ie# +PROC menuinfo (TEXT CONST infotext, INT CONST + position, timelimit): + +Zweck: Die Prozedur ermöglicht es, innerhalb des Menus einen Hinweis (Infor­ + mationstext) auszugeben. Im Menubildschirm erscheint der 'infotext' in + einer Box. Boxbreite und -höhe werden vom System automatisch anhand + des übergebenen 'infotext'es festgelegt. 'infotext' muß den gs-DIALOG- + Syntax-Regeln (sehen Sie Kap. 5.13) entsprechen. Mit 'position' wird die + relative Lage der Box innerhalb des Menubildschirms festgelegt (1, 2, 3, + 4, 5: sehen Sie dazu Kap. 5.12). Mit 'timelimit' kann die Zeitdauer (in + Zehntelsekunden) festgelegt werden, für die der Hinweis höchstens er­ + scheint. Die Anzeige kann vom Benutzer durch Tippen einer beliebigen + Taste abgebrochen werden. + + +PROC menuinfo (TEXT CONST infotext, + INT CONST position): + + wirkt wie: menuinfo (infotext, position, maxint) + + +PROC menuinfo (TEXT CONST infotext): + + wirkt wie: menuinfo (infotext, 5) + + +#ib#menukartenname#ie# +TEXT PROC menukartenname:#u#(*)#e# +Zweck: Liefert den Namen der zur zeit angekoppelten Menukarte. Ist keine + Menukarte angekoppelt, wird niltext ("") geliefert. + + +#ib#menuno#ie# +BOOL PROC menuno (TEXT CONST frage, + INT CONST position): + + wirkt wie: NOT menuyes (frage, position) + + +#ib#menuone#ie# +TEXT PROC menuone (THESAURUS CONST thesaurus, + TEXT CONST ueberschrift, + hinweis, + BOOL CONST mit reinigung): + +Zweck: Durch die Prozedur werden dem Benutzer innerhalb des Menubild­ + schirms Namen zur Auswahl angeboten. Nach Ankreuzen eines Namens + wird die Auswahl automatisch verlassen. Der angekreuzte Name wird + geliefert. Wird die Auswahl durch abgebrochen, so wird + niltext ("") geliefert. In 'thesaurus' wird ein THESAURUS mit den Namen + übergeben, die zur Auswahl angeboten werden sollen (sehen Sie dazu + auch Kap. 5.14). Die beiden Texte 'ueberschrift' und 'hinweis' erscheinen + zur Kennzeichnung im Kopf der Auswahlliste: 'ueberschrift' zentriert und + invers dargestellt, 'hinweis' nur zentriert. Hat 'mit reinigung' den Wert + TRUE, so wird nach der Auswahl der Menubildschirm automatisch wie­ + deraufgebaut, bei FALSE wird darauf verzichtet. +Fehler: Fenster für Auswahl zu klein (x < 56, y < 15) + + +#ib#menusome#ie# +THESAURUS PROC menusome (THESAURUS CONST + thesaurus, + TEXT CONST ueberschrift, + hinweis, + BOOL CONST mit reinigung): + +Zweck: Durch die Prozedur werden dem Benutzer innerhalb des Menubild­ + schirms Namen zur Auswahl angeboten. Die Auswahl kann durch die + Tastenfolge verlassen werden. Der/ die angekreuzte(n) + Name(n) wird/werden in einem Thesaurus geliefert. Wird die Auswahl + durch die Tastenfolge abgebrochen oder wurde kein Name + angekreuzt, dann wird ein leerer Thesaurus geliefert. In 'thesaurus' wird + ein Thesaurus mit den Namen übergeben, die zur Auswahl angeboten + werden sollen (sehen Sie dazu auch Kap. 5.14). Die beiden Texte + 'ueberschrift' und 'hinweis' erscheinen zur Kennzeichnung im Kopf der + Auswahlliste: 'ueberschrift' zentriert und invers dargestellt, 'hinweis' nur + zentriert. Hat 'mit reinigung' den Wert TRUE, so wird nach der Auswahl + der Menubildschirm automatisch wiederaufgebaut, bei FALSE wird darauf + verzichtet. +Fehler: Fenster für Auswahl zu klein (x < 56, y < 15) + + +#ib#menuwindowcenter#ie# +TEXT PROC menuwindowcenter (TEXT CONST text): + +Zweck: Die Prozedur liefert einen Text, der so lang ist, wie das aktuelle Menufen­ + ster breit ist. Dazu wird 'text' so mit Leerzeichen "ummantelt" daß 'text' + etwa in der Mitte zu stehen kommt. Steht der Cursor bei Ausgabe dieses + Textes am Anfang der Zeile, erscheint der Text zentriert in der Zeile + (vorhandene Zeileninhalte werden dadurch überschrieben (der Cursor + steht dann auf dem rechten Fensterrand!). + + +#ib#menuwindowcursor#ie# +PROC menuwindowcursor (INT CONST spalte, zeile): + +Zweck: Mit diesem Befehl kann der Cursor innerhalb des aktuellen Menufensters + positioniert werden. Ein "normales" Menufenster ist 77 Zeichen breit und + 20 Zeichen hoch; ein Menufenster in einem geschachtelten Menu ist 71 + Zeichen breit und 16 Zeichen hoch). (Sehen Sie auch die Informations­ + prozeduren 'get menuwindowcursor' und 'remaining menuwindowlines'). +Fehler: Wird außerhalb des aktuellen Menufensters positioniert, wird der Fenster­ + inhalt gelöscht und die Fensterposition (1,1) angenommen. + + +#ib#menuwindowedit#ie# +PROC menuwindowedit (TEXT CONST dateiname): + +Zweck: Durch den Befehl wird innerhalb des Menus ein umrandetes Fenster + geöffnet und die Datei mit dem Namen 'dateiname' zum Editieren ausge­ + geben. Auf die Größe des Menufensters kann kein Einfluß genommen + werden - sie wird selbständig vom System gesetzt ("normales" Menu: 77 + Zeichen breit und 20 Zeichen hoch; geschachteltes Menu 71 Zeichen + breit und 16 Zeichen hoch). +Fehler: Die Datei mit dem Namen 'dateiname' existiert nicht. + + +PROC menuwindowedit (FILE VAR f): + +Zweck: Vergl. obige 'menuwindowedit'-Prozedur. Die Datei 'f' muß mit der Verar­ + beitungsart 'modify' assoziiert worden sein. + + +#ib#menuwindoweditget#ie# +PROC menuwindoweditget (TEXT VAR text):#u#(*)#e# +Zweck: Vergl. 'menuwindowget (TEXT VAR text)' Zusätzlich kann hier in 'text' ein + Text zum Editieren vorgegeben werden. +Fehler: Text nicht initialisiert. + + +#ib#menuwindowget#ie# +PROC menuwindowget (TEXT VAR text): + +Zweck: Mit der Prozedur können Texte innerhalb des Menufensters eingelesen + werden (INTEGER- und REAL-Werte müssen ggf. "von Hand" konvertiert + werden). Die Eingabe wird durch abgeschlossen. Es muß + mindestens ein Zeichen (ungleich Leerzeichen) eingegeben werden. Von + der Eingabe werden die führenden Leerzeichen abgeschnitten. Ist der + einzugebende Text länger als die noch verbleibende Restzeile, so wird der + Text in der Restzeile gescrollt. Sind in der aktuellen Zeile weniger als 7 + Zeichenpositionen für die Eingabe vorhanden, so wird automatisch für die + Eingabe an den Anfang der nächsten Zeile positioniert. + + +#ib#menuwindowline#ie# +PROC menuwindowline (INT CONST anzahl): + +Zweck: Die Prozedur 'menuwindowline' hat innerhalb des Menubildschirms eine + ähnliche Wirkung wie die Prozedur 'line' auf dem Gesamtbildschirm. Es + werden 'anzahl' Zeilenwechsel vorgenommen. Wird allerdings die untere + Grenze des Menubildschirms überschritten, dann rollt (scrollt) der Bild­ + schirm nicht die entsprechende Anzahl Zeilen nach oben, statt dessen + wird der Fensterinhalt gelöscht und die Operation oben im Fenster fort­ + gesetzt. + + +PROC menuwindowline: + + wirkt wie: menuwindowline (1) + + +#ib#menuwindowout#ie# +PROC menuwindowout (TEXT CONST text): + +Zweck: Mit der Prozedur können innerhalb des aktuellen Menufensters Texte + ausgegeben werden. Sollen INTEGER- oder REAL-Werte ausgegeben wer­ + den, müssen diese zunächst in Texte konvertiert werden. Ist der Text + länger als die verbleibende Restzeile innerhalb des aktuellen Menufen­ + sters, so wird der Text bis zum Fensterende (rechts) ausgegeben und die + Ausgabe am Anfang der nächsten Zeile fortgesetzt. Sobald die letzte Posi­ + tion des aktuellen Menufensters (unten rechts in der Fensterecke) be­ + schrieben wurde, wird der Fensterinhalt gelöscht und die Ausgabe an der + Position (1,1) des Fensters fortgesetzt. + + +#ib#menuwindowpage#ie# +PROC menuwindowpage: + +Zweck: Durch den Befehl 'menuwindowpage' wird der Inhalt des Fensters inner­ + halb des aktuellen Menus gelöscht (das "Menufenster") (vergleichen Sie + auch 'show menuwindow'). Der Rahmen des Fensters (der bei 'show + menuwindow' ausgegeben wurde), bleibt bestehen, da er nicht mit zum + eigentlichen Fenster gehört. Durch den Befehl wird der Menubildschirm + nicht rekonstruiert! Soll das Fenster geschlossen werden, ist der Befehl + 'regenerate menuscreen' zu geben. + + +#ib#menuwindowshow#ie# +PROC menuwindowshow (TEXT CONST dateiname): + +Zweck: Vergl. 'menuwindowedit'-Prozedur. Die Datei 'dateiname' kann nicht + schreibend verändert werden. + + +PROC menuwindowshow (FILE VAR f): + +Zweck: Vergl. obige 'menuwindowshow'-Prozedur. Die Datei 'f' muß mit der + Verarbeitungsart 'modify' assoziiert worden sein. + + +#ib#menuwindowstop#ie# +PROC menuwindowstop (INT CONST zeilenzahl): + +Zweck: Innerhalb des Menufensters werden 'zeilenzahl' Zeilenwechsel vorge­ + nommen und der Text " Zum Weitermachen bitte irgendeine Taste tip­ + pen!" ausgegeben. Danach wird so lange gewartet, bis eine Taste getippt + wird. + + +PROC menuwindowstop: + + wirkt wie: menuwindowstop (2) + + +#ib#menuyes#ie# +BOOL PROC menuyes (TEXT CONST frage, + INT CONST position): + +Zweck: Die Prozedur dient dazu, innerhalb des Menus eine Ja/Nein-Entscheidung + des Benutzers einzuholen. Im Gegensatz zur Standardprozedur 'yes' + arbeitet diese Prozedur unabhängig davon, ob der Kommandodialog ein- + oder ausgeschaltet ist. Auf dem Bildschirm wird innerhalb des Menus eine + Box ausgegeben. Boxbreite und -höhe werden vom System automatisch + anhand der übergebenen 'frage' festgelegt. Der in 'frage' übergebene Text + wird um ein Fragezeichen (?) ergänzt und innerhalb der Box angezeigt. + Der Text muß den gs-DIALOG-Syntax-Regeln (sehen Sie Kap. 5.13) + entsprechen. In der letzten Zeile der ausgegebenen Box erscheint der Text + "Ja    Nein". Die Prozedur 'menuyes' liefert TRUE, wenn mit 'Ja' geantwor­ + tet wurde und FALSE, wenn mit 'Nein' geantwortet wurde (durch Tippen + der Anfangsbuchstaben oder Positionierung auf die Antwort und ab­ + schließendes ). Der Menubildschirm wird automatisch + regeneriert. Mit 'position' wird die relative Lage der Box innerhalb des + Menubildschirms festgelegt (1, 2, 3, 4, 5: sehen Sie dazu Kap. 5.12). + + +#ib#no#ie# +BOOL PROC no (WINDOW VAR w, TEXT CONST frage): + + wirkt wie: NOT yes (w, frage). + + +#ib#not empty#ie# +BOOL PROC not empty (THESAURUS CONST thes): + +Zweck: Dient der Prüfung, ob ein Thesaurus Namen enthält oder nicht. Die + Prozedur liefert TRUE, wenn Namen in 'thes' enthalten sind, sonst FALSE. + + +#ib#oberbegriff#ie# +PROC oberbegriff (TEXT CONST punktname, + startprocname, + leaveprocname): + +Zweck: Der Befehl wird bei der Generierung von Menukarten benötigt. Mit diesem + Befehl wird die Bezeichnung 'punktname' in die Kopfzeile des aktuell + geöffneten Menus eingetragen. Die in 'startprocname' übergebene Proze­ + dur wird ausgeführt, bevor das zugehörige Pull-Down-Menu auf dem + Bildschirm "ausgeklappt" wird; die in 'leaveprocname' übergebene Pro­ + zedur, wenn in ein anderes Pull-Down-Menu gewechselt wird (beachten + Sie, daß die Prozedurnamen als Texte(!) übergeben werden). +Fehler: Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt). + Menu noch nicht geöffnet ('oeffne menu' fehlt). + Zu viele Oberbegriffe im Menu (> 10). + Die Kopfzeile ist zu lang (> 70 Zeichen). + + +PROC oberbegriff (TEXT CONST punktname): + + wirkt wie: oberbegriff (punktname, "", "") + + +#ib#oeffne menu#ie# +PROC oeffne menu (TEXT CONST menuname, + einstiegsproc, + ausstiegsproc, infotext1, + infotext2, infotext3): + +Zweck: Der Befehl wird für die Generierung von Menukarten benötigt. Durch den + Befehl wird innerhalb der Menukarte ein Menu mit dem Namen + 'menuname' angelegt. Über diesen Namen kann das Menu auch später + angesprochen werden (mit 'handle menu'). Die unter 'einstiegsproc' + übergebene Prozedur wird bei der Aktivierung des Menus ausgeführt, die + unter 'ausstiegsproc' übergebene Prozedur, wenn das Menu (mit + ) verlassen wird (beachten Sie, daß die Prozedurnamen als + Texte(!) übergeben werden!). In 'infotext1', 'infotext2' und 'infotext3' + können Hinweise eingetragen werden, die bei Erscheinen des Menus auf + dem Bildschirm für kurze Zeit in einer Box rechts unten angezeigt wer­ + den. Die Erstellung der Boxtexte ist an genaue Regeln gebunden (sehen + Sie dazu Kap. 5.13). Sehen Sie auch bei 'schliesse menu'. + + +PROC oeffne menu (TEXT CONST menuname, + einstiegsproc, + ausstiegsproc): + + wirkt wie: oeffne menu (menuname, einstiegsproc, + ausstiegsproc, "", "", "") + + +PROC oeffne menu (TEXT CONST menuname): + + wirkt wie: oeffne menu (menuname, "", "") + + +#ib#oeffne menukarte#ie# +PROC oeffne menukarte (TEXT CONST menukartenname): + +Zweck: Der Befehl wird bei der Generierung von Menukarten benötigt. Ein Pro­ + gramm zur Erstellung einer Menukarte muß immer mit diesem Befehl + beginnen. Durch den Befehl wird ein Datenraum mit dem Namen + 'gs-MENUKARTE:menukartenname' eingerichtet; der Wortbestandteil + 'gs-MENUKARTE:' wird dabei automatisch vor den angegebenen Namen + gesetzt (sehen Sie auch 'schliesse menukarte'). +Fehler: Eine Menukarte mit dem angegebenen Namen existiert bereits in der + Task. Bei der Generierung wird dann angefragt, ob die alte Menukarte + gelöscht werden darf. + + +#ib#ohne praefix#ie# +THESAURUS PROC ohne praefix (THESAURUS CONST thes, + TEXT CONST praefix): + +Zweck: Liefert in einem Thesaurus alle Namen aus dem übergebenen Thesaurus + 'thes', die mit dem Wortbestandteil 'praefix' beginnen. Bei den gelie­ + ferten Namen ist dieser führende Wortbestandteil entfernt. + + +#ib#old menufootnote#ie# +PROC old menufootnote: + +Zweck: Der aktuelle Text in der Fußzeile des aktuellen Menubildschirms wird + durch den hier zuletzt vom System gesetzten Text überschrieben. Die + Prozedur wird benutzt, um eine selbstgesetzte Fußnote (sehen Sie auch + 'write menunotice') zu löschen. + + +#ib#out#ie# +PROC out (WINDOW VAR w, TEXT CONST text): + +Zweck: Vergl. 'menuwindowout'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowout' automatisch gesetzt wird. + + +#ib#out frame#ie# +PROC out frame (WINDOW VAR fenster): + +Zweck: Um den durch 'fenster' angegebenen Bildschirmbereich wird ein Rahmen + gezogen. + + +#ib#out footnote#ie# +PROC out footnote (WINDOW VAR fenster, + TEXT CONST textzeile): + +Zweck: In der untersten Zeile des Fensters 'fenster' wird 'textzeile' ausgegeben, in + der vorletzten Zeile eine Trennzeile. Sehen Sie auch 'erase footnote'. + + +#ib#page#ie# +PROC page (WINDOW VAR fenster, + BOOL CONST mit rahmen): + +Zweck: Der durch 'fenster' beschriebene Fensterbereich wird gelöscht. Hat 'mit + rahmen' den Wert TRUE, wird der Rahmenbereich ebenfalls gelöscht. + + +PROC page (WINDOW VAR fenster): + + wirkt wie: page (fenster, FALSE). + + +#ib#put#ie# +PROC put (WINDOW VAR w, TEXT CONST text): + + wirkt wie: out (w, text + " ") + + +PROC put (WINDOW VAR w, INT CONST zahl): + + wirkt wie: put (w, text (zahl)) + + +PROC put (WINDOW VAR w, REAL CONST zahl): + + wirkt wie: put (w, text (zahl)) + + +#ib#putline#ie# +PROC putline (WINDOW VAR w, TEXT CONST text): + + wirkt wie: put (w, text); line (w) + + +#ib#regenerate menuscreen#ie# +PROC regenerate menuscreen: + +Zweck: Der Befehl wird verwendet, um den Menubildschirm (z.B. nach der + Nutzung für anwendungsbezogene Ausgaben) in seinem letzten Zustand + zu reproduzieren. Der Bildschirm wird gelöscht. Anschließend wird der + aktuelle Menubildschirm vollständig neu aufgebaut - auch bei geschach­ + telten Menus. (sehen Sie auch 'refresh submenu') + + +#ib#refresh submenu#ie# +PROC refresh submenu: + +Zweck: Der Befehl dient dazu, das aktuelle Pull-Down-Menu (z.B. nach Über­ + schreiben) und ggf. eine gesetzte Menunotiz erneut auf den Bildschirm zu + schreiben. Betroffen ist nur der Bereich zwischen den Trennlinien der + Kopf- und Fußzeile. Für das vorausgehende Löschen verwendeter Bild­ + schirmbereich ist der Programmierer verantwortlich. Im Gegensatz zu + 'regenerate menuscreen' findet hier kein kompletter Bildschirmaufbau + statt. Wenn möglich, dann ist dieser Befehl dem Befehl 'regenerate + menuscreen' wegen des geringeren Zeitaufwandes vorzuziehen. + + +#ib#remaining lines#ie# +INT PROC remaining lines (WINDOW VAR w): + +Zweck: Die Prozedur liefert die Anzahl der Zeilen im Fenster 'w', die noch + zwischen Cursor und unterer Fenstergrenze vorhanden sind. + + +#ib#remaining menuwindowlines#ie# +INT PROC remaining menuwindowlines + +Zweck: Die Prozedur liefert die Anzahl der Zeilen im aktuellen Menufenster, die + noch zwischen Cursor und unterer Fenstergrenze vorhanden sind. + + +#ib#reset dialog#ie# +PROC reset dialog: + +Zweck: Das Menusystem wird in den Anfangszustand versetzt. (Keine Menukarte + angekoppelt; Anzahl der geöffneten Menus: 0) + + +#ib#schliesse menu#ie# +PROC schliesse menu: + +Zweck: Der Befehl wird bei der Generierung von Menukarten benötigt. Durch den + Befehl wird ein Menu in einer Menukarte abgeschlossen (sehen Sie auch + 'oeffne menu') + + +#ib#schliesse menukarte#ie# +PROC schliesse menukarte + +Zweck: Der Befehl wird bei der Generierung von Menukarten benötigt. Durch den + Befehl wird eine Menukarte abgeschlossen (sehen Sie auch 'oeffne + menukarte') + + +#ib#senkrecht#ie# +TEXT PROC senkrecht: + + Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" als senkrechter + Strich (�) ausgegeben wird. + + +PROC senkrecht (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" als senkrechter Strich ausgegeben werden soll. + + +#ib#show#ie# +PROC show (WINDOW VAR fenster): + +Zweck: Das Fenster 'fenster' wird auf dem Bildschirm angezeigt (das Fenster + muß zuvor durch 'window' initialisiert worden sein). Um den angegebe­ + nen Fensterbereich wird automatisch ein Rahmen gezogen. Der Rahmen + gehört nicht zum Fenster dazu! (Soll das Fenster ohne Rahmen ausgege­ + ben werden, dann muß der Befehl 'page' verwendet werden.) Der Bereich + innerhalb des Rahmens (Fensterbereich) wird gelöscht. + + +#ib#show#ie# +PROC show (WINDOW VAR w, TEXT CONST dateiname): + +Zweck: Vergl. 'menuwindowshow'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowshow' automatisch gesetzt wird. + + +PROC show (WINDOW VAR w, FILE VAR f): + +Zweck: Vergl. 'menuwindowshow'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowshow' automatisch gesetzt wird. + + +#ib#show menuwindow#ie# +PROC show menuwindow: + +Zweck: Durch den Befehl 'show menuwindow' wird ein entsprechender Rahmen + innerhalb des Menubildschirms ausgegeben und der Bereich innerhalb + dieses Rahmens (das Fenster) gelöscht (sehen Sie auch 'menuwindow­ + page'). Innerhalb des Fensters können anschließend verschiedene Opera­ + tionen ausgeführt werden. Auf die Größe des Menufensters kann kein + Einfluß genommen werden - sie wird selbständig vom System gesetzt + ("normales" Menu: 77 Zeichen breit und 20 Zeichen hoch; geschachteltes + Menu 71 Zeichen breit und 16 Zeichen hoch). + + +#ib#stdinfoedit#ie# +PROC stdinfoedit (TEXT CONST dateiname):#u#(*)#e# +Zweck: Löscht den Bildschirm und bietet die Datei 'dateiname' in einem festge­ + legten zum Editieren an. In der Fußzeile wird die Information "Info: +   Verlassen: " angezeigt. Nach Tippen von + werden Editorinformationen in den Bildschirm einge­ + blendet. + + +PROC stdinfoedit (FILE VAR f):#u#(*)#e# +Zweck: Wie obige 'stdinfoedit'-Prozedur'. Die Datei 'f' muß mit der Verarbei­ + tungsart 'modify' assoziiert worden sein. + + +PROC stdinfoedit (TEXT CONST dateiname, + INT CONST oberste zeile):#u#(*)#e# +Zweck: Wie obige Prozedur (die wie 'stdwinfoedit (w, 1)' wirkt). Allerdings kön­ + nen bis zu zwei Zeilen oben auf dem Bildschirm unbenutzt bleiben (z.B. + um die Kopfzeile des Menus weiterhin anzuzeigen). 'oberste zeile' gibt an, + welche Bildschirmzeile die erste von dieser Prozedur benutzte ist + (1<= oberste zeile<=3). + + +PROC stdinfoedit (FILE VAR f, + INT CONST oberste zeile):#u#(*)#e# +Zweck: Wie obige 'stdinfoedit'-Prozedur'. Die Datei 'f' muß mit der Verarbei­ + tungsart 'modify' assoziiert worden sein. + + +#ib#stop#ie# +PROC stop (WINDOW VAR w, INT CONST zeilenzahl): + +Zweck: Vergl. 'menuwindowstop'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowstop' automatisch gesetzt wird. + + +PROC stop (WINDOW VAR w): + + wirkt wie: stop (w, 1). + + +#ib#testinstallation#ie# +PROC testinstallation (TEXT CONST menutafelname): + +Zweck: Die Menutafel mit dem Namen 'menutafelname' (muß mit dem + 'gs-MENUKARTE:' beginnen!) wird als aktuelle Menutafel an gs-DIALOG + gekoppelt. Durch den Befehl wird die angegebene Menutafel zur Task + 'gs-MENUAKRTEN' geschickt. Dem Namen wird zur Kennzeichnung noch + der Taskname der Sendertask angehängt (dadurch können sich bei + Multi-User-Betrieb verschiedene Anwender mit gleichen Menukarten­ + namen nicht stören). Die Menukarte wird anschließend in jedem Fall + "frisch" angekoppelt. Außerdem bleibt die Menukarte (als benannter + Datenraum) in der Task erhalten! + (Mit dem Befehl 'handle menu' kann nun ein Menu aus der Menukarte + zur Ausführung gebracht werden oder mit 'anwendungstext' auf in die + Menukarte ausgelagerte Texte zugegriffen werden.) + Hinweis: Von Zeit zu Zeit muß der Systembetreuer die überflüssigen + Menukarten aus der Task 'gs-MENUKARTEN' entfernen, da die Anwender + aus Ihrer Task die Karten nicht löschen können! +Fehler: 'menutafelname' gibt es nicht! + 'menutafelname' hat falsche(n) Typ/Bezeichnung (keine + gs-MENUKARTE)! + + +#ib#trennlinie#ie# +PROC trennlinie: + +Zweck: Der Befehl wird bei der Generierung von Menukarten benötigt. Durch den + Befehl wird unter dem aktuellen Oberbegriff eine Trennlinie zur opti­ + schen Trennung einzelner Menupunkte eingetragen. Die Trennlinie belegt + den gleichen Platz wie eine Verarbeitungsfunktion. +Fehler: Zu viele Menupunkte in einem Pull-Down-Menu (maximal 15 incl. der + Trennlinien!). + + +#ib#textprozedur#ie# +PROC textprozedur (TEXT CONST dateiname, + prozedurname): + +Zweck: Der Befehl wird benötigt, um Texte entsprechend der gs-DIALOG-Syntax + aufzuarbeiten. Der in die Datei 'dateiname' geschrieben Text wird bear­ + beitet. Die Prozedur eignet sich insbesondere dafür, Informationstexte + aufzuarbeiten, die zu den einzelnen Menufunktionen ausgegeben werden, + wenn der Benutzer die Tastenfolge tippt (sehen Sie auch + 'textzeile'). Der aufbereitete Text steht anschließend in der Datei 'datei­ + name.a'. Der Text ist in eine Textprozedur "verpackt", die den Namen hat, + der als zweiter Parameter übergeben wird. + Die Zeilen werden dabei so zugeschnitten, daß Sie in einer Box in das + aktuelle Menu eingeblendet werden können. Boxbreite und -höhe werden + automatisch gesetzt (max. 65 Zeichen breit und 14 Zeichen hoch)); die + Zeilen werden geblockt, sofern in der Datei keine Absatzmarkierung + () am Ende der Zeile vorhanden ist. Soll eine Zeile zentriert + werden, so muß als erstes Zeichen der Zeile das Zeichen '%' notiert sein - + die Zeile muß durch eine Absatzmarke abgeschlossen sein. Textpassagen, + die invers (markiert) dargestellt werden sollen, müssen duch das Zeichen + '$' eingeleitet und durch das Zeichen '&' abgeschlossen werden. Markier­ + te Textpassagen dürfen (nach dem Zuschnitt!) nicht über Zeilengrenzen + hinausgehen! +Fehler: Datei 'dateiname' existiert nicht! + Fonttabelle 'fonttab.gs-Menu-Generator' existiert nicht! (Fonttabelle von + gs-Menu-Generator-Diskette in die Task 'configurator' laden!) + Text ist zu lang - bitte kürzen! (Text darf in aufbereiteter Form maximal + 14 Zeilen umfassen!) + Zeilenformatierung mit abgebrochen! + + + +#ib#textzeile#ie# +PROC textzeile (TEXT CONST dateiname): + +Zweck: Der Befehl wird benötigt, um Texte entsprechend der gs-DIALOG-Syntax + aufzuarbeiten. Der in die Datei 'dateiname' geschrieben Text wird bear­ + beitet. Die Prozedur eignet sich insbesondere dafür, anwendungsbezogene + Texte aufzuarbeiten, die in die Menukarte ausgelagert werden sollen + (sehen Sie auch 'textprozedur'). Der aufbereitete Text steht anschließend + in der Datei 'dateiname.a' in einer Zeile notiert. + + +#ib#waagerecht#ie# +TEXT PROC waagerecht: + +Zweck: Liefert das Zeichen, das bei der Darstellung der "Kästen" als waagerechter + Strich (̇) ausgegeben wird. + + +PROC waagerecht (TEXT CONST zeichen): + +Zweck: Durch diese Prozedur kann das Zeichen festgelegt werden, das bei Dar­ + stellung der "Kästen" als waagerechter Strich ausgegeben werden soll. + + +#ib#window#ie# +WINDOW PROC window (INT CONST x, y, xsize, ysize): + +Zweck: Einer Fenstervariablen (WINDOW VAR name) wird die Lage und Größe + zugeordnet (über den Zuweisungsoperator ':='). Gleichzeitig wird das + Fenster initialisiert. + Mit den ersten beiden Parametern wird die Lage der linken oberen Ecke + des Fensters bestimmt (x: Spalte; y: Zeile). Mit 'xsize' wird die Fenster­ + breite, mit 'ysize' die Fensterhöhe festgelegt. + Das Fenster wird noch nicht(!) angezeigt (sehen Sie dazu 'show' und + 'page'). Ein Rahmen wird nicht zum Fenster gezählt; er kann aber mit + der Prozedur 'show' ausgegeben werden. Ein Fenster darf nicht breiter als + 80 und höher als 24 Zeichen sein. Umrahmte Fenster unterliegen weite­ + ren Einschränkungen (sehen Sie auch 'show'). Ein Fenster muß min­ + destens 6 Zeichen breit und 3 Zeichen hoch sein. +Fehler: 'Window' ungültig + + +#ib#write menunotice#ie# +PROC write menunotice (TEXT CONST notiztext, + INT CONST position): + +Zweck: Die Prozedur dient dazu, innerhalb des Menus in einer Box einen "dauer­ + haften Informationstext" auszugeben. Die Box bleibt nämlich so lange + bestehen, bis sie explizit gelöscht (sehen Sie auch 'erase menunotice') + oder durch einen neuen Notiztext überschrieben wird. Wenn der Bild­ + schirm durch gs-DIALOG-Prozeduren überschrieben wird, wird die + Menunotiz ebenfalls ständig mitaufgefrischt und auch, wenn der Befehl + 'regenerate menuscreen' oder 'refresh submenu' gegeben wird (Sehen Sie + im Gegensatz dazu auch 'menuinfo' ("kurzzeitiger Informationstext"). + Im Menubildschirm erscheint der 'infotext' in einer Box. Boxbreite und + -höhe werden vom System automatisch anhand des übergebenen 'notiz­ + text'es festgelegt. 'notiztext' muß den gs-DIALOG-Syntax-Regeln (sehen Sie + Kap. 5.13) entsprechen. Mit 'position' wird die relative Lage der Box + innerhalb des Menubildschirms festgelegt (1, 2, 3, 4, 5: sehen Sie dazu + Kap. 5.12). In einem Menu kann zu einem Zeitpunkt nur eine Menunotiz + abgelegt werden. Durch ein erneutes 'write menunotice' wir eine beste­ + hende Menunotiz überschrieben. + + +#ib#yes#ie# +BOOL PROC yes (WINDOW VAR w, TEXT CONST frage): + +Zweck: Vergl. 'menuwindowyes'. Hier wird nur zusätzlich das Fenster festgelegt, + das bei 'menuwindowyes' automatisch gesetzt wird. + + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.impressum b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.impressum new file mode 100644 index 0000000..404826d --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.impressum @@ -0,0 +1,88 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#ls Menü-Generator + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# + +#free (4.0)##on("b")# +#center#gs-Menu-Generator + + +#center#Benutzerhandbuch + + +#center#Version 1.0 + + +#off("b")##center#copyright +#center#Eva Latta-Weber +#center#Software- und Hardware-Systeme, 1988 +#center#ERGOS GmbH, 1990 +#page# +#block# +#center#____________________________________________________________________________ + + +Copyright:  ERGOS GmbH   März 1990 + + Alle Rechte vorbehalten. Insbesondere ist die Überführung in + maschinenlesbare Form sowie das Speichern in Informations­ + systemen, auch auszugsweise, nur mit schriftlicher Einwilligung + der ERGOS GmbH gestattet. + + +#center#____________________________________________________________________________ + +Es kann keine Gewähr übernommen werden, daß das Programm für eine +bestimmte Anwendung geeignet ist. Die Verantwortung dafür liegt beim +Anwender. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrektheit und +Vollständigkeit der Angaben kann keine Gewähr übernommen werden. Das +Handbuch kann jederzeit ohne Ankündigung geändert werden. + +Texterstellung :  Dieser Text wurde mit der ERGOS-L3 Textverarbeitung + erstellt und aufbereitet und auf einem Kyocera Laser­ + drucker gedruckt. + + + + +#center#___________________________________________________________________________ + + + +Ergonomic Office Software GmbH + +Bergstr. 7 Telefon: (02241) 63075 +5200 Siegburg Teletex: 2627-2241413=ERGOS + Telefax: (02241) 63078 + + +#center#____________________________________________________________________________ + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.index b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.index new file mode 100644 index 0000000..0aacd97 --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.index @@ -0,0 +1,258 @@ +#block##pageblock# +#pagenr("%",1)##setcount(1)##count per page# +#headeven# +gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#headodd# +#right#gs-Menu-Generator +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +I - % #right#ERGOS +#end# +#bottomodd# +#center#____________________________________________________________ +ERGOS #right# I - % +#end# +Index + + +activate 5 - 28 +activate 8 - 1 +anwendungstext 4 - 13 +anwendungstext 8 - 2 +areax 8 - 2 +areaxsize 8 - 2 +areay 8 - 2 +areaysize 8 - 2 +balken links 8 - 2 +balken oben 8 - 3 +balken rechts 8 - 3 +balken unten 8 - 3 +boxalternative 8 - 4 +boxalternative 7 - 10 +boxanswer 8 - 4 +boxanswer 7 - 9 +boxanswerone 8 - 4 +boxanswerone 7 - 10 +boxanswersome 8 - 5 +boxanswersome 7 - 10 +boxinfo 8 - 5 +boxinfo 7 - 9 +boxno 8 - 5 +boxno 7 - 10 +boxnotice 8 - 6 +boxnotice 7 - 10 +boxone 8 - 6 +boxone 7 - 10 +boxsome 8 - 6 +boxsome 7 - 10 +boxyes 8 - 7 +boxyes 7 - 10 +center 8 - 7 +center 7 - 8 +clear buffer 8 - 7 +clear buffer and count 8 - 7 +current menuwindow 8 - 8 +cursor 8 - 8 +cursor 7 - 6 +cursor off 8 - 8 +cursor off 5 - 6 +cursor off 5 - 2 +cursor on 8 - 8 +cursor on 5 - 6 +cursor on 5 - 2 +deactivate 8 - 9 +deactivate 5 - 28 +direktstart 8 - 9 +ecke oben links 8 - 10 +ecke oben rechts 8 - 10 +ecke unten links 8 - 10 +ecke unten rechts 8 - 10 +edit 8 - 11 +edit 7 - 6 +editget 8 - 11 +erase 7 - 5 +erase 8 - 11 +erase footnote 8 - 12 +erase footnote 7 - 11 +erase menunotice 8 - 12 +erasemenunotice 5 - 15 +get 8 - 12 +get 7 - 7 +get cursor 8 - 13 +get cursor 7 - 6 +getline 7 - 7 +getline 8 - 13 +get menuwindowcursor 5 - 21 +get menuwindowcursor 8 - 13 +handle menu 3 - 2 +handle menu 8 - 13 +infix namen 8 - 14 +infix namen 5 - 26 +install menu 3 - 2 +install menu 4 - 3 +install menu 8 - 14 +invers 8 - 15 +kreuz 8 - 15 +line 8 - 15 +line 7 - 6 +menualternative 8 - 15 +menualternative 5 - 12 +menuanswer 8 - 17 +menuanswer 5 - 2 +menuanswerone 8 - 17 +menuanswerone 5 - 8 +menuanswersome 5 - 8 +menuanswersome 8 - 18 +menu archiv checken 8 - 18 +menu archiv checken 6 - 4 +menu archiv grundeinstellung 6 - 4 +menu archiv grundeinstellung 8 - 18 +menu archiv holen 8 - 19 +menu archiv holen 6 - 4 +menu archiv initialisieren 8 - 19 +menu archiv initialisieren 6 - 4 +menu archiv loeschen 8 - 19 +menu archiv loeschen 6 - 4 +menu archiv neue diskette 8 - 19 +menu archiv neue diskette 6 - 4 +menu archiv reservieren 6 - 4 +menu archiv reservieren 8 - 19 +menu archiv reservierung aufgeben 6 - 4 +menu archiv reservierung aufgeben 8 - 19 +menu archiv schreibcheck 8 - 20 +menu archiv schreibcheck 6 - 4 +menu archiv schreiben 6 - 4 +menu archiv schreiben 8 - 20 +menu archiv verzeichnis 8 - 20 +menu archiv verzeichnis 6 - 4 +menu archiv verzeichnis drucken 6 - 4 +menu archiv verzeichnis drucken 8 - 20 +menu archiv zieltask einstellen 6 - 4 +menu archiv zieltask einstellen 8 - 20 +menu dateien aufraeumen 8 - 21 +menu dateien aufraeumen 6 - 6 +menu dateien drucken 6 - 6 +menu dateien drucken 8 - 21 +menu dateien kopieren 6 - 6 +menu dateien kopieren 8 - 22 +menu dateien loeschen 8 - 22 +menu dateien loeschen 6 - 6 +menu dateien speicherplatz 6 - 6 +menu dateien speicherplatz 8 - 22 +menu dateien umbenennen 8 - 23 +menu dateien umbenennen 6 - 6 +menu dateien verzeichnis 6 - 6 +menu dateien verzeichnis 8 - 23 +menufootnote 5 - 17 +menufootnote 8 - 23 +menufunktion 4 - 6 +menufunktion 8 - 24 +menuinfo 5 - 4 +menuinfo 8 - 24 +menukartenname 8 - 25 +menuno 8 - 25 +menuno 5 - 10 +menuone 5 - 6 +menuone 8 - 25 +menusome 5 - 7 +menusome 8 - 26 +menuwindowcenter 8 - 26 +menuwindowcenter 5 - 23 +menuwindowcursor 5 - 21 +menuwindowcursor 8 - 27 +menuwindowedit 8 - 27 +menuwindowedit 5 - 19 +menuwindoweditget 8 - 27 +menuwindoweditget 5 - 22 +menuwindowget 8 - 28 +menuwindowget 5 - 22 +menuwindowline 8 - 28 +menuwindowline 5 - 21 +menuwindowno 5 - 22 +menuwindowout 5 - 22 +menuwindowout 8 - 28 +menuwindowpage 8 - 29 +menuwindowpage 5 - 20 +menuwindowshow 5 - 19 +menuwindowshow 8 - 29 +menuwindowstop 5 - 23 +menuwindowstop 8 - 29 +menuwindowyes 5 - 22 +menuyes 5 - 10 +menuyes 8 - 30 +no 8 - 30 +no 7 - 7 +not empty 5 - 27 +not empty 8 - 30 +oberbegriff 8 - 31 +oberbegriff 4 - 5 +oeffne menu 8 - 31 +oeffne menu 4 - 3 +oeffne menukarte 8 - 32 +oeffne menukarte 4 - 3 +ohne praefix 5 - 26 +ohne praefix 8 - 32 +oldmenufootnote 5 - 17 +old menufootnote 8 - 32 +out 7 - 7 +out 8 - 33 +out footnote 7 - 11 +out footnote 8 - 33 +out frame 8 - 33 +out frame 7 - 5 +page 8 - 33 +page 7 - 11 +page 7 - 5 +page up 7 - 11 +put 8 - 33 +put 7 - 7 +putline 8 - 34 +putline 7 - 7 +refresh submenu 5 - 18 +refresh submenu 8 - 34 +regenerate menuscreen 8 - 34 +regenerate menuscreen 5 - 18 +regenerate menuscreen 5 - 4 +remaining lines 8 - 34 +remaining lines 7 - 6 +remaining menuwindowlines 5 - 21 +remaining menuwindowlines 8 - 34 +reset dialog 8 - 35 +schliesse menu 4 - 3 +schliesse menu 8 - 35 +schliesse menukarte 8 - 35 +schliesse menukarte 4 - 3 +senkrecht 8 - 35 +show 8 - 35 +show 7 - 5 +show 8 - 36 +show 7 - 6 +show menuwindow 8 - 36 +show menuwindow 5 - 20 +stdinfoedit 8 - 36 +stop 7 - 8 +stop 8 - 37 +testinstallation 8 - 37 +testinstallation 4 - 3 +textprozedur 4 - 8 +textprozedur 8 - 38 +text zeile 4 - 13 +textzeile 8 - 39 +trennlinie 4 - 6 +trennlinie 8 - 38 +waagerecht 8 - 39 +WINDOW 7 - 2 +window 7 - 4 +window 8 - 40 +write menunotice 8 - 40 +write menunotice 5 - 15 +yes 7 - 7 +yes 8 - 41 + + diff --git a/app/gs.menugenerator/1.0/doc/menu-generator handbuch.inhalt b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.inhalt new file mode 100644 index 0000000..8b1aef4 --- /dev/null +++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.inhalt @@ -0,0 +1,72 @@ +#type ("elite.lq")##limit (11.5)##pagelength (16.5)##pageblock# +#start (1.8,0.0)# +#type ("prop.breit.lq")# +Inhaltsverzeichnis +#type ("elite.lq")# + + +1 Was kann ls-Menu-Generator 3 + +2 Installation von ls-Menu-Generator 6 +2. 1 Voraussetzungen 6 +2. 2 Lieferumfang 6 +2. 3 Installation 7 + +3 Die Arbeitsweise von ls-DIALOG 8 +3. 1 Ankoppeln einer Menukarte/ 8 + Ausführen eines Menus +3. 2 Aufbau/Inhalt einer Menukarte 11 + +4. Erstellen einer neuen Menukarte 13 +4. 1 Eintragen der Menupunkte 13 +4. 2 Erstellung und Einbinden von 20 + Informationstexten +4. 3 Auslagerung von anwendungsbezogenen 24 + Texten in die Menukarte + +5. Dialoge innerhalb des Menus 27 +5. 1 Eingabe eines Textes/Namens 28 +5. 2 Ausgabe einer Information 31 +5. 3 Auswahl eines Namen durch Ankreuzen 32 +5. 4 Auswahl mehrerer Namen durch Ankreuzen 34 +5. 5 Eingabe eines Textes/Namens - alternativ: 35 + Auswahl durch Ankreuzen +5. 6 Die Ja/Nein - Entscheidung 37 +5. 7 Die Alternativentscheidung 39 +5. 8 Die Menunotiz 43 +5. 9 Fußzeilen im Menu 44 +5.10 Wiederherstellung des Menubildschirms 46 +5.11 Arbeiten im Menufenster 47 +5.11.1 Datei anzeigen/editieren 48 +5.11.2 Menufenster öffnen/anzeigen 48 +5.11.3 Menufenster löschen(putzen) 49 +5.11.4 Positionierungen im Menufenster 49 +5.11.5 Informationen über die aktuelle 50 + Menu-Fensterposition +5.11.6 Aus-/Eingabe innerhalb des Menufensters 51 +5.11.7 Weitere Prozeduren 52 +5.12 Festlegung der Boxpositionen innerhalb 53 + des Menus +5.13 ls-DIALOG-Syntax 54 + (Regeln zur Erstellung von Texten) +5.14 Thesaurushandling 55 +5.15 Aktivieren/Deaktivieren von Menupunkten 57 + +6. Einbinden der Datei- und Archivoperationen 59 +6. 1 Einbinden der Archivoperationen 60 +6. 2 Einbinden der Dateioperationen 65 + +7. Eigene Fenster und Fensteroperationen 66 +7. 1 Definition von Fenstern 67 +7. 2 Anzeigen/Löschen von Fenstern 70 +7. 3 Operationen innerhalb des Fensters 71 +7. 3.1 Datei anzeigen/editieren 71 +7. 3.2 Positionierungen im Fenster 72 +7. 3.3 Ein- und Ausgaben innerhalb des Fensters 73 +7. 3.4 Weitere Prozeduren 74 +7. 4 Boxoperationen 75 + +8. Kurzbeschreibung der Befehle 78 + +9. Register 125 + diff --git a/app/gs.menugenerator/1.0/source-disk b/app/gs.menugenerator/1.0/source-disk new file mode 100644 index 0000000..f02e499 --- /dev/null +++ b/app/gs.menugenerator/1.0/source-disk @@ -0,0 +1 @@ +informatikpaket/06_gs.menugenerator.img diff --git a/app/gs.menugenerator/1.0/src/Generatordatei: Archivmenu b/app/gs.menugenerator/1.0/src/Generatordatei: Archivmenu new file mode 100644 index 0000000..76393fc --- /dev/null +++ b/app/gs.menugenerator/1.0/src/Generatordatei: Archivmenu @@ -0,0 +1,323 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-ARCHIV- ** + ** MENUTAFEL-GENERATOR ** + ** Version 1.0 ** + ** ** + ** (Stand: 30.03.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +TEXT PROC dateiverzeichnistext: + " "15" Verzeichnis der vorhandenen Dateien "14""13""13"" + + " Eine Liste der vorhandenen Dateien wird auf dem "13"" + + " Bildschirm ausgegeben. "13""13"" + + " Da die Liste selbst eine Datei ist, kann man sie "13"" + + " mit der Tastenfolge verlassen - das "13"" + + " wird auch in der Kopfzeile angezeigt. "13""13"" + + " Innerhalb der Liste kann man sich wie in einer "13"" + + " Datei bewegen - nicht aber schreiben." +END PROC dateiverzeichnistext; + +TEXT PROC dateiloeschentext: + " "15" Dateien löschen "14" "13""13"" + + " Alle vorhandenen Dateien werden zur Auswahl angebo- "13"" + + " ten. Anschließend werden die angekreuzten Dateien in "13"" + + " der Reihenfolge, in der sie angekreuzt wurden, ge- "13"" + + " löscht. "13""13"" + + " Zur Sicherheit muß noch einmal für jede einzelne Da- "13"" + + " tei bestätigt werden, daß sie auch tatsächlich ge- "13"" + + " löscht werden soll!" +END PROC dateiloeschentext; + +TEXT PROC dateidruckentext: + " "15" Dateien drucken "14" "13""13"" + + " Alle vorhandenen Dateien werden zur Auswahl angebo- "13"" + + " ten. Anschließend werden die angekreuzten Dateien "13"" + + " in der Reihenfolge, in der sie angekreuzt wurden, "13"" + + " zum Drucker geschickt. "13""13"" + + " Der Vorgang wird auf dem Bildschirm protokolliert." +END PROC dateidruckentext; + +TEXT PROC dateikopierentext: + " "15" Datei kopieren "14" "13""13"" + + " Der Dateiname der Datei, die kopiert werden soll, wird er- "13"" + + " fragt. Hier kann direkt ein Name eingegeben werden. Mit der "13"" + + " Tastenfolge kann man sich auch die vorhandenen Da- "13"" + + " teien zur Auswahl anbieten lassen und hier einen Namen an- "13"" + + " kreuzen. Anschließend wird der Name für die Kopie erfragt. "13""13"" + + " Es muß ein Name eingetragen werden, der noch nicht für eine "13"" + + " Datei vergeben wurde - ansonsten erfolgt ein Hinweis da- "13"" + + " rauf und es wird nicht kopiert! "13"" + + " Da man aber oft für die Kopie einen ähnlichen Namen wie für "13"" + + " das Original wählt, wird der 'alte' Name vorgeschlagen. Aus "13"" + + " genannten Gründen muß er aber verändert werden." +END PROC dateikopierentext; + +TEXT PROC dateiumbenennentext: + " "15" Datei umbenennen "14" "13""13"" + + " Der Dateiname der Datei, die umbenannt werden soll, wird er- "13"" + + " fragt. Hier kann direkt ein Name eingegeben werden. Mit der "13"" + + " Tastenfolge kann man sich auch die vorhandenen Da- "13"" + + " teien zur Auswahl anbieten lassen und dort einen Namen an- "13"" + + " kreuzen. Anschließend wird der zukünftige Dateiname erfragt. "13""13"" + + " Es muß ein Name eingetragen werden, der noch nicht für eine "13"" + + " Datei vergeben wurde - ansonsten erfolgt ein Hinweis und es "13"" + + " wird nicht umbenannt! "13"" + + " Da man aber oft den 'neuen' Namen in Anlehnung an den 'alten' "13"" + + " Namen wählt, wird der 'alte' Name vorgeschlagen. Aus genann- "13"" + + " ten Gründen muß er aber verändert werden." +END PROC dateiumbenennentext; + +TEXT PROC dateispeicherplatztext: + " "15" Datei-Speicherplatz ermitteln "14" "13""13"" + + " Der Dateiname der Datei, deren Speicherplatz ermittelt "13"" + + " werden soll, wird erfragt. Hier kann direkt ein Name "13"" + + " eingegeben werden. Mit der Tastenfolge kann "13"" + + " man sich auch die vorhandenen Dateien zur Auswahl an- "13"" + + " bieten lassen und dort Namen ankreuzen. "13""13"" + + " Der belegte Speicherplatz der ausgewählten Datei(en) "13"" + + " wird ermittelt und auf dem Bildschirm angezeigt." +END PROC dateispeicherplatztext; + +TEXT PROC dateiaufraeumtext: + " "15" Dateien aufräumen (reorganisieren) "14" "13""13"" + + " Der Dateiname der Datei, die aufgeräumt (reorganisiert) "13"" + + " werden soll, wird erfragt. Hier kann direkt ein Name "13"" + + " eingegeben werden. Mit der Tastenfolge kann man "13"" + + " sich auch die vorhandenen Dateien zur Auswahl anbieten "13"" + + " lassen und dort Namen ankreuzen. "13""13"" + + " Anschließend werden die ausgewählten Dateien aufgeräumt, "13"" + + " d.h. die interne Verwaltung der Datei wird optimiert. "13"" + + " Das führt zumeist dazu, daß die Datei anschließend weni- "13"" + + " ger Speicherplatz belegt als zuvor. "13""13"" + + " "15"Achtung! "14" Die Operation ist zeitaufwendig!!!" +END PROC dateiaufraeumtext; + + +(*------------------------------------------------------------------------*) + + + +TEXT PROC archivreserviertext: + " "15"Reservieren (des Archivlaufwerks) "14" "13""13"" + + " Das System versucht, auf das Archiv zuzugreifen. Ist das Archiv "13"" + + " von keiner anderen Task benutzt, dann wird die Frage gestellt, ob "13"" + + " die Diskette eingelegt ist. Erst zu diesem Zeitpunkt ist sicher- "13"" + + " gestellt, daß keine andere Task auf das Archiv zugreifen kann!"13""13"" + + " Nach Bejahen der gestellten Frage ermittelt das System selbstän- "13"" + + " dig den Namen der eingelegten Diskette, zeigt den Namen auf dem "13"" + + " Bildschirm an und aktiviert die anderen Menupunkte des Pull-Down- "13"" + + " Menus. "13""13"" + + " Beim Verlassen des Pull-Down-Menus oder wenn eine andere Zieltask "13"" + + " eingestellt wird, wird die Reservierung automatisch aufgehoben!" +END PROC archivreserviertext; + +TEXT PROC neuediskettetext: + " "15"Neue Diskette (anmelden) "14" "13""13"" + + " Der Datenaustausch mit einer Diskette ist nur dann möglich, wenn "13"" + + " der im System eingestellte Diskettenname (auf dem Bildschirm "13"" + + " sichtbar) mit dem tatsächlichen Namen der Diskette übereinstimmt. "13""13"" + + " Nach einem Diskettenwechsel ist das aber zumeist nicht mehr der "13"" + + " Fall. Nach Aktivieren dieses Menupunktes wird der Name der ein- "13"" + + " gelegten Diskette ermittelt, im System eingestellt und angezeigt. "13""13"" + + " Im Gegensatz zum Menupunkt 'Reservieren' greift das System ohne "13"" + + " Anfrage an den Benutzer auf das Archiv zu (die Reservierung "13"" + + " bleibt ja bestehen)." +END PROC neue diskettetext; + +TEXT PROC archivschreibtext: + " "15"Schreiben (Kopieren) "14" "13""13"" + + " Alle Dateien der eigenen Task werden zur Auswahl angeboten. An- "13"" + + " schließend werden Kopien der angekreuzten Dateien in der Reihen- "13"" + + " folge ihres Ankreuzens in die eingestellte Zieltask geschickt. "13"" + + " Der Vorgang wird auf dem Bildschirm protokolliert. "13""13"" + + " Sind in der Zieltask schon Dateien mit gleichem Namen vorhanden, "13"" + + " so wird erfragt, ob diese dort gelöscht werden sollen. "13""13"" + + " Normalerweise ist als Zieltask das Archiv der eigenen Station "13"" + + " eingestellt. Mit dem Menupunkt 'Zieltask einstellen' kann diese "13"" + + " Einstellung verändert werden." +END PROC archivschreibtext; + +TEXT PROC archivchecktext: + " "15"Checken (Prüfen) "14" "13""13"" + + " Alle Dateien der eingestellten Zieltask (des Archivs) wer- "13"" + + " den zur Auswahl angeboten. Anschließend werden die ange- "13"" + + " kreuzten Dateien in der Reihenfolge ihres Ankreuzens 'ge- "13"" + + " checkt', d.h. daraufhin untersucht, ob sie ohne Fehler ge- "13"" + + " lesen werden können. Der Vorgang wird auf dem Bildschirm "13"" + + " protokolliert. "13""13"" + + " Dieser Menupunkt kann nur ausgeführt werden, wenn der Da- "13"" + + " teiaustausch mit einem Archiv(manager) erfolgt." +END PROC archivchecktext; + +TEXT PROC archivkombinationstext: + " "15"Kombination "14" "13""13"" + + " Dieser Menupunkt wirkt wie eine Kombination der Menupunkte "13"" + + " 'Schreiben' und 'Checken' (Weitere Informationen dort). "13""13"" + + " Alle Dateien der eigenen Task werden zur Auswahl angeboten. "13"" + + " Die angekreuzten Dateien werden in der Reihenfolge ihres An- "13"" + + " kreuzens in die eingestellte Zieltask kopiert. Anschließend "13"" + + " werden alle Dateien, die gerade geschrieben wurden, gecheckt, "13"" + + " d.h. auf Lesefehler hin untersucht. Beide Vorgänge werden auf "13"" + + " dem Bildschirm protokolliert. "13""13"" + + " Dieser Menupunkt kann nur ausgeführt werden, wenn der Datei- "13"" + + " austausch mit einem Archiv(manager) erfolgt. " +END PROC archivkombinationstext; + + +TEXT PROC archivholtext: + " "15"Holen / Lesen "14" "13""13"" + + " Alle Dateien der eingestellten Zieltask werden zur Auswahl ange- "13"" + + " boten. Anschließend werden Kopien der angekreuzten Dateien in der "13"" + + " Reihenfolge des Ankreuzens in die eigene Task kopiert. Der Vor- "13"" + + " gang wird auf dem Bildschirm protokolliert. "13""13"" + + " Sind in der eigenen Task schon Dateien mit gleichem Namen vorhan- "13"" + + " den, so wird gefragt, ob die 'alten' Dateien überschrieben (ge- "13"" + + " löscht) werden dürfen. "13""13"" + + " Normalerweise werden die Dateien vom Archiv der eigenen Station "13"" + + " geholt. Mit dem Menupunkt 'Zieltask einstellen' kann diese Ein- "13"" + + " stellung verändert werden." +END PROC archivholtext; + + +TEXT PROC archivloeschtext: + " "15"Löschen "14" "13""13"" + + " Alle Dateien der eingestellten Zieltask werden zur Auswahl "13"" + + " angeboten. Anschließend werden die angekreuzten Dateien in "13"" + + " der Reihenfolge ihres Ankreuzens gelöscht. Zur Sicherheit "13"" + + " muß noch einmal für jede einzelne Datei bestätigt werden, "13"" + + " daß sie auch tatsächlich gelöscht werden soll. "13""13"" + + " Normalerweise ist als Zieltask das Archiv der eigenen Sta- "13"" + + " tion eingestellt. Mit dem Menupunkt 'Zieltask einstellen' "13"" + + " kann diese Einstellung verändert werden." +END PROC archivloeschtext; + +TEXT PROC archivverzeichnistext: + " "15"Verzeichnis "14" "13""13"" + + " Eine Liste aller Dateien, die in der Zieltask vorhanden "13"" + + " sind, wird auf dem Bildschirm ausgegeben. Ist die Ziel- "13"" + + " task ein Archiv (manager), so wird auch angezeigt, wie- "13"" + + " viel Platz auf der Diskette belegt ist. "13""13"" + + " Da die Liste selbt eine Datei ist, kann man sie mit der "13"" + + " Tastenfolge verlassen. Innerhalb der Liste "13"" + + " kann man sich wie im Editor bewegen." +END PROC archivverzeichnistext; + +TEXT PROC archivdruckentext: + " "15"Drucken "14" "13""13"" + + " Zur Sicherheit fragt das System an, ob ein Datei- "13"" + + " verzeichnis der Zieltask gedruckt werden soll. Be- "13"" + + " jaht man diese Frage, so wird ein Dateiverzeichnis "13"" + + " erstellt und zum Drucker geschickt." +END PROC archivdruckentext; + +TEXT PROC archivinitialisiertext: + " "15"Initialisieren (Vollständiges Löschen) "14" "13""13"" + + " Zunächst erfragt das System, ob die Diskette auch formatiert wer- "13"" + + " den soll. Bejaht man die Frage, so werden mehrere Formate zur "13"" + + " Auswahl angeboten - anschließend wird die Diskette formatiert "13"" + + " (wobei alle Inhalte "15"gelöscht "14" werden). Das Formatieren ist not-"13"" + + " wendig, wenn man eine 'frische' Diskette verwendet. "13""13"" + + " In jedem Fall wird dann angefragt, ob die Diskette initialisiert "13"" + + " bzw. überschrieben werden soll (je nachdem, ob die Diskette schon "13"" + + " benutzt wurde oder nicht). Nach Bejahen der gestellten Frage wird "13"" + + " der Name der Diskette erfragt. Bei der Initialisierung erhält die "13"" + + " Diskette einen (neuen) Namen und wird "15"vollständig gelöscht."14" "13"" +END PROC archivinitialisiertext; + +TEXT PROC archivzieltasktext: + " "15"Zieltask einstellen "14" "13""13"" + + " Das System bietet die Alternativen 'Archiv'-'Vatertask'-'PUBLIC' "13"" + + " und 'Sonstige' zur Auswahl an. Bei der Wahl einer der ersten drei "13"" + + " Möglichkeiten nimmt das System die vollständige Einstellung vor, "13"" + + " zeigt den Namen der eingestellten Zieltask an und aktiviert die "13"" + + " zur Verfügung stehenden Menupunkte. "13""13"" + + " Als Zieltask kann aber im Prinzip auch jede andere empfangsberei- "13"" + + " te Task auf der Station oder irgendwo im Netz (wenn installiert) "13"" + + " gewählt werden. Dazu wählt man die Alternative 'Sonstige'. Nach- "13"" + + " einander werden der Name der Task und die Stationsnummer erfragt. "13"" + + " Danach wird erfragt, ob die Zieltask ein Archiv(manager) ist. An- "13"" + + " schließend verfährt das System wie oben beschrieben." +END PROC archivzieltasktext; + + + + + + + + + +oeffne menukarte ("Archiv"); + +oeffne menu ("ARCHIV", "", "menu archiv reservierung aufgeben"); + +oberbegriff ("Dateien"); + +menufunktion ("v", "Verzeichnis", "menu dateien verzeichnis", + dateiverzeichnistext); +trennlinie; +menufunktion ("l", "Löschen", "menu dateien loeschen", + dateiloeschentext); +menufunktion ("d", "Drucken", "menu dateien drucken", + dateidruckentext); +trennlinie; +menufunktion ("k", "Kopieren", "menu dateien kopieren", + dateikopierentext); +menufunktion ("u", "Umbenennen", "menu dateien umbenennen", + dateiumbenennentext); +trennlinie; +menufunktion ("s", "Speicherplatz", "menu dateien speicherplatz", + dateispeicherplatztext); +menufunktion ("a", "Aufräumen", "menu dateien aufraeumen", + dateiaufraeumtext); + + + +oberbegriff ("Archiv", "menu archiv grundeinstellung (4)", + "menu archiv reservierung aufgeben"); + +menufunktion ("r", "Reservieren", "menu archiv reservieren", + archivreserviertext); +menufunktion ("n", "Neue Diskette", "menu archiv neue diskette", + neuediskettetext); +trennlinie; +menufunktion ("s", "Schreiben", "menu archiv schreiben", + archivschreibtext); +menufunktion ("c", "Checken", "menu archiv checken", + archivchecktext); +menufunktion ("k", "Kombination", "menu archiv schreibcheck", + archivkombinationstext); +menufunktion ("h", "Holen/Lesen", "menu archiv holen", + archivholtext); +menufunktion ("l", "Löschen", "menu archiv loeschen", + archivloeschtext); +trennlinie; +menufunktion ("v", "Verzeichnis", "menu archiv verzeichnis", + archivverzeichnistext); +menufunktion ("d", "Drucken", "menu archiv verzeichnis drucken", + archivdruckentext); +trennlinie; +menufunktion ("i", "Initialisieren", "menu archivinitialisieren", + archivinitialisiertext); +menufunktion ("z", "Zieltask einstellen", "menu archiv zieltask einstellen", + archivzieltasktext); +schliesse menu; +schliesse menukarte; + + diff --git a/app/gs.menugenerator/1.0/src/fonttab.ls-Menu-Generator b/app/gs.menugenerator/1.0/src/fonttab.ls-Menu-Generator new file mode 100644 index 0000000..a5fd613 Binary files /dev/null and b/app/gs.menugenerator/1.0/src/fonttab.ls-Menu-Generator differ diff --git a/app/gs.menugenerator/1.0/src/ls-MENUBASISTEXTE b/app/gs.menugenerator/1.0/src/ls-MENUBASISTEXTE new file mode 100644 index 0000000..48ef277 Binary files /dev/null and b/app/gs.menugenerator/1.0/src/ls-MENUBASISTEXTE differ diff --git a/app/gs.menugenerator/1.0/src/ls-Menu-Generator 1 b/app/gs.menugenerator/1.0/src/ls-Menu-Generator 1 new file mode 100644 index 0000000..b9dfd73 --- /dev/null +++ b/app/gs.menugenerator/1.0/src/ls-Menu-Generator 1 @@ -0,0 +1,47 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-Menu-Generator 1 ** + ** ** + ** Version 1.0 ** + ** ** + ** (Stand: 30.03.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls menu generator 1 DEFINES{} textprozedur,{} textzeile:{}LET maxzeilenzahl = 14,{} maxzeichenzahl = 65,{} zentrierkennung = "%",{} beginmarkkennung = "$",{} endmarkkennung = "&",{} unblockkennung = "�",{} blank = " ",{} dateikennung = ".a";{}LET dateieintrag = "#type (""10"")##limit (16.5)#",{} stdfonttabelle = "fonttab.ls-Menu-Generator";{}ROW 3 TEXT CONST fehlermeldung :: ROW 3 TEXT : ({}"existiert nicht!",{} +""15"Text ist zu lang - bitte kürzen! "14"",{}""15"Zeilenformatierung mit abgebrochen! "14""{});{}ROW 6 TEXT CONST hinweis :: ROW 6 TEXT : ({}"Bitte warten ...",{}"Zulässige Zeilenzahl: ",{}"Tatsächliche Zeilenzahl: ",{}"Textlänge ist in Ordnung!",{}"Textprozedur ist erstellt!",{}"Textzeile ist erstellt!"{});{}PROC textprozedur (TEXT CONST dateiname, prozedurname):{} BOOL VAR mit fehler;{} formatiere (dateiname, mit fehler);{} IF mit fehler{} THEN errorstop (fehlermeldung [3]){} FI;{} + bereite den text auf (dateiname);{} erzeuge textprozedur (dateiname, prozedurname);{} out (""7""); out (hinweis [5]);{} last param (dateiname + dateikennung){}END PROC textprozedur;{}PROC textzeile (TEXT CONST dateiname):{} BOOL VAR mit fehler;{} formatiere (dateiname, mit fehler);{} IF mit fehler{} THEN errorstop (fehlermeldung [3]){} FI;{} bereite den text auf (dateiname);{} erzeuge textzeile (dateiname);{} out (""7""); out (hinweis [6]);{} last param (dateiname + dateikennung){} +END PROC textzeile;{}PROC gib wartehinweis:{} page;{} out (hinweis [1]){}END PROC gib wartehinweis;{}PROC formatiere (TEXT CONST dateiname, BOOL VAR mit fehler):{} TEXT VAR fonttabelle, zeileninhalt;{} kontrolliere existenz;{} stelle fonttabelle ein;{} schreibe font in die datei;{} zeilenformatierung;{} entferne ggf font aus der datei;{} stelle fonttabelle zurueck;{} streiche restleerzeilen weg;{} untersuche ggf datei auf korrektheit.{} kontrolliere existenz:{} IF NOT exists (dateiname){} + THEN page; errorstop ("'" + dateiname + "' " + fehlermeldung [1]){} FI.{} stelle fonttabelle ein:{} gib wartehinweis;{} fonttabelle := fonttable;{} fonttable (stdfonttabelle).{} schreibe font in die datei:{} FILE VAR datei :: sequential file (modify, dateiname);{} to line (datei, 1);{} insert record (datei);{} write record (datei, dateieintrag + blank).{} zeilenformatierung:{} disable stop;{} lineform (dateiname);{} IF is error{} THEN clear error;{} + mit fehler := TRUE{} ELSE mit fehler := FALSE{} FI;{} enable stop.{} entferne ggf font aus der datei:{} to line (datei, 1);{} read record (datei, zeileninhalt);{} IF pos (zeileninhalt, dateieintrag) > 0{} THEN delete record (datei){} FI.{} stelle fonttabelle zurueck:{} fonttable (fonttabelle).{} streiche restleerzeilen weg:{} REP{} streiche ggf letzte zeile{} UNTIL zeile ist nicht leer PER.{} streiche ggf letzte zeile:{} to line (datei, lines (datei));{} + read record (datei, zeileninhalt);{} IF compress (zeileninhalt) = ""{} THEN delete record (datei){} FI.{} zeile ist nicht leer:{} compress (zeileninhalt) <> "".{} untersuche ggf datei auf korrektheit:{} IF NOT mit fehler{} THEN untersuche zeilenzahl{} FI.{} untersuche zeilenzahl:{} IF lines (datei) > maxzeilenzahl{} THEN page;{} out (hinweis [2] + text (maxzeilenzahl)); line;{} out (hinweis [3] + text (lines (datei))); line (2);{} errorstop (fehlermeldung [2]){} + ELSE page;{} out (hinweis [4]){} FI.{}END PROC formatiere;{}PROC bereite den text auf (TEXT CONST dateiname):{} INT VAR zaehler;{} TEXT VAR zeileninhalt;{} FILE VAR f :: sequential file (modify, dateiname);{} gib wartehinweis;{} vernichte ggf aufbereitete datei;{} richte datei neu ein;{} uebertrage die zeilen.{} vernichte ggf aufbereitete datei:{} IF exists (dateiname + dateikennung){} THEN forget (dateiname + dateikennung, quiet){} FI.{} richte datei neu ein:{} + FILE VAR aus :: sequential file (output, dateiname + dateikennung).{} uebertrage die zeilen:{} FOR zaehler FROM 1 UPTO lines (f) REP{} bereite eine zeile auf{} PER.{} bereite eine zeile auf:{} to line (f, zaehler);{} read record (f, zeileninhalt);{} ersetze alle gaensefuesschen;{} haenge ggf absatzmarke an;{} behandle zeile;{} putline (aus, zeileninhalt).{} ersetze alle gaensefuesschen:{} change all (zeileninhalt, """", "'").{} haenge ggf absatzmarke an:{} IF (zeileninhalt SUB (length (zeileninhalt))) = blank{} + THEN IF (zeileninhalt SUB 1) <> zentrierkennung{} THEN zeileninhalt CAT unblockkennung{} FI{} FI.{} behandle zeile:{} IF zeile soll zentriert werden{} THEN zentriere zeile{} ELIF zeile ist leerzeile{} THEN kennzeichne leerzeile{} ELSE blocke zeile auf stdlaenge{} FI.{} zeile soll zentriert werden:{} (zeileninhalt SUB 1) = zentrierkennung.{} zeile ist leerzeile:{} compress (zeileninhalt) = "".{} zentriere zeile:{} zeileninhalt := subtext (zeileninhalt, 2);{} + zeileninhalt := anfangsblanks + zeileninhalt;{} zeilenabschluss.{} anfangsblanks:{} ((maxzeichenzahl - length (zeileninhalt)) DIV 2) * blank.{} zeilenabschluss:{} ersetze markierungszeichen;{} setze 13.{} ersetze markierungszeichen:{} change all (zeileninhalt, beginmarkkennung, """15""");{} change all (zeileninhalt, endmarkkennung, """14""").{} setze 13:{} zeileninhalt CAT " ""13""".{} kennzeichne leerzeile:{} zeileninhalt := """13""".{} blocke zeile auf stdlaenge:{} + IF zeile darf nicht geblockt werden{} THEN ersetze endezeichen{} ELSE fuehre blockung aus{} FI.{} zeile darf nicht geblockt werden:{} (zeileninhalt SUB length (zeileninhalt)) = unblockkennung.{} ersetze endezeichen:{} zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 1);{} ersetze markierungszeichen;{} setze 13.{} fuehre blockung aus:{} ROW maxzeichenzahl INT VAR leerzeichen;{} INT VAR gezaehlte blanks, zu verteilende blanks;{} ordne anfangswerte zu;{} + verteile blanks gleichmaessig;{} verteile blanks zufaellig;{} baue zeile zusammen;{} ersetze markierungszeichen;{} setze 13.{} ordne anfangswerte zu:{} bestimme blankanzahl in der zeile;{} bestimme zu verteilende blanks;{} initialisiere die reihung.{} bestimme blankanzahl in der zeile:{} gezaehlte blanks := 0;{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO length (zeileninhalt) REP{} IF (zeileninhalt SUB zeiger) = blank{} THEN gezaehlte blanks INCR 1{} + FI{} PER.{} bestimme zu verteilende blanks:{} zu verteilende blanks := maxzeichenzahl - length (zeileninhalt).{} initialisiere die reihung:{} FOR zeiger FROM 1 UPTO gezaehlte blanks REP{} leerzeichen [zeiger] := 1{} PER.{} verteile blanks gleichmaessig:{} WHILE (zu verteilende blanks DIV gezaehlte blanks) > 0 REP{} schlag je ein blank auf;{} zu verteilende blanks DECR gezaehlte blanks{} PER.{} schlag je ein blank auf:{} FOR zeiger FROM 1 UPTO gezaehlte blanks REP{} + leerzeichen [zeiger] INCR 1{} PER.{} verteile blanks zufaellig:{} FOR zeiger FROM 1 UPTO zu verteilende blanks REP{} leerzeichen [random (1, gezaehlte blanks)] INCR 1{} PER.{} baue zeile zusammen:{} TEXT VAR zwischen := zeileninhalt;{} INT VAR aktuelles blank := 0;{} zeileninhalt := "";{} FOR zeiger FROM 1 UPTO length (zwischen) REP{} TEXT VAR aktuelles zeichen :: (zwischen SUB zeiger);{} IF aktuelles zeichen = blank{} THEN aktuelles blank INCR 1;{} + zeileninhalt CAT (leerzeichen [aktuelles blank] * blank){} ELSE zeileninhalt CAT aktuelles zeichen{} FI{} PER{}END PROC bereite den text auf;{}PROC erzeuge textprozedur (TEXT CONST dateiname, prozedurname):{} mache aus den zeilen einzeltexte;{} entferne ueberfluessige restzeilen;{} erstelle eine textprozedur.{} mache aus den zeilen einzeltexte:{} INT VAR zeiger;{} FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);{} FOR zeiger FROM 1 UPTO lines (ausdatei) REP{} + bearbeite eine zeile{} PER.{} bearbeite eine zeile:{} TEXT VAR zeileninhalt;{} to line (ausdatei, zeiger);{} read record (ausdatei, zeileninhalt);{} zeileninhalt := """ " + zeileninhalt + """ +";{} change all (zeileninhalt, "­", "-");{} write record (ausdatei, zeileninhalt).{} entferne ueberfluessige restzeilen:{} REP{} entferne ggf eine zeile{} UNTIL zeileninhalt <> """ ""13"""" +" PER;{} entferne return aus letzter zeile.{} entferne ggf eine zeile:{} + IF compress (zeileninhalt) = """ ""13"""" +"{} THEN delete record (ausdatei){} FI.{} entferne return aus letzter zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 6);{} write record (ausdatei, zeileninhalt).{} erstelle eine textprozedur:{} schreibe procanfang;{} schreibe procende.{} schreibe procanfang:{} to line (ausdatei, 1);{} insert record (ausdatei);{} + write record (ausdatei, "TEXT PROC " + prozedurname + ":").{} schreibe procende:{} to line (ausdatei, lines (ausdatei) + 1);{} insert record (ausdatei);{} write record (ausdatei, "END PROC " + prozedurname + ";").{}END PROC erzeuge textprozedur;{}PROC erzeuge textzeile (TEXT CONST dateiname):{} entferne ueberfluessige restzeilen;{} entferne return aus letzter zeile;{} erstelle eine textzeile.{} entferne ueberfluessige restzeilen:{} TEXT VAR zeileninhalt;{} INT VAR zeiger;{} + FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);{} REP{} entferne ggf eine zeile{} UNTIL compress (zeileninhalt) <> """13""" PER.{} entferne ggf eine zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} IF compress (zeileninhalt) = """13"""{} THEN delete record (ausdatei){} FI.{} entferne return aus letzter zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} change all (zeileninhalt, """13""", "");{} + write record (ausdatei, zeileninhalt).{} erstelle eine textzeile:{} haenge die zeilen aneinander;{} fasse zeile in gaensefuesschen;{} schreibe einzelzeile in ausgabedatei.{} haenge die zeilen aneinander:{} TEXT VAR zeile :: "";{} FOR zeiger FROM 1 UPTO lines (ausdatei) REP{} to line (ausdatei, zeiger);{} read record (ausdatei, zeileninhalt);{} zeile CAT (" " + zeileninhalt){} PER.{} fasse zeile in gaensefuesschen:{} zeile := """" + zeile + """";{} change all (zeile, "­","-").{} + schreibe einzelzeile in ausgabedatei:{} forget (dateiname + dateikennung, quiet);{} FILE VAR fertig :: sequential file (modify, dateiname + dateikennung);{} to line (fertig, 1);{} insert record (fertig);{} write record (fertig, zeile){}END PROC erzeuge textzeile;{}END PACKET ls menu generator 1;{} + diff --git a/app/gs.menugenerator/1.0/src/ls-Menu-Generator 2 b/app/gs.menugenerator/1.0/src/ls-Menu-Generator 2 new file mode 100644 index 0000000..608f680 --- /dev/null +++ b/app/gs.menugenerator/1.0/src/ls-Menu-Generator 2 @@ -0,0 +1,72 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-Menu-Generator 2 ** + ** ** + ** Version 1.0 ** + ** ** + ** (Stand: 30.03.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +PACKET ls menu generator 2 DEFINES{} oeffne menukarte,{} oeffne menu,{} oberbegriff,{} menufunktion,{} trennlinie,{} schliesse menu,{} schliesse menukarte,{} testinstallation:{}LET menutafeltype = 1954,{} kennung = "ls - Menu - Generator",{} mm taskname = "ls-MENUKARTEN",{} menutafelpraefix = "ls-MENUKARTE:",{} menu grundtext = "ls-MENUBASISTEXTE",{} zwischenablagename = "MENU-ZWISCHENABLAGEDATEI INTERN";{} +LET maxmenus = 6,{} maxmenutexte = 300,{} maxinfotexte = 2000,{} maxhauptmenupunkte = 10,{} maxuntermenupunkte = 15,{} maxmenubreite = 71; (* Breite der Hauptmenüzeile - 2 *){}LET blank = " ",{} cleop = ""4"",{} piep = ""7"",{} trennzeilensymbol = "###",{} bleibt leer symbol = "***",{} hauptmenuluecke = " ";{}LET dummyname = "Dummy für Anwendertexte",{} + install finished = "Installation abgeschlossen!",{} card finished = "Menukartengenerierung abgeschlossen!",{} filetype = 1003;{}TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,{} punktname,{} procname,{} boxtext,{} BOOL aktiv,{} angewaehlt),{} EINZELMENU = STRUCT (INT belegt,{} TEXT ueberschrift,{} + INT anfangsposition,{} maxlaenge,{} ROW maxuntermenupunkte MENUPUNKT menupunkt,{} INT aktueller untermenupunkt,{} TEXT startprozedurname,{} leaveprozedurname),{} MENU = STRUCT (TEXT menuname,{} INT anzahl hauptmenupunkte,{} ROW maxhauptmenupunkte EINZELMENU einzelmenu,{} + TEXT menueingangsprozedur,{} menuausgangsprozedur,{} menuinfo,{} lizenznummer,{} versionsnummer,{} INT hauptmenuzeiger,{} untermenuanfang,{} untermenuzeiger),{} INFOTEXT = STRUCT (INT anzahl infotexte,{} ROW maxinfotexte TEXT stelle),{} + MENUTEXT = STRUCT (INT anzahl menutexte,{} ROW maxmenutexte TEXT platz),{} MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,{} ROW maxmenus MENU menu,{} MENUTEXT menutext,{} INFOTEXT infotext);{}ROW 14 TEXT CONST aussage :: ROW 14 TEXT : ({}"ACHTUNG - Eine Menukarte mit diesem Namen existiert bereits - ACHTUNG",{}"Kann die bereits existierende Menukarte gelöscht werden",{} +"Dann kann keine neue Menukarte mit diesem Namen erstellt werden!",{}"Zum Weitermachen bitte irgendeine Taste tippen!",{}"Sollen auch Anwendungstexte in die Menukarte aufgenommen werden",{}"Auswahl der Datei, in der die Anwendungstexte stehen.",{}"Bitte die gewünschte Datei ankreuzen!",{}"Durchgang 1 von 2 Durchgängen - in Arbeit ist Zeile: ",{}"Durchgang 2 von 2 Durchgängen - in Arbeit ist Zeile: ",{}"",{}"Einlesen von Texten aus Datei : ",{}"Bearbeitet wird Menu : ",{}"Eingetragen wird Oberbegriff : ",{} +"Eingetragen wird Menufunktion : "{});{}ROW 22 TEXT CONST fehlermeldung :: ROW 22 TEXT : ({}"Ohne die Datei '",{}"' "13""10""10" ist die Menuerstellung "15"unmöglich "14"!!",{}"Hier muß unbedingt eine Datei angekreuzt werden!",{}"Ausgewählte Datei hat falschen Typ (<> 1003) )",{}"Zu viele Anwendungstexte in der Datei ",{}"Anführungszeichen fehlt am Anfang oder Ende der Zeile ",{}"Anführungszeichen fehlt irgendwo in Zeile ",{}"Die angegebene Datei existiert nicht!",{}"Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt)! ",{} +"Vorausgehendes Menu nicht geschlossen! ",{}"Zu viele Menus in der Menukarte (> " + text (maxmenus) + ")!",{}"Menuname ist mehrfach vorhanden!",{}"Menu noch nicht geoeffnet ('oeffne menu' fehlt)!",{}"Zu viele Oberbegriffe in einem Menu (> " + text (maxhauptmenupunkte) + ")!",{}"Die Kopfzeile ist zu lang (> " + text (maxmenubreite) + ")!",{}"Menupunkt-Kürzel ist länger als ein Zeichen!",{}"Menupunkt-Kürzel kommt mehrfach vor (nicht eindeutig)!",{}"Menupunkt-Bezeichnung ist zu lang!",{}"Zu viele (> " + text (maxuntermenupunkte) + ") Menupunkte in einem Pull-Down-Menu!",{} +"Menukarte '",{}"' gibt es nicht in dieser Task!",{}"' hat falsche(n) Typ/Bezeichnung"{});{}TEXT VAR menuinfotextdateiname,{} aktueller menudateiname;{}BOOL VAR menuleiste ist bereit :: FALSE,{} menu ist geoeffnet :: FALSE;{}BOUND MENULEISTE VAR menuleiste;{}BOUND MENUTEXT VAR basistexte;{}BOUND MENU VAR aktuelles menu;{}DATASPACE VAR ds;{}OP := (MENUTEXT VAR ziel, MENUTEXT VAR quelle):{} INT VAR z;{} ziel.anzahl menutexte := quelle.anzahl menutexte;{} FOR z FROM 1 UPTO quelle.anzahl menutexte REP{} + ziel.platz [z] := quelle.platz [z]{} PER{}END OP :=;{}OP := (MENU VAR ziel, MENU CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (EINZELMENU VAR ziel, EINZELMENU CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (MENUPUNKT VAR ziel, MENUPUNKT CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC oeffne menukarte (TEXT CONST menukartenname):{} gib bildschirmhinweis aus;{} ueberpruefe voraussetzungen;{} erfrage den namen der datei mit den anwendertexten;{} + erstelle neue menuleiste.{} gib bildschirmhinweis aus:{} page; out (center (invers (kennung))).{} ueberpruefe voraussetzungen:{} ueberpruefe ob basistexte vorhanden sind;{} ueberpruefe ob menukarte schon vorhanden ist.{} ueberpruefe ob basistexte vorhanden sind:{} IF NOT exists (menu grundtext){} THEN gib hinweis und brich ab{} FI.{} gib hinweis und brich ab:{} disable stop;{} fetch (menu grundtext, /mm taskname);{} IF is error{} THEN clear error;{} enable stop;{} + cursor (1, 4); out (cleop);{} errorstop (fehlermeldung [1] + menu grundtext + fehlermeldung [2]){} ELSE clear error;{} enable stop{} FI.{} ueberpruefe ob menukarte schon vorhanden ist:{} IF exists (menukarte){} THEN gib hinweis auf vorhandene menukarte;{} frage ob die alte karte geloescht werden darf{} FI.{} menukarte:{} menutafelpraefix + menukartenname.{} gib hinweis auf vorhandene menukarte:{} cursor (1, 4); out (cleop);{} + cursor (1, 4); out (center (menukarte));{} cursor (1, 6); out (center (invers (aussage [1]))).{} frage ob die alte karte geloescht werden darf:{} cursor (2, 9);{} IF yes (aussage [2]){} THEN forget (menukarte, quiet){} ELSE weiterarbeit ist unmoeglich{} FI.{} weiterarbeit ist unmoeglich:{} cursor (1, 12); out (center (invers (aussage [3])));{} cursor (2, 15); out (aussage [4]);{} cursor (2, 16); pause; page;{} errorstop ("").{} erfrage den namen der datei mit den anwendertexten:{} + cursor (1, 4); out (cleop);{} IF yes (aussage [5]){} THEN biete dateiauswahl an{} ELSE erzeuge dateidummy{} FI.{} biete dateiauswahl an:{} menuinfotextdateiname := one (2, 6, 77, 19, ALL myself,{} aussage [6], aussage [7]);{} ueberpruefe den dateinamen;{} ueberpruefe den dateityp.{} ueberpruefe den dateinamen:{} IF compress (menuinfotextdateiname) = ""{} THEN page; errorstop (fehlermeldung [3]){} FI.{} ueberpruefe den dateityp:{} + IF datei hat falschen typ{} THEN page; errorstop (fehlermeldung [4]){} FI.{} datei hat falschen typ:{} ds := old (menuinfotextdateiname);{} IF type (ds) <> filetype{} THEN forget (ds); TRUE{} ELSE forget (ds); FALSE{} FI.{} erzeuge dateidummy:{} forget (dummyname, quiet);{} FILE VAR datei :: sequential file (modify, dummyname);{} to line (datei, 1);{} menuinfotextdateiname := dummyname.{} erstelle neue menuleiste:{} INT VAR zeiger;{} TEXT VAR zeileninhalt;{} + initialisiere werte;{} aktueller menudateiname := menukarte;{} menuleiste := new (aktueller menudateiname);{} type (old (aktueller menudateiname), menutafeltype);{} menuleiste.belegt := 0;{} menuleiste ist bereit := TRUE;{} trage menubasistexte ein;{} trage anwendungstexte ein.{} initialisiere werte:{} menuleiste ist bereit := FALSE;{} menu ist geoeffnet := FALSE.{} trage menubasistexte ein:{} basistexte := old (menu grundtext);{} + menuleiste.menutext := basistexte.{} trage anwendungstexte ein:{} konvertiere (menuinfotextdateiname, zwischenablagename,{} menuleiste.infotext.anzahl infotexte);{} ueberpruefe anwendungstextanzahl;{} trage anwendungstexte in die menuleiste.{} ueberpruefe anwendungstextanzahl:{} IF menuleiste.infotext.anzahl infotexte > maxinfotexte{} THEN forget (zwischenablagename, quiet);{} forget (aktueller menudateiname, quiet);{} errorstop (fehlermeldung [5] + "'" + menuinfotextdateiname + "'"){} + FI.{} trage anwendungstexte in die menuleiste:{} gib hinweis auf anwendungstexteintrag;{} FILE VAR ein :: sequential file (input, zwischenablagename);{} FOR zeiger FROM 1 UPTO menuleiste.infotext.anzahl infotexte REP{} getline (ein, zeileninhalt);{} menuleiste.infotext.stelle [zeiger] := zeileninhalt;{} cout (zeiger){} PER;{} forget (zwischenablagename, quiet);{} forget (dummyname , quiet).{} gib hinweis auf anwendungstexteintrag:{} cursor (1, 7); out (aussage [9]).{} +END PROC oeffne menukarte;{}PROC konvertiere (TEXT CONST eingabedatei, ausgabedatei,{} INT VAR anzahl konvertierter saetze):{} loesche ausgabedatei;{} untersuche eingabedatei;{} konvertiere saetze.{} loesche ausgabedatei:{} IF exists (ausgabedatei){} THEN forget (ausgabedatei, quiet){} FI.{} untersuche eingabedatei:{} IF NOT exists (eingabedatei){} THEN errorstop (fehlermeldung [8]){} FI.{} konvertiere saetze:{} gib hinweis;{} konvertiere satzweise.{} + gib hinweis:{} cursor (1, 4); out (cleop);{} cursor (1, 4); out (aussage [11] + "'" + eingabedatei + "'");{} cursor (1, 6); out (aussage [ 8]);{} anzahl konvertierter saetze := 0.{} konvertiere satzweise:{} TEXT VAR zeileninhalt :: "";{} FILE VAR eingabe :: sequential file (input, eingabedatei);{} WHILE NOT eof (eingabe) REP{} behandle eine dateizeile{} PER;{} optimiere ausgabedatei.{} behandle eine dateizeile:{} getline (eingabe, zeileninhalt);{} anzahl konvertierter saetze INCR 1;{} + cout (anzahl konvertierter saetze);{} untersuche zeile;{} wandle die zeile um;{} FILE VAR aus :: sequential file (output, ausgabedatei);{} write (aus, textausgabe).{} untersuche zeile:{} zeileninhalt := compress (zeileninhalt);{} IF zeileninhalt = ""{} THEN zeileninhalt := """"""{} FI;{} IF (zeileninhalt SUB 1) <> """"{} OR (zeileninhalt SUB length (zeileninhalt)) <> """"{} THEN bereite abgang vor;{} errorstop (fehlermeldung [6] + text (anzahl konvertierter saetze)){} + FI.{} wandle die zeile um:{} TEXT VAR textausgabe :: "", codekette;{} zeileninhalt := subtext (zeileninhalt, 2, length (zeileninhalt) - 1);{} WHILE gaensefuesschenposition > 0 REP{} textausgabe CAT subtext (zeileninhalt, 1, gaensefuesschenposition - 1);{} zeileninhalt := subtext (zeileninhalt, gaensefuesschenposition);{} codekette := subtext (zeileninhalt, 1, pos (zeileninhalt, """", 2));{} IF codekette = """7"""{} THEN textausgabe CAT ""7""{} + ELIF codekette = """5"""{} THEN textausgabe CAT ""5""{} ELIF codekette = """4"""{} THEN textausgabe CAT ""4""{} ELIF codekette = """10"""{} THEN textausgabe CAT ""10""{} ELIF codekette = """13"""{} THEN textausgabe CAT ""13""{} ELIF codekette = """14"""{} THEN textausgabe CAT ""14""{} ELIF codekette = """15"""{} THEN textausgabe CAT ""15""{} ELIF codekette = """"""{} THEN textausgabe CAT """"{} + ELSE errorstop (fehlermeldung [7] +{} text (anzahl konvertierter saetze)){} FI;{} zeileninhalt := subtext (zeileninhalt, 1 + length (codekette)){} PER;{} textausgabe CAT zeileninhalt.{} gaensefuesschenposition:{} pos (zeileninhalt, """").{} bereite abgang vor:{} forget (ausgabedatei, quiet);{} line (2).{} optimiere ausgabedatei:{} FILE VAR ausgabe :: sequential file (modify, ausgabedatei);{} WHILE lines (ausgabe) > 0 CAND letzter satz ist leer REP{} + to line (ausgabe, lines (ausgabe));{} delete record (ausgabe);{} anzahl konvertierter saetze DECR 1;{} cout (anzahl konvertierter saetze ){} PER.{} letzter satz ist leer:{} TEXT VAR satz;{} to line (ausgabe,lines (ausgabe));{} read record (ausgabe, satz);{} IF compress (satz) = "" OR compress (satz) = ""13""{} THEN TRUE{} ELSE FALSE{} FI.{}END PROC konvertiere;{}PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc,{} itext, ltext, vtext):{} + gib hinweis auf geoeffnetes menu;{} ueberpruefe auf ungereimtheiten;{} nimm eintragungen in datenraum vor.{} gib hinweis auf geoeffnetes menu:{} cursor (1, 4); out (cleop);{} out (aussage [12]); out (invers (name));{} cursor (1, 6).{} ueberpruefe auf ungereimtheiten:{} pruefe auf bereits geoeffnete menuliste;{} pruefe auf noch geoeffnetes menu;{} pruefe auf noch freie menuplaetze;{} pruefe auf schon vorhandenen menunamen.{} pruefe auf bereits geoeffnete menuliste:{} IF NOT menuleiste ist bereit{} + THEN bereinige eintragungen (9){} FI.{} pruefe auf noch geoeffnetes menu:{} IF menu ist geoeffnet{} THEN bereinige eintragungen (10){} FI.{} pruefe auf noch freie menuplaetze:{} IF menuleiste.belegt = maxmenus{} THEN bereinige eintragungen (11){} FI.{} pruefe auf schon vorhandenen menunamen:{} IF menuname schon vorhanden{} THEN bereinige eintragungen (12){} FI.{} menuname schon vorhanden:{} INT VAR i;{} FOR i FROM 1 UPTO menuleiste.belegt REP{} + untersuche einzelnen menunamen{} PER;{} FALSE.{} untersuche einzelnen menunamen:{} IF menuleiste.menu [i].menuname = compress (name){} THEN LEAVE menuname schon vorhanden WITH TRUE{} FI.{} nimm eintragungen in datenraum vor:{} forget (ds);{} ds := nilspace;{} aktuelles menu := ds;{} init (aktuelles menu);{} aktuelles menu.menuname := compress (name);{} aktuelles menu.menueingangsprozedur := compress (einstiegsproc);{} + aktuelles menu.menuausgangsprozedur := compress (ausstiegsproc);{} IF itext <> ""{} THEN aktuelles menu.menuinfo := itext;{} aktuelles menu.lizenznummer := ltext;{} aktuelles menu.versionsnummer := vtext{} ELSE aktuelles menu.menuinfo := bleibt leer symbol;{} aktuelles menu.lizenznummer := "";{} aktuelles menu.versionsnummer := ""{} FI;{} menu ist geoeffnet := TRUE.{}END PROC oeffne menu;{} +PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc):{} oeffne menu (name, einstiegsproc, ausstiegsproc, "", "", ""){}END PROC oeffne menu;{}PROC oeffne menu (TEXT CONST name):{} oeffne menu (name, "", "", "", "", ""){}END PROC oeffne menu;{}PROC bereinige eintragungen (INT CONST nummer):{} forget (ds);{} forget (aktueller menudateiname, quiet);{} menuleiste ist bereit := FALSE;{} menu ist geoeffnet := FALSE;{} errorstop (fehlermeldung [nummer]){}END PROC bereinige eintragungen;{} +PROC init (MENU VAR m):{} m.menuname := "";{} m.hauptmenuzeiger := 1;{} m.untermenuanfang := 0;{} m.untermenuzeiger := 0;{} m.menueingangsprozedur := "";{} m.menuausgangsprozedur := "";{} m.menuinfo := "";{} m.versionsnummer := "";{} m.anzahl hauptmenupunkte := 0;{} belege hauptmenupunkte.{} belege hauptmenupunkte:{} INT VAR i;{} FOR i FROM 1 UPTO maxhauptmenupunkte REP{} + aktuelles einzelmenu.belegt := 0;{} aktuelles einzelmenu.ueberschrift := "";{} aktuelles einzelmenu.anfangsposition := 0;{} aktuelles einzelmenu.maxlaenge := 0;{} aktuelles einzelmenu.aktueller untermenupunkt := 1;{} aktuelles einzelmenu.startprozedurname := "";{} aktuelles einzelmenu.leaveprozedurname := "";{} belege untermenuepunkte{} PER.{} belege untermenuepunkte:{} + INT VAR j;{} FOR j FROM 1 UPTO maxuntermenupunkte REP{} aktueller menupunkt.punktkuerzel := "";{} aktueller menupunkt.punktname := "";{} aktueller menupunkt.procname := "";{} aktueller menupunkt.boxtext := "";{} aktueller menupunkt.aktiv := TRUE;{} aktueller menupunkt.angewaehlt := FALSE{} PER.{} aktuelles einzelmenu: m.einzelmenu [i].{} aktueller menupunkt: aktuelles einzelmenu.menupunkt [j].{}END PROC init;{}PROC oberbegriff (TEXT CONST punktname, startprocname, leaveprocname):{} + gib hinweis auf oberbegriff;{} untersuche ob menu geoeffnet und bereit ist;{} untersuche oberbegriffe;{} trage neuen oberbegriff ein;{} notiere die anfangsposition;{} notiere start und leaveprozedur;{} erhoehe die anzahl der oberbegriffe.{} gib hinweis auf oberbegriff:{} cursor (1, 6); out (cleop);{} cursor (1, 6); out (aussage [13]); out (invers (punktname)); line.{} untersuche ob menu geoeffnet und bereit ist:{} IF NOT menuleiste ist bereit{} THEN bereinige eintragungen ( 9){} + FI;{} IF NOT menu ist geoeffnet{} THEN bereinige eintragungen (13){} FI.{} untersuche oberbegriffe:{} IF zu viele oberbegriffe{} THEN bereinige eintragungen (14){} FI;{} IF gesamtlaenge > maxmenubreite{} THEN bereinige eintragungen (15){} FI.{} zu viele oberbegriffe:{} aktuelles menu.anzahl hauptmenupunkte = maxhauptmenupunkte.{} gesamtlaenge:{} gesamtlaenge ohne letzten punkt + length (compress (punktname)).{} gesamtlaenge ohne letzten punkt:{} length (hauptmenuzeile).{} + hauptmenuzeile:{} INT VAR zaehler;{} TEXT VAR zeile :: "";{} schreibe menunamen;{} schreibe oberbegriffe;{} zeile.{} schreibe menunamen:{} IF aktuelles menu. menuname <> ""{} THEN zeile CAT aktuelles menu.menuname;{} zeile CAT ":"{} FI.{} schreibe oberbegriffe:{} FOR zaehler FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP{} zeile CAT hauptmenuluecke;{} zeile CAT aktuelles menu. einzelmenu [zaehler].ueberschrift{} PER;{} zeile CAT hauptmenuluecke.{} + trage neuen oberbegriff ein:{} neuer menupunkt.ueberschrift := compress (punktname).{} notiere die anfangsposition:{} neuer menupunkt.anfangsposition := gesamtlaenge ohne letzten punkt + 1.{} notiere start und leaveprozedur:{} neuer menupunkt.startprozedurname := compress (startprocname);{} neuer menupunkt.leaveprozedurname := compress (leaveprocname).{} neuer menupunkt:{} aktuelles menu.einzelmenu [aktuelles menu.anzahl hauptmenupunkte + 1].{} erhoehe die anzahl der oberbegriffe:{} + aktuelles menu.anzahl hauptmenupunkte INCR 1.{}END PROC oberbegriff;{}PROC oberbegriff (TEXT CONST punktname):{} oberbegriff (punktname, "", ""){}END PROC oberbegriff;{}PROC menufunktionseintrag (TEXT CONST kuerzel,{} punktbezeichnung,{} prozedurname,{} infotext,{} BOOL CONST ist aktiv):{} gib hinweis auf menufunktionseintrag;{} trage menupunkt ein;{} organisiere menu neu.{} + gib hinweis auf menufunktionseintrag:{} line;{} out (aussage [14]);{} out ("'" + kuerzelzeichen + "' - " + punktname).{} kuerzelzeichen:{} IF kuerzel = "" THEN " " ELSE kuerzel FI.{} punktname:{} IF punktbezeichnung = trennzeilensymbol{} THEN "----------"{} ELSE punktbezeichnung{} FI.{} trage menupunkt ein:{} ueberpruefe das kuerzel;{} ueberpruefe die punktbreite;{} ueberpruefe die eintragsnummer;{} aktuelles menu.einzelmenu [stelle].belegt INCR 1;{} + aktueller menupunkt.punktkuerzel := compress (kuerzel);{} aktueller menupunkt.punktname := normierter menupunkt;{} aktueller menupunkt.procname := compress (prozedurname);{} aktueller menupunkt.boxtext := infotext;{} aktueller menupunkt.aktiv := ist aktiv;{} aktueller menupunkt.angewaehlt := FALSE.{} aktueller menupunkt:{} aktuelles untermenu.menupunkt [aktuelles untermenu.belegt].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [stelle].{} + stelle:{} aktuelles menu.anzahl hauptmenupunkte.{} normierter menupunkt:{} blank + compress (punktbezeichnung).{} ueberpruefe das kuerzel:{} TEXT VAR kurz :: compress (kuerzel);{} IF kuerzel ist zu lang{} THEN bereinige eintragungen (16){} ELIF kuerzel ist schon vorhanden{} THEN bereinige eintragungen (17){} FI.{} kuerzel ist zu lang:{} length (kurz) > 1.{} kuerzel ist schon vorhanden:{} (length (kurz) = 1) AND (pos (vorhandene kuerzel, kurz) > 0).{} + vorhandene kuerzel:{} TEXT VAR liste :: "";{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO aktuelles untermenu.belegt REP{} liste CAT aktuelles untermenu.menupunkt [zeiger].punktkuerzel{} PER;{} liste.{} ueberpruefe die punktbreite:{} IF length (compress (punktbezeichnung)) > maxmenubreite - 10{} THEN bereinige eintragungen (18){} FI.{} ueberpruefe die eintragsnummer:{} IF aktuelles untermenu.belegt = maxuntermenupunkte{} THEN bereinige eintragungen (19){} + FI.{} organisiere menu neu:{} IF neue punktlaenge > aktuelles untermenu.maxlaenge{} THEN aktuelles untermenu.maxlaenge := neue punktlaenge{} FI.{} neue punktlaenge:{} length (aktueller menupunkt.punktname).{}END PROC menufunktionseintrag;{}PROC menufunktion (TEXT CONST kuerzel, punktbezeichnung,{} prozedurname, infotext):{} menufunktionseintrag (kuerzel, punktbezeichnung, prozedurname, infotext,{} TRUE){}END PROC menufunktion;{} +PROC trennlinie:{} menufunktionseintrag ("", trennzeilensymbol, "", "", FALSE){}END PROC trennlinie;{}PROC schliesse menu:{} menuleiste. belegt INCR 1;{} menuleiste.menu [menuleiste.belegt] := aktuelles menu;{} menu ist geoeffnet := FALSE{}END PROC schliesse menu;{}PROC schliesse menukarte:{} forget (ds);{} page; out (piep); put (card finished){}END PROC schliesse menukarte;{}PROC testinstallation (TEXT CONST kartenname):{} ueberpruefe menukarte;{} nimm installation vor.{} + ueberpruefe menukarte:{} IF NOT exists (kartenname){} THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [21]){} ELIF (pos (kartenname, menutafelpraefix) <> 1){} OR (type (old (kartenname)) <> menutafeltype){} THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [22]){} FI.{} nimm installation vor:{} TEXT CONST neuer kartenname{} :: kartenname + " von Task '" + name (myself) + "'";{} command dialogue (FALSE);{} + rename (kartenname, neuer kartenname);{} save (neuer kartenname,task (mmtaskname));{} forget (neuer kartenname, quiet);{} reset dialog;{} install menu (neuer kartenname, FALSE);{} fetch (neuer kartenname, task (mmtaskname));{} rename (neuer kartenname, kartenname);{} command dialogue (TRUE);{} page; out (piep); put (install finished){}END PROC testinstallation;{}END PACKET ls menu generator 2;{} + diff --git a/app/gs.menugenerator/1.0/src/ls-Menu-Generator-gen b/app/gs.menugenerator/1.0/src/ls-Menu-Generator-gen new file mode 100644 index 0000000..9a4c3fc --- /dev/null +++ b/app/gs.menugenerator/1.0/src/ls-Menu-Generator-gen @@ -0,0 +1,30 @@ +(* + + ********************************************************* + ********************************************************* + ** ** + ** ls-Menu-Generator ** + ** GENERATORPROGRAMM ** + ** Version 1.0 ** + ** ** + ** (Stand: 30.03.88) ** + ** ** + ** ** + ** Autor: Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************* + ********************************************************* + + *) + +LET mm taskname = "ls-MENUKARTEN",{} datei 1 = "Generatordatei: Archivmenu",{} datei 2 = "ls-MENUBASISTEXTE",{} datei 3 = "ls-Menu-Generator 1",{} datei 4 = "ls-Menu-Generator 2";{}PROC stelle existenz des mm sicher:{} cursor (1, 5); out (""4"");{} IF NOT exists (task (mm taskname)){} THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");{} FI{}END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{} cursor (1,5); out (""4"");{} + out (" """); out (datei); putline (""" wird geholt.");{} fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{} IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{} hole (datei);{} cursor (1, 5); out (""4"");{} out (" """); out (datei); out (""" wird übersetzt: ");{} insert (datei);{} forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{} cursor (1, 5); out (""4"");{} out (" """); out(datei);{} out (""" wird zum MENUKARTEN-MANAGER geschickt!");{} + command dialogue (FALSE);{} save (datei, task (mm taskname));{} command dialogue (TRUE);{} forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-Menu-Generator/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{} page;{} putline (" "15"ls-Menu-Generator - Automatische Generierung "14"").{} +hole die dateien:{} IF NOT exists (datei 1) COR NOT exists (datei 2){} COR NOT exists (datei 3) COR NOT exists (datei 4){} THEN hole dateien vom archiv{} FI.{}hole dateien vom archiv:{} cursor (1,3);{} say ("Ist das Archiv angemeldet und die "); line;{} IF yes ("'ls-Menu-Generator'-Diskette eingelegt"){} THEN lese ein{} ELSE line (2);{} errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){} FI.{}lese ein:{} cursor (1, 3); out (""4"");{} out (" "15"Bitte die Diskette eingelegt lassen! "14"");{} + IF NOT einzeln{} THEN hole (datei 1);{} hole (datei 2);{} hole (datei 3);{} hole (datei 4);{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} release (archive){} FI.{}insertiere die dateien:{} check off;{} schicke (datei 2);{} in (datei 3);{} in (datei 4);{} IF einzeln THEN release (archive) FI;{} check on.{}mache global manager aus der task:{} global manager.{} + diff --git a/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis new file mode 100644 index 0000000..9507802 --- /dev/null +++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis @@ -0,0 +1,50 @@ +#limit (11.5)##pagelength (16.5)##pageblock# +#start (1.8,0.0)# +Inhaltsverzeichnis + + +1 Was kann gs-MP BAP 3 + +2 Allgemeines zum Simulationsprogramm 6 +2.1 Entstehung 6 +2.2 Beschreibung des Programmkerns 7 + - ein Simulationslauf +2.3 Das Teilprogramm 'Materialprüfung' 9 +2.4 Das Teilprogramm 'Bildschirmarbeitsplatz' 10 +2.5 Hinweise zum Einsatz des Programmsystems 12 +2.6 Erfahrungen mit dem Programmsystem 13 +2.7 Hinweise auf Arbeitsmaterial 14 + +3 Installation von gs-MP BAP 16 +3.1 Voraussetzungen 16 +3.2 Lieferumfang 16 +3.3 Installation 17 +3.4 Organisation des Task - Systems 19 +3.5 Direktstart des Systems 20 + +4 Eine kleine Beispielsitzung 22 +4.1 Aufruf von 'Bildschirmarbeitsplatz' (BAP) 22 +4.2 Einstellung von Simulationsparametern 23 +4.3 Ein Simulationslauf 26 +4.4 Die Simulationsauswertung/das Protokoll 28 +4.5 Hinweise zur Protokollauswertung 36 +4.5.1 Der Bewertungsfaktor 36 +4.5 2 Fehlerzeichenhäufigkeit in den Werkstücken 38 +4.5 3 Fehlerhafte Auswertungen 38 + +5 Beschreibung der Menufunktionen 40 +5.1 Kurzhinweise zur Bedienung der Menus 40 +5.2 Menufunktionen z. Oberbegriff 'Simulation' 44 +5.3 Menufunktionen z. Oberbegriff 'Parameter' 48 +5.4 Menufunktionen z. Oberbegriff 'Konfiguration' 56 +5.5 Menufunktionen z. Oberbegriff 'Dateien' 58 +5.6 Menufunktionen z. Oberbegriff 'Archiv' 60 + +6 Hinweise für den Systembetreuer 61 + + + + + + + diff --git a/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 1 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 1 new file mode 100644 index 0000000..e418764 --- /dev/null +++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 1 @@ -0,0 +1,119 @@ +#type ("12.lq")##limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (3)# +#headodd# +#center#gs-MP BAP#right#% + +#end# +#headeven# +%#center#gs-MP BAP + +#end# +#center#1 + +#center#Was +#center#kann +#center#gs-MP BAP + + + #on("b")#gs-MP BAP#off("b")# ist ein Programm, mit dem die Arbeit +an einem Bildschirmarbeitsplatz unter ganz unter­ +schiedlichen Aspekten simuliert werden kann. Vom +Benutzer wird dabei verlangt, eine Art "Kontrolltä­ +tigkeit am Bildschirm" auszuüben. Während dieser +Arbeit werden Daten über den Arbeitsverlauf erfaßt, +die (später) ausgewertet werden können. + #on("b")#gs-MP BAP#off("b")# ist so gestaltet, daß es für ganz un­ +terschiedliche Zwecke eingesetzt werden kann. Es +ist möglich, sämtliche Simulationsparameter den +eigenen Wünschen und der jeweiligen Situation an­ +zupassen. Daneben besteht die Möglichkeit, die Si­ +mulationsprotokolle offensichtlich oder "heimlich" +zu erfassen. + #on("b")#gs-MP BAP#off("b")# kann dazu benutzt werden, um Anwendern +lediglich die Belastungen eines Bildschirmarbeits­ +platzes an einem Beispiel darzulegen; es ist aber +genauso möglich, ihm eindrucksvoll aufzuzeigen, wie +eine Kontrolle am Bildschirmarbeitsplatz - ohne +sein Wissen - erfolgen kann. Auf der Basis dieser +Erfahrungen lassen sich dann ganz neue Fragestel­ +lungen thematisieren (Möglichkeiten/Befugnis der/ +zur Kontrolle am (Bildschirm-) Arbeitsplatz; Daten­ +schutz; Betriebsvereinbarungen zu Computerarbeits­ +plätzen und vieles mehr). + Durch die Möglichkeit, die Simulationsparameter +vielfältig zu variieren, können verschiedenste Un­ +tersuchungen mit dem Programm durchgeführt werden: +Angefangen von Untersuchungen zur Konzentrations­ +fähigkeit bei unterschiedlichen Umgebungsbedingun­ +gen (z.B. Lichtverhältnisse, Musik am Arbeitsplatz, +etc.), über Untersuchungen zum optimalen Arbeits­ +phasen - Pausen - Rhythmus (z.B. zur Fragestellung, +ob lange Arbeitsphasen mit langen Pausen günstiger +sind als kurze Arbeitsphasen mit immer wieder ein­ +gestreuten kleineren Pausen oder umgekehrt - wenn +die Gesamtzeit konstant ist), bis hin zu Untersu­ +chungen zur Ergonomie von Computerarbeitsplätzen +(z.B. hinsichtlich der Tastaturbelegung, Nützlich­ +keit eines eigenen Cursorblockes, etc.). + Anhand der aufgezeigten Möglichkeiten wird +sicher deutlich, daß der Einsatz des Programms +nicht auf den Informatikunterricht beschränkt ist. +Ebensogut ist, bei entsprechender Fragestellung, +ein Einsatz im gesellschafts- / sozialwissenschaft­ +lichen Unterricht, im Biologieunterricht, in den +kaufmännischen Lernbereichen oder im Technikunter­ +richt denkbar. Das Programm ist auch für die Aufar­ +beitung verschiedener Fragestellungen bei der Vor- +und Nachbereitung von Betriebspraktika geeignet. + Um all diese Möglichkeiten auch den Ausbildern +offenzuhalten, die keinerlei Vorerfahrungen mit +Computern haben, aber dieses Programm einsetzen +möchten, ist die Simulationsumgebung so komforta­ +bel, daß jeder Benutzer innerhalb weniger Minuten +das gesamte Programmsystem überblicken und bedienen +kann. + +- Durch die Einbettung in die komfortable Benut­ + zerschnittstelle #on("b")#gs-DIALOG#off("b")#, sind nur noch wenige + Betriebssystemkommandos zur Bedienung des Sy­ + stems notwendig. + +- Der Benutzer kann jederzeit Informationen über + die Bedienung des Menusystems und die Wirkung + der einzelnen Menufunktionen anfordern, die ihm + daraufhin in den aktuellen Bildschirm eingeblen­ + det werden. + +- Dem Benutzer wird ständig angezeigt, welche Mög­ + lichkeiten der Bedienung bestehen, welche Tasten + wirksam sind und welche Wirkung deren Betätigung + hat. Menufunktionen, deren Wirkungen zu bestimm­ + ten Zeitpunkten sinnlos oder fehlerhaft wären, + werden "inaktiviert", d.h. sind dem Benutzer gar + nicht erst zugänglich. + +- Die Auswertung der Simulationsprotokolle erfolgt + vom Menu aus durch einfaches Ankreuzen der ge­ + wünschten Protokolldateien. Es besteht sowohl + die Möglichkeit, die Auswertungen auf dem Bild­ + schirm anzeigen als auch über den Drucker ausge­ + ben zu lassen. + +- Die Festlegung der Simulationsparameter ist kin­ + derleicht. Die aktuell eingestellten Werte kön­ + nen jederzeit eingesehen werden. Zur Einstellung + werden umfangreiche Informationen und Hilfen + ausgegeben. Eine Fehlbedienung ist ausgeschlos­ + sen. + +- In das System ist eine komfortable Archivbehand­ + lung integriert, so daß auch für den Computer­ + laien die Konservierung der Simulationsergebnis­ + se auf einfachste Weise möglich ist. + +- Bei auftretenden Fehlern erhält der Benutzer + konkrete, verständliche Fehlermeldungen, die + zumeist mit einem Zusatz versehen sind, wie die + "Situation bereinigt werden kann". + diff --git a/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 2 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 2 new file mode 100644 index 0000000..b063ea3 --- /dev/null +++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 2 @@ -0,0 +1,302 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (6)# +#headodd# +#center#gs-MP BAP#right#% + +#end# +#headeven# +%#center#gs-MP BAP + +#end# +#center#2 + +#center#Allgemeines +#center#zum +#center#Simulationsprogramm + + +2.1 Entstehung + + Das Simulationsprogramm #on("b")#gs-MP BAP#off("b")# basiert auf +einer Idee von Hartmut Spenn und Mene Wolf, die +eine Unterrichtsreihe mit dem Titel "Der gläserne +Arbeiter" im Rahmen der Materialien zur Lehrerfort­ +bildung in Nordrhein Westfalen (Neue Technologien, +informations- und kommunikationstechnologische In­ +halte im Wahlpflichtunterricht der Klassen 9/10) +beschrieben und dazu ein Grundprogramm für den C64 +in COMAL geschrieben haben. + Dieses Grundprogramm diente einmal als Ausgangs­ +punkt für #on("b")#gs-MP BAP#off("b")#. Allerdings wuchsen die An­ +sprüche an das System immer mehr, so daß eine Reihe +weiterer Funktionen hinzugefügt wurden. Ein wesent­ +liches Ziel war es, ein Simulationsprogramm zur +Verfügung zu stellen, daß umfangreiche Variations­ +möglichkeiten - ohne jegliche Programmierkenntnisse +- bietet; ein Programm, das selbst von einem völli­ +gen Computerlaien innerhalb weniger Minuten über­ +blickt und sicher bedient werden kann. + + Erst als die komfortable Benutzerschnittstelle +#on("b")#gs-DIALOG#off("b")# zur Verfügung stand, konnte dieses Ziel +erreicht werden. Heute präsentiert sich Ihnen ein +Programmsystem, in dem Sie jede Programmfunktion +von einem Menu aus wählen können. Durch Informa­ +tionstexte, die Sie jederzeit abrufen können, und +durch die Bedienungshinweise werden Sie sicher +durch das Programmsystem geführt. Sie haben komfor­ +table Möglichkeiten, die Simulationsparameter zu +variieren. Das Programmsystem ist gegen Fehlbedie­ +nungen mehrfach abgesichert. + + +2.2 Beschreibung des Programmkerns + - ein Simulationslauf + + Mit #on("b")#gs-MP BAP#off("b")# kann die Arbeit an einem Bild­ +schirmarbeitsplatz simuliert werden. Der Benutzer +übt am Bildschirm eine Art "Kontrolltätigkeit" aus. +Die Interpretation dieser Tätigkeit ist offen: So +kann man sich vorstellen, daß "Werkstücke" auf dem +Bildschirm angezeigt werden, die auf Fehler hin +untersucht werden sollen; dabei muß jeder gefundene +Fehler markiert werden. Der Benutzer kann sich auch +vorstellen, er sei bei einer Tageszeitung beschäf­ +tigt und habe die aus der Redaktion eingehenden +Artikel auf Tippfehler hin zu untersuchen - natür­ +lich müssen die Tippfehler "verbessert" werden. +Andere Interpretationen sind denkbar. + Das Grundprinzip des Simulationslaufes ist recht +einfach - ein typischer Bildschirm könnte so ausse­ +hen: +#free (9.5)# + Im oberen Bereich des Bildschirms werden alle +Daten angezeigt, die der Benutzer während des Simu­ +lationslaufes benötigt. Links oben sind alle Tasten +angegeben, die für die Handhabung des Programms +notwendig sind. Rechts oben wird der Benutzer über +die Simulationszeiten und das festgelegte 'Fehler­ +zeichen' informiert. + Im unteren Bereich des Bildschirms wird ein +rechteckiger Block ausgegeben, der sich aus ver­ +schiedenen Zeichen (z.B. Buchstaben, Ziffern, Son­ +derzeichen) zusammensetzt. Der Benutzer hat jetzt +die Aufgabe, die Blöcke daraufhin zu untersuchen, +ob in ihnen das angegebene Fehlerzeichen auftaucht. + Entdeckt er solche Zeichen im Block auf dem +Bildschirm, so ist es seine Aufgabe, den Cursor +(Lichtfleck) auf dem Bildschirm mit Hilfe festge­ +legter Tasten an die entsprechende Position zu +steuern und eine 'Ausbesserung' (Kennzeichnung/ +Korrektur) vorzunehmen. Ist der Benutzer der Mei­ +nung, alle Fehlerzeichen bearbeitet zu haben, so +kann er den nächsten Block (das nächste Werkstück/ +den nächsten Artikel) durch Tippen einer festgeleg­ +ten Taste anfordern. + Die Arbeit ist dabei streng in 'Arbeitsphasen' +und 'Pausen' eingeteilt - der Rhythmus wird aber +vom Programm und nicht vom Benutzer bestimmt. Wäh­ +rend des Simulationslaufes werden alle wesentlichen +Kenndaten protokolliert. Diese können später ausge­ +wertet werden. + In unserem konkreten Beispiel hat der Benutzer +nach dem Fehlerzeichen 'F' zu suchen. Er hat insge­ +samt 34 Minuten zu arbeiten; dabei ist seine Ar­ +beitszeit eingeteilt in 3 Arbeitsphasen zu je 10 +Minuten mit zwei dazwischenliegenden Pausen von je +2 Minuten. + Zur Bedienung des Systems kann er die (Cursor-) +Pfeiltasten , , und +benutzen; damit kann er den Lichtfleck innerhalb +des Zeichen-Blocks bewegen. Zur Ausbesserung dient +die -Taste. Mit der -Taste kann er je­ +weils die neuen Werkstücke (Artikel) zur Bearbei­ +tung anfordern. + + +2.3 Das Teilprogramm 'Materialprüfung' (MP) + + Gemeinsamer Bestandteil beider Programmteile ist +der sogenannte "Simulationslauf" - ein eben ge­ +schilderter Arbeitsprozeß am Bildschirm. Diesem +Simulationslauf gehen im Teilprogramm 'Materialprü­ +fung' (MP) jedoch noch umfangreiche Informationen +voraus, die dem Benutzer die anschließend zu ver­ +richtende Tätigkeit detailliert erläutern. Gleich +nach Aufruf des Programmteils wird der Benutzer +noch nach einer "Identifikation" gefragt und aufge­ +fordert, z.B. den Vor- und Nachnamen einzugeben. +Die hier eingegebene Kennung ist auch Bestandteil +des Namens des Protokolls, das über den dann fol­ +genden Simulationslauf angelegt wird. + Am Ende des Simulationslaufes wird dem Benutzer, +sofern das System entsprechend konfiguriert ist, +eine 'Kurzauswertung' seiner Arbeit auf dem Bild­ +schirm präsentiert. Zusätzlich wird - ohne daß der +Benutzer es merkt - das angelegte Protokoll in die +Vatertask geschickt und in der eigenen Task ge­ +löscht. + + +2.4 Das Teilprogramm 'Bildschirmarbeitsplatz' + (BAP) + + Nach Aufruf des Teilprogramms erscheint auf dem +Bildschirm ein Menu, von dem aus eine Vielzahl von +Funktionen gewählt werden kann. Natürlich ist es +auch von hier aus möglich, einen oben beschriebenen +Simulationslauf zu starten. Im Gegensatz zum Pro­ +grammteil 'Materialprüfung' wird hier aber auf die +umfangreichen Informationen zur Handhabung des +Systems verzichtet und zum Abschluß auch keine Pro­ +tokolldatei zur Vatertask geschickt - die Proto­ +kolldatei verbleibt in der eigenen Task. + Daneben können vom Menu aus auch Protokolldatei­ +en ausgewertet werden. Sie können dabei noch ent­ +scheiden, ob Sie die Auswertungen auf dem Bild­ +schirm angezeigt oder aber auf dem angeschlossenen +Drucker ausgegeben haben möchten. + Weiterhin können Sie sämtliche Simulationspara­ +meter vom Menu aus Ihren Wünschen gemäß einstellen. +So ist es möglich, die Breite und Höhe des Werk­ +stücks zu variieren und zu entscheiden, ob die +Werkstücke "normal" oder "invers" dargestellt wer­ +den sollen. Sie können das 'Fehlerzeichen' festle­ +gen und überhaupt die Zeichen bestimmen, aus denen +die Werkstücke aufgebaut werden. Daneben haben Sie +noch die Möglichkeit, zu bestimmen, welche Tasten +auf der Tastatur welche Funktion beim Simulations­ +lauf haben sollen. + Sie legen von hier aus auch fest, in wie viele +Arbeitsphasen die Arbeitszeit unterteilt wird und +wie lange eine einzelne Arbeitsphase und die zwi­ +schen den Arbeitsphasen liegende Pause dauern sol­ +len. Auch hinsichtlich der Bewertung können Sie +Festlegungen treffen - nach dem von Ihnen hier ein­ +gestellten Wertungsschlüssel werden nämlich die +Protokolldateien ausgewertet. + Ihnen obliegt es auch, zu bestimmen, ob mit je­ +der Protokollauswertung die umfangreichen Erläute­ +rungen ausgegeben werden sollen und ob der Benutzer +am Ende eines Simulationslaufes eine 'Kurzauswer­ +tung' über seine Arbeit auf dem Bildschirm erhalten +soll oder nicht. + Zusätzlich werden Ihnen noch eine Reihe von Mög­ +lichkeiten zur Datei- und Archivbehandlung angebo­ +ten. So können Sie komfortabel Dateien löschen, +kopieren, umbenennen, etc., Dateien auf Diskette +konservieren oder gespeicherte Dateien von dort +holen und vieles mehr. + + +2.5 Hinweise zum Einsatz des Programmsystems + + Aus den Beschreibungen in 2.3 und 2.4 ist Ihnen +sicher schon die unterschiedliche Absicht, die hin­ +ter den beiden Programmteilen steckt, klar gewor­ +den. Die beiden Programmteile richten sich nämlich +auch an ganz unterschiedliche Nutzergruppen. + Das Teilprogramm 'Materialprüfung' (MP) ist vor­ +nehmlich für den 'unerfahrenen'/'unbefangenen' Be­ +nutzer gedacht. Ihm werden nämlich umfangreiche +Informationen ausgegeben. Mit diesem Programmteil +ist eben auch die "heimliche" Erfassung der Simula­ +tionsdaten möglich. Dieser Teil des Programms wird +sicherlich dann Anwendung finden, wenn die Fragen +um die Möglichkeiten und Gefahren der Kontrolle am +(Bildschirm-) Arbeitsplatz im Vordergrund der Be­ +trachtungen stehen. + Das Teilprogramm 'Bildschirmarbeitsplatz' (BAP) +hat zumindest zwei ganz unterschiedliche Einsatz­ +aspekte: + + Einerseits dient es dem Lehrer/Ausbilder dazu, +die gewünschten Simulationsparameter für das Teil­ +programm 'Materialprüfung' einzustellen. Die aktu­ +elle Einstellung, die mit dem Teilprogramm 'Bild­ +schirmarbeitsplatz' getroffen wurde, ist in der +jeweilgen Task gültig, in der die Einstellung vor­ +genommen wurde. Die Einstellung wird aber auch von +allen Sohntasks übernommen, die sich nach der je­ +weiligen Einstellung neu anmelden. Darüber hinaus +dient dieses Teilprogramm dem Lehrer/Ausbilder +dazu, die (ihm zugestellten) Simulationsprotokolle +auszuwerten. + Andererseits hat das Teilprogramm 'Bildschirm­ +arbeitsplatz' auch einen "eigenen Charakter": +Gerade bei den schon oben angesprochenen Untersu­ +chungen (zur Konzentrationsfähigkeit in Abhängikeit +von verschiedenen Faktoren, zur Bedeutung der Ar­ +beitsphasen-Pausen-Rhythmen, zur 'Ergonomie am Ar­ +beitsplatz', etc.) bietet sich hier ein schneller, +komfortabler Wechsel zwischen Parametereinstellung +und Simulationsläufen - ohne unnötigen Zeitverlust; +erst recht, wenn mehrere Simulationsläufe aufeinan­ +der folgen. + + +2.6 Erfahrungen mit dem Programmsystem + + Das Programmsystem wurde bereits in verschiede­ +nen Klassen/ Kursen ab der Jahrgangsstufe 8 einge­ +setzt, und zwar in verschiedenen Fachbereichen und +Schulformen. Die Akzeptanz ist sehr hoch; die Hand­ +habung des Programmsystems bereitete selbst Kolle­ +gen, die noch nie zuvor an einem Computer gesessen +hatten, keinerlei Schwierigkeiten. Von der Hand­ +habung des Programms her ist deshalb sicher auch +keine Alteruntergrenze hinsichtlich der "Eignung" +anzugeben. + Jedoch scheint eine Bearbeitung mit den oben +angegebenen Zielsetzungen erst auf dem Erfahrungs­ +horizont der Jahrgangsstufe 8 sinnvoll zu sein. +Eine Bearbeitung der Fragestellungen in der von +Hartmut Spenn und Mene Wolf (siehe Kapitel 2.7) +vorgeschlagenen Tiefe scheint allerdings erst am +Ende der Jahrgangsstufe 9 bzw. in der Jahrgangsstu­ +fe 10 erreichbar. + Besonders interessant scheint der Einsatz bei +der Vor- bzw. Nachbereitung von Betriebspraktika zu +sein. Durch die unmittelbare Berührung mit den +"neuen Technologien am Arbeitsplatz" ist das Inter­ +esse an der Bearbeitung entsprechender Fragestel­ +lungen sehr hoch und eine Sensibilisierung für die +angesprochenen Problematiken zu erreichen. + Die angegebenen Fragestellungen im Zusammenhang +mit diesem Programmsystem können auch Thema einer +Projektwoche/von Projekttagen sein. Besonders be­ +währt hat sich hier die Zusammenarbeit mit Kollegen +aus dem gesellschafts-/sozialwissenschaftlichen +Bereich. Ein Unterrichtsgang, z.B. in einen Super­ +markt mit modernen Scannerkassen, bei einer Tages­ +zeitung (Kleinanzeigenaufnahme am Freitag-Vormit­ +tag) o.ä., bei dem die "im Hintergrund (möglicher­ +weise) ablaufenden Prozesse" bewußt gemacht werden, +kann das Vorhaben noch abrunden. + Zum Einsatz in der Sekundarstufe II liegen erst +wenige Erfahrungen vor. Mit Sicherheit bietet das +Programm einen "anderen", interessanten Einstieg in +den Informatikunterricht der Jahrgangsstufe 11 und +kann auch bei der Aufarbeitung entsprechender Fra­ +gestellungen zu späteren Zeitpunkten herangezogen +werden. Erfahrungen aus anderen Fachbereichen lie­ +gen (noch) nicht vor. + + +2.7 Hinweise auf Arbeitsmaterial + + Ausdrücklich sei an dieser Stelle auf die Ausar­ +beitung von Hartmut Spenn und Mene Wolf hingewie­ +sen: + +Spenn, Hartmut; Wolf, Mene; Der gläserne Arbeiter, + Elektronische Leistungs- und Verhaltenskon­ + trolle am Arbeitsplatz + in: Landesinstitut für Schule und Weiterbildung + (Hrsg.), Materialien zur Lehrerfortbildung + in Nordrhein-Westfalen, Heft 4, Neue Tech­ + nologien - Informations- und Kommunuika­ + tionstechnologische Inhalte im Wahlpflicht­ + unterricht der Klassen 9/10, Soest, 1986. + diff --git a/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 3 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 3 new file mode 100644 index 0000000..f589a93 --- /dev/null +++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 3 @@ -0,0 +1,237 @@ +#limit (11.0)##pagelength (16.5)##block##pageblock# +#start (2.0,0.0)# +#page (16)# +#headodd# +#center#gs-MP BAP#right#% + +#end# +#headeven# +%#center#gs-MP BAP + +#end# +#center#3 + +#center#Installation +#center#von +#center#gs-MP BAP + + + Bevor Sie #on("b")#gs-MP BAP#off("b")# auf Ihrem Computer benutzen +können, müssen Sie das Programm zunächst installie­ +ren. Wenn #on("b")#gs-MP BAP#off("b")# auf Ihrem System schon zur Ver­ +fügung steht, können Sie dieses Kapitel ruhig über­ +springen. + + +3.1 Voraussetzungen + + Um #on("b")#gs-MP BAP#off("b")# auf Ihrem Computer betreiben zu +können, muß das EUMEL-Betriebssystem installiert +sein. #on("b")#gs-MP BAP#off("b")# setzt die Multi-User-Version voraus +und ist lauffähig ab Version 1.7.5. #on("b")#gs-MP BAP#off("b")# setzt +weiterhin voraus, daß auf Ihrem Computer bereits +das Programm #on("b")#gs-DIALOG#off("b")# installiert ist. + + +3.2 Lieferumfang + + #on("b")#gs-MP BAP#off("b")# wird auf einer Diskette geliefert, die +alle notwendigen Programme enthält (die Installa­ +tion von #on("b")#gs-DIALOG#off("b")# wird dabei vorausgesetzt!). Um +den Inhalt der Diskette feststellen zu können, +starten Sie Ihr System und bringen es dazu, daß +'gib kommando:' erscheint. Dann legen Sie die Dis­ +kette ein und geben das Kommando: + + archive("gs-MP BAP");list(archive); + release(archive) + + Anschließend erscheint eine Übersicht der auf +dem Archiv vorhandenen Programme. Folgende Program­ +me sollten sich in der Übersicht befinden: + + "gs-MP BAP 1" + "gs-MP BAP 2" + "gs-MENUKARTE:MP-BAP" + "gs-MP BAP/gen" + + Eventuell können noch weitere Namen auf der Dis­ +kette vorhanden sein. Wenn Sie den Inhalt der Dis­ +kette kontrolliert haben und diese Programme auf +der Diskette vorhanden sind, können Sie #on("b")#gs-MP BAP#off("b")# +installieren. + Sollten Sie statt der Übersicht eine Fehlermel­ +dung erhalten, überprüfen Sie bitte, ob die Disket­ +te das richtige Format besitzt oder ob Ihr Disket­ +tenlaufwerk Probleme macht. Sollten dagegen Pro­ +gramme fehlen, so reklamieren Sie die Diskette. + + +3.3 Installation + + #on("b")#gs-MP BAP#off("b")# muß in einer Task installiert werden, +in der bereits das Programm #on("b")#gs-DIALOG#off("b")# zur Verfügung +steht. Alle Söhne und Enkel der neuen Task können +anschließend auf die Programme (Materialprüfung / +Bildschirmarbeitsplatz) zugreifen. Richten Sie also +eine Task als Sohn der Task ein, in der auf Ihrem +Computer bereits #on("b")#gs-DIALOG#off("b")# installiert ist. Wir +nehmen hier an, daß #on("b")#gs-DIALOG#off("b")# in der Task 'MENU' +installiert ist und die neue Task den Namen 'MP +BAP' erhalten soll. (Sie können für die Task auch +einen beliebigen anderen Namen wählen): + +#on("b")# + (Supervisor - Taste) +#off("b")# + + --> gib supervisor kommando: +#on("b")# + begin ("MP BAP","MENU") +#off("b")# + + --> gib kommando: + + (Arbeiten mehrere Personen mit dem Computer, +dann ist es sinnvoll, diese Task vor unbefugtem +Zugriff durch ein Passwort zu schützen. Wie das +gemacht wird, können Sie in Ihrem EUMEL-Benutzer­ +handbuch erfahren.) + + Legen Sie dann die Archivdiskette ein, auf der +sich #on("b")#gs-MP BAP#off("b")# befindet, und geben Sie das folgende +Kommando: + +#on("b")# + archive("gs-MP BAP") + + fetch("gs-MP BAP/gen",archive) + + run +#off("b")# + + Sie haben damit das Generatorprogramm gestartet. +Beantworten Sie die Frage, ob Sie das Archiv ange­ +meldet und die Diskette eingelegt haben, mit 'ja' +durch Tippen der Taste . + Daraufhin wird die Installation automatisch +durchgeführt. Lassen Sie während des gesamten Vor­ +gangs die Archivdiskette eingelegt. Sie erhalten +einen Hinweis, wenn die Diskette entnommen werden +kann! Die Generierung ist beendet, wenn der EUMEL- +Eingangsbildschirm erscheint. Die Task, in der die +Generierung stattfindet, wird automatisch zur Mana­ +gertask, das heißt, daß Söhne von ihr eingerichtet +werden können. + Richten Sie sich gleich eine Sohntask (z.B mit +dem Namen 'mp bap') ein, dann können Sie das System +sofort ausprobieren. Gehen Sie dazu folgendermaßen +vor: + +#on("b")# + (Supervisor - Taste) +#off("b")# + + --> gib supervisor kommando: +#on("b")# + begin ("mp bap","MP BAP") +#off("b")# + + --> gib kommando: + +Mit dem Kommando + +#center##on("b")#mp bzw. bap #off("b")# + +können Sie nun das Programm + +#center#'Materialprüfung' bzw. 'Bildschirmarbeitsplatz' + +aufrufen. + + +3.4 Organisation des Task - Systems + + Wollen Sie unter anderem das Teilprogramm 'Ma­ +terialprüfung' (MP) nutzen, so sollten Sie beden­ +ken, daß die dabei entstehenden Simulationsproto­ +kolle in die Vatertask geschickt werden. Die Vater­ +task sollte sich daher ständig im Wartezustand be­ +finden, um die Protokolle auch aufnehmen zu können. +So kann es sinnvoll sein, eine 'Zwischentask' ein­ +zurichten, damit auch andere ungestört mit dem Si­ +mulationsprogramm arbeiten können. Gehen Sie dazu +etwa folgendermaßen vor: + In der Task 'mp bap', in der Sie bisher gearbei­ +tet haben, geben Sie bei 'gib kommando:' den Be­ +fehl: + + #on("b")#global manager #off("b")# + + Sie gestatten dadurch, daß Söhne dieser Task +eingerichtet werden können. Auf dem Bildschirm er­ +scheint der EUMEL-Eingangsbildschirm. + Alle Anwender (Schüler) melden sich dann als +Sohn der Task 'mp bap' an: + + #on("b")#begin ("Anwender1", "mp bap") #off("b")# + #on("b")#begin ("Anwender2", "mp bap") #off("b")# + #on("b")#begin ("Anwender3", "mp bap") #off("b")# + ... + + Die Simulationsprotokolle finden Sie dann an­ +schließend in der Task 'mp bap'. + + +3.5 Direktstart des Systems + (Steht erst ab gs-DIALOG Version 1.1 zur Ver­ + fügung) + + In den Kapitel 3.3/3.4 haben wir Ihnen gezeigt, +wie sie Sohntasks einrichten und hier durch das +Kommando 'mp' bzw. 'bap' das System aufrufen kön­ +nen. Wenn Sie immer nur mit einer Modellvariante +arbeiten oder vor dem Benutzer die 'gib komman­ +do:'-Ebene verbergen wollen, können Sie das System +auch so einrichten, daß sich sofort nach Einrichten +des Arbeitsbereichs das Menusystem meldet. Für den +Anfänger kann das die Arbeit durchaus erleichtern. + Gehen Sie dazu in die Task, unterhalb der die +Sohntasks eingerichtet werden sollen: + +#on("b")# + (Supervisor - Taste) + +#off("b")# + --> gib supervisor kommando: +#on("b")# + continue ("mp bap") +#off("b")# + + --> gib kommando: +#on("b")# + direktstart ("mp", TRUE) +#off("b")# + + Durch das Kommando haben Sie festgelegt, daß +sich alle Sohntasks direkt mit dem Programm 'Mate­ +rialprüfung' melden. Möchten Sie lieber mit 'Bild­ +schirmarbeitsplatz' arbeiten, ist nur 'mp' durch +'bap' zu ersetzen. In diesem Falle meldet sich das +System gleich mit dem BAP-Menu. + Durch den zweiten Parameter 'TRUE' legen Sie +fest, daß in den Sohntasks nach Verlassen des Menus +die jeweilige Task automatisch gelöscht wird. Statt +'TRUE' können Sie hier auch den Wert 'FALSE' ein­ +tragen. Dann wird nach Verlassen des Menus ange­ +fragt, ob die Task gelöscht werden soll. Wird die +Frage bejaht, wird gelöscht - sonst wird die Task +abgekoppelt (break) und kann durch 'continue' wie­ +der angekoppelt werden. + Anmerkung: In der Task, in der Sie das Kommando +'direktbefehl' gegeben haben, sollte nicht das Kom­ +mando 'monitor' gegeben werden, da Sie durch dieses +Kommando auch diese Task zu einer Task machen, die +sich direkt mit dem Menu meldet und ggf. bei Ver­ +lassen des Menus automatisch gelöscht wird! + diff --git a/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 4 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 4 new file mode 100644 index 0000000..6236d91 --- /dev/null +++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 4 @@ -0,0 +1,638 @@ +#limit (11.0)##pagelength (16.5)##block##pageblock# +#start (2.0,0.0)# +#page (22)# +#headodd# +#center#gs-MP BAP#right#% + +#end# +#headeven# +%#center#gs-MP BAP + +#end# +#center#4 + +#center#Eine +#center#kleine +#center#Beispielsitzung + + +4.1 Aufruf von 'Bildschirmarbeitsplatz' (BAP) + + Wenn Sie, wie in Kapitel 3 beschrieben, eine +Sohntask der Task eingerichtet haben, in der #on("b")#gs-MP +BAP#off("b")# installiert ist, und dort bei 'gib kommando:' +den Befehl: + + #on("b")#bap #off("b")# + +geben, erscheint - nach dem #on("b")#gs-DIALOG#off("b")#-Eingangsbild­ +schirm - das folgende Menu: + +#on("b")# +BAP: Simulation Parameter Konfiguration Dateien Archiv ++-------------------------------+----------------------------------------- +| s Simulation ausführen | +| --------------------------- | +| a Auswertung auf Bildschirm | +| d Drucken von Auswertungen | ++-------------------------------+ + + + + + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +4.2 Einstellung von Simulationsparametern + + Bevor Sie eine Neueinstellung von Simulations­ +parametern vornehmen, sollten Sie sich einen Über­ +blick über die zur Zeit eingestellten Werte ver­ +schaffen. Zwar wäre es möglich, gleich einen Simu­ +lationslauf zu starten, doch müßten Sie dann gleich +34 Minuten arbeiten - denn standardmäßig ist das +Simulationssystem auf 3 Arbeitsphasen von je 10 +Minuten Dauer und zwei dazwischenliegende Pausen +von je 2 Minuten eingestellt. + Wenn Sie sich die Einstellung anzeigen lassen +wollen, müssen Sie das Pull-Down-Menu wechseln. +Gehen Sie als durch Tippen der Pfeiltaste +zum Oberbegriff 'Parameter'. Dadurch wird das fol­ +gende Pull-Down-Menu aufgeschlagen: + +#on("b")# +BAP: Simulation Parameter Konfiguration Dateien Archiv +-------+---------------------------+-------------------------------------- + | e Einstellung anzeigen | + | s Standardwerte | + | ----------------------- | + | b Breite des Werkstücks | + | h Höhe des Werkstücks | + | i Invers-/Normal | + | z Zeichensatz | + | f Fehlerzeichen | + | t Tastenbelegung | + | ----------------------- | + | a Anzahl Arbeitsphasen | + | d Dauer Arbeitsphase | + | p Pausendauer | + | ----------------------- | + | w Wertungsschlüssel | + +---------------------------+ + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +Nach Tippen der Taste (für 'Einstellung anzei­ +gen') erscheint der folgende Bildschirm: + +#on("b")# ++-----------------------------------++-----------------------------------+ +| || Wertungsschlüssel | +| Breite : 15 Zeichen || Bewertungs- | +| Höhe : 12 Zeichen || faktor | +| Darstellung : normal || | +| Zeichensatz : A...Z (26 Zeichen)||1.0| + | +| Fehlerzeichen: F || | + | +| || | + | +| Nach rechts : || | + | +| Nach links : || | + | +| Nach oben : ||0.5| + | +| Nach unten : || | + | +| Ausbesserung : || | + | +| Nächstes : || | + | +| || | + | +| Anzahl der Arbeitsphasen: 3 ||0.0+--|--|--|--|--|--|--|--|--|--| | +| Dauer einer Arbeitsphase: 10 min || 0.0 0.5 1.0| +| Dauer einer Pause : 2 min || | +| || Ausbesserungsrate| +| Simulationsgesamtdauer : 34 min || | ++-----------------------------------++-----------------------------------+ +-------------------------------------------------------------------------- +Zum Weitermachen irgendeine Taste tippen! +#off("b")# + + Oben links wird das "Aussehen" der Werkstücke +auf dem Bildschirm beschrieben. Nach diesen Angaben +sind die Werkstücke 15 Zeichen breit und 12 Zeichen +hoch. Sie werden auf dem Bildschirm normal (nicht +invers) dargestellt. Die Werkstücke werden aus den +Großbuchstaben 'A ... Z' zusammengesetzt, wobei 'F' +das Fehlerzeichen ist, nach dem gesucht werden +soll. + Der Cursor kann mit den Pfeiltasten (, +, und ) innerhalb des Werk­ +stücks bewegt werden. Steht der Cursor auf einem +Fehlerzeichen, so verschwindet es, wenn die - +Taste getippt wird. Nach Tippen der -Taste +erscheint das nächste Werkstück auf dem Bildschirm. + Darunter sind die Informationen angegeben, die +uns eigentlich interessieren: Die Anzahl/Zeiten für +Arbeitsphasen und Pausen. Sie sollen die Simula­ +tionszeiten jetzt so verändern, daß die Gesamtsimu­ +lationszeit 3 Minuten beträgt. Wählen Sie dazu zu­ +erst die Menufunktion 'Anzahl Arbeitsphasen' durch +Tippen der Taste . Dann erscheint auf dem Bild­ +schirm folgendes Bild: + +#on("b")# ++-------------------------++-------------------------------------------+ +| Informationen || Anzahl Arbeitsphasen festlegen: | +| || | +| Kleinster Wert: 2 || Anzahl Arbeitsphasen neu festlegen (j/n)? | +| Größter Wert: 20 || | +| || | +| Eingestellter Wert: 3 || | ++-------------------------++-------------------------------------------+ + + + + +-------------------------------------+ + | Simulationszeiten: | + | | + | Anzahl der Arbeitsphasen: 3 | + | Dauer einer Arbeitsphase: 10 min | + | Dauer einer Pause : 2 min | + | | + | Simulationsgesamtdauer : 34 min | + +-------------------------------------+ + + + Wenn Sie die im Fenster oben rechts gestellte +Frage bejahen (Taste tippen), ändert sich der +Fensterinhalt: + +#on("b")# ++-------------------------++---------------------------------------------+ +| Informationen || Anzahl Arbeitsphasen festlegen: | +| || | +| Kleinster Wert: 2 ||Mit den Pfeilen und den Wert| +| Größter Wert: 20 ||einstellen. Eingabe mit abschließen.| +| || | +| Eingestellter Wert: 3 ||Bitte die Anzahl der Arbeitsphasen: 3 | ++-------------------------++---------------------------------------------+ + + Bestimmt ist Ihnen schon klar, was zu tun ist: +Mit der Pfeiltaste stellen Sie den +kleinstmöglichen Wert (2) ein - anschließend tippen +Sie die -Taste. Schauen Sie auf das Fenster +ganz unten - jetzt hätten Sie nur noch 24 Minuten +zu arbeiten. Bevor Sie die anderen Parameter ein­ +stellen, bestätigen Sie bitte, daß Sie mit der An­ +zahl der Arbeitsphasen einverstanden sind. + Gehen Sie jetzt ebenso vor, um die 'Dauer (ei­ +ner) Arbeitsphase' und die 'Pausendauer' einzustel­ +len - eine Beschreibung dazu ist sicher überflüs­ +sig. + Rechts im Fenster ist noch der 'Wertungsschlüs­ +sel' angegeben - seine Bedeutung erläutern wir aber +erst in Zusammenhang mit der Auswertung der Simula­ +tionsprotokolle. + + +4.3 Ein Simulationslauf + + So, jetzt können Sie zum Ausprobieren einen kur­ +zen Simulationslauf starten. Gehen Sie dazu zurück +zum Pull-Down-Menu ganz links und wählen Sie hier +die Menufunktion 'Simulation ausführen'. Zunächst +werden Sie nach einer "Identifikation" gefragt. +Geben Sie z.B. Ihren Namen ein und tippen Sie an­ +schließend die -Taste. Auf dem Bildschirm +erscheinen oben alle Informationen, die Sie während +der Simulation benötigen; darunter erscheint der +Hinweis, daß mit dem nächsten Tastendruck die erste +Arbeitsphase beginnt. Wenn das erste Werkstück auf +dem Bildschirm erscheint, sieht das z.B. so aus: + +#on("b")# ++-------------------------------+ +-------------------------------------+ +| Nach rechts : | | Anzahl der Arbeitsphasen: 3 | +| Nach links : | | Dauer einer Arbeitsphase: 10 min | +| Nach oben : | | Dauer einer Pause : 2 min | +| Nach unten : | | Simulationsgesamtdauer : 34 min | +| Ausbesserung : | | | +| Nächstes : | | Fehlerzeichen : F | ++-------------------------------+ +-------------------------------------+ + + GFMKLPDRFGTZQAL + RTWOJLMNVWQHTRS + PZBFVDDSWWAFGBD + EWWQAKGHHJINMPA + WSSDEKLJNHHGTFD + GGTEWLVCXFFRPTR + TREKGLMNTREFGTW + TRWFGLMBVCCDSAQ + HGFRWZTCXYAASWW + MNNBHGTREWQKJLO + CCXSDRFGHKLPOZR + RWPPKHJUUZTFDSE + + + Nun dürfen Sie einmal zeigen, was Sie können. +Bitte achten Sie darauf, daß Sie in jeder Arbeits­ +phase mindestens ein Werkstück bearbeiten - sonst +könnte es später zu Fehlern bei der Auswertung kom­ +men. Sie sollen sich ja auch nicht ausruhen, son­ +dern arbeiten! + Pausen werden Ihnen auf dem Bildschirm ange­ +zeigt. Auch wenn Sie weiterarbeiten wollen - um die +Pausen kommen Sie nicht herum! Am Ende einer Pause +wird ein Hinweis auf das Pausenende ausgegeben. + Nach der letzten Arbeitsphase erhalten Sie eine +Kurzauswertung des aktuellen Simualtionslaufes auf +den Bildschirm (wenn Ihnen das nicht gefällt, kön­ +nen Sie das später auch abschalten). Zur Erläute­ +rung der angegebenen Daten in der 'Kurzauswertung' +sehen Sie bitte das folgende Kapitel. + + +4.4 Die Simulationsauswertung/das Simulations­ + protokoll + + Wenn Sie wollen, können Sie das Protokoll, das +über Ihre Arbeit angefertigt wurde, gleich auswer­ +ten lassen. Wählen Sie dazu die Menufunktion 'Aus­ +wertung auf Bildschirm' (im gleichen Pull-Down- +Menu). Ihnen werden jetzt alle Protokolle, die sich +in Ihrer Task befinden, zur Auswahl angeboten. +Wahrscheinlich ist es zur Zeit nur eine Protokoll­ +datei. + Jetzt sehen Sie auch, warum von Ihnen vor Simu­ +lationsbeginn eine "Identifikation" erbeten wurde. +Sie ist Bestandteil des Protokollnamens - danach +können Sie nämlich die Protokolle zuordnen. Verwen­ +den Sie mehrfach die gleiche Identifikation, so +werden die Protokolle in der Reihenfolge ihrer An­ +lage durchnumeriert. + Wenn Sie den/die Dateinamen angekreuzt haben +(z.B. mit ) und die Auswahl durch +verlassen, werden die angekreuzten Protokolldateien +ausgewertet und anschließend auf dem Bildschirm +angezeigt. + Das Protokoll ist jeweils nach folgendem Schema +aufgebaut: Zunächst werden Datum und Uhrzeit des +Simulationslaufs ausgegeben; anschließend alle +Kenndaten der Simulation, so daß daraus die gesamte +Konfiguration des Simulationssystems rekonstruier­ +bar ist. Es folgt die "Gesamtauswertung" des Simu­ +lationslaufes, die identisch ist mit der auf dem +Bildschirm angezeigten 'Kurzauswertung'. Die Ge­ +samtauswertung erfolgt nach den gleichen Grundsät­ +zen wie die sich anschließenden Auswertungen der +einzelnen Werkstücke (es werden hier nur die ggf. +angefallenen Pausenüberschreitung(en) mit in die +Beurteilung einbezogen). + Das Protokoll ist durch die angehängten Bemer­ +kungen nahezu selbsterklärend. Damit Sie sich einen +Eindruck verschaffen können, haben wir auf den +nächsten Seiten ein ausgewertetes Protokoll abge­ +druckt. Bitte studieren Sie es eingehend - insbe­ +sondere die Anmerkungen am Ende des Protokolls: + + + + + + +#on("b")# + gs-Protokoll: TEST - Auswertung + =============================== +Datum : 03.09.87 Uhrzeit (zu Beginn): 10:21 + + Kenndaten der Werkstückbearbeitung: + =================================== +Nach rechts : Anzahl der Arbeitsphasen: 3 +Nach links : Dauer einer Arbeitsphase: 10 min +Nach oben : Dauer einer Pause : 2 min +Nach unten : Simulationsgesamtdauer : 34 min +Ausbesserung : +Nächstes : Fehlerzeichen : F + +Werkstückbreite : 15 Zeichen +Werkstückhöhe : 12 Zeichen +Anzahl Zeichen pro Werkstück : 180 Zeichen +Umfang des Zeichensatzes : A ... Z ( 26 Zeichen) + + Beispielwerkstück: + ------------------ + QQSEUZSTABQBZWI + UKZVNYPHCPLQMGH + NDJZPCMOOPQQICL + ARELRDKUOOZWOIE + NASIPRLRQUKJHGN + YJJVKIGWCJOLRTL + FXSZBOBIBKQPYXN + JJFKFMEVALZNDPU + VTWWIHKWRMPMHZP + CSSFZBOSACLARKQ + WAAIMHJELLFKIWA + XLNHUCZRVXOXHRL + + + + G e s a m t a u s w e r t u n g: + ================================ +Anzahl der vollständig bearbeiteten Werkstücke : 51 +Anzahl der Zeichen pro Werkstück : 180 +Anzahl der insgesamt untersuchten Zeichen : 9180 + +Anzahl der Bedienfehler : 3 + +Anzahl der vorgegebenen Fehler : 363 +Anzahl der Fehlerkorrekturen : 304 +Arbeitszeit (incl. Pausenüberschreitungen) : 1792.5 sec +Anzahl bearbeiteter Zeichen pro Sekunde : 5.1 + +Ausbesserungsrate : 0.8 +Bewertungsfaktor : 0.8 + +Gesamtbewertung (incl. Pausenüberschreitungen) : 4.3 +================================================ ======== +Arbeitszeit (ohne Pausenüberschreitungen) : 1788.5 sec +Anzahl bearbeiteter Zeichen pro Sekunde : 5.1 +Gesamtbewertung (ohne Pausenüberschreitungen) : 4.3 +================================================ ======== + + + Einzelauswertung der Werkstücke: + ================================ + +Werk- | Anzahl | Vorge- | Anzahl | Benö- | Zei- | Aus- |Bewer- | Bewer- +stück- | Be- | gebene | Kor- | tigte | chen | bes- |tungs- | tungs- +nummer | dien- | Feh- | rek- | Zeit | pro | se- |faktor | zahl + | feh- | ler- | turen | [sec] | Se- | rungs-| | + | ler | zahl | | | kunde | rate | | +-------------------------------------------------------------------------- + | | | | | | | | + 1 | 0 | 5 | 3 | 45.6 | 3.9 | 0.6 | 0.6 | 2.4 + 2 | 0 | 10 | 6 | 33.5 | 5.4 | 0.6 | 0.6 | 3.2 + 3 | 0 | 5 | 4 | 35.7 | 5.0 | 0.8 | 0.8 | 4.0 + 4 | 0 | 3 | 3 | 33.9 | 5.3 | 1.0 | 1.0 | 5.3 + 5 | 0 | 10 | 7 | 38.0 | 4.7 | 0.7 | 0.7 | 3.3 + 6 | 0 | 5 | 4 | 37.2 | 4.8 | 0.8 | 0.8 | 3.9 + 7 | 0 | 9 | 8 | 36.9 | 4.9 | 0.9 | 0.9 | 4.3 + 8 | 0 | 5 | 4 | 31.7 | 5.7 | 0.8 | 0.8 | 4.5 + 9 | 0 | 4 | 3 | 27.3 | 6.6 | 0.8 | 0.8 | 4.9 + 10 | 0 | 6 | 6 | 33.3 | 5.4 | 1.0 | 1.0 | 5.4 + 11 | 0 | 3 | 3 | 25.0 | 7.2 | 1.0 | 1.0 | 7.2 + 12 | 0 | 6 | 3 | 28.6 | 6.3 | 0.5 | 0.5 | 3.1 + 13 | 0 | 11 | 10 | 37.9 | 4.7 | 0.9 | 0.9 | 4.3 + 14 | 0 | 4 | 4 | 38.3 | 4.7 | 1.0 | 1.0 | 4.7 + 15 | 0 | 11 | 8 | 39.3 | 4.6 | 0.7 | 0.7 | 3.3 + 16 | 0 | 5 | 4 | 28.4 | 6.3 | 0.8 | 0.8 | 5.1 + 17 | 0 | 4 | 4 | 36.4 | 4.9 | 1.0 | 1.0 | 4.9 + 18 | 0 | 15 | 14 | 44.9 | 4.0 | 0.9 | 0.9 | 3.7 + + PAUSE ---> Überzogen um 2.2 sec + + 19 | 0 | 3 | 3 | 38.9 | 4.6 | 1.0 | 1.0 | 4.6 + 20 | 0 | 11 | 10 | 40.2 | 4.5 | 0.9 | 0.9 | 4.1 + 21 | 0 | 8 | 7 | 34.7 | 5.2 | 0.9 | 0.9 | 4.5 + 22 | 0 | 7 | 5 | 30.3 | 5.9 | 0.7 | 0.7 | 4.2 + 23 | 0 | 4 | 4 | 33.9 | 5.3 | 1.0 | 1.0 | 5.3 + 24 | 0 | 7 | 7 | 39.5 | 4.6 | 1.0 | 1.0 | 4.6 + 25 | 0 | 6 | 4 | 28.1 | 6.4 | 0.7 | 0.7 | 4.3 + 26 | 0 | 11 | 10 | 34.8 | 5.2 | 0.9 | 0.9 | 4.7 + 27 | 0 | 11 | 9 | 34.2 | 5.3 | 0.8 | 0.8 | 4.3 + 28 | 0 | 10 | 8 | 35.0 | 5.1 | 0.8 | 0.8 | 4.1 + 29 | 0 | 9 | 8 | 36.4 | 4.9 | 0.9 | 0.9 | 4.4 + 30 | 0 | 8 | 7 | 34.8 | 5.2 | 0.9 | 0.9 | 4.5 + 31 | 0 | 10 | 8 | 36.2 | 5.0 | 0.8 | 0.8 | 4.0 + 32 | 0 | 10 | 10 | 44.0 | 4.1 | 1.0 | 1.0 | 4.1 + 33 | 0 | 8 | 8 | 44.4 | 4.1 | 1.0 | 1.0 | 4.1 + 34 | 0 | 4 | 3 | 35.6 | 5.1 | 0.8 | 0.8 | 3.8 + + PAUSE ---> Überzogen um 1.8 sec + + 35 | 0 | 8 | 8 | 42.7 | 4.2 | 1.0 | 1.0 | 4.2 + 36 | 1 | 8 | 8 | 45.3 | 4.0 | 1.0 | 1.0 | 4.0 + 37 | 0 | 5 | 5 | 34.3 | 5.2 | 1.0 | 1.0 | 5.2 + 38 | 0 | 5 | 4 | 27.9 | 6.5 | 0.8 | 0.8 | 5.2 + 39 | 0 | 10 | 8 | 39.5 | 4.6 | 0.8 | 0.8 | 3.6 + 40 | 1 | 7 | 6 | 35.5 | 5.1 | 0.9 | 0.9 | 4.3 + 41 | 0 | 3 | 3 | 29.5 | 6.1 | 1.0 | 1.0 | 6.1 + 42 | 0 | 5 | 5 | 30.2 | 6.0 | 1.0 | 1.0 | 6.0 + 43 | 0 | 6 | 3 | 28.0 | 6.4 | 0.5 | 0.5 | 3.2 + 44 | 0 | 5 | 4 | 30.2 | 6.0 | 0.8 | 0.8 | 4.8 + 45 | 0 | 5 | 4 | 33.1 | 5.4 | 0.8 | 0.8 | 4.4 + 46 | 0 | 8 | 7 | 33.7 | 5.3 | 0.9 | 0.9 | 4.7 + 47 | 0 | 9 | 7 | 32.2 | 5.6 | 0.8 | 0.8 | 4.3 + 48 | 0 | 9 | 8 | 37.5 | 4.8 | 0.9 | 0.9 | 4.3 + 49 | 0 | 4 | 4 | 32.0 | 5.6 | 1.0 | 1.0 | 5.6 + 50 | 0 | 9 | 7 | 34.8 | 5.2 | 0.8 | 0.8 | 4.0 + 51 | 1 | 9 | 4 | 29.2 | 6.2 | 0.4 | 0.4 | 2.7 + | | | | | | | | +========================================================================== + +( 52 | 0 | 7 | 7 | 35.9 | 5.0 | 1.0 | 1.0 | 5.0) + + Anmerkungen: + ============= + + - Das zuletzt bearbeitete Werkstück (in der obigen Tabelle unterhalb + der letzten Trennlinie in Klammern angegeben) wurde nicht vollstän- + dig innerhalb der zur Verfügung stehenden Zeit bearbeitet. + Aus diesem Grunde wird es bei der Auswertung (Gesamtwertung) nicht + berücksichtigt! + + - Bei der Auflistung der Daten der einzelnen Werkstücke sind auch die + Pausen eingetragen, so daß sich die einzelnen Arbeitsphasen erken- + nen und miteinander vergleichen lassen. Die dabei notierten Zeiten + geben die Pausenüberschreitungen an. Diese Zeiten bleiben bei der + Betrachtung der einzelnen Werkstücke unberücksichtigt, fließen aber + in die Gesamtauswertung ein! + + - Die Anzahl der Bedienfehler ist ein Maß für die Sicherheit im Um- + gang mit dem System. Bei den weiteren Auswertungen bleibt die Be- + dienfehlerzahl allerdings unberücksichtigt! + + - Die 'Vorgegebene Fehlerzahl', die 'Anzahl Korrekturen' und die 'Be- + nötigte Zeit [sec]' wurden bei der Bearbeitung des Werkstücks er- + faßt. Auf diesen Daten beruhen die folgenden Auswertungen! + + - Da die Werkstücke ganz unterschiedliche Größen haben können, eignet + sich die 'Benötigte Zeit [sec]', die für die Bearbeitung eines je- + den Werkstücks ermittelt wird, als Maß für die "Arbeitsgeschwindig- + keit" nicht! Stattdessen wird ermittelt, wie viele Zeichen pro Se- + kunde "bearbeitet" wurden: + + Anzahl Zeichen pro Werkstück + Zeichen pro Sekunde = ---------------------------- + Benötigte Zeit [sec] + + Die 'Anzahl Zeichen pro Werkstück' kann aus der Werkstückbreite und + Werkstückhöhe ermittelt werden: + + Anzahl Zeichen pro Werkstück = Werkstückbreite * Werkstückhöhe + + - Aus der (zufällig) 'Vorgegebenen Fehlerzahl' und der 'Anzahl Kor- + rekturen' wird die 'Ausbesserungsrate' ermittelt: + + Anzahl Korrekturen + Ausbesserungsrate = ---------------------- + Vorgegebene Fehlerzahl + + Die Ausbesserungsrate gibt an, welcher Anteil der vorhandenen Feh- + ler ausgebessert wurde. Sie ist ein Maß für die Güte der verrichte- + ten Arbeit. + + - Der 'Bewertungsfaktor' ist abhängig von der 'Ausbesserungsrate'. Er + läßt sich aus dem folgenden Diagramm entnehmen: + + Bewertungs- + faktor + + 1.0| + + | + + | + + | + + | + + 0.5| + + | + + | + + | + + | + + 0.0+--|--|--|--|--|--|--|--|--|--| + 0.0 0.5 1.0 + Ausbesserungsrate + + + In diesem Diagramm ist festgelegt, wie die einzelnen 'Ausbesse- + rungsraten' bewertet werden. + + - Am Ende wird die 'Bewertungszahl' folgendermaßen ermittelt: + + Bewertungszahl = Zeichen pro Sekunde * Bewertungsfaktor + + Da der 'Bewertungsfaktor' nur Werte zwischen 0 und 1 annehmen kann, + ist die 'Bewertungszahl' ein Wert zwischen 0 und der 'Zeichen pro + Sekunde'. Die "Arbeitsleistung" war um so größer, je höher die 'Be- + wertungszahl ist. + +Eine weitere Kommentierung des Protokolls dürfte +sich wohl erübrigen, wenn Sie die Anmerkungen in­ +tensiv studiert haben. + + +4.5 Hinweise zur Protokollauswertung + +4.5.1 Der Bewertungsfaktor + + Sie haben sich sicher über den sogenannten 'Be­ +wertungsfaktor' gewundert, der an verschiedenen +Stellen genannt wird - aber bisher unberücksichtigt +blieb. In den bisher aufgezeigten Situationen war +der Bewertungsfaktor identisch mit der 'Ausbesse­ +rungsrate'. Warum dieser Faktor gesondert einge­ +führt wurde, möchten wir an einem kleinen Beispiel +erläutern: + Wenn Ihnen der Auswertalgorithmus vor dem Simu­ +lationslauf bekannt gewesen wäre und Sie die Ab­ +sicht gehabt hätten, eine möglichst hohe Bewer­ +tungszahl zu erzielen, wäre folgende "Arbeitsstra­ +tegie" erfolgversprechend gewesen: + Sobald ein Werkstück auf dem Bildschirm er­ +scheint, bewegen Sie den Cursor schnellstens zum +ersten Fehlerzeichen, das Sie entdecken können und +löschen es mit der Ausbesserungstaste. Sollten zu­ +fällig noch weiterer Fehlerzeichen in unmittelbarer +Nähe zu sehen sein, so können Sie sie ja auch "aus­ +merzen" - aber dann schnell das nächste Werkstück +anfordern usw. + Machen wir uns klar, was das bedeutet: Da sie +das Werkstück in sehr kurzer Zeit bearbeitet haben, +wird der eigentlich entscheidende Faktor hinsicht­ +lich der Auswertung "enorm in die Höhe getrieben" +(die Anzahl der Zeichen pro Sekunde). Da Sie bei +dieser Strategie zumeist nur 2 - 4 Sekunden zur +Bearbeitung eines Werkstücks brauchen, erhalten Sie +- auf das obige Beispielprotokoll bezogen - Werte +zwischen 90.0 und 45.0 (bearbeitete Zeichen pro +Sekunde). + Im Schnitt treten pro Werkstück etwa 7 Fehler­ +zeichen auf (sehen Sie dazu auch unter 'Aufbau der +Werkstücke'), von denen Sie dann eines korrigiert +haben. Sie kommen also auf eine durchschnittliche +Ausbesserungsrate von 0.14. Wäre - wie im obigen +Beispielprotokoll - der Bewertungsfaktor mit der +Ausbesserungsrate identisch, so erhielten Sie Be­ +wertungszahlen zwischen 12.9 und 6.4. Ein deut­ +licher Unterschied zur "Leistung" die im Protokoll +dokumentiert ist - oder? + Das aber ist nicht Sinn der dem Benutzer ge­ +stellten Aufgabe! Es würde auch nicht einer sinn­ +vollen 'Kontrolltätigkeit' entsprechen, wenn derart +viele Fehler unentdeckt blieben. Um hier "regulie­ +rend" einschreiten zu können, ist der 'Bewertungs­ +faktor' eingeführt worden. So können Sie festlegen, +daß Werkstücke, in denen weniger als 80% der Fehler +entdeckt wurden, bei der Auswertung unberücksich­ +tigt bleiben. Sie brauchen dazu nur den Bewertungs­ +schlüssel entsprechend einzustellen. ("Ziehen Sie +dazu bei der Einstellung des Bewertungsschlüssels +die ersten 8 Kreuzchen auf die Grundlinie"). + Anders ausgedrückt: Durch die Manipulation des +Bewertungsschlüssels können Sie die Anforderungen, +die an die Werkstückbearbeitung gestellt werden, +festlegen. Hierdurch entscheiden Sie über die Wer­ +tigkeit von Schnelligkeit und Genauigkeit. + Übrigens wird der zur Simulationszeit einge­ +stellte Wertungsschlüssel mit im Protokoll notiert. +Eine Auswertung des Protokolls mit verschiedenen +Wertungsschlüsseln ist so nicht möglich - und auch +nicht sinnvoll. Denn sonst könnte es ja vorkommen, +daß der Anwender ein ganz anderes Ergebnis in der +Kurzauswertung auf dem Bildschirm gezeigt bekommt +als er nachher im Protokoll nachlesen kann. Wenn +Sie also mit einem veränderten Wertungsschlüssel +arbeiten wollen, müssen Sie ihn #on("u")#vor dem Simula­ +tionslauf#off("u")# eingestellt haben! + + +4.5.2 Fehlerzeichenhäufigkeit in den Werkstücken + + Die Häufigkeit des Auftretens der Fehlerzeichen +in den einzelnen Werkstücken kann deutlich schwan­ +ken. Die Werkstücke werden nämlich mit Hilfe des +Zufallszahlengenerators aufgebaut. Je nach Anzahl +der verschiedenen Zeichen, die in einem Werkstück +auftreten können, ändert sich auch der Anteil der +auftretenden Fehlerzeichen. + In unserem bisher betrachteten Beispiel können +26 verschiedene Buchstaben im Werkstück auftreten. +Ein Werkstück besteht aus 180 Zeichen. In 1/26 al­ +ler Fälle müßte also das Fehlerzeichen auftreten, +d.h. also etwa 7 Fehlerzeichen pro Werkstück - al­ +lerdings auf eine große Anzahl von produzierten +Werkstücken bezogen. Da die Werkstücke zufällig +zusammengesetzt werden, gilt dieser Wert natürlich +nicht für das einzelne Werkstück! + + +4.5.3 Fehlerhafte Auswertungen + + In zwei Situationen kann es zu Fehlern bei der +Auswertung von Protokollen kommen: + + Wurde der Simulationslauf mit der -Taste +rigoros abgebrochen, so ist ggf. eine sinnvolle +Auswertung des Protokolls nicht möglich, da nur +unvollständige Daten vorhanden sind. + + In der letzten Arbeitsphase eines Simulations­ +laufes muß zumindest ein Werkstück angefordert wor­ +den sein. Dehnt ein Anwender die letzte Pause so +lange aus, daß das Pausenende über das Ende der +letzten Arbeitsphase hinausreicht, so erscheinen im +Protokoll keine Werte für die einzelnen Werkstücke +- in der Gesamtauswertung sind (fast) alle Werte +auf '0' gesetzt. + diff --git a/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 5 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 5 new file mode 100644 index 0000000..d08e4a7 --- /dev/null +++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 5 @@ -0,0 +1,699 @@ +#limit (11.0)##pagelength (16.5)##block##pageblock# +#start (2.0,0.0)# +#page (40)# +#headodd# +#center#gs-MP BAP#right#% + +#end# +#headeven# +%#center#gs-MP BAP + +#end# +#center#5 + +#center#Beschreibung +#center#der +#center#Menufunktionen + +#center#(Programmteil 'Bildschirmarbeitsplatz' (BAP)) + + +5.1 Kurzhinweise zur Bedienung des Menus + + Die Bedienung des Menus ist sehr einfach. Eine +ausführliche Beschreibung dazu finden Sie in den +Unterlagen zum Programmsystem #on("b")#gs-DIALOG#off("b")#. An dieser +Stelle sollen nur die wesentlichen Bedienungsvor­ +gänge beschrieben werden. + +- Mit der Tastenfolge können Sie sich + Informationen zur Bedienung des Menusystems in + das Menu einblenden lassen. + +- Mit den Pfeiltasten und können + Sie zwischen den "Oberbegriffen" in der Kopfzei­ + le wählen. Der aktuelle Oberbegriff ist jeweils + invers dargestellt. Das ausgeklappte 'Pull- + Down-Menu' bezieht sich auf diesen invers darge­ + stellten Oberbegriff. + +- Mit den Pfeiltasten und können + Sie zwischen den Menufunktionen wählen, die + Ihnen im aktuellen Pull-Down-Menu zur Auswahl + angeboten werden. Die aktuell angewählte Menu­ + funktion wird jeweils invers dargestellt. Die + Trennlinien, die in einigen Pull-Down-Menus + sichtbar sind, dienen nur der optischen Unter­ + gliederung; sie können nicht angewählt werden + und werden deshalb automatisch übersprungen. Die + einzelnen Menupunkte sind "zyklisch miteinander + verknüpft", das heißt, man gelangt vom untersten + Menupunkt wieder zum obersten und umgekehrt. + Menupunkte, vor denen ein Minuszeichen steht + ('-'), sind (zur Zeit) nicht aktivierbar; auch + sie können nicht angewählt werden und werden + einfach übersprungen. + +- Durch Tippen der Fragezeichentaste () können + Sie sich jeweils zur aktuellen Menufunktion (in­ + vers im Pull-Down-Menu) Informationen in das + Menu einblenden lassen. + +- Um eine Menufunktion ausführen zu lassen, bewe­ + gen Sie sich mit den Pfeiltasten auf die ge­ + wünschte Menufunktion im aktuellen Pull-Down- + Menu und tippen dann die -Taste. Steht + vor dem gewünschten Menupunkt ein einzelner + Buchstabe oder eine Ziffer, so kann durch Tippen + der entsprechenden Taste diese Menufunktion da­ + durch direkt aufgerufen werden. Sobald eine Me­ + nufunktion aufgerufen worden ist, erscheint da­ + vor ein Stern ('*'). Daraus können Sie entneh­ + men, daß das System bereits den Auftrag aus­ + führt. + +- An verschiedenen Stellen werden Fragen an Sie + gerichtet, die Sie mit 'ja' oder 'nein' beant­ + worten müssen. Tippen Sie dazu entsprechend der + Entscheidung die Taste (für 'ja') bzw. + (für 'nein'). + +- Werden Ihnen vom Menu aus Dateinamen zur Auswahl + angeboten, so können Sie den auf dem Bildschirm + sichtbaren Pfeil vor den gewünschten Namen posi­ + tionieren. Mit den Tasten oder kön­ + nen Sie den Namen ankreuzen. Ist die Auswahl + mehrerer Dateinamen möglich, so können Sie den + Vorgang wiederholen. Mit den Tasten oder + können Sie auch ein Kreuz vor einem + Namen wieder löschen. Daneben gibt es noch eini­ + ge Tastenfunktionen, die für die Bedienung recht + hilfreich sein können. Tippen Sie während der + Auswahl die Fragezeichentaste (), so werden + Ihnen alle Bedienungsmöglichkeiten auf dem Bild­ + schirm angezeigt. Eine Auswahl, in der mehrere + Dateien angekreuzt werden dürfen, wird durch die + Tastenfolge verlassen. Anschließend + wird die eingestellte Operation mit den ange­ + kreuzten Dateien ausgeführt. Sind Sie versehent­ + lich in eine solche Auswahl gelangt, so können + Sie den Vorgang durch die Tastenkombination + abbrechen. + +- An einigen Stellen werden Sie aufgefordert, eine + Eingabe zu machen (z.B. einen Dateinamen einzu­ + geben). Wird Ihnen hier ein Vorschlag gemacht, + den Sie akzeptieren, so brauchen Sie zur Bestä­ + tigung nur die -Taste zu tippen. Ge­ + fällt Ihnen der Vorschlag nicht oder wird Ihnen + kein Vorschlag gemacht, so machen Sie bitte die + gewünschte Eingabe. Zum Schreiben stehen Ihnen + alle aus dem Editor bekannten Funktionen zur + Verfügung. Mit der Taste können Sie + Buchstaben löschen, mit einfügen. Die + Eingabe wird durch Tippen der -Taste + abgeschlossen. Ist der von Ihnen gewünschte Name + schon in Ihrer Task vorhanden und steht in der + Fußzeile der Hinweis 'Zeigen: ', dann + können Sie sich auch alle vorhandenen Namen zur + Auswahl anbieten lassen und durch Ankreuzen den + beabsichtigten Namen auswählen. + +- Ihnen können auch mehrere Alternativen angeboten + werden, zwischen denen Sie wählen müssen. In der + untersten Zeile eines solchen Kastens, in denen + Ihnen die Alternativen auf dem Bildschirm einge­ + blendet werden, sind die Möglichkeiten aufge­ + führt, die darüber beschrieben sind. Mit den + Pfeiltasten können sie die Markierung auf die + gewünschte Alternative positionieren und dann + durch die -Taste zur Ausführung bringen. + (Manchmal ist das auch durch Tippen der den Al­ + ternativen vorangestellten Buchstaben oder Zif­ + fern möglich). + +- Durch die Tastenfolge kann das Menu + insgesamt verlassen werden. Damit das nicht ver­ + sehentlich geschieht, wird jeweils die Frage + gestellt, ob Sie das Menu tatsächlich verlassen + wollen. Diese Frage beantworten Sie bitte je + nach Wunsch mit 'ja' oder 'nein' durch Tippen + der Tasten bzw. . + +#page# +5.2 Menufunktionen zum Oberbegriff 'Simulation' + +#on("b")# +BAP: Simulation Parameter Konfiguration Dateien Archiv ++-------------------------------+----------------------------------------- +| s Simulation ausführen | +| --------------------------- | +| a Auswertung auf Bildschirm | +| d Drucken von Auswertungen | ++-------------------------------+ + + + + + + + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +#on("u")##on("b")#s Simulation ausführen#off("b")##off("u")# + Mit dieser Menufunktion starten Sie einen + Simulationslauf. Bevor Sie aber mit der Arbeit + am Bildschirmarbeitsplatz beginnen können, + wird eine "Identifikation" (Vor- und Nachname) + von Ihnen verlangt. Das Protokoll, das bei der + Simulation entsteht, erhält dann die hier ein­ + gegebene Kennung. Geben Sie für mehrere Proto­ + kolle den gleichen Namen an, so werden die + Protokolle in der Reihenfolge ihrer Anlage + durchnumeriert. + Nach Eingabe der Kennung werden oben auf + dem Bildschirm die zur Zeit eingestellten Si­ + mulationsdaten angezeigt - alle Daten, die Sie + zur Bedienung während der Simulation benöti­ + gen. Die eigentliche Simulation beginnt erst + mit dem nächsten Tastendruck; dazu erfolgt ein + Hinweis auf dem Bildschirm. + Nach Abschluß der Simulation wird Ihnen + gegebenenfalls (sehen Sie dazu auch die Menu­ + funktion 'k Kurzauswertung' unter dem Oberbe­ + griff 'Konfiguration') eine Kurzauswertung auf + dem Bildschirm ausgegeben. Anschließend gelan­ + gen Sie zurück in das Menu. + Diese Menufunktion hat eine ähnliche Wir­ + kung wie der Aufruf des Programms 'Material­ + prüfung' (MP). Im Gegensatz zum Aufruf des + Programms 'Materialprüfung' (MP - mit dem Be­ + fehl: mp ) werden hier allerdings kei­ + ne ausführlichen Informationen vor dem eigent­ + lichen Simulationslauf ausgegeben, sondern es + wird nur nach einer Identifikation (Vorname + und Nachname) gefragt. Nach Abschluß der Si­ + mulation verbleibt das Protokoll in der Task - + es wird nicht, wie im Programmteil 'Material­ + prüfung', in die Vatertask geschickt. + +#on("u")##on("b")#a Auswertung auf Bildschirm#off("b")##off("u")# + Alle Simulationsprotokolle, die sich in + Ihrer Task befinden, werden Ihnen zur Auswahl + angeboten. Wenn Sie den/die gewünschten Proto­ + kollnamen angekreuzt und die Auswahl mit der + Tastenfolge verlassen haben, werden + die Protokolle nacheinander in der Ankreuzrei­ + henfolge ausgewertet und die Auswertungen auf + dem Bildschirm angezeigt. + Die gesamte Auswertung kann zwar nicht auf + einmal auf dem Bildschirm angezeigt werden - + Sie können aber das Fenster mit + und rollen und so in die gesamte + Datei Einsicht nehmen. Gegebenenfalls (sehen + Sie dazu auch die Menufunktion 'u Umfang der + Auswertung' unter dem Oberbegriff 'Konfigura­ + tion') werden an das Ende der eigentlichen + Ergebnisse noch Erläuterungen zum Protokoll + ausgegeben. (Zur Protokollauswertung selbst + sehen Sie bitte Kapitel 4.4). Da die Auswer­ + tung jeweils in eine Datei geschrieben wird, + können Sie sie mit der Tastenkombination + verlassen. + + Fehlerfälle: - Sehen Sie dazu bitte Kapitel + 4.5.3 + +#on("u")##on("b")#d Drucken von Auswertungen#off("b")##off("u")# + Alle Simulationsprotokolle, die sich in + Ihrer Task befinden, werden Ihnen zur Auswahl + angeboten. Wenn Sie den/die gewünschten Proto­ + kollnamen angekreuzt und die Auswahl mit der + Tastenfolge verlassen haben, werden + die Protokolle nacheinander in der Ankreuzrei­ + henfolge ausgewertet und die Auswertdateien + zum Drucker geschickt. + #on("b")#ACHTUNG!#off("b")# Zum Ausdruck von Simulationsproto­ + kollen muß unbedingt diese Menufunktion ge­ + wählt werden! Zwar können normale Textdateien + auch mit dem Menupunkt 'Drucken' unter dem + Oberbegriff 'Dateien' ausgedruckt werden - das + gilt aber nicht für die bei den Simulationen + erzeugten Protokolldateien, die Sie am Präfix + 'gs-Protokoll:' erkennen können. + Der Ausdruck der Protokollauswertungen er­ + folgt normalerweise im Standardschrifttyp Ih­ + res Druckers. Es besteht allerdings die Mög­ + lichkeit, einen anderen Schrifttyp für den + Ausdruck der Protokolldateien einzustellen. + Sehen Sie dazu bitte im Kapitel 6 'Hinweise + für den Systembetreuer'. + +#page# +5.3 Menufunktionen zum Oberbegriff 'Parameter' + +#on("b")# +BAP: Simulation Parameter Konfiguration Dateien Archiv +-------+---------------------------+-------------------------------------- + | e Einstellung anzeigen | + | s Standardwerte | + | ----------------------- | + | b Breite des Werkstücks | + | h Höhe des Werkstücks | + | i Invers-/Normal | + | z Zeichensatz | + | f Fehlerzeichen | + | t Tastenbelegung | + | ----------------------- | + | a Anzahl Arbeitsphasen | + | d Dauer Arbeitsphase | + | p Pausendauer | + | ----------------------- | + | w Wertungsschlüssel | + +---------------------------+ + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +#on("u")##on("b")#e Einstellung anzeigen#off("b")##off("u")# + Auf dem Bildschirm erscheinen zwei Fenster. + Im Fenster links werden alle Werte angezeigt, + die die Parameter zur Zeit annehmen. Oben kön­ + nen Sie ablesen, welches Aussehen ein Werk­ + stück nach der augenblicklichen Einstellung + auf dem Bildschirm hätte. Darunter ist angege­ + ben, welche Tasten bei der Bearbeitung der + Werkstücke während des Simulationslauf benutzt + werden können. Unten ist noch aufgeführt, wie + viele Arbeitsphasen vorgesehen sind und wie + lange die Arbeitsphasen, Pausen und die Ge­ + samtsimulation dauern. + Im Fenster rechts wird ein Diagramm ausge­ + geben. Hier ist der Bewertungsfaktors in Ab­ + hängigkeit von der Ausbesserungsrate darge­ + stellt. Hinsichtlich der Bedeutung des Bewer­ + tungsfaktors sehen Sie bitte in Kapitel 4.5.1. + Die Anzeige kann durch Tippen einer belie­ + bigen Taste verlassen werden. + +#on("u")##on("b")#s Standardwerte#off("b")##off("u")# + Mit dieser Menufunktion können Sie mit ei­ + nem Tastendruck die sogenannten "Standardwer­ + te" einstellen - die Werte, die die Parameter + haben, wenn das System "frisch installiert" + ist. + Zur Sicherheit zeigt das System die aktuel­ + len Werte an und erfragt, ob Sie die Standard­ + werte tatsächlich einstellen wollen. Bejahen + Sie diese Frage, so werden alle aktuellen Wer­ + te durch die Standardwerte überschrieben und + auf dem Bildschirm angezeigt. Von dieser Ein­ + stellung ist auch der Wertungsschlüssel be­ + troffen - der aber nicht angezeigt wird. Die + Einstellung wird derart vorgenommen, daß Be­ + wertungsfaktor und Ausbesserungsrate identisch + sind. + +#on("u")##on("b")#b Breite des Werkstücks#off("b")##off("u")# + Mit dieser Menufunktion können Sie die An­ + zahl der Zeichen je Werkstückzeile festlegen. + Im Fenster links oben werden der kleinstmög­ + liche Wert (1), der größtmögliche Wert (70) + und der aktuell eingestellte Wert angezeigt. + Unten erscheint zur Kontrolle ein Werkstück, + das den aktuellen Parameterwerten entspricht. + Im Fenster rechts oben wird an Sie die Fra­ + ge gerichtet, ob Sie tatsächlich eine Verände­ + rung vornehmen möchten. Haben Sie versehent­ + lich diesen Menupunkt gewählt, verneinen Sie + einfach diese Frage (Taste ) und gelangen + so - unter Beibehaltung des z.Z. eingestellten + Wertes - zurück in das Menu. + Bejahen Sie die Frage, so erhalten Sie die + Möglichkeit, den bisher eingestellten Wert mit + der Pfeiltaste zu erhöhen, mit der + Pfeiltaste zu erniedrigen - aller­ + dings nur innerhalb der angezeigten Grenzen. + Wenn Sie die gewünschte Einstellung vorgenom­ + men und die Eingabe durch abgeschlos­ + sen haben, erscheint ein Werkstück in der neu + eingestellten Breite unten auf dem Bildschirm. + Bejahen Sie die Frage, ob Sie mit der Werk­ + stückbreite einverstanden sind, dann gelangen + Sie ins Menu zurück; ansonsten können Sie die + Werkstückbreite nach gleichem Verfahren erneut + einstellen. + +#on("u")##on("b")#h Höhe des Werkstücks#off("b")##off("u")# + Die Einstellung der Werkstückhöhe (Anzahl + Zeichen pro Werkstückspalte) erfolgt analog + zur Einstellung der Werkstückbreite - sehen + Sie bitte dort. + +#on("u")##on("b")#i Invers-/Normal#off("b")##off("u")# + Mit dieser Menufunktion können Sie festle­ + gen, ob das zu bearbeitende Werkstück 'normal' + oder 'invers' dargestellt wird. Diese Darstel­ + lung ist aber immer in Abhängigkeit von der + Grundeinstellung Ihres Bildschirms zu sehen. + Wenn Ihr Bildschirm normalerweise helle Zei­ + chen auf dunklem Grund darstellt, so bedeutet + 'normal' eben diese Einstellung; 'invers' be­ + deutet dann, daß die Zeichen des Werkstücks + dunkel auf hellem Grund dargestellt werden - + bei anderer Bildschirmgrundeinstellung eben + umgekehrt. + Unten auf dem Bildschirm wird Ihnen zur + Kontrolle ein Werkstück in aktueller Darstel­ + lung gezeigt. Im Fenster oben rechts erscheint + die Frage, ob Sie eine Veränderung der augen­ + blicklichen Einstellung wünschen. Je nachdem, + ob Sie die Frage bejahen oder verneinen, wird + eine Veränderung vorgenommen oder nicht. + +#on("u")##on("b")#z Zeichensatz#off("b")##off("u")# + Mit dieser Menufunktion können Sie das Feh­ + lerzeichen festlegen und bestimmen, aus wel­ + chen Zeichen die Werkstücke zusammengesetzt + werden sollen. Bejahen Sie die Frage nach der + Neufestlegung des Zeichensatzes, so werden + Ihnen im Fenster links alle möglichen Zeichen + angezeigt. Die Zeichen werden hier in der Rei­ + henfolge ihres internen Codes ausgegeben. Sie + können nun - indem Sie einfach die entspre­ + chende Taste tippen - eines der angegebenen + Zeichen als 'Fehlerzeichen' bestimmen. Es wird + daraufhin invers dargestellt. + Anschließend können Sie die Zeichen bestim­ + men, die sonst noch im Werkstück vorkommen + sollen. Allerdings sind Sie bei dieser Wahl + nicht so frei wie bei der Wahl des Fehlerzei­ + chens. Es muß sich um einen zusammenhängenden + Bereich von Zeichen handeln, die um das Feh­ + lerzeichen gruppiert sind - 'zusammenhängend' + bezieht sich dabei auf die Reihenfolge der + Zeichen im Fenster links. + Die Festlegung selbst erfolgt in zwei Etap­ + pen. Zuerst können Sie den Bereich der Zeichen + bestimmen, die in der Reihenfolge vor dem Feh­ + lerzeichen stehen. Mit der Pfeiltaste + markieren Sie den Bereich, der vor dem Fehler­ + zeichen liegt; mit der Pfeiltaste + können Sie ggf. die Markierung wieder rückgän­ + gig machen. Wenn Sie so den gewünschten Be­ + reich markiert haben, tippen Sie die + -Taste. + Anschließend bestimmen Sie den Bereich hin­ + ter dem Fehlerzeichen auf vergleichbare Weise + und schließen auch hier die Einstellung mit + der -Taste ab. Daraufhin wird Ihnen + der eingestellte Zeichensatz mit markiertem + Fehlerzeichen noch einmal zur Kontrolle im + Fenster links ausgegeben. Sind Sie mit der + Einstellung einverstanden, so bejahen Sie die + an Sie gerichtete Frage und gelangen ins Menu + zurück; ansonsten können Sie nach gleichem + Verfahren die Einstellung korrigieren. + +#on("u")##on("b")#f Fehlerzeichen#off("b")##off("u")# + Diese Menufunktion ist dann sinnvoll zu + wählen, wenn Sie den eingestellten Zeichensatz + beibehalten und nur das Fehlerzeichen verän­ + dern wollen. Wenn Sie die Frage bejaht haben, + eine Veränderung vornehmen zu wollen, haben + Sie die Möglichkeit, durch Verschiebung der + Markierung im Fenster links (durch die Tasten + und ) das neue Fehlerzeichen + einzustellen. Die Einstellung wird durch + abgeschlossen. Sind Sie mit dem ein­ + gestellten Fehlerzeichen einverstanden, gelan­ + gen Sie zurück ins Menu; ansonsten können Sie + Ihre Einstellung korrigieren. + +#on("u")##on("b")#t Tastenbelegung#off("b")##off("u")# + Mit dieser Menufunktion können Sie die Ta­ + sten bestimmen, die bei einem Simulationslauf + zur Bedienung des Systems benutzt werden kön­ + nen. Ihnen wird im Fenster links oben die ak­ + tuelle Einstellung angezeigt. Haben Sie sich + entschlossen, eine Neueinstellung vorzunehmen, + werden nacheinander die entsprechenden Tasten + erfragt. Sie brauchen dabei jeweils nur die + Taste zu tippen, die Sie für die entsprechende + Funktion vorgesehen haben. + Sie können die Tasten nahezu frei wählen. + Es ist allerdings nicht erlaubt, die - + Taste zu wählen. Ebensowenig wird die Einstel­ + lung akzeptiert, wenn Sie Mehrfachbelegungen + vornehmen, d.h, eine Taste für mehrere Funk­ + tionen vorschlagen. Achten Sie deshalb immer + auf den Kommentar zur Einstellung im Fenster + unten links. Ist die Neueinstellung fehler­ + haft, so erfolgt ein Hinweis darauf - in einem + solchen Falle bleibt die alte Tastenbelegung + erhalten. + +#on("u")##on("b")#a Anzahl Arbeitsphasen#off("b")##off("u")# + Mit dieser Menufunktion können Sie festle­ + gen, in wie viele Arbeitsphasen ein Simula­ + tionslauf jeweils eingeteilt werden soll. Im + Fenster links oben werden der kleinstmögliche + Wert (2), der größtmögliche Wert (20) und der + aktuell eingestellte Wert angezeigt. Im Fen­ + ster unten wird die aktuelle Simulationsdauer + angezeigt. + Im Fenster rechts oben wird an Sie die Fra­ + ge gerichtet, ob Sie tatsächlich eine Verände­ + rung vornehmen möchten. Bejahen Sie die Frage, + so erhalten Sie die Möglichkeit, den bisher + eingestellten Wert mit der Pfeiltaste + zu erhöhen, mit der Pfeiltaste zu + erniedrigen - allerdings nur innerhalb der + angezeigten Grenzen. + Wenn Sie die gewünschte Einstellung vorge­ + nommen und die Eingabe durch abge­ + schlossen haben, erscheinen die neuen Simula­ + tionszeiten im Fenster unten. Bejahen Sie die + Frage, ob Sie mit der Arbeitsphasenanzahl ein­ + verstanden sind, dann gelangen Sie ins Menu + zurück; ansonsten können Sie nach gleichem + Verfahren die getroffene Einstellung korrigie­ + ren. + +#on("u")##on("b")#d Dauer Arbeitsphase#off("b")##off("u")# + Mit dieser Menufunktion können Sie festle­ + gen, wie lange eine Arbeitsphase dauern soll. + Es kann ein Wert zwischen 1 min und 60 min + eingestellt werden. Das Einstellverfahren ver­ + läuft analog zur Festlegung der Anzahl der + Arbeitsphasen - sehen Sie bitte dort. + +#on("u")##on("b")#p Pausendauer#off("b")##off("u")# + Mit dieser Menufunktion können Sie festle­ + gen, wie lange die Pause zwischen je zwei Ar­ + beitsphasen dauern soll. Es kann ein Wert zwi­ + schen 1 min und 30 min eingestellt werden. Das + Einstellverfahren verläuft analog zur Festle­ + gung der Anzahl der Arbeitsphasen - sehen Sie + bitte dort. + +#on("u")##on("b")#w Wertungsschlüssel#off("b")##off("u")# + Mit dieser Menufunktion können Sie den Wer­ + tungsschlüssel festlegen. Zur genauen Erläu­ + terung der Bedeutung des Bewertungsfaktors + sehen Sie bitte Kapitel 4.5.1. + Im Fenster links wird der aktuell einge­ + stellte Wertungsschlüssel angezeigt. Stellen + Sie sich die ins Koordinatensystem eingetrage­ + nen Kreuzchen durch einen Streckenzug verbun­ + den vor. Entscheiden Sie sich für eine Neu­ + festlegung, dann können Sie mit den Pfeil­ + tasten und nacheinander die + einzelnen Kreuzchen im Koordinatensystem nach + oben bzw. nach unten verschieben. + Haben Sie ein Kreuzchen an die gewünschte + Stelle positioniert, so tippen Sie als Kenn­ + zeichen dafür die -Taste. So gelangen + Sie zum nächsten Kreuzchen bzw. nach dem letz­ + ten Kreuzchen zurück in das Fenster oben + rechts. Wenn Sie mit dem eingestellten Wer­ + tungsschlüssel einverstanden sind, gelangen + Sie zurück ins Menu; ansonsten können Sie die + vorgenommene Einstellung korrigieren. + +#page# +5.4 Menufunktionen zum Oberbegriff 'Konfigu­ + ration' + +#on("b")# +BAP: Simulation Parameter Konfiguration Dateien Archiv +--------------------+---------------------------+------------------------- + | u Umfang der Auswertung | + | k Kurzauswertung | + +---------------------------+ + + + + + + + + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + +#on("u")##on("b")#u Umfang der Auswertung#off("b")##off("u")# + Mit dieser Menufunktion können Sie festle­ + gen, ob am Ende einer Protokollauswertung die + sogenannten 'Anmerkungen', die die Zusammen­ + hänge im Protokoll erläutern, jeweils mit aus­ + gegeben werden sollen oder nicht. Die hier + getroffene Festlegung gilt sowohl für die Aus­ + wertung auf dem Bildschirm als auch für den + Ausdruck über einen angeschlossenen Drucker. + Zum Verständnis der Auswertungen sind die + Anmerkungen sehr hilfreich. Hat man aber meh­ + rere Simulationsläufe absolviert, bei denen + der Wertungsschlüssel identisch ist, so wäre + es überflüssig, jeweils die Anmerkungen mit + ausgeben zu lassen. + Die aktuelle Einstellung (mit/ohne Anmer­ + kungen) wird im Fenster links oben angezeigt. + Im Fenster rechts oben wird die Frage ge­ + stellt, ob Sie eine Veränderung der Einstel­ + lung wünschen. Nur wenn Sie diese Frage beja­ + hen, wird die Einstellung verändert; ansonsten + gelangen Sie unter Beibehaltung der alten Ein­ + stellung ins Menu zurück. + +#on("u")##on("b")#k Kurzsauswertung#off("b")##off("u")# + Standardmäßig wird am Ende eines Simula­ + tionslaufes eine Kurzauswertung auf dem Bild­ + schirm ausgegeben. Wenn Sie diese überflüssig + finden oder wenn Sie es aus didaktischen Grün­ + den vorziehen, auf eine solche Kurzauswertung + zu verzichten, können Sie diese Kurzauswertung + durch diese Menufunktion ab- bzw. wieder ein­ + schalten. + Die hier getroffene Einstellung ist auch + gültig für anschließend eingerichtete Sohn­ + tasks - und zwar sowohl für das Teilprogramm + 'Bildschirmarbeitsplatz' als auch für das + Teilprogramm 'Materialprüfung'. + Die aktuelle Einstellung (mit/ohne Kurzaus­ + wertung) wird im Fenster links oben angezeigt. + Im Fenster rechts oben wird die Frage ge­ + stellt, ob Sie eine Veränderung der Einstel­ + lung wünschen. Nur wenn Sie diese Frage beja­ + hen, wird die Einstellung verändert; ansonsten + gelangen Sie unter Beibehaltung der alten Ein­ + stellung ins Menu zurück + +#page# +5.5 Menufunktionen zum Oberbegriff 'Dateien' + +#on("b")# +BAP: Simulation Parameter Konfiguration Dateien Archiv +------------------------------------+-------------------+----------------- + | v Verzeichnis | + | --------------- | + | l Löschen | + | d Drucken | + | --------------- | + | k Kopieren | + | u Umbenennen | + | --------------- | + | s Speicherplatz | + | a Aufräumen | + +-------------------+ + + + + + + + +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + + Die einzelnen Menufunktionen zu diesem Oberbe­ +griff sind detailliert im Handbuch zum Programm +#on("b")#gs-DIALOG#off("b")# beschrieben und können dort nachgeschla­ +gen werden. An dieser Stelle seien nur einige Be­ +sonderheiten genannt, die hinsichtlich des Pro­ +grammsystems #on("b")#gs-MP BAP#off("b")# zutreffen: + Protokolldateien, die während eines Simulations­ +laufs angelegt werden, können Sie am Präfix 'gs- +Protokoll:' erkennen. Diese Protokolldateien können +#on("u")#nicht#off("u")# mit der in diesem Pull-Down-Menu angegebenen +Menufunktion 'd Drucken' über den Drucker ausge­ +druckt werden. Die Simulationsdaten sind in den +Protokolldateien nämlich in einem gesonderten For­ +mat aufgezeichnet, das vom Drucker nicht ausgewer­ +tet werden kann. + Für die Auswertung und den anschließenden Aus­ +druck dieser Protokolldateien ist die Menufunktion +'d Drucken von Auswertungen' unter dem Oberbegriff +'Simulation' bereitgestellt! + Sie können den Protokolldateien mit der Menu­ +funktion 'u Umbenennen' einen neuen Namen geben. +Achten Sie aber #on("u")#unbedingt(!)#off("u")# darauf, daß das Präfix +'gs-Protokoll:' bei der Umbenennung erhalten bleibt +- sonst wird die Datei nicht mehr als Protokollda­ +tei vom Auswertsystem erkannt! + Die eben angesprochenen Protokolldateien können +auch nicht mit der Menufunktion 'a Aufräumen' bear­ +beitet werden, da hier nur "normale" Textdateien +akzeptiert werden - im übrigen sind die Protokoll­ +dateien immer optimal organisiert. + +#page# +5.6 Menufunktionen zum Oberbegriff 'Archiv' + +#on("b")# +BAP: Simulation Parameter Konfiguration Dateien Archiv +------------------------------------------+-------------------------+----- + | r Reservieren | + | n Neue Diskette | + | --------------------- | + | s Schreiben | + | c Checken | + | k Kombination | + | h Holen/Lesen | + | l Löschen | + | --------------------- | + | v Verzeichnis | + | d Drucken | + | --------------------- | + | i Initialisieren | + | z Zieltask einstellen | + +---------------------+ +-------------------------+ + | Dateiaustausch mit: | + | Archiv | + | Archivname: | + | gs-MP BAP | + +---------------------+ +-------------------------------------------------------------------------- +Info:/ Wahl: Ausführen: Verlassen: +#off("b")# + + Die einzelnen Menufunktionen zu diesem Oberbe­ +griff sind detailliert im Handbuch zum Programm +#on("b")#gs-DIALOG#off("b")# beschrieben und können dort nachgeschla­ +gen werden. + + diff --git a/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 6 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 6 new file mode 100644 index 0000000..7d485d7 --- /dev/null +++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 6 @@ -0,0 +1,53 @@ +#limit (11.0)##pagelength (16.5)##block##pageblock# +#start (2.0,0.0)# +#page (61)# +#headodd# +#center#gs-MP BAP#right#% + +#end# +#headeven# +%#center#gs-MP BAP + +#end# +#center#6 + +#center#Hinweise +#center#für den +#center#Systembetreuer + + + Für den Ausdruck von Protokollauswertungen ist +der Standardschrifttyp des Druckers voreingestellt. +Sie haben aber die Möglichkeit, einen anderen +Schrifttyp für den Protokollausdruck einzustellen. +Dafür sind die beiden folgenden Prozeduren vorbe­ +reitet: + +PROC druckereinstellung fuer protokolldatei + (TEXT CONST schrifttyp, REAL CONST linker + rand, oberer rand, schreibfeldbreite, + schreibfeldlaenge) + + Geben Sie einen in Ihrer Installation vorhan­ + denen Schrifttyp an. Beachten Sie bei der + Festlegung der anderen Maße (wie gewohnt in + cm), daß auf dem Schreibfeld 80 Druckpositio­ + nen nebeneinander Platz haben müssen! + + +PROC std druckereinstellung fuer protokolldatei + + Sie können mit diesem Befehl wieder die Ein­ + stellung vornehmen, die sonst standardmäßig + von #on("b")#gs-MP BAP#off("b")# vorgegeben wird: + + schrifttyp : "" (Standard- + schrifttyp) + linker rand : 0.0 (cm) + oberer rand : 0.0 (cm) + schreibfeldbreite : 21.0 (cm) + schreibfeldlaenge : 29.5 (cm) + + + + diff --git a/app/gs.mp-bap/1.1/doc/gs-MP BAP handbuch.impressum b/app/gs.mp-bap/1.1/doc/gs-MP BAP handbuch.impressum new file mode 100644 index 0000000..91c6ce0 --- /dev/null +++ b/app/gs.mp-bap/1.1/doc/gs-MP BAP handbuch.impressum @@ -0,0 +1,104 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#gs-MP BAP + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# + +#free (4.0)##on("b")# +#center#gs-MP BAP + + +#center#Benutzerhandbuch + + +#center#Version 1.0 + + +#off("b")##center#copyright +#center#Eva Latta-Weber +#center#Software- und Hardware-Systeme, 1988 +#center#ERGOS GmbH, 1990 +#page# +#block# +#center#____________________________________________________________________________ + + +Copyright:  ERGOS GmbH   März 1990 + + Alle Rechte vorbehalten. Insbesondere ist die Überführung in + maschinenlesbare Form sowie das Speichern in Informations­ + systemen, auch auszugsweise, nur mit schriftlicher Einwilligung + der ERGOS GmbH gestattet. + + +#center#____________________________________________________________________________ + +Es kann keine Gewähr übernommen werden, daß das Programm für eine +bestimmte Anwendung geeignet ist. Die Verantwortung dafür liegt beim +Anwender. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrektheit und +Vollständigkeit der Angaben kann keine Gewähr übernommen werden. Das +Handbuch kann jederzeit ohne Ankündigung geändert werden. + +Texterstellung :  Dieser Text wurde mit der ERGOS-L3 Textverarbeitung + erstellt und aufbereitet und auf einem Kyocera Laser­ + drucker gedruckt. + + + + +#center#___________________________________________________________________________ + + + +Ergonomic Office Software GmbH + +Bergstr. 7 Telefon: (02241) 63075 +5200 Siegburg Teletex: 2627-2241413=ERGOS + Telefax: (02241) 63078 + + +#center#____________________________________________________________________________ + + + + + + + + + + + + + + + + + diff --git a/app/gs.mp-bap/1.1/source-disk b/app/gs.mp-bap/1.1/source-disk new file mode 100644 index 0000000..1732e99 --- /dev/null +++ b/app/gs.mp-bap/1.1/source-disk @@ -0,0 +1 @@ +informatikpaket/07_gs.mp-bap.img diff --git a/app/gs.mp-bap/1.1/src/ls-MENUKARTE:MP-BAP b/app/gs.mp-bap/1.1/src/ls-MENUKARTE:MP-BAP new file mode 100644 index 0000000..564b07c Binary files /dev/null and b/app/gs.mp-bap/1.1/src/ls-MENUKARTE:MP-BAP differ diff --git a/app/gs.mp-bap/1.1/src/ls-MP BAP 1 b/app/gs.mp-bap/1.1/src/ls-MP BAP 1 new file mode 100644 index 0000000..be7e3d2 --- /dev/null +++ b/app/gs.mp-bap/1.1/src/ls-MP BAP 1 @@ -0,0 +1,119 @@ +PACKET ls mp bap 1 DEFINES (*******************************) + (* *) + stdvoreinstellung der parameter, (* ls-MP BAP 1 *) + werkstueckdefinition, (* Version 1.1 *) + tastendefinition, (* *) + phasendefinition, (* (c) 1987, 1988 *) + bewertungsschluessel, (* by Eva Latta-Weber *) + werkstueckaufhaenger, (* Bielefeld *) + tastenbezeichnung, (* *) + piepse, (*******************************) + + mp bap einstellung anzeigen, + mp bap standardwerte, + mp bap breite des werkstuecks, + mp bap hoehe des werkstuecks, + mp bap invers normal, + mp bap zeichensatz, + mp bap fehlerzeichen, + mp bap tastenbelegung, + mp bap anzahl arbeitsphasen, + mp bap dauer einer arbeitsphase, + mp bap pausendauer, + mp bap wertungsschluessel: + +LET maxspalten = 70,{} maxzeilen = 14,{} kleinster wert = 1,{} oben unten return = ""3""10""13"",{} punkt = "+",{} punkt und zurueck = "+"8"",{} piep = ""7"",{} blank = " ";{}INT VAR aktuelle werkstueckbreite,{} aktuelle werkstueckhoehe,{} kleinster aktueller zeichencode,{} groesster aktueller zeichencode,{} aktuelle anzahl der arbeitsphasen,{} + aktuelle arbeitsphasendauer in minuten,{} aktuelle pausendauer in minuten;{}TEXT VAR aktuelles fehlerzeichen,{} nach rechts,{} nach links,{} nach oben,{} nach unten,{} ausbesserung,{} naechstes;{}BOOL VAR inversdarstellung;{}ROW 11 REAL VAR bewertung;{}WINDOW VAR w1, w2, w3, w4;{}PROC stdvoreinstellung der parameter:{} aktuelle werkstueckbreite := 15;{} aktuelle werkstueckhoehe := 12;{} kleinster aktueller zeichencode := 65;{} + groesster aktueller zeichencode := 90;{} aktuelle anzahl der arbeitsphasen := 3;{} aktuelle arbeitsphasendauer in minuten := 10;{} aktuelle pausendauer in minuten := 2;{} aktuelles fehlerzeichen := "F";{} nach rechts := ""2"";{} nach links := ""8"";{} nach oben := ""3"";{} nach unten := ""10"";{} ausbesserung := ""1"";{} + naechstes := ""27"";{} inversdarstellung := FALSE;{} bewertung := ROW 11 REAL : (0.0, 0.1, 0.2, 0.3, 0.4, 0.5,{} 0.6, 0.7, 0.8, 0.9, 1.0){}END PROC stdvoreinstellung der parameter;{}PROC werkstueckdefinition (INT VAR breite, hoehe, kleinster, groesster,{} TEXT VAR fzeichen, BOOL VAR invers):{} breite := aktuelle werkstueckbreite;{} hoehe := aktuelle werkstueckhoehe;{} + kleinster := kleinster aktueller zeichencode;{} groesster := groesster aktueller zeichencode;{} fzeichen := aktuelles fehlerzeichen;{} invers := inversdarstellung{}END PROC werkstueckdefinition;{}PROC tastendefinition (TEXT VAR rechts, links, hoch, runter, aus, nach):{} rechts := nach rechts;{} links := nach links;{} hoch := nach oben;{} runter := nach unten;{} aus := ausbesserung;{} nach := naechstes{}END PROC tastendefinition;{} +PROC phasendefinition (INT VAR aphasenzahl, aphasendauer, pausendauer):{} aphasenzahl := aktuelle anzahl der arbeitsphasen;{} aphasendauer := aktuelle arbeitsphasendauer in minuten;{} pausendauer := aktuelle pausendauer in minuten{}END PROC phasendefinition;{}PROC bewertungsschluessel (ROW 11 REAL VAR schluessel):{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO 11 REP{} schluessel [zeiger] := bewertung [zeiger]{} PER{}END PROC bewertungsschluessel;{}PROC mp bap einstellung anzeigen:{} aktuellen parameterzustand anzeigen;{} + regenerate menuscreen{}END PROC mp bap einstellung anzeigen;{}PROC mp bap standardwerte:{} standardwerte einstellen;{} regenerate menuscreen{}END PROC mp bap standardwerte;{}PROC mp bap breite des werkstuecks:{} breite des werkstuecks einstellen;{} regenerate menuscreen{}END PROC mp bap breite des werkstuecks;{}PROC mp bap hoehe des werkstuecks:{} hoehe des werkstuecks einstellen;{} regenerate menuscreen{}END PROC mp bap hoehe des werkstuecks;{}PROC mp bap invers normal:{} werkstueckdarstellung einstellen;{} + regenerate menuscreen{}END PROC mp bap invers normal;{}PROC mp bap zeichensatz:{} zeichensatz einstellen;{} regenerate menuscreen{}END PROC mp bap zeichensatz;{}PROC mp bap fehlerzeichen:{} fehlerzeichen veraendern;{} regenerate menuscreen{}END PROC mp bap fehlerzeichen;{}PROC mp bap tastenbelegung:{} tastaturbelegung einstellen;{} regenerate menuscreen{}END PROC mp bap tastenbelegung;{}PROC mp bap anzahl arbeitsphasen:{} anzahl der arbeitsphasen festlegen;{} regenerate menuscreen{}END PROC mp bap anzahl arbeitsphasen;{} +PROC mp bap dauer einer arbeitsphase:{} dauer einer arbeitsphase festlegen;{} regenerate menuscreen{}END PROC mp bap dauer einer arbeitsphase;{}PROC mp bap pausendauer:{} pausendauer festlegen;{} regenerate menuscreen{}END PROC mp bap pausendauer;{}PROC mp bap wertungsschluessel:{} wertungsschluessel veraendern;{} regenerate menuscreen{}END PROC mp bap wertungsschluessel;{}PROC aktuellen parameterzustand anzeigen:{} zeige die fenster;{} fuelle die fenster mit inhalt;{} gib hinweis aus.{} + zeige die fenster:{} w1 := window ( 2, 2, 37, 20);{} w2 := window (41, 2, 38, 20);{} w3 := window ( 1, 1, 79, 24);{} page; show (w1); show (w2).{} fuelle die fenster mit inhalt:{} zeige inhalt fenster 1;{} zeige inhalt fenster 2.{} zeige inhalt fenster 1:{} zeige eingestellte parameter an (w1).{} zeige inhalt fenster 2:{} gib bewertungsschluessel aus (w2).{} gib hinweis aus:{} out footnote (w3, anwendungstext (2)); pause.{}END PROC aktuellen parameterzustand anzeigen;{} +PROC zeige eingestellte parameter an (WINDOW VAR w):{} zeige ueberschrift;{} zeige werkstueckdefinition;{} zeige tastenbelegung;{} zeige simulationszeiten.{} zeige ueberschrift:{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext ( 1)))).{} zeige werkstueckdefinition:{} cursor (w, 2, 3); out (w, anwendungstext ( 6));{} out (w, text (aktuelle werkstueckbreite, 3));{} out (w, anwendungstext (28));{} cursor (w, 2, 4); out (w, anwendungstext ( 7));{} + out (w, text (aktuelle werkstueckhoehe, 3));{} out (w, anwendungstext (28));{} cursor (w, 2, 5); out (w, anwendungstext ( 8));{} IF inversdarstellung{} THEN out (w, anwendungstext (29)){} ELSE out (w, anwendungstext (30)){} FI;{} cursor (w, 2, 6); out (w, anwendungstext ( 9));{} out (w, zeichensatz);{} cursor (w, 2, 7); out (w, anwendungstext (10));{} + out (blank + aktuelles fehlerzeichen).{} zeige tastenbelegung:{} cursor (w, 2, 9); out (w, anwendungstext (11));{} out (w, tastenbezeichnung (nach rechts));{} cursor (w, 2, 10); out (w, anwendungstext (12));{} out (w, tastenbezeichnung (nach links));{} cursor (w, 2, 11); out (w, anwendungstext (13));{} out (w, tastenbezeichnung (nach oben));{} cursor (w, 2, 12); out (w, anwendungstext (14));{} out (w, tastenbezeichnung (nach unten));{} + cursor (w, 2, 13); out (w, anwendungstext (15));{} out (w, tastenbezeichnung (ausbesserung));{} cursor (w, 2, 14); out (w, anwendungstext (16));{} out (w, tastenbezeichnung (naechstes)).{} zeige simulationszeiten:{} cursor (w, 2, 16); out (w, anwendungstext (17));{} out (w, text (aktuelle anzahl der arbeitsphasen, 4));{} cursor (w, 2, 17); out (w, anwendungstext (18));{} out (w, text (aktuelle arbeitsphasendauer in minuten, 4));{} + out (w, anwendungstext (51));{} cursor (w, 2, 18); out (w, anwendungstext (19));{} out (w, text (aktuelle pausendauer in minuten, 4));{} out (w, anwendungstext (51));{} cursor (w, 2, 20); out (w, anwendungstext ( 5));{} out (w, gesamtdauerangabe).{} zeichensatz:{} blank + code (kleinster aktueller zeichencode) + "..." +{} code (groesster aktueller zeichencode) + " (" +{} text (groesster aktueller zeichencode{} + - kleinster aktueller zeichencode + 1, 2) +{} anwendungstext (28) + ")".{} gesamtdauerangabe:{} text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).{} arbeitsdauer:{} aktuelle anzahl der arbeitsphasen{} * aktuelle arbeitsphasendauer in minuten.{} pausendauer:{} (aktuelle anzahl der arbeitsphasen - 1){} * aktuelle pausendauer in minuten.{}END PROC zeige eingestellte parameter an;{}PROC gib bewertungsschluessel aus (WINDOW VAR w):{} zeichne koordinatenkreuz;{} + trage messwerte ein.{} zeichne koordinatenkreuz:{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext ( 4))));{} cursor (w, 2, 3); out (w, anwendungstext (20));{} cursor (w, 2, 4); out (w, anwendungstext (21));{} cursor (w, 2, 6); out (w, anwendungstext (23));{} cursor (w, 2, 7); out (w, anwendungstext (22));{} cursor (w, 2, 8); out (w, anwendungstext (22));{} cursor (w, 2, 9); out (w, anwendungstext (22));{} cursor (w, 2, 10); out (w, anwendungstext (22));{} + cursor (w, 2, 11); out (w, anwendungstext (24));{} cursor (w, 2, 12); out (w, anwendungstext (22));{} cursor (w, 2, 13); out (w, anwendungstext (22));{} cursor (w, 2, 14); out (w, anwendungstext (22));{} cursor (w, 2, 15); out (w, anwendungstext (22));{} cursor (w, 2, 16); out (w, anwendungstext (25));{} cursor (w, 2, 17); out (w, anwendungstext (26));{} cursor (w, 2, 19); out (w, anwendungstext (27)).{} trage messwerte ein:{} INT CONST abszisse :: 16, ordinate :: 2;{} + INT VAR nr;{} FOR nr FROM 1 UPTO 11 REP{} zeichne einen punkt{} PER.{} zeichne einen punkt:{} cursor (w, ordinate + 3 * nr, abszisse - nachkommastelle); out (punkt).{} nachkommastelle:{} int(bewertung [nr] * 10.0).{}END PROC gib bewertungsschluessel aus;{}PROC standardwerte einstellen:{} zeige fenster;{} zeige eingestellte parameter an (w1);{} gib information aus;{} hole bestaetigung ein.{} zeige fenster:{} w1 := window ( 2, 2, 37, 20);{} w2 := window (41, 10, 37, 12);{} + w3 := window (41, 2, 37, 6);{} page; show (w1); show (w2); show (w3).{} gib information aus:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (67));{} cursor (w2, 2, 4); out (w2, anwendungstext (68));{} cursor (w2, 2, 7); out (w2, anwendungstext (69));{} cursor (w2, 2, 9); out (w2, anwendungstext (70));{} cursor (w2, 2,10); out (w2, anwendungstext (71));{} cursor (w2, 2,11); out (w2, anwendungstext (72));{} + cursor (w2, 2,12); out (w2, anwendungstext (73)).{} hole bestaetigung ein:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (66))));{} cursor (w3, 2, 3);{} IF yes (w3, anwendungstext (66)){} THEN stdvoreinstellung der parameter;{} gib positive rueckmeldung{} FI.{} gib positive rueckmeldung:{} page (w1);{} zeige eingestellte parameter an (w1);{} cleop (w3, 2, 3); out (anwendungstext (221));{} cursor (w3, 2, 5); out (anwendungstext ( 3));{} + pause.{}END PROC standardwerte einstellen;{}PROC breite des werkstuecks einstellen:{} zeige die fenster;{} hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{} zeige die fenster:{} w1 := window ( 2, 2, 26, 6);{} w2 := window (30, 2, 48, 6);{} w3 := window (2, 9, 77, 16);{} page; show (w1); show (w2).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} + cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (kleinster wert, 3));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} out (w1, text (maxspalten, 3));{} cursor (w1, 2, 6); out (w1, anwendungstext (55));{} out (w1, text (aktuelle werkstueckbreite, 3)).{} erfrage veraenderung:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (57))));{} cursor (w2, 2, 3);{} IF no (anwendungstext (216)){} + THEN LEAVE breite des werkstuecks einstellen{} FI.{} neuen wert vom bildschirm holen:{} cleop (w2, 2, 3); out (w2, anwendungstext (58));{} cursor (w2, 2, 4); out (w2, anwendungstext (59));{} cursor (w2, 2, 6); out (w2, anwendungstext (60));{} aktuelle werkstueckbreite := ermittelter wert (1, maxspalten,{} aktuelle werkstueckbreite).{} benutzer ist einverstanden :{} gib aktuelle infos aus;{} hole bestaetigung.{} gib aktuelle infos aus:{} + hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} cleop (w2, 1, 3).{} hole bestaetigung:{} cursor (w2, 2, 3);{} IF yes (w2, anwendungstext (62)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC breite des werkstuecks einstellen;{}PROC hoehe des werkstuecks einstellen:{} fenster zeigen;{} hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{} + fenster zeigen:{} w1 := window ( 2, 2, 26, 6);{} w2 := window (30, 2, 48, 6);{} w3 := window (2, 9, 77, 16);{} page; show (w1); show (w2).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (kleinster wert, 3));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} out (w1, text (maxzeilen, 3));{} cursor (w1, 2, 6); out (w1, anwendungstext (55));{} + out (w1, text (aktuelle werkstueckhoehe, 3)).{} erfrage veraenderung:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (63))));{} cursor (w2, 2, 3);{} IF no (anwendungstext (217)){} THEN LEAVE hoehe des werkstuecks einstellen{} FI.{} neuen wert vom bildschirm holen:{} cleop (w2, 2, 3); out (w2, anwendungstext (58));{} cursor (w2, 2, 4); out (w2, anwendungstext (59));{} cursor (w2, 2, 6); out (w2, anwendungstext (64));{} aktuelle werkstueckhoehe := ermittelter wert (1, maxzeilen,{} + aktuelle werkstueckhoehe).{} benutzer ist einverstanden :{} gib aktuelle infos aus;{} hole bestaetigung.{} gib aktuelle infos aus:{} hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} cleop (w2, 1, 3).{} hole bestaetigung:{} cursor (w2, 2, 3);{} IF yes (w2, anwendungstext (65)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC hoehe des werkstuecks einstellen;{}PROC werkstueckdarstellung einstellen:{} fenster zeigen;{} + hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} REP{} bestaetigung einholen;{} hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3){} UNTIL benutzer ist einverstanden PER.{} fenster zeigen:{} w1 := window ( 2, 2, 28, 6);{} w2 := window (32, 2, 46, 6);{} w3 := window ( 2, 9, 77, 16);{} page; show (w1); show (w2).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} cursor (w1, 2, 3); out (w1, anwendungstext (74));{} + out (w1, anwendungstext (76));{} cursor (w1, 2, 4); out (w1, anwendungstext (74));{} out (w1, anwendungstext (77));{} cursor (w1, 2, 6); out (w1, anwendungstext (75));{} IF inversdarstellung{} THEN out (w1, anwendungstext (77)){} ELSE out (w1, anwendungstext (76)){} FI.{} bestaetigung einholen:{} page (w2);{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (89))));{} + cursor (w2, 2, 3);{} IF yes (w2, anwendungstext (78)){} THEN veraendere darstellungsart{} ELSE LEAVE werkstueckdarstellung einstellen{} FI.{} veraendere darstellungsart:{} IF inversdarstellung{} THEN inversdarstellung := FALSE{} ELSE inversdarstellung := TRUE{} FI.{} benutzer ist einverstanden:{} cleop (w2, 1, 3);{} cursor (w2, 2, 3);{} IF yes (w2, anwendungstext (99)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC werkstueckdarstellung einstellen;{} +PROC zeichensatz einstellen:{} zeige fenster;{} gib eingestellten zeichensatz an;{} gib bedienhinweise aus;{} erfrage neueinstellung;{} REP{} erfrage das neue fehlerzeichen;{} ermittle das kleinste zeichen;{} ermittle das groesste zeichen;{} page (w1);{} gib eingestellten zeichensatz an{} UNTIL benutzer ist einverstanden PER.{} zeige fenster:{} w1 := window ( 2, 2, 28, 22);{} w2 := window (32, 10, 46, 14);{} w3 := window (32, 2, 46, 6);{} page; show (w1); show (w2); show (w3).{} + gib eingestellten zeichensatz an:{} cursor (w1, 1, 1);{} out (w1, center (w1, invers (anwendungstext (79))));{} gib zeichenkette aus (w1, kleinster aktueller zeichencode,{} groesster aktueller zeichencode,{} code (aktuelles fehlerzeichen)).{} gib bedienhinweise aus:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (80));{} cursor (w2, 2, 4); out (w2, anwendungstext (81));{} + cursor (w2, 2, 5); out (w2, anwendungstext (82));{} cursor (w2, 2, 6); out (w2, anwendungstext (83));{} cursor (w2, 2, 8); out (w2, anwendungstext (84));{} cursor (w2, 2, 9); out (w2, anwendungstext (85));{} cursor (w2, 2,10); out (w2, anwendungstext (86));{} cursor (w2, 2,12); out (w2, anwendungstext (87));{} cursor (w2, 2,13); out (w2, anwendungstext (88)).{} erfrage neueinstellung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (90))));{} cursor (w3, 2, 3);{} + IF no (w3, anwendungstext (91)){} THEN LEAVE zeichensatz einstellen{} FI.{} erfrage das neue fehlerzeichen:{} gib vollstaendigen zeichensatz aus;{} gib fehlerzeicheninformationen aus;{} REP{} lasse fehlerzeichen eingeben{} UNTIL fehlerzeichen ist ok PER.{} gib vollstaendigen zeichensatz aus:{} page (w1); page (w2); page (w3);{} cursor (w1, 1, 1);{} out (w1, center (w1, invers (anwendungstext (92))));{} gib zeichenkette aus (w1, 33, 126, 0).{} gib fehlerzeicheninformationen aus:{} + cursor (w2, 1, 1);{} out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (95));{} cursor (w2, 2, 4); out (w2, anwendungstext (96));{} cursor (w2, 2, 6); out (w2, anwendungstext (97)).{} lasse fehlerzeichen eingeben:{} cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (100))));{} cursor (w3, 2, 3);{} out (w3, anwendungstext (101));{} cursor on; inchar (aktuelles fehlerzeichen); cursor off;{} IF fehlerzeichen ist ok{} + THEN out (w3, aktuelles fehlerzeichen);{} markiere das fehlerzeichen im ersten fenster;{} ELSE lege beschwerde ein{} FI.{} fehlerzeichen ist ok:{} code (aktuelles fehlerzeichen) >= 33{} AND code (aktuelles fehlerzeichen) <= 126.{} markiere das fehlerzeichen im ersten fenster:{} positioniere cursor in zeichenkette (w1, 33, code (aktuelles fehlerzeichen));{} out (w1, invers (aktuelles fehlerzeichen)).{} lege beschwerde ein:{} piepse;{} cursor (w2, 2, 8); out (w2, anwendungstext (102));{} + cursor (w2, 2,10); out (w2, anwendungstext (103));{} cursor (w2, 2,11); out (w2, anwendungstext (104));{} cursor (w2, 2,12); out (w2, anwendungstext (105));{} cursor (w2, 2,13); out (w2, anwendungstext (106));{} cursor (w2, 2,14); out (w2, anwendungstext (107)).{} ermittle das kleinste zeichen:{} page (w2); page (w3);{} gib kleinste zeichencode informationen aus;{} lasse den vorbereich festlegen.{} ermittle das groesste zeichen:{} lasse den nachbereich festlegen.{} gib kleinste zeichencode informationen aus:{} + cursor (w2, 1, 1);{} out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (111));{} cursor (w2, 2, 4); out (w2, anwendungstext (112));{} cursor (w2, 2, 5); out (w2, anwendungstext (113));{} cursor (w2, 2, 6); out (w2, anwendungstext (114));{} cursor (w2, 2, 8); out (w2, anwendungstext (115));{} cursor (w2, 2, 9); out (w2, anwendungstext (116));{} cursor (w2, 2,10); out (w2, anwendungstext (117));{} cursor (w2, 2,11); out (w2, anwendungstext (118));{} + cursor (w2, 2,13); out (w2, anwendungstext (119));{} cursor (w2, 2,14); out (w2, anwendungstext (120)).{} lasse den vorbereich festlegen:{} INT VAR s, z; page (w3); cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (121))));{} cursor (w3, 2, 3); out (w3, anwendungstext (122));{} cursor (w3, 2, 4); out (w3, anwendungstext (123));{} cursor (w3, 2, 5); out (w3, anwendungstext (125));{} get cursor (s, z); cursor on;{} kleinster aktueller zeichencode := code (aktuelles fehlerzeichen);{} + groesster aktueller zeichencode := code (aktuelles fehlerzeichen);{} kleinster aktueller zeichencode := eingabe mit intervallanzeige ( w1, 33,{} code (aktuelles fehlerzeichen),{} kleinster aktueller zeichencode, s, z);{} cursor off.{} lasse den nachbereich festlegen:{} cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (121))));{} cursor (w3, 2, 3); out (w3, anwendungstext (122));{} cursor (w3, 2, 4); out (w3, anwendungstext (124));{} + cursor (w3, 2, 5); out (w3, anwendungstext (125));{} get cursor (s, z); cursor on;{} groesster aktueller zeichencode := eingabe mit intervallanzeige ( w1,{} code (aktuelles fehlerzeichen), 126,{} groesster aktueller zeichencode, s, z);{} cursor off.{} benutzer ist einverstanden:{} page (w3); cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (90))));{} cursor (w3, 2, 3);{} IF yes (w3, anwendungstext (126)){} + THEN TRUE{} ELSE FALSE{} FI.{}END PROC zeichensatz einstellen;{}PROC fehlerzeichen veraendern:{} fenster zeigen;{} gib eingestellten zeichensatz an;{} gib bedienhinweise aus;{} erfrage neueinstellung;{} REP{} lasse fehlerzeichen einstellen{} UNTIL benutzer ist einverstanden PER.{} fenster zeigen:{} w1 := window ( 2, 2, 28, 22);{} w2 := window (32, 10, 46, 14);{} w3 := window (32, 2, 46, 6);{} page; show (w1); show (w2); show (w3).{} gib eingestellten zeichensatz an:{} + cursor (w1, 1, 1);{} out (w1, center (w1, invers (anwendungstext (79))));{} gib zeichenkette aus (w1, kleinster aktueller zeichencode,{} groesster aktueller zeichencode,{} code (aktuelles fehlerzeichen)).{} gib bedienhinweise aus:{} cursor (w2, 1, 1);{} out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (131));{} cursor (w2, 2, 4); out (w2, anwendungstext (132));{} cursor (w2, 2, 5); out (w2, anwendungstext (133));{} + cursor (w2, 2, 7); out (w2, anwendungstext (134));{} cursor (w2, 2, 8); out (w2, anwendungstext (135));{} cursor (w2, 2, 9); out (w2, anwendungstext (136)).{} erfrage neueinstellung:{} cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (130))));{} cursor (w3, 2, 3);{} IF no (w3, anwendungstext (137)){} THEN LEAVE fehlerzeichen veraendern{} FI.{} lasse fehlerzeichen einstellen:{} INT VAR s, z, fehlercode :: code (aktuelles fehlerzeichen);{} page (w3); cursor (w3, 1, 1);{} + out (w3, center (w3, invers (anwendungstext (138))));{} cursor (w3, 2, 3); out (w3, anwendungstext (139));{} cursor (w3, 2, 4); out (w3, anwendungstext (140));{} cursor (w3, 2, 5); out (w3, anwendungstext (141));{} get cursor (s, z); cursor on;{} fehlercode := eingabe mit elementanzeige (w1,{} kleinster aktueller zeichencode,{} groesster aktueller zeichencode,{} fehlercode, s, z);{} + cursor off;{} aktuelles fehlerzeichen := code (fehlercode).{} benutzer ist einverstanden:{} page (w3); cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (130))));{} cursor (w3, 2, 3);{} IF yes (w3, anwendungstext (142)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC fehlerzeichen veraendern;{}PROC tastaturbelegung einstellen:{} ROW 6 TEXT VAR tastenname, taste;{} fenster zeigen;{} REP{} tastaturneubelegung vornehmen{} UNTIL benutzer ist einverstanden PER.{} + fenster zeigen:{} w1 := window ( 2, 2, 28, 10);{} w2 := window ( 2, 14, 28, 10);{} w3 := window (32, 10, 46, 14);{} w4 := window (32, 2, 46, 6);{} page; show (w1); show (w2); show (w3); show (w4).{} tastaturneubelegung vornehmen:{} alte tastenbelegung einlesen;{} tastenbelegung anzeigen;{} bedienhinweise ausgeben;{} veraenderung erfragen;{} neue tastenbelegung erfragen;{} hinweis zur bewertung und stand ausgeben.{} alte tastenbelegung einlesen:{} INT VAR z1;{} + FOR z1 FROM 1 UPTO 6 REP{} tastenname [z1] := anwendungstext (z1 + 10){} PER;{} taste [1] := nach rechts;{} taste [2] := nach links;{} taste [3] := nach oben;{} taste [4] := nach unten;{} taste [5] := ausbesserung;{} taste [6] := naechstes;{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (151)))).{} tastenbelegung anzeigen:{} INT VAR cspa, czei;{} cursor (w1, 2, 3); out (w1, tastenname [1]);{} out (w1, tastenbezeichnung (taste [1]));{} + get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2, 4); out (w1, tastenname [2]);{} out (w1, tastenbezeichnung (taste [2]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2, 5); out (w1, tastenname [3]);{} out (w1, tastenbezeichnung (taste [3]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2, 6); out (w1, tastenname [4]);{} + out (w1, tastenbezeichnung (taste [4]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2, 8); out (w1, tastenname [5]);{} out (w1, tastenbezeichnung (taste [5]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2,10); out (w1, tastenname [6]);{} out (w1, tastenbezeichnung (taste [6]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei).{} + bedienhinweise ausgeben:{} cursor (w2, 1, 1); out (center (w2, invers (anwendungstext (152))));{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (52))));{} cursor (w3, 2, 3); out (w3, anwendungstext (153));{} cursor (w3, 2, 4); out (w3, anwendungstext (154));{} cursor (w3, 2, 6); out (w3, anwendungstext (155));{} cursor (w3, 2, 7); out (w3, anwendungstext (156));{} cursor (w3, 2, 8); out (w3, anwendungstext (157));{} cursor (w3, 2, 9); out (w3, anwendungstext (158));{} + cursor (w3, 2,11); out (w3, anwendungstext (159));{} cursor (w3, 2,12); out (w3, anwendungstext (160));{} cursor (w3, 2,13); out (w3, anwendungstext (161));{} cursor (w3, 2,14); out (w3, anwendungstext (162)).{} veraenderung erfragen:{} cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{} cursor (w4, 2, 3);{} IF no (w4, anwendungstext (164)){} THEN LEAVE tastaturbelegung einstellen{} FI.{} neue tastenbelegung erfragen:{} INT VAR z2; page (w4);{} + cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{} cursor (w4, 2, 3); out (w4, anwendungstext (165));{} FOR z2 FROM 1 UPTO 6 REP{} gib tastenhinweis;{} hole tastatureingabe;{} tastenbelegung anzeigen{} PER.{} gib tastenhinweis:{} cleol (w4, 2, 5); out (w4, tastenname [z2]).{} hole tastatureingabe:{} INT VAR s, z; get cursor (w4, s, z);{} cursor on; inchar (taste [z2]); cursor off;{} cursor (w4, s, z); out (w4, tastenbezeichnung (taste [z2])).{} + hinweis zur bewertung und stand ausgeben:{} IF neue tastenbelegung ist ok{} THEN akzeptiere{} ELSE akzeptiere nicht{} FI.{} neue tastenbelegung ist ok:{} INT VAR zeiger; TEXT VAR tastenkette :: "";{} FOR zeiger FROM 1 UPTO 6 REP{} IF pos (tastenkette, taste [zeiger]) > 0{} THEN LEAVE neue tastenbelegung ist ok WITH FALSE{} ELSE tastenkette CAT taste [zeiger]{} FI{} PER;{} TRUE.{} akzeptiere:{} cursor (w2, 3, 4);{} out (w2, anwendungstext (166));{} + cursor (w2, 7, 6);{} out (w2, anwendungstext (167)).{} akzeptiere nicht:{} cursor (w2, 3, 3); out (w2, anwendungstext (168));{} cursor (w2, 3, 4); out (w2, anwendungstext (169));{} cursor (w2, 3, 6); out (w2, anwendungstext (170));{} cursor (w2, 3, 7); out (w2, anwendungstext (171));{} cursor (w2, 3, 9); out (w2, anwendungstext (172));{} cursor (w2, 5,10); out (w2, anwendungstext (173)).{} benutzer ist einverstanden:{} page (w4);{} cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{} + IF neue tastenbelegung ist ok{} THEN gib hinweis auf abspeicherung{} ELSE frage nach neueingabe{} FI.{} gib hinweis auf abspeicherung:{} cursor (w4, 3, 3); out (w4, anwendungstext (174));{} neue tastenbelegung festschreiben;{} cursor (w4, 3, 5); out (w4, anwendungstext ( 2));{} cursor on; pause; cursor off;{} TRUE.{} neue tastenbelegung festschreiben:{} nach rechts := taste [1];{} nach links := taste [2];{} nach oben := taste [3];{} nach unten := taste [4];{} + ausbesserung := taste [5];{} naechstes := taste [6].{} frage nach neueingabe:{} cursor (w4, 2, 3);{} IF yes (w4, anwendungstext (175)){} THEN cleop (w2, 1, 3); FALSE{} ELSE alte tastenbelegung einlesen;{} tastenbelegung anzeigen;{} cleop (w4, 2, 3); out (w4, anwendungstext (176));{} cursor (w4, 3, 5); out (w4, anwendungstext ( 2));{} cursor on; pause; cursor off;{} TRUE{} FI.{}END PROC tastaturbelegung einstellen;{} +PROC simulationszeiten anzeigen (WINDOW VAR w):{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (181))));{} cursor (w, 2, 3); out (w, anwendungstext (17));{} out (w, text (aktuelle anzahl der arbeitsphasen, 4));{} cursor (w, 2, 4); out (w, anwendungstext (18));{} out (w, text (aktuelle arbeitsphasendauer in minuten, 4));{} out (w, anwendungstext (51));{} cursor (w, 2, 5); out (w, anwendungstext (19));{} out (w, text (aktuelle pausendauer in minuten, 4));{} + out (w, anwendungstext (51));{} cursor (w, 2, 7); out (w, anwendungstext ( 5));{} out (w, gesamtdauerangabe).{} gesamtdauerangabe:{} text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).{} arbeitsdauer:{} aktuelle anzahl der arbeitsphasen{} * aktuelle arbeitsphasendauer in minuten.{} pausendauer:{} (aktuelle anzahl der arbeitsphasen - 1){} * aktuelle pausendauer in minuten.{}END PROC simulationszeiten anzeigen;{}PROC anzahl der arbeitsphasen festlegen:{} + INT CONST minwert :: 2, maxwert :: 20;{} zeige fenster;{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{} zeige fenster:{} w1 := window ( 2, 2, 28, 6);{} w2 := window (22, 12, 37, 7);{} w3 := window (32, 2, 47, 6);{} page; show (w1); show (w2); show (w3).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} + cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (minwert, 2));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} out (w1, text (maxwert, 2));{} cursor (w1, 2, 6); out (w1, anwendungstext (55));{} out (w1, text (aktuelle anzahl der arbeitsphasen, 2)).{} erfrage veraenderung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (182))));{} cursor (w3, 2, 3);{} IF no (anwendungstext (218)){} + THEN LEAVE anzahl der arbeitsphasen festlegen{} FI.{} neuen wert vom bildschirm holen:{} cleop (w3, 2, 3); out (w3, anwendungstext ( 58));{} cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{} cursor (w3, 2, 6); out (w3, anwendungstext (183));{} aktuelle anzahl der arbeitsphasen := ermittelter wert (minwert, maxwert,{} aktuelle anzahl der arbeitsphasen).{} benutzer ist einverstanden:{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} + cleop (w3, 2, 3);{} IF yes (w3, anwendungstext (184)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC anzahl der arbeitsphasen festlegen;{}PROC dauer einer arbeitsphase festlegen:{} INT CONST minwert :: 1, maxwert :: 60;{} zeige fenster;{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{} zeige fenster:{} w1 := window ( 2, 2, 28, 6);{} w2 := window (22, 12, 37, 7);{} + w3 := window (32, 2, 47, 6);{} page; show (w1); show (w2); show (w3).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (minwert, 2));{} out (w1, anwendungstext (51));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} out (w1, text (maxwert, 2));{} out (w1, anwendungstext (51));{} + cursor (w1, 2, 6); out (w1, anwendungstext (55));{} out (w1, text (aktuelle arbeitsphasendauer in minuten, 2));{} out (w1, anwendungstext (51)).{} erfrage veraenderung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (187))));{} cursor (w3, 2, 3);{} IF no (anwendungstext (219)){} THEN LEAVE dauer einer arbeitsphase festlegen{} FI.{} neuen wert vom bildschirm holen:{} INT VAR spa, zei;{} cleop (w3, 2, 3); out (w3, anwendungstext ( 58));{} + cursor (w3, 2, 3); out (w3, anwendungstext ( 58));{} cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{} cursor (w3, 2, 6); out (w3, anwendungstext (188));{} get cursor (w3, spa, zei);{} cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));{} cursor (w3, spa, zei);{} aktuelle arbeitsphasendauer in minuten{} := ermittelter wert (minwert, maxwert,{} aktuelle arbeitsphasendauer in minuten).{} benutzer ist einverstanden:{} + hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} cleop (w3, 2, 3);{} IF yes (w3, anwendungstext (189)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC dauer einer arbeitsphase festlegen;{}PROC pausendauer festlegen:{} INT CONST minwert :: 1, maxwert :: 30;{} zeige fenster;{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{} + zeige fenster:{} w1 := window ( 2, 2, 28, 6);{} w2 := window (22, 12, 37, 7);{} w3 := window (32, 2, 47, 6);{} page; show (w1); show (w2); show (w3).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (minwert, 2));{} out (w1, anwendungstext (51));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} + out (w1, text (maxwert, 2));{} out (w1, anwendungstext (51));{} cursor (w1, 2, 6); out (w1, anwendungstext (55));{} out (w1, text (aktuelle pausendauer in minuten, 2));{} out (w1, anwendungstext (51)).{} erfrage veraenderung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (191))));{} cursor (w3, 2, 3);{} IF no (anwendungstext (220)){} THEN LEAVE pausendauer festlegen{} FI.{} + neuen wert vom bildschirm holen:{} INT VAR spa, zei;{} cleop (w3, 2, 3); out (w3, anwendungstext ( 58));{} cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{} cursor (w3, 2, 6); out (w3, anwendungstext (192));{} get cursor (w3, spa, zei);{} cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));{} cursor (w3, spa, zei);{} aktuelle pausendauer in minuten{} := ermittelter wert (minwert, maxwert,{} aktuelle pausendauer in minuten).{} + benutzer ist einverstanden:{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} cleop (w3, 2, 3);{} IF yes (w3, anwendungstext (193)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC pausendauer festlegen;{}PROC wertungsschluessel veraendern:{} INT CONST abszisse :: 16, ordinate :: 2;{} zeige fenster;{} gib bewertungsschluessel aus (w1);{} gib informationen aus;{} stelle frage nach veraenderung;{} REP{} neueinstellung{} UNTIL benutzer ist einverstanden PER.{} + zeige fenster:{} w1 := window ( 2, 2, 38, 22);{} w2 := window (42, 10, 37, 14);{} w3 := window (42, 2, 37, 6);{} page; show (w1); show (w2); show (w3).{} gib informationen aus:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (195));{} cursor (w2, 2, 4); out (w2, anwendungstext (196));{} cursor (w2, 2, 6); out (w2, anwendungstext (197));{} cursor (w2, 2, 7); out (w2, anwendungstext (198));{} cursor (w2, 2, 8); out (w2, anwendungstext (199));{} + cursor (w2, 2,11); out (w2, anwendungstext (200));{} cursor (w2, 2,12); out (w2, anwendungstext (201));{} cursor (w2, 2,13); out (w2, anwendungstext (202)).{} stelle frage nach veraenderung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (205))));{} cursor (w3, 2, 3);{} IF no (anwendungstext (206)){} THEN LEAVE wertungsschluessel veraendern{} ELSE gib hinweis auf linkes fenster{} FI.{} gib hinweis auf linkes fenster:{} cleop (w3, 2, 3); out (w3, anwendungstext (211));{} + cursor (w3, 2, 4); out (w3, anwendungstext (212));{} cursor (w3, 2, 5); out (w3, anwendungstext (213)).{} neueinstellung:{} INT VAR zeiger;{} cursor an;{} FOR zeiger FROM 1 UPTO 11 REP{} gehe auf aktuelle punktposition;{} lasse verschieben{} PER;{} cursor aus.{} gehe auf aktuelle punktposition:{} cursor (w1, ordinate + 3 * zeiger, abszisse - nachkommastelle).{} nachkommastelle:{} int (bewertung [zeiger] * 10.0).{} lasse verschieben:{} TEXT VAR eingabezeichen; INT VAR position;{} + REP{} inchar (eingabezeichen);{} position := pos (oben unten return, eingabezeichen);{} fuehre angemessene reaktion aus{} UNTIL position = 3 PER.{} fuehre angemessene reaktion aus:{} SELECT position OF{} CASE 1: steige auf{} CASE 2: steige ab{} CASE 3: (* tue nichts *){} OTHERWISE piepse{} END SELECT.{} steige auf:{} IF bewertung [zeiger] < 1.0{} THEN loesche alten punkt;{} bewertung [zeiger] INCR 0.1;{} schreibe neuen punkt{} + ELSE piepse{} FI.{} steige ab:{} IF bewertung [zeiger] > 0.0{} THEN loesche alten punkt;{} bewertung [zeiger] DECR 0.1;{} schreibe neuen punkt{} ELSE piepse{} FI.{} loesche alten punkt:{} INT VAR tabspalte, tabzeile;{} gehe auf aktuelle punktposition;{} get cursor (w1, tabspalte, tabzeile);{} IF tabspalte = ordinate + 3 OR tabzeile = abszisse{} THEN out (w1, "|"){} ELSE out (w1, blank){} FI.{} schreibe neuen punkt:{} gehe auf aktuelle punktposition;{} + out (w1, punkt und zurueck).{} benutzer ist einverstanden:{} cleop (w3, 2, 3);{} IF yes (w3, anwendungstext (207)){} THEN TRUE{} ELSE gib hinweis auf linkes fenster;{} FALSE{} FI.{}END PROC wertungsschluessel veraendern;{}PROC cleol (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):{} cursor (w, cursorspalte, cursorzeile);{} IF remaining lines (w) > 1{} THEN out (w, (areaxsize (w) - cursorspalte + 1) * blank){} ELSE out (w, (areaxsize (w) - cursorspalte) * blank){} + FI;{} cursor (w, cursorspalte, cursorzeile){}END PROC cleol;{}PROC cleop (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):{} cleol (w, cursorspalte, cursorzeile);{} INT VAR i;{} FOR i FROM 1 UPTO remaining lines (w) REP{} cleol (w, 1, cursorzeile + i){} PER;{} cursor (w, cursorspalte, cursorzeile){}END PROC cleop;{}PROC cursor an:{} INT VAR spalte, zeile;{} get cursor (spalte, zeile); cursor on; cursor (spalte, zeile){}END PROC cursor an;{}PROC cursor aus:{} INT VAR spalte, zeile;{} + get cursor (spalte, zeile); cursor off; cursor (spalte, zeile){}END PROC cursor aus;{}INT PROC eingabe mit intervallanzeige (WINDOW VAR w, INT CONST minwert,{} maxwert, anfangswert, cursorspalte,{} cursorzeile):{} BOOL VAR ist aufsteigend :: minwert = anfangswert;{} INT VAR aktueller wert :: anfangswert, alter wert, eingelesener wert;{} REP{} hole position aus vorgabe (oben unten return, eingelesener wert);{} SELECT eingelesener wert OF{} + CASE 1: erniedrige aktuellen wert wenn moeglich{} CASE 2: erhoehe aktuellen wert wenn moeglich{} END SELECT{} UNTIL eingelesener wert = 3 PER;{} aktueller wert.{} erniedrige aktuellen wert wenn moeglich:{} IF aktueller wert > minwert{} THEN alter wert := aktueller wert;{} aktueller wert DECR 1;{} IF ist aufsteigend{} THEN loesche alte markierung{} ELSE markiere neues zeichen{} FI{} ELSE piepse{} FI.{} erhoehe aktuellen wert wenn moeglich:{} + IF aktueller wert < maxwert{} THEN alter wert := aktueller wert;{} aktueller wert INCR 1;{} IF ist aufsteigend{} THEN markiere neues zeichen{} ELSE loesche alte markierung{} FI{} ELSE piepse{} FI.{} loesche alte markierung:{} positioniere cursor in zeichenkette (w, 33, alter wert);{} out (w, code (alter wert) + " ");{} cursor (cursorspalte, cursorzeile).{} markiere neues zeichen:{} positioniere cursor in zeichenkette (w, 33, aktueller wert);{} + out (w, invers (code (aktueller wert)));{} cursor (cursorspalte, cursorzeile).{}END PROC eingabe mit intervallanzeige;{}INT PROC eingabe mit elementanzeige (WINDOW VAR w, INT CONST minwert,{} maxwert, anfangswert,{} cursorspalte, cursorzeile):{} INT VAR aktueller wert :: anfangswert, alter wert, eingelesener wert;{} REP{} hole position aus vorgabe (oben unten return, eingelesener wert);{} SELECT eingelesener wert OF{} + CASE 1: erniedrige aktuellen wert wenn moeglich{} CASE 2: erhoehe aktuellen wert wenn moeglich{} END SELECT{} UNTIL eingelesener wert = 3 PER;{} aktueller wert.{} erniedrige aktuellen wert wenn moeglich:{} IF aktueller wert > minwert{} THEN alter wert := aktueller wert;{} aktueller wert DECR 1;{} loesche alte markierung;{} markiere neues zeichen{} ELSE piepse{} FI.{} erhoehe aktuellen wert wenn moeglich:{} IF aktueller wert < maxwert{} + THEN alter wert := aktueller wert;{} aktueller wert INCR 1;{} loesche alte markierung;{} markiere neues zeichen{} ELSE piepse{} FI.{} loesche alte markierung:{} positioniere cursor in zeichenkette (w, minwert, alter wert);{} out (w, code (alter wert) + " ");{} cursor (cursorspalte, cursorzeile).{} markiere neues zeichen:{} positioniere cursor in zeichenkette (w, minwert, aktueller wert);{} out (w, invers (code (aktueller wert)));{} + cursor (cursorspalte, cursorzeile).{}END PROC eingabe mit elementanzeige;{}PROC werkstueck zeigen (WINDOW VAR w):{} INT VAR zaehler, spalte, zeile;{} page (w);{} werkstueckaufhaenger (spalte, zeile);{} schreibe werkstueck zeilenweise.{} schreibe werkstueck zeilenweise:{} FOR zaehler FROM 1 UPTO aktuelle werkstueckhoehe REP{} positioniere den cursor;{} bastle eine zeile;{} gib eine zeile aus{} PER.{} positioniere den cursor:{} cursor (w, spalte, zeile + zaehler - 1).{} + bastle eine zeile:{} TEXT VAR zeileninhalt := "";{} INT VAR z;{} FOR z FROM 1 UPTO aktuelle werkstueckbreite REP{} zeileninhalt CAT code (random (kleinster aktueller zeichencode,{} groesster aktueller zeichencode)){} PER.{} gib eine zeile aus:{} IF inversdarstellung{} THEN out (w, invers (zeileninhalt)){} ELSE out (w, zeileninhalt){} FI.{}END PROC werkstueck zeigen;{}PROC werkstueckaufhaenger (INT VAR spalte, zeile):{} spalte := ((maxspalten - aktuelle werkstueckbreite) DIV 2) + 3;{} + zeile := ((maxzeilen - aktuelle werkstueckhoehe ) DIV 2) + 2;{} IF inversdarstellung THEN spalte DECR 1 FI{}END PROC werkstueckaufhaenger;{}PROC gib zeichenkette aus (WINDOW VAR w,{} INT CONST kleinster, groesster, markiertes):{} INT VAR zaehler;{} FOR zaehler FROM kleinster UPTO groesster REP{} positioniere cursor in zeichenkette (w, kleinster, zaehler);{} IF zaehler = markiertes{} THEN out (w, invers (code (zaehler))){} ELSE out (w, code (zaehler)){} + FI{} PER{}END PROC gib zeichenkette aus;{}PROC positioniere cursor in zeichenkette (WINDOW VAR w,{} INT CONST mincode, position):{} cursor (w, 4 + ((position - mincode) DIV 19) * 5,{} 3 + ((position - mincode) MOD 19)){}END PROC positioniere cursor in zeichenkette;{}TEXT PROC tastenbezeichnung (TEXT CONST zeichen):{} IF code (zeichen) >= 33 AND code (zeichen) <= 126{} THEN "<" + zeichen + ">"{} ELSE umgesetzter code{} FI.{} umgesetzter code:{} + SELECT code (zeichen) OF{} CASE 1: anwendungstext (31){} CASE 2: anwendungstext (32){} CASE 3: anwendungstext (33){} CASE 8: anwendungstext (34){} CASE 9: anwendungstext (35){} CASE 10: anwendungstext (36){} CASE 11: anwendungstext (37){} CASE 12: anwendungstext (38){} CASE 13: anwendungstext (39){} CASE 16: anwendungstext (40){} CASE 27: anwendungstext (41){} CASE 32: anwendungstext (42){} CASE 214: anwendungstext (43){} + CASE 215: anwendungstext (44){} CASE 216: anwendungstext (45){} CASE 217: anwendungstext (46){} CASE 218: anwendungstext (47){} CASE 219: anwendungstext (48){} CASE 251: anwendungstext (49){} OTHERWISE anwendungstext (50){} END SELECT{}END PROC tastenbezeichnung;{}INT PROC ermittelter wert (INT CONST minimum, maximum, startwert):{} INT VAR aktueller wert, eingelesener wert;{} cursor an;{} aktueller wert := startwert;{} REP{} gib dreistellig aus und positioniere zurueck (aktueller wert, FALSE);{} + hole position aus vorgabe (oben unten return, eingelesener wert);{} SELECT eingelesener wert OF{} CASE 1: erhoehe aktuellen wert wenn moeglich{} CASE 2: erniedrige aktuellen wert wenn moeglich{} END SELECT{} UNTIL eingelesener wert = 3 PER;{} cursor aus;{} aktueller wert.{} erhoehe aktuellen wert wenn moeglich:{} IF aktueller wert < maximum{} THEN aktueller wert INCR 1{} ELSE piepse{} FI.{} erniedrige aktuellen wert wenn moeglich:{} IF aktueller wert > minimum{} + THEN aktueller wert DECR 1{} ELSE piepse{} FI.{}END PROC ermittelter wert;{}PROC gib dreistellig aus und positioniere zurueck (INT CONST wert,{} BOOL CONST mit wertwandel):{} INT VAR spalte, zeile; get cursor (spalte, zeile);{} IF mit wertwandel{} THEN out ("'" + code (wert) + "'"){} ELSE out (text (wert, 3)){} FI;{} cursor (spalte, zeile);{}END PROC gib dreistellig aus und positioniere zurueck;{}PROC hole position aus vorgabe (TEXT CONST vorgabe, INT VAR position):{} + TEXT VAR eingabezeichen; INT VAR spa, zei;{} REP{} get cursor (spa, zei); inchar (eingabezeichen); cursor (spa, zei);{} position := pos (vorgabe, eingabezeichen);{} IF position = 0 THEN piepse; cursor (spa, zei) FI{} UNTIL position > 0 PER{}END PROC hole position aus vorgabe;{}PROC piepse:{} INT VAR spa, zei; get cursor (spa, zei); out (piep); cursor (spa, zei){}END PROC piepse;{}END PACKET ls mp bap 1;{}stdvoreinstellung der parameter{} + diff --git a/app/gs.mp-bap/1.1/src/ls-MP BAP 2 b/app/gs.mp-bap/1.1/src/ls-MP BAP 2 new file mode 100644 index 0000000..0cd66ff --- /dev/null +++ b/app/gs.mp-bap/1.1/src/ls-MP BAP 2 @@ -0,0 +1,126 @@ +PACKET ls mp bap 2 DEFINES (*******************************) + (* *) + materialpruefung, mp, (* ls-MP BAP 2 *) + bildschirmarbeitsplatz, bap, (* Version 1.1 *) + (* *) + mp bap simulation ausfuehren, (* (c) 1987, 1988 *) + mp bap auswertung auf bildschirm, (* by Eva Latta-Weber *) + mp bap drucken von auswertungen, (* Bielefeld *) + (* *) + mp bap protokollumfang festlegen, (*******************************) + mp bap kurzauswertung, + + druckereinstellung fuer protokolldatei, + stddruckereinstellung fuer protokolldatei: + + + +LET maxeintraege = 800, + protokolldateipraefix = "ls-Protokoll: ", + menukarte = "ls-MENUKARTE:MP-BAP", + menubezeichnung = "BAP", + auswertdateipostfix = " - Auswertung", + protokolldateityp = 1955, + maxspalten = 70, + maxzeilen = 14,{} blank = " ",{} trenn = "|",{} werkstueckendekennung = 1,{} pausenendekennung = 2,{} simulationsendekennung = 3,{} markierung ein = ""15"",{} markierung aus = " "14"",{} stdschrifttyp = "",{} + stdxstart = 0.0,{} stdystart = 0.0,{} stdfeldbreite = 21.0,{} stdfeldlaenge = 29.5;{}LET KONTROLLTABELLE = STRUCT (INT letzter eintrag,{} breite, hoehe,{} kleinster code, groesster code,{} anzahl aphasen, aphasendauer,{} pausendauer,{} + TEXT datum, uhrzeit, fehlerzeichen,{} nach rechts, nach links,{} nach oben, nach unten,{} ausbesserung, naechstes,{} BOOL inversdarstellung,{} ROW 11 REAL bewertung,{} ROW maxeintraege KONTROLLE tabelle),{} KONTROLLE = STRUCT (INT eintragskennung,{} produktionsfehler,{} + anzahl korrekturen,{} anzahl bedienfehler,{} REAL anfang, ende, differenz),{} WERKSTUECK = ROW maxspalten ROW maxzeilen INT;{}INT VAR breite, hoehe, kleinster code, groesster code,{} anzahl aphasen, aphasendauer, pausendauer,{} eckspalte, eckzeile, x, y, xsize, ysize;{}TEXT VAR fehlerzeichen, nach rechts, nach links, nach oben, nach unten,{} ausbesserung, naechstes, datum, uhrzeit;{} +TEXT VAR protokollschrifttyp :: stdschrifttyp;{}REAL VAR xstart :: stdxstart,{} ystart :: stdystart,{} schreibfeldbreite :: stdfeldbreite,{} schreibfeldlaenge :: stdfeldlaenge;{}ROW 11 REAL VAR bewertung;{}BOOL VAR inversdarstellung,{} kontrolldatei zur vatertask :: TRUE,{} mit kurzprotokoll :: TRUE,{} mit anmerkungen :: TRUE,{} auswertung geht zum drucker :: FALSE;{}WERKSTUECK VAR werkstueck;{} +PROC bildschirmarbeitsplatz:{} kontrolldatei zur vatertask := FALSE;{} install menu (menukarte);{} handle menu (menubezeichnung);{}END PROC bildschirmarbeitsplatz;{}PROC bap:{} bildschirmarbeitsplatz{}END PROC bap;{}PROC materialpruefung:{} TEXT VAR benutzerkennung :: "", protokollname, alter dateiname :: std;{} install menu (menukarte, FALSE);{} kontrolldatei zur vatertask := TRUE;{} ermittle eingestellte parameter;{} bereite den bildschirm vor;{} ermittle die benutzerkennung;{} gib benutzerhinweise aus;{} + arbeitsplatzsimulation ausfuehren (benutzerkennung, protokollname);{} forget (protokollname, quiet);{} last param (alter dateiname).{} bereite den bildschirm vor:{} WINDOW VAR w :: window ( 2, 10, 77, 14);{} page;{} show (w);{} out (w, center (w, anwendungstext (400))).{} ermittle die benutzerkennung:{} benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));{} IF benutzerkennung = ""{} THEN cursor on; page;{} LEAVE materialpruefung{} FI.{} + gib benutzerhinweise aus:{} boxinfo (w, anwendungstext (402));{} boxinfo (w, anwendungstext (403));{} boxinfo (w, anwendungstext (404));{} gib bedieninformationen aus (2);{} boxinfo (w, anwendungstext (405));{} boxinfo (w, anwendungstext (406));{} boxinfo (w, anwendungstext (407));{} boxinfo (w, anwendungstext (408)).{}END PROC materialpruefung;{}PROC mp:{} materialpruefung{}END PROC mp;{}PROC mp bap simulation ausfuehren:{} TEXT VAR benutzerkennung :: "", dateiname;{} + kontrolldatei zur vatertask := FALSE;{} ermittle eingestellte parameter;{} bereite den bildschirm vor;{} ermittle die benutzerkennung;{} arbeitsplatzsimulation ausfuehren (benutzerkennung, dateiname);{} regenerate menuscreen.{} bereite den bildschirm vor:{} WINDOW VAR w :: window (2,2,77,22);{} page;{} out (w, center (w, anwendungstext (399))).{} ermittle die benutzerkennung:{} benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));{} IF benutzerkennung = ""{} + THEN regenerate menuscreen;{} LEAVE mp bap simulation ausfuehren{} FI.{}END PROC mp bap simulation ausfuehren;{}PROC mp bap auswertung auf bildschirm:{} auswertung geht zum drucker := FALSE;{} lasse protokolldateien auswaehlen;{} werte protokolldateien aus;{} regenerate menuscreen.{} lasse protokolldateien auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := infix namen (ALL myself, protokolldateipraefix,{} protokolldateityp);{} + IF NOT not empty (verfuegbare){} THEN noch kein protokoll{} ELSE biete auswahl an{} FI.{} noch kein protokoll:{} regenerate menuscreen;{} menuinfo (anwendungstext (424));{} LEAVE mp bap auswertung auf bildschirm.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, anwendungstext (421),{} anwendungstext (422), FALSE).{} werte protokolldateien aus:{} INT VAR k;{} steige ggf bei leerem thesaurus aus;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} + IF name (verfuegbare, k) <> ""{} THEN disable stop;{} gib hinweis auf auswertung;{} simulationsauswertung (name (verfuegbare, k), TRUE);{} forget (name (verfuegbare, k) + auswertdateipostfix, quiet);{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN regenerate menuscreen;{} menuinfo (anwendungstext (423));{} LEAVE mp bap auswertung auf bildschirm{} + FI.{} gib hinweis auf auswertung:{} page;{} WINDOW VAR fenster :: window ( 2, 2, 77, 22);{} show (fenster);{} cursor (fenster, 1, 9); out (fenster, center (fenster, name (verfuegbare, k)));{} cursor (fenster, 1, 12); out (fenster, center (anwendungstext (274))).{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE mp bap auswertung auf bildschirm{} FI.{} +END PROC mp bap auswertung auf bildschirm;{}PROC mp bap drucken von auswertungen:{} auswertung geht zum drucker := TRUE;{} lasse protokolldateien auswaehlen;{} werte protokolldateien aus;{} regenerate menuscreen.{} lasse protokolldateien auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := infix namen (ALL myself, protokolldateipraefix,{} protokolldateityp);{} IF NOT not empty (verfuegbare){} THEN noch kein protokoll{} ELSE biete auswahl an{} + FI.{} noch kein protokoll:{} regenerate menuscreen;{} menuinfo (anwendungstext (424));{} LEAVE mp bap drucken von auswertungen.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, anwendungstext (425),{} anwendungstext (422), FALSE).{} werte protokolldateien aus:{} INT VAR k;{} steige ggf bei leerem thesaurus aus;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} gib hinweis auf auswertung;{} + simulationsauswertung (name (verfuegbare, k), FALSE);{} print (name (verfuegbare, k) + auswertdateipostfix);{} forget (name (verfuegbare, k) + auswertdateipostfix, quiet);{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN regenerate menuscreen;{} menuinfo (anwendungstext (423));{} LEAVE mp bap drucken von auswertungen{} FI.{} gib hinweis auf auswertung:{} + page;{} WINDOW VAR fenster :: window ( 2, 2, 77, 22);{} show (fenster);{} cursor (fenster, 1, 9); out (fenster, center (fenster, name (verfuegbare, k)));{} cursor (fenster, 1, 12); out (fenster, center (anwendungstext (270))).{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE mp bap drucken von auswertungen{} FI.{}END PROC mp bap drucken von auswertungen;{} +PROC mp bap protokollumfang festlegen:{} page;{} zeige aktuellen protokollumfang an;{} gib erlaeuterungen zum protokollumfang;{} frage nach umfangsaenderung;{} regenerate menuscreen{}END PROC mp bap protokollumfang festlegen;{}PROC mp bap kurzauswertung:{} page;{} zeige aktuelle kurzauswertungseinstellung an;{} gib erlaeuterungen zur kurzauswertung;{} frage nach kurzauswertungsaenderung;{} regenerate menuscreen{}END PROC mp bap kurzauswertung;{}PROC druckereinstellung fuer protokolldatei (TEXT CONST schrifttyp,{} + REAL CONST linker rand,{} oberer rand,{} feldbreite,{} feldlaenge):{} protokollschrifttyp := schrifttyp;{} xstart := linker rand;{} ystart := oberer rand;{} schreibfeldbreite := feldbreite;{} schreibfeldlaenge := feldlaenge;{}END PROC druckereinstellung fuer protokolldatei;{} +PROC stddruckereinstellung fuer protokolldatei:{} protokollschrifttyp := stdschrifttyp;{} xstart := stdxstart;{} ystart := stdystart;{} schreibfeldbreite := stdfeldbreite;{} schreibfeldlaenge := stdfeldlaenge{}END PROC stddruckereinstellung fuer protokolldatei;{} (********************************){}PROC arbeitsplatzsimulation ausfuehren (TEXT CONST kennung,{} TEXT VAR dateiname):{} ermittle eingestellte parameter;{} + lege datei mit kennung an (kennung, dateiname);{} cursor on;{} fuehre simulation durch (dateiname);{} schicke ggf protokolldatei zur vatertask;{} gib ggf kurzprotokoll aus.{} schicke ggf protokolldatei zur vatertask:{} IF kontrolldatei zur vatertask{} THEN command dialogue (FALSE);{} save (dateiname);{} command dialogue (TRUE){} FI.{} gib ggf kurzprotokoll aus:{} IF mit kurzprotokoll{} THEN kurzauswertung auf bildschirm (dateiname){} ELSE page; put (anwendungstext (271)){} + FI.{}END PROC arbeitsplatzsimulation ausfuehren;{}PROC ermittle eingestellte parameter:{} werkstueckdefinition (breite, hoehe, kleinster code, groesster code,{} fehlerzeichen, inversdarstellung);{} tastendefinition (nach rechts, nach links, nach oben, nach unten,{} ausbesserung, naechstes);{} phasendefinition (anzahl aphasen, aphasendauer, pausendauer);{} bewertungsschluessel (bewertung);{}END PROC ermittle eingestellte parameter;{}PROC lege datei mit kennung an (TEXT CONST kennung, TEXT VAR datname):{} + BOUND KONTROLLTABELLE VAR tab;{} TEXT VAR interner name :: protokolldateipraefix;{} interner name CAT kennung;{} lege neue datei an;{} type (old (datname), protokolldateityp).{} lege neue datei an:{} INT VAR i :: 0; TEXT VAR bezeichnung;{} REP{} i INCR 1;{} bezeichnung := interner name + " /" + text (i){} UNTIL NOT exists (bezeichnung) PER;{} tab := new (bezeichnung);{} initialisiere tabelle;{} datname := bezeichnung.{} initialisiere tabelle:{} tab.letzter eintrag := 0.{} +END PROC lege datei mit kennung an;{}PROC fuehre simulation durch (TEXT CONST dateiname):{} BOUND KONTROLLTABELLE VAR tab :: old (dateiname);{} TEXT CONST moegliche eingabezeichen :: nach rechts + nach links +{} nach oben + nach unten +{} ausbesserung + naechstes;{} treffe vorbereitungen;{} trage grunddaten in tabelle;{} simuliere.{} treffe vorbereitungen:{} initialisierungen;{} WINDOW VAR fenster :: window ( 1, 9, 79, 16);{} + page;{} gib bedieninformationen aus (2);{} werkstueckaufhaenger (eckspalte, eckzeile);{} weise auf arbeitsbeginn hin;{} beginn der arbeitsphase := clock (1);{} beginn der bearbeitung := beginn der arbeitsphase;{} arbeitsphasenlaenge := real (aphasendauer * 60).{} initialisierungen:{} INT VAR eintragzaehler :: 0,{} arbeitsphasenzaehler :: 1,{} werkstueckzaehler :: 0,{} bedienfehlerzaehler :: 0,{} + korrekturzaehler :: 0,{} produktionsfehler,{} cursorspalte relativ,{} cursorzeile relativ;{} REAL VAR beginn der arbeitsphase,{} beginn der bearbeitung,{} arbeitsphasenlaenge,{} arbeitsphasenueberziehung,{} pausenueberziehung.{} weise auf arbeitsbeginn hin:{} page (fenster);{} boxinfo (fenster, anwendungstext (252), 5, maxint);{} clear buffer.{} trage grunddaten in tabelle:{} tab.datum := date;{} + tab.uhrzeit := time of day;{} tab.breite := breite;{} tab.hoehe := hoehe;{} tab.kleinster code := kleinster code;{} tab.groesster code := groesster code;{} tab.anzahl aphasen := anzahl aphasen;{} tab.aphasendauer := aphasendauer;{} tab.pausendauer := pausendauer;{} tab.fehlerzeichen := fehlerzeichen;{} tab.nach rechts := nach rechts;{} tab.nach links := nach links;{} tab.nach oben := nach oben;{} + tab.nach unten := nach unten;{} tab.ausbesserung := ausbesserung;{} tab.naechstes := naechstes;{} tab.inversdarstellung := inversdarstellung;{} tab.bewertung := bewertung;{} eintragzaehler := 1.{} simuliere:{} REP{} gib holehinweis;{} hole werkstueck (werkstueck, produktionsfehler);{} zeige werkstueck (werkstueck, fenster);{} lasse werkstueck bearbeiten{} UNTIL simulationsende erreicht PER.{} gib holehinweis:{} + page (fenster);{} cursor (fenster, 2, 3); out (fenster, anwendungstext (253)).{} lasse werkstueck bearbeiten:{} initialisiere den relativcursor;{} setze cursor;{} clear buffer;{} bearbeite das werkstueck.{} initialisiere den relativcursor:{} cursorspalte relativ := 1;{} cursorzeile relativ := 1.{} setze cursor:{} IF inversdarstellung{} THEN cursor (fenster, eckspalte + cursorspalte relativ,{} eckzeile + cursorzeile relativ - 1);{} + ELSE cursor (fenster, eckspalte + cursorspalte relativ - 1,{} eckzeile + cursorzeile relativ - 1);{} FI.{} bearbeite das werkstueck:{} BOOL VAR werkstueck voll bearbeitet :: FALSE;{} REP{} hole eingabe und werte aus{} UNTIL werkstueck voll bearbeitet PER.{} hole eingabe und werte aus:{} TEXT VAR eingabezeichen := incharety (100);{} SELECT eingabezeichenposition OF{} CASE 1: wenn moeglich nach rechts{} CASE 2: wenn moeglich nach links{} + CASE 3: wenn moeglich nach oben{} CASE 4: wenn moeglich nach unten{} CASE 5: wenn moeglich ausbessern{} CASE 6: beende werkstueckbearbeitung{} OTHERWISE entscheide ob gepiepst wird{} END SELECT.{} eingabezeichenposition:{} pos (moegliche eingabezeichen, eingabezeichen).{} wenn moeglich nach rechts:{} IF cursorspalte relativ < breite{} THEN cursorspalte relativ INCR 1;{} setze cursor{} ELSE registriere bedienfehler{} FI.{} wenn moeglich nach links:{} + IF cursorspalte relativ > 1{} THEN cursorspalte relativ DECR 1;{} setze cursor{} ELSE registriere bedienfehler{} FI.{} wenn moeglich nach oben:{} IF cursorzeile relativ > 1{} THEN cursorzeile relativ DECR 1;{} setze cursor{} ELSE registriere bedienfehler{} FI.{} wenn moeglich nach unten:{} IF cursorzeile relativ < hoehe{} THEN cursorzeile relativ INCR 1;{} setze cursor{} ELSE registriere bedienfehler{} FI.{} + wenn moeglich ausbessern:{} IF werkstueck [cursorspalte relativ][cursorzeile relativ] = code (fehlerzeichen){} THEN werkstueck [cursorspalte relativ][cursorzeile relativ] := code (blank);{} korrekturzaehler INCR 1;{} get cursor (fenster, x, y);{} out (fenster, blank);{} cursor (fenster, x, y);{} ELSE registriere bedienfehler{} FI.{} registriere bedienfehler:{} piepse; bedienfehlerzaehler INCR 1.{} entscheide ob gepiepst wird:{} IF eingabezeichen <> "" THEN piepse FI.{} + beende werkstueckbearbeitung:{} IF simulationsende erreicht{} THEN trage simulationsende in tabelle ein{} ELIF arbeitsphasenende erreicht{} THEN trage werkstueckdaten in tabelle ein;{} ermittle ueberziehung der arbeitsphase;{} lege eine pause ein{} ELSE trage werkstueckdaten in tabelle ein{} FI;{} werkstueck voll bearbeitet := TRUE.{} lege eine pause ein:{} nimm pausendaten;{} weise auf pausenanfang hin;{} pausiere;{} weise auf pausenende hin;{} + registriere pausenueberziehung.{} nimm pausendaten:{} REAL VAR pausenanfang :: clock (1),{} pausenende :: pausenanfang + real (pausendauer * 60);.{} weise auf pausenanfang hin:{} page (fenster);{} boxnotice (fenster, anwendungstext (255), 5, x, y, xsize, ysize).{} pausiere:{} REP{} pause (int ((pausenende - clock (1)) * 10.0)){} UNTIL clock (1) >= pausenende PER.{} weise auf pausenende hin:{} page (fenster);{} pausenanfang := clock (1);{} piepse;{} + clear buffer;{} boxinfo (fenster, anwendungstext (256), 5, maxint);{} pausenende := clock (1).{} registriere pausenueberziehung:{} pausenueberziehung := pausenende - pausenanfang;{} trage pausenueberziehung in tabelle ein.{} trage werkstueckdaten in tabelle ein:{} REAL VAR bearbeitungsende :: clock (1);{} tab.tabelle [eintragzaehler].eintragskennung := werkstueckendekennung;{} tab.tabelle [eintragzaehler].produktionsfehler := produktionsfehler;{} tab.tabelle [eintragzaehler].anzahl korrekturen := korrekturzaehler;{} + tab.tabelle [eintragzaehler].anzahl bedienfehler:= bedienfehlerzaehler;{} tab.tabelle [eintragzaehler].anfang := beginn der bearbeitung;{} tab.tabelle [eintragzaehler].ende := bearbeitungsende;{} tab.tabelle [eintragzaehler].differenz := bearbeitungszeit;{} erhoehe eintragzaehler;{} beginn der bearbeitung := clock (1);{} werkstueckzaehler INCR 1;{} bedienfehlerzaehler := 0;{} korrekturzaehler := 0.{} trage pausenueberziehung in tabelle ein:{} + tab.tabelle [eintragzaehler].eintragskennung := pausenendekennung;{} tab.tabelle [eintragzaehler].produktionsfehler := 0;{} tab.tabelle [eintragzaehler].anzahl korrekturen := 0;{} tab.tabelle [eintragzaehler].anzahl bedienfehler:= 0;{} tab.tabelle [eintragzaehler].anfang := pausenanfang;{} tab.tabelle [eintragzaehler].ende := pausenende;{} tab.tabelle [eintragzaehler].differenz := pausenueberziehung;{} erhoehe eintragzaehler;{} arbeitsphasenzaehler INCR 1;{} + beginn der bearbeitung := clock (1);{} beginn der arbeitsphase := clock (1);{} bearbeitungslaenge bestimmen.{} trage simulationsende in tabelle ein:{} bearbeitungsende := clock (1);{} tab.tabelle [eintragzaehler].eintragskennung := simulationsendekennung;{} tab.tabelle [eintragzaehler].produktionsfehler := produktionsfehler;{} tab.tabelle [eintragzaehler].anzahl korrekturen := korrekturzaehler;{} tab.tabelle [eintragzaehler].anzahl bedienfehler:= bedienfehlerzaehler;{} + tab.tabelle [eintragzaehler].anfang := beginn der bearbeitung;{} tab.tabelle [eintragzaehler].ende := bearbeitungsende;{} tab.tabelle [eintragzaehler].differenz := bearbeitungszeit;{} tab.letzter eintrag := eintragzaehler.{} bearbeitungszeit:{} bearbeitungsende - beginn der bearbeitung.{} erhoehe eintragzaehler:{} IF eintragzaehler < maxeintraege{} THEN eintragzaehler INCR 1{} ELSE trage simulationsende in tabelle ein;{} + errorstop (anwendungstext (254)){} FI.{} ermittle ueberziehung der arbeitsphase:{} arbeitsphasenueberziehung := clock (1) - beginn der arbeitsphase{} - arbeitsphasenlaenge.{} bearbeitungslaenge bestimmen:{} arbeitsphasenlaenge := real (aphasendauer * 60){} - arbeitsphasenueberziehung{} - pausenueberziehung.{} arbeitsphasenende erreicht:{} clock (1) - beginn der arbeitsphase >= arbeitsphasenlaenge.{} + simulationsende erreicht:{} arbeitsphasenzaehler = anzahl aphasen AND arbeitsphasenende erreicht.{}END PROC fuehre simulation durch;{}PROC gib bedieninformationen aus (INT CONST zeile):{} WINDOW VAR f1 :: window ( 2, zeile, 35, 6),{} f2 :: window (40, zeile, 39, 6);{} show (f1); show (f2);{} cursor (f1, 2, 1); out (f1, anwendungstext (11));{} out (f1, tastenbezeichnung ( nach rechts));{} cursor (f1, 2, 2); out (f1, anwendungstext (12));{} out (f1, tastenbezeichnung ( nach links));{} + cursor (f1, 2, 3); out (f1, anwendungstext (13));{} out (f1, tastenbezeichnung ( nach oben));{} cursor (f1, 2, 4); out (f1, anwendungstext (14));{} out (f1, tastenbezeichnung ( nach unten));{} cursor (f1, 2, 5); out (f1, anwendungstext (15));{} out (f1, tastenbezeichnung ( ausbesserung));{} cursor (f1, 2, 6); out (f1, anwendungstext (16));{} out (f1, tastenbezeichnung ( naechstes));{} cursor (f2, 2, 1); out (f2, anwendungstext (17));{} + out (f2, text (anzahl aphasen, 4));{} cursor (f2, 2, 2); out (f2, anwendungstext (18));{} out (f2, text (aphasendauer, 4));{} out (f2, anwendungstext (51));{} cursor (f2, 2, 3); out (f2, anwendungstext (19));{} out (f2, text (pausendauer, 4));{} out (f2, anwendungstext (51));{} cursor (f2, 2, 4); out (f2, anwendungstext ( 5));{} out (f2, text (gesamtzeit, 4));{} out (f2, anwendungstext (51));{} + cursor (f2, 2, 6); out (f2, anwendungstext (251));{} out (f2, 3 * blank);{} out (f2, fehlerzeichen).{}END PROC gib bedieninformationen aus;{}INT PROC gesamtzeit:{} anzahl aphasen * aphasendauer + (anzahl aphasen - 1) * pausendauer{}END PROC gesamtzeit;{}PROC hole werkstueck (WERKSTUECK VAR w, INT VAR anzahl fehler):{} INT VAR spaltenzaehler, zeilenzaehler;{} anzahl fehler := 0;{} FOR zeilenzaehler FROM 1 UPTO hoehe REP{} ermittle eine zeile{} PER.{} + ermittle eine zeile:{} FOR spaltenzaehler FROM 1 UPTO breite REP{} ermittle eine position;{} ggf fehler registrieren{} PER.{} ermittle eine position:{} w [spaltenzaehler][zeilenzaehler] := zufallscode.{} zufallscode:{} random (kleinster code, groesster code).{} ggf fehler registrieren:{} IF w [spaltenzaehler][zeilenzaehler] = code (fehlerzeichen){} THEN anzahl fehler INCR 1{} FI.{}END PROC hole werkstueck;{}PROC zeige werkstueck (WERKSTUECK CONST w, WINDOW VAR f):{} + INT VAR spaltenzaehler, zeilenzaehler;{} page (f);{} FOR zeilenzaehler FROM 1 UPTO hoehe REP{} zeige eine zeile{} PER.{} zeige eine zeile:{} cursor (f, eckspalte, eckzeile + zeilenzaehler - 1);{} ggf invers einschalten;{} FOR spaltenzaehler FROM 1 UPTO breite REP{} out (f, code (w [spaltenzaehler][zeilenzaehler])){} PER;{} ggf invers ausschalten.{} ggf invers einschalten:{} IF inversdarstellung THEN out (f, markierung ein) FI.{} ggf invers ausschalten:{} IF inversdarstellung THEN out (f, markierung aus) FI.{} +END PROC zeige werkstueck;{}PROC kurzauswertung auf bildschirm (TEXT CONST dateiname):{} WINDOW VAR fenster :: window ( 2, 10, 77, 13);{} show (fenster);{} clear buffer;{} notiere ueberschrift;{} notiere ergebnis.{} notiere ueberschrift:{} cursor (fenster, 1, 1);{} out (fenster, center (fenster, anwendungstext (275)));{} cursor (fenster, 1, 2);{} out (fenster, center (fenster, anwendungstext (276))).{} notiere ergebnis:{} BOUND KONTROLLTABELLE CONST k := old (dateiname);{} ermittle die simulationsdaten;{} + notiere gesamtzahl werkstuecke;{} notiere zeichengesamtzahl;{} notiere bedienfehler;{} notiere benoetigte zeit;{} notiere gesamtausbesserungsrate;{} notiere gesamtbewertungsfaktor;{} notiere gesamtbewertungszahl mit pausenueberziehung;{} cursor (1, 24); out (anwendungstext (2));{} pause.{} ermittle die simulationsdaten:{} INT VAR z, anzahl zeichen pro werkstueck,{} anzahl werkstuecke :: 0,{} anzahl bedienfehler :: 0,{} anzahl produktionsfehler :: 0,{} + anzahl korrekturen :: 0;{} REAL VAR gesamtzahl zeichen, anteil korrekturen,{} gesamtzeit :: 0.0,{} pausenueberzug :: 0.0;{} FOR z FROM 1 UPTO k.letzter eintrag REP{} IF k.tabelle [z].eintragskennung = werkstueckendekennung{} THEN anzahl werkstuecke INCR 1;{} anzahl bedienfehler INCR k.tabelle [z].anzahl bedienfehler;{} anzahl produktionsfehler INCR k.tabelle [z].produktionsfehler;{} + anzahl korrekturen INCR k.tabelle [z].anzahl korrekturen;{} gesamtzeit INCR k.tabelle [z].differenz;{} ELIF k.tabelle [z].eintragskennung = pausenendekennung{} THEN pausenueberzug INCR k.tabelle [z].differenz;{} FI{} PER;{} anzahl zeichen pro werkstueck := k.breite * k.hoehe;{} gesamtzahl zeichen := real (anzahl werkstuecke){} * real (anzahl zeichen pro werkstueck);{} + IF anzahl produktionsfehler = 0{} THEN anteil korrekturen := 1.0{} ELSE anteil korrekturen := real (anzahl korrekturen){} / real (anzahl produktionsfehler){} FI.{} notiere gesamtzahl werkstuecke:{} cursor (fenster, 12, 4); out (fenster, anwendungstext (277));{} out (fenster, text (anzahl werkstuecke, 8)).{} notiere zeichengesamtzahl:{} cursor (fenster, 12, 5); out (fenster, anwendungstext (278));{} out (fenster, zahl aus zeichenkette).{} + zahl aus zeichenkette:{} subtext (text (gesamtzahl zeichen, 9, 0), 1, 8).{} notiere bedienfehler:{} cursor (fenster, 12, 6); out (fenster, anwendungstext (279));{} out (fenster, text (anzahl bedienfehler, 8)).{} notiere benoetigte zeit:{} cursor (fenster, 12, 7); out (fenster, anwendungstext (280));{} out (fenster, text (gesamtzeit, 8, 2)).{} notiere gesamtausbesserungsrate:{} cursor (fenster, 12, 9); out (fenster, anwendungstext (281));{} + out (fenster, text (anteil korrekturen, 8, 2)).{} notiere gesamtbewertungsfaktor:{} cursor (fenster, 12,10); out (fenster, anwendungstext (282));{} out (fenster, text (bewertungsfaktor, 8, 2)).{} bewertungsfaktor:{} bewertungsmasszahl (anteil korrekturen).{} notiere gesamtbewertungszahl mit pausenueberziehung:{} cursor (fenster, 12, 12); out (fenster, (anwendungstext (283)));{} out (fenster, text (gesamtwertung, 8, 2));{} + cursor (fenster, 12, 13); out (fenster, (anwendungstext (284)));{} out (fenster, 8 * "=").{} gesamtwertung:{} IF gesamtzeit = 0.0{} THEN 0.0{} ELSE gesamtzahl zeichen / (gesamtzeit + pausenueberzug){} * bewertungsfaktor{} FI.{}END PROC kurzauswertung auf bildschirm;{}PROC simulationsauswertung (TEXT CONST dateiname, BOOL CONST mit zeigen):{} TEXT CONST auswertdatei :: dateiname + auswertdateipostfix;{} ermittle die kenndaten aus der protokolldatei (dateiname);{} + notiere ueberschrift 1 (auswertdatei);{} notiere die kenndaten der simulation (auswertdatei);{} notiere die werkstueckkenndaten (auswertdatei);{} notiere ein beispielwerkstueck (auswertdatei);{} notiere ueberschrift 2 (auswertdatei);{} notiere gesamtergebnisse (auswertdatei, dateiname);{} notiere ueberschrift 3 (auswertdatei);{} notiere tabellenkopf (auswertdatei);{} notiere einzelne werkstueckdaten (auswertdatei, dateiname);{} + notiere ggf die anmerkungen;{} zeige ggf auswertung auf bildschirm.{} notiere ggf die anmerkungen:{} IF mit anmerkungen{} THEN notiere anmerkungen (auswertdatei);{} FI.{} zeige ggf auswertung auf bildschirm:{} IF mit zeigen{} THEN cursor on; show (auswertdatei); cursor off{} FI.{}END PROC simulationsauswertung;{}PROC ermittle die kenndaten aus der protokolldatei (TEXT CONST dateiname):{} BOUND KONTROLLTABELLE CONST k := old (dateiname);{} breite := k.breite;{} + hoehe := k.hoehe;{} kleinster code := k.kleinster code;{} groesster code := k.groesster code;{} fehlerzeichen := k.fehlerzeichen;{} inversdarstellung := k.inversdarstellung;{} nach rechts := k.nach rechts;{} nach links := k.nach links;{} nach oben := k.nach oben;{} nach unten := k.nach unten;{} ausbesserung := k.ausbesserung;{} naechstes := k.naechstes;{} + anzahl aphasen := k.anzahl aphasen;{} aphasendauer := k.aphasendauer;{} pausendauer := k.pausendauer;{} datum := k.datum;{} uhrzeit := k.uhrzeit;{} bewertung := k.bewertung;{}END PROC ermittle die kenndaten aus der protokolldatei;{}PROC notiere ueberschrift 1 (TEXT CONST auswertdatei):{} IF exists (auswertdatei){} THEN forget (auswertdatei, quiet){} FI;{} FILE VAR f :: sequential file (output, auswertdatei);{} + IF auswertung geht zum drucker{} THEN schreibe druckeranweisungen{} FI;{} putline (f, center (auswertdatei));{} putline (f, center (length (auswertdatei) * "="));{} put (f, anwendungstext (272)); put (f, datum); put (f, 26 * blank);{} put (f, anwendungstext (273)); putline (f, uhrzeit);{} line (f);{} putline (f, center (anwendungstext (291)));{} putline (f, center (length (anwendungstext (291)) * "=")).{} schreibe druckeranweisungen:{} write (f, "#type (""");{} write (f, protokollschrifttyp);{} + write (f, """)##limit (");{} write (f, text (schreibfeldbreite));{} write (f, ")##pagelength (");{} write (f, text (schreibfeldlaenge));{} write (f, ")##start (");{} write (f, text (xstart));{} write (f, ",");{} write (f, text (ystart));{} write (f, ")#"); line (f).{}END PROC notiere ueberschrift 1;{}PROC notiere ueberschrift 2 (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} putline (f, center (anwendungstext (285)));{} putline (f, center (length (anwendungstext (285)) * "=")){} +END PROC notiere ueberschrift 2;{}PROC notiere ueberschrift 3 (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} line (f, 2);{} putline (f, center (anwendungstext (311)));{} putline (f, center (length (anwendungstext (311)) * "="));{} line (f){}END PROC notiere ueberschrift 3;{}PROC notiere die kenndaten der simulation (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} ROW 6 TEXT VAR ausgabe;{} bestuecke ausgabezeilen;{} schreibe ausgabezeilen.{} + bestuecke ausgabezeilen:{} ausgabe [1] := anwendungstext (11){} + gleichlang (tastenbezeichnung (nach rechts ), 23){} + anwendungstext (17){} + text (anzahl aphasen, 4);{} ausgabe [2] := anwendungstext (12){} + gleichlang (tastenbezeichnung (nach links ), 23){} + anwendungstext (18){} + text (aphasendauer, 4) + anwendungstext (51);{} ausgabe [3] := anwendungstext (13){} + + gleichlang (tastenbezeichnung (nach oben ), 23){} + anwendungstext (19){} + text (pausendauer, 4) + anwendungstext (51);{} ausgabe [4] := anwendungstext (14){} + gleichlang (tastenbezeichnung (nach unten ), 23){} + anwendungstext ( 5){} + text (simulationsdauer, 4) + anwendungstext (51);{} ausgabe [5] := anwendungstext (15){} + gleichlang (tastenbezeichnung (ausbesserung), 23);{} + ausgabe [6] := anwendungstext (16){} + gleichlang (tastenbezeichnung (naechstes ), 23){} + anwendungstext (251){} + (3 * blank) + fehlerzeichen.{} simulationsdauer:{} anzahl aphasen * aphasendauer + (anzahl aphasen - 1) * pausendauer.{} schreibe ausgabezeilen:{} INT VAR i;{} FOR i FROM 1 UPTO 6 REP{} putline (f, ausgabe [i]){} PER;{} line (f).{}END PROC notiere die kenndaten der simulation;{}PROC notiere die werkstueckkenndaten (TEXT CONST auswertdatei):{} + FILE VAR f :: sequential file (output, auswertdatei);{} ROW 4 TEXT VAR ausgabe;{} bestuecke ausgabezeilen;{} schreibe ausgabezeilen.{} bestuecke ausgabezeilen:{} ausgabe [1] := anwendungstext (292) + text (breite, 4) +{} anwendungstext (296);{} ausgabe [2] := anwendungstext (293) + text (hoehe, 4) +{} anwendungstext (296);{} ausgabe [3] := anwendungstext (294) + text (breite * hoehe, 4) +{} anwendungstext (296);{} + ausgabe [4] := anwendungstext (295) + zeichenumfang.{} zeichenumfang:{} " " + code (kleinster code) + " ... " + code (groesster code) +{} " (" + text (groesster code - kleinster code + 1, 3) +{} anwendungstext (296) + ")".{} schreibe ausgabezeilen:{} INT VAR i;{} FOR i FROM 1 UPTO 4 REP putline (f, ausgabe [i]) PER;{} line (f).{}END PROC notiere die werkstueckkenndaten;{}PROC notiere ein beispielwerkstueck (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} + WERKSTUECK VAR beispiel;{} INT VAR beispielfehler;{} hole werkstueck (beispiel, beispielfehler);{} notiere ueberschrift;{} notiere werkstueckzeilen;{} notiere werkstueckleerzeilen.{} notiere ueberschrift:{} putline (f, center (anwendungstext (297)));{} putline (f, center (length (anwendungstext (297)) * "-")).{} notiere werkstueckzeilen:{} INT VAR bs, bz;{} FOR bz FROM 1 UPTO hoehe REP{} notiere eine zeile{} PER.{} notiere eine zeile:{} TEXT VAR beispielzeile :: "";{} + konstruiere beispielzeile;{} gib beispielzeile aus.{} konstruiere beispielzeile:{} beispielzeile CAT (((80 - breite) DIV 2) * blank);{} FOR bs FROM 1 UPTO breite REP{} beispielzeile CAT code (beispiel [bs][bz]){} PER.{} gib beispielzeile aus:{} putline (f, beispielzeile).{} notiere werkstueckleerzeilen:{} line (f, maxzeilen - hoehe + 1).{}END PROC notiere ein beispielwerkstueck;{}PROC notiere gesamtergebnisse (TEXT CONST auswertdatei, protokolldatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} + BOUND KONTROLLTABELLE CONST k :: old (protokolldatei);{} ermittle die simulationsdaten;{} notiere gesamtzahl werkstuecke;{} notiere anzahl zeichen pro werkstueck;{} notiere zeichengesamtzahl;{} notiere bedienfehler;{} notiere produktionsfehlerzahl;{} notiere fehlerkorrekturen;{} notiere gesamtzeit mit pausenueberziehung;{} notiere zeichenzahl pro sekunde mit;{} notiere gesamtausbesserungsrate;{} notiere gesamtbewertungsfaktor mit;{} notiere gesamtbewertungszahl mit;{} + notiere gesamtzeit ohne pausenueberziehung;{} notiere zeichenzahl pro sekunde ohne;{} notiere gesamtbewertungszahl ohne.{} ermittle die simulationsdaten:{} INT VAR z, anzahl zeichen pro werkstueck,{} anzahl werkstuecke :: 0,{} anzahl bedienfehler :: 0,{} anzahl produktionsfehler :: 0,{} anzahl korrekturen :: 0;{} REAL VAR gesamtzahl zeichen, anteil korrekturen,{} gesamtzeit :: 0.0,{} + pausenueberzug :: 0.0;{} FOR z FROM 1 UPTO k.letzter eintrag REP{} IF k.tabelle [z].eintragskennung = werkstueckendekennung{} THEN anzahl werkstuecke INCR 1;{} anzahl bedienfehler INCR k.tabelle [z].anzahl bedienfehler;{} anzahl produktionsfehler INCR k.tabelle [z].produktionsfehler;{} anzahl korrekturen INCR k.tabelle [z].anzahl korrekturen;{} gesamtzeit INCR k.tabelle [z].differenz;{} + ELIF k.tabelle [z].eintragskennung = pausenendekennung{} THEN pausenueberzug INCR k.tabelle [z].differenz;{} FI{} PER;{} anzahl zeichen pro werkstueck := k.breite * k.hoehe;{} gesamtzahl zeichen := real (anzahl werkstuecke){} * real (anzahl zeichen pro werkstueck);{} IF anzahl produktionsfehler = 0{} THEN anteil korrekturen := 1.0{} ELSE anteil korrekturen := real (anzahl korrekturen){} + / real (anzahl produktionsfehler){} FI.{} notiere gesamtzahl werkstuecke:{} put (f, anwendungstext (277)); putline (f, text (anzahl werkstuecke, 8)).{} notiere anzahl zeichen pro werkstueck:{} put (f, anwendungstext (286)); putline (f, text (breite * hoehe, 8)).{} notiere zeichengesamtzahl:{} put (f, anwendungstext (278)); putline (f, zahl aus zeichenkette);{} line (f).{} zahl aus zeichenkette:{} subtext (text (gesamtzahl zeichen, 9, 0), 1, 8).{} + notiere produktionsfehlerzahl:{} put (f, anwendungstext (287)); putline (f, text (anzahl produktionsfehler, 8)).{} notiere fehlerkorrekturen:{} put (f, anwendungstext (288)); putline (f, text (anzahl korrekturen, 8)).{} notiere bedienfehler:{} put (f, anwendungstext (279)); putline (f, text (anzahl bedienfehler,8));{} line (f).{} notiere gesamtzeit mit pausenueberziehung:{} put (f, anwendungstext (301)); put (f, text (gesamtzeit mit, 8, 1));{} putline (f, anwendungstext (300)).{} + gesamtzeit mit:{} gesamtzeit + pausenueberzug.{} notiere zeichenzahl pro sekunde mit:{} put (f, anwendungstext (302));{} putline (f, text (zeichenpro sec mit, 8, 1));{} line (f).{} zeichen pro sec mit:{} IF gesamtzeit + pausenueberzug > 0.0{} THEN gesamtzahl zeichen / (gesamtzeit + pausenueberzug){} ELSE 0.0{} FI.{} notiere gesamtausbesserungsrate:{} put (f, anwendungstext (281)); putline (f, text (anteil korrekturen, 8, 1)).{} notiere gesamtbewertungsfaktor mit:{} + put (f, anwendungstext (282)); putline (f, text (bewertungsfaktor, 8, 1));{} line (f).{} bewertungsfaktor:{} bewertungsmasszahl (anteil korrekturen).{} notiere gesamtbewertungszahl mit:{} put (f, (anwendungstext (283))); putline (f, text (gesamtwertung mit, 8, 1));{} put (f, (anwendungstext (284))); putline (f, 8 * "=").{} gesamtwertung mit:{} IF gesamtzeit = 0.0{} THEN 0.0{} ELSE gesamtzahl zeichen / (gesamtzeit + pausenueberzug){} * bewertungsfaktor{} + FI.{} notiere gesamtzeit ohne pausenueberziehung:{} put (f, anwendungstext (303)); put (f, text (gesamtzeit, 8, 1));{} putline (f, anwendungstext (300)).{} notiere zeichenzahl pro sekunde ohne:{} put (f, anwendungstext (302));{} putline (f, text (zeichenpro sec ohne, 8, 1)).{} zeichen pro sec ohne:{} IF gesamtzeit > 0.0{} THEN gesamtzahl zeichen / gesamtzeit{} ELSE 0.0{} FI.{} notiere gesamtbewertungszahl ohne:{} put (f, (anwendungstext (304))); putline (f, text (gesamtwertung ohne, 8, 1));{} + put (f, (anwendungstext (284))); putline (f, 8 * "=").{} gesamtwertung ohne:{} IF gesamtzeit = 0.0{} THEN 0.0{} ELSE gesamtzahl zeichen / gesamtzeit * bewertungsfaktor{} FI.{}END PROC notiere gesamtergebnisse;{}PROC notiere tabellenkopf (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} putline (f, anwendungstext (312));{} putline (f, anwendungstext (313));{} putline (f, anwendungstext (314));{} putline (f, anwendungstext (315));{} putline (f, anwendungstext (316));{} + putline (f, anwendungstext (317));{} putline (f, anwendungstext (318));{}END PROC notiere tabellenkopf;{}PROC notiere einzelne werkstueckdaten (TEXT CONST auswertdatei, dateiname):{} BOUND KONTROLLTABELLE CONST k :: old (dateiname);{} FILE VAR f :: sequential file (output, auswertdatei);{} INT VAR zeiger, werkstuecknummer :: 0;{} TEXT VAR ausgabezeile :: "";{} FOR zeiger FROM 1 UPTO k.letzter eintrag REP{} notiere bearbeitungszeile{} PER.{} notiere bearbeitungszeile:{} IF k.tabelle [zeiger].eintragskennung = werkstueckendekennung{} + THEN werkstuecknummer INCR 1;{} schreibe werkstueckzeile{} ELIF k.tabelle [zeiger].eintragskennung = pausenendekennung{} THEN schreibe pausenzeile{} ELIF k.tabelle [zeiger].eintragskennung = simulationsendekennung{} THEN werkstuecknummer INCR 1;{} schreibe abschluss{} ELSE putline (f, 75 * "?"){} FI.{} schreibe werkstueckzeile:{} konstruiere ausgabezeile;{} putline (f, ausgabezeile).{} konstruiere ausgabezeile:{} ausgabezeile := "";{} + ausgabezeile CAT text (werkstuecknummer, 5);{} ausgabezeile CAT 2 * blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (k.tabelle [zeiger].anzahl bedienfehler, 5);{} ausgabezeile CAT 3 * blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (k.tabelle [zeiger].produktionsfehler, 6);{} ausgabezeile CAT 2 * blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (k.tabelle [zeiger].anzahl korrekturen, 6);{} ausgabezeile CAT 2 * blank;{} ausgabezeile CAT trenn;{} + ausgabezeile CAT text (k.tabelle [zeiger].differenz, 6, 1);{} ausgabezeile CAT blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (zeichen pro zeiteinheit, 6, 1);{} ausgabezeile CAT blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (einzelausbesserungsrate, 6, 1);{} ausgabezeile CAT blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (bewertungsmasszahl (einzelausbesserungsrate), 6, 1);{} ausgabezeile CAT blank;{} ausgabezeile CAT trenn;{} + ausgabezeile CAT text (endbewertungszahl, 6, 1);{} ausgabezeile CAT blank.{} zeichen pro zeiteinheit:{} real (breite * hoehe) / k.tabelle [zeiger].differenz.{} einzelausbesserungsrate:{} IF k.tabelle [zeiger].produktionsfehler = 0{} THEN 0.0{} ELSE real (k.tabelle [zeiger].anzahl korrekturen){} / real (k.tabelle [zeiger].produktionsfehler ){} FI.{} endbewertungszahl:{} real (breite * hoehe) / k.tabelle [zeiger].differenz{} * bewertungsmasszahl (einzelausbesserungsrate).{} + schreibe pausenzeile:{} line (f);{} put (f, anwendungstext (320));{} put (f, text (k.tabelle [zeiger].differenz, 6, 1));{} putline (f, anwendungstext (300));{} line (f).{} schreibe abschluss:{} putline (f, anwendungstext (318));{} putline (f, anwendungstext (319));{} line (f);{} konstruiere ausgabezeile;{} ausgabezeile := "(" +{} subtext (ausgabezeile, 2, length (ausgabezeile) - 1) +{} ")";{} putline (f, ausgabezeile).{} +END PROC notiere einzelne werkstueckdaten;{}PROC notiere anmerkungen (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} line (f);{} schreibe kopf;{} schreibe hinweis auf letztes werkstueck;{} schreibe hinweis auf bedienfehler;{} erlaeutere bewertungsschluessel;{} stelle bewertungsschluessel graphisch dar;{} schreibe rest.{} schreibe kopf:{} putline (f, center (anwendungstext (325)));{} putline (f, center (length (anwendungstext (325)) * "="));{} line (f).{} + schreibe hinweis auf letztes werkstueck:{} INT VAR i;{} FOR i FROM 326 UPTO 337 REP{} putline (f, anwendungstext (i)){} PER;{} line (f).{} schreibe hinweis auf bedienfehler:{} FOR i FROM 339 UPTO 341 REP{} putline (f, anwendungstext (i)){} PER;{} line (f).{} erlaeutere bewertungsschluessel:{} FOR i FROM 343 UPTO 372 REP{} putline (f, anwendungstext (i)){} PER.{} stelle bewertungsschluessel graphisch dar:{} putline (f, anwendungstext (374));{} putline (f, anwendungstext (375));{} + ermittle die startposition;{} zeichne diagramm;{} trage werte ein.{} ermittle die startposition:{} modify (f);{} INT VAR zeilenpos :: lines (f) + 2, spaltenpos :: 18.{} zeichne diagramm:{} cursor (f, spaltenpos, zeilenpos , anwendungstext (20));{} cursor (f, spaltenpos, zeilenpos + 1, anwendungstext (21));{} cursor (f, spaltenpos, zeilenpos + 3, anwendungstext (23));{} cursor (f, spaltenpos, zeilenpos + 4, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 5, anwendungstext (22));{} + cursor (f, spaltenpos, zeilenpos + 6, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 7, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 8, anwendungstext (24));{} cursor (f, spaltenpos, zeilenpos + 9, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 10, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 11, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 12, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 13, anwendungstext (25));{} + cursor (f, spaltenpos, zeilenpos + 14, anwendungstext (26));{} cursor (f, spaltenpos, zeilenpos + 15, anwendungstext (27)).{} trage werte ein:{} zeilenpos INCR 13;{} INT VAR bwzeiger;{} FOR bwzeiger FROM 1 UPTO 11 REP{} cursor (f, spaltenpos + 3 * bwzeiger, zeilenpos - konkreter wert, "+"){} PER.{} konkreter wert:{} int (bewertung [bwzeiger] * 10.0).{} schreibe rest:{} output (f);{} line (f, 2);{} FOR i FROM 377 UPTO 387 REP{} putline (f, anwendungstext (i)){} + PER;{} haenge an jede zeile ein blank an.{} haenge an jede zeile ein blank an:{} TEXT VAR inhalt;{} INT VAR zeilenzeiger;{} modify (f);{} FOR zeilenzeiger FROM 1 UPTO lines (f) REP{} to line (f, zeilenzeiger);{} read record (f, inhalt);{} inhalt CAT blank;{} write record (f, inhalt){} PER;{} to line (f,1).{}END PROC notiere anmerkungen;{}PROC cursor (FILE VAR f, INT CONST spa, zei, TEXT CONST text):{} positioniere an zeile;{} positioniere an spalte;{} + gib text an position aus.{} positioniere an zeile:{} IF zeile noch nicht vorhanden{} THEN schaffe zeile und gehe dorthin{} ELSE to line (f,zei){} FI.{} zeile noch nicht vorhanden:{} zei > lines (f).{} schaffe zeile und gehe dorthin:{} INT VAR zaehler 1;{} IF lines (f) = 0{} THEN to line (f,lines (f));{} insert record (f);{} FI;{} FOR zaehler 1 FROM lines (f) UPTO zei REP{} to line (f,lines (f));{} down (f);insert record (f){} PER;{} + to line(f,zei).{} positioniere an spalte:{} TEXT VAR alter satz :: "", neuer satz :: "", restsatz ::"";{} INT VAR satzlaenge;{} read record (f,alter satz);{} satzlaenge := length (alter satz);{} IF satzlaenge = 0{} THEN neuer satz CAT (spa -1) * " "{} ELIF satzlaenge >= spa{} THEN neuer satz := subtext(alter satz,1,spa-1);{} restsatz := subtext(alter satz, spa + length (text));{} ELSE neuer satz := alter satz;{} neuer satz CAT (spa - satzlaenge - 1) * " "{} + FI.{} gib text an position aus:{} neuer satz CAT text;{} IF restsatz <> ""{} THEN neuer satz CAT restsatz{} FI;{} write record(f,neuer satz).{} END PROC cursor;{}TEXT PROC gleichlang (TEXT CONST text, INT CONST laenge):{} TEXT VAR intern :: compress (text);{} INT VAR anzahl :: laenge - length (intern);{} IF anzahl < 0{} THEN subtext (intern, 1, laenge){} ELSE intern + (anzahl * blank){} FI{}END PROC gleichlang;{}REAL PROC bewertungsmasszahl (REAL CONST wert):{} REAL VAR interner wert := round (wert, 1);{} + IF interner wert > wert{} THEN interner wert DECR 0.1{} FI;{} interpoliere.{} interpoliere:{} REAL VAR unterer wert, oberer wert;{} unterer wert := interner wert;{} IF unterer wert = 1.0{} THEN oberer wert := 1.0{} ELSE oberer wert := unterer wert + 0.1{} FI;{} unterer wert := bewertung (int (unterer wert * 10.0) + 1);{} oberer wert := bewertung (int (oberer wert * 10.0) + 1);{} unterer wert + (oberer wert - unterer wert) * faktor.{} faktor:{} frac (wert * 10.0).{} +END PROC bewertungsmasszahl;{}PROC zeige aktuellen protokollumfang an:{} WINDOW VAR w :: window (2, 2, 34, 5);{} show (w);{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (431))));{} IF mit anmerkungen{} THEN cursor (w, 2, 4); out (w, anwendungstext (432)){} ELSE cursor (w, 2, 4); out (w, anwendungstext (433));{} FI.{}END PROC zeige aktuellen protokollumfang an;{}PROC gib erlaeuterungen zum protokollumfang:{} WINDOW VAR f :: window ( 2, 9, 77, 15);{} show (f);{} cursor (f, 1, 1); out (f, center (f, invers (anwendungstext (434))));{} + cursor (f, 5, 3); out (f, anwendungstext (435));{} cursor (f, 5, 4); out (f, anwendungstext (436));{} cursor (f, 5, 5); out (f, anwendungstext (437));{} cursor (f, 5, 6); out (f, anwendungstext (438));{} cursor (f, 5, 8); out (f, anwendungstext (439));{} cursor (f, 5, 9); out (f, anwendungstext (440));{} cursor (f, 5,10); out (f, anwendungstext (441));{} cursor (f, 5,11); out (f, anwendungstext (442));{} cursor (f, 5,13); out (f, anwendungstext (443));{} cursor (f, 5,14); out (f, anwendungstext (444));{} +END PROC gib erlaeuterungen zum protokollumfang;{}PROC frage nach umfangsaenderung:{} WINDOW VAR fenster :: window (38, 2, 41, 5);{} show (fenster);{} cursor (fenster, 1, 1); out (fenster, center (fenster, invers (anwendungstext (451))));{} cursor (fenster, 4, 3); out (fenster, anwendungstext (452));{} cursor (fenster, 4, 4);{} IF yes (fenster, anwendungstext (453)){} THEN mit anmerkungen := NOT mit anmerkungen{} FI.{}END PROC frage nach umfangsaenderung;{}PROC zeige aktuelle kurzauswertungseinstellung an:{} + WINDOW VAR w :: window ( 2, 2, 34, 5);{} show (w);{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (431))));{} IF mit kurzprotokoll{} THEN cursor (w, 7, 4); out (w, anwendungstext (461));{} ELSE cursor (w, 7, 4); out (w, anwendungstext (462));{} FI.{}END PROC zeige aktuelle kurzauswertungseinstellung an;{}PROC gib erlaeuterungen zur kurzauswertung:{} WINDOW VAR f :: window ( 2, 9, 77, 15);{} show (f);{} cursor (f, 1, 1); out (f, center (f, invers (anwendungstext (463))));{} + cursor (f, 5, 3); out (f, anwendungstext (464));{} cursor (f, 5, 4); out (f, anwendungstext (465));{} cursor (f, 5, 5); out (f, anwendungstext (466));{} cursor (f, 5, 6); out (f, anwendungstext (467));{} cursor (f, 5, 8); out (f, anwendungstext (468));{} cursor (f, 5, 9); out (f, anwendungstext (469));{} cursor (f, 5,10); out (f, anwendungstext (470));{} cursor (f, 5,11); out (f, anwendungstext (471));{} cursor (f, 5,13); out (f, anwendungstext (472));{} cursor (f, 5,14); out (f, anwendungstext (473));{} +END PROC gib erlaeuterungen zur kurzauswertung;{}PROC frage nach kurzauswertungsaenderung:{} WINDOW VAR fenster :: window (38, 2, 41, 5);{} show (fenster);{} cursor (fenster, 1, 1); out (fenster, center (fenster, invers (anwendungstext (481))));{} cursor (fenster, 5, 3); out (fenster, anwendungstext (482));{} cursor (fenster, 5, 4);{} IF yes (fenster, anwendungstext (483)){} THEN mit kurzprotokoll := NOT mit kurzprotokoll{} FI.{}END PROC frage nach kurzauswertungsaenderung;{}END PACKET ls mp bap 2;{} + diff --git a/app/gs.mp-bap/1.1/src/ls-MP BAP-gen b/app/gs.mp-bap/1.1/src/ls-MP BAP-gen new file mode 100644 index 0000000..26a84c3 --- /dev/null +++ b/app/gs.mp-bap/1.1/src/ls-MP BAP-gen @@ -0,0 +1,30 @@ + (*****************************) + (* *) + (* ls-MP BAP *) + (* GENERATORPROGRAMM *) + (* *) + (* (c) 1987 (01.09.87) *) + (* by Eva Latta *) + (* Bielefeld *) + (*****************************) +LET mm taskname = "ls-MENUKARTEN", + eigener name = "ls-MP BAP/gen", + datei1 = "ls-MP BAP 1", + datei2 = "ls-MP BAP 2", + menukarte = "ls-MENUKARTE:MP-BAP"; + +PROC stelle existenz des mm sicher: + cursor (1, 5); out (""4""); + IF NOT exists (task (mm taskname)) + THEN errorstop ("Unbedingt erst den 'MENUKARTEN MANAGER' generieren!"); + FI +END PROC stelle existenz des mm sicher; + +PROC vom archiv (TEXT CONST datei): + cursor (1,5); out (""4""); + out (" """); out (datei); putline (""" wird geholt.");{} fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{} IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{} hole (datei);{} cursor (1, 5); out (""4"");{} out (" """); out (datei); out (""" wird übersetzt: ");{} insert (datei);{} forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{} cursor (1, 5); out (""4"");{} out (" """); out(datei);{} out (""" wird zum MENUKARTEN-MANAGER geschickt!");{} + command dialogue (FALSE);{} save (datei, task (mm taskname));{} command dialogue (TRUE);{} forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget (eigener name, quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{} page;{} putline (" "15"ls-MP BAP - Automatische Generierung "14"").{} +hole die dateien:{} IF NOT exists (datei 1){} COR NOT exists (datei 2){} COR NOT exists (menukarte){} THEN hole dateien vom archiv; LEAVE hole die dateien{} FI.{}hole dateien vom archiv:{} cursor (1,3); out (""4"");{} IF yes ("Ist das Archiv angemeldet und die Diskette eingelegt"){} THEN lese ein{} ELSE line (2);{} errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){} FI.{}lese ein:{} cursor (1, 3); out (""4"");{} out (" "15"Bitte die Diskette eingelegt lassen! "14"");{} + IF NOT einzeln{} THEN hole (datei 1);{} hole (datei 2);{} hole (menukarte);{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} release (archive){} FI.{}insertiere die dateien:{} check off;{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} in (datei 1);{} in (datei 2);{} schicke (menukarte);{} IF einzeln THEN release (archive) FI;{} + check on.{}mache global manager aus der task:{} global manager.{} + diff --git a/app/gs.process/1.02/doc/Anhang Prozess b/app/gs.process/1.02/doc/Anhang Prozess new file mode 100644 index 0000000..8415268 --- /dev/null +++ b/app/gs.process/1.02/doc/Anhang Prozess @@ -0,0 +1,92 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#center##on("b")#Anhang#off("b")# + +#center##on("b")#Bezugsquellenverzeichnis#off("b")# + + + - AKTRONIK + Elektronik-Großhandel + A. Kaup + Teichstraße 9 + 4401 Saerbeck + Tel.: 02574/8008 - 8009 + + + + - BICOS Computer GmbH + Werkering 6 + Postfach 1229 + 4800 Bielefeld 1 + Tel.: 0521/34011 + + + + - lattasoft + Eva Latta-Weber + Software-  und + Hardware-Systeme + Brehmstraße 7 + 4800 Bielefeld 1 + Tel.: 0521/38919 + + + + - Landesinstitut für Schule + und Weiterbildung + Paradieser Weg 64 + 4770 Soest + Tel.: 02921/683-1 + +#page# +#on("b")#Anhang#off("b")# + +#on("b")#Verzeichnis der Abbildungen#off("b")# + +Abb. 1: MUFI geöffnet +Abb. 2: Mögliche DIP-Schalter-Stellung beim MUFI +Abb. 3: Einbau des MUFIs in den Terminalkanal +Abb. 4: RS232-Adapter geöffnet +Abb. 5: Mögliche Jumperposition beim RS232-Adapter +Abb. 6: Auswahl der Interface-Anpassung +Abb. 7: Anschluß Leuchtdiodenanzeige -Kombikarte +Abb. 8: Pinbelegung auf der E/A-Karte +Abb. 9: Eingangsbildschirm ls-Prozess +Abb.10: Menubildschirm zum Oberbegriff 'Interface' +Abb.11: Information bei unkonfiguriertem System +Abb.12: Auswahl der Steckplatzart +Abb.13: Compact-Box: Belegung der Kanäle +Abb.14: Auswahl einer Interfacekarte +Abb.15: Kanalbelegung D/A-Karte (Einzelsteckplatz) +Abb.16: A/D-Karte: Angabe der Schalterstellung +Abb.17: A/D-Karte: Kanalbel./Spannungsber.(Bspl.) +Abb.18: Ausgabetest - Einblendung +Abb.19: Eingabetest - Einblendung +Abb.20: Beispiellochkarte +Abb.21: Aufbau eines Drehpotentiometers +Abb.22: Eingangsbildschirm ls-Prozess +Abb.23: Befehlsübersicht +Abb.24: Auswahl Ausgabebefehle +Abb.25: Auswahl Eingabebefehle +Abb.26: Auswahl Testbefehle +Abb.27: Auswahl 'Weitere Befehle' +Abb.28: Menubildschirm zum Oberbegriff 'Interface' +Abb.29: Menubildschirm zum Oberbegriff 'Programm' +Abb.30: Informationsauswahl zum EUMEL-Editor +Abb.31: Menubildschirm zum Oberbegriff 'Archiv' +Abb.32: Auswahl der Archiv-Formate +Abb.33: Auswahl der Zieltask + + + diff --git a/app/gs.process/1.02/doc/Inhalt Prozess b/app/gs.process/1.02/doc/Inhalt Prozess new file mode 100644 index 0000000..ab9616a --- /dev/null +++ b/app/gs.process/1.02/doc/Inhalt Prozess @@ -0,0 +1,84 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#center##on("b")#Inhaltsverzeichnis#off("b")# + +1 Was kann gs-Prozess + +2 Allgemeines zur Prozeßdatenverarbeitung +2.1 Welche Hardware-Lösungen gibt es zur Zeit ? +2.2 Die besonderen Probleme unter EUMEL +2.3 Die Wahl des Interface-Systems + +3 Installation des Interface-Systems +3.1 Das MUFI der Firma BICOS als Adapter +3.1.1 Einstellung der DIP-Schalter am MUFI +3.1.2 Einbau des MUFIs in den Terminalkanal +3.1.3 Das MUFI an separater serieller Schnittstelle +3.2 Der RS232-Adapter der Firma AKTRONIK +3.3 Verbindung Adapter - Interface-System +3.4 Bereitstellung des Interface-Systems + +4 Installation von gs-Prozess +4.1 Voraussetzungen +4.2 Lieferumfang +4.3 Installation +4.4 Anmerkungen zur Erstinstallation + +5 Konfiguration von gs-Prozess +5.1 Kontrolle der Konfigurationen/Anschlüsse +5.2 Vorbereitungen für den Ein-/Ausgabetest +5.2.1 Anschluß einer Leuchtdiodenanzeige an die Kombikarte +5.2.2 Anschluß des Codekartenlesers (Drahtstück) +5.3 Konfiguration von gs-Prozess +5.3.1 Auswahl der Steckplatzart/Interfacekarte +5.3.2 Bedeutung der Kanalnummern +5.4 Aus- und Eingabetest +5.5 Mögliche Fehlerfälle + +6 Arbeiten mit gs-Prozess +6.1 Kleine Beispiele zur digitalen Ausgabe +6.1.1 Möglichkeit eines Programmabbruchs +6.1.2 Die "sonstigen" Befehle +6.1.3 Schreibweise für Bitmuster/Bitsymbole +6.1.4 Befehle für die digitale Ausgabe +6.1.5 Befehle für die analoge Ausgabe +6.2 Kleine Beispiele zur digitalen Eingabe +6.2.1 Befehle für die digitale Eingabe +6.2.2 Eingabetests +6.2.3 Befehle für die analoge Eingabe +6.3 Hinweise auf Aufgabenmaterial + +7 Beschreibung der Menufunktionen +7.1 Kurzhinweise zur Bedienung der Menus +7.2 Menufunktionen zum Oberbegriff 'Info' +7.3 Menufunktionen zum Oberbegriff 'Interface' +7.4 Menufunktionen zum Oberbegriff 'Programm' +7.5 Menufunktionen zum Oberbegriff 'Archiv' + +8 Detailbeschreibung der Basisbefehle und Tests + +9 Hinweise für den Systembetreuer/    Programmierer +9.1 Vergabe der Kanäle/Organisation des Tasksystems +9.2 Informationsprozeduren +9.3 Neufestlegung des Interfacekanals +9.4 Fixieren der Konfiguration +9.5 Mögliche Fehlerfälle +9.6 Weitere Möglichkeiten + +Anhang: Bezugsquellenverzeichnis + Verzeichnis der Abbildungen + + + + diff --git a/app/gs.process/1.02/doc/gs-Prozess handbuch.impressum b/app/gs.process/1.02/doc/gs-Prozess handbuch.impressum new file mode 100644 index 0000000..ca22b10 --- /dev/null +++ b/app/gs.process/1.02/doc/gs-Prozess handbuch.impressum @@ -0,0 +1,104 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#gs-Prozess + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# + +#free (4.0)##on("b")# +#center#gs-Prozess + + +#center#Benutzerhandbuch + + +#center#Version 1.0 + + +#off("b")##center#copyright +#center#Eva Latta-Weber +#center#Software- und Hardware-Systeme, 1988 +#center#ERGOS GmbH, 1990 +#page# +#block# +#center#____________________________________________________________________________ + + +Copyright:  ERGOS GmbH   März 1990 + + Alle Rechte vorbehalten. Insbesondere ist die Überführung in + maschinenlesbare Form sowie das Speichern in Informations­ + systemen, auch auszugsweise, nur mit schriftlicher Einwilligung + der ERGOS GmbH gestattet. + + +#center#____________________________________________________________________________ + +Es kann keine Gewähr übernommen werden, daß das Programm für eine +bestimmte Anwendung geeignet ist. Die Verantwortung dafür liegt beim +Anwender. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrektheit und +Vollständigkeit der Angaben kann keine Gewähr übernommen werden. Das +Handbuch kann jederzeit ohne Ankündigung geändert werden. + +Texterstellung :  Dieser Text wurde mit der ERGOS-L3 Textverarbeitung + erstellt und aufbereitet und auf einem Kyocera Laser­ + drucker gedruckt. + + + + +#center#___________________________________________________________________________ + + + +Ergonomic Office Software GmbH + +Bergstr. 7 Telefon: (02241) 63075 +5200 Siegburg Teletex: 2627-2241413=ERGOS + Telefax: (02241) 63078 + + +#center#____________________________________________________________________________ + + + + + + + + + + + + + + + + + diff --git a/app/gs.process/1.02/doc/gs-Prozess-2 b/app/gs.process/1.02/doc/gs-Prozess-2 new file mode 100644 index 0000000..376143e --- /dev/null +++ b/app/gs.process/1.02/doc/gs-Prozess-2 @@ -0,0 +1,255 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#2  Allgemeines zur Prozeßdatenverarbeitung#off("b")# + +In diesem Kapitel erfahren Sie, warum unter EUMEL/ELAN die Prozeßdatenver­ +arbeitung bisher kaum Berücksichtigung gefunden hat und welche Probleme zu +überwinden waren. Es wird aufgezeigt, warum unter EUMEL/ELAN nicht jedes Inter­ +facesystem verwendet werden kann; außerdem werden die Gründe für die Wahl eines +bestimmten Interfacesystems genannt. + + +#on("b")#2.1  Welche Hardware-Lösungen gibt es zur Zeit ?#off("b")# + +Wie schon in Kapitel 1 erwähnt, ist zum Messen, Steuern und Regeln mit dem +Computer ein Hardware-Interface notwendig, über das der "Kontakt zur Außenwelt" +hergestellt wird. + + +#on("b")# + Computer <--------> Interface <--------> Modell +#off("b")# + + +Interfaces (zu deutsch etwas mißverständlich: Schnittstellen) verbinden innerhalb +eines Systems Teilsysteme und einzelne Funktionseinheiten miteinander. Dabei +werden z.B. #on("b")#Hardware-Schnittstellen#off("b")# (Um diese geht es vornehmlich in diesem +Kapitel), #on("b")#Hardware-Software-Schnittstellen#off("b")# (Nach Festlegung, welche Funktionen +eines Rechnersystems von der Hardware und welche von der Software übernommen +werden, erfolgt hierüber die Verknüpfung der beiden Komponenten), #on("b")#Software- +Schnittstellen#off("b")# (zwischen Programmoduln), #on("b")#Mensch-Maschine-Schnittstellen#off("b")# +(Benutzerschnittstellen - wie z.B. #on("b")#gs-DIALOG#off("b")#) unterschieden. + +Wenn wir im folgenden von 'Interface' reden, ist damit immer eine 'Hardware- +Schnittstelle' gemeint. + +Über ein solches Interface (eine Hardware-Schnittstelle) können an den Computer +externe Geräte/Modelle angeschlossen werden, die vom Computer aus gesteuert +werden. Dabei setzt das Interface die vergleichsweise schwachen Signale des +Computers in Ströme und Spannungen um, mit denen z.B. eine Lampe oder ein +Motor betrieben werden kann. Umgekehrt senden externe Geräte/Modelle über das +Interface Signale an den Computer, die von ihm ausgewertet werden. So müssen z.B. +Widerstandsveränderungen eines Temperaturfühlers oder die Stellung eines Schalters +in eine vom Computer erfaßbare Form umgewandelt werden. + +Inzwischen bieten verschiedene Hersteller (FISCHER, LEGO, AKTRONIK, PHYWE, +etc.) und Lehrmittelverlage (METZLER, CVK, etc.) eine Reihe von Lösungen an. +Leider sind die meisten Lösungen auf ganz spezielle Computertypen zugeschnitten +und somit nicht an anderen Computertypen verwendbar - außerdem unterscheiden +sich die verschiedenen Lösungen z.T. ganz erheblich im Leistungsumfang. + +Einzellösungen, insbesondere an den gängigen Homecomputern, gibt es schon seit +langem. Voraussetzung ist zumeist, daß der Computer über einen speziellen +Anschluß ('Userport' oder 'Joystick-Eingang') verfügt. Oder es werden Platinen +geliefert, die in spezielle Steckplätze (Slots) einzustecken sind, wo sie vom Computer +aus angesprochen werden können. + +Bei all diesen Lösungen konnten wir 'EUMELaner' nur neidvoll zuschauen. Der +Vorteil, den wir sonst so zu schätzen wissen, ein einheitliches Betriebssystem auf ganz +unterschiedlicher Hardware zur Verfügung zu haben, wird hier zum Nachteil. Eine +einheitliche Lösung schien zu Anfang völlig aussichtslos zu sein. + + +#on("b")#2.2  Die besonderen Probleme unter EUMEL#off("b")# + +Das Betriebssystem EUMEL gestattet es nicht, beliebig auf Hardwarekomponenten des +Rechners zuzugreifen - und das aus gutem Grund, denn sonst wäre ein reibungsloser +Multi-User-Betrieb nicht gewährleistet. Man kann aber den Zugriff auf neue Hard­ +warekomponenten im EUMEL-System etablieren. Allerdings ist das etwas aufwendiger +als in anderen Systemen, denn das sogenannte 'Shard', die 'Software-Hardware- +Schnittstelle', muß angepaßt werden. + +Unsere ersten "Gehversuche" mit der Prozeßdatenverarbeitung unter EUMEL haben +so angefangen. Es ist aber leicht einzusehen, daß dieser Weg nicht sinnvoll ist. Denn +dann müßten alle EUMEL-Shards (es gibt ja für jeden Rechnertyp mindestens eines) +entsprechend geändert werden, ggf. müßten für verschiedene Lösungen verschiedene +Versionen entwickelt werden - eine Aufgabe, die niemand bereit wäre zu überneh­ +men. + + +#on("b")#2.3  Die Wahl des Interface-Systems#off("b")# + +Unser Ziel war klar: Wir wollten ein gängiges, käuflich zu erwerbendes Hardware- +Interface möglichst universell an Computern verschiedener Hersteller unter dem +Betriebssystem EUMEL ansprechen können. + +Nach Sichtung der angebotenen Systeme kamen nur drei in die engere Wahl: das +LEGO-Interface, das FISCHER-Technik-Interface und das AKTRONIK-Interface (Soft­ +ware-kompatibel dazu ist das PHYWE-Interface). + +Bei der Auswahl hielten wir es für sinnvoll, die Empfehlung des Landesinstituts für +Schule und Weiterbildung in Soest zu berücksichtigen, in der folgende Anforderungen +an Interfaces formuliert sind: + + - 8 digitale Eingänge + - 8 digitale Ausgänge + - optional: analoge Ein- und Ausgabe. + +Allen gestellten Anforderungen wird nur das AKTRONIK-Interface gerecht. Das System +ist modular aufgebaut, je nach Anforderungen kann mit verschiedenen Steckkarten +gearbeitet werden. Es gibt eine "Kompaktlösung", bei der die wichtigsten Funktionen +bereitgestellt werden (8 digitale Eingänge, 8 digitale Ausgänge, 2 analoge Eingänge). +Darüber hinaus kann auch noch mit dem sog. 'Modul-Bus' gearbeitet werden, bei +dem gleichzeitig mehrere Steckkarten angesprochen werden können. Mit ent­ +sprechender Steckkarte ist auch die analoge Ausgabe möglich. + +Die beiden anderen Interfaces erfüllen die oben genannten Anforderungen nicht: Das +LEGO-Interface verfügt über nur 6 digitale Ausgänge und 2 digitale Eingänge; analoge +Ein- und Ausgabe ist gar nicht möglich. + +Das FISCHER-Technik-Inteface verfügt über 8 digitale Ausgänge und 8 digitale Ein­ +gänge. Das Interface verfügt auch über einen analogen Eingang - allerdings nicht +über einen Analog-Digital-Wandler-Baustein! Das bedeutet, daß der angeschlossene +Rechner die Auswertung der eingehenden Daten übernehmen muß - ein zeit­ +kritischer Prozeß, der in einem Multi-User-System nicht garantiert werden kann. Die +analoge Ausgabe ist grundsätzlich nicht möglich, das System ist in sich abgeschlossen +und kann sich ändernden Anforderungen ebensowenig angepaßt werden wie das +LEGO-Interface. + + +Wir entschieden uns also dafür, die weitere Entwicklung auf der Basis des +AKTRONIK-Interfaces zu betreiben. Es galt jedoch noch, dieses Interface mit dem +Computer zu verbinden - und das möglichst universell: möglichst unabhängig von der +verwendeten Computerhardware. + +Dieses Ziel ist nur dann zu erreichen, wenn man die 'Standardschittstellen' des +Computers berücksichtigt, die unter EUMEL problemlos ansprechbar sind: die +parallelen (Centronics) und seriellen (V24) Schnittstellen. Diese 'Standardschnitt­ +stellen' sind zwar nicht für den direkten Anschluß der Modelle/Interfaces geeignet, +über einen "Adapter" aber ist ein Anschluß möglich. + +Die Entscheidung fiel schnell gegen eine Verwendung der parallelen (Centronics) +Schnittstelle. Die meisten Computer verfügen nur über eine dieser Schnittstellen, die +zumeist auch schon durch den Drucker belegt ist. Außerdem handelt es sich dabei in +der Regel um eine unidirektionale Schnittstelle - d.h. die Daten können vom +Computer zum Endgerät (z.B. Drucker) gelangen, nicht aber vom Endgerät zum +Computer. Somit wären zwar Steuerungsvorgänge, nicht aber Meß- und Regelungs­ +vorgänge über die Schnittstelle möglich. + +Einige Hersteller nutzen die Datenleitungen, über die z.B. der Drucker dem Rechner +mitteilt, daß der interne Speicher voll bzw. das Papier zuende ist. Über diese Leitung +werden Daten seriell übertragen und vom Rechner ausgewertet. Unter EUMEL +scheidet diese Lösung aber aus, denn um hier eine sichere Auswertung zu gewähr­ +leisten, müßten Maschinenspracheprogramme eingebunden werden; das ist aber +unter EUMEL nicht möglich. + +Damit war festgelegt, daß die weitere Entwicklung auf der Basis des AKTRONIK-Inter­ +faces über die serielle Schnittstelle erfolgen sollte. Wie schon erwähnt, ist das Inter­ +face auf keinen Fall direkt an die serielle Schnittstelle anschließbar. Wie der Name +schon sagt, werden die Daten bei einer seriellen Schnittstelle seriell übertragen - um +Prozeßdatenverarbeitung zu betreiben, müssen die Daten aber parallel vorliegen. + +Notwendig ist also ein "Adapter", der einen Seriell-Parallel-/Parallel-Seriell-Wandler +beinhaltet, so daß die Verbindung zwischen Computer und Interface hergestellt +werden kann. + +Inzwischen sind uns hier zwei (käuflich zu erwerbende) Lösungen bekannt - der +"RS232-Adapter" der Firma AKTRONIK und das "MUFI" (Multifunktionales Interface) +der Firma BICOS: + +Das MUFI ist sicherlich der universeller verwendbare "Adapter" (leider aber auch die +kostspieligere Lösung). Einerseits kann es ebenso wie der "RS232-Adapter" an eine +separate serielle Schnittstelle angeschlossen werden, andererseits verfügt es über +einen zweiten - den eigentlich interessanten Betriebsmodus: Es kann nämlich auch +in den Terminalkanal eingebaut werden. + +Die Idee, die dahintersteckt, ist folgende: Das MUFI verfügt (neben der eigentlich +wichtigen bidirektionalen parallelen Schnittstelle) über einen (seriellen) Eingang und +einen (seriellen) Ausgang. So kann das MUFI einfach in eine Leitung zwischen +Computer und Terminal eingebaut werden. In ausgeschaltetem Zustand hat es +keinen Einfluß auf den Datenaustausch zwischen Rechner und Terminal - als ob es +gar nicht vorhanden wäre. In eingeschaltetem Zustand dagegen "horcht es den +Datenfluß zwischen Rechner und Terminal ab". Auf eine vereinbarte Parole +(Zeichenkombination) hin, "weiß es", daß die folgenden Daten nicht für das +Terminal, sondern eben für sich bestimmt sind. Diese, und nur diese Daten werden +aus dem Datenstrom vom MUFI "herausgefischt" und intern sachgerecht weiterver­ +arbeitet. Alle anderen Daten werden unbeeinflußt an das Terminal weitergeleitet, +damit ja nicht der reibungslose Betrieb gestört wird. Natürlich ist das MUFI ebenso in +der Lage, die gerade extern anliegenden Daten zu ermitteln und in den Datenstrom +zum Computer "einzuschleusen". + +Um diese Aufgaben bewältigen zu können, wurde das MUFI mit einem eigenen, +schnellen Mikroprozessor ausgestattet, der in der Lage ist, den Datenfluß zu +bewältigen. Zudem wurde versucht, das MUFI mit soviel Intelligenz (Firmware) +auszustatten, daß alle zeitkritischen Prozesse bei der Ansteuerung des Interface- +Systems vom MUFI selbst erledigt und die Daten vom MUFI so aufbereitet werden, +daß sie möglichst einfach weitergegeben und verarbeitet werden können. + +Durch die Beschränkung der Baud-Rate auf maximal 19200 ist die Verarbeitungs­ +geschwindigkeit allerdings auch beschränkt. Die rechnerisch maximale Ausgabetakt­ +rate von 320 Hz bei 19200 Baud und 160 Hz bei 9600 Baud wird von #on("b")#gs-Prozess#off("b")# auf +einem 80386-Rechner im Alleinbetrieb tatsächlich erreicht. Natürlich bedeuten +mehrere gleichzeitig betriebene MUFIs an einem Rechner Geschwindigkeitseinbußen. +Ebenso sinkt die Ausgabetaktrate bei Prozessoren mit geringerem Durchsatz (8088: +maximal 120 Hz). Für die Anwendungen in der Schule sind diese Geschwindigkeiten +aber hinreichend. + +Die Vorteile des MUFI für diejenigen, die EUMEL im Multi-User-Betrieb nutzen, liegen +dennoch klar auf der Hand: + + - Es werden keine weiteren seriellen Schnittstellen benötigt. (Die vorhandenen + sind sowieso schon weitgehend belegt. Gegebenenfalls würden zusätzliche + Kosten verursacht.) + + - Es sind keine weiteren Kabelverlegungen zwischen Rechner und Arbeitsplatz + notwendig, trotzdem befindet sich das MUFI direkt am Bildschirmarbeits­ + platz. + + - Das beim Anschluß an eine separate Schnittstelle notwendige, zeitauf­ + wendige Ansteuern des Interface-Kanals entfällt. + + +Arbeiten Sie an einem Einzelplatz-System (z.B. IBM-kompatibler Rechner nur mit +Monitor) so ist ein Betrieb des MUFIs im Terminal-Kanal nicht möglich. Hier bleibt +nur der Betrieb des Interface-Systems an einer separaten seriellen Schnittstelle. +Sinnvoll ist aber auch ein solcher Betrieb, wenn (zunächst) nur die Hardware für +einen Arbeitsplatz zur Verfügung steht. Das Interface kann dann nämlich von meh­ +reren Tasks abwechselnd angesprochen werden. + +Beim Anschluß an eine separate serielle Schnittstelle sind die Leistungen des MUFIs +und des RS232-Adapters gleichwertig. Da das abwechselnde Ansprechen einer +seriellen Schnittstelle und der Tastatur/des Monitors unter EUMEL relativ zeitauf­ +wendig ist, sind hier keine hohe Ausgabegeschwindigkeiten zu erwarten: bei einem +8088-Rechner ca. 40 Hz, bei Prozessoren mit höherem Durchsatz eben entsprechend +mehr. Dennoch ist das für die meisten Anwendungen in der Schule schnell genug. + +Für Spezialanwendungen ist auch die direkte Ansprache der Schnittstelle möglich. +Hierbei sind Ausgabetaktraten von 960 Hz bei 19200 Baud bzw. 480 Hz bei 9600 +Baud möglich. Für die schulische Praxis (in der Sekundarstufe I) ist diese "direkte +Ansprache" aber ungeeignet, da weitergehende Programmierkenntnisse erforderlich +sind. Zudem kann bei Programmierfehlern "die Task am Kanal hängenbleiben". +Genaueres dazu sehen Sie bitte im Kapitel 'Hinweise für den Systembetreuer/ +Programmierer'. + +Die Hardware-Konstellation stellt sich im Überblick also folgendermaßen dar: +#on("b")# + + Computer <---> Adapter <---> Interface <---> Modell + + (mit se- ('MUFI' (AKTRONIK) + rieller oder + Schnitt- 'RS232- + stelle) Adapter') +#off("b")# + diff --git a/app/gs.process/1.02/doc/gs-Prozess-3 b/app/gs.process/1.02/doc/gs-Prozess-3 new file mode 100644 index 0000000..3fae1bd --- /dev/null +++ b/app/gs.process/1.02/doc/gs-Prozess-3 @@ -0,0 +1,346 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#3  Installation des Interface-Systems#off("b")# + +In diesem Kapitel erfahren Sie, wie Sie Ihr Interface-System an den Rechner an­ +schließen und welche Einstellungen noch vorzunehmen sind. Für Details und weiter­ +gehende Informationen sehen Sie bitte in den Handbüchern / Begleitmaterialien der +Firmen BICOS bzw. AKTRONIK nach. + +Am Ende des Kapitels 2 haben wir festgestellt, daß das Interface-System über einen +Adapter mit dem Computer verbunden werden muß. An das Interface-System lassen +sich dann entsprechende Modelle anschließen: + +#on("b")# Computer <----> Adapter <----> Interface <----> Modell + + (mit se- ('MUFI' (AKTRONIK) + rieller oder + Schnitt- 'RS232- + stelle) Adapter') #off("b")# + +Wir möchten Ihnen zuerst erklären, wie Sie den jeweiligen Adapter mit dem +Computer verbinden und welche Einstellungen am Adapter vorzunehmen sind. An­ +schließend beschreiben wir, wie Sie das Interface-System an den Adapter anschlie­ +ßen. + +Wie schon in Kapitel 2 erwähnt, können Sie zwischen zwei Adaptern wählen - dem +MUFI der Firma BICOS und dem RS232-Adapter der Firma AKTRONIK. Letztge­ +nannter kann nur an einer separaten seriellen Schnittstelle betrieben werden, +während das MUFI zusätzlich auch in den Terminalkanal eingebaut werden kann. + + +#on("b")#3.1  Das MUFI der Firma BICOS als Adapter#off("b")# + +Für den Betrieb in einem Terminalkanal sollte das MUFI über eine sog. "Schnitt­ +stellen-Automatik" verfügen, die verhindert, daß das MUFI in ausgeschaltetem +Zustand oder mit abgezogenem Netzstecker den Datenfluß zwischen Rechner und +Terminal unterbricht. Diese sehr sinnvolle Automatik wird von BICOS #on("b")#nicht +standardmäßig#off("b")# eingebaut. Sie sollten bei eventuellen Bestellungen darauf achten. +Bevor Sie das MUFI in den Terminalkanal einbauen oder an eine separate serielle +Schnittstelle anschließen, ist noch die Einstellung der DIP-Schalter zu kontrollieren +bzw. eine Neueinstellung vorzunehmen. + + +#on("b")#3.1.1  Einstellung der DIP-Schalter am MUFI#off("b")# + +Versichern Sie sich, daß das MUFI noch nicht an das Netz angeschlossen ist. Öffnen +Sie dann das Gehäuse, indem Sie die vier Schrauben an der Unterseite des MUFIs +(direkt neben den Füßen) lösen. Heben Sie nun #on("b")##on("b")#vorsichtig#off("b")##off("b")# den hellen Deckel des +Gehäuses ab. Aber Achtung! Der Deckel bleibt über Kabel mit dem Fußteil ver­ +bunden! Legen Sie vorsichtig den Deckel neben das MUFI, so daß die Kabelver­ +bindungen nicht belastet werden. + + +---------------------------------------------------+ + | +-------+ +------------+ | + | | | | | +---------+ | + | +-------+ | | | DIP- | | + | +-------+ | | | Schalter| | +Rück- | | | | | +---------+ | Vorder- +seite | +-------+ | | +--------------+ | seite + | +-------+ | SCN68000 | | | | + | | | | | +--------------+ | + | +-------+ | | | + | +-------+ | | | + | | | | | | + | +-------+ +------------+ | + +---------------------------------------------------+ + + + +#center#Abb.1: MUFI geöffnet + + +Im Inneren des Fußteiles fällt Ihnen sofort der größte CHIP auf, der u.a. die +Bezeichnung 'SCN68000' trägt. Drehen Sie das MUFI so vor sich, daß an der linken +Seite dieses Chips die vier gleichen, mittelgroßen Chips zu liegen kommen. Dann +sehen Sie rechts vom großen Chip, ganz hinten im Gehäuse eine kleine Plastikbox +mit DIP-Schaltern, die die folgende Aufschrift trägt: + +#on("b")# + O N + 1 2 3 4 +#off("b")# + +Den durchsichtigen Deckel dieser kleinen Plastikbox müssen Sie nun öffnen, um die +Stellung der DIP-Schalter einsehen zu können. Dazu verwenden Sie am besten einen +Kugelschreiber oder einen kleinen Schraubendreher. Heben Sie damit den Deckel an +der rechten Seite leicht an, dann läßt sich der Deckel nach links herüberlegen. Weist +ein Schalter nach hinten (in dieser Lage des MUFIs von Ihrem Körper weg), so hat er +die Stellung 'ON', weist er nach vorn (zu Ihrem Körper hin), so hat er die Stellung +'OFF'. + + +Beispiel: + + +---------------------------------------+ + | +-----+ +-----+ +-----+ +-----+ | + | |+++++| | | | | | | | + | |+++++| | | | | | | | ON + | |+++++| | | | | | | | + | |+++++| | | | | | | | + | | | | | | | | | | + | | | | | | | | | | + | | | | | | | | | | + | | | |+++++| |+++++| |+++++| | + | | | |+++++| |+++++| |+++++| | + | | | |+++++| |+++++| |+++++| | OFF + | | | |+++++| |+++++| |+++++| | + | +-----+ +-----+ +-----+ +-----+ | + +---------------------------------------+ + + 1 2 3 4 + +#center#Abb.2:  Mögliche DIP-Schalter-Stellung beim MUFI + + +Dabei haben die DIP-Schalter folgende Bedeutung: + +#on("b")# + 1 ON : Modulbusbetrieb + OFF : Parallelportbetrieb + + 2 ON : RTS/CTS Hardware Handshake + OFF : XON-/XOFF-Protokoll + + 3 ON : 9600 Baud + OFF : 19200 Baud + + 4 ON : Even Parity + OFF : No Parity + +#off("b")# +Wenn Sie das MUFI im Terminalkanal betreiben wollen, müssen Sie je nachdem, wie +Sie Ihr Terminal konfiguriert haben, die entsprechende Einstellung vornehmen. + +Betreiben Sie das Terminal mit einer Übertragungsrate von 19200 Baud, so sollten +Sie unbedingt mit XON/XOFF-Protokoll arbeiten - es sei denn, das Terminal unter­ +stützt RTS/CTS! In jedem Falle muß der DIP-Schalter 1 in die Stellung ON gebracht +werden (der Betrieb des Interface-Systems der Firma AKTRONIK wird hier "Modul­ +busbetrieb" genannt). + +Wenn Sie das MUFI an einer separaten seriellen Schnittstelle betreiben wollen, #on("b")#muß#off("b")# +der Datenaustausch mit dem RTS/CTS-Protokoll abgewickelt werden. Versichern Sie +sich, daß Ihr Kabel darauf ausgelegt ist! + +Nach dieser Einstellung der DIP-Schalter ist das MUFI betriebsbereit. Schrauben Sie +bitte den Gehäusedeckel mit den vier Schrauben wieder fest. + + +#on("b")#3.1.2  Einbau des MUFIs in den Terminalkanal#off("b")# + +Um das MUFI in den Terminalkanal einbauen zu können, müssen Sie zunächst die +Zuleitung vom Rechner zum Terminal am Terminal lösen. Auf der Rückseite des +MUFIs befinden sich zwei Stecker, die mit V24/1 und V24/2 bezeichnet sind. Ver­ +inden Sie nun das Kabel, was ursprünglich vom Computer zum Terminal führte, mit +dem MUFI, indem Sie es an den mit V24/2 gekennzeichneten Stecker anstecken. Sie +benötigen jetzt noch ein weiteres (kurzes) V24-Kabel, um das MUFI mit dem +Terminal zu verbinden. Es wird einerseits auf den mit V24/1 gekennzeichneten +Stecker am MUFI aufgesteckt; das andere Ende wird mit dem Terminal in gleicher +Weise verbunden, wie das ursprüngliche Kabel zwischen Rechner und Terminal. + + + +--------------------------+ + | +----------------------+ | + | | V24/1 V24/2 | | + | | | | | | + | +----|-----------|-----+ | + +------|-----------|-------+ + | | + | | + ZUM <-----+ +-----> ZUM + TERMINAL COMPUTER + + +#center#Abb.3: Einbau des MUFIs in den Terminalkanal + + +Beachten Sie bitte, daß die V24-Schnittstellen des MUFIs auf 8 Datenbits und 1 Stop­ +bit fest eingestellt sind - ggf. müssen Sie Ihre Terminalkonfiguration hieran anpassen. +Kontrollieren Sie aber in jedem Falle, ob die Konfiguration mit diesen Daten überein­ +stimmt! + +Koppeln Sie dazu die Task 'configurator' an Ihr Terminal (mit 'continue +("configurator") ') und geben Sie dann das Kommando 'configurate +'. Für alle vorhandenen Kanäle werden Sie nun nacheinander gefragt, +ob Sie eine Konfiguration vornehmen wollen. Bei den "interessanten Kanälen" ant­ +worten Sie mit 'ja' (). + +Wollen Sie sich nur die aktuelle Konfiguration ansehen, so beantworten Sie alle dann +gestellten Fragen zum Kanal mit 'ja' (), dann bleibt die aktuelle Einstellung +erhalten. Der Konfigurationsdialog ist im EUMEL-Systemhandbuch auf den Seiten 6 - +8 detailliert beschrieben. + +Die Verschaltung der V24-Kabel ist in der Bedienungsanweisung zum MUFI erläutert, +ggf. können Sie entsprechende Kabel von der Firma BICOS beziehen. + +Wenn alle Kabelverbindungen gesteckt sind, sollten Sie auf alle Fälle erst einmal #on("b")#bei +ausgeschaltetem MUFI#off("b")# prüfen, ob das Terminal sich noch bedienen läßt. Wenn das +Terminal keine Reaktion mehr zeigt, obwohl es vorher (ohne MUFI) reibungslos +funktioniert hat, dann haben Sie entweder ein MUFI ohne "Schnittstellen-Automatik" +vor sich (vergl. Sie dazu Kap. 3.1), oder an den Kabelverbindungen stimmt irgend­ +etwas nicht. In diesem Falle sollten Sie noch einmal alle Anschlüsse und eventuell +auch die interne Verschaltung der Kabel überprüfen. + + +#on("b")#3.1.3  Das MUFI an separater serieller Schnittstelle#off("b")# + +Wenn Sie das MUFI als Endgerät an einer separaten seriellen Schnittstelle betreiben, +dann stecken Sie das vom Computer kommende Kabel auf den mit V24/2 +bezeichneten Stecker an der Rückseite des MUFIs. Damit ein einwandfreier Betrieb +gewährleistet ist, sollten Sie einen sog. "Kurzschlußstecker" auf die dann freie +25polige D-Subminiatur-Buchse (V24/1) am MUFI aufstecken. Haben Sie eine solche +nicht zur Hand, können Sie zwei kleine Brücken einsetzen: Nehmen Sie dazu zwei +kleine Drahtstücke und verbinden Sie einmal Pin (Öffnung) 2 mit Pin 3 und außer­ +dem Pin 4 mit Pin 5. + +In der Task 'configurator' muß der Kanal, an dem das MUFI angeschlossen ist, auf +'transparent, 8 Bit, 1 Stopbit, RTS/CTS-Protokoll' eingestellt werden, weiterhin je nach +MUFI-DIP-Schalter-Stellung auf '9600' bzw. '19200 Baud' und 'no parity' bzw. 'even +parity'. + + +#on("b")#3.2  Der RS232-Adapter der Firma AKTRONIK#off("b")# + +Bevor Sie den Adapter an die serielle Schnittstelle anschließen, ist noch die einge­ +stellte Baudrate zu überprüfen bzw. eine Neueinstellung vorzunehmen. + +Öffnen Sie das Gehäuse des Adapters, indem Sie die vier Schrauben an der Unterseite +lösen. Drehen Sie den Adapter so vor sich, daß die 25polige D-Subminiatur-Buchse +von Ihrem Körper wegzeigt. Vorn rechts sind dann zwei parallele 8polige Pfosten­ +steckerleisten sichtbar. + +#center#25-pol. D-Subminiatur-Stecker + + +---------------+ + | | + +---+ +---+ + | +------+ | + | | | | + | | | | + | | | | + | | | | + | +------+ | + | +------+ | + | | | +-------+ | + | +------+ | | | + | +------+ +-------+ | + | | | +-------+ | + | +------+ | <-|---------Jumper-Leiste + | +-------+ | + +---+ +---+ + | Baudrate | + +---------------+ + + +#center#Abb.4:  RS232-Adapter geöffnet + + +Auf einem Paar steckt ein 'Jumper', mit dem die Baudrate eingestellt wird. +Gegebenenfalls ist dieser Jumper umzustecken. Anschließend schrauben Sie das +Gehäuse mit den vier entfernten Schrauben wieder zu. + + +---------+ + | o o | 300 + | o o | 600 + | o o | 1200 + | o o | 2400 + | o o | 4800 + | o o | 9600 + Jumper ---> | o o | 19200 + | o o | 38400 + +---------+ + Baudrate + + +#center#Abb.5:  Mögliche Jumperposition beim RS232-Adapter + + +Nun muß noch in der Task 'configurator' der entsprechende Kanal konfiguriert +werden. Koppeln Sie dazu die Task 'configurator' an Ihr Terminal (mit 'continue +("configurator") ') und geben Sie dann das Kommando 'configurate +'. Für alle vorhandenen Kanäle werden Sie nun nacheinander gefragt, +ob Sie eine Konfiguration vornehmen wollen. Beim vorgesehenen Kanal antworten Sie +mit 'ja' (). + +Wollen Sie sich nur die aktuelle Konfiguration ansehen, so beantworten Sie alle dann +gestellten Fragen zum Kanal mit 'ja' (), dann bleibt die aktuelle Einstellung +erhalten. Der Konfigurationsdialog ist im EUMEL-Systemhandbuch auf den Seiten 6 - +8 detailliert beschrieben. + +Folgende Konfigurationsmerkmale müssen eingestellt werden: + + transparent, 8 Bit, 2 Stopbit, no Parity, #on("b")#kein#off("b")# Protokoll + +Die Baudrate ist entsprechend der Jumper-Stellung einzustellen. + +Am Adapter ist ein Kabel mit 25poligem D-Subminiatur-Stecker bereits fest montiert. +Sollte der Stecker nicht an Ihren Rechner passen, so müßten Sie ein entsprechendes +Adapterkabel basteln oder kaufen. + + + +#on("b")#3.3  Verbindung Adapter - Interface-System#off("b")# + +Nachdem Sie nun den Adapter (MUFI oder RS232-Adapter) an den Rechner ange­ +schlossen haben, müssen Sie noch die Verbindung zum Interface-System herstellen. +Dabei ist es gleichgültig, ob Sie eine Compact-Box, einen Einzelsteckplatz oder einen +Mehrfachsteckplatz benutzen, denn alle diese Geräte verfügen über den gleichen +Anschlußstecker. Den RS232-Adapter können Sie direkt an das Interface-System +anschließen, denn er verfügt bereits über einen entsprechenden Stecker. + +Für das MUFI benötigen Sie ein Anschlußkabel, das auf der einen Seite einen +36poligen Centronics-Stecker und auf der anderen Seite einen 25poligen D-Sub­ +miniatur-Stecker besitzt (von der Firma BICOS zu beziehen). + + +#on("b")#3.4  Bereitstellung des Interface-Systems#off("b")# + +Sofern Sie eine Compact-Box angeschlossen haben, brauchen Sie nur noch das mitge­ +lieferte Netzteil mit der Compact-Box und dem Netz zu verbinden und die ent­ +sprechende Spannung laut beiliegender Bedienungsanweisung der Fa. AKTRONIK +einzustellen. + +Wenn Sie mit einem Einzelsteckplatz oder einem Mehrfachsteckplatz arbeiten, +müssen Sie zunächst noch eine Interface-Karte einstecken. Für einen anschließenden +Test des Systems (sehen Sie dazu Kapitel 5) empfiehlt es sich, eine Kombikarte oder +eine E/A-Karte zu verwenden. Nach dem Einstecken der Interface-Karte ist der Steck­ +platz noch mit dem Netzstecker an das Stromnetz anzuschließen, um eine +Spannungsversorgung zu gewährleisten. + + + + + + + diff --git a/app/gs.process/1.02/doc/gs-Prozess-4 b/app/gs.process/1.02/doc/gs-Prozess-4 new file mode 100644 index 0000000..e106df1 --- /dev/null +++ b/app/gs.process/1.02/doc/gs-Prozess-4 @@ -0,0 +1,173 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#4  Installation von gs-Prozess#off("b")# + + +Bevor Sie #on("b")#gs-Prozess#off("b")# auf Ihrem Computer benutzen können, müssen Sie das +Programm zunächst installieren. Wenn #on("b")#gs-Prozess#off("b")# auf Ihrem System schon zur +Verfügung steht, können Sie dieses Kapitel ruhig überspringen. + + + +#on("b")#4.1  Voraussetzungen#off("b")# + + +Um #on("b")#gs-Prozess#off("b")# auf Ihrem Computer betreiben zu können, muß das EUMEL- +Betriebssystem installiert sein. #on("b")#gs-Prozess#off("b")# setzt die Multi-User-Version voraus und ist +lauffähig ab Version 1.8.x. #on("b")#gs-Prozess#off("b")# setzt weiterhin voraus, daß auf Ihrem +Computer bereits das Programm #on("b")#gs-DIALOG#off("b")# (Version 1.1) installiert ist. + + + +#on("b")#4.2  Lieferumfang#off("b")# + + +#on("b")#gs-Prozess#off("b")# wird auf einer Diskette geliefert, die alle notwendigen Programme ent­ +hält (die Installation von #on("b")#gs-DIALOG#off("b")# wird dabei vorausgesetzt!). Um den Inhalt der +Diskette feststellen zu können, starten Sie Ihr System und bringen es dazu, daß 'gib +kommando:' erscheint. Dann legen Sie die Diskette ein und geben das Kommando: + + +#on("b")##center#archive("gs-Prozess");list(archive);release(archive) #off("b")# +#page# +Anschließend erscheint eine Übersicht der auf dem Archiv vorhandenen Programme. +Folgende Programme sollten sich in der Übersicht befinden: + + + "gs-Prozess 1 für MUFI im Terminalkanal" + "gs-Prozess 1 für MUFI als Endgerät" + "gs-Prozess 1 für AKTRONIK Adapter" + "gs-Prozess 2" + "gs-Prozess 3" + "gs-Prozess 4" + "gs-Prozess 5" + "gs-MENUKARTE:Prozess" + "gs-Prozess/gen" + + +Eventuell können noch weitere Namen auf der Diskette vorhanden sein. Wenn Sie den +Inhalt der Diskette kontrolliert haben und diese Programme auf der Diskette vor­ +handen sind, können Sie #on("b")#gs-Prozess#off("b")# installieren. + +Sollten Sie statt der Übersicht eine Fehlermeldung erhalten, überprüfen Sie bitte, ob +die Diskette das richtige Format besitzt oder ob Ihr Diskettenlaufwerk Probleme +macht. Sollten dagegen Programme fehlen, so reklamieren Sie die Diskette. + + +#on("b")#4.3  Installation#off("b")# + +#on("b")#gs-Prozess#off("b")# muß in einer Task installiert werden, in der bereits das Programm +#on("b")#gs-DIALOG#off("b")# zur Verfügung steht. Alle Söhne und Enkel der neuen Task können +anschließend mit #on("b")#gs-Prozess#off("b")# arbeiten. Richten Sie also eine Task als Sohn der Task +ein, in der auf Ihrem Computer bereits #on("b")#gs-DIALOG#off("b")# installiert ist. Wir nehmen hier +an, daß #on("b")#gs-DIALOG#off("b")# in der Task 'MENU' installiert ist und die neue Task den Namen +'PDV' erhalten soll. (Sie können für die Task auch einen beliebigen anderen Namen +wählen): + +#on("b")# + (Supervisor - Taste) + + --> gib supervisor kommando: + + begin ("PDV","MENU") + + --> gib kommando: + + +#off("b")# +(Arbeiten mehrere Personen mit dem Computer, dann ist es sinnvoll, diese Task vor +unbefugtem Zugriff durch ein Passwort zu schützen. Wie das gemacht wird, können +Sie in Ihrem EUMEL-Benutzerhandbuch erfahren.) + + +Legen Sie dann die Archivdiskette ein, auf der sich #on("b")#gs-Prozess#off("b")# befindet, und geben +Sie das folgende Kommando: + + +#on("b")# + archive("gs-Prozess") + + fetch("gs-Prozess/gen",archive) + + run + +#off("b")# + +Sie haben damit das Generatorprogramm gestartet. Bevor die Generierung allerdings +ausgeführt werden kann, müssen Sie dem System noch Angaben über den ver­ +wendeten Adapter machen. Die zur Verfügung stehenden Anpassungen werden Ihnen +zur Auswahl angeboten: + +--------------------------------------------------------+ + | Auswahl der Interface-Anpassung | + | Bitte gewünschte Anpassung ankreuzen! | + |--------------------------------------------------------| + | Auswahl  e i n e r  Datei durch Ankreuzen | + |--------------------------------------------------------| + |==> > gs-Prozess 1 für MUFI im Terminalkanal | + | > gs-Prozess 1 für MUFI als Endgerät | + | > gs-Prozess 1 für AKTRONIC-Adapter | + | | + +--------------------------------------------------------| + | Info:  Fertig:  Abbrechen:  | + +--------------------------------------------------------+ +#center#Abb.6:  Auswahl der Interface-Anpassung + + +Bringen Sie den Pfeil mit den Pfeiltasten vor die gewünschte Anpassung und drücken +Sie die -Taste. + +Haben Sie als Anpassung "gs-Prozess für AKTRONIK Adapter" oder "gs-Prozess für +MUFI als Endgerät" gewählt, so erscheint als nächstes die Aufforderung: + +#center##on("b")#'Gib Interface-Kanal:'#off("b")# + +Geben Sie hier die Kanalnummer der seriellen Schnittstelle ein, an der der Adapter +betrieben werden soll. + +Die Installation wird automatisch durchgeführt. Lassen Sie während des gesamten +Vorgangs die Archivdiskette eingelegt. Die Generierung ist beendet, wenn der +EUMEL-Eingangsbildschirm erscheint. Die Task, in der die Generierung stattfin­ +det, wird automatisch zur Managertask, das heißt, daß Söhne von ihr eingerichtet +werden können. + + +#on("b")#4.4  Anmerkungen zur Erstinstallation#off("b")# + +Mit der Installation der Software ist das Gesamtsystem allerdings noch nicht betriebs­ +bereit. Dazu fehlen #on("b")#gs-Prozess#off("b")# noch einige Informationen. Bisher ist #on("b")#gs-Prozess#off("b")# +nämlich nur bekannt, welchen Adapter Sie verwenden und ob Sie ihn im Terminal­ +kanal oder an einer separaten Schnittstelle betreiben wollen. + +Um das angeschlossene Interface-System sachgerecht ansteuern zu können, benötigt +#on("b")#gs-Prozess#off("b")# aber noch Informationen über die Hardware-Konstellation. Diese Mit­ +teilungen, die noch gemacht werden müssen, nennen wir "Konfiguration von +#on("b")#gs-Prozess#off("b")#". Wie diese Konfiguration vorgenommen wird und wie Sie anschließend +Ihr Interface-System testen, ist im Kapitel 5 detailliert beschrieben. + +#on("b")#gs-Prozess#off("b")# bietet Ihnen eine Reihe von Möglichkeiten, die vorhandene Hardware +möglichst effektiv zu nutzen. So ist es möglich, wenn Sie Ihre(n) Adapter an +separater/separaten Schnittstelle(n) betreiben, von verschiedenen Tasks aus auf +einen Adapter zuzugreifen. Gerade in der Anschaffungsphase, wenn noch nicht +genügend Hardware zur Verfügung steht, ist das eine sinnvolle/preiswerte Möglich­ +keit, von verschiedenen Arbeitsplätzen aus Prozeßdatenverarbeitung zu betreiben. + +Zu diesem Zeitpunkt würde es aber zu weit führen, hierzu Details zu erläutern. +Beschreibungen dieser Möglichkeiten finden Sie im Kapitel "Hinweise für den +Systembetreuer/ Programmierer". + +#on("b")# +Sie sollten sich zunächst darauf beschränken, ein Interface-System "zum +Laufen zu bringen". Verfahren Sie dazu bitte genau, wie im Kapitel 5 +beschrieben.#off("b")# + diff --git a/app/gs.process/1.02/doc/gs-prozess-1 b/app/gs.process/1.02/doc/gs-prozess-1 new file mode 100644 index 0000000..f6a3696 --- /dev/null +++ b/app/gs.process/1.02/doc/gs-prozess-1 @@ -0,0 +1,99 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#1  Was kann gs-Prozess#off("b")# + +#on("b")#gs-Prozess#off("b")# ist ein Programmsystem unter dem Betriebssystem EUMEL, mit dem ein +Anwendungsbereich erschlossen werden kann, der bisher in der Schule zumeist sehr +stiefmütterlich behandelt wurde: die Prozeßdatenverarbeitung - das Messen, Steuern +und Regeln mit dem Computer. + +Es wird dadurch möglich, externe Modelle/Geräte (z.B. eine Ampelanlage) zu steuern +oder von externen Meßfühlern (z.B. einem Temperaturfühler) oder Eingabeeinheiten +(z.B. einem Lochkartenleser) Daten aufzunehmen. Durch die Kombination der +beiden Vorgänge können sogar komplexe geregelte Systeme in Modellen nachgebildet +werden. + +Eigentlich ist eine solch stiefmütterliche Behandlung dieses Anwendungsbereiches +von Computern in der Schule gar nicht einzusehen, denn in der Forschung, im +Dienstleistungsbereich, im privaten Bereich und vor allem in der Produktion gibt es +eine Vielzahl von Anwendungen, z.B.: + + Meßdatenerfassung und -auswertung bei Experimenten, Wetterbeobachtung, + seismologische Untersuchungen, ..., Ampelsteuerungen, Verkehrsleitsysteme, ..., + Scannerkassen, Scheckkartenleser, Geldautomaten, ..., Waschmaschinen, + Heizungsanlagen, Modelleisenbahnen, ..., CNC-Maschinen, Universalhand­ + habungsautomaten (Roboter),... + +In den meisten Fällen werden Computer eingesetzt, die speziell für diesen +Anwendungsbereich entwickelt wurden. Insbesondere an die Verarbeitungsge­ +schwindigkeit solcher Systeme werden sehr hohe Anforderungen gestellt. Solche +Systeme sind für die schulische Verwendung viel zu teuer. Zumeist sind auch die in +der Realität ablaufenden Vorgänge so komplex, daß sie als Ganzes gar nicht im +Unterricht nachgebildet werden können. + +Das aber kann auch nicht Ziel einer Auseinandersetzung mit diesem Anwendungs­ +bereich in der Schule sein. Hier gilt es, unter didaktisch-methodischen Gesichts­ +punkten, Grundprinzipen der Prozeßdatenverarbeitung zu vermitteln und beispiel­ +hafte Anwendungen an Modellen zu erarbeiten und zu erproben. In einem zeitge­ +mäßen Informatikunterricht darf dieser wichtige Anwendungsbereich von Computern +nicht ausgespart bleiben. + +Bisher scheiterte das Messen, Steuern und Regeln mit dem Computer in der Schule +meistens daran, daß es keine standardisierten Software- und Hardware-Systeme und +auch keine geeigneten Modelle gab. Das aber hat sich inzwischen geändert. +Verschiedene Hersteller bieten Interface-Systeme und Modelle an, die gut verwendet +werden können. + +Auch #on("b")#gs-Prozess#off("b")# greift auf ein solches Interface-System zu, das aus mehreren +Einzelkomponenten besteht (mehr dazu in den folgenden Kapiteln). Das sind Geräte, +über die der Computer "Kontakt" mit den 'Endgeräten' (z.B. Modellen) aufnimmt: +Hier werden Ausgaben des Computers in "elektrische Impulse" umgesetzt, mit denen +Modelle angesprochen werden können (z.B. Lämpchen ein- und ausgeschaltet, +Motoren zu Drehungen nach links oder rechts veranlaßt werden können). Ein­ +gehende "Impulse" werden in "computerangemessene Form" umgewandelt und an +den Computer weitergegeben. + +Der Aufwand, der betrieben werden muß, um ein Interfacesystem sachgerecht anzu­ +steuern, ist erheblich. Es kostet einige Mühe und vor allem viel Zeit, um alle Details +des Interfacesystems und seiner Programmierung kennenzulernen, und es gehört +eine gehörige Portion Erfahrung und vor allem viel Geduld dazu, um Fehlfunktionen +zu analysieren und letztlich zu beheben. Das alles ist einem Anwender, dem es z.B. +darum geht, ein bestimmtes Modell anzusteuern, nicht zumutbar. + +Hier schafft nun #on("b")#gs-Prozess#off("b")# Abhilfe! #on("b")#gs-Prozess#off("b")# ist eingebettet in die komfortable +Benutzerschnittstelle #on("b")#gs-DIALOG#off("b")#, so daß der Einarbeitungsaufwand in das +Programmsystem gering und eine einfache Bedienung des Systems gewährleistet ist. + +Ähnlich wie bei #on("b")#gs-Herbert und Robbi#off("b")# wird eine komplette Programmier­ +umgebung zur Verfügung gestellt, die alle Funtionen enthält (Informationen, +Konfiguration des Systems, Erstellung und Ausführung von Programmen, Archiv­ +handling), die bei der Arbeit von Bedeutung sein können - natürlich jetzt auf das +Messen, Steuern und Regeln bezogen. Durch diese Programmierumgebung wird +selbst dem Computerneuling ermöglicht, einen einfachen, eingängigen Zugang zu +diesem Anwendungsbereich zu finden. + +#on("b")#gs-Prozess#off("b")# stellt einen Basisbefehlssatz (Eingabe-, Ausgabebefehle und Tests) zur +Verfügung, mit dessen Hilfe Lösungsalgorithmen aus diesem Anwendungsbereich +angemessen formuliert werden können. Dabei kann sich der Anwender ganz auf sein +Problem konzentrieren, da er sich um die spezifische Ansteuerung des Interfaces +nicht zu kümmern braucht - das erledigt #on("b")#gs-Prozess#off("b")#. + +Der Basisbefehlssatz besteht aus nur wenigen Befehlen, um das Erlernen und den +Umgang damit möglichst einfach zu gestalten. Andererseits ist der Befehlssatz so +umfangreich und universell, daß alle schulisch relevanten Problemstellungen aus +diesem Anwendungsbereich angemessen bearbeitet werden können. + + + + diff --git a/app/gs.process/1.02/doc/gs-prozess-5 b/app/gs.process/1.02/doc/gs-prozess-5 new file mode 100644 index 0000000..5c44f29 --- /dev/null +++ b/app/gs.process/1.02/doc/gs-prozess-5 @@ -0,0 +1,819 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#5  Konfiguration von gs-Prozess#off("b")# +#on("b")#    Test des Interface-Systems#off("b")# + +In diesem Kapitel erfahren Sie, wie Sie #on("b")#gs-Prozess#off("b")# entsprechend der angeschlossenen +Hardware konfigurieren müssen. Anschließend zeigen wir Ihnen, wie Sie Ihr Inter­ +face-System testen können. + +Wir gehen hier davon aus, daß die Hardware-Voraussetzungen erfüllt, das Interface- +System über einen Adapter (MUFI / RS232-Adapter) angeschlossen und #on("b")#gs-Prozess#off("b")# +auf dem Rechner installiert sind. + + +#on("b")#5.1  Kontrolle der Konfigurationen/Anschlüsse#off("b")# + +Bevor Sie mit der Arbeit beginnen, überzeugen Sie sich unbedingt (noch einmal) +davon, daß die Konfigurationen und die Steckverbindungen den Vorgaben ent­ +sprechen: + +- #on("b")#MUFI im Terminalkanal:#off("b")# + + Sind die beiden Kabel zum Rechner und zum Terminal an der Rückseite des + MUFIs korrekt aufgesteckt (sehen Sie Abb.3)? Haben Sie die notwendigen + Konfigurationen vorgenommen (Task 'configurator', MUFI-DIP-Schalter, Ter­ + minal)? Ist das Netzkabel des MUFIs mit dem Stromnetz verbunden? Ist das + Verbindungskabel zwischen MUFI und Interface-System an der Vorderseite des + MUFIs und am Interface-System (Compact-Box, Einzel- oder Mehrfachsteck­ + platz) aufgesteckt? +#page# +- #on("b")#MUFI als Endgerät:#off("b")# + + Ist das vom Computer kommende Kabel auf den mit V24/2 gekennzeichneten + Stecker aufgesteckt? Haben Sie auf den freien Stecker (V24/1) einen "Kurz­ + schlußstecker" aufgesteckt? Haben Sie ein Kabel verwendet, über welches das + RTS/CTS-Protokoll abgewickelt werden kann? Haben Sie den Kanal, an dem das + MUFI betrieben wird, den Anweisungen in Kapitel 3.1.3 entsprechend kon­ + figuriert? Sind die DIP-Schalter im MUFI entsprechend eingestellt? Ist das + Netzkabel des MUFIs mit dem Stromnetz verbunden? Ist das Verbindungskabel + zwischen MUFI und Interface-System an der Vorderseite des MUFIs und am + Interface-System (Compact-Box, Einzel- oder Mehrfachsteckplatz) aufgesteckt? + + +- #on("b")#RS232-Adapter:#off("b")# + + Ist das Schnittstellen-Kabel korrekt am Computer angeschlossen? Haben Sie den + Kanal, an dem der RS232-Adapter betrieben wird, den Anweisungen in Kapitel + 3.2 entsprechend konfiguriert? Ist der Jumper im RS232-Adapter korrekt aufge­ + steckt? Ist der RS232-Adapter an das Interface-System (Compact-Box, Einzel- + oder Mehrfachsteckplatz) angesteckt? Ist der 3polige Platinenstecker des + Adapters in die 12V-Spannungsversorgungs-Buchse des Interface-Systems + eingesteckt? + + +- #on("b")#Compact-Box#off("b")# + + Ist die Compact-Box an das zugehörige Netzgerät angeschlossen? Ist der Stecker + wirklich richtig herum eingesteckt? Ist das Netzteil mit dem Stromnetz ver­ + bunden? + +- #on("b")#Einzelsteckplatz#off("b")# + + Ist eine Kombi-Karte oder eine E/A-Karte eingesteckt? Ist das Netzkabel des + Steckplatz-Netzgerätes mit dem Stromnetz verbunden? +#page# +- #on("b")#Mehrfachsteckplatz#off("b")# + + Ist ein passendes Netzteil an den Mehrfachsteckplatz angeschlossen? Ist das + zugehörige Netzkabel mit dem Stromnetz verbunden? Ist eine Kombi- oder + E/A-Karte in einen Steckplatz eingesteckt? + + +#on("b")#5.2  Vorbereitungen für den Ein-/Ausgabetest#off("b")# + +Für den Ausgabetest sollte eine 8elementige Leuchtdiodenanzeige zur Verfügung +stehen, um am Interface-System die Ausgaben kontrollieren zu können. Sofern Sie +mit der Compact-Box arbeiten oder eine E/A-Karte verwenden, brauchen Sie sich +darum nicht weiter zu kümmern, denn in diese Systeme ist eine Leuchtdioden­ +anzeige integriert. Wenn Sie dagegen mit einer Kombikarte arbeiten, muß eine +gesonderte Anzeige (kann leicht selbst gebaut werden oder ist fertig zu kaufen bei der +Fa. AKTRONIK) angeschlossen werden. + +Für den Eingabetest reicht ein kleines Drahtstück, an dem zwei kleine Lötschuhe +angelötet sind - schön wäre es, wenn ein Codekarten-Leser zur Verfügung stünde. + + +#on("b")#5.2.1  Anschluß einer Leuchtdiodenanzeige an die Kombikarte#off("b")# + +Stecken Sie den 8poligen Platinenstecker, der an der Leuchtdiodenanzeige befestigt +ist, auf die mit "AUSG." gekennzeichnte Buchse der Kombikarte. Den Lötschuh des +einzelnen Drahtes an der Leuchtdiodenanzeige stecken Sie auf den Masse-Lötstift +direkt neben der "Ausgangs-Buchse" der Kombikarte (sehen Sie Abb. 7). Da die +Leuchtdiodenanzeige mit Spannung versorgt werden muß, müssen jetzt noch zwei +Kabel - wie in der Abb. 7 dargestellt (Kabel 1 und Kabel 2) - aufgesteckt werden. +#page# + + + + +---------------------------------------------------------------+ + | 4-7 o----------+ | + | +-+-----------+-+ | | + | | | O | | GMD o | | + | | | | | | Kabel 1 | + | | | | | | | + | v | | O | | | | + | | | | | | | + | E| | | | | | + | | | O | | | | + | +-+-------------+ ___________| | + | o -----------| | + | Ausg. | | + | +---------------+ O 0 | | + | | +-----------+ | 1 O | | + ---+---|-|---| | | O 2 | | + ---+---|-|---| | | 3 O | | + ---+---|-|---| | | O 4 | | + ---|---|-|---| | | 5 O | | + ---|---|-|---| | | O 6 | | + ---|---|-|---| | | 7 O | | + | | +-----------+ | | | + | +---------------+ | | +<-----------------o | Kabel 2 | + Zur Leuchtdiodenanzeige | | + | +---------------+ | | + | | O | O 0 | | + | | O | 1 O | | + | | O | O 2 | | + | | O | 3 O | | + | | O | O 4 | | + | | O | 5 O | | + | | O | O 6 | | + | | O | 7 O | | + | +---------------+ | | + | GMD o o +5V | | + | | | | + | +----------------------------+ | + | | + | +---------------+ | + | | O | + O | + | | O | O E2 | + | | O | GMD O | + | +---------------+ | + | | + | +---------------+ | + | | O | + O | + | | O | O E2 | + | | O | GMD O | + | +---------------+ | + | o o o o o o o o o o | + | | | | | | | | | | | | + | +-o-+-o-+-o-+-o-+-o-+-o-+-o-+-o-+-o-+-o-+-o-+ | + | | | | + +----------+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+----------+ + | | | | | | | | | | | | | | | | | | | | | + | | | | | | | | | | | | | | | | | | | | | + +#center#Abb.7:  Anschluß Leuchtdiodenanzeige - Kombikarte + +#on("b")#ACHTUNG!#off("b")# Bei dieser Spannungversorgung auf der Kombikarte (+5V) darf #on("b")#auf +keinen Fall#off("b")# eine größere Last (z.B. Motor oder auch nur eine Glühbirne) ange­ +schlossen werden, da dadurch die Interfacekarte bzw. das Netzteil im Einzelsteck­ +platz beschädigt werden könnte. +#page# +Möchten Sie eine größere Last anschließen, so benötigen Sie ein stabilisiertes Netzteil +mit "ordentlich geglättetem" Gleichstrom. Die Masse (Minuspol) des Netztteils be­ +festigen Sie an dem Lötschuh (oder der davorliegenden Klemme), der zwischen den +beiden Lötstiften liegt, an denen in der Abb.7 das Kabel 1 befestigt ist. Den Pluspol +des Netzteiles verbinden Sie mit mit einem der Lötstifte (bzw. an der davorliegenden +Klemme), auf dem jetzt das Kabel 1 befestigt ist. Damit alle 8 Ausgänge mit Span­ +nung versorgt werden, müssen Sie auch hier ebenfalls eine Brücke zum zweiten +Lötschuh (oder der Klemme davor), an dem in der Zeichnung Kabel 1 befestigt ist, +anbringen. + +Da die Compact-Box ohnehin durch das Netzteil versorgt wird, kann es hier nicht zu +Komplikationen kommen. Wollen Sie eine größere Last an die E/A-Karte anschließen, +so benötigen Sie z.B. eine Relais-Box. + + + +#on("b")#5.2.2  Anschluß des Codekartenlesers (Drahtstück)#off("b")# + +Stecken Sie den 8poligen Platinenstecker, der am Codekartenleser befestigt ist, auf +die Eingangsbuchse an Ihrem Interface-System. Dann muß noch der 3polige +Platinenstecker, der ebenfalls am Codekartenleser befestigt ist, an die 12V-Span­ +nungsversorgungs-Buchse an Ihrem Interface-System aufgesteckt werden. + +haben Sie keinen Codekartenleser zur Hand, so reicht für den Eingabetest auch ein +kleines Kabelstück aus, an dessen Enden jeweils ein Lötschuh angelötet sein sollte. +Stecken Sie den einen Lötschuh auf einen +5V-Lötstift Ihres Interface-Systems. Das +andere Ende des Kabels wird zunächst noch nicht befestigt. + +Auf der Kombikarte sind die +5V-Lötstifte beschriftet und damit leicht zu finden. Wo +Sie einen +5V-Lötstift auf der E/A-Karte finden, können Sie der folgenden Abbildung +entnehmen: +#page# + Leuchtdiodenanzeige + | + +---------------------------------------+------------+ + | +---------------+ | | + | | O | O 0 V | +Digital- | | O | 1 O o o o o o o o o | +Ausgang | | O | O 2 | + | | O | 3 O | + | | O | O 4 | + | | O | 5 O | + | | O | O 6 | + | | O | 7 O | + | +---------------+ | + | +---------------+ | + | | O | O 0 | +Digital- | | O | 1 O | +Eingang | | O | O 2 | + | | O | 3 O | + | | O | O 4 | + | | O | 5 O | + | | O | O 6 | + | | O | 7 O | + | +---------------+ | + | +---------------+ | + | | O | O 0 | +Versorgungs- | | O | 1 O | +und | | O | O 2 | +Steuer- | | O | 3 O | +leitung | | O | O 4 | + | | O | 5 O | + | | O---5V------O 6 | + | | O | 7 O | + | +-------|-------+ | | + | | | | + | +---------------+ | + | | | + | GMD | + | | + | o o o o o o o o o o | + | | | | | | | | | | | | + | +-o-+-o-+-o-+-o-+-o-+-o-+-o-+-o-+-o-+-o-+-o-+ | + | | | | + +----+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+---+ + | | | | | | | | | | | | | | | | | | | | | + | | | | | | | | | | | | | | | | | | | | | + + +#center#Abb.8:  Pinbelegung auf der E/A-Karte + + +#on("b")#5.3  Konfiguration von gs-Prozess#off("b")# + +Normalerweise kann in jeder Task, in der #on("b")#gs-Prozess#off("b")# zur Verfügung steht, die +Konfiguration vorgenommen werden (beachten Sie aber bitte die Bemerkungen im +Kapitel "Hinweise für den Systembetreuer/Programmierer"). + +Richten Sie eine Sohntask der Task ein, in der #on("b")#gs-Prozess#off("b")# installiert ist - in unserem +Fall soll das die Task 'PDV' sein. Die Sohntask soll den Namen 'pdvtest' erhalten: +#page# +#on("b")# + (Supervisor - Taste) +#off("b")# + --> gib supervisor kommando: +#on("b")# + begin ("pdvtest","PDV") +#off("b")# + --> gib kommando: +#on("b")# + pdv +#off("b")# + +Daraufhin erscheint der in Abb.9 dargestellte Menubildschirm. Über die Menupunkte +im dann sichtbaren Pull-Down-Menu können Sie diverse Informationen zu +#on("b")#gs-Prozess#off("b")# abrufen, auf die wir hier allerdings nicht weiter eingehen wollen. Statt­ +dessen drücken Sie bitte die 'Pfeiltaste rechts'. Sie gelangen so zum Menu unter dem +Oberbegriff "Interface" (Abb. 10). + + ++---------------------------------------------------------------------+ +| PDV:  Info Interface Programm Archiv | +|-------+------------------------+------------------------------------+ +| | u  Übersicht Befehle | | +| | --------------------- | | +| | a  Ausgabebefehle | | +| | e  Eingabebefehle | | +| | t  Testbefehle | | +| | w  Weitere Befehle | | +| | --------------------- | | +| | b  Bitmuster | | +| | s  Symbole/Zeichen | | +| | d  Digital-/Analogwerte| | +| +------------------------+ | +| | +| +----------------------------------------+ | +| | gs-Prozess | | +| | Version 1.0 | | +| | | | +| | Copyright Ρ 1988 bei Eva Latta-Weber, | | +| | Bielefeld | | +| +----------------------------------------+ | ++---------------------------------------------------------------------+ +|Info:/ Wahl: Ausführen: Verlassen:| ++---------------------------------------------------------------------+ + + + Abb.9:  Eingangsbildschirm #on("b")#gs-Prozess#off("b")# +#page# + ++-----------------------------------------------------------------------+ +| PDV:  Info Interface Programm Archiv | ++-------+-------------------+-------------------------------------------+ +| | i  Informationen | | +| | ---------------- | | +| | k  Konfigurieren | | +| | ---------------- | | +| | a  Ausgabetest | | +| | e  Eingabetest | | +| +-------------------+ | +| | +| | +| | ++---------------------------------------------------------------------- + +| Info:/ Wahl: Ausführen: Verlassen: | ++-----------------------------------------------------------------------+ + + #center#Abb.10:  Menubildschirm zum Oberbegriff 'Interface' + + +Über den ersten Menupunkt ("Informationen") kann die aktuelle Konfiguration des +Interfaces erfragt werden. Wenn Sie diesen Menupunkt aktivieren und es ist weder in +dieser Task noch in einer übergeordneten Task eine Konfiguration vorgenommen +worden, erhalten Sie die folgende Warnung: + + +----------------------------------------+ + | Interface ist noch nicht konfiguriert! | + +----------------------------------------+ +#center#Abb.11:  Information bei unkonfiguriertem System + + +Ist schon eine Konfiguration, z.B. in der Vatertask vorgenommen worden, so wird +Ihnen die aktuellen Einstellung angezeigt (s.u.). +#page# +#on("b")#5.3.1  Auswahl der Steckplatzart/Interfacekarte#off("b")# + +Da Sie in jedem Falle eine Konfiguration von #on("b")#gs-Prozess#off("b")# vornehmen sollen, +aktivieren Sie jetzt bitte den Menupunkt "Konfigurieren". Daraufhin erscheint die +folgende Auswahl: + +-----------------------------+ + | Auswahl der Steckplatzart | + | | + | c Compactbox | + | e Einzelsteckplatz | + | m Mehrfachsteckplatz | + | | + | Compact   Einzel   Mehrfach | + +-----------------------------+ + +#center#Abb.12:  Auswahl der Steckplatzart + + +Haben Sie eine Compact-Box angeschlossen, so ist die Konfiguration schnell erledigt: +Sie tippen die Taste . Daraufhin wird die komplette Konfiguration ausgeführt +und die Einstellung eingeblendet. + +------------------------------------+ + | Eingestellt: Compactbox | + | | + | Belegung der Kanäle: | + | | + | Kanal 1:   Analogeingang 1 (E1) | + | | + | Kanal 2:   Analogeingang 2 (E2) | + | | + | Kanal 3:   Digitaleingang | + | | + | Kanal 4:   Digitalausgang | + +------------------------------------+ + +#center#Abb.13:  Compact-Box: Belegung der Kanäle +#page# +Die Anzeige verschwindet, wenn Sie eine beliebige Taste tippen. + +Anders dagegen, wenn Sie zuvor dem System mitgeteilt haben, daß ein Einzelsteck­ +platz bzw. ein Mehrfachsteckplatz angeschlossen ist. In diesem Fall müssen Sie +#on("b")#gs-Prozess#off("b")# noch mitteilen, welche Steckkarten Sie verwenden. Dazu wird Ihnen die +folgende Auswahl angeboten: + + +----------------------------------+ + | Angabe der Interfacekarte: | + | | + | k  Kombikarte | + | e  E/A - Karte | + | d  D/A - Wandler - Karte | + | a  A/D - Wandler - Karte | + | 0  Keine Steckkarte | + | | + | Kombi  E/A  D/A  A/D  Keine | + +----------------------------------+ + + +#center#Abb.14:  Auswahl einer Interfacekarte + + +Wenn Sie eine Kombikarte, eine E/A-Karte oder eine D/A-Wandler-Karte verwenden, +ist durch die jeweilige Angabe der Einstellvorgang abgeschlossen. #on("b")#gs-Prozess#off("b")# teilt +Ihnen daraufhin - ähnlich wie bei der Compact-Box - jeweils die Belegung der Kanäle +mit. Bei Nutzung der D/A-Wandler-Karte wird zusätzlich der gültige Spannungs­ +bereich angezeigt. +#page# + + +------------------------------------------------------+ + | Einzelsteckplatz mit D/A - Karte: | + | | + | Belegung der Kanäle: | + | | + | Die Karte stellt einen Analogausgang zur Verfügung, | + | der auf zwei Arten angesprochen werden kann:        | + | | + | Kanal 1:    Spannungsbereich  -5 V  -  +5 V | + | | + | Kanal 2:    Spannungsbereich   0 V  -  +5 V | + | | + +------------------------------------------------------+ + +#center#Abb.15:  Kanalbelegung D/A-Karte (Einzelsteckplatz) + + +Haben Sie dagegen eine A/D-Wandler-Karte angegeben, so erfragt #on("b")#gs-Prozess#off("b")# noch +die Schalterstellung der DIP-Schalter auf der A/D-Wandler-Karte. Über diese Schalter­ +stellung kann der Spannungsbereich der Analogeingänge festgelegt werden. Das +erfolgt nach folgendem Prinzip: + +Das Spannungsintervall wird jeweils über 3 Schalter festgelegt. Für den Eingang 1 +stehen die Schalter 1, 2 und 3 zur Verfügung, für denn Eingang 2 die Schalter 4, 5 +und 6. Im folgenden werden wir die Einstellung für den Eingang 1 aufzeigen - für den +Eingang 2 ist mit den drei genannten Schaltern synonym zu verfahren. + +Steht Schalter 1 in der Position 'ON', so ist ein Spannungsintervall von 0V - 25V einge­ +stellt (Fall 1) - unabhängig von der Stellung der anderen beiden Schalter. Innerhalb +eines Schaltertripletts "dominiert" nämlich ein Schalter mit kleinerer Nummer über +den/die mit größerer Nummer. Ist Schalter 1 in Stellung 'OFF' und Schalter 2 in +Stellung 'ON', so ist ein Spannungsbereich von 0V - 2,5V eingestellt (Fall 2). Sind die +beiden ersten Schalter in der Position 'OFF' und nur der Schalter 3 in der Position +'ON', so ist ein Spannungsintervall von 0V - 0,25V eingestellt (Fall 3). +#page# +Eine besondere Bedeutung kommt noch den Schaltern 7 und 8 zu, denn sie beein­ +flussen noch die eben genannten Intervalle. Dabei ist überraschenderweise der +Schalter 7 für den Eingang 2 und der Schalter 8 für den Eingang 1 zuständig. Die drei +oben genannten Fälle gelten nämlich nur, wenn Schalter 8 in der Position 'OFF' steht. +In der Position 'ON' werden die durch das Schaltertriplett eingestellten Spannungs­ +intervalle dagegen symmmetrisch um 0V angelegt: im Fall 1 also der Bereich von +-12,5V - +12,5V, im Fall 2 von -1,25V - +1,25V und im Fall 3 von -0,125V - ++0,125V. + +----------------------------------------------------+ + | Angabe der Schalterstellungen auf der A/D - Karte: | + | | + | Bitte die aktuelle Schalterstellung eintragen: | + | | + | Es bedeutet: 1 - Schalterstellung "on" | + | 0 - Schalterstellung "off" | + | | + | Nummer: 12345678 | + | | + | Eingabe: 10010010 | + +----------------------------------------------------+ +#center#Abb.16:  A/D-Karte: Angabe der Schalterstellung + + +Der Spannungsbereich wird von #on("b")#gs-Prozess#off("b")# aus der Schalterstellung automatisch +ermittelt und neben den festgelegten Kanalnummer angezeigt. Die obige Schalter­ +stellung führt somit zu folgender Meldung: + + +----------------------------------------------------------------+ + | Einzelsteckplatz mit A/D - Karte: | + | | + | Zwei analoge Einträge stehen zur Vefügung: | + | | + | Kanal 1: (E1) Spannungsbereich 0.000 V  -  +25.000 V | + | | + | Kanal 2: (E2) Spannungsbereich -12.500 V  -  +12.500 V | + | | + +----------------------------------------------------------------+ +#center#Abb.17:  A/D-Karte: Kanalbel./Spannungsber.(Bspl.) +#page# +Während Sie bei Verwendung eines Einzelsteckplatzes nur einmal nach all diesen +Angaben gefragt werden, erfolgt die Abfrage bei einem Mehrfachsteckplatz viermal +hintereinander. Haben Sie einen Steckplatz nicht belegt, so tippen Sie bei der Angabe +der Interfacekarte die Taste <0> (keine Steckkarte). + + +#on("b")#5.3.2  Bedeutung der Kanalnummern#off("b")# + +Nachdem Sie #on("b")#gs-Prozess#off("b")# die Angaben zur Konfiguration (Steckplatzart/Interface­ +kartenart) mitgeteilt haben, teilt Ihnen das System jeweils die Kanalnummern mit. +Diese Nummern sollten Sie sich merken, denn wenn Sie mit dem von #on("b")#gs-Prozess#off("b")# zur +Verfügung gestellten Befehlen programmieren wollen, müssen Sie jeweils diese +Kanalnummern angeben. Fordern Sie von einem Kanal eine Aktion, die nicht ausge­ +führt werden kann/nicht sinnvoll ist, so kann Ihnen dadurch eine Fehlermeldung +zugestellt werden. + +Auf der Compact-Box bzw. der Kombikarte an einem Einzelsteckplatz ist die +Numerierung identisch: die beiden Analogeingänge haben die Kanalnummern 1 und +2, der Digitaleingang hat die Nummer 3 und der Digitalausgang die Nummer 4. + +Die E/A-Karte verfügt nur über je einen digitalen Eingang und digitalen Ausgang, die +über die Kanäle 1 und 2 angesprochen werden können. Damit nun aber auch +Programme, die für die Compact-Box bzw. eine Kombikarte geschrieben sind, auch +auf der E/A-Karte laufen, können diese beiden Kanäle auch unter der Kanalnummer +3 (Eingang) bzw. 4 (Ausgang) angesprochen werden. Natürlich ist ein solches +Programm nur dann auf der E/A-Karte lauffähig, wenn keine Analogeingänge ange­ +sprochen werden, denn die sind ja auf der E/A-Karte gar nicht vorhanden! + +Die Kanalnummern auf einem Mehrfachsteckplatz werden nach folgendem System +vergeben: Die Kanalnummern sind immer zweistellig. Über die erste Ziffer wird der +Steckplatz (1 - 4) identifiziert, über die zweite Ziffer der eigentliche Kanal auf der +Steckkarte. Steckt also z.B. in Steckplatz 3 eine Kombikarte (4 mögliche Kanäle) und +möchten Sie hier den Digitalausgang (Kanal 4) ansprechen, so muß als Kanal die +Nummer 34 angegeben werden. +#page# +Aber auch hier gibt es eine zusätzliche Vereinbarung: Der erste Steckplatz eines +Mehrfachsteckplatzes kann (zusätzlich) wie ein Einzelsteckplatz angesprochen +werden. Bei Belegung des ersten Steckplatzes mit einer Kombikarte, können Sie die +Karte also über die Kanalnummern 11, 12, 13 und 14 ansprechen und zusätzlich +über die Nummern 1, 2, 3 und 4. Der Sinn der dahintersteckt ist Ihnen sicher sofort +klar geworden: Dadurch kann ein Programm, das z.B. für die Compact-Box ge­ +schrieben wurde, ohne Änderung übernommen werden, wenn eine Kombikarte auf +Steckplatz 1 des Mehrfachsteckplatzes steckt etc.. + + +#on("b")#5.4  Aus- und Eingabetest#off("b")# + +Nun wird es spannend, denn Sie sollen jetzt testen, ob Sie mit Ihrem Interface-System +arbeiten können. Sofern Sie mit dem MUFI als Adapter arbeiten, schalten Sie das +MUFI mit dem Schalter an der Vorderseite ein. + +Wenn Sie das MUFI im Terminalkanal betreiben, kann das Einschalten dazu führen, +daß eine unsinnige Zeichenkette auf dem Bildschirm erscheint. Diese Zeichen +werden durch den "Einschaltknack" verursacht und haben eigentlich nichts zu +bedeuten. Allerdings läßt sich die Ausgabe auch nicht verhindern. Die Zeichen ver­ +schwinden bei der nächsten Menubedienung. + +Wenn Sie alle Hinweise in Kapitel 5.1 beachtet haben, müßte spätestens jetzt das +Interface-System betriebsbereit sein - gleichgültig, welchen Adapter und welche +Interface-Komponenten Sie verwenden. + +Aktivieren Sie nun den Menupunkt 'Ausgabetest', indem Sie z.B. die Taste +tippen. Wenn Sie eine Compact-Box angeschlossen haben, müßte die folgende Ein­ +blendung in Ihrem Menubildschirm erscheinen: +#page# + +-------------------------------------------------------------+ + | Ausgabetest | + | | + | Ausgabe an Kanal 4 (= Digitalausgang der Compact-Box) | + |-------------------------------------------------------------| + | | + | | + | | + | Ausgabewert: 129 | + | | + |-------------------------------------------------------------| + | Bitte einen Wert zwischen 0 und 255 eingeben! | + | | + +-------------------------------------------------------------+ +#center#Abb.18:  Ausgabetest - Einblendung + + +Eine nahezu identische Einblendung erhalten Sie, wenn Sie einen Einzelsteckplatz +mit Kombi- oder E/A-Karte angeschlossen haben. + +Da beim Ausgabetest nur die Ausgänge einer Karte angesprochen werden, ist ein +Ausgabetest an einer A/D-Wandler-Karte nicht möglich! An einer D/A-Wandler-Karte +kann zwar prinzipiell ein Ausgabetest erfolgen - ist aber nicht sinnvoll, da die zur +Kontrolle notwendige Leuchtdiodenanzeige hier nicht angeschlossen werden kann. + +Wenn Sie einen Mehrfachsteckplatz angeschlossen haben, werden Sie zuvor noch +gefragt, welchen Steckplatz Sie testen wollen. Bitte beachten Sie hier das im vorigen +Abschnitt Gesagte. Ansonsten ist auch hier die anschließende Einblendung nahezu +identisch. + +Zum Testen geben Sie jetzt einige Werte zwischen 0 und 255 ein. Nach jeder Eingabe +tippen Sie bitte die -Taste. Bei Eingabe der '0' müßten alle Leucht­ +dioden dunkel sein. Bei '1' dürfte nur die letzte Leuchtdiode (rechts) aufleuchten, +bei 128 nur die erste (links); bei 255 müßten alle 8 Leuchtdioden der Anzeige auf­ +leuchten. +#page# +Sollten wider Erwarten Fehler aufgetreten sein, lesen Sie bitte im Kapitel 5.5 nach. +Wenn alles wie beschrieben funktioniert hat, gehen Sie gleich zum Eingabetest über. +Verlassen Sie dazu den Ausgabetest durch die Tastenfolge und +aktivieren Sie anschließend den Menupunkt 'Eingabetest' indem Sie z.B. die Taste + tippen. + +Außer bei der E/A-Karte im Einzelsteckplatz werden Sie hier zusätzlich nach der +Nummer des Kanals gefragt, über den der Einlesetest erfolgen soll. Das liegt daran, +daß sich auf den meisten Interfacesystemen mehrere Eingänge befinden. Beim +Einzelsteckplatz werden die Auswahlmöglichkeiten vorgegeben; beim Mehrfachsteck­ +platz erfolgt eine freie Eingabe der Kanalnummern. + +Wenn Sie eine Compact-Box angeschlossen haben, müßte die folgende Einblendung +in Ihrem Menubildschirm erscheinen: + + +-------------------------------------------------------------+ + | Eingabetest | + | | + | Eingabe von Kanal 3 (= Digitaleingang der Compact-Box) | + | | + |-------------------------------------------------------------| + | | + | | + | Eingelesener Wert: 129 | + |-------------------------------------------------------------| + | | + +-------------------------------------------------------------+ + +#center#Abb.19:  Eingabetest - Einblendung + + +Wenn Sie den Codekartenleser am Digitaleingang angeschlossen haben und alles +korrekt funktioniert, müßte als eingelesener Wert die Zahl 255 erscheinen. Legen Sie +eine Lochkarte ein oder legen Sie einen Finger zwischen Beleuchtung und Licht­ +sensoren. Daraufhin müßte sich die Anzeige auf dem Bildschirm ändern. Nun +können Sie versuchen, durch Abdecken der Sensoren die bei der Ausgabe schon +angesprochenen Testwerte zu erhalten. +#page# +Wenn Sie über keinen Codekartenleser verfügen, so benutzen Sie jetzt bitte das kleine +Kabelstück, das Sie auf den +5V-Lötschuh aufgesteckt haben und dessen anderes +Ende bisher noch nirgendwo aufgesteckt ist. Berühren Sie nun mit diesem freien +Ende die Stifte, die im 8poligen Eingangs-Platinenstecker sichbar sind. Wird kein Pin +berührt, müßte auf dem Bildschirm der Wert '0' erscheinen. Berühren Sie einen der +Pins an der Seite, müßte der Wert '1', berühren Sie den an der anderen Seite, müßte +der Wert '128' erscheinen. Wenn Sie also nacheinander die Pins berühren, müßten +die Zahlenwerte 1, 2, 4, 8, 16, 32, 64, 128 erscheinen. + +Wenn sowohl Ausgabe- als auch Eingabetest korrekt abgewickelt werden konnten, +brauchen Sie das Kapitel 5.5 nicht zu lesen, denn das beschäftigt sich nur mit +Fehlern, die bisher aufgetreten sein könnten. Den Eingabetest verlassen Sie bitte +durch die Tastenfolge . + + +#on("b")#5.5  Mögliche Fehlerfälle#off("b")# + +#on("b")# +- Das MUFI wurde in den Terminalkanal eingebaut. Selbst beim vom Netz + getrennten MUFI ist kein Terminalbetrieb möglich: +#off("b")# + + --> Das neu eingefügte Kabel ist unzureichend oder falsch verdrahtet. Bitte + Hinweise im MUFI-Handbuch lesen bzw. Informationen von BICOS ein­ + holen. + + +#on("b")# +- Das MUFI wurde in den Terminalkanal eingebaut. Beim Einschalten des + MUFIs erscheinen unsinnige Zeichenketten auf dem Bildschirm bzw. das + Einschalten hat noch schwerwiegendere Folgen: #off("b")# + + --> Der "Einschaltknack" des MUFI "schlägt auf andere Systemkomponenten + durch". Sofern nur Zeichen auf dem Bildscchirm erscheinen, ist das weit­ + gehend unproblematisch - kann auch nicht beseitigt werden. Ansonsten + erst das MUFI, dann das Terminal bzw. den Rechner einschalten. Ggf. + Rücksprache mit BICOS. +#page# +#on("b")# +- Das MUFI wurde in den Terminalkanal eingebaut. Bei ausgeschaltetem + MUFI ist ein einwandfreier Terminalbetrieb möglich, bei einge­ + schaltetem MUFI reagiert das Terminal nicht mehr: +#off("b")# + + --> MUFI- und Terminalkonfiguration passen nicht zueinander (Baudrate, + Protokoll, Anzahl der Stopbits). Einstellungen am Terminal, in der Task + 'configurator' und die DIP-Schalter-Stellung im MUFI kontrollieren; ggf. + Neueinstellung. + + --> MUFI defekt - Rücksprache mit BICOS. + + +#on("b")# +- Beim Austest erscheint die Einblendung "Interface ist noch nicht + konfiguriert!": +#off("b")# + + --> #on("b")#gs-Prozess#off("b")# wurde noch nicht konfiguriert. Unter dem Oberbegriff 'Inter­ + face' den Menupunkt 'Konfigurieren' aktivieren und den Ausführungen in + Kapitel 5.3 folgend die Konfiguration vornehmen. + + --> Bei Betrieb des Interface Systems an separater serieller Schnittstelle werden + unbenannte Sohntasks eingerichtet (unter der eigenen Task bzw. unter + einer "zentralen Abwicklungstask"). Diese unbenannte Sohntask wurde + irrtümlich gelöscht. Abhilfe: Neukonfiguration vornehmen. #on("b")#*)#off("b")# + + --> Bei Betrieb des Interface-Systems an separater serieller Schnittstelle und + "zentraler Abwicklungstask" wurde in der "zentralen Abwicklungs-Task" + eine Neukonfiguration von #on("b")#gs-Prozess#off("b")# vorgenommen. Die dabei ent­ + standene unbenannte Sohntask wird von den "alten" Sohntasks nicht mehr + erkannt. Abhilfe: Alle Sohntasks, die auf die "zentrale Abwicklungstask" + zugreifen, löschen und neu einrichten. #on("b")#*)#off("b")# +#page# +#on("b")# +- Es erscheint die Fehlermeldung "Interface meldet sich nicht!": +#off("b")# + + --> Der angeschlossene Adapter ist ohne Spannungsversorgung. Netzstecker + des Adapters überprüfen. Beim MUFI den Schalter an der Vorderseite in + Stellung 'Ein' bringen. Beim RS232-Adapter den 3poligen Platinenstecker + in die 12V-Spannungsversorgungsbuchse am Interface-System einstecken. + + --> Es wurde bei der Installation von #on("b")#gs-Prozess#off("b")# eine falsche Interface- + Kanal-Nummer angegeben. Die Kanalnummer kann mit 'put(interface­ + kanal) ' erfragt werden. Kanalnummer überprüfen. Ggf. neue + Kanalnummer angeben. Dafür steht die Prozedur 'PROC interfacekanal + (INT CONST nummer)' zur Verfügung. + + --> Speziell beim MUFI: Das MUFI wurde zwischenzeitlich (versehentlich) + ausgeschaltet oder es kam zu einem "ungeregeltem Bedienungsabbruch" + z.B. durch Drücken der SV-Taste im laufenden Betrieb. Die interne Ein­ + stellung des MUFIs ist verändert. Abhilfe: Menupunkt verlassen, MUFI + ausschalten, einige Sekunden warten, MUFI anschalten, Menupunkt neu + anwählen. + + +#on("b")# +- Es erscheint die Fehlermeldung "Interface-Kanal ist belegt!: +#off("b")# + + --> Das Interface-System ist an einer separaten seriellen Schnittstelle ange­ + schlossen. Am Kanal wurden schon andere Geräte betrieben, die nicht + ordentlich abgemeldet wurden. Mit 'taskinfo (2) ' kann die + Belegung der Kanäle eingesehen werden. Ggf. erst ein Terminal an den + Kanal anschließen (Kanal umkonfigurieren!) und dort 'break + ' geben. Oder von einer privilegierten Task aus die ange­ + koppelte Task "abschießen". + + --> Das Interface-System ist an einer separaten seriellen Schnittstelle ange­ + schlossen. Eine andere Task greift bereits auf das Interface-System am + eingestellten Kanal zu. Benutzer bitten, den Kanal freizugeben. #on("b")#*)#off("b")# +#page# +#on("b")# +- Es erscheint die Fehlermeldung "Interface-Task ist besetzt!": +#off("b")# + + --> Das Interface-System ist an einer separaten seriellen Schnittstelle ange­ + schlossen. Die Kommunikation erfolgt über eine "zentrale Abwicklungs­ + task". Auf diese Task greift zur Zeit ein anderer Benutzer zu. Mit dem + anderen Benutzer verständigen und warten, bis die Task freigegeben wird. + #on("b")#*)#off("b")# + + +#on("b")# +- Es erschient die Fehlermeldung "An Kanal ... ist keine Digitaleingabe + (Digiatalausgabe, Analogeingabe, Analogausgabe) möglich!": +#off("b")# + + --> Laut Konfiguration ist die gewünschte Leistung am angegebenen Kanal auf + der angeschlossenen Interfacekarte nicht möglich. Kanal neu konfigurieren + oder anderen Kanal ansprechen bzw. Interface-Karte wechseln und neu + konfigurieren. + + +#on("b")# +- Es erschient die Fehlermeldung "Kanalnummer ... ist unzulässig!": +#off("b")# + + --> Es wurde eine - bezogen auf das angeschlossene Interface-System - un­ + sinnige Kanalnummer angegeben. Diese Fehlermeldung erscheint in jedem + Falle, wenn die Kanalnummer kleiner als 1 oder größer als 49 ist! Abhilfe: + korrekte Kanalnummer angeben. + + +#on("b")# +- Es erschient die Fehlermeldung "Interface kann nicht geöffnet werden!": +#off("b")# + + --> Interessanter Fehler! Bitte alle Details der Fehlersituation notieren und an + ERGOS einsenden! +#page# +#on("b")# +- Beim Austest erscheint zwar keine Fehlermeldung, aber die Leucht­ + diodenanzeige zeigt auf verschiedene Ausgabewerte keine Reaktion + (bleibt dunkel oder unsinnige fixe Anzeige): +#off("b")# + + --> Die angeschlossene Leuchtdiodenanzeige ist nicht korrekt angeschlossen. + Platinenstecker (Digitalausgang) überprüfen; Massekabel überprüfen; die + beiden Überbrückungskabel (Abb.7) überprüfen. + + --> Steckplatz/Compact-Box wird nicht mit Spannung versorgt. Netzkabel/An­ + schluß zum Netzteil überprüfen. + + --> Verbindungskabel Adapter - Interface-System nicht richtig aufgesteckt oder + intern falsch verdrahtet. + + +#on("b")# +- Beim Austest erscheinen verschiedene Ausgabemuster an den Leucht­ + dioden, die Muster sind aber nicht korrekt: +#off("b")# + + --> Kabel vom Adapter zum Interface ist falsch verdrahtet. + + --> Kabel in der Leuchtdiodenanzeige (Selbstbau ?) sind falsch verdrahtet. + + +#on("b")#*)#off("b")# Die hier genannten Fehlermeldungen sind bei der oben beschriebenen Erst­ + installation (noch) nicht möglich. Sie können erst auftreten, wenn weiter­ + gehende Installationen erfolgt sind (z.B. Installation einer "zentralen Abwick­ + lungs-Task" etc.). Zum Verständnis lesen Sie bitte das Kapitel "Hinweise für den + Systembetreuer/Programmierer". + + + + + + + + diff --git a/app/gs.process/1.02/doc/gs-prozess-6 b/app/gs.process/1.02/doc/gs-prozess-6 new file mode 100644 index 0000000..a3835cd --- /dev/null +++ b/app/gs.process/1.02/doc/gs-prozess-6 @@ -0,0 +1,641 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#6  Arbeiten mit gs-Prozess#off("b")# + +In diesem Kapitel werden wir Ihnen die Basisbefehle von #on("b")#gs-Prozess#off("b")# vorstellen und +erläutern, was die einzelnen Befehle bewirken. Dabei werden wir an einfachen +Beispielen aufzeigen, wie Sie mit #on("b")#gs-Prozess#off("b")# arbeiten können. + +Wir gehen hier davon aus, daß die Hardware-Voraussetzungen erfüllt, das Interface- +System angeschlossen und die Software (#on("b")#gs-Prozess#off("b")#) auf dem Rechner installiert +sind. Sie sollten #on("b")#gs-Prozess#off("b")# bereits konfiguriert und einen Ein- und Ausgabetest +durchgeführt haben. + +In unserer Beschreibung gehen wir weiterhin davon aus, daß als Interface-System +eine Compact-Box verwendet wird. Alle hier beschriebenen Beispiele gelten ganz +genauso für einen Einzelsteckplatz mit Kombikarte (hier müssen Sie nur zusätzlich +eine Leuchtdiodenanzeige anschließen - aber Sie wissen ja schon, wie das gemacht +wird.) Bei anderen Hardware-Konfigurationen ist darauf zu achten, daß ggf. andere +Kanalnummern anzugeben sind. + +Die Compact-Box verfügt - genau wie die Kombikarte - über zwei analoge Eingänge +(Kanal 1 und Kanal 2), über einen digitalen Eingang (Kanal 3) sowie über einen +digitalen Ausgang (Kanal 4). Wie Sie schon bei der Konfiguration von #on("b")#gs-Prozess#off("b")# +gesehen haben, haben Sie keinen Einfluß auf die Numerierung der Kanäle - die wird +vom #on("b")#gs-Prozess#off("b")# vorgegeben. Diese Kanalnummer müssen Sie kennen, wenn Sie das +System ansprechen (programmieren) wollen (ggf. können Sie die Kanalnummern +durch Aktivieren des Menupunktes 'Information' unter dem Oberbegriff 'Interface' +erfragen). + + +#on("b")#6.1  Kleine Beispiele zur digitalen Ausgabe#off("b")# + +Bei diesem Einführungsbeispiel wollen wir uns zunächst ausschließlich auf die +digitale Ausgabe beschränken. Wenn Sie die Compact-Box (oder eine E/A-Karte) +angeschlossen haben, benötigen Sie hierzu keine zusätzliche Hardware, ansonsten +schließen Sie bitte an Ihren digitalen Ausgang eine 8-elementige Leuchtdiodenanzeige +an. +#page# +Sie haben sicher schon an einer Autobahnbaustelle ein sogenanntes "Lauflicht" +gesehen. Es erscheint, als ob ein Licht über die aufgestellten Barken hinwegläuft. +Dadurch soll auf die Baustellenein- bzw. -ausfahrt hingewiesen werden. Dieser Effekt +wird dadurch erreicht, daß die Lampen, die an den Barken angebracht sind, nach­ +einander ein- und auch wieder ausgeschaltet werden. + +Wir wollen jetzt auf unserer 8-elementigen Leuchtdiodenanzeige ein solches Lauflicht +nachbilden. Dabei soll das "Licht von rechts nach links über die Anzeige wandern". + +Um das Programm zu schreiben, aktivieren Sie im #on("b")#gs-Prozess#off("b")#-Menu unter dem +Oberbegriff "Programm" den Menupunkt "Neu erstellen". Sie werden dann nach +einem Namen gefragt, den Sie der Programmdatei geben wollen. Tragen Sie hier +einen beliebigen Namen ein, und tippen Sie anschließend die -Taste. +Notieren Sie dann das folgende ELAN-Programm: + +#on("b")# + initialisiere interface; + REP + lauflichtdurchgang; + warte (2.0) + UNTIL abbruch gewuenscht PER. + + lauflichtdurchgang: + bitmuster ausgeben (4, "OOOOOOOI"); + bitmuster ausgeben (4, "OOOOOOIO"); + bitmuster ausgeben (4, "OOOOOIOO"); + bitmuster ausgeben (4, "OOOOIOOO"); + bitmuster ausgeben (4, "OOOIOOOO"); + bitmuster ausgeben (4, "OOIOOOOO"); + bitmuster ausgeben (4, "OIOOOOOO"); + bitmuster ausgeben (4, "IOOOOOOO") +#off("b")# + + +Wenn Sie das Programm fertiggeschrieben haben, verlassen Sie die Datei durch die +Tastenfolge . Sie gelangen wieder zum Menu und aktivieren jetzt den +Menupunkt "Starten". Daraufhin wird das Programm übersetzt und ausgeführt. +#page# +#on("b")#6.1.1  Möglichkeit eines Programmabbruchs#off("b")# + +Wir hoffen natürlich, daß das Programm genau die Ausgabe an der Leuchtdioden­ +anzeige erzeugt, die Sie erwartet haben. + +Als Ausgangsbedingung der Schleife haben wir den Testbefehl 'abbruch gewuenscht' +verwendet. Dieser Befehl wird von #on("b")#gs-Prozess#off("b")# zur Verfügung gestellt. Durch den +Testbefehl wird überprüft, ab zwischenzeitlich die Tastenkombination +eingegeben wurde. Ist das bei unserem Programm der Fall, so wird die Schleife +('regulär') beendet. + +Aber bitte etwas Geduld: Das Programm wird nicht sofort nach Eingabe der Tasten­ +folge "abgebrochen". Hat nämlich gerade ein neuer 'lauflichtdurchgang' begonnen, +so wird das Refinement natürlich erst vollständig abgearbeitet. Erst dann wird +geprüft, ob die Tastenfolge zwischenzeitlich eingegeben wurde. + +Sollten Sie einmal in einer Situation sein, in der Sie ein Programm tatsächlich +abbrechen müssen, so ist das (in den meisten Fällen) über die Tastenfolge + möglich. Diese Tastenkombination sollten Sie sich für "Notfälle" +merken. Vielleicht probieren Sie sie gleich an unserem Beispiel aus. + + +#on("b")#6.1.2  Die "sonstigen" Befehle#off("b")# + +Gehen wir zunächst auf die beiden Befehle 'initialisiere interface' und 'warte' sowie +auf den Testbefehl 'abbruch gewuenscht ein: + +#on("b")# +PROC initialisiere interface +#off("b")# + + Jedes Programm zur Prozeßdatenverarbeitung, das auf das Interface-System + zugreift, sollte mit diesem Befehl beginnen. Durch diesen Befehl wird das System + in einen definierten Anfangszustand versetzt; systeminterne Variablen werden + initialisiert, so daß vom Programm aus darauf zugegriffen werden kann. +#page# +#on("b")# +PROC warte (REAL CONST wert) +PROC warte (INT CONST wert) +#off("b")# + + Der Befehl 'warte' ähnelt dem Ihnen sicher bekannten Befehl 'pause'. Allerdings + wird hier als Parameter (INT oder REAL) die Wartezeit in Sekunden angegeben - + bei 'pause' dagegen die Anzahl der Zehntelsekunden. Der eigentliche Unterschied + besteht aber darin, daß 'warte' im Gegensatz zu 'pause' ein "Nothalt" - d.h. die + Tastenkombination , die wir im vorigen Kapitel beschrieben haben + - registriert. Aus diesem Grunde sollte in Prozeßdatenverarbeitungsprogrammen + mit 'warte' statt mit 'pause' gearbeitet werden. + + +#on("b")# +BOOL PROC abbruch gewuenscht +#off("b")# + + Die Prozedur liefert den Wert 'TRUE', wenn zwischenzeitlich die Tasten­ + kombination eingegeben wurde, sonst den Wert 'FALSE'. + + +#on("b")#6.1.3  Schreibweise für Bitmuster/Bitsymbole#off("b")# + +Beim Befehl 'bitmuster ausgeben', wird eine Zeichenkette, die aus 8 Zeichen besteht, +übergeben - das sog. Bitmsuster. In unserem Falle kommen hier nur die Zeichen 'I' +und 'O' vor. Ihnen ist sicher die Bedeutung sofort klar gewesen: + + 'I' bedeutet, daß an der entsprechenden Position ein High-Pegel (5V) angelegt + werden soll; 'O' bedeutet, daß an der entsprechenden Position ein Low- + Pegel (0V) angelegt werden soll. + +So werden über den ersten Befehl im Refinement 'lauflichtdurchgang' alle Leucht­ +dioden ausgeschaltet, nur die Leuchtdiode ganz rechts wird angeschaltet. Über den +zweiten Befehl wird diese wieder ausgeschaltet und dafür aber die zweite von rechts +eingeschaltet usw. +#page# +Neben den Zeichen 'I' und 'O' dürfen auch die Zeichen 'X' und 'T' in der über­ +gebenen Zeichenkette auftauchen. Um die Bedeutung zu verstehen, muß man +wissen, daß #on("b")#gs-Prozess#off("b")# den jeweils letzten Zustand des digitalen Ausgangs speichert +(durch 'initialisiere interface' werden alle Ausgänge auf 'O' gesetzt). + + 'X' bedeutet, daß an der entsprechenden Position der zuletzt dagewesene + Zustand erhalten bleibt, d.h. durch diese Ausgabe nicht beeinflußt wird. + + 'T' bedeutet, daß an der entsprechenden Position der zuletzt dagewesene + Zustand "umgekehrt" wird. Lag zuletzt ein Low-Pegel (O) an, so wird + daraus ein High-Pegel (I) und umgekehrt. + +Sie können sich nun sicher sofort erklären, was das folgende Programm bewirkt: + + +#on("b")# + initialisiere interface; + bitmuster ausgeben (4, "OIOIOIOI"); + REP + bitmuster ausgeben (4, "TTTTTTTT"); + warte (1) + UNTIL abbruch gewuenscht PER +#off("b")# + + +Durch den ersten Befehl 'bitmuster ausgeben' wird jede zweite Leuchtdiode ange­ +schaltet, die anderen werden ausgeschaltet. Durch den zweiten Befehl in der Schleife +wird nun jeweils jeder Zustand in "das Gegenteil umgekehrt", so daß ein Blinklicht +entsteht, bei dem abwechselnd einmal die einen vier, dann die anderen vier Leucht­ +dioden aufleuchten - und das jeweils für eine Sekunde. + + +#on("b")#6.1.4  Befehle für die digitale Ausgabe#off("b")# + +Einen Befehl, mit dem der digitale Ausgang des Interfaces angesprochen werden +kann, haben Sie schon in Kapitel 6.1 kennengelernt: +#page# +#on("b")# +PROC bitmuster ausgeben (INT CONST kanal, + TEXT CONST zeichenkette) +#off("b")# + +Über den ersten Parameter wird der Kanal angegeben, über den der digitale Ausgang +angesprochen werden kann; bei uns ist das der Kanal 4 auf der Compact-Box. Über +den zweiten Parameter wird das sogenannte Bitmuster übergeben; ein Text, der aus +genau 8 Zeichen besteht. Dabei dürfen die Zeichen "I, O, X und T verwendet werden +(sehen Sie dazu auch Kapitel 6.1.3). + +#on("b")#gs-Prozess#off("b")# stellt noch zwei weitere Befehle für die digitale Ausgabe zur Verfügung. +Um die Wirkungsweise der Befehle zu verdeutlichen, hier das erste Beispiel (das +Lauflicht) in einer zweiten Version: + +#on("b")# + initialisiere interface; + REP + lauflichtdurchgang; + warte (2.0) + UNTIL abbruch gewuenscht PER. + + lauflichtdurchgang: + INT VAR zeiger; + FOR zeiger FROM 0 UPTO 7 REP + schalte aktuelle leichtdiode an; + schalte vorgaenger aus + PER. + + schalte aktuelle leuchtdiode an: + bitsymbol ausgeben (4, zeiger, "I"). + + schalte vorgaenger aus: + IF zeiger = 0 + THEN bitsymbol ausgeben (4, 7, "O") + ELSE bitsymbol ausgeben (4, zeiger - 1, "O") + FI. +#off("b")# + +#on("b")# +PROC bitsymbol ausgeben (INT CONST kanal, bitnummer, + TEXT CONST zeichen) +#off("b")# +#page# +Während durch den Befehl 'bitmuster ausgeben' auf alle 8 Ausgänge gleichzeitig +Einfluß genommen werden kann, wird mit dem Befehl 'bitsymbol ausgeben' gezielt +nur genau einer der 8 Ausgänge, d.h. eines der 8 Bits manipuliert. Welcher Ausgang / +welches Bit manipuliert werden soll, wird über den zweiten Parameter festgelegt: hier +kann einer der Werte 0...7 angegeben werden (Beachten Sie die Numerierung der +Ausgänge (!)). + +Als dritter Parameter wird ein Text übergeben, der aus genau einem Zeichen +bestehen muß. Ebenso wie beim Befehl 'bitmuster ausgeben' sind hier die Zeichen I, +O, X und T zulässig. Sie haben hier auch die gleiche Bedeutung. + +Mit dem dritten Ausgabebefehl für den digitalen Ausgang können wir das Beispiel +noch in einer dritten Version notieren: + +#on("b")# + initialisiere interface; + REP + lauflichtdurchgang; + warte (2.0) + UNTIL abbruch gewuenscht PER. + + lauflichtdurchgang: + INT VAR wert :: 1; + REP + dezimalwert ausgeben (4, wert); + wert := 2 * wert + UNTIL wert > 128 PER. +#off("b")# + +#on("b")# +PROC dezimalwert ausgeben (INT CONST kanal, wert) +#off("b")# + +'wert' kann Werte zwischen 0 und 255 annehmen. Das zugehörige Bitmuster wird +dann am angegebenen Kanal ausgegeben. Anhand dieses Befehls wird Ihnen sicher +auch klar, warum gerade die oben beschriebene Numerierung der Bits gewählt +wurde. +#page# +#on("b")#6.1.5  Befehle für die analoge Ausgabe#off("b")# + +Neben der 'digitalen' Ausgabe ist auch eine 'analoge' Ausgabe möglich. Allerdings +wollen wir die Beschreibung der Befehle an dieser Stelle sehr kurz halten, denn eine +"analoge" Ausgabe ist nur möglich, wenn Sie eine D/A-Karte besitzen. + +Auf der D/A-Karte steht nur ein physikalischer Ausgabekanal zur Verfügung, der von +#on("b")#gs-Prozess#off("b")# jedoch über zwei Kanalnummern angesprochen werden kann. + +Über den Ausgabekanal 1 können Spannungswerte zwischen -5V und +5V aus­ +gegeben werden, über den Ausgabekanal 2 Spannungswerte zwischen 0V und +5V. + +Dafür stellt #on("b")#gs-Prozess#off("b")# zwei Befehle bereit: + +#on("b")# +PROC spannungswert ausgeben (INT CONST kanal, + REAL CONST wert) +#off("b")# + +'wert' kann, in Abhängigkeit vom angegebenen Kanal, Werte zwischen -5.0 und +5.0 +(bei Kanal 1) bzw. 0.0 und +5.0 (bei Kanal 2) annehmen. Bei dem Versuch, Werte +außerhalb dieser Grenzen anzugeben, erhalten Sie die Fehlermeldung "Der +Spannungswert ... ist nicht zulässig!". + + +#on("b")# +PROC wert an analogausgang ausgeben (INT CONST kanal, wert) +#off("b")# + +Für 'wert' kann eine Zahl zwischen 0 und 255 angegeben werden. Dabei wird 0 auf +den kleinstmöglichen Spannungswert am jeweilgen Kanal (bei Kanal 1 also auf -5V, +bei Kanal 2 auf 0V) und 255 auf den größtmöglichen Spannungswert am jeweilgen +Kanal (bei beiden Kanälen auf +5V) abgebildet. Das Intervall zwischen kleinst- und +größtmöglichem Spannungswert wird in 255 gleichgroße Teilintervalle eingeteilt. Es +wird nun die Spannung ausgegeben, die der Intervallnummer entspricht. +Anmerkung: Dieser Befehl hat nur einen "geringen praktischen Nutzwert"; er dient + vornehmlich dazu, den Wandlungsprozeß zu verdeutlichen. +#page# +#on("b")#6.2  Kleine Beispiele zur digitalen Eingabe#off("b")# + +Für die im folgenden beschriebenen kleinen Beispiele benötigen Sie einen Code­ +kartenleser und einige Codekarten (können auch von der Fa. AKTRONIK bezogen +werden). Der Anschluß des Codekartenlesers an Ihr Interface-System ist denkbar +einfach. Stecken Sie den 8poligen Platinenstecker des Codekartenlesers in die Buchse +des Digitaleinganges der Steckkarte bzw. der Compact-Box und den 3poligen +Platinenstecker in die passende Spannungsversorgungsbuchse (12V) am Steckplatz +bzw. auf der Compact-Box - fertig! Bei eingeschalteter Betriebsspannung müßte nun +der Codekartenleser beleuchtet sein. + +Auf den Lochkarten sind bis zu 8 Löcher eingestanzt. Dabei können bestimmte +Löcher (Bits) für die Erfassung definierter Merkmale verwendet werden. Dazu kann +eine Karte in bestimmte Bereiche aufgeteilt werden. + +In unserem kleinen Beispiel stellen wir uns vor, daß eine (Modell-)Sparkasse zwei +Filialen hat. Sie hat an Ihre "Kunden" Codekarten verteilt. Die Filialen sind durch +Farben gekennzeichnet. Die oberen (höchstwertigen) zwei Bits der Karte sollen diese +Farbe kodiert enthalten, damit auch der "Sparkassen-Computer" die Farbe schnell +ermitteln kann. Die Karte soll folgenden Aufbau haben: + + +---------------------------------+ + | O o o O o o O | + | | | + | Farbbits| Kundennummer | + | | | + | | | + | | | + | | + +---------------------------------+ + + +#center#Abb.20 Beispiellochkarte +#page# +Bit 7 sei für rote, Bit 6 für grüne Farbe gesetzt, d.h. gelocht. Wie wollen jetzt ein +Programm erstellen, das auf Eingabe einer Karte deren Farbe und den durch die +ersten 6 Bits bestimmten Wert (Kundennummer) ausgibt: + +#on("b")# + initialisiere interface; + REP + erfasse lochkarte + UNTIL abbruch gewuenscht PER. + + erfasse lochkarte: + warte bis karte im leser; + gib farbe aus; + gib kundennummer aus; + warte bis keine karte im leser. + + warte bis karte im leser: + put ("Bitte eine Codekarte einlegen!"); line; + WHILE NOT alles abgedunkelt REP + tue nichts + END REP; + WHILE alles abgedunkelt REP + tue nichts + END REP; + warte (1). + + warte bis keine karte im leser: + put ("Bitte die Karte entnehmen!"); + REP + tue nichts + UNTIL alles beleuchtet PER. + + alles abgedunkelt: + bitmuster (3) = "OOOOOOOO". + + alles beleuchtet: + bitmuster (3) = "IIIIIIII". + + gib farbe aus: + IF bitsymbol (3, 7) = "I" + THEN put ("rote Karte"); line + ELSE put ("grüne Karte");line + FI; +#page# + gib kundennummer aus: + INT VAR kundennummer :: 0, bitnummer; + FOR bitnummer FROM 0 UPTO 5 REP + registriere gesetztes bit + PER; + put ("Kundennummer:"); put (kundennummer): line. + + registriere gesetztes bit: + IF bit ist gesetzt (3, bitnummer) + THEN kundennummer INCR (2 ** bitnummer) + FI. + + +#off("b")# + (Hinweis: Es handelt sich hier um ein Beispielprogramm, an dem diverse + Befehle erläutert werden sollen - die Programmierung ist nicht + optimal! Im Refinement 'warte bis karte im leser' ist es z.B. + günstiger, solange einzulesen, bis der eingelesene Wert "stabil" ist. + Auch das Refinement 'registriere gesetztes bit' würde man so nicht + programmieren, sondern nach einem Einlesevorgang (Bitmuster) + über Textoperationen aus dem Bitmuster die 'kundennummer' + ermitteln...). + +Bevor wir Ihnen die Funktionsweise der von #on("b")#gs-Prozess#off("b")# bereitgestellten Prozeduren +im Detail erläutern, möchten wir Ihnen noch ein paar kurze Erläuterungen zum +obigen Programm geben. + +Besondere Aufmerksamkeit sollten Sie den Refinements 'warte bis karte im leser' und +'warte bis keine karte im leser' schenken. Im erstgenannten Refinement ist sicherzu­ +stellen, daß das Einschieben der Karte (erst muß alles abgedunkelt werden - dann +müssen einige Positionen beleuchtet sein) registriert wird. Um Fehlauswertungen der +Karte zu vermeiden (z.B. beim Verkanten einer Karte) wird zur Sicherheit vor der +Auswertung eine Sekunde gewartet. Am Ende des Lesevorgangs soll sichergestellt +werden, daß die Karte auch entnommen worden ist (alle Positionen wieder beleuchtet +sind). +#page# +Wir prüfen im Refinement 'gib farbe aus' nur das 7. Bit (sehen Sie die Erklärung zu +'bitsymbol'). Ist das Bit gesetzt (die Karte hier gelocht), so identifizieren wir die Farbe +Rot, sonst Grün. Natürlich ist es möglich, mit 2 "Farbbits" vier Farben zu ver­ +schlüsseln: z.B. Rot, wenn nur Bit 7 gesetzt ist; Grün, wenn nur Bit 6 gesetzt ist; Blau, +wenn Bit 7 und Bit 6 gesetzt sind; Gelb, wenn weder Bit 7 noch Bit 6 gesetzt sind. +Dadurch wird der Auswertalgorithmus aber etwas aufwendiger. Vielleicht probieren +Sie es nacher einmal. + +Die Prozedur 'tue nichts' wird schon von #on("b")#gs-Prozess#off("b")# bereitgestellt. Es wird keine +Aktion ausgeführt - jedoch überprüft, ob zwischenzeitlich die Tastenfolge + ("Notbremse") eingegeben wurde. Es empfiehlt sich, diese Prozedur +gerade in Schleifenrümpfen einzusetzten, damit die Möglichkeit besteht, bei einer +"Endlosschleife" einen Abbruch herbeizuführen (sonst "hängt" die Task ggf. am +Interfacekanal)! + + +#on("b")#6.2.1  Befehle für die digitale Eingabe#off("b")# + +In Kapitel 6.1.4 haben Sie die Befehle für die digitale Ausgabe kennengelernt, die +Ihnen #on("b")#gs-Prozess#off("b")# zur Verfügung stellt. Zu jedem dieser drei Befehle gibt es das +"Gegenstück" auch als Eingabebefehl. Alle Eingabebefehle sind als werteliefernde +Prozeduren (Funktionen) ausgelegt. + +In den Refinements 'alles abgedunkelt' und 'alles beleuchtet' benutzen wir den +Befehl: + +#on("b")# +TEXT PROC bitmuster (INT CONST kanal) +#off("b")# + +Über den Parameter wird der Kanal angegeben, über den der digitale Eingang ange­ +sprochen werden kann; bei uns ist das der Kanal 3 auf der Compact-Box. Die +Prozedur liefert einen Text, der aus acht Zeichen besteht. Dabei können nur die +Zeichen "I und "O" auftreten (sehen Sie dazu auch Kapitel 6.1.3). +#page# +Die beiden gerade genannten Refinements hätten aber auch so notiert werden +können: + +#on("b")# + alles abgedunkelt: + dezimalwert (3) = 0. + + alles beleuchtet: + dezimalwert (3) = 255. +#off("b")# + +#on("b")# +INT PROC dezimalwert (INT CONST kanal) +#off("b")# + +Über den Parameter wird der Kanal angegeben, über den der digitale Eingang ange­ +sprochen werden kann; bei uns ist das wieder der Kanal 3 auf der Compact-Box. Die +Prozedur liefert einen Integer-Wert zwischen 0 und 255 (sehen Sie dazu auch unter +'dezimalwert ausgeben' im Kapitel 6.1.4). + +Den dritten Eingabebefehl für den Digitaleingang, den #on("b")#gs-Prozess#off("b")# bereitstellt, finden +Sie im Refinement 'gib farbe aus': + +#on("b")# +TEXT PROC bitsymbol (INT CONST kanal, bitnummer) +#off("b")# + +Wie schon bei den anderen beiden Eingabebefehlen wird hier über den ersten +Parameter der Eingabekanal festgelegt; bei uns auf der Compact-Box ist das wieder +der Kanal 3. Über den zweiten Parameter wird die Nummer des Bits angegeben, +dessen Wert ermittelt werden soll. Ist das betreffende Bit gesetzt, so liefert die +Prozedur das Zeichen "I", sonst das Zeichen "O" (sehen Sie dazu auch das Kapitel +6.1.3 'Schreibweise für Bitmuster/Bitsymbole'). + + +#on("b")#6.2.2  Eingabetests#off("b")# + +Neben diesen drei Eingabebefehlen stellt #on("b")#gs-Prozess#off("b")# noch zwei Testbefehle zur +Verfügung, die man häufig gut verwenden kann. Auf einen greifen wir schon im +Refinement 'registriere gesetztes bit' zurück: +#page# +#on("b")# +BOOL PROC bit ist gesetzt (INT CONST kanal, bitnummer) +#off("b")# + +Die Parameter sind die gleichen wie beim Befehl 'bitsymbol'. Zunächst liest die +Prozedur die aktuelle Einstellung am angegebenen Digitaleingang ('kanal') ein und +untersucht dann das Bit mit der angegebenen Bitnummer (0, ..., 7). Die Prozedur +liefert den Wert 'TRUE', wenn das Bit mit der entsprechenden Bitnummer gesetzt ist +(die Prozedur bitsymbol' mit gleichen Parametern also den Wert "I" liefern würde), +sonst 'FALSE' (die Prozedur bitsymbol' mit gleichen Parametern also den Wert "O" +liefern würde). + +Den zweiten Testbefehl haben wir im obigen Programm noch nicht verwendet. Wir +könnten damit aber auch die Refinements 'alles abgedunkelt' und 'alles beleuchtet' +folgendermaßen notieren: + +#on("b")# + alles abgedunkelt: + bitmuster gleich (3, "OOOOOOOO"). + + alles beleuchtet: + bitmuster gleich (3, "IIIIIIII"). +#off("b")# + + +#on("b")# +BOOL PROC bitmuster gleich (INT CONST kanal, + TEXT CONST vorgabe) +#off("b")# + +Wie bereits zuvor wird über den ersten Parameter der Kanal angegeben, über den der +Digitaleingang angesprochen werden kann. Zunächst liest die Prozedur am ange­ +gebenen Kanal die aktuelle Einstellung ein und vergleicht es mit der 'vorgabe'. Der +eigentliche Vorteil der Prozedur liegt darin, daß bei der Beschreibung der 'vorgabe' +neben den Zeichen "I" und "O" auch das Zeichen "X" verwendet werden darf. z.B. +"IOXXXXX". Entspricht das eingelesene Bitmuster der 'vorgabe', so liefert die Prozedur +den Wert 'TRUE', sonst den Wert 'FALSE'. In gerade genannten Beispiel liefert die +Prozedur also immer dann 'TRUE', wenn eine Karte mit der Markierung für Rot +eingeschoben wurde - gleichgültig, welche Kundennummer eingestanzt ist. +#page# +#on("b")#6.2.3  Befehle für die analoge Eingabe#off("b")# + +Die analoge Eingabe möchten wir Ihnen an einem ganz einfachen Beispiel vor Augen +führen. Sie brauchen dazu nur ein ganz normales Drehpotentiometer (ca. 5kOhm), +das Sie in jedem Elektronik-Fachgeschäft für wenig Geld erhalten können. Ein +solches Drehpotentiometer verfügt über drei Anschlüsse. Wenn man sich den inneren +Aufbau vor Augen führt, ist die Belegung der drei Anschlüsse auch recht einsichtig. + + + siehe Physikbuch!! + + + +#on("b")##center#Abb.21 Aufbau eines Drehpotentiometers#off("b")# + +Löten Sie ggf. auf die drei Anschlüsse je einen Lötschuh, um eine einfache Steckver­ +bindung zur Kombikarte/Compact-Box herstellen zu können. Wichtig ist vor allem, +daß der mittlere Anschluß am Drehpotentiometer auf den mittleren Stecksockel am +Analogeingang auf der Kombikarte/Compact-Box aufgesteckt wird. Die beiden +anderen Anschlüsse können können Sie beliebig auf die beiden dann noch freien +Lötstifte (+ und �) des gleichen Analogeingangs aufstecken. + +Starten Sie dann das folgende Programm: + +#on("b")# + initialisiere interface; + page; + REP + notiere potentiometerwert + UNTIL abbruch gewuenscht PER. + + notiere potentiometerwert: + put (wert von analogeingang (1)); + line. +#off("b")# +#page# +Nach dem Start des Programms müßten auf dem Bildschirm untereinander immer +wieder die gleiche Zahl (ein Wert zwischen 0 und 255) auftauchen. Wenn Sie dann +am Potentiometer drehen, müßten sich auch die Werte auf dem Bildschirm ändern. + +Sie hätten das Refinement 'notiere potentiometerwert' auch folgendermaßen notieren +können: + +#on("b")# + notiere potentiometerwert: + put (spannungswert (1)); + line. +#off("b")# + +Statt Wert zwischen 0 und 255 zu erhalten, müßten Sie jetzt Werte zwischen 0.0 und +5.0 erhalten. + + +#on("b")# +REAL PROC spannungswert (INT CONST kanal) +#off("b")# + +Über den Parameter wird der Kanal angegeben, über den der analoge Eingang ange­ +sprochen werden kann; bei uns ist das der Kanal 1 (oder 2) auf der Kombikarte/ +Compact-Box. Auf der Kombikarte/Compact-Box können nur Spannungswerte +zwischen 0.0V und 5.0V eingelesen werden. Auf der A/D-Karte kann der Bereich für +die einzulesenden Sapnnungwerte durch die Schalterstellung auf der Karte eingestellt +werden (Sehen Sie dazu auch Kapitel 5.3.1). + + +#on("b")# +REAL PROC wert von analogeingang (INT CONST kanal) +#off("b")# + +Über den Parameter wird der Kanal angegeben, über den der analoge Eingang ange­ +sprochen werden kann; bei uns ist das der Kanal 1 (oder 2) auf der Kombikarte/ +Compact-Box. Geliefert werden Werte zwischen 0 und 255. + +Tatsächlich wird aber ein Spannungswert vom Analogeingang eingelesen. Dieser +Spannungswert wird vom Analog-Digital-Wandler auf der Karte nach folgendem +Verfahren gewandelt: +#page# +Dem größtmöglichen Spannungswert an diesem Eingang wird der Wert 255, dem +kleinstmöglichen der Wert 0 zugeordnet. Das Intervall zwischen dem kleinst- und +größtmöglichen Spannungswert wird in 255 gleichgroße Teilintervalle eingeteilt. Es +wird nun die Nummer des Intervalls geliefert, in das die eingelesene Spannung fällt. +Kleinst- und größtmögliche Spannungswerte sind abhängig von der aktuellen Steck­ +karte, Interface-Konfiguration). + + +#on("b")#6.3  Hinweise auf Aufgabenmaterial#off("b")# + +Eine Fülle von Beispielanwendungen sind beschrieben in: + + Landesinstitut für Schule und Weiterbildung (Hrsg.), Materialien zur Lehrerfort­ + bildung in Nordrhein-Westfalen, Heft 2, Neue Technologien - Informations­ + technologische Inhalte im Wahlpflichtunterricht der Klassen 9/10, 2. über­ + arbeitete Auflage 1987 + diff --git a/app/gs.process/1.02/doc/gs-prozess-7 b/app/gs.process/1.02/doc/gs-prozess-7 new file mode 100644 index 0000000..db3b9d1 --- /dev/null +++ b/app/gs.process/1.02/doc/gs-prozess-7 @@ -0,0 +1,1121 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#7  Beschreibung der Menufunktionen#off("b")# + +Nach Aufruf meldet sich #on("b")#gs-Prozess#off("b")# zunächst mit dem #on("b")#gs-DIALOG#off("b")#-Emblem. Kurze +Zeit später erscheint das folgende Menu auf dem Bildschirm: + ++---------------------------------------------------------------------+ +| PDV:  Info Interface Programm Archiv | +|-------+------------------------+------------------------------------+ +| | u  Übersicht Befehle | | +| | --------------------- | | +| | a  Ausgabebefehle | | +| | e  Eingabebefehle | | +| | t  Testbefehle | | +| | w  Weitere Befehle | | +| | --------------------- | | +| | b  Bitmuster | | +| | s  Symbole/Zeichen | | +| | d  Digital-/Analogwerte| | +| +------------------------+ | +| | +| +----------------------------------------+ | +| | gs-Prozess | | +| | Version 1.0 | | +| | | | +| | Copyright Ρ 1988 bei Eva Latta-Weber, | | +| | Bielefeld | | +| +----------------------------------------+ | ++---------------------------------------------------------------------+ +|Info:/ Wahl: Ausführen: Verlassen:| ++---------------------------------------------------------------------+ + +#center#Abb.22:  Eingangsbildschirm #on("b")#gs-Prozess#off("b")# + + +Bevor wir Ihnen die Bedeutung der einzelnen Menupunkte erklären, geben wir erst +noch einige grundsätzliche Hinweise zur Bedienung des Menusystems für diejenigen +Leser, die im Umgang mit Menus unter #on("b")#gs-DIALOG#off("b")# nicht geübt sind. +#page# +#on("b")#7.1  Kurzhinweise zur Bedienung der Menus#off("b")# + +Die Bedienung des Menus ist sehr einfach. Eine ausführliche Beschreibung dazu +finden Sie in den Unterlagen zum Programmsystem #on("b")#gs-DIALOG#off("b")#. An dieser Stelle +sollen nur die wesentlichen Bedienungsvorgänge beschrieben werden. + +- Mit der Tastenfolge können Sie sich Informationen zur Bedienung + des Menusystems in das Menu einblenden lassen. + +- Mit den Pfeiltasten und können Sie zwischen den "Ober­ + begriffen" in der Kopfzeile wählen. Der aktuelle Oberbegriff ist jeweils invers + dargestellt. Das ausgeklappte 'Pull-Down-Menu' bezieht sich auf diesen invers + dargestellten Oberbegriff. + +- Mit den Pfeiltasten und können Sie zwischen den Menu­ + funktionen wählen, die Ihnen im aktuellen Pull-Down-Menu zur Auswahl ange­ + boten werden. Die aktuell angewählte Menufunktion wird jeweils invers darge­ + stellt. Die Trennlinien, die in einigen Pull-Down-Menus sichtbar sind, dienen nur + der optischen Untergliederung; sie können nicht angewählt werden und werden + deshalb automatisch übersprungen. Die einzelnen Menupunkte sind "zyklisch + miteinander verknüpft", das heißt, man gelangt vom untersten Menupunkt + wieder zum obersten und umgekehrt. Menupunkte, vor denen ein Minuszeichen + steht ('-'), sind (zur Zeit) nicht aktivierbar; auch sie können nicht angewählt + werden und werden einfach übersprungen. + +- Durch Tippen der Fragezeichentaste () können Sie sich jeweils zur + aktuellen Menufunktion (invers im Pull-Down-Menu) Informationen in das + Menu einblenden lassen. + +- Um eine Menufunktion ausführen zu lassen, bewegen Sie sich mit den Pfeiltasten + auf die gewünschte Menufunktion im aktuellen Pull-Down-Menu und tippen + dann die -Taste. Steht vor dem gewünschten Menupunkt ein +#page# + einzelner Buchstabe oder eine Ziffer, so kann durch Tippen der entsprechenden + Taste diese Menufunktion dadurch direkt aufgerufen werden. Sobald eine Menu­ + funktion aufgerufen worden ist, erscheint davor ein Stern ('*'). Daraus können + Sie entnehmen, daß das System bereits den Auftrag ausführt. + +- An verschiedenen Stellen werden Fragen an Sie gerichtet, die Sie mit 'ja' oder + 'nein' beantworten müssen. Tippen Sie dazu entsprechend der Entscheidung die + Taste (für 'ja') bzw. (für 'nein'). + +- Werden Ihnen vom Menu aus Dateinamen zur Auswahl angeboten, so können Sie + den auf dem Bildschirm sichtbaren Pfeil vor den gewünschten Namen + positionieren. Mit den Tasten oder können Sie den Namen + ankreuzen. Ist die Auswahl mehrerer Dateinamen möglich, so können Sie den + Vorgang wiederholen. Mit den Tasten oder können Sie auch + ein Kreuz vor einem Namen wieder löschen. Daneben gibt es noch einige Ta­ + stenfunktionen, die für die Bedienung recht hilfreich sein können. Tippen Sie + während der Auswahl die Fragezeichentaste (), so werden Ihnen alle + Bedienungsmöglichkeiten auf dem Bildschirm angezeigt. Eine Auswahl, in der + mehrere Dateien angekreuzt werden dürfen, wird durch die Tastenfolge + verlassen. Anschließend wird die eingestellte Operation mit den + angekreuzten Dateien ausgeführt. Sind Sie versehentlich in eine solche Auswahl + gelangt, so können Sie den Vorgang durch die Tastenkombination + abbrechen. + +- An einigen Stellen werden Sie aufgefordert, eine Eingabe zu machen (z.B. einen + Dateinamen einzugeben). Wird Ihnen hier ein Vorschlag gemacht, den Sie + akzeptieren, so brauchen Sie zur Bestätigung nur die -Taste zu + tippen. Gefällt Ihnen der Vorschlag nicht oder wird Ihnen kein Vorschlag ge­ + macht, so machen Sie bitte die gewünschte Eingabe. Zum Schreiben stehen + Ihnen alle aus dem Editor bekannten Funktionen zur Verfügung. Mit der Taste + können Sie Buchstaben löschen, mit einfügen. Die +#page# + Eingabe wird durch Tippen der -Taste abgeschlossen. Ist der von + Ihnen gewünschte Name schon in Ihrer Task vorhanden und steht in der Fußzeile + der Hinweis 'Zeigen: ', dann können Sie sich auch alle vor­ + handenen Namen zur Auswahl anbieten lassen und durch Ankreuzen den beab­ + sichtigten Namen auswählen. + +- Ihnen können auch mehrere Alternativen angeboten werden, zwischen denen Sie + wählen müssen. In der untersten Zeile eines solchen Kastens, in denen Ihnen die + Alternativen auf dem Bildschirm eingeblendet werden, sind die Möglichkeiten + aufgeführt, die darüber beschrieben sind. Mit den Pfeiltasten können sie die + Markierung auf die gewünschte Alternative positionieren und dann durch die + -Taste zur Ausführung bringen. (Manchmal ist das auch durch + Tippen der den Alternativen vorangestellten Buchstaben oder Ziffern möglich). + +- Durch die Tastenfolge kann das Menu insgesamt verlassen + werden. Damit das nicht versehentlich geschieht, wird jeweils die Frage gestellt, + ob Sie das Menu tatsächlich verlassen wollen. Diese Frage beantworten Sie bitte je + nach Wunsch mit 'ja' oder 'nein' durch Tippen der Tasten bzw. . + + +#on("b")#7.2  Menufunktionen zum Oberbegriff 'Info'#off("b")# + +Das auf dem Bildschirm sichtbare Pull-Down-Menu ist oben abgebildet. + +#on("b")#u   Übersicht Befehle#off("b")# + +Mit dieser Funktion können Sie sich eine Übersicht der Befehle, die Ihnen +#on("b")#gs-Prozess#off("b")# zur Verfügung stellt, in den aktuellen Bildschirm einblenden lassen: +#page# +#free(2.0)# + +------------------------------------------------------------+ + | Ausgabebefehle: Eingabebefehle: | + | | + | dezimalwert ausgeben dezimalwert | + | bitmuster ausgeben bitmuster | + | bitsymbol ausgeben bitsymbol | + | spannungswert ausgeben spannungswert | + | wert an analogausgang ausgeben wert von analogeingang | + | | + | | + | Testbefehle: Weitere Befehle: | + | | + | bitmuster gleich initialisiere interface | + | bit ist gesetzt warte | + | | + +------------------------------------------------------------+ +#center#Abb.23:  Befehlsübersicht + + Es werden 'Eingabebefehle', 'Ausgabebefehle' und 'Testbefehle' unterschieden. + Darüberhinaus werden 'Weitere Befehle' angegeben. Eine ausführliche + Beschreibung der einzelnen Befehle ist unter den gleichnamigen Menupunkten + abrufbar. + + +#on("b")#a   Ausgabebefehle#off("b")# + + Mit dieser Funktion können Sie sich die zur Verfügung stehenden Ausgabe­ + befehle detailliert erläutern lassen. Zuerst gelangen Sie in eine Auswahl, von + der aus zu jedem einzelnen Ausgabebefehl eine Informationstafel abgerufen + werden kann: +#page# +#free(2.0)# + +-------------------------------------+ + | Ausgabebefehle: | + | | + | 1  dezimalwert ausgeben | + | | + | 2  bitmuster ausgeben | + | 3  bitsymbol ausgeben | + | | + | 4  spannungswert ausgeben | + | 5  wert an analogausgang ausgeben | + | | + | z  Zurück in das Menu | + | | + | 1   2   3   4   5   z | + +-------------------------------------+ + +#center#Abb.24:  Auswahl Ausgabebefehle + + Auf jeder Informationstafel ist ein kleines Beispiel zur Verwendung des Befehls + angegeben, das auch erläutert wird. Anschließend wird ausführlich auf die + Parameter der Befehle eingegangen (Datentyp, Wertebereich, etc.). Aus den + einzelnen Informationstafeln gelangen Sie immer wieder zur Auswahl zurück. + Wird die Auswahl selbst verlassen, gelangen Sie zurück ins Ausgangsmenu. + + +#on("b")#e   Eingabebefehle#off("b")# + + Mit dieser Funktion können Sie sich die zur Verfügung stehenden Eingabe­ + befehle detailliert erläutern lassen. Zuerst gelangen Sie in eine Auswahl, von + der aus zu jedem einzelnen Eingabebefehl eine Informationstafel abgerufen + werden kann: +#page# +#free(1.0)# + +------------------------------+ + | Eingabebefehle: | + | | + | 1  dezimalwert | + | | + | 2  bitmuster | + | 3  bitsymbol | + | | + | 4  spannungswert | + | 5  wert von analogeingang | + | | + | z  Zurück in das Menu | + | | + | 1   2   3   4   5   z | + +------------------------------+ + + +#center#Abb.25:  Auswahl Eingabebefehle + + Auf jeder Informationstafel ist ein kleines Beispiel zur Verwendung des Befehls + angegeben, das auch erläutert wird. Anschließend wird ausführlich auf die + Parameter der Befehle (Datentyp, Wertebereich, etc.) und die Werte, die + geliefert werden, eingegangen. + + Aus den einzelnen Informationstafeln gelangen Sie immer wieder zur Auswahl + zurück. Wird die Auswahl selbst verlassen, gelangen Sie zurück ins Ausgangs­ + menu. + + +#on("b")#t   Testbefehle#off("b")# + + Mit dieser Funktion können Sie sich die zur Verfügung stehenden Testbefehle + detailliert erläutern lassen. Zuerst gelangen Sie in eine Auswahl, von der aus zu + jedem einzelnen Testbefehl eine Informationstafel abgerufen werden kann: +#page# + +------------------------+ + | Testbefehle: | + | | + | 1  bitmuster gleich | + | 2  bit ist gesetzt | + | | + | z  Zurück in das Menu | + | | + | 1   2   z | + +------------------------+ + +#center#Abb.26:  Auswahl Testbefehle + + Auf jeder Informationstafel ist ein kleines Beispiel zur Verwendung des Befehls + angegeben, das auch erläutert wird. Anschließend wird ausführlich auf die + Parameter der Befehle (Datentyp, Wertebereich, etc.) und die Werte, die ge­ + liefert werden, eingegangen. + Aus den einzelnen Informationstafeln gelangen Sie immer wieder zur Auswahl + zurück. Wird die Auswahl selbst verlassen, gelangen Sie zurück ins Ausgangs­ + menu. + + +#on("b")#w   Weitere Befehle#off("b")# + + Hier werden noch weitere zur Verfügung stehende Befehle erläutert, die für die + Programmierung ganz hilfreich sind. Zuerst gelangen Sie in eine Auswahl, von + der aus zu jedem Befehl eine Informationstafel abgerufen werden kann: + + + +----------------------------+ + | Weitere Befehle: | + | | + | 1  initialisiere interface | + | 2  warte | + | | + | z  Zurück in das Menu | + | | + | 1   2   z | + +----------------------------+ + +#center#Abb.27:  Auswahl 'Weitere Befehle' +#page# + Aus den einzelnen Informationstafeln gelangen Sie immer wieder zur Auswahl + zurück. Wird die Auswahl selbst verlassen, gelangen Sie zurück ins Ausgangs­ + menu. + + +#on("b")#b   Bitmuster#off("b")# + + Nach Aufruf dieser Funktion wird der Aufbau der Bitmuster erläutert, die als + Parameter übergeben oder auch von Prozeduren geliefert werden. + + Insbesondere wird auf die Numerierung der einzelnen Bits eingegangen. + + +#on("b")#s   Symbole/Zeichen#off("b")# + + Nach Aufruf der Funktion werden die Zeichen erläutert, die bei der Be­ + schreibung von Bitmustern und Bitsymbolen Verwendung finden. + + +#on("b")#d   Digital-/Analogwerte#off("b")# + + Bei den beiden Befehlen 'wert an analogausgang ausgeben' und 'wert von + analogeingang', wird ein Wert zwischen 0 und 255 als Parameter übergeben + bzw. von der Prozedur geliefert. Am Analogausgang wird aber eine Spannung + ausgegeben bzw. eingelesen. Hier wird erläutert, wie die Spannungswerte + innerhalb der Prozeduren gewandelt werden. + + +#on("b")#7.3  Menufunktionen zum Oberbegriff 'Interface'#off("b")# + +Über die Menufunktionen unter diesem Oberbegriff nehmen Sie die Konfiguration +von #on("b")#gs-Prozess#off("b")# vor. Ebenso ist von hier aus ein Test des Interface-Systems möglich. +#page# + ++-----------------------------------------------------------------------+ +| PDV:  Info Interface Programm Archiv | ++-------+-------------------+-------------------------------------------+ +| | i  Informationen | | +| | ---------------- | | +| | k  Konfigurieren | | +| | ---------------- | | +| | a  Ausgabetest | | +| | e  Eingabetest | | +| +-------------------+ | +| | +| | +| | ++---------------------------------------------------------------------- + +| Info:/ Wahl: Ausführen: Verlassen: | ++-----------------------------------------------------------------------+ + +#center#Abb.28:  Menubildschirm zum Oberbegriff 'Interface' + + +#on("b")#i   Informationen#off("b")# + + Mit dieser Menufunktion können Sie sich zu jedem Zeitpunkt die aktuell + eingestellte Konfiguration von #on("b")#gs-Prozess#off("b")# anzeigen lassen. Sie können er­ + sehen, welches Interface-System eingestellt ist, wie die Kanäle belegt und + numeriert sind (sehen Sie das Beispiel in Abb.13). + + Ist eine Compact-Box oder ein Einzelsteckplatz eingestellt, erhalten Sie die + Informationen direkt eingeblendet. Ist dagegen ein Mehrfachsteckplatz einge­ + stellt, gelangen Sie in eine Auswahl. Von hier aus können Sie Informationen zu + jedem einzelnen Steckplatz getrennt abrufen. + + Fehlerfälle: + - Wurde #on("b")#gs-Prozess#off("b")# bisher noch nicht konfiguriert, so erhalten Sie eine + Warnung (sehen Sie Abb.11). In diesem Falle ist zunächst eine Konfigura­ + tion von #on("b")#gs-Prozess#off("b")# vorzunehmen (sehen Sie die Beschreibung zur + nächsten Menufunktion). +#page# +#on("b")#k   Konfigurieren#off("b")# + + Mit dieser Menufunktion können Sie #on("b")#gs-Prozess#off("b")# auf das aktuell angeschlos­ + sene Interface-System einstellen. Dazu haben Sie verschiedene Angaben zu + machen. + + Zunächst wird Ihnen eine Auswahl der Steckplatzart angeboten (sehen Sie + dazu Abb.12). Hier können Sie zur Zeit zwischen Compact-Box, Einzelsteck­ + platz und Mehrfachsteckplatz wählen. + + Ist eine Compact-Box angeschlossen, ist mit der hier gemachten Angabe die + Konfiguration abgeschlossen; die aktuelle Kanalbelegung wird Ihnen dann nur + noch zur Information eingeblendet. + + Bei Einzel- und Mehrfachsteckplatz haben Sie noch anzugeben, welche Inter­ + facekarte eingesteckt ist. Beim Einzelsteckplatz ist diese Angabe nur einmal zu + machen, beim Mehrfachsteckplatz halt mehrfach. Hierzu wird Ihnen aber + ebenfalls eine Auswahl angeboten (sehen Sie Abb.14). Nach jeder vorge­ + nommenen Einstellung wird Ihnen zur Information die Kanalbelegung mitge­ + teilt. Sofern Sie eine A/D-Karte verwenden, wird noch die Schalterstellung auf + der Karte erfragt, denn daraus kann #on("b")#gs-Prozess#off("b")# die eingestellte Eingangsem­ + pfindlichkeit ermitteln. + + +#on("b")#a   Ausgabetest#off("b")# + + Mit dieser Menufunktion können Sie auf einfache Weise testen, ob Ihr Inter­ + face-System korrekte Ausgaben erzeugt. Nach Aktivieren der Menufunktion + erhalten Sie die Möglichkeit, Ausgabewerte einzutragen (sehen Sie Abb.18). + Jede Eintragung ist durch abzuschließen. + + Für den Ausgabetest sollte eine Leuchtdiodenanzeige zur Verfügung stehen, um + die Ausgaben am Interface kontrollieren zu können. Für detailliertere Informa­ + tionen lesen Sie bitte unbedingt Kapitel 5. +#page# + Fehlerfälle: + - Interface meldet sich nicht! + Abhilfe: Überprüfen, ob der Adapter ordnungsgemäß angeschlossen + und eingeschlatet ist (sehen Sie Kapitel 5). Wenn ein MUFI + verwendet wird, MUFI aus- und nach kurzer Pause wieder + einschalten. Noch einmal den Ausgabetest versuchen. + - Interface-Kanal belegt! + (Kann nur beim Betrieb von MUFI als Endgerät oder bei RS232-Adapter + auftreten!) + Abhilfe: Feststellen, welche Task an den Interface-Kanal gekoppelt ist + ('taskinfo (2) ') und diese dann abmelden + ('break' oder 'end'). Die Nummer des Interfacekanals kann + mit dem Kommando 'put (interfacekanal) ' + erfragt werden. + - Sehen Sie bitte die detaillierte Fehlerliste in Kapitel 5.5. + + +#on("b")#e   Eingabetest#off("b")# + + Mit dieser Menufunktion können Sie auf einfache Weise testen, ob über Ihr + Interface-System korrekte Eingaben möglich sind. Nach Aktivieren der Menu­ + funktion erhalten Sie die Möglichkeit, am Interface angelegte Eingabewerte + abzulesen (sehen Sie Abb.19). + + Für den Eingabetest sollte ein Codekartenleser oder zumindest ein kurzer + Draht zur Verfügung stehen. Für detailliertere Informationen lesen Sie bitte + unbedingt Kapitel 5. + + Fehlerfälle: + - Interface meldet sich nicht! + Abhilfe: Überprüfen, ob der Adapter ordnungsgemäß angeschlossen + und eingeschlatet ist (sehen Sie Kapitel 5). Wenn ein MUFI + verwendet wird, MUFI aus- und nach kurzer Pause wieder + einschalten. Noch einmal den Ausgabetest versuchen. +#page# + - Interface-Kanal belegt! + (Kann nur beim Betrieb von MUFI als Endgerät oder bei RS232-Adapter + auftreten!) + Abhilfe: Feststellen, welche Task an den Interface-Kanal gekoppelt ist + ('taskinfo (2) ') und diese dann abmelden + ('break' oder 'end'). Die Nummer des Interfacekanals kann + mit dem Kommando 'put (interfacekanal) ' + erfragt werden. + - Sehen Sie bitte die detaillierte Fehlerliste in Kapitel 5.5. + + +#on("b")#7.4  Menufunktionen zum Oberbegriff 'Programm'#off("b")# + + ++-------------------------------------------------------------------------+ +| PDV:  Info Interface Programm Archiv | +|---------------------+---------------------+-----------------------------| +| | n  Neu erstellen | | +| | a  Ansehen/Ändern | | +| | | | +| | s  Starten | | +| | w  Wiederholen | | +| | | | +| | v  Verzeichnis | | +| | | | +| | l  Löschen | | +| | d  Drucken | | +| | | | +| | k  Kopieren | | +| | u  Umbenennen | | +| +---------------------+ | +|-------------------------------------------------------------------------| +| Info:/ Wahl: Ausführen: Verlassen: | ++-------------------------------------------------------------------------+ + +#center#Abb.29:  Menubildschirm zum Oberbegriff 'Programm' +#page# +#on("b")#n   Neu erstellen#off("b")# + + Mit dieser Funktion können Sie eine neue Programmdatei anlegen und be­ + schreiben. + + Sie werden zunächst nach einem Namen für die #on("b")#neue#off("b")# Programmdatei gefragt. + Geben Sie einen beliebigen Namen (#on("b")#ohne Anführungszeichen (!)#off("b")#) ein und + schließen Sie die Eingabe durch ab. Daraufhin wird Ihnen auf + dem Bildschirm eine neue Datei zum beschreiben angeboten. + + Sollte schon eine Programmdatei mit diesem Namen in der Task vorhanden + sein, so werden Sie darauf aufmerksam gemacht. + + Sie können sich während des Schreibens die wichtigsten Tastenfunktionen des + Editors einblenden lassen. Tippen Sie dazu die Tastenfolge . Es + erscheint dann das folgende Angebot aus dem Sie auswählen können: + + + +------------------------------------------------+ + | Der EUMEL - Editor | + | | + | b ... Beschreibung desEditors | + | w ... Wichtige Tasten | + | p ... Positionieren der Schreibmarke | + | k ... Korrigieren im Text (Einfügen/Löschen) | + | m ... Markierte Textpassagen bearbeiten | + | l ... Lernen im Editor | + | a ... Anweisungen im Editor (Kommandodialog) | + | | + | z ... Zurück in den Schreibmodus | + | | + | b   w   p   k   m   l   a   z | + | | + +------------------------------------------------+ + +#center#Abb.30:  Informationsauswahl zum EUMEL-Editor +#page# + Fehlerfälle: + - Eine Datei mit dem vorgeschlagenen Namen existiert schon. + + +#on("b")#a   Ansehen/Ändern#off("b")# + + Mit dieser Funktion können Sie sich Dateien, die schon in Ihrer Task + existieren, ansehen oder auch verändern. + + Sie werden zunächst gefragt, ob Sie #on("b")#die zuletzt bearbeitete Programmdatei#off("b")# + ansehen bzw. verändern möchten (sofern Sie schon vorher mit #on("b")#gs-Prozess#off("b")# in + der Task gearbeitet haben). + + Bejahen Sie diese Frage, dann wird Ihnen diese Programmdatei zur Be­ + arbeitung angeboten. Verneinen Sie die Frage dagegen, so gelangen Sie in die + 'Auswahl' (d.h es werden Ihnen alle Programmdateien in der Task zur Auswahl + angeboten). Nachdem Sie einen der Namen angekreuzt haben, wird Ihnen die + ausgewählte Programmdatei zur Bearbeitung auf dem Bildschirm angebo­ + ten. + + Fehlerfälle: + - In der Task existiert noch keine Programmdatei. + + +#on("b")#s   Starten#off("b")# + + Mit dieser Menufunktion können Sie eine Programmdatei übersetzen und + ausführen lassen. + + Sie werden zunächst gefragt, ob #on("b")#das zuletzt bearbeitete Programm#off("b")# ausgeführt + werden soll. Bejahen Sie die Frage, so wird dieses Programm gestartet; ver­ + neinen Sie die Frage dagegen, so gelangen Sie in die 'Auswahl'. Nach An­ + kreuzen des gewünschten Programmnamens wird das ausgewählte Programm + ausgeführt. +#page# + Sind im Programm noch Fehler enthalten, so werden das Programm und die + Fehlermeldungen gleichzeitig auf dem Bildschirm dargestellt (Paralleleditor) + und zur Korrektur angeboten. Für die Programmkorrektur stehen ebenfalls alle + Editorfunktionen zur Verfügung. + + Sollte Ihnen beim Programmieren ein Fehler unterlaufen sein (z.B. eine + Endlosschleife), so kann mit der Tastenfolge der Programmlauf + abgebrochen werden ("Notbremse"). + + +#on("b")##on("b")#w   Wiederholen#off("b")# + + Mit dieser Funktion können Sie den Ablauf des zuletzt ausgeführten + Programms wiederholen, ohne daß das Programm neu übersetzt wird. + + Beachten Sie aber bitte, daß Veränderungen am Programmtext, die seit dem + letzten Prtogrammlauf vorgenommen wurden, #on("b")#nicht#off("b")# berücksichtigt werden; + dazu muß das Programm erneut mit der Menufunktion 's Starten' übersetzt + werden. + + Ist die Wiederholung eines Programmlaufs nicht möglich, so erfolgt ein Hin­ + weis darauf. + + +#on("b")#v   Verzeichnis#off("b")# + + Mit dieser Funktion können Sie sich einen Überblick über die in Ihrer Task + vorhandenen Programmdateien verschaffen. + + Nach Aufruf dieser Funktion wird eine Liste der Programmdateien auf dem + Bildschirm ausgegeben, die sich in Ihrer Task befinden. Da die Liste selbst + eine Datei ist, kann Sie mit der Tastenkombination verlassen + werden - hierauf wird auch in der Kopfzeile der Datei hingewiesen. Falls nicht + alle Namen auf den Bildschirm passen, können Sie das Fenster mit + und verschieben. +#page# +#on("b")#l   Löschen#off("b")# + + Mit dieser Funktion können Sie Programmdateien, die Sie nicht mehr + benötigen, die unnötig Platz belegen, löschen. Aber Vorsicht! Die Programm­ + dateien verschwinden durch diese Funktion unwiederbringlich! + + Nach Aufruf dieser Funktion werden Ihnen alle Programmdateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Hier können Sie die gewünschten + Namen ankreuzen. Die Auswahl wird dann durch die Tastenfolge + verlassen. + + Für jede einzelne Programmdatei wird noch einmal zur Sicherheit gefragt, ob + sie auch tatsächlich gelöscht werden soll. Zur Bestätigung tippen Sie bitte die + Taste ('ja') - zur Verhinderung ('nein'). + + Fehlerfälle: + - In der Task exsitiert noch keine Programmdatei. + + +#on("b")#d   Drucken#off("b")# + + Mit dieser Funktion können Sie Programmdateien über einen angeschlossenen + Drucker ausgeben lassen. + + Nach Aufruf dieser Funktion werden Ihnen alle Programmdateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Hier können Sie die gewünschten + Namen ankreuzen. Die Auswahl wird dann durch die Tastenfolge + verlassen. + + Die angekreuzten Programmdateien werden anschließend zum Drucker ge­ + schickt. Der Vorgang wird auf dem Bildschirm protokolliert. +#page# + Fehlerfälle: + - In der Task existiert noch keine Programmdatei. + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' betrieben. + - Auf Ihrem System werden die Druckkosten abgerechnet. Sie müssen sich + mit einer Codenummer identifizieren. + + +#on("b")#k   Kopieren#off("b")# + + Mit dieser Funktion können Sie sich eine Kopie einer bereits in der Task + vorhandenen Programmdatei anlegen. Das ist z.B. dann sinnvoll, wenn Sie sich + einen bestimmten 'Stand' aufbewahren wollen oder wenn Sie ein Programm + schreiben wollen, das einem bereits vorhandenen ähnelt. + + Nach Aufruf dieser Funktion werden Ihnen alle Programmdateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Nach Ankreuzen eines Namens + wird die Auswahl automatisch verlassen. + + Anschließend wird der angekreuzte Name angezeigt und der Name für die + Kopie erfragt. Es muß ein Name eingetragen werden, der in dieser Task noch + nicht für eine Programmdatei vergeben wurde; ansonsten erfolgt ein Hinweis + darauf und es wird nicht kopiert! + + Da man aber oft für die Kopie einen ähnlichen Namen wie für das Original + wählt, wird der 'alte' Name vorgeschlagen. Aus genannten Gründen muß er + aber verändert werden. Sie können diesen Namen mit den üblichen Editier­ + funktionen verändern oder mit löschen und ganz neu + eingeben. Sie sparen aber eine Menge Tipparbeit, wenn Sie einen langen + Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Programmdatei mit dem gewünschten Namen existiert bereits in der + Task. +#page# +#on("b")#u   Umbenennen#off("b")# + + Mit dieser Funktion können Sie einer bereits vorhandenen Programmdatei + einen neuen Namen geben. + + Nach Aufruf dieser Funktion werden Ihnen alle Programmdateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Nach Ankreuzen eines Namens + wird die Auswahl automatisch verlassen. + + Anschließend wird dieser Name angezeigt und der zukünftige Name für die + Programmdatei erfragt. Es muß ein Name eingetragen werden, der in dieser + Task noch nicht für eine Programmdatei vergeben wurde - ansonsten erfolgt + ein Hinweis darauf und die Programmdatei wird nicht umbenannt! + + Da man aber oft den 'neuen' Namen in Anlehnung an den 'alten' Namen + wählt, wird der 'alte' Name vorgeschlagen. Aus genannten Gründen muß er + aber verändert werden. Sie können diesen Namen mit den üblichen Editier­ + funktionen verändern oder mit löschen und ganz neu + eingeben. Sie sparen aber eine Menge Tipparbeit, wenn Sie einen langen + Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Programmdatei mit dem gewünschten Namen existiert bereits in der + Task. +#page# +#on("b")#7.5  Menufunktionen zum Oberbegriff 'Archiv'#off("b")# + + ++-----------------------------------------------------------------------+ +| PDV:  Info Interface Programm Archiv | +|------------------+------------------------+---------------------------| +| | r  Reservieren | | +| | -  Neue Diskette | | +| | | | +| | -  Schreiben | | +| | -  Checken | | +| | -  Kombination | | +| | -  Holen/Lesen | | +| | -  Löschen | | +| | | | +| | -  Verzeichnis | | +| | -  Drucken | | +| | | +---------------------+ | +| | i  Initialisieren | | Dateiaustausch mit:| | +| | z  Zieltask einstellen | | Archiv | | +| +------------------------+ | Archivname: | | +| | __________ | | +| +---------------------+ | +|-----------------------------------------------------------------------| +| Info:/ Wahl: Ausführen: Verlassen: | ++-----------------------------------------------------------------------+ + +#center#Abb.31:  Menubildschirm zum Oberbegriff 'Archiv' + + +In diesem Kapitel werden alle die Menufunktionen beschrieben, die Ihnen unter dem +Oberbegriff 'Archiv' im Menu angeboten werden. Mit den Funktionen in diesem Menu +können Sie aber nicht nur Dateien auf dem Archiv behandeln, sondern auch in +anderen Tasks im Multi-User-System oder über das EUMEL-Netz sogar auf anderen +Rechnern! + +Wenn Sie dieses Pull-Down-Menu gerade aufgeschlagen haben, sind nicht alle Funk­ +tionen aktivierbar! Um weitere Funktionen zu aktivieren, muß erst einer der aktivier­ +baren Menupunkte gewählt werden. +#page# +#on("b")#r   Reservieren#off("b")# (des Archivlaufwerks) + + Im EUMEL-Multi-User-System haben normalerweise mehrere Personen das + Zugriffsrecht auf das Archivlaufwerk. Allerdings muß der Zugriff so geregelt + werden, daß sich die Beteiligten dabei nicht gegenseitig "in die Quere + kommen". Ein Zugriff auf das Archivlaufwerk erfordert zunächst eine An­ + meldung. Ist diese Anmeldung erfolgt, kann von den anderen Beteiligten so + lange nicht mehr auf das Laufwerk zugegriffen werden, bis es wieder freige­ + geben worden ist. + + Diese Anmeldung des Archivlaufwerkes erfolgt über die Menufunktion 'r Reser­ + vieren'. Greift bereits eine andere Task auf das Laufwerk zu, so erhalten Sie + darüber einen Hinweis auf dem Bildschirm. Ansonsten wird an Sie die Frage + gestellt, ob die Diskette eingelegt und das Laufwerk geschlossen ist. + + Erst zu diesem Zeitpunkt ist sichergestellt, daß Sie den alleinigen Zugriff auf + das Laufwerk haben. Deshalb sollten Sie, wenn Sie mit mehreren Personen am + Computer arbeiten, erst zum Zeitpunkt der Fragestellung die Diskette ins + Laufwerk einlegen. + + Nachdem Sie die Diskette eingelegt und die Frage bejaht haben, ermittelt das + System selbständig den Namen der eingelegten Diskette, zeigt den Namen auf + dem Bildschirm (im kleinen Kasten unten) an und aktiviert die anderen + Menupunkte des Pull-Down-Menus. + + Beim Verlassen des Pull-Down-Menus, wenn eine andere Zieltask eingestellt + wird oder wenn das Menu gänzlich verlassen wird, wird die Reservierung + automatisch aufgehoben! +#page# + Fehlerfälle: + - Das Laufwerk ist von einer anderen Task belegt. + - Die Diskette ist falsch eingelegt oder das Laufwerk ist nicht richtig ge­ + schlossen. + - Die Diskette ist nicht formatiert bzw. initialisiert. + - Die Diskette kann nicht gelesen werden (keine EUMEL-Diskette, Diskette + hat ein falsches Format, Diskette ist verschmutzt...). + + +#on("b")#n   Neue Diskette#off("b")# (anmelden) + + Der Dateiaustausch mit einer Diskette ist nur dann möglich, wenn der im + System eingestellte Diskettenname (auf dem Bildschirm im kleinen Kasten + unten sichtbar) mit dem tatsächlichen Namen der Diskette übereinstimmt. + Nach einem Diskettenwechsel ist das aber in der Regel nicht mehr der Fall. + Greift man dann auf die neu eingelegte Diskette zu, so erscheint die Fehlermel­ + dung: 'Falscher Archivname! Bitte neue Diskette anmelden!'. + + Das Anmelden einer neuen Diskette - ohne einen neuen Reservierungsvorgang + - wird durch diese Menufunktion ermöglicht. Nach Aktivieren dieses Menu­ + punktes wird der Name der eingelegten Diskette ermittelt, im System eingestellt + und auf dem Bildschirm angezeigt. + + Im Gegensatz zur Menufunktion 'r Reservieren' greift das System ohne Anfrage + an den Benutzer auf das Archivlaufwerk zu (die Reservierung bleibt ja + bestehen). Ist das Archivlaufwerk reserviert, so ist die Neuanmeldung einer + Diskette über diese Menufunktion weniger zeitaufwendig. + + Fehlerfälle: + - wie unter 'r Reservieren'. +#page# +#on("b")#s   Schreiben#off("b")# (Kopieren) + + Alle Dateien der eigenen Task werden zur Auswahl angeboten. Wenn Sie die + Auswahl durch die Tastenfolge verlassen, überprüft das System + zunächst, ob die Dateien in der eingestellten Zieltask schon vorhanden sind. Ist + das der Fall, wird erfragt, ob die dort vorhandenen Dateien überschrieben, d.h. + gelöscht werden dürfen (s.u.). Anschließend werden alle angekreuzten Dateien + in der Reihenfolge, in der Sie sie angekreuzt haben, in die eingestellte Zieltask + kopiert. Der Vorgang wird auf dem Bildschirm protokolliert. Die Original­ + dateien in der eigenen Task bleiben dabei erhalten. + + Wenn in der Zieltask schon eine Datei existiert, die den gleichen Namen hat + wie eine Datei, die Sie dorthin kopieren möchten, so wird angefragt, ob die + vorher schon existierende Datei überschrieben (gelöscht!) werden soll. Bejahen + Sie diese Frage, so wird die bereits in der Zieltask existierende Datei (un­ + wiederbringlich) gelöscht und die gewünschte Datei dorthin transportiert. Ein + Überschreiben aus Versehen ist nicht möglich, wenn Sie die an Sie gestellte + Frage sorgfältig beantworten. + + Verneinen Sie die Frage, so wird die Datei auch nicht hinübertransportiert! Sie + können die Datei aber umbenennen (Menufunktion 'u Umbenennen' unter + den Oberbegriffen 'Landschaft'/Arbeitsfeld' bzw. 'Programm') und an­ + schließend mit anderem Namen hinüberschreiben. + + Beachten Sie, daß beim Überschreiben einer Datei auf einer Archivdiskette der + Speicherplatz der alten (überschriebenen) Version im allgemeinen nicht + wiederverwendet werden kann. In einem solchen Fall könnte die Diskette voll + geschrieben werden, obwohl eigentlich genügend Platz vorhanden wäre. Zur + Optimierung wird deshalb zuerst überprüft, ob die angekreuzten Dateien + schon in der Zieltask vorhanden sind und löscht diese, wenn Sie Ihr Einver­ + ständnis geben. Erst anschließend werden die Dateien insgesamt kopiert. +#page# + Normalerweise ist als Zieltask das Archivlaufwerk der eigenen Station einge­ + stellt. Mit der Menufunktion 'z Zieltask einstellen' kann diese Einstellung aber + verändert werden. + + Fehlerfälle: + - Die Diskette ist falsch eingelegt oder beschädigt. + - Die Diskette kann nicht beschrieben werden (Schreibfehler). + - Die Diskette ist voll. + - Sehen Sie auch unter 'r Reservieren' + 'z Zieltask einstellen'. + + +#on("b")#c   Checken#off("b")# + + Diese Menufunktion kann nur ausgeführt werden, wenn der Dateiaustausch + mit einem Archiv(manager) erfolgt - ansonsten ist diese Menufunktion auch + nicht aktivierbar. Die Menufunktion dient dazu, auf Diskette geschriebene + Dateien auf Lesefehler hin zu prüfen. Es empfiehlt sich, diese Prüfroutine auf + neu auf die Diskette geschriebene Dateien anzuwenden. Sehen Sie dazu auch + 'k Kombination'. + + Alle Dateien der eingestellten Zieltask (Archiv) werden zur Auswahl angeboten. + Wenn Sie die Auswahl durch die Tastenfolge verlassen, werden + alle angekreuzten Dateien in der Reihenfolge, in der Sie sie angekreuzt haben, + "gecheckt", d.h. auf Lesefehler hin überprüft. Der Vorgang wird auf dem Bild­ + schirm protokolliert. + + Fehlerfälle: + - Lesefehler auf dem Archiv. + - Sehen Sie auch unter 'r Reservieren'. + +#page# +#on("b")#k   Kombination#off("b")# + + Diese Menufunktion ist eine Kombination aus den beiden Menufunktionen 's + Schreiben' und 'c Checken' (Sehen Sie weitere Informationen auch dort!). + + Alle Dateien der eigenen Task werden zur Auswahl angeboten. Wenn Sie die + Auswahl durch die Tastenfolge verlassen, werden alle ange­ + kreuzten Dateien in der Reihenfolge, in der Sie sie angekreuzt haben, in die + eingestellte Zieltask kopiert (gegebenenfalls müssen bereits vorhandene + Dateien gleichen Namens in der Zieltask gelöscht werden). Anschließend + werden alle Dateien, die gerade geschrieben wurden, gecheckt, d.h. auf Lese­ + fehler hin untersucht. Beide Vorgänge werden auf dem Bildschirm + protokolliert. + + Da die 'Check' - Operation nur bei Archivmanagern zulässig ist, ist diese Menu­ + funktionen ebenfalls nur bei Archivmanagern aktivierbar. Zur Erläuterung + sehen Sie bitte auch unter 'z Zieltask einstellen'. + + +#on("b")#h   Holen/Lesen#off("b")# + + Die Menufunktion dient dazu, Dateien, die bereits auf einer Archivdiskette oder + in einer anderen Task existieren, in die eigene Task zu kopieren. + + Alle Dateien der eingestellten Zieltask werden zur Auswahl angeboten. An­ + schließend werden Kopien der angekreuzten Dateien in der Reihenfolge des + Ankreuzens in die eigene Task geholt. Das Original in der Zieltask bleibt dabei + unverändert! Der Vorgang wird auf dem Bildschirm protokolliert. + + Sind in der eigenen Task schon Dateien mit gleichem Namen vorhanden, so + wird gefragt, ob die 'alten' Dateien überschrieben (gelöscht) werden dürfen. + Nur wenn Sie zustimmen, werden die in Ihrer Task existierenden Dateien + (unwiederbringlich!) gelöscht und Kopien der gleichnamigen Dateien aus der + Zieltask angefertigt. +#page# + Stimmen Sie dem Löschvorgang nicht zu, dann bleiben die bisherigen Dateien + in Ihrer Task erhalten - die Dateien aus der Zieltask werden dann aber auch + nicht in Ihre Task kopiert! Um dennoch die Kopien zu erhalten, können Sie die + namensgleichen Dateien in Ihrer Task umbenennen und dann erst die Dateien + aus der anderen Task anfordern. + + Normalerweise werden die Dateien vom Archiv der eigenen Station geholt. Mit + dem Menupunkt 'z Zieltask einstellen' kann diese Einstellung verändert + werden. + + Fehlerfälle: + - Lesefehler auf dem Archiv. + - Sehen Sie auch unter 'r Reservieren' + 's Schreiben' + 'z Zieltask einstellen'. + + +#on("b")#l   Löschen#off("b")# + + Die Menufunktion dient dazu, Dateien in der Zieltask (unwiederbringlich!) zu + löschen. Dazu werden alle Dateien der eingestellten Zieltask zur Auswahl ange­ + boten. Anschließend werden die angekreuzten Dateien in der Reihenfolge ihres + Ankreuzens gelöscht. Zur Sicherheit muß noch einmal für jede einzelne Datei + bestätigt werden, daß sie auch tatsächlich gelöscht werden soll. + + Beachten Sie, daß beim Löschen einer Datei auf einer Archivdiskette der + Speicherplatz im allgemeinen nicht wieder verwendet werden kann. In einem + solchen Fall könnte die Diskette voll geschrieben werden, obwohl eigentlich + genügend Platz vorhanden wäre. Diese Probleme treten bei anderen Tasks, die + keine Archivmanager sind, nicht auf, da deren Speicherplatz intelligenter + verwaltet wird. +#page# + Normalerweise ist als Zieltask das Archiv der eigenen Station eingestellt. Mit + dem Menupunkt 'z Zieltask einstellen' kann diese Einstellung verändert + werden. + + Fehlerfälle: + - Sehen Sie auch unter 'r Reservieren' + 's Schreiben' + 'z Zieltask einstellen'. + + +#on("b")#v   Verzeichnis#off("b")# + + Mit dieser Menufunktion können Sie sich einen Überblick über die in der + Zieltask (z.B. auf dem Archiv) vorhandenen Dateien verschaffen. + + Nach Aufruf der Funktion wird eine Liste der Dateien auf dem Bildschirm + ausgegeben, die sich in der Zieltask (z.B. auf dem Archiv) befinden. Ist die + Zieltask ein Archiv(manager), so wird auch angezeigt, wieviel Platz auf der + Diskette belegt ist. Da die Liste selbst eine Datei ist, kann sie mit der Tasten­ + kombination verlassen werden. Falls nicht alle Dateinamen auf + den Bildschirm passen, können Sie das Fenster mit und + verschieben. + + Fehlerfälle: + - Sehen Sie unter 'z Zieltask einstellen'. + + +#on("b")#d   Drucken#off("b")# + + Das Verzeichnis der Dateien in der Zieltask, das man mit der Menufunktion 'v + Verzeichnis' auf dem Bildschirm angezeigt bekommt, kann mit dieser Menu­ + funktion ausgedruckt werden. +#page# + Zur Sicherheit wird angefragt, ob wirklich ein solches Dateiverzeichnis der + Zieltask gedruckt werden soll. Bejaht man die Frage, so wird ein Dateiver­ + zeichnis erstellt und zum Drucker geschickt. + + Fehlerfälle: + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' betrieben. + - Auf Ihrem System werden die Druckkosten abgerechnet. Sie müssen sich + mit einer Codenummer identifizieren. + + +#on("b")#i  Initialisieren#off("b")# + + Diese Menufunktion gestattet es, frische Disketten zu formatieren, zu + initialisieren bzw. beschriebene Disketten vollständig zu löschen und ggf. dabei + umzubenennen. Bei Aufruf dieser Menufunktion wird - sofern noch nicht + geschehen - das Archivlaufwerk automatisch reserviert. + + Wenn Sie eine fabrikneue Diskette aus der Verpackung nehmen, müssen Sie + diese zunächst #on("b")#formatieren#off("b")#. Dabei wird die Diskette auf ein festgelegtes + physikalisches Format eingestellt. Ohne daß diese Operation vorausgegangen + ist, kann eine Diskette weder beschrieben noch gelesen werden. + + Prinzipiell braucht eine Diskette nur ein einziges Mal formatiert zu werden. Sie + können Sie jedoch jederzeit wieder formatieren - z.B. wenn Sie Disketten ha­ + ben, von denen Sie nicht genau wissen, für welche Zwecke sie zuvor verwendet + wurden. + + Wenn Sie diese Menufunktion aktivieren, werden Sie so zunächst gefragt, ob Sie + die Diskette auch formatieren wollen. Bejahen Sie die Frage, so werden Ihnen + mehrere Formate zur Auswahl angeboten: +#page# + +----------------------------------+ + | Formatieren einer Diskette | + | | + | Dies sind die möglichen Formate: | + | | + | 1 .... 40 Spur - 360 KB | + | 2 .... 80 Spur - 720 KB | + | 3 .... 5 1/4" - 1,2 MB | + | 4 .... 3 1/2" - 1,4 MB | + | s .... Standard - Format | + | | + | | + | 1   2   3   4   s | + +----------------------------------+ + +#center#Abb.32:  Auswahl der Archiv-Formate + + Erkundigen Sie sich bei Ihrem Händler, welches Format Sie bei Ihrem Rechner + und den von Ihnen verwendeten Disketten einstellen müssen. Manche Rechner + unterstützen diese Operation innerhalb des EUMEL-Systems auch gar nicht, + das Formatieren muß dann irgendwie anders außerhalb des EUMEL-Systems + geschehen. + + Wenn Sie die Formatierung abgeschlossen oder auch übersprungen haben, + beginnt die eigentliche Initialisierung der Diskette. Dabei wird als erstes der + Archivname auf die Diskette geschrieben. Alle alten Daten, die sich ggf. auf der + Diskette befinden, werden bei diesem Vorgang unwiederbringlich (!) gelöscht. + + Zur Sicherheit überprüft das System in jedem Falle, ob es sich um eine EUMEL + - Diskette handelt, und erfragt Ihr Einverständnis, ob die Diskette wirklich + initialisiert werden soll. Geben Sie hierzu Ihr Einverständnis, dann wird noch + der (neue) Archivname erfragt. Hatte die Diskette schon einen Namen, dann + wird dieser zum Überschreiben angeboten. Wollen Sie den alten Archivnamen + beibehalten, so brauchen Sie nur die -Taste zu tippen, ansonsten + können Sie den Namen auch zuvor verändern oder einen ganz neuen Namen + hinschreiben. Anhand des ausgegebenen Namens können Sie auch über­ + prüfen, ob Sie die richtige Diskette eingelegt haben. +#page# + Das Initialisieren funktioniert natürlich nur, wenn Sie als Zieltask einen + Archivmanager eingestellt haben - ansonsten ist diese Menufunktion gesperrt + (nicht aktivierbar!). + + Fehlerfälle: + - Formatieren ist nicht auf dem System möglich. + - Sehen Sie auch unter 'r Reservieren' + 'z Zieltask einstellen'. + + +#on("b")#z   Zieltask einstellen#off("b")# + + Mit dieser Menufunktion können Sie festlegen, mit welcher Zieltask Sie + kommunizieren, d.h. z.B. Dateien austauschen möchten. Normalerweise ist hier + das Archiv am eigenen Rechner eingestellt. Das wird auch nach Aufklappen des + Pull-Down-Menus im Kasten unten angezeigt. + + Diese Menufunktion kann im Unterricht z.B. dazu genutzt werden, um fertig­ + gestellte Hausaufgaben in eine bestimmte Task zu schicken (Vatertask) oder um + von dort z.B. vorgefertigte Landschaften oder/und Programme abzuholen. + + Sie können aber auch eine andere Task einstellen (z.B. die Vatertask oder die + Task 'PUBLIC'), um mit diesen Dateien auszutauschen oder um sich auch nur + einen Überblick über die dort vorhandenen Dateien zu verschaffen. Wenn Sie + mit Ihrem Rechner in ein EUMEL-Netz integriert sind, können Sie auch auf + Tasks anderer Rechner zugreifen oder auch Disketten von Laufwerken anderer + Rechner einlesen (z.B. wenn Sie Disketten anderer Formate haben, die von + Ihrem Rechner nicht gelesen werden können). + + Dabei werden zwei Anforderungen an die Zieltask gestellt: Sie muß existieren + und bereit für den Dateiaustausch sein, d.h es muß eine Managertask sein, auf + die Sie Zugriff haben. Versuchen Sie auf andere Tasks zuzugreifen, so erhalten + Sie entsprechende (Fehler-)Meldungen. +#page# + Zu beachten ist noch, daß es im EUMEL-System verschiedene Arten von + Managertasks gibt - Archivmanager und normale Dateimanager. Der Unter­ + schied besteht darin, daß ein Archivmanager vom Benutzer vor dem Zugriff + reserviert werden muß - anschließend hat nur dieser Benutzer (bis zur Aufgabe + der Reservierung) ein Zugriffsrecht auf den Manager. Normale Dateimanager + können dagegen von mehreren Benutzern in beliebiger Reihenfolge ange­ + sprochen werden. + + Ein Archivmanager kann auch auf bestimmte Diskettenformate spezialisert sein + (z.B. auf das Lesen von DOS-Disketten). Manche Rechner haben auch mehrere + Archivmanager für verschiedene Laufwerke etc. Durch Einstellen unterschied­ + licher Archivmanager können Sie dann auf verschiedenen Laufwerken + archivieren. + + Nach Aktivieren dieses Menupunktes werden Ihnen die folgenden Alternativen + angeboten: + + + +-----------------------------------------+ + | Dateiaustausch gewünscht mit: | + | | + | a ...   Archiv (Eigene Station) | + | | + | v ...   Vatertask | + | | + | p ...   'PUBLIC' (Eigene Station) | + | | + | s ...   Sonstige Task | + | | + | Archiv   Vatertask   PUBLIC   Sonstige | + +-----------------------------------------+ + +#center#Abb.33:  Auswahl der Zieltask + + Da der Dateiaustausch mit dem Standardarchiv der eigenen Station (Task: + 'ARCHIVE'), mit der Vatertask und der Task 'PUBLIC' recht häufig in Anspruch + genommen wird, sind diese drei Optionen unter den Alternativen direkt ange­ +#page# + geben. Entscheiden Sie sich für eine dieser drei Tasks, so nimmt das System + alle notwendigen Einstellungen vor. Möchten Sie dagegen in Kontakt mit einer + anderen Task treten, so wählen Sie die Alternative 's ... Sonstige Task'. In + diesem Falle haben Sie noch 3 Angaben zu machen: + + - Zunächst werden Sie nach dem Namen der Zieltask gefragt. Geben Sie den + Namen der Zieltask - ohne Anführungsstriche (!) - ein und schließen Sie + die Eingabe mit der -Taste ab. (Den ausgegebenen Namen der + z.Z. eingestellten Task können Sie dabei verändern bzw. überschreiben.) + + - Dann wird die Nummer der Station im EUMEL-Netz erfragt, auf der sich + die Zieltask befindet. Die Nummer Ihrer Station wird als Vorschlag ausge­ + geben. Wollen Sie mit einer Task auf Ihrem Rechner kommunizieren, so + brauchen Sie diesen Vorschlag nur durch Drücken der -Taste + bestätigen - ansonsten tragen Sie zuvor die entsprechende Stationsnummer + ein. Ist Ihr Rechner nicht in ein EUMEL-Netz integriert, so wird die + Stationsnummer 0 (Null) ausgegeben. Bitte bestätigen Sie diese Stations­ + nummer durch Tippen der -Taste. + + - Zum Abschluß müssen Sie noch angeben, ob die eingestellte Zieltask ein + Archivmanager ist oder nicht. + + Das System versucht dann den Kontakt herzustellen. Je nachdem, welche + Einstellung Sie vorgenommen haben, sind bestimmte Funktionen innerhalb + des Menus nicht aktivierbar. Das System läßt nur die Funktionen zu, die + aufgrund Ihrer Einstellungen zulässig sind. + + Im Kasten unten auf dem Bildschirm wird jeweils angezeigt, welche Zieltask + eingestellt ist. Erscheint in diesem Kasten auch ein Hinweis auf den Archiv­ + namen, so haben Sie einen Archivmanager eingestellt. Ist dagegen vor dem + Namen der Zieltask noch eine Zahl und ein Schrägstrich angegeben, so haben + Sie eine Zieltask auf einem anderen Rechner eingestellt. +#page# + Bedenken Sie, daß Operationen mit Tasks auf anderen Stationen länger an­ + dauern können - werden Sie nicht ungeduldig! + + Sie können die Einstellung der Zieltask jederzeit wieder verändern! + + Fehlerfälle: + - Die eingestellte Zieltask existiert nicht. + - Die eingestellte Zieltask existiert zwar, ist aber nicht empfangsbereit, d.h. + ein Zugriff von Ihrer Task aus ist nicht möglich! + - Das Netz ist nicht funktionsbereit (Collector-Task fehlt). + - Die Kommunikation war nicht erfolgreich. + - Die gewünschte Operation kann mit der eingestellten Zieltask nicht ausge­ + führt werden (Zieltask ist z.B. gar kein Archivmanager - Sie aber ver­ + suchen, das Laufwerk zu reservieren). + diff --git a/app/gs.process/1.02/doc/gs-prozess-8 b/app/gs.process/1.02/doc/gs-prozess-8 new file mode 100644 index 0000000..c36ccc9 --- /dev/null +++ b/app/gs.process/1.02/doc/gs-prozess-8 @@ -0,0 +1,377 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#8  Detailbeschreibung der Basisbefehle und Tests#off("b")# + + +#on("b")# +BOOL PROC abbruch gewuenscht +#off("b")# + + - erfragt, ob inzwischen durch einen Basisbefehl die Tastenfolge + im Eingabestrom registriert worden ist. Ist das der Fall, liefert die Prozedur + den Wert 'TRUE', sonst 'FALSE'. + + +#on("b")# +BOOL PROC bit ist gesetzt (INT CONST kanal, bitnummer) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine digitale Ein­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Digital-Eingabe möglich!". + - untersucht, ob die angegebene Bitnummer zulässig ist (0 #on("b")#<#off("b")# 'bitnummer' #on("b")#<#off("b")# + 7). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehlermeldung "Bit­ + nummer ... ist nicht zulässig!". + - liest den aktuell anliegenden Wert am angegebenen Kanal. + - liefert den Wert 'TRUE', wenn in der binären Darstellung das Bit mit der + angegebenen Bitnummer gesetzt ist ("I"), sonst den Wert 'FALSE'. + +#on("b")# +TEXT PROC bitmuster (INT CONST kanal) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". +#page# + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine digitale Ein­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Digital-Eingabe möglich!". + - liest den aktuell anliegenden Wert am angegebenen Kanal ein und wandelt + ihn in die binäre Darstellung. + - liefert einen Text der Länge 8, bestehend aus den Zeichen "I" und/oder "O". + + +#on("b")# +PROC bitmuster ausgeben (INT CONST kanal, + TEXT CONST bitmuster) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine digitale Aus­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Digital-Ausgabe möglich!". + - untersucht die übergebene Zeichenkette (bitmuster) auf korrekte Länge (8 + Zeichen). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehlermeldung + "Das Bitmuster ... hat eine unzulässige Länge!". + - überprüft die in der übergebenen Zeichenkette (bitmuster) vorkommenden + Symbole auf ihre Zulässigkeit ("I", "O", "X", "T"). Taucht ein unzulässiges + Symbol auf, erfolgt ein Abbruch mit der Fehlermeldung "... ist ein unzu­ + lässiges Bitsymbol in ...!". +#page# + - aus dem am angegebenen Kanal zuletzt ausgegeben Wert und der über­ + gebenen Zeichenkette (bitmuster) wird der auszugebende Dezimalwert er­ + mittelt. Dieser Dezimalwert wird am angegebenen Kanal ausgegeben. Dabei + bedeuten "I", daß das betreffende Bit gesetzt wird,  "O", daß das betreffende + Bit nicht gesetzt wird,  "X", daß das betreffende Bit gegenüber der zuvor + erfolgten Ausgabe am gleichen Kanal nicht verändert wird und   "T", daß das + betreffende Bit gegenüber der zuvor erfolgten Ausgabe am gleichen Kanal + invertiert wird. + + +#on("b")# +BOOL PROC bitmuster gleich (INT CONST kanal, + TEXT CONST vergleichsmuster) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine digitale Ein­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Digital-Eingabe möglich!". + - untersucht die übergebene Zeichenkette (bitmuster) auf korrekte Länge (8 + Zeichen). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehlermeldung + "Das Bitmuster ... hat eine unzulässige Länge!". + - überprüft die im 'vergleichsmuster' vorkommenden Symbole auf ihre Zu­ + lässigkeit ("I", "O", "X"). Taucht ein unzulässiges Symbol auf, erfolgt ein + Abbruch mit der Fehlermeldung "... ist ein unzulässiges Bitsymbol in ...!". + - liest den aktuell anliegenden Wert am angegebenen Kanal ein und wandelt + ihn in die binäre Darstellung. + - überprüft, ob das eingelesene Bitmuster zum 'vergleichsmuster' "paßt". Ist + das der Fall, wird der Wert 'TRUE' geliefert, sonst der Wert 'FALSE'. +#page# +#on("b")# +TEXT PROC bitsymbol (INT CONST kanal, bitnummer) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine digitale Ein­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Digital-Eingabe möglich!". + - untersucht, ob die angegebene Bitnummer zulässig ist (0 #on("b")#<#off("b")# 'bitnummer' #on("b")#<#off("b")# + 7). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehlermeldung "Bit­ + nummer ... ist nicht zulässig!". + - liest den aktuell anliegenden Wert am angegebenen Kanal ein und wandelt + ihn in die binäre Darstellung. + - liefert einen Text der Länge 1, nämlich "I" oder "O". + + +#on("b")# +PROC bitsymbol ausgeben (INT CONST kanalnummer, bitnummer, + TEXT CONST bitsymbol) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine digitale Aus­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Digital-Ausgabe möglich!". +#page# + - untersucht, ob die angegebene Bitnummer zulässig ist (0 #on("b")#<#off("b")# 'bitnummer' #on("b")#<#off("b")# + 7). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehlermeldung "Bit­ + nummer ... ist nicht zulässig!". + - überprüft das übergebene Bitsymbol auf Zulässigkeit ("I", "O", "X", "T"). + Taucht ein unzulässiges Symbol auf oder besteht das Bitsymbol aus mehr als + einem Zeichen, erfolgt ein Abbruch mit der Fehlermeldung "... ist ein unzu­ + lässiges Bitsymbol!". + - ermittelt aus dem am angegebenen Kanal zuletzt ausgegeben Wert und der + übergebenen Bitnummer/dem übergebenen Bitsymbol den auszugebende + Dezimalwert. Dieser Dezimalwert wird am angegebenen Kanal ausgegeben. + Dabei bedeuten "I", daß das betreffende Bit gesetzt wird,  "O", daß das be­ + treffende Bit nicht gesetzt wird,  "X", daß das betreffende Bit gegenüber der + zuvor erfolgten Ausgabe am gleichen Kanal nicht verändert wird und  "T", daß + das betreffende Bit gegenüber der zuvor erfolgten Ausgabe am gleichen Kanal + invertiert wird. + + +#on("b")# +INT PROC dezimalwert (INT CONST kanal) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine digitale Ein­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Digital-Eingabe möglich!". + - liest den aktuell anliegenden Wert am angegebenen Kanal ein. + - liefert einen INT-Wert mit  0 #on("b")#<#off("b")# 'wert' #on("b")#<#off("b")# 255. +#page# +#on("b")# +PROC dezimalwert ausgeben (INT CONST kanal, wert) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine digitale Aus­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Digital-Ausgabe möglich!". + - ermittelt den auszugebenden Wert durch die Rechnung +#on("b")# +#center#ausgabe = wert MOD 256, +#off("b")# + und gibt diesen am angegebenen Kanal aus. + + +#on("b")# +PROC initialisiere interface +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob das Programm korrekt (mit 'run pdv') gestartet wurde. Ist das + nicht der Fall, erfolgt ein Abbruch mit der Fehlermeldung "PDV-Programme + müssen mit 'run pdv' gestartet werden!". Dieser Fehler kann nicht auftreten, + wenn die Programme vom #on("b")#gs-Prozess#off("b")#-Menu gestartet werden! + - An jeden Digitalausgang des angeschlossenen Interface-Systems wird der Wert + '0', an jeden Analogausgang eine "Nullspannung" angelegt (d.h. alles wird + "ausgeschaltet"). Die internen Variablen werden dabei initialisiert. +#page# +#on("b")# +PROC spannungswert (INT CONST kanal) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine analoge Ein­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Analog-Eingabe möglich!". + - ermittelt die laut Konfiguration aktuelle Obergrenze (u max) und Untergrenze + (u min) des Spannungsbereiches am angegebenen Analogeingang. + - liest den aktuell anliegenden Wert (0 #on("b")#<#off("b")# 'wert' #on("b")#<#off("b")# 255) am angegebenen + Kanal ein und wandelt ihn nach folgender Rechnung: + +#on("b")# + real(wert) * (u max - u min) + lieferwert = ---------------------------- + u min + 255.0 + +#off("b")# + - liefert einen REAL-Wert mit  u min #on("b")#<#off("b")# 'lieferwert' #on("b")#<#off("b")# u max, gerundet auf drei + Nachkommastellen. + + +#on("b")# +PROC spannungswert ausgeben (INT CONST kanal, + REAL CONST spannung) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". +#page# + - untersucht, ob am angegebenen Kanal laut Konfiguration eine analoge Aus­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Analog-Ausgabe möglich!". + - ermittelt die laut Konfiguration aktuelle Obergrenze (u max) und Untergrenze + (u min) des Spannungsbereiches am angegebenen Analogausgang und prüft, + ob  u min #on("b")#<#off("b")# 'spannung' #on("b")#<#off("b")# u max. Ist das nicht der Fall, erfolgt ein Abbruch + mit der Fehlermeldung 'Der Spannungswert ... ist nicht zulässig!". + - wandelt die angegebene 'spannung' nach der Rechnung: + +#on("b")# + (wert - u min) * 255.0 + ausgabewert = int ( ---------------------- + 0.5 ) + u max - u min + +#off("b")# + - gibt den ermittelten 'ausgabewert' am angegebenen Kanal aus. + + +#on("b")# +REAL PROC temperatur (REAL CONST spannungswert) +#off("b")# + + - errechnet aus dem Spannungswert, der vom Temperaturfühler eingelesen + wurde, der Thermometerkonstanten und der Minimaltemperatur die + Temperatur in �C. + - liefert einen REAL-Wert (die Temperatur in �C). + So nur anwendbar auf den Temperaturfühler der Fa. AKTRONIK! + + +#on("b")# +PROC tue nichts +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. +#page# +#on("b")# +PROC warte (INT CONST sekunden) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - wirkt sonst wie 'pause (sekunden * 10)'. + + +#on("b")# +PROC warte (REAL CONST sekunden) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - wirkt sonst wie 'pause (int (sekunden * 10.0 + 0.5))'. + + +#on("b")# +PROC wert an analogausgang ausgeben (INT CONST kanal, wert) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine analoge Aus­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Analog-Ausgabe möglich!". + - ermittelt den auszugebenden Wert durch die Rechnung + +#on("b")# +#center#ausgabe = wert MOD 256, + +#off("b")# + und gibt diesen Wert am angegebenen Kanal aus. Die am Analogausgang + auszugebende Spannung wird vom D/A-Wandler des Interface-Systems er­ + mittelt. +#page# +#on("b")# +INT PROC wert von analogeingang (INT CONST kanal) +#off("b")# + + - untersucht, ob inzwischen die Tastenfolge eingegeben wurde. + Ist das der Fall, dann erfolgt ein Abbruch mit der Fehlermeldung + "Programm-Abbruch durch !". + - registriert, ob inzwischen die Tastenfolge eingegeben wurde. + - untersucht, ob die angegebene Kanalnummer grundsätzlich zulässig ist (1 #on("b")#<#off("b")# + 'kanal' #on("b")#<#off("b")# 49). Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "Kanalnummer ... ist unzulässig!". + - untersucht, ob am angegebenen Kanal laut Konfiguration eine analoge Ein­ + gabe möglich ist. Ist das nicht der Fall, erfolgt ein Abbruch mit der Fehler­ + meldung "An Kanal ... ist keine Analog-Eingabe möglich!". + - liefert den vom A/D-Wandler des Interface-Systems gelieferten Wert mit 0 #on("b")#<#off("b")# + 'lieferwert' #on("b")#<#off("b")# 255. + diff --git a/app/gs.process/1.02/doc/gs-prozess-9 b/app/gs.process/1.02/doc/gs-prozess-9 new file mode 100644 index 0000000..6551b01 --- /dev/null +++ b/app/gs.process/1.02/doc/gs-prozess-9 @@ -0,0 +1,477 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (1)# +#headodd# +#center#gs-Prozess#right#% + +#end# +#headeven# +%#center#gs-Prozess + +#end# +#center#1 + +#on("b")#9  Hinweise für den Systembetreuer/   Programmierer#off("b")# + +Sie haben wahrscheinlich bisher - ausschließlich zu Testzwecken - mit nur einem +Interface-System gearbeitet. In diesem Kapitel möchten wir Ihnen Vorschläge +machen, wie Sie Ihr Tasksystem organisieren können, um möglichst effektiv und +störungsfrei mit der vorhandenen Hardware zu arbeiten. + +Neben den Möglichkeiten der Organisation des Systems werden wir Ihnen zeigen, wie +Sie eine einmal vorgenommene Konfiguration/Organisation "fixieren", d.h. schützen +können. + +Im letzten Teil dieses Kapitels werden wir für den #on("b")#routinierten(!) Programmierer#off("b")#, +Möglichkeiten aufzeigen, wie man, unter weitgehender Umgehung von #on("b")#gs-Prozess#off("b")#, +Programme für spezielle Anwendungen entwickeln kann. Schon an dieser Stelle sei +ausdrücklich gesagt, daß dabei alle "Sicherheiten", die #on("b")#gs-Prozess#off("b")# normalerweise +bietet, nicht (mehr) vorhanden sind. + + +#on("b")#9.1  Vergabe der Kanäle/Organisation des Tasksystems#off("b")# + +Zur optimalen Organisation Ihres Systems sollten Sie wissen, in welcher Task die +Konfiguration sinnvollerweise vorzunehmen ist. Da die Aspekte sehr vielfältig sind, +werden wir verschiedene Situationen beschreiben. Lesen Sie die Ausführungen zu der +Situation, die der Ihren am ehesten entspricht. + + +#on("b")# +1) Es stehen mehrere MUFIs als Adapter zur Verfügung. Alle MUFIs sollen + im Terminalkanal betrieben werden. Die Arbeitsplätze sind alle mit + dem gleichen Interfacesystem ausgestattet. +#off("b")# +#page# + Sie sind hervorragend ausgestattet. Die Organisation und Konfiguration des + Systems ist sehr einfach: + + Es ist sinnvoll, die Konfiguration von #on("b")#gs-Prozess#off("b")# in der Task vorzunehmen, in + der Sie #on("b")#gs-Prozess#off("b")# installiert haben. Das hat den Vorteil, daß alle Sohntasks, + die sich anschließend anmelden, diese Konfiguration "erben". + + Bei dieser Ausstattung ist es sinnvoll die Konfiguration zu "fixieren", um irrtüm­ + lichen oder "böswilligen" Umkonfigurationen vorzubeugen. Sehen Sie dazu + Kapitel 9.4. + + +#on("b")# +2) Es stehen mehrere MUFIs als Adapter zur Verfügung. Alle MUFIs sollen + im Terminalkanal betrieben werden. Die Arbeitsplätze sind aber mit + verschiedenen Interface-Systemen ausgestattet. +#off("b")# + + Wenn die Bestückung der einzelnen Arbeitsplätze ständig wechselt, ist es nicht + sinnvoll, eine generelle Konfiguration vorzugeben. Teilen Sie jedem Anwender + mit, daß er selbst für die Konfiguration seines Systems zuständig ist. Er sollte bei + jedem Neuankoppeln seiner Task zumindest die Konfiguration überprüfen und + ggf. den Vorgaben entsprechend eine Anpassung vornehmen. Es ist nicht sinn­ + voll, die jeweilige Konfiguration zu fixieren. + + Wenn Sie zwar unterschiedliche Interface-Systeme verwenden, aber die Inter­ + face-Systeme einzelnen MUFIs eindeutig zuordnen können, lohnt es sich schon, + eine Konfiguration des Systems vorzugeben. + + Richten Sie zu diesem Zwecke so viele Tasks ein, wie Sie unterschiedliche + Interface-Systeme zur Verfügung haben, und ordnen Sie jedem Interface-System + eindeutig je eine Task zu. Die Namen der Tasks sollten Sie so wählen, daß sofort + ersichtlich ist, welchem Interface-System sie zugeordnet ist. + + Nehmen Sie in jeder Task eine Konfiguration von #on("b")#gs-Prozess#off("b")# entsprechend + dem zugeordneten Interface-System vor. +#page# + Auch hier ist es sinnvoll, die vorgenommenen Konfigurationen zu "fixieren", um + irrtümlichen oder "böswilligen" Umkonfigurationen vorzubeugen. Sehen Sie + dazu Kapitel 9.4. + + Die Anwender sollten sich später jeweils als Sohntask der Task anmelden, die + sich dem an ihrem Arbeitsplatz vorhandenen Interface-System eindeutig zu­ + ordnen läßt. + + +#on("b")# +3) Es steht nur ein MUFI als Adapter zur Verfügung. Das MUFI soll im + Terminalkanal betrieben werden. +#off("b")# + + Je nachdem, ob Sie eine feste Hardware am MUFI betreiben oder nicht, sollten + Sie sich an den beiden zuvor beschriebenen Fällen orientieren. + + +#on("b")# +4) Es steht nur ein RS232-Adapter oder ein MUFI, das als Endgerät an + einer separaten Schnittstelle betrieben werden soll, zur Verfügung. Es + soll nur von einem Arbeitsplatz/einer Task aus mit dem angeschlos­ + senen Interface-System gearbeitet werden. +#off("b")# + + Nehmen Sie die Installation/Konfiguration wie unter 5) beschrieben vor. + Arbeiten Sie nur in der Task, in der Sie die Konfiguration vorgenommen haben. + + +#on("b")# +5) Es steht nur ein Adapter zur Verfügung. Sie wollen aber die Möglichkeit + schaffen, daß von verschiedenen Tasks abwechselnd darauf zugegriffen + werden kann. +#off("b")# + + Es ist gleichgültig, ob Sie ein MUFI oder einen RS232-Adapter verwenden - sie + sollten den Adapter an einer separaten seriellen Schnittstelle betreiben. +#page# + Auch wenn Sie ein MUFI besitzen, kann es vorteilhaft sein, das MUFI nicht im + Terminalkanal, sondern an einer separaten Schnittstelle zu betreiben: + + Beim Betrieb im Terminalkanal kann nämlich nur die Task mit dem MUFI + kommunizieren, die an das Terminal gekoppelt ist, in dessen Zuleitung das + MUFI eingebaut ist. Das wird hier zum Nachteil, denn wenn eine andere Task + auf das Interface-System zugreifen möchte, muß erst die alte Task abgekoppelt + und die neue an das Terminal mit dem MUFI angekoppelt werden. + + Der Betrieb an einer separaten Schnittstelle bietet hier wahrscheinlich viel­ + fältigere Möglichkeiten, wenngleich Sie dadurch auch Geschwindigkeitsein­ + bußen hinnehmen müssen. + + #on("b")#gs-Prozess#off("b")# bietet Ihnen bei Betrieb eines Adapters an einer separaten seriellen + Schnittstelle nämlich die Möglichkeit, abwechselnd von verschiedenen Tasks auf + den Adapter und das angeschlossene Interface-System zugreifen zu können. + + Teilen Sie bei der Installation (automatischen Generierung) von #on("b")#gs-Prozess#off("b")# + dem System gleich mit, daß Sie Ihren Adapter (ob nun MUFI oder + RS232-Adapter) an einer separaten seriellen Schnittstelle betreiben wollen. + Schon bei dieser Installation werden Sie nach der Kanalnummer gefragt. + + Wir gehen hier davon aus, daß Sie immer mit dem gleichen Interface-System an + diesem Adapter arbeiten werden. In diesem Falle empfiehlt es sich, gleich in der + Task, in der Sie die Installation vorgenommen haben, auch die Konfiguration + von #on("b")#gs-Prozess#off("b")# vorzunehmen und die Konfiguration zu "fixieren". Durch die + Konfiguration in dieser Task, "erben" alle Sohntasks, die anschließend ange­ + meldet werden, diese Konfiguration. + + Wenn Sie sich mit 'taskinfo ' einen Katalog ausgeben lassen, + werden Sie feststellen, daß eine weitere Task als unbenannter Sohn ("-") Ihrer + Task eingerichtet worden ist. Sie haben nämlich Ihre Task zu einer "zentralen + Abwicklungstask" gemacht - genauer gesagt die unbenannte Sohntask. +#page# + Wenn Sie aus Ihrer Task, in der Sie die Konfiguration vorgenommen haben, mit + dem Interface-System kommunizieren, erfolgt der Zugriff über diese unbe­ + nannte Sohntask! + + Sie schaffen dadurch aber zusätzlich die Möglichkeit, daß mehrere Sohntasks - + natürlich abwechselnd - über diese "zentrale Abwicklungstask" mit dem Inter­ + face-System kommunizieren. Selbstverständlich setzt der Zugriff auf das Inter­ + face-System eine Absprache zwischen den Beteiligten voraus! + + + Gerade in der Aufbauphase, wenn erst wenige Geräte zur Verfügung stehen, ist + das eine Möglichkeit, von verschiedenen Arbeitsplätzen aus mit nur einem Adap­ + ter/Interface-System Prozeßdatenverarbeitung zu betreiben. + + +#on("b")# +6) Sie wollen mehrere Adapter an separaten seriellen Schnittstellen + betreiben. +#off("b")# + + In diesem Falle ist es sinnvoll - bevor Sie eine Konfiguration vornehmen - gleich + nach der Installation von #on("b")#gs-Prozess#off("b")# für jeden einzelnen Adapter eine Sohntask + unter der Task einzurichten, in der #on("b")#gs-Prozess#off("b")# installiert ist. Jede dieser Sohn­ + tasks koppeln Sie mit einem festen Kanal, an dem ein Adapter/Interface-System + angeschlossen ist. + + Sie brauchen dazu #on("b")#gs-Prozess#off("b")# nicht mehrfach zu installieren; wir haben für + diesen Fall vorgesorgt. Für die Kopplung der Tasks an die einzelnen Kanäle steht + die Prozedur 'PROC interfacekanal (INT CONST kanalnummer)' zur Verfügung. + Geben Sie also in einer Task z.B. das Kommando 'interfacekanal (5) + ', so wird von dieser Task aus das Interface-System am Kanal 5 + angesprochen. + + Über die Prozedur 'INT PROC interfacekanal' können Sie sich in jeder Task + informieren, über welchen Kanal die Kommunikation mit dem Interface-System + abgewickelt wird: z.B. mit 'put (interfacekanal) '. +#page# + Ihnen ist sicher klar, daß es auch hier sinnvoll ist, den Namen der jeweiligen + Task so zu wählen, daß daraus sofort der betreffende Interfacekanal ablesbar + ist. + + In jeder so an einen Kanal gekoppelten Task sollten Sie die Konfiguration von + #on("b")#gs-Prozess#off("b")# vornehmen und ggf. "fixieren". Jede solche Task richtet auto­ + matisch eine unbenannte Sohntask ("-") ein, die sich wie eine "zentrale Ab­ + wicklungstask" verhält. Wenn Sie also aus Ihrer Task oder aus neu einge­ + richteten Sohntasks mit dem Interface-System kommunizieren, so erfolgt das + über die "zentrale Abwicklungstask". + + +#on("b")#9.2  Informationsprozeduren#off("b")# + +Zur Information stehen dem Systembetreuer drei wichtige Prozeduren zur Verfügung: + +#on("b")# +TEXT PROC adapterart +#off("b")# + +Hiermit können Sie in Erfahrung bringen, welche Interfaceanpassung z.Z. in der +aktuellen Task insertiert ist: MUFI im Terminalkanal, MUFI als Endgerät oder +AKTRONIK-Adapter (RS232-Adapter). + + +#on("b")# +INT PROC interfacekanal +#off("b")# + +Hiermit können Sie in Erfahrung bringen, über welchen Kanal z.Z. mit dem Inter­ +face-System aus der Task kommuniziert wird. Die Prozedur steht allerdings nur dann +zur Verfügung, wenn das Interface-System an einer separaten Schnittstelle betrieben +wird - sonst erscheint der Hinweis 'FEHLER: unbekanntes Kommando'. + +Es gibt noch einen Befehl, mit dem Sie sich über den Zustand des Interface-Systems +informieren können: +#page# +#on("b")# +PROC oeffne interface (INT VAR testwert) +#off("b")# + +Die Prozedur versucht, die aktuelle Betriebsart einzustellen. Anschließend erhalten +Sie eine 'Erfolgsauskunft'. Dabei bedeuten: + + 0 - alles okay + -1 - Interface ist noch nicht konfiguriert + -2 - Interface-Task ist besetzt + -3 - Interfacekanal ist belegt + -4 - Interface meldet sich nicht + -5 - Interface kann nicht geöffnet werden + +Ist der Adapter an einer separaten Schnittstelle angeschlossen, so arbeitet der Befehl +über die "zentrale Abwicklungstask". Als Antwort können alle genannten Codes auftre­ +ten; beim MUFI im Terminalkanal allerdings nur die Codes 0, -1 und -4. Die oben +genannten Fehlermeldungen sind detailliert in Kapitel 5.5 erläutert. + +Sie sollten anschließend #on("b")#unbedingt#off("b")# das Kommando 'schliesse interface' geben: Eine +eventuell durch 'oeffne interface' vollzogene Betriebsartumstellung wird dadurch +rückgängig gemacht. + + + +#on("b")#9.3  Neufestlegung des Interfacekanals#off("b")# + +Wenn Sie mit MUFI(s) im Terminalkanal arbeiten, spielen Kanalnummern für das +Ansprechen des/der MUFIs keine Rolle. Das jeweilige MUFI kann in diesem Falle +nämlich immer nur von der Task aus angesprochen werden, die an das Terminal +gekoppelt ist, in dessen Zuleitung das MUFI eingebaut wurde. + +Wenn Sie Adapter (MUFI oder RS232-Adapter) an separaten seriellen Schnittstellen +betreiben, so legen Sie schon bei der Installation von #on("b")#gs-Prozess#off("b")# den Kanal fest, +über den die Task mit dem Interface-System kommuniziert. Wie wir schon oben be­ +schrieben haben, können Sie den Interface-Kanal mit der Prozedur 'PROC interface­ +kanal (INT CONST kanalnummer)' neu festlegen. Beachten Sie dabei aber bitte +folgendes: +#page# +Wenn Sie in einer Task #on("b")#gs-Prozess#off("b")# konfigurieren und zuvor entschieden haben, daß +der Adapter an einer separaten Schnittstelle betrieben wird, so wird automatisch eine +unbenannte Sohntask ("-") eingerichtet. Diese Sohntask wird zur "zentralen Abwick­ +lungstask". Wenn Sie nun aus der Task, in der Sie die Konfiguration vorgenommen +haben, oder aus einer Sohntask dieser Task, die anschließend eingerichtet wird, mit +dem Interface-System kommunizieren, so erfolgt diese Kommunikation über diese +unbenannte Sohntask. Daher wählten wir die Bezeichnung "zentrale Abwicklungs­ +task". + +Da die "zentrale Abwicklungstask" den "Zustand der Vatertask" in dem Augenblick +erbt, in dem Sie eingerichtet wird, würde eine später erfolgende Neufestlegung des +Interfacekanals nicht von Ihr registriert und damit auch nicht wirksam. + +#on("b")#Es ist unbedingt notwendig#off("b")#, in der Task, in der Sie eine Neufestlegung des Interface- +Kanals vornehmen, #on("b")#gs-Prozess#off("b")# auch neu zu konfigurieren! Bei der Neukonfiguration +wird nämlich die unbenannte Sohntask gelöscht und neu eingerichtet. + +(Das hier beschriebene Phänomen ist Ihnen wahrscheinlich schon aus der +PRINTER-Task bekannt). + +Hinsichtlich der Sicherheit des Systems hat dieses Vorgehen aber einen Vorteil: wenn +in den "zugänglichen Sohntask", die über eine "zentrale Abwicklungstask" mit dem +Interface-System kommunizieren eine Neueinstellung des Interface-Kanals vorge­ +nommen wird, so bleibt diese unwirksam (solange in der Sohntask nicht umkonfigu­ +riert wird - was sich aber verhindern läßt! Sehen Sie dazu das folgende Kapitel!). + + +#on("b")#9.4  Fixieren der Konfiguration#off("b")# + +Prinzipiell kann in jeder Task, in der #on("b")#gs-Prozess#off("b")# zur Verfügung steht, die Konfigura­ +tion (von #on("b")#gs-Prozess#off("b")#) vorgenommen werden. Gerade von unerfahrenen Anwendern +könnte aber irrtümlich eine Umkonfiguration vorgenommen werden. Aber nicht nur +das: auch erfahrene Anwender könnten "böswillig" die Konfiguration verändern. Aus +diesem Grunde ist es ggf. sinnvoll, eine vorgenommene Konfiguration zu fixieren +(schützen). +#page# +Dazu steht die Prozedur 'PROC pdv konfiguration zugelassen (BOOL CONST ent­ +scheidung)' zur Verfügung. Mit dem Kommando 'pdv konfiguration zugelassen +(FALSE) ' sperren Sie in der aktuellen Task und in allen Sohntasks, die +sich #on("b")#anschließend#off("b")# unter dieser Task anmelden, den Menupunkt 'k Konfigurieren' +unter dem Oberbegriff 'Interface'. + +Sofern nötig, können Sie diese Sperre mit dem Kommando 'pdv konfiguration zuge­ +lassen (TRUE) ' wieder aufheben, #on("b")#allerdings nur in der Task, in der Sie +auch die Sperre gesetzt haben#off("b")#, denn #on("b")#gs-Prozess#off("b")# merkt sich diesen Tasknamen! +Wenn Sie also ein Password auf diese Task legen, und damit anderen den Zugang +verwehren, kann auch eine "böswilligie Umkonfiguration" verhindert werden. + + +#on("b")#9.5  Mögliche Fehlerfälle#off("b")# + +Wenn Fehlermeldungen auftreten, so finden Sie Fehlerbeschreibungen und Möglich­ +keiten zur Abhilfe im Kapitel 5.5 beschrieben. Auf einen Fehlerzustand möchten wir +Sie hier noch besonders hinweisen: + +#on("b")#Interfacekanal ist belegt!#off("b")# + + Über den angegebenen Kanal greift schon eine andere Task auf das angeschlos­ + sene Interface-System zu. Vielleicht wurde der betreffende Kanal auch zuvor für + andere Zwecke verwendet - anschließend hat der Benutzer den Kanal nicht + ordentlich freigegeben. Geben Sie in der 'gib kommmando'-Ebene den Befehl + 'taskinfo (2) '. In der Spalte mit der Überschrift 'CHAN' müßte jetzt + irgendwo die Kanalnummer auftauchen. Steht die Kanalnummer bei einem Sohn + der Task 'SUPERVISOR', so liegt der letztgenannte Fall vor, sonst der erstge­ + nannte. + + Abhilfe: Schließen Sie Ihr Interface-System an einen anderen Kanal an oder + bitten Sie den betreffenden Anwender, den Kanal freizugeben. + Ist das nicht möglich, so kann aus einer Systemtask das Kommando + 'end (canal (kanalnummer))' ' gegeben werden. Statt + 'kanalnummer' ist natürlich die tatsächliche Nummer (z.B. '4') + anzugeben. +#page# +#on("b")#9.6  Weitere Möglichkeiten#off("b")# + +Ihnen ist sicher aufgefallen, daß wir uns bemüht haben, einen sinnvollen Kompro­ +miß zwischen Sicherheit in der Handhabung und Geschwindigkeit des Systems zu +finden. In Zweifelsfällen haben wir uns eher zugunsten der Sicherheit entschieden. + +Sicher werden Sie inzwischen bemerkt haben, daß die Kommunikation mit einem +Adapter (MUFI oder RS232-Adapter) an einer separaten seriellen Schnittstelle recht +zeitaufwendig ist. + +Prinzipiell standen uns bei der Konzeption zwei Möglichkeiten zur Verfügung: Ent­ +weder wir gestalten jeden Basisbefehl so, daß wir uns zu Beginn der Ausführung +jeweils direkt an den betreffenden Kanal ankoppeln und am Ende der Ausführung +des Befehls wieder abkoppeln - oder wir richten eine "zentrale Abwicklungstask" ein +und nutzen die Intertaskkommunikation des EUMELs. Wir haben uns nach diversen +Tests für die zweite Variante entschieden: Einmal zeigte sich, daß dieses Verfahren +weit weniger zeitaufwendig ist als das ständige An- und Abkoppeln an den Interface- +Kanal. Zum anderen konnten wir so die Möglichkeit schaffen, über diese "zentrale +Abwicklungstask" den abwechselnden, koordinierten Zugriff mehrerer Tasks auf ein +Interface-System zu realiseren. + +Wenn Sie nun aber spezielle Anwendungen schreiben wollen, für die die Geschwin­ +digkeit beim Ansprechen des Interface-Systems an einer separaten Schnittstelle nicht +ausreicht, so möchten wir Ihnen hier noch eine Möglichkeit aufzeigen, dieses +Problem zu bewältigen. + +Auch an dieser Stelle sei noch einmal ausdrücklich darauf hingewiesen, daß Sie bei +dieser Programmiermöglichkeit auf alle Sicherheiten, die Ihnen #on("b")#gs-Prozess#off("b")# bietet, +verzichten müssen. Deshalb sollten Sie diesen Weg nur beschreiten, wenn Sie ein +hinlängliches Maß an Programmierroutine besitzen! Die zur Verfügung stehenden +Befehle und die Besonderheiten möchten wir Ihnen an einem kleinen Beispiel­ +programm aufzeigen: +#page# +#on("b")# + LET ausgabekanal = 4, + eingabekanal = 3; + + INT VAR test, eingabewert; + INT VAR terminalkanal :: channel (myself); + schliesse interface; + continue (interfacekanal); + oeffne interface direkt (test); + IF test < 0 + THEN continue (terminalkanal); + errorstop ("Funktionsfehler Interface-System") + FI; + initialisiere interface direkt; + eigentliches programm; + schliesse interface direkt; + continue (terminalkanal). + + eigentliches programm: + direkt ausgeben (ausgabekanal, 3); + eingabewert := direkteingabe (eingabekanal). +#off("b")# + +Wenn Sie ein solches Programm geschrieben haben, starten Sie es bitte mit dem +Befehl 'run pdv' oder aus dem Menusystem heraus mit der Menufunktion 's Starten'. +(Bei 'run' kann der Befehl 'schliesse interface' gestrichen werden!). + +Für die eigentliche Programmierung des Interface-Systems stehen Ihnen nur zwei +Befehle zur Verfügung: + +#on("b")# +PROC direkt ausgeben (INT CONST kanal, wert) +#off("b")# + + - ermittelt den auszugebenden Wert durch die Rechnung + +#on("b")##center#ausgabe = wert MOD 256#off("b")# + + und gibt diesen am Ausgabekanal aus. + + Der Befehl ähnelt dem Befehl 'dezimalwert ausgeben' - hat aber im Gegensatz + dazu keinerlei "Fehlerfänger": so werden Sie z.B. nicht darauf aufmerksam + gemacht, wenn der angegebene Kanal gar kein Ausgang ist, etc.) +#page# +#on("b")# +INT PROC direkteingabe (INT CONST kanal) +#off("b")# + + - liest den aktuell anliegenden Wert am angegebenen Kanal ein. + - liefert einen INT-Wert mit 0 � 'wert' � 255. + + Der Befehl ähnelt dem Befehl 'dezimalwert' - hat aber im Gegensatz dazu + ebenfalls keinerlei "Fehlerfänger"! + + +Das obige Programm beginnt mit dem Befehl 'schliesse interface'. Sicher kommt es +Ihnen sonderbar vor, daß zu Beginn des Programms das Interface geschlossen wird, +wo wir es doch eigentlich "öffnen" müßten. Ihnen wird die Funktion aber sofort klar, +wenn Sie sich die Situation vor Augen führen: + +Als Sie #on("b")#gs-Prozess#off("b")# in Ihrer Task konfiguriert haben, und festlegten, daß der Adapter +an einer separaten Schnittstelle "hängt", richtete #on("b")#gs-Prozess#off("b")# automatisch eine +unbenannte Sohntask ("-") als "zentrale Abwicklungstask" ein, die durch das +Kommando 'run pdv' bzw. durch die Menufunktion 's Starten' an den Interfacekanal +gekoppelt wird. Der Befehl 'schliesse interface' koppelt die Task "-" wieder vom Inter­ +face-Kanal ab, so daß Sie direkt darauf zugreifen können. Außerdem werden die +internen Einstellungen im Adapter wieder in Ausgangsstellung gebracht. + +Mit der Prozedur 'PROC oeffne interface direkt (INT VAR testwert)' sprechen Sie das +Interface neu an. Dabei wird ein angeschlossener Adapter automatisch auf Betriebs­ +bereitschaft getestet und dann auf den Betrieb an einer separaten seriellen Schnitt­ +stelle umgestellt (nur beim MUFI). + +Über 'testwert' erhalten Sie eine Rückmeldung. Dabei haben die gelieferten 'test­ +werte' folgende Bedeutung: + + 0 - Interface betriebsbereit + -4 - Interface #on("b")#nicht#off("b")# betriebsbereit + (Interface meldet sich nicht) +#page# +Der Befehl 'initialisiere interface direkt' wirkt ähnlich wie der schon oben be­ +schriebene Befehl 'initialisiere interface', jedoch #on("b")#nicht#off("b")# über den "Umweg zentrale +Abwicklungstask" - sondern halt 'direkt' am Interface-Kanal. Einzige Aufgabe hier: +Alle Ausgabe-Kanäle auf Wert '0' bzw. Nullspannung setzen. + +Durch das abschließende 'schliesse interface direkt' bringen Sie ein angeschlossenes +MUFI wieder in die "Ausgangsstellung". + +Beachten Sie bei der Programmierung bitte unbedingt, daß Sie ständig zwischen dem +Kanal, an dem Sie arbeiten (Terminal) und dem Interfacekanal hin- und herschalten +(müssen), wenn Ein- oder Ausgaben auf dem Terminal erfolgen sollen. Die direkte +Programmierung lohnt sich demnach nur, wenn aufeinanderfolgende Aktionen am +Interfacekanal durchgeführt werden (z.B. Schrittmotorsteuerungen etc.). + +Treten Programmfehler auf, während Sie an den Interfacekanal gekoppelt sind, +haben Sie keine Chance, von Ihrem Terminalkanal aus auf das Interface zuzugreifen +- denn das "hängt am Interfacekanal" (z.B. bei "Programmabsturz" oder Endlos­ +schleife). + +Bei Ihrer Programmierung sollten Sie diesem Fall vorbeugen (disable stop - enable +stop). Ansonsten müßten Sie aus einer Systemtask den Kanal "abschießen". Geben +Sie dazu in einer Systemtask z.B. das Kommando 'end (canal (5)) ', +wenn das Interface-System über den Kanal 5 angesprochen wird. + diff --git a/app/gs.process/1.02/source-disk b/app/gs.process/1.02/source-disk new file mode 100644 index 0000000..df52516 --- /dev/null +++ b/app/gs.process/1.02/source-disk @@ -0,0 +1 @@ +informatikpaket/04_gs.propess.img diff --git a/app/gs.process/1.02/src/ls-MENUKARTE:Prozess b/app/gs.process/1.02/src/ls-MENUKARTE:Prozess new file mode 100644 index 0000000..9a2e009 Binary files /dev/null and b/app/gs.process/1.02/src/ls-MENUKARTE:Prozess differ diff --git "a/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r AKTRONIC-Adapter" "b/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r AKTRONIC-Adapter" new file mode 100644 index 0000000..c42cfa5 --- /dev/null +++ "b/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r AKTRONIC-Adapter" @@ -0,0 +1,57 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Prozess 1 ** + ** ** + ** Anpassung für AKTRONIC-Adapter ** + ** ** + ** Version 1.02 ** + ** ** + ** (Stand : 26.01.90) ** + ** ** + ** ** + ** Autoren: Bruno Pollok, Bielefeld ** + ** Wolfgang Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ********************************************************** + ********************************************************** + + *) +PACKET ls prozess 1 DEFINES + run pdv,{} run pdv again,{} initialisiere interface,{} schalte alles aus,{} ausgeben,{} eingabe,{} warte,{} abbruch gewuenscht,{} tue nichts,{} trage kanaldaten ein,{} beende kanaldaten eintragen,{} hole spannungsbereich,{} letzte ausgabe,{} pruefe kanal,{} pruefe abbruch,{} teste interface,{} oeffne interface,{} schliesse interface,{} nicht belegt,{} digital aus,{} analog aus,{} + digital ein,{} analog ein,{} kanalbreite,{} ganzzahl obergrenze,{} adapterart,{} (* ------------------------- *){} kanalkoppler,{} interface kanal,{} oeffne interface direkt,{} schliesse interface direkt,{} initialisiere interface direkt,{} direkt ausgeben,{} direkt eingabe:{}(******** A N P A S S U N G A N A K T R O N I C - A D A P T E R ********){}LET interface test code = ""240"",{} interface open code = ""176"",{} + interface close code = ""176"",{} adresse 0 code = ""176"",{} interface write code = 64 ,{} interface read code = 192 ;{}TEXT CONST adapterart :: "AKTRONIC-Adapter";{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{} IF es ist ein ausgabekanal{} THEN code (interface write code + device + faktor * steuerungscode){} ELIF es ist ein eingabekanal{} THEN lesecode in abhaengigkeit von der taktzahl{} ELSE ""{} FI.{} es ist ein ausgabekanal:{} + kanal [kanalnummer].betriebsart < 0.{} es ist ein eingabekanal:{} kanal [kanalnummer].betriebsart > 0.{} device:{} IF steckplatznummer < 3{} THEN 16{} ELSE 32{} FI.{} faktor:{} IF steckplatznummer MOD 2 = 0{} THEN 4{} ELSE 1{} FI.{} steckplatznummer:{} IF kanalnummer < 10{} THEN 1{} ELSE kanalnummer DIV 10{} FI.{} lesecode in abhaengigkeit von der taktzahl:{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1: code fuer digital oder analog eingang{} + CASE 2: code fuer kombi e1{} CASE 3: code fuer kombi e2{} OTHERWISE "" END SELECT.{} code fuer digital oder analog eingang:{} IF kanal [kanalnummer].betriebsart = analog ein{} THEN kanal [kanalnummer].taktzahl := 2; (* ad wandler muss hier *){} lesecode + lesecode (* 2x gelesen werden! *){} ELSE lesecode{} FI.{} lesecode : code (interface read code + device + faktor * steuerungscode).{} code fuer kombi e1:{} kanal [kanalnummer].taktzahl INCR 1; (* bei Analogport1 der Kombikarte *){} + adresse 0 code + (3 * lesecode). (* sind hier 3 Takte noetig ! *){} code fuer kombi e2:{} kanal [kanalnummer].taktzahl DECR 1; (* hier nur 2 Takte noetig ! *){} adresse 0 code + lesecode + lesecode.{}END PROC interface anpassung;{}(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************){}LET max kanalanzahl = 49,{} initcode = 50,{} endcode = 51,{} alles aus code = 52,{} + endezeichen = "q",{} abbruchzeichen = "h",{} esc = ""27"";{}INT CONST analog aus :: -2, (* Betriebsarten *){} digital aus :: -1,{} nicht belegt :: 0,{} digital ein :: 1,{} analog ein :: 2,{} kanalbreite :: 8,{} ganzzahl obergrenze :: 2 ** kanalbreite,{} configuration error code :: -1,{} + kanal besetzt code :: -3,{} interface error code :: -4,{} not init code :: -5;{}INT VAR interfacechannel :: 2,{} dummy;{}TEXT VAR meldung :: "";{}BOOL VAR kanaldaten sind eingetragen :: FALSE,{} endezeichen gegeben :: FALSE,{} programm mit pdv gestartet :: FALSE,{} fehler zu melden :: FALSE;{}TASK VAR interface task :: niltask;{}DATASPACE VAR ds :: nilspace;{} +TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode),{} SPANNUNG = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT VAR vorherige ausgabe;{}ROW max kanalanzahl KANAL VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT :{} ("Interface ist noch nicht konfiguriert!",{} "Interface-Task ist besetzt!",{} "Interface-Kanal ist belegt!",{} "Interface meldet sich nicht!",{} "Interface kann nicht geöffnet werden!");{} +PROC run pdv:{} run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{} enable stop;{} last param (programmname);{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run (programmname);{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv;{}PROC run pdv again:{} + enable stop;{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run again;{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv again;{}PROC melde programmende:{} page;{} menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{} pause;{} schalte alles aus{}END PROC melde programmende;{} +PROC initialisiere interface:{} enable stop;{} pruefe abbruch;{} IF programm mit pdv gestartet{} THEN schalte alles aus{} ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){} FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{} INT VAR k;{} FOR k FROM 1 UPTO max kanalanzahl REP{} vorherige ausgabe [k] := 0{} PER;{} forget (ds); ds := nilspace;{} call (interface task, alles aus code, ds, dummy){}END PROC schalte alles aus;{}PROC ausgeben (INT CONST kanalnummer, wert):{} + merke wert;{} gib wert aus.{} merke wert:{} vorherige ausgabe [kanalnummer] := wert.{} gib wert aus:{} call (interface task, 256 * kanalnummer + wert, ds, dummy).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{} INT VAR eingabewert;{} call (interface task, kanalnummer, ds, eingabewert);{} eingabewert{}END PROC eingabe;{}PROC warte (REAL CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (int (sekunden * 10.0 + 0.5));{} IF eingabe = esc{} + THEN untersuche naechstes zeichen{} FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (sekunden * 10);{} IF eingabe = esc{} THEN untersuche naechstes zeichen{} + FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}BOOL PROC abbruch gewuenscht:{} pruefe abbruch;{} BOOL VAR entscheidung :: endezeichen gegeben;{} endezeichen gegeben := FALSE;{} entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{} + pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST kanalnummer,{} ROW 2 REAL CONST spannungsbereich,{} ROW 3 INT CONST kanalparameter):{} spannung [kanalnummer].minimalwert := spannungsbereich [1];{} spannung [kanalnummer].maximalwert := spannungsbereich [2];{} kanal [kanalnummer].betriebsart := kanalparameter [1];{} kanal [kanalnummer].taktzahl := kanalparameter [2];{} kanal [kanalnummer].steuercode := interface anpassung{} + (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{} loesche interface task;{} begin (PROC kanal koppler, interface task);{} kanaldaten sind eingetragen := TRUE.{} loesche interface task:{} disable stop;{} end (interface task);{} IF is error{} THEN clear error{} FI;{} enable stop.{}END PROC beende kanaldaten eintragen;{}PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max):{} + u min := spannung [kanalnummer].minimalwert;{} u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{} vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{} pruefe abbruch;{} pruefe kanalnummer;{} pruefe betriebsart.{} pruefe kanalnummer:{} IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{} THEN errorstop ("Kanalnummer " + text (kanalnummer) +{} + " ist unzulaessig !"){} FI.{} pruefe betriebsart:{} IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{} THEN errorstop ("An Kanal " + text (kanalnummer) +{} " keine " + wunsch + " moeglich!"){} FI.{} wunsch:{} IF gewuenschte betriebsart = analog aus{} THEN "Analog-Ausgabe"{} ELIF gewuenschte betriebsart = digital aus{} THEN "Digital-Ausgabe"{} ELIF gewuenschte betriebsart = digital ein{} THEN "Digital-Eingabe"{} + ELIF gewuenschte betriebsart = analog ein{} THEN "Analog-Eingabe"{} ELSE "Ein- oder Ausgabe"{} FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{} IF incharety = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} TEXT CONST zeichen :: incharety (30);{} IF zeichen = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF zeichen = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + abbruchzeichen + ">!"){} + FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{} enable stop;{} forget (ds); ds := nilspace;{} IF kanaldaten sind eingetragen{} THEN pingpong (interfacetask, initcode, ds, status){} ELSE status := configuration error code{} FI;{} IF status > 0 THEN status DECR maxint FI;{} forget (ds); ds := nilspace{}END PROC oeffne interface;{}PROC schliesse interface:{} enable stop;{} forget (ds); ds := nilspace;{} pingpong (interface task, end code, ds, dummy);{} forget (ds); ds := nilspace{} +END PROC schliesse interface;{}PROC teste interface:{} INT VAR test;{} oeffne interface (test);{} IF test < 0{} THEN errorstop (fehlermeldung [min (5, abs (test))]){} ELSE fehler zu melden := FALSE;{} endezeichen gegeben := FALSE{} FI{}END PROC teste interface;{}PROC fehlerbehandlung:{} meldung := errormessage;{} IF meldung <> ""{} THEN meldung CAT fehlerzeile;{} fehler zu melden := TRUE{} FI;{} clear error;{} initialisiere interface.{} fehlerzeile:{} + IF errorline = 0{} THEN ""{} ELSE " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlerbehandlung;{}(******************** EIN-/AUSGABE AM INTERFACE-KANAL ********************){}PROC kanalkoppler:{} IF name (myself) <> "-"{} THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} TASK VAR absender;{} TEXT VAR dummy;{} INT VAR codenummer, antwort;{} disable stop;{} REP forget (ds);{} wait (ds, codenummer, absender);{} + IF codenummer = initcode{} THEN kopple an interface kanal;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} FI;{} gib kanal frei{} ELSE antwort := not init code;{} gib negative rueckmeldung{} FI{} PER.{} kopple an interface kanal:{} continue (interface channel);{} IF is error{} THEN clear error;{} antwort := kanal besetzt code{} + ELSE oeffne interface direkt (antwort){} FI.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei:{} break (quiet);{} send (absender, 0, ds, antwort);{} collect heap garbage.{} bearbeite weitere auftraege:{} REP call (absender, antwort, ds, codenummer);{} IF codenummer > 255{} THEN sende wert an interface{} ELIF codenummer < 50{} THEN hole wert von interface{} ELIF codenummer = alles aus code{} + THEN initialisiere interface direkt{} FI{} UNTIL codenummer = endcode PER;{} IF is error THEN clear error FI;{} schliesse interface direkt.{} sende wert an interface:{} out (kanal [codenummer DIV 256].steuercode);{} out (code (codenummer)).{} hole wert von interface:{} out (kanal [codenummer].steuercode);{} SELECT kanal [codenummer].taktzahl OF{} CASE 1 : antwort := erstes zeichen{} CASE 2 : antwort := zweites zeichen{} CASE 3 : antwort := drittes zeichen{} + OTHERWISE antwort := -1{} END SELECT.{} erstes zeichen:{} code (incharety (1)).{} zweites zeichen:{} dummy := incharety (1);{} code (incharety (1)).{} drittes zeichen:{} dummy := incharety (1);{} dummy := incharety (1);{} code (incharety (1)).{}END PROC kanalkoppler;{}PROC interface kanal (INT CONST kanalnummer):{} enable stop;{} IF kanalnummer < 1 OR kanalnummer > 24{} THEN errorstop ("Unzulaessige Kanalnummer"){} ELSE interface channel := kanalnummer{} + FI{}END PROC interface kanal;{}INT PROC interface kanal:{} interface channel{}END PROC interface kanal;{}PROC oeffne interface direkt (INT VAR status):{} leere puffer;{} out (interface test code);{} IF antwort <> ""{} THEN status := 0;{} out (interface open code){} ELSE status := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} antwort: incharety (1).{}END PROC oeffne interface direkt;{}PROC schliesse interface direkt:{} out (interface close code){} +END PROC schliesse interface direkt;{}PROC initialisiere interface direkt:{} schalte alles aus.{} schalte alles aus:{} INT VAR kanalnummer, kanalbetriebsart;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} kanalbetriebsart := kanal [kanalnummer].betriebsart;{} IF kanalbetriebsart = digital aus{} THEN direkt ausgeben (kanalnummer, 0){} ELIF kanalbetriebsart = analog aus{} THEN direkt ausgeben (kanalnummer, gewandelte nullspannung){} FI{} + PER.{} gewandelte nullspannung:{} int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{} u max : spannung [kanalnummer].maximalwert.{} u min : spannung [kanalnummer].minimalwert.{}END PROC initialisiere interface direkt;{}PROC direkt ausgeben (INT CONST kanalnummer, wert):{} out (kanal [kanalnummer].steuercode);{} out (code (wert)){}END PROC direkt ausgeben;{}INT PROC direkt eingabe (INT CONST kanalnummer):{} gib lesecode aus;{} erhaltene antwort.{} gib lesecode aus:{} + out (kanal [kanalnummer].steuercode).{} erhaltene antwort:{} TEXT VAR dummy;{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1 : erstes zeichen{} CASE 2 : zweites zeichen{} CASE 3 : drittes zeichen{} OTHERWISE -1{} END SELECT.{} erstes zeichen:{} code (incharety (1)).{} zweites zeichen:{} dummy := incharety (1);{} code (incharety (1)).{} drittes zeichen:{} dummy := incharety (1);{} dummy := incharety (1);{} code (incharety (1)).{} +END PROC direkt eingabe;{}PROC initialisiere die kanaele:{} INT VAR kanalnummer;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{} vorherige ausgabe [kanalnummer] := 0{} PER.{} keine spannung:{} ROW 2 REAL : (0.0, 0.0).{} leere karte:{} ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{}initialisiere die kanaele;{}END PACKET ls prozess 1{} + diff --git "a/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r MUFI als Endger\303\244t" "b/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r MUFI als Endger\303\244t" new file mode 100644 index 0000000..4d2a5f4 --- /dev/null +++ "b/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r MUFI als Endger\303\244t" @@ -0,0 +1,57 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Prozess 1 ** + ** ** + ** Anpassung für MUFI als Endgerät ** + ** ** + ** Version 1.02 ** + ** ** + ** (Stand : 26.01.90) ** + ** ** + ** ** + ** Autoren: Bruno Pollok, Bielefeld ** + ** Wolfgang Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ********************************************************** + ********************************************************** + + *) +PACKET ls prozess 1 DEFINES + run pdv,{} run pdv again,{} initialisiere interface,{} schalte alles aus,{} ausgeben,{} eingabe,{} warte,{} abbruch gewuenscht,{} tue nichts,{} trage kanaldaten ein,{} beende kanaldaten eintragen,{} hole spannungsbereich,{} letzte ausgabe,{} pruefe kanal,{} pruefe abbruch,{} teste interface,{} oeffne interface,{} schliesse interface,{} nicht belegt,{} digital aus,{} analog aus,{} + digital ein,{} analog ein,{} kanalbreite,{} ganzzahl obergrenze,{} adapterart,{} (* ------------------------- *){} kanalkoppler,{} interface kanal,{} oeffne interface direkt,{} schliesse interface direkt,{} initialisiere interface direkt,{} direkt ausgeben,{} direkt eingabe:{}(******************** A N P A S S U N G A N M U F I ********************){}LET interface test code = ""27""27"10",{} interface okay code = ""27""27"00",{} + interface open code = ""27""27"1A18",{} interface close code = ""25""27""27"13",{} adresse 0 code = ""61"",{} leertakt code = ""62"",{} interface write code = 80 ,{} interface read code = 64 ,{} erwartete zeichen = 4 ;{}TEXT CONST adapterart :: "MUFI als Endgerät";{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{} IF es ist ein ausgabekanal{} THEN code (interface write code + device + 4 * steuerungscode){} ELIF es ist ein eingabekanal{} + THEN lesecode in abhaengigkeit von der taktzahl{} ELSE ""{} FI.{} es ist ein ausgabekanal:{} kanal [kanalnummer].betriebsart < 0.{} es ist ein eingabekanal:{} kanal [kanalnummer].betriebsart > 0.{} device:{} IF kanalnummer < 10{} THEN 0{} ELSE kanalnummer DIV 10 - 1{} FI.{} lesecode in abhaengigkeit von der taktzahl:{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1: lesecode{} CASE 2: adresse 0 code + lesecode + lesecode{} CASE 3: adresse 0 code + lesecode + zwei weitere takte{} + OTHERWISE "" END SELECT.{} lesecode : code (interface read code + device + 4 * steuerungscode).{} zwei weitere takte:{} IF leertakt code = ""{} THEN lesecode + lesecode{} ELSE kanal [kanalnummer].taktzahl DECR 1;{} leertakt code + lesecode{} FI.{}END PROC interface anpassung;{}(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************){}LET max kanalanzahl = 49,{} initcode = 50,{} endcode = 51,{} + alles aus code = 52,{} endezeichen = "q",{} abbruchzeichen = "h",{} esc = ""27"";{}INT CONST analog aus :: -2, (* Betriebsarten *){} digital aus :: -1,{} nicht belegt :: 0,{} digital ein :: 1,{} analog ein :: 2,{} kanalbreite :: 8,{} ganzzahl obergrenze :: 2 ** kanalbreite,{} + configuration error code :: -1,{} kanal besetzt code :: -3,{} interface error code :: -4,{} not init code :: -5;{}INT VAR interfacechannel :: 2,{} dummy;{}TEXT VAR meldung :: "";{}BOOL VAR kanaldaten sind eingetragen :: FALSE,{} endezeichen gegeben :: FALSE,{} programm mit pdv gestartet :: FALSE,{} fehler zu melden :: FALSE;{}TASK VAR interface task :: niltask;{} +DATASPACE VAR ds :: nilspace;{}TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode),{} SPANNUNG = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT VAR vorherige ausgabe;{}ROW max kanalanzahl KANAL VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT :{} ("Interface ist noch nicht konfiguriert!",{} "Interface-Task ist besetzt!",{} "Interface-Kanal ist belegt!",{} "Interface meldet sich nicht!",{} "Interface kann nicht geöffnet werden!");{} +PROC run pdv:{} run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{} enable stop;{} last param (programmname);{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run (programmname);{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv;{}PROC run pdv again:{} + enable stop;{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run again;{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv again;{}PROC melde programmende:{} page;{} menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{} pause;{} schalte alles aus{}END PROC melde programmende;{} +PROC initialisiere interface:{} enable stop;{} pruefe abbruch;{} IF programm mit pdv gestartet{} THEN schalte alles aus{} ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){} FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{} INT VAR k;{} FOR k FROM 1 UPTO max kanalanzahl REP{} vorherige ausgabe [k] := 0{} PER;{} forget (ds); ds := nilspace;{} call (interface task, alles aus code, ds, dummy){}END PROC schalte alles aus;{}PROC ausgeben (INT CONST kanalnummer, wert):{} + merke wert;{} gib wert aus.{} merke wert:{} vorherige ausgabe [kanalnummer] := wert.{} gib wert aus:{} call (interface task, 256 * kanalnummer + wert, ds, dummy).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{} INT VAR eingabewert;{} call (interface task, kanalnummer, ds, eingabewert);{} eingabewert{}END PROC eingabe;{}PROC warte (REAL CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (int (sekunden * 10.0 + 0.5));{} IF eingabe = esc{} + THEN untersuche naechstes zeichen{} FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (sekunden * 10);{} IF eingabe = esc{} THEN untersuche naechstes zeichen{} + FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}BOOL PROC abbruch gewuenscht:{} pruefe abbruch;{} BOOL VAR entscheidung :: endezeichen gegeben;{} endezeichen gegeben := FALSE;{} entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{} + pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST kanalnummer,{} ROW 2 REAL CONST spannungsbereich,{} ROW 3 INT CONST kanalparameter):{} spannung [kanalnummer].minimalwert := spannungsbereich [1];{} spannung [kanalnummer].maximalwert := spannungsbereich [2];{} kanal [kanalnummer].betriebsart := kanalparameter [1];{} kanal [kanalnummer].taktzahl := kanalparameter [2];{} kanal [kanalnummer].steuercode := interface anpassung{} + (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{} loesche interface task;{} begin (PROC kanal koppler, interface task);{} kanaldaten sind eingetragen := TRUE.{} loesche interface task:{} disable stop;{} end (interface task);{} IF is error{} THEN clear error{} FI;{} enable stop.{}END PROC beende kanaldaten eintragen;{}PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max):{} + u min := spannung [kanalnummer].minimalwert;{} u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{} vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{} pruefe abbruch;{} pruefe kanalnummer;{} pruefe betriebsart.{} pruefe kanalnummer:{} IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{} THEN errorstop ("Kanalnummer " + text (kanalnummer) +{} + " ist unzulaessig !"){} FI.{} pruefe betriebsart:{} IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{} THEN errorstop ("An Kanal " + text (kanalnummer) +{} " keine " + wunsch + " moeglich!"){} FI.{} wunsch:{} IF gewuenschte betriebsart = analog aus{} THEN "Analog-Ausgabe"{} ELIF gewuenschte betriebsart = digital aus{} THEN "Digital-Ausgabe"{} ELIF gewuenschte betriebsart = digital ein{} THEN "Digital-Eingabe"{} + ELIF gewuenschte betriebsart = analog ein{} THEN "Analog-Eingabe"{} ELSE "Ein- oder Ausgabe"{} FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{} IF incharety = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} TEXT CONST zeichen :: incharety (30);{} IF zeichen = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF zeichen = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + abbruchzeichen + ">!"){} + FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{} enable stop;{} forget (ds); ds := nilspace;{} IF kanaldaten sind eingetragen{} THEN pingpong (interfacetask, initcode, ds, status){} ELSE status := configuration error code{} FI;{} IF status > 0 THEN status DECR maxint FI;{} forget (ds); ds := nilspace{}END PROC oeffne interface;{}PROC schliesse interface:{} enable stop;{} forget (ds); ds := nilspace;{} pingpong (interface task, end code, ds, dummy);{} forget (ds); ds := nilspace{} +END PROC schliesse interface;{}PROC teste interface:{} INT VAR test;{} oeffne interface (test);{} IF test < 0{} THEN errorstop (fehlermeldung [min (5, abs (test))]){} ELSE fehler zu melden := FALSE;{} endezeichen gegeben := FALSE{} FI{}END PROC teste interface;{}PROC fehlerbehandlung:{} meldung := errormessage;{} IF meldung <> ""{} THEN meldung CAT fehlerzeile;{} fehler zu melden := TRUE{} FI;{} clear error;{} initialisiere interface.{} fehlerzeile:{} + IF errorline = 0{} THEN ""{} ELSE " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlerbehandlung;{}(******************** EIN-/AUSGABE AM INTERFACE-KANAL ********************){}PROC kanalkoppler:{} IF name (myself) <> "-"{} THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} TASK VAR absender;{} TEXT VAR dummy;{} INT VAR codenummer, antwort;{} disable stop;{} REP forget (ds);{} wait (ds, codenummer, absender);{} + IF codenummer = initcode{} THEN kopple an interface kanal;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} FI;{} gib kanal frei{} ELSE antwort := not init code;{} gib negative rueckmeldung{} FI{} PER.{} kopple an interface kanal:{} continue (interface channel);{} IF is error{} THEN clear error;{} antwort := kanal besetzt code{} + ELSE oeffne interface direkt (antwort){} FI.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei:{} break (quiet);{} send (absender, 0, ds, antwort);{} collect heap garbage.{} bearbeite weitere auftraege:{} REP call (absender, antwort, ds, codenummer);{} IF codenummer > 255{} THEN sende wert an interface{} ELIF codenummer < 50{} THEN hole wert von interface{} ELIF codenummer = alles aus code{} + THEN initialisiere interface direkt{} FI{} UNTIL codenummer = endcode PER;{} IF is error THEN clear error FI;{} schliesse interface direkt.{} sende wert an interface:{} out (kanal [codenummer DIV 256].steuercode);{} out (code (codenummer)).{} hole wert von interface:{} out (kanal [codenummer].steuercode);{} SELECT kanal [codenummer].taktzahl OF{} CASE 1 : antwort := erstes zeichen{} CASE 2 : antwort := zweites zeichen{} CASE 3 : antwort := drittes zeichen{} + OTHERWISE antwort := -1{} END SELECT.{} erstes zeichen:{} code (incharety (1)).{} zweites zeichen:{} dummy := incharety (1);{} code (incharety (1)).{} drittes zeichen:{} dummy := incharety (1);{} dummy := incharety (1);{} code (incharety (1)).{}END PROC kanalkoppler;{}PROC interface kanal (INT CONST kanalnummer):{} enable stop;{} IF kanalnummer < 1 OR kanalnummer > 24{} THEN errorstop ("Unzulaessige Kanalnummer"){} ELSE interface channel := kanalnummer{} + FI{}END PROC interface kanal;{}INT PROC interface kanal:{} interface channel{}END PROC interface kanal;{}PROC oeffne interface direkt (INT VAR status):{} leere puffer;{} out (interface test code);{} fange antwort;{} IF antwort = interface okay code{} THEN status := 0;{} out (interface open code){} ELSE status := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} fange antwort:{} INT VAR zaehler;{} TEXT VAR antwort :: "";{} FOR zaehler FROM 1 UPTO erwartete zeichen REP{} + antwort CAT incharety (1){} PER.{}END PROC oeffne interface direkt;{}PROC schliesse interface direkt:{} out (interface close code){}END PROC schliesse interface direkt;{}PROC initialisiere interface direkt:{} schalte alles aus.{} schalte alles aus:{} INT VAR kanalnummer, kanalbetriebsart;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} kanalbetriebsart := kanal [kanalnummer].betriebsart;{} IF kanalbetriebsart = digital aus{} THEN direkt ausgeben (kanalnummer, 0){} + ELIF kanalbetriebsart = analog aus{} THEN direkt ausgeben (kanalnummer, gewandelte nullspannung){} FI{} PER.{} gewandelte nullspannung:{} int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{} u max : spannung [kanalnummer].maximalwert.{} u min : spannung [kanalnummer].minimalwert.{}END PROC initialisiere interface direkt;{}PROC direkt ausgeben (INT CONST kanalnummer, wert):{} out (kanal [kanalnummer].steuercode);{} out (code (wert)){}END PROC direkt ausgeben;{} +INT PROC direkt eingabe (INT CONST kanalnummer):{} gib lesecode aus;{} erhaltene antwort.{} gib lesecode aus:{} out (kanal [kanalnummer].steuercode).{} erhaltene antwort:{} TEXT VAR dummy;{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1 : erstes zeichen{} CASE 2 : zweites zeichen{} CASE 3 : drittes zeichen{} OTHERWISE -1{} END SELECT.{} erstes zeichen:{} code (incharety (1)).{} zweites zeichen:{} dummy := incharety (1);{} code (incharety (1)).{} + drittes zeichen:{} dummy := incharety (1);{} dummy := incharety (1);{} code (incharety (1)).{}END PROC direkt eingabe;{}PROC initialisiere die kanaele:{} INT VAR kanalnummer;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{} vorherige ausgabe [kanalnummer] := 0{} PER.{} keine spannung:{} ROW 2 REAL : (0.0, 0.0).{} leere karte:{} ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{} +initialisiere die kanaele;{}END PACKET ls prozess 1{} + diff --git "a/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r MUFI im Terminalkanal" "b/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r MUFI im Terminalkanal" new file mode 100644 index 0000000..d1edbc1 --- /dev/null +++ "b/app/gs.process/1.02/src/ls-Prozess 1 f\303\274r MUFI im Terminalkanal" @@ -0,0 +1,55 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Prozess 1 ** + ** ** + ** Anpassung für MUFI im Terminalkanal ** + ** ** + ** Version 1.02 ** + ** ** + ** (Stand : 26.01.90) ** + ** ** + ** ** + ** Autoren: Bruno Pollok, Bielefeld ** + ** Wolfgang Weber, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ********************************************************** + ********************************************************** + + *) +PACKET altes incharety DEFINES old incharety: +TEXT PROC old incharety:{} incharety{}END PROC old incharety;{}TEXT PROC old incharety (INT CONST timelimit):{} incharety (timelimit){}END PROC old incharety;{}END PACKET altes incharety;{}PACKET ls prozess 1 DEFINES{} run pdv,{} run pdv again,{} initialisiere interface,{} ausgeben,{} eingabe,{} warte,{} abbruch gewuenscht,{} tue nichts,{} trage kanaldaten ein,{} beende kanaldaten eintragen,{} hole spannungsbereich,{} letzte ausgabe,{} + pruefe kanal,{} pruefe abbruch,{} teste interface,{} schalte alles aus,{} oeffne interface,{} schliesse interface,{} nicht belegt,{} digital aus,{} analog aus,{} digital ein,{} analog ein,{} kanalbreite,{} ganzzahl obergrenze,{} adapterart,{} incharety,{} inchar,{} pause:{}(******************** A N P A S S U N G A N M U F I ********************){}LET mufikennung = ""31""31"",{} erwartete zeichen = 4 ;{} +TEXT CONST adapterart :: "MUFI im Terminalkanal",{} interface test code :: ""27""27"10",{} interface okay code :: ""27""27"00",{} interface open code :: ""27""27"1C" + hex (mufikennung),{} interface close code :: mufikennung + "1C" + hex (""27""27""),{} adresse 0 code :: mufikennung + "3D",{} leertakt code :: mufikennung + "3E",{} interface write code :: mufikennung + "5" ,{} interface read code :: mufikennung + "4" ;{} +TEXT VAR puffer :: "";{}ROW 256 TEXT CONST hexcode :: ROW 256 TEXT : ({}"00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F",{}"10","11","12","13","14","15","16","17","18","19","1A","1B","1C","1D","1E","1F",{}"20","21","22","23","24","25","26","27","28","29","2A","2B","2C","2D","2E","2F",{}"30","31","32","33","34","35","36","37","38","39","3A","3B","3C","3D","3E","3F",{}"40","41","42","43","44","45","46","47","48","49","4A","4B","4C","4D","4E","4F",{}"50","51","52","53","54","55","56","57","58","59","5A","5B","5C","5D","5E","5F",{} +"60","61","62","63","64","65","66","67","68","69","6A","6B","6C","6D","6E","6F",{}"70","71","72","73","74","75","76","77","78","79","7A","7B","7C","7D","7E","7F",{}"80","81","82","83","84","85","86","87","88","89","8A","8B","8C","8D","8E","8F",{}"90","91","92","93","94","95","96","97","98","99","9A","9B","9C","9D","9E","9F",{}"A0","A1","A2","A3","A4","A5","A6","A7","A8","A9","AA","AB","AC","AD","AE","AF",{}"B0","B1","B2","B3","B4","B5","B6","B7","B8","B9","BA","BB","BC","BD","BE","BF",{}"C0","C1","C2","C3","C4","C5","C6","C7","C8","C9","CA","CB","CC","CD","CE","CF",{} +"D0","D1","D2","D3","D4","D5","D6","D7","D8","D9","DA","DB","DC","DD","DE","DF",{}"E0","E1","E2","E3","E4","E5","E6","E7","E8","E9","EA","EB","EC","ED","EE","EF",{}"F0","F1","F2","F3","F4","F5","F6","F7","F8","F9","FA","FB","FC","FD","FE","FF");{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{} LET hexzeichen = "0123456789ABCDEF";{} IF es ist ein ausgabekanal{} THEN interface write code{} + (hexzeichen SUB (device + 4 * steuerungscode)){} ELIF es ist ein eingabekanal{} + THEN lesecode in abhaengigkeit von der taktzahl{} ELSE ""{} FI.{} es ist ein ausgabekanal:{} kanal [kanalnummer].betriebsart < 0.{} es ist ein eingabekanal:{} kanal [kanalnummer].betriebsart > 0.{} device:{} IF kanalnummer < 10{} THEN 1{} ELSE kanalnummer DIV 10{} FI.{} lesecode in abhaengigkeit von der taktzahl:{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1: lesecode{} CASE 2: adresse 0 code + lesecode + lesecode{} CASE 3: adresse 0 code + lesecode + zwei weitere takte{} + OTHERWISE "" END SELECT.{} lesecode:{} interface read code + (hexzeichen SUB (device + 4 * steuerungscode)).{} zwei weitere takte:{} IF leertakt code = ""{} THEN lesecode + lesecode{} ELSE kanal [kanalnummer].taktzahl DECR 1;{} leertakt code + lesecode{} FI.{}END PROC interface anpassung;{}PROC ausgeben (INT CONST kanalnummer, wert):{} merke wert;{} gib wert aus.{} merke wert:{} vorherige ausgabe [kanalnummer] := wert.{} gib wert aus:{} out (kanal [kanalnummer].steuercode);{} + out (hexcode [wert + 1]).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{} gib lesecode aus;{} erhaltene antwort.{} gib lesecode aus:{} out (kanal [kanalnummer].steuercode).{} erhaltene antwort:{} TEXT VAR dummy;{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1 : erste sendung{} CASE 2 : zweite sendung{} CASE 3 : dritte sendung{} OTHERWISE -1{} END SELECT.{} erste sendung:{} fange mufikennung;{} dezimalwert (old incharety (1), old incharety (1)).{} + zweite sendung:{} fange mufikennung;{} dummy := old incharety (1);{} dummy := old incharety (1);{} erste sendung.{} dritte sendung:{} fange mufikennung;{} dummy := old incharety (1);{} dummy := old incharety (1);{} zweite sendung.{} fange mufikennung:{} puffer CAT old incharety;{} REP puffer CAT old incharety{} UNTIL pos (puffer, mufikennung) > 0 PER;{} puffer := subtext (puffer, 1, length (puffer) - 2).{}END PROC eingabe;{}(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************){} +LET max kanalanzahl = 49,{} endezeichen = "q",{} abbruchzeichen = "h",{} esc = ""27"";{}INT CONST analog aus :: -2, (* Betriebsarten *){} digital aus :: -1,{} nicht belegt :: 0,{} digital ein :: 1,{} analog ein :: 2,{} kanalbreite :: 8,{} ganzzahl obergrenze :: 2 ** kanalbreite,{} + configuration error code :: -1,{} interface error code :: -4;{}TEXT VAR meldung :: "";{}BOOL VAR kanaldaten sind eingetragen :: FALSE,{} endezeichen gegeben :: FALSE,{} programm mit pdv gestartet :: FALSE,{} fehler zu melden :: FALSE;{}TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode),{} SPANNUNG = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT VAR vorherige ausgabe;{} +ROW max kanalanzahl KANAL VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}PROC run pdv:{} run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{} enable stop;{} last param (programmname);{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run (programmname);{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} + THEN errorstop (meldung){} FI{}END PROC run pdv;{}PROC run pdv again:{} enable stop;{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run again;{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv again;{}PROC melde programmende:{} page;{} menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{} + pause;{} schalte alles aus{}END PROC melde programmende;{}PROC initialisiere interface:{} enable stop;{} pruefe abbruch;{} IF programm mit pdv gestartet{} THEN schalte alles aus{} ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){} FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{} INT VAR kanalnummer, kanalbetriebsart;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} kanalbetriebsart := kanal [kanalnummer].betriebsart;{} IF kanalbetriebsart = digital aus{} + THEN ausgeben (kanalnummer, 0){} ELIF kanalbetriebsart = analog aus{} THEN ausgeben (kanalnummer, gewandelte nullspannung){} FI{} PER.{} gewandelte nullspannung:{} int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{} u max : spannung [kanalnummer].maximalwert.{} u min : spannung [kanalnummer].minimalwert.{}END PROC schalte alles aus;{}PROC warte (REAL CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (int (sekunden * 10.0 + 0.5));{} + IF eingabe = esc{} THEN untersuche naechstes zeichen{} FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (sekunden * 10);{} IF eingabe = esc{} + THEN untersuche naechstes zeichen{} FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}TEXT PROC incharety:{} IF puffer = ""{} THEN old incharety{} ELSE erstes zeichen von puffer{} FI.{} erstes zeichen von puffer:{} TEXT CONST zeichen :: puffer SUB 1;{} + puffer := subtext (puffer, 2);{} zeichen.{}END PROC incharety;{}TEXT PROC incharety (INT CONST timelimit):{} IF puffer = ""{} THEN old incharety (timelimit){} ELSE erstes zeichen von puffer{} FI.{} erstes zeichen von puffer:{} TEXT CONST zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC incharety;{}PROC inchar (TEXT VAR character):{} REP character := incharety{} UNTIL character <> "" PER{}END PROC inchar;{}PROC pause:{} TEXT VAR dummy;{} inchar (dummy){} +END PROC pause;{}PROC pause (INT CONST timelimit):{} TEXT VAR dummy := incharety (timelimit){}END PROC pause;{}BOOL PROC abbruch gewuenscht:{} pruefe abbruch;{} BOOL VAR entscheidung :: endezeichen gegeben;{} endezeichen gegeben := FALSE;{} entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{} pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST kanalnummer,{} ROW 2 REAL CONST spannungsbereich,{} ROW 3 INT CONST kanalparameter):{} + spannung [kanalnummer].minimalwert := spannungsbereich [1];{} spannung [kanalnummer].maximalwert := spannungsbereich [2];{} kanal [kanalnummer].betriebsart := kanalparameter [1];{} kanal [kanalnummer].taktzahl := kanalparameter [2];{} kanal [kanalnummer].steuercode := interface anpassung{} (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{} kanaldaten sind eingetragen := TRUE{}END PROC beende kanaldaten eintragen;{} +PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max):{} u min := spannung [kanalnummer].minimalwert;{} u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{} vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{} pruefe abbruch;{} pruefe kanalnummer;{} pruefe betriebsart.{} pruefe kanalnummer:{} IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{} + THEN errorstop ("Kanalnummer " + text (kanalnummer) +{} " ist unzulaessig !"){} FI.{} pruefe betriebsart:{} IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{} THEN errorstop ("An Kanal " + text (kanalnummer) +{} " keine " + wunsch + " moeglich!"){} FI.{} wunsch:{} IF gewuenschte betriebsart = analog aus{} THEN "Analog-Ausgabe"{} ELIF gewuenschte betriebsart = digital aus{} THEN "Digital-Ausgabe"{} + ELIF gewuenschte betriebsart = digital ein{} THEN "Digital-Eingabe"{} ELIF gewuenschte betriebsart = analog ein{} THEN "Analog-Eingabe"{} ELSE "Ein- oder Ausgabe"{} FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{} TEXT VAR zeichen :: incharety;{} IF zeichen = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} zeichen := incharety (30);{} IF zeichen = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF zeichen = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <"{} + + abbruchzeichen + ">!"){} FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{} enable stop;{} IF kanaldaten sind eingetragen{} THEN teste interface funktion{} ELSE status := configuration error code{} FI.{} teste interface funktion:{} leere puffer;{} out (interface test code);{} fange antwort;{} IF antwort = interface okay code{} THEN status := 0;{} out (interface open code){} ELSE status := interface error code{} + FI.{} leere puffer:{} puffer := "";{} REP UNTIL old incharety = "" PER.{} fange antwort:{} INT VAR zaehler;{} TEXT VAR antwort :: "";{} FOR zaehler FROM 1 UPTO erwartete zeichen REP{} antwort CAT old incharety (1){} PER.{}END PROC oeffne interface;{}PROC schliesse interface:{} enable stop;{} out (interface close code){}END PROC schliesse interface;{}(********************* H I L F S P R O Z E D U R E N *********************){}PROC teste interface:{} INT VAR test;{} + warte etwas;{} oeffne interface (test);{} IF test < 0{} THEN errorstop (fehlermeldung){} ELSE endezeichen gegeben := FALSE;{} fehler zu melden := FALSE{} FI.{} warte etwas:{} pause (1); pause (1); pause (1); pause (1); pause (1).{} fehlermeldung:{} IF test = configuration error code{} THEN "Interface ist noch nicht konfiguriert!"{} ELIF test = interface error code{} THEN "Interface meldet sich nicht!"{} ELSE "Interface kann nicht geöffnet werden!"{} + FI.{}END PROC teste interface;{}PROC fehlerbehandlung:{} meldung := errormessage;{} IF meldung <> ""{} THEN meldung CAT fehlerzeile;{} fehler zu melden := TRUE{} FI;{} clear error;{} initialisiere interface.{} fehlerzeile:{} IF errorline = 0{} THEN ""{} ELSE " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlerbehandlung;{}INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):{} 16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).{} hexzeichen: "123456789ABCDEF".{} +END PROC dezimalwert;{}TEXT PROC hex (TEXT CONST zwei zeichen):{} hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2)){}END PROC hex;{}TEXT PROC hex (INT CONST wert):{} (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).{} hexzeichen: "0123456789ABCDEF".{}END PROC hex;{}PROC initialisiere die kanaele:{} INT VAR kanalnummer;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{} vorherige ausgabe [kanalnummer] := 0{} + PER.{} keine spannung:{} ROW 2 REAL : (0.0, 0.0).{} leere karte:{} ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{}initialisiere die kanaele{}END PACKET ls prozess 1{} + diff --git a/app/gs.process/1.02/src/ls-Prozess 2 b/app/gs.process/1.02/src/ls-Prozess 2 new file mode 100644 index 0000000..11cb4e7 --- /dev/null +++ b/app/gs.process/1.02/src/ls-Prozess 2 @@ -0,0 +1,39 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Prozess 2 ** + ** ** + ** Version 1.02 ** + ** ** + ** (Stand : 06.06.89) ** + ** ** + ** ** + ** ** + ** Autoren: Bruno Pollok, Bielefeld ** + ** Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ********************************************************** + ********************************************************** + + *) +PACKET ls prozess 2 DEFINES + wert an analogausgang ausgeben,{} spannungswert ausgeben,{} bitsymbol ausgeben,{} bitmuster ausgeben,{} dezimalwert ausgeben,{} bitmuster gleich,{} bit ist gesetzt,{} wert von analogeingang,{} spannungswert,{} bitsymbol,{} bitmuster,{} dezimalwert:{}LET eins = "I",{} null = "O",{} invers = "T",{} egal = "X";{}REAL CONST maximalwert :: real (ganzzahl obergrenze - 1);{}(********************* A U S G A B E - B E F E H L E *********************){} +PROC wert an analogausgang ausgeben (INT CONST kanal, wert):{} pruefe kanal (kanal, analog aus);{} ausgeben (kanal, wert MOD ganzzahlobergrenze){}END PROC wert an analogausgang ausgeben;{}PROC spannungswert ausgeben (INT CONST kanal, REAL CONST wert):{} pruefe kanal (kanal, analog aus);{} pruefe spannungswert;{} ausgeben (kanal, gewandelte spannung).{} pruefe spannungswert:{} REAL VAR u min, u max;{} hole spannungsbereich (kanal, u min, u max);{} IF wert < u min OR wert > u max{} THEN errorstop ("Der Spannungswert " + text (wert) +{} + " ist nicht zulaessig!"){} FI.{} gewandelte spannung:{} int (((wert - u min) * maximalwert) / (u max - u min) + 0.5).{}END PROC spannungswert ausgeben;{}PROC bitsymbol ausgeben (INT CONST kanal, bitnummer, TEXT CONST zeichen):{} pruefe kanal (kanal, digital aus);{} pruefe bitnummer (bitnummer);{} ausgeben (kanal, relativer dezimalwert (zeichen, bitnummer, kanal)){}END PROC bitsymbol ausgeben;{}PROC bitmuster ausgeben (INT CONST kanal, TEXT CONST zeichenkette):{} + pruefe kanal (kanal, digital aus);{} ausgeben (kanal, relativer dezimalwert (zeichenkette, kanal)){}END PROC bitmuster ausgeben;{}PROC dezimalwert ausgeben (INT CONST kanal, wert):{} pruefe kanal (kanal, digital aus);{} ausgeben (kanal, wert MOD ganzzahl obergrenze){}END PROC dezimalwert ausgeben;{}(********************* E I N G A B E - B E F E H L E *********************){}BOOL PROC bitmuster gleich (INT CONST kanal, TEXT CONST zeichenkette):{} INT CONST eingabewert :: dezimalwert (kanal);{} + pruefe zeichenkette;{} eingabe passt zur zeichenkette.{} pruefe zeichenkette:{} IF length (zeichenkette) <> kanalbreite{} THEN errorstop ("Das Bitmuster '" + zeichenkette +{} "' hat eine unzulaessige Laenge!"){} FI.{} eingabe passt zur zeichenkette:{} INT VAR stelle;{} BOOL VAR abweichung gefunden :: FALSE;{} FOR stelle FROM 1 UPTO kanalbreite REP{} teste bit an dieser stelle{} UNTIL abweichung gefunden PER;{} NOT abweichung gefunden.{} teste bit an dieser stelle:{} + TEXT CONST einzelbit :: zeichenkette SUB stelle;{} IF einzelbit = eins{} THEN teste eingabebit auf eins{} ELIF einzelbit = null{} THEN teste eingabebit auf null{} ELIF einzelbit = egal{} THEN eingabebit ist beliebig{} ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " +{} "Bitsymbol in '" + zeichenkette + "'!"){} FI.{} teste eingabebit auf eins:{} IF NOT bit (eingabewert, kanalbreite - stelle){} THEN abweichung gefunden := TRUE{} FI.{} + teste eingabebit auf null:{} IF bit (eingabewert, kanalbreite - stelle){} THEN abweichung gefunden := TRUE{} FI.{} eingabebit ist beliebig:{} .{}END PROC bitmuster gleich;{}BOOL PROC bit ist gesetzt (INT CONST kanal, bitnummer):{} pruefe kanal (kanal, digital ein);{} pruefe bitnummer (bitnummer);{} IF bit (eingabe (kanal), bitnummer){} THEN TRUE{} ELSE FALSE{} FI{}END PROC bit ist gesetzt;{}INT PROC wert von analogeingang (INT CONST kanal):{} pruefe kanal (kanal, analog ein);{} + eingabe (kanal){}END PROC wert von analogeingang;{}REAL PROC spannungswert (INT CONST kanal):{} INT CONST dezimalwert :: wert von analogeingang (kanal);{} REAL VAR u min, u max;{} hole spannungsbereich (kanal, u min, u max);{} round (real (dezimalwert) * (u max - u min) / maximalwert + u min, 3){}END PROC spannungswert;{}TEXT PROC bitsymbol (INT CONST kanal, bitnummer):{} pruefe kanal (kanal, digital ein);{} pruefe bitnummer (bitnummer);{} IF bit (eingabe (kanal), bitnummer){} THEN eins{} + ELSE null{} FI{}END PROC bitsymbol;{}TEXT PROC bitmuster (INT CONST kanal):{} TEXT VAR zeichenkette :: "";{} INT CONST wert :: dezimalwert (kanal);{} wandle wert;{} zeichenkette.{} wandle wert:{} INT VAR zeiger;{} FOR zeiger FROM kanalbreite - 1 DOWNTO 0 REP{} IF bit (wert, zeiger){} THEN zeichenkette CAT eins{} ELSE zeichenkette CAT null{} FI{} PER.{}END PROC bitmuster;{}INT PROC dezimalwert (INT CONST kanal):{} pruefe kanal (kanal, digital ein);{} + eingabe (kanal){}END PROC dezimalwert;{}(******************** H I L F S - P R O Z E D U R E N ********************){}INT PROC relativer dezimalwert (TEXT CONST zeichenkette, INT CONST kanal):{} INT VAR wert := letzte ausgabe (kanal);{} pruefe zeichenkette auf korrekte laenge;{} veraendere alten wert;{} wert.{} pruefe zeichenkette auf korrekte laenge:{} IF length (zeichenkette) <> kanalbreite{} THEN errorstop ("Bitmuster '" + zeichenkette + "' hat "{} + "unzulaessige Laenge!"){} + FI.{} veraendere alten wert:{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO kanalbreite REP{} veraendere dieses bit{} PER.{} veraendere dieses bit:{} TEXT CONST einzelbit :: zeichenkette SUB zeiger;{} IF einzelbit = eins THEN setze bit{} ELIF einzelbit = null THEN loesche bit{} ELIF einzelbit = invers THEN invertiere bit{} ELIF einzelbit = egal THEN lasse bit{} ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " +{} "Bitsymbol in '" + zeichenkette + "'!"){} + FI.{} setze bit:{} set bit (wert, kanalbreite - zeiger).{} loesche bit:{} reset bit (wert, kanalbreite - zeiger).{} invertiere bit:{} IF bit (wert, kanalbreite - zeiger){} THEN loesche bit{} ELSE setze bit{} FI.{} lasse bit:{} .{} END PROC relativer dezimalwert;{}INT PROC relativer dezimalwert (TEXT CONST bitzeichen,{} INT CONST bitnummer, kanal):{} INT VAR wert :: letzte ausgabe (kanal);{} IF bitzeichen = eins THEN setze bit{} + ELIF bitzeichen = null THEN loesche bit{} ELIF bitzeichen = invers THEN invertiere bit{} ELIF bitzeichen = egal THEN lasse bit{} ELSE errorstop ("'" + bitzeichen + "' ist ein unzulaessiges " +{} "Bitsymbol!"){} FI;{} wert.{} setze bit:{} set bit (wert, bitnummer).{} loesche bit:{} reset bit (wert, bitnummer).{} invertiere bit:{} IF bit (wert, bitnummer){} THEN loesche bit{} ELSE setze bit{} FI.{} lasse bit:{} + .{}END PROC relativer dezimalwert;{}PROC pruefe bitnummer (INT CONST bitnummer):{} IF bitnummer < 0 OR bitnummer > kanalbreite - 1{} THEN errorstop ("Bitnummer " + text (bitnummer) +{} " ist nicht zulaessig!"){} FI{}END PROC pruefe bitnummer{}END PACKET ls prozess 2{} + diff --git a/app/gs.process/1.02/src/ls-Prozess 3 b/app/gs.process/1.02/src/ls-Prozess 3 new file mode 100644 index 0000000..28ef825 --- /dev/null +++ b/app/gs.process/1.02/src/ls-Prozess 3 @@ -0,0 +1,26 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Prozess 3 ** + ** ** + ** Version 1.02 ** + ** ** + ** (Stand : 06.06.89) ** + ** ** + ** ** + ** ** + ** Autoren: Bruno Pollok, Bielefeld ** + ** Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ********************************************************** + ********************************************************** + + *) +PACKET ls prozess 3 DEFINES + temperatur:{}LET thermometerkonstante = 50.0,{} minimaltemperatur = 10.0;{}REAL PROC temperatur (REAL CONST spannungswert):{} spannungswert * thermometerkonstante - minimaltemperatur{}END PROC temperatur{}END PACKET ls prozess 3{} + diff --git a/app/gs.process/1.02/src/ls-Prozess 4 b/app/gs.process/1.02/src/ls-Prozess 4 new file mode 100644 index 0000000..158b548 --- /dev/null +++ b/app/gs.process/1.02/src/ls-Prozess 4 @@ -0,0 +1,61 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Prozess 4 ** + ** ** + ** Version 1.02 ** + ** ** + ** (Stand : 26.01.90) ** + ** ** + ** ** + ** ** + ** Autoren: Bruno Pollok, Bielefeld ** + ** Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ********************************************************** + ********************************************************** + + *) +PACKET ls prozess 4 DEFINES + pdv befehlsuebersicht anzeigen,{} pdv ausgabebefehle anzeigen,{} pdv eingabebefehle anzeigen,{} pdv testbefehle anzeigen,{} pdv weitere befehle anzeigen,{} pdv bitmuster erlaeutern,{} pdv symbole erlaeutern,{} pdv digital analog werte,{} pdv programm neu erstellen,{} pdv programm ansehen,{} pdv programm starten,{} pdv programm wiederholen,{} pdv dateien verzeichnis,{} + pdv datei kopieren,{} pdv datei umbenennen,{} pdv dateien loeschen,{} pdv dateien drucken,{} init pdv,{} pdv:{}LET menukarte = "ls-MENUKARTE:Prozess",{} niltext = "",{} maxlaenge = 45,{} maxnamenslaenge = 35;{}WINDOW VAR w :: window (1, 3, 79, 19);{}TEXT VAR programmname :: "";{}BOOL VAR noch kein programm gelaufen :: TRUE;{}PROC pdv:{} init pdv;{} install menu (menukarte, FALSE);{} + handle menu ("PDV"){}END PROC pdv;{}PROC init pdv:{} programmname := "";{} noch kein programm gelaufen := TRUE;{} cursor off;{}END PROC init pdv;{}PROC pdv befehlsuebersicht anzeigen:{} menuinfo (anwendungstext (20)){}END PROC pdv befehlsuebersicht anzeigen;{}PROC pdv ausgabebefehle anzeigen:{} INT VAR i;{} REP{} i := menualternative (anwendungstext (1), anwendungstext (3),{} anwendungstext (4), 5, TRUE);{} SELECT i OF{} CASE 1, 101: menuinfo (anwendungstext (21)){} + CASE 2, 102: menuinfo (anwendungstext (22)){} CASE 3, 103: menuinfo (anwendungstext (23)){} CASE 4, 104: menuinfo (anwendungstext (24)){} CASE 5, 105: menuinfo (anwendungstext (25)){} END SELECT{} UNTIL i = 6 OR i = 106 PER;{}END PROC pdv ausgabebefehle anzeigen;{}PROC pdv eingabebefehle anzeigen:{} INT VAR i;{} REP{} i := menualternative (anwendungstext (2), anwendungstext (3),{} anwendungstext (4), 5, TRUE);{} SELECT i OF{} CASE 1, 101: menuinfo (anwendungstext (31)){} + CASE 2, 102: menuinfo (anwendungstext (32)){} CASE 3, 103: menuinfo (anwendungstext (33)){} CASE 4, 104: menuinfo (anwendungstext (34)){} CASE 5, 105: menuinfo (anwendungstext (35)){} END SELECT{} UNTIL i = 6 OR i = 106 PER;{}END PROC pdv eingabebefehle anzeigen;{}PROC pdv testbefehle anzeigen:{} INT VAR i;{} REP{} i := menualternative (anwendungstext (5), anwendungstext (7),{} anwendungstext (8), 5, TRUE);{} SELECT i OF{} CASE 1, 101: menuinfo (anwendungstext (41)){} + CASE 2, 102: menuinfo (anwendungstext (42)){} END SELECT{} UNTIL i = 3 OR i = 103 PER;{}END PROC pdv testbefehle anzeigen;{}PROC pdv weitere befehle anzeigen:{} INT VAR i;{} REP{} i := menualternative (anwendungstext (6), anwendungstext (7),{} anwendungstext (8), 5, TRUE);{} SELECT i OF{} CASE 1, 101: menuinfo (anwendungstext (43)){} CASE 2, 102: menuinfo (anwendungstext (44)){} END SELECT{} UNTIL i = 3 OR i = 103 PER;{}END PROC pdv weitere befehle anzeigen;{} +PROC pdv bitmuster erlaeutern:{} menuinfo (anwendungstext (46)){}END PROC pdv bitmuster erlaeutern;{}PROC pdv symbole erlaeutern:{} menuinfo (anwendungstext (47)){}END PROC pdv symbole erlaeutern;{}PROC pdv digital analog werte:{} menuinfo (anwendungstext (48)){}END PROC pdv digital analog werte;{}PROC pdvdateien verzeichnis:{} disable stop;{} forget ("Verzeichnis der Dateien", quiet);{} THESAURUS VAR programme :: ALL myself;{} FILE VAR f ::{} sequential file (output, "Verzeichnis der Dateien");{} + f FILLBY programme;{} modify (f);{} to line (f, 1); insert record (f);{} menufootnote ("Verlassen: ");{} cursor on;{} show (w, f);{} cursor off;{} forget ("Verzeichnis der Dateien", quiet);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop{}END PROC pdvdateien verzeichnis;{}PROC pdvprogramm neu erstellen:{} hole programmname;{} + kontrolliere den programmnamen;{} command dialogue (FALSE);{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} cursor off;{} command dialogue (TRUE);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} hole programmname:{} programmname := "";{} programmname := menuanswer (ausgabe, programmname, 5).{} ausgabe:{} center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""{} + + " Bitte den Namen für das Programm "13""13"".{} kontrolliere den programmnamen:{} IF programmname = niltext{} THEN LEAVE pdvprogramm neu erstellen{} ELIF length (programmname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} programmname := niltext;{} LEAVE pdvprogramm neu erstellen{} ELIF exists (programmname){} THEN meckere existierendes programm an;{} LEAVE pdvprogramm neu erstellen{} FI.{}END PROC pdvprogramm neu erstellen;{} +PROC pdvprogramm ansehen:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI;{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name{} + + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare :: ALL myself;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE pdvprogramm ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} + programmname := menuone (verfuegbare, "Programm ansehen/ändern",{} "Bitte das gewünschte Programm ankreuzen!",{} FALSE);{} IF programmname = niltext{} THEN menu bildschirm;{} LEAVE pdvprogramm ansehen{} FI.{}END PROC pdvprogramm ansehen;{}PROC pdvdateien drucken:{} lasse programme auswaehlen;{} drucke programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare :: ALL myself;{} IF NOT not empty (verfuegbare){} + THEN noch kein programm;{} LEAVE pdvdateien drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Dateien drucken",{} "Bitte die Dateien ankreuzen, die gedruckt werden sollen!",{} FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Dateien drucken")));{} menuwindowline (2);{} command dialogue (FALSE);{} + fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Dateien wurden gedruckt!");{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " """ + name (verfuegbare, k) +{} """ wird gedruckt!");{} menuwindowline;{} + print (name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Datei ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE pdvdateien drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} + FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE pdvdateien drucken{} ELSE enable stop{} FI.{}END PROC pdvdateien drucken;{}PROC pdvdatei kopieren:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} kopiere ggf das programm.{} ermittle alten programmnamen:{} IF NOT not empty (ALL myself){} THEN noch kein programm;{} + LEAVE pdvdatei kopieren{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone (ALL myself, "Datei kopieren",{} "Bitte die Datei ankreuzen, das kopiert werden soll!",FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE pdvdatei kopieren{} FI.{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Name der 'alten' Datei: " + bisheriger name{} + + " Bitte den Namen für die Kopie: ".{} ueberschrift:{} center (maxlaenge, invers ("Datei kopieren")) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} kopiere ggf das programm:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE pdvdatei kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE pdvdatei kopieren{} ELSE copy (alter name, neuer name){} + FI.{} mache vorwurf:{} menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")).{}END PROC pdvdatei kopieren;{}PROC pdvdatei umbenennen:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} benenne ggf das programm um.{} ermittle alten programmnamen:{} IF NOT not empty (ALL myself){} THEN noch kein programm;{} LEAVE pdvdatei umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( ALL myself, "Datei umbenennen",{} + "Bitte die Datei ankreuzen, die umbenannt werden soll!", FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE pdvdatei umbenennen{} FI.{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Bisheriger Dateiname: " + bisheriger name{} + " Zukünftiger Dateiname: ".{} ueberschrift:{} center (maxlaenge, invers ("Datei umbenennen")) + ""13""13"".{} bisheriger name:{} + ""13""13" " + invers (alter name) + ""13""13"".{} benenne ggf das programm um:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE pdvdatei umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE pdvdatei umbenennen{} ELSE rename (alter name, neuer name);{} programmname := neuer name{} FI.{} mache vorwurf:{} menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")).{} +END PROC pdvdatei umbenennen;{}PROC pdvdateien loeschen:{} lasse programme auswaehlen;{} loesche programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare :: ALL myself;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE pdvdateien loeschen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Dateien löschen",{} "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).{} + loesche programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Dateien löschen")));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} + IF name (verfuegbare, k) <> ""{} THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen"){} THEN forget (name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} programmname := "".{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Datei ausgewählt!");{} menuwindowstop;{} + menu bildschirm;{} LEAVE pdvdateien loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE pdvdateien loeschen{} ELSE enable stop{} FI.{}END PROC pdvdateien loeschen;{} +PROC pdvprogramm starten:{} programmname ermitteln;{} bildschirm vorbereiten;{} cursor on;{} disable stop;{} warnings off;{} check on;{} run pdv (programmname);{} noch kein programm gelaufen := FALSE;{} cursor off;{} IF is error{} THEN fehler ggf melden;{} clear error{} ELSE regenerate menuscreen{} FI;{} enable stop.{} bildschirm vorbereiten:{} cursor (17, 2); out (waagerecht);{} cursor (38, 2); out (waagerecht);{} cursor ( 1, 3); out (""4"");{} menufootnote ("Programmabbruch: ");{} + cursor (1, 5);{} out ("Das Programm wird übersetzt. Zeilen-Nr.: ").{} fehler ggf melden:{} IF errormessage <> ""{} THEN fehler melden{} FI.{} fehler melden:{} IF pos (errormessage, "'halt' vom Terminal") > 0{} THEN regenerate menuscreen;{} out (""7""); menuinfo (" "15"'halt' vom Terminal "14""){} ELIF pos (errormessage, "Programm-Abbruch durch ") > 0{} THEN regenerate menuscreen;{} out (""7""); menuinfo (" "15"Programm-Abbruch durch "14""){} + ELIF pos (errormessage, "(bei Zeile") > 0 AND exists (programmname){} THEN programm mit fehler im notebook zeigen;{} regenerate menuscreen{} ELSE regenerate menuscreen;{} out (""7""); menuinfo (" " + invers ("FEHLER: "{} + subtext (errormessage, 1, 61))){} FI.{} programm mit fehler im notebook zeigen:{} noteline;{} note ("FEHLER: " + errormessage);{} INT VAR n; FOR n FROM 1 UPTO 9 REP noteline PER;{} note (""15"Verlassen: "14"");{} + FILE VAR p :: sequential file (modify, programmname);{} to line (p, max (1, fehlerzeile));{} col (1);{} clear error;{} out (""7"");{} cursor on;{} noteedit (p);{} cursor off.{} fehlerzeile:{} int (subtext (errormessage, zahlposition)).{} zahlposition: pos (errormessage, "(bei Zeile") + 10.{} programmname ermitteln:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI.{} frage nach diesem programm:{} + IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +{} name + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm starten")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare :: ALL myself;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE pdvprogramm starten{} + ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm starten",{} "Bitte das gewünschte Programm ankreuzen!", FALSE);{} IF programmname = niltext{} THEN menubildschirm;{} LEAVE pdv programm starten{} FI.{}END PROC pdvprogramm starten;{}PROC pdv programm wiederholen:{} bildschirm vorbereiten;{} cursor on;{} disable stop;{} IF noch kein programm gelaufen{} THEN errorstop ("Eine Wiederholung ist nicht moeglich!"){} + ELSE run pdv again{} FI;{} cursor off;{} regenerate menuscreen;{} IF is error{} THEN zeige fehler;{} clear error{} FI;{} enable stop.{} bildschirm vorbereiten:{} cursor (17, 2); out (waagerecht);{} cursor (38, 2); out (waagerecht);{} cursor ( 1, 3); out (""4"");{} menufootnote ("Programmabbruch: ");{} cursor (1,3).{} zeige fehler:{} out (""7"");{} IF errormessage = "'run again' nicht moeglich"{} THEN menuinfo (" "15"Eine Wiederholung ist nicht moeglich! "14""){} + ELIF pos (errormessage, "'halt' vom Terminal") > 0{} THEN menuinfo (" "15"'halt' vom Terminal "14""){} ELIF pos (errormessage, "Programm-Abbruch durch ") > 0{} THEN menuinfo (" "15"Programm-Abbruch durch "14""){} ELSE menuinfo (" " + invers ("FEHLER: "{} + subtext (errormessage, 1, 61))){} FI.{}END PROC pdv programm wiederholen;{}PROC meckere zu langen namen an:{} menuinfo (" " + invers ("Hier dürfen Namen höchstens "{} + text (max namenslaenge){} + + " Zeichen lang sein!")){}END PROC meckere zu langen namen an;{}PROC meckere existierendes programm an:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")){}END PROC meckere existierendes programm an;{}PROC noch kein programm:{} menuinfo (" " + invers ("Es existiert noch kein Programm!")){}END PROC noch kein programm;{}PROC menu bildschirm:{} cursor (1, 2);{} out (5 * waagerecht);{} cursor (1, 3);{} out (""4"");{} cursor (1,23);{} out (79 * waagerecht);{} + refresh submenu{}END PROC menu bildschirm{}END PACKET ls prozess 4{} + diff --git a/app/gs.process/1.02/src/ls-Prozess 5 b/app/gs.process/1.02/src/ls-Prozess 5 new file mode 100644 index 0000000..66bdf94 --- /dev/null +++ b/app/gs.process/1.02/src/ls-Prozess 5 @@ -0,0 +1,84 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Prozess 5 ** + ** ** + ** Version 1.02 ** + ** ** + ** (Stand : 26.01.90) ** + ** ** + ** ** + ** ** + ** Autoren: Bruno Pollok, Bielefeld ** + ** Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ********************************************************** + ********************************************************** + + *) +PACKET ls prozess 5 DEFINES + pdv konfiguration zugelassen,{} pdv konfiguration evtl aktivieren,{} pdv konfiguration zeigen,{} pdv kanal konfigurieren,{} pdv interfaceausgabe testen,{} pdv interfaceeingabe testen:{}LET max steckplaetze = 4,{} max portanzahl = 4,{} anzahl kartensorten = 5,{} betriebsart = 1,{} keine karte = 1,{} ea karte = 2,{} kombi = 3,{} da karte = 4,{} ad karte = 5,{} + compact = 6,{} einzel = 7,{} mehrfach = 8;{}LET testfenster x = 11,{} testfenster y = 5,{} testfenster xsize = 59,{} testfenster ysize = 15;{}WINDOW VAR testfenster :: window (testfenster x, testfenster y,{} testfenster xsize, testfenster ysize);{}INT VAR steckplatzart :: 0;{}BOOL VAR mit konfigurationsmoeglichkeit :: TRUE;{}TASK VAR konfigurationsmanager :: niltask;{} +ROW max steckplaetze INT VAR kartenart :: ROW max steckplaetze INT :{} (keine karte, keine karte,{} keine karte, keine karte);{}LET SPANNUNG = ROW 2 REAL,{} PORT = ROW 3 INT,{} KARTE = ROW max portanzahl PORT;{}ROW anzahl kartensorten KARTE CONST karte :: ROW anzahl kartensorten KARTE :{}(* ---------------------------------------------------------------------- *){}( KARTE : ({}(* ---------------------------------------------------------------------- *){} +(* *) PORT : (nicht belegt, 0, 0), (* Port 1 *){}(* leere *) PORT : (nicht belegt, 0, 0), (* Port 2 *){}(* Karte *) PORT : (nicht belegt, 0, 0), (* Port 3 *){}(* *) PORT : (nicht belegt, 0, 0)), (* Port 4 *){}(*----------------------------------------------------------------------- *){} KARTE : ({}(* ---------------------------------------------------------------------- *){}(* *) PORT : (digital ein, 1, 3), (* Port 1 *){} +(* E/A *) PORT : (digital aus, 1, 1), (* Port 2 *){}(* Karte *) PORT : (digital ein, 1, 3), (* Port 3 *){}(* *) PORT : (digital aus, 1, 1)), (* Port 4 *){}(*----------------------------------------------------------------------- *){} KARTE : ({}(* ---------------------------------------------------------------------- *){}(* *) PORT : (analog ein, 2, 2), (* Port 1 *){}(* Kombi *) PORT : (analog ein, 3, 2), (* Port 2 *){} +(* Karte *) PORT : (digital ein, 1, 3), (* Port 3 *){}(* *) PORT : (digital aus, 1, 1 )), (* Port 4 *){}(*----------------------------------------------------------------------- *){} KARTE : ({}(* ---------------------------------------------------------------------- *){}(* *) PORT : (analog aus, 1, 1), (* Port 1 *){}(* D/A *) PORT : (analog aus, 1, 3), (* Port 2 *){}(* Wandler *) PORT : (nicht belegt, 0, 0), (* Port 3 *){} +(* *) PORT : (nicht belegt, 0, 0)), (* Port 4 *){}(*----------------------------------------------------------------------- *){} KARTE : ({}(* ---------------------------------------------------------------------- *){}(* *) PORT : (analog ein, 1, 1), (* Port 1 *){}(* A/D *) PORT : (analog ein, 1, 3), (* Port 2 *){}(* Wandler *) PORT : (nicht belegt, 0, 0), (* Port 3 *){}(* *) PORT : (nicht belegt, 0, 0)) (* Port 4 *){} +(*----------------------------------------------------------------------- *){} );{}PROC pdv konfiguration zugelassen (BOOL CONST wahrheitswert):{} teste berechtigung;{} mit konfigurationsmoeglichkeit := wahrheitswert;{} IF mit konfigurationsmoeglichkeit{} THEN konfigurationsmanager := niltask{} ELSE konfigurationsmanager := myself{} FI.{} teste berechtigung:{} enable stop;{} IF NOT (konfigurationsmanager = niltask OR{} + konfigurationsmanager = myself){} THEN errorstop ("Befehl ist nur in Task '" +{} name (konfigurationsmanager) + "' zugelassen!"){} FI.{}END PROC pdv konfiguration zugelassen;{}PROC pdv konfiguration evtl aktivieren:{} IF mit konfigurationsmoeglichkeit{} THEN activate (3){} ELSE deactivate (3){} FI{}END PROC pdv konfiguration evtl aktivieren;{}PROC pdv kanal konfigurieren:{} TEXT CONST info :: " "15"Auswahl der Steckplatzart "14" "13""13""{} + + " c Compactbox "13""{} + " e Einzelsteckplatz "13""{} + " m Mehrfachsteckplatz ",{} liste :: "Compact"13"Einzel"13"Mehrfach",{} tasten :: "cemCEM";{} INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101, 104 : trage compactbox ein;{} zeige kanalbelegung (0){} CASE 2, 102, 105 : trage einzelplatzbelegung ein;{} + zeige kanalbelegung (0){} CASE 3, 103, 106 : bearbeite die steckplaetze einzeln{} END SELECT;{} beende kanaldaten eintragen.{} trage compactbox ein:{} steckplatzart := compact;{} trage steckplatzbelegung ein (1, kombi);{} trage steckplatzbelegung ein (2, keine karte);{} trage steckplatzbelegung ein (3, keine karte);{} trage steckplatzbelegung ein (4, keine karte).{} trage einzelplatzbelegung ein:{} steckplatzart := einzel;{} trage steckplatzbelegung ein (1, ermittelte kartenart (0));{} + trage steckplatzbelegung ein (2, keine karte);{} trage steckplatzbelegung ein (3, keine karte);{} trage steckplatzbelegung ein (4, keine karte).{} bearbeite die steckplaetze einzeln:{} INT VAR platz;{} steckplatzart := mehrfach;{} FOR platz FROM 1 UPTO max steckplaetze REP{} trage steckplatzbelegung ein (platz, ermittelte kartenart (platz));{} zeige kanalbelegung (platz * 10){} PER.{}END PROC pdv kanal konfigurieren;{}PROC pdv konfiguration zeigen:{} SELECT steckplatzart OF{} + CASE compact : zeige kanalbelegung (0){} CASE einzel : zeige kanalbelegung (0){} CASE mehrfach : zeige belegung einzelner steckplaetze{} OTHERWISE noch nicht konfiguriert{} END SELECT.{} noch nicht konfiguriert:{} menuinfo (" "15"Warnung: "14" "13""13""13""{} + " Das Interface wurde noch nicht konfiguriert! "13""13""{} + " In diesem Zustand sind weder Eingaben noch "13""{} + " Ausgaben über das Interface möglich. "13"").{} + zeige belegung einzelner steckplaetze:{} TEXT CONST info ::{} " "15"Eingestellt: Mehrfachsteckplatz "14" "13""13""{} + " 1 Info Steckplatz 1 "13""{} + " 2 Info Steckplatz 2 "13""{} + " 3 Info Steckplatz 3 "13""{} + " 4 Info Steckplatz 4 "13""13""{} + " z Zurück ins Hauptmenü ",{} liste :: "1"13"2"13"3"13"4"13"z",{} + tasten :: "1234zZ";{} INT VAR auswahl;{} REP auswahl := menualternative (info, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101 : zeige kanalbelegung (10){} CASE 2, 102 : zeige kanalbelegung (20){} CASE 3, 103 : zeige kanalbelegung (30){} CASE 4, 104 : zeige kanalbelegung (40){} END SELECT{} UNTIL (auswahl = 5) OR (auswahl > 104) PER{}END PROC pdv konfiguration zeigen;{}PROC pdv interfaceausgabe testen:{} gestalte testfenster ("Ausgabetest");{} + disable stop;{} teste interface;{} IF NOT is error{} THEN teste interface ausgabe{} FI;{} IF is error{} THEN fehlerbehandlung{} ELSE schliesse interface;{} enable stop;{} beseitige testfenster;{} refresh submenu{} FI.{} fehlerbehandlung:{} TEXT VAR meldung :: errormessage;{} clear error;{} schalte alles aus;{} schliesse interface;{} enable stop;{} cursor off;{} regenerate menuscreen;{} menuinfo (" " + invers (meldung)).{}END PROC pdv interfaceausgabe testen;{} +PROC pdv interfaceeingabe testen:{} gestalte testfenster ("Eingabetest");{} disable stop;{} teste interface;{} IF NOT is error{} THEN teste interface eingabe{} FI;{} IF is error{} THEN fehlerbehandlung{} ELSE schliesse interface;{} enable stop;{} beseitige testfenster;{} refresh submenu{} FI.{} fehlerbehandlung:{} TEXT VAR meldung :: errormessage;{} clear error;{} schalte alles aus;{} schliesse interface;{} enable stop;{} cursor off;{} + regenerate menuscreen;{} menuinfo (" " + invers (meldung)).{}END PROC pdv interfaceeingabe testen;{}PROC beseitige testfenster:{} INT VAR z;{} FOR z FROM testfenster y + testfenster ysize DOWNTO testfenster y - 1 REP{} cursor (testfenster x - 1, z);{} out (""5""){} PER{}END PROC beseitige testfenster;{}PROC gestalte testfenster (TEXT CONST funktionsart):{} show (testfenster);{} cursor (testfenster x - 1, testfenster y + testfenster ysize - 2);{} out (balken links + (testfenster xsize * waagerecht) + balken rechts);{} + cursor (testfenster, 1, 2);{} out (testfenster, center (testfenster, invers (funktionsart))){}END PROC gestalte testfenster;{}PROC testfensterfussnote (TEXT CONST meldung):{} cursor (testfenster, 2, testfenster ysize);{} out (testfenster, meldung){}END PROC testfensterfussnote;{}PROC teste interfaceausgabe:{} INT VAR kanalnummer, steckplatz, port;{} TEXT VAR nummer :: "";{} enable stop;{} REP hole kanalnummer;{} teste ausgabe an kanal{} PER.{} hole kanalnummer:{} SELECT steckplatzart OF{} + CASE compact : kanalnummer := 4; steckplatz := 1; port := 4{} CASE einzel : kanalnummer muss evtl erfragt werden{} CASE mehrfach : kanalnummer muss erfragt werden{} OTHERWISE errorstop ("Interface ist noch nicht konfiguriert!"){} END SELECT;{} cursor (testfenster, 2, 5);{} out (testfenster, "Ausgabe an Kanal " + text (kanalnummer) + klammer +{} kanalbeschreibung (steckplatz, port));{} IF steckplatzart = mehrfach{} THEN cursor (testfenster, 25, 6);{} + out (testfenster, "in Steckplatz " + text (steckplatz)){} FI;{} out (testfenster, ")").{} klammer:{} IF kanalnummer < 10{} THEN " (= "{} ELSE " (= "{} FI.{} kanalnummer muss evtl erfragt werden:{} SELECT kartenart [1] OF{} CASE kombi : kanalnummer := 4; steckplatz := 1; port := 4{} CASE eakarte : kanalnummer := 2; steckplatz := 1; port := 2{} CASE dakarte : frage nach kanalnummer auf da karte;{} steckplatz := 1; port := kanalnummer{} + OTHERWISE errorstop ("Keine Ausgabe an " + kartenname + " möglich!"){} END SELECT.{} kartenname:{} IF kartenart [1] = ad karte{} THEN "A/D-Karte"{} ELSE "leeren Steckplatz"{} FI.{} frage nach kanalnummer auf da karte:{} menufootnote ("Zurück zum Hauptmenü: ");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Ausgabe - Kanal (1 oder 2): ");{} cursor on;{} REP inchar (nummer){} UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER;{} + cursor off;{} IF nummer = ""27""{} THEN LEAVE teste interface ausgabe{} ELSE kanalnummer := int (nummer){} FI.{} esc q gedrueckt:{} (nummer = ""27"") AND (incharety (20) = "q").{} kanalnummer muss erfragt werden:{} TEXT VAR exit char;{} menufootnote ("Zurück zum Hauptmenü: ");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Ausgabe - Kanal:");{} cursor on;{} REP cursor (testfenster, 19, 5);{} + editget (testfenster, nummer, 4, 4, "", "q", exit char){} UNTIL (exit char = ""27"q") OR ausgabekanal eingegeben PER;{} cursor off;{} IF exit char = ""27"q"{} THEN LEAVE teste interface ausgabe{} FI.{} ausgabekanal eingegeben:{} kanalnummer := abs (int (nummer));{} steckplatz := kanalnummer DIV 10;{} port := kanalnummer MOD 10;{} IF steckplatz = 0 THEN steckplatz := 1 FI;{} cursor (testfenster, 2, 7);{} IF (kanalnummer < 1) OR (kanalnummer > 49){} + THEN out (testfenster, "Unzulässige Kanalnummer! "); FALSE{} ELIF (port = 0) OR (port > max portanzahl) OR kein ausgabeport{} THEN out (testfenster, "Dies ist kein Ausgabe-Kanal! "); FALSE{} ELSE out (testfenster, " "); TRUE{} FI.{} kein ausgabeport:{} (port betriebsart <> digital aus) AND (port betriebsart <> analog aus).{} port betriebsart: karte [sorte][port][betriebsart].{} sorte : kartenart [steckplatz].{} + teste ausgabe an kanal:{} TEXT VAR wert;{} cursor (testfenster, 1, 8);{} out (testfenster, testfenster xsize * "-");{} cursor (testfenster, 2, 11);{} out (testfenster, "Ausgabewert: ");{} testfenster fussnote ("Bitte einen Wert zwischen 0 und 255 eingeben!");{} menufootnote ("'Werte ausgeben' beenden: ");{} cursor on;{} REP cursor (testfenster, 15, 11);{} wert := "0";{} editget (testfenster, wert, 4, 4, "", "qh", exit char);{} IF exit char = return{} + THEN ausgeben (kanalnummer, int (wert) MOD ganzzahlobergrenze){} ELIF exit char = ""27"h"{} THEN errorstop ("Programm-Abbruch durch !"){} FI{} UNTIL exitchar = ""27"q" PER;{} cursor off;{} IF (steckplatzart = mehrfach) OR (kartenart [1] = da karte){} THEN cursor (testfenster, 1, 5);{} out (testfenster, (2 * testfenster xsize) * " ");{} cursor (testfenster, 2, 11);{} out (testfenster, " ");{} + testfenster fussnote ((testfenster xsize - 2) * " "){} ELSE LEAVE teste interfaceausgabe{} FI.{} return: ""13"".{}END PROC teste interfaceausgabe;{}PROC teste interfaceeingabe:{} INT VAR kanalnummer, steckplatz, port;{} TEXT VAR nummer :: "";{} enable stop;{} REP hole kanalnummer;{} teste eingabe vom kanal{} PER.{} hole kanalnummer:{} IF steckplatzart = 0{} THEN errorstop ("Interface ist noch nicht konfiguriert!"){} ELSE kanalnummer erfragen{} + FI;{} cursor (testfenster, 2, 5);{} out (testfenster, "Eingabe von Kanal " + text (kanalnummer) + klammer +{} kanalbeschreibung (steckplatz, port));{} IF steckplatzart = mehrfach{} THEN cursor (testfenster, 26, 6);{} out (testfenster, "in Steckplatz " + text (steckplatz)){} FI;{} out (testfenster, ")").{} klammer:{} IF kanalnummer < 10{} THEN " (= "{} ELSE " (= "{} FI.{} kanalnummer erfragen:{} SELECT steckplatzart OF{} + CASE compact : drei kanaele anbieten;{} steckplatz := 1; port := kanalnummer{} CASE einzel : zwei oder drei kanaele anbieten;{} steckplatz := 1; port := kanalnummer{} CASE mehrfach : alle kanaele moeglich{} END SELECT.{} drei kanaele anbieten:{} menufootnote ("Zurück zum Hauptmenü: ");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Eingabe - Kanal (1, 2 oder 3): ");{} + cursor on;{} REP inchar (nummer){} UNTIL (pos ("123", nummer) > 0) OR esc q gedrueckt PER;{} cursor off;{} IF nummer = ""27""{} THEN LEAVE teste interface eingabe{} ELSE kanalnummer := int (nummer){} FI.{} esc q gedrueckt:{} (nummer = ""27"") AND (incharety (20) = "q").{} zwei oder drei kanaele anbieten:{} SELECT kartenart [1] OF{} CASE kombi : drei kanaele anbieten{} CASE ad karte : zwei kanaele anbieten{} CASE ea karte : kanalnummer := 1{} + OTHERWISE errorstop ("Eingabe bei " + kartenname + " nicht möglich!"){} END SELECT.{} kartenname:{} IF kartenart [1] = da karte{} THEN "D/A-Karte"{} ELSE "leerem Steckplatz"{} FI.{} zwei kanaele anbieten:{} menufootnote ("Zurück zum Hauptmenü: ");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Eingabe - Kanal (1 oder 2): ");{} cursor on;{} REP inchar (nummer){} UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER;{} + cursor off;{} IF nummer = ""27""{} THEN LEAVE teste interface eingabe{} ELSE kanalnummer := int (nummer){} FI.{} alle kanaele moeglich:{} TEXT VAR exit char;{} menufootnote ("Zurück zum Hauptmenü: ");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Eingabe - Kanal:");{} cursor on;{} REP cursor (testfenster, 19, 5);{} editget (testfenster, nummer, 4, 4, "", "q", exit char){} UNTIL (exit char = ""27"q") OR eingabekanal eingegeben PER;{} + cursor off;{} IF exit char = ""27"q"{} THEN LEAVE teste interface eingabe{} FI.{} eingabekanal eingegeben:{} kanalnummer := abs (int (nummer));{} steckplatz := kanalnummer DIV 10;{} port := kanalnummer MOD 10;{} IF steckplatz = 0 THEN steckplatz := 1 FI;{} cursor (testfenster, 2, 7);{} IF (kanalnummer < 1) OR (kanalnummer > 49){} THEN out (testfenster, "Unzulässige Kanalnummer! "); FALSE{} ELIF (port = 0) OR (port > max portanzahl) OR kein eingabeport{} + THEN out (testfenster, "Dies ist kein Eingabe-Kanal! "); FALSE{} ELSE out (testfenster, " "); TRUE{} FI.{} kein eingabeport:{} (port betriebsart <> digital ein) AND (port betriebsart <> analog ein).{} port betriebsart: karte [sorte][port][betriebsart].{} sorte : kartenart [steckplatz].{} teste eingabe vom kanal:{} cursor (testfenster, 1, 8);{} out (testfenster, testfenster xsize * "-");{} cursor (testfenster, 2, 11);{} + out (testfenster, "Eingelesener Wert: ");{} testfenster fussnote (" ");{} menufootnote ("'Werte einlesen' beenden: ");{} REP cursor (testfenster, 21, 11);{} out (text (eingabe (kanalnummer), 3));{} warte (0.1){} UNTIL abbruch gewuenscht PER;{} IF (steckplatzart = einzel) AND (kartenart [1] = ea karte){} THEN LEAVE teste interfaceeingabe{} ELSE cursor (testfenster, 1, 5);{} out (testfenster, (2 * testfenster xsize) * " ");{} + cursor (testfenster, 2, 11);{} out (testfenster, " "){} FI.{}END PROC teste interfaceeingabe;{}TEXT PROC kanalbeschreibung (INT CONST steckplatz, port):{} IF steckplatzart = compact{} THEN port auf compactbox{} ELSE port auf steckkarte{} FI.{} port auf compactbox:{} portbeschreibung + " der Compact-Box".{} port auf steckkarte:{} SELECT kartenart [steckplatz] OF{} CASE kombi : portbeschreibung + " der Kombi-Karte"{} CASE ea karte : portbeschreibung + " der E/A-Karte"{} + CASE da karte : portbeschreibung + " der D/A-Karte"{} CASE ad karte : portbeschreibung + " der A/D-Karte"{} OTHERWISE ""{} END SELECT.{} portbeschreibung:{} SELECT 2 + karte [kartenart [steckplatz]][port][betriebsart] OF{} CASE 1 : "Digitalausgang"{} CASE 3 : "Digitaleingang"{} CASE 0 : "Analogausgang " + text (port){} CASE 4 : "Analogeingang " + text (port){} OTHERWISE ""{} END SELECT.{}END PROC kanalbeschreibung;{}PROC trage steckplatzbelegung ein (INT CONST steckplatz, art):{} + INT VAR port;{} kartenart [steckplatz] := art;{} klaere spannungsbereiche;{} FOR port FROM 1 UPTO max portanzahl REP{} trage kanaldaten ein (kanalnummer, spannungsbereich, portdaten);{} IF steckplatz = 1{} THEN trage kanaldaten ein (port, spannungsbereich, portdaten){} FI{} PER.{} kanalnummer: port + 10 * steckplatz.{} portdaten : karte [kartenart [steckplatz]][port].{} spannungsbereich:{} IF port = 1{} THEN bereich von e1{} ELIF port = 2{} THEN bereich von e2{} + ELSE SPANNUNG : (0.0, 0.0){} FI.{} klaere spannungsbereiche:{} SPANNUNG VAR bereich von e1, bereich von e2;{} SELECT kartenart [steckplatz] OF{} CASE kombi : spannungsbereich 0 bis 5 volt{} CASE da karte : setze spannungsbereiche{} CASE ad karte : erfrage adkarte schalterstellungen{} OTHERWISE alles auf 0 setzen{} END SELECT.{} spannungsbereich 0 bis 5 volt:{} bereich von e1 := SPANNUNG : (0.0, 5.0);{} bereich von e2 := SPANNUNG : (0.0, 5.0).{} setze spannungsbereiche:{} + bereich von e1 := SPANNUNG : (-5.0, 5.0);{} bereich von e2 := SPANNUNG : ( 0.0, 5.0).{} alles auf 0 setzen:{} bereich von e1 := SPANNUNG : (0.0, 0.0);{} bereich von e2 := SPANNUNG : (0.0, 0.0).{}erfrage adkarte schalterstellungen:{} REP{} hole schalterstellung{} UNTIL schalterstellung sinnvoll PER;{} bestimme spannungsbereiche (schalterzustand, bereich von e1, bereich von e2).{} hole schalterstellung:{} TEXT VAR schalterzustand := menuanswer (infotext, "00000000", 5).{} infotext:{} + ueberschrift{} + " Bitte die aktuelle Schalterstellung eintragen: "13""13""{} + " Es bedeutet : 1 - Schalterstellung 'on' "13""{} + " 0 - Schalterstellung 'off' "13""13""{} + " Nummer : 12345678 "13""{} + " |||||||| ".{} ueberschrift:{} IF steckplatzart = mehrfach{} THEN " "15"Angabe der Schalterstellungen auf der A/D-Karte "14""13""{} + " "15" in Steckplatz "{} + text (steckplatz) + ": "14""13""13""{} + ELSE " "15"Angabe der Schalterstellungen auf der A/D-Karte: "14""13""13""{} FI.{} schalterstellung sinnvoll:{} (length (schalterzustand) = 8) AND nur nullen und einsen.{} nur nullen und einsen:{} BOOL VAR ok := TRUE; INT VAR m;{} FOR m FROM 1 UPTO 8 REP{} IF NOT ((schalterzustand SUB m) = "1" OR (schalterzustand SUB m ) = "0"){} THEN ok := FALSE{} FI{} PER;{} ok.{}END PROC trage steckplatzbelegung ein;{}INT PROC ermittelte kartenart (INT CONST steckplatz):{} TEXT CONST info e :: " "15"Angabe der Interfacekarte: "14" "13""13""{} + + " k Kombikarte "13""{} + " e E / A - Karte "13""{} + " d D / A - Wandler - Karte "13""{} + " a A / D - Wandler - Karte "13""{} + " 0 Keine Steckkarte ",{} info m :: " "15"Angabe der Interfacekarte für Steckplatz "{} + text (steckplatz) + ": "14" "13""13""{} + " k Kombikarte "13""{} + + " e E / A - Karte "13""{} + " d D / A - Wandler - Karte "13""{} + " a A / D - Wandler - Karte "13""{} + " 0 Keine Steckkarte ",{} liste :: "Kombi"13"E/A"13"D/A"13"A/D"13"Keine",{} tasten :: "keda0KEDA";{} INT VAR auswahl := menualternative (infotext, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101, 106 : kombi{} + CASE 2, 102, 107 : eakarte{} CASE 3, 103, 108 : dakarte{} CASE 4, 104, 109 : adkarte{} OTHERWISE keine karte{} END SELECT.{} infotext:{} IF steckplatz = 0{} THEN info e{} ELSE info m{} FI.{}END PROC ermittelte kartenart;{}PROC zeige kanalbelegung (INT CONST steckplatz):{} ROW 4 TEXT VAR kanalnummer;{} kanalnummer [1] := text (steckplatz + 1, 2);{} kanalnummer [2] := text (steckplatz + 2, 2);{} kanalnummer [3] := text (steckplatz + 3, 2);{} + kanalnummer [4] := text (steckplatz + 4, 2);{} IF steckplatzart = compact{} THEN zeige compactboxbelegung{} ELSE zeige steckplatz mit karte{} FI.{} zeige steckplatz mit karte:{} SELECT kartenart [steckplatznummer] OF{} CASE kombi : zeige steckplatz mit kombi{} CASE eakarte: zeige steckplatz mit eakarte{} CASE dakarte: zeige steckplatz mit dakarte{} CASE adkarte: zeige steckplatz mit adkarte{} OTHERWISE zeige steckplatz ohne karte{} END SELECT.{} + steckplatznummer:{} IF steckplatz = 0{} THEN 1{} ELSE steckplatz DIV 10{} FI.{} zeige compactboxbelegung:{} menuinfo ({} " "15"Eingestellt: Compactbox "14" "13""13""{} + " Belegung der Kanäle: "13""13""13""{} + kanalnummeranzeige kombikarte).{} zeige steckplatz mit kombi:{} menuinfo (ueberschrift + " mit Kombikarte: "14" "13""13""{} + " Belegung der Kanäle: "13""13""13""{} + kanalnummeranzeige kombikarte).{} + zeige steckplatz mit eakarte:{} menuinfo (ueberschrift + " mit E / A - Karte: "14" "13""13""{} + " Belegung der Kanäle: "13""13""13""{} + kanalnummeranzeige eakarte).{} zeige steckplatz mit dakarte:{} menuinfo (ueberschrift + " mit D / A - Karte: "14" "13""13""{} + " Belegung der Kanäle: "13""13""{} + kanalnummeranzeige dakarte).{} zeige steckplatz mit adkarte:{} hole spannungsbereiche;{} menuinfo (" " + ueberschrift + " mit A / D - Karte: "14""13""13""{} + + " Zwei analoge Eingänge stehen zur Verfügung: "13""13""{} + kanalnummeranzeige adkarte).{} hole spannungsbereiche:{} SPANNUNG VAR e1 bereich, e2 bereich;{} hole spannungsbereich (steckplatz + 1, e1 bereich [1], e1 bereich [2]);{} hole spannungsbereich (steckplatz + 2, e2 bereich [1], e2 bereich [2]).{} zeige steckplatz ohne karte:{} IF steckplatz = 0{} THEN menuinfo ({} " "15"Einzelsteckplatz ohne Steckkarte: "14" "13""13""13""{} + " Es sind weder Ein- noch Ausgaben möglich! "13""){} + ELSE menuinfo ({} " "15"Steckplatz "{} + text (steckplatz DIV 10) + " ohne Steckkarte: "14""13""13""13""{} + " Es sind hier weder Ein- noch Ausgaben möglich! "13""){} FI.{} ueberschrift:{} IF steckplatz = 0{} THEN " "15"Einzelsteckplatz"{} ELSE " "15"Steckplatz " + text (steckplatz DIV 10){} FI.{} kanalnummeranzeige kombikarte:{} " "15"Kanal " + kanalnummer [1]{} + ": "14" Analogeingang 1 (E1) "13""13""{} + + " "15"Kanal " + kanalnummer [2]{} + ": "14" Analogeingang 2 (E2) "13""13""{} + " "15"Kanal " + kanalnummer [3]{} + ": "14" Digitaleingang "13""13""{} + " "15"Kanal " + kanalnummer [4]{} + ": "14" Digitalausgang "13"".{} kanalnummeranzeige eakarte:{} " "15"Kanal " + kanalnummer [1]{} + ": "14" Digitaleingang "13""13""{} + " "15"Kanal " + kanalnummer [2]{} + ": "14" Digitalausgang "13""13""{} + + " ( "15"Kanal " + kanalnummer [3]{} + ": "14" Digitaleingang (= Kanal " + kanalnummer [1] + ") )"13""13""{} + " ( "15"Kanal " + kanalnummer [4]{} + ": "14" Digitalausgang (= Kanal " + kanalnummer [2] + ") )"13"".{} kanalnummeranzeige adkarte:{} " "15"Kanal " + kanalnummer [1]{} + ": "14" (E1) Spannungsbereich " + bereich1 + ""13""13""{} + " "15"Kanal " + kanalnummer [2]{} + ": "14" (E2) Spannungsbereich " + bereich2 + ""13"".{} + bereich1:{} IF e1 bereich [1] = 0.0{} THEN " 0.000 V - +" + text (e1 bereich [2], 6, 3) + " V "{} ELSE text (e1 bereich [1], 7, 3) + " V - +" + text (e1 bereich [2], 6, 3) + " V "{} FI.{} bereich2:{} IF e2 bereich [1] = 0.0{} THEN " 0.000 V - +" + text (e2 bereich [2], 6, 3) + " V"{} ELSE text (e2 bereich [1], 7, 3) + " V - +" + text (e2 bereich [2], 6, 3) + " V"{} FI.{} kanalnummeranzeige dakarte:{} " Die Karte stellt einen Analogausgang zur Verfügung, "13""{} + + " der auf zwei Arten angesprochen werden kann: "13""13""13""{} + " "15"Kanal " + kanalnummer [1]{} + ": "14" Spannungsbereich -5 V - +5 V "13""13""{} + " "15"Kanal " + kanalnummer [2]{} + ": "14" Spannungsbereich 0 V - +5 V "13"".{}END PROC zeige kanalbelegung;{}PROC bestimme spannungsbereiche (TEXT CONST schalterstellung,{} SPANNUNG VAR bereich von e1,{} SPANNUNG VAR bereich von e2):{} + bestimme bereich von e1;{} bestimme bereich von e2.{} bestimme bereich von e1:{} IF schalter 3 geschlossen{} THEN umax1 := 0.25{} ELIF schalter 2 geschlossen{} THEN umax1 := 2.5{} ELIF schalter 1 geschlossen{} THEN umax1 := 25.0{} ELSE umax1 := 0.0{} FI;{} IF schalter 8 geschlossen{} THEN symmetrische spannungsmessung ueber e1{} ELSE asymmetrische spannungsmessung ueber e1{} FI.{} schalter 1 geschlossen: (schalterstellung SUB 1) = on.{} + schalter 2 geschlossen: (schalterstellung SUB 2) = on.{} schalter 3 geschlossen: (schalterstellung SUB 3) = on.{} schalter 8 geschlossen: (schalterstellung SUB 8) = on.{} umin1: bereich von e1 [1].{} umax1: bereich von e1 [2].{} symmetrische spannungsmessung ueber e1:{} umax1 := umax1 / 2.0;{} umin1 := - umax1.{} asymmetrische spannungsmessung ueber e1:{} umin1 := 0.0.{} bestimme bereich von e2:{} IF schalter 6 geschlossen{} THEN umax2 := 0.25{} ELIF schalter 5 geschlossen{} + THEN umax2 := 2.5{} ELIF schalter 4 geschlossen{} THEN umax2 := 25.0{} ELSE umax2 := 0.0{} FI;{} IF schalter 7 geschlossen{} THEN symmetrische spannungsmessung ueber e2{} ELSE asymmetrische spannungsmessung ueber e2{} FI.{} schalter 4 geschlossen: (schalterstellung SUB 4) = on.{} schalter 5 geschlossen: (schalterstellung SUB 5) = on.{} schalter 6 geschlossen: (schalterstellung SUB 6) = on.{} schalter 7 geschlossen: (schalterstellung SUB 7) = on.{} + umin2: bereich von e2 [1].{} umax2: bereich von e2 [2].{} symmetrische spannungsmessung ueber e2:{} umax2 := umax2 / 2.0;{} umin2 := - umax2.{} asymmetrische spannungsmessung ueber e2:{} umin2 := 0.0.{} on: "1".{}END PROC bestimme spannungsbereiche{}END PACKET ls prozess 5{} + diff --git a/app/gs.process/1.02/src/ls-Prozess-gen b/app/gs.process/1.02/src/ls-Prozess-gen new file mode 100644 index 0000000..b93e4b9 --- /dev/null +++ b/app/gs.process/1.02/src/ls-Prozess-gen @@ -0,0 +1,146 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Prozess/gen ** + ** ** + ** Version 1.02 ** + ** ** + ** (Stand : 26.01.90) ** + ** ** + ** ** + ** ** + ** Autoren: Bruno Pollok, Bielefeld ** + ** Wolfgang Weber, Bielefeld ** + ** ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ********************************************************** + ********************************************************** + + *) +WINDOW VAR fenster := window (1, 1, 79, 24); +TEXT CONST titel :: ""15"ls-Prozess : Automatische Generierung "14"", + ueberschrift :: "Auswahl der Interface-Anpassung", + hinweis :: "Bitte gewünschte Anpassung ankreuzen!"; +TEXT VAR anpassung; +BOOL VAR alles okay; +frage nach diskette; +IF alles okay + THEN installation +FI; +PROC installation: + THESAURUS VAR thes :: infix namen (ALL archive, "ls-Prozess 1"); + anpassung := boxone (fenster, thes, ueberschrift, hinweis, FALSE); + cursor (1, 3); + out (""4""); + IF anpassung <> "" + THEN installiere ls prozess + ELSE warnung + FI. + warnung: + out (""7""); + line (2); + out (" FEHLER: Es muß unbedingt eine Anpassung ausgewaehlt werden!"); + cursor (5, 7); + IF no ("Generierung abbrechen") + THEN installation + FI. +END PROC installation; +PROC installiere ls prozess: + forget ("ls-Prozess/gen", quiet); + frage evtl nach interfacekanal; + check off; + warnings off; + installiere (anpassung); + installiere ("ls-Prozess 2"); + installiere ("ls-Prozess 3"); + installiere ("ls-Prozess 4"); + installiere ("ls-Prozess 5"); + + installiere ("ls-MENUKARTE:Prozess"); + check on; + release (archive); + setze ggf interface kanal; + global manager. + frage evtl nach interfacekanal: + IF adapter fuer separate schnittstelle + THEN erfrage kanalnummer + FI. + erfrage kanalnummer: + INT VAR kanalnummer; + line (2); + REP put (" Gib Interfacekanal:"); + get (kanalnummer); + IF kanalnummer < 1 OR kanalnummer > 24 + THEN out (""7" Unzulaessige Kanalnummer!"); + line (2) + + FI + UNTIL kanalnummer > 0 AND kanalnummer < 25 PER; + cursor (1, 3); + out (""4""). + setze ggf interfacekanal: + IF adapter fuer separate schnittstelle + THEN do ("interface kanal (" + text (kanalnummer) + ")") + FI. + adapter fuer separate schnittstelle: + (anpassung = "ls-Prozess 1 für AKTRONIC-Adapter") OR + (anpassung = "ls-Prozess 1 für MUFI als Endgerät"). +END PROC installiere ls prozess; +PROC installiere (TEXT CONST datei): + INT VAR zeile, spalte; + + hole datei vom archiv; + IF datei = "ls-MENUKARTE:Prozess" + THEN schicke zu menukarten task + ELSE insertiere + FI. + hole datei vom archiv: + line (2); + out ("'" + datei + "' "); + get cursor (spalte, zeile); + IF NOT exists (datei) + THEN out ("wird von der Archivdiskette geholt."); + fetch (datei, archive) + FI. + insertiere: + cursor (spalte, zeile); + out (""5""); + out ("wird insertiert."); + insert (datei); + cursor (spalte, zeile); + + out (""4""); + forget (datei, quiet). + schicke zu menukarten task: + cursor (spalte, zeile); + out (""5""); + command dialogue (FALSE); + save (datei, /"ls-MENUKARTEN"); + command dialogue (TRUE); + forget (datei, quiet). +END PROC installiere; +PROC frage nach diskette: + page; + out (center (fenster, titel)); + line (4); + putline (" Ist das Archiv angemeldet,"); + putline (" die Diskette mit 'ls-Prozess' eingelegt"); + IF yes (" und das Laufwerk geschlossen") + + THEN alles okay := TRUE + ELSE alles okay := FALSE; + warnung + FI. + warnung: + line (3); + out (" FEHLER : Diskettenzugriff nicht gesichert!"7""); + line (2); + out (" Bitte Fehler beseitigen und Programm neu starten!"); + line (5) +END PROC frage nach diskette; + + diff --git a/app/gs.warenhaus/1.01/doc/Anhang Warenhaus b/app/gs.warenhaus/1.01/doc/Anhang Warenhaus new file mode 100644 index 0000000..9388ceb --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/Anhang Warenhaus @@ -0,0 +1,65 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (100)# +#headodd# +#center#gs-Warenhaus#right#% + +#end# +#headeven# +%#center#gs-Warenhaus + +#end# +#center#1 + +#center##on("b")##Anhang#off("b")# + +#on("b")##center#Muster für Codekarten#off("b")# + + +-------------------+ + | O O O O O O O O | + | | + | | + | | + | | + | | + | | + | | + | ----------------- | + +-------------------+ + + + + +--------------------+ + | | + | O O O O | + | | + | | + |W A R E N K A R T E | + | | + | | + | Artikel | + | ---------------- | + | | + +--------------------+ + +#page# + + + +------------------------+ + | | + | O O O O O O | + | | + | K U N D E N K A R T E | + | | + | | + | Name | + | ---------------------- | + | | + | | + +------------------------+ + + + + + + diff --git a/app/gs.warenhaus/1.01/doc/Inhalt Warenhaus b/app/gs.warenhaus/1.01/doc/Inhalt Warenhaus new file mode 100644 index 0000000..a9b720d --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/Inhalt Warenhaus @@ -0,0 +1,50 @@ +#limit (11.5)##pagelength (16.5)##pageblock# +#start (1.8,0.0)# +Inhaltsverzeichnis + + +1 Was kann gs-Warenhaus 1-1 + +2 Aufbau von gs-Warenhaus 2-1 + +3 Installation von gs-Warenhaus 3-1 +3.1 Voraussetzungen 3-1 +3.2 Lieferumfang 3-1 +3.3 Installation 3-2 +3.4 Einrichten mehrerer Hauptstellen 3-8 + +4 Anschluß eines Codekartenlesers 4-1 +4.1 Hardware-Voraussetzungen 4-1 +4.2 Verwendung des MUFI 4-2 +4.2.1 Einstellungen am MUFI 4-3 +4.2.2 MUFI im Terminalkanal 4-5 +4.2.3 MUFI als Endgerät 4-6 +4.3 Verwendung des AKTRONIC-Adapters 4-7 +4.4 Konfiguration der seriellen Schnittstelle 4-8 +4.5 Verbindung der Hardware-Komponenten 4-10 + +5 Beschreibung der Menufunktionen 5-1 +5.1 Kurzhinweise zur Bedienung des Menus 5-1 +5.2 Menufunktionen zum Oberbegriff 'Info' 5-4 +5.3 Menufunktionen zum Oberbegriff 'Eingabeart' 5-7 +5.4 Menufunktionen zum Oberbegriff 'Kommandos' 5-9 +5.5 Menufunktionen zum Oberbegriff 'Programme' 5-18 +5.6 Menufunktionen zum Oberbegriff 'Filialdaten' 5-24 +5.7 Menufunktionen zum Oberbegriff 'Archiv' 5-28 + +6 Beschreibung der Programmierschnittstelle 6-1 +6.1 Schreibweisen und Syntaxregeln in GRIN-Programmen 6-4 +6.2 Kontrollstrukturen 6-8 +6.3 Detailbeschreibung der Warenhaus-Grundbefehle 6-13 + +7 Weitere Kommandos (für Systembetreuer) 7-1 + +Anhang: Muster für Codekarten + + + + + + + + diff --git a/app/gs.warenhaus/1.01/doc/gs-Warenhaus handbuch.impressum b/app/gs.warenhaus/1.01/doc/gs-Warenhaus handbuch.impressum new file mode 100644 index 0000000..3fbb371 --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus handbuch.impressum @@ -0,0 +1,89 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#gs-Warenhaus + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# + +#free (4.0)##on("b")# +#center#gs-Warenhaus + + +#center#Benutzerhandbuch + + +#center#Version 1.0 + + +#off("b")##center#copyright +#center#Eva Latta-Weber +#center#Software- und Hardware-Systeme, 1988 +#center#ERGOS GmbH, 1990 +#page# +#block# +#center#____________________________________________________________________________ + + +Copyright:  ERGOS GmbH   März 1990 + + Alle Rechte vorbehalten. Insbesondere ist die Überführung in + maschinenlesbare Form sowie das Speichern in Informations­ + systemen, auch auszugsweise, nur mit schriftlicher Einwilligung + der ERGOS GmbH gestattet. + + +#center#____________________________________________________________________________ + +Es kann keine Gewähr übernommen werden, daß das Programm für eine +bestimmte Anwendung geeignet ist. Die Verantwortung dafür liegt beim +Anwender. + +Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrektheit und +Vollständigkeit der Angaben kann keine Gewähr übernommen werden. Das +Handbuch kann jederzeit ohne Ankündigung geändert werden. + +Texterstellung :  Dieser Text wurde mit der ERGOS-L3 Textverarbeitung + erstellt und aufbereitet und auf einem Kyocera Laser­ + drucker gedruckt. + + + + +#center#___________________________________________________________________________ + + + +Ergonomic Office Software GmbH + +Bergstr. 7 Telefon: (02241) 63075 +5200 Siegburg Teletex: 2627-2241413=ERGOS + Telefax: (02241) 63078 + + +#center#____________________________________________________________________________ + + diff --git a/app/gs.warenhaus/1.01/doc/gs-Warenhaus-1 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-1 new file mode 100644 index 0000000..ca79094 --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-1 @@ -0,0 +1,124 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (3)# +#headodd# +#center#gs-warenhaus#right#% + +#end# +#headeven# +%#center#gs-warenhaus + +#end# +#center#1  Was kann gs-Warenhaus + + +Das Programmpaket #on("b")#gs-Warenhaus#off("b")# entstand auf der Grundlage der projekt­ +orientierten Unterrichtseinheit "WARENHAUS", die vom 'Landesinstitut für Schule +und Weiterbildung' (LSW) in Soest für den Bereich der 'Informations- und +kommunikationstechnologischen Grundbildung' (kurz: GRIN) entwickelt wurde. + +Unter #on("b")#1.1 Thema und Ziele #off("b")# ist in dem zugehörigen Begleitheft folgendes zu +finden: + +#i1#"Die Schülerinnen und Schüler sollen in dieser Unterrichtseinheit die An­ +wendungen neuer Technologien im Warenhaus kennenlernen und dabei sowohl +die grundlegenden technologischen Zusammenhänge erarbeiten als auch die +Auswirkungen reflektieren, die sich durch ihren Einsatz ergeben. Sie werden +dabei nicht nur die Rolle der Kunden einnehmen, sondern auch die Interessen +der Angestellten und die der Geschäftsleitung in ihre Beurteilung mit einbe­ +ziehen. + +Diese komplexen Zusammenhänge werden den Schülerinnen und Schülern im 8. +Schuljahr nähergebracht, indem sie veranlaßt werden, in einem Modell-Waren­ +haus selbst schrittweise das Modell eines Warenwirtschaftssystems aufzubauen +und damit zu arbeiten. + +In diesem Modell-Warenhaus kommt dem Umgang mit dem Computer eine +besondere Bedeutung zu. Mit Hilfe des Rechners, an den ein Codekartenleser +angeschlossen ist, und des zugehörigen Programms werden die wesentlichen +Bestandteile eines modernen Kassensystems abgebildet. + +Mit dem Codekartenleser kann das Merkmal des automatischen Dateneinlesens +vereinfacht dargestellt werden. Programmabläufe, Bildschirmausgaben werden +nicht nur über Tastatureingaben der Benutzer beeinflußt, sondern auch durch +das Lesen verschlüsselter Informationen. Am Beispiel des Lesegerätes wird zum +#page# +einen der Rationalisierungseffekt an der Kasse verdeutlicht, es lassen sich zum +anderen aber auch Fragen der Zugangsberechtigung durch maschinenlesbare +Ausweiskarten ansprechen. + +Das zur Verfügung stehende Programm erlaubt es, daß die Schülerinnen und +Schüler schrittweise die zentralen Funktionen eines modernen Warenwirtschafts­ +systems kennenlernen. Neben der maschinellen Datenerfassung mit Hilfe des +Lesegeräts und der Decodierung von Informationen sind dies z.B.: + +- automatische Abrechnung, +- Speicherung von Warendaten, +- Kontrolle des Lagerbestandes, +- Informationen über Verkaufszahlen, +- automatische Nachbestellung, +- Speicherung von Kundendaten, +- Zusammenfassung von Informationen aus verschiedenen Filialen, +- Erstellen von Übersichten. + +Die Schülerinnen und Schüler arbeiten dabei mit einer benutzerfreundlichen +Programmierumgebung. Diese bietet einerseits die Möglichkeit, die Befehle direkt +aufzurufen, mit denen alle Funktionen dieses vereinfachten Warenwirtschafts­ +systems ausgeführt werden können, wie etwa Dateien aufbauen, einkaufen und +Listen erstellen. Andererseits stellt die Programmierumgebung weitere Befehle +zur Verfügung, mit denen einige dieser Funktionen auch 'programmiert' werden +können."#off("b")# + +Soweit zu Thema und Zielen dieser Unterrichtseinheit. Für weitere didaktisch- +methodische Informationen zu dieser Reihe verweisen wir auf das entsprechende +Begleitheft des LSW. +(Vertrieb: Soester Verlagskontor, Jakobistraße 46, 4770 Soest; Bestellnummer 1710) +#page# +Da bei der Software-Entwicklung für GRIN vom LSW das Betriebssystem EUMEL nicht +mit berücksichtigt wird, erscheint es notwendig, durch Eigeninitiativen wenigstens +einige GRIN - Projekte unter EUMEL zur Verfügung zu stellen, um den Schulen, die +mit EUMEL arbeiten, nicht gänzlich den Zugang zu GRIN zu verwehren. + +Das Projekt WARENHAUS bietet sich dabei besonders an, weil die Vernetzungen +innerhalb eines Warenwirtschaftssystems mit einem Mehrplatz-System und der +Möglichkeit der Intertask-Kommunikation wesentlich wirklichkeitsnäher aufzeigbar +sind als mit einem reinen Einzelplatz-System wie z.B. MS DOS, bei dem die +Kommunikation nur über den Transport von Disketten geregelt wird. (Ein Netzwerk +ist in der Software der LSW nicht vorgesehen.) + +#on("b")#gs-Warenhaus#off("b")# umfaßt die wesentlichen Funktionen der vom LSW für MS DOS +erstellten Programmierumgebung WARENHAUS-2. Es ist jedoch keine genaue 'Nach­ +bildung' dieser Software, sondern eher eine Realisierung des 'Vorbildes' unter +Berücksichtigung der besonderen Gegebenheiten des EUMEL-Systems, wobei sowohl +am äußeren Erscheinungsbild als auch inhaltlich Änderungen und Erweiterungen +vorgenommen wurden. Eingebettet ist #on("b")#gs-Warenhaus#off("b")# in die menüorientierte +Benutzerschnittstelle #on("b")#gs-DIALOG#off("b")#. + +Ein Codekartenleser kann in Verbindung mit einem Interface (z.B. dem MUFI der +Firma BICOS) verwendet werden, ist für die Nutzung des Programmes aber nicht +unbedingt erforderlich. + +Da zur Zeit der Entstehung dieses Programms GRIN an den Schulen noch nicht +etabliert ist und man mit (vorerst) nur einem Projekt dem Ansatz von GRIN sicher +nicht gerecht werden kann, ist #on("b")#gs-Warenhaus#off("b")# flexibel angelegt. Es enthält neben +einer Programmierumgebung, in der die vom LSW für GRIN entwickelten Befehle und +Syntaxregeln benutzt werden, eine weitere, in der in gewohnter ELAN-Syntax ge­ +arbeitet werden kann, so daß es z.B. ebenfalls für den Unterricht in Klasse 9/10 (für +spezielle Fragestellungen evtl. auch in der Sek. II) verwendbar ist. +#page# +Natürlich ist #on("b")#gs-Warenhaus#off("b")# #i1#kein#off("b")# Verwaltungsprogramm für 'echte' Warenhäuser +oder gar ganze Warenwirtschaftssysteme, es ist vielmehr ein Simulationsprogramm, +das die Vorgänge in solch einem System anhand eines stark vereinfachten Modells +klarmachen soll. Aus diesem Grunde werden Ihnen beim Umgang mit diesem Pro­ +gramm wahrscheinlich eine ganze Reihe von Erweiterungsmöglichkeiten und +Funktionen einfallen, die das Programm nicht bietet. Denken Sie dabei bitte aber +immer daran, daß #on("b")#gs-Warenhaus#off("b")# in erster Linie für den Einsatz in GRIN oder im +WP-Unterricht konzipiert wurde, vornehmlich also von absoluten 'Anfängern' auf dem +Gebiet des Umgangs mit Rechnern genutzt wird, die von einer zu großen Fülle von +Programmfunktionen nur verwirrt würden. + +Wir werden Ihnen in den folgenden Kapiteln dieses Handbuchs den Umgang mit den +Funktionsangeboten von #on("b")#gs-Warenhaus#off("b")# erklären, auf die Umsetzungsmöglichkeiten +der am Anfang dieses Kapitels erwähnten Ziele im Unterricht gehen wir jedoch nicht +ein. Beschaffen Sie sich dafür bitte das bereits oben angegebene Begleitheft des LSW. + diff --git a/app/gs.warenhaus/1.01/doc/gs-Warenhaus-2 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-2 new file mode 100644 index 0000000..f3f1284 --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-2 @@ -0,0 +1,72 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (5)# +#headodd# +#center#gs-warenhaus#right#% + +#end# +#headeven# +%#center#gs-warenhaus + +#end# +#center##on("b")#2  Aufbau von gs-Warenhaus#off("b")# + +#on("b")#gs-Warenhaus#off("b")# bietet die Möglichkeit, nicht nur #us#ein#use# Warenhaus, sondern eine +Warenhaus-Kette im Modell nachzubilden. Solch eine Warenhauskette besteht hier +stets aus einer #us#Hauptstelle#use# und einer oder mehrerer (bis zu 10) #us#Filialen#use#. Damit die +Filialen auf die zentralen Daten der Warenhauskette zugreifen können, verfügt jede +Hauptstelle über eine #us#Zentrale#use#, die jederzeit angerufen werden kann. Für die +Kommunikation untereinander gehört zu jeder Filiale eine (Filial-) #us#Verwaltung#use#, bei +der die aktuellen Filialdaten erfragt werden können. + + +Realisiert wird dieser Aufbau durch verschiedene Tasks und der Möglichkeit der +Intertask-Kommunikation. Unter einer Task, in der #on("b")#gs-Warenhaus#off("b")# insertiert ist, +können eine oder mehrere Tasks als Hauptstellen angemeldet werden (siehe '3.3 +Installation' und '7 Weitere Kommandos'). So kann man z.B. für verschiedene +Klassen gleichzeitig Warenhausketten einrichten. Zu beachten ist, daß verschiedene +Ketten untereinander völlig unabhängig sind und dadurch #us#nicht#use# miteinander +kommunizieren können. + + +Jede Hauptstellen-Task richtet sich automatisch eine Sohn-Task als Zentrale ein. +Werden nun Sohn-Tasks einer Hauptstellen-Task angemeldet, so werden diese zu +Filialen der entsprechenden Hauptstelle, wobei ihnen automatisch eine Filialnummer +zugeteilt wird, die identisch ist mit der Kanalnummer des benutzten Terminals. +(Steht keine Mehrplatzanlage zur Verfügung, so läßt sich nur #us#eine#use# Filiale einrichten; +die Filialnummer ist dann in der Regel 1.) + + +Die Filial-Tasks ihrerseits legen beim Starten von #on("b")#gs-Warenhaus#off("b")# automatisch jeweils +eine Sohn-Task als (Filial-) Verwaltung an. +#page# +Insgesamt ergibt sich folgender schematischer Aufbau (die Pfeile zeigen die +Kommunikationsmöglichkeiten an): + + +#on("b")# + W A R E N H A U S + / | \ + Hauptstelle A Hauptstelle B Hauptstelle C . . . + + / | \ +Zentrale A Filiale A1 Filiale A2 . . . + ^ + | + | Verwaltg.A1 Verwaltg.A2 . . . + | ^ ^ + | | | + --------------------------- . . . +#off("b")# + + + + + + + + + + + + diff --git a/app/gs.warenhaus/1.01/doc/gs-Warenhaus-3 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-3 new file mode 100644 index 0000000..ffef881 --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-3 @@ -0,0 +1,309 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (7)# +#headodd# +#center#gs-Warenhaus#right#% + +#end# +#headeven# +%#center#gs-Warenhaus + +#end# +#center#1 + +#center##on("b")#3  Installation von gs-Warenhaus#off("b")# + + +Bevor Sie #on("b")#gs-Warenhaus#off("b")# auf Ihrem Computer benutzen können, müssen Sie das +Programm zunächst installieren. Wenn #on("b")#gs-Warenhaus#off("b")# auf Ihrem System schon zur +Verfügung steht, können Sie dieses Kapitel ruhig überspringen. + + + +#on("b")#3.1  Voraussetzungen#off("b")# + +Um #on("b")#gs-Warenhaus#off("b")# auf Ihrem Computer betreiben zu können, muß das EUMEL- +Betriebssystem installiert sein. #on("b")#gs-Warenhaus#off("b")# setzt die Multi-User-Version voraus +und ist lauffähig ab Version 1.8.0. #on("b")#gs-Warenhaus#off("b")# setzt weiterhin voraus, daß auf +Ihrem Computer bereits das Programm #on("b")#gs-DIALOG#off("b")# (ab Version 1.1) installiert ist. + + + +#on("b")#3.2  Lieferumfang#off("b")# + +#on("b")#gs-Warenhaus#off("b")# wird auf einer Diskette geliefert, die alle notwendigen Programme +enthält (die Installation von #on("b")#gs-DIALOG#off("b")# wird dabei vorausgesetzt!). Um den Inhalt +der Diskette feststellen zu können, starten Sie Ihr System und bringen es dazu, daß +'gib kommando:' erscheint. Dann legen Sie die Diskette ein und geben das +Kommando: + + +#on("b")#archive("gs-Warenhaus"); list(archive); release(archive) #off("b")# +#page# +Anschließend erscheint eine Übersicht der auf dem Archiv vorhandenen Programme. +Folgende Dateinamen sollten sich in der Übersicht befinden: + + "gs-MENUKARTE:Warenhaus" + "gs-Warenhaus 0: ohne Kartenleser" + "gs-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter" + "gs-Warenhaus 0: mit Kartenleser an MUFI als Endgerät" + "gs-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal" + "--------------------------------------------" + "gs-Warenhaus 1" + "gs-Warenhaus 2" + "gs-Warenhaus 3" + "gs-Warenhaus 4" + "gs-Warenhaus 5" + "gs-Warenhaus/gen" + +Eventuell können noch weitere Namen auf der Diskette vorhanden sein. Wenn Sie den +Inhalt der Diskette kontrolliert haben und diese Dateien auf der Diskette vorhanden +sind, können Sie #on("b")#gs-Warenhaus#off("b")# installieren. + +Sollten Sie statt der Übersicht eine Fehlermeldung erhalten, überprüfen Sie bitte, ob +die Diskette das richtige Format besitzt oder ob Ihr Diskettenlaufwerk Probleme +macht. Sollten dagegen Programme fehlen, so reklamieren Sie die Diskette. + + + +#on("b")#3.3  Installation#off("b")# + +#on("b")#gs-Warenhaus#off("b")# muß in einer Task installiert werden, in der bereits das Programm +#on("b")#gs-DIALOG#off("b")# zur Verfügung steht. Alle Söhne und Enkel der neuen Task können +anschließend das Warenhaus-Modell aufrufen. Richten Sie also eine Task als Sohn +#page# +der Task ein, in der auf Ihrem Computer bereits #on("b")#gs-DIALOG#off("b")# installiert ist. Wir +nehmen hier an, daß #on("b")#gs-DIALOG#off("b")# in der Task 'MENU' installiert ist und die neue +Task den Namen 'WARENHAUS' erhalten soll. (Sie können für die Task auch einen +beliebigen anderen Namen wählen): + +#on("b")# + (Supervisor - Taste) + +#off("b")# + --> gib supervisor kommando: +#on("b")# + begin ("WARENHAUS","MENU") +#off("b")# + + --> gib kommando: + +(Arbeiten mehrere Personen mit dem Computer, dann ist es sinnvoll, diese Task vor +unbefugtem Zugriff durch ein Passwort zu schützen. Wie das gemacht wird, können +Sie in Ihrem EUMEL-Benutzerhandbuch erfahren.) + +Legen Sie dann die Archivdiskette ein, auf der sich #on("b")#gs-Warenhaus#off("b")# befindet, und +geben Sie die folgenden Kommandos: + +#on("b")# + archive ("gs-Warenhaus") + + fetch (ALL archive, archive) + + release (archive) + + run ("gs-Warenhaus/gen") +#off("b")# + +Sie haben damit das Installationsprogramm gestartet und können die Diskette wieder +aus dem Laufwerk nehmen. (Natürlich können Sie die Dateien auch mit Hilfe von +#on("b")#gs-DIALOG#off("b")# von der Diskette holen. Achten Sie dann bitte darauf, daß sie #on("b")#alle#off("b")# oben +angegebenen Dateien von der Diskette in Ihre Task holen). +#page# +Zunächst werden Sie nun aufgefordert, eine Interface-Anpassung für den Codekarten­ +leser auszuwählen. Dazu erscheint das folgende Menu auf dem Bildschirm: + ++----------------------------------------------------------------------+ +|center#Auswahl einer Interface-Anpassung für den Codekartenleser | +|center#Wenn kein Kartenleser benutzt wird, tippen! | +| | +| Auswahl  e i n e r  Datei durch Ankreuzen | +| | +| ==> � gs-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter | +| � gs-Warenhaus 0: mit Kartenleser an MUFI als Endgerät | +| � gs-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal | +| | +| | +| | +| | +| Info:  Fertig:  Abbrechen:  | +| | ++----------------------------------------------------------------------- +Soll kein Kartenleser benutzt werden, tippen Sie einfach . Sonst fahren +Sie den Pfeil mit den Cursor-Tasten in die gewünschte Zeile und drücken +. Welche der angegebenen Anpassung für welchen Zweck die geeignete +ist, wird in Kapitel 4 ("Anschluß eines Codekartenlesers") genauer beschrieben. + +Daraufhin wird die Installation automatisch durchgeführt. Haben Sie die Anpassung +für den 'AKTRONIC-Adapter' oder für das 'MUFI als Endgerät' ausgewält, so erscheint +nach der Insertierung dieser Datei die Aufforderung + +#center##on("b")#Gib Interface-Kanal:#off("b")# + +Hier muß angegeben werden, an welchen Kanal (serielle Schnittstelle) das Interface +angeschlossen werden soll (vgl. wiederum Kapitel 4). Der Interface-Kanal läßt sich +auch später noch umstellen (vgl. Kapitel 7). + +Wenn der Insertierungs-Vorgang abgeschlossen ist, müssen Sie noch einige Fragen +beantworten: + +#on("b")#Frage 1:#off("b")# #on("b")#Version für GRIN (j/n)?#off("b")# + +Tippen Sie hier ein , so werden später in der Programmierumgebung die +'Soester' Befehle und Syntax-Regeln benutzt, ein liefert die Programmier­ +umgebung für ELAN. Die Versions-Einstellung kann auch noch später geändert +werden (vgl. Kapitel 7, Befehl 'grin'). + +#on("b")#Frage 2:#off("b")# #on("b")#Soll diese Task Warenhaus-Hauptstelle sein (j/n)?#off("b")# + +Das Tippen von macht Ihre momentan benutzte Task zur (einzigen!) Waren­ +haus-Hauptstelle; Sie können dann (nach Beantwortung mindestens einer weiteren +Frage, s.u.) in Söhnen dieser Task das Warenhaus-Programm starten. Allerdings ist es +dann nicht mehr möglich, Sohntasks dieser Task zu Hauptstellen zu machen! + +Möchten Sie aber mehrere Hauptstellen (evtl. für verschiedene Lerngruppen) ein­ +richten, so müssen Sie hier ein tippen. In diesem Fall ist die Installation +zunächst beendet und es erscheint der EUMEL-Eingangsbildschirm. Was Sie dann +noch tun müssen, erfahren Sie in Kapitel 3.4; die folgenden Ausführungen können +Sie überschlagen. + +#on("b")#Frage 3:#off("b")# #on("b")#Mit Direktstart (j/n)?#off("b")# + +Wenn Sie vor dem Benutzer die 'gib kommando:'-Ebene verbergen wollen, können +Sie das System durch Tippen eines so einstellen, daß sich sofort nach Ein­ +richten einer Sohntask das Menusystem meldet. Für den Anfänger kann das die +Arbeit durchaus erleichtern. Wenn Sie das nicht möchten, tippen Sie hier ein . +Haben Sie die Frage mit beantwortet, so erscheint noch eine (letzte) Abfrage: + +#on("b")#Frage 4:#off("b")# #on("b")#Mit automatischem Löschen (j/n)?#off("b")# + +Durch Tippen eines legen Sie fest, daß in den Sohntasks nach Verlassen des +Menus die jeweilige Task automatisch gelöscht wird. Tippen Sie ein , dann wird +nach Verlassen des Menus angefragt, ob die Task gelöscht werden soll. Wird die Frage +bejaht, wird gelöscht - sonst wird die Task abgekoppelt (break) und kann durch +'continue' wieder angekoppelt werden. + +#on("b")#Anmerkung:#off("b")# In Tasks, in denen Sie die Frage nach dem Direktstart mit beant­ +wortet haben, sollte nicht das Kommando 'monitor' gegeben werden, da Sie durch +dieses Kommando auch diese Task zu einer Task machen, die sich direkt mit dem +Menu meldet und ggf. bei Verlassen des Menus automatisch gelöscht wird! + + +Nachdem der EUMEL-Eingangsbildschirm zu sehen ist, können Sie nun #on("b")#gs-Waren­ +haus#off("b")# starten. Nehmen wir an, die Task 'WARENHAUS' sei Hauptstellen-Task. Sie ist +damit automatisch Managertask, Sie können also Sohntasks anmelden: + +#on("b")# + (Supervisor - Taste) + +#off("b")# + --> gib supervisor kommando: +#on("b")# + begin ("Test","WARENHAUS") +#off("b")# + +Statt 'Test' können Sie der Sohntask natürlich auch einen beliebigen anderen Namen +geben. Wenn Sie einen Direktstart eingerichtet haben, erscheint nun sofort das +#on("b")#gs-DIALOG#off("b")#-Emblem. + + +------------------------+ + | gs-DIALOG | + +---------------------------+ | + | Version 1.1 | | + +-----------------------------+ | | + | (C) 1987/88 Eva Latta Weber | | | + +-------------------------------+ | |-----+ + | (C) 1988 ERGOS GmbH | | | + | | |---+ + +------------------------------+ | | + | gggggggg ssssssss | |-------+ + | ggg sss sss | | + | ggg sss | --------+ + | ggg gggg ssssssss | + | ggg ggg sss | + | ggg ggg sss | + | gggggggggg sssssssss | + +------------------------------+ + + W A R E N H A U S + + Filiale 1 +#off("b")# +Andernfalls erscheint + +#on("b")# + gib kommando: +#off("b")# + +Mit dem Kommando + + #on("b")#warenhaus #off("b")# + +starten Sie #on("b")#gs-Warenhaus#off("b")# und erhalten zunächst ebenfalls das obige Emblem auf +dem Bildschirm. Links unten sehen Sie, unter welcher Filialnummer diese Task nun +von #on("b")#gs-Warenhaus#off("b")# geführt wird. Diese Nummer ist identisch mit der Kanalnummer, +unter der das EUMEL-System Ihren Arbeitsplatz verwaltet. + +Kurze Zeit später erscheint das WARENHAUS-Eingangsmenu. Wie Sie nun weiter mit +#on("b")#gs-Warenhaus#off("b")# arbeiten können, erfahren Sie in Kapitel 5. + + + +#on("b")#3.4  Einrichten mehrerer Hauptstellen#off("b")# + +Wir gehen hier davon aus, daß Sie die Installation von #on("b")#gs-Warenhaus#off("b")# gemäß den +Beschreibungen in Kapitel 3.3 bereits durchgeführt und dabei die Frage 2 ("Soll diese +Task Warenhaus-Hauptstelle sein (j/n)?") mit 'nein' beantwortet haben. (Falls Sie +Frage 2 mit 'ja' beantwortet haben und nun den Hauptstellen-Status der Task wieder +rückgängig machen wollen, so lesen Sie zunächst in Kapitel 7 nach.) + +Die Task, in der die Installation stattfand (wir nehmen weiterhin an, daß sie den +Namen 'WARENHAUS' hat), wurde automatisch zur Managertask, das heißt, daß +Söhne von ihr eingerichtet werden können. Bevor Sie in diesem Fall das Programm +nutzen können, müssen Sie nun noch mindestens eine Sohntask zur Hauptstelle +machen. Gehen Sie dabei folgendermaßen vor: + +#on("b")# + (Supervisor - Taste) + +#off("b")# + --> gib supervisor kommando: +#on("b")# + begin ("Hauptstelle A","WARENHAUS") +#off("b")# + + --> gib kommando: + + +Mit dem Kommando + +#center##on("b")#warenhaus hauptstelle (TRUE) #off("b")# + +wird die Task 'Hauptstelle A' zur Warenhaus-Hauptstelle. + +Zu beantworten sind dabei eine oder zwei Fragen; es sind dieselben, die auftauchen, +wenn bei der Abfrage 'Soll diese Task Warenhaus-Hauptstelle sein (j/n)?' ein +getippt wird. Lesen Sie deshalb nun weiter in Kapitel 3.3 bei der Frage 3: 'Mit Direkt­ +start (j/n)?'. + + + + + + + + + + + + + + + + + + + + + + diff --git a/app/gs.warenhaus/1.01/doc/gs-Warenhaus-4 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-4 new file mode 100644 index 0000000..2c5d7dc --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-4 @@ -0,0 +1,378 @@ +limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (11)# +#headodd# +#center#gs-Warenhaus#right#% + +#end# +#headeven# +%#center#gs-Warenhaus + +#end# +#center#1 + +#center# #on("b")#4  Anschluß eines Codekartenlesers#off("b")# + + +Ein 'echter' Scanner oder Barcodeleser ist als automatisches Lesegerät für den Ein­ +satz im Unterricht nicht geeignet und kann unter EUMEL/ELAN unseres Wissens nach +auch nicht angesteuert werden. #on("b")#gs-Warenhaus#off("b")# benutzt stattdessen (ebenso wie die +Soester Software) den von der Firma AKTRONIC vertriebenen Codekartenleser für +einfache 8-Bit-Lochkarten (siehe Anhang). + +Die Verwendung eines Codekartenlesers ist für die Bedienung des Programms zwar +nicht unbedingt notwendig, bietet jedoch beim Einsatz von #on("b")#gs-Warenhaus#off("b")# im Unter­ +richt neben den didaktischen Hintergründen (Modell für Scanner-Kasse) auch noch +mancherlei Vorteile bezüglich des "Datenschutzes" (Änderungen an Kunden- oder +Artikeldaten sowie Zugriffe auf Auskunftsfunktionen nur mit entsprechender Code­ +karte möglich), so daß sein Anschluß sehr empfohlen werden muß. + +Allerdings ist solch ein Gerät nur mittels eines (relativ teuren) Interface-Systems +anschließbar, dessen Anschaffung sich nur lohnt, wenn das System auch sonst noch +zum Messen, Steuern, Regeln (= "Prozeßdatenverarbeitung", "PDV") im Unterricht +genutzt wird. (#on("b")#ERGOS#off("b")# bietet mit #on("b")#"gs-Prozess"#off("b")# auch ein Programmpaket zur PDV +unter EUMEL/ELAN an!) + + + +#on("b")#4.1  Hardware-Voraussetzungen#off("b")# + +Der Codekartenleser wird an einen Steckplatz des Interface-Systems MODUL-BUS der +Firma AKTRONIC angeschlossen, wobei ein Einzel- oder Mehrfachsteckplatz mit +Kombi- oder E/A-Karte oder eine Compact-Box benutzt werden können. + +Da Eingaben von externen Geräten unter EUMEL in der Regel nur über eine serielle +Schnittstelle möglich sind, benötigt man neben dem Kartenleser und dem MODUL- +#page# +BUS-Steckplatz noch einen 'Adapter', der die parallelen Signale des MODUL-BUS- +Systems in serielle Signale wandelt, die der Computer über eine serielle Schnittstelle +(auch RS232- oder V24-Schnittstelle genannt) empfangen kann. Für erfahrene +Elektronik-Bastler ist das Erstellen solch eines Adapters sicher eine lösbare Aufgabe, +unter den fix und fertig kaufbaren Geräten haben wir allerdings nur zwei geeignete +gefunden: das 'Multifunktionale Interface' (kurz: MUFI) der Firma BICOS und den +'RS232-Adapter für das MODUL-BUS-System' der Firma AKTRONIC. Diese beiden +Geräte werden auch von #on("b")#gs-Warenhaus#off("b")# unterstützt. + +Die erforderliche Hardware-Konstellation stellt sich im Überblick also folgender­ +maßen dar: + +#on("b")# + Computer <----> Adapter <----> Interface <----> Kartenleser + + (mit se- ('MUFI' ('MODUL- + rieller oder BUS'- + Schnitt- 'AKTRONIC- Steck- + stelle) Adapter') platz) +#off("b")# + + +#on("b")#4.2  Verwendung des MUFI#off("b")# + +Das MUFI ist speziell für die Arbeit in einem Mehrplatz-System entwickelt worden. Es +benötigt keine zusätzliche serielle Schnittstelle am Rechner, sondern kann einfach +zwischen Rechner und Terminal 'in den Terminalkanal gesteckt' werden, sodaß man +von diesem Terminal aus optimal auf das Interface-System zugreifen kann. Im Ideal­ +fall sollte jeder Arbeitsplatz mit der oben genannten Hardware ausgestattet sein, was +aber momentan sicher nicht für jede Schule finanzierbar ist. Haben Sie zunächst nur +ein (oder wenige) MUFI(s) zur Verfügung und möchten von verschiedenen Terminals +(abwechselnd) auf ein Interface-System zugreifen oder verfügen Sie gar nicht über +ein Terminal, sondern nur über einen Monitor (z.B. bei IBM-Kompatiblen), so +können Sie das MUFI auch 'als Endgerät' an einer separaten seriellen Schnittstelle +nutzen. +#page# +Für den Betrieb in einem Terminalkanal sollte das MUFI über eine sog. "Schnitt­ +stellen-Automatik" verfügen, die verhindert, daß das MUFI in ausgeschaltetem +Zustand oder mit abgezogenem Netzstecker den Datenfluß vom Rechner zum +Terminal unterbricht. Diese sehr sinnvolle Automatik wird von BICOS #on("b")#nicht#off("b")# +standardmäßig eingebaut. Sie sollten bei eventuellen Bestellungen darauf achten. + + +#on("b")#4.2.1  Einstellungen am MUFI#off("b")# + +Gleichgültig ob Sie das MUFI 'im Terminalkanal' oder 'als Endgerät' benutzen, +müssen Sie zunächst am MUFI einige Einstellungen per DIP-Schalter im Inneren des +MUFI vornehmen. Ziehen Sie dazu aber auf alle Fälle den Stecker aus der Steckdose! +Lösen Sie dann die 4 Schrauben an der Unterseite des Gehäuses, heben das Oberteil +vorsichtig ab und legen es neben das Unterteil, sodaß die Kabelverbindungen +zwischen Unter- und Oberteil nicht belastet werden. + + +---------------------------------------------------+ + | +-------+ +------------+ | + | | | | | +---------+ | + | +-------+ | | | DIP- | | + | +-------+ | | | Schalter| | +Rück- | | | | | +---------+ | Vorder- +seite | +-------+ | | +--------------+ | seite + | +-------+ | SCN68000 | | | | + | | | | | +--------------+ | + | +-------+ | | | + | +-------+ | | | + | | | | | | + | +-------+ +------------+ | + +---------------------------------------------------+ + + + +#center#Abb.1: MUFI geöffnet +#page# +Die kleine Plastikbox mit den DIP-Schaltern trägt die folgende Aufschrift: + +#center##on("b")#O N   +#center#1 2 3 4#off("b")# + +Heben Sie den Deckel mit Hilfe eines kleinen Schraubendrehers o.ä. an der rechten +Seite leicht an und klappen Sie ihn nach links um. Sie können nun die 4 DIP- +Schalter sehen. + + +---------------------------------------+ + | +-----+ +-----+ +-----+ +-----+ | + | |+++++| | | | | | | | + | |+++++| | | | | | | | ON + | |+++++| | | | | | | | + | |+++++| | | | | | | | + | | | | | | | | | | + | | | | | | | | | | + | | | | | | | | | | + | | | |+++++| |+++++| |+++++| | + | | | |+++++| |+++++| |+++++| | + | | | |+++++| |+++++| |+++++| | OFF + | | | |+++++| |+++++| |+++++| | + | +-----+ +-----+ +-----+ +-----+ | + +---------------------------------------+ + + 1 2 3 4 + +#center#Abb.2: Mögliche DIP-Schalter-Stellung beim MUFI + + Dabei haben die DIP-Schalter folgende Bedeutung: + + 1 ON : Modulbusbetrieb + OFF : Parallelportbetrieb + 2 ON : RTS/CTS-Hardware-Handshake + OFF : XON/XOFF-Protokoll + 3 ON : 9600 Baud + OFF : 19200 Baud + 4 ON : Even Parity + OFF : No Parity + +In jedem Fall muß der DIP-Schalter 1 in Stellung #on("b")#ON#off("b")# gebracht werden. +#page# +Wenn Sie das MUFI im Terminalkanal betreiben wollen, müssen Sie die anderen +Einstellungen so vornehmen, daß sie zu der Konfiguration des Terminals passen (vgl. +auch Kapitel 4.4). Beträgt die Übertragungsrate 19200 Baud, so sollten Sie unbedingt +mit dem XON/XOFF-Protokoll arbeiten - es sei denn, das Terminal unterstützt +RTS/CTS! Wenn Sie das MUFI an einer separaten seriellen Schnittstelle als Endgerät +betreiben wollen, #on("b")#muß#off("b")# der Datenaustausch mit dem RTS/CTS-Protokoll abgewickelt +werden (Schalter 2 auf 'ON'!). Vergewissern Sie sich, daß Ihr Schnittstellen-Kabel +auch darauf ausgelegt ist! Nach dieser Einstellung der DIP-Schalter ist das MUFI +betriebsbereit. Fügen Sie die beiden Gehäuseteile wieder zusammen und ver­ +schrauben Sie sie wieder. + + +#on("b")#4.2.2  MUFI im Terminalkanal#off("b")# + +Um das MUFI in den Terminalkanal einbauen zu können, müssen Sie zunächst am +Terminal die Zuleitung vom Rechner lösen. Auf der Rückseite des MUFIs befinden +sich zwei Stecker, die mit V24/1 und V24/2 bezeichnet sind. Stecken Sie an Stecker +V24/2 das Kabel, das ursprünglich vom Computer zum Terminal führte. Sie +benötigen jetzt noch ein weiteres (kurzes) V24-Kabel, um das MUFI mit dem +Terminal zu verbinden. Dieses wird einerseits auf Stecker V24/1 am MUFI gesteckt +und andererseits auf den Stecker am Terminal, von dem Sie das ursprüngliche Kabel +zwischen Rechner und Terminal abgezogen haben. + + +--------------------------+ + | +----------------------+ | + | | V24/1 V24/2 | | + | | | | | | + | +----|-----------|-----+ | + +------|-----------|-------+ + | | + | | + ZUM <-----+ +-----> ZUM + TERMINAL COMPUTER + + +#center#Abb.3: Einbau des MUFIs in den Terminalkanal +#page# +Die Verschaltung der V24-Kabel ist in der Bedienungsanleitung zum MUFI erläutert, +ggf. können Sie entsprechende Kabel von der Firma BICOS beziehen. + +Wenn alle Kabelverbindungen gesteckt sind, sollten Sie auf alle Fälle erst einmal #on("b")#bei +ausgeschaltetem MUFI#off("b")# prüfen, ob das Terminal sich noch bedienen läßt. Wenn dieses +keine Reaktion mehr zeigt, obwohl es vorher (ohne MUFI) reibungslos funktioniert +hat, dann haben Sie entweder ein MUFI ohne "Schnittstellen-Automatik" vor sich +(vgl. Kapitel 4.2, Seite 15), oder an den Kabelverbindungen stimmt irgendetwas nicht. +In diesem Fall sollten Sie noch einmal alle Anschlüsse und evtl. auch die interne +Verschaltung der Kabel überprüfen. + +Schalten Sie dann das MUFI ein. Bei ebenfalls eingeschaltetem Terminal können nun +einige Zeichen auf dem Bildschirm erscheinen, dieser Effekt ist normal. Funktioniert +Ihr Terminal bei eingeschaltetem MUFI reibungslos, so sind alle Einstellungen richtig +und Sie brauchen erst bei Kapitel 4.5 weiterzulesen. Andernfalls studieren Sie Kapitel +4.4 unter Beachtung von Kapitel 4.2.1! + + +#on("b")#4.2.3  MUFI als Endgerät#off("b")# + +Wenn Sie das MUFI als Endgerät an einer separaten seriellen Schnittstelle betreiben +wollen, dann stecken Sie das vom Computer kommende Kabel auf den mit V24/2 +bezeichneten Stecker des MUFI. + +Damit ein einwandfreier Betrieb gewährleistet ist, sollten Sie einen sog. 'Kurzschluß­ +stecker' auf den dann freien Stecker V24/1 des MUFIs stecken. Haben Sie einen +solchen nicht zur Hand, können Sie auch zwei provisorische Drahtbrücken einsetzen: +Verbinden Sie mit zwei kleinen Drähten einmal Pin (Öffnung) 2 mit Pin 3 und +außerdem Pin 4 mit Pin 5. + +Die Anpassung 'gs-Warenhaus 0: mit Kartenleser an MUFI als Endgerät' unterstützt +standardmäßig nur den Betrieb von #on("b")#einem#off("b")# MUFI als Endgerät. Wie Sie vorgehen +müssen, wenn Sie mehrere MUFIs in dieser Betriebsart benutzen wollen, erfahren Sie +in Kapitel 7. +#page# +#on("b")#4.3  Verwendung des AKTRONIC-Adapters#off("b")# + +Im Gegensatz zum MUFI ist der AKTRONIC-Adapter #on("b")#nicht#off("b")# für den Einbau in einen +Terminalkanal geeignet, sondern kann nur als Endgerät an einer separaten seriellen +Schnittstelle betrieben werden. Bevor Sie den Adapter an eine serielle Schnittstelle an­ +schließen, sollten Sie noch die eingestellte Baud-Rate überprüfen und gegebenenfalls +neu einstellen. + +Öffnen Sie dazu das Gehäuse des Adapters, indem Sie die vier Schrauben an der +Unterseite lösen. Drehen Sie den Adapter so vor sich, daß die 25-polige D-Sub­ +miniaturbuchse von Ihnen weg zeigt. Vorn rechts sind dann zwei parallele 8-polige +Pfostensteckerleisten sichtbar. + +#center#25-pol. D-Subminiatur-Stecker + + +---------------+ + | | + +---+ +---+ + | +------+ | + | | | | + | | | | + | | | | + | | | | + | +------+ | + | +------+ | + | | | +-------+ | + | +------+ | | | + | +------+ +-------+ | + | | | +-------+ | + | +------+ | <-|---------Jumperleiste + | +-------+ | + +---+ +---+ + | Baudrate | + +---------------+ + + +#center#Abb.4: AKTRONIC-Adapter geöffmet +#page# +Auf einem Pfostensteckerpaar steckt ein 'Jumper', der gegebenenfalls (passend zu +der Schnittstellen-Konfiguration im Computer, vgl. Kapitel 4.4) umgesteckt werden +muß. + + +---------+ + | ζ ζ | 300 + | ζ ζ | 600 + | ζ ζ | 1200 + | ζ ζ | 2400 + | ζ ζ | 4800 + | ζ ζ | 9600 + Jumper > | ζ ζ | 19200 + | ζ ζ | 38400 + +---------+ + Baudrate + + +#center#Abb.5: Mögliche Jumperposition beim AKTRONIC-Adapter + + +Am Adapter ist ein Kabel mit 25-poligem D-Subminiaturstecker bereits fest montiert. +Sollte der Stecker nicht an Ihren Rechner passen, so müßten Sie ein entsprechendes +Adapterkabel basteln oder kaufen. + +Die Anpassung 'gs-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter' unterstützt +standardmäßig nur den Betrieb von #on("b")#einem#off("b")# Adapter. Wie Sie vorgehen müssen, wenn +Sie mehrere dieser Adapter benutzen wollen, erfahren Sie in Kapitel 7. + + +#on("b")#4.4  Konfiguration der seriellen Schnittstelle#off("b")# + +Sie müssen nun noch dafür Sorge tragen, daß die Einstellungen am MUFI bzw. am +AKTRONIC-Adapter mit den Einstellungen im Computer übereinstimmen. +#page# +Koppeln Sie dazu die Task 'configurator' an Ihr Terminal an (mit 'continue +("configurator") ') und geben Sie dann das Kommando 'configurate +'. Für alle vorhandenen Kanäle werden Sie nun nacheinander gefragt, +ob Sie eine Konfiguration vornehmen wollen. Bei den "interessanten" Kanälen ant­ +worten Sie mit 'ja' (). Wollen Sie sich nur die aktuelle Konfiguration ansehen, so +beantworten Sie alle weiterhin gestellten Fragen zu diesem Kanal mit 'ja' (), +dann bleibt die aktuelle Einstellung erhalten. (Der Konfigurationsdialog ist im +EUMEL-Systemhandbuch auf den Seiten 6 - 8 detailliert beschrieben.) + +Benutzen Sie ein MUFI, so müssen auf alle Fälle #on("b")#8 Datenbits#off("b")# und #on("b")#1 Stopbit#off("b")# einge­ +stellt sein und außerdem je nach DIP-Schalter-Stellung im MUFI (vgl. Kapitel 4.2.1) +9600 oder 19200 Baud sowie 'no parity' oder 'even parity'. + +Benutzen Sie das MUFI im Terminalkanal, so müssen Sie bei einer eventuellen +Änderung der Konfiguration an diesen Stellen auch das entsprechende Terminal auf +diese Werte einstellen! + +Bei der Verwendung des MUFIs als Endgerät muß der Kanal, an den das MUFI ange­ +schlossen wird, darüberhinaus unbedingt auf die Betriebsarten + +#center#transparent und RTS/CTS-Protokoll + +eingestellt werden. + +Verwenden Sie einen AKTRONIC-Adapter, so müssen für den entsprechenden Kanal +folgende Konfigurationsmerkmale eingestellt werden: + +#center#transparent, 8 Bit, 2 Stopbit, #on("b")#kein#off("b")# Protokoll + +Die Baud-Rate ist gemäß der Jumper-Position im Adapter (vgl. Kapitel 4.3) einzu­ +stellen. + + + +#on("b")#4.5  Verbindung der Hardware-Komponenten#off("b")# + +Der Anschluß des Kartenlesers an den MODUL-BUS-Steckplatz ist denkbar einfach: +Stecken Sie den 8-poligen Platinenstecker des Codekartenlesers in die Buchse des +Digital-Einganges der Steckkarte bzw. Compact-Box und den 3-poligen Platinen­ +stecker in die passende Spannungsversorgungsbuchse (12 V) am Steckplatz bzw. auf +der Compact-Box, fertig. Bei eingeschalteter Betriebsspannung muß nun der Code­ +kartenleser beleuchtet sein. (Falls Sie einen Mehrfachsteckplatz benutzen, benötigen +Sie ein passendes Netzteil für diesen Steckplatz! Achten Sie auch darauf, daß in +diesem Fall die Kombi- oder E/A-Karte in Steckplatz (Slot) 1 installiert ist.) + +Nun müssen Sie noch die Verbindung zu dem verwendeten Adapter herstellen. Dabei +ist es gleichgültig, ob Sie eine Compact-Box, einen Einzel- oder einen Mehrfachsteck­ +platz benutzen, denn alle diese Geräte verfügen über ein Anschlußkabel mit dem +gleichen 25-poligen Stecker. + +Den AKTRONIC-Adapter können Sie damit direkt an den Steckplatz anschließen, +denn er verfügt bereits über eine entsprechende 25-polige Buchse. Hier müssen Sie +dann nur noch die Stromversorgung des Adapters sichern, indem Sie das Kabel mit +dem 3-poligen Platinenstecker in die passende Spannungsversorgungsbuchse (12 V) +am Steckplatz oder auf der Compact-Box stecken. (Damit Codekartenleser und +Adapter hier gleichzeitig versorgt werden können, ist in den Stecker eine Verzweigung +eingebaut.) + +Für das MUFI benötigen Sie ein weiteres Kabel, das an einem Ende einen 36-poligen +Centronics-Stecker besitzt und an dem anderen einen 25-poligen D-Subminiatur­ +stecker (von der Firma BICOS zu beziehen). + +Zum Ausprobieren des Kartenlesers benutzen Sie am besten die Menupunkte +'Dezimalwert lesen' und 'Bitmuster lesen' unter dem Oberbegriff 'Kommandos' des +Warenhaus-Menus. Eine Beschreibung dieser Punkte finden Sie in Kapitel 5.4. + + + + + + + + + + diff --git a/app/gs.warenhaus/1.01/doc/gs-Warenhaus-5 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-5 new file mode 100644 index 0000000..c1164ad --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-5 @@ -0,0 +1,1468 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (20)# +#headodd# +#center#gs-Warenhaus#right#% + +#end# +#headeven# +%#center#gs-Warenhaus + +#end# +#center#1 + +#center##on("b")#5  Beschreibung der Menufunktionen#off("b")# + + +Nach Aufruf meldet sich #on("b")#gs-Warenhaus#off("b")# zunächst mit dem #on("b")#gs-DIALOG#off("b")#-Emblem +(vgl. Kapitel 3.3). Kurze Zeit später erscheint das WARENHAUS-Eingangsmenu auf +dem Bildschirm: + + +------------------------------------------------------------------------+ + | WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv| + |------------------------------------------------------------------------| + | | b  Befehlsvorrat | | + | | ------------------ | | + | | a  Artikeldaten | | + | | k  Kundendaten | | + | +--------------------+ | + | | + | | + | | + |------------------------------------------------------------------------+ + | | + | Info:/ Wahl: Ausführen: Verlassen: | + +------------------------------------------------------------------------+ + +#off("b")# + + +Bevor wir Ihnen die Bedeutung der einzelnen Menu-Punkte erklären, geben wir erst +noch einige grundsätzliche Hinweise zur Bedienung des Menus für diejenigen Leser, +die im Umgang mit Menus unter #on("b")#gs-DIALOG#off("b")# nicht geübt sind. + + + +#on("b")#5.1  Kurzhinweise zur Bedienung des Menus#off("b")# + +Die Bedienung des Menus ist sehr einfach. Eine ausführliche Beschreibung dazu +finden Sie in den Unterlagen zum Programmsystem #on("b")#gs-DIALOG#off("b")#. An dieser Stelle +sollen nur die wesentlichen Bedienungsvorgänge beschrieben werden. +#page# +- Mit der Tastenfolge können Sie sich Informationen zur Bedienung + des Menusystems in das Menu einblenden lassen + +- Mit den Pfeiltasten und können Sie zwischen den "Ober­ + begriffen" in der Kopfzeile wählen. Der aktuelle Oberbegriff ist jeweils invers + dargestellt. Das ausgeklappte 'Pull-Down-Menu' bezieht sich auf diesen invers + dargestellten Oberbegriff. + +- Mit den Pfeiltasten und können Sie zwischen den Menu­ + funktionen wählen, die Ihnen im aktuellen Pull-Down-Menu zur Auswahl ange­ + boten werden. Die aktuell angewählte Menufunktion wird jeweils invers darge­ + stellt. Die Trennlinien, die in einigen Pull-Down-Menus sichtbar sind, dienen nur + der optischen Untergliederung; sie können nicht angewählt werden und werden + deshalb automatisch übersprungen. Die einzelnen Menupunkte sind "zyklisch + miteinander verknüpft", das heißt, man gelangt vom untersten Menupunkt + wieder zum obersten und umgekehrt. Menupunkte, vor denen ein Minuszeichen + steht ('-'), sind (zur Zeit) nicht aktivierbar; auch sie können nicht angewählt + werden und werden einfach übersprungen. + +- Durch Tippen der Fragezeichentaste () können Sie sich jeweils zur + aktuellen Menufunktion (invers im Pull-Down-Menu) Informationen in das Menu + einblenden lassen. + +- Um eine Menufunktion ausführen zu lassen, bewegen Sie sich mit den Pfeiltasten + auf die gewünschte Menufunktion im aktuellen Pull-Down-Menu und tippen + dann die -Taste. Steht vor dem gewünschten Menupunkt ein + einzelner Buchstabe oder eine Ziffer, so kann durch Tippen der entsprechenden + Taste diese Menufunktion dadurch direkt aufgerufen werden. Sobald eine Menu­ + funktion aufgerufen worden ist, erscheint davor ein Stern ('*'). Daraus können + Sie entnehmen, daß das System bereits den Auftrag ausführt. + +- An verschiedenen Stellen werden Fragen an Sie gerichtet, die Sie mit 'ja' oder + 'nein' beantworten müssen. Tippen Sie dazu entsprechend der Entscheidung die + Taste (für 'ja') bzw. (für 'nein'). + +- Werden Ihnen vom Menu aus Dateinamen zur Auswahl angeboten, so können Sie + den auf dem Bildschirm sichtbaren Pfeil vor den gewünschten Namen +#page# + positionieren. Mit den Tasten oder können Sie den Namen + ankreuzen. Ist die Auswahl mehrerer Dateinamen möglich, so können Sie den + Vorgang wiederholen. Mit den Tasten oder können Sie auch + ein Kreuz vor einem Namen wieder löschen. Daneben gibt es noch einige Tasten­ + funktionen, die für die Bedienung recht hilfreich sein können. Tippen Sie + während der Auswahl die Fragezeichentaste (), so werden Ihnen alle + Bedienungsmöglichkeiten auf dem Bildschirm angezeigt. Eine Auswahl, in der + mehrere Dateien angekreuzt werden dürfen, wird durch die Tastenfolge + verlassen. Anschließend wird die eingestellte Operation mit den + angekreuzten Dateien ausgeführt. Sind Sie versehentlich in eine solche Auswahl + gelangt, so können Sie den Vorgang durch die Tastenkombination + abbrechen. + +- An einigen Stellen werden Sie aufgefordert, eine Eingabe zu machen (z.B. einen + Dateinamen einzugeben). Wird Ihnen hier ein Vorschlag gemacht, den Sie + akzeptieren, so brauchen Sie zur Bestätigung nur die -Taste zu + tippen. Gefällt Ihnen der Vorschlag nicht oder wird Ihnen kein Vorschlag + gemacht, so machen Sie bitte die gewünschte Eingabe. Zum Schreiben stehen + Ihnen alle aus dem Editor bekannten Funktionen zur Verfügung. Mit der Taste + können Sie Buchstaben löschen, mit einfügen. Die + Eingabe wird durch Tippen der -Taste abgeschlossen. Ist der von + Ihnen gewünschte Name schon in Ihrer Task vorhanden und steht in der Fußzeile + der Hinweis 'Zeigen: ', dann können Sie sich auch alle vor­ + handenen Namen zur Auswahl anbieten lassen und durch Ankreuzen den beab­ + sichtigten Namen auswählen. + +- Ihnen können auch mehrere Alternativen angeboten werden, zwischen denen Sie + wählen müssen. In der untersten Zeile eines solchen Kastens, in denen Ihnen die + Alternativen auf dem Bildschirm eingeblendet werden, sind die Möglichkeiten + aufgeführt, die darüber beschrieben sind. Mit den Pfeiltasten können sie die + Markierung auf die gewünschte Alternative positionieren und dann durch die + -Taste zur Ausführung bringen. (Manchmal ist das auch durch + Tippen der den Alternativen vorangestellten Buchstaben oder Ziffern möglich). +#page# +- Durch die Tastenfolge kann das Menu insgesamt verlassen + werden. Damit das nicht versehentlich geschieht, wird jeweils die Frage gestellt, + ob Sie das Menu tatsächlich verlassen wollen. Diese Frage beantworten Sie bitte je + nach Wunsch mit 'ja' oder 'nein' durch Tippen der Tasten bzw. . + + +#on("b")#5.2  Menufunktionen zum Oberbegriff 'Info'#off("b")# + +Das auf dem Bildschirm sichtbare Pull-Down-Menu ist bereits oben abgebildet. + +#on("b")#b Befehlsvorrat#off("b")# + + Mit dieser Funktion können Sie sich die Befehle, die Ihnen von der jeweils + eingestellten Programmierumgebung zur Verfügung gestellt werden, auf dem + Bildschirm anzeigen lassen. Anhand dieser Informationen können Sie auch + feststellen, ob in dem System, das Ihnen zur Verfügung steht, die 'GRIN- + Version' oder die 'ELAN-Version' eingestellt ist. + + Je nach Version gelangen Sie zunächst in eines der folgenden beiden Auswahl­ + menus: +#on("b")# + GRIN-Version: + + + +-------------------------------------------------+ + | d   Datei - Bearbeitung | + | e   Einkaufen und Auskunft | + | k   Kontroll - Strukturen | + | | + | z   Zurück zum Hauptmenü | + | | + | Datei   Kaufen/Auskunft   Kontroll   Zurück | + | | + +-------------------------------------------------+ +#off("b")# +#page# +#on("b")# + ELAN-Version: + + +-------------------------------------------------+ + | d   Datei - Bearbeitung | + | e   Einkaufen und Auskunft | + | s   Sonstige Befehle | + | | + | z   Zurück zum Hauptmenü | + | | + | Datei   Kaufen/Auskunft   Sonstige   Zurück | + | | + +-------------------------------------------------+ + +#off("b")# + + Von hier aus können Sie zu jedem dort angegebenen Bereich eine Informa­ + tionstafel abrufen. + + Aus jeder dieser Tafeln gelangen Sie wieder in die Auswahl zurück. Verlassen + Sie die Auswahl selbst, gelangen Sie zurück ins Ausgangsmenu. + + +#on("b")#a Artikeldaten#off("b")# + + Bei Aktivierung dieses Menupunktes erhalten Sie eine Kurzinformation über + Aufbau und Umfang der Artikeldaten: +#on("b")# + +-------------------------------------------------------+ + | Ein Satz 'Artikeldaten' besteht aus: | + | | + | Artikelname | + | Preis | + | Mindestbestand | + | Bestand | + | | + | Es können Daten für maximal 15 Artikel gespeichert | + | werden. Die zugehörigen Artikelnummern sind 1...15. | + | | + +-------------------------------------------------------+ + + +#off("b")# + + In allen Filialen müssen zu einer Artikelnummer stets der Artikelname und + Preis identisch sein, Bestand und Mindestbestand können beliebig gewählt + werden. Artikeldateien werden nur in den jeweiligen Filialen gehalten und + nicht in der Zentrale. +#page# + Gegenüber der Soester Warenhaus-Version sind Artikeldaten um den Punkt + 'Mindestbestand' erweitert worden, weil sich damit unserer Meinung nach eine + realistischere Nachbestellung realisieren läßt (vgl. auch Kapitel 5.4, 'Nachbe­ + stellen'). + + Sollte Ihnen der Umfang des Warensortiments mit maximal 15 verschiedenen + Artikeln sehr gering vorkommen, so denken Sie bitte daran, daß die Artikel­ + daten an jedem Arbeitsplatz erst einmal eingegeben werden müssen, was bei + Computer-Anfängern recht lange dauert. Außerdem kommt es nur bei einem + genügend kleinen Sortiment zu den methodisch-didaktisch erwünschten + Einkaufshäufungen bei bestimmten Produkten. + + +#on("b")#k Kundendaten#off("b")# + + Bei Aktivierung dieses Menupunktes erhalten Sie eine Kurzinformation über + Aufbau und Umfang der Kundendaten: +#on("b")# + +----------------------------------------------------------+ + | Nachname | + | Vorname | + | Geschlecht | + | | + | Es können Daten für maxomal 31 Kunden gespeichert | + | werden. Die zugehörigen Kundennummern sind 129...159. | + | | + +----------------------------------------------------------+ +#off("b")# + + Die Zuordnung Kundennummer ---> Kunde muß in allen Filialen gleich sein. + Kundendateien werden von jeder Filiale und von der Zentrale geführt. + + Gegenüber der Soester Warenhaus-Version sind Kundendaten um die Punkte + 'Nachname' und 'Geschlecht' erweitert worden, um dem Begriff Kunden#on("b")#daten#off("b")# + etwas gerechter zu werden. Die maximale Kundenanzahl von 31 entspricht + etwa der Größe einer Klasse. +#page# +#on("b")#5.3  Menufunktionen zum Oberbegriff 'Eingabeart'#off("b")# + +Die Funktionen unter diesem Oberbegriff sind nur dann für Sie interessant, wenn Sie +einen Codekartenleser verwenden. +#on("b")# ++-------------------------------------------------------------------------+ +| WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv | +|-------------+-----------------+-----------------------------------------| +| | *  Anzeigen | | +| | --------------- | | +| | k  Kartenleser | | +| | t  Tastatur | | +| +-----------------+ | +| | +| | +| +------------------------+ | +| | Die Eingabeart ist auf | | +| | | | +| | Tastatur | | +| | | | +| | eingestellt | | +| +------------------------+ | +|-------------------------------------------------------------------------| +| Info:/ Wahl: Ausführen: Verlassen: | ++-------------------------------------------------------------------------+ +#off("b")# + +#on("b")#a Anzeigen#off("b")# + + Es wird die momentan eingestellte Eingabeart angezeigt. Möglich sind die + Eingabearten #on("b")#Tastatur#off("b")# und #on("b")#Kartenleser#off("b")#. Die Standardeinstellung ist + 'Tastatur'! + + +#on("b")#k Kartenleser#off("b")# + + Die Eingabeart 'Kartenleser' wird eingestellt. Alle Artikelnummern, Kunden­ + nummern und sonstige Codenummern (für Auskünfte) können danach nur + über den Kartenleser eingegeben werden. +#page# + Diese Eingabeart kann nur eingestellt werden, wenn ein Kartenleser mit + funktionstüchtigem Interface angeschlossen ist. Sonst erfolgt eine ent­ + sprechende Fehlermeldung. + + Fehlerfälle: + + - Kein Interface vorhanden! + Ursache: Bei der Installation von #on("b")#gs-Warenhaus#off("b")# wurde angegeben, daß + kein Kartenleser benutzt werden soll. + + - Interface meldet sich nicht! + Abhilfe: Überprüfen, ob der Adapter ordnungsgemäß angeschlossen und + eingeschaltet ist (vgl. Kapitel 4). Notfalls Eingabeart auf + 'Tastatur' schalten; wenn ein MUFI verwendet wird, MUFI aus- + und nach kleiner Pause wieder einschalten; noch einmal die + Eingabe 'Kartenleser' anwählen. + + - TASK für Interface ist besetzt! + (Kann nur beim Betrieb von MUFI als Endgerät oder bei AKTRONIC-Adapter + auftreten.) + Abhilfe: Wenn irgendeine andere Task die Eingabeart 'Kartenleser' ein­ + gestellt hat, dort auf 'Tastatur' umstellen. + + - Interface-Kanal belegt! + (Kann nur beim Betrieb von MUFI als Endgerät oder bei AKTRONIC-Adapter + auftreten.) + Abhilfe: Feststellen, welche Task an den Interface-Kanal angekoppelt ist + ('taskinfo (2)'), und diese dann abmelden ('break' oder 'end'). + Die Nummer des Interface-Kanals kann mit dem Befehl 'put + (interfacekanal)' erfragt werden. + + - TASK für Interface existiert nicht! + (Kann nur beim Betrieb von MUFI als Endgerät oder bei AKTRONIC-Adapter + auftreten.) + Abhilfe: Task löschen; in der Vatertask das Kommando 'init interface­ + channel' geben; Task neu anmelden. +#page# +#on("b")#t Tastatur#off("b")# + + Die Eingabeart 'Tastatur' wird eingestellt. Alle Artikelnummern, Kunden­ + nummern und sonstige Codenummern (für Auskünfte) können danach nur + über die Tastatur eingegeben werden. Ein etwa angeschlossener Codekarten­ + leser ist bei dieser Einstellung nicht mehr ansprechbar. + + + +#on("b")#5.4  Menufunktionen zum Oberbegriff 'Kommandos'#off("b")# + +Dieses ist das zentrale Menu für den Benutzer von #on("b")#gs-Warenhaus#off("b")#. Unter diesem +Oberbegriff finden Sie alle Funktionen, die notwendig sind, um die Abläufe innerhalb +des Modell-Warenhauses zu simulieren. (Die angebotenen Menufunktionen ent­ +sprechen etwa den "Direktbefehlen" der Soester Software.) +#on("b")# ++-------------------------------------------------------------------------+ +| WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv | +|---------------------+-------------------------------+-------------------| +| | w   Warendatei bearbeiten | | +| | k   Kundendatei bearbeiten | | +| | -------------------------- | | +| | e   Einkaufen | | +| | -------------------------- | | +| | a   Auskunft einholen | | +| | n   Nachbestellen | | +| | -------------------------- | | +| | -   Dezimalwert lesen | | +| | -   Bitmuster lesen | | +| +-------------------------------+ | +| | +|-------------------------------------------------------------------------| +| Info:/ Wahl: Ausführen: Verlassen:| ++-------------------------------------------------------------------------+ +#off("b")# + +Wird im Unterricht kein Kartenleser benutzt, so sind die eingegeben Daten völlig +ungeschützt. Vor allem bei der Kundendatei muß sichergestellt werden, daß dort +#page# +keine unsinnigen Eintragungen oder Änderungen vorgenommen werden, da alle +Neueintragungen und Änderungen in dieser Datei auch in der Warenhaus-Zentrale +wirksam werden und von dort aus auf Anfrage jeder Filiale mitgeteilt werden. +Korrekturen können dadurch sehr mühsam werden. Natürlich sind ohne Kartenleser +(und dem damit verbundenen 'Ausweis' Codekarte) auch jederzeit Einkäufe mit jeder +beliebigen Kundennummer möglich. Auch hier sollten Sie etwaigem Mißbrauch +vorbeugen. + + +#on("b")#w Warendatei bearbeiten#off("b")# + + Hiermit kann die Warendatei der Filiale aufgebaut und verändert werden. Der + Bildschirm sieht dabei wie folgt aus: +#on("b")# ++------------------------------------------------------------------------+ +|WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv | +|-----------------------------------+------------------------------------| +| | Artikelnummer : 1 | +| | | +| | | +| | Artikelname : Bier (Kasten)| +| | | +| | Preis : 16.85 | +| | | +| | Mindestbestand : 25 | +| | | +| | Bestand : 20 | +| | | +| | | +| | Alles richtig ? | +| | | +| | Ja    Nein | +|-----------------------------------+------------------------------------| +| Info:/ Wahl: Ausführen: Verlassen: | ++------------------------------------------------------------------------+ +#off("b")# + + Zunächst muß eine Artikelnummer (1...15) eingegeben werden (je nach + Einstellung über die Tastatur oder mittels einer Warenkarte über den Code­ + kartenleser). Unzulässige Artikelnummern werden dabei nicht akzeptiert. +#page# + Ist unter dieser Nummer bereits ein Artikel gespeichert, so werden die ent­ + sprechenden Artikeldaten in dem rechten oberen Bildschirmfenster gezeigt + und können dort geändert oder einfach übernommen werden. Gibt es noch + keinen Artikel mit dieser Nummer, so sind neue Artikeldaten einzugeben. + + Dieser Vorgang wird solange wiederholt, bis bei der Eingabe der Artikelnummer + die Tastenfolge gedrückt wird. + + Achten Sie darauf, daß in jeder Filiale der zu einer Artikelnummer gehörige + Artikel stets denselben Artikelnamen und -preis erhält. Bestand und Mindest­ + bestand können unterschiedlich sein. + + +#on("b")#k Kundendatei bearbeiten#off("b")# + + Hiermit kann die Kundendatei der Filiale aufgebaut und verändert werden. + Ähnlich wie bei der Funktion 'Warendatei bearbeiten' erfolgen die Eingaben im + rechten oberen Bildschirmfenster. + + Zunächst muß eine Kundennummer (129...159) eingegeben werden (je nach + Einstellung über die Tastatur oder mittels einer Kundenkarte über den Code­ + kartenleser). Unzulässige Kundennummern werden dabei nicht akzeptiert. + + Ist unter dieser Nummer bereits ein Kunde in der Filiale oder in der Zentrale + gespeichert, so werden die entsprechenden Kundendaten in dem rechten + oberen Bildschirmfenster gezeigt und können dort geändert oder einfach über­ + nommen werden. Gibt es noch keinen Kunden mit dieser Nummer, so sind + neue Kundendaten einzugeben. (Neueingaben und Änderungen werden sofort + der Zentrale, aber nicht automatisch den andern Filialen mitgeteilt!) + + Dieser Vorgang wird solange wiederholt, bis bei der Eingabe der Kunden­ + nummer die Tastenfolge gedrückt wird. +#page# +#on("b")#e Einkaufen#off("b")# + + Zunächst wird eine Kundennummer (129...159) erfragt. Wird die Nummer + eines Kunden eingegeben, dessen Daten in der Filiale oder Zentrale bereits + gespeichert sind, so erscheint im linken Bildschirmfenster der Rechnungskopf + mit dem Namen des Kunden. Ist unter der Nummer noch kein Kunde einge­ + tragen oder wird die Eingabe der Kundennummer durch die Tastenfolge + abgebrochen, so enthält der Rechnungskopf keinen Kunden­ + namen. + + Das eigentliche Einkaufen erfolgt nun durch die Eingabe von Artikelnummern + (1...15). Der zugehörige Artikelname und der Preis werden daraufhin in die + Rechnung eingetragen. +#on("b")# ++------------------------------------------------------------------------+ +|WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv | +|----------------------------------+-------------------------------------| +| RECHNUNG für Herrn B. Pollok | Artikelnummer :  1 | +| | | +| Bier (Kasten) 16.85 | | +| Tageszeitung 0.80 | | +| Pflaster 2.39 | | +| Mehl 0.79 | | +| Seife 1.80 | | +| Weinbrand 12.75 | | +| Zigaretten 3.80 | | +| Brot 2.29 | | +| Schallplatte 19.90 | | +| Geodreieck 2.35 |-------------------------------------| +| Videokassette 12.75 | Artikelnummer eingeben | +| Schulheft 0.85 | | +| | Stoptaste:   | +|----------------------------------+-------------------------------------| +| Einkaufen | ++------------------------------------------------------------------------+ +#off("b")# | + + Dieser Vorgang wird solange wiederholt, bis die Eingabe einer Artikelnummer + durch Tippen der Tastenfolge abgebrochen wird. + + Abschließend wird der Rechnungsgesamtbetrag ausgegeben und gefragt, ob die + Rechnung gedruckt werden soll. +#page# +#on("b")#a Auskunft einholen#off("b")# + + Mit Hilfe dieses Kommandos lassen sich nach Einlesen einer Codenummer (je + nach Einstellung über Tastatur oder Codekartenleser) verschiedene Auskünfte + über die gespeicherten Daten abrufen. Es können #on("b")#Einzelauskünfte#off("b")# oder + #on("b")#Listenauskünfte#off("b")# eingeholt werden. Bei Eingabe einer falschen Nummer wird + die Auskunft abgebrochen! + + + #on("b")#Einzelauskünfte:#off("b")# + + Codenummern 1...15 (Artikelnummern): + Die zugehörigen Artikeldaten werden im rechten oberen Bild­ + schirmfenster angezeigt. + + Codenummern 129...159 (Kundennummern): + Die zugehörigen Kundendaten werden im rechten oberen + Bildschirmfenster angezeigt. + + + #on("b")#Listenauskünfte:#off("b")# + + Hierbei liefern jeweils 3 benachbarte Codenummern von der Art her ähnliche + Auskunfts-Listen, die auf Wunsch auch ausgedruckt werden können. Die + mittlere Nummer bezieht die Auskünfte stets auf die eigene Filiale; die beiden + anderen sind nur effizient, wenn mehrere Filialen angemeldet sind. Dabei + werden bei Eingabe der linken Nummer die jeweiligen Daten #on("b")#aller#off("b")# Filialen + 'aufaddiert' und in #on("b")#einer#off("b")# Gesamtliste ausgegeben. Bei Eingabe der rechten + Nummer hingegen werden die jeweiligen Listen von allen angeschlossenen + Filialen der Reihe nach abgerufen und #on("b")#hintereinander#off("b")# in eine Datei ge­ + schrieben, sodaß man eine Zusammenstellung der entsprechenden #on("b")#Einzel#off("b")#- + Listen der Filialen erhält: +#page# + Codenummern 66, 67, 68: + Die bisherigen Verkaufszahlen der einzelnen Waren werden + gezeigt; die Listen sind sortiert nach diesen Zahlen ('Ver­ + kaufs-Hitlisten'). + + Codenummern 73, 74, 75: + Nach Eingabe einer Artikelnummer wird eine Liste aller + Käufer dieses Artikels ausgegeben. + + Codenummern 77, 78, 79: + Diese Codes liefern Kundenlisten der Filialen. + + Codenummern 84, 85, 86: + Nach Eingabe einer Kundennummer wird eine Liste aller von + diesem Kunden gekauften Artikel ausgegeben. + + Codenummern 89, 90, 91: + Diese Codes liefern die Lagerbestandslisten der Filialen. Sollte + sich bei der Auskunft '90' herausstellen, daß der Bestand + mehrerer Artikel unter den Mindestbestand abgesunken ist, ist + es sinnvoll, als nächstes den Menupunkt 'Nachbestellen' + anzuwählen (s.u.). +#page# + Beispiel: Der Code '90' liefert bei entsprechend eingegebener Warendatei + folgende Auskunft: +#on("b")# + +------------------------------------------------------------------------+ + | ............. Auskunft: Filiale 1 ................... Zeile 1 | + | | + | Lagerübersicht: | + | ---------------------------------------------------------------------- | + | ---------------------------------------------------------------------- | + | | Art.Nr.| Artikelname | Preis | Min.Best. | Bestand | | + | ---+---------+------------------+-------------+-----------+----------+ | + | | | | | | | | + | | 1 | Bier (Kasten) | 16.85 | 25 | 19 | | + | | 2 | Tageszeitung | 0.80 | 15 | 16 | | + | | 3 | Pflaster | 2.39 | 14 | 22 | | + | | 4 | Mehl | 0.79 | 32 | 58 | | + | | 5 | Seife | 1.80 | 27 | 49 | | + | | 6 | Weinbrand | 12.75 | 24 | 41 | | + | | 7 | Zigaretten | 4 +------------+--------+ | | + | | 8 | Brot | 2 | Auskunft drucken ?| | | + | | 9 | EMMA | 3 | | | | + | | 10 | Schallplatte | 19 | Ja     Nein | | | + | | 11 | Geodreieck | 2 +---------------------+ | | + | | | | | | | + | | | | | | | + | | | | | | | + |----------------------------------------------------------------------- | + | | Ändern:    Bestätigen:  | + + -----------------------------------------------------------------------+ + +#off("b")# + + Hinweis: Nur die zu den jeweils mittleren Codenummern gehörigen Aus­ + kunftsfunktionen arbeiten mit Daten, die in der eigenen Task + gespeichert sind. Bei den übrigen Auskünften müssen Daten aus + anderen Filialverwaltungs-Tasks oder der Zentrale geholt werden, + so daß die Erstellung solch einer Auskunft recht zeitaufwendig ist. + Um zu lange Wartezeiten zu vermeiden, sollten nicht mehrere + Filialen gleichzeitig Auskünfte dieser Art einholen. +#page# +#on("b")#n Nachbestellen#off("b")# + + Auf dem Bildschirm wird eine Bestelliste ausgegeben, die alle Artikel enthält, + deren Bestand innerhalb der Filiale den Mindestbestand unterschritten hat. + + Die Nachbestellung ist so bemessen, daß diese Artikel wieder mit ihrem + doppelten Mindestbestand vorrätig sind. Die neuen Bestände werden auto­ + matisch in die Warendatei der Filiale eingetragen. + + Auf Wunsch kann die Bestelliste ausgedruckt werden. + + +#on("b")#d Dezimalwert lesen#off("b")# + + Der aktuelle Wert, der vom Codekartenleser gelesen wird, wird (ähnlich wie bei + 'Bitmuster lesen', s.u.) auf dem Bildschirm ausgegeben, bis + gedrückt wird. Mit Hilfe dieses Kommandos kann man z.B. die Funktion des + Codekartenlesers testen und den Zusammenhang zwischen Bitmuster und + Dezimalwert klären. + + Dieser Menupunkt ist (ebenso wie der nächste) nur dann aufrufbar, wenn + unter #on("b")#Eingabeart#off("b")# der #on("b")#Kartenleser#off("b")# eingestellt ist. + + +#on("b")#b Bitmuster lesen#off("b")# + + Dieser Menupunkt ist nur dann aufrufbar, wenn unter #on("b")#Eingabeart#off("b")# der + #on("b")#Kartenleser#off("b")# eingestellt ist (vgl. Kapitel 5.3). + + Ist das der Fall, so wird hier das aktuelle Bitmuster, das vom Codekartenleser + gelesen wird, auf dem Bildschirm ausgegeben, bis gedrückt + wird. +#on("b")# ++-------------------------------------------------------------------------+ +| WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv | +|-----------------------------------+-------------------------------------| +| | | +| | | +| | Bitmuster :    0I00III0 | +| | | +| | | +| | | +| | | +| | | +| | | +| | | +| | | +| | | +| | Lesen beenden mit | +| +-------------------------------------| +| | +| Bitmuster lesen | ++-------------------------------------------------------------------------+ +#off("b")# + + Ein Bitmuster besteht aus 8 Zeichen (z.B. 'OIOOIIIO'). Dabei zeigt jedes 'I' ein + Loch an der entsprechenden Stelle der Codekarte an, die sich gerade im + Kartenlesegerät befindet. Dieses Bitmuster entspricht der Dualzahl 01001110 + (im 'Zweiersystem'); zu ihr gehört die Dezimalzahl +#on("b")# + + 0 * 128 + 1 * 64 + 0 * 32 + 0 * 16 + 1 * 8 + 1 * 4 + 1 * 2 + 0 * 1 = 78. +#off("b")# + + Mit Hilfe dieses Kommandos können Sie z.B. die Funktion des Codekarten­ + lesers testen. Bei voller Beleuchtung aller 8 Sensoren muß das Bitmuster + 'IIIIIIII' geliefert werden. Decken Sie einige Sensoren mit den Fingern oder + einer Lochkarte ab, so muß sich das Bitmuster auf dem Bildschirm ent­ + sprechend verändern. Ist das nicht der Fall, so liegt ein Fehler vor. + + Prüfen Sie dann erst einmal, ob der Steckplatz mit Strom versorgt wird (Netz­ + kabel in der Steckdose? Compact-Box mit Netzteil richtig verbunden?) Ist dort + alles in Ordnung, so könnte der Fehler noch in der Verbindung zum Adapter + liegen. (Steckplatz ordnungsgemäß mit Adapter verbunden? Richtiges Kabel + verwendet?) +#page# + Sollten Sie auf diese Weise nicht zum Erfolg kommen, so verlassen Sie diesen + Menupunkt und wählen noch einmal den Oberbegriff 'Eingabeart' an. Stellen + Sie dort die Eingabeart zunächst auf 'Tastatur um' und dann wieder auf + 'Kartenleser'. Treten hier Fehlermeldungen auf, so lesen Sie in Kapitel 5.3 + nach. Läßt sich die Umstellung dagegen problemlos vornehmen, so müßte nun + auch das 'Bitmuster lesen' wieder funktionieren. + + +#on("b")#5.5  Menufunktionen zum Oberbegriff 'Programme'#off("b")# + +#on("b")# ++-------------------------------------------------------------------------+ +| WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv | +|---------------------+----------------------+----------------------------| +| | n  Neu erstellen | | +| | a  Ansehen/Ändern | | +| | ------------------ | | +| | s  Starten | | +| | w  Wiederholen | | +| | ------------------ | | +| | v  Verzeichnis | | +| | ------------------ | | +| | l  Löschen | | +| | d  Drucken | | +| | ------------------ | | +| | k  Kopieren | | +| | u  Umbenennen | | +| +----------------------+ | +|-------------------------------------------------------------------------| +| Info:/ Wahl: Ausführen: Verlassen: | ++-------------------------------------------------------------------------+ +#off("b")# + +#on("b")#n Neu erstellen#off("b")# + + Mit dieser Funktion können Sie eine neue Programmdatei anlegen und + beschreiben. + + Sie werden zunächst nach einem Namen für die #on("b")#neue#off("b")# Programmdatei gefragt. + Geben Sie einen beliebigen Namen (#on("b")#ohne Anführungszeichen (!)#off("b")#) ein und +#page# + schließen Sie die Eingabe durch ab. Daraufhin wird Ihnen auf + dem Bildschirm eine neue Datei zum Beschreiben angeboten. + + Sollte schon eine Programmdatei mit diesem Namen in der Task vorhanden + sein, so werden Sie darauf aufmerksam gemacht. + + Sie können sich während des Schreibens die wichtigsten Tastenfunktionen des + Editors einblenden lassen. Tippen Sie dazu die Tastenfolge . Es + erscheint dann das folgende Angebot aus dem Sie auswählen können: + +#on("b")# + +-----------------------------------------------------+ + | Der EUMEL - Editor | + | | + | b ... Beschreibung desEditors | + | w ... Wichtige Tasten | + | p ... Positionieren der Schreibmarke | + | k ... Korrigieren im Text (Einfügen/Löschen) | + | m ... Markierte Textpassagen bearbeiten | + | l ... Lernen im Editor | + | a ... Anweisungen im Editor (Kommandodialog) | + | | + | z ... Zurück in den Schreibmodus | + | | + | b   w   p   k   m   l   a   z | + | | + +-----------------------------------------------------+ +#off("b")# + Fehlerfälle: + - Eine Programm-Datei mit dem vorgeschlagenen Namen existiert schon. + + +#on("b")#a Ansehen/ändern#off("b")# + + Mit dieser Funktion können Sie sich Dateien, die schon in Ihrer Task + existieren, ansehen oder auch verändern. + + Sie werden zunächst gefragt, ob Sie #on("b")#die zuletzt bearbeitete Programmdatei#off("b")# + ansehen bzw. verändern möchten (sofern Sie schon vorher mit #on("b")#gs-Warenhaus#off("b")# + in der Task gearbeitet haben). +#page# + Bejahen Sie diese Frage, dann wird Ihnen diese Programmdatei zur Bear­ + beitung angeboten. Verneinen Sie die Frage dagegen, so gelangen Sie in die + 'Auswahl' (d.h es werden Ihnen alle Programmdateien in der Task zur Auswahl + angeboten). Nachdem Sie einen der Namen angekreuzt haben, wird Ihnen die + ausgewählte Programmdatei zur Bearbeitung auf dem Bildschirm angeboten. + + Fehlerfälle: + - In der Task existiert noch keine Programmdatei. + + +#on("b")#s Starten#off("b")# + + Mit dieser Menufunktion können Sie ein fertiggestelltes Programm übersetzen + und ausführen lassen. + + Sie werden zunächst gefragt, ob #on("b")#das zuletzt bearbeitete Programm#off("b")# ausgeführt + werden soll. Bejahen Sie die Frage, so wird dieses Programm gestartet; ver­ + neinen Sie die Frage dagegen, so gelangen Sie in die 'Auswahl'. Nach An­ + kreuzen des gewünschten Programmnamens wird das ausgewählte Programm + ausgeführt. + + Sind im Programm noch Fehler enthalten, so werden das Programm und die + Fehlermeldungen gleichzeitig auf dem Bildschirm dargestellt (Paralleleditor) + und zur Korrektur angeboten. Für die Programmkorrektur stehen ebenfalls alle + Editorfunktionen zur Verfügung. + + Sollte Ihnen beim Programmieren ein Fehler unterlaufen sein (z.B. eine + Endlosschleife), so kann mit der Tastenfolge der Programm­ + ablauf abgebrochen werden ("Notbremse"). +#page# +#on("b")#w Wiederholen#off("b")# + + Mit dieser Funktion können Sie den Ablauf des zuletzt ausgeführten + Programms wiederholen, ohne daß das Programm neu übersetzt wird. + + Beachten Sie aber bitte, daß Veränderungen am Programmtext, die seit dem + letzten Programmlauf vorgenommen wurden, #on("b")#nicht#off("b")# berücksichtigt werden; + dazu muß das Programm erneut mit der Menufunktion 'Starten' übersetzt + werden. + + Ist die Wiederholung eines Programmlaufs nicht möglich, so erfolgt ein Hin­ + weis darauf. + + +#on("b")#v Verzeichnis#off("b")# + + Mit dieser Funktion können Sie sich einen Überblick über die in Ihrer Task + vorhandenen Programmdateien verschaffen. + + Nach Aufruf dieser Funktion wird eine Liste der Programmdateien auf dem + Bildschirm ausgegeben, die sich in Ihrer Task befinden. Da die Liste selbst + eine Text-Datei ist, kann Sie mit der Tastenkombination ver­ + lassen werden - hierauf wird auch in der letzten Bildschirmzeile hingewiesen. + Falls nicht alle Namen auf den Bildschirm passen, können Sie das Fenster mit + und verschieben. + + +#on("b")#Löschen#off("b")# + + Mit dieser Funktion können Sie Programmdateien, die Sie nicht mehr + benötigen, die unnötig Platz belegen, löschen. Aber Vorsicht! Die Dateien + verschwinden durch diese Funktion unwiederbringlich! + + Nach Aufruf dieser Funktion werden Ihnen alle Programmdateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Hier können Sie die gewünschten + Namen ankreuzen. Die Auswahl wird dann durch die Tastenfolge + verlassen. +#page# + Für jede einzelne Programmdatei wird noch einmal zur Sicherheit gefragt, ob + sie auch tatsächlich gelöscht werden soll. Zur Bestätigung tippen Sie bitte die + Taste ('ja') - zur Verhinderung ('nein'). + + Fehlerfälle: + - In der Task exsitiert noch keine Programmdatei + + +#on("b")#d Drucken#off("b")# + + Mit dieser Funktion können Sie Programmdateien über einen angeschlossenen + Drucker ausgeben lassen. + + Nach Aufruf dieser Funktion werden Ihnen alle Programmdateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Hier können Sie die gewünschten + Namen ankreuzen. Die Auswahl wird dann durch die Tastenfolge + verlassen. + + Die angekreuzten Programmdateien werden anschließend zum Drucker ge­ + schickt. Der Vorgang wird auf dem Bildschirm protokolliert. + + Fehlerfälle: + - In der Task existiert noch keine Programmdatei. + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' betrieben. + - Auf Ihrem System werden die Druckkosten abgerechnet. Sie müssen sich + mit einer Codenummer identifizieren. + + +#on("b")#k Kopieren#off("b")# + + Mit dieser Funktion können Sie sich eine Kopie einer bereits in der Task + vorhandenen Programmdatei anlegen. Das ist z.B. dann sinnvoll, wenn Sie sich + einen bestimmten 'Stand' aufbewahren wollen oder wenn Sie ein Programm + schreiben wollen, das einem bereits vorhandenen ähnelt. +#page# + Nach Aufruf dieser Funktion werden Ihnen alle Programmdateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Nach Ankreuzen eines Namens + wird die Auswahl automatisch verlassen. + + Anschließend wird der angekreuzte Name angezeigt und der Name für die + Kopie erfragt. Es muß ein Name eingetragen werden, der in dieser Task noch + nicht für eine Programmdatei vergeben wurde; ansonsten erfolgt ein Hinweis + darauf und es wird nicht kopiert! + + Da man aber oft für die Kopie einen ähnlichen Namen wie für das Original + wählt, wird der 'alte' Name vorgeschlagen. Aus genannten Gründen muß er + aber verändert werden. Sie können diesen Namen mit den üblichen Editier­ + funktionen verändern oder mit löschen und ganz neu + eingeben. Sie sparen aber eine Menge Tipparbeit, wenn Sie einen langen + Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Programmdatei mit dem gewünschten Namen existiert bereits in der + Task. + + +#on("b")#u Umbenennen#off("b")# + + Mit dieser Funktion können Sie einer bereits vorhandenen Programmdatei + einen neuen Namen geben. + + Nach Aufruf dieser Funktion werden Ihnen alle Programmdateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Nach Ankreuzen eines Namens + wird die Auswahl automatisch verlassen. + + Anschließend wird dieser Name angezeigt und der zukünftige Name für die + Programmdatei erfragt. Es muß ein Name eingetragen werden, der in dieser + Task noch nicht für eine Programmdatei vergeben wurde - ansonsten erfolgt + ein Hinweis darauf und die Programmdatei wird nicht umbenannt! +#page# + Da man aber oft den 'neuen' Namen in Anlehnung an den 'alten' Namen + wählt, wird der 'alte' Name vorgeschlagen. Aus genannten Gründen muß er + aber verändert werden. Sie können diesen Namen mit den üblichen Editier­ + funktionen verändern oder mit löschen und ganz neu + eingeben. Sie sparen aber eine Menge Tipparbeit, wenn Sie einen langen + Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Programmdatei mit dem gewünschten Namen existiert bereits in der + Task. + + + +#on("b")#5.6  Menufunktionen zum Oberbegriff 'Filialdaten'#off("b")# +#on("b")# ++-------------------------------------------------------------------------+ +| WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv | +|---------------------------------------+--------------------------+------| +| | e   Eintragen/ergänzen | | +| | z   Zusammenstellen | | +| | ----------------------- | | +| | v   Verzeichnis | | +| | ----------------------- | | +| | l   Löschen | | +| | u   Umbenennen | | +| +--------------------------+ | +| | +| | +|-------------------------------------------------------------------------| +| Info:/ Wahl: Ausführen: Verlassen:| ++-------------------------------------------------------------------------+ + +#off("b")# + +#on("b")#e Eintragen/ergänzen#off("b")# + + Mit diesem Menupunkt können Sie Filialdaten-Dateien, die Sie z.B. von der + Vatertask oder von der Diskette geholt haben, in Ihrer Task laden. +#page# + Ihnen werden zunächst alle vorhandenen Filialdaten-Dateien zur Auswahl + angeboten. Anschließend werden die angekreuzten Dateien in der Reihenfolge, + in der sie angekreuzt wurden, zur Filialverwaltung geschickt und die Daten + dort zu den bereits vorhandenen hinzugefügt. Gegebenenfalls wird auch die + zentrale Kundendatei ergänzt. Der Vorgang wird auf dem Bildschirm + protokolliert. + + Beachten Sie bitte, daß in der Filiale etwa vorhandene Daten dadurch nicht + überschrieben, sondern lediglich ergänzt werden. Ein gänzliches Beseitigen von + alten Daten gelingt nur durch Löschen der Filialtask. + + Fehlerfälle: + - In der Task exsitieren noch keine Filialdaten-Dateien. + + +#on("b")#z Zusammenstellen#off("b")# + + Mit dieser Funktion können Sie eine Datei anlegen, in der die aktuell in der + Filiale gehaltenen Daten zusammengestellt werden. Solch eine Datei kann man + sich jedoch nicht ansehen! + + Zunächst wird der Name der Datei erfragt, in die die Filialdaten geschrieben + werden sollen. Danach werden darin die aktuellen Daten gespeichert und es + wird eine 'Vollzugsmeldung' ausgegeben. + + Die Daten können dann später mit Hilfe der Archiv-Funktionen (vgl. Kapitel + 5.7) z.B. auf einer Diskette gespeichert werden, damit Sie beim eventuellen + Löschen der Filialtask nicht verlorengehen. Eine Verwechselung mit + Programmdateien ist nicht möglich, da Namen für Filialdaten-Dateien (intern) + automatisch mit dem Präfix 'Filialdaten:' versehen werden. + + Fehlerfälle: + - Eine Filialdaten-Datei mit dem gewünschten Namen existiert bereits in der + Task. +#page# +#on("b")#v Verzeichnis#off("b")# + + Mit dieser Funktion können Sie sich einen Überblick über die in Ihrer Task + vorhandenen Filialdaten-Dateien verschaffen. + + Nach Aufruf dieser Funktion wird eine Liste der Filialdaten-Dateien auf dem + Bildschirm ausgegeben, die sich in Ihrer Task befinden. Da die Liste eine + Text-Datei ist, kann Sie mit der Tastenkombination verlassen + werden - hierauf wird auch in der letzten Bildschirmzeile hingewiesen. Falls + nicht alle Namen auf den Bildschirm passen, können Sie das Fenster mit + und verschieben. + + +#on("b")#l Löschen#off("b")# + + Mit dieser Funktion können Sie Filialdaten-Dateien, die Sie nicht mehr + benötigen und die unnötig Platz belegen, löschen. Aber Vorsicht! Die Dateien + verschwinden durch diese Funktion unwiederbringlich! + + Nach Aufruf dieser Funktion werden Ihnen alle Filialdaten-Dateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Hier können Sie die gewünschten + Namen ankreuzen. Die Auswahl wird dann durch die Tastenfolge + verlassen. + + Für jede einzelne Datei wird nachgefragt, ob sie auch tatsächlich gelöscht + werden soll. Zur Bestätigung tippen Sie bitte die Taste ('ja') - zur Ver­ + hinderung ('nein'). + + Fehlerfälle: + - In der Task exsitiert noch keine Filialdaten-Datei. +#page# +#on("b")#u Umbenennen#off("b")# + + Mit dieser Funktion können Sie einer bereits vorhandenen Filialdaten-Datei + einen neuen Namen geben. + + Nach Aufruf dieser Funktion werden Ihnen alle Filialdaten-Dateien, die sich in + Ihrer Task befinden, zur Auswahl angeboten. Nach Ankreuzen eines Namens + wird die Auswahl automatisch verlassen. + + Anschließend wird dieser Name angezeigt und der zukünftige Name für die + Datei erfragt. Es muß ein Name eingetragen werden, der in dieser Task noch + nicht für eine Filialdaten-Datei vergeben wurde - ansonsten erfolgt ein Hinweis + darauf und die Datei wird nicht umbenannt! + + Da man aber oft den 'neuen' Namen in Anlehnung an den 'alten' Namen + wählt, wird der 'alte' Name vorgeschlagen. Aus genannten Gründen muß er + aber verändert werden. Sie können diesen Namen mit den üblichen Editier­ + funktionen verändern oder mit löschen und ganz neu + eingeben. Sie sparen aber eine Menge Tipparbeit, wenn Sie einen langen + Namen nur an einer Stelle ändern wollen. + + Fehlerfälle: + - Eine Filialdaten-Datei mit dem gewünschten Namen existiert bereits in der + Task. +#page# +#on("b")#5.7  Menufunktionen zum Oberbegriff 'Archiv'#off("b")# +#on("b")# ++--------------------------------------------------------------------------+ +| WARENHAUS:  Info  Eingabeart  Kommandos  Programme  Filialdaten  Archiv | +|---------------------------------------------+------------------------+---| +| | r  Reservieren | | +| | -  Neue Diskette | | +| | -------------------- | | +| | -  Schreiben | | +| | -  Checken | | +| | -  Kombination | | +| | -  Holen/Lesen | | +| | -  Löschen | | +| | -------------------- | | +| | -  Verzeichnis | | +| | -  Drucken | | +| | -------------------- | | +| +-----------------------+ | i  Initialisieren | | +| | Dateiaustausch mit: | | z  Zieltask einstellen| | +| | Archiv | +------------------------+ | +| | Archivname: | | +| | gs-Warenhaus | | +| +-----------------------+ | +|--------------------------------------------------------------------------| +| Info:/ Wahl: Ausführen: Verlassen: | ++--------------------------------------------------------------------------+ +#off("b")# + +In diesem Kapitel werden alle die Menufunktionen beschrieben, die Ihnen unter dem +Oberbegriff 'Archiv' im Menu angeboten werden. Mit den Funktionen in diesem Menu +können Sie aber nicht nur Dateien auf dem Archiv behandeln, sondern auch in +anderen Tasks im Multi-User-System oder über das EUMEL-Netz sogar auf anderen +Rechnern! + +Wenn Sie dieses Pull-Down-Menu gerade aufgeschlagen haben, sind nicht alle +Funktionen aktivierbar! Um weitere Funktionen zu aktivieren, muß erst einer der +aktivierbaren Menupunkte gewählt werden. + +Bei der Archivbehandlung werden Ihnen jeweils alle in der Task vorhandenen Dateien +zur Auswahl angeboten. Das System unterscheidet nicht von sich aus - wie unter den +#page# +Oberbegriffen 'Programme' und 'Filialdaten' - zwischen Programm- und Filial­ +daten-Dateien. In den hier gezeigten Listen können Sie aber Filialdaten-Dateien +daran erkennen, daß ihnen das Präfix 'Filialdaten:' vorangestellt ist. + + +#on("b")#r Reservieren#off("b")# (des Archivlaufwerks) + + Im EUMEL-Multi-User-System haben normalerweise mehrere Personen das + Zugriffsrecht auf das Archivlaufwerk. Allerdings muß der Zugriff so geregelt + werden, daß sich die Beteiligten dabei nicht gegenseitig "in die Quere + kommen". Ein Zugriff auf das Archivlaufwerk erfordert zunächst eine An­ + meldung. Ist diese Anmeldung erfolgt, kann von den anderen Beteiligten so + lange nicht mehr auf das Laufwerk zugegriffen werden, bis es wieder freige­ + geben worden ist. + + Diese Anmeldung des Archivlaufwerkes erfolgt über die Menufunktion 'r Reser­ + vieren'. Greift bereits eine andere Task auf das Laufwerk zu, so erhalten Sie + darüber einen Hinweis auf dem Bildschirm. Ansonsten wird an Sie die Frage + gestellt, ob die Diskette eingelegt und das Laufwerk geschlossen ist. + + Erst zu diesem Zeitpunkt ist sichergestellt, daß Sie den alleinigen Zugriff auf + das Laufwerk haben. Deshalb sollten Sie, wenn Sie mit mehreren Personen am + Computer arbeiten, erst zum Zeitpunkt der Fragestellung die Diskette ins Lauf­ + werk einlegen. + + Nachdem Sie die Diskette eingelegt und die Frage bejaht haben, ermittelt das + System selbständig den Namen der eingelegten Diskette, zeigt den Namen auf + dem Bildschirm (im kleinen Kasten links unten) an und aktiviert die anderen + Menupunkte des Pull-Down-Menus. + + Beim Verlassen des Pull-Down-Menus, wenn eine andere Zieltask eingestellt + wird oder wenn das Menu gänzlich verlassen wird, wird die Reservierung + automatisch aufgehoben! +#page# + Fehlerfälle: + - Das Laufwerk ist von einer anderen Task belegt. + - Die Diskette ist falsch eingelegt oder das Laufwerk ist nicht richtig ge­ + schlossen. + - Die Diskette ist nicht formatiert bzw. initialisiert. + - Die Diskette kann nicht gelesen werden (keine EUMEL-Diskette, Diskette + hat ein falsches Format, Diskette ist verschmutzt...). + + +#on("b")#n Neue Diskette#off("b")# (anmelden) + + Der Dateiaustausch mit einer Diskette ist nur dann möglich, wenn der im + System eingestellte Diskettenname (auf dem Bildschirm im kleinen Kasten + unten links sichtbar) mit dem tatsächlichen Namen der Diskette überein­ + stimmt. Nach einem Diskettenwechsel ist das aber in der Regel nicht mehr der + Fall. Greift man dann auf die neu eingelegte Diskette zu, so erscheint die + Fehlermeldung: 'Falscher Archivname! Bitte neue Diskette anmelden!'. + + Das Anmelden einer neuen Diskette - ohne einen neuen Reservierungsvorgang + - wird durch diese Menufunktion ermöglicht. Nach Aktivieren dieses Menu­ + punktes wird der Name der eingelegten Diskette ermittelt, im System eingestellt + und auf dem Bildschirm angezeigt. + + Im Gegensatz zur Menufunktion 'r Reservieren' greift das System ohne Anfrage + an den Benutzer auf das Archivlaufwerk zu (die Reservierung bleibt ja be­ + stehen). Ist das Archivlaufwerk reserviert, so ist die Neuanmeldung einer Dis­ + kette über diese Menufunktion weniger zeitaufwendig. + + Fehlerfälle: + - wie unter 'r Reservieren'. +#page# +#on("b")#s Schreiben#off("b")# (Kopieren) + + Alle Dateien der eigenen Task werden zur Auswahl angeboten. Wenn Sie die + Auswahl durch die Tastenfolge verlassen, überprüft das System + zunächst, ob die Dateien in der eingestellten Zieltask schon vorhanden sind. Ist + das der Fall, wird erfragt, ob die dort vorhandenen Dateien überschrieben, d.h. + gelöscht werden dürfen (s.u.). Anschließend werden alle angekreuzten Dateien + in der Reihenfolge, in der Sie sie angekreuzt haben, in die eingestellte Zieltask + kopiert. Der Vorgang wird auf dem Bildschirm protokolliert. Die Original­ + dateien in der eigenen Task bleiben dabei erhalten. + + Wenn in der Zieltask schon eine Datei existiert, die den gleichen Namen hat + wie eine Datei, die Sie dorthin kopieren möchten, so wird angefragt, ob die + vorher schon existierende Datei überschrieben (gelöscht!) werden soll. Bejahen + Sie diese Frage, so wird die bereits in der Zieltask existierende Datei (un­ + wiederbringlich) gelöscht und die gewünschte Datei dorthin transportiert. Ein + Überschreiben aus Versehen ist nicht möglich, wenn Sie die an Sie gestellte + Frage sorgfältig beantworten. + + Verneinen Sie die Frage, so wird die Datei auch nicht hinübertransportiert! Sie + können die Datei aber umbenennen (Menufunktion 'u Umbenennen' unter + den Oberbegriffen 'Programme' bzw. 'Filialdaten') und anschließend mit + anderem Namen hinüberschreiben. + + Beachten Sie, daß beim Überschreiben einer Datei auf einer Archivdiskette der + Speicherplatz der alten (überschriebenen) Version im allgemeinen nicht + wiederverwendet werden kann. In einem solchen Fall könnte die Diskette voll + geschrieben werden, obwohl eigentlich genügend Platz vorhanden wäre. Zur + Optimierung wird deshalb zuerst überprüft, ob die angekreuzten Dateien + schon in der Zieltask vorhanden sind und löscht diese, wenn Sie Ihr Einver­ + ständnis geben. Erst anschließend werden die Dateien insgesamt kopiert. +#page# + Normalerweise ist als Zieltask das Archivlaufwerk der eigenen Station einge­ + stellt. Mit der Menufunktion 'z Zieltask einstellen' kann diese Einstellung aber + verändert werden. + + Fehlerfälle: + - Die Diskette ist falsch eingelegt oder beschädigt. + - Die Diskette kann nicht beschrieben werden (Schreibfehler). + - Die Diskette ist voll. + - Sehen Sie auch unter 'r Reservieren' + 'z Zieltask einstellen'. + + +#on("b")#c Checken#off("b")# + + Diese Menufunktion kann nur ausgeführt werden, wenn der Dateiaustausch + mit einem Archiv(manager) erfolgt - ansonsten ist diese Menufunktion auch + nicht aktivierbar. Die Menufunktion dient dazu, auf Diskette geschriebene + Dateien auf Lesefehler hin zu prüfen. Es empfiehlt sich, diese Prüfroutine auf + neu auf die Diskette geschriebene Dateien anzuwenden. Sehen Sie dazu auch + 'k Kombination'. + + Alle Dateien der eingestellten Zieltask (Archiv) werden zur Auswahl angeboten. + Wenn Sie die Auswahl durch die Tastenfolge verlassen, werden + alle angekreuzten Dateien in der Reihenfolge, in der Sie sie angekreuzt haben, + "gecheckt", d.h. auf Lesefehler hin überprüft. Der Vorgang wird auf dem Bild­ + schirm protokolliert. + + Fehlerfälle: + - Lesefehler auf dem Archiv. + - Sehen Sie auch unter 'r Reservieren'. +#page# +#on("b")#k Kombination#off("b")# + + Diese Menufunktion ist eine Kombination aus den beiden Menufunktionen 's + Schreiben' und 'c Checken' (Sehen Sie weitere Informationen auch dort!). + + Alle Dateien der eigenen Task werden zur Auswahl angeboten. Wenn Sie die + Auswahl durch die Tastenfolge verlassen, werden alle ange­ + kreuzten Dateien in der Reihenfolge, in der Sie sie angekreuzt haben, in die + eingestellte Zieltask kopiert (gegebenenfalls müssen bereits vorhandene + Dateien gleichen Namens in der Zieltask gelöscht werden). Anschließend + werden alle Dateien, die gerade geschrieben wurden, gecheckt, d.h. auf Lese­ + fehler hin untersucht. Beide Vorgänge werden auf dem Bildschirm + protokolliert. + + Da die 'Check' - Operation nur bei Archivmanagern zulässig ist, ist diese Menu­ + funktionen ebenfalls nur bei Archivmanagern aktivierbar. Zur Erläuterung + sehen Sie bitte auch unter 'z Zieltask einstellen'. + + +#on("b")#h Holen/Lesen#off("b")# + + Die Menufunktion dient dazu, Dateien, die bereits auf einer Archivdiskette oder + in einer anderen Task existieren, in die eigene Task zu kopieren. + + Alle Dateien der eingestellten Zieltask werden zur Auswahl angeboten. An­ + schließend werden Kopien der angekreuzten Dateien in der Reihenfolge des + Ankreuzens in die eigene Task geholt. Das Original in der Zieltask bleibt dabei + unverändert! Der Vorgang wird auf dem Bildschirm protokolliert. + + Sind in der eigenen Task schon Dateien mit gleichem Namen vorhanden, so + wird gefragt, ob die 'alten' Dateien überschrieben (gelöscht) werden dürfen. + Nur wenn Sie zustimmen, werden die in Ihrer Task existierenden Dateien + (unwiederbringlich!) gelöscht und Kopien der gleichnamigen Dateien aus der + Zieltask angefertigt. +#page# + Stimmen Sie dem Löschvorgang nicht zu, dann bleiben die bisherigen Dateien + in Ihrer Task erhalten - die Dateien aus der Zieltask werden dann aber auch + nicht in Ihre Task kopiert! Um dennoch die Kopien zu erhalten, können Sie die + namensgleichen Dateien in Ihrer Task umbenennen und dann erst die Dateien + aus der anderen Task anfordern. + + Normalerweise werden die Dateien vom Archiv der eigenen Station geholt. Mit + dem Menupunkt 'z Zieltask einstellen' kann diese Einstellung verändert + werden. + + Fehlerfälle: + - Lesefehler auf dem Archiv. + - Sehen Sie auch unter 'r Reservieren' + 's Schreiben' + 'z Zieltask einstellen'. + + +#on("b")#l Löschen#off("b")# + + Die Menufunktion dient dazu, Dateien in der Zieltask (unwiederbringlich!) zu + löschen. Dazu werden alle Dateien der eingestellten Zieltask zur Auswahl ange­ + boten. Anschließend werden die angekreuzten Dateien in der Reihenfolge ihres + Ankreuzens gelöscht. Zur Sicherheit muß noch einmal für jede einzelne Datei + bestätigt werden, daß sie auch tatsächlich gelöscht werden soll. + + Beachten Sie, daß beim Löschen einer Datei auf einer Archivdiskette der + Speicherplatz im allgemeinen nicht wieder verwendet werden kann. In einem + solchen Fall könnte die Diskette voll geschrieben werden, obwohl eigentlich + genügend Platz vorhanden wäre. Diese Probleme treten bei anderen Tasks, die + keine Archivmanager sind, nicht auf, da deren Speicherplatz intelligenter + verwaltet wird. +#page# + Normalerweise ist als Zieltask das Archiv der eigenen Station eingestellt. Mit + dem Menupunkt 'z Zieltask einstellen' kann diese Einstellung verändert + werden. + + Fehlerfälle: + - Sehen Sie auch unter 'r Reservieren' + 's Schreiben' + 'z Zieltask einstellen'. + + +#on("b")#v Verzeichnis#off("b")# + + Mit dieser Menufunktion können Sie sich einen Überblick über die in der + Zieltask (z.B. auf dem Archiv) vorhandenen Dateien verschaffen. + + Nach Aufruf der Funktion wird eine Liste der Dateien auf dem Bildschirm + ausgegeben, die sich in der Zieltask (z.B. auf dem Archiv) befinden. Ist die + Zieltask ein Archiv(manager), so wird auch angezeigt, wieviel Platz auf der + Diskette belegt ist. Da die Liste selbst eine Datei ist, kann sie mit der Tasten­ + kombination verlassen werden. Falls nicht alle Dateinamen auf + den Bildschirm passen, können Sie das Fenster mit und + verschieben. + + Fehlerfälle: + - Sehen Sie unter 'z Zieltask einstellen'. + + +#on("b")#d Drucken#off("b")# + + Das Verzeichnis der Dateien in der Zieltask, das man mit der Menufunktion 'v + Verzeichnis' auf dem Bildschirm angezeigt bekommt, kann mit dieser Menu­ + funktion ausgedruckt werden. +#page# + Zur Sicherheit wird angefragt, ob wirklich ein solches Dateiverzeichnis der + Zieltask gedruckt werden soll. Bejaht man die Frage, so wird ein Dateiver­ + zeichnis erstellt und zum Drucker geschickt. + + Fehlerfälle: + - Der Drucker ist nicht funktionsbereit. + - Der Drucker wird nicht über die Task 'PRINTER' betrieben. + - Auf Ihrem System werden die Druckkosten abgerechnet. Sie müssen sich + mit einer Codenummer identifizieren. + + +#on("b")#i Initialisieren#off("b")# + + Diese Menufunktion gestattet es, frische Disketten zu formatieren, zu initiali­ + sieren bzw. beschriebene Disketten vollständig zu löschen und ggf. dabei + umzubenennen. Bei Aufruf dieser Menufunktion wird - sofern noch nicht + geschehen - das Archivlaufwerk automatisch reserviert. + + Wenn Sie eine fabrikneue Diskette aus der Verpackung nehmen, müssen Sie + diese zunächst #on("b")#formatieren#off("b")#. Dabei wird die Diskette auf ein festgelegtes + physikalisches Format eingestellt. Ohne daß diese Operation vorausgegangen + ist, kann eine Diskette weder beschrieben noch gelesen werden. + + Prinzipiell braucht eine Diskette nur ein einziges Mal formatiert zu werden. Sie + können Sie jedoch jederzeit wieder formatieren - z.B. wenn Sie Disketten + haben, von denen Sie nicht genau wissen, für welche Zwecke sie zuvor ver­ + wendet wurden. + + Wenn Sie diese Menufunktion aktivieren, werden Sie so zunächst gefragt, ob Sie + die Diskette auch formatieren wollen. Bejahen Sie die Frage, so werden Ihnen + mehrere Formate zur Auswahl angeboten: +#page# +#on("b")# + +----------------------------------------+ + | Formatieren einer Diskette | + | | + | Dies sind die möglichen Formate: | + | | + | 1 .... 40 Spur - 360 KB | + | 2 .... 80 Spur - 720 KB | + | 3 .... 5 1/4" - 1,2 MB | + | 4 .... 3 1/2" - 1,4 MB | + | s .... Standard - Format | + | | + | | + | 1   2   3   4   s | + +----------------------------------------+ + +#off("b")# + + Erkundigen Sie sich bei Ihrem Händler, welches Format Sie bei Ihrem Rechner + und den von Ihnen verwendeten Disketten einstellen müssen. Manche Rechner + unterstützen diese Operation innerhalb des EUMEL-Systems auch gar nicht, + das Formatieren muß dann irgendwie anders außerhalb des EUMEL-Systems + geschehen. + + Wenn Sie die Formatierung abgeschlossen oder auch übersprungen haben, + beginnt die eigentliche Initialisierung der Diskette. Dabei wird als erstes der + Archivname auf die Diskette geschrieben. Alle alten Daten, die sich ggf. auf der + Diskette befinden, werden bei diesem Vorgang unwiederbringlich (!) gelöscht. + + Zur Sicherheit überprüft das System in jedem Falle, ob es sich um eine EUMEL + - Diskette handelt, und erfragt Ihr Einverständnis, ob die Diskette wirklich + initialisiert werden soll. Geben Sie hierzu Ihr Einverständnis, dann wird noch + der (neue) Archivname erfragt. Hatte die Diskette schon einen Namen, dann + wird dieser zum Überschreiben angeboten. Wollen Sie den alten Archivnamen + beibehalten, so brauchen Sie nur die -Taste zu tippen, ansonsten + können Sie den Namen auch zuvor verändern oder einen ganz neuen Namen + hinschreiben. Anhand des ausgegebenen Namens können Sie auch über­ + prüfen, ob Sie die richtige Diskette eingelegt haben. +#page# + Das Initialisieren funktioniert natürlich nur, wenn Sie als Zieltask einen + Archivmanager eingestellt haben - ansonsten ist diese Menufunktion gesperrt + (nicht aktivierbar!). + + Fehlerfälle: + - Formatieren ist nicht auf dem System möglich. + - Sehen Sie auch unter 'r Reservieren' + 'z Zieltask einstellen'. + + +#on("b")#z Zieltask einstellen#off("b")# + + Mit dieser Menufunktion können Sie festlegen, mit welcher Zieltask Sie + kommunizieren, d.h. z.B. Dateien austauschen möchten. Normalerweise ist + hier das Archiv am eigenen Rechner eingestellt. Das wird auch nach Auf­ + klappen des Pull-Down-Menus im Kasten links unten angezeigt. + + Diese Menufunktion kann im Unterricht z.B. dazu genutzt werden, um fertig­ + gestellte Hausaufgaben in eine bestimmte Task zu schicken (Vatertask) oder + um von dort z.B. vorgefertigte Programme und/oder Filialdaten-Dateien abzu­ + holen. + + Sie können aber auch eine andere Task einstellen (z.B. die Vatertask oder die + Task 'PUBLIC'), um mit diesen Dateien auszutauschen oder um sich auch nur + einen Überblick über die dort vorhandenen Dateien zu verschaffen. Wenn Sie + mit Ihrem Rechner in ein EUMEL-Netz integriert sind, können Sie auch auf + Tasks anderer Rechner zugreifen oder auch Disketten von Laufwerken anderer + Rechner einlesen (z.B. wenn Sie Disketten anderer Formate haben, die von + Ihrem Rechner nicht gelesen werden können). + + Dabei werden zwei Anforderungen an die Zieltask gestellt: Sie muß existieren + und bereit für den Dateiaustausch sein, d.h es muß eine Managertask sein, auf + die Sie Zugriff haben. Versuchen Sie auf andere Tasks zuzugreifen, so erhalten + Sie entsprechende (Fehler-)Meldungen. +#page# + Zu beachten ist noch, daß es im EUMEL-System verschiedene Arten von + Managertasks gibt - Archivmanager und normale Dateimanager. Der Unter­ + schied besteht darin, daß ein Archivmanager vom Benutzer vor dem Zugriff + reserviert werden muß - anschließend hat nur dieser Benutzer (bis zur Aufga­ + be der Reservierung) ein Zugriffsrecht auf den Manager. Normale Datei­ + manager können dagegen von mehreren Benutzern in beliebiger Reihenfolge + angesprochen werden. + + Ein Archivmanager kann auch auf bestimmte Diskettenformate spezialisert + sein (z.B. auf das Lesen von DOS-Disketten). Manche Rechner haben auch + mehrere Archivmanager für verschiedene Laufwerke etc. Durch Einstellen + unterschiedlicher Archivmanager können Sie dann auf verschiedenen Lauf­ + werken archivieren. + + Nach Aktivieren dieses Menupunktes werden Ihnen die folgenden Alternativen + angeboten: +#on("b")# + +-------------------------------------------+ + | Dateiaustausch gewünscht mit: | + | | + | a ...    Archiv (Eigene Station) | + | | + | v ...   Vatertask | + | | + | p ...   'PUBLIC' (Eigene Station) | + | | + | s ...   Sonstige Task | + | | + | Archiv   Vatertask   PUBLIC   Sonstige | + +-------------------------------------------+ +#off("b")# + + Da der Dateiaustausch mit dem Standardarchiv der eigenen Station (Task: + 'ARCHIVE'), mit der Vatertask und der Task 'PUBLIC' recht häufig in Anspruch + genommen wird, sind diese drei Optionen unter den Alternativen direkt ange­ + geben. Entscheiden Sie sich für eine dieser drei Tasks, so nimmt das System + alle notwendigen Einstellungen vor. Möchten Sie dagegen in Kontakt mit einer +#page# + anderen Task treten, so wählen Sie die Alternative 's ... Sonstige Task'. + In diesem Falle haben Sie noch 3 Angaben zu machen: + + - Zunächst werden Sie nach dem Namen der Zieltask gefragt. Geben Sie den + Namen der Zieltask - ohne Anführungsstriche (!) - ein und schließen Sie + die Eingabe mit der -Taste ab. (Den ausgegebenen Namen der + z.Z. eingestellten Task können Sie dabei verändern bzw. überschreiben.) + + - Dann wird die Nummer der Station im EUMEL-Netz erfragt, auf der sich + die Zieltask befindet. Die Nummer Ihrer Station wird als Vorschlag ausge­ + geben. Wollen Sie mit einer Task auf Ihrem Rechner kommunizieren, so + brauchen Sie diesen Vorschlag nur durch Drücken der -Taste + bestätigen - ansonsten tragen Sie zuvor die entsprechende Stationsnummer + ein. Ist Ihr Rechner nicht in ein EUMEL-Netz integriert, so wird die + Stationsnummer 0 (Null) ausgegeben. Bitte bestätigen Sie diese Stations­ + nummer durch Tippen der -Taste. + + - Zum Abschluß müssen Sie noch angeben, ob die eingestellte Zieltask ein + Archivmanager ist oder nicht. + + Das System versucht dann den Kontakt herzustellen. Je nachdem, welche + Einstellung Sie vorgenommen haben, sind bestimmte Funktionen innerhalb + des Menus nicht aktivierbar. Das System läßt nur die Funktionen zu, die + aufgrund Ihrer Einstellungen zulässig sind. + + Im Kasten links unten auf dem Bildschirm wird jeweils angezeigt, welche + Zieltask eingestellt ist. Erscheint in diesem Kasten auch ein Hinweis auf den + Archivnamen, so haben Sie einen Archivmanager eingestellt. Ist dagegen vor + dem Namen der Zieltask noch eine Zahl und ein Schrägstrich angegeben, so + haben Sie eine Zieltask auf einem anderen Rechner eingestellt. + + Bedenken Sie, daß Operationen mit Tasks auf anderen Stationen länger an­ + dauern können - werden Sie nicht ungeduldig! +#page# + Sie können die Einstellung der Zieltask jederzeit wieder verändern! + + Fehlerfälle: + - Die eingestellte Zieltask existiert nicht. + - Die eingestellte Zieltask existiert zwar, ist aber nicht empfangsbereit, d.h. + ein Zugriff von Ihrer Task aus ist nicht möglich! + - Das Netz ist nicht funktionsbereit (Collector-Task fehlt). + - Die Kommunikation war nicht erfolgreich. + - Die gewünschte Operation kann mit der eingestellten Zieltask nicht ausge­ + führt werden (Zieltask ist z.B. gar kein Archivmanager - Sie aber ver­ + suchen, das Laufwerk zu reservieren). + + + + + + + + + diff --git a/app/gs.warenhaus/1.01/doc/gs-Warenhaus-6 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-6 new file mode 100644 index 0000000..3edf312 --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-6 @@ -0,0 +1,589 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (61)# +#headodd# +#center#gs-Warenhaus#right#% + +#end# +#headeven# +%#center#gs-Warenhaus + +#end# +#center#1 + +#center##on("b")#6  Beschreibung der Programmierschnittstelle#off("b")# + + +In allen GRIN-Projekten soll - zumindest als Erweiterung - der Aspekt des +"algorithmischen Problemlösens" mit in den Unterricht eingebracht werden. Deshalb +ist auch in dem Soester Programm zum Projekt WARENHAUS eine Programmier­ +schnittstelle realisiert, die es erlaubt, mit Hilfe eines eng begrenzten Befehlssatzes +kleine Programme zur Steuerung der Abläufe im Modell-Warenhaus zu schreiben. + +Wir haben lange überlegt, ob wir diese Programmierschnittstelle überhaupt nach­ +bilden sollten, weil wir der Meinung sind, daß beim Projekt WARENHAUS das +algorithmische Problemlösen, wenn überhaupt, nur eine sehr untergeordnete Rolle +spielt. Als Randproblematik kann man hier vielleicht untersuchen, wie die Menu- +Funktionen unter dem Oberbegriff 'Kommandos' (vgl. Kapitel 5.4) aufgebaut sind, +und man kann versuchen, diese in eigenen kleinen Programmen nach- oder umzu­ +bilden. + +Unser zweites Problem war, ob wir uns bei einer eventuellen Nachbildung der +Programmierschnittstelle auch wirklich streng an die Soester Vorgaben halten sollten, +auch wenn sie unseren Vorstellungen und Konzepten teilweise zuwiderlaufen. Eigent­ +lich sind wir der Meinung, daß uns mit der Programmiersprache ELAN bereits ein +ausgezeichnetes Hilfsmittel zur Verfügung steht, um auch in der Sekundarstufe I in +das algorithmische Problemlösen einzuführen. Gerade das Refinementkonzept - die +Methode der 'schrittweisen Verfeinerung' / der "Modularisierung im Kleinen" - +scheint uns besonders geeignet, typische Denkweisen des algorithmischen Problem­ +lösens offenzulegen. Lediglich die Konstruktion einer Zählschleife und den Umgang +mit den Fehlermeldungen des ELAN-Compilers halten wir bei Anfängern für etwas +problematisch. + +Wir haben uns deshalb entschlossen, Ihnen die Programmierschnittstelle in zwei +Versionen zur Verfügung zu stellen: In der 'ELAN-Version' können Sie in der üblichen +#page# +ELAN-Umgebung programmieren; das bietet sich z.B. an, wenn Sie #on("b")#gs-Warenhaus#off("b")# +im Wahlpflichtbereich bzw. im Differenzierungsbereich 9/10 einsetzen möchten. Es +ist dann dort nicht nötig, erst eine neue, weniger komfortable "Programmiersprache" +zu erlernen. + +Für den GRIN-Bereich enthält #on("b")#gs-Warenhaus#off("b")# eine weitere Programmierebene +('GRIN-Version'), die an die Soester Vorgaben angelehnt ist, und die es erlaubt, die +dort benutzten Schreibweisen von Befehlen und Kontrollstrukturen zu übernehmen. +Allerdings haben wir dabei eine grundsätzliche Änderung bezüglich der Modularisie­ +rungsmöglichkeit von 'GRIN-Programmen' vorgenommen, auf die wir in Kapitel 6.1 +näher eingehen werden. + +Ein 'GRIN-Programm' wird bei der Ausführung des Menupunktes 's Starten' (vgl. +Kapitel 5.5) zunächst in ein ELAN-Programm übersetzt und dabei auf formale +Korrektheit überprüft. Werden keine Fehler festgestellt, so wird nun seinerseits das +ELAN-Programm vom Compiler übersetzt und anschließend ausgeführt. Als Benutzer +werden Sie dabei nicht mit Fehlermeldungen des Compilers konfrontiert, da der +#on("b")#gs-Warenhaus#off("b")#-Übersetzer vorher alle formalen Fehler abfängt und zum Korrigieren +anbietet. + +Sollte das System nach erfolgreicher Übersetzung und/oder Compilation bei der +Ausführung des Programms einen Fehler "bemerken" (z.B. falscher Aufruf eines +Befehles), so wird das Programm automatisch abgebrochen und die entsprechende +Fehlermeldung mit der Nummer der Programmzeile, in der der Fehler bemerkt +wurde, im unteren Teil des Bildschirmes in einem 'notebook' gezeigt. Im oberen Teil +wird das Programm zum Verbessern angeboten, wobei der Cursor am Anfang der +fehlerhaften Zeile steht (gilt auch für die 'ELAN-Version'). + +In beiden Versionen der Programmierschnittstelle ist die Schreibweise der Befehle bis +auf die Groß- und Kleinschreibung identisch. Folgende Befehle stehen zu Verfügung: +#page# + GRIN-Version | ELAN-Version +------------------------+------------------------------ + Artikelnummer lesen | artikelnummer lesen + Artikeldaten eingeben | artikeldaten eingeben + Kundennummer lesen | kundennummer lesen + Kundendaten eingeben | kundendaten eingeben + neues Blatt | neues blatt + Rechnungskopf | rechnungskopf + Artikel kaufen | artikel kaufen + Abrechnung | abrechnung + Auskunft | auskunft + Bildschirm neu | bildschirm neu + | nachbestellen + | dezimalwert lesen + | bitmuster lesen + | + + +Die drei letzten Befehle der ELAN-Version haben wir in den GRIN-Befehlssatz nicht +mit aufgenommen, weil wir hier den Befehlssatz möglichst klein (und damit über­ +sichtlich) halten wollten und diese Befehle bereits unter dem Oberbegriff +'Kommandos' als Menu-Funktionen zur Verfügung stehen. (Ebenso könnte man bei +dem Befehl 'Auskunft' argumentieren. Die entsprechende Menu-Funktion 'Auskunft +einholen' liefert bei jeder Anwahl jedoch immer nur #on("b")#eine#off("b")# Auskunft; in einem +Programm kann man nun die Ausgabe mehrerer Auskünfte hintereinander +realisieren.) + +Die genaue Wirkung der Befehle werden wir in Kapitel 6.3 noch detailliert +beschreiben. Sie entsprechen im wesentlichen den Soester Befehlen, die im +WARENHAUS-Begleitheft des LSW (siehe Anhang) auf den Seiten 99/100 aufgelistet +sind. (Die anderen dort zu findenden Befehle gehören eigentlich nicht in die Befehls­ +liste der Programmierschnittstelle, weil sie nicht von Programmen aus sondern nur in +einem 'Direktbefehgs-Modus' als Kommando aufrufbar sind! Diese Befehle sind auch +#page# +#on("b")#keine#off("b")# Programmierbefehle im eigentlichen Sinne, sondern entweder "Macros" zum +"Handling" des Warenhausmodells oder Systemkommandos. #on("b")#gs-Warenhaus#off("b")# stellt +diese Befehle unter ähnlichen Namen als Menu-Funktionen zur Verfügung.) + + + +#on("b")#6.1  Schreibweisen und Syntaxregeln in GRIN-Programmen#off("b")# + +Die Regeln, die beim Schreiben eines ELAN-Programms zu beachten sind, werden im +EUMEL/ELAN-Benutzerhandbuch beschrieben; wir werden uns daher hier auf die +GRIN-Version konzentrieren. + +Beginnen wir mit einem Beispiel aus dem WARENHAUS-Begleitheft des LSW. Dort +finden Sie auf Seite 70 (unten) das folgende Programm: + +#on("b")# + PROGRAMM Rechnung schreiben + neues Blatt + Kundennummer lesen + WENN nicht Stoptaste gedrückt + Rechnungskopf + WIEDERHOLE + Artikelnummer lesen + WENN nicht Stoptaste gedrückt + Artikel kaufen + ENDE WENN + BIS Stoptaste gedrückt + Abrechnung + ENDE WENN + ENDE PROGRAMM #off("b")# + +Sie können dieses Programm ohne Änderungen übernehmen und starten, +#on("b")#gs-Warenhaus#off("b")# wird es ohne Beanstandungen ausführen. Bezüglich der Übersicht­ +lichkeit und des Programmierstils kann man hier sicher geteilter Meinung sein, +darauf gehen wir später noch ein. +#page# +Wir möchten Ihnen zunächst einige Regeln zur Schreibweise und Syntax in 'GRIN- +Programmen' aufzeigen, die sich im obigen Beispiel-Programm beobachten lassen: + +- In jeder Zeile darf nur #on("b")#ein#off("b")# Befehl stehen; Befehgs-Trennzeichen (wie etwa das + Semikolon in ELAN) werden deshalb nicht verwendet. Leerzeichen können + beliebig gesetzt werden, auch leere Zeilen sind zulässig, nicht jedoch + Kommentare. + +- Das Arbeiten mit Variablen (gleich welcher Art) ist #on("b")#nicht#off("b")# möglich; alle Befehle + sind datentypfrei. + +- Schlüsselworte für Kontrollstrukturen (wie z.B. WIEDERHOLE, WENN etc.) + werden in GROSSBUCHSTABEN geschrieben, Ausführungsbefehle und + Bedingungen hingegen klein und gemäß den Regeln der deutschen Sprache mit + großem Anfangsbuchstaben bei Substantiven. Diese Festlegung bezüglich der + Groß- und Kleinschreibung ist bei den von #on("b")#gs-Warenhaus#off("b")# zur Verfügung ge­ + stellten Befehlen #on("b")#verbindlich#off("b")#, d.h. alle Warenhaus-#on("b")#Grund#off("b")#befehle und Kontroll­ + strukturen müssen (bis auf Leerzeichen) genauso geschrieben werden, wie sie in + den Kapiteln 6.2 und 6.3 vorgegeben werden! (In der Soester Software können + dagegen Groß- und Kleinbuchstaben beliebig verwendet werden, sodaß dort z.B. + neben 'neues Blatt' auch 'neues blatt', "NEueS BlaTT" u.ä. als identisch ange­ + sehen werden.) + +- Jedes 'GRIN-Programm' beginnt mit dem 'Schlüsselwort' , + gefolgt von einem Programmnamen, der beliebig gewählt werden kann, jedoch + noch in diese Zeile passen muß. Sinnvoll ist es, hier z.B. den Namen der + Programmdatei einzutragen. + +- Jedes 'GRIN-Programm' endet mit der Zeile . Nach dieser + Zeile dürfen nur noch leere Zeilen folgen, es sei denn zwischen und wurden Befehle benutzt, die + nicht zum Warenhaus-Grundbefehlssatz gehören. Solche Befehle müssen in einer + 'Befehlserklärung' nach Programmende definiert werden. +#page# +Das obige Programm befriedigt vom äußeren Erscheinungbild her einen PASCAL- +Programmierer wahrscheinlich völlig, einen ELAN-Verwöhnten jedoch sicher nicht. +Die Soester WARENHAUS-Software bietet keinerlei Möglichkeit der Modularisierung +#on("b")#innerhalb#off("b")# eines Programms (Refinement-/Prozedurkonzept o.ä.). Es gibt dort nur die +Möglichkeit, fertiggestellte Programme unter dem Programmnamen dem Basis­ +befehlssatz "hinzuzufügen" - ein Vorgang, der dem Insertieren unter EUMEL/ELAN +ähnelt. Obwohl es unter EUMEL/ELAN ein leichtes gewesen wäre, diese Möglichkeit +ebenfalls zu realisieren, haben wir davon Abstand genommen, weil auf diese Weise an +jedem Arbeitsplatz eine "eigene" Programmierumgebung entstehen würde. Wir sind +der Meinung, daß für Schüler der Sekundarstufe I eine #on("b")#feste Modellumgebung als +Basis#off("b")# vorhanden sein muß. Außerdem erscheint uns bei der Programmierung "im +Kleinen" die "Bottom-Up"-Technik unangemessen und für den Anfänger viel zu +unübersichtlich zu sein; viel eher wäre hier die "Top-Down"-Methode angebracht. Wir +haben daher die Programmierumgebung in anderer Richtung erweitert und eine +Modularisierungsmöglichkeit realisiert, die dem Refinementkonzept nachempfunden +ist und damit unseren didaktisch-methodischen Vorstellungen viel eher entspricht. + +Bei #on("b")#gs-Warenhaus#off("b")# werden etwa benutzte 'eigene' Befehle #on("b")#innerhalb derselben#off("b")# +Programmdatei 'erklärt' und zwar #on("b")#nach#off("b")# dem Ende des eigentlichen 'Haupt­ +programms', d.h. also nach der Zeile . Mit Hilfe dieser Mög­ +lichkeit könnte das obige Programm besser strukturiert etwa so aussehen: + +#on("b")# + PROGRAMM Rechnung schreiben + neues Blatt + Kundennummer lesen + WENN nicht Stoptaste gedrückt + einkaufen mit Rechnung + ENDE WENN + ENDE PROGRAMM + + einkaufen mit Rechnung: + Rechnungskopf + WIEDERHOLE + Artikelnummer lesen + Artikel eventuell kaufen + BIS Stoptaste gedrückt + Abrechnung +#page# + Artikel eventuell kaufen: + WENN nicht Stoptaste gedrückt + Artikel kaufen + ENDE WENN +#off("b")# + + +Sie sehen, das Programm ist so zwar etwas länger, aber erheblich übersichtlicher +geworden. Für 'neue Befehle' und die zugehörigen 'Befehlserklärungen' gelten +folgende Grundsätze: + +- Die 'Befehlserklärungen' müssen #on("b")#nach#off("b")# aufgelistet + werden. Die Reihenfolge ist beliebig. + +- Eine 'Befehlserklärung' besteht aus dem zu erklärenden Befehl in (bis auf Leer­ + zeichen) völlig identischer Schreibweise (!) und einem nachfolgenden Doppel­ + punkt (:). + +- Ein 'neuer Befehl' darf alle möglichen Zeichen enthalten außer einem Doppel­ + punkt (:). Außerdem darf solch ein Befehl #on("b")#nicht#off("b")# mit einem 'Schlüsselwort' + beginnen (vgl. Kapitel 6.2). + +- In 'Befehlserklärungen' können neben den Grundbefehlen auch wieder 'neue + Befehle' benutzt werden, die dann wiederum erklärt werden müssen. + +- Befehle dürfen nur #on("b")#einmal#off("b")# erklärt werden, auch wenn sie mehrfach benutzt + werden. + +- Es dürfen nur Befehle erklärt werden, die irgendwo auch wirklich benutzt + werden. + +- Befehlserklärungen sind nur möglich für #on("b")#Ausführungs-Befehle#off("b")#. Es lassen sich + also z.B. keine neuen Bedingungen oder Kontrollstrukturen erklären! + +- Es dürfen innerhalb eines Programms maximal 20 verschiedene 'neue Befehle' + verwendet werden. (Diese Grenze dürfte in Warenhaus-Programmen kaum ein­ + mal erreicht werden!) +#page# +Formale Verstöße gegen diese Regeln werden bei dem Übersetzungsvorgang sofort +beim Auftauchen des ersten Fehlers zur Korrektur angeboten. Dabei wird in der +oberen Bildschirmhälfte das Programm editiert, wobei der Cursor an den Anfang der +Zeile gesetzt wird, in der sich der (erste) Fehler befindet. In der unteren Bildschirm­ +hälfte wird über den Paralleleditor in einem 'notebook' die Art des Fehlers mit An­ +gabe der Zeilennummer genauer beschrieben. + +In der Regel wird hier nur auf #on("b")#einen#off("b")# (nämlich den ersten auftauchenden) Fehler +hingewiesen, so daß Sie das Programm evtl. mehrfach starten müssen, bis alle Fehler +erkannt und beseitigt sind. Manchmal tauchen im Fehler-'notebook' aber auch +mehrere Fehlermeldungen auf (z.B. wenn 'neue Befehle' nicht erklärt oder erklärte +Befehle nicht benutzt wurden). In Extremfällen kann es dabei dazu kommen, daß +nicht mehr das ganze Fehler-'notebook' auf dem Bildschirm sichtbar ist. In diesem +Fall können Sie mit der Tastenfolge den Cursor zwischen den beiden +Bildschirmhälften hin- und herschalten und mit den Pfeiltasten evtl. nicht-sichtbare +Teile des 'notebooks' oder der Programmdatei auf den Bildschirm holen. (Für +genauere Informationen über den Umgang mit dem EUMEL-Editor lesen Sie bitte im +EUMEL-Benutzerhandbuch nach.) + + +#on("b")#6.2  Kontrollstrukturen#off("b")# + +Sowohl in ELAN-Programmen, als auch in GRIN-Programmen werden Kontroll­ +strukturen durch 'Schlüsselworte' gekennzeichnet, die grundsätzlich in +GROSSBUCHSTABEN geschrieben werden müssen, um sie deutlich gegenüber Aus­ +führungsbefehlen und Bedingungen abzuheben. In GRIN-Programmen gibt es +Schlüsselworte für den Anfang und das Ende eines Programms sowie für Schleifen +und einseitige Abfragen. Wir notieren hier nur die in GRIN-Programmen möglichen +Kontrollstrukturen und geben, wenn vorhanden, die zugehörige ELAN-Übersetzung in +Klammern an. + + +#on("b")#Programm-Anfang/Ende:#off("b")# + + #on("b")#PROGRAMM#off("b")# + + + . + . + #on("b")#ENDE PROGRAMM#off("b")# + + +Jedes GRIN-(Haupt-)Programm beginnt mit dem Schlüsselwort 'PROGRAMM', gefolgt +von einem frei wählbaren Programmnamen, der jedoch in dieselbe Zeile passen +muß. Die Zeile 'ENDE PROGRAMM' zeigt das Ende eines GRIN-(Haupt-)Programms +an. Sowohl 'PROGRAMM', als auch 'ENDE PROGRAMM' dürfen in einer Programm­ +datei nur #on("b")#einmal#off("b")# verwendet werden. Entsprechende Schlüsselworte in ELAN- +Programmen gibt es nicht. + + +#on("b")#Schleifen:#off("b")# + +Schleifen müssen innerhalb des Hauptprogramms oder der Befehlserklärung, in der +sie geöffnet werden, auch wieder geschlossen werden. Schachtelungen sind zwar +zulässig, sollten aber aus Gründen der Übersichtlichkeit vermieden werden. Soll +dennoch innerhalb einer Schleife eine weitere Schleife verwendet werden, so sollte die +innere Schleife über einen 'neuen Befehl' in eine Befehlserklärung 'ausgelagert' +werden. Folgende Schleifenarten sind möglich: + +a) Zählschleife: + + #on("b")#WIEDERHOLE#off("b")# #on("b")#MAL#off("b")# (ELAN: INT VAR i; + FOR i FROM 1 UPTO n REPEAT + . + . . + . . + #on("b")#ENDE WIEDERHOLE#off("b")# END REPEAT) + + +Die Anweisungen innerhalb der Schleife werden  - mal ausgeführt. + + +b) Schleife mit Ausgangsbedingung: + + + #on("b")#WIEDERHOLE#off("b")# (ELAN: REPEAT + . + . + . . + . . + #on("b")#BIS#off("b")# UNTIL bedingung END REPEAT) + + +Die Anweisungen innerhalb der Schleife werden mindestens einmal ausgeführt und +dann solange wiederholt, bis die Bedingung erfüllt ist. Bei der Programmierung ist +darauf zu achten, daß durch die Anweisungen die Bedingung erfüllt werden kann, +denn sonst ist das Resultat eine 'Endlosschleife', deren Ausführung nur durch einen +totalen Programmabbruch () beendet werden kann. + + +c) Zählschleife mit Ausgangsbedingung: + + + #on("b")#WIEDERHOLE#off("b")# #on("b")#MAL#off("b")# (ELAN: INT VAR i; + FOR i FROM 1 UPTO n REPEAT + . + . . + . . + #on("b")#BIS#off("b")# UNTIL bedingung END REPEAT) + + +Die Anweisungen innerhalb der Schleife werden -mal ausgeführt. Im Gegensatz +zur reinen Zählschleife können die Wiederholungen jedoch vorzeitig abgebrochen +werden, nämlich dann, wenn nach irgendeinem Schleifendurchlauf die Bedingung +erfüllt ist. + + +d) Endlosschleife: + + + #on("b")#WIEDERHOLE#off("b")# (ELAN: REPEAT + . + . + . . + . . + #on("b")#ENDE WIEDERHOLE#off("b")# END REPEAT) + + +Die Anweisungen innerhalb der Schleife werden immer wieder ausgeführt. Da keine +begrenzte Anzahl von Durchläufen und auch keine Abbruchbedingung angegeben ist, +kann diese Schleife nur durch einen totalen Programmabbruch () +beendet werden. + +(Die Schleifenarten c) und d) sind in der Soester WARENHAUS-Software nicht vor­ + handen, ergaben sich bei der Konstruktion des #on("b")#gs-Warenhaus#off("b")#-Übersetzers wegen + der analogen Strukturen in ELAN jedoch quasi "von selbst", so daß wir sie auch + zugelassen haben. Schleifen mit Eingangsbedingung (ELAN: WHILE bedingung + REPEAT ... END REPEAT) sind für GRIN-Programme jedoch nicht realisiert.) + + +#on("b")#Einseitige Abfragen:#off("b")# + + + #on("b")#WENN#off("b")# (ELAN: IF bedingung + THEN anweisung 1; + anweisung 2; + . . + . . + #on("b")#ENDE WENN#off("b")# END IF) + + +Die Anweisungen werden nur ausgeführt, wenn die Bedingung erfüllt ist. (Eine Ent­ +sprechung zu der in ELAN möglichen 'zweiseitigen Abfrage' (IF ... THEN ... ELSE ... +END IF) gibt es in der GRIN-Version nicht!) + +Eine im Hauptprogramm oder in einer Befehlserklärung begonnene Abfrage ('WENN +...') muß auch im selben Programmteil wieder beendet werden. Ähnlich wie bei +Schleifen ist die Schachtelung von Abfragen innerhalb des Hauptprogramms oder +einer Befehlserklärung zwar zulässig, führt aber zu unübersichtlichen Programmen. +Auch hier sollte man innerhalb einer Abfrage eventuell notwendige weitere Abfragen +durch 'neue Befehle' in Befehlserklärungen auslagern. + + +#on("b")#Zulässige Bedingungen:#off("b")# + +#on("b")#Stoptaste gedrückt#off("b")# (ELAN: stoptaste gedrückt) + + Die Bedingung ist erfüllt (d.h. liefert den Wert 'wahr'), wenn während des bis­ + herigen Programmablaufs die Tastenfolge getippt worden ist; + sonst ist sie nicht erfüllt (Wahrheitswert 'falsch'). (Das Tippen von + beim Verlassen einer Datei hat jedoch #on("b")#keinen#off("b")# Einfluß auf den Wahrheitswert der + Bedingung!) + + Bei jeder Ausführung der Befehle 'Artikelnummer lesen', 'Kundennummer lesen' + und 'Auskunft' wird der Wahrheitswert der Bedingung zunächst immer auf + 'falsch' gesetzt (siehe 6.3), so daß die Abfrage der Bedingung nach einem dieser + Befehle nur dann 'wahr' liefert, wenn #on("b")#während#off("b")# oder #on("b")#nach#off("b")# der letztmaligen Aus­ + führung eines der drei Befehle getippt wurde; ein etwa vorher + erfolgtes Tippen dieser Tastenfolge ist somit wirkungslos! + + +#on("b")#nicht Stoptaste gedrückt#off("b")# (ELAN: NOT stoptaste gedrückt) + + Dieses ist das logische Gegenteil von 'Stoptaste gedrückt': 'nicht Stoptaste ge­ + drückt' ist erfüllt, wenn 'Stoptaste gedrückt' #on("b")#nicht#off("b")# erfüllt ist und umgekehrt. + +Um Probleme bei der Arbeit mit Terminals zu vermeiden, die nicht über den +deutschen Zeichensatz verfügen (Umlaute!), ist bei beiden Bedingungen auch die +Schreibweise 'gedrueckt' erlaubt. + + + +#on("b")#6.3  Detailbeschreibung der Warenhaus-Grundbefehle#off("b")# + +Wie bereits in 6.1 erwähnt, ist die im folgenden vorgegebene Schreibweise der Grund­ +befehle bezüglich Groß- und Kleinschreibung verbindlich; Leerzeichen dagegen +können beliebig eingefügt oder auch weggelassen werden. Fett gedruckt steht immer +der GRIN-Befehl, in Klammern dahinter der zugehörige ELAN-Befehl. + + +#on("b")#Artikelnummer lesen#off("b")# (ELAN: artikelnummer lesen) + + - Der Wahrheitswert der Bedingung 'Stoptaste gedrückt' wird zunächst auf + 'falsch' gesetzt. + - Der Benutzer wird aufgefordert, eine Artikelnummer einzugeben. Je nach + Einstellung der 'Eingabeart' (vgl. Kapitel 5.3) erfolgt die Eingabe durch Ein­ + tippen einer Zahl über die Tastatur oder durch Einschieben einer Warenkarte + in das Lesegerät. Eingaben über die Tastatur sind mit abzu­ + schließen. Akzeptiert werden nur Werte von 1 bis 15, ansonsten erfolgt eine + Warnung, und die Eingabe wird wiederholt. + - Durch Tippen der Tastenfolge kann dieser Befehl abgebrochen + werden, ohne daß eine Artikelnummer eingelesen wird. In diesem Falle wird + der Wahrheitswert der Bedingung 'Stoptaste gedrückt' auf 'wahr' gesetzt, sonst + bleibt der Wert auf 'falsch'. + - Durch Tippen der Tastenfolge wird die Ausführung des + gesamten Programms abgebrochen. + + +#on("b")#Artikeldaten eingeben#off("b")# (ELAN: artikeldaten eingeben) + + - Der Befehl setzt voraus, daß zuvor eine Artikelnummer eingelesen wurde, + ansonsten erfolgt eine entsprechende Fehlermeldung. + - Die Angaben zu einem Artikel (Name, Preis, Mindestbestand, Bestand) können + eingegeben bzw. verändert werden. + - Alle Eingaben sind mit oder der Tastenfolge + abzuschließen. Durch wird der Wahrheitswert der Bedingung + 'Stoptaste gedrückt' auf 'wahr' gesetzt. + - Nach Abschluß der Eingaben werden die Artikeldaten in der Filial-Verwaltung + gespeichert, worauf auch kurz hingewiesen wird. + - Durch Tippen der Tastenfolge während der Eingaben wird die + Ausführung des gesamten Programms abgebrochen. + + +#on("b")#Kundennummer lesen#off("b")# (ELAN: kundennummer lesen) + + - Der Wahrheitswert der Bedingung 'Stoptaste gedrückt' wird zunächst auf + 'falsch' gesetzt. + - Der Benutzer wird aufgefordert, eine Kundennummer einzugeben. Je nach + Einstellung der 'Eingabeart' (vgl. Kapitel 5.3) erfolgt die Eingabe durch Ein­ + tippen einer Zahl über die Tastatur oder durch Einschieben einer Kundenkarte + in das Lesegerät. Eingaben über die Tastatur sind mit abzu­ + schließen. Akzeptiert werden nur Werte von 129 bis 159, ansonsten erfolgt eine + Warnung, und die Eingabe wird wiederholt. + - Durch Tippen der Tastenfolge kann dieser Befehl abgebrochen + werden, ohne daß eine Kundennummer eingelesen wird. In diesem Falle wird + der Wahrheitswert der Bedingung 'Stoptaste gedrückt' auf 'wahr' gesetzt, sonst + bleibt der Wert auf 'falsch'. + - Durch Tippen der Tastenfolge wird die Ausführung des + gesamten Programms abgebrochen. + + +#on("b")#Kundendaten eingeben#off("b")# (ELAN: kundendaten eingeben) + + - Der Befehl setzt voraus, daß zuvor eine Kundennummer eingelesen wurde, + ansonsten erfolgt eine entsprechende Fehlermeldung. + - Die Angaben zu einem Kunden (Name, Vorname, Geschlecht) können einge­ + geben bzw. verändert werden. + - Alle Eingaben sind mit oder der Tastenfolge + abzuschließen. Durch wird der Wahrheitswert der Bedingung + 'Stoptaste gedrückt' auf 'wahr' gesetzt. + - Nach Abschluß der Eingaben werden die Kundendaten sowohl in der Filial- + Verwaltung als auch in der Zentrale gespeichert, worauf auch kurz hingewiesen + wird. + - Durch Tippen der Tastenfolge während der Eingaben wird die + Ausführung des gesamten Programms abgebrochen. + + +#on("b")#neues Blatt#off("b")# (ELAN: neues blatt) + + - Das Rechnungsfenster auf dem Bildschirm wird gelöscht. + - Für die Ausgabe der nächsten Rechnung auf dem Drucker wird eine neue + Rechnungsdatei bereitgestellt. + + +#on("b")#Rechnungskopf#off("b")# (ELAN: rechnungskopf) + + - Ein Rechnungskopf wird auf dem Bildschirm ausgegeben. Falls zuvor eine + Kundenummer eingelesen worden ist, unter der bereits Kundendaten einge­ + geben wurden, erscheint der Name des betreffenden Kunden im Rechnungs­ + kopf. + - Der Rechnungskopf wird für einen eventuellen späteren Ausdruck in die + Rechnungsdatei geschrieben. + + +#on("b")#Artikel kaufen#off("b")# (ELAN: artikel kaufen) + + - Der Befehl setzt voraus, daß zuvor eine Artikelnummer eingelesen worden ist, + ansonsten erfolgt eine entsprechende Fehlermeldung. + - Artikelname und -preis werden auf den Bildschirm und in die Rechnungsdatei + geschrieben. + - Der Kauf wird intern in den entsprechenden Filial-Dateien registriert. + + +#on("b")#Abrechnung#off("b")# (ELAN: abrechnung) + + - Die Preise der gekauften Artikel werden addiert. + - Die Summe wird auf dem Bildschirm angezeigt und in die Rechnungsdatei + geschrieben. + - Der Benutzer wird gefragt, ob die Rechnung ausgedruckt werden soll. + + +#on("b")#Auskunft#off("b")# (ELAN: auskunft) + + - Der Wahrheitswert der Bedingung 'Stoptaste gedrückt' wird zunächst auf + 'falsch' gesetzt. + - Der Benutzer wird aufgefordert, eine Codenummer einzugeben. Je nach Ein­ + stellung der 'Eingabeart' (vgl. Kapitel 5.3) erfolgt die Eingabe durch Eintippen + einer Zahl über die Tastatur oder durch Einschieben einer Codekarte in das + Lesegerät. Eingaben über die Tastatur sind mit abzuschließen. + Akzeptiert werden nur zulässige Werte, ansonsten erfolgt eine Warnung, und + die Eingabe wird wiederholt. Die Bedeutungen der einzelnen Auskunftscodes + sind in Kapitel 5.4 unter der Menufunktion 'Auskunft einholen' beschrieben. + - Durch Tippen der Tastenfolge kann der Befehl abgebrochen + werden, ohne daß eine Codenummer eingelesen wird. In diesem Falle wird der + Wahrheitswert der Bedingung 'Stoptaste gedrückt' auf 'wahr' gesetzt, sonst + bleibt der Wert auf 'falsch'. + - Durch Tippen der Tastenfolge wird die Ausführung des + gesamten Programms abgebrochen. + + +#on("b")#Bildschirm neu#off("b")# (ELAN: bildschirm neu) + + - Der Programm-Eingangsbildschirm wird neu aufgebaut. Der Befehl wird + benötigt, wenn die Fenstereinteilung auf dem Bildschirm wiederhergestellt + werden soll (z.B. nach Ausgabe einer Liste bei dem Befehl 'Auskunft'). + - Der Befehl wird beim Starten eines GRIN-Programms automatisch ausgeführt; + bei ELAN-Programmen wird er automatisch am Anfang eines jeden Programms + eingefügt, wenn das Programm nicht mit diesem Befehl beginnt. + + +Neben diesen Befehlen stehen für ELAN-Programme noch drei weitere zur Verfügung, +die nicht zum GRIN-Befehlssatz gehören: + + nachbestellen, + dezimalwert lesen, + bitmuster lesen. + +Diese Befehle entsprechen in ihrer Wirkung den gleichnamigen Menufunktionen +unter dem Oberbegriff 'Kommandos', die in Kapitel 5.4 beschrieben sind. + + + diff --git a/app/gs.warenhaus/1.01/doc/gs-Warenhaus-7 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-7 new file mode 100644 index 0000000..3a55dfe --- /dev/null +++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-7 @@ -0,0 +1,235 @@ +#limit (11.0)##pagelength (16.5)##block# +#start (2.0,0.0)# +#page (69)# +#headodd# +#center#gs-Warenhaus#right#% + +#end# +#headeven# +%#center#gs-Warenhaus + +#end# +#center#1 + +#center##on("b")#7  Weitere Kommandos (für Systembetreuer)#off("b")# + + +Wenn Sie #on("b")#gs-Warenhaus#off("b")# installiert haben und mit dem Aufbau des Systems nach +der automatischen Generierung zufrieden sind, dann ist dieses Kapitel nicht wichtig +für Sie. Wir erklären Ihnen hier die Befehle, mit denen Sie die Einstellungen, die bei +der Installation vorgenommen wurden, auch nachträglich noch ändern können. +Beachten Sie bitte, daß aus Sicherheitsgründen eine Einstellungs#on("b")#änderung#off("b")# i.a. nur in +der Task möglich ist, in der die entsprechende Einstellung vorgenommen wurde, es +sei denn, dort wurde eine Einstellung gänzlich aufgehoben. Außerdem werden Ein­ +stellungsänderungen stets nur an Sohntasks weitergegeben ("vererbt"), die #on("b")#nach#off("b")# der +Änderung angemeldet werden! + +Die Standard-Installation sieht z.B. nur die Einrichtung #on("b")#einer#off("b")# Warenhaus-Hauptstelle +vor. Wenn Sie tatsächlich nur eine Hauptstelle eingerichtet haben, nun aber doch +mehrere Hauptstellen (für verschiedene Lerngruppen) betreiben wollen, so brauchen +Sie das Programm nicht erneut zu insertieren! Machen Sie besser in der bisherigen +Hauptstellen-Task den Hauptstellenstatus mit dem Kommando 'warenhaus haupt­ +stelle (FALSE)' rückgängig und richten Sie in Sohntasks mit dem Kommando 'waren­ +haus hauptstelle (TRUE)' wieder neue Hauptstellen ein. Außerdem können Sie in +Hauptstellen-Tasks die Version für die Programmierschnittstelle umstellen ('grin +(TRUE)' bzw. 'grin (FALSE)'). + +Ähnlich verhält es sich mit dem Betrieb eines Adapters für das Kartenleser-Interface. +Auch hier ist die Standard-Einstellung u.U. nur für den Betrieb #on("b")#eines#off("b")# Adapters ausge­ +legt. Möchten Sie mehrere Kartenleser anschließen, so sind bei der Verwendung von +MUFIs im Terminalkanal keine Änderungen nötig, da hier jede Filialtask sowieso nur +auf das MUFI zugreifen kann, das in den Kanal des Terminals geschaltet ist, an das +die Task gekoppelt ist. Möchten Sie jedoch mehrere Kartenleser über Adapter an +separaten seriellen Schnittstellen ansprechen, so müssen Sie dem System mehrere +Kanalnummern mitteilen, die für verschiedene Filialtasks ja durchaus unterschied­ +lich sein können. Am geschicktesten erscheint es in diesem Fall, unter einer Haupt­ +stelle mehrere "Zwischentasks" einzurichten, in diesen jeweils die Interface- +Kanalnummern festzulegen und die Filialtasks als Söhne dieser "Zwischentasks" +anzumelden. Benennen Sie die "Zwischentasks" so, daß die eingestellte Kanal­ +nummer aus dem Namen ersichtlich ist, so ist gleich bei der Anmeldung einer Filial­ +task klar, welcher Kartenleser von dieser Task aus angesprochen werden kann. + +Um diesen Aufbau zu realisieren, sollten Sie zunächst in der entsprechenden Haupt­ +stellentask einen etwa eingerichteten Direktstart mit dem Kommando 'warenhaus +direktstart (FALSE)' aufheben. Ebenfalls in der Hauptstellentask wird dann mit dem +Kommando 'init interface channel' eine etwa vorhandene Kanaleinstellung gelöscht, +wenn Sie bei der Aufforderung 'Gib Interface-Kanal:' eine '0' eingeben. Nun richten +Sie für jeden vorhandenen Adapter (natürlich müssen auch entsprechend viele freie +serielle Schnittstellen zur Verfügung stehen!) eine "Zwischentask" als Sohn der +Hauptstellentask ein (z.B. 'Kanal 5', 'Kanal 6' etc.) und geben dort jeweils wieder das +Kommando 'init interface channel'. Bei der Abfrage 'Gib Interface-Kanal:' geben Sie +dann die entsprechende Kanalnummer ein (in unserem Beispiel 5 oder 6 etc.). Alle +Söhne der Zwischentask 'Kanal 5' z.B. können dann (abwechselnd) den Kartenleser +benutzen, der an den Adapter an Kanal 5 angeschlossen ist. In diesen Zwischentasks +können Sie, wenn Sie möchten, mit dem Kommando 'warenhaus direktstart (TRUE)' +einen Direktstart für die neu anzumeldenden Sohntasks (Filialen) einrichten. +Ansonsten wird #on("b")#gs-Warenhaus#off("b")# in den Sohntasks aus der 'gib Kommando' - Ebene +mit dem Befehl 'warenhaus' gestartet (vgl. Kapitel 3.3). + +Sollten Sie beim Betrieb eines Codekartenlesers feststellen, daß die Wartezeit beim +Einlesen einer Codekarte zu kurz oder zu lang ist, so können Sie auch diese ändern. +Da die Wartezeit durch eine Schleife realisiert ist, in der laufend Werte vom Interface +gelesen werden, ist sie abhängig von der Geschwindigkeit des verwendeten Rechners +und von der gewählten Interface-Anpassung. Die Veränderung der Wartezeit erfolgt +mit dem Kommando 'eingabesicherheit (n)', wobei n eine 'Integer'-Zahl sein muß. +Bei sehr langsamen Systemen hat sich ein Wert von 3 als sinnvoll herausgestellt; bei +schnellen Rechnern muß n etwa 10 oder noch größer sein. Ermitteln Sie den für +Ihren Rechner geeigneten Wert bitte durch Ausprobieren. (Standardmäßig eingestellt +ist n = 5.) + +Mit Hilfe von drei Informationsprozeduren können Sie Informationen über den +Systemzustand einholen: 'put (hauptstellenname)' liefert den Namen der zu­ +ständigen Hauptstellen-Task, 'put (interface anpassung)' zeigt den Namen der bei +der Installation gewählten Interfaceanpassung für den Kartenleser, und 'put (inter­ +face channel)' liefert die Nummer des Kanals, über den ein Interface an separater +serieller Schnittstelle angesprochen wird. + + + +#on("b")#Detailbeschreibung der Befehle#off("b")#: + + +#on("b")#PROC eingabesicherheit (INT CONST n):#off("b")# + + - stellt die Wartezeit beim Einlesen einer Artikel-, Kunden- oder Auskunfts­ + codenummer in Abhängigkeit vom Absolutbetrag von n ein. Bei langsamen + Rechnern sollte abs(n) klein (ca. 3), bei schnellen Rechnern größer (ca. 10) + sein. + - Standardeinstellung ist 5. + - Der Befehl kann in jeder Task gegeben werden, in der #on("b")#gs-Warenhaus#off("b")# + insertiert ist. + + +#on("b")#PROC grin (BOOL CONST entscheidung):#off("b")# + + - ist nur in Hauptstellentasks aufrufbar und in Tasks, die keiner Hauptstellen­ + task untergeordnet sind. + - stellt die Version für die Programmierschnittstelle gemäß der 'entscheidung' + ein: + TRUE ---> GRIN-Version, FALSE ---> ELAN-Version. + + Fehlerfälle: + - Dieser Befehl darf nur von der Task '...' aus gegeben werden! + + +#on("b")#TEXT PROC hauptstellenname:#off("b")# + + - liefert den Namen der zuständigen Hauptstellentask. + - liefert 'niltext' (""), wenn in diesem Zweig des Taskbaumes noch keine + Hauptstelle existiert; es ist dann kein Warenhaus-Betrieb möglich! (vgl. + 'PROC warenhaus hauptstelle') + + +#on("b")#PROC init interfacechannel:#off("b")# + + - initialisiert eine unbenannte Sohntask ("-") zum Ansprechen des Interface­ + systems über eine separate serielle Schnittstelle und existiert deshalb nur bei + den Anpassungen für 'MUFI als Endgerät' und 'AKTRONIK-Adapter'. + - erfragt zunächst eine Kanalnummer ('Gib Interface-Kanal:'); zulässig sind + Eingaben von 0 bis 24. + - löscht eine evtl. bereits vorhandene unbenannte Sohntask ("-"). + - richtet bei Eingabe einer Kanalnummer > 0 eine neue unbenannte Sohntask + ein und sperrt dieses Kommando für Sohntasks, die danach angemeldet + werden. + - hebt eine etwa gesetzte Sperrung bei Eingabe von 0 als Kanalnummer wieder + auf. + + Fehlerfälle: + - Dieses Kommando kann nur von der Task '...' aus gegeben werden! + - Unzulässige Kanalnummer! + + +#on("b")#TEXT PROC interface anpassung:#off("b")# + + - liefert den Namen der bei der Installation ausgewählten Anpassung. Möglich + sind zur Zeit: + + "ohne Kartenleser", + "mit Kartenleser an AKTRONIC-Adapter", + "mit Kartenleser an MUFI als Endgerät", + "mit Kartenleser an MUFI im Terminalkanal". + + +#on("b")#INT PROC interface channel:#off("b")# + + - existiert nur bei den Anpassungen für den AKTRONIC-Adapter und MUFI als + Endgerät. + - liefert die Kanalnummer der seriellen Schnittstelle, über die das Interface­ + system angesprochen wird. + - wird der Wert 0 geliefert, so kann in der Task keine Eingabe über einen + Kartenleser erfolgen (siehe 'PROC init interfacechannel'). + + +#on("b")#PROC warenhaus:#off("b")# + + - ist nicht in Hauptstellentasks aufrufbar. + - startet #on("b")#gs-Warenhaus#off("b")# aus der 'gib Kommando' - Ebene oder wird bei einge­ + richtetem Direktstart automatisch aufgerufen. + - richtet eine Sohntask als Filialverwaltung ein und kennzeichnet damit die + eigene Task für das System als 'aktive' Filiale. Der Name dieser Sohntask + enthält den Namen der zuständigen Hauptstellentask und die Filialnummer, + unter der die Filiale geführt wird. Diese Filialnummer ist identisch mit der + Kanalnummer des angekoppelten Terminals. + - löscht die Filialverwaltungstask, wenn das Warenhaus-Menu geregelt mit + verlassen wird. Zu Kollisionen bezüglich der Filialnummer + kann es somit nur kommen, wenn an einem Arbeitsplatz das WARENHAUS- + Menu ungeregelt verlassen wird (z.B. durch Tippen der SV-Taste) und dann + an demselben Arbeitsplatz eine neue Filiale angemeldet werden soll. In + diesem Fall erhält die neue Task #on("b")#keine#off("b")# Filialverwaltung als Sohntask und ist + damit für den Warenhaus-Betrieb nicht brauchbar. Deshalb wird hier nach + Ausgabe einer Fehlermeldung sofort gefragt, ob die Task gelöscht werden soll. + + Fehlerfälle: + - Dieser Befehl darf nur von Söhnen dieser Task aus gegeben werden! + - Keine uebergeordnete Task ist 'warenhaus hauptstelle'! + - Filiale ist bereits besetzt durch TASK '...'! + Es ist so kein geregelter Warenhaus-Betrieb möglich! + + +#on("b")#PROC warenhaus direktstart (BOOL CONST entscheidung):#off("b")# + + - richtet gemäß dem Wahrheitswert der 'entscheidung' einen Direktstart ein + oder hebt ihn wieder auf. + Hat 'entscheidung' den Wert 'TRUE', so wird ein Direktstart eingerichtet. Es + erscheint zunächst die Frage 'Mit automatischem Löschen (j/n)?'. Durch den + Direktstart gelangt man beim Anmelden einer Sohntask nicht in die 'gib + Kommando' - Ebene, sondern sofort in das WARENHAUS-Menu. Wird die + obige Frage mit beantwortet, so werden Sohntasks nach dem Ausstieg + aus dem WARENHAUS-Menu sofort gelöscht; andernfalls wird erst noch ge­ + fragt, ob gelöscht werden soll. Bei Verneinung erfolgt ein 'break'. Die Ein­ + richtung eines Direktstarts wird vom System vermerkt und der Befehl darauf­ + hin in allen untergeordneten Tasks gesperrt. Sowohl der Direktstart als auch + die Sperrung sind nur wirksam für Sohntasks, die #on("b")#nach#off("b")# Ausführung dieses + Befehls angemeldet werden. + Hat 'entscheidung' den Wert 'FALSE', so wird ein etwa eingerichteter Direkt­ + start und die damit verbundene Sperrung des Befehls für neue Sohntasks + wieder aufgehoben. Die Aufhebung ist nur möglich in der Task, von der aus + der Direktstart eingerichtet wurde. + + Fehlerfälle: + - Der Direktstart kann nur aus der Task '...' geaendert werden! + + +#on("b")#PROC warenhaus hauptstelle (BOOL CONST entscheidung):#off("b")# + + - macht je nach Wahrheitswert der 'entscheidung' eine Task zur Hauptstellen­ + task ('TRUE') bzw. hebt diesen Status wieder auf ('FALSE'). Eine Task kann + nur Hauptstelle werden, wenn noch keine übergeordnete Task Hauptstelle ist. + Der Hauptstellenstatus kann danach auch nur in dieser Task wieder aufge­ + hoben werden. + - löscht bei der Einrichtung der Hauptstelle eine etwa bereits vorhandene + "Zentrale" und richtet automatisch eine neue "Zentrale" in Form einer Sohn­ + task ein, die den Namen der Vatertask mit dem Zusatz ".Zentrale" erhält und + in der später die zentrale Kundendatei gespeichert wird. Bei Aufhebung des + Hauptstellenstatus wird diese Task wieder gelöscht. + - fragt bei Einrichtung der Hauptstelle nach, ob ein Direktstart eingerichtet + werden soll ('Mit Direktstart (j/n)?') und ruft die Prozedur 'warenhaus + direktstart' entsprechend auf. + - Hebt bei Löschen des Hauptstellenstatus einen in der Task etwa einge­ + richteten Direktstart automatisch auf. + + Fehlerfälle: + - Hauptstelle ist bereits die Task '...'! + - Dieses Kommando darf nur in der Task '...' gegeben werden! + + diff --git a/app/gs.warenhaus/1.01/source-disk b/app/gs.warenhaus/1.01/source-disk new file mode 100644 index 0000000..74c6338 --- /dev/null +++ b/app/gs.warenhaus/1.01/source-disk @@ -0,0 +1 @@ +informatikpaket/08_gs.warenhaus.img diff --git a/app/gs.warenhaus/1.01/src/ls-MENUKARTE:Warenhaus b/app/gs.warenhaus/1.01/src/ls-MENUKARTE:Warenhaus new file mode 100644 index 0000000..414470a Binary files /dev/null and b/app/gs.warenhaus/1.01/src/ls-MENUKARTE:Warenhaus differ diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter new file mode 100644 index 0000000..36de5ef --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter @@ -0,0 +1,36 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 0 ** + ** ** + ** Anpassung für Kartenleser an AKTRONIC-Adapter ** + ** ** + ** Version 1.01 ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET ls warenhaus 0 DEFINES + interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key,{}(* --------------------------- *){} kanalkoppler,{} interfacechannel,{} init interfacechannel:{}TEXT CONST interface anpassung :: "mit Kartenleser an AKTRONIC-Adapter";{}LET max channel = 24,{} initcode = 26,{} endcode = 27,{} read code = 28;{}INT CONST nicht initialisiert code :: -3,{} interface error code :: -4,{} + kanal besetzt code :: -5;{}INT VAR interfacekanal :: 0;{}TEXT VAR puffer :: "";{}TASK VAR hardwaremanager :: niltask,{} interface task :: niltask,{} absender;{}DATASPACE VAR ds :: nilspace;{}INT PROC interfacechannel:{} interfacekanal{}END PROC interfacechannel;{}PROC oeffne interface (INT VAR status):{} puffer := "";{} forget (ds); ds := nilspace;{} pingpong (interfacetask, init code, ds, status);{} IF status > 0 THEN status DECR maxint FI;{} + forget (ds); ds := nilspace{}END PROC oeffne interface;{}INT PROC wert von interface:{} INT VAR wert;{} puffer CAT incharety (1);{} call (interface task, read code, ds, wert);{} wert.{}END PROC wert von interface;{}PROC schliesse interface:{} forget (ds); ds := nilspace;{} send (interface task, end code, ds);{} forget (ds); ds := nilspace{}END PROC schliesse interface;{}TEXT PROC pressed key:{} IF puffer = ""{} THEN incharety{} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} + TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} IF puffer = ""{} THEN incharety (warten){} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}(*************************************************************************){}PROC kanalkoppler:{} enable stop;{} IF name (myself) <> "-"{} + THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} INT VAR codenummer, antwort;{} disable stop;{} REP wait (ds, codenummer, absender);{} reagiere auf anruf;{} loesche ggf fehlerzustand{} PER.{} reagiere auf anruf:{} IF codenummer = initcode{} THEN kopple an interface;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} + FI;{} gib kanal frei{} ELSE send (absender, nicht initialisiert code, ds){} FI.{} loesche ggf fehlerzustand:{} IF is error{} THEN clear error{} FI.{} kopple an interface:{} IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself{} THEN antwort := kanal besetzt code;{} ELSE continue (interfacekanal);{} teste interface{} FI.{} teste interface:{} leere puffer;{} out (""240"");{} IF incharety (1) <> ""{} THEN antwort := 0;{} + out (""176""){} ELSE antwort := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei: break (quiet).{} ende: out (""176"").{} bearbeite weitere auftraege:{} REP pingpong (absender, antwort, ds, codenummer);{} IF codenummer = read code{} THEN hole wert von interface{} + ELIF codenummer < 0{} THEN send (absender, codenummer, ds);{} codenummer := endcode{} ELSE antwort := 0{} FI{} UNTIL codenummer = endcode PER;{} ende.{} hole wert von interface:{} out (""211"");{} antwort := code (incharety (1)).{}END PROC kanalkoppler;{}PROC init interfacechannel:{} teste auf zulaessigkeit;{} loesche interfacetask;{} erfrage interface kanal;{} generiere ggf neue interfacetask.{} teste auf zulaessigkeit:{} + enable stop;{} IF hardwaremanager <> niltask AND hardwaremanager <> myself{} THEN errorstop ("Dieses Kommando kann nur von der Task '" +{} name (hardwaremanager) + "' aus gegeben werden!"){} ELSE hardwaremanager := myself{} FI.{} loesche interfacetask:{} disable stop;{} end (interfacetask);{} IF is error THEN clear error FI;{} enable stop.{} generiere ggf neue interfacetask:{} IF interface kanal = 0{} THEN interface task := niltask;{} hardwaremanager := niltask{} + ELSE begin (PROC kanalkoppler, interface task);{} hardwaremanager := myself{} FI.{} erfrage interfacekanal:{} INT VAR kanalnummer;{} put ("Gib Interface - Kanal:");{} get (kanalnummer);{} set interfacechannel (kanalnummer).{}END PROC init interfacechannel;{}PROC set interface channel (INT CONST channel number):{} IF channel number < 0 OR channel number > max channel{} THEN errorstop ("Unzulässige Kanalnummer"){} ELSE interfacekanal := channel number{} FI{}END PROC set interface channel;{} +BOOL OP <> (TASK CONST t1, t2):{} NOT (t1 = t2){}END OP <>;{}init interfacechannel{}END PACKET ls warenhaus 0{} + diff --git "a/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" "b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" new file mode 100644 index 0000000..f108f7b --- /dev/null +++ "b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" @@ -0,0 +1,36 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 0 ** + ** ** + ** Anpassung für Kartenleser an MUFI als Endgerät ** + ** ** + ** Version 1.01 ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET ls warenhaus 0 DEFINES + interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key,{}(* --------------------------- *){} kanalkoppler,{} interfacechannel,{} init interfacechannel:{}TEXT CONST interface anpassung :: "mit Kartenleser an MUFI als Endgerät";{}LET mufikennung = ""27""27"",{} max channel = 24,{} initcode = 26,{} endcode = 27,{} read code = 28;{}INT CONST nicht initialisiert code :: -3,{} interface error code :: -4,{} + kanal besetzt code :: -5;{}INT VAR interfacekanal :: 2;{}TEXT VAR puffer :: "";{}TASK VAR hardwaremanager :: niltask,{} interface task :: niltask,{} absender;{}DATASPACE VAR ds :: nilspace;{}INT PROC interfacechannel:{} interfacekanal{}END PROC interfacechannel;{}PROC oeffne interface (INT VAR status):{} puffer := "";{} forget (ds); ds := nilspace;{} pingpong (interfacetask, init code, ds, status);{} IF status > 0 THEN status DECR maxint FI;{} + forget (ds); ds := nilspace{}END PROC oeffne interface;{}INT PROC wert von interface:{} INT VAR wert;{} puffer CAT incharety (1);{} call (interface task, read code, ds, wert);{} wert.{}END PROC wert von interface;{}PROC schliesse interface:{} forget (ds); ds := nilspace;{} send (interface task, end code, ds);{} forget (ds); ds := nilspace{}END PROC schliesse interface;{}TEXT PROC pressed key:{} IF puffer = ""{} THEN incharety{} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} + TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} IF puffer = ""{} THEN incharety (warten){} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}(*************************************************************************){}PROC kanalkoppler:{} enable stop;{} IF name (myself) <> "-"{} + THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} INT VAR codenummer, antwort;{} disable stop;{} REP wait (ds, codenummer, absender);{} reagiere auf anruf;{} loesche ggf fehlerzustand{} PER.{} reagiere auf anruf:{} IF codenummer = initcode{} THEN kopple an interface;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} + FI;{} gib kanal frei{} ELSE send (absender, nicht initialisiert code, ds){} FI.{} loesche ggf fehlerzustand:{} IF is error{} THEN clear error{} FI.{} kopple an interface:{} IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself{} THEN antwort := kanal besetzt code;{} ELSE continue (interfacekanal);{} teste interface{} FI.{} teste interface:{} leere puffer;{} out (mufikennung + "10");{} fange status;{} IF status = mufikennung + "00"{} + THEN antwort := 0;{} out (mufikennung + "1A18"22""){} ELSE antwort := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} fange status:{} INT VAR zaehler;{} TEXT VAR status :: "";{} FOR zaehler FROM 1 UPTO 4 REP{} status CAT incharety (1){} PER.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei: break (quiet).{} ende: out (""25"").{} + bearbeite weitere auftraege:{} REP pingpong (absender, antwort, ds, codenummer);{} IF codenummer = read code{} THEN hole wert von interface{} ELIF codenummer < 0{} THEN send (absender, codenummer, ds);{} codenummer := endcode{} ELSE antwort := 0{} FI{} UNTIL codenummer = endcode PER;{} ende.{} hole wert von interface:{} out (""76"");{} antwort := code (incharety (1)).{}END PROC kanalkoppler;{}PROC init interfacechannel:{} + teste auf zulaessigkeit;{} loesche interfacetask;{} erfrage interface kanal;{} generiere ggf neue interfacetask.{} teste auf zulaessigkeit:{} enable stop;{} IF hardwaremanager <> niltask AND hardwaremanager <> myself{} THEN errorstop ("Dieses Kommando kann nur von der Task '" +{} name (hardwaremanager) + "' aus gegeben werden!"){} FI.{} loesche interfacetask:{} disable stop;{} end (interfacetask);{} IF is error THEN clear error FI;{} enable stop.{} generiere ggf neue interfacetask:{} + IF interface kanal = 0{} THEN interface task := niltask;{} hardwaremanager := niltask{} ELSE begin (PROC kanalkoppler, interface task);{} hardwaremanager := myself{} FI.{} erfrage interfacekanal:{} INT VAR kanalnummer;{} put ("Gib Interface - Kanal:");{} get (kanalnummer);{} set interfacechannel (kanalnummer).{}END PROC init interfacechannel;{}PROC set interface channel (INT CONST channel number):{} IF channel number < 0 OR channel number > max channel{} THEN errorstop ("Unzulässige Kanalnummer!"){} + ELSE interface kanal := channel number{} FI{}END PROC set interface channel;{}BOOL OP <> (TASK CONST t1, t2):{} NOT (t1 = t2){}END OP <>;{}init interfacechannel{}END PACKET ls warenhaus 0{} + diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal new file mode 100644 index 0000000..30c69da --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal @@ -0,0 +1,30 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 0 ** + ** ** + ** Anpassung für Kartenleser an MUFI im Terminalkanal ** + ** ** + ** Version 1.01 ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET ls warenhaus 0 DEFINES + interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key:{}TEXT CONST interface anpassung :: "mit Kartenleser an MUFI im Terminalkanal";{}LET mufikennung = ""31""31"";{}INT CONST interface error code :: -4;{}TEXT CONST readcode :: mufikennung + "4C";{}TEXT VAR puffer :: "";{}PROC oeffne interface (INT VAR status):{} cursor (2,24);{} warte etwas;{} leere eingangspuffer;{} out (""27""27"10");{} fange antwort;{} IF antwort = ""27""27"00"{} + THEN status := 0;{} out (""27""27"1C" + hex (mufikennung)){} ELSE status := interface error code{} FI.{} warte etwas:{} pause (1); pause (1); pause (1); pause (1); pause (1).{} leere eingangspuffer:{} puffer := "";{} REP UNTIL incharety = "" PER.{} fange antwort:{} TEXT VAR antwort :: incharety (1);{} INT VAR i;{} FOR i FROM 1 UPTO 3 REP{} antwort CAT incharety (1){} PER.{}END PROC oeffne interface;{}INT PROC wert von interface:{} puffer CAT incharety (1);{} + out (readcode);{} fange mufikennung;{} dezimalwert (incharety (1), incharety (1)).{} fange mufikennung:{} REP puffer CAT incharety{} UNTIL pos (puffer, mufikennung) > 0 PER;{} change (puffer, mufikennung, "").{}END PROC wert von interface;{}PROC schliesse interface:{} cursor (2,24);{} out (mufikennung + "1C" + hex (""27""27"")){}END PROC schliesse interface;{}TEXT PROC pressed key:{} IF puffer = ""{} THEN incharety{} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} + TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} IF puffer = ""{} THEN incharety (warten){} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):{} 16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).{} + hexzeichen: "123456789ABCDEF".{}END PROC dezimalwert;{}TEXT PROC hex (TEXT CONST zwei zeichen):{} hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2)){}END PROC hex;{}TEXT PROC hex (INT CONST wert):{} (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).{} hexzeichen: "0123456789ABCDEF".{}END PROC hex{}END PACKET ls warenhaus 0{} + diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: ohne Kartenleser b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: ohne Kartenleser new file mode 100644 index 0000000..4912d64 --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: ohne Kartenleser @@ -0,0 +1,27 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 0 ** + ** ** + ** Anpassung für den Betrieb ohne Kartenleser ** + ** ** + ** Version 1.01 ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET ls warenhaus 0 DEFINES + interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key:{}TEXT CONST interface anpassung :: "ohne Kartenleser";{}PROC oeffne interface (INT VAR test):{} test := -6{}END PROC oeffne interface;{}PROC schliesse interface:{}END PROC schliesse interface;{}INT PROC wert von interface:{} INT VAR wert :: 0;{} wert{}END PROC wert von interface;{}TEXT PROC pressed key:{} incharety{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} + incharety (warten){}END PROC pressed key;{}END PACKET ls warenhaus 0{} + diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 1 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 1 new file mode 100644 index 0000000..81fd8ee --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 1 @@ -0,0 +1,37 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 1 ** + ** ** + ** Version 1.01 ** + ** ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET monitor alt DEFINES original monitor: + PROC original monitor:{} monitor{} END PROC originalmonitor{}END PACKET monitor alt;{}PACKET ls warenhaus 1 DEFINES{} zentrale,{} monitor,{} warenhaus direktstart,{} warenhaus hauptstelle,{} hauptstellenname:{}LET max kundenzahl = 31,{} min kundennummer = 129,{} kundendatei holen code = 100,{} kundendatei ergaenzen code = 200;{}TYPE KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht),{} KUNDENDATEI = ROW max kundenzahl KUNDENDATEN;{}{} +BOUND KUNDENDATEN VAR kundendaten;{}BOUND KUNDENDATEI VAR bound kundendatei;{}KUNDENDATEI VAR kundendatei;{}DATASPACE VAR ds;{}TASK VAR absender,{} zentraltask :: niltask,{} hauptstelle :: niltask,{} direktstartmanager :: niltask;{}BOOL VAR mit direktstart :: FALSE,{} mit loeschen :: FALSE;{}INT VAR codenummer;{}PROC zentrale:{} enable stop;{} IF pos (name (myself), ".Zentrale") = 0{} THEN errorstop ("Unzulaessiger Befehl!"){}{} + FI;{} disable stop;{} REP wait (ds, codenummer, absender);{} bearbeite auftrag;{} send (absender, codenummer, ds);{} IF is error THEN clear error FI{} PER.{} bearbeite auftrag:{} IF codenummer = kundendatei holen code{} THEN hole kundendatei{} ELIF codenummer = kundendatei ergaenzen code{} THEN ergaenze kundendatei{} ELIF codenummer >= min kundennummer{} THEN lies kundendaten{} ELSE speichere kundendaten{} FI.{}END PROC zentrale;{}{} +PROC hole kundendatei:{} bound kundendatei := ds;{} bound kundendatei := kundendatei{}END PROC hole kundendatei;{}PROC ergaenze kundendatei:{} INT VAR kundennummer;{} bound kundendatei := ds;{} FOR kundennummer FROM 1 UPTO max kundenzahl REP{} IF kundendatei [kundennummer].nachname = ""{} THEN kundendatei [kundennummer] := bound kundendatei [kundennummer]{} FI{} PER;{} init ds{}END PROC ergaenze kundendatei;{}PROC lies kundendaten:{} kundendaten := ds;{} kundendaten := kundendatei [platznummer].{}{} + platznummer: codenummer - min kundennummer + 1.{}END PROC lies kundendaten;{}PROC speichere kundendaten:{} kundendaten := ds;{} kundendatei [codenummer] := kundendaten;{} init ds{}END PROC speichere kundendaten;{}PROC warenhaus hauptstelle (BOOL CONST task soll hauptstelle sein):{} enable stop;{} IF task soll hauptstelle sein{} THEN mache task zur hauptstelle{} ELSE mache hauptstellenstatus rueckgaengig{} FI.{} mache task zur hauptstelle:{} sei eine hauptstelle;{} line (2);{}{} + IF NOT mit direktstart CAND yes ("Mit Direktstart"){} THEN warenhaus direktstart (TRUE){} ELSE global manager{} FI{}END PROC warenhaus hauptstelle;{}PROC sei eine hauptstelle:{} IF NOT (hauptstelle = niltask OR hauptstelle = myself){} THEN errorstop ("Hauptstelle ist bereits die Task '" +{} name (hauptstelle) + "'!"){} FI;{} disable stop;{} end (zentraltask);{} IF is error THEN clear error FI;{} enable stop;{} hauptstelle := niltask;{} begin (name (myself) + ".Zentrale", PROC zentrale, zentraltask);{}{} + hauptstelle := myself{}END PROC sei eine hauptstelle;{}PROC mache hauptstellenstatus rueckgaengig:{} IF NOT (hauptstelle = niltask OR hauptstelle = myself){} THEN errorstop ("Dieses Kommando darf nur in der Task '" +{} name (hauptstelle) + " gegeben werden!"){} FI;{} disable stop;{} end (zentraltask);{} IF is error THEN clear error FI;{} enable stop;{} hauptstelle := niltask;{} warenhaus direktstart (FALSE){}END PROC mache hauptstellenstatus rueckgaengig;{}PROC warenhaus direktstart (BOOL CONST wahl):{}{} + pruefe zulaessigkeit;{} mit direktstart := wahl;{} IF mit direktstart{} THEN direktstartmanager := myself;{} mit loeschen := yes ("Mit automatischem Löschen"){} ELSE direktstartmanager := niltask{} FI;{} global manager.{} pruefe zulaessigkeit:{} enable stop;{} IF NOT (direktstartmanager = niltask OR direktstartmanager = myself){} THEN errorstop ("Der Direktstart kann nur aus der Task '" +{} name (direktstartmanager) + "'geaendert werden!"){}{} + FI.{}END PROC warenhaus direktstart;{}TEXT PROC hauptstellenname:{} name (hauptstelle){}END PROC hauptstellenname;{}PROC monitor:{} IF mit direktstart{} THEN warenhaus monitor{} ELSE original monitor{} FI{}END PROC monitor;{}PROC warenhausmonitor:{} disable stop;{} INT VAR previous heapsize := heap size;{} REP command dialogue (TRUE);{} sysin (""); sysout ("");{} cry if not enough storage;{} reset dialog; erase menunotice;{} do ("warenhaus");{} IF is error{}{} + THEN clear error{} ELSE sitzungsende{} FI{} PER.{} sitzungsende:{} collect heap garbage if necessary;{} page;{} IF mit loeschen{} THEN break; end (myself){} ELSE end; break{} FI.{} collect heap garbage if necessary:{} IF heap size > previous heapsize + 10{} THEN collect heap garbage;{} previous heapsize := heap size{} FI.{} cry if not enough storage:{} INT VAR size, used;{} storage (size, used);{} IF used > size{} THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10""){}{} + FI.{}END PROC warenhausmonitor;{}OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (KUNDENDATEI VAR ziel, KUNDENDATEI CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC init ds:{} forget (ds); ds := nilspace{}END PROC init ds;{}PROC initialisiere kundendatei:{} KUNDENDATEN CONST leer :: KUNDENDATEN : ("", "", "");{} INT VAR nr;{} FOR nr FROM 1 UPTO max kundenzahl REP{} kundendatei [nr] := leer{} PER{}END PROC initialisiere kundendatei;{}{} +initialisiere kundendatei{}END PACKET ls warenhaus 1{}{} + diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 2 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 2 new file mode 100644 index 0000000..7048aff --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 2 @@ -0,0 +1,112 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 2 ** + ** ** + ** Version 1.01 ** + ** ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET ls warenhaus 2 DEFINES + max artikelzahl,{} max kundenzahl,{} min kundennummer,{} max kundennummer,{} min artikelnummer,{} max artikelnummer,{} filialverwaltung,{} initialisiere verwaltung,{} hole artikeldaten,{} speichere artikeldaten,{} registriere verkauf,{} hole kundendaten,{} speichere kundendaten,{} sichere filialdaten,{} lade filialdaten,{} hole bestelliste,{} hole auskunft ein:{}LET max filialen = 10,{} max artikel = 15,{} + max kunden = 31,{} min kundennr = 129,{} max kundennr = 159,{} min artikelnr = 1,{} max artikelnr = 15;{}LET zentrale kundendatei holen code = 100,{} zentrale kundendatei ergaenzen code = 200,{} filialdaten holen code = 201,{} filialdaten ergaenzen code = 202;{}INT CONST max artikelzahl :: max artikel,{} max kundenzahl :: max kunden,{} min kundennummer :: min kundennr,{} max kundennummer :: max kundennr,{} + min artikelnummer :: min artikelnr,{} max artikelnummer :: max artikelnr;{}TYPE ARTIKELDATEN = STRUCT (TEXT artikelname, REAL preis,{} INT mindestbestand, bestand),{} KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht),{} WARENDATEI = ROW max artikel ARTIKELDATEN,{} KUNDENDATEI = ROW max kunden KUNDENDATEN,{} EINKAUFSDATEI = ROW max kunden ROW max artikel INT,{} VERKAUFSDATEI = ROW max artikel INT,{} FILIALDATEN = STRUCT (WARENDATEI waren, KUNDENDATEI kunden,{} + EINKAUFSDATEI einkaeufe,{} VERKAUFSDATEI hitliste);{}KUNDENDATEI VAR kunde;{}WARENDATEI VAR artikel;{}EINKAUFSDATEI VAR einkaufsdatei;{}VERKAUFSDATEI VAR verkaufszahl;{}DATASPACE VAR ds;{}INT VAR codenummer, reply code;{}TASK VAR zentrale, verwaltung, absender;{}TEXT VAR hauptstelle :: "",{} filialnummer :: "0",{} filialverwaltungsname :: "";{}PROC filialverwaltung:{} enable stop;{} + IF pos (name (myself), ".Filialverwaltung") = 0{} THEN errorstop ("Unzulaessiger Befehl!"){} FI;{} disable stop;{} REP wait (ds, codenummer, absender);{} bearbeite auftrag;{} send (absender, 0, ds);{} IF is error THEN clear error FI{} PER.{} bearbeite auftrag:{} IF codenummer <= max artikel{} THEN artikeldaten speichern{} ELIF codenummer <= max kundennr{} THEN kauf registrieren{} ELIF codenummer <= max kundennr + max kunden{} THEN kundendaten speichern{} + ELIF codenummer = filialdaten holen code{} THEN filialdaten holen{} ELIF codenummer = filialdaten ergaenzen code{} THEN filialdaten ergaenzen; init ds{} ELIF codenummer = 256{} THEN sperre task{} FI.{} sperre task:{} call (absender, 256, ds, codenummer).{}END PROC filialverwaltung;{}PROC artikeldaten speichern:{} BOUND ARTIKELDATEN VAR artikeldaten :: ds;{} artikel [codenummer] := artikeldaten;{} init ds{}END PROC artikeldaten speichern;{}PROC kauf registrieren:{} + artikelnummer aus ds lesen;{} artikel [artikelnummer].bestand DECR 1;{} verkaufszahl [artikelnummer] INCR 1;{} IF kundennummer > 0{} THEN einkaufsdatei [kundennummer][artikelnummer] INCR 1{} FI.{} artikelnummer aus ds lesen:{} BOUND INT VAR nummer :: ds;{} INT CONST artikelnummer :: nummer,{} kundennummer :: codenummer - min kundennr + 1;{} init ds{}END PROC kauf registrieren;{}PROC kundendaten speichern:{} BOUND KUNDENDATEN VAR kundendaten :: ds;{} kunde [codenummer - min kundennr - max kunden + 1] := kundendaten{} +END PROC kundendaten speichern;{}PROC filialdaten holen:{} init ds;{} BOUND FILIALDATEN VAR filialdaten :: ds;{} CONCR (filialdaten.waren) := CONCR (artikel);{} CONCR (filialdaten.kunden) := CONCR (kunde);{} CONCR (filialdaten.einkaeufe) := CONCR (einkaufsdatei);{} CONCR (filialdaten.hitliste) := CONCR (verkaufszahl){}END PROC filialdaten holen;{}PROC filialdaten ergaenzen:{} BOUND FILIALDATEN VAR neue daten :: ds;{} INT VAR kundennummer, artikelnummer;{} ergaenze artikeldatei und verkaufszahlen;{} + ergaenze kundendatei;{} ergaenze einkaufsdatei.{} ergaenze artikeldatei und verkaufszahlen:{} FOR artikelnummer FROM 1 UPTO max artikel REP{} verkaufszahl [artikelnummer] INCR neue daten.hitliste [artikelnummer];{} IF artikel [artikelnummer].artikelname = ""{} THEN artikel [artikelnummer] := neue daten.waren [artikelnummer]{} FI{} PER.{} ergaenze kundendatei:{} FOR kundennummer FROM 1 UPTO max kunden REP{} IF kunde [kundennummer].nachname = ""{} THEN kunde [kundennummer] := neue daten.kunden [kundennummer]{} + FI{} PER.{} ergaenze einkaufsdatei:{} FOR kundennummer FROM 1 UPTO max kunden REP{} FOR artikelnummer FROM 1 UPTO max artikel REP{} einkaufsdatei [kundennummer][artikelnummer]{} INCR neue daten.einkaeufe [kundennummer][artikelnummer]{} PER{} PER.{}END PROC filialdaten ergaenzen;{}OP := (ARTIKELDATEN VAR ziel, ARTIKELDATEN CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):{} CONCR (ziel) := CONCR (quelle){} +END OP :=;{}PROC init ds:{} forget (ds); ds := nilspace{}END PROC init ds;{}(************************************************************************){}PROC initialisiere verwaltung:{} hauptstelle := hauptstellenname;{} zentrale := task (hauptstelle + ".Zentrale");{} filialnummer := text (channel (myself));{} filialverwaltungsname := hauptstellenname + ".Filialverwaltung ";{} begin (filialverwaltungsname + filialnummer,{} PROC filialverwaltung, verwaltung){}END PROC initialisiere verwaltung;{} +PROC hole artikeldaten (INT CONST artikelnummer,{} TEXT VAR name, REAL VAR preis,{} INT VAR mindestbestand, bestand):{} enable stop;{} pruefe artikelnummer;{} hole daten.{} pruefe artikelnummer:{} INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} hole daten:{} name := artikel [artikelindex].artikelname;{} + preis := artikel [artikelindex].preis;{} mindestbestand := artikel [artikelindex].mindestbestand;{} bestand := artikel [artikelindex].bestand.{}END PROC hole artikeldaten;{}PROC speichere artikeldaten (INT CONST artikelnummer,{} TEXT CONST name, REAL CONST preis,{} INT CONST mindestbestand, bestand):{} enable stop;{} pruefe artikelnummer;{} speichere daten;{} schicke kopie an verwaltung.{} pruefe artikelnummer:{} + INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} speichere daten:{} artikel [artikelindex].artikelname := name;{} artikel [artikelindex].preis := preis;{} artikel [artikelindex].mindestbestand:= mindestbestand;{} artikel [artikelindex].bestand := bestand.{} schicke kopie an verwaltung:{} init ds;{} BOUND ARTIKELDATEN VAR artikeldaten :: ds;{} + artikeldaten := artikel [artikelindex];{} call (verwaltung, artikelindex, ds, reply code).{}END PROC speichere artikeldaten;{}PROC registriere verkauf (INT CONST kundennummer, artikelnummer):{} enable stop;{} pruefe daten;{} speichere daten;{} schicke kopie zur verwaltung.{} pruefe daten:{} INT VAR kundenindex :: kundennummer - min kundennr + 1,{} artikelindex :: artikelnummer - min artikelnr + 1;{} IF kundenindex < 0 OR kundenindex > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} + ELIF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} speichere daten:{} IF artikel [artikelindex].bestand > 0{} THEN artikel [artikelindex].bestand DECR 1;{} verkaufszahl [artikelindex] INCR 1;{} IF kundenindex > 0{} THEN trage evtl in einkaufsdatei ein{} FI FI.{} trage evtl in einkaufsdatei ein:{} IF kunde [kundenindex].nachname = ""{} THEN kundenindex := 0{} ELSE einkaufsdatei [kundenindex][artikelindex] INCR 1{} + FI.{} schicke kopie zur verwaltung:{} init ds;{} BOUND INT VAR nummer :: ds;{} nummer := artikelindex;{} call (verwaltung, kundenindex + min kundennr - 1, ds, reply code).{}END PROC registriere verkauf;{}PROC hole kundendaten (INT CONST kundennummer,{} TEXT VAR nachname, vorname, geschlecht):{} enable stop;{} pruefe kundennummer;{} rufe zentrale an;{} uebergib die zentraldaten;{} IF aenderungen vorhanden{} THEN aktualisiere filialdaten{} FI;{} forget (ds).{} + pruefe kundennummer:{} INT CONST index :: kundennummer - min kundennr + 1;{} IF index < 1 OR index > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} rufe zentrale an:{} init ds;{} call (zentrale, kundennummer, ds, reply code).{} aenderungen vorhanden:{} (kunde [index].nachname <> nachname ) OR{} (kunde [index].vorname <> vorname ) OR{} (kunde [index].geschlecht <> geschlecht).{} aktualisiere filialdaten:{} kunde [index] := daten von zentrale;{} + call (verwaltung, kundennummer + max kunden, ds, reply code).{} uebergib die zentraldaten:{} BOUND KUNDENDATEN VAR daten von zentrale :: ds;{} nachname := daten von zentrale.nachname;{} vorname := daten von zentrale.vorname;{} geschlecht := daten von zentrale.geschlecht.{}END PROC hole kundendaten;{}PROC speichere kundendaten(INT CONST kundennummer,{} TEXT CONST nachname, vorname, geschlecht):{} enable stop;{} pruefe kundennummer;{} IF kundendaten geaendert{} + THEN speichere daten;{} schicke kopie an verwaltung und zentrale{} FI.{} pruefe kundennummer:{} IF kundennummer < min kundennr OR kundennummer > max kundennr{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} kundendaten geaendert:{} INT CONST index :: kundennummer - min kundennr + 1;{} nachname <> kunde [index].nachname OR{} vorname <> kunde [index].vorname OR{} geschlecht <> kunde [index].geschlecht.{} speichere daten:{} kunde [index].nachname := nachname;{} + kunde [index].vorname := vorname;{} kunde [index].geschlecht := geschlecht.{} schicke kopie an verwaltung und zentrale:{} init ds;{} BOUND KUNDENDATEN VAR kundendaten :: ds;{} kundendaten := kunde [index];{} call (verwaltung, kundennummer + max kunden, ds, reply code);{} call (zentrale, kundennummer - min kundennr + 1, ds, reply code);{} forget (ds).{}END PROC speichere kundendaten;{}PROC sichere filialdaten (TEXT CONST name):{} enable stop;{} filialdaten holen;{} + type (ds, 1951);{} forget (name, quiet);{} copy (ds, name);{} forget (ds){}END PROC sichere filialdaten;{}PROC lade filialdaten (TEXT CONST name):{} enable stop;{} forget (ds);{} ds := old (name);{} IF type (ds) = 1951{} THEN filialdaten ergaenzen;{} kopie an verwaltung schicken;{} kopie der kundendatei an zentrale schicken{} ELSE errorstop ("'" + name + "' enthält keine Filialdaten!"){} FI.{} kopie an verwaltung schicken:{} call (verwaltung, filialdaten ergaenzen code, ds, reply code).{} + kopie der kundendatei an zentrale schicken:{} BOUND KUNDENDATEI VAR kundendatei :: ds;{} CONCR (CONCR (kundendatei)) := CONCR (kunde);{} call (zentrale, zentrale kundendatei ergaenzen code, ds, reply code).{}END PROC lade filialdaten;{}PROC hole bestelliste (FILE VAR f):{} bereite datei vor;{} schreibe daten in datei.{} bereite datei vor:{} forget("Nachbestellung",quiet);{} f := sequential file (output, "Nachbestellung");{} line (f);{} write (f, " Nachbestellungen für " +{} + invers ("Filiale " + filialnummer)+":");{} line;{} write (f, " ==================================================");{} line (f, 2);{} write (f, " | Art.Nr. | Artikelname | Anzahl |");{} line (f);{} write (f, " +----------+-------------------------+-----------+");{} line (f).{} schreibe daten in datei:{} INT VAR artikelnummer;{} FOR artikelnummer FROM 1 UPTO max artikel REP{} IF artikel[artikelnummer].bestand{} + < artikel[artikelnummer].mindestbestand{} THEN bestelle artikel nach{} FI{} PER;{} write (f, " +----------+-------------------------+-----------+");{} line (f).{} bestelle artikel nach:{} write (f, " | " + wirkliche artikelnummer + " | "{} + text (artikel [artikelnummer].artikelname, 23) + " | "{} + text (nachzubestellende anzahl, 6) + " |");{} line (f);{} artikel [artikelnummer].bestand{} := 2 * artikel [artikelnummer].mindestbestand.{} + wirkliche artikelnummer:{} text (artikelnummer + min artikelnr - 1, 5).{} nachzubestellende anzahl:{} 2 * artikel [artikelnummer].mindestbestand{} - artikel [artikelnummer].bestand.{}END PROC hole bestelliste;{}PROC hole auskunft ein (INT CONST codenummer, artikel oder kundennummer,{} FILE VAR f):{} enable stop;{} hauptstelle := hauptstellenname;{} SELECT codenummer OF CASE 66 : hitliste von zentrale (f){} CASE 67 : hitliste von filiale (f){} + CASE 68 : hitlisten aller filialen (f){} (* --------------------------------------------- *){} CASE 73 : artikelkaeuferliste von zentrale{} (artikel oder kundennummer, f){} CASE 74 : artikelkaeuferliste von filiale{} (artikel oder kundennummer, f){} CASE 75 : artikelkaeuferlisten aller filialen{} (artikel oder kundennummer, f){} + (* --------------------------------------------- *){} CASE 77 : kundenliste von zentrale (f){} CASE 78 : kundenliste von filiale (f){} CASE 79 : kundenlisten aller filialen (f){} (* --------------------------------------------- *){} CASE 84 : kundeneinkaufsliste von zentrale{} (artikel oder kundennummer, f){} CASE 85 : kundeneinkaufsliste von filiale{} + (artikel oder kundennummer, f){} CASE 86 : kundeneinkaufslisten aller filialen{} (artikel oder kundennummer, f){} (* --------------------------------------------- *){} CASE 89 : lageruebersicht von zentrale (f){} CASE 90 : lageruebersicht von filiale (f){} CASE 91 : lageruebersichten aller filialen (f){} (* --------------------------------------------- *){} + OTHERWISE errorstop ("Unzulässige Code - Nummer bei Auskunft!"){} END SELECT{}END PROC hole auskunft ein;{}PROC hitliste von zentrale (FILE VAR f):{} INT VAR filialnr;{} beginne mit eigener filiale;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr <> int (filialnummer) CAND{} exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in zentralliste{} + FI{} PER;{} werte zentralliste aus.{} beginne mit eigener filiale:{} WARENDATEI VAR zentrale warendatei;{} CONCR (zentrale warendatei) := CONCR (artikel);{} VERKAUFSDATEI VAR zentrale verkaufsdatei;{} CONCR (zentrale verkaufsdatei) := CONCR (verkaufszahl).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} BOUND FILIALDATEN VAR aktuelle daten :: ds.{} schreibe daten in zentralliste:{} INT VAR i;{} + FOR i FROM 1 UPTO max artikel REP{} IF zentrale warendatei [i].artikelname = ""{} THEN zentrale warendatei [i] := aktuelle daten.waren [i]{} FI;{} zentrale verkaufsdatei [i] INCR aktuelle daten.hitliste [i]{} PER.{} werte zentralliste aus:{} forget (ds);{} forget ("Auskunft: Zentrale", quiet);{} f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} write (f, " Zentrale Warenliste, geordnet nach Verkaufszahlen:");{} sortiere (zentrale warendatei, zentrale verkaufsdatei);{} + fuelle (f, zentrale warendatei, zentrale verkaufsdatei).{}END PROC hitliste von zentrale;{}PROC hitliste von filiale (FILE VAR f):{} bereite auskunftsdatei vor;{} kopiere artikeldatei und verkaufsdatei;{} sortiere (hilfsdatei artikel, hilfsdatei verkaufszahlen);{} fuelle (f,hilfsdatei artikel, hilfsdatei verkaufszahlen).{} kopiere artikeldatei und verkaufsdatei:{} WARENDATEI VAR hilfsdatei artikel;{} CONCR (hilfsdatei artikel) := CONCR (artikel);{} VERKAUFSDATEI VAR hilfsdatei verkaufszahlen;{} + CONCR (hilfsdatei verkaufszahlen) := CONCR (verkaufszahl).{} bereite auskunftsdatei vor:{} forget ("Auskunft: Filiale " + filialnummer, quiet);{} f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} line (f);{} write (f, " Warenliste, geordnet nach Verkaufszahlen:").{}END PROC hitliste von filiale;{}PROC hitlisten aller filialen (FILE VAR f):{} WARENDATEI VAR aktuelle warendatei;{} VERKAUFSDATEI VAR aktuelle verkaufsdatei;{} INT VAR filialnr;{} + bereite auskunftsdatei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr = int (filialnummer){} THEN nimm eigene daten{} ELIF exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} arbeite mit diesen daten{} FI{} PER;{} forget (ds).{} bereite auskunftsdatei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen");{} + line (f).{} nimm eigene daten:{} CONCR (aktuelle warendatei) := CONCR (artikel);{} CONCR (aktuelle verkaufsdatei) := CONCR (verkaufszahl);{} sortiere und fuelle.{} sortiere und fuelle:{} write (f, " Warenliste von " + invers ("Filiale " + text (filialnr)){} + ", geordnet nach Verkaufszahlen:");{} sortiere (aktuelle warendatei, aktuelle verkaufsdatei);{} fuelle (f,aktuelle warendatei, aktuelle verkaufsdatei).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} + BOUND FILIALDATEN VAR aktuelle daten :: ds.{} arbeite mit diesen daten:{} CONCR (aktuelle warendatei) := CONCR (aktuelle daten.waren);{} CONCR (aktuelle verkaufsdatei) := CONCR (aktuelle daten.hitliste);{} sortiere und fuelle.{}END PROC hitlisten aller filialen;{}PROC sortiere (WARENDATEI VAR warendatei, VERKAUFSDATEI VAR stueckzahl):{} INT VAR i,j;{} FOR i FROM 1 UPTO max artikel - 1 REP{} FOR j FROM i + 1 UPTO max artikel REP{} IF stueckzahl [i] < stueckzahl [j]{} THEN vertausche{} + FI{} PER PER.{} vertausche:{} INT CONST hilfsint :: stueckzahl [i];{} ARTIKELDATEN CONST hilfsartikel :: warendatei [i];{} stueckzahl [i] := stueckzahl [j];{} warendatei [i] := warendatei [j];{} stueckzahl [j] := hilfsint;{} warendatei [j] := hilfsartikel.{}END PROC sortiere;{}PROC fuelle (FILE VAR f, WARENDATEI VAR warendat, VERKAUFSDATEI VAR anzahl):{} INT VAR nummer, platz :: 0;{} bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} + line (f,2);{} write(f," | Platz | Verk.Anzahl | Artikelname | Preis |");{} line (f);{} write(f," +-------+-------------+------------------------+-----------+");{} line (f).{}schreibe daten in datei:{} FOR nummer FROM 1 UPTO max artikel REP{} IF warendat [nummer].artikelname <> ""{} THEN schreibe in datei; line (f){} FI{} PER;{} write(f," +-------+-------------+------------------------+-----------+");{} line (f,3).{}schreibe in datei:{} platz INCR 1;{} write (f, " |" + text (platz, 5) + " |"{} + + text (anzahl [nummer], 9) + " | "{} + text (warendat [nummer].artikelname, 22) + " | "{} + text (warendat [nummer].preis,8,2) + " |").{}END PROC fuelle;{}PROC artikelkaeuferliste von zentrale (INT CONST artikelnummer, FILE VAR f):{} INT VAR filialnr;{} pruefe artikelnummer;{} beginne mit eigener filiale;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} + IF filialnr <> int (filialnummer) CAND{} exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in zentralliste{} FI{} PER;{} werte zentralliste aus.{} pruefe artikelnummer:{} INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} beginne mit eigener filiale:{} TEXT VAR aktueller artikelname :: artikel [artikelindex].artikelname;{} + KUNDENDATEI VAR hilfsdatei;{} CONCR (hilfsdatei) := CONCR (kunde);{} ROW max kunden INT VAR kaeufe;{} INT VAR i;{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] := einkaufsdatei [i][artikelindex]{} PER.{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{} schreibe daten in zentralliste:{} BOUND FILIALDATEN VAR aktuelle daten :: ds;{} IF aktueller artikelname = ""{} THEN aktueller artikelname{} + := aktuelle daten.waren [artikelindex].artikelname{} FI;{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] INCR aktuelle daten.einkaeufe [i][artikelindex];{} IF hilfsdatei [i].nachname = ""{} THEN hilfsdatei [i] := aktuelle daten.kunden [i]{} FI{} PER.{} werte zentralliste aus:{} forget (ds);{} forget ("Auskunft: Zentrale", quiet);{} f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} IF aktueller artikelname = ""{} THEN write (f, " Der Artikel Nr. " + text (artikelindex){} + + " wird in keiner Filiale geführt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3);{} ELSE write (f, " Gesamtkäuferliste des Artikels "{} + invers (aktueller artikelname) + ":");{} fuelle (f, hilfsdatei, kaeufe){} FI.{}END PROC artikelkaeuferliste von zentrale;{}PROC artikelkaeuferliste von filiale (INT CONST artikelnummer, FILE VAR f):{} + pruefe artikelnummer;{} kopiere einkaufszahlen in hilfsliste;{} erstelle filialliste.{} pruefe artikelnummer:{} INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} kopiere einkaufszahlen in hilfsliste:{} ROW max kunden INT VAR kaeufe;{} INT VAR i;{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] := einkaufsdatei [i][artikelindex]{} PER.{} erstelle filialliste:{} + forget ("Auskunft: Filiale " + filialnummer, quiet);{} f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} line (f);{} IF artikel [artikelindex].artikelname = ""{} THEN write (f, " Der Artikel Nr. " + text (artikelindex){} + " wird in dieser Filiale nicht geführt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3);{} ELSE write (f, " Käufer des Artikels "{} + + invers (artikel [artikelindex].artikelname){} + ":");{} fuelle (f, kunde, kaeufe){} FI.{}END PROC artikelkaeuferliste von filiale;{}PROC artikelkaeuferlisten aller filialen(INT CONST artikelnummer,FILE VAR f):{} INT VAR i, filialnr;{} ROW max kunden INT VAR kaeufe;{} pruefe artikelnummer;{} bereite datei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} + IF filialnr = int (filialnummer){} THEN kopiere eigene einkaufszahlen in hilfsliste;{} schreibe eigene daten in auskunftsdatei{} ELIF exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in auskunftsdatei{} FI{} PER;{} forget (ds).{} pruefe artikelnummer:{} INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} + FI.{} bereite datei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen");{} line (f).{} kopiere eigene einkaufszahlen in hilfsliste:{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] := einkaufsdatei [i][artikelindex]{} PER.{} schreibe eigene daten in auskunftsdatei:{} IF artikel [artikelindex].artikelname = ""{} THEN write (f, " Der Artikel Nr. " + text (artikelindex){} + " wird in "{} + + invers ("Filiale " + filialnummer){} + " nicht geführt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3){} ELSE write (f, " Käufer des Artikels '"{} + artikel [artikelindex].artikelname{} + "' in " + invers ("Filiale " + filialnummer) + ":");{} fuelle(f, kunde, kaeufe){} FI.{} hole daten dieser filiale:{} + init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} BOUND FILIALDATEN VAR aktuelle daten :: ds;{} TEXT CONST aktueller artikelname{} := aktuelle daten.waren [artikelindex].artikelname{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] := aktuelle daten.einkaeufe [i][artikelindex];{} PER.{} schreibe daten in auskunftsdatei:{} IF aktueller artikelname = ""{} THEN write (f, " Der Artikel Nr. " + text (artikelindex){} + + " wird in "{} + invers ("Filiale " + text (filialnr)){} + " nicht geführt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3){} ELSE write (f, " Käufer des Artikels '"{} + aktueller artikelname{} + "' in " + invers ("Filiale " + text(filialnr)) + ":");{} fuelle(f, aktuelle daten.kunden, kaeufe){} + FI.{}END PROC artikelkaeuferlisten aller filialen;{}PROC fuelle (FILE VAR f, KUNDENDATEI CONST kundenliste,{} ROW max kunden INT CONST einkaufszahlen):{} INT VAR kundennummer;{} bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} line (f, 2);{} write(f," | Anzahl | Nachname, Vorname | Geschlecht |");{} line (f);{} write(f," +--------+------------------------------------+------------+");{} + line (f).{}schreibe daten in datei:{} FOR kundennummer FROM 1 UPTO max kunden REP{} IF einkaufszahlen [kundennummer] > 0{} THEN schreibe in datei; line (f);{} FI{} PER;{} write(f," +--------+------------------------------------+------------+");{} line (f, 3).{}schreibe in datei:{} write(f," |" + text(einkaufszahlen [kundennummer], 5) + " | "{} + text(kundenliste [kundennummer].nachname + ",", 17) + " "{} + text(kundenliste [kundennummer].vorname, 16) + " | ");{} + IF kundenliste [kundennummer].geschlecht = "m"{} THEN write (f, " männlich |"){} ELIF kundenliste [kundennummer].geschlecht = "w"{} THEN write (f, " weiblich |"){} ELSE write (f, " |"){} FI.{}END PROC fuelle;{}PROC kundenliste von zentrale (FILE VAR f):{} hole kundenliste von zentrale;{} bereite datei vor;{} schreibe daten in datei.{} hole kundenliste von zentrale:{} init ds;{} call (zentrale, zentrale kundendatei holen code, ds, reply code);{} BOUND KUNDENDATEI VAR zentrale kundenliste :: ds.{} + bereite datei vor:{} forget ("Auskunft: Zentrale", quiet);{} f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} write (f, " Zentrale Kundenliste:").{} schreibe daten in datei:{} fuelle (f, zentrale kundenliste);{} forget (ds).{}END PROC kundenliste von zentrale;{}PROC kundenliste von filiale (FILE VAR f):{} bereite datei vor;{} schreibe daten in datei.{} bereite datei vor:{} forget ("Auskunft: Filiale " + filialnummer, quiet);{} f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} + line (f);{} write (f," Kundenliste:").{} schreibe daten in datei:{} fuelle (f, kunde).{}END PROC kundenliste von filiale;{}PROC kundenlisten aller filialen (FILE VAR f):{} INT VAR filialnr;{} bereite datei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr = int (filialnummer){} THEN schreibe eigene daten in auskunftsdatei{} ELIF exists task (aktuelle verwaltung){} + THEN hole daten dieser filiale;{} schreibe daten dieser filiale in auskunftsdatei{} FI{} PER.{} bereite datei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen");{} line (f).{} schreibe eigene daten in auskunftsdatei:{} schreibe ueberschrift;{} fuelle (f, kunde).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} BOUND FILIALDATEN VAR aktuelle filialdaten :: ds.{} + schreibe daten dieser filiale in auskunftsdatei:{} schreibe ueberschrift;{} fuelle (f, aktuelle filialdaten.kunden).{} schreibe ueberschrift:{} write (f, " Kundenliste für " +{} invers ("Filiale " + text (filialnr)) + ":").{}END PROC kundenlisten aller filialen;{}PROC fuelle (FILE VAR f, KUNDENDATEI VAR kundendatei):{} INT VAR kundennummer;{} bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} + line (f,2);{} write(f," | Kun.Nr.| Nachname, Vorname | Geschlecht |");{} line (f);{} write(f," +--------+------------------------------------+------------+");{} line (f).{}schreibe daten in datei:{} FOR kundennummer FROM 1 UPTO max kunden REP{} IF kundendatei [kundennummer].nachname <> ""{} THEN schreibe in datei; line (f){} FI{} PER;{} write(f," +--------+------------------------------------+------------+");{} line (f, 3).{}schreibe in datei:{} write (f, " |" + text (kundennummer + min kundennummer - 1, 6) + " | "{} + + text (kundendatei [kundennummer].nachname + ",", 17) + " "{} + text (kundendatei [kundennummer].vorname, 16) + " | ");{} IF kundendatei [kundennummer].geschlecht = "m"{} THEN write (f, " männlich |"){} ELIF kundendatei [kundennummer].geschlecht = "w"{} THEN write (f, " weiblich |"){} ELSE write (f, " |"){} FI.{}END PROC fuelle;{}PROC kundeneinkaufsliste von zentrale (INT CONST kundennummer, FILE VAR f):{} INT VAR filialnr;{} + pruefe kundennummer;{} beginne mit eigener filiale;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr <> int (filialnummer) CAND{} exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in zentralliste{} FI{} PER;{} werte zentralliste aus.{} pruefe kundennummer:{} INT CONST kundenindex :: kundennummer - min kundennr + 1;{} + IF kundenindex < 1 OR kundenindex > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} beginne mit eigener filiale:{} KUNDENDATEN VAR aktueller kunde :: kunde [kundenindex];{} WARENDATEI VAR hilfsdatei;{} CONCR (hilfsdatei) := CONCR (artikel);{} ROW max artikel INT VAR kaeufe;{} INT VAR i;{} FOR i FROM 1 UPTO max artikel REP{} kaeufe [i] := einkaufsdatei [kundenindex][i]{} PER.{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{} + schreibe daten in zentralliste:{} BOUND FILIALDATEN VAR aktuelle daten :: ds;{} IF aktueller kunde.nachname = ""{} THEN aktueller kunde := aktuelle daten.kunden [kundenindex]{} FI;{} FOR i FROM 1 UPTO max artikel REP{} kaeufe [i] INCR aktuelle daten.einkaeufe [kundenindex][i];{} IF hilfsdatei [i].artikelname = ""{} THEN hilfsdatei [i] := aktuelle daten.waren [i]{} FI{} PER.{} werte zentralliste aus:{} forget (ds);{} forget ("Auskunft: Zentrale", quiet);{} + f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} IF aktueller kunde.nachname = ""{} THEN write (f, " Ein Kunde mit Nr. " + text (kundenindex){} + " ist in keiner Filiale bekannt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3);{} ELSE write (f, " Gesamteinkaufsliste " + anrede{} + invers (aktueller kundenname) + ":");{} + fuelle (f, hilfsdatei, kaeufe){} FI.{} anrede:{} IF aktueller kunde.geschlecht = "m"{} THEN "des Kunden "{} ELIF aktueller kunde.geschlecht = "w"{} THEN "der Kundin "{} ELSE "von "{} FI.{} aktueller kundenname:{} (aktueller kunde.vorname SUB 1) + ". " + aktueller kunde.nachname.{}END PROC kundeneinkaufsliste von zentrale;{}PROC kundeneinkaufsliste von filiale (INT CONST kundennummer, FILE VAR f):{} pruefe kundennummer;{} erstelle filialliste.{} + pruefe kundennummer:{} INT CONST kundenindex :: kundennummer - min kundennr + 1;{} IF kundenindex < 1 OR kundenindex > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} erstelle filialliste:{} forget ("Auskunft: Filiale " + filialnummer, quiet);{} f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} line (f);{} IF kunde [kundenindex].nachname = ""{} THEN schicke leere liste zurueck{} ELSE schreibe dateikopf;{} fuelle (f, artikel, einkaufsdatei [kundenindex]){} + FI.{} schicke leere liste zurueck:{} write (f," Ein Kunde mit Nr. " + text (kundennummer) + " ist in "{} + "dieser Filiale nicht bekannt.");{} line (f);{} write (f,{} " ============================================================");{} line (f,3).{} schreibe dateikopf:{} write (f, " Einkaufsliste " + anrede +{} invers ((kunde [kundenindex].vorname SUB 1) + ". " +{} kunde [kundenindex].nachname) + ":").{} anrede:{} IF kunde [kundenindex].geschlecht = "m"{} + THEN "des Kunden "{} ELIF kunde [kundenindex].geschlecht = "w"{} THEN "der Kundin "{} ELSE "von "{} FI.{}END PROC kundeneinkaufsliste von filiale;{}PROC kundeneinkaufslisten aller filialen (INT CONST kundennummer,FILE VAR f):{} INT VAR filialnr;{} pruefe kundennummer;{} bereite datei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr = int (filialnummer){} + THEN schreibe eigene daten in auskunftsdatei{} ELIF exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in auskunftsdatei{} FI{} PER;{} forget (ds).{} pruefe kundennummer:{} INT CONST kundenindex :: kundennummer - min kundennr + 1;{} IF kundenindex < 1 OR kundenindex > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} bereite datei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen");{} + line (f).{} schreibe eigene daten in auskunftsdatei:{} IF kunde [kundenindex].nachname = ""{} THEN write (f," Ein Kunde mit Nr. " + text (kundennummer){} + " ist in " + invers ("Filiale " + filialnummer){} + " nicht bekannt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3){} ELSE write (f, " Einkaufsliste " + anrede hier +{} (kunde [kundenindex].vorname SUB 1) + ". " +{} + kunde [kundenindex].nachname +{} " in " + invers ("Filiale " + filialnummer) + ":");{} fuelle (f, artikel, einkaufsdatei [kundenindex]){} FI.{} anrede hier:{} IF kunde [kundenindex].geschlecht = "m"{} THEN "des Kunden "{} ELIF kunde [kundenindex].geschlecht = "w"{} THEN "der Kundin "{} ELSE "von "{} FI.{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} + BOUND FILIALDATEN VAR aktuelle daten :: ds;{} KUNDENDATEN CONST aktueller kunde := aktuelle daten.kunden [kundenindex].{} schreibe daten in auskunftsdatei:{} IF aktueller kunde.nachname = ""{} THEN write (f," Ein Kunde mit Nr. " + text (kundennummer){} + " ist in " + invers ("Filiale " + text (filialnr)){} + " nicht bekannt.");{} line (f);{} write(f,{} " ============================================================");{} + line (f,3){} ELSE write (f, " Einkaufsliste " + anrede +{} (aktueller kunde.vorname SUB 1) + ". " +{} aktueller kunde.nachname +{} " in " + invers ("Filiale " + text (filialnr)) + ":");{} fuelle (f, aktuelle daten.waren,{} aktuelle daten.einkaeufe [kundenindex]){} FI.{} anrede:{} IF aktueller kunde.geschlecht = "m"{} THEN "des Kunden "{} ELIF aktueller kunde.geschlecht = "w"{} + THEN "der Kundin "{} ELSE "von "{} FI.{}END PROC kundeneinkaufslisten aller filialen;{}PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei,{} ROW max artikel INT CONST einkaufszahlen):{} INT VAR artikelnummer;{} REAL VAR gesamtpreis, summe :: 0.0;{} bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} line (f,2);{} write(f," | Art.Nr.| Artikelname | Anzahl | Preis | Gesamt |");{} + line (f);{} write(f," +--------+-------------------+--------+---------+----------+");{} line (f).{}schreibe daten in datei:{} FOR artikelnummer FROM 1 UPTO max artikel REP{} IF einkaufszahlen [artikelnummer] > 0{} THEN schreibe in datei; line (f){} FI{} PER;{} write(f," +--------+-------------------+--------+---------+----------+");{} line (f);{} write(f," Summe: " +{} text (summe,8,2));{} + line (f, 3).{}schreibe in datei:{} gesamtpreis := real (einkaufszahlen [artikelnummer]) *{} warendatei [artikelnummer].preis;{} summe INCR gesamtpreis;{} write (f," |" + text(artikelnummer,5) + " | "{} + text(warendatei [artikelnummer].artikelname,17) + " | "{} + text(einkaufszahlen [artikelnummer],4) + " |"{} + text(warendatei [artikelnummer].preis,7,2) + " |"{} + text(gesamtpreis,8,2) + " |").{} +END PROC fuelle;{}PROC lageruebersicht von zentrale (FILE VAR f):{} INT VAR filialnr;{} beginne mit eigener filiale;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr <> int (filialnummer) CAND{} exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in zentralliste{} FI{} PER;{} werte zentralliste aus.{} beginne mit eigener filiale:{} + WARENDATEI VAR hilfsdatei;{} CONCR (hilfsdatei) := CONCR (artikel).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{} schreibe daten in zentralliste:{} BOUND FILIALDATEN VAR aktuelle daten :: ds;{} INT VAR i;{} FOR i FROM 1 UPTO max artikel REP{} IF hilfsdatei [i].artikelname = ""{} THEN hilfsdatei [i] := aktuelle daten.waren [i]{} ELSE hilfsdatei [i].mindestbestand INCR aktuell.mindestbestand;{} + hilfsdatei [i].bestand INCR aktuell.bestand{} FI{} PER.{} aktuell: aktuelle daten.waren [i].{} werte zentralliste aus:{} forget (ds);{} forget ("Auskunft: Zentrale", quiet);{} f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} write (f, " Zentrale Lagerübersicht:");{} fuelle (f, hilfsdatei).{}END PROC lageruebersicht von zentrale;{}PROC lageruebersicht von filiale (FILE VAR f):{} forget ("Auskunft: Filiale " + filialnummer, quiet);{} + f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} schreibe dateikopf;{} fuelle (f, artikel).{} schreibe dateikopf:{} line (f);{} write (f, " Lagerübersicht:").{}END PROC lageruebersicht von filiale;{}PROC lageruebersichten aller filialen (FILE VAR f):{} INT VAR filialnr;{} bereite datei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr = int (filialnummer){} + THEN schreibe eigene daten in auskunftsdatei{} ELIF exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in auskunftsdatei{} FI{} PER;{} forget (ds).{} bereite datei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen").{} schreibe eigene daten in auskunftsdatei:{} line (f);{} write (f, " Lagerübersicht für " +{} invers ("Filiale " + filialnummer) + ":");{} + fuelle (f, artikel).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} BOUND FILIALDATEN VAR aktuelle daten :: ds.{} schreibe daten in auskunftsdatei:{} line (f);{} write (f, " Lagerübersicht für " +{} invers ("Filiale " + text (filialnr)) + ":");{} fuelle (f, aktuelle daten.waren).{}END PROC lageruebersichten aller filialen;{}PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei):{} INT VAR artikelnummer;{} + bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} line (f,2);{} write(f," | Art.Nr.| Artikelname | Preis | Min.Best.| Bestand |");{} line (f);{} write(f," +--------+-------------------+--------+----------+---------+");{} line (f).{}schreibe daten in datei:{} FOR artikelnummer FROM 1 UPTO max artikel REP{} IF warendatei[artikelnummer].artikelname <> ""{} THEN schreibe in datei; line (f){} + FI{} PER;{} write(f," +--------+-------------------+--------+----------+---------+");{} line (f, 3).{}schreibe in datei:{} write (f, " |" + text(artikelnummer,5) + " | "{} + text(warendatei[artikelnummer].artikelname,17) + " |"{} + text(warendatei[artikelnummer].preis,7,2) + " | "{} + text(warendatei[artikelnummer].mindestbestand,6)+" | "{} + text(warendatei[artikelnummer].bestand,6) + " |").{}END PROC fuelle;{} +PROC initialisiere dateien:{} INT VAR kundennummer, artikelnummer;{} FOR kundennummer FROM 1 UPTO max kunden REP{} kunde [kundennummer].nachname := "";{} kunde [kundennummer].vorname := "";{} kunde [kundennummer].geschlecht := ""{} PER;{} FOR artikelnummer FROM 1 UPTO max artikel REP{} verkaufszahl [artikelnummer] := 0;{} artikel [artikelnummer].mindestbestand := 0;{} artikel [artikelnummer].bestand := 0;{} artikel [artikelnummer].artikelname := "";{} + artikel [artikelnummer].preis := 0.0;{} FOR kundennummer FROM 1 UPTO max kunden REP{} einkaufsdatei[kundennummer][artikelnummer] := 0{} PER;{} PER{}END PROC initialisiere dateien;{}initialisiere dateien{}END PACKET ls warenhaus 2{} + diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 3 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 3 new file mode 100644 index 0000000..3473e0f --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 3 @@ -0,0 +1,82 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 3 ** + ** ** + ** Version 1.01 ** + ** ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET ls warenhaus 3 DEFINES + artikelnummer lesen,{} artikeldaten eingeben,{} kundennummer lesen,{} kundendaten eingeben,{} neues blatt,{} rechnungskopf,{} artikel kaufen,{} abrechnung,{} nachbestellen,{} auskunft,{} stoptaste gedrueckt,{} stoptaste gedrückt,{} dezimalwert lesen,{} bitmuster lesen,{} bildschirm neu,{}(* ------------------------------ *){} tastatureingabe,{} eingabesicherheit,{} eingabe mit codekartenleser,{} + cursor w3 1 1:{}LET esc = ""27"",{} stopzeichen = "q",{} abbruchzeichen = "h";{}WINDOW VAR w1 :: window (43, 3, 36, 16),{} w2 :: window (43, 20, 36, 3),{} w3k :: window ( 2, 4, 40, 3),{} w3 :: window ( 2, 7, 40, 16),{} w4 :: window ( 8, 4, 66, 18);{}BOOL VAR ende gewuenscht := FALSE,{} artikelnummer ist eingelesen := FALSE,{} kundennummer ist eingelesen := FALSE,{} codekartenleser aktiviert := FALSE,{} + auf neuem blatt := TRUE;{}INT VAR artikelnummer :: 0,{} mindestbestand :: 0,{} bestand :: 0,{} kundennummer :: 0,{} sicherheit :: 5;{}TEXT VAR artikelname :: "",{} nachname :: "",{} vorname :: "",{} geschlecht :: "",{} ueberschrift :: " RECHNUNG",{} hilfstext, exit char;{}REAL VAR preis :: 0.0,{} summe :: 0.0;{}PROC eingabesicherheit (INT CONST wert):{} + sicherheit := abs (wert){}END PROC eingabesicherheit;{}PROC cursor w3 1 1:{} cursor (w1, 1, 1);{} cursor (w2, 1, 1);{} cursor (w3, 1, 1);{} cursor (w3k, 1, 1);{} forget ("WARENHAUS:Rechnung", quiet);{} setze variable in anfangszustand{}END PROC cursor w3 1 1;{}PROC setze variable in anfangszustand:{} ende gewuenscht := FALSE;{} artikelnummer ist eingelesen := FALSE;{} kundennummer ist eingelesen := FALSE;{} artikelnummer := 0;{} mindestbestand := 0;{} bestand := 0;{} + kundennummer := 0;{} artikelname := "";{} nachname := "";{} vorname := "";{} geschlecht := "";{} ueberschrift := " RECHNUNG";{} preis := 0.0;{} summe := 0.0{}END PROC setze variable in anfangszustand;{}PROC bildschirm neu:{} cursor off;{} pruefe abbruch;{} cursor (w1, 1, 1);{} cursor (w2, 1, 1);{} cursor (w3, 1, 1);{} cursor (w3k,1, 1);{} auf neuem blatt := TRUE;{} page;{} out ("WARENHAUS: Info Eingabeart Kommandos "15"Programme "14" " +{} + "Filialdaten Archiv"); line;{} out (ecke oben links + (40 * waagerecht) + balken oben{} + (36 * waagerecht) + ecke oben rechts);{} INT VAR zeile;{} FOR zeile FROM 3 UPTO 22 REP{} cursor ( 1, zeile); out (senkrecht);{} cursor (42, zeile); out (senkrecht);{} cursor (79, zeile); out (senkrecht){} PER;{} cursor (1, 23);{} out (ecke unten links + (40 * waagerecht) + balken unten{} + (36 * waagerecht) + ecke unten rechts);{} + cursor (42, 19);{} out (balken links + (36 * waagerecht) + balken rechts);{} cursor (2, 24);{} out ("Programmabbruch: <" + abbruchzeichen + ">");{} cursor on{}END PROC bildschirm neu;{}PROC pruefe abbruch:{} IF pressed key = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} TEXT VAR naechstes zeichen :: pressed key (20);{} IF naechstes zeichen = stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF naechstes zeichen = abbruch zeichen{} + THEN setze variable in anfangszustand;{} cursor off;{} errorstop (1951, "Programm - Abbruch durch <"{} + abbruchzeichen + ">"){} FI{}END PROC pruefe abbruch;{}PROC regeneriere w2:{} cursor (42, 19);{} out (ecke oben links + (36 * waagerecht));{} INT VAR zeile;{} FOR zeile FROM 20 UPTO 22 REP{} cursor (42, zeile); out (senkrecht);{} PER;{} cursor (42, 23); out (balken unten);{} page (w2){} +END PROC regeneriere w2;{}PROC fenster putzen:{} page (w1);{} page (w2){}END PROC fenster putzen;{}PROC lies nummer ein (INT VAR nummer):{} line (w2, 2);{} out (w2, " Stoptaste: <" + stopzeichen + ">");{} hilfstext := text (nummer);{} REP cursor (w1, 19, 2);{} editget (w1, hilfstext, 4, 4, "", stopzeichen + abbruchzeichen,{} exit char);{} pruefe exit char;{} change all (hilfstext, " ", ""){} UNTIL hilfstext >= "0" AND hilfstext <= "9999" PER;{} + nummer := int (hilfstext).{} pruefe exit char:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE;{} cursor off; fenster putzen; cursor on;{} nummer := 0;{} LEAVE lies nummer ein{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Progamm - Abbruch durch <"{} + abbruchzeichen + ">"){} ELSE ende gewuenscht := FALSE{} FI.{} +END PROC lies nummer ein;{}PROC lies artikelnummer ein:{} page (w2);{} cursor (w1, 2, 2);{} out (w1, "Artikelnummer : ");{} IF codekartenleser aktiviert{} THEN artikelnummer := gesicherter wert von interface{} (min artikelnummer , max artikelnummer, "Warenkarte"){} ELSE artikelnummer von tastatur lesen{} FI;{} IF ende gewuenscht{} THEN artikelnummer ist eingelesen := FALSE{} ELSE artikelnummer ist eingelesen := TRUE{} + FI.{} artikelnummer von tastatur lesen:{} cursor on;{} REP out (w2, " Artikelnummer eingeben");{} lies nummer ein (artikelnummer);{} UNTIL ende gewuenscht COR artikelnummer zulaessig PER.{} artikelnummer zulaessig:{} IF (artikelnummer < min artikelnummer OR{} artikelnummer > max artikelnummer){} THEN page (w2); out (""7"");{} out (w2, " Unzulässige Artikelnummer!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} + pause; page (w2);{} FALSE{} ELSE TRUE{} FI.{}END PROC lies artikelnummer ein;{}PROC artikelnummer lesen:{} pruefe abbruch;{} lies artikelnummer ein;{} IF artikelnummer ist eingelesen{} THEN hole artikeldaten (artikelnummer, artikelname, preis,{} mindestbestand, bestand){} FI{}END PROC artikelnummer lesen;{}PROC kundennummer lesen:{} pruefe abbruch;{} lies kundennummer ein;{} IF kundennummer ist eingelesen{} THEN hole kundendaten (kundennummer, nachname, vorname, geschlecht){} + FI{}END PROC kundennummer lesen;{}PROC lies kundennummer ein:{} page (w2);{} cursor (w1, 2, 2);{} out (w1, "Kundennummer : ");{} IF codekartenleser aktiviert{} THEN kundennummer := gesicherter wert von interface{} (min kundennummer , max kundennummer, "Kundenkarte"){} ELSE kundennummer von tastatur lesen{} FI;{} IF ende gewuenscht{} THEN kundennummer ist eingelesen := FALSE{} ELSE kundennummer ist eingelesen := TRUE{} FI.{} kundennummer von tastatur lesen:{} + cursor on;{} REP out (w2, " Kundennummer eingeben");{} lies nummer ein (kundennummer){} UNTIL ende gewuenscht COR kundennummer zulaessig PER.{} kundennummer zulaessig:{} IF (kundennummer < min kundennummer OR{} kundennummer > max kundennummer){} THEN page (w2); out (""7"");{} out (w2, " Unzulässige Kundennummer!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} pause; page (w2);{} FALSE{} + ELSE TRUE{} FI.{}END PROC lies kundennummer ein;{}PROC zeige artikeldaten:{} cursor (w1, 2, 6);{} out (w1, "Artikelname : " + text (artikelname, 16));{} cursor (w1, 2, 8);{} out (w1, "Preis : " + text preis + " ");{} cursor (w1, 2, 10);{} out (w1, "Mindestbestand : " + text (mindestbestand) + " ");{} cursor (w1, 2, 12);{} out (w1, "Bestand : " + text (bestand) + " ").{} text preis:{} TEXT VAR hilfe :: text (preis, min (8, pos(text(preis),".")+2), 2);{} + change (hilfe, " ", "0");{} hilfe.{}END PROC zeige artikeldaten;{}PROC zeige kundendaten:{} cursor (w1, 2, 6);{} out (w1, "Nachname : " + text (nachname, 16));{} cursor (w1, 2, 8);{} out (w1, "Vorname : " + text (vorname , 16));{} cursor (w1, 2, 10);{} out (w1, "Geschlecht : " + geschlecht + " ");{}END PROC zeige kundendaten;{}PROC artikeldaten speichern:{} pruefe abbruch;{} page (w2); line (w2);{} out (w2, " Artikeldaten werden gespeichert") ;{} + speichere artikeldaten (artikelnummer, artikelname, preis,{} mindestbestand, bestand);{} pause (10);{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI{}END PROC artikeldaten speichern;{}PROC kundendaten speichern:{} pruefe abbruch;{} page (w2); line (w2);{} out (w2, " Kundendaten werden gespeichert") ;{} speichere kundendaten (kundennummer, nachname,vorname, geschlecht);{} pause (10);{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} + FI{}END PROC kundendaten speichern;{}BOOL PROC stoptaste gedrueckt:{} pruefe abbruch;{} ende gewuenscht{}END PROC stoptaste gedrueckt;{}BOOL PROC stoptaste gedrückt:{} stoptaste gedrueckt{}END PROC stoptaste gedrückt;{}PROC neues blatt:{} pruefe abbruch;{} page (w3k);{} page (w3);{} auf neuem blatt := TRUE;{} forget ("WARENHAUS:Rechnung", quiet){}END PROC neues blatt;{}PROC nachbestellen:{} pruefe abbruch;{} FILE VAR f;{} warten in w2;{} hole bestelliste (f);{} pruefe abbruch;{} cursor (2,24);{} + out ("Weiter mit ; Cursor bewegen: ");{} cursor on;{} show (w4, f);{} cursor off;{} cursor (1, 24); out (""5"");{} WINDOW VAR w :: window(45,18,25,3);{} outframe (w);{} IF yes (w, "Bestelliste drucken", FALSE){} THEN drucke (headline (f)){} FI;{} cursor on;{} forget (headline (f), quiet){}END PROC nachbestellen;{}PROC warten in w2:{} cursor off;{} page (w2);{} line (w2);{} out (w2, " Bitte warten!");{} cursor on{}END PROC warten in w2;{}PROC codenummer von tastatur lesen (INT VAR codenummer):{} + codenummer := 0;{} out (w2, " Codenummer eingeben");{} cursor on;{} lies nummer ein (codenummer){}END PROC codenummer von tastatur lesen;{}PROC auskunft:{} pruefe abbruch;{} FILE VAR f;{} INT VAR codenummer :: 0;{} cursor (w1, 2, 2);{} out (w1, "Codenummer : ");{} page (w2);{} IF codekartenleser aktiviert{} THEN codenummer := gesicherter wert von interface (0,254, "Codekarte");{} lasse karte entfernen (FALSE){} ELSE codenummer von tastatur lesen (codenummer){} + FI;{} IF ende gewuenscht THEN LEAVE auskunft FI;{} SELECT codenummer OF CASE 66, 67, 68 : hitliste{} CASE 73, 74, 75 : kaeuferliste{} CASE 77, 78, 79 : kundenliste{} CASE 84, 85, 86 : einkaufsliste{} CASE 89, 90, 91 : lageruebersicht{} OTHERWISE teste auf artikel oder kundennummer{} END SELECT;{} IF codekartenleser aktiviert CAND wert von interface <> 255{} THEN karte entfernen{} FI.{} karte entfernen:{} + SELECT codenummer OF{} CASE 66, 67, 68, 73, 74, 75, 77, 78, 79, 84, 85, 86, 89, 90,{} 91: lasse karte entfernen (TRUE){} OTHERWISE lasse karte entfernen (FALSE){} END SELECT.{} teste auf artikel oder kundennummer:{} IF codenummer >= min artikelnummer AND codenummer <= max artikelnummer{} THEN gib auskunft ueber artikeldaten{} ELIF codenummer >= min kundennummer AND codenummer <= max kundennummer{} THEN gib auskunft ueber kundendaten{} ELSE unzulaessige codenummer{} + FI.{} unzulaessige codenummer:{} out (10 * ""7"");{} page (w2);{} out (w2, " Unzulässige Codenummer !!!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} pause;{} page (w2).{} gib auskunft ueber artikeldaten:{} hole artikeldaten (codenummer, artikelname, preis,{} mindestbestand, bestand);{} zeige artikeldaten;{} artikelnummer ist eingelesen := FALSE;{} stop w2;{} page (w1).{} gib auskunft ueber kundendaten:{} hole kundendaten (codenummer, nachname, vorname, geschlecht);{} + zeige kundendaten;{} kundennummer ist eingelesen := FALSE;{} stop w2;{} page (w1).{} hitliste:{} warten in w2;{} hole auskunft ein (codenummer, 0, f);{} zeige f.{} kundenliste:{} warten in w2;{} hole auskunft ein (codenummer, 0, f);{} zeige f.{} zeige f:{} pruefe abbruch;{} cursor (2, 24);{} out ("Weiter mit ; Cursor bewegen: ");{} show (w4, f);{} cursor (1, 24); out (""5"");{} evtl drucken.{} lageruebersicht:{} warten in w2;{} + hole auskunft ein (codenummer, 0, f);{} zeige f.{} kaeuferliste:{} lies artikelnummer ein;{} IF artikelnummer ist eingelesen{} THEN artikelnummer ist eingelesen := FALSE;{} warten in w2;{} hole auskunft ein (codenummer, artikelnummer, f);{} zeige f{} FI.{} einkaufsliste:{} lies kundennummer ein;{} IF kundennummer ist eingelesen{} THEN kundennummer ist eingelesen := FALSE;{} warten in w2;{} hole auskunft ein (codenummer, kundennummer, f);{} + zeige f{} FI.{} evtl drucken:{} WINDOW VAR w :: window(46,18,22,3);{} cursor off;{} outframe (w);{} IF yes (w, "Auskunft drucken", FALSE){} THEN drucke (headline (f)){} FI;{} cursor on;{} forget (headline (f), quiet).{}END PROC auskunft;{}PROC rechnungskopf:{} pruefe abbruch;{} IF kundennummer ist eingelesen AND nachname <> ""{} THEN ueberschrift := " RECHNUNG für " + anrede + (vorname SUB 1) +{} ". " + text (nachname, 10){} ELSE ueberschrift := " RECHNUNG"{} + FI;{} summe := 0.0;{} schreibe ueberschrift auf bildschirm;{} schreibe in rechnungsdatei;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} schreibe in rechnungsdatei:{} sysout ("WARENHAUS:Rechnung");{} line;{} put (ueberschrift);{} line;{} put (" ==================================");{} line (2);{} sysout ("").{} anrede:{} IF geschlecht = "m"{} THEN "Herrn "{} ELIF geschlecht = "w"{} THEN "Frau "{} ELSE ""{} + FI.{}END PROC rechnungskopf;{}PROC schreibe ueberschrift auf bildschirm:{} INT VAR spalte, zeile;{} get cursor (w3, spalte, zeile);{} IF zeile = 1{} THEN auf neuem blatt := TRUE;{} schreibe in w3k{} ELSE auf neuem blatt := FALSE;{} schreibe in w3{} FI.{} schreibe in w3:{} IF remaining lines (w3) < 7{} THEN page (w3);{} page (w3k);{} auf neuem blatt := TRUE;{} schreibe in w3k{} ELSE line (w3);{} out (w3, ueberschrift);{} + line (w3);{} out (w3, " ==================================");{} line (w3, 2){} FI.{} schreibe in w3k:{} out (w3k, ueberschrift);{} line (w3k);{} out (w3k, " ==================================").{}END PROC schreibe ueberschrift auf bildschirm;{}PROC artikel kaufen:{} pruefe abbruch;{} IF artikelnummer ist eingelesen{} THEN kauf registrieren{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Artikelnummer eingelesen worden!"){} + FI;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} kauf registrieren:{} artikelnummer ist eingelesen := FALSE;{} IF bestand > 0{} THEN artikel auf rechnung setzen;{} registrieren{} ELSE page (w2); out (""7"");{} IF artikelname = ""{} THEN out (w2, " Artikel hier nicht erhältlich!"){} ELSE out (w2, " Der Artikel ist ausverkauft!"){} FI;{} line (w2, 2);{} out (w2, " Weiter durch Tippen einer Taste");{} + pause{} FI.{} registrieren:{} IF kundennummer ist eingelesen{} THEN registriere verkauf (kundennummer, artikelnummer){} ELSE registriere verkauf (min kundennummer - 1, artikelnummer){} FI.{} artikel auf rechnung setzen:{} summe INCR preis;{} IF remaining lines (w3) < 3{} THEN beginne wieder oben{} FI;{} out (w3, " " + text (artikelname, 15) + text (preis, 12, 2));{} line (w3);{} sysout ("WARENHAUS:Rechnung");{} put (" " + text (artikelname, 15) + text preis);{} + line;{} sysout ("").{} beginne wieder oben:{} IF auf neuem blatt{} THEN page (w3){} ELSE schreibe ueberschrift auf bildschirm{} FI.{} text preis:{} TEXT VAR hilfe :: text (preis, 12, 2);{} INT VAR vor punkt :: pos (hilfe, ".") - 1;{} IF (hilfe SUB vor punkt) = " "{} THEN change (hilfe, vor punkt, vor punkt, "0"){} FI;{} hilfe.{}END PROC artikel kaufen;{}PROC abrechnung:{} pruefe abbruch;{} schreibe summe auf bildschirm;{} + schreibe summe in rechnungsdatei;{} setze variable zurueck;{} frage ob drucken;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} schreibe summe auf bildschirm:{} IF remaining lines (w3) < 2{} THEN beginne wieder oben{} FI;{} put (w3, " -------------");{} line (w3);{} put (w3, " Summe " + text (summe, 12, 2));{} line (w3).{} beginne wieder oben:{} IF auf neuem blatt{} THEN page (w3){} ELSE schreibe ueberschrift auf bildschirm{} + FI.{} schreibe summe in rechnungsdatei:{} sysout ("WARENHAUS:Rechnung");{} put (" -------------");{} line;{} put (" Summe " + text (summe, 12, 2));{} line;{} sysout ("").{} setze variable zurueck:{} BOOL VAR alter wert :: ende gewuenscht;{} setze variable in anfangszustand;{} ende gewuenscht := alter wert.{} frage ob drucken:{} IF yes (w2, "Rechnung drucken", FALSE){} THEN cursor (3, 22);{} disable stop;{} print ("WARENHAUS:Rechnung");{} + IF is error THEN clear error FI;{} enable stop{} FI.{}END PROC abrechnung;{}PROC artikeldaten eingeben:{} pruefe abbruch;{} IF artikelnummer ist eingelesen{} THEN lies artikeldaten ein;{} artikeldaten speichern{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Artikelnummer eingelesen worden!"){} FI.{} lies artikeldaten ein:{} zeige artikeldaten;{} IF artikelname <> ""{} THEN vielleicht schon fertig{} ELSE page (w2){} + FI;{} REP line (w2);{} put (w2, " Artikeldaten eingeben");{} eingabe{} UNTIL yes (w2, "Alles richtig", TRUE){} PER;{} artikelnummer ist eingelesen := FALSE.{} vielleicht schon fertig:{} IF yes (w2, "Alles richtig", TRUE){} THEN artikelnummer ist eingelesen := FALSE;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI;{} LEAVE artikeldaten eingeben{} FI.{} eingabe:{} name holen;{} + preis holen;{} mindestbestand holen;{} bestand holen.{} name holen:{} REP cursor (w1, 19, 6);{} editget (w1, artikelname, 80, 80, "", abbruchzeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL artikelname <> "" PER.{} preis holen:{} hilfstext := text (preis, pos(text(preis),".") + 2, 2);{} change (hilfstext, " ", "0");{} REP cursor (w1, 19, 8);{} editget (w1, hilfstext, 8, 8, "", abbruch zeichen + stopzeichen,{} + exit char);{} change (hilfstext, ",", ".");{} preis := round (real (hilfstext), 2);{} teste auf abbruch{} UNTIL preis >= 0.0 PER.{} mindestbestand holen:{} hilfstext := text (mindestbestand);{} REP cursor (w1, 19, 10);{} editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,{} exit char);{} mindestbestand := int (hilfstext);{} teste auf abbruch{} UNTIL mindestbestand >= 0 PER.{} + bestand holen:{} hilfstext := text (bestand);{} REP cursor (w1, 19, 12);{} editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,{} exit char);{} bestand := int (hilfstext);{} teste auf abbruch{} UNTIL bestand >= 0 PER.{} teste auf abbruch:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Programm - Abbruch durch <"{} + + abbruchzeichen + ">"){} FI.{}END PROC artikeldaten eingeben;{}PROC kundendaten eingeben:{} IF kundennummer ist eingelesen{} THEN lies kundendaten ein;{} kundendaten speichern{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Kundennummer eingelesen worden!"){} FI.{} lies kundendaten ein:{} zeige kundendaten;{} IF nachname <> ""{} THEN vielleicht schon fertig{} ELSE page (w2){} FI;{} REP line (w2);{} + put (w2, " Kundendaten eingeben");{} eingabe{} UNTIL yes (w2, "Alles richtig", TRUE) PER;{} kundennummer ist eingelesen := FALSE.{} vielleicht schon fertig:{} IF yes (w2, "Alles richtig", TRUE){} THEN kundennummer ist eingelesen := FALSE;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI;{} LEAVE kundendaten eingeben{} FI.{} eingabe:{} nachname holen;{} vorname holen;{} geschlecht holen.{} + nachname holen:{} REP cursor (w1, 19, 6);{} editget (w1, nachname, 80, 80, "", abbruch zeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL nachname <> "" PER.{} vorname holen:{} REP cursor (w1, 19, 8);{} editget (w1, vorname, 80, 80, "", abbruch zeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL vorname <> "" PER.{} geschlecht holen:{} REP cursor (w1, 19, 10);{} + editget (w1, geschlecht, 9, 9, "", abbruchzeichen + stopzeichen,{} exit char);{} geschlecht := geschlecht SUB 1;{} teste auf abbruch{} UNTIL geschlecht = "m" OR geschlecht = "w" PER.{} teste auf abbruch:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Programm - Abbruch durch <"{} + + abbruchzeichen + ">"){} FI.{}END PROC kundendaten eingeben;{}PROC drucke (TEXT CONST name):{} TEXT VAR zeile;{} FILE VAR f :: sequential file (modify, name);{} to line (f, 1);{} insert record (f);{} write record (f, "#center#" + name);{} down (f);{} insert record (f);{} down (f);{} WHILE NOT eof (f) REP{} read record (f, zeile);{} IF pos (zeile, ""15"") > 0{} THEN change (zeile, ""15"", "#on(""r"")#");{} change (zeile, ""14"", "#off(""r"")#");{} + write record (f, zeile){} FI;{} down (f){} PER;{} cursor (3, 22);{} print (name){}END PROC drucke;{}PROC stop w2:{} cursor off;{} page (w2);{} out (w2," Zum Weitermachen bitte");line(w2);{} out (w2," irgendeine Taste tippen!");{} pause;{} page (w2);{} cursor on{}END PROC stop w2;{}BOOL PROC yes (WINDOW VAR w, TEXT CONST frage, BOOL CONST default):{} BOOL VAR antwort :: default;{} TEXT VAR taste;{} INT CONST ja pos :: (areaxsize (w) - 9) DIV 2;{} cursor off;{} cursor (42,24); out ("Ändern: Bestätigen: ");{} + page (w);{} out (w, center (w, frage + " ?"));{} cursor (w, ja pos, 3);{} IF default{} THEN out (w, ""15"Ja "14" Nein ");{} cursor (w, ja pos, 3){} ELSE out (w, " Ja "15"Nein "14"");{} cursor (w, ja pos + 5, 3){} FI;{} tastendruck auswerten;{} page (w);{} cursor (42,24); out (""5"");{} cursor on;{} antwort.{} tastendruck auswerten:{} REP inchar (taste);{} SELECT code (taste) OF CASE 2, 8 : position aendern{} CASE 13 : LEAVE tastendruck auswerten{} + CASE 74, 106 : antwort := TRUE; (*Jj*){} LEAVE tastendruck auswerten{} CASE 78, 110 : antwort := FALSE; (*Nn*){} LEAVE tastendruck auswerten{} OTHERWISE out (""7"") END SELECT{} PER.{} position aendern:{} IF antwort THEN antwort := FALSE;{} cursor (w, ja pos, 3);{} out (w, " Ja "15"Nein "14"");{} + cursor (w, ja pos + 5, 3){} ELSE antwort := TRUE;{} cursor (w, ja pos, 3);{} out (w, ""15"Ja "14" Nein ");{} cursor (w, ja pos, 3){} FI.{}END PROC yes;{}PROC tastatureingabe (BOOL CONST erwuenscht, INT VAR rueckmeldung):{} IF erwuenscht{} THEN rueckmeldung := 0;{} codekartenleser aktiviert := FALSE;{} schliesse interface{} ELSE oeffne interface (rueckmeldung);{} IF rueckmeldung >= 0{} + THEN codekartenleser aktiviert := TRUE{} ELSE codekartenleser aktiviert := FALSE{} FI{} FI{}END PROC tastatureingabe;{}BOOL PROC eingabe mit codekartenleser:{} codekartenleser aktiviert{}END PROC eingabe mit codekartenleser;{}PROC dezimalwert lesen:{} pruefe abbruch;{} IF codekartenleser aktiviert{} THEN interfacewerte zeigen{} ELSE setze variable in anfangszustand;{} errorstop ("Eingabeart ist auf Tastatur eingestellt!"){} FI.{} interfacewerte zeigen:{} + cursor off;{} fenster putzen;{} line (w1, 4); line (w2);{} out (w1, " Dezimalwert :");{} out (w2, " Lesen beenden mit ");{} ende gewuenscht := FALSE;{} REP pruefe abbruch;{} cursor (w1, 17, 5);{} out (w1, text (wert von interface, 3)){} UNTIL ende gewuenscht PER;{} page (w2); cursor (w1, 1, 5); out (" ");{} cursor on.{}END PROC dezimalwert lesen;{}PROC bitmuster lesen:{} pruefe abbruch;{} IF codekartenleser aktiviert{} + THEN interfacewerte zeigen{} ELSE setze variable in anfangszustand;{} errorstop ("Eingabeart ist auf Tastatur eingestellt!"){} FI.{} interfacewerte zeigen:{} cursor off;{} fenster putzen;{} line (w1, 4); line (w2);{} out (w1, " Bitmuster :");{} out (w2, " Lesen beenden mit ");{} ende gewuenscht := FALSE;{} REP pruefe abbruch;{} cursor (w1, 16, 5);{} out (w1, bitmuster (wert von interface)){} UNTIL ende gewuenscht PER;{} page (w2); cursor (w1, 1, 5); out (" ");{} + cursor on.{}END PROC bitmuster lesen;{}TEXT PROC bitmuster (INT CONST wert):{} INT VAR bitnr;{} TEXT VAR muster :: "";{} FOR bitnr FROM 7 DOWNTO 0 REP{} IF bit (wert, bitnr){} THEN muster CAT "I"{} ELSE muster CAT "O"{} FI{} PER;{} muster{}END PROC bitmuster;{}PROC lasse karte entfernen (BOOL CONST mit rahmen):{} IF wert von interface <> 255{} THEN cursor off;{} IF mit rahmen THEN regeneriere w2 ELSE page (w2) FI;{} line (w2);{} out (w2, " Bitte Karte entfernen");{} + REP pruefe abbruch{} UNTIL (wert von interface = 255) OR ende gewuenscht PER;{} cursor on{} FI{}END PROC lasse karte entfernen;{}INT PROC gesicherter wert von interface (INT CONST von, bis,{} TEXT CONST kartenart):{} INT VAR wert, zaehler;{} ende gewuenscht := FALSE;{} cursor off;{} REP out (w2, " Bitte " + kartenart + " einschieben");{} line (w2, 2);{} out (w2, " Stoptaste: <" + stopzeichen + ">");{} cursor (79, 24);{} + gesicherten wert einlesen;{} cursor (w1, 19, 2);{} out (w1, text (wert, 3));{} IF wert < von OR wert > bis{} THEN warnung{} FI{} UNTIL wert >= von AND wert <= bis PER;{} cursor on;{} wert.{} gesicherten wert einlesen:{} REP zaehler := 0;{} warte auf karte;{} wert := wert von interface;{} lies wert{} UNTIL wert gesichert AND wert <> 255 PER.{} warte auf karte:{} REP beachte esc q{} UNTIL wert von interface <> 255 PER.{} beachte esc q:{} + pruefe abbruch;{} IF ende gewuenscht{} THEN cursor on;{} LEAVE gesicherter wert von interface WITH 0{} FI.{} lies wert:{} REP beachte esc q;{} IF wert = wert von interface{} THEN zaehler INCR 1{} ELSE LEAVE lies wert{} FI{} UNTIL wert gesichert PER.{} wert gesichert: zaehler = sicherheit.{} warnung:{} page (w2); out (""7"");{} out (w2, " Dies ist keine " + kartenart + "!");{} line (w2, 2);{} out (w2, " Bitte Karte entfernen");{} + REP beachte esc q{} UNTIL wert von interface = 255 PER;{} page (w2).{}END PROC gesicherter wert von interface{}END PACKET ls warenhaus 3{} + diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 4 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 4 new file mode 100644 index 0000000..a19a6d6 --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 4 @@ -0,0 +1,48 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 4 ** + ** ** + ** Version 1.01 ** + ** ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET ls warenhaus 4 DEFINES + uebersetze:{}TYPE VOKABEL = STRUCT (TEXT grin, elan),{} REFINEMENT = STRUCT (TEXT name, INT aufruf);{}LET befehlsanzahl = 10,{} max refinements = 20,{} max offene strukturen = 10,{} schleife = 1,{} abfrage = 2;{}ROW befehlsanzahl VOKABEL CONST befehl :: ROW befehlsanzahl VOKABEL :{} (VOKABEL : ("Artikelnummerlesen", "artikelnummer lesen"),{} VOKABEL : ("Artikeldateneingeben", "artikeldaten eingeben"),{} VOKABEL : ("Kundennummerlesen", "kundennummer lesen"),{}{} + VOKABEL : ("Kundendateneingeben", "kundendaten eingeben"),{} VOKABEL : ("Rechnungskopf", "rechnungskopf"),{} VOKABEL : ("Artikelkaufen", "artikel kaufen"),{} VOKABEL : ("Abrechnung", "abrechnung"),{} VOKABEL : ("Auskunft", "auskunft"),{} VOKABEL : ("neuesBlatt", "neues blatt"),{} VOKABEL : ("Bildschirmneu", "bildschirm neu"));{}ROW max refinements REFINEMENT VAR refinement;{}ROW max offene strukturen INT VAR offene struktur;{}{} +INT VAR zeilennummer, erster fehler;{}OP := (VOKABEL VAR links, VOKABEL CONST rechts):{} CONCR (links) := CONCR (rechts){}END OP :=;{}PROC uebersetze (TEXT CONST dateiname):{}forget ("elanprogramm", quiet);{}FILE VAR quelle :: sequential file (input, dateiname),{} ziel :: sequential file (output, "elanprogramm");{}suche programmanfang;{}WHILE NOT (eof (quelle) OR anything noted) REP{} bearbeite zeile{}PER;{}IF NOT anything noted{} THEN abschlusspruefung{}FI;{}IF anything noted{} THEN quelle := sequential file (modify, dateiname);{}{} + to line (quelle, erster fehler);{} col (1);{} noteedit (quelle);{} errorstop (""){}FI.{}abschlusspruefung:{} IF anzahl refinements > 0{} THEN pruefe refinementliste{} ELSE pruefe programmende{} FI.{}pruefe programmende:{} IF programmende fehlt{} THEN zeilennummer INCR 1;{} fehler (16){} FI.{}pruefe refinementliste:{} zeilennummer INCR 1;{} pruefe auf offene schleife oder abfrage;{} put (ziel, "END PROC refinement " + text (letztes refinement));{}{} + FOR index FROM 1 UPTO anzahl refinements REP{} IF refinement [index].aufruf > 0{} THEN zeilennummer := refinement [index].aufruf;{} fehler (25){} ELIF refinement [index].aufruf < 0{} THEN zeilennummer := - refinement [index].aufruf;{} fehler (26){} FI{} PER.{}suche programmanfang:{} TEXT VAR restzeile, zeile :: "";{} BOOL VAR programmende fehlt := FALSE,{} refinement muss folgen := FALSE;{} INT VAR anzahl refinements := 0,{} letztes refinement := 0,{}{} + letzte geoeffnete := 0,{} index;{} zeilennummer := 0;{} erster fehler := 0;{} WHILE NOT eof (quelle) AND zeile = "" REP{} getline (quelle, zeile);{} zeile := compress (zeile);{} zeilennummer INCR 1;{} cout (zeilennummer);{} IF zeile = "" THEN line (ziel) FI;{} PER;{} put (ziel, "bildschirm neu;");{} IF zeile = "" THEN LEAVE uebersetze{} ELIF pos (zeile, "PROGRAMM") = 1{} THEN programmende fehlt := TRUE{} ELSE fehler (1){} FI.{}bearbeite zeile:{}{} + zeilennummer INCR 1;{} cout (zeilennummer);{} getline (quelle, zeile);{} zeile := compress (zeile);{} change all (zeile, " ", "");{} IF zeile = ""{} THEN line (ziel){} ELSE analysiere und uebersetze{} FI.{}analysiere und uebersetze:{} IF refinement muss folgen{} THEN erstes refinement{} ELSE pruefe zunaechst auf schluesselworte;{} durchsuche befehlsliste{} FI.{}erstes refinement:{} IF pos (zeile, ":") = 0{} THEN fehler (19){} ELIF pos (zeile, ":") < length (zeile){}{} + THEN fehler (20){} ELIF (pos (zeile, "PROGRAMM") = 1) OR{} (pos (zeile, "ENDE") = 1) OR{} (pos (zeile, "WIEDERHOLE") = 1) OR{} (pos (zeile, "BIS") = 1) OR{} (pos (zeile, "WENN") = 1){} THEN fehler (21){} ELIF (zeile = "Stoptastegedrückt:") OR{} (zeile = "nichtStoptastegedrückt:") OR{} (zeile = "Stoptastegedrueckt:") OR{} (zeile = "nichtStoptastegedrueckt:"){} THEN fehler (22){} ELSE refinement muss folgen := FALSE;{}{} + line (ziel);{} trage befehlsdefinition ein{} FI.{}trage befehlsdefinition ein:{} change (zeile, ":", "");{} FOR index FROM 1 UPTO anzahl refinements REP{} IF refinement [index].name = zeile{} THEN pruefe aufruf; LEAVE trage befehlsdefinition ein{} FI{} PER;{} anzahl refinements INCR 1;{} IF anzahl refinements > max refinements{} THEN fehler (24){} ELSE refinement [anzahl refinements].name := zeile;{} refinement [anzahl refinements].aufruf := - zeilennummer;{}{} + letztes refinement := anzahl refinements;{} line (ziel);{} put (ziel, "PROC refinement " + text (anzahl refinements) + ":"){} FI.{}pruefe aufruf:{} IF refinement [index].aufruf > 0{} THEN refinement [index].aufruf := 0;{} line (ziel);{} put (ziel, "PROC refinement " + text (index) + ":");{} letztes refinement := index{} ELSE fehler (23){} FI.{}pruefe zunaechst auf schluesselworte:{} IF pos (zeile, "WIEDERHOLE") = 1{} THEN oeffne schleife; LEAVE analysiere und uebersetze{}{} + ELIF pos (zeile, "WENN") = 1{} THEN oeffne if; LEAVE analysiere und uebersetze{} ELIF pos (zeile, "BIS") = 1{} THEN schliesse mit until; LEAVE analysiere und uebersetze{} ELIF pos (zeile, "ENDE") = 1{} THEN schliesse; LEAVE analysiere und uebersetze{} ELIF pos (zeile, "PROGRAMM") = 1{} THEN fehler (18); LEAVE analysiere und uebersetze{} FI.{}oeffne schleife:{} IF letzte geoeffnete = max offene strukturen{} THEN fehler (2){} ELSE letzte geoeffnete INCR 1;{} offene struktur [letzte geoeffnete] := schleife;{}{} + analysiere schleifenart{} FI.{}analysiere schleifenart:{} IF zeile = "WIEDERHOLE"{} THEN line (ziel); put (ziel, "REPEAT"){} ELSE es muss eine zaehlschleife sein{} FI.{}es muss eine zaehlschleife sein:{} restzeile := subtext (zeile, 11);{} INT VAR malpos := pos (restzeile, "MAL");{} IF malpos > 0{} THEN zaehlschleife{} ELSE fehler (3){} FI.{}zaehlschleife:{} IF length (restzeile) > malpos + 2{} THEN fehler (4){} ELSE bestimme anzahl der wiederholungen{} FI.{}{} +bestimme anzahl der wiederholungen:{} INT VAR wdh := int (subtext (restzeile, 1, malpos - 1));{} IF last conversion ok{} THEN line (ziel);{} put (ziel, "INT VAR index" + text (zeilennummer) +{} "; FOR index" + text (zeilennummer) +{} " FROM 1 UPTO " + text (wdh) + " REPEAT"){} ELSE fehler (5){} FI.{}oeffne if:{} IF letzte geoeffnete = max offene strukturen{} THEN fehler (6){} ELSE letzte geoeffnete INCR 1;{} offene struktur [letzte geoeffnete] := abfrage;{}{} + uebersetze abfrage{} FI.{}uebersetze abfrage:{} restzeile := subtext (zeile, 5);{} IF (restzeile = "Stoptastegedrückt") OR{} (restzeile = "Stoptastegedrueckt"){} THEN line (ziel); put (ziel, "IF stoptaste gedrueckt THEN"){} ELIF (restzeile = "nichtStoptastegedrückt") OR{} (restzeile = "nichtStoptastegedrueckt"){} THEN line (ziel); put (ziel, "IF NOT stoptaste gedrueckt THEN"){} ELIF restzeile = ""{} THEN fehler (7){} ELSE fehler (8){} FI.{}schliesse mit until:{}{} + teste ob als letztes schleife offen;{} letzte geoeffnete DECR 1;{} restzeile := subtext (zeile, 4);{} IF (restzeile = "Stoptastegedrückt") OR{} (restzeile = "Stoptastegedrueckt"){} THEN line (ziel);{} put (ziel, "UNTIL stoptaste gedrueckt END REPEAT;");{} ELIF (restzeile = "nichtStoptastegedrückt") OR{} (restzeile = "nichtStoptastegedrueckt"){} THEN line (ziel);{} put (ziel, "UNTIL NOT stoptaste gedrueckt END REPEAT;");{} ELIF restzeile = ""{}{} + THEN fehler (9){} ELSE fehler (8){} FI.{}schliesse:{} restzeile := subtext (zeile, 5);{} IF restzeile = "WIEDERHOLE"{} THEN schliesse schleife{} ELIF restzeile = "WENN"{} THEN schliesse if{} ELIF restzeile = "PROGRAMM"{} THEN programmende{} ELSE fehler (10){} FI.{}schliesse schleife:{} teste ob als letztes schleife offen;{} letzte geoeffnete DECR 1;{} line (ziel); put (ziel, "END REPEAT;").{}teste ob als letztes schleife offen:{} IF letzte geoeffnete = 0{} THEN fehler (11);{}{} + LEAVE bearbeite zeile{} ELIF offene struktur [letzte geoeffnete] = abfrage{} THEN fehler (12){} FI.{}schliesse if:{} teste ob als letztes abfrage offen;{} line (ziel); put (ziel, "END IF;");{} letzte geoeffnete DECR 1.{}teste ob als letztes abfrage offen:{} IF letzte geoeffnete = 0{} THEN fehler (13);{} LEAVE bearbeite zeile{} ELIF offene struktur [letzte geoeffnete] = schleife{} THEN fehler (14){} FI.{}programmende:{} IF programmende fehlt{} THEN programmende fehlt := FALSE;{}{} + refinement muss folgen := TRUE{} ELSE fehler (17);{} LEAVE programmende{} FI;{} pruefe auf offene schleife oder abfrage.{}pruefe auf offene schleife oder abfrage:{} IF letzte geoeffnete = 0{} THEN alles okay{} ELIF offene struktur [letzte geoeffnete] = schleife{} THEN fehler (14){} ELSE fehler (12){} FI.{} alles okay: .{}durchsuche befehlsliste:{} IF pos (zeile, ":") > 0{} THEN auf refinementdefinition pruefen{} ELSE befehl suchen{} FI.{}befehl suchen:{}{} + BOOL VAR gefunden := FALSE;{} INT VAR i;{} verhindere bedingung;{} FOR i FROM 1 UPTO befehlsanzahl REP{} IF befehl [i].grin = zeile{} THEN gefunden := TRUE;{} line (ziel);{} put (ziel, befehl [i].elan + ";"){} FI{} UNTIL gefunden PER;{} IF NOT gefunden{} THEN trage in refinementliste ein{} FI.{}auf refinementdefinition pruefen:{} IF pos (zeile, ":") < length (zeile){} THEN fehler (20){} ELIF programmende fehlt{} THEN fehler (16){} ELIF (zeile = "Stoptastegedrückt:") OR{}{} + (zeile = "nichtStoptastegedrückt:") OR{} (zeile = "Stoptastegedrueckt:") OR{} (zeile = "nichtStoptastegedrueckt:"){} THEN fehler (22){} ELSE pruefe auf offene schleife oder abfrage;{} put (ziel, "END PROC refinement " + text (letztes refinement){} + ";");{} trage befehlsdefinition ein{} FI.{}trage in refinementliste ein:{} FOR index FROM 1 UPTO anzahl refinements REP{} IF refinement [index].name = zeile{}{} + THEN trage evtl aufruf ein;{} LEAVE trage in refinementliste ein{} FI{} PER;{} anzahl refinements INCR 1;{} IF anzahl refinements > max refinements{} THEN fehler (24){} ELSE refinement [anzahl refinements].name := zeile;{} refinement [anzahl refinements].aufruf := zeilennummer;{} line (ziel);{} put (ziel, "refinement " + text (anzahl refinements) + ";"){} FI.{}trage evtl aufruf ein:{} line (ziel);{} put (ziel, "refinement " + text (index) + ";");{}{} + IF refinement [index].aufruf < 0{} THEN refinement [index].aufruf := 0{} FI.{}verhindere bedingung:{} IF (zeile = "Stoptastegedrückt") OR (zeile = "nichtStoptastegedrückt") OR{} (zeile = "Stoptastegedrueckt") OR (zeile = "nichtStoptastegedrueckt"){} THEN fehler (15);{} LEAVE bearbeite zeile{} FI.{}END PROC uebersetze;{}PROC fehler (INT CONST fehlernr):{} noteline;{} note ("FEHLER in Zeile " + text (zeilennummer) + ": ");{} noteline;{} note (" " + anwendungstext (fehlernr + 20));{}{} + noteline;{} IF erster fehler = 0{} THEN erster fehler := zeilennummer{} FI{}END PROC fehler{}END PACKET ls warenhaus 4{}{} + diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 5 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 5 new file mode 100644 index 0000000..6b05bad --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 5 @@ -0,0 +1,103 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus 5 ** + ** ** + ** Version 1.01 ** + ** ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +PACKET ls warenhaus 5 DEFINES + warenhaus,{} grin,{} direktbefehl 1,{} direktbefehl 2,{} direktbefehl 3,{} direktbefehl 4,{} direktbefehl 5,{} direktbefehl 6,{} direktbefehl 7,{} warenhausbefehle zeigen,{} eingabe grundeinstellung,{} tastatur einstellen,{} kartenleser einstellen,{} evtl d und b sperren,{} loesche zwischenraum,{} eingabeart anzeigen,{} filialdaten zusammenstellen,{} filialdaten eintragen,{} filialdaten verzeichnis,{} + filialdaten umbenennen,{} filialdaten loeschen,{} warenhausprogramme verzeichnis,{} warenhausprogramm neu erstellen,{} warenhausprogramm ansehen,{} warenhausprogramm kopieren,{} warenhausprogramm umbenennen,{} warenhausprogramme loeschen,{} warenhausprogramme drucken,{} warenhausprogramm starten,{} warenhausprogramm wiederholen:{}LET menukarte = "ls-MENUKARTE:Warenhaus",{} praefix = "Filialdaten:",{} filialdatentyp = 1951,{} + niltext = "",{} maxlaenge = 45,{} maxnamenslaenge = 35;{}TEXT VAR filialdatenname :: "",{} programmname :: "";{}INT VAR fehlerzeile :: 0;{}BOOL VAR grin version :: FALSE,{} noch kein programm gelaufen :: TRUE,{} bildschirm neu eingesetzt :: FALSE;{}WINDOW VAR w :: window (1, 3, 79, 19);{}INITFLAG VAR in this task :: FALSE;{}PROC warenhausbefehle zeigen:{} TEXT VAR info, liste, tasten;{} INT VAR grinoffset;{} + IF grin version{} THEN grinbefehle{} ELSE elanbefehle{} FI;{} REP{} INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101, 105 : menuinfo (anwendungstext (1 + grinoffset)){} CASE 2, 102, 106 : menuinfo (anwendungstext (2 + grinoffset)){} CASE 3, 103, 107 : menuinfo (anwendungstext (3 + grinoffset)){} END SELECT{} UNTIL auswahl = 4 OR auswahl = 104 OR auswahl = 108 PER.{} grinbefehle:{} grinoffset := 13;{} info := " "15"Info zu den Programmierbefehlen "14""13""13""{} + + " d Datei - Bearbeitung "13""{} + " e Einkaufen und Auskunft "13""{} + " k Kontroll - Strukturen "13""13""{} + " z Zurück zum Hauptmenü ";{} liste := "Datei"13"Kaufen/Auskunft"13"Kontroll"13"Zurück";{} tasten := "dekzDEKZ".{} elanbefehle:{} grinoffset := 0;{} info := " "15"Info zu den Programmierbefehlen "14""13""13""{} + " d Datei - Bearbeitung "13""{} + + " e Einkaufen und Auskunft "13""{} + " s Sonstige Befehle "13""13""{} + " z Zurück zum Hauptmenü ";{} liste := "Datei"13"Kaufen/Auskunft"13"Sonstige"13"Zurück";{} tasten := "deszDESZ".{}END PROC warenhausbefehle zeigen;{}PROC eingabe grundeinstellung:{} INT VAR dummy;{} IF eingabe mit codekartenleser{} THEN tastatureingabe (TRUE, dummy){} FI{}END PROC eingabe grundeinstellung;{}PROC tastatur einstellen:{} + eingabe grundeinstellung;{} menuinfo (anwendungstext (6), 4){}END PROC tastatur einstellen;{}PROC kartenleser einstellen:{} INT VAR ergebnis;{} IF eingabe mit codekartenleser{} THEN tastatureingabe (TRUE, ergebnis){} FI;{} pause (10);{} tastatureingabe (FALSE, ergebnis);{} IF ergebnis < 0{} THEN menuinfo (anwendungstext (7 - ergebnis), 5){} ELSE menuinfo (anwendungstext (7), 4){} FI{}END PROC kartenleser einstellen;{}PROC loesche zwischenraum:{} INT VAR zeile;{} cursor (1, 2); out (79 * waagerecht + " ");{} + FOR zeile FROM 3 UPTO 22 REP{} cursor (1, zeile); out (""5"");{} PER;{} cursor (1, 23); out (79 * waagerecht + " ");{} cursor (1, 24); out (""5"");{}END PROC loesche zwischenraum;{}PROC ergaenze bildschirm:{} cursor ( 1, 2); out (ecke oben links);{} cursor (42, 2); out (balken oben);{} cursor (80, 2); out (ecke oben rechts);{} INT VAR zeile;{} FOR zeile FROM 3 UPTO 22 REP{} cursor ( 1, zeile); out (senkrecht);{} cursor (42, zeile); out (senkrecht);{} cursor (80, zeile); out (senkrecht){} + PER;{} cursor ( 1, 23); out (ecke unten links);{} cursor (42, 23); out (balken unten);{} cursor (80, 23); out (ecke unten rechts);{} cursor (42, 19);{} out (balken links + (37 * waagerecht) + balken rechts);{} cursor w3 1 1{}END PROC ergaenze bildschirm;{}PROC zweite zeile:{} cursor (1, 2); out (79 * waagerecht + " "){}END PROC zweite zeile;{}PROC evtl d und b sperren:{} IF eingabe mit codekartenleser{} THEN activate ( 9);{} activate (10){} ELSE deactivate ( 9);{} deactivate (10){} + FI{}END PROC evtl d und b sperren;{}PROC direktbefehl 1:{} disable stop;{} warendatei bearbeiten;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 1;{}PROC warendatei bearbeiten:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Warendatei bearbeiten"));{} REP artikelnummer lesen;{} + IF NOT stoptaste gedrueckt{} THEN artikeldaten eingeben{} FI{} UNTIL stoptaste gedrueckt PER{}END PROC warendatei bearbeiten;{}PROC direktbefehl 2:{} disable stop;{} kundendatei bearbeiten;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 2;{}PROC kundendatei bearbeiten:{} enable stop;{} loesche zwischenraum;{} + ergaenze bildschirm;{} cursor (2, 24); out (invers ("Kundendatei bearbeiten"));{} REP kundennummer lesen;{} IF NOT stoptaste gedrueckt{} THEN kundendaten eingeben{} FI{} UNTIL stoptaste gedrueckt PER{}END PROC kundendatei bearbeiten;{}PROC direktbefehl 3:{} disable stop;{} einkaufen gehen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} + FI;{} enable stop{}END PROC direktbefehl 3;{}PROC einkaufen gehen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Einkaufen"));{} forget ("WARENHAUS:Rechnung", quiet);{} kundennummer lesen;{} rechnungskopf;{} REP einkaufen{} UNTIL stoptaste gedrueckt PER;{} abrechnung;{} forget ("WARENHAUS:Rechnung", quiet).{} einkaufen:{} artikelnummer lesen;{} IF NOT stoptaste gedrueckt{} THEN artikel kaufen{} FI.{}END PROC einkaufen gehen;{} +PROC direktbefehl 4:{} disable stop;{} auskunft einholen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 4;{}PROC auskunft einholen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Auskunft"));{} auskunft{}END PROC auskunft einholen;{}PROC direktbefehl 5:{} disable stop;{} + ware nachbestellen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 5;{}PROC ware nachbestellen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Nachbestellen"));{} nachbestellen{}END PROC ware nachbestellen;{}PROC direktbefehl 6:{} disable stop;{} dezimalwerte von interface lesen;{} + cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 6;{}PROC dezimalwerte von interface lesen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Dezimalwert lesen"));{} dezimalwert lesen{}END PROC dezimalwerte von interface lesen;{}PROC direktbefehl 7:{} disable stop;{} + bitmuster von interface lesen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 7;{}PROC bitmuster von interface lesen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Bitmuster lesen"));{} bitmuster lesen{}END PROC bitmuster von interface lesen;{}PROC eingabeart anzeigen:{} + IF eingabe mit codekartenleser{} THEN menuinfo (anwendungstext (7), 4){} ELSE menuinfo (anwendungstext (6), 4){} FI{}END PROC eingabeart anzeigen;{}PROC warenhaus:{} BOOL VAR am ende loeschen :: TRUE;{} pruefe zulaessigkeit;{} installiere menukarte mit anfangsbild;{} initialisiere warenhaus;{} handle menu ("WARENHAUS");{} IF am ende loeschen{} THEN sperre verwaltungstask;{} end (task (verwaltung)){} FI.{} installiere menukarte mit anfangsbild:{} install menu (menukarte, TRUE);{} + cursor off;{} cursor (17, 20);{} out (" W A R E N H A U S ");{} cursor (21, 22);{} out (invers("Filiale " + text (channel (myself))));{} cursor (79, 24);{} pause (10).{} sperre verwaltungstask:{} DATASPACE VAR ds;{} INT VAR dummy;{} forget (ds); ds := nilspace;{} call (task (verwaltung), 256, ds, dummy).{} pruefe zulaessigkeit:{} IF hauptstellenname = ""{} THEN line;{} putline ("Keine uebergeordnete Task ist 'warenhaus hauptstelle'!");{} end; LEAVE warenhaus{} + ELIF name (myself) = hauptstellenname{} THEN errorstop ("Dieser Befehl darf nur von Söhnen dieser "{} + "Task aus gegeben werden!");{} LEAVE warenhaus{} FI.{} initialisiere warenhaus:{} TEXT CONST verwaltung :: hauptstellenname + ".Filialverwaltung "{} + text (channel (myself));{} IF NOT exists task (verwaltung){} THEN initialisiere verwaltung{} ELSE biete evtl loeschen an{} FI;{} IF NOT initialized (in this task){} + THEN filialdatenname := "";{} programmname := ""{} FI;{} noch kein programm gelaufen := TRUE.{} biete evtl loeschen an:{} access catalogue;{} IF NOT (father (task (verwaltung)) = myself){} THEN fehlermeldung;{} line;{} end;{} am ende loeschen := FALSE{} FI.{} fehlermeldung:{} cursor (1, 22);{} putline ("Filiale " + text (channel (myself)) +{} " ist bereits besetzt durch TASK '"{} + name (father (task (verwaltung))) + "'!");{} + putline ("Es ist so kein geregelter Warenhaus-Betrieb moeglich!").{}END PROC warenhaus;{}PROC grin (BOOL CONST entscheidung):{} enable stop;{} IF hauptstellenname = "" OR hauptstellenname = name (myself){} THEN grin version := entscheidung{} ELSE errorstop ("Dieser Befehl darf nur von der Task '" +{} hauptstellenname + "' aus gegeben werden!"){} FI;{} bildschirm neu eingesetzt := FALSE{}END PROC grin;{}PROC filialdaten verzeichnis:{} disable stop;{} THESAURUS VAR filialdaten ::{} + ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);{} forget ("Verzeichnis der Filialdaten-Dateien", quiet);{} FILE VAR f ::{} sequential file (output, "Verzeichnis der Filialdaten-Dateien");{} f FILLBY filialdaten;{} modify (f);{} to line (f, 1); insert record (f);{} menufootnote ("Verlassen: ");{} cursor on;{} show (w, f);{} cursor off;{} forget ("Verzeichnis der Filialdaten-Dateien", quiet);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} + menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop{}END PROC filialdaten verzeichnis;{}PROC warenhausprogramme verzeichnis:{} disable stop;{} forget ("Verzeichnis der Programme", quiet);{} THESAURUS VAR programme ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN programme := programme - "WARENHAUS:Rechnung"{} FI;{} FILE VAR f ::{} sequential file (output, "Verzeichnis der Programme");{} + f FILLBY programme;{} modify (f);{} to line (f, 1); insert record (f);{} menufootnote ("Verlassen: ");{} cursor on;{} show (w, f);{} cursor off;{} forget ("Verzeichnis der Programme", quiet);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop{}END PROC warenhausprogramme verzeichnis;{}PROC filialdaten zusammenstellen:{} hole filialdatenname;{} + kontrolliere den filialdatennamen;{} disable stop;{} sichere filialdaten (praefix + filialdatenname);{} IF is error{} THEN out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE bestaetige{} FI;{} enable stop.{} hole filialdatenname:{} filialdatenname := menuanswer (ausgabe, filialdatenname, 5).{} ausgabe:{} center (maxlaenge, invers ("Filialdaten zusammenstellen")) + ""13""13""{} + " Bitte den Namen für die Filialdaten "13""13"".{} + kontrolliere den filialdatennamen:{} IF filialdatenname = niltext{} THEN enable stop; LEAVE filialdaten zusammenstellen{} ELIF length (filialdatenname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} filialdatenname := niltext;{} enable stop; LEAVE filialdaten zusammenstellen{} ELIF exists (praefix + filialdatenname){} THEN meckere existierenden filialdatennamen an;{} enable stop; LEAVE filialdaten zusammenstellen{} + FI.{} bestaetige:{} menuinfo (" "15"Bestätigung "14" "13""13"" +{} " Die Filialdaten wurden von der "13"" +{} " Verwaltung unter dem gewünschten "13"" +{} " Namen zusammengestellt. "13"" , 3).{}END PROC filialdaten zusammenstellen;{}PROC warenhausprogramm neu erstellen:{} hole programmname;{} kontrolliere den programmnamen;{} command dialogue (FALSE);{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} + cursor off;{} command dialogue (TRUE);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} hole programmname:{} programmname := "";{} programmname := menuanswer (ausgabe, programmname, 5).{} ausgabe:{} center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""{} + " Bitte den Namen für das Programm "13""13"".{} kontrolliere den programmnamen:{} + IF programmname = niltext{} THEN LEAVE warenhausprogramm neu erstellen{} ELIF length (programmname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} programmname := niltext;{} LEAVE warenhausprogramm neu erstellen{} ELIF exists (programmname){} THEN meckere existierendes programm an;{} LEAVE warenhausprogramm neu erstellen{} FI.{}END PROC warenhausprogramm neu erstellen;{}PROC warenhausprogramm ansehen:{} IF programmname <> niltext CAND exists (programmname){} + THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI;{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name{} + " Soll mit diesem Programm gearbeitet werden", 5){} + THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} + LEAVE warenhausprogramm ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm ansehen/ändern",{} "Bitte das gewünschte Programm ankreuzen!",{} FALSE);{} IF programmname = niltext{} THEN menu bildschirm;{} LEAVE warenhausprogramm ansehen{} FI.{}END PROC warenhausprogramm ansehen;{}PROC filialdaten eintragen:{} lasse filialdaten auswaehlen;{} + trage filialdaten ein;{} menu bildschirm.{} lasse filialdaten auswaehlen:{} THESAURUS VAR verfuegbare ::{} ohne praefix (infix namen (ALL myself,praefix,filialdatentyp),praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine filialdaten;{} LEAVE filialdaten eintragen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, bezeichnung,{} "Bitte die Filialdaten ankreuzen, die eingetragen werden sollen!", FALSE).{} trage filialdaten ein:{} + show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (bezeichnung)));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (schlussbemerkung);{} menuwindowstop.{} bezeichnung:{} "Filialdaten eintragen/ergänzen".{} schlussbemerkung:{} " Alle ausgewählten Filialdaten wurden eingetragen!".{} fuehre einzelne operationen aus:{} + INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " Filialdaten """ + name (verfuegbare, k){} + """ werden eingetragen!");{} menuwindowline;{} lade filialdaten (praefix + name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} + THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE filialdaten eintragen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} menuinfo (" " + invers (errormessage));{} + clear error; enable stop;{} LEAVE filialdaten eintragen{} ELSE enable stop{} FI.{}END PROC filialdaten eintragen;{}PROC warenhausprogramme drucken:{} lasse programme auswaehlen;{} drucke programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} + THEN noch kein programm;{} LEAVE warenhausprogramme drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Programme drucken",{} "Bitte die Programme ankreuzen, die gedruckt werden sollen!",{} FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Programme drucken")));{} menuwindowline (2);{} command dialogue (FALSE);{} + fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Programme wurden gedruckt!");{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " """ + name (verfuegbare, k) +{} """ wird gedruckt!");{} menuwindowline;{} + print (name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde kein Programm ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE warenhausprogramme drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} + ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE warenhausprogramme drucken{} ELSE enable stop{} FI.{}END PROC warenhausprogramme drucken;{}PROC warenhausprogramm kopieren:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} kopiere ggf das programm.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} + THEN noch kein programm;{} LEAVE warenhausprogramm kopieren{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, "Programm kopieren",{} "Bitte das Programm ankreuzen, das kopiert werden soll!",FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE warenhausprogramm kopieren{} FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp){} - "WARENHAUS:Rechnung".{} + erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Name des 'alten' Programms: " + bisheriger name{} + " Bitte den Namen für die Kopie: ".{} ueberschrift:{} center (maxlaenge, invers ("Programm kopieren")) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} kopiere ggf das programm:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} + LEAVE warenhausprogramm kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE warenhausprogramm kopieren{} ELSE copy (alter name, neuer name){} FI.{} mache vorwurf:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).{}END PROC warenhausprogramm kopieren;{}PROC filialdaten umbenennen:{} ermittle alten filialdatennamen;{} erfrage neuen filialdatennamen;{} benenne ggf die filialdaten um.{} ermittle alten filialdatennamen:{} + IF NOT not empty (bestand){} THEN noch keine filialdaten;{} LEAVE filialdaten umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, text1, text2, FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE filialdaten umbenennen{} FI.{} bestand:{} ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix).{} text1: "Filialdaten umbenennen".{} text2:{} "Bitte die Filialdaten-Datei ankreuzen, die umbenannt werden soll!" .{} + erfrage neuen filialdatennamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{} ueberschrift:{} center (maxlaenge, invers ("Filialdaten umbenennen")) + ""13""13"".{} hinweis auf alt:{} " Bisheriger Filialdaten-Name: ".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} aufforderung:{} " Zukünftiger Filialdaten-Name: ".{} benenne ggf die filialdaten um:{} IF neuer name = niltext{} + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE filialdaten umbenennen{} ELIF exists (praefix + neuer name){} THEN menuinfo (" " + invers("Filialdaten mit diesem Namen gibt es bereits!"));{} LEAVE filialdaten umbenennen{} ELSE rename (praefix + alter name, praefix + neuer name);{} filialdatenname := neuer name{} FI.{}END PROC filialdaten umbenennen;{}PROC warenhausprogramm umbenennen:{} ermittle alten programmnamen;{} + erfrage neuen programmnamen;{} benenne ggf das programm um.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} THEN noch kein programm;{} LEAVE warenhausprogramm umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, "Programm umbenennen",{} "Bitte das Programm ankreuzen, das umbenannt werden soll!", FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE warenhausprogramm umbenennen{} + FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp){} - "WARENHAUS:Rechnung".{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Bisheriger Programmname: " + bisheriger name{} + " Zukünftiger Programmname: ".{} ueberschrift:{} center (maxlaenge, invers ("Programm umbenennen")) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} + benenne ggf das programm um:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE warenhausprogramm umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE warenhausprogramm umbenennen{} ELSE rename (alter name, neuer name);{} programmname := neuer name{} FI.{} mache vorwurf:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).{}END PROC warenhausprogramm umbenennen;{} +PROC filialdaten loeschen:{} lasse filialdaten auswaehlen;{} loesche filialdaten;{} menu bildschirm.{} lasse filialdaten auswaehlen:{} THESAURUS VAR verfuegbare ::{} ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine filialdaten;{} LEAVE filialdaten loeschen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Filialdaten-Dateien löschen",{} "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).{} + loesche filialdaten:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Filialdaten-Dateien löschen")));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} + IF name (verfuegbare, k) <> ""{} THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k){} + """ löschen"){} THEN forget (praefix + name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} filialdatenname := "".{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");{} + menuwindowstop;{} menu bildschirm;{} LEAVE filialdaten loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE filialdaten loeschen{} ELSE enable stop{} FI.{} +END PROC filialdaten loeschen;{}PROC warenhausprogramme loeschen:{} lasse programme auswaehlen;{} loesche programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramme loeschen{} + ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Programm löschen",{} "Bitte alle Programme ankreuzen, die gelöscht werden sollen!", FALSE).{} loesche programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Programme löschen")));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} + menuwindowout (" Alle ausgewählten Programme wurden gelöscht!");{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen"){} THEN forget (name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} programmname := "".{} + steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde kein Programm ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE warenhausprogramme loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} + menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE warenhausprogramme loeschen{} ELSE enable stop{} FI.{}END PROC warenhausprogramme loeschen;{}PROC warenhausprogramm starten:{} IF grin version{} THEN warenhausprogramm uebersetzen und starten{} ELSE warenhausprogramm direkt starten{} FI{}END PROC warenhausprogramm starten;{}PROC warenhausprogramm direkt starten:{} programmname ermitteln;{} bildschirm neu eingesetzt := FALSE;{} + untersuche programmdatei auf bildschirm neu;{} cursor w3 1 1;{} cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: ");{} cursor on;{} check on;{} warnings off;{} disable stop;{} run (programmname);{} noch kein programm gelaufen := FALSE;{} IF bildschirm neu eingesetzt{} THEN entferne befehl aus programmdatei{} FI;{} cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} + "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{} fehlerbehandlung:{} IF is error{} THEN fehler ggf melden{} ELSE enable stop{} FI.{} fehler ggf melden:{} IF errormessage = ""{} THEN regenerate menuscreen{} ELSE fehler melden{} FI;{} clear error; enable stop;{} LEAVE warenhausprogramm direkt starten.{} fehler melden:{} out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN regenerate menuscreen;{} + menuinfo (" " + invers (errormessage)){} ELSE programm mit fehler zeigen;{} regenerate menuscreen{} FI.{} programmname ermitteln:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +{} name + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} + FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm starten")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramm direkt starten{} + ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm starten",{} "Bitte das gewünschte Programm ankreuzen!", FALSE);{} menubildschirm;{} menufootnote ("");{} IF programmname = niltext{} THEN LEAVE warenhaus programm direkt starten{} FI.{} untersuche programmdatei auf bildschirm neu:{} FILE VAR a :: sequential file (modify, programmname);{} TEXT VAR zeile;{} to line (a, 1);{} REP{} read record (a, zeile);{} + IF NOT eof (a) THEN down (a) FI{} UNTIL zeile <> "" OR eof (a) PER;{} change all (zeile, " ", "");{} IF pos (zeile, "bildschirmneu") = 0{} THEN setze befehl in datei ein{} FI.{} setze befehl in datei ein:{} to line (a, 1);{} zeile := "bildschirm neu; (* ergänzt *)";{} insert record (a);{} write record (a, zeile);{} bildschirm neu eingesetzt := TRUE.{} entferne befehl aus programmdatei:{} FILE VAR b :: sequential file (modify, programmname);{} to line (b, 1);{} + REP{} read record (b, zeile);{} IF NOT eof (b) THEN down (b) FI{} UNTIL zeile <> "" OR eof (b) PER;{} change all (zeile, " ", "");{} IF pos (zeile, "bildschirmneu;(*ergänzt*)") > 0{} THEN up (b); delete record (b){} FI.{}END PROC warenhausprogramm direkt starten;{}PROC warenhausprogramm uebersetzen und starten:{} programmname ermitteln;{} cursor w3 1 1;{} cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: ");{} cursor on;{} disable stop;{} uebersetze (programmname);{} + IF NOT is error{} THEN check on;{} warnings off;{} run ("elanprogramm");{} noch kein programm gelaufen := FALSE{} FI;{} forget ("elanprogramm", quiet);{} cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{} fehlerbehandlung:{} IF is error{} THEN fehler ggf melden{} + ELSE enable stop{} FI.{} fehler ggf melden:{} IF errormessage = ""{} THEN regenerate menuscreen{} ELSE fehler melden{} FI;{} clear error; enable stop;{} LEAVE warenhausprogramm uebersetzen und starten.{} fehler melden:{} out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage)){} ELSE programm mit fehler zeigen ;{} regenerate menuscreen{} FI.{} programmname ermitteln:{} + IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +{} name + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm starten")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} + lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramm uebersetzen und starten{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm starten",{} + "Bitte das gewünschte Programm ankreuzen!", FALSE);{} menubildschirm;{} menufootnote ("");{} IF programmname = niltext{} THEN LEAVE warenhaus programm uebersetzen und starten{} FI.{}END PROC warenhausprogramm uebersetzen und starten;{}PROC programm mit fehler zeigen:{} IF exists (programmname){} THEN noteline;{} note (fehlermeldung mit zeilennummer);{} INT VAR i; FOR i FROM 1 UPTO 9 REP noteline PER;{} note (invers ("Verlassen: "));{} + FILE VAR f :: sequential file (modify, programmname);{} to line (f, max (1, fehlerzeile));{} col (1);{} clear error;{} cursor on;{} noteedit (f);{} cursor off{} ELSE menuinfo (invers (fehlermeldung mit zeilennummer)){} FI{}END PROC programm mit fehler zeigen;{}PROC warenhausprogramm wiederholen:{} cursor on;{} disable stop;{} IF noch kein programm gelaufen{} THEN errorstop ("'run again' nicht moeglich"){} ELSE runagain{} FI;{} + cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{}fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} fehler melden;{} clear error; enable stop;{} LEAVE warenhausprogramm wiederholen{} ELSE enable stop{} FI.{} fehler melden:{} + out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN menuinfo (" " + invers (errormessage)){} ELIF errormessage = "'run again' nicht moeglich"{} THEN menuinfo (" " + invers ("Wiederholung nicht möglich!")){} ELSE menuinfo (" " + invers (fehlermeldung mit zeilennummer)){} FI{}END PROC warenhausprogramm wiederholen;{}TEXT PROC fehlermeldung mit zeilennummer:{} TEXT VAR meldung :: "FEHLER: " + errormessage;{} fuege ggf fehlerzeile an;{} IF length (meldung) < 70{} + THEN meldung{} ELSE subtext (meldung, 1, 69){} FI.{} fuege ggf fehlerzeile an:{} fehlerzeile := errorline;{} IF errorline < 1{} THEN LEAVE fuege ggf fehlerzeile an{} ELIF bildschirm neu eingesetzt{} THEN meldung CAT " (bei Zeile " + text (errorline - 1) + ")"{} ELSE meldung CAT " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlermeldung mit zeilennummer;{}PROC meckere zu langen namen an:{} menuinfo (" " + invers ("Hier dürfen Namen höchstens "{} + + text (max namenslaenge){} + " Zeichen lang sein!")){}END PROC meckere zu langen namen an;{}PROC meckere existierenden filialdatennamen an:{} menuinfo (" " + invers ("Filialdaten mit diesem Namen gibt es bereits!")){}END PROC meckere existierenden filialdatennamen an;{}PROC meckere existierendes programm an:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")){}END PROC meckere existierendes programm an;{}PROC noch keine filialdaten:{} menuinfo (" " + invers ("Es existiert noch keine Filialdaten-Datei!")){} +END PROC noch keine filialdaten;{}PROC noch kein programm:{} menuinfo (" " + invers ("Es existiert noch kein Programm!")){}END PROC noch kein programm;{}PROC menu bildschirm:{} cursor (1, 2);{} out (5 * waagerecht);{} cursor (1, 3);{} out (""4"");{} cursor (1, 23);{} out (79 * waagerecht);{} refresh submenu{}END PROC menu bildschirm{}END PACKET ls warenhaus 5{} + diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus-gen b/app/gs.warenhaus/1.01/src/ls-Warenhaus-gen new file mode 100644 index 0000000..f4bd77f --- /dev/null +++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus-gen @@ -0,0 +1,29 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** ls-Warenhaus/gen ** + ** ** + ** Version 1.01 ** + ** ** + ** ** + ** (Stand: 30.08.89) ** + ** ** + ** ** + ** ** + ** Autor: Bruno Pollok, Bielefeld ** + ** ** + ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld ** + ** Copyright (C) 1990 ERGOS GmbH, Siegburg ** + ** ** + ********************************************************** + ********************************************************** + + *) +LET kartenleserkennung = "ls-Warenhaus 0: mit Kartenleser"; +baue bildschirm auf;{}schicke menukarte ab;{}erfrage anpassung;{}check off;{}warnings off;{}insertiere (anpassung);{}loesche alle anpassungen;{}insertiere ("ls-Warenhaus 1");{}insertiere ("ls-Warenhaus 2");{}insertiere ("ls-Warenhaus 3");{}insertiere ("ls-Warenhaus 4");{}insertiere ("ls-Warenhaus 5");{}check on;{}frage nach grin;{}frage nach hauptstelle.{}baue bildschirm auf:{} page;{} cursor (18, 1);{} out (invers ("ls-Warenhaus : Automatische Generierung"));{} line (3).{}erfrage anpassung:{} + WINDOW VAR w :: window (1, 1, 79, 24);{} TEXT VAR anpassung :: boxone (w, alle kartenleser,{} "Auswahl einer Interface - Anpassung für den Codekartenleser",{} "Wenn kein Kartenleser benutzt wird, tippen!", FALSE);{} IF anpassung = ""{} THEN anpassung := "ls-Warenhaus 0: ohne Kartenleser"{} FI;{} baue bildschirm auf.{}alle kartenleser:{} infix namen (ALL myself, kartenleserkennung).{}loesche alle anpassungen:{} command dialogue (FALSE);{} forget (infixnamen (ALL myself, "ls-Warenhaus 0"));{} + forget ("--------------------------------------------------------",quiet);{} command dialogue (TRUE).{}schicke menukarte ab:{} command dialogue (FALSE);{} save ("ls-MENUKARTE:Warenhaus", /"ls-MENUKARTEN");{} command dialogue (TRUE);{} forget ("ls-MENUKARTE:Warenhaus", quiet);{} forget ("ls-Warenhaus/gen", quiet).{}frage nach grin:{} line;{} IF yes ("Version für GRIN"){} THEN do ("grin (TRUE)"){} ELSE do ("grin (FALSE)"){} FI.{}frage nach hauptstelle:{} line (2);{} IF yes ("Soll diese Task Warenhaus - Hauptstelle sein"){} + THEN do ("warenhaus hauptstelle (TRUE)"){} ELSE global manager{} FI.{};{}PROC insertiere (TEXT CONST dateiname):{} INT VAR s, z;{} out ("'" + dateiname + "'");{} get cursor (s, z);{} out (" wird insertiert. ");{} insert (dateiname);{} forget (dateiname, quiet);{} cursor (s, z);{} out (""4"") ;{} line{}END PROC insertiere{} + diff --git a/app/mpg/2.2/doc/GRAPHIK.dok.e b/app/mpg/2.2/doc/GRAPHIK.dok.e new file mode 100644 index 0000000..7e61cd4 --- /dev/null +++ b/app/mpg/2.2/doc/GRAPHIK.dok.e @@ -0,0 +1,2235 @@ +#type ("prop.lq")##limit (16.0)# +#free(10.0)# +#headoff##bottomoff# + +#type("prop.breit.lq")##center##on("u")#Dokumentation des MPG-Graphik-Systems#off("u")# + +#free(1.0)# +#type("prop")##center#Version 2.1 vom 10.09.87 + +#free(0.5)# +#center#(c) 1987 Beat Jegerlehner & Carsten Weinholz + +#page# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Inhaltsverzeichnis +#type("pica.lq")##free(1.0)# +#type("prop")##limit(16.0)##linefeed(01.0)# +#type("pica")##on("u")#Inhaltsverzeichnis#off("u")##type("prop.lq")# +#free(0.5)# +#type ("prop.lq")##limit (16.0)# + Teil 1: Komponenten des Graphik-Systems ................... 1 + 1.0 GRAPHIK.Basis ................................ 1 + 2.0 GRAPHIK.Configuration/GRAPHIK.Configurator ... 1 + 3.0 GRAPHIK.Plot ................................. 1 + Teil 1.1: Generierung der Graphik ......................... 2 + Teil 1.2: Tasks des Graphik-Systems ....................... 3 + 1.0 Task: 'GRAPHIK' .............................. 3 + 2.0 Task: 'PLOT' ................................. 3 + 3.0 Task: 'FKT' .................................. 4 + Teil 2: Operationen der Basisgraphik ...................... 5 + 1.0 Paket: 'transformation' ...................... 5 + 2.0 Paket: picture ............................... 8 + 3.0 Paket: 'picfile' ............................. 13 + 4.0 Paket: 'devices' ............................. 17 + Teil 2.1: Operationen des 'device interface' .............. 19 + 1.0 Paket: 'device interface' .................... 19 + Teil 2.2: Operationen zur Graphik-Ausgabe ................. 23 + 2.0 Paket: 'basisplot' ........................... 23 + 3.0 Paket: 'plot interface' ...................... 27 + 4.0 Paket: 'plot' ................................ 29 + Teil 3: Konfigurierung der Graphik ........................ 30 + Teil 3.1: Der Graphik-Konfigurator ........................ 30 + Teil 3.2: Erstellung der Konfigurationsdateien ............ 31 + 1.0 Pseudo-Schlüsselworte ........................ 32 + 2.0 Pseudo-Prozeduren ............................ 34 + Teil 4: Graphik-Applikationen ............................. 37 + Teil 4.1: Der Funktionenplotter 'FKT' ..................... 37 + 1.0 Allgemeines über FKT ......................... 37 + 2.0 Das FKT-Menue ................................ 37 + 3.0 FKT-Menuepunkte .............................. 38 + Teil 4.2: Die TURTLE-Graphik .............................. 44 + 1.0 Paket: 'turtlegraphics' ...................... 44 + Stichwortverzeichnis ....................................... XX +#page(1)# +#head on##bottom on# +#bottom# +#right#Seite % +#end# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Teil 1: Komponenten des Graphik-Systems +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Teil 1: Komponenten des Graphik-Systems#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + + Das MPG-Graphik-System besteht aus folgenden Komponenten: + + #ib(1)#1.0 GRAPHIK.Basis#ie(1)# + + 1.1 #ib(2," (1.1)")#PACKET transformation#ie(2,"")# + - Transformations- und Umrechnungsprozeduren zur Endgerät­ + unabhängigen Abbildung von PICTURES bzw. PICFILES. + + 1.2 #ib(2," (1.2)")#PACKET picture#ie(2,"")# + - Verwaltung des Datentyps PICTURE, der eine Bildebene objekt­ + orientiert beschreibt. + + 1.3 #ib(2," (1.3)")#PACKET picfile#ie(2,"")# + - Verwaltung des Datentyps PICFILE, der ein aus verschiedenen Bild­ + ebenen (PICTURES) bestehendes Bild und seine (allgemeine) Abbildung + auf den Endgeräten beschreibt. + + 1.4 #ib(2," (1.4)")#PACKET devices#ie(2,"")# + - Allgemeine Verwaltung der verschiedenen Endgeräte. + + + #ib(1)#2.0 GRAPHIK.Configuration/GRAPHIK.Configurator#ie(1)# + + 2.1 #ib(2," (2.1)")#PACKET deviceinterface#ie(2,"")# + - Bereitstellung der allgemeinen graphischen Basisoperationen, die + für jedes Endgerat gleichartig vorhanden sind. + - Das 'deviceinterface' wird vom 'GRAPHIK.Configurator' bei Bedarf + durch geeignetes Zusammenbinden veschiedener Endgerät- + Konfigurationsdateien automatisch erzeugt. + + + #ib(1)#3.0 GRAPHIK.Plot#ie(1)# + + 3.1 #ib(2," (3.1)")#PACKET basisplot#ie(2,"")# + - Bereitstellung der von der EUMEL-Graphik benötigten + Basisoperationen. + + 3.2 #ib(2," (3.2)")#PACKET plotinterface#ie(2,"")# + - Paket zur Ansteuerung und Kontrolle der Endgeräte. + + 3.3 #ib(2," (3.3)")#PACKET plot#ie(2,"")# + - Ausgabeprozeduren für PICTURES bzw. PICFILES für alle Endgeräte. +#page# +#type("pica")##on("u")##ib(1)#Teil 1.1: Generierung der Graphik#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Es wird zunächst eine Task 'GRAPHIK' (o.ä.) eingerichtet. + Das MPG-Graphik-Sytem befindet sich auf der Diskette 'GRAPHIK 2.1': + + - archive ("GRAPHIK 2.1") + - fetch ("GRAPHIK.Install",archive) + - run ("GRAPHIK.Install") + + 'GRAPHIK.Install' enthält ein Generierungsprogramm, das die weitere Generierung + des Graphik-Systems vornimmt. + Existiert auf dem Archiv eine Datei 'GRAPHIK.Configuration', so wird nachge­ + fragt, ob das Graphiksystem hinsichtlich der anzusteuernden Endgeräte neu­ + konfiguriert('GRAPHIK.Configuration' also in Abhängigkeit von den ebenfalls + auf der Diskette vorhandenen Endgerät-Konfigurationsdateien neu erstellt + werden soll). Fehlt 'GRAPHIK.Configuration', so wird es zwangsläufig neu er­ + stellt (siehe 'Neukonfiguration des Graphik-Systems', S. #to page ("newconf")#). + Mit der im Hintergrund ablaufenden Installation des Plotmanagers in der + (Sohn-)Task 'PLOT' (siehe 'Funktion von PLOT', S.#to page ("plotmanager")#) steht dann die Graphik allen + Sohntasks von 'GRAPHIK' zur Verfügung: + + . + . + GRAPHIK + PLOT + FKT + EUCLID + user + usw. + . + . +#page# +#type("pica")##on("u")##ib(1)#Teil 1.2: Tasks des Graphik-Systems#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + + #ib(1)#1.0 Task: 'GRAPHIK'#ie(1)# + + 'GRAPHIK' ist die Ausgangstask des Graphik-Systems; in ihr werden (s.o) die + einzelnen Graphikpakete insertiert, und stehen den Sohntasks zur Verfügung + (siehe 'Operationen der Basisgraphik', S. #topage("gfuncts")#). Zusätzlich kann sie den Plot­ + manager in der Task 'PLOT' kontrollieren + + #ib(1)#2.0 Task: 'PLOT'#ie(1)##goalpage("plotmanager")# + + 'PLOT' enthält den Multispool-Manager des Graphik-Systems, der die indirekte + Ausgabe von PICFILES auf jedem Endgerät der Station ermöglicht. Der Manager + verwaltet im Gegensatz zum 'PRINTER' aber nicht nur eine Warteschlange bzw. + Server sondern mehrere (die Anzahl ist durch die Konstante 'max spools' in + 'GRAPHIK.Manager' festgelegt). + (Achtung !, eine Task kann nicht mehr als 255 Datenräume, also Einträge in + Warteschlangen verwalten !). + Sollte PLOT neben PRINTER zur graphischen Ausgabe auf dem Drucker arbei­ + ten, so ist in PRINTER 'spool control task (/"PLOT")' einzustellen. + Der Plotmanager besitzt eine Kommandoebene, die wie folgt arbeitet: + Nach 'continue' erscheint der Prompt 'All-Plotter', der anzeigt, daß nach­ + folgende Kommandos gleichermassen auf alle Spools/Server wirken; sollen + die Kommandos auf nur einen Spool/Server wirken, so ist dieser mit 'select + plotter' einzustellen, was durch eine Änderung des Prompts auf den + Plotternamen angezeigt wird. + + - 2.1 #ib(2," (2.1)")#listspool#ie(2,"")# + Gibt Auskunft über die Inhalte und Aktivitäten aller bzw. des + gewählten Spools. + + - 2.2 #ib(2," (2.2)")#clearspool#ie(2,"")# + Initialisiert nach Rückfrage alle bzw. den gewählten Spool; + sämtliche Einträge werden gelöscht, evtl. laufende Ausgaben + abgebrochen (der Server beendet). + + - 2.3 #ib(2," (2.3)")#spool control#ie(2,"")# + (TEXT CONST control task) + Stellt die Task mit dem Namen 'control task' und alle ihre Söhne + als privilegiert ein, d.h. Kommandos wie 'start', 'stop' usw. werden + von diesen Tasks wie auch von Systemstasks und von 'GRAPHIK' + aus zugelassen. + + - 2.4 #ib(2," (2.4)")#stop#ie(2,"")# + Unterbricht eine evtl. laufende Ausgabe und unterbindet die + weitere Ausgabe von Einträgen aller bzw. des gewählten Spools; + wobei nach Rückfrage die abgebrochene Ausgabe als erster + Eintrag erneut eingetragen wird. + + - 2.5 #ib(2," (2.5)")#start#ie(2,"")# + Nimmt die Ausgabe des gewählten bzw. aller Spools wieder auf. + + - 2.6 #ib(2," (2.6)")#halt#ie(2,"")# + Unterbindet die weitere Ausgabe von Einträgen aller bzw. des + gewählten Spools; evtl. laufende Ausgaben werden jedoch nicht + abgebrochen. + + - 2.7 #ib(2," (2.7)")#select plotter#ie(2,"")# + Bietet als Auswahl die Endgeräte der Station an; die obenge­ + nannten Operationen wirken danach nur auf den gewählten Spool, + was durch die Änderung des Prompts auf den Namen des gewählten + Endgerätes angezeigt wird. + Der Abbruch der Auswahloperation führt dementsprechend wieder + zur Einstellung 'All-Plotter'. + Das aktuell zu kontrollierende Endgerät kann jedoch auch mit + den Standard-Auswahloperationen gewählt werden; diese lassen + aber auch die Wahl von Plottern anderer Stationen zu, was im + Plotmanager als 'All-Plotter' gewertet wird. + + Folgende Funktionen können nur auf einzelne Spools; also nicht auf + 'All-Plotter' angewendet werden: + + - 2.8 #ib(2," (2.8)")#killer#ie(2,"")# + Bietet im Dialog alle im Spool enthaltenen Einträge zum Löschen + an. + + - 2.9 #ib(2," (2.9)")#first#ie(2,"")# + Bietet im Dialog alle dem ersten Eintrag nachfolgenden Einträge + zum Vorziehen an. + + #ib(1)#3.0 Task: 'FKT'#ie(1)# + + Die Task 'FKT' stellt den Funktionenplotter FKT, bzw. dessen menuegesteuerten + Monitor als Taskmonitor zur Verfügung. + Wird die Task mit dem Menuepunkt + 'q' - in die Kommandoebene zurueck + verlassen, so werden alle enthaltenen PICFILES gelöscht. + Der Funktionenplotter wird in 'FKT' mit dem Kommando 'fktmanager' instal­ + liert; er ist jedoch auch in jeder anderen Task mit dem Kommando 'fktplot' + erreichbar. + +#page# +#bottom# +#right#Seite % +#end# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Teil 2: Operationen der Basisgraphik +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Teil 2: Operationen der Basisgraphik#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# +#goalpage("gfuncts")# + Die Pakete der Basisgraphik sind in der Datei 'GRAPHIK.Basis' enthalten, und + realisieren folgende Aufgaben: + - Vektorielle Abbildung virtueller Koordinaten unter Verwendung einer + Transformationsmatrix auf die konkrete Endgerät-Zeichenfläche unter + Berücksichtigung des eingestellten Teils der Zeichenfläche ('viewport') + und des Fensters ('window'). + - Bereitstellung des Datentyps PICTURE, der die gemeinsame Manipulation + von Objekten ermöglicht. + - Bereitstellung des Datentyps PICFILE, der die gemeinsame Manipulation + von PICTURES hinsichtlich ihrer Ausgabe ermöglicht. + - Bereitstellung des Datentyps PLOTTER, der die freie Auswahl von End­ + geräten ermöglicht, und Informationen über sie liefert. + + Zu den mit '*' gekennzeichneten Beschreibungen vgl. die Beschreibung im + Programmierhandbuch. + + #ib(1)#1.0 Paket: 'transformation'#ie(1)# + + 1.1 BOOL PROC #ib(2," (1.1)")#clippedline#ie(2," (PROC)")# + (REAL VAR x0, y0, x1, y1) + - Intern verwendete Prozedur, welche die in den Variablen über­ + gebenen Anfangs- und Endkoordinaten einer Geraden auf die + Ausmaße der aktuellen Endgerät-Zeichenfläche begrenzt. + Es wird zurückgeliefert, ob Teile der übergebenen Geraden inner­ + halb der Zeichenfläche liegen, also gezeichnet werden müssen. + + 1.2 PROC #ib(2," (1.2)")#drawingarea *#ie(2," (PROC)")# + (REAL VAR x cm, REAL VAR y cm, REAL VAR xp, REAL yp) + - Trägt in die übergebenen Variablen die Ausmaße der aktuellen + Endgerät-Zeichenfläche in cm und Pixel ein. + + 1.3 PROC #ib(2," (1.3)")#getvalues#ie(2," (PROC)")# + (ROW 3 ROW 2 REAL VAR, ROW 2 ROW 2 REAL VAR, + ROW 4 REAL VAR, ROW 2 REAL VAR, ROW 3 REAL VAR) + - Intern verwendete Prozedur, die in die übergebenen Felder die + aktuellen Werte der Transformationsmatrix einträgt. + + 1.4 BOOL PROC #ib(2," (1.4)")#newvalues#ie(2," (PROC)")# + - Intern verwendete Prozedur, die anzeigt, ob die Transformations­ + matrix verändert wurde. + + 1.5 PROC #ib(2," (1.5)")#oblique *#ie(2," (PROC)")# + (REAL CONST a, b) + - Stellt für o.g. Abbildungsfunktion die Projektionsart + 'schiefwinklig' ein; 'a;b' ist der Punkt in der X-Y-Ebene, auf den der + Einheitsvektor in Z-Richtung abgebildet werden soll. + + 1.6 PROC #ib(2," (1.6)")#orthographic *#ie(2," (PROC)")# + - Stellt die Projektionsart 'Paralellprojektion' ein (s.o.). + + 1.7 PROC #ib(2," (1.7)")#perspective *#ie(2," (PROC)")# + (REAL CONST x,y,z) + - Stellt die Abbildungsart 'perspektivisch' ein; 'x;y;z' gibt den + Fluchtpunkt der Zentralperspektive an. + + 1.8 PROC #ib(2," (1.8)")#setdrawingarea#ie(2," (PROC)")# + (REAL CONST x cm, y cm, x p, y p) + - Intern verwendete Prozedur, die vorm Beginn des Zeichnens dem + Transformationspaket die Ausmaße der Endgerät-Zeichenfläche + übergibt. + + 1.9 PROC #ib(2," (1.9)")#setvalues#ie(2," (PROC)")# + (ROW 3 ROW 2 REAL CONST, ROW 2 ROW 2 REAL CONST, + ROW 4 REAL CONST, ROW 2 REAL CONST, ROW 3 REAL CONST) + - Intern verwendete Prozedur, welche die Transformationsmatrix mit + den Werten der übergebenen Felder füllt. + + 1.10 PROC #ib(2," (1.10)")#transform#ie(2," (PROC)")# + (REAL CONST x, y, z, xp, yp) + - Intern verwendete Prozedur zur Abbildung eines drei­ + dimensionalen Vektors in virtuellen Koordinaten auf + (zweidimensionale) Bildschirmkoordinaten. + + 1.11 PROC #ib(2," (1.11)")#view *#ie(2," (PROC)")# + (REAL CONST alpha, phi, theta) + - Stellt für o.g. Abbildungsfunktion zusätzlich die Drehwinkel der + Abbildung in Polarkoordinaten ein. + In der derzeitigen Version fehlerhaft ! + + 1.12 PROC #ib(2," (1.12)")#view *#ie(2," (PROC)")# + (REAL CONST alpha, phi) + - s.o.; ebenfalls fehlerhaft ! + + 1.13 PROC #ib(2," (1.13)")#view *#ie(2," (PROC)")# + (REAL CONST alpha) + - Dreht die Abbildung um den Mittelpunkt der Zeichenfläche um + 'alpha' Grad ! + + 1.14 PROC #ib(2," (1.14)")#viewport *#ie(2," (PROC)")##goalpage("viewport")# + (REAL CONST hormin, hormax, vertmin, vertmax) + - Definiert den verwendeten Teil der Endgerät-Zeichenfläche in + Welt- oder Gerätekoordinaten, bei Verwendung dieser Prozedur ist + vorangehend 'window (TRUE)' aufzurufen; damit die neuen Werte + auch Berücksichtigung finden. + + 1. Angabe in Weltkoordinaten (cm): + 'hor min;vert min' - Position der unteren linken Ecke der ver­ + wendeten Zeichenfläche in cm. + 'hor max;vert max' - Position der oberen rechten Ecke der ver­ + wendeten Zeichenfläche in cm. + + 2. Angabe in Gerätekoordinaten: + Es wird eine Angabe in Gerätekoordinaten angenommen, wenn + hor max < 2.0 und vert max < 2.0 gilt. + Die Werte werden als Bruchteile der Größe der gesamten Zei­ + chenfläche aufgefaßt, wobei für die horizontalen Werte zu­ + sätzlich das Verhältnis 'Horizontale/Vertikale' (i.d. Regel > 1) + berücksichtigt wird. + Das bedeutet für 'vert max' = 'hor max' = 1, + daß der obere Rand der spezifizierten Zeichenfläche an der + Oberkante der Gesamt-Zeichenfläche, und der rechte Rand an + der rechten Kante des durch die Gesamthöhe der Zeichenfläche + gegebenen Quadrates liegt (unverzerrt). + Soll die gesamte Zeichenfläche genutzt werden, so ist 'hor min' + = 'vert min' = 0 und 'vert max' = 1 zu setzen; + 'hor max' dagegen auf das Verhältnis 'Horizontale/Vertikale' !. + Die halbe horizontale Verwendung der Zeichenfläche ist durch + Halbierung des Seitenverhältnisses zu erreichen. + + 1.15 PROC #ib(2," (1.15)")#window *#ie(2," (PROC)")# + (REAL CONST xmin, xmax, ymin, ymax, zmin, zmax) + - Stellt die Fenstergröße der virtuellen Zeichenfläche, zu der die + virtuellen Koordinaten in Bezug gesetzt werden sollen, mittels + der gegenüberliegenden Ecken 'min' und 'max' ein. + + 1.16 PROC #ib(2," (1.16)")#window *#ie(2," (PROC)")# + (REAL CONST xmin, xmax, ymin, ymax) + - s.o., jedoch für zweidimensionale Darstellungen. + + 1.17 PROC #ib(2," (1.17)")#window *#ie(2," (PROC)")# + (BOOL CONST update) + - Die Übergabe von TRUE verursacht die interne Neuberechnung der + Transformationsmatrix beim nächsten 'set values'; die immer dann + notwendig wird, wenn die Zeichenfläche oder das mit 'viewport' + eingestellte virtuelle Fenster verändert werden soll. +#page# + #ib(1)#2.0 Paket: picture#ie(1)# + + 2.1 #ib(2," (2.1)")#TYPE PICTURE *#ie(2,"")# + - Datentyp zur Verwaltung eines einfarbigen Bildes; das aus entwe­ + der zwei- oder dreidimensionalen Objekten besteht. + + 2.2 OP #ib(2," (2.2)")#:= *#ie(2," (OP)")# + (PICTURE VAR dest, PICTURE CONST source) + - Zuweisungsoperator für den Datentyp PICTURE. + + 2.3 PROC #ib(2," (2.3)")#bar *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST width, height, pattern) + - Zeichnet in 'pic' an der aktuellen Position ein Rechteck + 'width/height' mit dem Muster 'pattern', wobei zu beachten ist, daß + die aktuelle X-Position die horizontale Position der vertikalen + Symmetrieachse des Rechtecks angibt. + Als 'pattern' z.Zt. implementiert: + 0 - nicht gefüllt + 1 - halb gefüllt (zeitaufwendig!) + 2 - gefüllt + 3 - horizontal schraffiert + 4 - vertikal schraffiert + 5 - horizontal und vertikal schraffiert + 6 - diagonal rechts schraffiert + 7 - diagonal links schraffiert + 8 - diagonal rechts und links schraffiert + + 2.4 OP #ib(2," (2.4)")#CAT *#ie(2," (OP)")# + (PICTURE VAR dest, PICTURE CONST add) + - Fügt die Bilder 'dest' und 'add' in 'dest' zusammen. + + 2.5 PROC #ib(2," (2.5)")#circle *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y, rad, INT CONST pattern) + - Zeichnet in 'pic' an der Position 'x;y' mit dem Radius 'rad' und dem + Muster 'pattern' gefüllt ('pattern' z.Zt. wirkungslos) + + 2.6 INT PROC #ib(2," (2.6)")#dim *#ie(2," (PROC)")# + (PICTURE CONST pic) + - Liefert die für 'pic' eingestellte Dimensionalität + (2 - zweidimensional; 3 - dreidimensional); wobei die Dimensionali­ + tät mit der ersten Zeichenoperation eingestellt wird. + + 2.7 PROC #ib(2," (2.7)")#draw *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y, z) + - Zeichnet in 'pic' von der aktuellen Position einen Gerade zur + Position 'x;y'. + + 2.8 PROC #ib(2," (2.8)")#draw *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y, z) + - s.o., jedoch für zweidimensionale Bilder. + + 2.9 PROC #ib(2," (2.9)")#draw *#ie(2," (PROC)")# + (PICTURE VAR pic, TEXT CONST text, REAL CONST angle, height, width) + - Zeichnet in 'pic' an der aktuellen Position 'text' in der Größe + 'height/width' unter dem Winkel 'angle'. + + 2.10 PROC #ib(2," (2.10)")#draw *#ie(2," (PROC)")# + (PICTURE VAR pic, TEXT CONST text) + - Zeichnet in 'pic' an der aktuellen Position 'text' in Standardgröße + und normaler Ausrichtung. + + 2.11 PROC #ib(2," (2.11)")#draw cm *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x cm, y cm) + - Zeichnet in 'pic' eine Gerade zur cm-Position 'x;y', d.h., die Projek­ + tionseinstellung wird nicht beachtet. + + 2.12 PROC #ib(2," (2.12)")#draw cm r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx cm, dy cm) + - Zeichnet in 'pic' eine Gerade zur um 'dx cm;dy cm' verschobenen + Zeichenposition, d.h, die Projektionseinstellung wird nicht beach­ + tet. + + 2.13 PROC #ib(2," (2.13)")#draw r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy, dz) + - Zeichnet in 'pic' eine Gerade der Länge 'dx;dy;dz' relativ zur + aktuellen Position. + + 2.14 PROC #ib(2," (2.14)")#draw r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy) + - s.o., jedoch für zweidimensionale Bilder. + + 2.15 PROC #ib(2," (2.15)")#extrema *#ie(2," (PROC)")# + (PICTURE CONST pic, REAL VAR x min, x max, y min, y max, z min, z max) + - Trägt in die übergebenen Variablen die grössten und kleinsten + Koordinaten aller Objekte in 'pic' ein. + + 2.16 PROC #ib(2," (2.16)")#extrema *#ie(2," (PROC)")# + (PICTURE CONST pic, REAL VAR x min, x max, y min, y max) + - s.o., jedoch für zweidimensionale Bilder. + + 2.17 INT PROC #ib(2," (2.17)")#length *#ie(2," (PROC)")# + (PICTURE CONST pic) + - Liefert die Länge des Objekt-Verwaltungstextes von 'pic'. + + 2.18 PROC #ib(2," (2.18)")#move *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y, z) + - Fährt den Zeichenstift auf 'pic' an die Position 'x;y;z'. + + 2.19 PROC #ib(2," (2.19)")#move *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y) + - s.o., jedoch für zweidimensionale Bilder. + + 2.20 PROC #ib(2," (2.20)")#move cm *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x cm, y cm) + - Die aktuelle Zeichenposition wird auf 'x cm;y cm' verschoben, wobei + die Darstellungsart unberücksichtigt bleibt. + + 2.21 PROC #ib(2," (2.21)")#move cm r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST d xcm, d ycm) + - Die aktuelle Zeichenposition wird um 'd xcm;d ycm' verschoben, + wobei die Darstellungsart unberücksichtigt bleibt. + + 2.22 PROC #ib(2," (2.22)")#move r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy, dz) + - Verschiebt die aktuelle Zeichenposition in 'pic' um 'dx;dy;dz'. + + 2.23 PROC #ib(2," (2.23)")#move r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy) + - s.o., jedoch für zweidimensionale Bilder. + + 2.24 PICTURE PROC #ib(2," (2.24)")#nilpicture *#ie(2," (PROC)")# + - Initialisierungsfunktion; liefert 'leeres Bild'. + + 2.25 INT PROC #ib(2," (2.25)")#pen *#ie(2," (PROC)")# + (PICTURE CONST pic) + - Liefert den für 'pic' eingestellten Stift (Nummer 1 - 16). + + 2.26 PROC #ib(2," (2.26)")#pen *#ie(2," (PROC)")# + (PICTURE VAR pic, INT CONST no) + - Stellt den Stift 'no' für 'pic' ein, wobei 'no' die Werte 1 - 16 an­ + nehmen darf. + + 2.27 PICTURE PROC #ib(2," (2.27)")#picture *#ie(2," (PROC)")# + (TEXT CONST objects) + - Die Objektbeschreibung aller Objekte eines Bildes wird in einem + Text verwaltet; mit dieser Prozedur wird ein TEXT im entsprechen­ + den Format in ein PICTURE verwandelt. + Das Format des TEXTes: Dimension : 2- oder 3-D + Zeichenstift-Nummer + <...> Objekteinträge + + Die Objekteinträge haben folgendes Format: + Objektcode <...> Parameter. + + Objektcodes für: > Die Parameter entsprechen der + - draw 1 Parameterfolge der Prozeduren. + - move 2 + - text 3 > Vor dem Text wird als die + - move r 4 Textlänge gehalten. + - draw r 5 + - move cm 6 + - draw cm 7 + - move cm r 8 + - draw cm r 9 + - bar 10 + - circle 11 + + 2.28 PROC #ib(2," (2.28)")#rotate *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST alpha, beta, gamma) + - Die Objekte von 'pic' werden gemäß den Winkeln 'alpha;beta;gamma' + im positiven Sinne um die X-,Y-,Z-Achse gedreht; wobei nur ein + Winkel <> 0.0 sein darf. + + 2.29 PROC #ib(2," (2.29)")#rotate *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST alpha) + - Die Objekte von 'pic' werden gemäß dem Winkel 'alpha' im positiven + Sinne um die X-Achse gedreht. + + 2.30 PROC #ib(2," (2.30)")#stretch *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST xc, yc, zc) + - 'pic' wird um die Faktoren 'xc;yc;zc' gestreckt oder gestaucht: + Faktor > 1 -> Streckung + Faktor < 1 -> Stauchung + Faktor < 0 -> zusätzlich Achsenspiegelung + + 2.31 PROC #ib(2," (2.31)")#stretch *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST xc, yc) + - s.o., jedoch für zweidimensionale Bilder. + + 2.32 TEXT PROC #ib(2," (2.32)")#text *#ie(2," (PROC)")# + (PICTURE CONST pic) + - Liefert den Objekt-Verwaltungstext von 'pic'(vergleiche + 'picture'). + + 2.33 PROC #ib(2," (2.33)")#translate *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy, dz) + - 'pic' wird um 'dx;dy;dz' verschoben. + + 2.34 PROC #ib(2," (2.34)")#translate *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy) + - s.o., jedoch für zweidimensionale Bilder. + + 2.35 PROC #ib(2," (2.35)")#where *#ie(2," (PROC)")# + (PICTURE CONST pic, REAL VAR x, y, z) + - Trägt die aktuelle Zeichenposition in 'pic' in die übergebenen + Variablen 'x;y;z' ein. + + 2.36 PROC #ib(2," (2.36)")#where *#ie(2," (PROC)")# + (PICTURE CONST pic, REAL VAR x, y) + - s.o., jedoch für zweidimensionale Bilder. +#page# + #ib(1)#3.0 Paket: 'picfile'#ie(1)# + + 3.1 #ib(2," (3.1)")#TYPE PICFILE#ie(2,"")# + - Datentyp zur Verwaltung mehrerer Bilder (PICTUREs) und der + Darstellungsparameter.(Aktuelle Typnummer: 1102 !). + + 3.2 OP #ib(2," (3.2)")#:= *#ie(2," (OP)")# + (PICFILE VAR dest, DATASPACE CONST source) + - Assoziiert das PICFILE 'dest' mit dem DATASPACE 'source'. + + 3.3 OP #ib(2," (3.3)")#:= *#ie(2," (OP)")# + (PICFILE VAR dest, PICFILE CONST source): + - Assoziiert das PICFILE 'dest' mit 'source'; wie bei Files entsteht + keine Kopie! + + 3.4 INT PROC #ib(2," (3.4)")#background *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Liefert die auf 'pf' eingestellte Hintergrundfarbe. + + 3.5 PROC #ib(2," (3.5)")#background *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST no) + - Stellt die Farbe 'no' als Hintergrundfarbe für 'pf' ein: + + 3.6 PROC #ib(2," (3.6)")#delete picture *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Löscht das aktuelle Bild in 'pf'. + + 3.7 PROC #ib(2," (3.7)")#down *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Positioniert in 'pf' ein Bild weiter. + + 3.8 PROC #ib(2," (3.8)")#down *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST step) + - Positioniert in 'pf' 'step'-Bilder weiter. + + 3.9 BOOL PROC #ib(2," (3.9)")#eof *#ie(2," (PROC)")# + (PICFILE CONST) + - Liefert zurück, ob das aktuelle Bild auch das letzte des PICFILES + ist. + + 3.10 PROC #ib(2," (3.10)")#extrema *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL VAR x min, x max, y min, y max, z min, z max) + - Trägt in die übergebenen Variablen die kleinsten bzw. größten + Koordinaten aller Bilder in 'pf' ein. + + 3.11 PROC #ib(2," (3.11)")#extrema *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL VAR x min, x max, y min, y max) + - s.o., jedoch für zweidimensionale PICFILEs. + + 3.12 PROC #ib(2," (3.12)")#get *#ie(2," (PROC)")# + (PICFILE VAR pf, FILE VAR source) + - Liest die in 'source' enthaltenen Informationen über Bilder nach + 'pf' ein. + + 3.13 PROC #ib(2," (3.13)")#get values *#ie(2," (PROC)")# + (PICFILE CONST pf, ROW 3 ROW 2 REAL VAR,ROW 2 ROW 2 REAL VAR, + ROW 4 REAL VAR, ROW 2 REAL VAR, ROW 3 REAL VAR) + - Trägt die Werte der Transformationsmatrix von 'pf' in die über­ + gebenen Variablenfelder ein. + + 3.14 PROC #ib(2," (3.14)")#insert picture *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Fügt vor das aktuelle Bild von 'pf' ein leeres Bild ein. + + 3.15 BOOL PROC #ib(2," (3.15)")#is first picture *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Liefert zurück, ob das aktuelle auch das erste Bild von 'pf' ist. + + 3.16 PROC #ib(2," (3.16)")#oblique *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST a, b) + - Stellt für 'pf' die Projektionsart 'schiefwinklig' ein; 'a;b' ist der + Punkt in der X-Y-Ebene, auf den der Einheitsvektor in Z-Richtung + abgebildet werden soll. + + 3.17 PROC #ib(2," (3.17)")#perspective *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST x, y, z) + - Stellt für 'pf' die Projektionsart 'perspektivisch' ein; 'x;y;z' gibt + den Fluchtpunkt der Zentralperspektive an. + + 3.18 INT PROC #ib(2," (3.18)")#picture no *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Liefert die Nummer des aktuellen Bildes von 'pf' zurück. + + 3.19 INT PROC #ib(2," (3.19)")#pictures *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Liefert die Anzahl der in 'pf' enthaltenen Bilder zurück. + + 3.20 PROC #ib(2," (3.20)")#put *#ie(2," (PROC)")# + (FILE VAR dest, PICFILE CONST pf) + - Liest 'pf' nach 'dest' aus. + + 3.21 PROC #ib(2," (3.21)")#put picture *#ie(2," (PROC)")# + (PICFILE VAR pf, PICTURE CONST ins) + - Fügt das Bild 'ins' vor das aktuelle Bild von 'pf' ein. + + 3.22 PROC #ib(2," (3.22)")#read picture *#ie(2," (PROC)")# + (PICFILE VAR pf, PICTURE VAR pic) + - Trägt das aktuelle Bild von 'pf' in 'pic' ein. + + 3.23 PROC #ib(2," (3.23)")#selected pen *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST no, INT VAR color, thickness, linetype, + BOOL VAR visible) + - Trägt in die übergebenen Variablen die für den Stift 'no' aktuell + eingestellten Werte ein, wobei 'no' die Werte 1 - 16 annehmen darf. + + 3.24 PROC #ib(2," (3.24)")#select pen *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST no, INT CONST color, thickness, linetype, + BOOL CONST visible) + - Stellt für den Stift 'no' von 'pf' die übergebenen Werte für Farbe, + Stiftbreite, Art des Linenzuges ein, wobei 'no' die Werte 1 - 16 + annehmen darf. + 'visible' = FALSE bedeutet, das die mit diesem Stift gezogenen + Linien innerhalb bereits durch das Zeichnen entstandener Flächen + nicht gezeichnet werden, die Flächen sie also 'verdecken'. + Vordefiniert sind: + - color: + <0 - nicht standardisierte XOR-Modi + 0 - Löschstift + 1 - Standardfarbe d. Endgerätes (s/w) + 2 - rot + 3 - blau + 4 - grün + 5 - schwarz + 6 - weiss + n - Sonderfarben + - thickness: + 0 - Standardstrichstärke d. Endgerätes + n - Strichstärke in 1/10 mm + - linetype: + 0 - keine Linie + 1 - durchgängige Linie + 2 - gepunktete Linie + 3 - kurz gesrichelte Linie + 4 - lang gestrichelte Linie + 5 - Strichpunktlinie + (Standard-Definitionen, die Linetypes können + über 'basisplot' auch verändert werden.) + + 3.25 PROC #ib(2," (3.25)")#set values *#ie(2," (PROC)")# + (PICFILE VAR pf, ROW 3 ROW 2 REAL CONST, + ROW 2 ROW 2 REAL CONST, + ROW 4 REAL CONST, + ROW 2 REAL CONST, ROW 3 REAL CONST) + - Die übergebenen Felder werden in die Transformationsmatrix von + 'pf' übernommen. + + 3.26 PROC #ib(2," (3.26)")#to eof *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Positioniert auf das letzte Bild von 'pf'. + + 3.27 PROC #ib(2," (3.27)")#to first pic *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Positioniert auf das erste Bild von 'pf'. + + 3.28 PROC #ib(2," (3.28)")#to pic *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST n) + - Positioniert auf das 'n'-te Bild von 'pf'. + + 3.29 PROC #ib(2," (3.29)")#up *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Positioniert in 'pf' ein Bild zurück. + + 3.30 PROC #ib(2," (3.30)")#up *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST step) + - Positioniert in 'pf' 'step'-Bilder zurück. + + 3.31 PROC #ib(2," (3.31)")#view *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST alpha, phi, theta) + - Stellt für die Abbildung von 'pf' zusätzlich die Drehwinkel der + Abbildung in Polarkoordinaten ein. + In der derzeitigen Version fehlerhaft ! + + 3.32 PROC #ib(2," (3.32)")#view *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST alpha, phi) + - s.o.; in der derzeitigen Version fehlerhaft ! + + 3.33 PROC #ib(2," (3.33)")#view *#ie(2," (PROC)")# + (REAL CONST alpha) + - Dreht das Bild um den Mittelpunkt der Zeichenfläche um 'alpha' + Grad ! + + 3.34 PROC #ib(2," (3.34)")#viewport *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST hor min, hor max, vert min, vert max) + - Spezifiziert die Zeichenfläche, auf die 'pf' abgebildet werden soll. + Siehe dazu auch 'viewport' im 'transformation'-Paket (S. #topage("viewport")#). + + 3.35 PROC #ib(2," (3.35)")#window *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST x min, x max, y min, y max, z min, z max) + - Definiert die virtuelle Zeichenfläche von 'pf'. + + 3.36 PROC #ib(2," (3.36)")#window *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST x min, x max, y min, y max) + - s.o., jedoch für zweidimensionale PICFILEs. + + 3.37 PROC #ib(2," (3.37)")#write picture *#ie(2," (PROC)")# + (PICFILE VAR pf, PICTURE CONST new) + - Überschreibt das aktuelle Bild von 'pf' mit 'new'. +#page# + #ib(1)#4.0 Paket: 'devices'#ie(1)# + + 4.1 #ib(2," (4.1)")#TYPE PLOTTER#ie(2,"")# + - Verwaltungstyp zur Repräsentation eines Endgerätes hinsichtlich + seiner Station, seines Kanals, seines Namens sowie seiner Zeichen­ + fläche. Dabei ist zu beachten, daß der gültige Endgerät- + Descriptor, der zur Selektion verwendet wird, aus Station, Kanal + und Namen besteht; die Namen also nicht eindeutig vergeben + werden müssen. + + 4.2 OP #ib(2," (4.2)")#:=#ie(2," (OP)")# + (PLOTTER VAR dest, PLOTTER CONST source) + - Zuweisungsoperator für den Datentyp 'PLOTTER'. + + 4.3 BOOL OP #ib(2," (4.3)")#=#ie(2," (OP)")# + (PLOTTER CONST left, right) + - Vergleichsoperator für den Datentyp 'PLOTTER'. + + 4.4 INT PROC #ib(2," (4.4)")#actual plotter#ie(2," (PROC)")# + - Liefert die interne Verwaltungsnummer des eingestellten End­ + gerätes (Kein Endgerät eingestellt -> 0). + + 4.5 INT PROC #ib(2," (4.5)")#channel#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Liefert den Kanal von 'plotter'. + + 4.6 PROC #ib(2," (4.6)")#drawingarea#ie(2," (PROC)")# + (REAL VAR x cm, y cm, INT VAR x p, y p) + - Trägt in die übergebenen Variablen die Maße der + Zeichenfläche des eingestellten Endgerätes ein. + + 4.7 PROC #ib(2," (4.7)")#drawingarea#ie(2," (PROC)")# + (REAL VAR x cm, y cm, INT VAR x p, y p, PLOTTER CONST plotter) + - Trägt in die übergebenen Variablen die Maße der Zeichenfläche + von 'plotter' ein. + + 4.8 PROC #ib(2," (4.8)")#install plotter#ie(2," (PROC)")# + (TARGET VAR new descriptors) + - Übergibt dem Verwaltungspacket den zu verwaltenden Satz End­ + geräte. Wird intern vom 'device interface' verwendet, kann aber + auch im nachhinein zur Installation von Endgeräten anderer + Stationen oder zum Ausblenden von Endgeräten dienen. Nachdem + die Graphik installiert wurde, können jedoch keine neuen sta­ + tionseigenen Endgeräte erzeugt werden (oder nur verwaltungs­ + seitig, d.h. die Ansteuerung fehlt). + + 4.9 TEXT PROC #ib(2," (4.9)")#name#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Liefert den Namen von 'plotter' + + 4.10 PLOTTER PROC #ib(2," (4.10)")#no plotter#ie(2," (PROC)")# + - Liefert den Endgerät-Descriptor 'kein Plotter'. + + 4.11 PLOTTER PROC #ib(2," (4.11)")#plotter#ie(2," (PROC)")# + - Liefert den Endgerät-Descriptor des eingestellten Endgerätes. + + 4.12 PLOTTER PROC #ib(2," (4.12)")#plotter#ie(2," (PROC)")# + (TEXT CONST descriptor) + - Liefert den Endgerät-Descriptor des durch 'descriptor' beschrie­ + benen Endgerätes. + 'descriptor' hat folgendes Format: + //Endgerätname, + wobei nicht vorhandene Endgeräte abgelehnt werden. + + 4.13 TEXT PROC #ib(2," (4.13)")#plotterinfo#ie(2," (PROC)")# + (TEXT CONST descriptor, INT CONST length) + - Liefert einen auf die Länge 'length' eingerichteten TEXT, der + 'descriptor' in aufbereiteter Form wiedergibt. + Format von 'descriptor' s.o. + + 4.14 THESAURUS PROC #ib(2," (4.14)")#plotters#ie(2," (PROC)")# + - Liefert alle vorhandenen Endgeräte in Form o.g. Descriptoren. + + 4.15 PROC #ib(2," (4.15)")#select plotter#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Stellt 'plotter' als aktuelles Endgerät ein. + + 4.16 PROC #ib(2," (4.16)")#select plotter#ie(2," (PROC)")# + (TEXT CONST descriptor) + - Stellt das durch 'descriptor' beschriebene Endgerät als aktuelles + Endgerät ein. + + 4.17 PROC #ib(2," (4.17)")#select plotter#ie(2," (PROC)")# + - Bietet eine Auswahl aller Endgeräte an, und stellt das gewählte + als aktuelles Endgerät ein. + + 4.18 INT PROC #ib(2," (4.18)")#station#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Liefert die Stationsnummer von 'plotter' zurück. +#page# +#type("pica")##on("u")##ib(1)#Teil 2.1: Operationen des 'device interface'#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + + Das automatisch vom 'GRAPHIK.Configurator' anhand von Konfigurationsda­ + teien erstellte Paket 'device interface' realisiert die normierte, jedoch von + der Zeichenfläche des Endgeräts abhängige Ansteuerung der verschiedenen + Endgeräte. Es entspricht dabei dem Paket 'Endgerät.Basis' der EUMEL-Graphik, + geht aber teilweise über dessen Leistungen hinaus.Hinweis: Falls diese Lei­ + stung nicht bereits endgerätseitig implementiert ist, wird nicht geclipped; + die Überschreitung der Zeichengrenzen hat also Undefiniertes zur Folge. + Zudem ist die Mehrheit der Prozeduren ausschließlich nach 'initplot' funk­ + tionsfähig. + + #ib(1)#1.0 Paket: 'device interface'#ie(1)# + + 1.1 INT PROC #ib(2," (1.1)")#background#ie(2," (PROC)")# + - Liefert die Nummer der aktuell für den Hintergrund eingestellten + Farbe zurück. + + 1.2 PROC #ib(2," (1.2)")#background#ie(2," (PROC)")# + (INT CONST color no) + - Stellt die Farbe 'color no' als Hintergrundfarbe ein. + + 1.3 PROC #ib(2," (1.3)")#box#ie(2," (PROC)")# + (INT CONST x1, y1, x2, y2, pattern) + - Zeichnet ein Rechteck mit den gegenüberliegenden Ecken 'x1;y1' + und 'x2;y2', das mit dem Muster 'pattern' gefüllt wird, wobei + 'pattern' endgerätspezifisch ist. + + 1.4 PROC #ib(2," (1.4)")#circle#ie(2," (PROC)")# + (INT CONST x, y, rad, from, to) + - Zeichnet an der Stelle 'x;y' einen Kreis (bzw. Kreissegment) des + Radius 'rad' mit dem Anfangswinkel 'from' und dem Endwinkel 'to'. + + 1.5 PROC #ib(2," (1.5)")#clear#ie(2," (PROC)")# + - Initialisiert die Zeichenfläche des aktuellen Endgerätes, wobei + die Zeichenposition auf '0;0' und die Standardfarben + gesetzt werden. + + 1.6 PROC #ib(2," (1.6)")#clear#ie(2," (PROC)")# + (BOOL CONST onoff) + - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe + von 'clear' wirkungslos sind; mit TRUE werden sie entsprechend + wieder aktiviert. + + 1.7 INT PROC #ib(2," (1.7)")#color#ie(2," (PROC)")# + (INT CONST color no) + - Liefert den für die Farbe 'color no' eingestellten Farbwert im + normierten RGB-Code von 0-999. + + 1.8 INT PROC #ib(2," (1.8)")#colors#ie(2," (PROC)")# + - Liefert die Anzahl möglicher Farben für das aktuelle Endgerät. + + 1.9 PROC #ib(2," (1.9)")#draw to#ie(2," (PROC)")# + (INT CONST x, y) + - Zieht von der aktuellen Zeichenposition eine Gerade zur Position + 'x;y'. + + 1.10 PROC #ib(2," (1.10)")#endplot#ie(2," (PROC)")# + - Wartet auf eine Eingabe des Benutzers und beendet dann die + graphische Ausgabe; ggf. durch Umschalten in den Text-Modus. + Falls möglich, sollte die ausgegebene Graphik jedoch auf dem + Bildschirm erhalten bleiben. + + 1.11 PROC #ib(2," (1.11)")#end plot#ie(2," (PROC)")# + (BOOL CONST onoff) + - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe + von 'endplot' wirkungslos sind; mit TRUE werden sie entsprechend + wieder aktiviert. + + 1.12 PROC #ib(2," (1.12)")#fill#ie(2," (PROC)")# + (INT CONST x, y, INT CONST pattern) + - Die Umgebung von 'x;y' wird mit dem Muster 'pattern' gefüllt, wobei + sowohl 'pattern' als auch die genauen Füll-Bedingungen (Art der + Umrahmung usw.) endgerätspezifisch sind. + + 1.13 INT PROC #ib(2," (1.13)")#foreground#ie(2," (PROC)")# + - Liefert die Nummer der aktuell für den Vordergrund eingestellten + Farbe zurück. + + 1.14 PROC #ib(2," (1.14)")#foreground#ie(2," (PROC)")# + (INT CONST color no) + - Stellt die Farbe 'color no' als Vordergrundfarbe ein. + + 1.15 PROC #ib(2," (1.15)")#get cursor#ie(2," (PROC)")# + (INT VAR x, y, TEXT VAR exit char) + - Nach Aufruf dieser Prozedur sollte das Endgerät die Eingabe + einer Position mittels eines graphischen Cursors (i.d.R. + Fadenkreuz) ermöglichen. Dieser Modus soll bleibt solange auf­ + rechterhalten bis eine Taste gedrückt wird; in 'x;y' findet sich + dann die Position des Cursors, und in 'exit char' die gedrückte + Taste. + Diese Prozedur ist jedoch nicht für das Ein bzw. Ausschalten des + graphischen Cursors zuständig, d.h der eingeschaltete Cursor ist + ständig sichtbar; bei ausgeschaltetem Cursor kehrt die Prozedur + sofort mit 'exit char' = ""0"" zurück. + + 1.16 BOOL PROC #ib(2," (1.16)")#graphik cursor#ie(2," (PROC)")# + - Diese Prozedur gibt an, ob graphische Eingabeoperationen und + die dazugehörigen Operationen auf dem aktuellen Endgerät ver­ + fügbar sind. + + 1.17 PROC #ib(2," (1.17)")#graphik cursor#ie(2," (PROC)")# + (INT CONST x, y, BOOL CONST onoff) + - Diese Prozedur schaltet den graphischen Cursor an bzw. aus oder + positioniert ihn. Nach dem Einschalten sollte der Cursor perma­ + nent sichtbar sein. Ein erneutes Einschalten hat die + Neupositionierung des Cursors zur Folge. + + 1.18 PROC #ib(2," (1.18)")#home#ie(2," (PROC)")# + - Positioniert die aktuelle Zeichenposition auf den Punkt '0;0'; bei + eingeschaltetem graphischen Cursor diesen auf die Mitte der + Zeichenfläche. + + 1.19 PROC #ib(2," (1.19)")#init plot#ie(2," (PROC)")# + - Initialisiert das aktuelle Endgerät zur graphischen Ausgabe, + (schaltet ggf. in den Graphik-Modus), wobei der Bildschirm jedoch + möglichst nicht gelöscht werden sollte. + + 1.20 PROC #ib(2," (1.20)")#move to#ie(2," (PROC)")# + (INT CONST xp, yp) + - Die Position 'xp;yp' wird neue Stiftposition; die Wirkung ist unde­ + finiert bei Überschreitung der Bildschrimgrenzen. + + 1.21 PROC #ib(2," (1.21)")#prepare#ie(2," (PROC)")# + - Bereitet die Ausgabe auf einem Endgerät vor; d.h. die Task wird an + den entsprechenden Kanal angekoppelt, und andere Tasks am An­ + koppeln gehindert (z.B. 'stop' des PRINTER-Servers). Dabei wird die + Prozedur erst dann verlassen, wenn die Aktion erfolgreich been­ + det ist. (z.B. bis zur Freigabe des Kanals). + + + 1.22 PROC #ib(2," (1.22)")#set color#ie(2," (PROC)")# + (INT CONST no, rgb) + - Setzt die Farbe von 'no' auf die normierte RGB-Farbkombination + 'rgb' (0 - 999). + + 1.23 PROC #ib(2," (1.23)")#setmarker#ie(2," (PROC)")# + (INT CONST xp, yp, type) + - Zeichnet an der Position 'xp;yp' eine Markierung; wobei die Wir­ + kung bei Überschreitung der Bildschirmgrenzen undefiniert ist. + Als 'type' sollten vorhanden sein: + 0 - Kreuz '+' + 1 - Kreuz diagonal 'x' + - weitere beliebig + + 1.24 PROC #ib(2," (1.24)")#setpalette#ie(2," (PROC)")# + - Initialisiert die Farben des Endgerätes gemäß den im Paket ge­ + setzten Farben. + + 1.25 PROC #ib(2," (1.25)")#setpixel#ie(2," (PROC)")# + (INT CONST xp, yp) + - Setzt das Pixel 'xp;yp' in der aktuellen Schreibfarbe. + + 1.26 PROC #ib(2," (1.26)")#stdcolors#ie(2," (PROC)")# + - Initialisiert die Paket-Intern verwendete Farbtabelle auf die + standardmäßig für das Endgerät definierten Farben; + wobei die Farben jedoch nicht auf dem Endgerät eingestellt + werden. + + 1.27 PROC #ib(2," (1.27)")#stdcolors#ie(2," (PROC)")# + (BOOL CONST onoff) + - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe + von 'stdcolors' wirkungslos sind; mit TRUE werden sie entspre­ + chend wieder aktiviert. +#page# +#type("pica")##on("u")##ib(1)#Teil 2.2: Operationen zur Graphik-Ausgabe#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Die Pakete zur Ausgabe von Graphiken (PICFILES) sind in der Datei + 'GRAPHIK.Basis' enthalten, und realisieren folgende Leistungen: + - Im Datentyp PICTURE bzw. PICFILE in Codierter Form verwendete Ausgabe­ + prozeduren auf einzelne Objekte unter Berücksichtigung der Abbil­ + dungsparameter und Zeichenfläche. + - Kommunikations- und Kontrolloperationen auf die Task 'PLOT' zur + indirekten Ausgabe von PICFILES. + - Ausgabeoperationen auf den Datentyp PICTURE bzw. PICFILE unter Be­ + rücksichtung des eingestellten Endgerätes. + Wird für die Angabe von Koordinaten der Typ REAL verwendet, so handelt es + sich um virtuelle Koordinaten, d.h. die Ausgabe-Parameter wie 'viewport' und + 'window' werden berücksichtigt; bei Verwendung von INT ist die Ausgabe end­ + gerätspezifisch. + + #ib(1)#2.0 Paket: 'basisplot'#ie(1)# + + 2.1 PROC #ib(2," (2.1)")#bar *#ie(2," (PROC)")# + (INT CONST x, y, height, width, pattern) + - Zeichnet an der Position 'x;y' ein Rechteck der Länge/Breite + 'width/height' mit dem Muster 'pattern', wobei 'x;y' die untere linke + Ecke des Rechtecks angibt. + Als 'pattern' z.Zt. implementiert: + 0 - nicht gefüllt + 1 - halb gefüllt + 2 - gefüllt + 3 - horizontal schraffiert + 4 - vertikal schraffiert + 5 - horizontal und vertikal schraffiert + 6 - diagonal rechts schraffiert + 7 - diagonal links schraffiert + 8 - diagonal rechts und links schraffiert + + 2.2 PROC #ib(2," (2.2)")#bar *#ie(2," (PROC)")# + (REAL CONST height, width, INT CONST pattern) + - siehe oben, jedoch mit Ausgangspunkt an der aktuellen Zeichen­ + position, wobei zu beachten ist, daß die x-Koordinate die horizon­ + tale Position der vertikalen Symmetrieachse des Rechtecks angibt. + + 2.3 PROC #ib(2," (2.3)")#beginplot#ie(2," (PROC)")# + - Leitet die graphische Ausgabe ein, wobei das Endgerät in seinen + Startzustand versetzt wird, und dem Transformationspaket die + Abmessungen der Zeichenfläche mitgeteilt werden. + + 2.4 PROC #ib(2," (2.4)")#box *#ie(2," (PROC)")# + - Zeichnet eine Umrahmung der gesamten Zeichenfläche (Nicht nur + des verwendeten Teiles). + + 2.5 PROC #ib(2," (2.5)")#circle *#ie(2," (PROC)")# + (REAL CONST rad, from, to, INT CONST pattern) + - Zeichnet an aktuellen Position einen Kreis od. ein Kreissegment + des Radius 'rad'; beginnend bei 'from' bis zum Endwinkel 'to' und + gefüllt mit dem Muster 'pattern' ('pattern' z.Zt. nicht + implementiert). + + 2.6 PROC #ib(2," (2.6)")#draw *#ie(2," (PROC)")# + (INT CONST x, y) + - Zeichnet von der aktuellen Position eine Gerade zur Position 'x;y'. + + 2.7 PROC #ib(2," (2.7)")#draw *#ie(2," (PROC)")# + (INT CONST x0, y0, x1, y1) + - Zieht eine Gerade von der Position 'x0;y0' bis zur Position 'x1;y1'. + + 2.8 PROC #ib(2," (2.8)")#draw *#ie(2," (PROC)")# + (REAL CONST x, y, z) + - Zieht von der aktuellen Zeichenposition eine Gerade zur + (transformierten) 3-D Position 'x;y;z'. + + 2.9 PROC #ib(2," (2.9)")#draw *#ie(2," (PROC)")# + (REAL CONST x, y) + - s.o., jedoch für zweidimensionale Bilder. + + 2.10 PROC #ib(2," (2.10)")#draw *#ie(2," (PROC)")# + (TEXT CONST text, REAL CONST angle, height, width) + - Zeichnet den TEXT 'text' ab der aktuellen Zeichenposition unter + dem Winkel 'angle' und in der Höhe/Breite 'height;width'. + + 2.11 PROC #ib(2," (2.11)")#draw *#ie(2," (PROC)")# + - s.o., jedoch in Standard-Ausrichtung (0 Grad) und + Standard-Höhe/Breite (0.5/0.5). + + 2.12 PROC #ib(2," (2.12)")#draw cm *#ie(2," (PROC)")# + (REAL CONST x cm, y cm) + - Zeichnet von der aktuellen Position eine Gerade zur cm-Position + 'x cm;y cm'. + + 2.13 PROC #ib(2," (2.13)")#draw cm r *#ie(2," (PROC)")# + (REAL CONST x cm, REAL CONST y cm) + - Zieht von der aktuellen Zeichenposition eine Gerade zur um 'x cm; + y cm' verschobenen Zielposition. + + 2.14 PROC #ib(2," (2.14)")#draw r *#ie(2," (PROC)")# + (REAL CONST dx, dy) + - Zieht von der aktuellen Zeichenposition eine Gerade zur um 'dx;dy' + Einheiten verschobenen Zielposition. + + 2.15 PROC #ib(2," (2.15)")#draw r *#ie(2," (PROC)")# + (REAL CONST dx, dy, dz) + - Zeichnet von der aktuellen Zeichenposition eine Gerade zur um + 'dx;dy;dz' Einheiten verschobenen und transformierten 3-D Ziel­ + position. + + 2.16 PROC #ib(2," (2.16)")#hidden lines *#ie(2," (PROC)")# + (BOOL CONST visible) + - Schaltet die vektorisierte Speicherung aller zukünftigen Aus­ + gabe ein (FALSE) bzw. aus.Ist dieser Modus eingeschaltet, so werden + alle durch vorheriges Zeichnen entstandenen Flächen beim Zeichen + berücksichtigt, also nicht übermalt; sie 'verdecken' die weiteren + Linien. + + 2.17 PROC #ib(2," (2.17)")#linetype#ie(2," (PROC)")# + (INT CONST line no, TEXT CONST bitpattern) + - Stellt für den Linientyp 'line no' das Bitmuster 'bitpattern' ein; + wobei der 'bitpattern'-TEXT ausschließlich aus den Zeichen '0' und + '1' bestehen sollte. + + 2.18 PROC #ib(2," (2.18)")#move *#ie(2," (PROC)")# + (INT CONST x,y) + - Zeichnet von der aktuellen Position eine Gerade zur Position 'x;y'. + + 2.19 PROC #ib(2," (2.19)")#move *#ie(2," (PROC)")# + (REAL CONST x, y, z) + - Zeichnet von der aktuellen Position eine Gerade zur trans­ + formierten 3-D-Position 'x;y;z' + + 2.20 PROC #ib(2," (2.20)")#move *#ie(2," (PROC)")# + (REAL CONST x, y) + - s.o., jedoch für zweidimensionale Bilder. + + 2.21 PROC #ib(2," (2.21)")#move cm#ie(2," (PROC)")# + (REAL CONST x cm, y cm) + - Setzt die aktuelle Zeichenposition auf die cm-Position 'x cm,;y cm'. + + 2.22 PROC #ib(2," (2.22)")#move cm r *#ie(2," (PROC)")# + (REAL CONST d x cm, d y cm) + - Zeichnet von der aktuellen Position eine Gerade zur um + 'd x cm;d y cm' verschobenen Zielposition. + + 2.23 PROC #ib(2," (2.23)")#move r *#ie(2," (PROC)")# + (REAL CONST d x, d y, d z) + - Zeichnet von der aktuellen Position eine Gerade zur um 'd x;d y;d z' + Einheiten verschobenen und transformierten Zielposition. + + 2.24 PROC #ib(2," (2.24)")#move r *#ie(2," (PROC)")# + (REAL CONST d x, d y) + - s.o., jedoch für zweidimensionale Bilder. + + 2.25 PROC #ib(2," (2.25)")#pen *#ie(2," (PROC)")# + (INT CONST background, foreground, thickness, linetype) + - Aktiviert für alle folgenden Ausgaben mit virtuellen Koordi­ + naten den Hintergrund 'background'; die Schreibfarbe + 'foreground'; die Zeichenstärke 'thickness' in 1/10 mm und den + Linientyp 'linetype' (i.d.R. 1-6). Vergleiche 'select pen'. + + 2.26 PROC #ib(2," (2.26)")#reset *#ie(2," (PROC)")# + - Die mit 'hidden lines (FALSE)' vektorisiert abgespeicherte + Ausgabe wird gelöscht. + + 2.27 PROC #ib(2," (2.27)")#reset linetypes *#ie(2," (PROC)")# + - Setzt die Linientypen 1-6 auf Standard-Linientypen: 1 - durch­ + gängige Linie + 2 - gepunktete Linie + 3 - kurz gestrichelte Linie + 4 - lang gestrichelte Linie + 5 - Strichpunktlinie + + 2.28 PROC #ib(2," (2.28)")#reset zeichensatz *#ie(2," (PROC)")# + - Setzt den Zeichensatz auf den Standard-Zeichensatz 'ZEICHENSATZ'. + + 2.29 PROC #ib(2," (2.29)")#where *#ie(2," (PROC)")# + (REAL VAR x, y, z) + - Trägt die aktuelle Zeichenposition als (retransformierte) 3-D + Position in die übergeben Variablen ein. + + 2.30 PROC #ib(2," (2.30)")#where *#ie(2," (PROC)")# + (REAL VAR x, y) + - s.o., jedoch für zweidimensionale Bilder. + + 2.31 PROC #ib(2," (2.31)")#zeichensatz *#ie(2," (PROC)")# + (TEXT CONST zeichenname) + - Lädt den Zeichensatz 'zeichenname' zur Verwendung bei Beschrif­ + tungen. +#page# + #ib(1)#3.0 Paket: 'plot interface'#ie(1)# + + 3.1 THESAURUS OP #ib(2," (3.1)")#ALL#ie(2," (OP)")# + (PLOTTER CONST plotter) + - Liefert die Namen der z.Zt. im Spool 'plotter' zur indirekten + Graphik-Ausgabe gespoolten task-eigenen PICFILES. + Bei Aufruf aus 'GRAPHIK' werden die Namen aller zur Ausgabe + gespoolten PICFILES geliefert. + + 3.2 PROC #ib(2," (3.2)")#erase#ie(2," (PROC)")# + (TEXT CONST picname, PLOTTER CONST plotter) + - Löscht nach Rückfrage das im Spool 'plotter' zur indirekten + Graphik-Ausgabe gespoolte task-eigene PICFILE 'picname'. + Bei Aufruf aus 'GRAPHIK' ist auch das Löschen fremder zur Ausgabe + gespoolter PICFILES möglich. + + 3.3 PROC #ib(2," (3.3)")#erase#ie(2," (PROC)")# + (THESAURUS CONST piclist, PLOTTER CONST plotter) + - Löscht im Dialog alle in 'piclist' und im Spool 'plotter' zur in­ + direkten Graphik-Ausgabe gespoolten task-eigenen PICFILES. + Bei Aufruf aus 'GRAPHIK' ist auch das Löschen fremder zur Ausgabe + gespoolter PICFILES möglich. + + 3.4 BOOL PROC #ib(2," (3.4)")#exists#ie(2," (PROC)")# + (TEXT CONST picname, PLOTTER CONST plotter) + - Liefert zurück, ob z.Zt. im Spool 'plotter' ein task-eigenes PICFILE + 'picname' zur indirekten Graphik-Ausgabe gespoolt wird. + Bei Aufruf aus 'GRAPHIK' kann auch die Existenz fremder zur Aus­ + gabe gespoolter PICFILES erfragt werden. + + 3.5 PROC #ib(2," (3.5)")#first#ie(2," (PROC)")# + (TEXT CONST picname, PLOTTER CONST plotter) + - Zieht das im Spool 'plotter' zur indirekten Ausgabe gespoolte + PICFILE 'picname' an die erste Stelle der Warteschlange. Der Auf­ + ruf ist nur aus 'GRAPHIK' zulässig. + + 3.6 PROC #ib(2," (3.6)")#generate plotmanager#ie(2," (PROC)")# + - Erzeugt die Task 'PLOT', in der dann im Hintergrund der Plot­ + manager insertiert wird. Dabei darf 'PLOT' zuvor nicht existieren, + und in der Task muß die Datei 'GRAPHIK.Manager' vorhanden sein. + + 3.7 PROC #ib(2," (3.7)")#halt#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Unterbindet die weitere indirekte Graphik-Ausgabe aus dem Spool + 'plotter'; eine aktuell laufende Ausgabe wird jedoch nicht ab­ + gebrochen. Der Aufruf ist nur aus 'GRAPHIK' zulässig. + + 3.8 PROC #ib(2," (3.8)")#list#ie(2," (PROC)")# + (FILE VAR list file, PLOTTER CONST plotter) + - Erzeugt in 'list file' eine Inhalts/Aktivitätsübersicht des Spools + 'plotter'. + + 3.9 PROC #ib(2," (3.9)")#list#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Zeigt eine Inhalts/Aktivitätsübersicht des Spools 'plotter'. + + 3.10 THESAURUS PROC #ib(2," (3.10)")#picfiles#ie(2," (PROC)")# + - Liefert eine Liste der Namen aller in der Task enthaltenen + PICFILES. + + 3.11 PROC #ib(2," (3.11)")#save#ie(2," (PROC)")# + (TEXT CONST picname, PLOTTER CONST plotter) + - Sendet das PICFILE 'picname' zwecks indirekter Graphik-Ausgabe + zum Spool 'plotter'. + + 3.12 PROC #ib(2," (3.12)")#save#ie(2," (PROC)")# + (THESAURUS CONST piclist, PLOTTER CONST plotter) + - Sendet alle in 'piclist' namentlich enthaltenen PICFILES zwecks + indirekter Graphik-Ausgabe zum Spool 'plotter'. + + 3.13 PROC #ib(2," (3.13)")#start#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Nimmt die zuvor mit 'halt','wait for halt','stop' oder spoolseitig + unterbrochene indirekte Graphik-Ausgabe des Spools 'plotter' + wieder auf. Der Aufruf ist nur aus 'GRAPHIK' zulässig. + + 3.14 PROC #ib(2," (3.14)")#stop#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Unterbricht sofort die aktuell laufende Ausgabe des Spools + 'plotter', und unterbindet weitere Ausgaben. Nach Rückfrage wird + das PICFILE, das aktuell ausgegeben wurde, erneut an erster + Steller der Warteschlange eingetragen. + + 3.15 PROC #ib(2," (3.15)")#wait for halt#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Unterbindet die weitere Ausgabe der + gespoolten PICFILES, und wartet bis die aktuell laufende Ausgabe + beendet ist. +#page# + #ib(1)#4.0 Paket: 'plot'#ie(1)# + + 4.1 PROC #ib(2," (4.1)")#plot *#ie(2," (PROC)")# + (PICTURE CONST picture) + - Ausgabe der Objektebene 'picture', unter Verwendung des in + 'picture' angegebenen Stiftes gemäß seiner aktuellen Einstellung + im 'basisplot'.Nur für Direkt-Ausgaben verwendbar. + + 4.2 PROC #ib(2," (4.2)")#plot *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Ausgabe des Bildes 'pf' unter vollständiger Berücksichtung der in + 'pf' mit 'select pen';'window';'viewport' usw. eingestellten + Ausgabeparameter. Nur für Direkt-Ausgaben verwendbar. + + 4.3 PROC #ib(2," (4.3)")#plot *#ie(2," (PROC)")# + (TEXT CONST picfile name) + - Direkte oder indirekte Ausgabe des Bildes 'picfile name'. + Bei direkter Ausgabe wird obiges 'plot' verwendet; bei indirekter + Ausgabe wird das PICFILE an den aktuell eingestellten Spool zur + graphischen Ausgabe gesendet. +#page# +#bottom# +#right#Seite % +#end# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Teil 3: Konfigurierung der Graphik +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Teil 3: Konfigurierung der Graphik#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + +#type("pica")##on("u")##ib(1)#Teil 3.1: Der Graphik-Konfigurator#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# +#goalpage("newconf")# + Die MPG-EUMEL-Graphik besitzt eine normierte Schnittstelle zu allen graphischen + Endgeräten. Diese wird vom Programm 'GRAPHIK.Configurator' aus verschiede­ + nen Dateien, die einer gewissen Syntax zu genügen haben, zu einem Paket + namens 'device interface' zusammengefügt. Diese Dateien enthalten verschie­ + dene Informationen und endgerätspezifische ELAN-Prozeduren, die zur + Erzeugung graphischer Primitiva wie Gerade, Kreis, Rechteck und zur Be­ + rechnung der konkreten Abbildung graphischer Objekte sowie zur Realisa­ + tion von Eingaben benötigt werden. Das Konfigurationsprogramm erkennt + diese Dateien an der Namensendung '.GCONF', und bietet diese zu + Programmbeginn zur Auswahl an. + Dann werden die gewählten Dateien inhaltlich untersucht und die relevan­ + ten Informationen, Rümpfe der benötigten Prozeduren sowie alle vom Benut­ + zer zusätzlich eingetragenen globalen Objekte (globale Variablen, + LET-Objekte, zusätzlich benötigte Prozeduren usw.) vom Programm extrahiert + und zwischengespeichert. + Im letzten Schritt erstellt das Programm schließlich das Paket 'device + interface' in der Datei 'GRAPHIK.Configuration', indem die zwischengespei­ + cherten Texte sinnvoll zusammengefügt werden. + Die benötigten Konfigurationsdateien sind relativ einfach zu erstellen, da + sich der Programmierer ausschließlich mit der Realisation der geforderten + Leistungen auf einem Endgerät-Typ befassen kann, da die programmseitige + Einbindung ins Graphiksystem vom Konfigurationsprogramm vorgenommen + wird. +#page# +#type("pica")##on("u")##ib(1)#Teil 3.2: Erstellung der Konfigurationsdateien#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Namensgebung: ".GCONF" + Konfigurationsdateien zur Anbindung eines Endgerät-Types auf der + eigenen Station enthalten die benötigten ELAN-Quelltexte zur Realisa­ + tion der geforderten Leistungen und weitere Verwaltungs- und Berech­ + nungsoperationen. + Das Konfigurationsprogramm erkennt die relevanten Daten bzw. Quelltexte + dieser Dateien an verschiedenen Pseudo-Schlüsselworten bzw. Pseudo- + Prozedurdeklarationen, wobei die Namensgebung hinsichtlich des Pro­ + zedurnamens, der Parameter sowie ihrer Namen vollständig festgelegt ist. + Daher ist es unzulässig, Parameternamen zu ändern oder Delimiter + (Semikolon, Doppelpunkt) fortzulassen. + Derartige Fehler werden jedoch i.d.R. vom Konfigurationsprogramm + erkannt und gemeldet, wohingegen Fehler in den Prozedurrümpfen, den + zusätzlichen Prozeduren bzw. das Fehlen zusätzlich benötigter Pro­ + zeduren nicht erkannt, sondern erst beim Compilieren des Gesamt-Paketes + vom ELAN-Compiler gemeldet werden. + (Die Korrektur im Gesamt-Paket sollte unterlassen werden, vielmehr ist + der Fehler in der entsprechenden Konfigurationsdatei zu beheben, falls + nicht einfach die Einbindung eines zusätzlichen Paketes vergessen + wurde.) + Zudem ist zu beachten, daß die benötigten Prozedurrümpfe vom Kon­ + figurationsprogramm in Refinements umgewandelt werden, und zusätz­ + liche Objekte (Prozeduren, LET-Objekte, Variablen) einfach mit ein­ + gebunden werden, so daß: + - Globale und lokale Variablen eindeutig für alle! Konfigurations­ + dateien benannt werden müssen. + (Zweckmässig: ... VAR endgerätname variablenname) + - Zusätzliche Prozeduren und LET-Objekte ebenso eindeutig benannt + werden müssen. + - Überflüssige Delimiter, die aber vom ELAN-Compiler nicht bemängelt + werden (z.B. Punkt am Ende des Prozedurrumpfes) nicht vorkommen + dürfen. + - Nicht realisierbare Pseudo-Prozeduren mit leerem Rumpf enthalten + sein müssen (z.B. Vordergrund/Hintergrund od. Farben bei + Monochrom-Endgeräten) + - Prozedur-Köpfe bzw. -Enden allein in einer Zeile und an ihrem Anfang + stehen müssen. + + Namensgebung: "ENVIRONMENT.GCONF" + Dient zur verwaltungsseitigen Einbindung von Endgeräten anderer + Stationen, da für diese Endgeräte nur die Verwaltungsinformationen + benötigt werden, weil die konkrete Anpassung auf der anderen Station + erfolgt. + Die in 'ENVIRONMENT.GCONF' zeilenweise enthaltenen Informationen werden + dem Benutzer bei der Auswahl der Konfigurationsdateien mit angeboten; er + kann sie aber auch 'von Hand' in die THESAURUS-Auswahl einfügen. + + Namensgebung: "Dateizweck" (also beliebig) + Darüberhinaus existieren weitere Dateien, die globale Prozeduren und + weitere Objekte enthalten, die für verschiedene Endgerät-Anpassungen + nützlich sein können, wie z.B. unten beschriebene Dateien: + - 'std primitives' + Enthält Prozeduren zur softwareseitigen Emulation von zwar gefor­ + derten, hardwareseitig aber eventuell nicht bereitgestellten + Leistungen wie 'circle' und 'box'. + - 'matrix printer' + Enthält Prozeduren zur Erzeugung von Geraden und Füllmustern auf + einer Bitmatrix, die zur graphischen Ausgabe auf Druckern benötigt + wird. + - 'terminal plot' + Enthält grundlegende Prozeduren zur (behelfsmäßigen) Ausgabe von + Graphiken auf Ascii-Terminals (Zeichenorientiert, nicht graphikfähig) + + Folgende Pseudo-Schlüsselworte bzw. Pseudo-Prozeduren werden vom + Konfigurationsprogramm erkannt und behandelt: + + #ib(1)#1.0 Pseudo-Schlüsselworte#ie(1)# + + 1.1 #ib(2," (1.1)")#COLORS#ie(2,"")# + Syntax: COLORS "RGB-Kombinationen"; + - Dient der Definition der Standard-Farben. + - "RGB-Kombinationen": (TEXT) Pro Farbe 3-ziffrige RGB- + (Rot-Grün-Blau)- + Kombinationen in normierter + Notation + (jeder Farbanteil wird durch + die Ziffern 0-9 dargestellt; + sollte das Endgerät dieser + Notation nicht genügen, so ist + eine anteilige Umrechnung + vorzunehmen). + Die erste RGB-Kombination + wird für die Hintergrundfarbe + verwendet (i.d.R. 000), bei + monochromen Endgeräten ist + also "000999" einzusetzen. + + 1.2 #ib(2," (1.2)")#EDITOR#ie(2,"")# + Syntax: EDITOR; + - Schlüsselwort, das dem Konfigurationsprogramm anzeigt, daß + folgende Eingabeprozeduren vorhanden sind: + - 'graphik cursor' + - 'get cursor' + - 'set marker' + Fehlt das Schlüsselwort, so können o.g. Pseudo-Prozeduren weg­ + gelasssen werden, brauchen also nicht mit leerer Leistung + implementiert werden. + + 1.3 #ib(2," (1.3)")#INCLUDE#ie(2,"")# + Syntax: INCLUDE "Name der Includedatei"; + - Schlüsselwort, mit dem weitere Dateien in die Konfigurationsdatei + textuell eingebunden werden können (s.o). + + 1.4 #ib(2," (1.4)")#LINK#ie(2,"")# + Syntax: LINK /, .... ; + - Dient zur Anbindung mehrerer Endgeräte an einen Endgerät-Typ, + die hier genannten Kanäle werden eigenständig verwaltet, aber + wie das bei 'PLOTTER' definierte Endgerät angesteuert; wobei für + alle Endgeräte der gleiche Name gilt, sie also durch die Kanal­ + nummer unterschieden werden. + Durch Kommata getrennt, können mit dieser Anweisung beliebig + viele Endgeräte zusätzlich angebunden werden. + - : (INT) Stationsnummer des Endgerätes + (eigene Station) + - : (INT) Kanalnummer des Endgerätes + + 1.5 #ib(2," (1.5)")#PLOTTER#ie(2,"")# + Syntax: PLOTTER "Endgerätname",,, + ,,,; + - Dient zur Erkennung als Endgerät-Konfigurationsdatei, und zur + Übergabe der verwaltungsseitig benötigten + Endgerät-Spezifikationen: + - "Endgerätname": (TEXT) Name des Endgerätes + - : (INT) Stationsnummer des Endgerätes + (eigene Station) + - : (INT) Kanalnummer des Endgerätes + Jedes Endgerät wird über diese drei Werte eindeutig identifiziert, + der Endgerätname kann also mehrfach verwendet werden. + - : (INT) X-Rasterkoordinate des letzten + Pixels in X-Richtung (i.d.R + adressierbare Pixel - 1) + - : (INT) Y-Rasterkoordinate des letzten + Pixels in Y-Richtung (s.o.) + - : (REAL) Breite der Zeichenfläche in cm. + - : (REAL) Höhe der Zeiuchenfläche in cm. + (Möglichst genau ausmessen od. berechnen, um Verzerrungen zu + vermeiden) + 'PLOTTER' muß als erstes in der Konfigurationsdatei stehen! + + #ib(1)#2.0 Pseudo-Prozeduren#ie(1)# + + 2.1 PROC #ib(2," (2.1)")#background#ie(2," (PROC)")# + Syntax: PROC background (INT VAR type): + - Stellt die Hintergrundfarbe 'type' ein. Ist bei monochromen End­ + geräten mit leerer Leistung zu implementieren.In 'type' ist die + tatsächlich eingestellte Hintergrundfarbe angegeben, womit die + erbrachte Leistung kontrolliert werden kann. + + 2.2 PROC #ib(2," (2.2)")#box#ie(2," (PROC)")# + Syntax: PROC box (INT CONST x1, y1, x2, y2, pattern): + - Zeichnet ein Rechteck mit den gegenüberliegenden Ecken + 'x1;y1/x2;y2'. Sollte das Endgerät diese Leistung nicht erbringen, + so muß 'std box' aus 'std.GCONF' mit gleichen Parametern aufge­ + rufen werden. + 'pattern' als Füllmuster kann endgerätspezifisch implementiert + werden, wobei von System nur 'pattern' = 0 verwendet wird, was ein + ungefülltes Rechteck anfordert. + + 2.3 PROC #ib(2," (2.3)")#circle#ie(2," (PROC)")# + Syntax: PROC circle (INT CONST x, y, rad, from, to): + - Zeichnet einen Kreis oder ein Kreissegment an den Raster- + Koordinaten 'x;y', die auch neue Zeichenposition werden. 'rad' gibt + den Radius und 'from,to' den Start bzw. Endwinkel im mathematisch + positivem Sinne an. + Sollte das Endgerät diese Leistung nicht erbringen, so muß 'std + circle' aus 'std.GCONF' mit gleichen Parametern aufgerufen werden. + + 2.4 PROC #ib(2," (2.4)")#clear#ie(2," (PROC)")# + Syntax: PROC clear: + - Löscht den Bildschirm bzw. initialisiert das Ausgabe-Raster. + Die Zeichenposition wird '0;0' und die Standardfarben werden + eingestellt. + + 2.5 PROC #ib(2," (2.5)")#drawto#ie(2," (PROC)")# + Syntax: PROC drawto (INT CONST x, y): + - Zieht von der aktuellen Zeichenposition eine Gerade zu den Ko­ + ordinaten 'x;y', die Zeichenposition wird entsprechend geändert. + + 2.6 PROC #ib(2," (2.6)")#endplot#ie(2," (PROC)")# + Syntax: PROC endplot: + - Schließt die Graphik-Ausgabe auf einem Endgerät ab; evtl. Wechsel + in den Text-Modus, ggf. Cursor einschalten. + Bei Terminals sollte der Bildschirm nicht gelöscht werden. + + 2.7 PROC #ib(2," (2.7)")#fill#ie(2," (PROC)")# + Syntax: PROC fill (INT CONST x, y, pattern): + - Zusätzliche vom System nicht verwendete Leistung zum Füllen von + Polygonen (rundum geschlossen), wobei die genau erbrachte Lei­ + stung und die Bedingungen endgerätspezifisch sind. + + 2.8 PROC #ib(2," (2.8)")#foreground#ie(2," (PROC)")# + Syntax: PROC foreground (INT VAR type): + - Stellt die Vordergrundfarbe 'type' ein. Ist bei monochromen + Endgeräten mit leerer Leistung zu implementieren.In 'type' ist die + tatsächlich eingestellte Hintergrundfarbe angegeben, womit die + erbrachte Leistung kontrolliert werden kann. + + 2.9 PROC #ib(2," (2.9)")#get cursor#ie(2," (PROC)")# + Syntax: PROC get cursor (INT VAR x, y, TEXT VAR exit char): + - Wartet auf eine Eingabe vom Endgerät, wobei der Cursor beweglich + bleiben muß. Wird eine Taste gedrückt, so wird deren Code in 'exit + char' und die aktuelle Position des Cursors in 'x;y' eingetragen. + Der Cursor sollte nur innerhalb dieser Prozedur beweglich sein, + aber immer sichtbar bleiben (falls er eingeschaltet ist). + + 2.10 PROC #ib(2," (2.10)")#graphik cursor#ie(2," (PROC)")# + Syntax: PROC graphik cursor (INT CONST x, y, BOOL CONST on): + - Schaltet einen endgerätseitig vorhandenen graphischen Cursor + (i.d.R Fadenkreuz) ein oder aus bzw. setzt ihn auf eine bestimmte + Position. + Mit 'on' = TRUE wird der Cursor dauerhaft! eingeschaltet bzw. neu + positioniert, falls er bereits eingeschaltet war. + Mit 'on' = FALSE wird er grundsätzlich abgeschaltet. + Durch Einschalten des Cursors wird die Wirkung von 'home' + verändert: + normal - 'home' positioniert die Zeichenposition auf + '0;0' + cursor - 'home' positioniert die Zeichenposition und + den graphischen Cursor auf die Mitte der + Zeichenfläche. + + 2.11 PROC #ib(2," (2.11)")#home#ie(2," (PROC)")# + Syntax: PROC home: + - Die Zeichenposition wird auf '0;0' eingestellt; ist ein graphischer + Cursor eingeschaltet, so sollte dieser, sowie die Zeichenposition, + jedoch auf den Mittelpunkt der Zeichenfläche gesetzt werden. + + 2.12 PROC #ib(2," (2.12)")#initplot#ie(2," (PROC)")# + Syntax: PROC initplot: + - Bereitet die Graphik-Ausgabe auf einem Endgerät vor; evtl. + Wechsel in den Graphik-Modus, ggf. Cursor abschalten. + Bei Terminals sollte der Bildschirm nicht gelöscht werden. + + 2.13 PROC #ib(2," (2.13)")#moveto#ie(2," (PROC)")# + Syntax: PROC moveto (INT CONST x, y): + - Die Zeichenposition wird auf die Koordinaten 'x;y' gesetzt, bei + Überschreitung der Zeichenfläche ist die Wirkung undefiniert. + + 2.14 PROC #ib(2," (2.14)")#prepare#ie(2," (PROC)")# + Syntax: PROC prepare: + - Bereitet die Ausgabe auf einem Kanal vor. + Die eigene Task sollte an den Kanal angekoppelt, und andere Tasks + ggf. am Ankoppeln gehindert bzw. abgekoppelt werden (z.B. der + PRINTER-Server bei Drucker-Graphik). Es darf erst nach erfolg­ + reichem Abschluß der Aktion zurückgekehrt werden. + + 2.15 PROC #ib(2," (2.15)")#set marker#ie(2," (PROC)")# + Syntax: PROC set marker (INT CONST x, y, type): + - Zeichnet an der Position 'x;y', die auch neue Zeichenposition wird, + eine Markierung. Folgende Markierungsarten können systemseitig + verwendet werden: + 0 - Kreuz '+' + 1 - Kreuz diagonal 'x' + Weitere Typen können endgerätspezifisch implementiert werden. + + 2.16 PROC #ib(2," (2.16)")#setpalette#ie(2," (PROC)")# + Syntax: PROC setpalette: + - Stellt die aktuell eingestellten RGB-Kombinationen auf dem End­ + gerät ein. Dazu sind die vom Konfigurationsprogramm + hinzugefügten Prozeduren 'colors' und 'color' zu verwenden: + INT PROC colors + - Liefert die Anzahl der für das Endgerät möglichen Farben + (abgeleitet aus den mit 'COLOR' angebenen + Standard-Kombinationen). + INT PROC color (INT CONST no) + - Liefert die normierte RGB-Kombination der für 'no' ein­ + gestellten Farbe (0 - 999). Die Rückgabe von 'maxint' (32767) + bedeutet: Farbe nicht initialisiert oder existiert nicht. + + 2.17 PROC #ib(2," (2.17)")#setpixel#ie(2," (PROC)")# + Syntax: PROC setpixel (INT CONST x, y): + - Setzt ein Pixel an den Raster-Koordinaten 'x;y'. +#page# +#bottom# +#right#Seite % +#end# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Teil 4: Graphik-Applikationen +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Teil 4: Graphik-Applikationen#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + +#type("pica")##on("u")##ib(1)#Teil 4.1: Der Funktionenplotter 'FKT'#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Mit diesem Programmpaket kann man für beliebige reelle und reellwertige + Funktionen Graphen erstellen. Diese Graphen werden im System gespeichert. + + Zur Ausgabe der erstellten Graphen stehen alle graphikfähigen Endgeräte + zur Verfügung. + + #ib(1)#1.0 Allgemeines über FKT#ie(1)# + Zu einer Zeichnung, wie sie mit 'FKT' erstellt werden kann, gehören + folgende Eigenschaften: + - Der Name der Zeichnung (zum Wiederfinden) + - Das Format + - Der Graph mit den Achsen bzw. dem Rahmen. + + Es können beliebig viele Zeichnungen angelegt und aufbewahrt werden, + wobei der Name aller Zeichnungen mit "PICFILE." beginnt. + + Es wird von FKT zwischen den Definitions- und Wertebereich einerseits + und dem Format anderseits unterschieden: + - Der Definitionsbereich wird vom Benutzer gewählt. Er gibt das + Intervall an, über dem der Graph gezeichnet wird. Der + Wertebereich wird vom Rechner automatisch ermittelt. + - Das Format besteht aus der Angabe von vier Werten, die Auskunft + geben über die maximale Ausdehnung der Koordinatenachsen, wobei + die Zeichnung auf den Endgeräten stets so abgebildet wird, daß sie + unverzerrt in maximaler Größe (also im größtmöglichen Quadrat) + gezeichnet wird. + + Der Funktionenplotter FKT ist in allen Sohntasks von 'GRAPHIK' verfüg­ + bar, zusätzlich existiert die Task 'FKT', in der das FKT-Menue als + Kommandoebene verwendet wird. + + #ib(1)#2.0 Das FKT-Menue#ie(1)# + Das Menue des Funktionenplotters ist wie folgt aufgebaut: + - in der obersten Zeile wird der eingegebene Funktionsterm angezeigt + - die nachfolgende Zeile zeigt in eckigen Klammern den Definitions­ + bereich und die Schachtelung des Intervalles, über dem der Graph + gezeichnet wird. + - dann folgt ebenfalls in eckigen Klammern der von FKT selbst zu + ermittelnde Wertebereich der Funktion innerhalb des zuvor + definierten Intervalles. + Wird kein Funktionsterm angezeigt, oder erscheinen in den eckigen + Klammern Sternchen, so wurde noch kein Funktionsterm bzw. + Definitionsbereich eingegeben, oder der Wertebereich noch nicht + ermittelt. + - Der Bereich zwischen o.g Anzeige und der Auflistung der Menuepunkte + ist der Dialogbereich, in dem weitere Anfragen an den Benutzer oder + auch Fehlermeldungen erscheinen. + - Unterhalb der Bildschirmmitte werden die unten beschriebenen + Menuepunkte zur Auswahl aufgeführt. + - Dann folgt der Endgerät-Auswahlbereich, das Endgerät, auf dem eine + Zeichnung ausgegeben werden soll, kann mit den Tasten 'Links' bzw. + 'Rechts' eingestellt werden, wobei der Name des aktuell eingestellten + Endgerätes invertiert erscheint. + - Als unterste Zeile der FKT-Tapete folgt der Eingabebereich, hier wird + der Benutzer zur Eingabe eines bei den Menuepunkten genannten + Buchstabens aufgefordert, und dieser bei einem zulässigen + Tastendruck dort angezeigt. + + #ib(1)#3.0 FKT-Menuepunkte#ie(1)# + + Jede Eingabe oder Operation kann durch Drücken der Taste 'ESC' + abgebrochen werden, die Eingabe wird dann ignoriert, und im Dialog­ + bereich erscheint die Fehlermeldung 'F E H L E R : Abgebrochen'. + + 3.1 #ib(2," (3.1)")#(f) Funktionsterm eingeben#ie(2,"")# + Im Dialogbereich wird die Eingabe des Funktionsterms erwartet, wobei + als Variable im Term 'x' verwendet werden muß. + Es stehen alle mathematischen Funktionen des EUMEL-Systems zur + Verfügung, sofern sie reelle Werte (REAL) zurückliefern. + Beispiele von Funktionstermen (alternative Möglichkeiten in eckigen, + Erklärungen in runden Klammern): + + 2*x + [2x] + 2x*x + 3x ­ 5 + [2.0*x*x + 3.0*x ­ 5.0] + 0.7 * sqrt (x) (sqrt : Quadratwurzel aus) + log10 (x) (log10 : 10­er Logar.) + ln (3x) (ln : Nat. Logar.) + 2**x (** : Potenzieren) + exp (1/x) + [e**(1/x)] (exp : Expon.Fktn) + arctan (pi*x) (arctan: arkus tangens ) + sin (x) (sin : Sinus in Radiant ) + sind (x) (sind : Sinus in Altgrad ) + 1/(x*x+1) + + Die Klammern dürfen dabei NICHT weggelassen werden, es sind nur + runde Klammern zulässig, auch geschachtelt, wie z.B. in: + + log10 (abs (sin (x) + 5)) (abs : Absolutbetrag ) + + Ein Dezimalkomma gibt es nicht, sondern nur den Dezimalpunkt. + + Beispiele von abschnittsweise definierten Funktionen: + + IF x < 5 THEN x*x ELSE sqrt (x ­ 5) END IF + IF x = 0 THEN 0 ELSE 1/x END IF + IF x < 0 THEN x ELIF x = 0 THEN 1 ELSE x*x END IF + + Die sog. Schlüsselworte "IF" "THEN" "ELIF" "ELSE" "END IF" müssen + dabei immer in der angegebenen Form (alle, in der angegebenen Reihen­ + folge, vollständig aus Großbuchstaben) auftauchen. + + IF --+--> THEN --+--> ELSE --> END IF + | | + | | + +--- ELIF --+ + + + Es können bei IF auch mehrere Bedingungen mit logischem OR oder AND + verknüpft werden: + + IF x <= 0 OR x > 100 THEN 0 ELSE x*x END IF + + Hat die Funktion eine Definitionslücke an einer bereits bekannten + Stelle, so kann dies im Term auf folgende Art berücksichtigt werden, + z.B.: + + IF x = 0 THEN luecke ELSE 1/x END IF + IF x < ­0.05 THEN ­1/x ELIF x > 0.05 THEN 1/x ELSE luecke END IF + + Taucht eine unvorhergesehene Definitionslücke auf, so wird beim + Erstellen des Wertebereichs eine entspr. Fehlermeldung ausgegeben. + Dann muß entweder der Funktionsterm durch Fallunterscheidung (s.o.) + angepaßt, oder der Definitionsbereich geändert werden. + + Graphen mit Definitionslücken können auch in zwei oder mehr Teilen + erstellt werden, nämlich jeweils über den zusammenhängenden + Definitionsintervallen, die keine Lücke enthalten. Dazu muß jeweils + die Zeichnung ergänzt (siehe '(z) Zeichnung anfertigen') werden. + + Fehlerquelle: Der Funktionsterm ist fehlerhaft. + Es tauchen z.B. dem Rechner unbekannte Operationen auf, + Multiplikationszeichen fehlen, andere Symbole als 'x' wurden + für die Variable benutzt, 'END IF' fehlt o.ä. + + 3.2 #ib(2," (3.2)")#(d) Definitionsbereich waehlen#ie(2,"")# + Im Dialogbereich wird die Eingabe von Unter- und Obergrenze erwartet, + wobei Untergrenze < Obergrenze gilt, ansonsten wird die Eingabe der + Obergrenze nochmals gefordert. + Erscheinen in der zug. Informationszeile Sterne, so ist die gewählte + Genauigkeit zu groß und sollte umgewählt werden. + + Fehlerquelle: Der Funktionsterm ist noch nicht vorhanden. + + 3.3 #ib(2," (3.3)")#(w) Wertebereich ermitteln lassen#ie(2,"")# + Es werden automatisch der größte und kleinste Funktionswert + ermittelt, also die tatsächlichen Grenzen des Wertebereichs. + Erscheinen in der zug. Informationszeile Sterne, so ist die gewählte + Genauigkeit zu groß und sollte umgewählt werden. + + 3.4 #ib(2," (3.4)")#(z) Zeichnung anfertigen#ie(2,"")# + Eine Zeichnung kann auf allen zur Verfügung stehenden Geräten + ausgegeben werden, wenn sie erzeugt ist. + Mit diesem Menuepunkt werden die Zeichnungen nur erstellt, d.h. der + Graph erscheint noch nicht auf einem Ausgabegerät. + Diese Zeichnungen werden dann im System aufbewahrt und können + somit mehrfach ausgegeben werden. + + Im Dialogbereich wird zunächst der Name der Zeichnung angefordert, + dieser beginnt grundsätzlich mit dem Prefix 'PICFILE.', das nicht + verändert werden kann. + Dabei wird als Ergänzung des Namens der Funktionsterm angeboten, so + daß die Zeichnung z.B. 'PICFILE.sin(x)' heißt. + Dieser Teil des Namens kann aber frei verändert werden. + Existiert bereits eine Zeichnung gleichen Namens, so erscheint im + Dialogbereich eine Anfrage, wie verfahren werden soll, wobei + folgende Möglichkeiten genannt werden: + + -  : Die alte Zeichnung wird gelöscht. + -  : Der Name wird erneut zur Änderung angeboten. + -  : Die neue Zeichnung, welche hiernach erstellt wird, wird an die + schon existierende Zeichnung angahängt. Dies ist vorteil­ + haft, wenn mehrere od. abschnittsweise definierte Graphen + auf in eine Zeichnung kommen sollen. + Die Eingabe anderer Buchstaben wird ignoriert. + + Ansonsten wird eine Zeichnung erstellt, die unter dem eingegebenen + Namen abgelegt wird. + + Danach wird im Dialogbereich erfragt, ob und wie das Format der + Zeichnung geändert werden soll. + Nachdem die Zeichnung erstellt wurde, was durch den + Stützpunkt-Zähler angezeigt wird, muß noch die Farbe, in der der + Graph gezeichnet werden soll eingegeben werden. + + Fehlerquelle: Wertebereich ist noch nicht bestimmt (siehe 4). + Unzuläessiges Format: ymax ist kleiner oder gleich + ymin, bzw. xmax ist kleiner + oder gleich xmin. + + 3.5 #ib(2," (3.5)")#(a) Ausgabe der Zeichnung auf Endgerät#ie(2,"")# + Im Dialogbereich wird der Name der auszugebenden Zeichnung erfragt, + wobei die zuletzt bearbeitete Zeichnung angeboten wird. + Die Wahl von '?' als Namen der Zeichnung ('PICFILE.?') führt zu einer + Auswahl aller vorhanden Bilder, von denen eines zur Ausgabe + ausgewählt werden kann. + Danach kann wie oben nochmals das Format variiert werden. + Dann wird im Dialogbereich die Überschrift der Zeichnung erfragt, + wobei der Funktionsterm angeboten wird. Die Überschrift erscheint + zentriert am oberen Rand. + Je nach Lage des Ursprungs (innerhalb od. außerhalb der Zeichnung) + kann die Ausgabe mit Koordinatensystem od. mit Rahmen gewählt + werden, liegt der Ursprung nicht innerhalb der Zeichnung, so wird + grundsätzlich der Rahmen verwendet. + Zum Abschluß wird dann die Farbgebung von Koordinatensystem bzw. + Rahmen sowie der Überschrift erfragt, dann wird die Zeichnung auf + dem im unteren Teil eingestelltem Endgerät ausgegeben. + + 3.6 #ib(2," (3.6)")#(t) Wertetafel erstellen lassen#ie(2,"")# + In dem gewählten Definitionsbereich kann eine Wertetafel erstellt + werden, die in einer von Ihnen gewünschten Schrittweite ermittelte + Funktionswerte zeigt. + Zunächst wird die Schrittweite erfragt, dann die von FKT formatiert + erstellte Wertetafel gezeigt. + Diese befindet sich in einer Datei, die den Namen des zugehörigen + Funktionsterms trägt, existiert diese bereits, so wird die Wertetafel + ergänzt. + Enthält diese Tafel Sterne, so müssen Sie die Genauigkeit umwählen + und die Tafel neu erstellen lassen. + Nach Verlassen der Anzeige wird noch gefragt, ob die Wertetafel + gedruckt, und ob sie aufbewahrt werden soll. + + Fehlerquelle: Definitionsbereich bzw. Funktionsterm ist noch nicht + gewählt. + Die Schrittweite wurde zu klein gewählt. Sie muß so + groß sein, daß nicht mehr als 512 Werte zu berechnen + sind. + + 3.7 #ib(2," (3.7)")#(l) Zeichnungen auflisten#ie(2,"")# + Es wird eine Namesliste aller vorhandenen Zeichnungen gezeigt. + + 3.8 #ib(2," (3.8)")#(?) Hilfestellung#ie(2,"")# + Es wird eine Kurzanleitung gezeigt. + + 3.9 #ib(2," (3.9)")#(q) in die Kommandoebene zurück#ie(2,"")# + Die Arbeit mit dem Funktionsplotter wird beendet, in normalen Tasks + erscheint die Ebene, aus der 'FKT' mit 'fktplot' aufgerufen wurde. + Wird die Task 'FKT' mit 'q' verlassen, so wird dagegen die Task + abgekoppelt und alle in ihr enthaltenen Zeichnungen gelöscht! + + 3.10 #ib(2," (3.10)")#(s) Anzahl der Stützpunkte waehlen#ie(2,"")# + Bei der Ermittlung des Wertebereiches und beim Erstellen des Funk­ + tionsgraphen ist es wegen der Endlichkeit des Computers nicht mög­ + lich, alle Punkte des Definitionsbereiches zu benutzen. Deshalb wird + der Definitionsbereich diskretisiert, d.h. es wird eine endliche An­ + zahl von Stützpunkten ausgesucht. Diese Stützpunkte liegen gleich­ + verteilt über dem Definitionsbereich. Die Mindestanzahl ist 2, d.h. als + Stützpunkte werden nur die beiden Randwerte zugelassen. Aus + technischen Gründen ist die Höchstgrenze 512. + + Fehlerquelle: Zahl der Stützpunkte ist fehlerhaft. + Nur ganze Zahlen aus dem Intervall [2;512] zulässig. + + 3.11 #ib(2," (3.11)")#(n) Nachkommastellenzahl wählen#ie(2,"")# + Hier kann die Zahl der angezeigten Nachkommastellen eingestellt + werden (intern wird immer höchstmögliche Genauigkeit verwendet). + Maximal sind neun Nachkommastellen zulässigt, jedoch kann die + Genauigkeit zu groß für das Anzeigeformat werden; dann erscheinen + in der Anzeige Sterne (*************). + Es gilt grundsätzlich: + Anzahl Vorkommastellen + Anz. Nachkommastellen = 12. + + 3.12 #ib(2," (3.12)")#(e) Arbeit beenden#ie(2,"")# + Die Arbeit mit 'FKT' wird abgeschlossen, die Task vom Terminal + abgekoppelt. Für jede Task bleibt dabei FKT das laufende Programm, + d.h. nach erneutem Ankoppeln erscheint wieder die FKT-Tapete. In der + Task FKT bleiben die Zeichnungen bei Verlassen mit 'e' erhalten (im + Gegensatz zum Verlassen mit 'q'). + + 3.13 #ib(2," (3.13)")#(L) Zeichnungen loeschen#ie(2,"")# + Es erscheint eine Namensliste aller in der Task enthaltenen + Zeichnungen. Die dann ausgewählten Zeichnungen werden nach noch­ + maliger Rückfrage gelöscht. + + 3.14 #ib(2," (3.14)")#(A) Zeichnungen archivieren#ie(2,"")# + Nach Aufruf dieses Menuepunktes können Zeichnungen zu anderen + Tasks geschickt, oder auch auf Diskette geschrieben werden. + Dazu wird der MPG-Dateimanager 'dm' verwendet. + + 3.15 #ib(2," (3.15)")#(b) Zeichnungen beschriften#ie(2,"")# + Mit diesem Menuepunkt können Zeichnungen frei beschriftet werden. + Zunächst wird im Dialogbereich erfragt, wie mit bereits bestehenden + Beschriftungen verfahren werden soll: + + ­ : Die nachfolgenden Texte werden zusätzlich zu den schon + vorhandenen Beschriftungen angefügt. + ­ : Die vorhandenen Beschriftungen werden gelöscht, und es wird + zum Menue zurückgekehrt. + ­ : Die Operation wird abgebrochen. + + Nun wird die Farbgebung aller Beschriftungen erfragt, + danach wird das aktuelle Format der Zeichnung gezeigt, was bei der + Positionierung hilfreich sein kann. + Nach der nun geforderten Eingabe des Beschriftungstextes wird die + Positionierung der Beschriftung in zwei Weisen angeboten: + - in cm : Die nachfolgend einzugebenden Werte werden als + cm-Angabe relativ zur unteren linken Ecke der Zeichnung + aufgefaßt. + - in REAL: Die nachfolgend einzugebenden Werte werden als + Koordinatenangabe im Koordinatensystem der erstellten + Zeichnung aufgefaßt ('0;0' demnach im Ursprung) Nach + Eingabe o.g. Werte wird noch die Texthöhe und Breite erfragt, wobei die + eingegebenen Werte als mm-Angaben aufgefäßt werden (Standard: 5 * 5 + mm). + Anschließend wird erfragt, ob noch weitere Beschriftungen + vorgenommen werden sollen. + + Fehlerquelle: Zeichnung existiert nicht. +#page# + +#type("pica")##on("u")##ib(1)#Teil 4.2: Die TURTLE-Graphik#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Die TURTLE-Graphik bietet die Möglichkeit, sehr einfach zweidimensionale + Zeichnungen zu erstellen. Sie basiert auf dem in LOGO verwendeten Modell, in + dem eine Zeichenposition in jeweils eine bestimmte Richtung vorwärts bzw. + rückwärts bewegt werden kann, und die Zeichenrichtung verändert werden + kann.Bei den Bewegungen, die vornehmlich relativ zur alten Position bzw. + Zeichenrichtung ausgeführt werden, kann dann eine Linie hinterlassen + werden. Diese Art der Graphik eignet sich insbesondere für Programm­ + gesteuerte Zeichnungen, wie z.B. die rekursiven 'Sierpinski' - bzw. 'Hilbert'- + "Funktionen". + + Die Koordinaten bewegen sich im Intervall von [-500.0,500.0]. + (0,0) liegt dabei in der Bildschirmmitte und ist auch die Anfangsposition. + Der Anfangswinkel ist 0. Winkel werden in Grad angegeben. + + #ib(1)#1.0 Paket: 'turtlegraphics'#ie(1)# + + 1.1 REAL PROC #ib(2," (1.1)")#angle#ie(2," (PROC)")# + - liefert den momentanen Winkel zwischen Zeichenrichtung und + X-Achse. + + 1.2 PROC #ib(2," (1.2)")#turnto#ie(2," (PROC)")# + (REAL CONST w) + - Die Zeichenrichtung wird absolut auf den Winkel 'w' als Winkel + zwischen Zeichenrichtung und X-Achse eingestellt. + + 1.3 PROC #ib(2," (1.3)")#forward#ie(2," (PROC)")# + (REAL CONST s) + - Die Zeichenposition wird in Zeichenrichtung um die Strecke 's' + verschoben, wobei ggf. gezeichnet wird. + + 1.4 PROC #ib(2," (1.4)")#penup#ie(2," (PROC)")# + - Der Zeichenstift wird abgehoben, Bewegungen erzeugen keine + Linien mehr. + + 1.5 PROC #ib(2," (1.5)")#forward to#ie(2," (PROC)")# + (REAL CONST x,y) + - Die Zeichenposition wird absolut auf die Position 'x;y' gesetzt, die + Zeichenrichtung wird nicht verändert. + + 1.6 PROC #ib(2," (1.6)")#endturtle#ie(2," (PROC)")# + - Wurde die Graphik im Direktmodus ('begin turtle' ohne Parameter), + also auch sofort sichtbar erzeugt, so wird die Graphikausgabe in + üblicher Weise beendet, sonst nunmehr das erzeugte PICFILE + ausgegeben. + + 1.7 PROC #ib(2," (1.7)")#pendown#ie(2," (PROC)")# + - Der Zeichenstift wird gesenkt, Bewegungen erzeugen Linien. + + 1.8 PROC #ib(2," (1.8)")#beginturtle#ie(2," (PROC)")# + (TEXT CONST picfile name) + - öffnet ein PICFILE 'picfile name', in das alle Aktionen eingetragen + werden. Auf dem Bildschirm geschieht nichts. Ist das Picfile schon + vorhanden, werden die Aktionen hinzugefügt. + + 1.9 PROC #ib(2," (1.9)")#beginturtle#ie(2," (PROC)")# + - Leitet die direkte graphische Ausgabe einer TURTLE-Graphik ein, + alle Aktionen werden sofort auf dem Bildschirm sichtbar. + + 1.10 PROC #ib(2," (1.10)")#turn#ie(2," (PROC)")# + (REAL CONST w) + - Dreht die Zeichenposition um 'w'-Grad im mathematisch positiven + Sinne. + + 1.11 BOOL PROC #ib(2," (1.11)")#pen#ie(2," (PROC)")# + - Liefert zurück, ob der Zeichenstift oben (FALSE) oder unten (TRUE) + ist, also ob Bewegungen Linien hervorrufen oder nicht. + + 1.12 PROC #ib(2," (1.12)")#getturtle#ie(2," (PROC)")# + - In die übergebenen Variablen wird die aktuelle Zeichenposition + absolut eingetragen. +#page# + Diese Dokumentation und die einzelnen Programme wurden mit größtmöglicher + Sorgfalt erstellt bzw. weiterentwickelt. + Dennoch kann keine Fehlerfreiheit garantiert oder die Haftung für evtl. aus + Fehlern resultierende Folgen übernommen werden. + Für Hinweise auf Fehler sind die Autoren stets dankbar. +#page# +#bottom off# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Stichwortverzeichnis +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Stichwortverzeichnis#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# +(a) Ausgabe der Zeichnung auf Endgerät ........... 41 (3.5) +actual plotter (PROC) ............................ 17 (4.4) +ALL (OP) ......................................... 27 (3.1) +angle (PROC) ..................................... 44 (1.1) +(A) Zeichnungen archivieren ...................... 42 (3.14) +background * (PROC) .............................. 13 (3.4), 13 (3.5), 19 (1.1), + 19 (1.2), 34 (2.1) +bar * (PROC) ..................................... 8 (2.3), 23 (2.1), 23 (2.2) +beginplot (PROC) ................................. 23 (2.3) +beginturtle (PROC) ............................... 45 (1.9), 45 (1.8) +box (PROC) ....................................... 19 (1.3), 23 (2.4), 34 (2.2) +(b) Zeichnungen beschriften ...................... 42 (3.15) +CAT * (OP) ....................................... 8 (2.4) +channel (PROC) ................................... 17 (4.5) +circle (PROC) .................................... 8 (2.5), 19 (1.4), 24 (2.5), + 34 (2.3) +clear (PROC) ..................................... 19 (1.5), 19 (1.6), 34 (2.4) +clearspool ....................................... 3 (2.2) +clippedline (PROC) ............................... 5 (1.1) +color (PROC) ..................................... 19 (1.7) +COLORS ........................................... 32 (1.1) +colors (PROC) .................................... 20 (1.8) +(d) Definitionsbereich waehlen ................... 39 (3.2) +delete picture * (PROC) .......................... 13 (3.6) +dim * (PROC) ..................................... 8 (2.6) +down * (PROC) .................................... 13 (3.7), 13 (3.8) +draw cm * (PROC) ................................. 9 (2.11), 24 (2.12) +draw cm r * (PROC) ............................... 9 (2.12), 24 (2.13) +drawingarea * (PROC) ............................. 5 (1.2), 17 (4.6), 17 (4.7) +draw * (PROC) .................................... 8 (2.8), 8 (2.7), 9 (2.10), + 9 (2.9), 24 (2.6), 24 (2.9), + 24 (2.8), 24 (2.7), 24 (2.11), + 24 (2.10) +draw r * (PROC) .................................. 9 (2.13), 9 (2.14), 24 (2.14), + 25 (2.15) +drawto (PROC) .................................... 20 (1.9), 34 (2.5) +(e) Arbeit beenden ............................... 42 (3.12) +EDITOR ........................................... 33 (1.2) +end plot (PROC) .................................. 20 (1.10), 20 (1.11), 34 (2.6) +endturtle (PROC) ................................. 44 (1.6) +eof * (PROC) ..................................... 13 (3.9) +erase (PROC) ..................................... 27 (3.3), 27 (3.2) +exists (PROC) .................................... 27 (3.4) +extrema * (PROC) ................................. 9 (2.16), 9 (2.15), 13 (3.11), + 13 (3.10) +(f) Funktionsterm eingeben ....................... 38 (3.1) +fill (PROC) ...................................... 20 (1.12), 34 (2.7) +first ............................................ 4 (2.9) +first (PROC) ..................................... 27 (3.5) +foreground (PROC) ................................ 20 (1.14), 20 (1.13), 35 (2.8) +forward (PROC) ................................... 44 (1.3) +forward to (PROC) ................................ 44 (1.5) +generate plotmanager (PROC) ...................... 27 (3.6) +get cursor (PROC) ................................ 20 (1.15), 35 (2.9) +get * (PROC) ..................................... 14 (3.12) +getturtle (PROC) ................................. 45 (1.12) +getvalues (PROC) ................................. 5 (1.3), 14 (3.13) +graphik cursor (PROC) ............................ 20 (1.16), 21 (1.17), 35 (2.10) +halt ............................................. 4 (2.6) +halt (PROC) ...................................... 27 (3.7) +hidden lines * (PROC) ............................ 25 (2.16) +(?) Hilfestellung ................................ 41 (3.8) +home (PROC) ...................................... 21 (1.18), 35 (2.11) +INCLUDE .......................................... 33 (1.3) +init plot (PROC) ................................. 21 (1.19), 35 (2.12) +insert picture * (PROC) .......................... 14 (3.14) +install plotter (PROC) ........................... 17 (4.8) +is first picture * (PROC) ........................ 14 (3.15) +killer ........................................... 4 (2.8) +length * (PROC) .................................. 9 (2.17) +linetype (PROC) .................................. 25 (2.17) +LINK ............................................. 33 (1.4) +list (PROC) ...................................... 27 (3.8), 28 (3.9) +listspool ........................................ 3 (2.1) +(l) Zeichnungen auflisten ........................ 41 (3.7) +(L) Zeichnungen loeschen ......................... 42 (3.13) +move cm (PROC) ................................... 10 (2.20), 25 (2.21) +move cm r * (PROC) ............................... 10 (2.21), 25 (2.22) +move * (PROC) .................................... 9 (2.19), 9 (2.18), 25 (2.18), + 25 (2.19), 25 (2.20) +move r * (PROC) .................................. 10 (2.23), 10 (2.22), + 25 (2.23), 25 (2.24) +move to (PROC) ................................... 21 (1.20), 35 (2.13) +name (PROC) ...................................... 17 (4.9) +newvalues (PROC) ................................. 5 (1.4) +nilpicture * (PROC) .............................. 10 (2.24) +(n) Nachkommastellenzahl wählen .................. 42 (3.11) +no plotter (PROC) ................................ 17 (4.10) +oblique * (PROC) ................................. 5 (1.5), 14 (3.16) +:= (OP) .......................................... 8 (2.2), 13 (3.2), 13 (3.3), + 17 (4.3), 17 (4.2) +orthographic * (PROC) ............................ 5 (1.6) +PACKET basisplot ................................. 1 (3.1) +PACKET deviceinterface ........................... 1 (2.1) +PACKET devices ................................... 1 (1.4) +PACKET picfile ................................... 1 (1.3) +PACKET picture ................................... 1 (1.2) +PACKET plot ...................................... 1 (3.3) +PACKET plotinterface ............................. 1 (3.2) +PACKET transformation ............................ 1 (1.1) +pendown (PROC) ................................... 44 (1.7) +pen * (PROC) ..................................... 10 (2.25), 10 (2.26), + 26 (2.25), 45 (1.11) +penup (PROC) ..................................... 44 (1.4) +perspective * (PROC) ............................. 6 (1.7), 14 (3.17) +picfiles (PROC) .................................. 28 (3.10) +picture no * (PROC) .............................. 14 (3.18) +picture * (PROC) ................................. 11 (2.27) +pictures * (PROC) ................................ 14 (3.19) +plot * (PROC) .................................... 29 (4.3), 29 (4.2), 29 (4.1) +PLOTTER .......................................... 33 (1.5) +plotterinfo (PROC) ............................... 18 (4.13) +plotter (PROC) ................................... 18 (4.11), 18 (4.12) +plotters (PROC) .................................. 18 (4.14) +prepare (PROC) ................................... 21 (1.21), 36 (2.14) +put picture * (PROC) ............................. 14 (3.21) +put * (PROC) ..................................... 14 (3.20) +(q) in die Kommandoebene zurück .................. 41 (3.9) +read picture * (PROC) ............................ 14 (3.22) +reset linetypes * (PROC) ......................... 26 (2.27) +reset * (PROC) ................................... 26 (2.26) +reset zeichensatz * (PROC) ....................... 26 (2.28) +rotate * (PROC) .................................. 11 (2.28), 11 (2.29) +(s) Anzahl der Stützpunkte waehlen ............... 42 (3.10) +save (PROC) ...................................... 28 (3.12), 28 (3.11) +selected pen * (PROC) ............................ 15 (3.23) +select pen * (PROC) .............................. 15 (3.24) +select plotter ................................... 4 (2.7) +select plotter (PROC) ............................ 18 (4.16), 18 (4.15), 18 (4.17) +set color (PROC) ................................. 21 (1.22) +setdrawingarea (PROC) ............................ 6 (1.8) +set marker (PROC) ................................ 21 (1.23), 36 (2.15) +setpalette (PROC) ................................ 21 (1.24), 36 (2.16) +setpixel (PROC) .................................. 21 (1.25), 36 (2.17) +setvalues (PROC) ................................. 6 (1.9), 15 (3.25) +spool control .................................... 3 (2.3) +start ............................................ 4 (2.5) +start (PROC) ..................................... 28 (3.13) +station (PROC) ................................... 18 (4.18) +stdcolors (PROC) ................................. 22 (1.26), 22 (1.27) +stop ............................................. 3 (2.4) +stop (PROC) ...................................... 28 (3.14) +stretch * (PROC) ................................. 11 (2.31), 11 (2.30) +text * (PROC) .................................... 11 (2.32) +to eof * (PROC) .................................. 15 (3.26) +to first pic * (PROC) ............................ 16 (3.27) +to pic * (PROC) .................................. 16 (3.28) +transform (PROC) ................................. 6 (1.10) +translate * (PROC) ............................... 12 (2.33), 12 (2.34) +turn (PROC) ...................................... 45 (1.10) +turnto (PROC) .................................... 44 (1.2) +(t) Wertetafel erstellen lassen .................. 41 (3.6) +TYPE PICFILE ..................................... 13 (3.1) +TYPE PICTURE * ................................... 8 (2.1) +TYPE PLOTTER ..................................... 17 (4.1) +up * (PROC) ...................................... 16 (3.30), 16 (3.29) +viewport * (PROC) ................................ 7 (1.14), 16 (3.34) +view * (PROC) .................................... 6 (1.13), 6 (1.12), 6 (1.11), + 16 (3.32), 16 (3.31), 16 (3.33) +wait for halt (PROC) ............................. 28 (3.15) +where * (PROC) ................................... 12 (2.35), 12 (2.36), + 26 (2.30), 26 (2.29) +window * (PROC) .................................. 7 (1.15), 7 (1.16), 7 (1.17), + 16 (3.35), 16 (3.36) +write picture * (PROC) ........................... 16 (3.37) +(w) Wertebereich ermitteln lassen ................ 40 (3.3) +zeichensatz * (PROC) ............................. 26 (2.31) +(z) Zeichnung anfertigen ......................... 40 (3.4) + + diff --git a/app/mpg/2.2/source-disk b/app/mpg/2.2/source-disk new file mode 100644 index 0000000..f00ec02 --- /dev/null +++ b/app/mpg/2.2/source-disk @@ -0,0 +1,4 @@ +mpg/mpg-graphik-system-2.1_1987-09-10.1.img +mpg/mpg-graphik-system-2.1_1987-09-10.2.img +mpg/mpg-graphik-system-2.1_1987-09-10.3.img +mpg/mpg-graphik-system-2.1_1987-09-10.4.img diff --git a/app/mpg/2.2/src/AMPEX 2-1-6.GCONF b/app/mpg/2.2/src/AMPEX 2-1-6.GCONF new file mode 100644 index 0000000..030efd4 --- /dev/null +++ b/app/mpg/2.2/src/AMPEX 2-1-6.GCONF @@ -0,0 +1,84 @@ +INCLUDE "terminal plot"; +INCLUDE "std primitives"; + +PLOTTER "AMPEX",2,1,78,47,21.5,16.0; + +LINK 2/2,2/3,2/4,2/5,2/6; + +COLORS "000999"; + +PROC clear: + IF plot + THEN INT VAR i; + FOR i FROM 1 UPTO 24 + REP display [i] := empty line PER; + page + ELSE errorstop ("PROC clear : clear without plotmodus") FI +END PROC clear; + +PROC prepare: + break(quiet); + REP + disable stop; + continue (channel(plotter)); + clear error; + enable stop; + IF NOT online + THEN pause (300) + FI + UNTIL online PER +END PROC prepare; + +PROC initplot: + plot := TRUE; + cursor (x pos + 1, 24 - (y pos) DIV 2) +END PROC initplot; + +PROC endplot: + pause; + plot := FALSE +END PROC endplot; + +PROC home: + move to (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + x pos := x ; + y pos := y +END PROC moveto; + +PROC drawto (INT CONST x,y): + new x pos := x; + new y pos := y; + plot vector (new x pos - x pos, new y pos - y pos) ; +END PROC drawto; + +PROC setpixel (INT CONST x,y): + move to (x,y); + point +END PROC setpixel; + +PROC foreground (INT VAR type): + type := 1 +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1,y1,x2,y2,pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): +END PROC fill; + + diff --git a/app/mpg/2.2/src/AMPEX 3-1-4.GCONF b/app/mpg/2.2/src/AMPEX 3-1-4.GCONF new file mode 100644 index 0000000..cc3a7ad --- /dev/null +++ b/app/mpg/2.2/src/AMPEX 3-1-4.GCONF @@ -0,0 +1,84 @@ +INCLUDE "terminal plot"; +INCLUDE "std primitives"; + +PLOTTER "AMPEX",3,1,78,47,21.5,16.0; + +LINK 3/2,3/3,3/4; + +COLORS "000999"; + +PROC clear: + IF plot + THEN INT VAR i; + FOR i FROM 1 UPTO 24 + REP display [i] := empty line PER; + page + ELSE errorstop ("PROC clear : clear without plotmodus") FI +END PROC clear; + +PROC prepare: + break(quiet); + REP + disable stop; + continue (channel(plotter)); + clear error; + enable stop; + IF NOT online + THEN pause (300) + FI + UNTIL online PER +END PROC prepare; + +PROC initplot: + plot := TRUE; + cursor (x pos + 1, 24 - (y pos) DIV 2) +END PROC initplot; + +PROC endplot: + pause; + plot := FALSE +END PROC endplot; + +PROC home: + move to (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + x pos := x ; + y pos := y +END PROC moveto; + +PROC drawto (INT CONST x,y): + new x pos := x; + new y pos := y; + plot vector (new x pos - x pos, new y pos - y pos) ; +END PROC drawto; + +PROC setpixel (INT CONST x,y): + move to (x,y); + point +END PROC setpixel; + +PROC foreground (INT VAR type): + type := 1 +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1,y1,x2,y2,pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): +END PROC fill; + + diff --git a/app/mpg/2.2/src/Atari 3-9.GCONF b/app/mpg/2.2/src/Atari 3-9.GCONF new file mode 100644 index 0000000..82b4826 --- /dev/null +++ b/app/mpg/2.2/src/Atari 3-9.GCONF @@ -0,0 +1,119 @@ +INCLUDE "std primitives"; + +PLOTTER "ATARI",3,9,640,400,21.0,13.0; + +COLORS "000999"; + +TEXT VAR atari kommando; +TEXT VAR atari puffer 2 := "12", + atari puffer 4 := "1234"; + +PROC atari g c (TEXT CONST kommando kennung): + LET esc g = ""27"g"; + atari kommando := esc g; + atari kommando CAT kommando kennung + +END PROC atari g c; + +PROC atari g w (INT CONST unsigned integer): + replace (atari puffer 2, 1, unsigned integer); + atari kommando CAT atari puffer 2 + +END PROC atari g w; + +PROC atari g k (INT CONST x, y): + replace (atari puffer 4, 1, x); + replace (atari puffer 4, 2, y); + atari kommando CAT atari puffer 4 + +END PROC atari g k; + +PROC atari g e: + out (atari kommando) + +END PROC atari g e; + +PROC initplot: + INT VAR atari d; + control (11, channel, 255, atari d); + atari g c ("B"); + atari g e +END PROC initplot; + +PROC endplot: + pause; + INT VAR atari d; + atari g c ("E"); + atari g e; + control (11, channel, 25, atari d) +END PROC endplot; + +PROC prepare: + break(quiet); + REP + disable stop; + continue (channel(plotter)); + clear error; + enable stop; + IF NOT online + THEN pause (300) + FI + UNTIL online PER +END PROC prepare; + +PROC clear: + atari g c("C"); + atari g e +END PROC clear; + +PROC home: + move to(0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + atari g c("M"); + atari g k(x,y); + atari g e +END PROC moveto; + +PROC drawto (INT CONST x,y): + atari g c ("D"); + atari g k(x,y); + atari g e +END PROC drawto; + +PROC setpixel (INT CONST x,y): + atari g c("."); + atari g k(x,y); + atari g e +END PROC setpixel; + +PROC foreground (INT VAR type): + type := 1 +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + atari g c("K"); + atari g k(x,y); + atari g w(rad); + atari g w(from); + atari g w(to); + atari g e +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1,y1,x2,y2,pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): +END PROC fill; + + + diff --git a/app/mpg/2.2/src/DATAGRAPH 3-7.GCONF b/app/mpg/2.2/src/DATAGRAPH 3-7.GCONF new file mode 100644 index 0000000..6ed887d --- /dev/null +++ b/app/mpg/2.2/src/DATAGRAPH 3-7.GCONF @@ -0,0 +1,119 @@ +PLOTTER "DATAGRAPH",3,7,511,241,25.0,16.5; + +COLORS "000999900029490000990751"; + +LET csi = ""27"[?"; + +PROC datagraph palette: + INT VAR coln, rgb; + REAL VAR anteil; + FOR coln FROM 0 UPTO colors - 1 REP + rgb := color (coln); + IF rgb <> maxint + THEN out (csi + text (coln) + ";"); + anteil := real (rgb DIV 100) / 9.0; + out (text (int (7.0 * anteil + 0.5)) + ";"); + anteil := real ((rgb MOD 100) DIV 10) / 9.0; + out (text (int (7.0 * anteil + 0.5)) + ";"); + anteil := real (rgb MOD 10) / 9.0; + out (text (int (3.0 * anteil + 0.5)) + "m"); + FI + PER +END PROC datagraph palette; + +PROC prepare: + break(quiet); + REP + disable stop; + continue (channel(plotter)); + clear error; + enable stop; + IF NOT online + THEN pause (300) + FI + UNTIL online PER +END PROC prepare; + +PROC clear: + out (csi + "2D"); + foreground (1) +END PROC clear; + +PROC initplot: + out (csi + "1a"); + out (csi + "0j"); + out (csi + "3j"); + out (csi + "4j") +END PROC initplot; + +PROC endplot: + pause; + out (csi + "0a"); + out (csi + "3;7;5;1m"); + out (csi + "0;0;0;0m"); + out (""27"[33m") +END PROC endplot; + +PROC home: + move to (0,0); +END PROC home; + +PROC moveto (INT CONST x,y): + out (csi + "1;"+text(y)+";"+text(x)+"C") +END PROC moveto; + +PROC drawto (INT CONST x,y): + out (csi + "0V"); + out (csi + "1V"); + out (csi + "3;"+text(y)+";"+text(x)+"V") +END PROC drawto; + +PROC setpixel (INT CONST x,y): + out (""27"[?0;"+text(y)+";"+text(x)+"P") +END PROC setpixel; + +PROC foreground (INT VAR type): + IF type >= 0 AND type <= 7 + THEN out (csi + text (type) + ";f") + ELSE type := 1;out (csi + "1;f") + FI +END PROC foreground; + +PROC background (INT VAR type): + IF color (type) <> maxint + THEN set color (0,color (type)) + ELSE type := 0;set color (0,000) + FI; + set palette +END PROC back ground; + +PROC set palette: + datagraph palette +END PROC set palette; + +PROC circle (INT CONST x,y,rad,from,to): + move to (x, y); + IF from = 0 AND to = 360 + THEN out (csi + "0;" + text(y) + ";" + text (x) + ";" + + text (y) + ";" + text (x+rad) + "K") + ELSE out (csi + "2;" + text (y) + ";" + text (x+rad) +"C"); + out (csi + "2;" + text (to-from) + "S") + FI +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + move to (x1, y1); + out (csi + text (pattern + 3 * sign(pattern)) + ";" + + text (y1) + ";" + text (x1) + ";" + + text (y2) + ";" + text (x2) + "R") +END PROC box; + +PROC fill (INT CONST x,y,pattern): + move to (x,y); + IF pattern > 6 OR pattern = 0 + THEN out (csi + "0I") + ELSE out (csi + text (pattern+3) + "I") + FI +END PROC fill; + + diff --git a/app/mpg/2.2/src/ENVIRONMENT2.GCONF b/app/mpg/2.2/src/ENVIRONMENT2.GCONF new file mode 100644 index 0000000..da04554 --- /dev/null +++ b/app/mpg/2.2/src/ENVIRONMENT2.GCONF @@ -0,0 +1,5 @@ +PLOTTER "VC 404",2,7,78,47,21.5,16.0; +PLOTTER "NEC P9 HD",2,15,2880,2880,20.32,20.32; +PLOTTER "NEC P9 MD",2,15,2340,1984,33.02,27.99644; + + diff --git a/app/mpg/2.2/src/ENVIRONMENT3.GCONF b/app/mpg/2.2/src/ENVIRONMENT3.GCONF new file mode 100644 index 0000000..27a4412 --- /dev/null +++ b/app/mpg/2.2/src/ENVIRONMENT3.GCONF @@ -0,0 +1,7 @@ +PLOTTER "DATAGRAPH",3,7,511,241,25.0,16.5; +PLOTTER "WATANABE",3,8,3449,2599,34.5,26.0; +PLOTTER "VIDEOSTAR",3,6,640,480,27.0,19.5; +PLOTTER "NEC P3",3,15,1024,1024,21.68,21.68; +PLOTTER "ATARI",3,9,640,400,21.0,13.0; + + diff --git a/app/mpg/2.2/src/FKT.help b/app/mpg/2.2/src/FKT.help new file mode 100644 index 0000000..05e82dc --- /dev/null +++ b/app/mpg/2.2/src/FKT.help @@ -0,0 +1,24 @@ +* : Funktionsterm waehlen bzw. umwaehlen * +* : Definitionsbereich setzen * +* ACHTUNG : Untergrenze < Obergrenze * +* : Anzahl der Stuetzpunkte waehlen; 2 <= s <= 512 * +* : Wertebereich wird ermittelt * +* ACHTUNG : Anzahl der Stuetzpunkte * +* : Wertetafel wird erstellt * +* ACHTUNG : Nicht mehr als 512 Werte koennen ermittelt werden* +* : Zeichnung wird erstellt * +* ACHTUNG : Erst Funktionsterm einegeben * +* ACHTUNG : Erst Wertebereich ermitteln lassen * +* : Erstellte Zeichnung zeigen lassen * +* ACHTUNG : Auf Endgeraet achten * +* : Liste aller bereits erstellten Zeichnungen wird gezeigt * +* : Nachkommastellen setzen * +* : Sitzung beenden * +* : Auf Kommandoebene zurueck (nicht in der Task FKT) * +* : Diese Anleitung wird gezeigt * +* : Zeichnungen koennen auf Diskette geschrieben werden * +* : Zeichnungen koennen mit beliebigen Texten versehen werden * +* : Es werden alle Zeichnungen zum Loeschen angeboten * +* <<- ->> : Das Endgeraet umwaehlen. * +*****************VERLASSEN DIESER ANLEITUNG MIT ******************* + diff --git a/app/mpg/2.2/src/GRAPHIK.Basis b/app/mpg/2.2/src/GRAPHIK.Basis new file mode 100644 index 0000000..733297d --- /dev/null +++ b/app/mpg/2.2/src/GRAPHIK.Basis @@ -0,0 +1,1574 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.2 vom 23.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Basis" geschrieben von C.Weinholz/EUMEL-Std *) +(* *) +(**************************************************************************) +(* *) +(* Paket I: Endgeraet-unabhaengige Graphikroutinen *) +(* *) +(* 1. Transformation (Umsetzung 3D -> 2D), *) +(* Clipping und Normierung *) +(* 2. PICTURE - Verwaltung *) +(* (geanderte Standard-Version) *) +(* 3. PICFILE - Verwaltung *) +(* (geanderte Standard-Version) *) +(* 4. Endgeraet - Verwaltung *) +(* *) +(**************************************************************************) +(* Urversion : 10.09.87 *) +(* Aenderungen: 23.09.87, Carsten Weinholz *) +(* OP := (PICFILE VAR, PICFILE CONST) hinzugefuegt *) +(* TEXT PROC text (PICTURE CONST) *) +(* wg. Heapueberlauf geaendert *) +(* *) +(**************************************************************************) + +(****************************** transformation ****************************) + +PACKET transformation DEFINES + transform, + set values, + get values, + new values, + drawing area, + set drawing area, + + window, + viewport, + view, + oblique, + orthographic, + perspective, + + clipped line: + +BOOL VAR new limits :: TRUE, + values new :: TRUE, + perspective projektion :: FALSE; + +REAL VAR display hor, display vert, (* Anzahl der Pixel *) + size hor, size vert, (* Groesse des Bildschirms *) + size hor d, size vert d, + h min limit, h max limit, + v min limit, v max limit, + h min, h max, + v min, v max, + relation; + +ROW 5 ROW 5 REAL VAR p ; +ROW 3 ROW 2 REAL VAR size d ; +ROW 2 ROW 2 REAL VAR limits d ; +ROW 4 REAL VAR angles d ; +ROW 2 REAL VAR oblique d ; +ROW 3 REAL VAR perspective d ; + +INT VAR i, j; + +PROC init transformation rows: + size d := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0)); + + limits d := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, relation), + ROW 2 REAL : (0.0, 1.0)); + + angles d := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0); + + oblique d := ROW 2 REAL : (0.0, 0.0); + + perspective d := ROW 3 REAL : (0.0, 0.0, 0.0); + set values (size d, limits d, angles d, oblique d, perspective d); +END PROC init transformation rows; + +BOOL OP = (ROW 3 ROW 2 REAL CONST l, r): + FOR i FROM 1 UPTO 3 + REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2] + THEN LEAVE = WITH FALSE FI + PER; + TRUE +END OP =; + +BOOL OP = (ROW 2 ROW 2 REAL CONST l, r): + FOR i FROM 1 UPTO 2 + REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2] + THEN LEAVE = WITH FALSE FI + PER; + TRUE +END OP =; + +BOOL OP = (ROW 2 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] +END OP =; + +BOOL OP = (ROW 3 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] +END OP =; + +BOOL OP = (ROW 4 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] AND l [4] = r [4] +END OP =; + +PROC oblique (REAL CONST a, b) : + set values (size d, limits d, angles d, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) +END PROC oblique; + +PROC orthographic : + set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0)) +END PROC orthographic; + +PROC perspective (REAL CONST cx, cy, cz) : + set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy,-cz)) +END PROC perspective; + +PROC window (BOOL CONST dev) : + new limits := dev +END PROC window; + +PROC window (REAL CONST x min, x max, y min, y max) : + window (x min, x max, y min, y max, 0.0, 1.0) +END PROC window; + +PROC window (REAL CONST x min, x max, y min, y max, z min, z max) : + set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max), + ROW 2 REAL : (y min, y max), + ROW 2 REAL : (z min, z max)), + limits d, angles d, oblique d, perspective d) +END PROC window; + +PROC viewport (REAL CONST h min, h max, v min, v max) : + set values (size d, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), + ROW 2 REAL : (v min, v max)), + angles d, oblique d, perspective d) +END PROC view port; + +PROC view (REAL CONST alpha) : + set values (size d, limits d, ROW 4 REAL : (alpha, angles d(2), angles d (3), angles d (4)), + oblique d, perspective d) +END PROC view; + +PROC view (REAL CONST phi, theta) : + set values (size d, limits d, ROW 4 REAL : (angles d(1), sind (theta) * cosd (phi), + sind (theta) * sind (phi), cosd (theta)), + oblique d, perspective d) +END PROC view; + +PROC view (REAL CONST x, y, z) : + set values (size d, limits d, ROW 4 REAL : (angles d (1), x, y, z), oblique d, perspective d) +END PROC view; + +PROC drawing area (REAL VAR min h, max h, min v, max v): + min h := h min limit; max h := h max limit; + min v := v min limit; max v := v max limit +END PROC drawing area; + +PROC set drawing area (REAL CONST new size hor,new size vert, + new display hor,new display vert): + size hor := new size hor; + size vert:= new size vert; + display hor := new display hor; + display vert:= new display vert; + relation := size hor/size vert; + new limits := TRUE; + init transformation rows +END PROC set drawing area; + +BOOL PROC new values: + IF values new + THEN values new := FALSE; + TRUE + ELSE FALSE FI +END PROC new values; + +PROC get values (ROW 3 ROW 2 REAL VAR size, + ROW 2 ROW 2 REAL VAR limits, + ROW 4 REAL VAR angles, + ROW 2 REAL VAR oblique, + ROW 3 REAL VAR perspective) : + size := size d; + limits := limits d; + angles := angles d; + oblique := oblique d; + perspective := perspective d; + +END PROC get values; + +PROC set values (ROW 3 ROW 2 REAL CONST size, + ROW 2 ROW 2 REAL CONST limits, + ROW 4 REAL CONST angles, + ROW 2 REAL CONST oblique, + ROW 3 REAL CONST perspective) : + IF NOT same values + THEN values new := TRUE; + copy values; + set views; + check perspective projektion; + calc limits; + change projektion + FI . + +same values: + size hor d = size hor AND size vert d = size vert AND + size d = size AND limits d = limits AND angles d = angles AND + oblique d = oblique AND perspective d = perspective . + +copy values : + size hor d := size hor; + size vert d := size vert; + size d := size; + limits d := limits; + angles d := angles; + oblique d := oblique; + perspective d := perspective . + +set views : + REAL VAR diagonale := sqrt (angles [2] * angles [2] + + angles [3] * angles [3] + + angles [4] * angles [4]), + projektion := sqrt (angles [2] * angles [2] + + angles [4] * angles [4]), + sin p, cos p, sin t, cos t, sin a, cos a; + + IF diagonale = 0.0 + THEN sin p := 0.0; cos p := 1.0; + sin t := 0.0; cos t := 1.0 + ELIF projektion = 0.0 + THEN sin p := angles [3] / diagonale; + cos p := projektion / diagonale; + sin t := 0.0; cos t := 1.0 + ELSE sin p := angles [3] / diagonale; + cos p := projektion / diagonale; + sin t := angles [2] / projektion; + cos t := angles [4] / projektion + FI; + + REAL VAR sin p sin t := sin p * sin t, + sin p cos t := sin p * cos t, + cos p sin t := cos p * sin t, + cos p cos t := cos p * cos t, + + dx := size [1][2] - size [1][1], + dy := size [2][2] - size [2][1], + dz := size [3][2] - size [3][1], + norm az := oblique [1] , + norm bz := oblique [2] , + norm cx := perspective [1] / dx, + norm cy := perspective [2] / dy, + norm cz := perspective [3] / dz; + +p := ROW 5 ROW 5 REAL : + (ROW 5 REAL : ( cos t / dx - cos p sin t / dx * norm az , + - sin p sin t / dx - cos p sin t / dx * norm bz, + 0.0, + - cos p sin t / dx * norm cz, + 0.0 ), + ROW 5 REAL : ( - sin p / dy * norm az, + cos p / dy - sin p / dy * norm bz, + 0.0, + - sin p / dy * norm cz, + 0.0 ), + ROW 5 REAL : ( sin t / dz + cos p cos t / dz * norm az, + + sin p cos t / dz + cos p cos t / dz * norm bz, + 0.0, + cos p cos t / dz * norm cz, + 0.0 ), + ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ), + ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0)); + + IF angles (1) = 0.0 + THEN set alpha as y vertical + ELSE sin a := sind (angles (1)); + cos a := cosd (angles (1)) + FI; + + FOR j FROM 1 UPTO 5 + REP REAL CONST p j 1 := p (j)(1); + p (j)(1) := p j 1 * cos a - p (j)(2) * sin a; + p (j)(2) := p j 1 * sin a + p (j)(2) * cos a + PER . + +set alpha as y vertical : + REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2); + IF r = 0.0 + THEN sin a := 0.0; + cos a := 1.0 + ELSE sin a :=-p(2)(1)/r; + cos a := p(2)(2)/r + FI . + +check perspective projektion: + perspective projektion := perspective [3] <> 0.0 . + +calc limits : + IF new limits + THEN calc two dim extrema; + IF all limits smaller than 2 + THEN prozente + ELSE zentimeter FI + FI . + +calc two dim extrema : + h min := max real; h max :=-max real; + v min := max real; v max :=-max real; + + extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max); + extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max); + extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max); + extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max); + extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max); + extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max); + extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max); + extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max) . + +all limits smaller than 2 : + limits (1)(2) < 2.0 AND limits (2)(2) < 2.0 . + +prozente : + h min limit := display hor * limits (1)(1)/relation; + h max limit := display hor * limits (1)(2)/relation; + + v min limit := limits (2)(1) * display vert; + v max limit := limits (2)(2) * display vert . + +zentimeter : + h min limit := display hor * (limits (1)(1)/size hor); + h max limit := display hor * (limits (1)(2)/size hor); + + v min limit := display vert * (limits (2)(1)/size vert); + v max limit := display vert * (limits (2)(2)/size vert) . + +change projektion : + REAL VAR sh := (h max limit - h min limit) / (h max - h min), + sv := (v max limit - v min limit) / (v max - v min), + dh := h min limit - h min*sh, + dv := v min limit - v min*sv; + + FOR j FROM 1 UPTO 5 + REP + p (j)(1) := p (j)(1) * sh; + p (j)(2) := p (j)(2) * sv + PER; + p (5)(1) := dh; + p (5)(2) := dv. +END PROC set values; + +PROC transform (REAL CONST x, y, z, INT VAR h, v) : + disable stop; + IF perspective projektion + THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0); + h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1)); + v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2)) + ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1)); + v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2)); + FI; + IF is error + THEN h := -1; + v := -1; + clear error + FI +END PROC transform; + +PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max): + REAL VAR h, v; + IF perspective projektion + THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0); + h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w; + v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w + ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1)); + v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2)) + FI; + + IF h < h min + THEN h min := h + ELIF h > h max + THEN h max := h FI; + + IF v < v min + THEN v min := v + ELIF v > v max + THEN v max := v FI + +END PROC extrema; + +BOOL PROC clipped line (REAL VAR x0,y0,x1,y1): + REAL VAR dx :: (display hor - 1.0) / 2.0, + dy :: (display vert- 1.0) / 2.0, + rx0 :: x0 - dx, + ry0 :: y0 - dy, + rx1 :: x1 - dx, + ry1 :: y1 - dy; + INT VAR cx0, + cy0, + cx1, + cy1; + calculate cells; + IF (cx0*cx1 = 1) OR (cy0 * cy1 = 1) + THEN FALSE + ELIF (x0 = x1) AND (y0 = y1) + THEN cx0 = 0 AND cy0 = 0 + ELSE do clipping + FI. + + do clipping: + IF cx0 <> 0 + THEN REAL VAR next x :: real(cx0) * dx; + ry0 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx0) + ry0; + rx0 := next x + FI; + calculate cells; + IF cy0 <> 0 + THEN REAL VAR next y :: real(cy0) * dy; + rx0 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry0) + rx0; + ry0 := next y + FI; + IF cx1 <> 0 + THEN next x := real(cx1) * dx; + ry1 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx1) + ry1; + rx1 := next x + FI; + calculate cells; + IF cy1 <> 0 + THEN next y := real(cy1) * dy; + rx1 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry1) + rx1; + ry1 := next y + FI; + IF (rx1 = rx0) AND (ry1 = ry0) + THEN FALSE + ELSE x0 := rx0+dx; + y0 := ry0+dy; + x1 := rx1+dx; + y1 := ry1+dy; + TRUE + FI. + + calculate cells: + cx0 := 0; + cy0 := 0; + cx1 := 0; + cy1 := 0; + IF abs(rx0) > dx + THEN cx0 := sign(rx0) + FI; + IF abs(rx1) > dx + THEN cx1 := sign(rx1) + FI; + IF abs(ry0) > dy + THEN cy0 := sign(ry0) + FI; + IF abs(ry1) > dy + THEN cy1 := sign(ry1) + FI. + +END PROC clipped line; + +END PACKET transformation; + +(******************************** picture ********************************) + +PACKET picture DEFINES (* Autor: H.Indenbirken *) + PICTURE, (* Stand: 23.02.1985 *) + :=, CAT, nilpicture, + draw, draw r, draw cm, draw cm r, + move, move r, move cm, move cm r, + bar, circle, + length, dim, pen, where, + extrema, rotate, stretch, translate, + text, picture: + +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + move cm key = 6, + draw cm key = 7, + move cm r key = 8, + draw cm r key = 9, + bar key = 10, + circle key = 11, + max 2 dim = 31983, + max 3 dim = 31975, + max text = 31974, + max bar = 31982, + max circle = 31974, + max length = 32000; + + +TYPE PICTURE = STRUCT (INT dim, pen, TEXT points); + + +INT VAR read pos; +REAL VAR x, y, z; +TEXT VAR r2 :: 16*""0"", r3 :: 24*""0"", i1 :: ""0""0""; + +OP := (PICTURE VAR l, PICTURE CONST r) : + CONCR (l) := CONCR (r) +END OP :=; + +OP CAT (PICTURE VAR l, PICTURE CONST r) : + IF l.dim <> r.dim + THEN errorstop ("OP CAT : left dimension <> right dimension") + ELIF length (l.points) > max length - length (r.points) + THEN errorstop ("OP CAT : Picture overflow") FI; + + l.points CAT r.points +END OP CAT; + +PICTURE PROC nilpicture : + PICTURE : (0, 1, "") +END PROC nilpicture; + +PROC draw (PICTURE VAR p, TEXT CONST text) : + draw (p, text, 0.0, 0.0, 0.0) +END PROC draw; + +PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright): + write (p, text, angle, height, bright, text key) +END PROC draw; + +PROC draw (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, draw key) +END PROC draw; + +PROC draw (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, draw key) +END PROC draw; + +PROC draw r (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, draw r key) +END PROC draw r; + +PROC draw r (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, draw r key) +END PROC draw r; + +PROC draw cm (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, draw cm key) +END PROC draw cm; + +PROC draw cm r (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, draw cm r key) +END PROC draw cm r; + +PROC move (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, move key) +END PROC move; + +PROC move (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, move key) +END PROC move; + +PROC move r (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, move r key) +END PROC move r; + +PROC move r (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, move r key) +END PROC move r; + +PROC move cm (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, move cm key) +END PROC move cm; + +PROC move cm r (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, move cm r key) +END PROC move cm r; + +PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern): + write (p, width, height, pattern, bar key) +END PROC bar; + +PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern): + write (p, radius, from, to, pattern, circle key) +END PROC circle; + + +PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST key) : + IF length (p.points) < max 3 dim + THEN p.points CAT code (key); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + p.points CAT r3 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST key) : + IF length (p.points) < max 2 dim + THEN p.points CAT code (key); + replace (r2, 1, x); + replace (r2, 2, y); + p.points CAT r2 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST n, key) : + IF length (p.points) < max bar + THEN p.points CAT code (key); + replace (r2, 1, x); + replace (r2, 2, y); + p.points CAT r2; + replace (i1, 1, n); + p.points CAT i1 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST n, key) : + IF length (p.points) < max circle + THEN p.points CAT code (key); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + p.points CAT r3; + replace (i1, 1, n); + p.points CAT i1 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, TEXT CONST t, REAL CONST angle, height, bright, + INT CONST key) : + IF max text - length (p.points) >= length (t) + THEN p.points CAT code (key); + replace (i1, 1, length (t)); + p.points CAT i1; + p.points CAT t; + replace (r3, 1, angle); + replace (r3, 2, height); + replace (r3, 3, bright); + p.points CAT r3 + FI; +END PROC write; + +PROC check dim (PICTURE VAR p, INT CONST dim): + IF p.dim = 0 + THEN p.dim := dim + ELIF p.dim <> dim + THEN errorstop ("Picture is " + text (p.dim) + " dimensional") FI +END PROC check dim; + +INT PROC length (PICTURE CONST p): + length (p.points) +END PROC length; + +INT PROC dim (PICTURE CONST pic) : + pic.dim +END PROC dim; + +PROC pen (PICTURE VAR p, INT CONST pen) : + IF pen < 0 OR pen > 16 + THEN errorstop ("pen out of range [0-16]") FI; + p.pen := pen +END PROC pen; + +INT PROC pen (PICTURE CONST p) : + p.pen +END PROC pen; + +PROC where (PICTURE CONST p, REAL VAR x, y) : + IF p.dim = 0 + THEN x := 0.0; y := 0.0 + ELIF p.dim = 3 + THEN errorstop ("Picture is 3 dimensional") + ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1; + y := subtext (p.points, length (p.points)-7, length (p.points)) RSUB 1 + FI +END PROC where; + +PROC where (PICTURE CONST p, REAL VAR x, y, z) : + IF p.dim = 0 + THEN x := 0.0; y := 0.0; z := 0.0 + ELIF p.dim = 2 + THEN errorstop ("Picture is 2 dimensional") + ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1; + y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1; + z := subtext (p.points, length (p.points)-7, length (p.points)) RSUB 1; + FI +END PROC where; + + +PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) : + x min := max real; x max :=-max real; + y min := max real; y max :=-max real; + z min := max real; z max :=-max real; + read pos := 0; + INT CONST pic length := length (p.points); + WHILE read pos < pic length + REP check position PER . + +check position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : calc extrema + CASE move key : calc extrema + CASE move r key : calc rel extrema + CASE draw r key : calc rel extrema + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +calc extrema : + x := next real; y := next real; z := next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y); + z min := min (z min, z); z max := max (z max, z) . + +calc rel extrema : + x INCR next real; y INCR next real; z INCR next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y); + z min := min (z min, z); z max := max (z max, z) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC extrema; + +PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max): + x min := max real; x max :=-max real; + y min := max real; y max :=-max real; + read pos := 0; + INT CONST pic length := length (p.points); + WHILE read pos < pic length + REP check position PER . + +check position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : calc extrema + CASE move key : calc extrema + CASE move r key : calc rel extrema + CASE draw r key : calc rel extrema + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +calc extrema : + x := next real; y := next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y) . + +calc rel extrema : + x INCR next real; y INCR next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC extrema; + +PROC rotate (PICTURE VAR p, REAL CONST angle) : (* X-Rotation *) + REAL CONST s :: sind( angle ), c := cosd( angle ); + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( 1.0, 0.0, 0.0 ), + ROW 3 REAL : ( 0.0, c , s ), + ROW 3 REAL : ( 0.0, -s , c ), + ROW 3 REAL : ( 0.0, 0.0, 0.0 ))) +END PROC rotate; + +PROC yrotate (PICTURE VAR p, REAL CONST angle): (* Y-Rotation *) + REAL CONST s :: sind (angle), c :: cosd (angle); + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( c , 0.0, -s ), + ROW 3 REAL : ( 0.0, 1.0, 0.0 ), + ROW 3 REAL : ( s , 0.0, c ), + ROW 3 REAL : ( 0.0, 0.0, 0.0 ))) +END PROC yrotate; + +PROC zrotate (PICTURE VAR p, REAL CONST angle): (* Z-Rotation *) + REAL CONST s :: sind (angle), c :: cosd (angle); + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( c , s , 0.0 ), + ROW 3 REAL : ( -s , c , 0.0 ), + ROW 3 REAL : ( 0.0, 0.0, 1.0 ), + ROW 3 REAL : ( 0.0, 0.0, 0.0 ))) +END PROC zrotate; + +PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) : + IF phi <> 0.0 + THEN rotate (p, phi) FI; + IF theta <> 0.0 + THEN yrotate (p, theta) FI; + IF lambda <> 0.0 + THEN zrotate (p, lambda) + FI +END PROC rotate; + +PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) : + stretch (pic, sx, sy, 1.0) +END PROC stretch; + +PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) : + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( sx, 0.0, 0.0), + ROW 3 REAL : (0.0, sy, 0.0), + ROW 3 REAL : (0.0, 0.0, sz), + ROW 3 REAL : (0.0, 0.0, 0.0))) +END PROC stretch; + +PROC translate (PICTURE VAR p, REAL CONST dx, dy) : + translate (p, dx, dy, 0.0) +END PROC translate; + +PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) : + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : (1.0, 0.0, 0.0), + ROW 3 REAL : (0.0, 1.0, 0.0), + ROW 3 REAL : (0.0, 0.0, 1.0), + ROW 3 REAL : ( dx, dy, dz))) +END PROC translate; + +PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) : + INT CONST pic length := length (p.points); + INT VAR begin pos; + read pos := 0; + x := 0.0; y := 0.0; z := 0.0; + IF p.dim = 2 + THEN transform 2 dim pic + ELSE transform 3 dim pic FI . + +transform 2 dim pic: + WHILE read pos < pic length + REP transform 2 dim position PER . + +transform 2 dim position: + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : transform 2 dim point + CASE move key : transform 2 dim point + CASE move r key : transform 2 dim point + CASE draw r key : transform 2 dim point + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +transform 2 dim point: + begin pos := read pos+1; + x := next real; y := next real; + transform (a, x, y, z); + replace (r2, 1, x); + replace (r2, 2, y); + replace (p.points, begin pos, r2) . + +transform 3 dim pic: + WHILE read pos < pic length + REP transform 3 dim position PER . + +transform 3 dim position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : transform 3 dim point + CASE move key : transform 3 dim point + CASE move r key : transform 3 dim point + CASE draw r key : transform 3 dim point + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +transform 3 dim point: + begin pos := read pos+1; + x := next real; y := next real; z := next real; + transform (a, x, y, z); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + replace (p.points, begin pos, r3) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC transform; + +PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) : + REAL CONST ox :: x, oy :: y, oz :: z; + x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1); + y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2); + z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3) +END PROC transform; + +TEXT PROC text (PICTURE CONST pic): + TEXT VAR result :: ""0""0""0""0""; (* 23.09.87 -cw- *) + replace (result, 1, pic.dim); (* wegen Heap-Ueberlauf *) + replace (result, 2, pic.pen); + result CAT pic.points; + result +END PROC text; + +PICTURE PROC picture (TEXT CONST text): + PICTURE : (text ISUB 1, text ISUB 2, subtext (text, 5)) +END PROC picture; + +END PACKET picture; + +(******************************** picfile *********************************) + +PACKET picfile DEFINES (* Autor: H.Indenbirken *) + (* Stand: 23.02.1985 *) + PICFILE, :=, picture file, + select pen, selected pen, background, + set values, get values, + view, viewport, window, oblique, orthographic, perspective, + extrema, + + put, get, + to first pic, to eof, to pic, up, down, + is first picture, eof, picture no, pictures, + delete picture, insert picture, read picture, + write picture, put picture: + + +LET max pics = 1024, + pic dataspace = 1102; + + +TYPE PICFILE = BOUND STRUCT (INT size, pos, background, + ROW 16 ROW 3 INT pens, + ROW 16 BOOL hidden, + ROW 3 ROW 2 REAL sizes, + ROW 2 ROW 2 REAL limits, + ROW 4 REAL angles, + ROW 2 REAL obliques, + ROW 3 REAL perspectives, + ROW max pics PICTURE pic); + +TEXT VAR i text :: ""0""0"", r text :: ""0""0""0""0""0""0""0""0""; +INT VAR i; + +OP := (PICFILE VAR dest, PICFILE CONST source): + EXTERNAL 260 +END OP := ; + +OP := (PICFILE VAR p, DATASPACE CONST d) : + IF type (d) = pic dataspace + THEN CONCR (p) := d + ELIF type (d) < 0 + THEN type (d, pic dataspace) ; + CONCR (p) := d ; + init picfile dataspace ; + ELSE errorstop ("dataspace is no PICFILE") FI . + +init picfile dataspace : + r.size := 0; + r.pos := 0; + r.background := 0; + r.sizes [1][1] := 0.0; + r.sizes [1][2] := 1.0; + r.sizes [2][1] := 0.0; + r.sizes [2][2] := 1.0; + r.sizes [3][1] := 0.0; + r.sizes [3][2] := 1.0; + r.limits [1][1] := 0.0; + r.limits [1][2] := 1.0; + r.limits [2][1] := 0.0; + r.limits [2][2] := 1.0; + r.angles [1] := 0.0; + r.angles [2] := 0.0; + r.angles [3] := 0.0; + r.angles [4] := 0.0; + r.obliques [1] := 0.0; + r.obliques [2] := 0.0; + r.perspectives [1] := 0.0; + r.perspectives [2] := 0.0; + r.perspectives [3] := 0.0; + FOR i FROM 1 UPTO 16 + REP r.pens [i][1] := 1; + r.pens [i][2] := 0; + r.pens [i][3] := 1; + r.hidden [i] := TRUE + PER. + +r : CONCR (CONCR (p)). + +END OP :=; + +DATASPACE PROC picture file (TEXT CONST name) : + IF exists (name) + THEN old (name) + ELSE new (name) FI +END PROC picture file; + +PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type, + BOOL CONST hidden): + IF pen < 1 OR pen > 16 + THEN errorstop ("pen out of range") FI; + p.pens [pen][1] := colour; + p.pens [pen][2] := thickness; + p.pens [pen][3] := line type; + p.hidden [pen] := hidden +END PROC select pen; + +PROC selected pen (PICFILE CONST p, INT CONST pen, + INT VAR colour, thickness, line type, + BOOL VAR hidden): + IF pen < 1 OR pen > 16 + THEN errorstop ("pen out of range") FI; + colour := p.pens [pen][1]; + thickness := p.pens [pen][2]; + line type := p.pens [pen][3]; + hidden := p.hidden [pen] +END PROC selected pen; + +INT PROC background (PICFILE CONST p): + p.background +END PROC background; + +PROC background (PICFILE VAR p, INT CONST colour): + p.background := colour +END PROC background; + +PROC get values (PICFILE CONST p, + ROW 3 ROW 2 REAL VAR size, + ROW 2 ROW 2 REAL VAR limits, + ROW 4 REAL VAR angles, + ROW 2 REAL VAR oblique, + ROW 3 REAL VAR perspective) : + size := p.sizes; + limits := p.limits; + angles := p.angles; + oblique := p.obliques; + perspective := p.perspectives; + +END PROC get values; + +PROC set values (PICFILE VAR p, + ROW 3 ROW 2 REAL CONST size, + ROW 2 ROW 2 REAL CONST limits, + ROW 4 REAL CONST angles, + ROW 2 REAL CONST oblique, + ROW 3 REAL CONST perspective) : + p.sizes := size; + p.limits := limits; + p.angles := angles; + p.obliques := oblique; + p.perspectives := perspective; + +END PROC set values; + +PROC view (PICFILE VAR p, REAL CONST alpha): + p.angles [1] := alpha +END PROC view; + +PROC view (PICFILE VAR p, REAL CONST phi, theta): + p.angles [2] := sind (theta) * cosd (phi); + p.angles [3] := sind (theta) * sind (phi); + p.angles [4] := cosd (theta); +END PROC view; + +PROC view (PICFILE VAR p, REAL CONST x, y, z): + p.angles [2] := x; + p.angles [3] := y; + p.angles [4] := z +END PROC view; + +PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) : + p.limits [1][1] := hor min; + p.limits [1][2] := hor max; + p.limits [2][1] := vert min; + p.limits [2][2] := vert max; +END PROC viewport; + +PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) : + window (p, x min, x max, y min, y max, 0.0, 1.0) +END PROC window; + +PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) : + p.sizes [1][1] := x min; + p.sizes [1][2] := x max; + p.sizes [2][1] := y min; + p.sizes [2][2] := y max; + p.sizes [3][1] := z min; + p.sizes [3][2] := z max; +END PROC window; + +PROC oblique (PICFILE VAR p, REAL CONST a, b) : + p.obliques [1] := a; + p.obliques [2] := b; + p.perspectives [1] := 0.0; + p.perspectives [2] := 0.0; + p.perspectives [3] := 0.0 +END PROC oblique; + +PROC orthographic (PICFILE VAR p) : + p.obliques [1] := 0.0; + p.obliques [2] := 0.0; + p.perspectives [1] := 0.0; + p.perspectives [2] := 0.0; + p.perspectives [3] := 0.0 +END PROC orthographic; + +PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) : + p.obliques [1] := 0.0; + p.obliques [2] := 0.0; + p.perspectives [1] := cx; + p.perspectives [2] := cy; + p.perspectives [3] := cz +END PROC perspective; + +PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) : + REAL VAR dummy; + extrema (p, x min, x max, y min, y max, dummy, dummy) +END PROC extrema; + +PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) : + REAL VAR new x min, new x max, new y min, new y max, new z min, new z max; + x min := max real; x max := - max real; + y min := max real; y max := - max real; + z min := max real; z max := - max real; + FOR i FROM 1 UPTO p.size + REP IF dim (p.pic [i]) = 2 + THEN extrema (p.pic [i], new x min, new x max, new y min, new y max) + ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max, + new z min, new z max) + FI; + x min := min (x min, new x min); x max := max (x max, new x max); + y min := min (y min, new y min); y max := max (y max, new y max); + z min := min (z min, new z min); z max := max (z max, new z max); + PER +END PROC extrema; + +PROC put (FILE VAR f, PICFILE CONST p): + put line (f, parameter); + FOR i FROM 1 UPTO p.size + REP put line (f, text (p.pic [i])) PER . + +parameter: + intern (p.size) + intern (p.pos) + intern (p.background) + intern (p.pens) + + intern (p.hidden) + intern (p.sizes) + intern (p.limits) + intern (p.angles) + + intern (p.obliques) + intern (p.perspectives) . + +END PROC put; + +PROC get (PICFILE VAR p, FILE VAR f): + TEXT VAR record; + get line (f, record); + convert parameter; + FOR i FROM 1 UPTO p.size + REP get line (f, record); + p.pic [i] := picture (record) + PER . + +convert parameter: + convert (record, p.size); convert (record, p.pos); + convert (record, p.background); convert (record, p.pens); + convert (record, p.hidden); convert (record, p.sizes); + convert (record, p.limits); convert (record, p.angles); + convert (record, p.obliques); convert (record, p.perspectives) . + +END PROC get; + +PROC to first pic (PICFILE VAR p): + p.pos := 1 +END PROC to first pic; + +PROC to eof (PICFILE VAR p): + p.pos := p.size+1 +END PROC to eof; + +PROC to pic (PICFILE VAR p, INT CONST n): + IF n < 1 + THEN errorstop ("Position underflow") + ELIF n > p.size + THEN errorstop ("Position after end of PICFILE") + ELSE p.pos := n FI +END PROC to pic; + +PROC up (PICFILE VAR p): + to pic (p, p.pos-1) +END PROC up; + +PROC up (PICFILE VAR p, INT CONST n): + to pic (p, p.pos-n) +END PROC up; + +PROC down (PICFILE VAR p): + to pic (p, p.pos+1) +END PROC down; + +PROC down (PICFILE VAR p, INT CONST n): + to pic (p, p.pos+n) +END PROC down; + +BOOL PROC is first picture (PICFILE CONST p): + p.pos = 1 +END PROC is first picture; + +BOOL PROC eof (PICFILE CONST p): + p.pos >= p.size +END PROC eof; + +INT PROC picture no (PICFILE CONST p): + p.pos +END PROC picture no; + +INT PROC pictures (PICFILE CONST p): + p.size +END PROC pictures; + +PROC delete picture (PICFILE VAR p) : + INT VAR i; + FOR i FROM p.pos+1 UPTO p.size + REP p.pic [i-1] := p.pic [i] PER; + + p.pic [p.size] := nilpicture; + IF p.size > 1 + THEN p.size DECR 1 FI +END PROC delete picture; + +PROC insert picture (PICFILE VAR p) : + INT VAR i; + IF p.size >= max pics + THEN errorstop ("PICFILE overflow") + ELSE p.size INCR 1; + FOR i FROM p.size DOWNTO p.pos+1 + REP p.pic [i] := p.pic [i-1] PER; + + p.pic [p.pos] := nilpicture; + FI +END PROC insert picture; + +PROC read picture (PICFILE VAR p, PICTURE VAR pic) : + pic := p.pic (p.pos) . +END PROC read picture; + +PROC write picture (PICFILE VAR p, PICTURE CONST pic) : + p.pic (p.pos) := pic . +END PROC write picture; + +PROC put picture (PICFILE VAR p, PICTURE CONST pic) : + IF p.size >= max pics + THEN errorstop ("PICFILE overflow") + ELSE p.size INCR 1; + p.pic [p.size] := pic; + FI +END PROC put picture; + +TEXT PROC intern (INT CONST n): + replace (i text, 1, n); + i text +END PROC intern; + +TEXT PROC intern (ROW 16 ROW 3 INT CONST n): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 16 + REP FOR j FROM 1 UPTO 3 + REP result CAT intern (n [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 16 BOOL CONST n): + INT VAR i, result :: 0; + FOR i FROM 1 UPTO 16 + REP IF n [i] + THEN set bit (result, i-1) FI + PER; + intern (result) +END PROC intern; + +TEXT PROC intern (REAL CONST r): + replace (r text, 1, r); + r text +END PROC intern; + +TEXT PROC intern (ROW 3 ROW 2 REAL CONST r): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 3 + REP FOR j FROM 1 UPTO 2 + REP result CAT intern (r [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 2 ROW 2 REAL CONST r): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 2 + REP FOR j FROM 1 UPTO 2 + REP result CAT intern (r [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 4 REAL CONST r): + intern (r [1]) + intern (r [2]) + intern (r [3]) + intern (r [4]) +END PROC intern; + +TEXT PROC intern (ROW 3 REAL CONST r): + intern (r [1]) + intern (r [2]) + intern (r [3]) +END PROC intern; + +TEXT PROC intern (ROW 2 REAL CONST r): + intern (r [1]) + intern (r [2]) +END PROC intern; + +PROC convert (TEXT VAR record, INT VAR n): + n := record ISUB 1; + record := subtext (record, 3) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 16 ROW 3 INT VAR n): + INT VAR i, j; + FOR i FROM 1 UPTO 16 + REP FOR j FROM 1 UPTO 3 + REP convert (record, n [i][j]) PER + PER +END PROC convert; + +PROC convert (TEXT VAR record, ROW 16 BOOL VAR n): + INT VAR i, result; + convert (record, result); + FOR i FROM 1 UPTO 16 + REP n [i] := bit (i-1, result) PER +END PROC convert; + +PROC convert (TEXT VAR record, REAL VAR r): + r := record RSUB 1; + record := subtext (record, 9) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 3 ROW 2 REAL VAR r): + INT VAR i, j; + FOR i FROM 1 UPTO 3 + REP FOR j FROM 1 UPTO 2 + REP convert (record, r [i][j]) PER + PER; +END PROC convert; + +PROC convert (TEXT VAR record, ROW 2 ROW 2 REAL VAR r): + INT VAR i, j; + FOR i FROM 1 UPTO 2 + REP FOR j FROM 1 UPTO 2 + REP convert (record, r [i][j]) PER + PER; +END PROC convert; + +PROC convert (TEXT VAR record, ROW 4 REAL VAR r): + convert (record, r [1]); convert (record, r [2]); + convert (record, r [3]); convert (record, r [4]) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 3 REAL VAR r): + convert (record, r [1]); convert (record, r [2]); convert (record, r [3]) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 2 REAL VAR r): + convert (record, r [1]); convert (record, r [2]) +END PROC convert; + +END PACKET picfile; + +(********************************* devices ********************************) + +PACKET devices DEFINES PLOTTER, + select plotter, + install plotter, + plotters, + plotter, + no plotter, + name, + channel, + station, + actual plotter, + drawing area, + plotter info, + :=, + = : + +LET trenn = "/"; + +TYPE PLOTTER = STRUCT (INT station, channel, TEXT name); +PLOTTER CONST noplotter :: PLOTTER : (0,0,""); +PLOTTER VAR plotter id :: no plotter; +TARGET VAR devices; +TEXT VAR plotter set; +INT VAR act plotter; + +OP := (PLOTTER VAR dest, PLOTTER CONST source): + CONCR (dest) := CONCR (source) +END OP := ; + +BOOL OP = (PLOTTER CONST a, b): + (a.station = b.station) AND + (a.channel = b.channel) AND + (a.name = b.name ) +END OP =; + +PLOTTER PROC plotter: + plotter id +END PROC plotter; + +PLOTTER PROC plotter (TEXT CONST def plotter): + select target (devices, def plotter, plotter set); + IF plotter set = "" + THEN IF def plotter = "" + THEN act plotter := 0; + no plotter + ELSE errorstop ("Unbekannter Plot-Id : " + def plotter); + no plotter + FI + ELSE select;plotter id + FI. + + select: + INT VAR tp; + PLOTTER VAR plotter id; + plotter id.station := int(def plotter); + tp := pos (def plotter, trenn) + 1; + plotter id.channel := int(subtext (def plotter,tp)); + plotter id.name := subtext (def plotter, pos (def plotter,trenn,tp)+1); +END PROC plotter; + +PROC select plotter: + THESAURUS VAR plotter list :: empty thesaurus; + TEXT VAR plotter name; + INT VAR index :: 0; + get (plotters, plotter name, index); + WHILE index > 0 REP + insert (plotter list,plotter info (plotter name,60)); + get (plotters, plotter name, index) + PER; + select plotter (name (plotters, link (plotter list, one(plotter list)))) +END PROC select plotter; + +PROC select plotter (PLOTTER CONST plotter): + select plotter (text (plotter.station) + trenn + text (plotter.channel) + + trenn + plotter.name) +END PROC select plotter; + +PROC select plotter (TEXT CONST def plotter): + select target (devices, def plotter, plotter set); + IF plotter set = "" + THEN IF def plotter = "" + THEN act plotter := 0; + plotter id := no plotter + ELSE errorstop ("Unbekannter Plot-Id : " + def plotter) + FI + ELSE select + FI. + + select: + INT VAR xp, yp, tp; REAL VAR xc, yc; + act plotter := link (plotters, def plotter); + plotter id.station := int(def plotter); + tp := pos (def plotter, trenn) + 1; + plotter id.channel := int(subtext (def plotter,tp)); + plotter id.name := subtext (def plotter, pos (def plotter,trenn,tp)+1); + drawing area (xc, yc, xp, yp); + set drawing area (xc, yc, real (xp), real (yp)); +END PROC select plotter; + +PROC install plotter (TARGET VAR new plotset): + THESAURUS VAR new plotter :: target names (new plotset); + INT VAR index :: 0; + TEXT VAR name,set; + initialize target (devices); + get (new plotter,name,index); + WHILE index > 0 REP + select target (new plotset, name, set); + complete target (devices, name, set); + get (new plotter, name, index) + PER +END PROC install plotter; + +INT PROC actual plotter: + act plotter +END PROC actual plotter; + +THESAURUS PROC plotters: + target names (devices) +END PROC plotters; + +TEXT PROC name (PLOTTER CONST plotter): + plotter.name +END PROC name; + +INT PROC channel (PLOTTER CONST plotter): + plotter.channel +END PROC channel; + +INT PROC station (PLOTTER CONST plotter): + plotter.station +END PROC station; + +PROC drawing area (REAL VAR xcm, ycm, INT VAR xp, yp): + IF plotter set <> "" + THEN INT VAR cp; + xp := int(plotter set); + cp := pos (plotter set,",")+1; + yp := int (subtext (plotter set,cp)); + cp := pos (plotter set,",",cp)+1; + xcm := real (subtext (plotter set,cp)); + cp := pos (plotter set,",",cp)+1; + ycm := real (subtext (plotter set,cp)) + FI +END PROC drawing area; + +PROC drawing area (REAL VAR xcm, ycm, INT VAR xp, yp,PLOTTER CONST pl): + PLOTTER CONST keep :: plotter; + select plotter (pl); + drawing area (xcm, ycm, xp, yp); + select plotter (keep) +END PROC drawing area; + +TEXT PROC plotter info (TEXT CONST plotter id,INT CONST len): + INT VAR tp :: pos (plotter id, trenn)+1; + TEXT VAR plotter name :: plotter id, + station :: "/Station" + text (int(plotter name),2), + kanal :: " Kanal" + text (int (subtext (plottername,tp)),3); + plotter name := subtext (plotter name, pos (plotter name, trenn,tp)+1) + " "; + INT VAR llen :: length (plotter name + kanal + station); + plotter name + (max(len-llen,0) * ".") + kanal + station +END PROC plotter info; + +END PACKET devices + diff --git a/app/mpg/2.2/src/GRAPHIK.Configurator b/app/mpg/2.2/src/GRAPHIK.Configurator new file mode 100644 index 0000000..68bf070 --- /dev/null +++ b/app/mpg/2.2/src/GRAPHIK.Configurator @@ -0,0 +1,946 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.2 vom 11.11.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Konfiguration" geschrieben von C.Weinholz *) +(* *) +(**************************************************************************) +(* *) +(* Graphik-Konfiguration *) +(* *) +(* Erstellung eines fuer alle Engeraete gueltigen *) +(* Basisgraphik-Paketes durch zusammenfuegen *) +(* von '.GCONF'-Dateien *) +(* *) +(* Aufruf durch 'configurate graphik', wenn insertiert *) +(* (normalerweise nicht notwendig) *) +(* Bei 'run' muss 'configurate graphik' ans Dateiende *) +(* geschrieben werden. *) +(* *) +(**************************************************************************) +PACKET graphik configuration DEFINES configurate graphik: + +LET PLOTTERCONF = STRUCT (TEXT name, station, channel, area, prep, init, end, + clear, home, move, draw, pixel, foreground, + background, palette, std colors, circle, box, + fill, cursor, get cursor, set marker, linked, + BOOL editor, + BOOL no plotter); +LET max conf = 15, + dquote = ""34""34"", + interface = "GRAPHIK.Configuration", + env conf file = "ENVIRONMENT.GCONF", + packet header = "PACKET device interface DEFINES prepare, init plot, endplot, clear, home, moveto, drawto, setpixel, foreground, background, set color, stdcolors, color, colors, set palette, circle, box,fill,graphik cursor, get cursor, set marker:", + packet end = "END PACKET device interface", + target = "TARGET VAR  plotter; initialize target ( plotter);", + install target= "install plotter ( plotter);", + init set = "PROC initplot: IF  wsc THEN  palette :=  std palette + ELSE  palette :=  empty palette FI;  initplot; set palette + END PROC initplot;", + end set = "BOOL VAR  we::TRUE; + PROCendplot(BOOL CONSTs): we:=s + END PROCendplot; + PROCendplot: IF weTHEN endplotFI + END PROCendplot;", + clear set = "BOOL VAR  wc::TRUE; PROCclear(BOOL CONSTs): wc:=s + END PROC clear; PROC clear:IF wcTHEN clearFI END PROC clear;", + color set = "BOOL VAR  wsc::TRUE; TEXT VAR  palette; PROC setcolor (INT CONST no,rgb): + IF (no+1) <= colors THEN replace( palette,no+1,rgb) + FI END PROC set color;", + color set2 = "INT PROC colors : length ( palette) DIV 2 END PROC colors; + INT PROC color (INT CONST no): IF no >= 0 AND (no+1) <= colors + THEN  palette ISUB (no+1) ELSE maxint FI END PROC color;", + std colors = "PROCstdcolors(BOOL CONSTs):  wsc:=s END PROCstdcolors; + PROC stdcolors:IF wscTHEN palette :=  std palette;set palette FI END PROCstdcolors;", + foreground = "INT VAR af::1; INT PROCforeground: af END PROCforeground; + PROCforeground(INT CONSTm):  af:=m; foreground( af) END PROCforeground;", + background = "INT VAR  ab::0; INT PROCbackground: ab END PROCbackground; + PROCbackground(INT CONSTm):  ab:=m; background( ab) END PROCbackground;"; + +ROW max conf PLOTTERCONF VAR plotter; +ROW max conf DATASPACE VAR global data; + +TEXT CONST spaces :: 20 * " "; +INT VAR inst plotter, targets, error line :: 0; +TEXT VAR errorm1, errorm2, procvalue :: "", env conf, error source :: ""; +BOOL VAR errors :: FALSE; +FILE VAR f; +DATASPACE VAR conf ds; +THESAURUS VAR plotconfs; + +PROC configurate graphik: + FOR inst plotter FROM 1 UPTO max conf REP + act plotter.name := ""; + act plotter.area := ""; + act plotter.prep := ""; + act plotter.init := ""; + act plotter.end := ""; + act plotter.clear:= ""; + act plotter.home := ""; + act plotter.move := ""; + act plotter.draw := ""; + act plotter.pixel:= ""; + act plotter.foreground := ""; + act plotter.background := ""; + act plotter.palette := ""; + act plotter.circle := ""; + act plotter.box := ""; + act plotter.fill := ""; + act plotter.cursor := ""; + act plotter.get cursor := ""; + act plotter.set marker := ""; + act plotter.linked := ""; + act plotter.editor := FALSE; + PER; + env conf := ""; + inst plotter := 0; + plotconfs := empty thesaurus; + IF exists (env conf file) + THEN plotconfs := ALL env conf file + FI; + plotconfs := SOME (plotconfs + (all LIKE "*.GCONF") - env conf file); + INT VAR id :: 0; TEXT VAR conf file; + get (plotconfs, conf file, id); + WHILE id > 0 REP + IF exists (conf file) + THEN extract conf data (conf file) + ELSE get environment plotter + FI; + get (plotconfs, conf file, id); + PER; + IF inst plotter > 0 + THEN generate interface + ELSE errorstop ("Kein Interface erzeugt") + FI; + last param (interface). + + get environment plotter: + check sequence (conf file, "PLOTTER *,*,*,*,*,*,*;", + "2|4,3,3,3,3,3,3;", + "PLOTTER erwartet,"+ + "Name erwartet,,"+ + "Station erwartet,,"+ + "Kanal erwartet,,"+ + "XPixel erwartet,,"+ + "YPixel erwartet,,"+ + "Xcm erwartet,,"+ + "Ycm erwartet,,"+ + "Plotterkommando fehlerhaft"); + IF errors + THEN errorstop (errorm2) + ELSE TEXT VAR one int :: ""0""0"", one real :: 8 * ""0""; + replace (one int,1,length(get var (1))); + env conf CAT one int; + env conf CAT get var (1); + replace (one int, 1, int (get var (2))); + env conf CAT one int; + replace (one int, 1, int (get var (3))); + env conf CAT one int; + replace (one int, 1, int (get var (4))); + env conf CAT one int; + replace (one int, 1, int (get var (5))); + env conf CAT one int; + replace (one real, 1, real (get var (6))); + env conf CAT one real; + replace (one real, 1, real (get var (7))); + env conf CAT one real; + FI +END PROC configurate graphik; + +PROC extract conf data (TEXT CONST conf file): + TEXT VAR line; + inst plotter INCR 1; + IF inst plotter > max conf + THEN putline ("Warnung: Es koennen nicht mehr als " + text(max conf) + + " Geraete konfiguriert werden"); + inst plotter DECR 1 + ELSE error source := conf file; + conf ds := old (conf file); + f := sequential file (modify, conf ds); + set line numbers; + IF is plotter configuration + THEN get name and area (line, act plotter.name, + act plotter.station, + act plotter.channel, + act plotter.area); + get linked (act plotter.linked); + get includes; + putline ("""" + act plotter.name + """ wird eingelesen"); + get paramless ("initplot",act plotter.init); + get paramless ("endplot" ,act plotter.end); + get paramless ("clear" ,act plotter.clear); + get paramless ("home" ,act plotter.home); + get paramless ("prepare" ,act plotter.prep); + get koord ("moveto" ,act plotter.move); + get koord ("drawto" ,act plotter.draw); + get koord ("setpixel",act plotter.pixel); + get var param ("foreground",act plotter.foreground); + get var param ("background",act plotter.background); + get paramless ("setpalette",act plotter.palette); + get std colors(act plotter.std colors); + get circle (act plotter.circle); + get box (act plotter.box); + get fill (act plotter.fill); + IF editor available + THEN get graphik cursor (act plotter.cursor); + get get cursor (act plotter.get cursor); + get set marker (act plotter.set marker) + FI; + push error; + IF anything noted + THEN f := sequential file (modify,conf file); + out (""7"");note edit (f);errorstop("") + FI + FI; + global data [inst plotter] := conf ds; + forget (conf ds) + FI. + + is plotter configuration: + plotter [inst plotter].no plotter := NOT sequence found ("PLOTTER", + line, 1,TRUE); + NOT plotter [inst plotter].no plotter. + + editor available: + plotter [inst plotter].editor := sequence found ("EDITOR", line, 1,TRUE); + IF plotter [inst plotter].editor + THEN delete record (f); + check sequence (line, "EDITOR;", "2;", + "EDITOR erwartet,"+ + "Semikolon erwartet," + + "Editorkommando fehlerhaft") + FI; + plotter [inst plotter].editor. + + set line numbers: + INT VAR line number; + to line (f,1); + FOR line number FROM 1 UPTO lines (f)-1 REP + cout (line number); + insert line number; + down (f) + PER; + insert line number. + + insert line number: + TEXT VAR new line; + read record (f, new line); + insert char (new line, " ", 1); + insert char (new line, " ", 1); + replace (new line, 1, line number); + write record (f, new line). + + get includes: + BOOL VAR include found :: sequence found ("INCLUDE",line, 1, TRUE); + WHILE include found REP + push error; + include found := sequence found ("INCLUDE",line, line no (f), TRUE); + IF include found + THEN add to plotconfs + FI + PER. + + add to plotconfs: + check sequence (line, "INCLUDE *;","2|4;", + "INCLUDE erwartet,Dateiname erwartet," + + "Includekommando fehlerhaft"); + IF NOT errors CAND exists (get var (1)) + THEN IF NOT (plotconfs CONTAINS get var (1)) + THEN insert (plotconfs,get var (1)) + FI; + ELIF NOT errors + THEN error ("""" + get var (1) + """ existiert nicht") + FI; + delete record (f) +END PROC extract conf data; + +PROC generate interface: + INT VAR act conf; + conf ds := nilspace; + forget (interface,quiet); + proc value := ""; + FILE VAR f :: sequential file (output, conf ds); + putline (f,packet header); + putline (f,target); + generate target; + putline (f,install target); + putline (f,init set); + putline (f,end set); + putline (f,clear set); + putline (f,color set); + putline (f,color set 2); + putline (f, std colors); + putline (f,foreground); + putline (f,background); + FOR act conf FROM 1 UPTO inst plotter REP + FILE VAR source := sequential file (modify,global data [act conf]); + copy lines (f,source) + PER; + generate proc (""," initplot", TEXT PROC (INT CONST) initplotbody); + generate proc (""," endplot", TEXT PROC (INT CONST) endplotbody); + generate proc (""," clear", TEXT PROC (INT CONST) clearbody); + generate proc ("","prepare", TEXT PROC (INT CONST) prepbody); + proc value := " TEXT"; + generate proc (""," std palette", TEXT PROC (INT CONST) std palette body); + generate proc (""," empty palette", TEXT PROC (INT CONST) empty palette body); + proc value := ""; + generate proc ("","home", TEXT PROC (INT CONST) homebody); + generate proc ("INT CONST x,y","moveto", TEXT PROC (INT CONST) movebody); + generate proc ("INT CONST x,y","drawto", TEXT PROC (INT CONST) drawbody); + generate proc ("INT CONST x,y","set pixel", TEXT PROC (INT CONST) pixelbody); + generate proc ("INT VAR type"," foreground", TEXT PROC (INT CONST) foregroundbody); + generate proc ("INT VAR type"," background", TEXT PROC (INT CONST) backgroundbody); + generate proc ("","set palette", TEXT PROC (INT CONST) set palette body); + generate proc ("INT CONST x,y,rad,from,to","circle", TEXT PROC (INT CONST) circlebody); + generate proc ("INT CONST x1,y1,x2,y2,pattern", "box", TEXT PROC (INT CONST) box body); + generate proc ("INT CONST x,y,pattern","fill", TEXT PROC (INT CONST) fill body); + generate proc ("INT CONST x,y, BOOL CONST on","graphik cursor",TEXT PROC (INT CONST) graphik cursor body); + generate proc ("INT VAR x,y, TEXT VAR exit char","get cursor",TEXT PROC (INT CONST) get cursor body); + generate proc ("INT CONST x,y, type","set marker",TEXT PROC (INT CONST) set marker body); + proc value := "BOOL "; + generate proc ("","graphik cursor",TEXT PROC (INT CONST) editor available); + generate device link; + putline (f,packet end); + copy (conf ds,interface); + IF yes ("""" + interface + """ insertieren") + THEN insert (interface) + FI. + + generate target: + INT VAR devices :: 0; + targets := 0; + FOR act conf FROM 1 UPTO inst plotter REP + TEXT VAR linked :: plotter[act conf].linked, + one int:: ""0""0""; + plotter [act conf].linked := ""; + IF NOT plotter [act conf].no plotter + THEN putline (f,"complete target ( plotter,""" + + plotter [act conf].station + "/" + + plotter [act conf].channel + "/" + + plotter [act conf].name + + """,""" + plotter [act conf].area + """);"); + devices INCR 1; + targets INCR 1; + replace (one int, 1, devices); + plotter [act conf].linked CAT one int; + replace (one int, 1, targets); + plotter [act conf].linked CAT one int; + IF linked > "" + THEN INT VAR x :: 1; + WHILE x <= length (linked) DIV 2 REP + putline (f,"complete target ( plotter, """ + + text(linked ISUB x) + "/" + + text(linked ISUB (x+1)) + "/" + + plotter[act conf].name + """,""" + + plotter[act conf].area + """);"); + targets INCR 1; + replace (one int, 1, targets); + plotter [act conf].linked CAT one int; + x INCR 2 + PER + FI + FI + PER; + WHILE env conf <> "" REP + generate env target (env conf) + PER +END PROC generate interface; + +PROC generate env target (TEXT VAR conf): + INT VAR nlen :: conf ISUB 1; + TEXT VAR tnam :: subtext (conf, 3, 2+nlen); + conf := subtext (conf, nlen + 3); + putline (f,"complete target ( plotter, """ + text (conf ISUB 1) + "/" + + text (conf ISUB 2) + "/" + tnam + """,""" + + text (conf ISUB 3) + "," + text (conf ISUB 4) + "," + + first real + "," + text (conf RSUB 2) + """);"); + conf := subtext (conf, 17). + + first real: + conf := subtext (conf, 9); + text (conf RSUB 1) +END PROC generate env target; + +TEXT PROC initplotbody (INT CONST no): + plotter [no].init +END PROC initplotbody; + +TEXT PROC endplotbody (INT CONST no): + plotter [no].end +END PROC endplotbody; + +TEXT PROC clearbody (INT CONST no): + plotter [no].clear +END PROC clearbody; + +TEXT PROC prepbody (INT CONST no): + plotter [no].prep +END PROC prepbody; + +TEXT PROC homebody (INT CONST no): + plotter [no].home +END PROC homebody; + +TEXT PROC movebody (INT CONST no): + plotter [no].move +END PROC movebody; + +TEXT PROC drawbody (INT CONST no): + plotter [no].draw +END PROC drawbody; + +TEXT PROC pixelbody (INT CONST no): + plotter [no].pixel +END PROC pixelbody; + +TEXT PROC std palette body (INT CONST no): + TEXT CONST rgb codes :: plotter [no].std colors; + TEXT VAR body :: dquote; + INT VAR x; + FOR x FROM 1 UPTO length (rgb codes) DIV 3 REP + INT VAR color :: int (subtext(rgb codes, (x-1)*3+1, x*3)); + body CAT (text (color AND 255) + dquote); + body CAT (text (color DIV 256) + dquote); + PER; + body +END PROC std palette body; + +TEXT PROC empty palette body (INT CONST no): + text (length (plotter[no].std colors) DIV 3) + "*" + dquote + + "255" + dquote + "127" + dquote +END PROC empty palette body; + +TEXT PROC set palette body (INT CONST no): + plotter[no].palette +END PROC set palette body; + +TEXT PROC foregroundbody (INT CONST no): + plotter [no].foreground +END PROC foregroundbody; + +TEXT PROC backgroundbody (INT CONST no): + plotter [no].background +END PROC backgroundbody; + +TEXT PROC circle body (INT CONST no): + plotter [no].circle +END PROC circle body; + +TEXT PROC box body (INT CONST no): + plotter [no].box +END PROC box body; + +TEXT PROC fill body (INT CONST no): + plotter [no].fill +END PROC fill body; + +TEXT PROC graphik cursor body (INT CONST no): + plotter [no].cursor +END PROC graphik cursor body; + +TEXT PROC get cursor body (INT CONST no): + plotter [no].get cursor +END PROC get cursor body; + +TEXT PROC set marker body (INT CONST no): + plotter [no].set marker +END PROC set marker body; + +TEXT PROC editor available (INT CONST no): + IF plotter [no].editor + THEN "TRUE" + ELSE "FALSE" + FI +END PROC editor available; + +PROC generate device link: + INT VAR actconf; + putline (f, "INT PROC  act device :"); + putline (f, "SELECT actual plotter OF"); + FOR act conf FROM 1 UPTO inst plotter REP + IF NOT plotter [act conf].no plotter + THEN putline (f,"CASE " + text (plotter[act conf].linked ISUB 2) + ":"); + put (f,text (plotter[act conf].linked ISUB 1)); + IF length (plotter[act conf].linked) > 2 + THEN generate table + FI + FI + PER; + putline (f,"OTHERWISE errorstop (""Kein Endgeraet angekoppelt"");0"); + putline (f,"END SELECT END PROC  act device;"). + + generate table: + INT VAR x; + FOR x FROM 3 UPTO length (plotter[act conf].linked) DIV 2 REP + put (f,"CASE"); + put (f,text (plotter[act conf].linked ISUB x)); + put (f,":"); + put (f, text (plotter[act conf].linked ISUB 1)) + PER +END PROC generate device link; + +PROC generate proc (TEXT CONST params,procname,TEXT PROC (INT CONST)procbody): + INT VAR actconf, no plotter :: 0; + IF params = "" + THEN putline (f,procvalue + " PROC " + procname + ":") + ELSE putline (f,procvalue + " PROC " + procname + "(" + params + "):") + FI; + IF procvalue <> "" + THEN putline (f,procvalue + " VAR  d;") + FI; + putline (f,"SELECT  act device OF"); + FOR act conf FROM 1 UPTO inst plotter REP + IF NOT plotter [act conf].no plotter + THEN putline (f, "CASE " + text (act conf-no plotter) + ":" + + lowercase(plotter[act conf].name) + + plotter [act conf].channel + procname) + ELSE no plotter INCR 1 + FI + PER; + IF procvalue <> "" + THEN putline (f," OTHERWISE  d END SELECT") + ELSE putline (f," END SELECT") + FI; + FOR act conf FROM 1 UPTO inst plotter REP + IF NOT plotter [act conf].no plotter + THEN putline (f,"."); + putline (f,lowercase(plotter[act conf].name)+ + plotter[act conf].channel + procname + ":"); + putline (f,procbody (act conf)) + FI + PER; + putline (f,"END PROC "+ procname +";") +END PROC generate proc; + +PROC get name and area (TEXT CONST line, TEXT VAR name, station, channel, area): + push error; + check sequence (line, "PLOTTER *,*,*,*,*,*,*;", + "2|4,3,3,3,3,3,3;", + "PLOTTER erwartet,"+ + "Name erwartet,,"+ + "Station erwartet,,"+ + "Kanal erwartet,,"+ + "XPixel erwartet,,"+ + "YPixel erwartet,,"+ + "Xcm erwartet,,"+ + "Ycm erwartet,,"+ + "Plotterkommando fehlerhaft"); + name := get var (1); + station := get var (2); + channel := get var (3); + area := ""; + area CAT (get var (4) + ","); + area CAT (get var (5) + ","); + area CAT (get var (6) + ","); + area CAT (get var (7) + ","); + delete record (f) +END PROC get name and area; + +PROC get linked (TEXT VAR keep): + TEXT VAR line; + IF sequence found ("LINK", line, 1, TRUE) + THEN extract data; + delete record (f) + FI. + + extract data: + TEXT VAR symbol, one int :: ""0""0""; + INT VAR ltyp :: 2,type :: 0;(* 0 = ',' 1 = '/' 2 = Station 3 = Kanal*) + push error; (* 4 = Ende erwartet ! *) + keep := ""; + errorm1 := line; + scan (line); + next symbol (symbol); + IF symbol <> "LINK" + THEN error ("LINK erwartet") + FI; + WHILE type < 7 AND NOT errors REP + next symbol (symbol, type); + IF ltyp = 0 + THEN IF symbol = "," + THEN ltyp := 2 + ELIF symbol = ";" + THEN ltyp := 4 + ELSE error ("Semikolon oder Komma erwartet") + FI + ELIF ltyp = 1 + THEN IF symbol = "/" + THEN ltyp := 3 + ELSE error ("'/' erwartet") + FI + ELIF ltyp = 4 + THEN IF type = 8 + THEN error ("Kommentarende fehlt") + ELIF type = 9 + THEN error ("Text unzulaessig (Textende fehlt)") + ELIF type <> 7 + THEN error ("Zeilenende nach Semikolon erwartet") + FI + ELIF type = 3 + THEN replace (one int, 1, int (symbol)); + keep CAT one int; + ltyp DECR 1; + IF ltyp = 2 + THEN ltyp := 0 + FI + FI + PER +END PROC get linked; + +PROC get graphik cursor (TEXT VAR keep): + get proc ("graphik cursor","(INT CONST x,y, BOOL CONST on)", + "(2|2 x,y,2|2 on)","INT erwartet, CONST erwartet,"+ + "Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen,"+ + "BOOL erwartet, CONST erwartet,"+ + "Formaler Parameter muss on heissen", + keep); +END PROC get graphik cursor; + +PROC get get cursor (TEXT VAR keep): + get proc ("get cursor","(INT VAR x,y, TEXT VAR exit char)", + "(2|2 x,y,2|2 exit char)","INT erwartet, VAR erwartet,"+ + "Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen,"+ + "TEXT erwartet, VAR erwartet,"+ + "Formaler Parameter muss exit char heissen", + keep); +END PROC get get cursor; + +PROC get set marker (TEXT VAR keep): + get proc ("set marker","(INT CONST x,y,type)","(2|2 x,y,type)", + "INT erwartet, CONST erwartet,"+ + "Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen,"+ + "Formaler Parameter muss type heissen", + keep); +END PROC get set marker; + +PROC get std colors (TEXT VAR keep): + TEXT VAR line; + push error; + IF sequence found ("COLORS", line, 1, TRUE) + THEN extract data + ELSE error ("COLORS fehlt") + FI. + + extract data: + check sequence (line, "COLORS *;","2|4;", + "COLORS erwartet,"+ + "Rgbcodes erwartet,Semikolon fehlt"); + keep := get var (1); + delete record (f); +END PROC get std colors; + +PROC get paramless (TEXT CONST procname, TEXT VAR keep): + get proc (procname, "", "", "", keep) +END PROC get paramless; + +PROC get var param (TEXT CONST procname, TEXT VAR keep): + get proc (procname, "(INT VAR type)","(2|2 type)", + "INT erwartet, VAR erwartet, Formaler Parameter muss type heissen", + keep); +END PROC get var param; + +PROC get koord (TEXT CONST procname, TEXT VAR keep): + get proc (procname, "(INT CONST x,y)","(2|2 x,y)", + "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen",keep) +END PROC get koord; + +PROC get circle (TEXT VAR keep): + get proc ("circle","(INT CONST x,y,rad,from,to)","(2|2 x,y,rad,from,to)", + "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen,Formaler Parameter muss rad heissen,"+ + "Formaler Parameter muss from heissen,Formaler Parameter muss to heissen", + keep); +END PROC get circle; + +PROC get box (TEXT VAR keep): + get proc ("box","(INT CONST x1,y1,x2,y2,pattern)","(2|2 x1,y1,x2,y2,pattern)", + "INT erwartet,CONST erwartet,Formaler Parameter muss x1 heissen,"+ + "Formaler Parameter muss y1 heissen,Formaler Parameter muss x2 heissen,"+ + "Formaler Parameter muss y2 heissen,Formaler Parameter muss pattern heissen", + keep); +END PROC get box; + +PROC get fill (TEXT VAR keep): + get proc ("fill","(INT CONST x,y,pattern)","(2|2 x,y,pattern)", + "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen"+ + "Formaler Parameter muss y heissen,Formaler Parameter muss pattern heissen", + keep); +END PROC get fill; + +PROC get proc (TEXT CONST procname, psym, ptyp, perr, + TEXT VAR keep): + TEXT VAR line; + push error; + IF sequence found ("PROC"+procname, line, 1, TRUE) + THEN errors := FALSE; + get body (line,procname,psym,ptyp,perr,keep) + ELSE error (procname + " nicht gefunden") + FI +END PROC get proc; + +PROC get body (TEXT CONST header,procname,psyms,ptypes ,perrs, TEXT VAR keep body): + INT VAR start, ende; + start := line no(f); + keep body := ""; + check sequence (header, "PROC " + procname + psyms + ":", + "2|1"+ ptypes + ":", + "PROC erwartet," + + procname + " erwartet,,"+ + perrs+ + ",Fehler in " + procname + "-Header"); + IF NOT errors + THEN get to end of proc + FI. + + get to end of proc: + TEXT VAR last; + errors := FALSE; + IF sequence found ("END PROC " + procname, last, line no(f),FALSE) + THEN ende := line no (f); + check sequence (last, "END PROC " + procname + ";", + "2|2|1;", + "END erwartet,"+ + "PROC erwartet,"+ + "PROC heisst " + procname + + ",Semikolon fehlt"); + IF NOT errors + THEN to line (f,start); + delete record (f); + INT VAR lc; + FOR lc FROM start UPTO ende-2 REP + TEXT VAR scratch; + read record (f,scratch); + scratch := subtext (scratch, 3); + keep body CAT (" " + scratch); + delete record (f); + PER; + delete record (f) + FI + ELSE error ("END PROC " + procname + " nicht gefunden") + FI +END PROC get body; + +BOOL PROC sequence found (TEXT CONST sequence text, + TEXT VAR sequence line, INT CONST from line, + BOOL CONST evtl at): + BOOL VAR found :: FALSE, at char :: evtl at; + to line (f,from line); + col (f,1); + WHILE NOT (found OR eof (f)) REP + cout (line no (f)); + to first char; + IF found + THEN read record (f, sequence line); + error line := sequence line ISUB 1; + sequence line := subtext (sequence line, 3); + scan sequence + FI + PER; + IF NOT found + THEN read record (f, sequence line); + IF pos (first char, sequence line) > 0 + THEN scan sequence + FI + FI; + found. + + to first char: + IF at char + THEN downety (f, first char) + ELSE down (f, first char) + FI; + at char := FALSE; + found := pattern found. + + scan sequence: + TEXT VAR source symbols,symbols; + scan (sequence text); + get symbols; + source symbols := symbols; + scan (sequence line); + get symbols; + found := pos (symbols,source symbols) = 1. + + get symbols: + TEXT VAR symbol; + INT VAR type; + symbols := ""; + REP + next symbol (symbol, type); + symbols CAT symbol + UNTIL type > 6 PER. + + first char: + sequence text SUB 1 +END PROC sequence found; + +PROC error (TEXT CONST emsg): + IF NOT eof (f) + THEN read record (f,errorm1); + errorm1 := """" + error source + """, Zeile " + + text (error line) + ":" + ELSE errorm1 := """" + error source + """, Fileende:" + FI; + errorm2 := spaces + emsg; + errors := TRUE +END PROC error; + +PROC push error: + IF errors + THEN note (errorm1);note line; + note (10* " " + errorm2); note line; + errors := FALSE + FI +END PROC push error; + + (* Hinweis: bei Fehlermeldungen statt Blank ' ' (geschuetzt) verwenden. + Bei verschiedenen Typen ohne trennenden Delimiter zur + Abgrenzung in 'seq typ' '|' verwenden. + '*' wird in 'seq sym' als Wildcard verwendet (Itemweise) + Bei Delimitern wird der 'allgemeine Fehler' (letzter i.d Liste) + verwendet. Jedoch muss auch fuer Delimiter ein Eintrag + in der Liste freigehalten werden (...,,... oder ...,dummy,...). +*) + +ROW 100 STRUCT (TEXT sym, INT typ, BOOL var) VAR seqlist; +INT VAR scanpos; + +TEXT PROC get var (INT CONST no): + INT VAR count :: 0, checkpos :: 1; + WHILE checkpos <= scanpos REP + IF seqlist[checkpos].var + THEN count INCR 1; + IF count >= no + THEN LEAVE get var WITH seqlist[checkpos].sym + FI + FI; + checkpos INCR 1 + PER;"" +END PROC get var; + +PROC check sequence (TEXT CONST seq, seq sym, seq typ, seq err): + ROW 100 TEXT VAR err; + INT VAR checkpos,erpos, typ, error1 :: 0,error2 :: 0; + TEXT VAR sym; + scan (seq err); + next symbol (sym, typ); + erpos := 1; + err[erpos] := ""; + REP + SELECT typ OF + CASE 5: err[erpos] CAT " " + CASE 6: erpos INCR 1; + err [erpos] := "" + OTHERWISE err[erpos] CAT sym + END SELECT; + next symbol (sym, typ) + UNTIL typ >= 7 PER; + scan (seq); + FOR scanpos FROM 1 UPTO 100 REP + next symbol (seqlist[scanpos].sym,seqlist[scanpos].typ); + UNTIL seqlist[scanpos].typ >= 7 PER; + SELECT seqlist[scanpos].typ OF + CASE 8: error ("Kommentarende fehlt") + CASE 9: error ("Textende fehlt") + OTHERWISE IF scanpos = 100 + THEN error ("Kommando zu schwierig") + FI + END SELECT; + scan (seq sym); + FOR checkpos FROM 1 UPTO scanpos REP + next symbol (sym, typ); + IF sym = "*" + THEN seqlist[checkpos].var := TRUE + ELSE seqlist[checkpos].var := FALSE + FI + PER; + scan (seq typ); + next symbol (sym,typ); + FOR checkpos FROM 1 UPTO scanpos REP + WHILE sym = "|" REP + next symbol (sym, typ) + PER; + BOOL VAR std err :: typ <> 3; + IF NOT std err + THEN typ := int(sym); + IF seqlist[checkpos].typ <> typ + THEN error1 := checkpos + FI; + ELIF seqlist[checkpos].sym <> sym + THEN error1 := erpos + FI; + next symbol (sym, typ) + UNTIL error1 > 0 OR typ >= 7 PER; + scan (seq sym); + next symbol (sym,typ); + FOR checkpos FROM 1 UPTO scanpos-1 REP + std err := typ = 6; + IF (seqlist[checkpos].sym <> sym) AND (sym <> "*") + THEN IF std err + THEN error2 := erpos + ELSE error2 := checkpos + FI + FI; + next symbol (sym, typ) + UNTIL error2 > 0 PER; + IF error1 = 0 + THEN error1 := error2 + ELIF error1 = erpos + THEN IF (error2 <> 0) AND (error2 <> erpos) + THEN error1 := error2 + FI + FI; + IF error1 > 0 + THEN error (err [error1]) + FI +END PROC check sequence; + +INT PROC lower pair (INT CONST upper pair): + INT VAR lower :: upper pair; + set bit (lower,5); + set bit (lower,13); + lower +END PROC lower pair; + +TEXT PROC lower case (TEXT CONST uppercase): + TEXT VAR lower :: uppercase; + INT VAR x; + IF length(lower) MOD 2 <> 0 + THEN lower CAT ""0"" + FI ; + FOR x FROM 1 UPTO length(lower)DIV2 REP + replace (lower,x,lower pair (lower ISUB x)) + PER; + lower +END PROC lower case; + +PROC copy lines (FILE VAR dest, source): + INT VAR l; + input(source); + output(dest); + FOR l FROM 1 UPTO lines (source) REP + TEXT VAR scratch,test; + getline (source,scratch); + scratch := subtext (scratch,3); + test := scratch; + change all (test," ",""); + IF test <> "" + THEN putline (dest, scratch) + FI + PER +END PROC copy lines; + +.act plotter: + plotter[inst plotter] + +END PACKET graphik configuration; +configurate graphik + diff --git a/app/mpg/2.2/src/GRAPHIK.Fkt b/app/mpg/2.2/src/GRAPHIK.Fkt new file mode 100644 index 0000000..6e42af4 --- /dev/null +++ b/app/mpg/2.2/src/GRAPHIK.Fkt @@ -0,0 +1,1379 @@ +(***************************************************************************) +(* *) +(* FKT - Funktionenplotter *) +(* *) +(* Grundversion : MPG, KB, KN, LP 23.05.84 | 7756 Byte Code *) +(* Version 6.20 : MPG, Rainer Kottmann 23.09.85 | 7196 Byte Paketdaten *) +(* Angepasst an MPG-Turtle-Standard : 07.03.85 | 1374 Zeilen *) +(* Version 8.21 : MPG,Beat Jegerlehner 18.09.87 | *) +(* Angepasst an MPG EUMELGRAPHIK/EUMEL Version 1.8.1| *) +(* *) +(***************************************************************************) +PACKET funktionen DEFINES fkt plot, (*************************************) + y grenzen, (* Interaktives Programm *) + wertetafel, (* Einzelprozeduren fuer "do" *) + ~, (* BOOL OP "ungefaehr gleich" *) + luecke : (* Dummykonstante fuer "undefiniert" *) + (*************************************) + (* Autoren: Klaus Bovermann *) + (* Kai Nikisch *) + (* Lutz Prechelt *) + (* Rainer Kottmann *) + (* Beat Jegerlehner *) + (*************************************) + +LET fkpos = 1, (* Diese LETs sind Bildschirmpositionen *) + inpos = 2, + wpos = 3, + fehlerpos = 5, + eingpos = 7, + textpos = 11, + wahlpos = 24, + xupos = 16, + yupos = 16, + xopos = 32, + yopos = 32, + stuetzpktpos = 48, + endgeraetepos = 20; + +LET punkte = 512, (* maximale Anzahl der Stuetzpunkte *) + ug1 = 0.15051, (* Hilfswerte fuer 'gauss' *) + ug2 = 0.5, + ug3 = 0.84948, + din a 4 hoehe = 5.0, (* Hoehe der Beschriftung *) + din a 4 breite = 5.0, (* in mm *) + ziffern = 12, (* Genauigkeitsangabe *) + gross = 8.888888e88, + epsilon = 1.0e-11; + +LET wahlstring = ""8""2"fdwsazntlLAqeb~?", + farbstr = "Standard ot lau ruen chwarz", + farbchars = ""13"rbgs", + graphikvater = "GRAPHIK", + helpfile = "FKT.help"; + +ROW punkte REAL VAR graph; + +TEXT VAR term :: "", + rohterm :: "", + picfilename :: "", + prefix :: "PICFILE.", + postfix :: "", + fehlernachricht :: "", + proc, + inline; + +REAL VAR x min :: -gross, x max :: gross, + y min :: maxreal, y max :: -maxreal, + xstep; + +INT VAR nachkomma :: 2, + stuetzen :: punkte, + endgeraet :: 1, + endgeraete :: highest entry(plotters); + +BOOL VAR intervall definiert :: FALSE, + wertebereich bestimmt :: FALSE, + wertetafel vorhanden :: FALSE, + fehlerzustand :: FALSE; + +REAL CONST luecke :: gross; + +PICTURE VAR dummy picture :: nilpicture; +move (dummy picture,0.0,0.0); + +(***************************************************************************) +(* Alte Prozeduren (Graphik-unabhaengig) *) +(***************************************************************************) + +PROC get (TEXT VAR text): (* moeglichkeit, ueberall abzubrechen! *) + text := ""; + TEXT VAR exit char; + editget (text,""27"","",exit char); + IF exit char = ""27"" + THEN errorstop("Abgebrochen") + FI +END PROC get; + +PROC get (INT VAR nr): + TEXT VAR t; + get(t); + line; + nr := int(t) +END PROC get; + +PROC get (REAL VAR nr): + TEXT VAR t; + get(t); + line; + nr := real(t) +END PROC get; + +PROC editget (TEXT VAR t): + TEXT VAR t2 :: t,exit char; + editget(t2,""27"","",exit char); + IF exit char = ""27"" + THEN errorstop("Abgebrochen") + FI; + t := t2 +END PROC editget; + +PROC inchar (TEXT VAR a,TEXT CONST b): + REP + inchar (a) + UNTIL pos(b,a) <> 0 OR a = ""27"" PER; + IF a = ""27"" + THEN errorstop("Abgebrochen") + FI +END PROC inchar; + +BOOL OP ~ (REAL CONST left , right) : + abs (left - right) <= xstep +END OP ~; + +(******************* MAIN PROGRAMM *****************************) + +PROC fkt plot: + auswahlbild; + select plotter(name(plotters,endgeraet)); + REP + bild; + auswahl (inline) + UNTIL inline = "q" PER + +END PROC fkt plot; + +(****************** LAY OUT *****************************) + +PROC auswahlbild: + page; + cursor (1,textpos); + put ("(f) Funktionsterm eingeben "); + putline ("(?) Hilfestellung "); + put ("(d) Definitionsbereich waehlen "); + putline ("(q) in die Kommandoebene zurueck "); + put ("(w) Wertebereich ermitteln lassen "); + putline ("(s) Anzahl der Stuetzpunkte waehlen "); + put ("(z) Zeichnung anfertigen "); + putline ("(n) Nachkommastellenzahl waehlen "); + put ("(a) Ausgabe der Zeichnung auf Endgeraet"); + putline ("(e) Arbeit beenden "); + put ("(t) Wertetafel erstellen lassen "); + putline ("(L) Zeichnungen loeschen "); + put ("(l) Zeichnungen auflisten "); + putline ("(A) Zeichnungen archivieren "); + put (" "); + putline ("(b) Zeichnung beschriften "); + cursor (1,wahlpos); + put ("Ihre Wahl:") +END PROC auswahlbild; + +PROC bild: + cursor (1,fkpos); + put ("f(x) = " + rohterm); + out (""5""); + cursor (1,inpos); + put ("Def.Bereich: [ / ]"); + cursor (xupos,inpos); + put (text (x min,ziffern,nachkomma)); + cursor (xopos,inpos); + put (text (x max,ziffern,nachkomma)); + cursor (1,wpos); + put ("Wertebereich: [ / ]"); + cursor (yupos,wpos); + put (text (y min,ziffern,nachkomma)); + cursor (yopos,wpos); + put (text (y max,ziffern,nachkomma)); + cursor (1,endgeraetepos); + put endgeraetestring; + cursor (stuetzpktpos,inpos); + put ("Anzahl der Stuetzpunkte: " + text (stuetzen,3)); + drei zeilen ab eingpos loeschen. +END PROC bild; + +(****************** MONITOR *****************************) + +PROC auswahl 1 (TEXT VAR wahl): + enable stop; + SELECT code (wahl) OF + CASE 8 : endgeraet := max(endgeraet-1,1); + select plotter(name(plotters,endgeraet)) + CASE 2 : endgeraet := min(endgeraet+1,endgeraete); + select plotter(name(plotters,endgeraet)) + CASE 102 : fkt lesen (* f *) + CASE 100 : defbereich waehlen (* d *) + CASE 119 : wertebereich erstellen (* w *) + CASE 116 : wertetafel erstellen (* t *) + CASE 113 : LEAVE auswahl 1 (* q *) + CASE 122 : graph erstellen (* z *) + CASE 97 : graph zeigen (* a *) + CASE 110 : genauigkeitsangabe (* n *) + CASE 65 : dm; (* A *) + auswahlbild + CASE 108 : dateien listen (* l *) + CASE 76 : dateien aus task raeumen (* L *) + CASE 101 : unterbrechung (* e *) + CASE 126 : spezialeingabe (* TIL *) + CASE 63 : hilfe (* ? *) + CASE 115 : stuetzpunkte setzen (* s *) + CASE 98 : zeichnung beschriften (* b *) + END SELECT; +END PROC auswahl 1; + +PROC auswahl (TEXT VAR wahl): (* Faengerebene *) + cursor (12,24); + out (""5""); + inchar (wahl,wahlstring); + fehlerloeschen; + disable stop; + auswahl 1 (wahl); + IF is error + THEN fehlersetzen (error message); + clear error + FI; + enable stop; + IF fehlerzustand + THEN fehleraus (fehlernachricht) + FI +END PROC auswahl; + +PROC put endgeraetestring: + TEXT VAR s :: "Endgeraet: "; + INT VAR i; + THESAURUS CONST t :: plotters; + FOR i FROM 1 UPTO endgeraete REP + IF length(s)+length(name(t,i))+4 > 79 + THEN putline(s+""5""); + s := " " + FI; + IF i = endgeraet + THEN s CAT ""15"" + name(t,i) + " "14" " + ELSE s CAT " "+name(t,i) + " " + FI + PER; + putline(s+""5"") + +END PROC put endgeraetestring; + + +(**************************** f *******************************************) + +PROC fkt lesen: + reset wertebereich; + cursor (1,eingpos); + put ("f(x) ="); + out (""5""); + cursor (1,eingpos + 1); + out(""5""); + cursor (8,eingpos); + editget (rohterm); + change int to real (rohterm,term); + change all (term,"X","x"); + change all (term,"=","~"); (* Ueberdeckung von = *) + change all (term,"<~","<="); (* ruecksetzen von <= *) + change all (term,">~",">="); (* " >= *) + term testen; + wertetafel vorhanden := FALSE. + +term testen: + disable stop; + proc := "REAL PROC f (REAL CONST x):"; + proc CAT term; + proc CAT " END PROC f"; + do ("do ("""+proc+""")"); (* komischer do-Fehler *) + IF is error + THEN fehlersetzen ("Term fehlerhaft"); + clear error; + LEAVE fkt lesen + FI +END PROC fkt lesen; + +(**************************** d *******************************************) + +PROC defbereich waehlen: + cursor (1,eingpos); + put ("Untergrenze :"); + out (""5""); + get (x min); + obergrenze lesen; + intervall definiert := TRUE; + reset wertebereich. + +obergrenze lesen: + REP + put ("Obergrenze :"); + out (""5""); + get (x max); + IF x max <= x min + THEN out (""7""13""3""5"") + FI + UNTIL x max > x min PER +END PROC defbereich waehlen; + +(**************************** w *******************************************) + +PROC wertebereich erstellen: + IF rohterm = "" + THEN fehlersetzen ("Erst Fkts.Term eingeben! (f)"); + LEAVE wertebereich erstellen + ELIF NOT intervall definiert + THEN fehlersetzen ("Erst Def.Bereich waehlen (d)"); + LEAVE wertebereich erstellen + ELIF wertebereich bestimmt + THEN fehlersetzen ("Wertebereich ist bereits bestimmt"); + LEAVE wertebereich erstellen + FI; + proc := "REAL PROC f (REAL CONST x):"+ term; + proc CAT " END PROC f; ygrenzen (PROC f)"; + do (proc) +END PROC wertebereich erstellen; + +PROC ygrenzen (REAL PROC (REAL CONST) f): + REAL VAR x, f von x; + INT VAR i :: 1; + + disable stop; + xstep := (x max - x min) / real (stuetzen - 1); + x := x min; + y min := maxreal; + y max := -maxreal; + cursor (1,eingpos); + putline ("Wertebereich wird ermittelt"); + out (""5""); + out ("bei Stuetzpunkt Nr.: "); + wertegrenzen berechnen; + IF is error + THEN fehler setzen (error message); + reset wertebereich; + LEAVE ygrenzen + ELIF fehlerzustand + THEN reset wertebereich; + LEAVE ygrenzen + ELSE wertebereich bestimmt := TRUE + FI; + IF y min = y max + THEN y min DECR 1.0; + y max INCR 1.0 + FI. + +wertegrenzen berechnen: + FOR i FROM 1 UPTO stuetzen REP + x := real (i-1) * xstep + x min; + cout (i); + f von x := f (x); + graph [i] := f von x; + IF f von x <> luecke + THEN y min := min (y min, f von x); + y max := max (y max, f von x) + FI + UNTIL is error OR interrupt PER . + +interrupt: + IF incharety = ""27"" + THEN fehlersetzen ("Abgebrochen"); + TRUE + ELSE FALSE + FI +END PROC ygrenzen; + +(**************************** t *******************************************) + +PROC wertetafel erstellen: + IF rohterm = "" + THEN fehleraus ("Erst Fkts.Term eingeben (f)"); + LEAVE wertetafel erstellen + ELIF NOT intervall definiert + THEN fehleraus ("Erst Def.Bereich waehlen (d)"); + LEAVE wertetafel erstellen + FI; + proc := "REAL PROC f (REAL CONST x):"+ term; + proc CAT " END PROC f; wertetafel (PROC f)"; + do (proc) +END PROC wertetafel erstellen; + +PROC wertetafel (REAL PROC (REAL CONST ) f): + FILE VAR g :: sequential file (output,rohterm); + REAL VAR x, f von x; + INT VAR i :: 0; + + REP + schrittweite einlesen + UNTIL (xstep > 0.0) CAND ((x max-x min) / xstep < real (punkte)) PER; + x := x min; + evtl ueberschrift; + disable stop; + REP + datei erstellen + UNTIL x > x max OR is error PER; + fehleraus in tafel; + enable stop; + modify (g); + edit (g); + line; + IF yes("Tafel drucken") + THEN print (rohterm) + FI; + line (2); + IF yes("Tafel loeschen") + THEN forget(rohterm,quiet); + wertetafel vorhanden := FALSE + ELSE wertetafel vorhanden := TRUE + FI; + auswahlbild. + +evtl ueberschrift: + IF NOT wertetafel vorhanden + THEN putline (g, " W E R T E T A F E L"); + line (g); + putline (g, " x ! " + rohterm); + putline (g, "----------------!----------------") + FI. + +fehleraus in tafel: + IF is error + THEN fehlernachricht := errormessage; + clearerror; + line (g,2); + putline (g,fehlernachricht); + fehlernachricht := "" + FI. + +datei erstellen: + i INCR 1; + cout (i); + put (g, text (x,ziffern,nachkomma)); + put (g, " !"); + f von x := f (x); + IF f von x <> luecke + THEN put (g, text (f von x,ziffern,nachkomma)) + ELSE put (g, "Definitionsluecke") + FI; + line (g); + x INCR xstep. + +schrittweite einlesen: + cursor (1,eingpos); + put ("Schrittweite:"); + out (""5""); + cursor (1,eingpos + 1); + out (""5""); + cursor (15,eingpos); + get (xstep); + put ("Zwischenpunkt :"); + IF (xstep <= 0.0) COR ((x max-x min) / xstep > real (punkte)) + THEN fehleraus ("Schrittweite zu klein"); + LEAVE wertetafel + FI +END PROC wertetafel; + +(*********************************** n *************************************) + +PROC genauigkeitsangabe: + cursor (1,eingpos); + put ("Anzahl der Nachkommastellen : "); + get (nachkomma); + disable stop; + nachkomma := min (nachkomma, ziffern - 3); + nachkomma := max (nachkomma, 0); + IF is error + THEN fehlersetzen ("Falscher Wert"); + clear error; + nachkomma := 2 + FI +END PROC genauigkeitsangabe; + +(********************************l ****************************************) + +PROC dateien listen: + th(all LIKE (prefix+"*")); + auswahlbild +END PROC dateien listen; + +(********************************L ****************************************) + +PROC dateien aus task raeumen: + forget(some(all LIKE (prefix+"*"))); + auswahlbild +END PROC dateien aus task raeumen; + +(**************************** s *******************************************) + +PROC stuetzpunkte setzen: + cursor (1,eingpos); + put ("Anzahl der Stuetzpunkte :"); + get (stuetzen); + disable stop; + IF stuetzen <= 1 OR stuetzen > punkte + THEN fehler setzen ("Achtung Stuetzpunkte fehlerhaft") + FI; + stuetzen := max (stuetzen, 2) ; + stuetzen := min (stuetzen, punkte); + IF is error + THEN fehlersetzen ("Falscher Wert"); + clear error; + stuetzen := punkte + FI; + reset wertebereich +END PROC stuetzpunkte setzen; +(**************************** e *******************************************) + +PROC unterbrechung: + break; + auswahlbild +END PROC unterbrechung; + +(****************************** ? ******************************************) + +PROC hilfe: + IF NOT exists(helpfile) + THEN fetch(helpfile,task (graphikvater)) + FI; + FILE VAR f :: sequential file(input,helpfile); + headline(f,"Verlassen mit "); + open editor(f,FALSE); + edit (groesster editor,"q",PROC (TEXT CONST) dummy ed); + auswahlbild +END PROC hilfe; + +PROC dummy ed (TEXT CONST t): + IF t = "q" + THEN quit + ELSE out(""7"") + FI +END PROC dummy ed; + +(**************************** TILDE ****************************************) + +PROC spezialeingabe: + TEXT CONST termeingabename :: "Bitte Funktionsrumpf eingeben"; + TEXT VAR t; + FILE VAR f :: sequential file (modify, termeingabename); + + edit (f); + lese den term aus; + teste den term; + rohterm := "spezial"; + reset wertebereich; + auswahlbild. + +lese den term aus: + term := ""; + input (f); + WHILE NOT eof (f) REP + getline (f,t); + term CAT t; + term CAT " " + PER. + +teste den term: + disable stop; + proc := "REAL PROC f (REAL CONST x):"; + proc CAT term; + proc CAT " END PROC f"; + do (proc); + IF is error + THEN fehlersetzen ("Funktionsrumpf fehlerhaft"); + clear error; + term := ""; + rohterm := ""; + reset wertebereich; + auswahlbild; + LEAVE spezialeingabe + FI +END PROC spezialeingabe; + +(***************************************************************************) +(********* Ab hier Hilfsprozeduren *********) +(***************************************************************************) + +PROC fehleraus (TEXT CONST t): + cursor (1,fehlerpos); + out (""7"F E H L E R : ", t); + fehlerzustand := FALSE +END PROC fehleraus; + +PROC fehlerloeschen: + cursor (1,fehlerpos); + out (""5""); + fehlernachricht := ""; + fehlerzustand := FALSE +END PROC fehlerloeschen; + +PROC fehler setzen (TEXT CONST message): + fehlernachricht := message; + fehlerzustand := TRUE; + clear error +END PROC fehler setzen; + +REAL PROC gauss (REAL CONST z): + IF is integer (z) + THEN round (z,0) + ELIF sign (z) = -1 + THEN floor (z) - 1.0 + ELSE floor (z) + FI +END PROC gauss; + +BOOL PROC is integer (REAL CONST x): + abs (x - floor (x)) < epsilon +END PROC is integer; + +PROC berechnung (REAL CONST min, max, + REAL VAR sweite, + INT VAR styp): + + sweite := faktor * round (10.0 ** expo,11). + +faktor: + IF nachkomma < ug1 + THEN styp := 1; + 1.0 + ELIF nachkomma < ug2 + THEN styp := 2; + 2.0 + ELIF nachkomma < ug3 + THEN styp := 5; + 5.0 + ELSE styp := 1; + 10.0 + FI. + +nachkomma: + IF frac (logwert) < -epsilon + THEN 1.0 + frac (logwert) + ELIF frac (logwert) > epsilon + THEN frac (logwert) + ELSE 0.0 + FI. + +differenz: + max - min. + +expo: + gauss (logwert) - 1.0. + +logwert: + round (log10 (differenz),8) +END PROC berechnung; + +REAL PROC runde ab (REAL CONST was, auf): + auf * gauss (was / auf) +END PROC runde ab; + +REAL PROC runde auf (REAL CONST was, auf): + REAL VAR hilf :: runde ab (was,auf); + + IF abs (hilf - was) < epsilon + THEN was + ELSE hilf + auf + FI +END PROC runde auf; + +PROC loesche zeile (INT CONST zeile): + cursor (1,zeile); + out (""5"") +END PROC loesche zeile; + +PROC drei zeilen ab eingpos loeschen: + loesche zeile (eingpos); + loesche zeile (eingpos + 1); + loesche zeile (eingpos + 2); +END PROC drei zeilen ab eingpos loeschen; + +PROC change int to real (TEXT CONST term alt,TEXT VAR term neu): + TEXT VAR symbol :: "", presymbol :: ""; + INT VAR type :: 0, pretype :: 0, position; + LET number = 3, + tag = 1, + end of scan = 7, + pot = "**"; + + term neu := ""; + scan (term alt); + WHILE type <> end of scan REP + presymbol := symbol; + pretype := type; + next symbol (symbol,type); + IF type <> number OR presymbol = pot + THEN term neu CAT evtl mal und symbol + ELSE term neu CAT changed symbol + FI + PER. + +evtl mal und symbol: + IF pretype = number AND type = tag + THEN "*" + symbol + ELSE symbol + FI. + +changed symbol: + position := pos (symbol,"e"); + IF position <> 0 + THEN text (symbol,position - 1) + ".0" + + subtext (symbol,position,length (symbol)) + ELIF pos (symbol,".") = 0 + THEN symbol CAT ".0"; + symbol + ELSE symbol + FI +END PROC change int to real; + +PROC reset wertebereich: + y min := -maxreal; + y max := maxreal; + wertebereich bestimmt := FALSE +END PROC reset wertebereich; + +TEXT PROC textreal (REAL CONST z): + TEXT VAR t :: text (z); + + IF (t SUB length (t)) = "." + THEN subtext (t,1,length (t) - 1) + ELIF (t SUB 1) = "." + THEN "0" + t + ELIF (t SUB 2) = "." AND sign (z) = -1 + THEN "-0" + subtext (t,2) + ELIF t = "0.0" + THEN "0" + ELSE t + FI +END PROC textreal; + +INT PROC length (REAL CONST z): + length (text (z)) +END PROC length; + +PROC put format(INT CONST wo, REAL CONST xxmi,xxma,yymi,yyma): + cursor (1,wo); + put ("Aktuelles Format: xmin xmax" + + " ymin ymax"); + cursor (19,wo + 1); + put (text (xx mi,ziffern,nachkomma)); + cursor (34,wo + 1); + put (text (xx ma,ziffern,nachkomma)); + cursor (49,wo + 1); + put (text (yy mi,ziffern,nachkomma)); + cursor (64,wo + 1); + put (text (yy ma,ziffern,nachkomma)) +END PROC put format; + +PROC out (TEXT CONST a, b) : + out (a); out (b) +END PROC out; + +(***************************************************************************) +(* Neue Prozeduren *) +(***************************************************************************) + +PROC graph erstellen: + PICFILE VAR funktionen; + PICTURE VAR funktionsgraph :: nilpicture, + formatpic :: nilpicture; + REAL VAR xx min :: x min, + xx max :: x max, + yy min :: y min, + yy max :: y max; + + IF rohterm = "" + THEN fehlersetzen ("Erst Funktionsterm waehlen (f)"); + LEAVE graph erstellen + ELIF NOT wertebereich bestimmt + THEN fehlersetzen ("Erst Wertebereich bestimmen lassen (w)"); + LEAVE graph erstellen + FI; + + hole filenamen; + funktionen := picture file (picfilename); + initialisiere stifte; + waehle format; + zeichne graphen; + pictures ins picfile. + +hole filenamen: + TEXT VAR t :: ""; + REP + namen lesen + UNTIL t = "l" OR t = "e" PER. + +namen lesen: + cursor (1,eingpos); + out ("Welchen Namen soll die Zeichnung haben: "+ prefix); + postfix:= rohterm; + editget (postfix); + line; + IF (postfix SUB 1) = "?" + THEN picfilename := one(all LIKE (prefix+"*")); + auswahlbild; + bild; + cursor(1,eingpos) + ELSE picfilename := prefix + postfix; + picfilename := compress (picfilename) + FI; + IF NOT exists (picfilename) + THEN LEAVE hole filenamen + FI; + putline ("Zeichnung gibt es schon!"); + put ("loeschen (l), Namen neuwaehlen (n), " + + "alte Zeichnung ergaenzen (e):"); + inchar (t,"lne"); + IF t = "l" + THEN forget (picfilename,quiet) + ELIF t = "n" + THEN drei zeilen ab eingpos loeschen + FI. + +initialisiere stifte: + select pen (funktionen, 1, 1, 0, 1, TRUE); (* Standardfarbe *) + select pen (funktionen, 2, 2, 0, 1, TRUE); (* Rot *) + select pen (funktionen, 3, 3, 0, 1, TRUE); (* Blau *) + select pen (funktionen, 4, 4, 0, 1, TRUE); (* Gruen *) + select pen (funktionen, 5, 5, 0, 1, TRUE). (* Schwarz *) + +waehle format: + IF altes picfile + THEN ergaenze wertebereich + FI; + drei zeilen ab eingpos loeschen; + REAL VAR step; + INT VAR i dummy; + berechnung (yy min, yy max, step, idummy); + yy min := runde ab (yy min, step); + yy max := runde auf (yy max, step); + put format(eingpos, xx min, xx max, yy min, yy max); + pause ; + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + IF yes("Format aendern") + THEN interactive change of format (xx min,xx max,yy min,yy max) + FI; + drei zeilen ab eingpos loeschen. + +ergaenze wertebereich: + to pic (funktionen,3); (* Formatpicture *) + read picture (funktionen,formatpic); + move (formatpic, xx min, yy min); + move (formatpic, xx max, yy max); + extrema (formatpic, xx min, xx max, yy min, yy max). + +altes picfile: + t = "e". + +zeichne graphen: + REAL VAR x :: x min, + x schrittweite :: (x max - x min) / real (stuetzen - 1); + INT VAR i; + + cursor (1,eingpos); + put ("Graph bei Stuetzpunkt Nr. "); + FOR i FROM 1 UPTO stuetzen REP + cout (i); + IF graph[i] <> luecke + THEN IF zuletzt luecke + THEN move (funktionsgraph, x, graph[i]) + ELSE draw (funktionsgraph, x, graph[i]) + FI + FI; + x INCR x schrittweite + UNTIL abbruch PER; + drei zeilen ab eingpos loeschen. + + abbruch: + IF incharety = ""27"" + THEN errorstop("Abgebrochen"); + TRUE + ELSE FALSE + FI. + + zuletzt luecke: + i = 1 COR graph[i-1] = luecke. + +pictures ins picfile: + setze graphenfarbe; + to first pic(funktionen); + IF altes picfile + THEN down (funktionen); (* Skip *) + down (funktionen) + ELSE put picture (funktionen, dummy picture); (* Zusaetzliche Beschr.*) + put picture (funktionen, dummy picture) + FI; + formatpic := nilpicture; + move (formatpic, xx min, yy min); + move (formatpic, xx max, yy max); + IF altes picfile + THEN write picture (funktionen, formatpic) + ELSE put picture (funktionen, formatpic) + FI; + put picture (funktionen, funktionsgraph). + +setze graphenfarbe: + cursor (1,eingpos); + put("Farbe des Graphen :"); + pen (funktionsgraph, farbe). + +farbe : + TEXT VAR ff; + put(farbstr); + inchar (ff,farbchars); + out(ff); + pos (farbchars,ff). + +END PROC graph erstellen; + +PROC interactive change of format (REAL VAR x mi,x ma,y mi,y ma): + TEXT VAR tt; + REP + cursor (1,eingpos + 2); + put ("Geben Sie die neuen Koordinaten ein"); + out (""5""); + pause (20); + loesche zeile (eingpos + 2); + cursor (1,eingpos + 2); + put ("xmin:"); + tt := text (xmi); + editget (tt); + xmi := real (tt); + cursor (1,eingpos + 2); + put ("xmax:"); + out (""5""); + tt := text (xma); + editget (tt); + xma := real (tt); + cursor (1,eingpos + 2); + put ("ymin:"); + out (""5""); + tt := text (ymi); + editget (tt); + ymi := real (tt); + cursor (1,eingpos + 2); + put ("ymax:"); + out (""5""); + tt := text (yma); + editget (tt); + yma := real (tt); + UNTIL format ok PER. + + format ok: + IF xma <= xmi OR yma <= ymi + THEN fehlersetzen ("Format falsch"); + FALSE + ELSE TRUE + FI +END PROC interactive change of format; + +PROC geraet waehlen: +END PROC geraet waehlen; + +PROC zeichnung beschriften: + namen holen; + PICFILE VAR funktionen :: picture file(picfilename); + PICTURE VAR beschr; + to pic(funktionen,2); + read picture(funktionen,beschr); + cursor(1,eingpos); + put("Beschriftung (e) rgaenzen , (l) oeschen oder (a) bbruch"); + TEXT VAR t; + inchar(t,"ela"); + IF t = "l" + THEN to pic(funktionen,2); + beschr := nilpicture; + write picture(funktionen,beschr) + ELIF t = "e" + THEN beschrifte + FI; + cursor(1,eingpos); + drei zeilen ab eingpos loeschen. + + beschrifte: + farbe holen; + REAL VAR rx,ry,hx,bx; + to pic(funktionen,3); + PICTURE VAR format; + read picture(funktionen,format); + extrema(format,rx,ry,hx,bx); + drei zeilen ab eingpos loeschen; + put format (eingpos,rx,ry,hx,bx); + pause; + REP + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + put("Text :"); + TEXT VAR btext; + getline(btext); + put("Koordinaten in (c)m oder in (r)eal "); + inchar(t,"cra"); + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + put("X-Koordinate:"); + get(rx); + put("Y-Koordinate:"); + get(ry); + IF t = "c" + THEN move cm(beschr,rx,ry) + ELSE move (beschr,rx,ry) + FI; + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + put("Hoehe der Zeichen in mm :"); + get(hx); + put("Breite der Zeichen in mm:"); + get(bx); + draw(beschr,btext,0.0,hx,bx); + drei zeilen ab eingpos loeschen; + cursor(1,eingpos) + UNTIL no("Weitere Beschriftungen") PER; + to pic(funktionen,2); + write picture(funktionen,beschr). + + farbe holen: + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + put("Farbe der Beschriftungen: "); + TEXT VAR ff; + put(farbstr); + inchar (ff,farbchars); + out(ff); + pen(beschr,pos (farbchars,ff)). + + namen holen: + cursor(1,eingpos); + put("Wie heisst die Zeichnung:"); + out(prefix); + editget(postfix); + picfilename := prefix + postfix; + IF (postfix SUB 1) = "?" + THEN picfilename := one(all LIKE (prefix + "*")); + auswahlbild; + bild + FI; + IF NOT exists(picfilename) + THEN fehlersetzen("Zeichnung gibt es nicht"); + LEAVE zeichnung beschriften + FI + +END PROC zeichnung beschriften; + +PROC graph zeigen: + REAL VAR xx max,xx min,yy max,yy min; + + cursor (1,eingpos); + put ("Wie heisst die Zeichnung :"); + out(prefix); + editget(postfix); + picfilename := prefix+postfix; + IF (postfix SUB 1) = "?" + THEN picfilename := one(all LIKE (prefix+"*")); + postfix := subtext(picfilename,length(prefix)+1); + auswahlbild; + bild + ELIF NOT exists (picfilename) + THEN fehlersetzen ("Zeichnung gibt es nicht"); + LEAVE graph zeigen + FI; + drei zeilen ab eingpos loeschen; + PICFILE VAR funktionen :: picture file (picfilename); + PICTURE VAR rahmen :: nilpicture; + hole ausschnitt; + hole headline; + erzeuge rahmen; + gib bild aus. + + gib bild aus: + REAL VAR x cm,y cm; INT VAR i,j; + drawing area (x cm,y cm,i,j); + viewport (funktionen, 0.0, x cm/y cm, 0.0, 1.0); + erweitere bereich; (* Rundungsfehler beim clippen vermeiden !!! *) + window (funktionen, xx min, xx max, yy min, yy max); + plot (picfilename); + auswahlbild. + + erweitere bereich: + xx max := xx max + (xx max - xx min) / real(i). + + erzeuge rahmen: + to pic (funktionen,1); + waehle achsenart; + IF achsenart = "r" + THEN rahmen := frame (xx min,xx max,yy min,yy max) + ELSE rahmen := axis (xx min,xx max,yy min,yy max) + FI; + rahmen CAT beschriftung (xx min,xx max,yy min,yy max,headline, + achsenart = "r"); + cursor (1,eingpos); + put ("Farbe des"); + IF achsenart = "k" + THEN put("Koordinatensystems :") + ELSE put("Rahmens :") + FI; + pen (rahmen,farbe); + drei zeilen ab eingpos loeschen; + write picture (funktionen,rahmen). + + farbe : + TEXT VAR ff; + put(farbstr); + inchar (ff,farbchars); + out(ff); + pos (farbchars,ff). + + waehle achsenart: + TEXT VAR achsenart :: "r"; + IF koord moeglich + THEN frage nach achsenart + FI. + + frage nach achsenart: + cursor (1,eingpos); + put("oordinatensystem oder ahmen zeichnen ?"); + inchar (achsenart,"kr"); + putline(achsenart); + drei zeilen ab eingpos loeschen. + + koord moeglich: + NOT (xmin >= 0.0 OR xx max <= 0.0 OR yy min >= 0.0 OR yy max <= 0.0). + + hole ausschnitt: + PICTURE VAR format; + to pic (funktionen,3); + read picture (funktionen,format); + extrema (format, xx min, xx max, yy min, yy max); + cursor (1,eingpos); + put format (eingpos, xx min, xx max, yy min, yy max); + pause; + drei zeilen ab eingpos loeschen; + cursor (1,eingpos); + IF yes ("Wollen Sie den Ausschnitt veraendern") + THEN interactive change of format (xx min,xx max,yy min,yy max) + FI; + drei zeilen ab eingpos loeschen. + + hole headline: + cursor (1,eingpos); + TEXT VAR headline :: rohterm; + put ("Ueberschrift :"); + editget (headline); + drei zeilen ab eingpos loeschen +END PROC graph zeigen; + +PICTURE PROC frame (REAL CONST xx min,xx max,yy min,yy max): + + PICTURE VAR rahmen :: nilpicture; + zeichne achsen; + zeichne restrahmen; + rahmen. + + zeichne restrahmen: + move (rahmen,xx min,yy max); + draw (rahmen,xx max,yy max); + draw (rahmen,xx max,yy min). + + zeichne achsen: + rahmen := axis (xx min,xx max,yy min,(yy max - yy min) / 90.0,0,0); + rahmen CAT axis (yy min,yy max,xx min,(xx max - xx min) / 90.0,1,0) + +END PROC frame; + +PICTURE PROC axis (REAL VAR xx min,xx max,yy min,yy max): + PICTURE VAR rahmen :: nilpicture; + rahmen := axis (xx min,xx max,0.0,(yy max - yy min) / 180.0,0,1); + rahmen CAT axis (yy min,yy max,0.0,(xx max - xx min) / 180.0,1,1); + rahmen +END PROC axis; + +PICTURE PROC axis (REAL CONST min, max, pos,strich, + INT CONST dir,mode): + PICTURE VAR achse :: nilpicture; + REAL VAR step, + feinstep, + wert; + INT VAR type; + berechnung (min,max,step,type); + feinstep := step / real(zwischenstriche); + IF min MOD feinstep <> 0.0 + THEN wert := runde auf (min,feinstep); + ELSE wert := min + FI; + INT VAR zaehler :: int( wert MOD step / feinstep + 0.5); + WHILE wert <= max REP + IF wert = 0.0 + THEN ziehe nullstrich + ELIF zaehler MOD zwischenstriche = 0 + THEN ziehe normstrich + ELSE ziehe feinstrich + FI; + wert INCR feinstep; + zaehler INCR 1 + PER; + zeichne achse; + achse. + + zwischenstriche: + IF type = 2 + THEN 4 + ELSE 5 + FI. + + ziehe nullstrich: + REAL VAR p0 :: pos + real (mode) * strich * 3.0, + p1 :: pos - strich * 3.0; + ziehe linie. + + ziehe normstrich: + p0 := pos + real (mode) * strich * 2.0; + p1 := pos - strich * 2.0; + ziehe linie. + + ziehe feinstrich: + p0 := pos + real (mode) * strich; + p1 := pos - strich; + ziehe linie. + + zeichne achse: + IF dir = 0 + THEN move (achse,min,pos); + draw (achse,max,pos) + ELSE move (achse,pos,min); + draw (achse,pos,max) + FI. + + ziehe linie: + IF dir = 0 + THEN move (achse,wert,p0); + draw (achse,wert,p1) + ELSE move (achse,p0,wert); + draw (achse,p1,wert) + FI +END PROC axis; + +PICTURE PROC beschriftung (REAL VAR xx min,xx max,yy min,yy max, + TEXT CONST ueberschrift, + BOOL CONST mode): + PICTURE VAR rahmen :: nilpicture; + beschrifte; + rahmen. + + beschrifte : + REAL VAR x cm,y cm; + INT VAR dummy; + drawing area (x cm,y cm,dummy,dummy); + erweitere; + zeichne x achse; + zeichne y achse; + zeichne ueberschrift; + xx max := xn max; + xx min := xn min; + yy max := yn max; + yy min := yn min. + + erweitere: + REAL VAR hoehe :: din a4 hoehe / 23.5 * y cm, { der Zeichen } + breite :: din a4 breite / 30.5 * x cm; + INT CONST anzahl y stellen :: max (stellen (yy min),stellen (yy max)), + anzahl x stellen :: max (stellen (xx min),stellen (xx max)); + REAL VAR xn min :: xx min, + xn max :: xx max, + yn min :: yy min; + IF mode { rahmen wg clipping } + THEN xn min DECR (xx max - xx min) / 30.0; + yn min DECR (yy max - yy min) / 30.0 + FI; + REAL VAR xx dif :: xx max - xn min, + yy dif :: yy max - yn min, + yn dif :: y cm / (y cm - 2.0 * hoehe / 10.0 - 0.4) * yy dif, + xn dif :: x cm / (x cm - x erweiterung) * xx dif, + y 1 mm :: yn dif / y cm / 10.0, + r hoch :: hoehe / y cm / 10.0 * yn dif, + r breit:: breite / x cm / 10.0 * xn dif, + yn max :: yy max + r hoch + 3.0 * y 1 mm; + yn min := yn min - r hoch - 2.0 * y 1 mm; + IF mode + THEN xn min := xn min - real(anzahl y stellen) * r breit + FI. + + x erweiterung: + IF mode + THEN real(anzahl y stellen) * breite / 10.0 + ELSE 0.0 + FI. + + zeichne x achse: + TEXT VAR zahl :: text (xx min, anzahl x stellen, nachkomma); + ersetze zahl; + move (rahmen, max(xn min, xx min - real(length(zahl)) * r breit / 2.0), + yn min); + draw (rahmen, zahl, 0.0, breite, hoehe); + zahl := text (xx max, anzahl x stellen, nachkomma); + ersetze zahl; + move (rahmen, xx max - real(length(zahl)) * r breit, yn min); + draw (rahmen, zahl, 0.0, breite, hoehe). + + zeichne y achse: + zahl := text (yy min, anzahl y stellen, nachkomma); + ersetze zahl; + move (rahmen, max (xn min, xx min - real(length(zahl)) * r breit - + (xx max - xx min) / 30.0),yy min - r hoch / 2.0); + draw (rahmen, zahl, 0.0, breite, hoehe); + zahl := text (yy max,anzahl y stellen,nachkomma); + ersetze zahl; + move (rahmen, max (xn min, xx min - real(length(zahl)) * r breit - + (xx max - xx min) / 30.0),yy max - r hoch / 2.0); + draw (rahmen, zahl, 0.0, breite, hoehe). + + zeichne ueberschrift: + move (rahmen, (xx max + xx min - real(length(ueberschrift)) * r breit) + / 2.0, yy max + y 1 mm); + draw (rahmen, ueberschrift, 0.0, breite, hoehe). + + ersetze zahl: + change all (zahl, ".", ",") + +END PROC beschriftung; + +INT PROC stellen (REAL CONST r): + IF r = 0.0 + THEN nachkomma + 2 + ELSE nachkomma + 3 + max (0, int ( round(log10 (abs(r)),nachkomma))) + FI +END PROC stellen + +END PACKET funktionen; + +PACKET fkt manager DEFINES fkt manager: + +LET continue code = 100, + ack = 0, + nack = 1; + +DATASPACE VAR dummy space; +INT VAR order; +TASK VAR order task; + +PROC fkt manager: + set autonom; + disable stop; + break (quiet); + REP + forget (dummy space); + wait (dummy space, order, order task); + IF order >= continue code AND order task = supervisor + THEN call (supervisor, order, dummy space, order); + IF order = ack + THEN fkt online + FI; + set autonom; + command dialogue (FALSE); + forget (ALL myself) + ELSE send (order task, nack, dummy space) + FI + PER. + + fkt online: + command dialogue (TRUE); + fktplot; + IF online + THEN eumel must advertise; + break (quiet) + FI +END PROC fktmanager + +END PACKET fktmanager + diff --git a/app/mpg/2.2/src/GRAPHIK.Install b/app/mpg/2.2/src/GRAPHIK.Install new file mode 100644 index 0000000..acd1d38 --- /dev/null +++ b/app/mpg/2.2/src/GRAPHIK.Install @@ -0,0 +1,84 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.1 vom 10.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Installation" geschrieben von C.Weinholz *) +(* *) +(**************************************************************************) +(* *) +(* Dieses Programm wird in eine neueingerichtete Task *) +(* GRAPHIK vom Archiv geladen, und sorgt nach 'run' *) +(* fuer die volstaendige Installation des Graphik-Systems *) +(* *) +(**************************************************************************) +(* Urversion : 10.09.87 *) +(* Aenderungen: 23.09.87, Carsten Weinholz *) +(* global manager aequivalent ersetzt *) +(* 'family password' wird nun erfragt und gesetzt *) +(* *) +(**************************************************************************) +LET packet 1 = "GRAPHIK.Basis", + packet 2 = "GRAPHIK.Plot", + config = "GRAPHIK.Configurator", + install = "GRAPHIK.Configuration", + fkt = "GRAPHIK.Fkt", + fkthelp = "FKT.help", + turtle = "GRAPHIK.Turtle"; + +FILE VAR f; +TEXT VAR l; +INT VAR x; + +check off; +warnings off; +archiv; +fetch (ALLarchive- all,archive); +BOOL VAR new conf :: NOT exists (install); +IF new conf + THEN mess ("GRAPHIK muss neu konfiguriert werden") + ELSE new conf := yes ("GRAPHIK neu konfigurieren") +FI; +release; +ins (packet 1); +IF new conf + THEN run (config) + ELSE ins (install) +FI; +ins (packet 2); +ins (fkt); +ins (turtle); +do ("generate plot manager"); +mess (""15" Fertig "14""); +IF yes ("Alles loeschen") + THEN command dialogue (FALSE); + forget (all-fkthelp); + command dialogue (TRUE) +FI; +TEXT VAR geheim; +put ("GRAPHIK-Password: "); +get secret line (geheim); +family password (geheim); +global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) std manager); + +PROC ins (TEXT CONST name): + page; + f := sequential file (input, name); + FOR x FROM 1 UPTO 11 REP + getline (f,l); + putline (l); + PER; + mess ("""" + name + """ wird insertiert"13""10""); + insert (name) +END PROC ins; + +PROC mess (TEXT CONST msg): + line; + putline (msg); +END PROC mess; + + + diff --git a/app/mpg/2.2/src/GRAPHIK.Manager b/app/mpg/2.2/src/GRAPHIK.Manager new file mode 100644 index 0000000..df9df6b --- /dev/null +++ b/app/mpg/2.2/src/GRAPHIK.Manager @@ -0,0 +1,925 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.2 vom 23.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Plotmanager" geschrieben von C.Weinholz *) +(* *) +(**************************************************************************) +(* *) +(* Dieses Paket stellt den Multispool-Ausgabemanager *) +(* zur Verfuegung. *) +(* Er wird in der Regel durch Aufruf von *) +(* 'generate plot manager' in GRAPHIK in einer neuerzeugten *) +(* Sohntask 'PLOT' installiert. *) +(* *) +(**************************************************************************) +(* Urversion : 10.09.87 *) +(* Aenderungen: 23.09.87, Carsten Weinholz *) +(* Kommando 'spool control ("TEXT")' im Plot-Monitor *) +(* Anzeige von 'order tasks' anderer Stationen *) +(* 11.1.88, Thomas Clermont *) +(* Fehler 'Zu viele DATASPACEs' und *) +(* Spooling von zwei gleichnamigen JOBs behoben. *) +(* Fehler : Keine bekannt. *) +(**************************************************************************) +PACKET plot manager DEFINES plot manager , + plot server : + +LET max spools = 14, (* Hinweis: max spools + dataspaces + *) + max entries = 14, (* max spools * max entries < 250 *) + + ack = 0, + second phase ack = 5, + false code = 6, + fetch code = 11, + save code = 12, + existscode = 13, + erase code = 14, + list code = 15, + all code = 17, + first code = 25, + start code = 26, + stop code = 27, + halt code = 28, + wait for halt code = 29, + continue code = 100, + picfiletype = 1102, + + trenn = "/", + + MSG = STRUCT (TEXT ds name, dev name, passwd, INT dev no), + + JOB = STRUCT (DATASPACE ds, TEXT ds name, TASK order task), + + ENTRY = STRUCT (JOB job, INT link), + + CHAIN = STRUCT (ROW max entries ENTRY entry, INT first, last, empty), + + SERVER = STRUCT (TASK task, wait for halt, REAL time, + JOB current job, BOOL stopped, INT link); + +ROW max spools STRUCT (SERVER server, CHAIN chain) VAR device; + +MSG VAR msg; + +INT VAR entry to erase, last created server, reply, current plotter; +FILE VAR chain info; +THESAURUS VAR managed plotter; +BOUND THESAURUS VAR thesaurus msg; +DATASPACE VAR reply ds; +TASK VAR control task; + +(********************************* SPOOL ***********************************) + +PROC plot manager : + INT VAR act dev; + managed plotter := plotters LIKE (text (station (myself)) + any); + FOR act dev FROM 1 UPTO max devices REP + init device (act dev) + PER; + control task := niltask; + end global manager (FALSE); + global manager (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST)plot manager) +END PROC plot manager; + +PROC plot manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST order task): + enable stop; + INT VAR act dev; + SELECT order OF + CASE fetch code : y fetch + CASE save code : y save + CASE exists code: y exists + CASE erase code : y erase + CASE list code : y list + CASE all code : y all + OTHERWISE IF order >= continue code AND order task = supervisor + THEN forget (ds); + continue (order - continue code); + spool monitor + ELIF priv control op + THEN SELECT order OF + CASE first code : y first + CASE start code : y start + CASE stop code : y stop + CASE halt code : y halt + CASE wait for halt code : y halt + OTHERWISE order error + ENDSELECT + ELSE order error + FI; + END SELECT; + BOOL VAR test; + FOR act dev FROM 1 UPTO max devices REP + test := server is active (act dev) + PER; + forget (ds). + + priv control op: + (order task = father) OR (order task < supervisor) OR + spool control task. + + spool control task: + NOT (order task = niltask) CAND + ((order task = control task) OR (order task < control task)). + + y fetch: + FOR act dev FROM 1 UPTO max devices REP + UNTIL act server.task = order task PER; + IF act dev > max devices + THEN order error + ELIF chain is empty (act dev) OR act server.stopped + THEN end server (act dev); + IF exists (act server.wait for halt) + THEN send (act server.wait for halt, ack); + act server.wait for halt := niltask + FI + ELSE transfer next job (act dev); + send current job (act dev) + FI. + + y save: + IF phase = 1 + THEN y save pre + ELSE y save post + FI. + + y save pre: + link dev; + IF act dev = 0 + THEN device error + ELIF chain is full (act dev) + THEN errorstop ("SPOOL ist voll") + ELSE send (order task, second phase ack) + FI. + + y save post: + act dev := msg.dev no; + IF type (ds) <> picfile type + THEN errorstop ("Datenraum hat falschen Typ") + ELSE entry into chain (act dev, new job); + forget (ds); + IF NOT (server is active (act dev) OR act server.stopped) + THEN create server (act dev) + FI; + send ack + FI. + + new job: + JOB : (ds, msg.ds name, order task). + + y exists: + link dev; + IF find entry (msg.ds name,act dev,order task, priv control op) = 0 + THEN send (order task, false code, ds) + ELSE send ack + FI. + + y erase: + IF phase = 1 + THEN link dev; + IF act dev > 0 + THEN y erase pre + ELSE device error + FI + ELSE erase entry (act dev, entry to erase); + send ack + FI. + + y erase pre: + entry to erase := find entry (msg.ds name,act dev, order task, priv control op); + IF order not from job order task AND NOT priv control op + THEN errorstop ("Kein Zugriffsrecht auf Auftrag """ + msg.ds name + """") + ELIF entry to erase = 0 + THEN manager message ("""" + msg.ds name + """ existiert nicht") + ELSE manager question (erase msg) + FI. + + erase msg: + TASK VAR owner ::act chain.entry [entry to erase].job.order task; + owner id (owner) + "/ """ + msg.ds name + + """ in Spool """ + name (managed plotter, act dev) + + """ loeschen". + + order not from job order task: + NOT (act chain.entry [entry to erase].job.order task = order task). + + y list: + link dev; + create chain list (act dev); + send (order task, ack, reply ds). + + y all: + link dev; + forget (reply ds); + reply ds := nilspace; + thesaurus msg := reply ds; + thesaurus msg := chain thesaurus (act dev, owner or priv task, FALSE); + send (order task, ack, reply ds). + + owner or priv task: + IF priv control op + THEN niltask + ELSE order task + FI. + + y start: + link dev; + IF act dev = 0 + THEN FOR act dev FROM 1 UPTO max devices REP + start (act dev) + PER + ELSE start (act dev) + FI; + send ack. + + y stop: + IF phase = 1 + THEN y stop pre + ELSE y stop post + FI. + + y stop pre: + link dev; + IF act dev > 0 + THEN stop (act dev); + IF NOT is no job (act server.current job) + THEN manager question ("""" + act server.current job.ds name + + """ neu eintragen") + ELSE send ack + FI + ELSE FOR act dev FROM 1 UPTO max devices REP + stop (act dev) + PER; + send ack + FI. + + y stop post: + act dev := msg.dev no; + entry into chain (act dev, act server.current job); + IF act chain.last > 1 + THEN make new first (act dev, act chain.last) + FI; + send ack. + + y halt: + link dev; + IF act dev = 0 + THEN IF order <> halt code + THEN device error + ELSE FOR act dev FROM 1 UPTO max devices REP + halt (act dev) + PER; + send ack + FI + ELSE halt (act dev); + IF order = halt code + THEN send ack; + act server.wait for halt := niltask + ELSE act server.wait for halt := order task + FI + FI. + + y first: + link dev; + IF act dev = 0 + THEN device error + ELSE INT VAR new first entry :: find entry (msg.ds name,act dev,order task,TRUE); + IF new first entry = 0 + THEN manager message ("""" + msg.ds name + """ existiert nicht") + ELSE make new first (act dev,new first entry); + send ack + FI + FI. + + act server: + device [act dev].server. + + act chain: + device [act dev].chain. + + send ack: + send (order task, ack). + + link dev: + msg := ds; + act dev := msg.dev no. + + order error: + errorstop ("Falscher Auftrag fuer Task """ + name (myself) + """"). + + device error: + disable stop; + IF plotter (msg.dev name) = no plotter + THEN clear error; (* 'plotter(TEXT)' liefert evtl. bereits error *) + errorstop ("Kein Endgeraet eingestellt") + ELSE clear error; + errorstop ("Unbekanntes Endgeraet: """ + msg.dev name + """") + FI; + enable stop. +END PROC plot manager; + +(****************************** Spool Monitor ******************************) + +INT VAR command index , params ; +TEXT VAR command line, param 1, param 2 ; +BOOL VAR is break; + +LET spool command list = +"break:1.0start:2.0stop:3.0halt:4.0first:5.0killer:6.0listspool:7.0 + clearspool:8.0selectplotter:9.0spoolcontrol:10.1"; + +PROC spool monitor: + disable stop ; + current plotter := 0; + is break := FALSE; + select plotter (""); + REP command dialogue (TRUE) ; + get command (gib kommando, command line); + analyze command (spool command list, command line, 3, command index, + params, param1, param2); + execute command; + UNTIL is break PER; + command dialogue (FALSE); + eumel must advertise; + break (quiet); + set autonom. + + gib kommando: + IF actual plotter > 0 + THEN plotter info (name(plotters,actual plotter),50) + ELSE "ALL-Plotter: " + FI +END PROC spool monitor; + +PROC execute command: + enable stop; + SELECT command index OF + CASE 1 : is break := TRUE + CASE 2 : start cmd + CASE 3 : stop cmd + CASE 4 : halt cmd + CASE 5 : first cmd + CASE 6 : killer cmd + CASE 7 : show spool list + CASE 8 : clear spool + CASE 9 : select plotter cmd + CASE 10 : set spool control + OTHERWISE do (command line); + set current plotter + END SELECT. + + set current plotter: + current plotter := link(managed plotter, name (plotters,actual plotter)); + IF actual plotter > 0 AND current plotter = 0 + THEN select plotter (""); + current plotter := 0; + errorstop ("Auf dieser Station unbekannt: """+name(plotter)+"""") + FI. + + start cmd: + FOR act dev FROM curr dev UPTO top dev REP + start (act dev) + PER. + + stop cmd: + FOR act dev FROM curr dev UPTO top dev REP + IF device [act dev].server.current job.ds name <> "" CAND + yes ("""" + device [act dev].server.current job.ds name + + """ neu eintragen") + THEN entry into chain (act dev, device [act dev].server.current job); + IF device [act dev].chain.last > 1 + THEN make new first (act dev, device [act dev].chain.last) + FI + FI; + stop (act dev) + PER. + + halt cmd: + FOR act dev FROM curr dev UPTO top dev REP + halt (act dev) + PER. + + first cmd: + IF current plotter = 0 + THEN device error + FI; + TEXT VAR make to first :: one (chain thesaurus (current plotter,niltask,TRUE) + -first chain entry) + IF make to first <> "" + THEN INT VAR new first entry :: find entry (make to first, + current plotter, niltask, FALSE); + IF new first entry > 1 + THEN make new first (current plotter, new first entry) + FI + FI. + + first chain entry: + INT VAR first entry id :: device [current plotter].chain.first; + IF first entry id > 0 + THEN device [current plotter].chain.entry[first entry id].job.ds name + ELSE "" + FI. + + killer cmd: + IF current plotter = 0 + THEN device error + FI; + THESAURUS VAR to erase :: chain thesaurus (current plotter,niltask,FALSE); + INT VAR index, act dev; + TEXT VAR name to erase; + FOR act dev FROM curr dev UPTO top dev REP + index := 0; + get (to erase, name to erase, index); + WHILE index > 0 REP + INT VAR entry to erase := find entry (name to erase, current plotter, niltask, TRUE); + IF (entry to erase > 0) CAND + yes ("""" + name to erase + """ loeschen") + THEN erase entry (current plotter, entry to erase) + FI; + get (to erase, name to erase, index) + PER + PER. + + show spool list : + create chain list (current plotter); + show (chain info); + forget (reply ds). + + clear spool: + FOR act dev FROM curr dev UPTO top dev REP + IF yes ("Spool """ + name (managed plotter, act dev) + """ initialisieren") + THEN BOOL VAR stopped :: device [act dev].server.stopped; + stop (act dev); + init device (act dev); + IF stopped + THEN device [act dev].server.stopped := TRUE + ELSE start (act dev) + FI + FI + PER. + + set spool control: + control task := task (param 1). + + select plotter cmd: + THESAURUS VAR plotter list :: empty thesaurus; + TEXT VAR plotter name; + get (managed plotter, plotter name, index); + WHILE index > 0 REP + insert (plotter list, plotter info (plotter name, 60)); + get (managed plotter, plotter name, index) + PER; + select plotter (name (managed plotter, + link (plotter list,one (plotter list)))); + set current plotter. + + curr dev: + IF current plotter = 0 + THEN 1 + ELSE current plotter + FI. + + top dev: + IF current plotter = 0 + THEN max devices + ELSE current plotter + FI. + + device error: + errorstop ("Kein Endgeraet eingestellt") + +ENDPROC execute command ; + +(************************** SPOOL - Verwaltung *****************************) + +PROC entry into chain (INT CONST dev no, JOB CONST new job): + INT VAR act entry := act chain.empty; + act chain.empty := act chain.entry [act entry].link; + IF act chain.last > 0 + THEN act chain.entry [act chain.last].link := act entry + FI; + act chain.last := act entry; + IF act chain.first = 0 + THEN act chain.first := act entry + FI; + init job (act chain.entry [act entry].job); + act chain.entry [act entry] := ENTRY : (new job,0); + forget (new job.ds). + + act chain : + device [dev no].chain +END PROC entry into chain; + +PROC erase entry (INT CONST dev no, to erase): + INT VAR act entry; + to forward entry; + IF act entry > 0 + THEN act chain.entry [act entry].link := act chain.entry [to erase].link + FI; + IF act chain.last = to erase + THEN act chain.last := act entry + FI; + IF act chain.first = to erase + THEN act chain.first := act chain.entry [to erase].link + FI; + init job (act chain.entry [to erase].job); + act chain.entry [to erase].link := act chain.empty; + act chain.empty := to erase. + + to forward entry: + FOR act entry FROM 1 UPTO max entries REP + UNTIL act chain.entry [act entry].link = to erase PER; + IF act entry > max entries + THEN act entry := 0 + FI. + + act chain: + device [dev no].chain +END PROC erase entry; + +INT PROC find entry (TEXT CONST ds name, INT CONST dev, TASK CONST order task,BOOL CONST priviledged): + INT VAR act dev :: dev,act entry,last found :: 0; + IF act dev = 0 + THEN FOR act dev FROM 1 UPTO max devices REP + find entry of order task + UNTIL act entry > 0 PER + ELSE find entry of order task + FI; + IF act entry = 0 + THEN last found + ELSE act entry + FI. + + find entry of order task: + BOOL VAR entry found; + act entry := act chain.first; + WHILE act entry > 0 REP + entry found := (act chain.entry [act entry].job.ds name = ds name); + IF entry found + THEN last found := act entry; + entry found := (index (act chain.entry [act entry].job.order task) = + index (order task)) OR priviledged + FI; + IF NOT entry found + THEN act entry := act chain.entry [act entry].link + FI + UNTIL entry found PER. + + act chain: + device [act dev].chain + +END PROC find entry; + +PROC make new first (INT CONST dev no, new first): + JOB VAR new first job :: act chain.entry [new first].job; + erase entry (dev no, new first); + INT VAR act entry := act chain.empty; + act chain.empty := act chain.entry [act entry].link; + act chain.entry [act entry] := ENTRY : (new first job, act chain.first); + init job (new first job); + act chain.first := act entry; + IF act chain.last = 0 + THEN act chain.last := act entry + FI. + + act chain: + device [dev no].chain + +END PROC make new first; + +THESAURUS PROC chain thesaurus (INT CONST dev no, TASK CONST order task, + BOOL CONST double): + THESAURUS VAR list :: empty thesaurus; + INT VAR act dev := dev no,act entry; + IF act dev = 0 + THEN FOR act dev FROM 1 UPTO max devices REP + list chain + PER + ELSE list chain + FI; + list. + + list chain: + act entry := act chain.first; + WHILE act entry > 0 REP + IF (order task = niltask) OR + (act chain.entry [act entry].job.order task = order task) + THEN insert job name + FI; + act entry := act chain.entry [act entry].link + PER. + + insert job name: + TEXT VAR this job :: act chain.entry [act entry].job.ds name + IF double OR (NOT (list CONTAINS this job)) + THEN insert (list, this job) + FI. + + act chain: + device [act dev].chain + +END PROC chain thesaurus; + + +PROC create chain list (INT CONST dev no): + INT VAR act dev :: dev no, act entry; + init chain info; + IF act dev = 0 + THEN FOR act dev FROM 1 UPTO max devices REP + list chain + PER + ELSE list chain + FI. + + init chain info: + forget (reply ds); + reply ds := nilspace; + chain info := sequential file (output, reply ds); + headline (chain info,"GRAPHIK - Ausgabe um "+ time of day (clock (1)) + " Uhr :"). + + + list chain: + server head; + IF NOT server is active (act dev) OR is no job (act server.current job) + THEN put (chain info, "- Kein Auftrag in Bearbeitung") ; + IF act server.stopped + THEN put (chain info, " ( SERVER deaktiviert )") + FI; + line (chain info) + ELSE put (chain info, "- In Bearbeitung seit "+time of day (act server.time)+" Uhr :"); + IF act server.stopped + THEN put (chain info, " ( SERVER wird deaktiviert !)") + FI; + line (chain info, 2); + putline (chain info, job note (act server.current job)) + FI; + line (chain info); + IF act chain.last = 0 + THEN putline (chain info, "- Keine Auftraege im SPOOL") + ELSE putline (chain info, "- Weitere Auftraege im SPOOL :"); + line (chain info); + act entry := act chain.first; + WHILE act entry > 0 REP + putline (chain info, job note (act chain.entry [act entry].job)); + act entry := act chain.entry [act entry].link + PER + FI; + line (chain info, 2). + + server head: + TEXT VAR plotter name :: name (managed plotter,act dev); + INT VAR station :: int (plottername), + tp :: pos (plottername,trenn)+1, + channel :: int (subtext (plottername,tp)); + plotter name := subtext (plotter name, pos (plotter name, trenn, tp)+1); + putline (chain info, 77 * "-"); + putline (chain info, + center (plotter name + (30-length(plotter name))*"." + + "Kanal " + text (channel) + + "/Station " + text (station))); + putline (chain info, 77 * "-"); + line (chain info). + + act chain: + device [act dev].chain. + + act server: + device [act dev].server + +END PROC create chain list; + +BOOL PROC chain is empty (INT CONST dev no): + device [dev no].chain.first = 0 OR device [dev no].chain.last = 0 +END PROC chain is empty; + +BOOL PROC chain is full (INT CONST dev no): + device [dev no].chain.empty = 0 +END PROC chain is full; + +PROC transfer next job (INT CONST dev no): + INT VAR next chain entry := device [dev no].chain.first; + next server job (dev no, device [dev no].chain.entry [next chain entry].job); + erase entry (dev no,next chain entry) +END PROC transfer next job; + +(*************************** SERVER - Verwaltung ***************************) + +PROC next server job (INT CONST dev no,JOB CONST next job): + act server.time := clock (1); + init job (act server.current job); + act server.current job := next job. + + act server: + device [dev no].server +END PROC next server job; + +BOOL PROC server is active (INT CONST dev no): + exists (act server.task) CAND server alive or restarted. + + server alive or restarted: + SELECT status (act server.task) OF + CASE 0 (* busy *) , + 4 (* busy-blocked *), + 2 (* wait *), + 6 (* wait-blocked *) : TRUE + CASE 1 (* i/o *), + 5 (* i/o -blocked *): IF channel (act server.task) = 0 + THEN restart + ELSE TRUE + FI + OTHERWISE restart + END SELECT. + + restart: + end server (dev no); + IF NOT act server.stopped AND NOT chain is empty (dev no) + THEN create server (dev no) + FI; + NOT is niltask (act server.task). + + act server: + device [dev no].server + +END PROC server is active; + +PROC create server (INT CONST dev no): + init job (act server.current job); + act server.wait for halt := niltask; + act server.time := 0.0; + act server.stopped := FALSE; + last created server := dev no; + begin (PROC plot server, act server.task). + + act server: + device [dev no].server +END PROC create server; + +PROC end server (INT CONST dev no): + end (act server.task); + init job (act server.current job); + act server.task := niltask. + + act server: + device [dev no].server + +END PROC end server; + +PROC start (INT CONST dev no): + IF server is active (dev no) + THEN end server (dev no) + FI; + IF NOT chain is empty (dev no) + THEN create server (dev no) + FI; + device [dev no].server.stopped := FALSE +END PROC start; + +PROC stop (INT CONST dev no): + device [dev no].server.stopped := TRUE; + IF exists (device [dev no].server.wait for halt) + THEN send (device [dev no].server.wait for halt,ack) + FI; + device [dev no].server.wait for halt := niltask; + IF server is active (dev no) + THEN end server (dev no) + FI +END PROC stop; + +PROC halt (INT CONST dev no): + device [dev no].server.stopped := TRUE +END PROC halt; + +PROC send current job (INT CONST dev no): + forget (reply ds); + reply ds := device [dev no].server.current job.ds; + send (device [dev no].server.task, ack,reply ds); +END PROC send current job; + +(****************************** Hilfsprozeduren ****************************) + +PROC init device (INT CONST dev no): + INT VAR act entry; + act server.task := niltask; + act server.time := 0.0; + init job (act server.current job); + act server.stopped := FALSE; + act chain.first := 0; + act chain.last := 0; + act chain.empty := 1; + FOR act entry FROM 1 UPTO max entries-1 REP + init job (act chain.entry [act entry].job); + act chain.entry [act entry].link := act entry + 1 + PER; + init job (act chain.entry [act entry].job); + act chain.entry [act entry].link := 0. + + act server : + device [dev no].server. + + act chain : + device [dev no].chain + +END PROC init device; + +INT PROC max devices: + highest entry (managed plotter) +END PROC max devices; + +OP := (MSG VAR dest, DATASPACE VAR source): + TEXT VAR ds name :: "", dev name :: ""; + BOUND STRUCT (TEXT ds name, dev name, passwd) VAR msg in := source; + divide names; + dest := MSG : (ds name, dev name, msg in .passwd, + link (managed plotter,dev name)); + forget (source). + + divide names: + INT VAR pps :: pos (msg in.ds name, ""0""); + WHILE pos (msg in.ds name, ""0"", pps+1) > 0 REP + pps := pos (msg in.ds name,""0"", pps+1) + PER; + IF pps > 0 + THEN ds name := subtext (msg in.ds name, 1, pps-1); + FI; + dev name := subtext (msg in.ds name, pps+1). + +END OP :=; + +TEXT PROC job note (JOB CONST job): + " - " + owner id (job.order task) + " : " + qrline (job.ds name, 30) + + " (" + text (storage (job.ds)) + " K)". +END PROC job note; + +TEXT PROC owner id (TASK CONST owner): + TEXT VAR test :: name (owner); + IF test <> "" + THEN text (station (owner)) + "/" + qrline (test,15) + ELSE "?????" + FI +END PROC owner id; + +PROC init job (JOB VAR to initialize): + forget (to initialize.ds); + to initialize.ds name := ""; + to initialize.order task := niltask +END PROC init job; + +TEXT PROC qrline (TEXT CONST t,INT CONST len): + IF length (t) > len-2 + THEN """" + text (t, len-5) + "...""" + ELSE text ("""" + t + """", len) + FI +END PROC qrline; + +TEXT PROC center (TEXT CONST chars,INT CONST len): + len DIV 2 * " " + chars +END PROC center; + +BOOL PROC is no job (JOB CONST job): + job.ds name = "" +END PROC is no job; + +PROC send (TASK CONST task, INT CONST code): + DATASPACE VAR ds :: nilspace; + send (task, code, ds); + forget (ds) +END PROC send; + +(**************************** Plot - Server ********************************) + +PROC plot server: + disable stop; + select plotter (name (managed plotter,last created server)); + REP + error handling; + TEXT VAR dummy; + catinput (dummy, dummy); (* evtl. Zeichen im Tastaturpuffer *) + PICFILE VAR pic :: next server job; + prepare; + plot (pic); + PER. + + next server job: + forget (reply ds); + reply ds := nilspace; + REP + error handling; + call (father, fetch code, reply ds, reply) + UNTIL reply = ack PER; + reply ds. + + error handling: + IF is error + THEN rename myself (error message); + clear error; + pause + FI. + +END PROC plot server; + +END PACKET plot manager + diff --git a/app/mpg/2.2/src/GRAPHIK.Plot b/app/mpg/2.2/src/GRAPHIK.Plot new file mode 100644 index 0000000..0479d75 --- /dev/null +++ b/app/mpg/2.2/src/GRAPHIK.Plot @@ -0,0 +1,1237 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.2 vom 23.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Plot" geschrieben von C.Weinholz *) +(* *) +(**************************************************************************) +(* *) +(* Paket II: Endgeraet-abhaengige Graphikroutinen *) +(* (koennen erst nach 'Interface.Conf' insertiert werden) *) +(* *) +(* 1. Plot (Grundlegende Graphik-Operationen *) +(* *) +(* 2. Plot Input/Output (Routinen zum *) +(* Ansprechen des PLOT-Spoolers *) +(* zur indirekten Graphik-Ausgabe) *) +(* *) +(* 3. Plot Picture/Picfile *) +(* (Ausgabe von PICTURES/ PICFILES) *) +(* *) +(**************************************************************************) +(* Urversion : 10.09.87 *) +(* Aenderungen: 23.09.87, Carsten Weinholz *) +(* PROC save (PICFILE CONST, TEXT CONST, PLOTTER CONST) *) +(* hinzugefuegt *) +(* PROC plot (PICFILE CONST) auch indirekt *) +(* Fehlermeldung bei indirektem 'plot (PICTURE)' *) +(* 20.11.87, Beat Jegerlehner *) +(* Clipping bei move eingefuehrt. Gibt sonst bei Watanabe *) +(* Probleme *) +(* Textgenerator korrigiert *) +(* *) +(**************************************************************************) + +(************************************ Plot ********************************) + +PACKET basis plot DEFINES + + beginplot, + pen , + + move , + move r , + move cm , + move cm r, + + draw , + draw r , + draw cm , + draw cm r, + + hidden lines, + reset , + + zeichensatz, + reset zeichensatz, + + linetype, + reset linetypes, + + where, + bar, + circle, + box: + +LET empty = 0, (* Punktmuster *) + half = 1, + full = 2, + horizontal = 3, + vertical = 4, + cross = 5, + diagonal right = 6, + diagonal left = 7, + diagonal both = 8, + std zeichenname = "ZEICHENSATZ"; + +INT VAR ltype :: 1, + thick :: 0, + xpixel :: 0, + ypixel :: 0, + old x :: 0, + old y :: 0, + real old x :: 0, + real old y :: 0; + +REAL VAR x cm, ycm,hor relation, vert relation,x to y,y to x; + +ROW 5 TEXT VAR linetypes; + +INT VAR cnt :: 0; +TEXT VAR muster :: "0"; +INT VAR lentxt :: length(muster); + +LET POS = STRUCT (REAL x, y, z); +POS VAR pos :: POS : (0.0, 0.0, 0.0); + +LET ZEICHENSATZ = ROW 255 TEXT; +ZEICHENSATZ VAR zeichen; +REAL CONST char x :: 6.0, char y :: 6.0,y base :: 2.0; + +BOUND ZEICHENSATZ VAR std zeichen :: old (std zeichenname); +reset zeichensatz; +reset linetypes; + +INT VAR h :: 0, v :: 0, new h :: 0, new v :: 0; + +BOOL VAR hidden :: FALSE; + +DATASPACE VAR ds :: nilspace; +BOUND STRUCT (ROW 32764 INT akt, last) VAR maxima :: ds; + +(*************************** Initialisierung *******************************) + +PROC beginplot: + init plot; + drawing area (x cm, y cm, x pixel, y pixel); + hor relation := real (x pixel)/x cm; + vert relation:= real (y pixel)/y cm; + x to y := x cm / real(x pixel) / (y cm / real (y pixel)); (*umrechnung:*) + y to x := 1.0 / x to y; (* x pixel in y pixel u andersherum*) +END PROC beginplot; + +PROC pen (INT CONST backgr,colour,thickn,linetype): + background(backgr); + foreground(colour); + thick := thickn; + ltype := selected linetype; + IF ltype > 1 + THEN muster := linetypes[ltype]; + lentxt := length (muster); + cnt := 0 + FI. + + selected linetype: + IF linetype < 0 OR linetype > 5 + THEN 1 + ELSE linetype + FI +END PROC pen; + +(************************** MOVE - Prozeduren ******************************) + +PROC move (INT CONST x,y): + old x := x; + old y := y +END PROC move; + +PROC do move (INT CONST x,y): + IF x <> real old x OR + y <> real old y + THEN real old x := x; + real old y := y; + move to (x,y) + FI; + old x := x; + old y := y +END PROC do move; + +PROC move (REAL CONST x, y) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (x, y, 0.0, h, v); + move (h, v); + pos := POS : (x, y, 0.0) +END PROC move; + +PROC move (REAL CONST x, y, z) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (x, y, z, h, v); + move (h, v); + pos := POS : (x, y, z) +END PROC move; + +PROC move r (REAL CONST x, y) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (pos.x+x, pos.y+y, pos.z, h, v); + move (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z) +END PROC move r; + +PROC move r (REAL CONST x, y, z) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (pos.x+x, pos.y+y, pos.z+z, h, v); + move (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC move r; + +PROC move cm (REAL CONST x cm, y cm) : + IF hidden + THEN maxima.last := maxima.akt FI; + + h := int (x cm*hor relation+0.5); + v := int (y cm*vert relation+0.5); + move (h, v) +END PROC move cm; + +PROC move cm r (REAL CONST x cm, y cm) : + IF hidden + THEN maxima.last := maxima.akt FI; + + h INCR int (x cm*hor relation+0.5); + v INCR int (y cm*vert relation+0.5); + move (h, v) +END PROC move cm r; + +(************************** DRAW - Prozeduren ******************************) + +PROC draw (INT CONST x,y): + draw (old x,old y,x,y) +END PROC draw; + +PROC draw (INT CONST x0,y0,x1,y1): + IF thick = 0 + THEN line (x0, y0,x1,y1) + ELSE old x := x0; + old y := y0; + draw thick line (x1,y1) + FI; + old x := x1; + old y := y1 +END PROC draw; + +PROC draw (REAL CONST x, y) : + IF hidden + THEN transform (x, y, 0.0, new h, new v); + vector (new h-h, new v-v) + ELSE transform (x, y, 0.0, h, v); + draw (h, v) + FI; + pos := POS : (x, y, 0.0) +END PROC draw; + +PROC draw (REAL CONST x, y, z) : + IF hidden + THEN transform (x, y, z, new h, new v); + vector (new h-h, new v-v) + ELSE transform (x, y, z, h, v); + draw (h, v) + FI; + pos := POS : (x, y, z) +END PROC draw; + +PROC draw r (REAL CONST x, y) : + IF hidden + THEN transform (pos.x+x, pos.y+y, pos.z, h, v); + vector (new h-h, new v-v) + ELSE transform (pos.x+x, pos.y+y, pos.z, h, v); + draw (h, v) + FI; + pos := POS : (pos.x+x, pos.y+y, pos.z) +END PROC draw r; + +PROC draw r (REAL CONST x, y, z) : + IF hidden + THEN transform (pos.x+x, pos.y+y, pos.z+z, h, v); + vector (new h-h, new v-v) + ELSE transform (pos.x+x, pos.y+y, pos.z+z, h, v); + draw (h, v) + FI; + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC draw r; + +PROC draw cm (REAL CONST x cm, y cm) : + IF hidden + THEN vector (int (x cm*hor relation+0.5)-h, int (y cm*vert relation+0.5)-v) + ELSE h := int (x cm*hor relation+0.5); + v := int (y cm*vert relation+0.5); + draw (h, v) + FI +END PROC draw cm; + +PROC draw cm r (REAL CONST x cm, y cm) : + IF hidden + THEN vector (int (x cm*hor relation+0.5), int (y cm*vert relation+0.5)) + ELSE h INCR int (x cm*hor relation+0.5); + v INCR int (y cm*vert relation+0.5); + draw (h, v) + FI +END PROC draw cm r; + +(*************************** LINIEN zeichnen *******************************) + +PROC line (INT CONST x0,y0,x1,y1): + REAL VAR x0r :: real (x0), + y0r :: real (y0), + x1r :: real (x1), + y1r :: real (y1); + IF clipped line (x0r,y0r,x1r,y1r) + THEN IF ltype > 1 + THEN draw special line(int(x0r),int(y0r),int(x1r),int(y1r)) + ELIF ltype = 1 + THEN do move (int(x0r),int(y0r)); + draw std line (int(x1r),int(y1r)) + FI + FI +END PROC line; + +PROC draw std line (INT CONST x,y): + old x := x; + old y := y; + real old x := x; + real old y := y; + draw to (x,y) +END PROC draw std line; + +PROC draw special line (INT CONST x0,y0,x1,y1): + IF x0 = x1 + THEN vertical line + ELIF y0 = y1 + THEN horizontal line + ELIF abs(x1-x0) > abs(y1 - y0) + THEN steile linie + ELSE flache linie + FI. + + vertical line: + INT VAR steps :: abs(y1 - y0), + sig :: sign(y1-y0), + i; + FOR i FROM 0 UPTO steps REP + IF next pixel + THEN set pixel(x0,y0+i*sig) + FI + PER. + + horizontal line: + steps := abs(x1 - x0); + sig := sign(x1 - x0); + FOR i FROM 0 UPTO steps REP + IF next pixel + THEN set pixel(x0+i*sig,y0) + FI + PER. + + steile linie: + steps := abs(x1 - x0); + sig := sign(x1 - x0); + REAL VAR m :: real(y1 - y0) / real(x1 - x0); + FOR i FROM 0 UPTO steps REP + IF next pixel + THEN set pixel(x0+sig*i,y0+int(m*real(sig*i) + 0.5)) + FI + PER. + + flache linie: + steps := abs(y1 - y0); + sig := sign(y1 - y0); + m := real(x1 - x0) / real(y1 - y0); + FOR i FROM 0 UPTO steps REP + IF next pixel + THEN set pixel(x0+int(m*real(sig*i) + 0.5),y0+sig*i) + FI + PER. + + next pixel: + BOOL VAR is set :: (muster SUB cnt) <> "0"; + cnt INCR 1; + IF cnt > lentxt THEN cnt := 1 FI; + is set +END PROC drawspecialline; + +PROC draw thick line (INT CONST xe,ye): + + INT VAR x0 :: old x, + y0 :: old y, + x1 :: xe, + y1 :: ye; + + IF x0 = x1 AND y0 = y1 + THEN draw point (x0,y0) + ELIF abs(x0-x1) >= abs(y0-y1) + THEN IF x0 > x1 + THEN draw thick2(x1,y1,x0,y0) + ELSE draw thick2(x0,y0,x1,y1) + FI + ELSE IF y0 > y1 + THEN draw thick1(x1,y1,x0,y0) + ELSE draw thick1(x0,y0,x1,y1) + FI + FI +END PROC draw thick line; + +PROC draw point (INT CONST x,y): + INT VAR i,k,d :: int(0.5 + real(thick) / (x cm / real(x pixel)) / 10.0 / + 2.0); + FOR i FROM 0 UPTO d REP + k := int (0.5 + sqrt(real(d)**2 - real(i)**2)* x to y); + line (x+i, y-k, x+i, y+k); + line (x-i, y-k, x-i, y+k) + PER +END PROC draw point; + +PROC draw thick 1 (INT CONST x0,y0,x1,y1): + REAL VAR dxx :: real(x1 - x0), + dyx :: real(y1 - y0) * y to x, + d3 :: real(thick) / (x cm / real(x pixel)) / 10.0, + d1 :: sqrt (d3**2 + (d3 * dxx / dyx)**2), + d2 :: d3 * dxx / dyx, + dh :: (d3**2 - d2**2 + d1**2) / 2.0 / d1, + d4 :: sqrt(max(0.0,d3 ** 2 - dh ** 2)) * x to y; + INT VAR l :: int (0.5 + d1 / 2.0), + dy :: abs(y0 - y1), + dx :: abs(x0 - x1), + x :: x0 - int(0.5 + d3 / 2.0 * dxx / dyx), + y :: y0 - int(d3 / 2.0 * x to y), + z :: y1 + int (d3 / 2.0 * x to y), + dp :: dx + dx, + d :: dp - dy, + dq :: dp - dy - dy, + a :: sign (y1 - y0), + b :: sign (x1 - x0); + do line; + WHILE y <> z REP + y INCR a; + IF d < 0 + THEN d INCR dp + ELSE x INCR b; + d INCR dq + FI; + do line + PER. + + do line: + INT VAR s1 :: l, + s2 :: l, + s3 :: x, + sh; + IF y < y0 - int (0.5 + d4 / 2.0) + THEN s1 := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(y - y0) * y to + x)**2)); + s2 := s1; + s3 := x0 + ELIF y < y0 + int (0.5 + d4 / 2.0) + THEN sh := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(y-y0) * y to + x)**2)); + IF x0 > x1 + THEN s2 := sh + x0 - x + ELSE s1 := sh + x - x0 + FI; + s3 := x + ELIF y > y1 + int (0.5 + d4/2.0) + THEN s1 := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(y-y1)*y to x)**2)); + s2 := s1; + s3 := x1 + ELIF y > y1 - int(0.5 + d4 / 2.0) + THEN sh := int(0.5 + sqrt(d3**2/4.0 - (real(y-y1)*y to x)**2)); + IF x0 > x1 + THEN s1 := sh + x - x1 + ELSE s2 := sh + x1 - x + FI; + s3 := x + FI; + line (s3 - s1,y,s3 + s2, y) +END PROC draw thick 1; + +PROC draw thick 2 (INT CONST x0,y0,x1,y1): + REAL VAR dxx :: real(x1 - x0) * x to y, + dyx :: real(y1 - y0), + d3 :: real(thick) / (y cm / real(y pixel)) / 10.0, + d1 :: sqrt (d3**2 + (d3 * dyx / dxx)**2), + d2 :: d3 * dyx / dxx, + dh :: (d3**2 - d2**2 + d1**2) / 2.0 / d1, + d4 :: sqrt(max(0.0,d3 ** 2 - dh ** 2)) * y to x; + INT VAR l :: int (0.5 + d1 / 2.0), + dy :: abs(y0 - y1), + dx :: abs(x0 - x1), + y :: y0 - int(0.5 + d3 / 2.0 * dyx / dxx), + x :: x0 - int(d3 / 2.0 * y to x), + z :: x1 + int (d3 / 2.0 * y to x), + dp :: dy + dy, + d :: dp - dx, + dq :: dp - dx - dx, + a :: sign (x1 - x0), + b :: sign (y1 - y0); + do line; + WHILE x <> z REP + x INCR a; + IF d < 0 + THEN d INCR dp + ELSE y INCR b; + d INCR dq + FI; + do line + PER. + + do line: + INT VAR s1 :: l, + s2 :: l, + s3 :: y, + sh; + IF x < x0 - int (0.5 + d4 / 2.0) + THEN s1 := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(x - x0) * x to y)**2)); + s2 := s1; + s3 := y0 + ELIF x < x0 + int (0.5 + d4 / 2.0) + THEN sh := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(x-x0) * x to y)**2)); + IF y0 > y1 + THEN s2 := sh + y0 - y + ELSE s1 := sh + y - y0 + FI; + s3 := y + ELIF x > x1 + int (0.5 + d4/2.0) + THEN s1 := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(x-x1)*x to y)**2)); + s2 := s1; + s3 := y1 + ELIF x > x1 - int(0.5 + d4 / 2.0) + THEN sh := int(0.5 + sqrt(d3**2/4.0 - (real(x-x1)*x to y)**2)); + IF y0 > y1 + THEN s1 := sh + y - y1 + ELSE s2 := sh + y1 - y + FI; + s3 := y + FI; + line (x, s3-s1, x, s3+s2) +END PROC draw thick 2; + +(*************************** HIDDEN LINES **********************************) + +PROC hidden lines (BOOL CONST dev): + hidden := NOT dev; +END PROC hidden lines; + +PROC vector (INT CONST dx, dy): + IF dx >= 0 + THEN IF dy > dx THEN vector (v, h, dy, dx, 1, 1) + ELIF dy > 0 THEN vector (h, v, dx, dy, 1, 1) + + ELIF dy > -dx THEN vector (h, v, dx, -dy, 1,-1) + ELSE vector (v, h, -dy, dx,-1, 1) FI + + ELSE IF dy > -dx THEN vector (v, h, dy, -dx, 1,-1) + ELIF dy > 0 THEN vector (h, v, -dx, dy,-1, 1) + + ELIF dy > dx THEN vector (h, v, -dx, -dy,-1,-1) + ELSE vector (v, h, -dy, -dx,-1,-1) FI + FI . + +ENDPROC vector ; + +PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) : + INT VAR i; + prepare first step ; + draw point; + FOR i FROM 1 UPTO dx + REP do one step PER; + + IF was visible + THEN draw (h, v) FI . + + +prepare first step : + INT VAR up right error := dy - dx, + right error := dy, + old error := 0, + last h :: h, last v :: v; + BOOL VAR was visible :: visible . + + +do one step: + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR right ; + y pos INCR up ; + draw point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + draw point ; + old error INCR right error . + +draw point : + IF was visible + THEN IF NOT visible + THEN draw (last h, last v); + was visible := FALSE + FI; + last h := h; + last v := v + ELSE IF visible + THEN move (h, v); + was visible := TRUE; + last h := h; + last v := v + FI + FI . + +visible: + IF h < 1 OR h > x pixel + THEN FALSE + ELSE IF maxima.akt [h] < v + THEN maxima.akt [h] := v FI; + v > maxima.last [h] + FI +END PROC vector; + +PROC reset: + forget (ds); + ds := nilspace; + maxima := ds +END PROC reset; + +(**************************** TEXT - Ausgabe *******************************) + +PROC zeichensatz (TEXT CONST name): + IF exists (name) + THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name); + zeichen := new zeichen; + ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI +END PROC zeichensatz; + +PROC reset zeichensatz: + zeichen := std zeichen +END PROC reset zeichensatz; + +PROC draw char (INT CONST char no,REAL CONST x, y,REAL CONST y size, + x size, direction): + TEXT CONST character :: zeichen [char no]; + INT VAR n :: 1, x0, y0, x1, y1; + INT CONST len :: length (character); + REAL CONST sindir :: sind(direction), + cosdir :: cosd(direction); + WHILE n < len + REP value (character, n, x0, y0, x1, y1); + REAL VAR xr0 :: real(x0), + yr0 :: real(y0), + xr1 :: real(x1), + yr1 :: real(y1); + transform (xr0, yr0, x, y, x size, y size, sindir,cosdir); + transform (xr1, yr1, x, y, x size, y size, sindir,cosdir); + draw (int(xr0), int (yr0 * x to y), + int(xr1),int(yr1 * x to y)); + n INCR 4 + PER . + +END PROC draw char; + +PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1): + x0 := val (code (char SUB n)); y0 := val (code (char SUB n+1)); + x1 := val (code (char SUB n+2)); y1 := val (code (char SUB n+3)); +END PROC value; + +INT PROC val (INT CONST n): + IF n > 127 + THEN -256 OR n + ELSE n FI +END PROC val; + +PROC transform (REAL VAR x, y,REAL CONST x0, y0,REAL CONST x size, y size, + sindir,cosdir): + REAL CONST old x :: x, old y :: y; + REAL CONST dx :: x size / char x * old x * cosdir - + (y size-y base) / char y * old y * sindir, + dy :: (y size-y base) / char y * old y * cosdir + + x size / char x * old x * sindir; + x := x0 + dx; + y := y0 + dy +END PROC transform; + +PROC draw text (REAL CONST x pos, y pos,TEXT CONST msg, REAL CONST angle, + REAL CONST height, width): + INT VAR i; + REAL VAR x :: x pos, y :: y pos, + x step :: cosd (angle)*width, + y step :: sind (angle)*width; + FOR i FROM 1 UPTO length (msg) + REP IF control char + THEN execute control char + ELSE execute normal char FI + PER . + +control char: + akt char < ""32"" . + +execute control char: + SELECT code (akt char) OF + CASE 1: home + CASE 2: right + CASE 3: up + CASE 7: out (""7"") + CASE 8: left + CASE 10: down + CASE 13: return + ENDSELECT . + +home: + x := x pos; + y := y pos . + +right: + x INCR x step; y INCR y step . + +up: + x INCR y step; y INCR x step . + +left: + x DECR x step; y DECR y step . + +down: + x DECR y step; y DECR x step . + +return: + x := x pos . + +execute normal char: + draw char (code (akt char), x, y, height, width, + angle); + x INCR x step; + y INCR y step . + +akt char: + msg SUB i . + +END PROC draw text; + +PROC draw (TEXT CONST msg): + draw (msg,0.0,5.0,5.0) +END PROC draw; + +PROC draw (TEXT CONST msg,REAL CONST angle,REAL CONST heigth,width): + REAL CONST xr :: real(old x), + yr :: real(old y) * y to x; + draw text (xr,yr,msg,angle,heigth * real(x pixel) / x cm / 10.0, + width * real(x pixel) / x cm / 10.0) + (* heigth mm --> x punkte *) +END PROC draw; + +(***************************** LINETYPES ***********************************) + +PROC linetype (INT CONST nummer,TEXT CONST lt): + IF nummer > 5 OR nummer < 2 + THEN errorstop ("number out of range") + ELSE linetypes [nummer] := lt + FI +END PROC linetype ; + +PROC reset linetypes : + linetype (2,"1100"); + linetype (3,"11110000"); + linetype (4,"1111111100000000"); + linetype (5,"1111111100011000"); +END PROC reset linetypes ; + +(***************************** UTILIES *************************************) + +PROC where (REAL VAR x, y) : + x := pos.x; y := pos.y +END PROC where; + +PROC where (REAL VAR x, y, z) : + x := pos.x; y := pos.y; z := pos.z +END PROC where; + +PROC bar (REAL CONST hight, width, INT CONST pattern): + INT VAR zero x, zero y, end x, end y; + transform (0.0, 0.0, 0.0, zero x, zero y); + transform (width, hight, 0.0, end x, end y); + bar (h-(end x-zero x) DIV 2, v, end x-zero x, end y-zero y, pattern) +END PROC bar; + +PROC bar (INT CONST from x, from y, width, hight, pattern): + INT CONST to x :: from x+width, to y :: from y+hight; + INT VAR x, y; + draw frame; + SELECT pattern OF + CASE empty: (* nothing to do *) + CASE half: half bar + CASE full: full bar + CASE horizontal: horizontal bar + CASE vertical: vertical bar + CASE cross: horizontal bar; + vertical bar + CASE diagonal right: diagonal right bar + CASE diagonal left: diagonal left bar + CASE diagonal both: diagonal both bar + OTHERWISE errorstop ("Unknown pattern") ENDSELECT . + +draw frame: + move (from x, from y); + draw (from x, to y); + draw (to x, to y); + draw (to x, from y); + draw (from x, from y). + +full bar: + FOR y FROM from y UPTO to y + REP move (from x, y); + draw (to x, y) + PER . + +half bar: + FOR y FROM from y UPTO to y + REP x := from x + 1 + (y AND 1); + WHILE x < to x + REP move (x, y); + draw (x, y); + x INCR 2 + PER + PER . + +horizontal bar: + y := from y; + WHILE y < to y + REP move (from x, y); + draw (to x, y); + y INCR 5 + PER . + +vertical bar: + x := from x + 5; + WHILE x < to x + REP move (x, from y); + draw (x, to y); + x INCR 5 + PER . + +diagonal right bar: + y := from y-width+5; + WHILE y < to y + REP move (max (from x, to x-y-width+from y), max (from y, y)); + draw (min (to x, from x+to y-y), min (to y, y+width)); + y INCR 5 + PER . + +diagonal left bar: + y := from y-width+5; + WHILE y < to y + REP move (min (to x, to x-from y+y), max (from y, y)); + draw (max (from x, from x+y+width-to y), min (to y, y+width)); + y INCR 5 + PER . + +diagonal both bar: + y := from y-width+5; + WHILE y < to y + REP move (max (from x, to x-y-width+from y), max (from y, y)); + draw (min (to x, from x+to y-y), min (to y, y+width)); + move (min (to x, to x-from y+y), max (from y, y)); + draw (max (from x, from x+y+width-to y), min (to y, y+width)); + y INCR 5 + PER . + +END PROC bar; + +PROC circle (REAL CONST r, from, to, INT CONST pattern): + REAL VAR t :: from; INT VAR i; i := pattern; (* sonst WARNUNG *) + WHILE t < to + REP transform (pos.x + r*cosd (t), pos.y + r*sind (t), 0.0, h, v); + draw (h, v); + t INCR 1.0 + PER; + transform (pos.x, pos.y, 0.0, h, v); + draw (h, v) . + +END PROC circle; + +PROC box : + move (0,0); + draw (0,y pixel-1); + draw (x pixel-1, y pixel-1); + draw (x pixel-1, 0); + draw (0,0) +END PROC box; + +END PACKET basis plot; + +(************************* Plot Spool Input/ Output ***********************) + +PACKET plot interface DEFINES (* Carsten Weinholz *) + (* V 1.1 02.07.87 *) + save , + exists , + erase , + ALL , + first , + start , + stop , + halt , + wait for halt , + list , + picfiles , + generate plot manager: + +LET initfile = "GRAPHIK.Manager", + plot manager name= "PLOT" , + + picfiletype = 1102, + + ack = 0, + false code = 6, + fetch code = 11, + save code = 12, + exists code = 13, + erase code = 14, + list code = 15, + all code = 17, + first code = 25, + start code = 26, + stop code = 27, + halt code = 28, + wait for halt code = 29; + +BOUND STRUCT (TEXT tname,user id,pass) VAR msg; + +DATASPACE VAR ds; + +INT VAR reply; +THESAURUS VAR all myself picfiles; + +PROC first (TEXT CONST ds name, PLOTTER CONST plotter id): + call (first code, ds name + ""0"" + id name (plotter id), plot id (plotter id)) +END PROC first; + +PROC start (PLOTTER CONST plotter id): + call (start code, id name (plotter id), plot id (plotter id)) +END PROC start; + +PROC stop (PLOTTER CONST plotter id): + call (stop code, id name (plotter id), plot id (plotter id)) +END PROC stop; + +PROC halt (PLOTTER CONST plotter id): + call (halt code, id name (plotter id), plot id (plotter id)) +END PROC halt; + +PROC wait for halt (PLOTTER CONST plotter id): + call (wait for halt code, id name (plotter id), plot id (plotter id)) +END PROC wait for halt; + +PROC save (TEXT CONST ds name, PLOTTER CONST plotter id): + enable stop; + last param (ds name); + call (save code, ds name + ""0"" + id name (plotter id), + old (ds name), plot id (plotter id)) +END PROC save; + +PROC save (PICFILE CONST p, TEXT CONST pname, PLOTTER CONST plotter id): + enable stop; + DATASPACE VAR ds; + ds BECOMES p; + call (save code, pname + ""0"" + id name (plotter id), ds, + plot id (plotter id)); +END PROC save; + +OP BECOMES (DATASPACE VAR ds, PICFILE CONST p): + EXTERNAL 260 +END OP BECOMES; + +PROC save (THESAURUS CONST nameset, PLOTTER CONST plotter id): + TEXT VAR name; + INT VAR i :: 0; + get (nameset, name, i); + WHILE i > 0 REP + save (name, plotter id); + cout (i); + get (nameset, name, i) + PER +END PROC save; + +BOOL PROC exists (TEXT CONST ds name, PLOTTER CONST plotter id): + INT VAR reply; + DATASPACE VAR ds :: nilspace; + BOUND TEXT VAR qname :: ds; + qname := ds name + ""0"" + id name (plotter id); + REP + call (plot id (plotter id), exists code, ds, reply) + UNTIL reply = false code OR reply = ack PER; + forget (ds); + reply = ack +END PROC exists; + +PROC erase (TEXT CONST ds name,PLOTTER CONST plotter id): + call (erase code, ds name + ""0"" + id name (plotter id), plot id (plotter id)) +END PROC erase; + +PROC erase (THESAURUS CONST nameset, PLOTTER CONST plotter id): + TEXT VAR name; + INT VAR i :: 0; + get (nameset, name, i); + WHILE i > 0 REP + erase (name, plotter id); + cout (i); + get (nameset, name, i) + PER +END PROC erase; + +THESAURUS OP ALL (PLOTTER CONST plotter id): + REP + forget (ds); + ds := nilspace; + msg := ds; + msg.tname := id name (plotter id); + msg.user id := ""; + msg.pass := ""; + call (plot id (plotter id), all code, ds, reply) + UNTIL reply = ack PER; + BOUND THESAURUS VAR result ds :: ds; + THESAURUS VAR result :: result ds; + forget (ds); + result +END OP ALL; + +PROC list (FILE VAR f,PLOTTER CONST plotter id): + REP + forget (ds); + ds := nilspace; + msg := ds; + msg.tname := id name (plotter id); + msg.user id := ""; + msg.pass := ""; + call (plot id (plotter id), list code, ds, reply) + UNTIL reply = ack PER; + f := sequential file (modify, ds) +END PROC list; + +PROC list (PLOTTER CONST plotter id): + FILE VAR list file; + list (list file, plotter id); + show (list file) +END PROC list; + +THESAURUS PROC picfiles: + all myself picfiles := empty thesaurus; + do (PROC (TEXT CONST) insert if picfile,ALL myself); + all myself picfiles +END PROC picfiles; + +PROC insert if picfile (TEXT CONST filename): + IF type (old (filename)) = picfiletype + THEN insert (all myself picfiles,filename) + FI +END PROC insert if picfile; + +PROC generate plot manager: + TASK VAR plot manager; + IF exists (initfile) + THEN generate in background + ELSE errorstop ("""" + init file + """ existiert nicht") + FI. + + generate in background: + begin (plot manager name,PROC init plot manager, plot manager); + INT VAR manager call; + DATASPACE VAR initspace; + TASK VAR order task; + REP + wait (initspace, manager call, order task) + UNTIL order task = plot manager PER; + initspace := old (initfile); + send (plot manager, ack, initspace); + say ("Plot-Manager wird generiert"13""10""); + say ("Bitte etwas Geduld..."13""10""); + REP + wait (initspace, manager call, order task) + UNTIL order task = plot manager PER; + forget (initspace); + say ("Plotmanager generiert !"13""10"") +END PROC generate plot manager; + +PROC init plot manager: + DATASPACE VAR initspace :: nilspace; + INT VAR dummy; + call (father, fetch code, initspace, dummy); + copy (init space,init file); + insert (init file); + send (father,ack,initspace); + do ("plot manager"); +END PROC init plot manager; + +TASK PROC plot id (PLOTTER CONST plotter id): + IF plotter id = no plotter + THEN task (plot manager name) + ELSE station (plotter id)/plot manager name + FI +END PROC plot id; + +TEXT PROC id name (PLOTTER CONST plotter id): + text (station (plotter id)) + "/" + text (channel (plotter id)) + "/" + + name (plotter id) +END PROC id name; + +END PACKET plot interface; + +(************************* Plot Picture / Picfile *************************) + +PACKET plot DEFINES plot : + +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + move cm key = 6, + draw cm key = 7, + move cm r key = 8, + draw cm r key = 9, + bar key = 10, + circle key = 11; + +LET postfix = ".PICFILE" + +INT VAR read pos; + +PROC plot (TEXT CONST name) : + PICFILE VAR p :: old (name); + IF channel <> channel (plotter) OR station (myself) <> station (plotter) + THEN save (name, plotter) + ELSE plot (p) + FI +END PROC plot; + +PROC plot (PICFILE VAR p) : + IF channel <> channel (plotter) OR station(myself) <> station(plotter) + THEN save (p, name (myself) + "." + text (highest entry (ALL plotter)) + + postfix, plotter) + ELSE direct plot + FI. + + direct plot: + ROW 3 ROW 2 REAL VAR sizes; + ROW 2 ROW 2 REAL VAR limits; + ROW 4 REAL VAR angles; + ROW 2 REAL VAR obliques; + ROW 3 REAL VAR perspectives; + get values (p,sizes,limits,angles,obliques,perspectives); + set values (sizes,limits,angles,obliques,perspectives); + begin plot; + clear; + INT VAR i; + FOR i FROM 1 UPTO pictures (p) + REP PICTURE VAR act pic :: nilpicture; + to pic (p,i); + read picture (p,act pic); + IF pen (act pic) <> 0 + THEN plot pic FI + PER; + end plot . + + plot pic: + INT VAR colour, thickness, linetype; + BOOL VAR hidden; + selected pen (p,pen (act pic),colour,thickness,linetype,hidden); + pen (background (p),colour,thickness,linetype); + hidden lines (hidden); + plot (act pic). + +END PROC plot; + +PROC plot (PICTURE CONST p) : + IF channel <> channel (plotter) OR station (myself) <> station (plotter) + THEN errorstop ("PICTURES koennen nur direkt ausgegeben werden") + ELSE plot pic + FI. + +plot pic: + INT CONST pic length :: length (p); + TEXT CONST points :: subtext (text(p),5); + read pos := 0; + IF dim (p) = 2 + THEN plot two dim pic + ELSE plot three dim pic FI . + +plot two dim pic: + WHILE read pos < pic length + REP plot two dim position PER . + +plot two dim position : + read pos INCR 1; + SELECT code (points SUB read pos) OF + CASE draw key : draw (next real, next real) + CASE move key : move (next real, next real) + CASE move r key : move r (next real, next real) + CASE draw r key : draw r (next real, next real) + CASE move cm key : move cm (next real, next real) + CASE draw cm key : draw cm (next real, next real) + CASE move cm r key : move cm r (next real, next real) + CASE draw cm r key : draw cm r (next real, next real) + CASE text key : draw (next text, next real, next real, next real) + CASE bar key : bar (next real, next real, next int) + CASE circle key : circle (next real, next real, next real, next int) + OTHERWISE errorstop ("wrong key code") END SELECT . + +plot three dim pic: + WHILE read pos < pic length + REP plot three dim position PER . + +plot three dim position : + read pos INCR 1; + SELECT code (points SUB read pos) OF + CASE draw key : draw (next real, next real, next real) + CASE move key : move (next real, next real, next real) + CASE move r key : move r (next real, next real, next real) + CASE draw r key : draw r (next real, next real, next real) + CASE move cm key : move cm (next real, next real) + CASE draw cm key : draw cm (next real, next real) + CASE move cm r key : move cm r (next real, next real) + CASE draw cm r key : draw cm r (next real, next real) + CASE text key : draw (next text, next real, next real, next real) + CASE bar key : bar (next real, next real, next int) + CASE circle key : circle (next real, next real, next real, next int) + OTHERWISE errorstop ("wrong key code") END SELECT . + +next real : + read pos INCR 8; + subtext (points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (points, read pos-1, read pos) ISUB 1 . + +next text : + INT CONST text length :: next int; + read pos INCR text length; + subtext (points, read pos-text length+1, read pos) . + +END PROC plot; + +END PACKET plot + diff --git a/app/mpg/2.2/src/GRAPHIK.Turtle b/app/mpg/2.2/src/GRAPHIK.Turtle new file mode 100644 index 0000000..efdacc7 --- /dev/null +++ b/app/mpg/2.2/src/GRAPHIK.Turtle @@ -0,0 +1,139 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.1 vom 10.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Turtle-Graphik" geschrieben von B.Jegerlehner *) +(* *) +(**************************************************************************) +(* *) +(* Dieses Paket stellt eine LOGO-aehnliche *) +(* 'Schildkroetengraphik' zur Verfuegung *) +(* *) +(**************************************************************************) +PACKET turtle graphics DEFINES begin turtle, + end turtle, + forward , + forward to , + turn , + turn to , + pen up , + pen down , + pen , + angle , + get turtle : + +REAL VAR x pos, + y pos, + winkel; + +PICFILE VAR bild; +PICTURE VAR pic; + +BOOL VAR direct, + pen status; + +PROC begin turtle: + direct := TRUE; + x pos := 0.0; + y pos := 0.0; + winkel := 0.0; + begin plot; + clear; + viewport (0.0, 1.0, 0.0, 1.0); + window (-500.0, 500.0, -500.0, 500.0); + pen up; + forward to (0.0, 0.0) +END PROC begin turtle; + +PROC begin turtle (TEXT CONST picfile): + direct := FALSE; + bild := picture file (picfile); + pic := nilpicture; + x pos := 0.0; + y pos := 0.0; + winkel := 0.0; + pen up; + forward to (0.0,0.0) +END PROC begin turtle; + +PROC end turtle: + IF direct + THEN end plot + ELSE ausgabe + FI. + + ausgabe: + REAL VAR x cm,y cm; + INT VAR dummy; + put picture (bild,pic); + drawing area (x cm,y cm,dummy,dummy); + viewport (bild, 0.0, 1.0, 0.0, 1.0); + window (bild, -500.0,500.0,-500.0,500.0); + plot(bild) +END PROC end turtle; + +PROC turn (REAL CONST w): + winkel := (winkel + w) MOD 360.0 +END PROC turn; + +PROC turn to (REAL CONST w): + winkel := w MOD 360.0 +END PROC turn to; + +REAL PROC angle: + winkel +END PROC angle; + +PROC forward (REAL CONST len): + forward to (x pos + cosd (winkel) * len, + y pos + sind (winkel) * len) +END PROC forward; + +PROC pen up: + pen status := FALSE +END PROC pen up; + +PROC pen down: + pen status := TRUE +END PROC pen down; + +BOOL PROC pen: + pen status +END PROC pen; + +PROC forward to (REAL CONST x,y): + IF direct + THEN dir plot + ELSE pic plot + FI; + x pos := x; + y pos := y. + + dir plot: + IF pen status + THEN draw (x,y) + ELSE move (x,y) + FI. + + pic plot: + IF length (pic) > 1923 + THEN put picture (bild,pic); + pic := nilpicture + FI; + IF pen status + THEN draw (pic,x,y) + ELSE move (pic,x,y) + FI +END PROC forward to; + +PROC get turtle (REAL VAR x,y): + x := x pos; + y := y pos +END PROC get turtle + +END PACKET turtle graphics + diff --git a/app/mpg/2.2/src/GRAPHIK.list b/app/mpg/2.2/src/GRAPHIK.list new file mode 100644 index 0000000..09f6002 --- /dev/null +++ b/app/mpg/2.2/src/GRAPHIK.list @@ -0,0 +1,28 @@ +GRAPHIK.list +GRAPHIK.Install +GRAPHIK.Basis +GRAPHIK.Configurator +GRAPHIK.Plot +GRAPHIK.Manager +GRAPHIK.Fkt +GRAPHIK.Turtle +ZEICHENSATZ +FKT.help +Muster +std primitives +matrix printer +terminal plot +DATAGRAPH 3/7.GCONF +VIDEOSTAR 3/6.GCONF +AMPEX 2/1-6.GCONF +NEC P-3 3/15.GCONF +WATANABE 3/8.GCONF +VC 404 2/7.GCONF +NEC P-9 2/15.HD.GCONF +NEC P-9 2/15.MD.GCONF +Atari 3/9.GCONF +AMPEX 3/1-4.GCONF +ENVIRONMENT2.GCONF +ENVIRONMENT3.GCONF + + diff --git a/app/mpg/2.2/src/HERCULES XT.GCONF b/app/mpg/2.2/src/HERCULES XT.GCONF new file mode 100644 index 0000000..a77a50e --- /dev/null +++ b/app/mpg/2.2/src/HERCULES XT.GCONF @@ -0,0 +1,105 @@ +INCLUDE "std primitives"; +INCLUDE "terminal plot" ; + +PLOTTER "HERCULES XT",1,1,720,348,24.5,18.5; + +COLORS "000999"; + +PROC clear: + INT VAR return; + REP + control(-5,512+0,0,return); + UNTIL return <> -1 + PER; + IF return <> 0 + THEN errorstop("Graphik nicht ansprechbar!") + FI; +END PROC clear; + +PROC prepare: + break(quiet); + REP disable stop; + continue (channel(plotter)); + clear error; + enable stop; + IF NOT online + THEN pause(100) + FI + UNTIL online PER; +END PROC prepare; + +PROC initplot: +END PROC initplot; + +PROC endplot: + INT VAR dummy; + pause; + control (-5,2,0, dummy); +END PROC endplot; + +PROC home: + moveto(0,347); +END PROC home; + +PROC moveto(INT CONST x,y): + INT VAR dummy; + control (-7,x,(347-y),dummy); (* move nach SHARD-AT *) +END PROC moveto; + +PROC set pixel(INT CONST x,y): + moveto(x,(347-y)); + point; +END PROC set pixel; + +PROC drawto(INT CONST x,y): + INT VAR dummy; + control(-6,x,(347-y),dummy); (* draw nach SHARD-AT *) +END PROC drawto; + +PROC foreground (INT VAR type): + ROW 5 ROW 4 INT CONST nibble :: ROW 5 ROW 4 INT: + (ROW 4 INT : ( 4369, 4369, 4369, 4369), (* durhgezogene Linie *) + ROW 4 INT : ( 17, 17, 17, 17), (* gepunktete Linie *) + ROW 4 INT : ( 4369, 0, 4369, 0), (* kurz gestrichelt *) + ROW 4 INT : ( 4369, 4369, 0, 0), (* lang gestrichelt *) + ROW 4 INT : ( 4369, 4369, 4369, 0)); (* gestrichpunktet *); + INT VAR dummy; + IF type > 5 OR type < 0 + THEN type := 0 + FI; + IF type = 0 + THEN control( -9, 0, 0, dummy); + control(-10, 0, 0, dummy); (* loeschen *) + ELSE control( -9, nibble[type][2], nibble[type][1], dummy); + control(-10, nibble[type][4], nibble[type][3], dummy) + FI; +END PROC foreground; + +PROC background(INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1,y1,x2,y2,pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): +END PROC fill; + + + + + + + + + + + diff --git a/app/mpg/2.2/src/Muster b/app/mpg/2.2/src/Muster new file mode 100644 index 0000000..cebb35c --- /dev/null +++ b/app/mpg/2.2/src/Muster @@ -0,0 +1,75 @@ +INCLUDE "Name der Include-Datei"; + +PLOTTER "Plottername",,,,,,; + +LINK /,/....; + +COLORS ""; + + . + . + . + + +PROC initplot: + Warnung: Da der Configurator den Prozedur-Rumpf in ein Refinement + verwandelt, muessen Namenskonflikte vermieden wrden ! +END PROC initplot; + +PROC endplot: +END PROC endplot; + +PROC prepare: +END PROC prepare; + +PROC clear: +END PROC clear; + +PROC home: +END PROC home; + +PROC moveto (INT CONST x,y): +END PROC moveto; + +PROC drawto (INT CONST x,y): +END PROC drawto; + +PROC setpixel (INT CONST x,y): +END PROC setpixel; + +PROC foreground (INT CONST type): +END PROC foreground; + +PROC background (INT CONST type): +END PROC background; + +PROC setpalette: +END PROC setpalette: + +PROC circle (INT CONST x,y,rad,from,to): +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): +END PROC box; + +PROC fill (INT CONST x,y,pattern): +END PROC fill; + +EDITOR; (* Durch EDITOR wird das optionale Vorhandensein nachfolgender + Editor-Befehle angezeigt *) + +PROC get cursor (INT VAR x,y,TEXT VAR exit char): +END PROC get cursor; + +PROC graphik cursor (INT CONST x,y,BOOL CONST on): +END PROC graphik cursor; + +PROC set marker (INT CONST x,y,type): +END PROC set marker; + + diff --git a/app/mpg/2.2/src/NEC P-3 3-15.GCONF b/app/mpg/2.2/src/NEC P-3 3-15.GCONF new file mode 100644 index 0000000..ecf052c --- /dev/null +++ b/app/mpg/2.2/src/NEC P-3 3-15.GCONF @@ -0,0 +1,126 @@ +INCLUDE "std primitives"; +INCLUDE "matrix printer"; + +PLOTTER "NEC P3",3,15,1024,1024,21.68,21.68; + +COLORS "000999"; + +(* Version vom 21.10.87 BJ *) + +(******** Hilfsvariablen fuer nec-plot ***************) +LET nec x pixel = 1024,nec y pixel d 16 = 64; +LET nec y max = 1023; +LET BITLINE = ROW nec x pixel INT; +BOUND ROW nec y pixeld16 BITLINE VAR nec map; +BITLINE VAR nec nilline; +DATASPACE VAR nec ds; +INT VAR nec x,nec y; +(*****************************************************) + +PROC prepare: + call (29, "", printer); (* wait for halt *) + continue (channel (plotter)) +END PROC prepare; + +PROC initplot: + INT VAR nec i; + FOR nec i FROM 1 UPTO nec x pixel REP + nec nilline[nec i] := 0 + PER; + forget(nec ds); + nec ds := nilspace; + nec map := nec ds; + disable stop +END PROC initplot; + +PROC endplot: + out(""27"T16"); + INT VAR nec i; + FOR nec i FROM 1 UPTO necypixeld16 REP + nec out line (nec i) + PER; + out(""12""); + break(quiet); + call (26,"",printer); (* start spool *) + enable stop +END PROC endplot; + +PROC nec out line (INT CONST i): + INT VAR c,j :: 1,d; + WHILE j <= nec x pixel REP + c := nec map[i][j]; + d := 0; + WHILE j <= nec x pixel CAND nec map[i][j] = c REP + j INCR 1; + d INCR 1 + PER; + IF j <= nec x pixel OR c <> 0 + THEN TEXT VAR t :: text(d,4); + change all(t," ","0"); + INT VAR kk :: c;rotate(kk,8); + out(""27"W"+t+code(c AND 255) + code(kk AND 255)) + FI + PER; + out(""13""10"") +END PROC nec out line; + +PROC clear: + INT VAR nec i; + FOR nec i FROM 1 UPTO nec y pixeld16 REP + nec map[nec i] := nec nilline + PER +END PROC clear; + +PROC home: + move to (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + nec x := x; + nec y := y +END PROC moveto; + +PROC drawto (INT CONST x,y): + printer line (nec x+1, nec y max - nec y,x+1,nec y max - y, + PROC (INT CONST, INT CONST) nec p3 set pixel); + nec x:=x;nec y:=y +END PROC drawto; + +PROC setpixel (INT CONST x,y): + setbit(nec map[(nec y max-y) DIV 16 + 1][x+1],(nec y max-y) AND 15) +END PROC setpixel; + +PROC nec p3 set pixel (INT CONST x,y): + set bit(nec map[y DIV 16 + 1][x],y AND 15) +END PROC nec p3 set pixel; + +BOOL PROC nec p3 is pixel (INT CONST x,y): + bit (nec map[y DIV 16 + 1][x],y AND 15) +END PROC nec p3 is pixel; + +PROC foreground (INT VAR type): + type := 1; (* Nur Schwarz auf Weiss-Druck moeglich *) +END PROC foreground; + +PROC background (INT VAR type): + type := 0; +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1, y1, x2, y2, pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): + printer fill (x,x,nec y max - y,1, + BOOL PROC (INT CONST, INT CONST) nec p3 is pixel, + PROC (INT CONST, INT CONST) nec p3 set pixel) +END PROC fill; + + diff --git a/app/mpg/2.2/src/NEC P-6 MD.GCONF b/app/mpg/2.2/src/NEC P-6 MD.GCONF new file mode 100644 index 0000000..627ec31 --- /dev/null +++ b/app/mpg/2.2/src/NEC P-6 MD.GCONF @@ -0,0 +1,221 @@ +INCLUDE "std primitives"; +INCLUDE "matrix printer"; + +PLOTTER "NEC P6 MD",1,15,1416,1760,20.00,25.00; + +COLORS "000999"; + +(* Version vom 21.10.87 BJ/26.11.SvA *) + +(* Globale Daten fuer NEC P6 *) + +LET md p9 graf = ""27"*"39"", (* Nec P9 in 24-Nadel 180 Pixel/zoll Modus *) + md p9 feed = ""28"3", (* Zeilenabstand in 360 Pixel/Zoll setzen *) + md p9 nlq = ""27"x"1"", (* NLQ Modus waehlen *) + md p9 pos = ""27"\"; (* in 1/180 Zoll-Schritten rel Positionieren *) + +LET md p9 x max = 1416, + md p9 y max = 1760, + md p9 y lines = 110, (* y pixel / 16 (Punkte pro INT) *) + md p9 x per ds= 596, (* Maximale x pixel pro Dataspace ( Darf *) + (* Nicht mehr als 256 K sein !!! *) + (* x per ds = 256 * 1024 / p9 y lines / 4 *) + md p9 x lines = 3; (* x pixel / hd p9 x per ds *) + +LET MDPYLINE = ROW md p9 x per ds INT, + MDPSMAP = ROW md p9 y lines MDPYLINE, + MDPMAP = ROW md p9 x lines BOUND MDPSMAP; + +MDPMAP VAR md p9 map; + +ROW md p9 x lines DATASPACE VAR md p9 ds; + +INT VAR md p9 x pos, md p9 y pos; + +(* Globale Daten Ende *) + +PROC prepare: + REP + call (29, "", printer); (* wait for halt *) + IF task(channel(plotter)) = niltask (* Es koennte der HD worker dran sein *) + THEN continue (channel (plotter)) (* der startet den PRINTER wieder ! *) + ELSE pause(300) (* folge : Kanal belegt -> dead *) + FI + UNTIL channel(myself) = channel(plotter) PER +END PROC prepare; + +PROC initplot: + INT VAR md p9 i; + FOR md p9 i FROM 1 UPTO md p9 x lines REP + md p9 ds[md p9 i] := nilspace; + md p9 map[md p9 i] := md p9 ds[md p9 i] + PER +END PROC initplot; + +PROC endplot: + md p9 put map; + break(quiet); + call (26, "", printer); (* start spool *) + enable stop +END PROC endplot; + +PROC md p9 put map: + open graf; + put map; + close graf; + forget dataspaces. + + open graf: + out(md p9 feed + ""32""); (* LF auf 16/180 Zoll setzen *) + out(md p9 nlq). (* NLQ Modus waehlen, damit Positionierung in 1/180 *) + (* Schritten geht (sonst 1/120) *) + close graf: + out(""12""). (* Form Feed ! Drucker muss auf richtige Seitenlaenge *) + (* eingestellt sein (EUMEL-DR macht kein FF) *) + + forget dataspaces: + INT VAR i; + FOR i FROM 1 UPTO md p9 x lines REP + forget(md p9 ds[i]) + PER. + + put map: + INT VAR j; + FOR j FROM 1 UPTO md p9 y lines REP + put line; + PER. + + put line: + INT VAR actual pos :: 0, (* actual pos : aktuelle x-position 0..x max*) + last pos; + WHILE actual pos <= md p9 x max REP + put blank cols; + put nonblank cols + PER; + line. + + put blank cols: + last pos := actual pos; + WHILE actual pos <= md p9 x max CAND actual col is blank REP + actual pos INCR 1 + PER; + IF actual pos > last pos AND actual pos <= md p9 x max + THEN out blank cols + FI. + + put nonblank cols: + last pos := actual pos; + WHILE actual pos <= md p9 x max CAND NOT actual col is blank REP + actual pos INCR 1 + PER; + IF actual pos > last pos + THEN out nonblank cols + FI. + + out blank cols: + TEXT VAR t :: " "; + replace(t, 1, actual pos - last pos); + out (md p9 pos + t). + + out nonblank cols: + t := " "; + replace (t,1, actual pos - last pos); + out(md p9 graf + t); + INT VAR k; + FOR k FROM last pos UPTO actual pos - 1 REP + INT VAR word :: md p9 map [(k DIV md p9 x per ds) + 1][j] + [(k MOD md p9 x per ds) + 1], + first byte :: word; + rotate (word, 8); + out (code (word)); + out (code (first byte)); + out (""0"") + PER. + + actual col is blank: + md p9 map [(actual pos DIV md p9 x per ds) + 1][j] + [(actual pos MOD md p9 x per ds) + 1] = 0 + +END PROC md p9 put map; + +PROC clear: + md p9 clear +END PROC clear; + +PROC md p9 clear: + create initline; + initialize all lines. + + create initline: + MDPYLINE VAR initline; + INT VAR i; + FOR i FROM 1 UPTO md p9 x per ds REP + initline[i] := 0 + PER. + + initialize all lines: + INT VAR k; + FOR i FROM 1 UPTO md p9 x lines REP + FOR k FROM 1 UPTO md p9 y lines REP + md p9 map[i][k] := initline + PER + PER +END PROC md p9 clear; + +PROC home: + move to (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + md p9 x pos := x; + md p9 y pos := y +END PROC moveto; + +PROC drawto (INT CONST x,y): + printer line (md p9 x pos,md p9 y max - md p9 y pos, + x, md p9 y max - y, + PROC (INT CONST, INT CONST) md p9 set pixel); + md p9 x pos := x; + md p9 y pos := y +END PROC drawto; + +PROC setpixel (INT CONST x,y): + md p9 set pixel (x, md p9 y max - x) +END PROC setpixel; + +PROC md p9 set pixel (INT CONST x,y): + setbit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] + [(x MOD md p9 x per ds) + 1],15 - (y AND 15)) +END PROC md p9 set pixel; + +BOOL PROC md p9 is pixel (INT CONST x,y): + bit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] + [(x MOD md p9 x per ds) + 1],15 - (y AND 15)) +END PROC md p9 is pixel; + +PROC foreground (INT VAR type): + type := 1 +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1, y1, x2, y2, pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): + printer fill (x,x,md p9 y max - y,1, + BOOL PROC (INT CONST, INT CONST) md p9 is pixel, + PROC (INT CONST, INT CONST) md p9 set pixel) +END PROC fill; + + diff --git a/app/mpg/2.2/src/NEC P-9 2-15.HD.GCONF b/app/mpg/2.2/src/NEC P-9 2-15.HD.GCONF new file mode 100644 index 0000000..552e298 --- /dev/null +++ b/app/mpg/2.2/src/NEC P-9 2-15.HD.GCONF @@ -0,0 +1,244 @@ +INCLUDE "std primitives"; +INCLUDE "matrix printer"; + +PLOTTER "NEC P9 HD",2,15,2880,2880,20.32,20.32; + +COLORS "000999"; + +(* Version vom 21.10.87 BJ *) + +(* Globale Daten fuer NEC P9 *) + +LET hd p9 graf = ""27"*"40"", (* Nec P9 in 24-Nadel 360 Pixel/zoll Modus *) + hd p9 feed = ""28"3", (* Zeilenabstand in 360 Pixel/Zoll setzen *) + hd p9 nlq = ""27"x"1"", (* NLQ Modus waehlen *) + hd p9 pos = ""27"\"; (* in 1/180 Zoll-Schritten rel Positionieren *) + +LET hd p9 x max = 2879, + hd p9 y max = 2879, + hd p9 y lines = 90, (* y pixel / 16 (Punkte pro INT) / 2 (Maps) *) + hd p9 x per ds= 1440, (* Maximale x pixel pro Dataspace ( Darf *) + (* Nicht mehr als 256 K sein !!! *) + (* x per ds = 256 * 1024 / p9 y lines / 4 *) + hd p9 x lines = 2; (* x pixel / hd p9 x per ds *) + +LET HDPYLINE = ROW hd p9 x per ds INT, + HDPSMAP = ROW hd p9 y lines HDPYLINE, + HDPMAP = ROW hd p9 x lines ROW 2 BOUND HDPSMAP; + +HDPMAP VAR hd p9 map; + +ROW hd p9 x lines ROW 2 DATASPACE VAR hd p9 ds; + +INT VAR hd p9 x pos, hd p9 y pos; + +(* Globale Daten Ende *) + +PROC prepare: + REP + call (29, "", printer); (* wait for halt *) + IF task(channel(plotter)) = niltask (* Es koennte der MD worker dran sein *) + THEN continue (channel (plotter)) (* Der startet den PRINTER wieder ! *) + ELSE pause(300) (* folge : Kanal belegt -> dead *) + FI + UNTIL channel(myself) = channel(plotter) PER +END PROC prepare; + +PROC initplot: + INT VAR hd p9 i,hd p9 j; + FOR hd p9 i FROM 1 UPTO hd p9 x lines REP + FOR hd p9 j FROM 1 UPTO 2 REP + hd p9 ds[hd p9 i][hd p9 j] := nilspace; + hd p9 map[hd p9 i][hd p9 j] := hd p9 ds[hd p9 i][hd p9 j] + PER + PER +END PROC initplot; + +PROC endplot: + hd p9 put map; + break(quiet); + call (26, "", printer); (* start spool *) + enable stop +END PROC endplot; + +PROC hd p9 put map: + open graf; + put map; + close graf; + forget dataspaces. + + open graf: + out(hd p9 nlq). (* NLQ Modus waehlen, damit Positionierung in 1/180 *) + (* Schritten geht (sonst 1/120) *) + close graf: + out(""12""). (* Form Feed ! Drucker muss auf richtige Seitenlaenge *) + (* eingestellt sein (EUMEL-DR macht kein FF) *) + + forget dataspaces: + INT VAR i; + FOR i FROM 1 UPTO hd p9 x lines REP + FOR j FROM 1 UPTO 2 REP + forget(hd p9 ds[i][j]) + PER + PER. + + put map: + INT VAR j,half; + FOR j FROM 1 UPTO hd p9 y lines REP + FOR half FROM 1 UPTO 2 REP + open line; + put half line; + close line + PER + PER. + + open line: + INT VAR actual pos :: 0, (* aktuelle x-pos 0..x max *) + last pos. + + close line: + out(hd p9 feed); + IF half = 1 + THEN out (""1"") (* LF 1/360 Zoll *) + ELSE out (""31"") + FI; + line. + + put half line: + WHILE actual pos <= hd p9 x max REP + put blank cols; + put nonblank cols + PER. + + put blank cols: + last pos := actual pos; + WHILE actual pos <= hd p9 x max CAND actual col is blank REP + actual pos INCR 1 + PER; + IF actual pos > last pos AND actual pos <= hd p9 x max + THEN out blank cols + FI. + + put nonblank cols: + last pos := actual pos; + WHILE actual pos <= hd p9 x max CAND NOT actual col is blank REP + actual pos INCR 1 + PER; + IF actual pos > last pos + THEN out nonblank cols + FI. + + out blank cols: + IF actual pos - last pos > 1 + THEN TEXT VAR t :: " "; + replace(t, 1, (actual pos - last pos) DIV 2); + out (hd p9 pos + t) + FI; + IF (actual pos - last pos) MOD 2 = 1 + THEN out (hd p9 graf + ""1""0"" + 3 * ""0"") + FI. + + out nonblank cols: + t := " "; + replace (t,1, actual pos - last pos); + out(hd p9 graf + t); + INT VAR k; + FOR k FROM last pos UPTO actual pos - 1 REP + INT VAR word :: hd p9 map [(k DIV hd p9 x per ds) + 1][half][j] + [(k MOD hd p9 x per ds) + 1], + first byte :: word; + rotate (word, 8); + out (code (word)); + out (code (first byte)); + out (""0"") + PER. + + actual col is blank: + hd p9 map [(actual pos DIV hd p9 x per ds) + 1][half][j] + [(actual pos MOD hd p9 x per ds) + 1] = 0 + +END PROC hd p9 put map; + +PROC clear: + hd p9 clear +END PROC clear; + +PROC hd p9 clear: + create initline; + initialize all lines. + + create initline: + HDPYLINE VAR initline; + INT VAR i; + FOR i FROM 1 UPTO hd p9 x per ds REP + initline[i] := 0 + PER. + + initialize all lines: + INT VAR j,k; + FOR i FROM 1 UPTO hd p9 x lines REP + FOR j FROM 1 UPTO 2 REP + FOR k FROM 1 UPTO hd p9 y lines REP + hd p9 map[i][j][k] := initline + PER + PER + PER +END PROC hd p9 clear; + +PROC home: + move to (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + hd p9 x pos := x; + hd p9 y pos := y +END PROC moveto; + +PROC drawto (INT CONST x,y): + printer line (hd p9 x pos,hd p9 y max - hd p9 y pos, + x, hd p9 y max - y, + PROC (INT CONST, INT CONST) hd p9 set pixel); + hd p9 x pos := x; + hd p9 y pos := y +END PROC drawto; + +PROC setpixel (INT CONST x,y): + hd p9 set pixel (x, hd p9 y max - x) +END PROC setpixel; + +PROC hd p9 set pixel (INT CONST x,y): + setbit (hd p9 map [(x DIV hd p9 x per ds) + 1][(y AND 1) + 1][(y DIV 32) + 1] + [(x MOD hd p9 x per ds) + 1],15 - ((y DIV 2) AND 15)) +END PROC hd p9 set pixel; + +BOOL PROC hd p9 is pixel (INT CONST x,y): + bit (hd p9 map [(x DIV hd p9 x per ds) + 1][(y AND 1) + 1][(y DIV 32) + 1] + [(x MOD hd p9 x per ds) + 1],15 - ((y DIV 2) AND 15)) +END PROC hd p9 is pixel; + +PROC foreground (INT VAR type): + type := 1 +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1, y1, x2, y2, pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): + printer fill (x,x, hd p9 y max - y, 1, + BOOL PROC (INT CONST, INT CONST) hd p9 is pixel, + PROC (INT CONST, INT CONST) hd p9 set pixel) +END PROC fill; + + diff --git a/app/mpg/2.2/src/NEC P-9 2-15.MD.GCONF b/app/mpg/2.2/src/NEC P-9 2-15.MD.GCONF new file mode 100644 index 0000000..5a5fa03 --- /dev/null +++ b/app/mpg/2.2/src/NEC P-9 2-15.MD.GCONF @@ -0,0 +1,221 @@ +INCLUDE "std primitives"; +INCLUDE "matrix printer"; + +PLOTTER "NEC P9 MD",2,15,2340,1984,33.02,27.99644; + +COLORS "000999"; + +(* Version vom 21.10.87 BJ *) + +(* Globale Daten fuer NEC P9 *) + +LET md p9 graf = ""27"*"39"", (* Nec P9 in 24-Nadel 180 Pixel/zoll Modus *) + md p9 feed = ""28"3", (* Zeilenabstand in 360 Pixel/Zoll setzen *) + md p9 nlq = ""27"x"1"", (* NLQ Modus waehlen *) + md p9 pos = ""27"\"; (* in 1/180 Zoll-Schritten rel Positionieren *) + +LET md p9 x max = 2339, + md p9 y max = 1979, + md p9 y lines = 124, (* y pixel / 16 (Punkte pro INT) *) + md p9 x per ds= 780, (* Maximale x pixel pro Dataspace ( Darf *) + (* Nicht mehr als 256 K sein !!! *) + (* x per ds = 256 * 1024 / p9 y lines / 4 *) + md p9 x lines = 3; (* x pixel / hd p9 x per ds *) + +LET MDPYLINE = ROW md p9 x per ds INT, + MDPSMAP = ROW md p9 y lines MDPYLINE, + MDPMAP = ROW md p9 x lines BOUND MDPSMAP; + +MDPMAP VAR md p9 map; + +ROW md p9 x lines DATASPACE VAR md p9 ds; + +INT VAR md p9 x pos, md p9 y pos; + +(* Globale Daten Ende *) + +PROC prepare: + REP + call (29, "", printer); (* wait for halt *) + IF task(channel(plotter)) = niltask (* Es koennte der HD worker dran sein *) + THEN continue (channel (plotter)) (* der startet den PRINTER wieder ! *) + ELSE pause(300) (* folge : Kanal belegt -> dead *) + FI + UNTIL channel(myself) = channel(plotter) PER +END PROC prepare; + +PROC initplot: + INT VAR md p9 i; + FOR md p9 i FROM 1 UPTO md p9 x lines REP + md p9 ds[md p9 i] := nilspace; + md p9 map[md p9 i] := md p9 ds[md p9 i] + PER +END PROC initplot; + +PROC endplot: + md p9 put map; + break(quiet); + call (26, "", printer); (* start spool *) + enable stop +END PROC endplot; + +PROC md p9 put map: + open graf; + put map; + close graf; + forget dataspaces. + + open graf: + out(md p9 feed + ""32""); (* LF auf 16/180 Zoll setzen *) + out(md p9 nlq). (* NLQ Modus waehlen, damit Positionierung in 1/180 *) + (* Schritten geht (sonst 1/120) *) + close graf: + out(""12""). (* Form Feed ! Drucker muss auf richtige Seitenlaenge *) + (* eingestellt sein (EUMEL-DR macht kein FF) *) + + forget dataspaces: + INT VAR i; + FOR i FROM 1 UPTO md p9 x lines REP + forget(md p9 ds[i]) + PER. + + put map: + INT VAR j; + FOR j FROM 1 UPTO md p9 y lines REP + put line; + PER. + + put line: + INT VAR actual pos :: 0, (* actual pos : aktuelle x-position 0..x max*) + last pos; + WHILE actual pos <= md p9 x max REP + put blank cols; + put nonblank cols + PER; + line. + + put blank cols: + last pos := actual pos; + WHILE actual pos <= md p9 x max CAND actual col is blank REP + actual pos INCR 1 + PER; + IF actual pos > last pos AND actual pos <= md p9 x max + THEN out blank cols + FI. + + put nonblank cols: + last pos := actual pos; + WHILE actual pos <= md p9 x max CAND NOT actual col is blank REP + actual pos INCR 1 + PER; + IF actual pos > last pos + THEN out nonblank cols + FI. + + out blank cols: + TEXT VAR t :: " "; + replace(t, 1, actual pos - last pos); + out (md p9 pos + t). + + out nonblank cols: + t := " "; + replace (t,1, actual pos - last pos); + out(md p9 graf + t); + INT VAR k; + FOR k FROM last pos UPTO actual pos - 1 REP + INT VAR word :: md p9 map [(k DIV md p9 x per ds) + 1][j] + [(k MOD md p9 x per ds) + 1], + first byte :: word; + rotate (word, 8); + out (code (word)); + out (code (first byte)); + out (""0"") + PER. + + actual col is blank: + md p9 map [(actual pos DIV md p9 x per ds) + 1][j] + [(actual pos MOD md p9 x per ds) + 1] = 0 + +END PROC md p9 put map; + +PROC clear: + md p9 clear +END PROC clear; + +PROC md p9 clear: + create initline; + initialize all lines. + + create initline: + MDPYLINE VAR initline; + INT VAR i; + FOR i FROM 1 UPTO md p9 x per ds REP + initline[i] := 0 + PER. + + initialize all lines: + INT VAR k; + FOR i FROM 1 UPTO md p9 x lines REP + FOR k FROM 1 UPTO md p9 y lines REP + md p9 map[i][k] := initline + PER + PER +END PROC md p9 clear; + +PROC home: + move to (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + md p9 x pos := x; + md p9 y pos := y +END PROC moveto; + +PROC drawto (INT CONST x,y): + printer line (md p9 x pos,md p9 y max - md p9 y pos, + x, md p9 y max - y, + PROC (INT CONST, INT CONST) md p9 set pixel); + md p9 x pos := x; + md p9 y pos := y +END PROC drawto; + +PROC setpixel (INT CONST x,y): + md p9 set pixel (x, md p9 y max - x) +END PROC setpixel; + +PROC md p9 set pixel (INT CONST x,y): + setbit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] + [(x MOD md p9 x per ds) + 1],15 - (y AND 15)) +END PROC md p9 set pixel; + +BOOL PROC md p9 is pixel (INT CONST x,y): + bit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] + [(x MOD md p9 x per ds) + 1],15 - (y AND 15)) +END PROC md p9 is pixel; + +PROC foreground (INT VAR type): + type := 1 +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1, y1, x2, y2, pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): + printer fill (x,x,md p9 y max - y,1, + BOOL PROC (INT CONST, INT CONST) md p9 is pixel, + PROC (INT CONST, INT CONST) md p9 set pixel) +END PROC fill; + + diff --git a/app/mpg/2.2/src/PUBLIC.insert b/app/mpg/2.2/src/PUBLIC.insert new file mode 100644 index 0000000..9fb98a6 --- /dev/null +++ b/app/mpg/2.2/src/PUBLIC.insert @@ -0,0 +1,3412 @@ +(* Rainer Kottmann *) +(* Klaus Bovermann *) +(* Lutz Prechelt *) +(* Carsten Weinholz *) +(* 19.06.87 *) + +(* Pakete : 1. mpg test elan programs + 2. mpg archive system <--- ************************** + 3. mpg some <--- Sind für seperaten Hamster + 4. mpg dm <--- notwendig. + 5. mpg tools <--- ************************** + 6. mpg target handling + 7. mpg print cmd + 8. edit monitor + 9. mpg global manager *) + +(************************* ELAN TEST ****************************) + +PACKET mpg test elan programs DEFINES elan test : + +LET scan end = 7, + in comment = 8, + in text = 9, + bold = 2, + char = 4, + delimiter = 6, + limit = 77, + max denoter length = 255, + end bolds = "ENDIFIENDSELECTENDREPEATPERENDPROCEDURENDPACKETENDOP", + w = "WARNING: ", + e = "ERROR : "; + +INT VAR zeile; +FILE VAR err; +TEXT VAR last error; + + +PROC elan test : + elan test (last param) +END PROC elan test; + +PROC elan test (TEXT CONST datei) : + INT VAR byte :: 0, kbyte :: 0, (* Byte/Kilobyte der EUMEL Datei *) + sbyte:: 0, skbyte:: 0, (* Byte/Kilobyte des Elan Quelltextes *) + denoter length :: 0, units :: 0, typ, scan operations :: 0, + round brackets :: 0, square brackets :: 0; (* Klammerzaehler *) + TEXT VAR in, symbol; + FILE VAR inputfile :: sequential file (input , datei); + err := note file; + zeile := 0; + last error := ""; + scan (""); next symbol (in); + WHILE NOT eof (inputfile) REP + naechste zeile; + analyse; + in := incharety + UNTIL in <> "" PER; + IF in <> "" + THEN putline (err, "*** ELAN TEST VORZEITIG ABGEBROCHEN ***") FI; + last error := ""; + ausgabe der enddaten; + modify (inputfile); + note edit (inputfile); + line. + +naechste zeile : + getline (inputfile , in); + continue scan (in); + byte INCR LENGTH in; + kbyte INCR byte DIV 1000; + byte := byte MOD 1000; + zeile INCR 1; cout (zeile); + IF LENGTH in > limit + THEN error (w + "line exceeding screen") + FI. + +analyse : + REPEAT + next symbol (symbol, typ); + scan operations INCR 1; + analysiere symbol + UNTIL typ >= scan end + PER; + IF typ = in comment + THEN error (w + "comment exceeding line") + FI; + IF typ = in text + THEN denoter length INCR LENGTH symbol; + IF denoter length > max denoter length + THEN error (e + "text denoter too long (" + text (denoter length) + + " characters)") + ELSE error (w + "text denoter exceeding source line") + FI + ELSE denoter length := 0 + FI; + skbyte INCR sbyte DIV 1000; + sbyte := sbyte MOD 1000. + +analysiere symbol : + IF typ = scan end THEN test brackets + ELIF typ = delimiter THEN delimiters + ELIF typ = char + THEN denoter length INCR LENGTH symbol; + IF denoter length > max denoter length + THEN error (e + "text denoter too long (" + text (denoter length) + + " characters)") + FI + ELIF typ = bold CAND pos (endbolds, symbol) <> 0 + THEN unitend + FI; + sbyte INCR LENGTH symbol. + +test brackets : + IF round brackets <> 0 + THEN error (w + text (round brackets) + " ""("" open") + FI; + IF square brackets <> 0 + THEN error (w + text (square brackets) + " ""["" open") + FI. + +delimiters : + IF symbol = ";" OR (symbol = "." AND is refinement) + THEN unitend + ELIF symbol = "(" THEN round brackets INCR 1 + ELIF symbol = ")" THEN round brackets DECR 1 + ELIF symbol = "[" THEN square brackets INCR 1 + ELIF symbol = "]" THEN square brackets DECR 1 + FI. + +unitend : + units INCR 1; + IF round brackets <> 0 + THEN error (e + text (round brackets) + " ""("" open at end of unit"); + round brackets := 0 + FI; + IF square brackets <> 0 + THEN error (e + text (square brackets) + " ""["" open at end of unit"); + square brackets := 0 + FI. + +is refinement : FALSE. (* vorlaeufig *) + +ausgabe der enddaten : + line (err); + putline (err, 77 * "="); + putline (err, "EUMEL - Datei : " + text (zeile) + " Zeilen , " + + bytes (kbyte, byte)); + putline (err, "Elan - Quelltext : " + text (units) + " Units , " + + bytes (skbyte, sbyte)); + putline (err, text (scan operations) + + " Scanner - Operationen durchgefuehrt."); + putline (err, 77 * "="). +END PROC elan test; + +PROC error (TEXT CONST error message) : + IF error message = last error + THEN putline (err, "dito " + text (zeile)); + IF online THEN put (zeile); putline ("dito") FI; + LEAVE error FI; + last error := error message; + putline (err, "EOLN " + text (zeile) + " " + error message); + IF online THEN put (zeile); putline (error message) FI +END PROC error; + +TEXT PROC bytes (INT CONST kilobytes, bytes) : + TEXT VAR t :: text (kilobytes); + IF bytes < 10 THEN t CAT "00" + ELIF bytes < 100 THEN t CAT "0" + FI; + t CAT text (bytes); + t CAT " Byte"; + t +END PROC bytes + +END PACKET mpg test elan programs; + +(************************* ARCHIV **********************************) + +PACKET mpg archive system DEFINES reserve, archive, release, + archiv, archiv name,archiv error, + archiv angemeldet, + from, to, + pla : + + +LET archive 0 code = 90, + archive 1 code = 91, + altos archive 0 = 0, + altos archive 1 = 1, + bicos archive 0 = 2, + altos station = 1, + free code = 20, + reserve code = 19, + type = "#type (""micron"")#", + configurator = "configurator"; + +BOOL VAR angemeldet; +TEXT VAR err :: ""; + +(************************ Standard - Prozeduren ****************************) +(* Erlaubt jedoch nur eine ARCHIVE-Task *) + +PROC reserve (TASK CONST task): + reserve ("", task) +END PROC reserve; + +PROC reserve (TEXT CONST msg, TASK CONST task): + IF task = archive + THEN angemeldet := TRUE + FI; + call (reserve code, msg, task) +END PROC reserve; + +PROC archive (TEXT CONST name): + reserve (name, archive) +END PROC archive; + +PROC archive (TEXT CONST name, INT CONST station): + reserve (name,station/archive) +END PROC archive; + +PROC archive (TEXT CONST name, TASK CONST task): + reserve (name, task) +END PROC archive; + +PROC release (TASK CONST task): + call (free code, "", task); + IF task = archive + THEN angemeldet := FALSE + FI +END PROC release; + +PROC release : + release (archive); +END PROC release; + +PROC archiv (INT CONST nr): + SELECT nr OF + CASE altos archive 0, altos archive 1: altos anmelden + CASE bicos archive 0 : archiv + OTHERWISE unbekannte laufwerksnummer + END SELECT. + + altos anmelden: + IF station (myself) <> altos station + THEN unbekannte laufwerksnummer + ELSE reserve (archive); + SELECT nr OF + CASE altos archive 0: call (archive 0 code, "",task(configurator)) + CASE altos archive 1: call (archive 1 code, "",task(configurator)) + END SELECT; + archiv + FI. + + unbekannte laufwerksnummer: + errorstop ("Unbekannte Laufwerksnummer") +END PROC archiv; + +PROC archiv : + angemeldet := TRUE; + TEXT CONST name :: archiv name; + IF err = "" + THEN display ("Gefundenes Archiv: """ + name + """"); + ELSE errorstop (err) + FI; + display (""13""10""). + +END PROC archiv; + +BOOL PROC archiv angemeldet: + angemeldet +END PROC archiv angemeldet; + +TEXT PROC archiv name: + TEXT VAR name :: ""; + THESAURUS VAR th; + IF NOT angemeldet + THEN errorstop ("Archiv nicht angemeldet");"" + ELSE angemeldet := FALSE; + err := ""; + disable stop; + archive (""); + IF is error + THEN err := errormessage; + LEAVE archiv name WITH "" + FI; + th := ALL archive; + richtigen namen suchen; + clear error; + enable stop; + archive (name); + angemeldet := TRUE; + name + FI. + +richtigen namen suchen: + IF subtext (error message, 1, 13) = "Archiv heisst" + THEN name := subtext (error message, 16, LENGTH error message - 1) + ELSE err := error message + FI +END PROC archiv name; + +TEXT PROC archiv error: + err +END PROC archiv error; + +PROC from (TEXT CONST name) : + fetch (name, archive) +END PROC from; + +PROC to (TEXT CONST name) : + BOOL CONST cd :: command dialogue; + command dialogue (FALSE); + save (name, archive); + command dialogue (cd) +END PROC to; + +PROC to : + to (last param) +END PROC to; + +PROC from (THESAURUS CONST nameset): + fetch (nameset, archive) +END PROC from; + +PROC to (THESAURUS CONST nameset): + BOOL CONST cd :: command dialogue; + command dialogue (FALSE); + save (nameset, archive); + command dialogue (cd) +END PROC to; + +PROC pla: + LET dummy name pos = 18; + + FILE VAR listfile; + INT VAR i; + TEXT CONST head :: 70 * "=", + end :: 70 * "_"; + TEXT VAR record; + WHILE yes ("Archiv eingelegt") REP + print archive listing + PER; + release. + +print archive listing: + archiv; + listfile := sequential file (output , "PLA"); + list (listfile, archive); + print head; + erase dummy names; + print bottom; + print and erase listing. + +print head : + modify (listfile); + to line (listfile, 1); + FOR i FROM 1 UPTO 6 REP + insert record (listfile) + PER; + to line (listfile, 1); + write record (listfile, type); down (listfile); + write record (listfile, head); down (listfile); + write record (listfile, "ARCHIVNAME: "+headline (listfile) + " " + + time of day +" " + date ); down (listfile); + write record (listfile, head); down (listfile); + write record (listfile, " "); down (listfile); + write record (listfile, "Date Store Contents"). + +erase dummy names : + to line (listfile, 6); + WHILE NOT eof (listfile) REP + read record (listfile, record); + IF (record SUB dummy name pos) = "-" + THEN delete record (listfile) + ELSE down (listfile) + FI + PER. + +print bottom : + output (listfile); + putline (listfile, end). + +print and erase listing : + modify (listfile); + edit (listfile); + line (3); + IF yes ("Archivlisting drucken") + THEN print ("PLA") + FI; + forget ("PLA", quiet) +END PROC pla + +END PACKET mpg archive system; + +(************************ MPG SOME TOOLS *********************) + +PACKET mpg some (*************************) + (* Klaus Bovermann *) + (* Andreas Dieckmann *) + (* Thomas Clermont *) + (* Version 3.2 *) + (* EUMEL 1.8.1 *) + (* Datum: 21.10.87 *) + (*************************) + +DEFINES some, SOME, (* in mehreren Versionen *) + one, (* in mehreren Versionen *) + inchar, (* *) + center, (* Hilfsroutinen *) + invers , (* *) + edit some, (* fuer Anfaenger *) + edit one, (* fuer Anfaenger *) + + reorganize: (* auf Thesaurus *) + +LET max bild laenge = 80; + +TEXT PROC center (TEXT CONST n): + center (n," ",max bild laenge - 1) +END PROC center; + +TEXT PROC center (TEXT CONST n,fuell zeichen,INT CONST max text laenge): + TEXT VAR fuell text :: + ((max text laenge - length (n)) DIV 2) * fuell zeichen; + fuelltext CAT (n + fuelltext); + IF (LENGTH fuelltext) - max text laenge = 0 + THEN fuelltext + ELSE fuelltext + fuellzeichen + FI +END PROC center; + +TEXT PROC invers (TEXT CONST n): + mark ein + n + " " + mark aus +END PROC invers; + +PROC inchar (TEXT VAR t, TEXT CONST allowed chars): + enable stop; + REP getchar (t); (* Auslesen nur aus virtuellem Puffer *) + IF pos (allowed chars,t) = 0 + THEN out (""7"") + FI + UNTIL pos (allowed chars,t) <> 0 PER +END PROC inchar; + +(*********************************************************************) + +LET min zeilen = 3, + bildschirm = 24, + min x size = 30, + max entries = 200; + +LET trennzeichen = ""222"", (* ESC # *) + zeichenstring = ""1""27""3""10""13"x"12"o?"11"", + oben unten rubout o return x = ""3""10""12"o"13"x", + q eins neun a return x rubout o s = "q19a"13"x"12"os"; + +LET mark ein = ""15"", + mark aus = ""14""; + +LET stdtext1 = "Auswahl einer Datei ", + stdtext2 = "Auswahl mehrerer Dateien ", + stdhelp = "( Bei Unklarheiten bitte )"; + +LET hop = 1, + esc = 2, + obe = 3, + unt = 4, + ank = 5, + ank 1 = 6, + aus = 7, + aus 1 = 8, + fra = 9, + ins = 10; + +LET filetype = 1003; + +INT VAR anzahl, begin x,begin y, + kopf zeilen , size x,size y, + max eintraege, + realc, + virtc; + +TEXT VAR string, + weitertext, + niltext, + kopfzeilen text, + kz1, + kz2; + +BOOL VAR raender, + auswahlende, + abbruch; + +ROW max entries TEXT VAR eintrag; + +THESAURUS VAR gesamt liste; +FILE VAR tools info; +DATASPACE VAR tools info ds; + +INITFLAG VAR init tools info; + +(******************* Grundlegende Prozedur *************************) + +THESAURUS PROC einzelne (THESAURUS CONST t, BOOL CONST viele, + TEXT CONST k1, + INT CONST x begin,y begin, + x size ,y size): + begin x := x begin; + begin y := y begin; + size x := x size; + size y := y size; + kz1 := k1; + string := ""; + raender := FALSE; + gen kopf zeilen; + IF groesster editor > 0 + THEN INT VAR x,y; + get edit cursor (x,y) ; + IF bildschirm - kopfzeilen - min zeilen + 1 < y + THEN begin y := 1; + size y := 24; + begin x := 1; + size x := 79 + ELSE begin y := y; + size y := bildschirm - y + 1; + max eintraege := size y - min zeilen - kopfzeilen; + IF (80 - x) < min x size OR col = 1 + THEN begin x := 1; + size x := 79 + ELSE raender := TRUE; + begin x := x; + size x := 80 - x - 2 + FI + FI; + gen kopfzeilen + FI; + IF (size y - kopf zeilen) < min zeilen OR + begin y < 0 OR + (begin y + size y - 1) > bildschirm OR + (begin x + size x - 1) > 79 + THEN errorstop ("Fenster zu klein") + FI; + init weitertext; + init niltext; + THESAURUS VAR ausgabe :: empty thesaurus; + gesamt liste := t; + INT VAR i; + anzahl := 0; + FOR i FROM 1 UPTO highest entry (t) REP + IF name (t,i) <> "" + THEN anzahl INCR 1; + eintrag [anzahl] := name (t,i) + FI + PER; + IF anzahl = 0 THEN LEAVE einzelne WITH ausgabe FI; + bild aufbauen; + abbruch := FALSE; + kreuze an (viele); + IF abbruch + THEN LEAVE einzelne WITH ausgabe + FI; + cursor (begin x,begin y + size y - 1); + out (niltext); (* Folgende Ausgaben werden sonst unleserlich *) + ausgabe erzeugen; + ausgabe. + +ausgabe erzeugen: + TEXT VAR nam; + WHILE string <> "" REP + nam := subtext (string,1,3); + string := subtext (string,5); + insert (ausgabe, eintrag [int (nam)]) + PER +END PROC einzelne; + +PROC realcursor setzen: + cursor (begin x,kopf zeilen + realc + begin y); + IF raender + THEN out ("|") + FI; + out (marke (virtc, TRUE) + 6 * ""8"") +END PROC real cursor setzen; + +TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor): + INT VAR pl :: nr (zeiger); + IF pl = 0 + THEN leer + ELSE mit zahl + FI. + +mit zahl: + IF mit cursor + THEN (3-length(text(pl))) * "-" + text (pl) + "-> " + ELSE text (pl,3) + " > " + FI. + +leer: + IF mit cursor + THEN "----> " + ELSE 6 * " " + FI +END PROC marke; + +PROC init weitertext: + weitertext := "----> " + mark ein + "weitere Eintraege " + mark aus + + ((size x - 27) * "-") +END PROC init weitertext; + +PROC init niltext: + IF size x > 78 + THEN niltext := ""5"" + ELSE IF raender + THEN niltext := ((size x + 2) * " " + (size x + 2) * ""8"") + ELSE niltext := (size x * " " + size x * ""8"") + FI + FI +END PROC init niltext; + +PROC bild (INT CONST anfang): + INT VAR i; + gib oberlinie aus; + FOR i FROM anfang UPTO grenze REP + cursor (begin x,kopfzeilen + begin y + i - anfang + 1); + rand; + out (marke (i, FALSE)); + IF LENGTH ("""" + eintrag [i] + """") <= (size x - 6) + THEN out (text ("""" + eintrag [i] + """",size x - 6)) + ELSE out (text ("""" + eintrag [i],size x - 10) + " ...") + FI; + rand + PER; + gib unterlinie aus; + IF grenze < (anfang + max eintraege) + THEN FOR i FROM 0 UPTO (anfang + max eintraege - anzahl - 1) REP + cursor (begin x,begin y + kopfzeilen + i + + grenze - anfang + min zeilen); + out (niltext) + PER + FI. + +gib oberlinie aus: + cursor (begin x,kopfzeilen + begin y); + rand; + IF realc = virtc + THEN out (size x * "-") + ELSE out (weitertext) + FI; + rand. + +gib unterlinie aus: + cursor (begin x,begin y + grenze - anfang + kopfzeilen + min zeilen - 1); + rand; + IF anzahl <= (anfang + max eintraege) + THEN out (size x * "-") + ELSE out (weitertext) + FI; + rand. + +grenze: + min (anzahl,anfang + max eintraege). + +END PROC bild; + +PROC gen kopfzeilen: + kopfzeilen := 0; + kopfzeilen text := ""; + kopfzeilen text CAT code (0); + IF pos (kz1,trenn zeichen) > 0 + THEN analysiere kopfzeile + ELIF kz1 <> "" AND length (kz1) <= size x + THEN kopfzeilen text := kz1 + code (1); + kopf zeilen := 1 + ELIF kz1 <> "" + THEN analysiere kopfzeile + FI; + IF kopfzeilen > size y - min zeilen + THEN kopfzeilen := size y - min zeilen + FI; + max eintraege := size y - kopfzeilen - min zeilen. + +analysiere kopfzeile: + kz2 := compress (kz1); + BOOL VAR mark is on :: FALSE; + TEXT VAR einschub; + REP kopf zeilen INCR 1; + kontrolliere pos; + einschub := subtext(kz2,1,pos (kz2,trennzeichen)-1); + kontrolliere auf markiert; + kopfzeilen text CAT einschub; + kopfzeilen text CAT code (kopf zeilen); + kz2 := compress (subtext(kz2,pos (kz2,trennzeichen) + 1)); + UNTIL NOT (length (kz2) > size x OR pos (kz2,trennzeichen) > 0 )PER; + IF kz2 <> "" + THEN einschub := kz2; + kontrolliere auf markiert; + kopfzeilen text CAT einschub; + kopf zeilen INCR 1 + FI; + kopfzeilentext CAT code (kopfzeilen). + +muss noch getrennt werden: + (pos (kz2,trennzeichen) > size x OR pos (kz2,trennzeichen) = 0) + AND length (kz2) > size x. + +kontrolliere pos: + IF muss noch getrennt werden + THEN trenne kopfzeile + FI. + +trenne kopfzeile: + INT VAR i; + FOR i FROM size x DOWNTO (size x DIV 2) REP + UNTIL (kz2 SUB i) = " " PER; + kz2 := subtext (kz2,1,i) + trennzeichen + subtext (kz2,i+1). + +kontrolliere auf markiert: + IF mark is on + THEN kopfzeilen text CAT mark ein; + IF pos (einschub,mark aus) > 0 AND pos (einschub,mark ein) = 0 + THEN mark is on := FALSE + FI + ELSE IF pos (einschub,mark ein) > 0 + THEN IF pos (einschub,mark aus) = 0 + THEN einschub CAT mark aus; + mark is on := TRUE + FI + FI + FI. + +END PROC gen kopfzeilen; + +PROC zeige kopfzeilen: + INT VAR i; + FOR i FROM 1 UPTO kopfzeilen REP + cursor (begin x,begin y + i - 1); + rand; + out (niltext); + out (center (subtext (kopfzeilen text,pre code + 1,post code - 1) + ," ",size x)); + rand + PER. + + post code: + pos (kopfzeilen text,code (i)). + + pre code: + pos (kopfzeilen text,code (i - 1)). + +END PROC zeige kopfzeilen; + +PROC bild aufbauen: + zeige kopfzeilen; + virtc := 1; + realc := 1; + bild (1); + realcursor setzen +END PROC bild aufbauen; + +PROC kreuze an (BOOL CONST viele): + auswahlende := FALSE; + REP zeichen lesen; + zeichen interpretieren + UNTIL auswahlende + PER. + +zeichen lesen: + TEXT VAR zeichen; + inchar (zeichen, zeichenstring). + +zeichen interpretieren: + SELECT pos (zeichenstring, zeichen) OF + CASE hop : hoppen (viele) + CASE esc : esc kommandos (viele) + CASE obe : nach oben + CASE unt : nach unten + CASE ank : ankreuzen (viele,FALSE); evtl aufhoeren + CASE ank 1 : ankreuzen (viele,TRUE ); evtl aufhoeren + CASE aus : auskreuzen + CASE aus 1 : auskreuzen + CASE fra : info (viele) + CASE ins : eintrag einfuegen; + IF string <> "" + THEN evtl aufhoeren + FI + END SELECT. + +evtl aufhoeren: + IF NOT viele + THEN LEAVE kreuze an + FI +END PROC kreuze an; + +PROC hoppen (BOOL CONST viele): + zweites zeichen lesen; + zeichen interpretieren. + +zweites zeichen lesen: + TEXT VAR zz; + getchar (zz). + +zeichen interpretieren: + SELECT pos (oben unten rubout o return x , zz) OF + CASE 0 : out (""7"") + CASE 1 : hop nach oben + CASE 2 : hop nach unten + CASE 3,4 : alles loeschen + CASE 5 : bild nach oben + CASE 6 : IF viele THEN rest ankreuzen ELSE out (""7"") FI + END SELECT. + +bild nach oben: + realc := 1; + bild (virtc); + realcursor setzen. + +rest ankreuzen: + INT VAR i; + FOR i FROM 1 UPTO anzahl REP + IF nr (i) = 0 + THEN string CAT textstr (i) + FI + PER; + bild aktualisieren; + realcursor setzen. + +alles loeschen: + string := ""; + bild aktualisieren; + realcursor setzen. + +hop nach oben: + IF ganz oben + THEN out (""7"") + ELIF oben auf der seite + THEN raufblaettern + ELSE top of page + FI. + +ganz oben: + virtc = 1. + +oben auf der seite: + realc = 1. + +raufblaettern: + virtc DECR (max eintraege + 1); + virtc := max (virtc, 1); + bild (virtc); + realcursor setzen. + +top of page: + loesche marke; + virtc DECR (realc - 1); + realc := 1; + realcursor setzen. + +hop nach unten: + IF ganz unten + THEN out (""7"") + ELIF unten auf der seite + THEN runterblaettern + ELSE bottom of page + FI. + +ganz unten: + virtc = anzahl. + +unten auf der seite: + realc > maxeintraege . + +runterblaettern: + INT VAR alter virtc :: virtc; + virtc INCR (max eintraege + 1); + virtc := min (virtc, anzahl); + realc := virtc - alter virtc; + bild (alter virtc + 1); + realcursor setzen. + +bottom of page: + loesche marke; + alter virtc := virtc; + virtc INCR (max eintraege + 1 - realc); + virtc := min (anzahl, virtc); + realc INCR (virtc - alter virtc); + realcursor setzen +END PROC hoppen; + +PROC esc kommandos (BOOL CONST viele): + TEXT VAR zz; + getchar (zz); + SELECT pos(q eins neun a return x rubout o s, zz) OF + CASE 0 : out (""7"") + CASE 1 : auswahlende := TRUE + CASE 2 : zeige anfang + CASE 3 : zeige ende + CASE 4 : abbruch := TRUE; auswahlende := TRUE + CASE 5,6 : IF viele + THEN ankreuzen bis ende + ELSE out (""7"") + FI + CASE 7,8 : IF viele + THEN loeschen bis ende + ELSE out (""7"") + FI + CASE 9 : liste nach nummern ordnen + END SELECT. + +liste nach nummern ordnen : + THESAURUS VAR dummy thesaurus :: empty thesaurus; + TEXT VAR nam,dummy string :: ""; + cursor (begin x,begin y + screen ende + kopfzeilen + minzeilen - 1); + rand; + out (center(invers("Bitte warten !"),"-",size x)); + rand; + i := 0; + WHILE string <> "" REP + i INCR 1; + nam := subtext (string,1,3); + string := subtext (string,5); + insert (dummy thesaurus, eintrag [int (nam)]); + dummy string CAT textstr (i) + PER; + anzahl := 0; + string := dummy string; + gesamt liste := dummy thesaurus + gesamt liste; + FOR i FROM 1 UPTO highest entry (gesamt liste) REP + IF name (gesamt liste,i) <> "" + THEN anzahl INCR 1; + eintrag [anzahl] := name (gesamt liste,i) + FI + PER; + bild aufbauen. + +loeschen bis ende: + INT VAR j; + FOR j FROM virtc UPTO anzahl REP + INT VAR posi :: nr (j); + IF posi <> 0 + THEN rausschmeissen + FI + PER; + bild aktualisieren; + realcursor setzen. + +rausschmeissen: + string := subtext (string,1, 4*posi-4) + subtext (string,4*posi+1). + +ankreuzen bis ende: + INT VAR i; + FOR i FROM virtc UPTO anzahl REP + IF nr (i) = 0 + THEN string CAT textstr (i) + FI + PER; + bild aktualisieren; + realcursor setzen. + +zeige anfang: + IF virtc = 1 + THEN out (""7"") + ELIF virtc = realc + THEN loesche marke; + virtc := 1; + realc := 1; + realcursor setzen + ELSE virtc := 1; + realc := 1; + bild (1); + realcursor setzen + FI. + +zeige ende: + IF virtc = anzahl + THEN out (""7"") + ELIF ende auf screen + THEN loesche marke; + realc INCR (anzahl - virtc); + virtc := anzahl; + realcursor setzen + ELSE virtc := anzahl; + realc := max eintraege + 1; + bild (anzahl - maxeintraege); + realcursor setzen + FI. + +ende auf screen: + (realc + anzahl - virtc) < maxeintraege + 1. + +screen ende: + min (realc + anzahl - virtc - 1,max eintraege). + +END PROC esc kommandos; + +PROC ankreuzen (BOOL CONST viele,xo): + INT VAR pl :: nr (virtc); + IF pl <> 0 + THEN out (""7""); + cursor setzen; + LEAVE ankreuzen + FI; + string CAT textstr (virtc); + IF viele + THEN cursor setzen + FI. + + cursor setzen: + IF xo + THEN realcursor setzen + ELSE IF virtc < anzahl + THEN nach unten + FI; + IF virtc = anzahl + THEN realcursor setzen + FI + FI +END PROC ankreuzen; + +PROC auskreuzen : + INT VAR posi :: nr (virtc); + IF posi = 0 + THEN out (""7""); LEAVE auskreuzen + FI; + rausschmeissen; + loesche marke; + bild aktualisieren; + realcursor setzen. + +rausschmeissen: + string := subtext (string,1, 4*posi-4) + subtext (string,4*posi+1) +END PROC auskreuzen; + +PROC eintrag einfuegen : + IF anzahl = max entries + THEN out (""7""); + LEAVE eintrag einfuegen + FI; + mache platz frei; + trage ein; + baue richtiges bild auf. + +mache platz frei: + INT VAR i; + FOR i FROM anzahl DOWNTO virtc REP + eintrag [i+1] := eintrag [i] + PER; + eintrag [virtc] := """"; + ruecke kreuze einen weiter; + anzahl INCR 1; + string CAT textstr (virtc); + baue richtiges bild auf. + +trage ein: + TEXT VAR exit char; + realcursor setzen; + out (marke (virtc,TRUE)); + out (""""); + push (""11""); + editget (ein,max text length,size x - 7,"","",exit char); + IF (ein SUB length (ein)) = """" + THEN ein := subtext (ein,1,length (ein) - 1) + FI; + IF ein = "" + THEN auskreuzen; + setze eintraege zurueck + ELSE realcursor setzen; + out (6 * ""2"" + text ("""" + ein + """",size x - 7)) + FI. + +ein: + eintrag [virtc]. + +setze eintraege zurueck: + FOR i FROM virtc UPTO anzahl-1 REP + eintrag [i] := eintrag [i+1]; + change (string,textstr (i+1),textstr (i)) + PER; + anzahl DECR 1. + +ruecke kreuze einen weiter: + FOR i FROM anzahl DOWNTO virtc REP + change (string,textstr (i),textstr (i+1)) + PER. + +baue richtiges bild auf: + bild (virtc - (realc - 1)); + realcursor setzen +END PROC eintrag einfuegen; + +PROC bild aktualisieren: + INT VAR ob, un, i; + ob := virtc - (realc - 1); + un := min (ob + max eintraege, anzahl); + FOR i FROM ob UPTO un REP + cursor (begin x,kopfzeilen + begin y + i - ob + 1); + rand; + out (marke (i, FALSE)) + PER +END PROC bild aktualisieren; + +PROC nach oben: + IF noch nicht oben (* virtuell *) + THEN gehe nach oben + ELSE out (""7"") + FI. + +noch nicht oben: + virtc > 1. + +gehe nach oben: + IF realc = 1 + THEN scroll down + ELSE cursor up + FI. + +scroll down: + virtc DECR 1; + bild (virtc); + realcursor setzen. + +cursor up: + loesche marke; + virtc DECR 1; + realc DECR 1; + realcursor setzen +END PROC nach oben; + +PROC nach unten: + IF noch nicht unten (* virtuell *) + THEN gehe nach unten + ELSE out (""7"") + FI. + +noch nicht unten: + virtc < anzahl. + +gehe nach unten: + IF realc > maxeintraege + THEN scroll up + ELSE cursor down + FI. + +scroll up: + virtc INCR 1; + bild (virtc - maxeintraege); + realcursor setzen. + +cursor down: + loesche marke; + virtc INCR 1; + realc INCR 1; + realcursor setzen +END PROC nach unten; + +PROC loesche marke: + cursor (begin x,kopf zeilen + realc + begin y); + rand; + out (marke (virtc, FALSE)) +END PROC loesche marke; + +TEXT PROC textstr (INT CONST nr): + text (nr,3) + "!" +END PROC textstr; + +INT PROC nr (INT CONST zeiger): + IF pos (string, textstr (zeiger)) = 0 + THEN 0 + ELSE (pos (string,textstr (zeiger)) DIV 4) + 1 + FI +END PROC nr; + +PROC rand: + IF raender + THEN out ("|") + FI +END PROC rand; + +PROC info (BOOL CONST mehrere moeglich): + IF NOT initialized (init tools info) + THEN initialisiere tools info + FI; + modify (tools info); + IF mehrere moeglich + THEN head line (tools info," INFO : Auswahl mehrerer Dateien "); + ELSE head line (tools info," INFO : Auswahl einer Datei "); + FI; + to line (tools info,1); + col (tools info,1); + IF raender + THEN open editor (groesster editor + 1,tools info,FALSE, + begin x,begin y,size x + 2,size y) + ELSE open editor (groesster editor + 1,tools info,FALSE, + begin x,begin y,size x,size y) + FI; + edit (groesster editor,"q19",PROC (TEXT CONST) std kommando interpreter); + zeige kopfzeilen; + bild (virtc - (realc - 1)); + realcursor setzen +END PROC info; + +(******************** Herausgereichte, abgeleitete Prozeduren ***********) + +THESAURUS PROC some (THESAURUS CONST t,TEXT CONST kopf zeile, + INT CONST start x,start y,x size,y size): + einzelne (t,TRUE,kopf zeile,start x,start y,x size,y size) +END PROC some; + +THESAURUS PROC some (THESAURUS CONST t, + INT CONST start x,start y,x size,y size): + some (t,invers (std text 2 + std help),start x,start y,x size,y size) +END PROC some; + +THESAURUS PROC some (THESAURUS CONST t,TEXT CONST kopf zeile, + INT CONST start y,ende y): + einzelne (t,TRUE,kopf zeile,1,start y,79,ende y - start y + 1) +END PROC some; + +THESAURUS PROC some (THESAURUS CONST t,INT CONST start y,ende y): + some (t,invers(stdtext 2 + std help),1,start y,79,ende y - start y + 1) +END PROC some; + +THESAURUS PROC some (THESAURUS CONST t,TEXT CONST kopf zeile): + some (t,kopf zeile,1,bildschirm) +END PROC some; + +THESAURUS PROC some (THESAURUS CONST t): + some (t,invers(stdtext 2 + std help),1,bildschirm) +END PROC some; + +THESAURUS PROC some: + some (all,invers(stdtext 2 + std help),1,bildschirm) +END PROC some; + +THESAURUS PROC some (TEXT CONST te): + some (ALL te) +END PROC some; + +THESAURUS PROC some (TASK CONST quelle): + some (ALL quelle) +END PROC some; + +THESAURUS OP SOME (THESAURUS CONST th): + some (th) +END OP SOME; + +THESAURUS OP SOME (TASK CONST ta): + some (ALL ta) +END OP SOME; + +THESAURUS OP SOME (TEXT CONST te): + some (ALL te) +END OP SOME; + +TEXT PROC one (THESAURUS CONST t,TEXT CONST kopf zeile, + INT CONST start x,start y,x size,y size): + name(einzelne (t,FALSE,kopf zeile,start x,start y,x size,y size),1) +END PROC one; + +TEXT PROC one (THESAURUS CONST t, + INT CONST start x,start y,x size,y size): + one (t,invers (std text 1 + std help),start x,start y,x size,y size) +END PROC one; + +TEXT PROC one (THESAURUS CONST t, TEXT CONST t1, + INT CONST start y,ende y): + name (einzelne (t,FALSE, t1,1,start y,79,ende y - start y + 1), 1) +END PROC one; + +TEXT PROC one (THESAURUS CONST t, + INT CONST start y,ende y): + one (t,invers (std text 1+ std help),1,start y,79,ende y - start y + 1) +END PROC one; + +TEXT PROC one (THESAURUS CONST t,TEXT CONST kopf zeile): + one (t,kopf zeile,1,bildschirm) +END PROC one; + +TEXT PROC one (THESAURUS CONST t): + one (t,invers(stdtext 1 + std help),1,bildschirm) +END PROC one; + +TEXT PROC one (TASK CONST quelle): + one (ALL quelle) +END PROC one; + +TEXT PROC one: + one (all) +END PROC one; + +TEXT PROC one (TEXT CONST te): + one (ALL te) +END PROC one; + +PROC edit one : + TEXT CONST datei :: one (all,invers(stdtext 1 + "zum Editieren") + + trennzeichen + stdhelp, + 1,bildschirm); + IF datei <> "" CAND (NOT exists (datei) + COR type (old (datei)) = filetype) + THEN IF groesster editor > 0 + THEN ueberschrift neu; + bild neu + FI; + edit (datei) + FI +END PROC edit one; + +PROC edit some: + THESAURUS CONST tt :: some (all,invers(stdtext 2 + "zum Editieren") + + trennzeichen + stdhelp, + 1,bildschirm); INT VAR i; + FOR i FROM 1 UPTO highest entry (tt) REP + TEXT VAR datei :: name (tt,i); + IF datei <> "" CAND (NOT exists (datei) + COR type (old (datei)) = filetype) + THEN IF groesster editor > 0 + THEN ueberschrift neu; + bild neu + FI; + edit (datei) + FI + PER +END PROC edit some; + +PROC reorganize (THESAURUS CONST t): + page; + do (PROC (TEXT CONST) do reorganize,t) +END PROC reorganize; + +PROC do reorganize (TEXT CONST name): + IF type (old(name)) = file type + THEN put ("Datei " + center (invers("""" + name + """")," ",30) + + " wird reorganisiert :"); + FILE VAR file :: sequential file (modify,name); + IF segments (file) = 1 + THEN put (lines (file)) + ELSE reorganize (name) + FI + ELSE put (" " + center (invers("""" + name + """")," ",30) + + " ist keine Datei.") + FI; + line +END PROC do reorganize ; + +PROC initialisiere tools info : + tools info ds := nilspace; + tools info := sequential file (output, tools info ds); + putline (tools info,""15" Mit den angekreuzten Namen wird die gewaehlte Operation ausgefuehrt "14""); + line (tools info); + putline (tools info," "15" Positionierungen: "14" "); + line (tools info); + putline (tools info," Oben : zum vorausgehenden Namen"); + putline (tools info," Unten : zum folgenden Namen "); + putline (tools info," HOP Oben : zum ersten Namen der (vorigen) Seite"); + putline (tools info," HOP Unten : zum letzten Namen der (vorigen) Seite"); + putline (tools info," HOP RETURN : aktuelle Zeile wird erste Zeile"); + putline (tools info," ESC 1 : zum ersten Namen der Liste"); + putline (tools info," ESC 9 : zum letzten Namen der Liste"); + putline (tools info," ESC s : Liste nach Nummern ordnen"); + line (tools info); + putline (tools info," "15" Auswahl treffen: "14" "); + line (tools info); + putline (tools info," ( Folgende Befehle sind nur bei einer )"); + putline (tools info," ( Auswahl von mehreren Namen Möglich. )"); + line (tools info); + putline (tools info," RETURN bzw. x: diesen Namen ankreuzen "); + putline (tools info," RUBOUT bzw. o: Kreuz vor dem Namen loeschen"); + putline (tools info," HOP x : alle Namen ankreuzen "); + putline (tools info," HOP o : alle Kreuze loeschen "); + putline (tools info," ESC x : alle folgenden Namen ankreuzen"); + putline (tools info," ESC o : alle folgenden Kreuze loeschen"); + putline (tools info," RUBIN : einen neuen Namen eintragen"); + line (tools info); + putline (tools info," ( Nur dieser Befehl kann benutzt werden , wenn )"); + putline (tools info," ( die Auswahl eines ! Namens möglich ist. )"); + line (tools info); + putline (tools info," RETURN bzw. x: diesen Namen auswaehlen"); + line (tools info); + putline (tools info," "15" Auswahl verlassen: "14""); + line (tools info); + putline (tools info," ESC q : Auswaehlen beenden "); + putline (tools info," ESC a : Auswahl abbrechen (ohne Kreuze !)"); + line (tools info); + putline (tools info,""15" Zum Verlassen des Infos bitte 'ESC q' tippen! "14""); +END PROC initialisiere tools info; + +END PACKET mpg some; + +(****************** DATEI MONITOR ********************************) + +PACKET mpg dm DEFINES dm: (* Klaus Bovermann *) + (* Andreas Dieckmann *) + (* Thomas Clermont *) + (* Version 2.1 *) + (* EUMEL 1.7.5 *) + (* Datum 06.05.87 *) +LET mark ein = ""15"", + mark aus = ""14"", + trennzeichen = ""222"", + type = "#type (""micron"")#", + dummy name pos = 18, + disk zeichenfolge = "alnfiqushcvd", + mana zeichenfolge = "al qush v"; + +TASK CONST std manager :: task ("PUBLIC"); +TASK VAR manager; + +BOOL VAR archive ist meins :: archiv angemeldet, + disk , + diskette im schacht :: FALSE; + +TEXT VAR aktueller archivename, + manager name, + t1; + +PROC dm: + TEXT VAR zeichen, alte lernsequenz :: lernsequenz auf taste ("k"); + REP aktion + UNTIL zeichen = "q" PER; + lernsequenz auf taste legen ("k",alte lernsequenz). + +aktion: + manager := std manager; + vormonitor; + IF zeichen <> "q" AND managername <> "" + THEN hauptmonitor + FI. + +zeige vormonitor: + managername := name (manager); + page; + write(27 * " "); write(mark ein); + write("V O R M O N I T O R "); write(mark aus); + line(4); + zeile ("t","Task einstellen, mit der kommuniziert werden soll"); + zeile ("p","Es soll mit 'PUBLIC' kommuniziert werden"); + zeile ("v","Es soll mit der Vatertask kommuniziert werden"); + zeile ("a","Es soll mit dem Archiv kommuniziert werden"); + zeile ("q","Programm beenden"). + +vormonitor: + IF NOT eingabe von erlaubtem zeichen ("tvapq") + THEN zeige vormonitor + FI; + line; + write ("Bitte Eingabe : "); + inchar (zeichen, "tvapq"); + out (zeichen); line; + IF pos ("a",zeichen) = 0 CAND manager = archive + THEN automatische freigabe des archives + FI; + ausfuehren der vorwahl. + +ausfuehren der vorwahl: + IF pos ("tvap", zeichen) <> 0 + THEN neue task einstellen + FI. + +neue task einstellen: + managername := ""; + IF zeichen = "a" THEN managername := "ARCHIVE" + ELIF zeichen = "p" THEN managername := "PUBLIC" + ELIF zeichen = "v" THEN managername := name (father) + ELSE namen holen + FI; + TEXT VAR mess; + BOOL VAR ok :: managername = "" COR + managername = "PUBLIC" COR + task ist kommunikativ (managername, mess); + IF NOT ok + THEN cursor (1,20); putline (""7""15"FEHLER: " + mess + ""14""); + pause; + managername := ""; + FI; + IF managername = "" THEN manager := std manager + ELIF managername = "ARCHIVE" THEN manager := archive + ELSE manager := task (managername) + FI. + +namen holen: + REP + cursor (1,14); + put ("Neue Task:"); + editget (managername); line; + IF managername = name (myself) + THEN putline ("Mit der eigenen Task kann nicht kommuniziert werden.") + FI; + UNTIL managername <> name (myself) PER; + lernsequenz auf taste legen ("k",managername). + +END PROC dm; + +BOOL PROC task ist kommunikativ (TEXT CONST taskname, TEXT VAR message): + disable stop; + TASK VAR t :: task (taskname); + IF is error + THEN message := errormessage; + clear error; + enable stop; + FALSE + ELSE task behandlung + FI. + + task behandlung: + IF taskname <> "ARCHIVE" + THEN task kommunikation + ELSE archive behandlung + FI. + + task kommunikation: + IF status (t) <> 2 + THEN message := "Task ist nicht im Wartezustand"; + enable stop; + FALSE + ELSE versuchen zuzugreifen + FI. + + versuchen zuzugreifen: + INT CONST listcode :: 15; + DATASPACE VAR dummy :: nilspace; + call (listcode, "", dummy, t); + forget (dummy); + IF is error + THEN message := errormessage; + clear error; + enable stop; + FALSE + ELSE message := ""; + enable stop; + TRUE + FI. + + archive behandlung: + IF status (archive) <> 2 + THEN message := "ARCHIVE ist nicht im Wartezustand"; + LEAVE archive behandlung WITH FALSE + FI; + archive (""); + IF is error + THEN message := errormessage; + clear error; + enable stop; + FALSE + ELSE enable stop; + archive ist meins := TRUE; + diskette im schacht := FALSE; + message := ""; + TRUE + FI +END PROC task ist kommunikativ; + +PROC hauptmonitor: + disk := (manager = archive); + TEXT VAR zeichenfolge; + IF disk + THEN zeichenfolge := disk zeichenfolge + ELSE zeichenfolge := mana zeichenfolge + FI; + TEXT VAR taste; + INT VAR stelle; + diskette im schacht := FALSE; + IF disk + THEN reservieren des archives + FI; + disable stop; + REP + IF NOT eingabe von erlaubtem zeichen (zeichenfolge) + THEN zeige menue + FI; + line; + write ("Bitte Eingabe : "); + inchar (taste,zeichenfolge); + out (taste + " Bitte warten..."); + stelle := pos (disk zeichenfolge, taste); (*!! ACHTUNG !!*) + IF stelle > 6 + AND NOT diskette im schacht + AND disk + THEN line; + putline (" Erst Diskette einlegen !");pause (100) + ELIF taste <> " " + THEN menue auswerten (stelle) + FI; + IF is error + THEN IF disk + THEN melde archiveerror (errormessage) + ELSE melde error (errormessage) + FI; + clear error + FI + UNTIL taste = "q" PER; + IF archiv angemeldet + THEN automatische freigabe des archives + FI. + + zeige menue: + page; + write(24 * " "); write(mark ein); + write("D A T E I M O N I T O R "); write(mark aus); + line(3); + zeile ("a","Auflisten aller Dateien in dieser Task"); + zeile ("l","Loeschen von Dateien in dieser Task"); + line(2); + write( 15 * " "); + IF disk + THEN write("Archiv: ") + ELSE write("Task : ") + FI; + IF disk + THEN IF diskette im schacht + THEN IF length(aktueller archivename) > 40 + THEN write ("'" + subtext (aktueller archivename,1,40) + " ...") + ELSE write (invers(""""+ aktueller archivename + """")) + FI + FI + ELSE write (invers("""" + managername + """")) + FI; + line(2); + TEXT VAR zielname 1, zielname 2, zielname 3; + IF disk + THEN zielname 1 := "des Archivs"; + zielname 2 := "zum Archiv"; + zielname 3 := "vom Archiv" + ELSE zielname 1 := "in " + managername; + zielname 2 := "zu " + managername; + zielname 3 := "von " + managername + FI; + zeile ("u","Uebersicht ueber alle Dateien " + zielname 1); + zeile ("s","Senden von Dateien " + zielname 2); + zeile ("h","Holen von Dateien " + zielname 3); + IF disk + THEN zeile ("c","'Checken' von Dateien " + zielname 1) + FI; + zeile ("v","Vernichten von Dateien " + zielname 1); + IF disk THEN + zeile ("d","Drucken einer Liste der Dateien des Archivs"); + zeile ("f","Formatieren einer Diskette"); + zeile ("i","Initialisieren/vollstaendiges Loeschen des Archivs"); + zeile ("n","Neue Diskette anmelden"); + FI; + line(1); + zeile ("q","Zurueck zum Vormonitor"). + +END PROC hauptmonitor; + +PROC menue auswerten (INT CONST stelle): + enable stop; + SELECT stelle OF + CASE 1 : auflisten der taskdateien + CASE 2 : loeschen von dateien in der task + CASE 3 : neue diskette anmelden + CASE 4 : formatieren einer diskette + CASE 5 : initialisieren des archives + CASE 6 : (* nichts *) + CASE 7 : auflisten der archivedateinamen + CASE 8 : schreiben von dateien aufs archive + CASE 9 : holen von dateien vom archive + CASE 10 : checken von dateien auf dem archive + CASE 11 : loeschen von dateien auf dem archive + CASE 12 : ausdruck archivelisting + END SELECT +END PROC menue auswerten; + +BOOL PROC eingabe von erlaubtem zeichen (TEXT CONST erlaubte zeichen): + TEXT VAR char in; + char in := getcharety; + IF pos (erlaubte zeichen,char in) > 0 AND char in <> " " + THEN push (char in);TRUE + ELSE FALSE + FI. +END PROC eingabe von erlaubtem zeichen; + +PROC zeile (TEXT CONST t,tt): + putline (8*" " + ""15"" + t + " "14"" + " ... " + tt) +END PROC zeile; + +PROC formatieren einer diskette: + page; + putline ("Formatieren einer Diskette."); + putline ("==========================="); + putline (""15"Achtung: Alle Disketten-Informationen werden gelöscht!"14""); + line; + putline ("Dies sind die moeglichen Formate:"); + zeile ("o","... Ohne Format-Angabe"); + zeile ("0","... Standard-Format"); + zeile ("1","... 40 Spur - 360 KB"); + zeile ("2","... 80 Spur - 720 KB"); + zeile ("3","... IBM Std - 1200 KB"); + zeile ("q","... Es wird nicht formatiert."); + TEXT VAR art; + put ("Ihre Wahl:"); + inchar (art, "o01234q"); + IF art = "q" + THEN LEAVE formatieren einer diskette + FI; + out (art); line; + put ("zukünftiger Name des Archives :"); + editget (aktueller archivename);line; + archive (aktueller archivename); + diskette im schacht := TRUE; + disable stop; + IF art = "o" THEN format (archive) + ELSE format (int (art), archive) + FI; + IF is error + THEN diskette im schacht := FALSE + ELSE aktueller archivename := archiv name + FI +END PROC formatieren einer diskette; + +PROC auflisten der taskdateien: + DATASPACE VAR dummy ds :: nilspace; + FILE VAR f :: sequential file (output,dummy ds); + list (f); + headline (f,"Liste der eigenen Task"); + modify (f); + to line (f,1); + show (f); + forget (dummy ds) +END PROC auflisten der taskdateien; + +PROC loeschen von dateien in der task: + t1 := invers ("Loeschen von Dateien ") + " Info mit " + trennzeichen + + "Bitte alle zu loeschenden Dateien ankreuzen" + trennzeichen + + invers ("(Ankreuzen mit )"); + forget (some (all,t1)) +END PROC loeschen von dateien in der task; + +PROC reservieren des archives: + TEXT VAR meldung; + page; + cursor(1,1); write("Bitte warten..."); + line (2); + versuche archive zu reservieren (meldung); + IF meldung <> "" + THEN page; + line(10); + write (""15"" + meldung + " "14""); + weitermachen; + diskette im schacht := FALSE; + archive ist meins := FALSE; + LEAVE reservieren des archives + FI; + archive anmelden (aktueller archive name, meldung); + IF meldung <> "" + THEN melde archiveerror (meldung) + FI. + +END PROC reservieren des archives; + +PROC versuche archive zu reservieren (TEXT VAR fehlermeldung): + fehlermeldung := ""; + IF archive ist meins + THEN LEAVE versuche archive zu reservieren + FI; + disable stop; + archive (""); + IF is error + THEN fehlermeldung := errormessage; + archive ist meins := FALSE; + clear error; + enable stop; + ELSE archive ist meins := TRUE; + fehlermeldung := ""; + enable stop + FI +END PROC versuche archive zu reservieren; + +PROC archive anmelden (TEXT VAR archivename, fehlermeldung): + page; + line(3); + fehlermeldung := ""; + IF NOT archive ist meins + THEN archivename := ""; + diskette im schacht := FALSE; + fehlermeldung := "nicht reserviert"; + LEAVE archive anmelden + FI; + IF yes ("Haben Sie die Diskette eingelegt und das Laufwerk geschlossen") + THEN line; + write ("Bitte warten..."); + archive name := archiv name; + IF archiv error <> "" + THEN fehlermeldung := archiv error; + diskette im schacht := FALSE + ELSE diskette im schacht := TRUE + FI + ELSE diskette im schacht := FALSE; + archivename := "" + FI +END PROC archive anmelden; + +PROC verlange reservierung des archives: + page; + line(7); + write (""15"Sie muessen unbedingt erst das Archiv reservieren, "14""); + line(2); + write (""15"sonst kann ich nicht darauf zugreifen! "14""); + line(2); + weitermachen +END PROC verlange reservierung des archives; + +PROC auflisten der archivedateinamen: + forget ("Dateiliste", quiet); + ueberpruefe reservierung; + liste dateien des archivs auf; + liste ausgeben; + forget ("Dateiliste", quiet). + + ueberpruefe reservierung: + IF disk AND diskette im schacht + AND NOT archive ist meins + THEN verlange reservierung des archives; + LEAVE auflisten der archivedateinamen + FI. + + liste dateien des archivs auf: + FILE VAR f :: sequential file (output,"Dateiliste"); + disable stop; + list(f,manager); + IF is error + THEN LEAVE auflisten der archivedateinamen; + ELSE enable stop + FI. + + liste ausgeben: + show (f) +END PROC auflisten der archivedateinamen; + +PROC checken von dateien auf dem archive: + ueberpruefe reservierung; + lasse dateien auswaehlen und checke. + + ueberpruefe reservierung: + IF disk AND diskette im schacht + AND NOT archive ist meins + THEN verlange reservierung des archives; + LEAVE checken von dateien auf dem archive + FI. + + lasse dateien auswaehlen und checke: + t1 := invers ("'Checken' von Dateien (auf dem Archiv) ") + + trennzeichen + "Bitte alle zu 'checkenden' Dateien ankreuzen"; + disable stop; + check (some (ALL manager, t1), manager); + weitermachen; + IF is error + THEN LEAVE checken von dateien auf dem archive + ELSE enable stop; + FI +END PROC checken von dateien auf dem archive; + +PROC schreiben von dateien aufs archive: + ueberpruefe reservierung; + lasse dateien auswaehlen und schreibe aufs archive. + +ueberpruefe reservierung: + IF disk AND diskette im schacht + AND NOT archive ist meins + THEN verlange reservierung des archives; + LEAVE schreiben von dateien aufs archive + FI. + +lasse dateien auswaehlen und schreibe aufs archive: + t1 := invers ("Schreiben von Dateien ") + " Info mit " + trennzeichen + + "Bitte alle zu schreibenden Dateien ankreuzen." + trennzeichen + + invers ("(Ankreuzen mit )"); + THESAURUS VAR angekreuzte :: some (ALL myself, t1); + disable stop; + zuerst loeschen; + INT VAR zaehler; + TEXT VAR dname; + page; + FOR zaehler FROM 1 UPTO highest entry (angekreuzte) REP + IF is error + THEN LEAVE schreiben von dateien aufs archive + FI; + dname := name (angekreuzte, zaehler); + IF dname <> "" + THEN putline (managername + " <--- """ + dname + """"); + save (dname, manager) + FI; + PER. + + zuerst loeschen: + IF disk CAND (not empty (angekreuzte)) + THEN out (center(invers("Bitte Warten"),"-",80)); + THESAURUS CONST zu loe :: angekreuzte / ALL manager; + IF not empty (zu loe) AND NOT is error + THEN page; + putline ("Zuerst Dateien auf der Diskette loeschen?"); + erase (zu loe, manager) + FI + FI +END PROC schreiben von dateien aufs archive; + +BOOL PROC not empty (THESAURUS CONST t): + INT VAR i; + FOR i FROM 1 UPTO highest entry (t) REP + IF name (t,i) <> "" + THEN LEAVE not empty WITH TRUE + FI + PER; + FALSE +END PROC not empty; + +PROC holen von dateien vom archive: + ueberpruefe reservierung; + lasse dateien auswaehlen und hole vom archive. + +ueberpruefe reservierung: + IF disk AND diskette im schacht + AND NOT archive ist meins + THEN verlange reservierung des archives; + LEAVE holen von dateien vom archive + FI. + +lasse dateien auswaehlen und hole vom archive: + t1 := invers ("Holen von Dateien ") + " Info mit " + + trennzeichen + + "Bitte alle zu holenden Dateien ankreuzen."; + THESAURUS VAR angekreuzte :: some (ALL manager,t1); + INT VAR zaehler; + TEXT VAR dname; + page; + FOR zaehler FROM 1 UPTO highest entry (angekreuzte) REP + dname := name (angekreuzte, zaehler); + disable stop; + IF dname <> "" + THEN putline (managername + " --> """ + dname + """"); + fetch (dname, manager) + FI; + IF is error + THEN LEAVE holen von dateien vom archive + ELSE enable stop + FI + PER +END PROC holen von dateien vom archive; + +PROC loeschen von dateien auf dem archive: + ueberpruefe reservierung; + lasse dateien auswaehlen und loesche. + + ueberpruefe reservierung: + IF disk AND diskette im schacht + AND NOT archive ist meins + THEN verlange reservierung des archives; + LEAVE loeschen von dateien auf dem archive + FI. + +lasse dateien auswaehlen und loesche: + t1 := invers ("Vernichten (Loeschen) von Dateien") + " Info mit " + + trennzeichen + "Bitte alle zu loeschenden Dateien ankreuzen."; + disable stop; + erase (some (ALL manager, t1), manager); + IF is error + THEN LEAVE loeschen von dateien auf dem archive + ELSE enable stop; + FI +END PROC loeschen von dateien auf dem archive; + +PROC initialisieren des archives: + TEXT VAR neuer archivename; + page; + line(2); + write(center (""15"Vollstaendiges Loeschen des Archivs "14"")); + line(2); + IF archive ist meins AND diskette im schacht + THEN write("Eingestellter Archivname: " + + invers ("""" + aktueller archivename + """")); + line(2); + IF yes ("Moechten Sie einen anderen Namen fuer das Archiv") + THEN line(2); + stelle frage nach neuem namen + ELSE neuer archivename := aktueller archivename + FI + ELSE stelle frage nach neuem namen + FI; + fuehre initialisierung durch. + + stelle frage nach neuem namen: + write("Bitte den Namen fuer das Archiv (maximal 30 Buchstaben):"); + line; + getline(neuer archivename); + neuer archivename := compress(neuer archivename); + IF length (neuer archivename) > 40 + THEN line(2); + write ("Der neue Archivname ist zu lang!"); + weitermachen; + LEAVE initialisieren des archives + FI. + + fuehre initialisierung durch: + disable stop; + aktueller archivename := neuer archivename; + archive (neuer archivename); + IF is error + THEN diskette im schacht := FALSE; + archive ist meins := FALSE; + LEAVE initialisieren des archives + ELSE clear(archive); + IF is error + THEN diskette im schacht := FALSE; + LEAVE initialisieren des archives + ELSE aktueller archivename := archiv name; + diskette im schacht := archiv error = "" + FI + FI +END PROC initialisieren des archives; + +PROC ausdruck archivelisting: + ueberpruefe reservierung; + print archive listing; + weitermachen. + +ueberpruefe reservierung: + IF disk AND diskette im schacht + AND NOT archive ist meins + THEN verlange reservierung des archives; + LEAVE ausdruck archivelisting + FI. + +print archive listing: + FILE VAR listfile := sequential file (output , "PLA"); + INT VAR i; + TEXT CONST head :: 70 * "=", + end :: 70 * "_"; + TEXT VAR record; + disable stop; + list (listfile, archive); + IF is error + THEN diskette im schacht := FALSE; + LEAVE ausdruck archivelisting + FI; + print head; + erase dummy names; + print bottom; + print and erase listing. + +print head : + modify (listfile); + to line (listfile, 1); + FOR i FROM 1 UPTO 6 REP + insert record (listfile) + PER; + to line (listfile, 1); + write record (listfile, type); down (listfile); + write record (listfile, head); down (listfile); + write record (listfile, "ARCHIVNAME: "+headline (listfile) + " " + + time of day +" " + date ); down (listfile); + write record (listfile, head); down (listfile); + write record (listfile, " "); down (listfile); + write record (listfile, "Date Store Contents"). + +erase dummy names : + to line (listfile, 6); + WHILE NOT eof (listfile) REP + read record (listfile, record); + IF (record SUB dummy name pos) = "-" + THEN delete record (listfile) + ELSE down (listfile) + FI + PER. + +print bottom : + output (listfile); + putline (listfile, end). + +print and erase listing : + modify (listfile); + edit (listfile); + line (3); + IF yes ("Archivlisting drucken") + THEN print ("PLA") + FI; + forget ("PLA", quiet). + +END PROC ausdruck archivelisting; + +PROC neue diskette anmelden: + ueberpruefe reservierung; + melde neue diskette an. + + ueberpruefe reservierung: + IF NOT archive ist meins + THEN reservieren des archives; + LEAVE neue diskette anmelden + FI. + + melde neue diskette an: + TEXT VAR meldung; + page; + cursor(1,1); write("Bitte warten..."); + line (2); + archive anmelden (aktueller archive name,meldung); + IF meldung <> "" + THEN melde archiveerror (meldung) + FI. + +END PROC neue diskette anmelden; + +PROC automatische freigabe des archives: + archive ist meins := FALSE; + diskette im schacht := FALSE; + command dialogue (FALSE); + release(archive); + command dialogue (TRUE) +END PROC automatische freigabe des archives; + +PROC melde archiveerror (TEXT CONST meldung): + line(2); + IF meldung = "nicht reserviert" + THEN verlange reservierung des archives; + ELIF meldung = "keine diskette" + THEN write (""15"Ich mache die Reservierung rueckgaengig! "14""); + neu reservieren + ELIF pos (meldung,"inkonsistent") > 0 + THEN write(""15"Diskette ist nicht formatiert / initialisiert "14""); + neu reservieren; + ELIF pos(meldung,"Lesen unmoeglich") > 0 + COR pos(meldung, "Schreiben unmoeglich") > 0 + THEN write(""15"Die Diskette ist falsch eingelegt "14"");line (2); + write(""15"oder das Laufwerk ist nicht geschlossen "14"");line (2); + write(""15"oder die Diskette ist nicht formatiert !"14""); + neu reservieren; + ELIF pos (meldung, "Archiv heisst") > 0 AND pos(meldung, "?????") > 0 + THEN write(""15"Diskette nicht lesbar ! (Name: '?????') "14"");line(2); + write(""15"Moeglicherweise ist die Diskette defekt ! "14""); + neu reservieren; + ELIF pos(meldung, "Archiv heisst") > 0 + THEN write (invers(meldung)); + line(2); + write (""15"Diskette wurde mit anderem Namen angemeldet!"14"");line(2); + write("Bitte neu reservieren!"); + weitermachen + ELSE write(invers(meldung)); + neu reservieren + FI +END PROC melde archiveerror; + +PROC neu reservieren: + line (2); + write ("Bitte den Fehler beseitigen und das Archiv neu reservieren !"); + weitermachen; + diskette im schacht := FALSE +END PROC neu reservieren; + +PROC weitermachen: + line (2); + write("Zum Weitermachen bitte irgendeine Taste tippen!"); + pause +END PROC weitermachen; + +PROC melde error (TEXT CONST meldung): + page; + line(10); + write (invers(meldung)); + weitermachen +END PROC melde error + +END PACKET mpg dm; + +(**************************** TOOLS *******************************) + +PACKET mpg tools DEFINES put, + th, + gen : + + +lernsequenz auf taste legen ("E", ""27""2""27"p"27"qedit ("27"g)"13""); + +PROC put (BOOL CONST b) : + IF b THEN put ("TRUE") ELSE put ("FALSE") FI +END PROC put; + +PROC th (THESAURUS CONST thes) : + THESAURUS VAR help :: SOME thes;help := empty thesaurus +END PROC th; + +(************************ Task - Generierung *******************************) + +(* Zum Generieren einer TASK ist folgendes zu beachten: + +a) Es muss ein Archiv zur Verfuegung stehen, das einen beliebigen Namen hat. +b) Auf diesem Archiv muss es eine Datei namens <"gen." + taskname> geben. +c) Diese Datei muss folgendermassen aufgebaut sein: + In jeder Zeile steht genau ein Name einer fuer diese TASK wichtigen Datei. + Die ersten Namen sind Namen von zu insertierenden Dateien. + Es folgt "gen." + taskname. + Alle folgenden Dateinamen werden vom Archiv geholt und bleiben in der + TASK erhalten. *) + +BOOL VAR archive access :: FALSE; + +PROC hole (TEXT CONST dateiname): + IF exists (dateiname) + THEN display ("***") + ELSE IF NOT archive access + THEN archiv; (* geaendert BV 10.07.86 *) + archive access := TRUE + FI; + display ("-->"); + from (dateiname) + FI; + display (dateiname + ""13""10"") +END PROC hole; + +PROC ins (TEXT CONST dateiname): + line; + out (77 * "=" + ""13""10""); + out (dateiname + " wird insertiert"13""10""); + insert (dateiname); + forget (dateiname, quiet) +END PROC ins; + +LET anzahl dateien = 50; + +ROW anzahl dateien TEXT VAR datei; + +INT VAR anzahl zu insertierender, + gesamtzahl; + +PROC gen: + TEXT CONST taskname :: name (myself), + gendateiname :: "gen." + taskname; + TEXT VAR record; + BOOL VAR zu insertieren :: TRUE; + + archive access := FALSE; + anzahl zu insertierender := 0; + gesamtzahl := 0; + page; + putline ("GENERIERUNG VON " + taskname); + putline ((16 + length (taskname)) * "="); + hole (gendateiname); + + FILE VAR gendatei := sequential file (input, gendateiname); + WHILE NOT eof (gendatei) AND gesamtzahl < anzahl dateien REP + getline (gendatei, record); + record := compress (record); + IF record = gendateiname + THEN zu insertieren := FALSE + FI; + IF zu insertieren + THEN anzahl zu insertierender INCR 1 + FI; + gesamtzahl INCR 1; + hole (record); + datei [gesamtzahl] := record + PER; + forget (gendateiname, quiet); + IF archive access + THEN release; + line (2); + put ("Bitte entfernen Sie Ihre Diskette aus dem Laufwerk!"); + line + FI; + INT VAR i; + FOR i FROM 1 UPTO anzahl zu insertierender REP + ins (datei [i]) + PER; + IF yes ("global manager") + THEN do ("global manager") + FI. +END PROC gen + +END PACKET mpg tools; + +(********************* MPG TARGET HANDLING *******************) + +PACKET target handling DEFINES TARGET, + initialize target, + complete target, + delete in target, + select target, + actual target name, + actual target set, + target names: + + +TYPE TARGET = STRUCT (INT ind, THESAURUS target name, target set); + +LET no target = 0; + +PROC initialize target (TARGET VAR tar): + tar.target set := empty thesaurus; + tar.target name := empty thesaurus; + tar.ind := no target +END PROC initialize target; + +PROC complete target (TARGET VAR tar, TEXT CONST nam, set): + IF NOT (tar.target name CONTAINS nam) + THEN insert (tar.target name, nam); + insert (tar.target set , set) + ELSE errorstop ("Bezeichner bereits vorhanden") + FI +END PROC complete target; + +PROC delete in target (TARGET VAR tar, TEXT CONST nam): + INT CONST ind :: link (tar.target name, nam); + delete (tar.target name, ind); + delete (tar.target set , ind); + tar.ind := no target +END PROC delete in target; + +PROC select target (TARGET VAR tar, TEXT CONST nam, TEXT VAR set): + INT VAR ind :: link (tar.target name, nam); + IF ind <> 0 + THEN set := name (tar.target set , ind); + tar.ind := ind + ELSE set := "" + FI +END PROC select target; + +TEXT PROC actual target name (TARGET CONST tar): + IF tar.ind = no target + THEN "" + ELSE name (tar.target name, tar.ind) + FI +END PROC actual target name; + +TEXT PROC actual target set (TARGET CONST tar): + IF tar.ind = no target + THEN "" + ELSE name (tar.target set, tar.ind) + FI +END PROC actual target set; + +THESAURUS PROC target names (TARGET CONST tar): + tar.target name +END PROC target names + +END PACKET target handling; + +(*********************** MPG PRINT CMD ***********************) + +PACKET mpg print cmd DEFINES print, select printer, + install printers, + list printers, + printer, printers: + + +TARGET VAR printer list; + +LET std printer name = "PRINTER", + titel = "PRINTER AUSWAHL"; + +LET trenner = "\#"; + +TARGET PROC printers: + printer list +END PROC printers; + +PROC install printers (FILE VAR f): + initialize target (printer list); + TEXT VAR nam, set; + TEXT VAR std nam :: "", std set :: ""; + WHILE NOT eof (f) REP + TEXT VAR zeile; + getline (f, zeile); + IF zeile <> "" + THEN INT CONST po :: pos (zeile, trenner); + nam := subtext (zeile, 1, po - 1); + set := subtext (zeile, po + 1); + complete target (printer list, nam, set); + IF int (nam) = station (myself) + THEN std nam := nam; + std set := set + FI + FI + PER; + select target (printer list, std nam, std set); + IF std set <> "" + THEN fonttable (std set) + FI +END PROC install printers; + +PROC select printer: + TEXT VAR font; + select target (printer list, + one (target names (printer list), titel,1,24), font); + IF font <> "" + THEN fonttable (font) + FI +END PROC select printer; + +PROC list printers: + th (target names (printer list)) +END PROC list printers; + +PROC print : + print (last param) +END PROC print; + +PROC print (TEXT CONST file) : + save (file, printer) +END PROC print; + +PROC print (THESAURUS CONST thes) : + save (thes, printer) +END PROC print; + +TASK PROC printer: + INT VAR stat :: int (actual target name (printer list)); + IF stat = 0 + THEN niltask + ELSE stat/std printer name + FI +END PROC printer + +END PACKET mpg print cmd; + +(************************ EDIT MONITOR *************************) + +PACKET edit monitor DEFINES edit monitor, (* Lutz Prechelt *) + F, (* Carsten Weinholz *) + table: (* Thomas Clermont *) + (* EUMEL 1.8 *) + (* Version 4.4.1 *) + (* Multimonitor *) + (* Alphaeditor *) + (* 06.07.1987 *) + +LET command handling line = 18, (* muss > max file + 1 und < 23 sein *) + max file = 15, (* max. 20 *) + file type = 1003, + min lines per segment = 24, (* darunter wird reorganisiert *) + integer is allowed = 3, + no command = 4711, + gib kommando 1 = "Gib Edit-Monitor ", + gib kommando 2 = " Kommando :"; + +TEXT CONST command list ::"quitmonitor:1.0edit:2.1run:3.1insert:4.1" + + "forget:5.1rename:6.2copy:7.2fetch:8.1" + + "save:9.1close:10.1fileinfo:11.0reorganize:12.1"; + +LET EDITTABLE = ROW max file STRUCT (THESAURUS line table, + TEXT name, + FILE file ); + +LET nil code = 0, + edit code= 1, + do code = 2; + +INT VAR command index, number of params, command indices, + aufruftiefe :: 0,zeile; + +TEXT VAR param 1, param 2, old command :: "", command line :: ""; +BOOL VAR short command, info :: FALSE,verlasse monitor :: FALSE; +INITFLAG VAR this monitor; + +EDITTABLE VAR etb; + +PROC edit monitor : + TEXT VAR ch, old lernsequenz :: lernsequenz auf taste ("Q"); + INT VAR i, previous heap size :: heap size; + disable stop; + initialize; + get new table; + REP + prepare screen; + perhaps reorganize and get command; + execute command; + collect heap garbage if necessary + UNTIL verlasse monitor PER; + lernsequenz auf taste legen ("Q",old lernsequenz); + close all files if not nested. + +initialize : + lernsequenz auf taste legen ("Q",""1""8""1""12"quitmonitor"13""); + verlasse monitor := FALSE; + aufruftiefe INCR 1; + IF aufruftiefe > max file + THEN aufruftiefe DECR 1; + errorstop ("Editmonitor overflow: Bereits " + text (max file ) + "Monitore geoeffnet") + ELSE IF NOT initialized (this monitor) + THEN FOR i FROM 1 UPTO max file REP + etb [i].line table := empty thesaurus; + etb [i].name := "" + PER + FI; + FOR i FROM 1 UPTO max file REP + etb [i].name := name (etb [aufruftiefe].line table,i) + PER + FI. + +prepare screen : + calc command handling line; + put file info. + +calc command handling line: + out (""10""); (* down *) + INT VAR dummy, y; + get cursor (dummy, y); + FOR dummy FROM 1 UPTO y-22 REP + out (""10"") + PER; + zeile := max (command handling line, min (y + 1, 22)). + +perhaps reorganize and get command : + BOOL VAR anything reorganized :: FALSE, + was error :: FALSE ; + IF is error + THEN command line := old command; + out (""3""); (* up *) + put error; clear error; was error := TRUE + ELSE command line := "" + FI; + out ( " "); + out (gib kommando); + out (""13""10" "); + IF NOT was error THEN perhaps reorganize FI; + IF anything reorganized + THEN command index := no command; + LEAVE perhaps reorganize and get command + FI; + editget (command line, "", "fk", ch); + IF ch = ""27"k" + THEN out (""13""5""); + command line := old command; + out (" "); + editget (command line, "", "f", ch) + FI; + line; + old command := command line; + command index := cmd index (command line); + param position (LENGTH command line + 7); + IF (command index > 0 AND command index <= max file) + AND command indices > 0 + THEN short command := TRUE + ELSE short command := FALSE; + analyze command (command list, command line, integer is allowed, + command index, number of params,param 1, param 2) + FI. + +perhaps reorganize : + BOOL VAR interrupt; + ch := getcharety; + IF ch <> "" + THEN push (ch); LEAVE perhaps reorganize + FI; + ch := incharety (50); + IF ch <> "" + THEN type (ch); LEAVE perhaps reorganize + FI; + FOR i FROM 1 UPTO max file REP + reorganize (etb [i].name, anything reorganized, interrupt, i); + UNTIL interrupt OR anything reorganized PER. + +close all files if not nested : + aufruftiefe DECR 1; + command index := 0; (* Um die verschachtelten Aufrufe zu schuetzen *) + verlasse monitor := aufruftiefe = 0; + IF aufruftiefe > 0 + THEN FOR i FROM 1 UPTO max file REP + etb [i].name := name (etb [aufruftiefe].line table,i) + PER; + ELSE param 1 := ""; + param 2 := ""; + command line := ""; + old command := "" + FI. + +collect heap garbage if necessary : + IF heap size > previous heap size + 4 + THEN collect heap garbage; + previous heap size := heap size + FI +ENDPROC edit monitor; + +PROC put file info: + INT VAR i; + out (""1""); (* home *) + FOR i FROM 1 UPTO max file WHILE NOT is incharety REP + out (text (i, 2)); + out (" : "); + IF info + THEN show file info + FI; + IF etb [i].name <> "" + THEN out ("""" + etb [i].name + """") + FI; + out (""5""10""13"") + PER; + out(""5""); + cursor (1, zeile). + +show file info : + (* Falls fileinfo an, werden vor den Dateinamen bei FILEs die Anzahl von + Zeilen , Segmenten und Speicher angezeigt. *) + IF exists (etb [i].name) + THEN IF type (old (etb [i].name)) = file type + THEN out (text (lines (etb [i].file), 5)); + out (" "); + out (text (segments (etb [i].file), 4)); + out (" ") + ELSE out ( 11 * "=") + FI; + out (text (storage (old (etb [i].name)),5)) + ELIF etb [i].name <> "" + THEN out ( 16 * "=") + FI; + out (" "). + +END PROC put file info; + +PROC execute command : + enable stop; + IF command index = no command THEN LEAVE execute command FI; + IF short command THEN do edit monitor command (command index) + ELSE case selection FI. + +case selection : + SELECT command index OF + CASE 1 : (* quit *) verlasse monitor := TRUE + CASE 2 : edit (name from list (param 1)) + CASE 3 : run (name from list (param 1)) + CASE 4 : insert (name from list (param 1)) + CASE 5 : forget (name from list (param 1)); close (int (param1)) + CASE 6 : rename (name from list (param 1) , name from list (param 2)) + CASE 7 : copy (name from list (param 1), name from list (param 2)) + CASE 8 : fetch (name from list (param 1)) + CASE 9 : save (name from list (param 1)) + CASE 10: close (int (param 1)) + CASE 11: info := NOT info + CASE 12: reorganize (name from list (param 1)) + OTHERWISE do (command line) + END SELECT +END PROC execute command; + +PROC close (INT CONST n) : + IF (n > 0 AND n <= max file) CAND etb [n].name <> "" + THEN IF exists (etb [n].name) CAND type (old (etb [n].name)) = file type + THEN close (etb [n].file) + FI; + INT VAR id; + delete (etb [aufruftiefe].line table,etb [n].name,id); + etb [n].name := "" + FI +END PROC close; + +TEXT OP F (INT CONST nr) : + IF nr > 0 AND nr <= max file + THEN etb [nr].name + ELSE out (""7""); "" + FI +END OP F; + +OP F (INT CONST nr, TEXT CONST datei) : + IF nr > 0 AND nr <= max file + THEN etb [nr].name := datei; + insert (etb [aufruftiefe].line table,datei); + IF exists (datei) CAND type (old (datei)) = file type + THEN etb [nr].file := sequential file(modify, datei) + FI + ELSE out (""7"") + FI +END OP F; + +PROC get new table: + table (some (all + etb [aufruftiefe].line table + vorgaenger)). + + vorgaenger: + IF aufruftiefe = 1 + THEN empty thesaurus + ELSE etb [aufruftiefe - 1].line table + FI +END PROC get new table; + +THESAURUS PROC table : + THESAURUS VAR result :: emptythesaurus; + INT VAR i; + FOR i FROM 1 UPTO max file REP + IF exists (etb [i].name) AND NOT (result CONTAINS etb [i].name) + THEN insert (result, etb [i].name) + FI + PER; + result +END PROC table; + +PROC table (THESAURUS CONST new) : + INT VAR i, nr :: 1, dummy; + TEXT VAR t; + etb [aufruftiefe].line table := empty thesaurus; + FOR i FROM 1 UPTO max file REP + etb [i].name := "" + PER; + FOR i FROM 1 UPTO highest entry (new) REP + get (new, t, dummy); + IF t <> "" + THEN nr F t;nr INCR 1 + FI + UNTIL nr > max file PER +END PROC table; + +PROC do edit monitor command (INT CONST file nr) : + enable stop; + IF command indices = 1 + THEN try to edit or to execute + ELSE try alpha editor + FI. + +try to edit or to execute: + SELECT prepare edit (file nr) OF + CASE edit code: last param (etb [file nr].name); + edit (etb [file nr].file); + page + CASE do code : do (etb[file nr].name) + END SELECT. + +try alpha editor: + IF command indices <= 10 + THEN open sub editors; + IF groesster editor > 0 + THEN edit (1); + WHILE groesster editor > 0 REP + quit + PER; + page + FI + ELSE errorstop ("Maximal 10 Parallel-Editoren") + FI. + +open sub editors: + TEXT VAR num, edit cmd :: ""; + INT VAR ye :: 1, sub :: file nr, pass; + WHILE groesster editor > 0 REP + quit + PER; + FOR pass FROM 1 UPTO 2 REP + IF pass = 2 + THEN command line := edit cmd + FI; + scan (command line); + next symbol (num); (* skip ersten index *) + REP + INT VAR op code := prepare edit (sub); + IF pass = 1 + THEN SELECT op code OF + CASE nil code : command indices DECR 1 + CASE editcode : edit cmd CAT (num + " ") + CASE do code : edit cmd CAT (num + " "); + command indices DECR 1 + END SELECT + ELSE SELECT op code OF + CASE edit code: neuer editor + CASE do code: do (etb [sub].name); + IF groesster editor > 0 + THEN bild zeigen; + ueberschrift zeigen + FI + END SELECT + FI; + next symbol (num); + sub := int (num) + UNTIL num = "" PER; + sub := file nr; + PER. + + neuer editor: + open editor (groesster editor+1,etb [sub].file, TRUE, 1,ye,79,25-ye); + ye INCR (24 DIV command indices) + +END PROC do edit monitor command; + +INT PROC prepare edit (INT CONST file nr): + IF file nr > 0 AND file nr <= max file + THEN IF etb [file nr].name = "" + THEN get file name and open; + IF etb [file nr].name <> "" + THEN IF exists (etb [file nr].name) + THEN IF type (old (etb [file nr].name)) = file type + THEN edit code + ELSE nil code + FI + ELSE do code + FI + ELSE nil code + FI + ELIF NOT exists (etb [file nr].name) + THEN do code + ELIF type (old (etb [file nr].name)) <> file type + THEN nil code + ELSE modify (etb [file nr].file); + edit code + FI + ELSE errorstop ("Undefinierter Index [1;15]");nil code + FI. + +get file name and open : + cursor (4, file nr); + out (""5"? "); + editget (etb [file nr].name); + IF etb [file nr].name <> "" + THEN file nr F etb [file nr].name; + IF NOT exists (etb [file nr].name) + THEN out (""13""10""); + IF no (5 * ""2"" +"Datei neu einrichten") + THEN LEAVE prepare edit WITH nil code + ELSE kopple file an + FI + ELIF type (old (etb [file nr].name)) = file type + THEN kopple file an + FI + FI. + + kopple file an: + etb [file nr].file := sequential file (output, etb [file nr].name). + +END PROC prepare edit; + +(***************** Hilfsprozeduren *********************************) + +BOOL PROC is incharety : + TEXT VAR ch :: getcharety; + IF ch = "" + THEN FALSE + ELSE push (ch); + TRUE + FI +END PROC is incharety; + +TEXT PROC name from list (TEXT CONST name): + INT VAR i :: int (name); + IF (i > 0 AND i <= max file) + THEN etb [i].name + ELSE name + FI. +END PROC name from list; + +PROC reorganize (TEXT CONST datei, BOOL VAR reorganization processed, + interrupted, + INT CONST file nummer): + (* Reorganisiert nur , falls : + 1. Datei ein FILE ist + 2. FILE mindestens "min lines to reorganize" Zeilen hat + 3. FILE nicht im Schnitt "min lines per segment" Zeilen pro Segment hat + 4. kein Tastendruck erfolgt + *) + DATASPACE VAR ds; + FILE VAR in, out; + TEXT VAR t; + INT VAR actual line,i,x,y; + get cursor (x,y); + interrupted := FALSE; + IF NOT exists (datei) COR type (old (datei)) <> file type + THEN LEAVE reorganize + FI; + in := sequential file (modify, datei); + actual line := line no (in); + input (in); + IF (lines (in) < 120 CAND segments (in) < 6) COR + lines (in) DIV segments (in) >= min lines per segment + THEN modify (in); + to line (in,actual line); + LEAVE reorganize + FI; + disable stop; + ds := nilspace; + out := sequential file (output, ds); + IF info + THEN FOR i FROM 1 UPTO lines (in) REP + cursor (4, file nummer); + put (i); + getline (in, t); + putline (out, t); + IF is error COR is incharety THEN interrupt FI + PER + ELSE FOR i FROM 1 UPTO lines (in) REP + getline (in, t); + putline (out, t); + IF is error COR is incharety THEN interrupt FI + PER + FI; + copy attributes (in,out); + modify (out); + to line (out,actual line); + forget (datei, quiet); + copy (ds, datei); + forget (ds); + reorganization processed := TRUE. + +interrupt : + cursor (4, lines (in)); + forget (ds); + interrupted := TRUE; + cursor (x,y); + enable stop; + LEAVE reorganize. + +END PROC reorganize; + +INT PROC cmd index (TEXT CONST command line): + INT VAR type, result :: 0; + TEXT VAR num; + command indices := 0; + scan (command line); + REP + next symbol (num, type); + IF type = 3 (* Ziffernfolge *) + THEN IF command indices = 0 + THEN result := int (num) + FI; + command indices INCR 1 + ELIF type <> 7 + THEN command indices := 0 + FI + UNTIL type = 7 OR command indices = 0 PER; + result +END PROC cmd index; + +TEXT PROC gib kommando: + gib kommando 1 + text (aufruftiefe) + gib kommando 2 +END PROC gib kommando; + +END PACKET edit monitor; + +(******************************** MANAGER ******************************) + +PACKET mpg global manager DEFINES monitor, + break, + end global manager, + begin, + begin password, + manager message, + manager question, + free manager, + std manager, + mpg manager, + free global manager, + global manager : + + +LET ack = 0, + nak = 1, + error nak = 2, + message ack = 3, + question ack = 4, + second phase ack = 5, + false code = 6, + + begin code = 4, + password code = 9, + fetch code = 11, + save code = 12, + exists code = 13, + erase code = 14, + list code = 15, + all code = 17, + + killer code = 24, + + continue code = 100, + + error pre = ""7""13""10""5"Fehler : ", + cr lf = ""13""10""; + + +DATASPACE VAR ds := nilspace; + +BOUND STRUCT (TEXT fnam, write pass, read pass) VAR msg; +BOUND TEXT VAR reply msg; + +TASK VAR order task, last order task; + +FILE VAR list file; +INT VAR reply, order, last order, phase no; +TEXT VAR error message buffer :: "", + record, + fnam, + create son password :: "", + save write password, + save read password, + save file fnam; + +TEXT VAR std begin proc :: "checkoff;endglobalmanager(TRUE);" + + "warnings off;sysout("""");sysin("""");" + + "monitor"; +BOOL VAR is global manager, is break manager; + +PROC mpg manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + manager) : + IF online + THEN TEXT VAR dummy; + put ("Task-Passwort :"); + getsecretline (dummy); + IF dummy <> "" THEN taskpassword (dummy) FI; + put ("Beginn-Passwort:"); + getsecretline (dummy); + IF dummy <> "" THEN begin password (dummy) FI + FI; + is break manager := FALSE; + global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + manager) +END PROC mpg manager; + +PROC global manager : + mpg manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + std manager) +END PROC global manager; + +PROC global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, + TASK CONST) manager) : + is global manager := TRUE; + internal manager (PROC (DATASPACE VAR,INT CONST,INT CONST, + TASK CONST) manager) +END PROC global manager; + +PROC internal manager (PROC (DATASPACE VAR, INT CONST, INT CONST, + TASK CONST) manager) : + old break; + set autonom; + disable stop; + command dialogue (FALSE); + last order task := niltask; + remember heap size; + REP + wait (ds, order, order task); + IF order <> second phase ack + THEN prepare first phase; + manager (ds, order, phase no, order task) + ELIF order task = last order task + THEN prepare second phase; + manager (ds, order, phase no, order task) + ELSE send nak FI; + send error if necessary; + collect heap garbage if necessary + UNTIL (NOT is global manager) AND (NOT is break manager) + PER; + command dialogue (TRUE); + reset autonom. + +send error if necessary : + IF is error + THEN forget (ds); + ds := nilspace; + reply msg := ds; + CONCR (reply msg) := error message; + clear error; + send (order task, error nak, ds) + FI . + +remember heap size : + INT VAR old heap size := heap size . + +collect heap garbage if necessary : + IF heap size > old heap size + 2 + THEN collect heap garbage; + old heap size := heap size + FI . + +prepare first phase : + phase no := 1; + last order := order; + last order task := order task. + +prepare second phase : + phase no INCR 1; + order := last order. + +send nak : + forget (ds); + ds := nilspace; + send (order task, nak, ds) +END PROC internal manager; + +PROC free global manager : + mpg manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + free manager) +END PROC free global manager; + +PROC std manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + IF (order = begin code AND task darf beginnen) COR + task darf senden + THEN free manager (ds, order, phase, order task) + ELSE errorstop ("Kein Zugriffsrecht auf Task """ + name (myself) + """") + FI. + + task darf beginnen: + (task ist systemtask OR task ist sohn) AND is global manager. + + task darf senden: + task ist systemtask OR task ist sohn. + + task ist systemtask: + ordertask < supervisor OR ordertask = supervisor. + + task ist sohn: + order task < myself +END PROC std manager; + +PROC free manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + enable stop; + IF order > continue code AND + order task = supervisor THEN y maintenance + ELIF order = begin code AND is global manager + THEN y begin + ELSE file manager order + FI . + +file manager order : + get message text if there is one; + SELECT order OF + CASE fetch code : y fetch + CASE save code : y save + CASE exists code : y exists + CASE erase code : y erase + CASE list code : y list + CASE all code : y all + CASE killer code : y killer + OTHERWISE errorstop ("Falscher Auftrag fuer Task """ + name (myself) + """") + ENDSELECT . + +get message text if there is one : + IF order >= fetch code AND order <= erase code AND phase = 1 (* 28.6.'86 *) + THEN msg := ds; + fnam := msg.fnam + FI . + +y begin : + BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg := ds; + IF create son password = sv msg.tpass AND create son password <> "-" + THEN create son task + ELIF sv msg.tpass = "" + THEN ask for password + ELSE errorstop ("Passwort falsch") + FI . + +create son task : + begin (ds, PROC std begin, reply); + send (order task, reply, ds) . + +ask for password : + send (order task, password code, ds) . + +y fetch : + IF read permission (fnam, msg.read pass) COR order task < supervisor + THEN forget (ds); + ds := old (fnam); + send (order task, ack, ds) + ELSE errorstop ("Passwort falsch") + FI . + +y erase : + msg := ds; + fnam := msg.fnam; + IF NOT exists (fnam) + THEN manager message ("""" + fnam + """ existiert nicht", order task) + ELIF phase no = 1 + THEN manager question ("""" + fnam + """ loeschen", order task) + ELIF write permission (fnam, msg.write pass) COR order task < supervisor + THEN forget (fnam, quiet); + send (order task, ack, ds) + ELSE errorstop ("Passwort falsch") FI . + +y save : + IF phase no = 1 + THEN ysave pre + ELSE y save post FI. + +y save pre : + IF write permission (fnam, msg.write pass) COR order task < supervisor + THEN save file fnam := fnam; + save write password := msg.write pass; + save read password := msg.read pass; + IF exists (fnam) + THEN manager question (""""+fnam+""" ueberschreiben", order task) + ELSE send (order task, second phase ack, ds) + FI; + ELSE errorstop ("Passwort falsch") + FI . + +y save post : + forget (save file fnam, quiet); + copy (ds, save file fnam); + enter password (save file fnam, + save write password, save read password); + forget (ds); + ds := nilspace; + send (order task, ack, ds); + cover tracks of save passwords. + +cover tracks of save passwords : + replace (save write password, 1, LENGTH save write password * " "); + replace (save read password, 1, LENGTH save read password * " ") . + +y exists : + IF exists (fnam) + THEN send (order task, ack, ds) + ELSE send (order task, false code, ds) + FI. + +y list : + forget (ds); + ds := nilspace; + list file := sequential file (output, ds); + list (list file); + send (order task, ack, ds) . + +y all : + BOUND THESAURUS VAR all fnams := ds; + all fnams := all; + send (order task, ack, ds) . + +y maintenance : + TEXT VAR param 1, param 2; + INT VAR c index, nr of params; + TEXT CONST c list :: "break:1.0end:2.0monitor:3.0stdbeginproc:4.1"; + disable stop; + call (supervisor, order, ds, reply); + forget (ds); + IF reply = ack + THEN IF is break manager + THEN end global manager (TRUE); + LEAVE y maintenance + FI; + put error message if there is one; + REP + command dialogue (TRUE); + get command ("Gib " + name (myself) + "-Kommando :"); + analyze command (c list,0,c index,nr of params,param 1,param 2); + SELECT c index OF + CASE 1 : old break + CASE 2, 3 : is global manager := FALSE; + is break manager := FALSE; + LEAVE y maintenance + CASE 4 : std begin proc := param 1 + OTHERWISE do command + END SELECT + UNTIL NOT on line PER; + command dialogue (FALSE); + old break; + set autonom; + save error message if there is one + FI; + enable stop . + +put error message if there is one : + IF error message buffer <> "" + THEN out (error pre); + out (error message buffer); + out (cr lf); + error message buffer := "" + FI. + +save error message if there is one : + IF is error + THEN error message buffer := error message; + clear error + FI. + +y killer : + FILE VAR f :: sequential file (input, ds); + WHILE NOT eof (f) REP + getline (f, record); + IF exists (record) THEN forget (record, quiet) FI + PER; + send (order task, ack, ds). +ENDPROC free manager; + +PROC manager question (TEXT CONST question) : + forget (ds); + ds := nilspace; + reply msg := ds; + reply msg := question; + send (order task, question ack, ds) +END PROC manager question; + +PROC manager question (TEXT CONST question, TASK CONST receiver) : + forget (ds); + ds := nilspace; + reply msg := ds; + reply msg := question; + send (receiver, question ack, ds) +END PROC manager question; + +PROC manager message (TEXT CONST message) : + forget (ds); + ds := nilspace; + reply msg := ds; + reply msg := message; + send (order task, message ack, ds) +END PROC manager message; + +PROC manager message (TEXT CONST message, TASK CONST receiver) : + forget (ds); + ds := nilspace; + reply msg := ds; + reply msg := message; + send (receiver, message ack, ds) +END PROC manager message; + +PROC std begin : + do (std begin proc) +ENDPROC std begin; + +PROC begin (TEXT CONST task name) : + TASK VAR sohn; + begin (task name, PROC monitor, sohn) +END PROC begin; + +PROC begin password (TEXT CONST password) : + cover tracks of old create son password; + create son password := password; + display (""3""13""5""); + cover tracks. + +cover tracks of old create son password: + replace (create son password,1,LENGTH create son password * " ") +END PROC begin password; + +PROC end global manager (BOOL CONST ende) : + is global manager := NOT ende; + is break manager := NOT ende +ENDPROC end global manager; + +PROC old break : + eumel must advertise; + supervisor call (6) +END PROC old break; + +PROC break : + IF is global manager + THEN old break; LEAVE break + FI; + is break manager := TRUE; + is global manager := FALSE; + internal manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + std manager) +END PROC break; + +PROC supervisor call (INT CONST nr) : + DATASPACE VAR sv space :: nilspace; + INT VAR answer; + call (supervisor, nr, sv space, answer); + IF answer = error nak + THEN BOUND TEXT VAR err msg :: sv space; + forget (sv space); errorstop (err msg) + FI; + forget (sv space) +END PROC supervisor call; + + + +LET cmd list = + +"edit:1.01end:3.0run:4.01runagain:6.0insert:7.01forget:9.01rename:11.2copy:12.2 +list:13.0storageinfo:14.0taskinfo:15.0fetch:16.1save:17.01saveall:19.0"; + + +INT VAR cmd index , params , previous heap size ; +TEXT VAR param1, param2 ; + + +PROC monitor : + disable stop ; + previous heap size := heap size ; + REP + command dialogue (TRUE); + sysin (""); + sysout (""); + cry if not enough storage; + get command ("gib kommando :"); + analyze command (cmd list, 4, cmd index, params, param1, param2); + execute command ; + collect heap garbage if necessary + PER . + +collect heap garbage if necessary : + IF heap size > previous heap size + 4 + THEN collect heap garbage ; + previous heap size := heap size + FI. + +cry if not enough storage : + INT VAR size, used; + storage (size, used); + IF used > size + THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10"") + FI. +ENDPROC monitor ; + +PROC execute command : + enable stop ; + SELECT cmd index OF + CASE 1 : edit + CASE 2 : edit (param1) + CASE 3 : end + CASE 4 : run + CASE 5 : run (param1) + CASE 6 : run again + CASE 7 : insert + CASE 8 : insert (param1) + CASE 9 : forget + CASE 10: forget (param1) + CASE 11: rename (param1, param2) + CASE 12: copy (param1, param2) + CASE 13: list + CASE 14: storage info + CASE 15: task info + CASE 16: fetch (param1) + CASE 17: save + CASE 18: save (param1) + CASE 19: save all + OTHERWISE do command + ENDSELECT . + +ENDPROC execute command ; + +END PACKET mpg global manager + diff --git a/app/mpg/2.2/src/VC 404 2-7.GCONF b/app/mpg/2.2/src/VC 404 2-7.GCONF new file mode 100644 index 0000000..b70c9e5 --- /dev/null +++ b/app/mpg/2.2/src/VC 404 2-7.GCONF @@ -0,0 +1,93 @@ +INCLUDE "terminal plot"; +INCLUDE "std primitives"; + +PLOTTER "VC 404",2,7,78,47,21.5,16.0; + +COLORS "000999"; + +PROC clear: + IF plot + THEN INT VAR vc i; + FOR vc i FROM 1 UPTO 24 + REP display [vc i] := empty line PER; + page + ELSE errorstop ("PROC clear : clear without plotmodus") FI +END PROC clear; + +PROC prepare: + break(quiet); + REP + disable stop; + continue (channel(plotter)); + clear error; + enable stop; + IF NOT online + THEN pause (300) + FI + UNTIL online PER +END PROC prepare; + +PROC initplot: + plot := TRUE; + cursor (x pos + 1, 24 - (y pos) DIV 2) +END PROC initplot; + +PROC endplot: + pause; + plot := FALSE +END PROC endplot; + +PROC home: + move to (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + x pos := x ; + y pos := y +END PROC moveto; + +PROC drawto (INT CONST x,y): + new x pos := x; + new y pos := y; + plot vector (new x pos - x pos, new y pos - y pos) ; +END PROC drawto; + +PROC setpixel (INT CONST x,y): + move to (x,y); + point +END PROC setpixel; + +PROC foreground (INT VAR type): + type := 1 +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1,y1,x2,y2,pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): +END PROC fill; + + + + + + + + + + + + + diff --git a/app/mpg/2.2/src/VIDEOSTAR 3-6.GCONF b/app/mpg/2.2/src/VIDEOSTAR 3-6.GCONF new file mode 100644 index 0000000..9accb3f --- /dev/null +++ b/app/mpg/2.2/src/VIDEOSTAR 3-6.GCONF @@ -0,0 +1,92 @@ +INCLUDE "std primitives"; + +PLOTTER "VIDEOSTAR",3,6,640,480,27.0,19.5; + +COLORS "000999"; + +TEXT PROC koordinaten (INT CONST x,y): + code(32+((y DIV 32) AND 31)) + code(96+(y MOD 32)) + + code(32+((x DIV 32) AND 31)) + code(64+(x MOD 32)) +END PROC koordinaten; + +PROC clear: + out (""29""27""140""27"/0d"); + moveto(0,0) +END PROC clear; + +PROC prepare: + break(quiet); + REP + disable stop; + continue (channel(plotter)); + clear error; + enable stop; + IF NOT online + THEN pause (300) + FI + UNTIL online PER +END PROC prepare; + +PROC initplot: +END PROC initplot; + +PROC endplot: + pause; + out(""24"") +END PROC endplot; + +PROC home: + moveto (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + out (""29""29""); + out (koordinaten (x,y)) +END PROC moveto; + +PROC drawto (INT CONST x,y): + out (koordinaten(x,y)) +END PROC drawto; + +PROC setpixel (INT CONST x,y): + out (""28""); + out (koordinaten (x,y)) +END PROC setpixel; + +PROC foreground (INT VAR type): + IF type = 0 THEN out (""27"/1d") (* loeschend *) + ELIF type < 0 THEN out (""27"/2d");type := -1 (* XOR *) + ELSE out (""27"/0");type := 1 (* normal *) + FI +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + IF full circle inside screen + THEN out (""29"" + koordinaten(x, y) + ""27"C" + + subtext (koordinaten(0,rad),1,3) + ""28""); + ELSE std circle (x,y,rad,from,to) + FI. + + full circle inside screen: + (from = 0 AND to = 360) AND + (x + rad) < 640 AND (x - rad >= 0) AND + (y + rad) < 480 AND (y - rad >= 0) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1, y1, x2, y2, pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): + moveto (x,y); + out (""27"F"); +END PROC fill; + + diff --git a/app/mpg/2.2/src/WATANABE 3-8.GCONF b/app/mpg/2.2/src/WATANABE 3-8.GCONF new file mode 100644 index 0000000..66e4856 --- /dev/null +++ b/app/mpg/2.2/src/WATANABE 3-8.GCONF @@ -0,0 +1,94 @@ +INCLUDE "std primitives"; +PLOTTER "WATANABE",3,8,3449,2599,34.5,26.0; + +COLORS "999000900009090000990"; + +LET terminator = ""13""; +TEXT VAR watanabe polygon :: ""; + +PROC watanabe pen (INT CONST nummer): + draw watanabe polygon; + INT VAR pen no := nummer; + IF pen no > 6 OR pen no < 0 + THEN pen no := 1 + FI; + out ("J" + text(pen no) + terminator) +END PROC watanabe pen; + +PROC draw watanabe polygon: + IF watanabe polygon <> "" + THEN out ("D" + subtext (watanabe polygon,2) + terminator) + FI; + watanabe polygon := "" +END PROC draw watanabe polygon; + +PROC prepare: + continue (channel (plotter)) +END PROC prepare; + +PROC initplot: + watanabe polygon := ""; + TEXT VAR watanabe wait; + REP + UNTIL incharety = "" PER; + out("M1500,1500"13""); (* Signal ! *) + inchar(watanabe wait); + disable stop +END PROC initplot; + +PROC endplot: + watanabe pen (0); + home; + IF is error + THEN break (quiet) + FI; + enable stop +END PROC endplot; + +PROC clear: + watanabe pen (1) +END PROC clear; + +PROC home: + draw watanabe polygon; + out ("H" + terminator) +END PROC home; + +PROC moveto (INT CONST x,y): + draw watanabe polygon; + out ( "M" + text(x) + "," + text(y) + terminator) +END PROC moveto; + +PROC drawto (INT CONST x,y): + watanabe polygon CAT "," + text (x) + "," + text (y) +END PROC drawto; + +PROC setpixel (INT CONST x,y): + move to (x,y); + out ("N1" + terminator) +END PROC setpixel; + +PROC foreground (INT VAR type): + type := min (max (type, 0), 6); + watanabe pen (type) +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1,y1,x2,y2,pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): +END PROC fill; + + diff --git a/app/mpg/2.2/src/ZEICHENSATZ b/app/mpg/2.2/src/ZEICHENSATZ new file mode 100644 index 0000000..0414682 Binary files /dev/null and b/app/mpg/2.2/src/ZEICHENSATZ differ diff --git a/app/mpg/2.2/src/matrix printer b/app/mpg/2.2/src/matrix printer new file mode 100644 index 0000000..66157cf --- /dev/null +++ b/app/mpg/2.2/src/matrix printer @@ -0,0 +1,130 @@ +(* Version vom 21.10.87 BJ *) +(* Standardoperationen *) +(* printer line - Linienalgorithmus *) +(* printer fill - Fuellalgorithmus *) + +PROC printer line (INT CONST x1,y1,x2,y2, + PROC (INT CONST, INT CONST) p set pixel): + INT VAR x,y,z, + a,b,d, + dx :: abs(x2-x1), + dy :: abs(y2-y1), + dp,dq; + IF dx <> 0 AND dy <> 0 + THEN IF dy <= dx + THEN draw line 1 + ELSE draw line 2 + FI + ELSE IF dx = 0 AND dy <> 0 + THEN draw vertical line + ELSE draw horizontal line + FI + FI. + + draw line 1: + x := x1; + y := y1; + z := x2; + a := sign(x2-x1); + b := sign(y2-y1); + dp := dy * 2; + d := dp - dx; + dq := dp - 2 * dx; + setpoint; + WHILE x <> z REP + x := x + a; + IF d < 0 + THEN d := d + dp + ELSE y := y + b; + d := d + dq + FI; + setpoint + PER. + + draw line 2: + x := x1; + y := y1; + z := y2; + b := sign(x2-x1); + a := sign(y2-y1); + dp := dx * 2; + d := dp - dy; + dq := dp - 2 * dy; + setpoint; + WHILE y <> z REP + y := y + a; + IF d < 0 + THEN d := d + dp + ELSE x := x + b; + d := d + dq + FI; + setpoint + PER. + + draw vertical line: + a := sign(y2-y1); + x := x1; + y := y1; + z := y2; + setpoint; + WHILE y <> z REP + y := y + a; + setpoint + PER. + + draw horizontal line: + a := sign(x2-x1); + x := x1; + y := y1; + z := x2; + setpoint; + WHILE x <> z REP + x := x + a; + setpoint + PER. + + setpoint: + p set pixel (x,y) +END PROC printer line; + +PROC printer fill (INT CONST xl, xr, y, dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset): + INT VAR xl1 :: xl; + WHILE point(xl1,y) REP + xl1 INCR 1; + IF xl1 >= xr + THEN LEAVE printer fill + FI + PER; + INT VAR xrn :: xl1+1, + xln :: xl1; + WHILE NOT point(xrn,y) REP + pset(xrn,y); + xrn INCR 1 + PER; + WHILE NOT point(xln,y) REP + pset(xln,y); + xln DECR 1 + PER; + IF xrn > xr + THEN printer fill (xr, xrn-1,y-dir,-dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) + ELSE printer fill (xrn, xr, y, dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) + FI; + IF xln < xl + THEN printer fill (xln+1,xl, y-dir,-dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) + ELSE printer fill (xl,xln, y, dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) + FI; + printer fill(xln+1, xrn-1, y+dir, dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) +END PROC printer fill; + diff --git a/app/mpg/2.2/src/printer.targets b/app/mpg/2.2/src/printer.targets new file mode 100644 index 0000000..c4e4e53 --- /dev/null +++ b/app/mpg/2.2/src/printer.targets @@ -0,0 +1,3 @@ +2/NEC P 9\#fonttab.nec.p9 +3/NEC P 3\#fonttab.nec.p3-2 + diff --git a/app/mpg/2.2/src/std primitives b/app/mpg/2.2/src/std primitives new file mode 100644 index 0000000..ab3877c --- /dev/null +++ b/app/mpg/2.2/src/std primitives @@ -0,0 +1,80 @@ +PROC std circle (INT CONST xp,yp,r,from,to): + moveto (xp,yp); + REAL VAR ang :: real (from MOD 360), + rad :: real(r), + max :: endwinkel, + cx :: real (xp), + cy :: real (yp), + ax0 :: cx, + ay0 :: cy, + ax1, ay1; + + BOOL VAR fullcircle :: ang = 0.0 AND max = 360.0; + IF fullcircle + THEN move to (int (cx + rad * cosd (ang)+0.5), + int (cy + rad * -sind (ang)+0.5)); + ang INCR 1.0 + FI; + WHILE ang <= max REP + ax1 := cx + rad * cosd (ang); + ay1 := cy + rad * -sind (ang); + draw arc; + ang INCR 1.0 + PER; + IF NOT fullcircle + THEN ax0 := cx; + ay0 := cy; + draw arc; + draw to (xp,yp) + ELSE move to (xp,yp) + FI. + + draw arc: + IF clipped line (ax0,ay0,ax1,ay1) + THEN draw to (int (ax1+0.5), int (ay1+0.5)) + FI; + ax0 := ax1; + ay0 := ay1. + + endwinkel: + IF (to MOD 360) = 0 + THEN 360.0 + ELSE real (to MOD 360) + FI +END PROC std circle; + +PROC std box (INT CONST x0, y0, x1, y1, pattern): + REAL VAR xx0 :: real (x0), + yy0 :: real (y0), + xx1 :: real (x0), + yy1 :: real (y1); + IF clipped line (xx0,yy0,xx1,yy1) + THEN moveto (int (xx0), int (yy0)); + drawto (int (xx1), int (yy1)) + FI; + xx0 := real (x0); + yy0 := real (y1); + xx1 := real (x1); + yy1 := real (y1); + IF clipped line (xx0,yy0,xx1,yy1) + THEN moveto (int (xx0), int (yy0)); + drawto (int (xx1), int (yy1)) + FI; + xx0 := real (x1); + yy0 := real (y1); + xx1 := real (x1); + yy1 := real (y0); + IF clipped line (xx0,yy0,xx1,yy1) + THEN moveto (int (xx0), int (yy0)); + drawto (int (xx1), int (yy1)) + FI; + xx0 := real (x1); + yy0 := real (y0); + xx1 := real (x0); + yy1 := real (y0); + IF clipped line (xx0,yy0,xx1,yy1) + THEN moveto (int (xx0), int (yy0)); + drawto (int (xx1), int (yy1)) + FI +END PROC std box; + diff --git a/app/mpg/2.2/src/terminal plot b/app/mpg/2.2/src/terminal plot new file mode 100644 index 0000000..21a17ff --- /dev/null +++ b/app/mpg/2.2/src/terminal plot @@ -0,0 +1,114 @@ +(* Prozeduren zur Ausgabe auf ASCII-Terminals *) +INT CONST up := 1 , + right := 1 , + down := -1 , + left := -1 ; + +INT VAR x pos := 0 , + y pos := 0 , + new x pos , + new y pos ; + +BOOL VAR plot := FALSE; +TEXT CONST empty line :: 79 * " "; +ROW 24 TEXT VAR display; + + +PROC plot vector (INT CONST dx , dy) : + + IF dx >= 0 + THEN IF dy > dx THEN vector (y pos, x pos, dy, dx, up, right) + ELIF dy > 0 THEN vector (x pos, y pos, dx, dy, right, up) + + ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down) + ELSE vector (y pos, x pos, -dy, dx, down, right) + FI + ELSE IF dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left) + ELIF dy > 0 THEN vector (x pos, y pos, -dx, dy, left, up) + + ELIF dy > dx THEN vector (x pos, y pos, -dx, -dy, left, down) + ELSE vector (y pos, x pos, -dy, -dx, down, left) + FI + FI . + +ENDPROC plot vector ; + +PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) : + + prepare first step ; + INT VAR i ; + FOR i FROM 1 UPTO dx REP + do one step + PER . + +prepare first step : + point; + INT VAR old error := 0 , + up right error := dy - dx , + right error := dy . + +do one step : + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR right ; + y pos INCR up ; + point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + point ; + old error INCR right error . + +ENDPROC vector ; + + +PROC point : + IF x pos < 1 + THEN x pos := 1 + ELIF x pos > 78 + THEN x pos := 78 FI; + + IF y pos < 1 + THEN y pos := 1 + ELIF y pos > 47 + THEN y pos := 47 FI; + + INT CONST line :: y pos DIV 2; + BOOL CONST above :: (y pos MOD 2) = 1; + TEXT CONST point :: display [line+1] SUB (x pos+1), + new point :: calculated point; + + replace (display [line+1], x pos+1, new point); + cursor (x pos, 24-line); + out (new point) . + +calculated point : + IF above + THEN IF point = "," OR point = "|" + THEN "|" + ELSE "'" FI + ELSE IF point = "'" OR point = "|" + THEN "|" + ELSE "," FI + FI + +END PROC point; + +REAL CONST real max int := real (max int); +INT PROC round (REAL CONST x) : + IF x > real max int + THEN max int + ELIF x < 0.0 + THEN 0 + ELSE int (x + 0.5) FI + +END PROC round; + diff --git a/app/schulis-mathematiksystem/1.0/source-disk b/app/schulis-mathematiksystem/1.0/source-disk new file mode 100644 index 0000000..64e5484 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/source-disk @@ -0,0 +1 @@ +schulis-mathematiksystem-1.0/04_mathematiksystem.img diff --git a/app/schulis-mathematiksystem/1.0/src/PAC element row b/app/schulis-mathematiksystem/1.0/src/PAC element row new file mode 100644 index 0000000..574160c --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC element row @@ -0,0 +1,3 @@ +PACKETelementrowDEFINES ELEMROW,:=,clear,length,insert,delete,append,remove,define,recall,field,pos,sup,inf,min,max,MIN,MAX,EXC,:LETminelement=1,maxelement=1000;LETminfield=1,maxfield=4;TYPE ELEMROW=STRUCT(INTused,ROWmaxelementROWmaxfieldINTf);OP:=(ELEMROW VARd,ELEMROW CONSTs):CONCR(d):=CONCR(s);END OP:=;PROCclear(ELEMROW VARt):t.used:=0;END PROCclear;INT PROClength(ELEMROW CONSTt):t.usedEND PROClength;PROCinsert(ELEMROW VARt,INT CONSTk):insert(t,k,0,0,0,0);END PROCinsert;PROCinsert(ELEMROW VARt,INT CONSTk,INT CONSTa,b,c,d):checkelement(k," bei 'insert'");checkfilled(t.used," bei 'insert'");INT VARi:=t.used;WHILEi>=kREPt.f[i+1]:=t.f[i];iDECR1PER;t.usedINCR1;t.f[k][1]:=a;t.f[k][2]:=b;t.f[k][3]:=c;t.f[k][4]:=d;END PROCinsert;PROCdelete(ELEMROW VARt,INT CONSTk):IFkt.usedTHEN LEAVEdeleteFI;INT VARi:=k;WHILEit.usedTHEN LEAVEdeleteFI;a:=t.f[k][1];b:=t.f[k][2];c:=t.f[k][3];d:=t.f[k][4];INT VARi:=k;WHILEit.usedTHENa:=0;b:=0;c:=0;d:=0;LEAVErecallFI;a:=t.f[k][1];b:=t.f[k][2];c:=t.f[k][3];d:=t.f[k][4];END PROCrecall;PROCfield(ELEMROW VARt,INT CONSTk,n,INT CONSTv):checkelement(k," bei 'field'");checkfield(n," bei 'field'");WHILEt.usedt.usedORnmaxfieldTHEN LEAVEfieldWITH0;FI;t.f[k][n]END PROCfield;PROCcheckempty(INT CONSTu,TEXT CONSTmsg):IFu=maxelementTHENerrorstop("Element-Anzahl = "+text(u)+" >= "+text(maxelement)+msg)FI;END PROCcheckfilled;PROCcheckelement(INT CONSTn,TEXT CONSTmsg):IFnmaxelementTHENerrorstop("Element-Nummer = "+text(n)+" > "+text(maxelement)+msg)FI;END PROCcheckelement;PROCcheckfield(INT CONSTn,TEXT CONSTmsg):IFnmaxfieldTHENerrorstop("Feld-Nummer = "+text(n)+" > "+text(maxfield)+msg)FI;END PROCcheckfield;INT PROCpos(ELEMROW CONSTt,INT CONSTa,b,c,d):pos(t,a,b,c,d,1)END PROCpos;INT PROCpos(ELEMROW CONSTt,INT CONSTa,b,c,d,INT CONSTbeg):INT VARp:=1MAXbegMINt.used+1;WHILEp<=t.usedREP IFt.f[p][1]=aANDt.f[p][2]=bANDt.f[p][3]=cANDt.f[p][4]=dTHEN LEAVEposWITHp;FI;pINCR1;PER;0END PROCpos;INT PROCsup(ELEMROW CONSTt,INT CONSTxp,yp):sup(t,xp,yp,xp,yp,1)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxp,yp,INT CONSTbeg):sup(t,xp,yp,xp,yp,beg)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye):sup(t,xb,yb,xe,ye,1)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye,INT CONSTbeg):INT VARp:=1MAXbegMINt.used+1;WHILEp<=t.usedREP IFt.f[p][1]<=xbANDt.f[p][2]<=ybANDt.f[p][3]>=xeANDt.f[p][4]>=yeTHEN LEAVEsupWITHp;FI;pINCR1;PER;0END PROCsup;INT PROCinf(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye):inf(t,xb,yb,xe,ye,t.used)END PROCinf;INT PROCinf(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye,INT CONSTend):INT VARp:=0MAXendMINt.used;WHILEp>=1REP IFt.f[p][1]<=xbANDt.f[p][2]<=ybANDt. +f[p][3]>=xeANDt.f[p][4]>=yeTHEN LEAVEinfWITHp;FI;pDECR1;PER;0END PROCinf;PROCmin(ELEMROW CONSTt,INT CONSTp,q,INT VARxb,yb,xe,ye):recall(t,p,xb,yb,xe,ye);min(t,q,xb,yb,xe,ye);END PROCmin;PROCmin(ELEMROW CONSTt,INT CONSTp,INT VARxb,yb,xe,ye):IFp<1ORp>t.usedTHEN LEAVEminFI;INT VARxl,yl,xh,yh;recall(t,p,xl,yl,xh,yh);xb:=xlMAXxb;yb:=ylMAXyb;xe:=xhMINxe;ye:=yhMINye;END PROCmin;PROCmax(ELEMROW CONSTt,INT CONSTp,q,INT VARxb,yb,xe,ye):recall(t,p,xb,yb,xe,ye);max(t,q,xb,yb,xe,ye);END PROCmax;PROCmax(ELEMROW CONSTt,INT CONSTp,INT VARxb,yb,xe,ye):IFp<1ORp>t.usedTHEN LEAVEmaxFI;INT VARxl,yl,xh,yh;recall(t,p,xl,yl,xh,yh);xb:=xlMINxb;yb:=ylMINyb;xe:=xhMAXxe;ye:=yhMAXye;END PROCmax;INT OP MIN(INT CONSTa,b):IFabTHENaELSEbFI END OP MAX;OP EXC(INT VARa,b):INT CONSTd:=a;a:=b;b:=d;END OP EXC;END PACKETelementrow; + diff --git a/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer b/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer new file mode 100644 index 0000000..84d90c5 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer @@ -0,0 +1,9 @@ +PACKETformulaanalyzerDEFINESclearformulaspaces,opindex,regenerateformula,arithnotation,printnotation,formulacomplexity,removeformulaobj,appendformulaobj,insertformulaobj,insertformulapars,createformulaobj,adjoinformulaobj,adjoinformulapars,getformulaposition,formulaposition,getformulanode,formulanode,getformulaterm,defformulaterm,formulaterm,getformulapos,defformulapos,formulabeg,formulaend,formulaindex,getformulaaddress,defformulaaddress,formulaaddress,getformulatree,defformulatree,expand,compress,getformulabox,defformulabox,getformulaobject,defformulaobject,getformulalength,getformula,writeformula,clearformula,outformula,out,:LETnilidx=0;INT VARnillbp,nilrbp;TEXT VARnilari;LETatomidx=1;INT VARatomlbp,atomrbp;TEXT VARatomari;LETtimesidx=2;INT VARtimeslbp,timesrbp;TEXT VARtimesari;LETapplyidx=3;INT VARapplylbp,applyrbp;TEXT VARapplyari;LETifidx=4;INT VARiflbp,ifrbp;TEXT VARifari;LETfiidx=5;INT VARfilbp,firbp;TEXT VARfiari;LETthenidx=6;INT VARthenlbp,thenrbp;TEXT VARthenari;LETelif1idx=7;INT VARelif1lbp,elif1rbp;TEXT VARelif1ari;LETelif2idx=8;INT VARelif2lbp,elif2rbp;TEXT VARelif2ari;LETelif3idx=9;INT VARelif3lbp,elif3rbp;TEXT VARelif3ari;LETmonadidx=10;INT VARprefixlbp,postfixrbp;LETlforceidx=11;INT VARlforcelbp,lforcerbp;TEXT VARlforceari;LETrforceidx=12;INT VARrforcelbp,rforcerbp;TEXT VARrforceari;LETlparidx=15;INT VARlparlbp,lparrbp;LETrparidx=16;INT VARrparlbp,rparrbp;LETinfixnpm=2;LETxmin=1,ymin=1,xmax=400,ymax=400,xsiz=400,ysiz=400;LET MEM=STRUCT(INTnodr,nodc,adrc,sp,ELEMROWstk,TEXTROWtrm,ELEMROWobj,ELEMROWadr,tre,alg,del,box);LET SCR=STRUCT(INTxbeg,ybeg,xend,yend,ROWysizTEXTrec);TEXT VARari:="",prt:="";INT VARanum:=0,alen:=0;BOOL VARariok,prtok,analyzeok;INITFLAG VARspacesok:=FALSE;DATASPACE VARmemds;BOUND MEM VARmem;DATASPACE VARscrds;BOUND SCR VARscr;INT VARdummy;TEXT VARemptyrec:=xsiz*" ";TEXT VARrec;PROCclearformulaspaces:disablestop;IFinitialized(spacesok)THENforget(memds);forget(scrds)FI;spacesok:=FALSE;END PROCclearformulaspaces;PROCinitformulaspaces:disablestop;IFinitialized(spacesok)THEN LEAVEinitformulaspacesFI;spacesok:=FALSE;enablestop;forget(memds);memds:=nilspace;mem:=memds;forget(scrds);scrds:=nilspace;scr:=scrds;ari:="";anum:=0;alen:=0;ariok:=FALSE;prt:="";prtok:=FALSE;mem.trm:=emptytextrow;clear(mem.obj);define(mem.obj,1,1,0,0,0);mem.nodr:=0;mem.nodc:=0;mem.adrc:=0;clear(mem.stk);mem.sp:=0;clear(mem.adr);clear(mem.tre);clear(mem.alg);clear(mem.del);clear(mem.box);scr.xbeg:=xmax+1;scr.ybeg:=ymax+1;scr.xend:=xmin-1;scr.yend:=ymin-1;analyzeok:=TRUE;spacesok:=TRUE;initops;END PROCinitformulaspaces;PROCgetfixedops:getoppower(nilidx,nillbp,nilrbp);nilari:=oparithsymbol(nilidx);getoppower(atomidx,atomlbp,atomrbp);atomari:=oparithsymbol(atomidx);getoppower(timesidx,timeslbp,timesrbp);timesari:=oparithsymbol(timesidx);getoppower(applyidx,applylbp,applyrbp);applyari:=oparithsymbol(applyidx);getoppower(ifidx,iflbp,ifrbp);ifari:=oparithsymbol(ifidx);getoppower(fiidx,filbp,firbp);fiari:=oparithsymbol(fiidx);getoppower(thenidx,thenlbp,thenrbp);thenari:=oparithsymbol(thenidx);getoppower(elif1idx,elif1lbp,elif1rbp);elif1ari:=oparithsymbol(elif1idx);getoppower(elif2idx,elif2lbp,elif2rbp);elif2ari:=oparithsymbol(elif2idx);getoppower(elif3idx,elif3lbp,elif3rbp);elif3ari:=oparithsymbol(elif3idx);getoppower(monadidx,prefixlbp,postfixrbp);getoppower(lforceidx,lforcelbp,lforcerbp);lforceari:=oparithsymbol(lforceidx);getoppower(rforceidx,rforcelbp,rforcerbp);rforceari:=oparithsymbol(rforceidx);getoppower(lparidx,lparlbp,lparrbp);getoppower(rparidx,rparlbp,rparrbp);END PROCgetfixedops;INT PROCopindex(TEXT CONSTamid,BOOL CONSTlft,rgt):INT VARidx:=opindex(amid);WHILEidx>atomidxAND(lftANDrgtANDopparams(idx)<>2OR NOTlftANDrgtANDoplbp(idx)<>lparlbpANDoplbp(idx)<>prefixlbpORlftAND NOTrgtANDoprbp(idx)<>rparrbpANDoprbp(idx)<>postfixrbp)REPidx:=opindex(amid,idx+1);PER;idxEND PROCopindex;PROCregenerateformula(INT VARnodc,adrc):initformulaspaces;mem.nodc:=nodc;mem.adrc:=adrc;ariok:=FALSE;ari:="";anum:=0;alen:=0;IFmem.nodr>0THENcatarith( +ari,anum,alen,mem.nodr,FALSE,FALSE)FI;ariok:=TRUE;prtok:=FALSE;analyzeok:=FALSE;analyzeformula;nodc:=mem.nodc;adrc:=mem.adrc;END PROCregenerateformula;PROCarithnotation(TEXT CONSTnewari):enablestop;initformulaspaces;IFariokANDnewari=ariTHEN LEAVEarithnotationFI;ariok:=TRUE;prtok:=FALSE;analyzeok:=FALSE;ari:=newari;alen:=LENGTHari;analyzeformula;END PROCarithnotation;TEXT PROCarithnotation:enablestop;IFariokTHEN LEAVEarithnotationWITHariFI;initformulaspaces;analyzeformula;TEXT CONSToldari:=ari;ariok:=FALSE;ari:="";anum:=0;alen:=0;IFmem.nodr>0THENcatarith(ari,anum,alen,mem.nodr,FALSE,FALSE)FI;ariok:=TRUE;IFari<>oldariTHENprtok:=FALSE;analyzeok:=FALSE FI;ariEND PROCarithnotation;TEXT PROCarithnotation(INT CONSTnod1):enablestop;initformulaspaces;analyzeformula;TEXT VARari:="";INT VARanum:=0;alen:=0;IFnod1>0THENcatarith(ari,anum,alen,nod1,FALSE,FALSE)FI;ariEND PROCarithnotation;TEXT PROCprintnotation:enablestop;IFprtokTHEN LEAVEprintnotationWITHprtFI;initformulaspaces;analyzeformula;prtok:=FALSE;prt:="";IFmem.nodr>0THENcatprint(prt,mem.nodr)FI;prtok:=TRUE;prtEND PROCprintnotation;TEXT PROCprintnotation(INT CONSTnod1):enablestop;initformulaspaces;analyzeformula;TEXT VARprt:="";IFnod1>0THENcatprint(prt,nod1)FI;prtEND PROCprintnotation;INT PROCformulacomplexity:initformulaspaces;mem.nodrEND PROCformulacomplexity;PROCgetformulaposition(INT CONSTapos,INT VARxpoi,ypoi):INT VARnod1,adr1;INT VARabeg,aend,idx;INT VARxdel,ydel;initformulaspaces;FORnod1FROM1UPTOmem.nodrREPadr1:=field(mem.adr,nod1,3);recall(mem.obj,adr1,abeg,aend,idx,dummy);IFapos>=abegANDapos<=aendTHENrecall(mem.del,nod1,xpoi,ypoi,xdel,ydel);xpoiINCRapos-abeg;LEAVEgetformulaposition;FI;PER;END PROCgetformulaposition;INT PROCformulaposition(INT CONSTxpoi,ypoi):INT VARnod1,adr1;INT VARxpos,ypos,xdel,ydel;INT VARabeg,aend,idx;initformulaspaces;nod1:=sup(mem.box,xpoi,ypoi);adr1:=field(mem.adr,nod1,3);recall(mem.del,nod1,xpos,ypos,xdel,ydel);recall(mem.obj,adr1,abeg,aend,idx,dummy);abegMAXabeg+xpoi-xposMINaendEND PROCformulaposition;INT PROCformulanode(INT CONSTapos):INT VARnod1,adr1;INT VARabeg,aend,idx;initformulaspaces;FORnod1FROM1UPTOmem.nodrREPadr1:=field(mem.adr,nod1,3);recall(mem.obj,adr1,abeg,aend,idx,dummy);IFapos>=abegANDapos<=aendTHEN LEAVEformulanodeWITHnod1;FI;PER;0END PROCformulanode;PROCgetformulanode(INT CONSTapos,INT VARnod1):nod1:=formulanode(apos);END PROCgetformulanode;INT PROCformulanode(INT CONSTxpoi,ypoi):initformulaspaces;sup(mem.box,xpoi,ypoi)END PROCformulanode;PROCgetformulanode(INT CONSTxpoi,ypoi,INT VARnod1):initformulaspaces;nod1:=sup(mem.box,xpoi,ypoi);END PROCgetformulanode;PROCdefformulaterm(INT CONSTadr1,TEXT CONSTsym):initformulaspaces;ariok:=FALSE;prtok:=FALSE;rename(mem.trm,adr1,sym);END PROCdefformulaterm;PROCdefformulaterm(INT CONSTadr1,TEXT CONSTsym,INT CONSTidx):initformulaspaces;ariok:=FALSE;prtok:=FALSE;rename(mem.trm,adr1,sym);field(mem.obj,adr1,3,idx);END PROCdefformulaterm;TEXT PROCformulaterm(INT CONSTadr1):initformulaspaces;name(mem.trm,adr1)END PROCformulaterm;PROCgetformulaterm(INT CONSTadr1,TEXT VARsym):sym:=formulaterm(adr1);END PROCgetformulaterm;PROCdefformulapos(INT CONSTadr1,INT CONSTabeg,aend,idx,dummy):initformulaspaces;define(mem.obj,adr1,abeg,aend,idx,dummy);END PROCdefformulapos;PROCgetformulapos(INT CONSTadr1,INT VARabeg,aend,idx,dummy):initformulaspaces;recall(mem.obj,adr1,abeg,aend,idx,dummy);END PROCgetformulapos;PROCgetformulapos(INT CONSTadr1,INT VARabeg,aend):INT VARidx;initformulaspaces;recall(mem.obj,adr1,abeg,aend,idx,dummy);END PROCgetformulapos;INT PROCformulabeg(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,1)END PROCformulabeg;INT PROCformulaend(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,2)END PROCformulaend;INT PROCformulaindex(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,3)END PROCformulaindex;PROCformulaindex(INT CONSTadr1,idx):initformulaspaces;field(mem.obj,adr1,3,idx)END PROCformulaindex;PROCdefformulaaddress(INT CONSTnod1,INT CONSTnod2,nodx,adr1,adr2):initformulaspaces;define( +mem.adr,nod1,nod2,nodx,adr1,adr2);END PROCdefformulaaddress;PROCgetformulaaddress(INT CONSTnod1,INT VARnod2,nodx,adr1,adr2):initformulaspaces;recall(mem.adr,nod1,nod2,nodx,adr1,adr2);END PROCgetformulaaddress;INT PROCformulaaddress(INT CONSTnod1):initformulaspaces;field(mem.adr,nod1,3)END PROCformulaaddress;PROCdefformulatree(INT CONSTnod1,INT CONSTlnod,rnod,pnod,inod):initformulaspaces;define(mem.tre,nod1,lnod,rnod,pnod,inod);END PROCdefformulatree;PROCgetformulatree(INT CONSTnod1,INT VARlnod,rnod,pnod,inod):initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);END PROCgetformulatree;PROCexpand(INT VARlnod,rnod):INT VARnod1;initformulaspaces;REPnod1:=lnod;lnod:=field(mem.tre,nod1,1)UNTILlnod=0PER;lnod:=nod1;REPnod1:=rnod;rnod:=field(mem.tre,nod1,2)UNTILrnod=0PER;rnod:=nod1;END PROCexpand;PROCcompress(INT VARlnod,rnod):expand(rnod,lnod);END PROCcompress;PROCdefformulabox(INT CONSTnod1,INT CONSTxbeg,ybeg,xend,yend):initformulaspaces;define(mem.box,nod1,xbeg,ybeg,xend,yend);END PROCdefformulabox;PROCgetformulabox(INT CONSTnod1,INT VARxbeg,ybeg,xend,yend):initformulaspaces;recall(mem.box,nod1,xbeg,ybeg,xend,yend);END PROCgetformulabox;PROCdefformulaobject(INT CONSTnod1,INT CONSTxobj,yobj,xdel,ydel):initformulaspaces;define(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCdefformulaobject;PROCgetformulaobject(INT CONSTnod1,INT VARxobj,yobj,xdel,ydel):initformulaspaces;recall(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCgetformulaobject;PROCgetformulaobject(INT CONSTnod1,INT VARxobj,yobj):INT VARxdel,ydel;initformulaspaces;recall(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCgetformulaobject;PROCcatarith(TEXT VARari,INT VARadrc,alen,INT CONSTnod1,BOOL CONSTforce,forcepending):INT VARnod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod;INT VARladr,radr;INT VARoidx,rbp,lbp;INT VARlidx,llbp,lrbp;INT VARridx,rlbp,rrbp;TEXT VARlsym,rsym;initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.adr,nod1,nod2,nodx,adr1,adr2);oidx:=field(mem.obj,adr1,3);IFnodx=2THENcatterm2;catarith(ari,adrc,alen,lnod,FALSE,FALSE);catterm1;ELIFnod1<>nod2THENrnod:=field(mem.tre,nod2,1);catterm1;catarith(ari,adrc,alen,rnod,FALSE,FALSE);catterm2;ELSE IFforceAND(lnod>0ORrnod>0)THENcatarith(ari,adrc,alen,lforceari);FI;getoppower(oidx,lbp,rbp);IFlnod>0THENcatleftparamFI;catterm1;IFrnod>0THENcatrightparamFI;IFforceAND(lnod>0ORrnod>0)THENcatarith(ari,adrc,alen,rforceari);FI;FI;.catterm1:catarith(ari,adrc,alen,name(mem.trm,adr1));IFnod1=mem.nodcTHENmem.adrc:=adrcFI;.catterm2:catarith(ari,adrc,alen,name(mem.trm,adr2));IFnod2=mem.nodcTHENmem.adrc:=adrcFI;.catleftparam:ladr:=field(mem.adr,lnod,4);lidx:=field(mem.obj,ladr,3);lsym:=name(mem.trm,ladr);getoppower(lidx,llbp,lrbp);IFlrbp=postfixrbpTHENlrbp:=llbpFI;IFoplforce(oidx)=0ANDopoforce(lidx)=0THENcatarith(ari,adrc,alen,lnod,FALSE,forcependingORlrbprlbp);ELIFforcependingORrbp>rlbpTHENcatarith(ari,adrc,alen,rnod,TRUE,FALSE);ELSEcatarith(ari,adrc,alen,rnod,FALSE,FALSE);FI;.END PROCcatarith;PROCcatarith(TEXT VARari,INT VARadrc,alen,TEXT CONSTsym):IFsym=nilariTHEN LEAVEcatarithFI;IFpos(ari,delimiter,alen,alen)<>alenTHENariCATdelimiterFI;ariCATsym;adrcINCR1;alen:=LENGTHari;END PROCcatarith;PROCcatprint(TEXT VARprt,INT CONSTnod1):INT VARlnod,rnod,pnod,inod;INT VARadr1;INT VARoidx;TEXT VARplft,pmid,prgt;IFnod1<=0THEN LEAVEcatprintFI;initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);adr1:=field(mem.adr,nod1,3);oidx:=field(mem.obj,adr1,3);IFoidx<=atomidxTHENplft:="";pmid:=name(mem.trm,adr1);prgt:="";ELSEgetopprintsymbols(oidx,plft,pmid,prgt);FI;prtCATplft;IFopparamexc(oidx)=0THENcatprint(prt,lnod);prtCATpmid;catprint(prt,rnod);ELSEcatprint(prt,rnod);prt +CATpmid;catprint(prt,lnod);FI;prtCATprgt;END PROCcatprint;PROCremoveformulaobj(INT CONSTnod1):INT VARnod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod,snod;initformulaspaces;analyzeformula;ariok:=FALSE;prtok:=FALSE;recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.adr,nod1,nod2,nodx,adr1,adr2);define(mem.adr,nod1,nod1,1,adr1,adr1);define(mem.adr,nod2,nod2,1,adr2,adr2);rename(mem.trm,adr1,"");IFlnod=0THENsnod:=rnod;ELIFrnod=0THENsnod:=lnod;ELSE LEAVEremoveformulaobj;FI;IFpnod>0THENfield(mem.tre,pnod,inod,snod);FI;IFsnod>0THENfield(mem.tre,snod,3,pnod);field(mem.tre,snod,4,inod);FI;END PROCremoveformulaobj;PROCappendformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTpnod,inod,INT VARnod1):INT VARlnod,rnod;initformulaspaces;SELECTinodOF CASE1:rnod:=0;lnod:=field(mem.tre,pnod,1);CASE2:lnod:=0;rnod:=field(mem.tre,pnod,2);OTHERWISElnod:=0;rnod:=0;END SELECT;insertformulaobj(sym,idx,lnod,rnod,pnod,inod,nod1);END PROCappendformulaobj;PROCinsertformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTlnod,rnod,pnod,inod,INT VARnod1):initformulaspaces;analyzeformula;ariok:=FALSE;prtok:=FALSE;INT VARadr1;insert(mem.trm,sym);append(mem.obj,0,-1,idx,0);adr1:=length(mem.obj);append(mem.tre,lnod,rnod,pnod,inod);nod1:=length(mem.tre);append(mem.adr,nod1,1,adr1,adr1);IFlnod>0THENfield(mem.tre,lnod,3,nod1);field(mem.tre,lnod,4,1)FI;IFrnod>0THENfield(mem.tre,rnod,3,nod1);field(mem.tre,rnod,4,2)FI;IFpnod>0THENfield(mem.tre,pnod,inod,nod1)ELSEmem.nodr:=nod1FI;END PROCinsertformulaobj;PROCinsertformulapars(TEXT CONSTsym1,sym2,INT CONSTidx1,idx2,INT CONSTsnod,pnod,inod,INT VARnod1,nod2):adjoinformulaobj(sym2,idx2,snod,0,nod2);insertformulaobj(sym1,idx1,0,nod2,pnod,inod,nod1);END PROCinsertformulapars;PROCcreateformulaobj(TEXT CONSTsym,INT CONSTidx,INT VARnod1):adjoinformulaobj(sym,idx,0,0,nod1);END PROCcreateformulaobj;PROCadjoinformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTlnod,rnod,INT VARnod1):initformulaspaces;analyzeformula;INT VARadr1;insert(mem.trm,sym);append(mem.obj,0,-1,idx,0);adr1:=length(mem.obj);append(mem.tre,lnod,rnod,0,0);nod1:=length(mem.tre);append(mem.adr,nod1,1,adr1,adr1);IFlnod>0THENfield(mem.tre,lnod,3,nod1);field(mem.tre,lnod,4,1)FI;IFrnod>0THENfield(mem.tre,rnod,3,nod1);field(mem.tre,rnod,4,2)FI;END PROCadjoinformulaobj;PROCadjoinformulapars(TEXT CONSTsym1,sym2,INT CONSTidx1,idx2,INT CONSTsnod,INT VARnod1,nod2):adjoinformulaobj(sym2,idx2,snod,0,nod2);adjoinformulaobj(sym1,idx1,0,nod2,nod1);END PROCadjoinformulapars;PROCputobjectontostack(INT VARnod1,INT CONSTadr1,TEXT CONSTsym,INT CONSTidx):INT VARlbp,rbp;getoppower(idx,lbp,rbp);getparamsfromstack(nod1,lbp);INT VARadr2;insert(mem.trm,sym,adr2);INT CONSTapos:=field(mem.obj,adr1,1)-1;define(mem.obj,adr2,apos,apos,idx,0);mem.spINCR1;define(mem.stk,mem.sp,nod1,adr2,idx,rbp);END PROCputobjectontostack;PROCgetparamsfromstack(INT VARnod1,INT CONSTlbp):INT VARstacknod,stackadr,stackidx,stackrbp;WHILEmem.sp>0REPrecall(mem.stk,mem.sp,stacknod,stackadr,stackidx,stackrbp);IFstackrbplforceidxANDstackidx<>rforceidxTHENnod1INCR1;define(mem.adr,nod1,nod1,1,stackadr,stackadr);IFstackadr=mem.adrcTHENmem.nodc:=nod1FI;FI;PER;END PROCgetparamsfromstack;PROCfindprefixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindprefixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILlbp=prefixlbpPER;END PROCfindprefixop;PROCfindpostfixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindpostfixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILrbp=postfixrbpPER;END PROCfindpostfixop;PROCfindinfixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindinfixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILnpm=infixnpmPER;END PROCfindinfixop +;PROCanalyzeformula:INT VARnod1,nod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod;INT VARabeg,aend;INT VARstackidx,stackrbp;INT VARlastidx,lastnpm,lastlbp,lastrbp;INT VARnextidx,nextnpm,nextlbp,nextrbp;TEXT VARsym;INT VARtlen;INT VARxfb,yfb,xfe,yfe;INT VARpxp,pyp,pxd,pyd;INT VARoxb,oyb,oxe,oye,oxp,oyp,oxd,oyd;INT VARlxb,lyb,lxe,lye,lxp,lyp,lxa,lya,lxd,lyd;INT VARrxb,ryb,rxe,rye,rxp,ryp,rxa,rya,rxd,ryd;INT VARoxc,oyc;IFanalyzeokTHEN LEAVEanalyzeformulaFI;getfixedops;splitari;computerpn;computetre;computealgdelandbox;computescr;analyzeok:=TRUE;.splitari:mem.trm:=emptytextrow;clear(mem.obj);aend:=0;REPabeg:=aend+1;aend:=pos(ari,delimiter,abeg);IFaend>abegTHENsym:=subtext(ari,abeg,aend-1);insert(mem.trm,sym);nextidx:=opindex(sym)MAXatomidx;append(mem.obj,abeg,aend-1,nextidx,0);FI;UNTILaend=0PER;IFabeg<=alenTHENsym:=subtext(ari,abeg,alen);insert(mem.trm,sym);nextidx:=opindex(sym)MAXatomidx;append(mem.obj,abeg,alen,nextidx,0);FI;.computerpn:clear(mem.adr);nod1:=0;clear(mem.stk);mem.sp:=0;lastidx:=nilidx;lastnpm:=0;lastlbp:=nillbp;lastrbp:=nilrbp;FORadr1FROM1UPTOlength(mem.obj)REPprocessobject;lastidx:=nextidx;lastnpm:=nextnpm;lastlbp:=nextlbp;lastrbp:=nextrbp;PER;nextidx:=nilidx;getoppower(nextidx,nextlbp,nextrbp);getopparams(nextidx,nextnpm);insertmissingobject;getparamsfromstack(nod1,nextlbp);mem.nodr:=nod1;.processobject:nextidx:=field(mem.obj,adr1,3);getoppower(nextidx,nextlbp,nextrbp);getopparams(nextidx,nextnpm);insertmissingobject;getparamsfromstack(nod1,nextlbp);IFnextidx=rforceidxTHEN IFfield(mem.stk,mem.sp,3)=lforceidxTHENfield(mem.stk,mem.sp,4,rforcerbp)FI;ELIFnextlbp=rparlbpTHENnod1INCR1;define(mem.adr,nod1,nod1,1,adr1,adr1);IFadr1=mem.adrcTHENmem.nodc:=nod1FI;IFfield(mem.stk,mem.sp,4)=lparrbpTHENfield(mem.stk,mem.sp,4,rparrbp)FI;ELSEmem.spINCR1;define(mem.stk,mem.sp,nod1,adr1,nextidx,nextrbp);FI;.insertmissingobject:IFnextidx=fiidxTHEN IFlastnpm=infixnpmORlastlbp=prefixlbpTHENpostfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFlastlbp=lparlbpORlastidx=lforceidxORlastidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;putobjectontostack(nod1,adr1,elif3ari,elif3idx);ELIFlastidx=elif1idxTHEN IFnextidx=elif1idxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;putobjectontostack(nod1,adr1,elif2ari,elif2idx);IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastidx=atomidxORlastrbp=rparrbpORlastidx=rforceidxTHEN IFnextidx=atomidxORnextidx=lforceidxTHENputobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=prefixlbpTHENinfixnext;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=lparlbpTHENputobjectontostack(nod1,adr1,applyari,applyidx);FI;ELIFlastrbp=postfixrbpTHEN IFnextidx=atomidxORnextidx=lforceidxTHENinfixlast;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=prefixlbpTHENinfixlast;infixnext;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=lparlbpTHENinfixlast;putobjectontostack(nod1,adr1,applyari,applyidx);FI;ELIFlastnpm=infixnpmTHEN IFnextnpm=infixnpmTHENprefixnext;postfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENpostfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastlbp=prefixlbpTHEN IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastlbp=lparlbpORlastidx=lforceidxORlastidx=nilidxTHEN IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpTHENputobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;FI;.prefixnext:findprefixop(name(mem.trm,adr1),nextidx,nextnpm,nextlbp,nextrbp);IFnextlbp=prefixlbpTHENfield(mem. +obj,adr1,3,nextidx);LEAVEinsertmissingobject;FI;.infixnext:findinfixop(name(mem.trm,adr1),nextidx,nextnpm,nextlbp,nextrbp);IFnextnpm=infixnpmTHENfield(mem.obj,adr1,3,nextidx);LEAVEinsertmissingobject;FI;.infixlast:findinfixop(name(mem.trm,adr1-1),lastidx,lastnpm,lastlbp,lastrbp);IFlastnpm=infixnpmTHENfield(mem.stk,mem.sp,3,lastidx);field(mem.stk,mem.sp,4,lastrbp);field(mem.obj,adr1-1,3,lastidx);LEAVEinsertmissingobject;FI;.postfixlast:findpostfixop(name(mem.trm,adr1-1),lastidx,lastnpm,lastlbp,lastrbp);IFlastrbp=postfixrbpTHENfield(mem.stk,mem.sp,3,lastidx);field(mem.stk,mem.sp,4,lastrbp);field(mem.obj,adr1-1,3,lastidx);LEAVEinsertmissingobject;FI;.computetre:clear(mem.tre);define(mem.tre,mem.nodr,0,0,0,0);clear(mem.stk);mem.sp:=0;FORnod1FROM1UPTOlength(mem.adr)REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);field(mem.adr,nod1,2,1);nextidx:=field(mem.obj,adr1,3);getopparams(nextidx,nextnpm);getoppower(nextidx,nextlbp,nextrbp);WHILEnextnpm>0REPrecall(mem.stk,mem.sp,nod2,adr2,stackidx,stackrbp);mem.spDECR1;IFstackrbp=rparrbpANDnextlbp=lparlbpTHENdefine(mem.adr,nod2,nod1,2,adr2,adr1);define(mem.adr,nod1,nod2,1,adr1,adr2);FI;field(mem.tre,nod2,3,nod1);IFnextnpm>1ORnextlbp=lparlbpORnextlbp=prefixlbpTHENfield(mem.tre,nod1,2,nod2);field(mem.tre,nod2,4,2);ELSEfield(mem.tre,nod1,1,nod2);field(mem.tre,nod2,4,1);FI;nextnpmDECR1;PER;mem.spINCR1;define(mem.stk,mem.sp,nod1,adr1,nextidx,nextrbp);PER;.computealgdelandbox:clear(mem.alg);define(mem.alg,mem.nodr,0,0,0,0);clear(mem.del);define(mem.del,mem.nodr,0,0,0,0);clear(mem.box);define(mem.box,mem.nodr,0,0,0,0);FORnod1FROM1UPTOmem.nodrREPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.tre,nod1,lnod,rnod,pnod,inod);sym:=name(mem.trm,adr1);tlen:=LENGTHsym;recall(mem.obj,adr1,abeg,aend,nextidx,dummy);oxb:=0;oyb:=0;oxe:=0;oye:=0;lxd:=0;lyd:=0;rxd:=0;ryd:=0;getopalignment(nextidx,lxa,lya,rxa,rya);getopposition(nextidx,lxp,lyp,rxp,ryp);IFnextidx<=atomidxTHEN IFtlen>0THENoxe:=tlen;ELSEoxe:=LENGTHopscreensymbol(nextidx);FI;rxp:=oxe+1;getopframe(nextidx,xfb,yfb,xfe,yfe);ELSEoxe:=LENGTHopscreensymbol(nextidx);getopframe(nextidx,xfb,yfb,xfe,yfe);FI;IFlnod>0THENdefine(mem.alg,lnod,lxa,lya,lxp,lyp);recall(mem.box,lnod,lxb,lyb,lxe,lye);align(lxa,lxp,lxb,lxe,lxd);align(lya,lyp,lyb,lye,lyd);define(mem.del,lnod,0,0,lxd,lyd);oxb:=oxbMINlxb;oyb:=oybMINlyb;oxe:=oxeMAXlxe;oye:=oyeMAXlye;FI;IFlnod>0ANDrnod>0THEN IFrxa>=4THEN IFrxp>0THENrxpINCRoxeELIFrxp<0THENrxpINCRoxbFI FI;IFrya>=4THEN IFryp>0THENrypINCRoyeELIFryp<0THENrypINCRoybFI FI;FI;IFrnod>0THENdefine(mem.alg,rnod,rxa,rya,rxp,ryp);recall(mem.box,rnod,rxb,ryb,rxe,rye);align(rxa,rxp,rxb,rxe,rxd);align(rya,ryp,ryb,rye,ryd);define(mem.del,rnod,0,0,rxd,ryd);oxb:=oxbMINrxb;oyb:=oybMINryb;oxe:=oxeMAXrxe;oye:=oyeMAXrye;FI;oxbINCRxfb;oybINCRyfb;oxeINCRxfe;oyeINCRyfe;define(mem.box,nod1,oxb,oyb,oxe,oye);PER;nod1:=mem.nodr;recall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.box,nod1,oxb,oyb,oxe,oye);align(1,2,oxb,oxe,oxd);align(1,1,oyb,oye,oyd);define(mem.del,nod1,oxd,oyd,oxd,oyd);define(mem.box,nod1,oxb,oyb,oxe,oye);FORnod1FROMmem.nodr-1DOWNTO1REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);pnod:=field(mem.tre,nod1,3);recall(mem.del,pnod,pxp,pyp,pxd,pyd);recall(mem.del,nod1,oxp,oyp,oxd,oyd);oxp:=pxp+oxd;oyp:=pyp+oyd;define(mem.del,nod1,oxp,oyp,oxd,oyd);shiftelement(mem.box,nod1,oxp,oyp);PER;.computescr:scr.xbeg:=xmax+1;scr.ybeg:=ymax+1;scr.xend:=xmin-1;scr.yend:=ymin-1;FORnod1FROMmem.nodrDOWNTO1REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.obj,adr1,abeg,aend,nextidx,dummy);recall(mem.box,nod1,oxb,oyb,oxe,oye);recall(mem.del,nod1,oxp,oyp,oxd,oyd);IFscr.ybeg>scr.yendTHENscr.ybeg:=oyb;scr.yend:=oyb-1;FI;WHILEscr.ybeg>oybANDscr.ybeg>yminREPscr.ybegDECR1;scr.rec[scr.ybeg]:=emptyrecPER;WHILEscr.yend=yminANDoye<=ymaxTHEN IFnextidx<=atomidxTHENsym:=name(mem.trm,adr1);IFsym=""THENsym:=opscreensymbol(nextidx)FI +;replace(scr.rec[oyp],oxp,sym);ELSEgetopposition(nextidx,lxp,lyp,rxp,ryp);getopalignment(nextidx,lxa,lya,rxa,rya);sym:=opscreensymbol(nextidx);IFsym=""THEN ELIFlxa=2ANDlya=3ANDrxa=2ANDrya=1THENoxc:=oxb;WHILEoxcoybREPreplace(scr.rec[oyc],oxc,symSUB2);oycDECR1PER;WHILEoxcnod1THENoyc:=oyb;WHILEoyc<=oyeREPreplace(scr.rec[oyc],oxp,sym);oycINCR1PER;ELSEreplace(scr.rec[oyp],oxp,sym);FI;FI;FI;PER;.END PROCanalyzeformula;PROCshiftelement(ELEMROW VARlist,INT CONSTnod1,INT CONSTxdel,ydel):INT VARxbeg,ybeg,xend,yend;recall(list,nod1,xbeg,ybeg,xend,yend);xbegINCRxdel;ybegINCRydel;xendINCRxdel;yendINCRydel;define(list,nod1,xbeg,ybeg,xend,yend);END PROCshiftelement;PROCalign(INT CONSTali,pos,INT VARbeg,end,INT VARdel):SELECTaliAND3OF CASE0:del:=0;CASE1:del:=beg;CASE2:del:=beg+end;IFdel<0THENdelDECR1FI;del:=delDIV2;CASE3:del:=end;OTHERWISEerrorstop("unzulässige Alignment-Kennung : "+text(ali));END SELECT;del:=pos-del;begINCRdel;endINCRdel;END PROCalign;PROCgetformulalength(INT VARxbeg,ybeg,xend,yend):initformulaspaces;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;END PROCgetformulalength;PROCgetformula(INT VARxbeg,ybeg,xend,yend,ROWymaxTEXT VARrec):INT VARypoi;initformulaspaces;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;FORypoiFROMybegUPTOyendREPrec[ypoi]:=subtext(scr.rec[ypoi],xbeg,xend)PER;END PROCgetformula;PROCwriteformula(FILE VARf):INT VARypoi;initformulaspaces;output(f);IFcol(f)<=16000THENline(f)FI;INT VARxbeg,ybeg,xend,yend;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;FORypoiFROMybegUPTOyendREPputline(f,subtext(scr.rec[ypoi],xbeg,xend))PER;END PROCwriteformula;PROCclearformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff):IFxbeg>xendORxbeg>xmaxORxendyendORybeg>ymaxORyendxendORxbeg>xmaxORxendyendORybeg>ymaxORyend=yminANDypoi<=ymaxTHENout(xbeg+xoff,ypoi+yoff,subtext(emptyrec,xbeg,xend));FI;END PROCclearformula;PROCoutformula(INT CONSTxbeg,xend,ypoi,INT CONSTxoff,yoff):IFypoi>=yminANDypoi<=ymaxTHENinitformulaspaces;IFypoi>=scr.ybegANDypoi<=scr.yendTHENout(xbeg+xoff,ypoi+yoff,subtext(scr.rec[ypoi],xbeg,xend));FI;FI;END PROCoutformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff,TEXT CONSTframe):IFxbeg>xendORxbeg>xmaxORxendyendORybeg>ymaxORyend=yminANDypoi<=ymaxTHENinitformulaspaces;IFypoi>=scr.ybegANDypoi<=scr.yendTHENrec:=scr.rec[ypoi];ELSErec:=emptyrec;FI;replace(rec,xbeg,xend," ",frameSUBfp+1);replace(rec,xend,frameSUBfp+2);replace(rec,xbeg,frameSUBfp);out(xbeg+xoff,ypoi+yoff,subtext(rec,xbeg,xend));FI;END PROCoutformula;PROCreplace(TEXT VARrec,INT CONSTb,e,TEXT CONSTold,new):INT CONSTl:=LENGTHold;IFl<>LENGTHnewTHEN LEAVEreplaceFI;INT VARp:=pos(rec,old,b,e);WHILEp>0REPreplace(rec,p,new);p:=pos(rec,old,p+l,e)PER;END PROCreplace;PROCout(INT CONSTxcur,ycur, +TEXT CONSTrec):cursor(xcur,ycur);out(rec);END PROCout;PROCcatexpr(TEXT VARrec,INT CONSTadrb,adr1,adr2,adre):INT VARadr;initformulaspaces;IFadr1=adr2THENrecCAT" ";FORadrFROMadrbUPTOadr1-1REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr1UPTOadr2REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr2+1UPTOadreREPrecCATname(mem.trm,adr)PER;recCAT" ";ELSErecCAT" ";FORadrFROMadrbUPTOadr2REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr2+1UPTOadr1-1REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr1UPTOadreREPrecCATname(mem.trm,adr)PER;recCAT" ";FI;END PROCcatexpr;END PACKETformulaanalyzer; + diff --git a/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung b/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung new file mode 100644 index 0000000..dae28a7 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung @@ -0,0 +1,12 @@ +PACKETformulaeditorDEFINESresetformulaeditor,outformula,showformula,editformula,defformeditwindow,getformeditwindow,defformeditoffset,getformeditoffset,defformeditshift,getformeditshift,defformeditcursor,getformeditcursor,defformeditpointer,getformeditpointer,moveformeditpointer,defformeditexitkeys,getformeditexitkeys,formeditexitkey,defformeditbuffer,getformeditbuffer,formeditbuffer,defformeditarith,getformeditarith,formeditarith,defformediterror,getformediterror,formediterror,defformeditbeep,getformeditbeep,formeditbeep,defformeditrubin,getformeditrubin,formeditrubin,defformeditlearn,getformeditlearn,formeditlearn,defformeditkeys,getformeditkeys,formeditkeys,defformeditmark,getformeditmark,formeditmark,displayformeditbuffer,clearformeditbuffer,displayformeditarith,clearformeditarith,displayformediterror,clearformediterror,displayformeditrubin,clearformeditrubin,displayformeditlearn,clearformeditlearn,:LETnilidx=0;TEXT VARnilari;LETatomidx=1;TEXT VARatomari,atomscr;LETtimesidx=2;TEXT VARtimesari,timesscr;LETapplyidx=3;TEXT VARapplyari,applyscr;LETifidx=4;TEXT VARifari;LETfiidx=5;TEXT VARfiari;LETthenidx=6;TEXT VARthenari;LETelif1idx=7;TEXT VARelif1ari;LETelif2idx=8;TEXT VARelif2ari;LETelif3idx=9;TEXT VARelif3ari;LETmonadidx=10;INT VARprefixlbp,postfixrbp;LETlforceidx=11;TEXT VARlforceari;LETrforceidx=12;TEXT VARrforceari;LETbegdifidx=13;TEXT VARbegdifari;LETenddifidx=14;TEXT VARenddifari;LETlparidx=15;INT VARlparlbp,lparrbp;TEXT VARlparari;LETrparidx=16;INT VARrparlbp,rparrbp;TEXT VARrparari;INT VARpointermode;INT VARnodc,adrc;INT VARnod1,nod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod,snod;INT VARidx;TEXT VARltrm,rtrm;TEXT VARtrm;INT VARtpos,tlen;INT VARapos,abeg,aend;INT VARpbeg,pend;INT VARxobj,yobj,xbeg,ybeg,xend,yend;INT VARxpoi,ypoi,xmin,ymin,xmax,ymax;INT VARxoff,yoff;INT VARxcur,ycur,xlow,ylow,xhig,yhig;INT VARxrel,yrel;INT VARdummy;BOOL VARbufferon;BOOL VARarithon;BOOL VARerroron;BOOL VARbeepon;BOOL VARrubinon;BOOL VARlearnon;BOOL VARkeyson;BOOL VARmarkon;INT VARxbuffer,ybuffer,lbuffer;INT VARxarith,yarith,larith;INT VARxerror,yerror,lerror;INT VARxrubin,yrubin;INT VARxlearn,ylearn;INT VARxkeys,ykeys;INT VARdspxmin,dspymin,dspxmax,dspymax;INT VARdspxbeg,dspybeg,dspxend,dspyend;TEXT VARdspbuffer,clrbuffer;TEXT VARdsparith,clrarith;TEXT VARdsperror,clrerror;TEXT VARdsprubin,clrrubin;TEXT VARdsplearn,clrlearn;TEXT VARdspkeys,clrkeys;TEXT VARdspmark,clrmark;resetformulaeditor;TEXT VARbuffer:="";BOOL VARwriteenabled;BOOL VARquiteditor;BOOL VARnewdisplay,regenerate;BOOL VARlearnmode:=FALSE;BOOL VARrubinmode:=FALSE;INT VARheadpos;TEXT VARlearnedkeys:="";TEXT VARrec;TEXT VARexitkey:="";BOOL VARwashop,wasesc;TEXT VARstdkeys:="",hopkeys:="",esckeys:="";LETkeys="����� +�� �� bpdg()[]{}|<>=^_/*�BPIWDA;!";LEThopkey=1;LETrightkey=2;LETupkey=3;LETleftkey=4;LETtabkey=5;LETdownkey=6;LETrubinkey=7;LETruboutkey=8;LETreturnkey=9;LETesckey=11;LETbkey=13;LETpkey=14;LETdkey=15;LETgkey=16;LETlparkey=17;LETrparkey=18;LETlbrakey=19;LETrbrakey=20;LETlcmtkey=21;LETrcmtkey=22;LETabskey=23;LETlesskey=24;LETgreaterkey=25;LETequalskey=26;LETcircumflexkey=27;LETunderlinekey=28;LETslashkey=29;LETstarkey=30;LETrootkey=31;LETcapbkey=32;LETcappkey=33;LETcapikey=34;LETcapwkey=35;LETcapdkey=36;LETcapakey=37;LETsemicolonkey=38;LETexclamationkey=39;PROCgetfixedops:nilari:=oparithsymbol(nilidx);atomari:=oparithsymbol(atomidx);atomscr:=opscreensymbol(atomidx);timesari:=oparithsymbol(timesidx);timesscr:=opscreensymbol(timesidx);applyari:=oparithsymbol(applyidx);applyscr:=opscreensymbol(applyidx);ifari:=oparithsymbol(ifidx);fiari:=oparithsymbol(fiidx);thenari:=oparithsymbol(thenidx);elif1ari:=oparithsymbol(elif1idx);elif2ari:=oparithsymbol(elif2idx);elif3ari:=oparithsymbol(elif3idx);getoppower(monadidx,prefixlbp,postfixrbp);lforceari:=oparithsymbol(lforceidx);rforceari:=oparithsymbol(rforceidx);begdifari:=oparithsymbol(begdifidx);enddifari:=oparithsymbol(enddifidx);lparari:=oparithsymbol(lparidx);getoppower(lparidx,lparlbp,lparrbp);rparari:=oparithsymbol(rparidx) +;getoppower(rparidx,rparlbp,rparrbp);END PROCgetfixedops;PROCshowformula:editformula(FALSE);END PROCshowformula;PROCeditformula:editformula(TRUE);END PROCeditformula;PROCeditformula(BOOL CONSTwriteaccess):enablestop;dspxmin:=xlow-xoff;dspymin:=ylow-yoff;dspxmax:=xhig-xoff;dspymax:=yhig-yoff;getformulalength(xmin,ymin,xmax,ymax);xminDECR1;xmaxINCR1;IFesckeys=""THENclearformula;outformula;LEAVEeditformula;FI;writeenabled:=writeaccess;quiteditor:=esckeys="";newdisplay:=TRUE;pointermode:=pointermodeMAX2;xrel:=0;yrel:=0;getfixedops;REPcomputepointers;displayformeditarith;IFnewdisplayTHENnewdisplay:=FALSE;clearformula;outformula;headpos:=xkeys;displayformeditbuffer;IFrubinmodeTHENdisplayformeditrubinFI;IFlearnmodeTHENdisplayformeditlearnFI;FI;processstdkey;IFregenerateTHENregenerate:=FALSE;out("�");regenerateformula(nodc,adrc);getformulalength(xmin,ymin,xmax,ymax);xminDECR1;xmaxINCR1;nod1:=nodc;adr1:=adrc;FI;UNTILquiteditorPER;out("�");.computepointers:REP SELECTpointermodeOF CASE4:computenodcfromadrc;CASE3:computepoifromnodc;CASE2:computenod1frompoi;CASE1:computetrefromnod1;OTHERWISE LEAVEcomputepointers;END SELECT;PER;.computenodcfromadrc:FORnodcFROMformulacomplexityDOWNTO1REP UNTILformulaaddress(nodc)=adrcPER;pointermode:=3;.computepoifromnodc:nod1:=nodc;adr1:=adrc;IFnod1>0THENgetformulaobject(nod1,xobj,yobj);xobjINCRxrel;xrel:=0;yobjINCRyrel;yrel:=0;ELIFadr1>0THENxobj:=xmax;yobj:=ymax;ELSExobj:=xmin;yobj:=ymin;FI;defformeditpointer(xobj,yobj);pointermode:=2;.computenod1frompoi:nod1:=formulanode(xpoi,ypoi);pointermode:=1;.computetrefromnod1:getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulatree(nod1,lnod,rnod,pnod,inod);getformulaobject(nod1,xobj,yobj);getformulapos(adr1,abeg,aend,idx,dummy);getformulaterm(adr1,trm);tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;SELECTnodxOF CASE1:getformulabox(nod1,xbeg,ybeg,xend,yend);aend:=formulaend(adr2);apos:=abegMAXabeg+xpoi-xobjMINaend+1;CASE2:getformulabox(nod2,xbeg,ybeg,xend,yend);abeg:=formulabeg(adr2);apos:=abegMAXaend+xpoi-xobjMINaend+1;OTHERWISExbeg:=0;ybeg:=0;xend:=0;yend:=0;abeg:=0;aend:=0;apos:=0;END SELECT;pbeg:=abeg;pend:=aend;getformulatree(nod1,lnod,rnod,pnod,inod);nodc:=nod1;adrc:=adr1;pointermode:=0;.END PROCeditformula;PROCclearformula:clearformula(dspxminMAXxlow-xoff,dspyminMAXylow-yoff,dspxmaxMINxhig-xoff,dspymaxMINyhig-yoff,xoff,yoff);dspxmin:=xhig-xoff;dspymin:=yhig-yoff;dspxmax:=xlow-xoff;dspymax:=ylow-yoff;END PROCclearformula;PROCoutformula:outformula(xminMAXxlow-xoff,yminMAXylow-yoff,xmaxMINxhig-xoff,ymaxMINyhig-yoff,xoff,yoff);dspxmin:=xmin;dspymin:=ymin;dspxmax:=xmax;dspymax:=ymax;dspxbeg:=0;END PROCoutformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,TEXT CONSTframe):outformula(xbegMAXxlow-xoff,ybegMAXylow-yoff,xendMINxhig-xoff,yendMINyhig-yoff,xoff,yoff,frame);END PROCoutformula;PROCgetkey:IFxbeg<>dspxbegORybeg<>dspybegORxend<>dspxendORyend<>dspyendTHEN IFmarkonANDdspxbeg>0THENoutformula(dspxbeg-1,dspybeg,dspxend,dspyend,clrmark);FI;IFmarkonTHENoutformula(xbeg-1,ybeg,xend,yend,dspmark);FI;cursor(80,1);out("");dspxbeg:=xbeg;dspybeg:=ybeg;dspxend:=xend;dspyend:=yend;FI;cursor(xcur,ycur);getchar(exitkey);IFlearnmodeTHENlearnedkeysCATexitkeyFI;END PROCgetkey;PROCprocessstdkey:getkey;displaykey(exitkey);processkey;clearkey(exitkey);.processkey:IFpos(stdkeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processhopkey;CASEleftkey:processleft;CASErightkey:processright;CASEupkey:processup;CASEdownkey:processdown;CASEtabkey:processtab;CASErubinkey:processrubin;CASEruboutkey:processrubout;CASEesckey:processesckey;OTHERWISE:processother;END SELECT;.processleft:xmove(-1);.processright:xmove(+1);.processup:ymove(-1);.processdown:ymove(+1);.processtab:adrc:=adr1;REPadrcINCR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep;LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processrubin:IFrubinonTHENrubinmode:=NOTrubinmode;IFrubinmodeTHEN +displayformeditrubinELSEclearformeditrubinFI;FI;.processrubout:deletechar;.processother:IFexitkey<" "THEN IF NOTlearnonORpos(keys,exitkey)>0THENbeep;LEAVEprocesskeyFI;IFtasteenthaeltkommando(exitkey)THENdisablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;ELSEinsertchar(exitkey);FI;.END PROCprocessstdkey;PROCprocesshopkey:washop:=TRUE;displaykey("HOP");getkey;displaykey(exitkey);processkey;clearkey(exitkey);clearkey("HOP");exitkey:="�"+exitkey;washop:=FALSE;.processkey:IFpos(hopkeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processhophop;CASEleftkey:processhopleft;CASErightkey:processhopright;CASEupkey:processhopup;CASEdownkey:processhopdown;CASEruboutkey:processhoprubout;CASEtabkey:CASEreturnkey:CASEesckey:processhopesc;CASElparkey:processhoplpar;CASErparkey:processhoprpar;CASElbrakey:processhoplbra;CASErbrakey:processhoprbra;CASElcmtkey:CASErcmtkey:CASEabskey:CASEcapakey:processhopcapa;CASEcapdkey:processhopcapd;OTHERWISE:processhopother;END SELECT;.processhophop:IFxcur>xlowORycur>ylowTHENxmove(xlow-xcur);ymove(ylow-ycur);ELSExmove(xlow-xhig-1);ymove(ylow-yhig-1);FI;.processhopleft:IFxcur>xlowTHENxmove(xlow-xcur)ELSExmove(xlow-xhig-1)FI;.processhopright:IFxcurylowTHENymove(ylow-ycur)ELSEymove(ylow-yhig-1)FI;.processhopdown:IFycuratomidxTHENbeep;LEAVEprocesskeyFI;trm:=subtext(trm,1,tpos-1MINtlen);defformulaterm(adr1,trm);pointermode:=2;regenerate:=TRUE;newdisplay:=TRUE;.processhopesc:processesckey;push("�");.processhoplpar:insertpars("(",")",opindex("("),opindex(")"));.processhoprpar:deletepars("(",")");.processhoplbra:insertpars("[","]",opindex("["),opindex("]"));.processhoprbra:deletepars("[","]");.processhopcapa:insertpars(ifari,fiari,ifidx,fiidx);.processhopcapd:insertpars(begdifari,enddifari,begdifidx,enddifidx);.processhopother:IFexitkey<" "THEN IF NOTlearnonORpos(keys,exitkey)>0THENbeep;LEAVEprocesskeyFI;IFtasteenthaeltkommando(exitkey)THENdisablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;ELSEinsertchar(exitkey);FI;.END PROCprocesshopkey;PROCprocessesckey:wasesc:=TRUE;displaykey("ESC");getkey;displaykey(exitkey);processkey;clearkey(exitkey);clearkey("ESC");exitkey:="�"+exitkey;wasesc:=FALSE;.processkey:IFpos(esckeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processeschop;CASEleftkey:processescleft;CASErightkey:processescright;CASErubinkey:processescrubin;CASEruboutkey:processescrubout;CASEbkey:CASEpkey:processescp;CASEdkey:processescd;CASEgkey:processescg;CASElparkey:processesclpar;CASErparkey:processescrpar;CASElesskey:CASEequalskey:processescequals;CASEgreaterkey:CASEexclamationkey:CASEupkey:processescup;CASEdownkey:CASEcircumflexkey:CASEunderlinekey:CASEslashkey:CASEstarkey:CASErootkey:CASEcapbkey:CASEcappkey:CASEcapikey:CASEcapwkey:CASEcapdkey:processesccapd;CASEcapakey:processesccapa;CASEsemicolonkey:processescsemicolon;OTHERWISE:processescother;END SELECT;.processeschop:IF NOTlearnonTHENbeep;LEAVEprocesskeyFI;learnmode:=NOTlearnmode;IFlearnmodeTHENdisplayformeditlearn;learnedkeys:="";ELSEregenerate:=TRUE;newdisplay:=TRUE;learnedkeys:=subtext(learnedkeys,1,LENGTHlearnedkeys-2);REPgetkey;IFexitkey="�"ORpos(learnedkeys,exitkey)=0OR(exitkey>=" "ANDpos(learnedkeys,"�"+exitkey)=0)THENlernsequenzauftastelegen(exitkey,learnedkeys);clearformeditlearn;LEAVEprocesseschop;FI;out("�");PER;FI;.processescleft:adrc:=adr1;REPadrcDECR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep;LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processescright:adrc:=adr1;REPadrcINCR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep; +LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processescup:processesccapp;.processescrubin:processescg;.processescrubout:processescp;.processescp:IF NOTwriteenabledORnod1<1THENbeep;LEAVEprocesskeyFI;IFnodx=2THENnod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod)FI;buffer:=arithnotation(nod1);displayformeditbuffer;defformulaaddress(nod1,nod1,1,adr1,adr1);defformulatree(nod1,0,0,pnod,inod);defformulaterm(adr1,nilari);nodc:=pnod;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processescd:IFnod1<1THENbeep;LEAVEprocesskeyFI;IFnodx=2THENnod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod);buffer:=arithnotation(nod1);nod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod);ELSEbuffer:=arithnotation(nod1);FI;displayformeditbuffer;.processescg:IF NOTwriteenabledORnod1<1ORidx>atomidxTHENbeep;LEAVEprocesskeyFI;IFtrm=atomariTHENtrm:=nilari;tpos:=1;tlen:=0FI;change(trm,tpos,tpos-1,delimiter+buffer+delimiter);trm:=lforceari+delimiter+trm+delimiter+rforceari;defformulaterm(adr1,trm);nodc:=nod1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processesclpar:push("[");.processescrpar:push("]");.processescequals:insertchar("->");.processesccapp:push("^");.processesccapd:createformulaobj("D",atomidx,lnod);nodc:=lnod;createformulaobj("D",atomidx,rnod);adjoinformulaobj("/",opindex("/"),lnod,rnod,snod);insertformulapars(begdifari,enddifari,begdifidx,enddifidx,snod,pnod,inod,nod1,nod2);pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processesccapa:createformulaobj(atomari,atomidx,lnod);nodc:=lnod;createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(thenari,thenidx,lnod,rnod,snod);insertformulapars(ifari,fiari,ifidx,fiidx,snod,pnod,inod,nod1,nod2);pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processescsemicolon:INT VARanod,bnod,tnod;IF NOTwriteenabledORnod1<1THENbeep;LEAVEprocesskeyFI;IFidx=ifidxTHEN IFtpos<=1THENbeep;LEAVEprocesskeyFI;xobj:=xpoi;yobj:=ypoi;snod:=nod1;REPxobjINCR1;nod1:=formulanode(xobj,yobj);getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulaterm(adr1,trm);UNTILnod1<>snodANDtrm<>""PER;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);WHILEpnod>0ANDidx<>elif2idxANDidx<>elif3idxREPnod1:=pnod;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);PER;insertelifbeforeelif;ELIFidx=fiidxTHEN IFtpos>1THENbeep;LEAVEprocesskeyFI;xobj:=xpoi;yobj:=ypoi;snod:=nod1;REPxobjDECR1;nod1:=formulanode(xobj,yobj);getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulaterm(adr1,trm);UNTILsnod<>nod1ANDtrm<>""PER;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);WHILEpnod>0ANDidx<>elif2idxANDidx<>elif3idxREPnod1:=pnod;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);PER;insertelifbehindelif;ELSEbeep;LEAVEprocesskey;FI;nodc:=anod;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.insertelifbeforeelif:createformulaobj(atomari,atomidx,anod);createformulaobj(atomari,atomidx,bnod);adjoinformulaobj(thenari,thenidx,anod,bnod,tnod);adjoinformulaobj(elif1ari,elif1idx,tnod,0,snod);insertformulaobj(elif2ari,elif2idx,snod,nod1,pnod,inod,tnod);.insertelifbehindelif:createformulaobj(atomari,atomidx,anod);createformulaobj(atomari,atomidx,bnod);adjoinformulaobj(thenari,thenidx,anod,bnod,tnod);SELECTidxOF CASEelif2idx:adjoinformulaobj(elif1ari,elif1idx,tnod,0,snod);insertformulaobj(elif2ari,elif2idx,snod,rnod,nod1,2,tnod);CASEelif3idx:defformulaterm(adr1,elif2ari,elif2idx);insertformulaobj(elif1ari,elif1idx,lnod,0,nod1,1,snod);insertformulaobj(elif3ari,elif3idx,tnod,0,nod1,2,snod);END SELECT;.processescother:IFtasteenthaeltkommando(exitkey)THEN IF NOTlearnonTHENbeep;LEAVEprocesskeyFI;disablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;.END PROC +processesckey;PROCdeletechar:IF NOTwriteenabledORnod1<1ORypoi<>yobjTHENbeep;LEAVEdeletecharFI;IFtpos<1THENbeep;LEAVEdeletecharFI;out("�");IFidx=applyidxORidx=timesidxTHENdeletenilop;ELIFtpos<=tlenTHENdeletecharinobject;ELSEdeletespacebehindobject;FI;regenerate:=TRUE;newdisplay:=TRUE;.deletenilop:adr1:=formulaaddress(lnod);idx:=formulaindex(adr1);WHILEidx=lforceidxORidx=rforceidxREPadr1DECR1;idx:=formulaindex(adr1);PER;adr2:=formulaaddress(rnod);idx:=formulaindex(adr2);WHILEidx=lforceidxORidx=rforceidxREPadr2INCR1;idx:=formulaindex(adr2);PER;trm:=formulaterm(adr1);trmCATformulaterm(adr2);defformulaterm(adr1,trm,atomidxMAXopindex(trm));defformulaterm(adr2,"",atomidx);nodc:=lnod;pointermode:=3;.deletecharinobject:change(trm,tpos,tpos,"");tlen:=LENGTHtrm;IFtlen>0THENdefformulaterm(adr1,trm,atomidxMAXopindex(trm));pointermode:=1;ELIFidx<=atomidxTHENdeleteatom;defformulaterm(adr1,trm,atomidx);pointermode:=3;ELSEdeletenilparams;deleteop;defformulaterm(adr1,trm,atomidx);pointermode:=3;FI;.deleteatom:nodc:=pnod;.deletenilparams:getformulatree(nod1,lnod,rnod,pnod,inod);IFlnod>0ANDformulaterm(formulaaddress(lnod))=atomariTHENlnod:=0;FI;IFrnod>0ANDformulaterm(formulaaddress(rnod))=atomariTHENrnod:=0;FI;defformulatree(nod1,lnod,rnod,pnod,inod);.deleteop:removeformulaobj(nod1);IFrnod>0THENnodc:=rnodELIFlnod>0THENnodc:=lnodELSEnodc:=pnodFI;.deletespacebehindobject:adr2:=adr1;idx:=formulaindex(adr2);IFoppforce(idx)>0THENbeep;LEAVEdeletecharFI;REPadr2INCR1;idx:=formulaindex(adr2);UNTILidx<>lforceidxANDidx<>rforceidxPER;IFoppforce(idx)>0THENbeep;LEAVEdeletecharFI;trmCATformulaterm(adr2);defformulaterm(adr1,trm,atomidxMAXopindex(trm));defformulaterm(adr2,"",atomidx);pointermode:=1;.END PROCdeletechar;PROCinsertchar(TEXT CONSTsym):INT VARsidx:=opindex(sym)MAXatomidx;INT VARslbp:=oplbp(sidx);INT VARsrbp:=oprbp(sidx);INT VARpidx;IF NOT(writeenabledANDnod1>0AND(washopORypoi=yobj))THENbeep;LEAVEinsertcharFI;out("�");IFidx=timesidxTHENtrm:=timesscr;tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;ELIFidx=applyidxTHENtrm:=applyscr;tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;FI;IFidx=atomidxANDtrm=atomariTHENltrm:=nilari;rtrm:=nilari;ELIFrubinmodeOR(idx>atomidxXORsidx>atomidx)THENltrm:=subtext(trm,1,tpos-1);rtrm:=subtext(trm,tpos);ELSEltrm:=subtext(trm,1,tpos-1);rtrm:=subtext(trm,tpos+1);FI;trm:=ltrm;trmCATsym;trmCATrtrm;IF NOTwashopANDidx>atomidxANDtpos>=1ANDtpos<=tlen+1THENreplaceop;FI;IFltrm=nilariTHENinsertbeforeobject;ELIFrtrm=nilariTHENinsertbehindobject;ELSEinsertintoobject;FI;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.replaceop:IFrubinmodeORtpos=tlen+1THENreplaceopbytrm;ELIFtpos=1THENreplaceopbysym;FI;.replaceopbytrm:IFtrm=lforceariORtrm=rforceariTHEN LEAVEreplaceopbytrmFI;IFopindex(trm,lnod>0,rnod>0)<=atomidxTHEN LEAVEreplaceopbytrmFI;pidx:=formulaindex(formulaaddress(pnod));IFinod=1ANDoplforce(pidx)<>0ORinod=2ANDoprforce(pidx)<>0THENdefformulaterm(adr1,trm,opindex(trm,lnod>0,rnod>0));ELSEdefformulaterm(adr1,trm,idx);FI;nodc:=nod1;xrel:=xpoi-xobj+1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;LEAVEinsertchar;.replaceopbysym:IFopindex(sym,lnod>0,rnod>0)<=atomidxTHEN LEAVEreplaceopbysymFI;pidx:=formulaindex(formulaaddress(pnod));IFinod=1ANDoplforce(pidx)<>0ORinod=2ANDoprforce(pidx)<>0THENdefformulaterm(adr1,sym,opindex(sym,lnod>0,rnod>0));ELSEdefformulaterm(adr1,sym,idx);FI;nodc:=nod1;xrel:=+1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;LEAVEinsertchar;.insertbeforeobject:IF NOTwashopANDxpoi>xbegTHENbeep;LEAVEinsertcharFI;pidx:=formulaindex(formulaaddress(pnod));WHILEpidx=enddifidxORpidx=begdifidxORoprforce(sidx)=0ANDinod=1ANDsrbpnod2ANDidx<>begdifidxTHENinsertbeforelpar;ELSEinsertbeforeop;FI;. +insertbeforeatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbeforerpar:beep;LEAVEinsertchar;.insertbeforelpar:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,lnod);insertformulaobj(applyari,applyidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;xrel:=+1;ELIFslbp=prefixlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFslbp=lparlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(applyari,applyidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(applyari,applyidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbeforeop:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,lnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;xrel:=+1;ELIFslbp=prefixlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFslbp=lparlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbehindobject:IF NOTwashopANDxpoinod2ANDidx<>begdifidxTHENinsertbehindlpar;ELSEinsertbehindop;FI;.insertbehindatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=xpoi-xobj+1;ELIFslbp=prefixlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(ltrm,atomidx,lnod);insertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENcreateformulaobj(ltrm,atomidx,lnod);insertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod; +FI;.insertbehindrpar:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,rnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertbehindlpar:beep;LEAVEinsertchar;.insertbehindop:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,rnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertintoobject:IFidx<=atomidxTHENinsertintoatom;ELIFnodx=2THENinsertintorpar;ELIFnod1<>nod2THENinsertintolpar;ELSEinsertintoop;FI;.insertintoatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=xpoi-xobj+1;ELIFslbp=prefixlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(ltrm,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=rparrbpTHENcreateformulaobj(ltrm,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=rnod;ELSEcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertintorpar:beep;LEAVEinsertchar;.insertintolpar:beep;LEAVEinsertchar;.insertintoop:beep;LEAVEinsertchar;.END PROCinsertchar;PROCinsertpars(TEXT CONSTlparari,rparari,INT CONSTlparidx,rparidx):IF NOTwriteenabledORnod1<1ORypoi<>yobjTHENbeep;LEAVEinsertparsFI;out("�");snod:=nod1;insertformulapars(lparari,rparari,lparidx,rparidx,snod,pnod,inod,nod1,nod2);nodc:=snod;xrel:=xpoi-xobj;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;END PROCinsertpars;PROCdeletepars(TEXT CONSTlparari,rparari):IF NOTwriteenabledORnod1=nod2ORypoi<>yobjTHENbeep;LEAVEdeleteparsFI;out("�");IFnodx=2THENnod1EXCnod2;adr1EXCadr2FI;IF(formulaterm(adr1)<>lparariORformulaterm(adr2)<>rparari)THENbeep;LEAVEdeleteparsFI;removeformulaobj(nod1);removeformulaobj(nod2);IFlnod>0THENnodc:=lnodELIFrnod>0THENnodc:=rnodELSEnodc:=nod1FI;pointermode:=2;regenerate:=TRUE;newdisplay:=TRUE;END PROCdeletepars;PROCdisplayformeditbuffer:IFbufferonTHENcursor(xbuffer,ybuffer);outtext(dspbuffer+buffer,1,lbuffer);cursor(xcur,ycur);FI;END PROCdisplayformeditbuffer;PROCclearformeditbuffer:IFbufferonTHENcursor(xbuffer,ybuffer);outtext(clrbuffer,1,lbuffer);cursor(xcur,ycur);FI;END PROCclearformeditbuffer;PROCdisplayformeditarith:IFarithonTHENrec:= +dsparith;recCAT"";INT CONSTxaoff:=LENGTHrec;INT CONSTxabeg:=xarith+xaoff;INT CONSTxasiz:=larith-xaoff;recCATarithnotation;changeall(rec,delimiter," ");cursor(xarith,yarith);outtext(rec,1,larith);IFadr1=0THEN LEAVEdisplayformeditarithFI;IFpbeg-1>=0ANDpbeg-1=0ANDpend+1""THENbeep;IFerroronTHENpm:=dsperror;pmCATerrormessage;IFerrorline>0THENpmCAT" bei Zeile ";pmCATtext(errorline)FI;pmCAT" ";cursor(xerror,yerror);outsubtext(pm,1,lerror);cursor(xerror,yerror);pause;cursor(xcur,ycur);FI;FI;END PROCdisplayformediterror;PROCclearformediterror:IFerroronTHEN TEXT VARpm:=clrerror;cursor(xerror,yerror);outsubtext(pm,1,lerror);cursor(xcur,ycur);FI;END PROCclearformediterror;PROCbeep:IFbeeponTHENout("�");FI;END PROCbeep;PROCdisplayformeditrubin:IFrubinonTHENcursor(xrubin,yrubin);out(dsprubin);cursor(xcur,ycur);FI;END PROCdisplayformeditrubin;PROCclearformeditrubin:IFrubinonTHENcursor(xrubin,yrubin);out(clrrubin);cursor(xcur,ycur);FI;END PROCclearformeditrubin;PROCdisplayformeditlearn:IFlearnonTHENcursor(xlearn,ylearn);out(dsplearn);cursor(xcur,ycur);FI;END PROCdisplayformeditlearn;PROCclearformeditlearn:IFlearnonTHENcursor(xlearn,ylearn);out(clrlearn);cursor(xcur,ycur);FI;END PROCclearformeditlearn;PROCdisplaykey(TEXT CONSTkey):IFkeysonAND(keySUB1)>=" "THENcursor(headpos,ykeys);out("");out(key);out(" ");cursor(xcur,ycur);headposINCR3+LENGTHkey;FI;END PROCdisplaykey;PROCclearkey(TEXT CONSTkey):IFkeysonAND(keySUB1)>=" "THENheadposDECR3+LENGTHkey;cursor(headpos,ykeys);out(" ");LENGTHkeyTIMESOUT" ";out(" ");cursor(xcur,ycur);FI;END PROCclearkey;PROCdefformeditbuffer(INT CONSTxp,yp,xl):xbuffer:=xp;ybuffer:=yp;lbuffer:=xl;END PROCdefformeditbuffer;PROCgetformeditbuffer(INT VARxp,yp,xl):xp:=xbuffer;yp:=ybuffer;xl:=lbuffer;END PROCgetformeditbuffer;PROCdefformeditarith(INT CONSTxp,yp,xl):xarith:=xp;yarith:=yp;larith:=xl;END PROCdefformeditarith;PROCgetformeditarith(INT VARxp,yp,xl):xp:=xarith;yp:=yarith;xl:=larith;END PROCgetformeditarith;PROCdefformediterror(INT CONSTxp,yp,xl):xerror:=xp;yerror:=yp;lerror:=xl;END PROCdefformediterror;PROCgetformediterror(INT VARxp,yp,xl):xp:=xerror;yp:=yerror;xl:=lerror;END PROCgetformediterror;PROCdefformeditrubin(INT CONSTxp,yp):xrubin:=xp;yrubin:=yp;END PROCdefformeditrubin;PROCgetformeditrubin(INT VARxp,yp):xp:=xrubin;yp:=yrubin;END PROCgetformeditrubin;PROCdefformeditlearn(INT CONSTxp,yp):xlearn:=xp;ylearn:=yp;END PROCdefformeditlearn;PROCgetformeditlearn(INT VARxp,yp):xp:=xlearn;yp:=ylearn;END PROCgetformeditlearn;PROCdefformeditkeys(INT CONSTxp,yp):xkeys:=xp;ykeys:=yp;END PROCdefformeditkeys;PROCgetformeditkeys(INT VARxp,yp):xp:=xkeys;yp:=ykeys;END PROCgetformeditkeys;PROCdefformeditbuffer(TEXT CONSTdsp,clr):dspbuffer:=dsp;clrbuffer:=clr;END PROCdefformeditbuffer;PROCgetformeditbuffer(TEXT VARdsp,clr):dsp:=dspbuffer;clr:=clrbuffer;END PROCgetformeditbuffer;PROCdefformeditarith(TEXT CONSTdsp,clr):dsparith:=dsp;clrarith:=clr;END PROCdefformeditarith;PROCgetformeditarith(TEXT VARdsp,clr):dsp:=dsparith;clr:=clrarith;END PROCgetformeditarith;PROCdefformediterror(TEXT CONSTdsp,clr):dsperror:=dsp;clrerror:=clr;END PROCdefformediterror;PROCgetformediterror(TEXT VARdsp,clr):dsp:=dsperror;clr:=clrerror;END PROCgetformediterror;PROCdefformeditkeys(TEXT CONSTdsp,clr):dspkeys:=dsp;clrkeys:=clr;END PROCdefformeditkeys;PROCgetformeditkeys(TEXT VARdsp,clr):dsp:=dspkeys;clr:=clrkeys;END PROCgetformeditkeys;PROCdefformeditrubin(TEXT CONSTdsp,clr):dsprubin:=dsp;clrrubin:=clr;END + PROCdefformeditrubin;PROCgetformeditrubin(TEXT VARdsp,clr):dsp:=dsprubin;clr:=clrrubin;END PROCgetformeditrubin;PROCdefformeditlearn(TEXT CONSTdsp,clr):dsplearn:=dsp;clrlearn:=clr;END PROCdefformeditlearn;PROCgetformeditlearn(TEXT VARdsp,clr):dsp:=dsplearn;clr:=clrlearn;END PROCgetformeditlearn;PROCdefformeditmark(TEXT CONSTdsp,clr):replace(dspmark,1,dsp);replace(clrmark,1,clr);END PROCdefformeditmark;PROCgetformeditmark(TEXT VARdsp,clr):dsp:=dspmark;clr:=clrmark;END PROCgetformeditmark;PROCdefformeditbuffer(BOOL CONSTon):bufferon:=on;END PROCdefformeditbuffer;PROCgetformeditbuffer(BOOL VARon):on:=bufferon;END PROCgetformeditbuffer;BOOL PROCformeditbuffer:bufferonEND PROCformeditbuffer;PROCdefformeditarith(BOOL CONSTon):arithon:=on;END PROCdefformeditarith;PROCgetformeditarith(BOOL VARon):on:=arithon;END PROCgetformeditarith;BOOL PROCformeditarith:arithonEND PROCformeditarith;PROCdefformediterror(BOOL CONSTon):erroron:=on;END PROCdefformediterror;PROCgetformediterror(BOOL VARon):on:=erroron;END PROCgetformediterror;BOOL PROCformediterror:erroronEND PROCformediterror;PROCdefformeditbeep(BOOL CONSTon):beepon:=on;END PROCdefformeditbeep;PROCgetformeditbeep(BOOL VARon):on:=beepon;END PROCgetformeditbeep;BOOL PROCformeditbeep:beeponEND PROCformeditbeep;PROCdefformeditrubin(BOOL CONSTon):rubinon:=on;END PROCdefformeditrubin;PROCgetformeditrubin(BOOL VARon):on:=rubinon;END PROCgetformeditrubin;BOOL PROCformeditrubin:rubinonEND PROCformeditrubin;PROCdefformeditlearn(BOOL CONSTon):learnon:=on;END PROCdefformeditlearn;PROCgetformeditlearn(BOOL VARon):on:=learnon;END PROCgetformeditlearn;BOOL PROCformeditlearn:learnonEND PROCformeditlearn;PROCdefformeditkeys(BOOL CONSTon):keyson:=on;END PROCdefformeditkeys;PROCgetformeditkeys(BOOL VARon):on:=keyson;END PROCgetformeditkeys;BOOL PROCformeditkeys:keysonEND PROCformeditkeys;PROCdefformeditmark(BOOL CONSTon):markon:=on;END PROCdefformeditmark;PROCgetformeditmark(BOOL VARon):on:=markon;END PROCgetformeditmark;BOOL PROCformeditmark:markonEND PROCformeditmark;PROCresetformulaeditor:disablestop;xcur:=1;ycur:=1;xlow:=1;ylow:=1;xhig:=79;yhig:=24;xoff:=0;yoff:=0;xpoi:=1;ypoi:=1;xmin:=1;ymin:=1;xmax:=1;ymax:=1;pointermode:=2;buffer:="";bufferon:=FALSE;xbuffer:=0;ybuffer:=0;lbuffer:=0;arithon:=FALSE;xarith:=0;yarith:=0;larith:=0;erroron:=TRUE;xerror:=0;yerror:=0;lerror:=0;beepon:=TRUE;rubinon:=TRUE;xrubin:=0;yrubin:=0;learnon:=FALSE;xlearn:=0;ylearn:=0;keyson:=FALSE;xkeys:=0;ykeys:=0;markon:=TRUE;dspbuffer:="Puffer : ";clrbuffer:=" ";dsparith:="Formel : ";clrarith:=" ";dsperror:="FEHLER : ";clrerror:=" ";dsprubin:="RUBIN ";clrrubin:=" ";dsplearn:="LEARN ";clrlearn:=" ";dspkeys:="Tasten : ";clrkeys:=" ";dspmark:="+-+| |+-++ +";clrmark:=" ";END PROCresetformulaeditor;PROCdefformeditexitkeys(TEXT CONSTstd,hop,esc):stdkeys:=std;hopkeys:=hop;esckeys:=esc;END PROCdefformeditexitkeys;PROCgetformeditexitkeys(TEXT VARstd,hop,esc):std:=stdkeys;hop:=hopkeys;esc:=esckeys;END PROCgetformeditexitkeys;TEXT PROCformeditexitkey:exitkeyEND PROCformeditexitkey;PROCdefformeditwindow(INT CONSTxl,yl,xh,yh):disablestop;xcurDECRxlow;ycurDECRylow;xoffDECRxlow;yoffDECRylow;xlow:=xl;ylow:=yl;xhig:=xh;yhig:=yh;xoffINCRxlow;yoffINCRylow;xcurINCRxlow;ycurINCRylow;END PROCdefformeditwindow;PROCgetformeditwindow(INT VARxl,yl,xh,yh):xl:=xlow;yl:=ylow;xh:=xhig;yh:=yhig;END PROCgetformeditwindow;PROCdefformeditoffset(INT CONSTxo,yo):disablestop;xcurDECRxoff;ycurDECRyoff;xoff:=xo;yoff:=yo;xcurINCRxoff;ycurINCRyoff;END PROCdefformeditoffset;PROCgetformeditoffset(INT VARxo,yo):xo:=xoff;yo:=yoff;END PROCgetformeditoffset;PROCdefformeditshift(INT CONSTxs,ys):defformeditoffset(xs+xlow-1,ys+ylow-1);END PROCdefformeditshift;PROCgetformeditshift(INT VARxs,ys):xs:=xoff-xlow+1;ys:=yoff-ylow+1;END PROCgetformeditshift;PROCdefformeditcursor(INT CONSTxc,yc):xmove(xc-xcur);ymove(yc-ycur);END PROCdefformeditcursor;PROCgetformeditcursor(INT VARxc,yc):xc:=xcur;yc:=ycur +;END PROCgetformeditcursor;PROCdefformeditpointer(INT CONSTxp,yp):xmove(xp-xpoi);ymove(yp-ypoi);END PROCdefformeditpointer;PROCgetformeditpointer(INT VARxp,yp):xp:=xpoi;yp:=ypoi;END PROCgetformeditpointer;PROCmoveformeditpointer(INT CONSTxd,yd):xmove(xd);ymove(yd);END PROCmoveformeditpointer;PROCxmove(INT CONSTxdel):disablestop;IFxdel<0THENmoveleftELIFxdel>0THENmoverightFI;pointermode:=2;.moveleft:IFxpoi<=xminTHENbeep;LEAVEmoveleftFI;xcurINCRxdel;xpoiINCRxdel;IFxpoi=xmaxTHENbeep;LEAVEmoverightFI;xcurINCRxdel;xpoiINCRxdel;IFxpoi>xmaxTHENxcurINCRxmax-xpoi;xpoi:=xmaxFI;IFxcur>xhigTHENxoffINCRxhig-xcur;xcur:=xhig;newdisplay:=TRUE FI;.END PROCxmove;PROCymove(INT CONSTydel):disablestop;IFydel<0THENmoveupELIFydel>0THENmovedownELSE LEAVEymoveFI;pointermode:=2;.moveup:IFypoi<=yminTHENbeep;LEAVEmoveupFI;ycurINCRydel;ypoiINCRydel;IFypoi=ymaxTHENbeep;LEAVEmovedownFI;ycurINCRydel;ypoiINCRydel;IFypoi>ymaxTHENycurINCRymax-ypoi;ypoi:=ymaxFI;IFycur>yhigTHENyoffINCRyhig-ycur;ycur:=yhig;newdisplay:=TRUE FI;.END PROCymove;END PACKETformulaeditor; + diff --git a/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung b/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung new file mode 100644 index 0000000..43ad1db --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung @@ -0,0 +1,3 @@ +PACKETopstoreDEFINESforgetops,clearops,initops,reorganizeops,loadops,saveops,delimiter,defop,getop,getoppower,oplbp,oprbp,getopforce,oplforce,oprforce,opoforce,oppforce,getopparams,opparams,getopparamexc,opparamexc,getopposition,getopalignment,getopframe,oparithsymbol,opscreensymbol,getopprintsymbols,opindex,definedops,:LETopspacetype=12345;LET OPSTORE=STRUCT(INTused,TEXTdelim,ELEMROWpwr,ELEMROWfrc,ELEMROWpoi,ELEMROWalg,ELEMROWfrm,TEXTROWamid,TEXTROWsmid,TEXTROWplft,pmid,prgt);INITFLAG VARopspaceok:=FALSE;DATASPACE VARopspace;BOUND OPSTORE VARop;INT VARdummy;PROCforgetops:disablestop;IFinitialized(opspaceok)THENforget(opspace)FI;opspaceok:=FALSE;END PROCforgetops;PROCcheckops:disablestop;IFinitialized(opspaceok)THEN LEAVEcheckopsFI;opspaceok:=FALSE;errorstop("Keine Operatoren geladen");END PROCcheckops;PROCclearops:IFinitialized(opspaceok)THENforget(opspace)FI;opspace:=nilspace;op:=opspace;type(opspace,opspacetype);op.used:=0;op.delim:=" ";clear(op.pwr);clear(op.frc);clear(op.poi);clear(op.alg);clear(op.frm);op.amid:=emptytextrow;op.smid:=emptytextrow;op.plft:=emptytextrow;op.pmid:=emptytextrow;op.prgt:=emptytextrow;END PROCclearops;PROCinitops:BOOL VARok;LETstdops="std ops";disablestop;IFinitialized(opspaceok)THEN LEAVEinitopsFI;opspaceok:=FALSE;enablestop;ok:=exists(stdops);IFokTHENloadops(stdops);LEAVEinitops;FI;fetch(stdops,ok);IFokTHENloadops(stdops);forget(stdops,quiet);ELSEclearops;FI;END PROCinitops;PROCfetch(TEXT CONSTdsname,BOOL VARok):accesscatalogue;TASK VARtask:=myself;LETwaitstatus=2,urindex=2;ok:=FALSE;REPtask:=father(task);IFindex(task)<=urindexTHEN LEAVEfetchFI;UNTILstatus(task)=waitstatusCANDexists(dsname,task)PER;fetch(dsname,task);ok:=exists(dsname);END PROCfetch;PROCreorganizeops:enablestop;checkops;disablestop;DATASPACE VARscratchspace:=nilspace;BOUND OPSTORE VARscratch:=scratchspace;scratch:=op;IF NOTiserrorTHENforget(opspace);opspace:=scratchspace;op:=opspace;type(opspace,opspacetype);FI;forget(scratchspace);END PROCreorganizeops;PROCloadops(TEXT CONSTdsname):forgetops;disablestop;opspace:=old(dsname,opspacetype);IFiserrorTHENforgetops;LEAVEloadopsFI;op:=opspace;opspaceok:=TRUE;END PROCloadops;PROCsaveops(TEXT CONSTdsname):enablestop;checkops;disablestop;IFexists(dsname)THENforget(dsname)FI;IF NOTexists(dsname)THENreorganizeops;copy(opspace,dsname)FI;END PROCsaveops;PROCdelimiter(INT CONSTdelim):delimiter(code(delim));END PROCdelimiter;PROCdelimiter(TEXT CONSTdelim):initops;replace(op.delim,1,delim);END PROCdelimiter;TEXT PROCdelimiter:initops;op.delimEND PROCdelimiter;PROCdefop(INT CONSTidx,TEXT CONSTamid,INT CONSTlbp,rbp,npm,exc,lfc,rfc,ofc,pfc,TEXT CONSTsmid,INT CONSTlxp,lyp,rxp,ryp,lxa,lya,rxa,rya,bxf,byf,exf,eyf,TEXT CONSTplft,pmid,prgt):initops;define(op.pwr,idx,lbp,rbp,npm,exc);define(op.frc,idx,lfc,rfc,ofc,pfc);define(op.poi,idx,lxp,lyp,rxp,ryp);define(op.alg,idx,lxa,lya,rxa,rya);define(op.frm,idx,bxf,byf,exf,eyf);WHILEhighestentry(op.amid),>,<=,=,>=,textrow,thesaurus,FILLBY,:LEThex00="�";LEThexff="�";LEThex0000="��";LEThex0001="��";LEThexfeff="��";LEThexffff="��";TEXT VARindexpat:="��ii��";replace(indexpat,2,1);TEXT VARentrypat;TYPE TEXTROW=TEXT;TEXTROW CONSTemptytextrow:=TEXTROW:(indexpat);OP:=(TEXTROW VARd,TEXTROW CONSTs):CONCR(d):=CONCR(s);END OP:=;PROCcatexpanded(TEXT VARt,TEXT CONSTentry):INT CONSTl:=LENGTHentry;INT VARb:=1;INT VARef:=pos(entry,hexff,b);IFef=0THENef:=l+1FI;INT VARe0:=pos(entry,hex00,b);IFe0=0THENe0:=l+1FI;REP IFe00THEN(subtext(CONCR(t),p+2,p+3)ISUB1)-1ELSE0FI END PROChighestentry;INT PROCfirstentry(TEXTROW CONSTdir):nextentry(dir,0)END PROCfirstentry;INT PROCnextentry(TEXTROW CONSTdir,INT CONSTstart):INT VARindex:=start;INT CONSTlimit:=highestentry(dir);WHILEindex<=limitREPindexINCR1UNTILname(dir,index)<>""PER;indexEND PROCnextentry;BOOL OP CONTAINS(TEXTROW CONSTt,TEXT CONSTentry):entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;pos(CONCR(t),entrypat,1)>0END OP CONTAINS;INT PROClink(TEXTROW CONSTt,TEXT CONSTentry):INT VARp;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENsubtext(CONCR(t),p-2,p-1)ISUB1ELSE0FI END PROClink;INT PROClink(TEXTROW CONSTt,TEXT CONSTentry,INT CONSTstart):INT VARp,index;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=0;REPp:=pos(CONCR(t),entrypat,p+1);IFp=0THEN LEAVElinkWITH0FI;index:=subtext(CONCR(t),p-2,p-1)ISUB1;UNTILindex>=startPER;indexEND PROClink;TEXT PROCname(TEXTROW CONSTt,INT CONSTindex):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1);IFb=0THEN LEAVEnameWITH""FI;replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b+6);IFe=0THEN LEAVEnameWITH""FI;entrypat:="";catcompressed(entrypat,subtext(CONCR(t),b+6,e-1));entrypatEND PROCname;PROCrename(TEXTROW VARt,TEXT CONSTold,new):INT VARp,len;entrypat:=hexffff;catexpanded(entrypat,old);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENlen:=LENGTHentrypat;entrypat:="";catexpanded(entrypat,new);change(CONCR(t),p+2,p+len-3,entrypat);FI;END PROCrename;PROCrename(TEXTROW VARt,INT CONSTindex,TEXT CONSTnew):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1);replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b+6);IFe>0THENchange(CONCR(t),b+6,e-1,new);FI;END PROCrename;PROCinsert(TEXTROW VARt,TEXT CONSTentry,INT VARindex):index:=subtext(CONCR(t),LENGTH CONCR(t)-3)ISUB1;catexpanded(CONCR(t),entry);replace(indexpat,2,index+1);CONCR(t)CATindexpat;END PROCinsert;PROCinsert(TEXTROW VARt,TEXT CONSTentry):INT VARindex;insert(t,entry,index);END PROCinsert;PROCdelete(TEXTROW VARt,TEXT CONSTentry,INT VARindex):INT VARp;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENindex:=subtext(CONCR(t),p-2,p-1)ISUB1;change(CONCR(t),p+2,p+len-3,"");ELSEindex:=0;FI;END PROCdelete;PROCdelete(TEXTROW VARt,INT CONSTindex):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1)+6;replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b); +IFe=0THEN LEAVEdeleteFI;IFindex=highestentry(t)THEN CONCR(t):=subtext(CONCR(t),1,b-1);ELSEchange(CONCR(t),b,e-1,"");FI;END PROCdelete;PROCget(TEXTROW CONSTt,TEXT VARentry,INT VARindex):INT VARb,e;indexINCR1;replace(indexpat,2,index);b:=pos(CONCR(t),indexpat,1);entry:="";REPbINCR6;indexINCR1;replace(indexpat,2,index);e:=pos(CONCR(t),indexpat,b);IFe>bTHENindexDECR1;catcompressed(entry,subtext(CONCR(t),b,e-1));LEAVEget;ELIFe=0THENindex:=0;LEAVEget;FI;PER;END PROCget;TEXT PROCtop(TEXTROW CONSTt):name(t,highestentry(t))END PROCtop;TEXT PROCpop(TEXTROW VARt):pop(t,entrypat);entrypatEND PROCpop;PROCpop(TEXTROW VARt,TEXT VARentry):entry:=top(t);delete(t,highestentry(t));END PROCpop;INT PROCleftmatchinglinks(TEXTROW CONSTt,TEXT CONSTentry):INT VARp,l,n;entrypat:=hexffff;catexpanded(entrypat,entry);l:=LENGTHentrypat;n:=0;p:=pos(CONCR(t),entrypat,1);WHILEp>0REPnINCR1;p:=pos(CONCR(t),entrypat,p+l)PER;nEND PROCleftmatchinglinks;INT PROCrightmatchinglinks(TEXTROW CONSTt,TEXT CONSTentry):INT VARp,l,n;entrypat:="";catexpanded(entrypat,entry);entrypatCAThex0000;l:=LENGTHentrypat;n:=0;p:=pos(CONCR(t),entrypat,1);WHILEp>0REPnINCR1;p:=pos(CONCR(t),entrypat,p+l)PER;nEND PROCrightmatchinglinks;TEXTROW OP LIKE(TEXTROW CONSTa,TEXT CONSTpattern):TEXTROW VARlike:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(like,entry)=0AND(entryLIKEpattern)THENinsert(like,entry)FI;PER;likeEND OP LIKE;TEXTROW OP REV(TEXTROW CONSTa):TEXTROW VARrev:=emptytextrow;INT VARindex;FORindexFROMhighestentry(a)DOWNTO1REPinsert(rev,name(a,index));PER;revEND OP REV;TEXTROW OP-(TEXTROW CONSTa):textrow(all)-aEND OP-;TEXTROW OP+(TEXTROW CONSTa,b):TEXTROW VARunion:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(union,entry)=0THENinsert(union,entry)FI;PER;FORindexFROM1UPTOhighestentry(b)REPentry:=name(b,index);IFlink(union,entry)=0THENinsert(union,entry)FI;PER;unionEND OP+;TEXTROW OP-(TEXTROW CONSTa,b):TEXTROW VARdiff:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(diff,entry)=0ANDlink(b,entry)=0THENinsert(diff,entry)FI;PER;diffEND OP-;TEXTROW OP/(TEXTROW CONSTa,b):TEXTROW VARinter:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(inter,entry)=0ANDlink(b,entry)>0THENinsert(inter,entry)FI;PER;interEND OP/;TEXTROW OP*(TEXTROW CONSTa,b):TEXTROW VARsdiff:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(sdiff,entry)=0ANDlink(b,entry)=0THENinsert(sdiff,entry)FI;PER;FORindexFROM1UPTOhighestentry(b)REPentry:=name(b,index);IFlink(sdiff,entry)=0ANDlink(a,entry)=0THENinsert(sdiff,entry)FI;PER;sdiffEND OP*;BOOL OP<(TEXTROW CONSTa,b):a<=bAND NOT(b<=a)END OP<;BOOL OP<>(TEXTROW CONSTa,b):NOT(a=b)END OP<>;BOOL OP>(TEXTROW CONSTa,b):b;BOOL OP<=(TEXTROW CONSTa,b):TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(b,entry)=0THEN LEAVE<=WITH FALSE FI;PER;TRUE END OP<=;BOOL OP=(TEXTROW CONSTa,b):a<=bANDb<=aEND OP=;BOOL OP>=(TEXTROW CONSTa,b):b<=aEND OP>=;TEXTROW PROCtextrow(THESAURUS CONSTdir):TEXTROW VARres:=emptytextrow;INT VARindex;FORindexFROM1UPTOhighestentry(dir)REPinsert(res,name(dir,index));PER;resEND PROCtextrow;THESAURUS PROCthesaurus(TEXTROW CONSTdir):THESAURUS VARres:=emptythesaurus;INT VARindex;FORindexFROM1UPTOhighestentry(dir)REPinsert(res,name(dir,index));PER;resEND PROCthesaurus;OP FILLBY(FILE VARf,TEXTROW CONSTdir):INT VARindex;output(f);FORindexFROM1UPTOhighestentry(dir)REPputline(f,name(dir,index))PER;END OP FILLBY;OP FILLBY(TEXTROW VARdir,FILE VARf):TEXT VARentry;input(f);WHILE NOTeof(f)REPgetline(f,entry);insert(dir,entry)PER;END OP FILLBY;END PACKETtextrow; + diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 new file mode 100644 index 0000000..373245e Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 differ diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 new file mode 100644 index 0000000..cdb76cb Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 differ diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 new file mode 100644 index 0000000..49b821a Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 differ diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 new file mode 100644 index 0000000..caff4ba Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 differ diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 new file mode 100644 index 0000000..f37fd1d Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 differ diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 new file mode 100644 index 0000000..46e2f95 Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 differ diff --git a/app/schulis-mathematiksystem/1.0/src/ibmoperatoren b/app/schulis-mathematiksystem/1.0/src/ibmoperatoren new file mode 100644 index 0000000..23601d2 Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/ibmoperatoren differ diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe new file mode 100644 index 0000000..09a2939 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe @@ -0,0 +1,4 @@ +PACKETlsdialog1DEFINESwaagerecht,senkrecht,eckeobenlinks,eckeobenrechts,eckeuntenlinks,eckeuntenrechts,balkenunten,balkenoben,balkenlinks,balkenrechts,kreuz,cursoron,cursoroff,clearbuffer,clearbufferandcount,center,invers,page,pageup,outframe,outmenuframe,eraseframe,stdgraphicchar,ft20graphicchar,ibmgraphicchar,AREA,:=,fill,areax,areay,areaxsize,areaysize,cursor,getcursor,out,outinvers,outwithbeam,outinverswithbeam,erase,eraseinvers,erasewithbeam,writepermanentfootnote,oldfootnote,footnote:TYPE AREA=STRUCT(INTx,y,xsize,ysize);LETblank=" ",markein="",markaus="",cleol="�";TEXT CONSTfehlermeldung:="Unzulässige Größen!";TEXT VAReol:="+",eor:="+",eul:="+",eur:="+",bo:="+",br:="+",bl:="+",bu:="+",waa:="-",sen:="|",kr:="+",cursorsichtbar:="",cursorunsichtbar:="";TEXT VARpermanentefusszeile:="";PROCwritepermanentfootnote(TEXT CONSTt):permanentefusszeile:=t;footnote(t)END PROCwritepermanentfootnote;PROColdfootnote:footnote(permanentefusszeile)END PROColdfootnote;PROCfootnote(TEXT CONSTt):INT VARx,y;getcursor(x,y);cursor(1,24);out(invers(text(t,76)));cursor(x,y)END PROCfootnote;TEXT PROCeckeobenlinks:eolEND PROCeckeobenlinks;TEXT PROCeckeobenrechts:eorEND PROCeckeobenrechts;TEXT PROCeckeuntenlinks:eulEND PROCeckeuntenlinks;TEXT PROCeckeuntenrechts:eurEND PROCeckeuntenrechts;TEXT PROCbalkenoben:boEND PROCbalkenoben;TEXT PROCbalkenlinks:blEND PROCbalkenlinks;TEXT PROCbalkenrechts:brEND PROCbalkenrechts;TEXT PROCbalkenunten:buEND PROCbalkenunten;TEXT PROCwaagerecht:waaEND PROCwaagerecht;TEXT PROCsenkrecht:senEND PROCsenkrecht;TEXT PROCkreuz:krEND PROCkreuz;PROCeckeobenlinks(TEXT CONSTt):eol:=tEND PROCeckeobenlinks;PROCeckeobenrechts(TEXT CONSTt):eor:=tEND PROCeckeobenrechts;PROCeckeuntenlinks(TEXT CONSTt):eul:=tEND PROCeckeuntenlinks;PROCeckeuntenrechts(TEXT CONSTt):eur:=tEND PROCeckeuntenrechts;PROCbalkenoben(TEXT CONSTt):bo:=tEND PROCbalkenoben;PROCbalkenlinks(TEXT CONSTt):bl:=tEND PROCbalkenlinks;PROCbalkenrechts(TEXT CONSTt):br:=tEND PROCbalkenrechts;PROCbalkenunten(TEXT CONSTt):bu:=tEND PROCbalkenunten;PROCwaagerecht(TEXT CONSTt):waa:=tEND PROCwaagerecht;PROCsenkrecht(TEXT CONSTt):sen:=tEND PROCsenkrecht;PROCkreuz(TEXT CONSTt):kr:=tEND PROCkreuz;PROCstdgraphicchar:eckeobenlinks("+");eckeobenrechts("+");eckeuntenlinks("+");eckeuntenrechts("+");balkenoben("+");balkenrechts("+");balkenlinks("+");balkenunten("+");waagerecht("-");senkrecht("|");kreuz("+");cursorsichtbar:="";cursorunsichtbar:=""END PROCstdgraphicchar;PROCft20graphicchar:eckeobenlinks("�R��S");eckeobenrechts("�RD�S");eckeuntenlinks("�RH�S");eckeuntenrechts("�RL�S");balkenoben("�RP�S");balkenrechts("�RT�S");balkenlinks("�RX�S");balkenunten("�R\�S");waagerecht("�R`�S");senkrecht("�Rd�S");kreuz("�Rh�S");cursorsichtbar:="�-1";cursorunsichtbar:="�-0";ft20statuszeilenausEND PROCft20graphicchar;PROCft20statuszeilenaus:out("�.A")END PROCft20statuszeilenaus;PROCft20statuszeilenan:out("�.�")END PROCft20statuszeilenan;PROCibmgraphicchar:eckeobenlinks("�");eckeobenrechts("�");eckeuntenlinks("̈");eckeuntenrechts("�");balkenoben("̗");balkenrechts("ω");balkenlinks("�");balkenunten("̊");waagerecht("̊");senkrecht("�");kreuz("�");cursorsichtbar:="";cursorunsichtbar:=""END PROCibmgraphicchar;PROCcursoron:out(cursorsichtbar)END PROCcursoron;PROCcursoroff:out(cursorunsichtbar)END PROCcursoroff;PROCcursoron(TEXT CONSTt):cursorsichtbar:=tEND PROCcursoron;PROCcursoroff(TEXT CONSTt):cursorunsichtbar:=tEND PROCcursoroff;PROCclearbuffer:REP UNTILincharety=""PER END PROCclearbuffer;INT PROCclearbufferandcount(TEXT CONSTzeichen):INT VARzaehler:=0;TEXT VARzeichenkette:="",ch;IFzeichen=""THENclearbuffer;LEAVEclearbufferandcountWITH0FI;ermittlediezeichenkette;untersucheaufvorhandenezeichen;zaehler.ermittlediezeichenkette:REPch:=incharety(1);zeichenketteCATchUNTILch=""PER.untersucheaufvorhandenezeichen:INT VARi;FORiFROM1UPTOlength(zeichenkette)REP IFpos(subtext(zeichenkette,i),zeichen)=1THENzaehlerINCR1FI PER.END PROCclearbufferandcount;TEXT PROCcenter(INT CONSTxsize,TEXT CONSTt):TEXT VARzeile:=compress(t +);zeile:=((xsize-length(zeile))DIV2)*blank+zeile;zeileCAT(xsize-length(zeile))*blank;zeileEND PROCcenter;TEXT PROCcenter(TEXT CONSTt):center(79,t)END PROCcenter;TEXT PROCinvers(TEXT CONSTt):TEXT VARneu:=markein;neuCATt;neuCAT" ";neuCATmarkaus;neuEND PROCinvers;PROCpage(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI;cursor(x,y).ineinemstreich:FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(leerzeile)PER.END PROCpage;PROCpage(AREA CONSTa):page(a.x,a.y,a.xsize,a.ysize)END PROCpage;PROCpageup(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI.ineinemstreich:FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(leerzeile)PER.END PROCpageup;PROCpageup(AREA CONSTa):pageup(a.x,a.y,a.xsize,a.ysize)END PROCpageup;PROCoutframe(INT CONSTx,y,xsize,ysize):TEXT VARlinie:=(xsize-2)*waagerecht;INT VARzeiger;IFx<1CORy<1CORxsize<8CORysize<3CORx+xsize>80CORy+ysize>25THEN LEAVEoutframeFI;maleoben;maleseiten;maleunten.maleoben:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).maleseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(senkrecht);cursor(x+xsize-1,y+zeiger);out(senkrecht)PER.maleunten:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts)END PROCoutframe;PROCoutframe(AREA CONSTa):IFa.x-1<1ORa.y-1<1ORa.xsize+2>79ORa.ysize+2>24ORa.x+a.xsize+1>80ORa.y+a.ysize+1>25THEN LEAVEoutframeFI;outframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutframe;PROCoutmenuframe(INT CONSTx,y,xsize,ysize):INT VARi;TEXT VARlinie;untersucheangaben;schreiberahmen.untersucheangaben:IFx<0CORy<0CORx+xsize>81CORy+ysize>26THEN LEAVEoutmenuframeFI.schreiberahmen:IFx=0CORy=0CORxsize=81CORysize=26THENlinie:=xsize*waagerecht;zeichnereduziertenrahmenELSElinie:=(xsize-2)*waagerecht;zeichnevollenrahmenFI.zeichnereduziertenrahmen:zeichneoberlinie;zeichneunterlinie.zeichneoberlinie:cursor(1,2);out(linie).zeichneunterlinie:cursor(1,23);out(linie).zeichnevollenrahmen:schreibekopf;schreiberumpf;schreibefuss;schreibekopfleiste;schreibefussleiste.schreibekopf:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreiberumpf:FORiFROMy+1UPTOy+ysize-2REPcursor(x,i);out(senkrecht);cursor(x+xsize-1,i);out(senkrecht)PER.schreibefuss:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).schreibekopfleiste:cursor(x,y+2);schreibebalkenlinie.schreibefussleiste:cursor(x,y+ysize-3);schreibebalkenlinie.schreibebalkenlinie:out(balkenlinks);out(linie);out(balkenrechts).END PROCoutmenuframe;PROCoutmenuframe(AREA CONSTa):outmenuframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutmenuframe;PROCeraseframe(INT CONSTx,y,xsize,ysize):INT VARzeiger;TEXT VARleerzeile:=xsize*blank;loescheoben;loescheseiten;loescheunten.loescheoben:cursor(x,y);out(leerzeile).loescheseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(blank);cursor(x+xsize-1,y+zeiger);out(blank)PER.loescheunten:cursor(x,y+ysize-1);out(leerzeile)END PROCeraseframe;OP:=(AREA VARziel,AREA CONSTquelle):CONCR(ziel):=CONCR(quelle)END OP:=;PROCfill(AREA VARziel,INT CONSTa,b,c,d):IFa<1CORb<1CORa>79CORb>24CORc<8CORd<1CORc>79CORd>24CORa+c>80CORb+d>25THENerrorstop(fehlermeldung)FI;ziel.x:=a;ziel.y:=b;ziel.xsize:=c;ziel.ysize:=dEND PROCfill;INT PROCareax(AREA CONSTa):a.xEND PROCareax;INT PROCareay(AREA CONSTa):a.yEND PROCareay;INT PROCareaxsize(AREA CONSTa):a.xsizeEND PROCareaxsize;INT PROCareaysize(AREA CONSTa):a.ysizeEND PROCareaysize;PROCout(TEXT CONSTt,INT CONSTbreite):outtext(t,1,breite)END PROCout;PROCerase(INT CONSTbreite):out(breite*blank)END PROCerase;PROCcursor(AREA CONSTa,INT CONSTspa,zei):cursor(a.x+spa-1,a.y+zei-1)END PROCcursor;PROCgetcursor(AREA CONSTa,INT VARspalte,zeile):INT VARx,y;getcursor(x,y);spalte:=x-a.x+1;zeile:=y-a.y+1END PROCgetcursor;PROCout(AREA CONSTa,INT CONSTspa +,zei,TEXT CONSTt):out(a,spa,zei,t,LENGTHt)END PROCout;PROCout(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEouttext(t,1,laenge)FI.ueberpruefecursorangaben:IFspa>a.xsizeCORzei>a.ysizeCORspa<1CORzei<1THEN LEAVEoutFI.positionierecursor:cursor(a.x+spa-1,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa+1.verkuerzteausgabe:outtext(t,1,a.xsize-spa+1)END PROCout;PROCerase(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):out(a,spa,zei,laenge*blank,laenge)END PROCerase;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinvers(a,spa,zei,t,LENGTHt)END PROCoutinvers;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=markein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-1);ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;out(hilf).ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEoutinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1END PROCoutinvers;PROCeraseinvers(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+3)FI.ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEeraseinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1.verkuerzteausgabe:erase(a.xsize-spa+2).END PROCeraseinvers;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outwithbeam(a,spa,zei,t,LENGTHt)END PROCoutwithbeam;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCAT" ";IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCAT" ";hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutwithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.END PROCoutwithbeam;PROCerasewithbeam(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+6)FI.ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEerasewithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.verkuerzteausgabe:erase(a.xsize-spa+4).END PROCerasewithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinverswithbeam(a,spa,zei,t,LENGTHt)END PROCoutinverswithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCATblank;hilfCATmarkein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutinverswithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2END PROCoutinverswithbeam;END PACKETlsdialog1; + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe new file mode 100644 index 0000000..73d4c2a --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe @@ -0,0 +1,7 @@ +PACKETlsdialog2DEFINESsome,one,lsexitkey,resetlsexitkey,infixnamen,ohnepraefix,notempty:LETmaxentries=200;LETzeichenstring="��� + �xo? ",obenuntenreturnruboutkreuzkringelblank="� + �xo ",qeinsneunh="w19m";LETzurueck="�",piep="�";LEThop=1,esc=2,oben=3,unten=4,return=5,rubout=6,kreuz=7,kringel=8,frage=9,leer=10;LETpunkt=".",blank=" ";INT VARx,y,xsize,ysize,maxeintraege,anzahl,ersteauswahlzeile,virtuellercursor,reellercursor;TEXT VARkennzeile1,kennzeile2,registrierkette:="",exitkey:="";BOOL VARabbruch,auswahlende;BOUND ROWmaxentriesTEXT VAReintrag;ROW2TEXT CONSTfehlermeldung:=ROW2TEXT:("Unzulässige Cursorwerte bei der Auswahl","Fenster für Auswahl zu klein (x < 56 / y < 15)");ROW16TEXT CONSThinweis:=ROW16TEXT:(" Bitte warten...!"," Info: Weiter: Menü: "," Weiter mit beliebiger Taste!","Weitere Einträge!"," INFORMATIONEN ZUR AUSWAHL AUS DER LISTE"," Positionierung der Schreibmarke:"," Pfeil auf/ab : eine Position nach oben/unten"," HOP Pfeil auf/ab : auf erste/letzte Pos. der Seite"," ESC 1/ESC 9 : auf erste/letzte Pos. der Liste"," Ankreuzen und Löschen von Kreuzen:"," RETURN/x : den Eintrag ankreuzen"," RUBOUT/o/Leertaste: Kreuz vor dem Eintrag löschen"," HOP RETURN/HOP x : alle folgenden Eintr. ankreuzen"," HOP RUBOUT/HOP o : alle folgenden Kreuze löschen"," /HOP Leertaste"," Info: Menü: ");TEXT PROClsexitkey:exitkeyEND PROClsexitkey;PROClsexitkey(TEXT CONSTausgang):exitkey:=ausgang;END PROClsexitkey;PROCresetlsexitkey:exitkey:=""END PROCresetlsexitkey;THESAURUS PROCauswahl(THESAURUS CONSTt,BOOL CONSTmehreremoeglich,TEXT CONSTt1,t2):TEXT VARlinie:=(xsize-2)*waagerecht;werteinitialisieren;namenbesorgen;bildschirmaufbauen;auswaehlenlassen;abgangvorbereiten.werteinitialisieren:THESAURUS VARausgabe:=emptythesaurus;DATASPACE VARds:=nilspace;eintrag:=ds;kennzeile1:=t1;kennzeile2:=t2;abbruch:=FALSE;ersteauswahlzeile:=y+5;anzahl:=0;maxeintraege:=ysize-8;virtuellercursor:=1;reellercursor:=1.namenbesorgen:fischedienamenausdemthesaurus;IFkeineintragvorhandenTHEN LEAVEauswahlWITHausgabeFI.bildschirmaufbauen:schreibekopfzeile;gibhinweisaus(kennzeile1,kennzeile2);bauebildschirmauf(1);schreibefusszeile;IFmehreremoeglichTHENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF;reellencursorsetzen.schreibekopfzeile:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreibefusszeile:cursor(x,y+ysize-2);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).auswaehlenlassen:kreuzean(mehreremoeglich).abgangvorbereiten:footnote(hinweis[1]);cursor(x+1,y+ysize-1);ausgabeerzeugen;forget(ds);ausgabe.fischedienamenausdemthesaurus:INT VARzeiger;FORzeigerFROM1UPTOhighestentry(t)REP IFname(t,zeiger)<>""THENanzahlINCR1;eintrag[anzahl]:=name(t,zeiger)FI PER.keineintragvorhanden:anzahl=0.ausgabeerzeugen:TEXT VARnummer;WHILEregistrierkette<>""REPnummer:=subtext(registrierkette,1,3);registrierkette:=subtext(registrierkette,5);insert(ausgabe,eintrag[int(nummer)])PER.END PROCauswahl;PROCreellencursorsetzen:cursor(x+1,ersteauswahlzeile+reellercursor-1);out(marke(virtuellercursor,TRUE)+8*zurueck)END PROCreellencursorsetzen;PROCbauebildschirmauf(INT CONSTanfang):TEXT VARpunktlinie:=(xsize-2)*punkt,weiterzeile:=(xsize-length(hinweis[4])-5)*punkt+invers(hinweis[4]),beamedleerzeile:=senkrecht+(xsize-2)*blank+senkrecht;gibkopfzeileaus;gibnamenstabelleaus;gibfusszeileaus;loescheggfrestbereich.gibkopfzeileaus:cursor(x,ersteauswahlzeile-1);out(senkrecht);IFreellercursor=virtuellercursorTHENout(punktlinie)ELSEout(weiterzeile)FI;out(senkrecht);line.gibnamenstabelleaus:INT VARzeiger,zaehler:=-1;TEXT VARhilf;FORzeigerFROManfangUPTOgrenzeREPzaehlerINCR1;cursor(x,ersteauswahlzeile+zaehler);hilf:=senkrecht;hilfCATmarke(zeiger,FALSE);hilfCATtext(subtext(eintrag[zeiger],1,xsize-10),xsize-10);hilfCATsenkrecht;out(hilf)PER.gibfusszeileaus:cursor(x,ersteauswahlzeile+zaehler+1);out(senkrecht);IF NOT((virtuellercursor+maxeintraege-reellercursor) o "ELSE" o "FI.END PROCmarke;INT PROCnr(INT CONSTzeiger):IFpos(registrierkette,textstring(zeiger))=0THEN0ELSE(pos(registrierkette,textstring(zeiger))DIV4)+1FI END PROCnr;TEXT PROCtextstring(INT CONSTnr):text(nr,3)+"!"END PROCtextstring;PROCinfo:INT VARi;notierehinweisueberschrift;notierepositionierhinweise;IFnochplatzvorhandenTHENnotiereauswahlmoeglichkeitenaufalterseiteELSEwechsleaufnaechsteseite;notierehinweisueberschrift;notiereauswahlmoeglichkeitenaufneuerseiteFI;stellealtenbildschirmzustandwiederher.notierehinweisueberschrift:cursor(x+1,y+1);out(center(xsize-2,hinweis[5]));cursor(x+1,y+2);out("",xsize-2).notierepositionierhinweise:cursor(x+1,y+3);out(hinweis[6],xsize-2);cursor(x+1,y+4);out("",xsize-2);FORiFROM5UPTO7REPcursor(x+1,y+i);out(hinweis[i+2],xsize-2)PER.notiereauswahlmoeglichkeitenaufalterseite:cursor(x+1,y+8);out("",xsize-2);cursor(x+1,y+9);out(hinweis[10],xsize-2);cursor(x+1,y+10);out("",xsize-2);FORiFROM11UPTO15REPcursor(x+1,y+i);out(hinweis[i],xsize-2)PER;loeschedierestlichenzeilen;footnote(hinweis[3]);cursorinruhestellung;clearbuffer.loeschedierestlichenzeilen:FORiFROMy+16UPTOy+ysize-3REPcursor(x+1,i);out("",xsize-2)PER.wechsleaufnaechsteseite:loescheseitenrest;footnote(hinweis[3]);cursorinruhestellung;clearbuffer;pause.loescheseitenrest:INT VARzaehler;FORzaehlerFROM8UPTOysize-3REPcursor(x+1,y+zaehler);out("",xsize-2)PER.notiereauswahlmoeglichkeitenaufneuerseite:cursor(x+1,y+3);out(hinweis[10],xsize-2);cursor(x+1,y+4);out("",xsize-2);FORiFROM5UPTO9REPcursor(x+1,y+i);out(hinweis[i+6],xsize-2)PER;FORzaehlerFROM10UPTOysize-3REPcursor(x+1,y+zaehler);out("",xsize-2)PER.cursorinruhestellung:cursor(x+1,y+ysize-2).stellealtenbildschirmzustandwiederher:clearbuffer;pause;gibhinweisaus(kennzeile1,kennzeile2);virtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzen.nochplatzvorhanden:ysize>17.END PROCinfo;PROCkreuzean(BOOL CONSTmehrere):auswahlende:=FALSE;clearbuffer;REPzeichenlesen;zeicheninterpretierenUNTILauswahlendePER.zeichenlesen:TEXT VARzeichen;getchar(zeichen).zeicheninterpretieren:SELECTpos(zeichenstring,zeichen)OF CASEhop:hopkommandoverarbeiten(mehrere)CASEesc:esckommandoverarbeitenCASEoben:nachobenCASEunten:nachuntenCASEkreuz,return:ankreuzenweiter;evtlaufhoerenCASErubout,kringel,leer:auskreuzenweiterCASEfrage:info;IFmehrereTHENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF;OTHERWISEout(piep)END SELECT.evtlaufhoeren:IF NOTmehrereTHEN LEAVEkreuzeanFI.END PROCkreuzean;PROChopkommandoverarbeiten(BOOL CONSTmehrere):zweiteszeichenlesen;zeicheninterpretieren.zweiteszeichenlesen:TEXT VARzweiteszeichen;getchar(zweiteszeichen).zeicheninterpretieren:SELECTpos(obenuntenreturnruboutkreuzkringelblank,zweiteszeichen)OF CASE1:hopnachobenCASE2:hopnachuntenCASE3,5:IFmehrereTHENalledarunterankreuzenFI CASE4,6,7:IFmehrereTHENalledarunterloeschenFI OTHERWISEout(piep)END SELECT.alledarunterankreuzen:INT VARi;FORiFROMvirtuellercursorUPTOanzahlREP IFnr(i)=0THENankreuzenFI PER;bildaktualisieren;reellencursorsetzen.ankreuzen:registrierketteCATtextstring(i).alledarunterloeschen:INT VARj,position;FORjFROMvirtuellercursorUPTOanzahlREPposition:=nr(j);IFposition>0THENrausschmeissen;FI PER;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,(4*position)-4)+subtext(registrierkette,(4*position)+1).hopnachoben:IFganzobenTHENout(piep)ELIFobenaufderseiteTHENraufblaettern +ELSEtopofpageFI.ganzoben:virtuellercursor=1.obenaufderseite:reellercursor=1.raufblaettern:virtuellercursorDECRmaxeintraege;virtuellercursor:=max(virtuellercursor,1);bauebildschirmauf(virtuellercursor);reellencursorsetzen.topofpage:loeschemarke;virtuellercursorDECR(reellercursor-1);reellercursor:=1;reellencursorsetzen.hopnachunten:IFganzuntenTHENout(piep)ELIFuntenaufderseiteTHENrunterblaetternELSEbottomofpageFI.ganzunten:virtuellercursor=anzahl.untenaufderseite:reellercursor>maxeintraege-1.runterblaettern:INT VARaltervirtuellercursor:=virtuellercursor;virtuellercursorINCRmaxeintraege;virtuellercursor:=min(virtuellercursor,anzahl);reellercursor:=virtuellercursor-altervirtuellercursor;bauebildschirmauf(altervirtuellercursor+1);reellencursorsetzen.bottomofpage:loeschemarke;altervirtuellercursor:=virtuellercursor;virtuellercursorINCR(maxeintraege-reellercursor);virtuellercursor:=min(anzahl,virtuellercursor);reellercursorINCR(virtuellercursor-altervirtuellercursor);reellencursorsetzen.END PROChopkommandoverarbeiten;PROCesckommandoverarbeiten:TEXT VARzweiteszeichen;getchar(zweiteszeichen);SELECTpos(qeinsneunh,zweiteszeichen)OF CASE1:auswahlende:=TRUE CASE2:zeigeanfangCASE3:zeigeendeCASE4:abbruch:=TRUE;auswahlende:=TRUE;registrierkette:=""OTHERWISEout(piep)END SELECT;exitkey:=zweiteszeichen.zeigeanfang:IFvirtuellercursor=1THENout(piep)ELIFvirtuellercursor=reellercursorTHENloeschemarke;virtuellercursor:=1;reellercursor:=1;reellencursorsetzenELSEvirtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzenFI.zeigeende:IFvirtuellercursor=anzahlTHENout(piep)ELIFendeaufbildschirmTHENloeschemarke;reellercursorINCR(anzahl-virtuellercursor);virtuellercursor:=anzahl;reellencursorsetzenELSEvirtuellercursor:=anzahl;reellercursor:=maxeintraege;bauebildschirmauf(anzahl-(maxeintraege-1));reellencursorsetzenFI.endeaufbildschirm:(reellercursor+anzahl-virtuellercursor)0THENrausschmeissen;END IF;IFvirtuellercursor0THENrausschmeissenEND IF;loeschemarke;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,4*position-4)+subtext(registrierkette,4*position+1).END PROCauskreuzen;PROCbildaktualisieren:INT VARob,un,i,zaehler:=-1;ob:=virtuellercursor-reellercursor+1;un:=min(ob+maxeintraege-1,anzahl);FORiFROMobUPTOunREPzaehlerINCR1;cursor(x+1,ersteauswahlzeile+zaehler);out(marke(i,FALSE))PER END PROCbildaktualisieren;PROCnachoben:IFnochnichtobenTHENgehenachobenELSEout(piep)FI.nochnichtoben:virtuellercursor>1.gehenachoben:IFreellercursor=1THENscrolldownELSEcursorupFI.scrolldown:virtuellercursorDECR1;bauebildschirmauf(virtuellercursor);reellencursorsetzen.cursorup:loeschemarke;virtuellercursorDECR1;reellercursorDECR1;reellencursorsetzenEND PROCnachoben;PROCnachunten:IFnochnichtuntenTHENgehenachuntenELSEout(piep)FI.nochnichtunten:virtuellercursormaxeintraege-1THENscrollupELSEcursordownFI.scrollup:virtuellercursorINCR1;bauebildschirmauf(virtuellercursor-(maxeintraege-1));reellencursorsetzen.cursordown:loeschemarke;virtuellercursorINCR1;reellercursorINCR1;reellencursorsetzenEND PROCnachunten;PROCloeschemarke:out(marke(virtuellercursor,FALSE))END PROCloeschemarke;PROCgibhinweisaus(TEXT CONSTt1,t2): +cursor(x,y+1);out(senkrecht);out(center(xsize-2,invers(t1)));out(senkrecht);cursor(x,y+2);out(senkrecht);out("",xsize-2);out(senkrecht);cursor(x,y+3);out(senkrecht);out(center(xsize-2,t2));out(senkrecht)END PROCgibhinweisaus;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:pos(eintrag,infix)<>0END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:eintrag<>""CANDtype(old(eintrag))=dateityp.END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)AND(type(old(eintrag))=dateityp).END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,infix2):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)OR(pos(eintrag,infix2)<>0)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix):infixnamen(ALLmyself,infix)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix1,infix2):infixnamen(ALLmyself,infix1,infix2)END PROCinfixnamen;THESAURUS PROCohnepraefix(THESAURUS CONSTthesaurus,TEXT CONSTpraefix):THESAURUS VARt:=emptythesaurus;INT VARzaehler;FORzaehlerFROM1UPTOhighestentry(thesaurus)REP IFname(thesaurus,zaehler)<>""ANDpos(name(thesaurus,zaehler),praefix)=1THENinsert(t,subtext(name(thesaurus,zaehler),length(praefix)+1))FI;PER;tEND PROCohnepraefix;BOOL PROCnotempty(THESAURUS CONSTt):INT VARi;FORiFROM1UPTOhighestentry(t)REP IFname(t,i)<>""THEN LEAVEnotemptyWITH TRUE FI PER;FALSE END PROCnotempty;PROCuntersuchebildschirmmasszahlen(TEXT CONSTt1,t2):IFunzulaessigecursorwerteTHENerrorstop(fehlermeldung[1])ELIFfensteristzukleinTHENerrorstop(fehlermeldung[2])FI.unzulaessigecursorwerte:(x+xsize)>80COR(y+ysize)>25CORx<1CORy<1CORxsize>79CORysize>24.fensteristzuklein:(xsize)<56COR(ysize)<15CORlength(t1)>(xsize-5)CORlength(t2)>(xsize-5).END PROCuntersuchebildschirmmasszahlen;TEXT PROCggfgekuerztertext(TEXT CONSTtext):IFlength(text)>(xsize-5)THENsubtext(text,1,xsize-7)+".."ELSEtextFI END PROCggfgekuerztertext;THESAURUS PROCsome(INT CONSTspa,zei,breite,hoehe,THESAURUS CONSTt,TEXT CONSTt1,t2):TEXT VARtext1,text2;x:=spa;y:=zei;xsize:=breite;ysize:=hoehe;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);auswahl(t,TRUE,text1,text2)END PROCsome;THESAURUS PROCsome(INT CONSTspa,zei,THESAURUS CONSTt,TEXT CONSTt1,t2):some(spa,zei,79-spa+1,24-zei+1,t,t1,t2)END PROCsome;THESAURUS PROCsome(THESAURUS CONSTt,TEXT CONSTt1,t2):some(1,1,79,24,t,t1,t2)END PROCsome;TEXT PROCone(INT CONSTspa,zei,breite,hoehe,THESAURUS CONSTt,TEXT CONSTt1,t2):TEXT VARtext1,text2;x:=spa;y:=zei;xsize:=breite;ysize:=hoehe;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);name(auswahl(t,FALSE,text1,text2),1)END PROCone;TEXT PROCone(INT CONSTspa,zei,THESAURUS CONSTt,TEXT CONSTt1,t2):one(spa,zei,79-spa+1,24-zei+1,t,t1,t2)END PROCone;TEXT PROCone(THESAURUS CONSTt,TEXT CONSTt1,t2):one(1,1,79,24,t,t1,t2)END PROCone;END PACKETlsdialog2; + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe new file mode 100644 index 0000000..3408f21 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe @@ -0,0 +1,3 @@ +PACKETlsdialog3DEFINES WINDOW,:=,window,show,page,erase,line,remaininglines,cursor,getcursor,outframe,outmenuframe,out,put,putline,get,getline,yes,no,edit,center,stop,area,areax,areay,areaxsize,areaysize:LETpiep="�",cr=" ";LETjaneinkette="jJyYnN",blank=" ",niltext="";TYPE WINDOW=STRUCT(AREAfenster,INTcspalte,czeile,belegbarezeilen,BOOLfensterendeerreicht);ROW3TEXT CONSTaussage:=ROW3TEXT:(" 'Window' ungültig!"," (j/n) ?"," Weiter mit beliebiger Taste!");TEXT VARnumberword,exitchar;OP:=(WINDOW VARlinks,WINDOW CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;WINDOW PROCwindow(INT CONSTx,y,xsize,ysize):WINDOW VARw;fill(w.fenster,x,y,xsize,ysize);initialize(w);wEND PROCwindow;PROCinitialize(WINDOW VARw):w.czeile:=1;w.cspalte:=1;w.fensterendeerreicht:=FALSE;w.belegbarezeilen:=areaysize(w.fenster)END PROCinitialize;PROCshow(WINDOW VARw):zeigerahmen;fensterputzen.zeigerahmen:outframe(w.fenster).fensterputzen:page(w).END PROCshow;PROCpage(WINDOW VARw):initialize(w);page(w,FALSE)END PROCpage;PROCpage(WINDOW CONSTw,BOOL CONSTmitrahmen):IFareax(w)=1ANDareay(w)=1ANDareaxsize(w)=79ANDareaysize(w)=24THENpage;ELSEloeschebereichFI.loeschebereich:IFmitrahmenTHENpage(areax(w)-1,areay(w)-1,areaxsize(w)+2,areaysize(w)+2)ELSEpage(area(w))FI END PROCpage;PROCerase(WINDOW VARw):page(w,TRUE)END PROCerase;PROCline(WINDOW VARw):w.cspalte:=1;IFw.czeileareaxsize(w)ORzeile>areaysize(w)THENpage(w);ELSEw.cspalte:=spalte;w.czeile:=zeile;FI;cursor(w.fenster,w.cspalte,w.czeile)END PROCcursor;PROCgetcursor(WINDOW CONSTw,INT VARspalte,zeile):IF(w.cspalte<1)OR(w.cspalte>areaxsize(w.fenster))OR(w.czeile<1)OR(w.czeile>areaysize(w.fenster))THENspalte:=0;zeile:=0ELSEspalte:=w.cspalte;zeile:=w.czeileFI END PROCgetcursor;PROCout(WINDOW VARw,TEXT CONSTtext):INT VARrestlaenge;IF(w.cspalte>=1)AND(w.cspalte<=areaxsize(w.fenster))AND(w.czeile>=1)AND(w.czeile<=w.belegbarezeilen)THENputzeggffenster;cursor(w.fenster,w.cspalte,w.czeile);outtext(text,1,textende);setzefenstercursorneu;setzeausgabeggfinnaechsterzeilefortFI.putzeggffenster:IFw.fensterendeerreichtTHENpage(w);w.fensterendeerreicht:=FALSE FI.textende:restlaenge:=areaxsize(w.fenster)-w.cspalte+1;min(length(text),restlaenge).setzefenstercursorneu:IFlength(text)>=restlaengeTHENw.cspalte:=1;w.czeileINCR1;schlageggfneueseiteaufELSEw.cspalteINCRlength(text)FI.schlageggfneueseiteauf:IFw.czeile>w.belegbarezeilenTHENw.fensterendeerreicht:=TRUE;w.czeile:=1;w.cspalte:=1FI.setzeausgabeggfinnaechsterzeilefort:IFlength(text)>restlaengeTHENout(w,subtext(text,restlaenge+1))FI.END PROCout;PROCoutframe(WINDOW VARw):outframe(area(w))END PROCoutframe;PROCoutmenuframe(WINDOW VARw):outmenuframe(area(w))END PROCoutmenuframe;PROCput(WINDOW VARw,TEXT CONSTword):out(w,word);out(w,blank)END PROCput;PROCput(WINDOW VARw,INT CONSTnumber):put(w,text(number))END PROCput;PROCput(WINDOW VARw,REAL VARnumber):put(w,text(number))END PROCput;PROCputline(WINDOW VARw,TEXT CONSTtextline):out(w,textline);line(w)END PROCputline;PROCprivateget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator,INT CONSTlength):INT VARx,y;INT VARrestlaenge:=areaxsize(w.fenster)-w.cspalte-1;ggfzurnaechstenzeile;getcursor(x,y);cursoron;cursor(x,y);REPword:="";editget(word,laenge,laenge,separator,"",exitchar);out(w,word);echoeexitchar(w)UNTILword<>niltextANDword<>blankPER;cursoroff;deleteleadingblanks.ggfzurnaechstenzeile:IFrestlaenge<5THENline(w);restlaenge:=areaxsize(w.fenster)-2FI.deleteleadingblanks:WHILE(wordSUB1)=blankREPword:=subtext(word,2)PER.laenge:min(length,restlaenge).END PROCprivateget;PROCget(WINDOW VARw,TEXT VARword): +privateget(w,word," ",maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator):privateget(w,word,separator,maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,INT CONSTlength):privateget(w,word,"",length)END PROCget;PROCget(WINDOW VARw,INT VARnumber):get(w,numberword);number:=int(numberword)END PROCget;PROCget(WINDOW VARw,REAL VARnumber):get(w,numberword);number:=real(numberword)END PROCget;PROCgetline(WINDOW VARw,TEXT VARtextline):privateget(w,textline,"",maxtextlength)END PROCgetline;PROCechoeexitchar(WINDOW VARfenster):IFexitchar=crTHENline(fenster)ELSEout(fenster,exitchar)FI END PROCechoeexitchar;TEXT PROCcenter(WINDOW CONSTw,TEXT CONSTtext):IFlength(text)>=areaxsize(w.fenster)THENsubtext(text,1,areaxsize(w.fenster))ELSEcenter(areaxsize(w.fenster),text)FI END PROCcenter;BOOL PROCyes(WINDOW VARw,TEXT CONSTfrage):TEXT VARzeichen,internefrage:=frage;internefrageCATaussage[2];wechselggfaufneueseite;out(w,internefrage);holeeingabezeichen;wertezeichenaus.wechselggfaufneueseite:IFremaininglines(w)<1THENpage(w)FI.holeeingabezeichen:cursoron;clearbuffer;REPinchar(zeichen);piepseggfUNTILpos(janeinkette,zeichen)>0PER;out(w,blank+zeichen);cursoroff;line(w).piepseggf:IFpos(janeinkette,zeichen)=0THENout(piep)FI.wertezeichenaus:IFpos(janeinkette,zeichen)<5THEN TRUE ELSE FALSE FI.END PROCyes;PROCedit(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);cursoron;edit(f,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoroffEND PROCedit;PROCedit(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);edit(w,f)END PROCedit;PROCshow(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);openeditor(groesstereditor+1,f,FALSE,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoron;edit(groesstereditor,"eqvw19dpgn�",PROC(TEXT CONST)stdkommandointerpreter);cursoroffEND PROCshow;PROCshow(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);show(w,f)END PROCshow;PROCloescherechtespalten(WINDOW VARw):INT VARi;FORiFROM1UPTOareaysize(w.fenster)REPcursor(w,areaxsize(w.fenster)-2,i);out(" ")PER END PROCloescherechtespalten;BOOL PROCno(WINDOW VARw,TEXT CONSTfrage):NOTyes(w,frage)END PROCno;PROCstop(WINDOW VARw):stop(w,2)END PROCstop;PROCstop(WINDOW VARw,INT CONSTzeilenzahl):INT VARi;FORiFROM1UPTOzeilenzahlREPline(w)PER;out(w,aussage[3]);pauseEND PROCstop;AREA PROCarea(WINDOW CONSTw):w.fensterEND PROCarea;INT PROCareax(WINDOW CONSTw):areax(w.fenster)END PROCareax;INT PROCareay(WINDOW CONSTw):areay(w.fenster)END PROCareay;INT PROCareaxsize(WINDOW CONSTw):areaxsize(w.fenster)END PROCareaxsize;INT PROCareaysize(WINDOW CONSTw):areaysize(w.fenster)END PROCareaysize;END PACKETlsdialog3 + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe new file mode 100644 index 0000000..bafd79b --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe @@ -0,0 +1,6 @@ +PACKETlsdialog4DEFINESboxinfo,boxnotice,boxalternative,boxyes,boxno,boxanswer,boxone,boxanswerone,boxsome,boxanswersome:LETdelimiter=" ",piep="�",gueltigezeichen=" +� ",esc="�",auswahl="z",abbruch="m",blank=" ",trennliniensymbol="-",niltext="",janeintasten="jn";ROW8TEXT CONSTaussage:=ROW8TEXT:(" Weiter mit beliebiger Taste!"," Wählen: Bestätigen: Menü: "," Wählen: Bestätigen: Ja: Nein: "," Wählen: Bestätigen: "," Bestätigen: Zeigen: Menü: "," Bestätigen: Menü: ","Ja Nein"," Eingabe: ");PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt):boxinfo(w,t,5,maxint)END PROCboxinfo;PROCboxnotice(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibenotiz(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxnotice;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize):INT VARergebnis,spa,zei;getcursor(w,spa,zei);schreibealternativen(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize,ergebnis);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):INT VARx,y,xsize,ysize,ergebnis,spa,zei;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);BOOL CONSTwert:=ja(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):NOTboxyes(w,t,position,x,y,xsize,ysize)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition):NOTboxyes(w,t,position)END PROCboxno;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;TEXT VARwert;getcursor(w,spa,zei);wert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);oldfootnote;cursor(spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxanswer;TEXT PROCboxone(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);TEXT VARwert:=one(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));FI;oldfootnote;cursor(w,spa,zei);wertEND PROCboxone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);wert.lasseauswaehlen:IFmitreinigungTHENwert:=boxone(w,thesaurus,t1,t2,TRUE)ELSEwert:=boxone(w, +thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnote;FI.END PROCboxanswerone;THESAURUS PROCboxsome(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);THESAURUS VARwert:=some(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));oldfootnote;FI;cursor(w,spa,zei);wertEND PROCboxsome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):THESAURUS VARergebnis:=emptythesaurus;INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);ergebnis.lasseauswaehlen:IFmitreinigungTHENergebnis:=boxsome(w,thesaurus,t1,t2,TRUE)ELSEergebnis:=boxsome(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFwert<>niltextTHENinsert(ergebnis,wert)FI;IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnote;FI.END PROCboxanswersome;PROCzerteiletexte(TEXT CONSTt,ROW24TEXT VARtexte,INT VARbelegt):TEXT VARintern:=t;INT VARende:=0;belegt:=0;entfernefuehrendedelimiter;WHILEende<>maxint-1REPende:=pos(intern,delimiter);belegtINCR1;IFende=0THENende:=maxint-1END IF;texte(belegt):=subtext(intern,1,ende-1);intern:=subtext(intern,ende+1)PER.entfernefuehrendedelimiter:WHILE(internSUB1)=delimiterREPintern:=subtext(intern,2)PER END PROCzerteiletexte;PROCermittleboxgroesse(WINDOW VARw,INT CONSTposition,zusatzlaenge,minbreite,minhoehe,belegt,ROW24TEXT CONSTtexte,INT VARx,y,xsize,ysize):ermittleboxbreiteundboxhoehe;ermittlerahmenwerte.ermittleboxbreiteundboxhoehe:xsize:=0;FORysizeFROM1UPTObelegtREPEATxsize:=max(xsize,LENGTHtexte(ysize))PER;ysize:=belegt.ermittlerahmenwerte:schlagenotwendigegroessenauf;killueberlaengen;legebildschirmpositionenfest.schlagenotwendigegroessenauf:xsize:=max(xsize,minbreite);ysize:=max(ysize,minhoehe);ysizeINCRzusatzlaenge;ysizeINCR2;xsizeINCR2.killueberlaengen:ysize:=min(ysize,areaysize(w)-4);xsize:=min(xsize,areaxsize(w)-4).legebildschirmpositionenfest:SELECTpositionOF CASE1:plazierunglinksobenCASE2:plazierungrechtsobenCASE3:plazierunglinksuntenCASE4:plazierungrechtsuntenOTHERWISEplazierungimzentrumEND SELECT.plazierunglinksoben:x:=areax(w)+2;y:=areay(w)+2.plazierungrechtsoben:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+2.plazierunglinksunten:x:=areax(w)+2;y:=areay(w)+areaysize(w)-ysize-2.plazierungrechtsunten:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+areaysize(w)-ysize-2.plazierungimzentrum:x:=areax(w)+((areaxsize(w)-(xsize+2))DIV2)+1;y:=areay(w)+((areaysize(w)-ysize)DIV2)END PROCermittleboxgroesse;PROCschreibeboxtext(WINDOW VARw,TEXT CONSTt,INT CONSTposition,zusatzlaenge,mindestbreite,mindesthoehe,INT VARx,y,xsize,ysize):ROW24TEXT VARtexte;INT VARanzahltexte;INT VARi;zerteiletexte(t,texte,anzahltexte);FORiFROManzahltexte+1UPTO24REPEATtexte(i):=""PER;ermittleboxgroesse(w,position,zusatzlaenge,mindestbreite,mindesthoehe,anzahltexte,texte,x,y,xsize,ysize);schreibeboxkopf;schreibeboxrumpf.schreibeboxkopf:cursor(x,y);out(eckeobenlinks);out((xsize-2)*waagerecht);out(eckeobenrechts).schreibeboxrumpf:FORiFROM1UPTOysize-zusatzlaenge-2REPcursor(x,y+i);out(senkrecht+text(texte(i),xsize-2)+senkrecht)PER.END PROCschreibeboxtext;PROCschreibeboxfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize,limit):schreibeabschlusszeile;footnote(aussage[1]);cursorinpositionundwarten.schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).cursorinpositionundwarten:cursorparken(w);clearbuffer;pause(limit)END PROCschreibeboxfuss;PROCcursorparken(WINDOW VARw):cursor(w,1,2)END PROCcursorparken;PROCschreibebox(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibeboxfuss(w,x,y,xsize,ysize,timelimit)END PROCschreibebox;PROCschreibenotizfuss(WINDOW VARw,INT + CONSTx,y,xsize,ysize):schreibeabschlusszeile;cursorparken(w).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).END PROCschreibenotizfuss;PROCschreibenotiz(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibenotizfuss(w,x,y,xsize,ysize)END PROCschreibenotiz;PROCschreibealternativen(WINDOW VARw,TEXT CONSTt,altzeile,sonst,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize,ergebnis):ROW24TEXT VARtexte;TEXT VARtasten:=gueltigezeichen+sonst;INT VARbelegt,obersteauswahlzeile,untersteauswahlzeile,maxlaenge,kommando,aktpos;BOOL VARausgewaehlt:=FALSE;IFmitabbruchTHENtastenCATescFI;zerteiletexte(altzeile,texte,belegt);errechnemaximalelaengederalternativen;cursoroff;schreibeboxtext(w,t,position,belegt,maxlaenge+9,0,x,y,xsize,ysize);schreibepraefixintexte;obersteauswahlzeile:=ysize-belegt;untersteauswahlzeile:=ysize;schreibealternativenaufbildschirm;schreibefusszeile;lasseauswaehlen;cursoron.errechnemaximalelaengederalternativen:INT VARi;maxlaenge:=0;FORiFROM1UPTObelegtREPEATmaxlaenge:=max(maxlaenge,LENGTHtexte(i))PER.schreibepraefixintexte:FORiFROM1UPTObelegtREPEAT IF(sonstSUBi)=trennliniensymbolTHENtexte(i):=(xsize-2)*trennliniensymbolELSEtexte(i):=(sonstSUBi)+" "+texte(i)END IF PER.schreibealternativenaufbildschirm:WINDOW VARhilf:=window(x,y,xsize,ysize);markiere(hilf,texte(1),obersteauswahlzeile);FORiFROM2UPTObelegtREPEATdemarkiere(hilf,texte(i),obersteauswahlzeile+i-1)PER.schreibefusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks+(xsize-2)*waagerecht+eckeuntenrechts);IFmitabbruchTHENfootnote(aussage[2])ELSEberuecksichtigejaneinhinweisFI.beruecksichtigejaneinhinweis:IFsonst=janeintastenTHENfootnote(aussage[3])ELSEfootnote(aussage[4])FI.lasseauswaehlen:aktpos:=1;REPlieszeichen;interpretierezeichenUNTILausgewaehltEND REP;ergebnis:=aktpos.lieszeichen:TEXT VARzeichen;REPinchar(zeichen)UNTILzeichengueltigEND REP.zeichengueltig:kommando:=pos(tasten,zeichen);IFkommando=0THENout(piep);FALSE ELSE TRUE FI.interpretierezeichen:demarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);IFzeichen=escTHENpruefeaufescabbruchELSE SELECTkommandoOF CASE1:einsnachuntenCASE2:einsnachobenCASE3:ausgewaehlt:=TRUE OTHERWISEmittasteausgewaehltEND SELECT;IF NOTausgewaehltTHENmarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);END IF END IF.einsnachunten:REPaktpos:=aktposMODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.einsnachoben:REPaktpos:=(aktpos+belegt-2)MODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.mittasteausgewaehlt:IFzeichen=trennliniensymbolTHENout(piep)ELSEaktpos:=kommando-3+100;ausgewaehlt:=TRUE END IF.pruefeaufescabbruch:inchar(zeichen);IFzeichen=abbruchTHENausgewaehlt:=TRUE;aktpos:=0ELSEout(piep)FI END PROCschreibealternativen;PROCmarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outinverswithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCmarkiere;PROCdemarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outwithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCdemarkiere;BOOL PROCja(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARergebnis;schreibealternativen(w,t+"?",aussage[7],janeintasten,position,FALSE,x,y,xsize,ysize,ergebnis);ergebnis=1ORergebnis=101END PROCja;TEXT PROCholeantwort(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTmitauswahl,INT VARx,y,xsize,ysize):TEXT VAReingabe:=vorgabe;schreibeboxtext(w,t,position,2,length(aussage[8])+12,2,x,y,xsize,ysize);schreibeantwortfuss;clearbuffer;REP IFeingabe="break"THENeingabe:=""FI;lasseeintragenUNTILeingabe<>"break"PER;liefereergebnis.schreibeantwortfuss:schreibeleerzeile;schreibeeingabezeile;schreibeabschlusszeile;IFmitauswahlTHENfootnote(aussage[5])ELSEfootnote(aussage[6])FI.schreibeleerzeile:cursor(x,y+ysize-3);out(senkrecht);out((xsize-2)*blank);out(senkrecht).schreibeeingabezeile:cursor(x,y+ysize-2);out(senkrecht);out(aussage[8]);out((xsize-2-length(aussage[8]))*blank);out(senkrecht). +schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).lasseeintragen:TEXT VARexit:="";cursoron;cursor(x+length(aussage[8])+1,y+ysize-2);IFmitauswahlTHENeditget(eingabe,maxtextlength,textlaenge,"",abbruch+auswahl,exit)ELSEeditget(eingabe,maxtextlength,textlaenge,"",abbruch,exit)FI;cursoroff;IFexit=esc+abbruchTHENeingabe:="";lsexitkey(abbruch)ELIFmitauswahlAND(exit=esc+auswahl)THENeingabe:=esc+auswahl;lsexitkey(auswahl);ELSElsexitkey("");eingabe:=compress(eingabe)FI.textlaenge:xsize-2-length(aussage[8]).liefereergebnis:eingabeEND PROCholeantwort;END PACKETlsdialog4 + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe new file mode 100644 index 0000000..608cae7 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe @@ -0,0 +1,9 @@ +PACKETlsdialog5DEFINESwritehead,restorehead,menuinfo,menualternative,menuyes,menuno,menuone,menusome,menuanswer,installmenu,handlemenu,refreshsubmenu,deactivate,regeneratemenuscreen,activate,writemenunotice,erasemenunotice,menubasistext,anwendungstext,showmenuwindow,menuwindowpage,menuwindowout,menuwindowline,menuwindowyes,menuwindowno,menuwindowcursor,getmenuwindowcursor,remainingmenuwindowlines,menuwindowcenter,menuwindowstop,menukartenname,currentmenuwindow,resetdialog,ausstieg:LETmenutafeltaskname="ls-MENUKARTEN",menutafeltype=1954,menutafelpraefix="ls-MENUKARTE:",maxmenus=6,maxmenutexte=300,maxinfotexte=2000,maxhauptmenupunkte=10,maxuntermenupunkte=15,ersteuntermenuzeile=3;LETblank=" ",verlassen="q",piep="�",trennzeilensymbol="###",hauptmenuluecke=" ";LETauswahlstring1="�� +� �?";TYPE MENUPUNKT=STRUCT(TEXTpunktkuerzel,punktname,procname,boxtext,BOOLaktiv,angewaehlt),EINZELMENU=STRUCT(INTbelegt,TEXTueberschrift,INTanfangsposition,maxlaenge,ROWmaxuntermenupunkteMENUPUNKTmenupunkt,INTaktuelleruntermenupunkt,TEXTstartprozedurname,leaveprozedurname),MENU=STRUCT(TEXTmenuname,kopfzeile,INTanzahlhauptmenupunkte,ROWmaxhauptmenupunkteEINZELMENUeinzelmenu,TEXTmenueingangsprozedur,menuausgangsprozedur,menuinfo,lizenznummer,versionsnummer,INThauptmenuzeiger,untermenuanfang,untermenuzeiger),INFOTEXT=STRUCT(INTanzahlinfotexte,ROWmaxinfotexteTEXTstelle),MENUTEXT=STRUCT(INTanzahlmenutexte,ROWmaxmenutexteTEXTplatz),MENULEISTE=STRUCT(INTbelegt,zeigeraktuell,zeigerhintergrund,ROWmaxmenusMENUmenu,MENUTEXTmenutext,INFOTEXTinfotext);BOUND MENULEISTE VARmenuleiste;DATASPACE VARds;WINDOW VARmenuwindow,schreibfenster;WINDOW VARzweitesmenu:=window(6,5,73,19);INITFLAG VARinthistask:=FALSE;INT VARanzahloffenermenus:=0;INT VARmenunotizx,menunotizxsize,menunotizy,menunotizysize,menunotizposition;TEXT VARangekoppeltemenutafel:="",menunotiztext;BOOL VARmenunotizistgesetzt:=FALSE,mitausstieg:=FALSE,hochruntererlaubt:=TRUE,activationchanged:=FALSE;ROW13TEXT CONSTfehlermeldung:=ROW13TEXT:("Die Task '"+menutafeltaskname+"' existiert nicht!","Die Menükarte '","' existiert nicht in der Task '"+menutafeltaskname+"'!","' hat falschen Typ/Bezeichnung (keine 'MENÜKARTE')!","Das Menü '","' ist nicht in der angekoppelten Menükarte!","Zu viele geöffnete Menüs ( > 2 )!","Kein Menü geöffnet!","Menü enthält keine Menüpunkte!","Menüpunkt ist nicht im Menü enthalten!","Kein Text vorhanden!","Zugriff unmöglich!","Einschränkung unzulässig!");ROW1TEXT CONSTvergleichstext:=ROW1TEXT:("gibt es nicht");ROW3TEXT CONSThinweis:=ROW3TEXT:(" Info:/ Wählen: Bestätigen: Verlassen:"," Weiter mit beliebiger Taste!"," Bitte warten...!");ROW3TEXT CONSTinfotext:=ROW3TEXT:(" Für diesen Menüpunkt ist (noch) keine Funktion eingetragen!"," Möchten Sie dieses Menü tatsächlich verlassen"," Leider ist zu diesem Menüpunkt kein Info - Text eingetragen!");PROCinstallmenu(TEXT CONSTmenutafelname):installmenu(menutafelname,TRUE)END PROCinstallmenu;PROCinstallmenu(TEXT CONSTmenutafelname,BOOL CONSTmitkennung):TEXT VARletzterparameter;IFmitkennungTHENzeigemenukennungFI;initialisieremenuggf;IFmenutafelnochnichtangekoppeltTHENletzterparameter:=std;holemenutafel;kopplemenutafelan;lastparam(letzterparameter)FI.initialisieremenuggf:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI.menutafelnochnichtangekoppelt:menutafelname<>angekoppeltemenutafel.holemenutafel:IF NOTexiststask(menutafeltaskname)THENbereinigesituation;cursoron;errorstop(fehlermeldung[1])FI;disablestop;fetch(menutafelname,/menutafeltaskname);IFiserrorANDpos(errormessage,vergleichstext[1])>0THENclearerror;enablestop;bereinigesituation;cursoron;errorstop(fehlermeldung[2]+menutafelname+fehlermeldung[3])ELIFiserrorTHENclearerror;enablestop;bereinigesituation;cursoron;errorstop(errormessage)ELSEenablestopFI.kopplemenutafelan:IFtype(old(menutafelname))=menutafeltypeANDpos(menutafelname,menutafelpraefix)=1THENforget(ds);ds:=old(menutafelname +);menuleiste:=ds;angekoppeltemenutafel:=menutafelname;forget(menutafelname,quiet)ELSEbereinigesituation;cursoron;errorstop("'"+menutafelname+fehlermeldung[4])FI.END PROCinstallmenu;PROCausstieg(BOOL CONSTwert):mitausstieg:=wertEND PROCausstieg;TEXT PROCmenukartenname:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI;angekoppeltemenutafelEND PROCmenukartenname;PROChandlemenu(TEXT CONSTmenuname):mitausstieg:=TRUE;cursoroff;bietemenuan;lassemenupunkteauswaehlen;schliessemenu;leereggfdenbildschirm.bietemenuan:oeffnemenu(menuname).leereggfdenbildschirm:IFanzahloffenermenus<1THENerasemenunotice;page;cursoronFI.lassemenupunkteauswaehlen:TEXT VARkuerzelkette:="";starteaktuelleuntermenuoperationen;disablestop;REPcursorinwarteposition;ermittleaktuellekuerzelkette(kuerzelkette);nimmzeichenauf;interpretierezeichenUNTILmenuverlassengewuenschtPER.nimmzeichenauf:TEXT CONSTerlaubtezeichen:=auswahlstring1+kuerzelkette;TEXT VAReingabezeichen;INT VARzeichenposition;REPinchar(eingabezeichen);pruefeobfehler;zeichenposition:=pos(erlaubtezeichen,eingabezeichen);piepseggfUNTILzeichenposition>0PER.piepseggf:IFzeichenposition=0THENout(piep)FI.menuverlassengewuenscht:zeichenposition=6AND(zweiteszeichen=verlassen).interpretierezeichen:SELECTzeichenpositionOF CASE1,2:geheeinenhauptmenupunktnachlinksoderrechtsCASE3:geheeinenuntermenupunktnachuntenCASE4:geheeinenuntermenupunktnachobenCASE5:fuehreaktuellenmenupunktausCASE6:holeescsequenzCASE7:zeigeerklaerungstextimmenuanOTHERWISEwertekuerzeleingabeausEND SELECT.pruefeobfehler:IFiserrorTHENclearerror;regeneratemenuscreen;menuinfo(errormessage)END IF.geheeinenhauptmenupunktnachlinksoderrechts:INT VARanzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;IFzeichenposition=1THENanzahlschritteINCRclearbufferandcount("�");ermittlelinkemenuposition;ELSEanzahlschritteINCRclearbufferandcount("�");ermittlerechtemenuposition;END IF;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.loeschealtehauptmenumarkierung:eraseinvers(area(menuwindow),startpos,1,ueberschriftlaenge);out(area(menuwindow),startpos,1,ueberschrifttext).startpos:aktuellesuntermenu.anfangsposition.ueberschriftlaenge:length(ueberschrifttext).ueberschrifttext:aktuellesuntermenu.ueberschrift.ermittlelinkemenuposition:INT VARpositionszaehler;FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwertrunterPER.ermittlerechtemenuposition:FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwerthochPER.drehediemenupositionumeinenwertrunter:IFaktuellesmenu.hauptmenuzeiger>1THENaktuellesmenu.hauptmenuzeigerDECR1ELSEaktuellesmenu.hauptmenuzeiger:=aktuellesmenu.anzahlhauptmenupunkteFI.drehediemenupositionumeinenwerthoch:IFaktuellesmenu.hauptmenuzeiger0)CAND(naechsteraktiver>0).gehezumfolgendenuntermenupunkt:aktuellesmenu.untermenuzeiger:=naechsteraktiver.stelleaktuellenhauptmenupunktinversdar:outinvers(area(menuwindow),startpos,1,ueberschrifttext).fuehreaktuellenmenupunktaus:IFaktuellesmenu.untermenuzeiger<>0THENkennzeichnealsangetickt;fuehreoperationaus(menuanweisung);IFactivationchangedTHENactivationchanged:=FALSE;refreshsubmenu;IF +folgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF END IF;nimmkennzeichnungzurueckELSEout(piep)FI.kennzeichnealsangetickt:aktuellermenupunkt.angewaehlt:=TRUE;markiereaktuellenuntermenupunkt.nimmkennzeichnungzurueck:IFaktuellesmenu.untermenuzeiger<>0THENaktuellermenupunkt.angewaehlt:=FALSE;markiereaktuellenuntermenupunktEND IF.menuanweisung:compress(aktuellermenupunkt.procname).aktuellermenupunkt:aktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].holeescsequenz:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(verlassen+"?$",zweiteszeichen)OF CASE1:CASE2:menuinfo(menuleiste.menutext.platz[4],5,maxint)CASE3:gibinfoausOTHERWISEout(piep)END SELECT.wertekuerzeleingabeaus:naechsteraktiver:=pos(kuerzelkette,eingabezeichen);nimmummarkierungvor;fuehreaktuellenmenupunktaus.gibinfoaus:menuinfo(menuleiste.menutext.platz[20]).zeigeerklaerungstextimmenuan:IFaktuellesmenu.untermenuzeiger>0THEN IFcompress(erklaerungstext)=""THENmenuinfo(infotext[3])ELSEmenuinfo(erklaerungstext)FI FI.erklaerungstext:aktuellermenupunkt.boxtext.beendeaktuelleuntermenuoperationen:kuerzelkette:="".starteaktuelleuntermenuoperationen:ermittleaktuellekuerzelkette(kuerzelkette);IFstartoperation<>""THENfuehreoperationaus(startoperation)FI.startoperation:compress(aktuellesuntermenu.startprozedurname).END PROChandlemenu;PROCermittleaktuellekuerzelkette(TEXT VARkuerzelkette):kuerzelkette:="";INT VARkuerzelzeiger;FORkuerzelzeigerFROM1UPTOaktuellesuntermenu.belegtREP IFcompress(aktuellespunktkuerzel)=""THENkuerzelketteCAT"�"ELSEhaengeggfkuerzelanFI PER.aktuellespunktkuerzel:aktuellesuntermenu.menupunkt[kuerzelzeiger].punktkuerzel.haengeggfkuerzelan:IFbetrachteterpunktistaktivTHENkuerzelketteCATaktuellespunktkuerzelELSEkuerzelketteCAT"�"FI.betrachteterpunktistaktiv:aktuellesuntermenu.menupunkt[kuerzelzeiger].aktivEND PROCermittleaktuellekuerzelkette;PROCoeffnemenu(TEXT CONSTmenuname):cursoroff;sucheeingestelltesmenu;ueberpruefeanzahloffenermenus;aktuellesmenu.hauptmenuzeiger:=1;aktuellesmenu.untermenuzeiger:=0;aktuellesmenu.untermenuanfang:=0;fuehreggfmenueingangsprozeduraus;showmenu;.sucheeingestelltesmenu:INT VARi,suchzeiger;BOOL VARgefunden:=FALSE;FORiFROM1UPTOmenuleiste.belegtREP IFmenuleiste.menu[i].menuname=menunameTHENgefunden:=TRUE;suchzeiger:=iFI UNTILgefundenPER;IF NOTgefundenTHENcursoron;page;errorstop(fehlermeldung[5]+menuname+fehlermeldung[6])FI;anzahloffenermenusINCR1.ueberpruefeanzahloffenermenus:IFanzahloffenermenus=1THENmenuwindow:=window(1,2,79,23)ELIFanzahloffenermenus=2THENmenuleiste.zeigerhintergrund:=menuleiste.zeigeraktuell;menuwindow:=zweitesmenuELSEanzahloffenermenus:=0;cursoron;errorstop(fehlermeldung[7])FI;menuleiste.zeigeraktuell:=suchzeiger;hochruntererlaubt:=TRUE.fuehreggfmenueingangsprozeduraus:IFaktuellesmenu.menueingangsprozedur<>""THENfuehreoperationaus(aktuellesmenu.menueingangsprozedur)FI.END PROCoeffnemenu;PROCshowmenu:ueberpruefemenudaten;page;schreibekopfzeile;stellehauptmenuleistezusammen;zeigehauptmenuan;stelleaktuellenhauptmenupunktinversdar;schreibeaktuellesuntermenuaufbildschirm;zeigeinformationszeilean.ueberpruefemenudaten:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFaktuellesmenu.anzahlhauptmenupunkte<1THENerrorstop(fehlermeldung[9])FI.schreibekopfzeile:IFaktuellesmenu.kopfzeile<>""THENcursor(1,1);out(invers(text(aktuellesmenu.kopfzeile,77)))END IF.stellehauptmenuleistezusammen:TEXT VARhauptmenuzeile:=aktuellesmenu.menuname;INT VARzeiger;hauptmenuzeileCAT":";FORzeigerFROM1UPTOaktuellesmenu.anzahlhauptmenupunkteREPhaengehauptmenupunktanPER.haengehauptmenupunktan:hauptmenuzeileCAThauptmenuluecke;hauptmenuzeileCAThauptmenupunktname.hauptmenupunktname:aktuellesmenu.einzelmenu[zeiger].ueberschrift.zeigehauptmenuan:cursor(1,2);out(hauptmenuzeile);cursor(1,3);out(79*waagerecht).stelleaktuellenhauptmenupunktinversdar:cursor(menuwindow,startposition,1);out(menuwindow,invers(ueberschrifttext)).startposition:aktuellesuntermenu.anfangsposition-1.ueberschrifttext: +aktuellesuntermenu.ueberschrift.zeigeinformationszeilean:writepermanentfootnote(hinweis[1])END PROCshowmenu;PROCschreibeaktuellesuntermenuaufbildschirm:ermittlelinkeobereeckedesuntermenukastens;zeichnequerlinieneu;wirfuntermenuaus;showmenunotice;cursorinwarteposition.ermittlelinkeobereeckedesuntermenukastens:aktuellesmenu.untermenuanfang:=menumitte-halbemenubreite;achteaufrandextrema.menumitte:startposition+(length(ueberschrifttext)DIV2)-1.startposition:aktuellesuntermenu.anfangsposition.ueberschrifttext:aktuellesuntermenu.ueberschrift.halbemenubreite:aktuellesuntermenu.maxlaengeDIV2.achteaufrandextrema:gleicheggflinkenrandaus;gleicheggfrechtenrandaus.zeichnequerlinieneu:cursor(1,3);out(79*waagerecht).gleicheggflinkenrandaus:IFaktuellesmenu.untermenuanfang<4THENaktuellesmenu.untermenuanfang:=4FI.gleicheggfrechtenrandaus:IF(aktuellesmenu.untermenuanfang+aktuellesuntermenu.maxlaenge)>(areaxsize(menuwindow)-3)THENaktuellesmenu.untermenuanfang:=areaxsize(menuwindow)-aktuellesuntermenu.maxlaenge-3FI.wirfuntermenuaus:TEXT VARlinie:=(aktuellesuntermenu.maxlaenge+5)*waagerecht;IFaktuellesmenu.untermenuzeiger=0THENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI;wirfuntermenukopfzeileaus;wirfuntermenurumpfaus;wirfuntermenufusszeileaus;markiereaktuellenuntermenupunkt.wirfuntermenukopfzeileaus:cursor(menuwindow,spalte,anfangszeile);out(balkenoben);out(linie);out(balkenoben).wirfuntermenufusszeileaus:cursor(menuwindow,spalte,endezeile);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.endezeile:ersteuntermenuzeile+aktuellesuntermenu.belegt.wirfuntermenurumpfaus:INT VARlaufvar;INT CONSTaktuellepunktlaenge:=aktuellesuntermenu.maxlaenge+1;FORlaufvarFROM1UPTOaktuellesuntermenu.belegtREPwirfeineeinzelnemenuzeileausPER.wirfeineeinzelnemenuzeileaus:outwithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.aktuellerpunktname:untermenubezeichnung(laufvar).laenge:aktuellepunktlaengeEND PROCschreibeaktuellesuntermenuaufbildschirm;PROCloescheaktuellesuntermenuaufbildschirm:beendeaktuelleuntermenuoperationen;loescheuntermenuaufbildschirm;schreibebalkenwiederhin;aktuellesmenu.untermenuzeiger:=1.beendeaktuelleuntermenuoperationen:IFleaveoperation<>""THENfuehreoperationaus(leaveoperation)FI.leaveoperation:compress(aktuellesuntermenu.leaveprozedurname).loescheuntermenuaufbildschirm:INT VARlaufvar;FORlaufvarFROMaktuellesuntermenu.belegt+1DOWNTO1REPloescheeineeinzelnemenuzeilePER.loescheeineeinzelnemenuzeile:erasewithbeam(area(menuwindow),menuspalte,menuzeile,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.laenge:aktuellesuntermenu.maxlaenge+1.schreibebalkenwiederhin:cursor(menuwindow,spalte,anfangszeile);out((aktuellesuntermenu.maxlaenge+7)*waagerecht).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.END PROCloescheaktuellesuntermenuaufbildschirm;PROCmarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENlaufeggfzumnaechstenaktivenmenupunkt;IFaktuellesmenu.untermenuzeiger<>0THENoutinverswithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF ELSEhochruntererlaubt:=FALSE FI.laufeggfzumnaechstenaktivenmenupunkt:IF NOTaktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].aktivTHENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCmarkiereaktuellenuntermenupunkt;PROCdemarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENeraseinvers(area(menuwindow),menuspalte,menuzeile,laenge);out(area(menuwindow),menuspalte,menuzeile, +aktuellerpunktname,laenge)FI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCdemarkiereaktuellenuntermenupunkt;INT PROCfolgenderaktiveruntermenupunkt:INT VARnaechster,aktueller,anzahl,zeiger;zeiger:=aktuellesmenu.untermenuzeiger;IFzeiger=0THEN IFaktuellesuntermenu.menupunkt[1].aktivTHEN LEAVEfolgenderaktiveruntermenupunktWITH1ELSEaktueller:=1END IF ELSEaktueller:=zeigerEND IF;naechster:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugenachfolger;IFnaechster=aktuellerTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[naechster].aktivTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITHnaechsterEND IF PER;0.erzeugenachfolger:naechster:=(naechsterMODanzahl)+1END PROCfolgenderaktiveruntermenupunkt;INT PROCvorausgehenderaktiveruntermenupunkt:INT VARvoriger,aktueller,anzahl;aktueller:=aktuellesmenu.untermenuzeiger;voriger:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugevorgaenger;IFvoriger=aktuellerTHEN LEAVEvorausgehenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[voriger].aktivTHEN LEAVEvorausgehenderaktiveruntermenupunktWITHvorigerEND IF PER;0.erzeugevorgaenger:voriger:=((voriger+anzahl-2)MODanzahl)+1END PROCvorausgehenderaktiveruntermenupunkt;PROCcursorinwarteposition:cursor(areax(menuwindow),areay(menuwindow)+1)END PROCcursorinwarteposition;TEXT PROCuntermenubezeichnung(INT CONSTposition):TEXT VARbezeichnung:=kennzeichnung;bezeichnungCATpunktkennung;bezeichnung.kennzeichnung:IFaktuellermenupunkt.aktivTHEN IFaktuellermenupunkt.angewaehltTHEN"*"ELIFaktuellermenupunkt.punktkuerzel<>""THENaktuellermenupunkt.punktkuerzelELSEblankFI ELSE"-"FI.punktkennung:IFmenupunktisttrennzeileTHENstrichellinieELSEaktuellermenupunkt.punktnameFI.menupunktisttrennzeile:aktuellermenupunkt.punktname=(blank+trennzeilensymbol).strichellinie:(aktuellesuntermenu.maxlaenge+1)*"-".aktuellermenupunkt:aktuellesuntermenu.menupunkt[position]END PROCuntermenubezeichnung;PROCfuehreoperationaus(TEXT CONSToperation):disablestop;IFoperation=""THENmenuinfo(infotext[1]);LEAVEfuehreoperationausFI;do(operation);IFiserrorTHENclearerror;oldfootnote;regeneratemenuscreen;menuinfo(errormessage,5)FI;enablestop;cursoroffEND PROCfuehreoperationaus;PROCveraendereaktivierung(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereaktivierung.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;LEAVEveraendereaktivierung.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereaktivierung:veraendereaktivierung(unterpunktposition,eintrag)END PROCveraendereaktivierung;PROCveraendereaktivierung(INT CONSTpunktnummer,BOOL CONSTeintrag):IFpunktnummer>=1ANDpunktnummer<=untermenuendeTHENaktuellesuntermenu.menupunkt[punktnummer].angewaehlt:=FALSE;aktuellesuntermenu.menupunkt[punktnummer].aktiv:=eintrag;activationchanged:=TRUE;FI.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegtEND PROCveraendereaktivierung;PROCveraendereanwahl(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereanwahl.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;enablestop;errorstop(fehlermeldung[10]).untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereanwahl:aktuellesuntermenu.menupunkt[unterpunktposition].angewaehlt:=eintragEND PROCveraendereanwahl;PROCactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,TRUE)END PROC +activate;PROCactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,TRUE)END PROCactivate;PROCdeactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,FALSE)END PROCdeactivate;PROCdeactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,FALSE)END PROCdeactivate;PROCselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,TRUE)END PROCselect;PROCdeselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,FALSE)END PROCdeselect;PROCschliessemenu:IFaktuellesmenu.menuausgangsprozedur<>""THENfootnote(hinweis[3]);fuehreoperationaus(aktuellesmenu.menuausgangsprozedur)FI;anzahloffenermenusDECR1;IFanzahloffenermenus=1THENaktivieredasaufeisgelegtemenuFI.aktivieredasaufeisgelegtemenu:hochruntererlaubt:=TRUE;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);showmenuEND PROCschliessemenu;PROCrefreshsubmenu:schreibeaktuellesuntermenuaufbildschirm;showmenunotice;activationchanged:=FALSE END PROCrefreshsubmenu;PROCregeneratemenuscreen:page;showmenu;showmenunotice;activationchanged:=FALSE.END PROCregeneratemenuscreen;PROCmenuinfo(TEXT CONSTt,INT CONSTposition,timelimit):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);boxinfo(w,t,position,timelimit);oldfootnote;schreibeaktuellesuntermenuaufbildschirmEND PROCmenuinfo;PROCmenuinfo(TEXT CONSTt,INT CONSTposition):menuinfo(t,position,maxint)END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt):menuinfo(t,5,maxint)END PROCmenuinfo;INT PROCmenualternative(TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);INT VARergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;ergebnisEND PROCmenualternative;BOOL PROCmenuyes(TEXT CONSTfrage,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);BOOL VARwert:=boxyes(w,frage,position);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuyes;BOOL PROCmenuno(TEXT CONSTfrage,INT CONSTposition):NOTmenuyes(frage,position)END PROCmenuno;TEXT PROCmenuone(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT CONSTwert:=boxone(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuone;THESAURUS PROCmenusome(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS CONSTthesaurus:=boxsome(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;thesaurusEND PROCmenusome;TEXT PROCmenuanswer(TEXT CONSTt,vorgabe,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswer(w,t,vorgabe,position);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuanswer;TEXT PROCmenubasistext(INT CONSTnummer):IFnummer<=20THENfehlermeldung[12]ELIFnummer>menuleiste.menutext.anzahlmenutexteTHENfehlermeldung[11]ELSEmenuleiste.menutext.platz[nummer]FI END PROCmenubasistext;TEXT PROCanwendungstext(INT CONSTnummer):IFnummer>menuleiste.infotext.anzahlinfotexteTHENfehlermeldung[11]ELSEmenuleiste.infotext.stelle[nummer]FI END PROCanwendungstext;PROCzeigemenukennung:END PROCzeigemenukennung;PROCresetdialog:angekoppeltemenutafel:="";anzahloffenermenus:=0END PROCresetdialog;PROCwritemenunotice(TEXT CONSTt,INT CONSTposition):erasemenunotice;boxnotice(menuwindow,t,position,menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotiztext:=t;menunotizposition:=position;menunotizistgesetzt:=TRUE END PROCwritemenunotice;PROCshowmenunotice +:IFmenunotizistgesetztTHENboxnotice(menuwindow,menunotiztext,menunotizposition,menunotizx,menunotizy,menunotizxsize,menunotizysize);FI END PROCshowmenunotice;PROCerasemenunotice:INT VARspa,zei;getcursor(spa,zei);IFmenunotizistgesetztTHENpageup(menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotizistgesetzt:=FALSE;cursor(spa,zei)FI END PROCerasemenunotice;PROCinitializemenuwindow:schreibfenster:=window(areax(menuwindow)+1,areay(menuwindow)+3,areaxsize(menuwindow)-2,areaysize(menuwindow)-4)END PROCinitializemenuwindow;PROCshowmenuwindow:initializemenuwindow;show(schreibfenster);END PROCshowmenuwindow;PROCmenuwindowpage:initializemenuwindow;page(schreibfenster)END PROCmenuwindowpage;PROCmenuwindowout(TEXT CONSTtext):out(schreibfenster,text)END PROCmenuwindowout;BOOL PROCmenuwindowyes(TEXT CONSTfrage):yes(schreibfenster,frage)END PROCmenuwindowyes;BOOL PROCmenuwindowno(TEXT CONSTfrage):no(schreibfenster,frage)END PROCmenuwindowno;PROCmenuwindowline:menuwindowline(1)END PROCmenuwindowline;PROCmenuwindowline(INT CONSTanzahl):line(schreibfenster,anzahl)END PROCmenuwindowline;PROCmenuwindowcursor(INT CONSTspa,zei):cursor(schreibfenster,spa,zei)END PROCmenuwindowcursor;PROCgetmenuwindowcursor(INT VARspa,zei):getcursor(schreibfenster,spa,zei)END PROCgetmenuwindowcursor;INT PROCremainingmenuwindowlines:remaininglines(schreibfenster)END PROCremainingmenuwindowlines;TEXT PROCmenuwindowcenter(TEXT CONSTt):center(schreibfenster,t)END PROCmenuwindowcenter;PROCmenuwindowstop:menuwindowstop(2)END PROCmenuwindowstop;PROCmenuwindowstop(INT CONSTanzahl):stop(schreibfenster,anzahl)END PROCmenuwindowstop;WINDOW PROCcurrentmenuwindow:initializemenuwindow;schreibfensterEND PROCcurrentmenuwindow;PROCbereinigesituation:page;forget(ds);resetdialogEND PROCbereinigesituation;PROCwritehead(TEXT CONSTt):INT VARx,y;getcursor(x,y);IFt<>""THENcursor(1,1);out(invers(text(t,77)))END IF;cursor(x,y)END PROCwritehead;PROCrestorehead:TEXT VARkopf:=menuleiste.menu[menuleiste.zeigeraktuell].kopfzeile;writehead(kopf)END PROCrestorehead;.aktuellesuntermenu:aktmenu.einzelmenu[aktmenu.hauptmenuzeiger].aktmenu:menuleiste.menu[menuleiste.zeigeraktuell].aktuellesmenu:menuleiste.menu[menuleiste.zeigeraktuell]END PACKETlsdialog5; + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik b/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik new file mode 100644 index 0000000..d547811 Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik differ diff --git a/app/schulis-mathematiksystem/1.0/src/mat.abbildung b/app/schulis-mathematiksystem/1.0/src/mat.abbildung new file mode 100644 index 0000000..0e839e1 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.abbildung @@ -0,0 +1,13 @@ +PACKETabbildungDEFINES ABBILDUNG,abbildungsterme,abbildungsvariablen,abbildung,neueabbildung,adresse,variablenidentitaet,vergleichsfunktion,aufloesung,ergebnis,ergebnisvektor,result,ableitung,komplexefunktion,:=,+,-,*,/,O,newtonvorschrift,iterationsvorschrift,loeschebenannteabbildung,loeschetemporaereabbildung,loescheabbildung,ableitungsverbot,selektionshaltigetermliste:LETpisymbol="pi",allgemeinespotenzsymbol="**",speziellespotenzsymbol="^",multiplikationssymbol="*",divisionssymbol="/",verkettungssymbol="O",plussymbol="+",minussymbol="-",strichsymbol="'",kleinersymbol="<",kleinergleichsymbol="<=",ungleichsymbol="<>",gleichsymbol="=",groessergleichsymbol=">=",odersymbol="ODER",differenziersymbol="D",esymbol="e",sinussymbol="sin",cosinussymbol="cos",tangenssymbol="tan",cotangenssymbol="cot",arcussinussymbol="arcsin",arcuscosinussymbol="arccos",arcustangenssymbol="arctan",arcuscotangenssymbol="arccot",lnsymbol="ln",log2symbol="log2",log10symbol="log10",exponentialsymbol="exp",signumsymbol="sign",betragssymbol="abs",wurzelsymbol="wurzel",gaussklammersymbol="gauss",rundsymbol="rund",intsymbol="ganz",fracsymbol="frak",defaultfuervariablenindex=1,defaultfuerkomponentenindex=1;TYPE ABBILDUNG=STRUCT(LISTEvariablenliste,termliste);OP:=(ABBILDUNG VARlinks,ABBILDUNG CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;LISTE PROCabbildungsterme(ABBILDUNG CONSTf):f.termlisteEND PROCabbildungsterme;LISTE PROCabbildungsvariablen(ABBILDUNG CONSTf):f.variablenlisteEND PROCabbildungsvariablen;ABBILDUNG PROCabbildung(TERM CONSTterm):IF NOT(termISfunktionsdefinition)THENerrorstop(anwendungstext(1))END IF;funktion(neueliste(LISTENANFANG VARIABLENterm,LISTENENDE VARIABLENterm),neueliste(LISTENANFANG TERMEterm,LISTENENDE TERMEterm))END PROCabbildung;ABBILDUNG PROCabbildung(TEXT CONSTabbildungsname):TERM VAReintrag:=listenposition(eigenefunktionen,abbildungsname);IFeintrag=nilTHENeintrag:=listenposition(standardfunktionen,abbildungsname);IFeintrag=nilTHENerrorstop(anwendungstext(48))END IF;kopiertestandardfunktionELSEabbildung(DEFINITIONeintrag)END IF.kopiertestandardfunktion:TERM VARneuevariable:=newvariable(1,"x"),argument:=newterm(neuevariable),ausdruck:=newterm(newfunktionsauswertung(eintrag,newtermliste(argument,argument,1),defaultfuerkomponentenindex));neueabbildung(neueliste(neuevariable,neuevariable),neueliste(ausdruck,ausdruck))END PROCabbildung;ABBILDUNG PROCneueabbildung(LISTE CONSTvariablenliste,termliste):anhaengenantemporaerefunktionen(newtemporaerefunktion(newfunktionsdefinition(newvariablenliste(listenanfang(variablenliste),listenende(variablenliste),laenge(variablenliste)),newtermliste(listenanfang(termliste),listenende(termliste),laenge(termliste)))));funktion(variablenliste,termliste)END PROCneueabbildung;ABBILDUNG PROCfunktion(LISTE CONSTvariablen,terme):ABBILDUNG VARf;f.variablenliste:=variablen;f.termliste:=terme;fEND PROCfunktion;ABBILDUNG OP+(ABBILDUNG CONSTl,r):additivezusammenfassung(l,r,plussymbol)END OP+;ABBILDUNG OP-(ABBILDUNG CONSTl,r):additivezusammenfassung(l,r,minussymbol)END OP-;ABBILDUNG PROCadditivezusammenfassung(ABBILDUNG CONSTl,r,TEXT CONSTopsymbol):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>laenge(r.termliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste),terme:=neueliste(nil,nil);TERM VARlinkerterm:=listenanfang(l.termliste),rechterterm:=listenanfang(r.termliste);REPanhaengen(terme,newterm(newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),opsymbol)));linkerterm:=nachfolger(linkerterm);rechterterm:=nachfolger(rechterterm)UNTILrechterterm=nilEND REP;loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neueabbildung(variablen,terme)END PROC +additivezusammenfassung;ABBILDUNG OP*(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>laenge(r.termliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste);TERM VARlinkerterm:=listenanfang(l.termliste),rechterterm:=listenanfang(r.termliste),neuerterm:=newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),multiplikationssymbol);linkerterm:=nachfolger(linkerterm);WHILElinkerterm<>nilREPrechterterm:=nachfolger(rechterterm);neuerterm:=newdyade(neuerterm,newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),multiplikationssymbol),plussymbol);linkerterm:=nachfolger(linkerterm);END REP;loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neuerterm:=newterm(neuerterm);neueabbildung(variablen,neueliste(neuerterm,neuerterm))END OP*;ABBILDUNG OP/(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>1CORlaenge(r.termliste)<>1THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste);TERM VARergebnis:=newterm(newdyade(kopie(AUSDRUCKlistenanfang(l.termliste),variablen),kopie(AUSDRUCKlistenanfang(r.termliste),variablen),divisionssymbol));loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neueabbildung(variablen,neueliste(ergebnis,ergebnis))END OP/;ABBILDUNG OP O(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung;loeschetemporaereabbildungenundreicheneueabbildungnachaussen.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IFlaenge(r.termliste)<>laenge(l.variablenliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:initialisieredielistenderneuenabbildung;erzeugealletermederneuenabbildung.initialisieredielistenderneuenabbildung:LISTE VARvariablen:=kopiedervariablenliste(r.variablenliste),terme:=neueliste(nil,nil).erzeugealletermederneuenabbildung:INT VARtermzaehler;TERM VARlinkeadresse:=adresse(l),rechteadresse:=adresse(r);FORtermzaehlerFROM1UPTOlaenge(l.termliste)REPerzeugeeinentermEND REP.erzeugeeinenterm:LISTE VARargumente:=neueliste(nil,nil);erstelleargumentlistederfunktionsauswertung;anhaengen(terme,newterm(newfunktionsauswertung(linkeadresse,newtermliste(listenanfang(argumente),listenende(argumente),laenge(argumente)),termzaehler))).erstelleargumentlistederfunktionsauswertung:INT VARargumentzaehler;LISTE VARliste;IFebene=1THENanhaengen(argumente,newterm(kopie(AUSDRUCKlistenanfang(r.termliste),variablen)));FORargumentzaehlerFROM2UPTOlaenge(variablen)REPanhaengen(argumente,newterm(auswahl(variablen,argumentzaehler)))END REP ELSE FORargumentzaehlerFROM1UPTOlaenge(r.termliste)REPliste:=neueliste(nil,nil);erstelleargumentlistederinnerenfunktion;anhaengen(argumente,newterm(newfunktionsauswertung(rechteadresse,newtermliste(listenanfang(liste),listenende(liste),laenge(liste)),argumentzaehler)))END REP END IF.erstelleargumentlistederinnerenfunktion:INT VARi;FORiFROM1UPTOlaenge(r.variablenliste)REPanhaengen(liste,newterm(auswahl(r.variablenliste,i)))END REP.loeschetemporaereabbildungenundreicheneueabbildungnachaussen:ABBILDUNG VARscratchfunktion:=neueabbildung(variablen,terme),exportfunktion:=aufloesung(scratchfunktion);loescheabbildung(scratchfunktion);loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);exportfunktionEND OP O;ABBILDUNG + OP+(ABBILDUNG CONSToperand):testeexistenz(operand);IFselektionshaltigetermliste(listenanfang(operand.termliste))THENerrorstop(anwendungstext(204))END IF;operandEND OP+;ABBILDUNG OP-(ABBILDUNG CONSToperand):testeexistenz(operand);IFselektionshaltigetermliste(listenanfang(operand.termliste))THENerrorstop(anwendungstext(204))END IF;bildeneueabbildung.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(operand.variablenliste),terme:=neueliste(nil,nil);TERM VARlaufterm:=listenanfang(operand.termliste);REPanhaengen(terme,newterm(newmonade(kopie(AUSDRUCKlaufterm,variablen),minussymbol)));laufterm:=nachfolger(laufterm)UNTILlaufterm=nilEND REP;loeschetemporaereabbildung(operand);neueabbildung(variablen,terme)END OP-;ABBILDUNG PROCnewtonvorschrift(ABBILDUNG CONSTf,INT CONSTvarindex):testeparameter;bildenewtonvorschrift.testeparameter:enablestop;TERM CONSTfunktionsadresse:=adresse(f);IFfunktionsadresse=nilTHENerrorstop(anwendungstext(48))ELIFableitungsverbot(funktionsadresse)THENerrorstop(anwendungstext(56))ELIFvarindex<1CORvarindex>laenge(f.variablenliste)THENerrorstop(anwendungstext(53))END IF.bildenewtonvorschrift:ABBILDUNG VARtemp1:=aufloesung(f),temp2:=ableitung(temp1,1,varindex);LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);TERM VARneuerterm:=newterm(newdyade(auswahl(neuevariablen,varindex),newdyade(kopie(AUSDRUCKlistenanfang(temp1.termliste),neuevariablen),kopie(AUSDRUCKlistenanfang(temp2.termliste),neuevariablen),divisionssymbol),minussymbol));loeschetemporaereabbildung(temp1);loeschetemporaereabbildung(temp2);neueabbildung(neuevariablen,neueliste(neuerterm,neuerterm))END PROCnewtonvorschrift;ABBILDUNG PROCiterationsvorschrift(ABBILDUNG CONSTf,INT CONSTvarindex):testeparameter;bildeiterationsvorschrift.testeparameter:enablestop;TERM CONSTfunktionsadresse:=adresse(f);IFfunktionsadresse=nilTHENerrorstop(anwendungstext(48))ELIFvarindex<1CORvarindex>laenge(f.variablenliste)THENerrorstop(anwendungstext(53))END IF.bildeiterationsvorschrift:ABBILDUNG VARtemp1:=aufloesung(f);LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);TERM VARnt:=newterm(kopie(AUSDRUCKlistenanfang(temp1.termliste),neuevariablen));loeschetemporaereabbildung(temp1);neueabbildung(neuevariablen,neueliste(nt,nt))END PROCiterationsvorschrift;VECTOR PROCergebnis(ABBILDUNG CONSTf,VECTOR CONSTvariablenvektor):enablestop;testeexistenz(f);IFlaenge(f.variablenliste)<>length(variablenvektor)THENerrorstop(anwendungstext(45))END IF;ergebnisvektor(f.termliste,variablenvektor)END PROCergebnis;VECTOR PROCergebnisvektor(LISTE CONSTzuberechnendetermliste,VECTOR CONSTvariablenvektor):INT VARanzahlterme:=laenge(zuberechnendetermliste),i;VECTOR VARergebnisse:=vector(anzahlterme);TERM VARterm:=listenanfang(zuberechnendetermliste);FORiFROM1UPTOanzahltermeREPreplace(ergebnisse,i,result(AUSDRUCKterm,variablenvektor));term:=nachfolger(term)END REP;ergebnisseEND PROCergebnisvektor;REAL PROCresult(TERM CONSTterm,VECTOR CONSTvariablenvektor):TEXT VARoperationssymbol;TERM VARobjekt;enablestop;IFtermISvariableTHENvariablenvektorSUB(PLATZterm)ELIFtermISdyadischTHENwertderdyadeELIFtermISmonadischTHENwertdermonadeELIFtermISfunktionsauswertungTHENfunktionswertELIFtermISkonstanteTHEN WERTtermELSEselektierterwertEND IF.wertderdyade:REAL VARlinks:=result(LINKSterm,variablenvektor),rechts:=result(RECHTSterm,variablenvektor);operationssymbol:=OPERATIONterm;IFoperationssymbol=plussymbolTHENlinks+rechtsELIFoperationssymbol=minussymbolTHENlinks-rechtsELIFoperationssymbol=multiplikationssymbolTHENlinks*rechtsELIFoperationssymbol=divisionssymbolTHENlinks/rechtsELSE IFlinks=0.0CANDrechts=0.0THENerrorstop(anwendungstext(101))END IF;IFrechts<=32767.0CANDrechts>=-32768.0CANDreal(int(rechts))=rechtsTHENlinks**int(rechts)ELSElinks**rechtsEND IF END IF.wertdermonade:IF OPERATIONterm=minussymbolTHEN-result(OPERANDterm,variablenvektor)ELSEresult(OPERANDterm,variablenvektor)END IF.funktionswert:objekt:=ABBILDUNGSAUSDRUCKterm;IF NOT((objektISstandardfunktion)COR(objektIS +eigenefunktion))THENerrorstop(anwendungstext(14))END IF;IFobjektISstandardfunktionTHENwertderstandardfunktionELSEwertderselbstdefiniertenfunktionEND IF.wertderstandardfunktion:REAL VARargumentwert:=result(erstesargument(term),variablenvektor);operationssymbol:=NAMEobjekt;IFoperationssymbol=sinussymbolTHENsin(argumentwert)ELIFoperationssymbol=cosinussymbolTHENcos(argumentwert)ELIFoperationssymbol=tangenssymbolTHENtan(argumentwert)ELIFoperationssymbol=cotangenssymbolTHENcot(argumentwert)ELIFoperationssymbol=arcussinussymbolTHENarcsin(argumentwert)ELIFoperationssymbol=arcuscosinussymbolTHENarccos(argumentwert)ELIFoperationssymbol=arcustangenssymbolTHENarctan(argumentwert)ELIFoperationssymbol=arcuscotangenssymbolTHENarccot(argumentwert)ELIFoperationssymbol=lnsymbolTHENln(argumentwert)ELIFoperationssymbol=log2symbolTHENlog2(argumentwert)ELIFoperationssymbol=log10symbolTHENlog10(argumentwert)ELIFoperationssymbol=exponentialsymbolTHENexp(argumentwert)ELIFoperationssymbol=signumsymbolTHENreal(sign(argumentwert))ELIFoperationssymbol=wurzelsymbolTHENsqrt(argumentwert)ELIFoperationssymbol=gaussklammersymbolTHENgauss(argumentwert)ELIFoperationssymbol=rundsymbolTHENrund(argumentwert)ELIFoperationssymbol=intsymbolTHENganz(argumentwert)ELIFoperationssymbol=fracsymbolTHENfrak(argumentwert)ELSEabs(argumentwert)END IF.wertderselbstdefiniertenfunktion:result(ausgewaehlterfunktionsterm(term),ergebnisvektor(neueliste(LISTENANFANG ARGUMENTEterm,LISTENENDE ARGUMENTEterm),variablenvektor)).selektierterwert:TERM VARhilfsterm:=term;WHILE NOTcondition(BEDINGUNGhilfsterm,variablenvektor)REPhilfsterm:=ALTERNATIVEhilfsterm;IFhilfsterm=nilTHENerrorstop(anwendungstext(106))END IF END REP;result(AKTIONhilfsterm,variablenvektor)END PROCresult;BOOL PROCcondition(TERM CONSTterm,VECTOR CONSTwerte):TEXT VARoperationssymbol;BOOL VARlinks,rechts;REAL VARlinkerwert,rechterwert;IFtermISlogischedyadeTHENlinks:=condition(LINKSterm,werte);rechts:=condition(RECHTSterm,werte);IF OPERATIONterm=odersymbolTHENlinksCORrechtsELSElinksCANDrechtsEND IF ELSEoperationssymbol:=OPERATIONterm;linkerwert:=result(LINKSterm,werte);rechterwert:=result(RECHTSterm,werte);IFoperationssymbol=kleinersymbolTHENlinkerwertrechterwertELIFoperationssymbol=groessergleichsymbolTHENlinkerwert>=rechterwertELSElinkerwert>rechterwertEND IF END IF END PROCcondition;BOOL PROCkomplexefunktion(ABBILDUNG CONSTf):enablestop;testeexistenz(f);komplexeliste(listenanfang(f.termliste))END PROCkomplexefunktion;BOOL PROCkomplexeliste(TERM CONSTterm):komplexerterm(AUSDRUCKterm)COR((nachfolger(term)<>nil)CANDkomplexeliste(nachfolger(term)))END PROCkomplexeliste;BOOL PROCkomplexerterm(TERM CONSTterm):IF(termISdyadisch)COR(termISlogischedyade)COR(termISvergleich)THENkomplexerterm(LINKSterm)CORkomplexerterm(RECHTSterm)ELIF(termISmonadisch)THENkomplexerterm(OPERANDterm)ELIFtermISfunktionsauswertungTHEN((ABBILDUNGSAUSDRUCKterm)ISableitungsoperation)COR((ABBILDUNGSAUSDRUCKterm)ISabbildungsdyade)COR((ABBILDUNGSAUSDRUCKterm)ISabbildungsmonade)CORkomplexeliste(LISTENANFANG ARGUMENTEterm)COR(((ABBILDUNGSAUSDRUCKterm)ISeigenefunktion)CANDkomplexerterm(ausgewaehlterfunktionsterm(term)))ELIFtermISselektionTHENkomplexerterm(BEDINGUNGterm)CORkomplexerterm(AKTIONterm)CORkomplexerterm(ALTERNATIVEterm)ELSE FALSE END IF END PROCkomplexerterm;ABBILDUNG PROCableitung(ABBILDUNG CONSTf):ableitung(f,defaultfuerkomponentenindex,defaultfuervariablenindex)END PROCableitung;ABBILDUNG PROCableitung(ABBILDUNG CONSTf,INT CONSTkompindex,varindex):enablestop;ueberpruefedieaktuellenparameter;erzeugteableitung.ueberpruefedieaktuellenparameter:testeexistenz(f);IFkompindex>laenge(f.termliste)CORkompindex<1THENerrorstop(anwendungstext(42))ELIFvarindex>laenge(f.variablenliste)CORvarindex<1THENerrorstop(anwendungstext(53))END IF.erzeugteableitung:LISTE VARneuevariablen:= +kopiedervariablenliste(f.variablenliste);TERM VARabgeleiteterterm:=newterm(diff(abzuleitenderterm,varindex,neuevariablen));neueabbildung(neuevariablen,neueliste(abgeleiteterterm,abgeleiteterterm)).abzuleitenderterm:AUSDRUCKauswahl(f.termliste,kompindex)END PROCableitung;TERM PROCdiff(TERM CONSTterm,INT CONSTvariablenindex,LISTE CONSTvariablen):TERM VARzeiger,objekt;TEXT VARoperation;REAL VARwert;IFtermISselektionTHENerrorstop(anwendungstext(57))END IF;IFtermISvariableTHENableitungeinervariablenELIFtermISmonadischTHENabgeleitetermonadeELIFtermISkonstanteTHENableitungeinerkonstantenELIFtermISdyadischTHENabgeleitetedyadeELSEabgeleitetefunktionsauswertungEND IF.ableitungeinervariablen:IF PLATZterm=variablenindexTHENnewkonstante(1.0,"1")ELSEnewkonstante(0.0,"0")END IF.abgeleitetermonade:signreduce(diff(OPERANDterm,variablenindex,variablen),OPERATIONterm).ableitungeinerkonstanten:newkonstante(0.0,"0").abgeleitetedyade:TERM VARlinkeableitung:=diff(LINKSterm,variablenindex,variablen),rechteableitung;operation:=OPERATIONterm;IFoperation<>speziellespotenzsymbolTHENrechteableitung:=diff(RECHTSterm,variablenindex,variablen)END IF;IFoperation=plussymbolCORoperation=minussymbolTHENadditionsregelELIFoperation=multiplikationssymbolTHENmultiplikationsregelELIFoperation=divisionssymbolTHENdivisionsregelELIFoperation=allgemeinespotenzsymbolTHENallgemeinepotenzregelELSEspeziellepotenzregelEND IF.additionsregel:reduce(linkeableitung,rechteableitung,operation).multiplikationsregel:reduce(reduce(linkeableitung,rechtekopie,multiplikationssymbol),reduce(linkekopie,rechteableitung,multiplikationssymbol),plussymbol).divisionsregel:reduce(reduce(reduce(linkeableitung,rechtekopie,multiplikationssymbol),reduce(linkekopie,rechteableitung,multiplikationssymbol),minussymbol),reduce(rechtekopie,newkonstante(2.0,"2"),speziellespotenzsymbol),divisionssymbol).allgemeinepotenzregel:reduce(reduce(newkonstante(e,esymbol),reduce(rechtekopie,argumentterm,multiplikationssymbol),allgemeinespotenzsymbol),reduce(reduce(rechteableitung,argumentterm,multiplikationssymbol),reduce(reduce(rechtekopie,linkeableitung,multiplikationssymbol),linkekopie,divisionssymbol),plussymbol),multiplikationssymbol).argumentterm:IF(LINKStermISkonstante)CAND(NAME LINKSterm=esymbol)THENnewkonstante(1.0,"1")ELSEzeiger:=newterm(linkekopie);newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex)END IF.speziellepotenzregel:IF(RECHTStermISkonstante)THENwert:=WERT RECHTStermELSE IF(OPERATION RECHTSterm=minussymbol)THENwert:=-WERT OPERAND RECHTStermELSEwert:=WERT OPERAND RECHTStermEND IF END IF;reduce(linkeableitung,reduce(newkonstante(wert,text(int(wert))),reduce(linkekopie,newkonstante(wert-1.0,text(int(wert-1.0))),speziellespotenzsymbol),multiplikationssymbol),multiplikationssymbol).linkekopie:kopie(LINKSterm,variablen).rechtekopie:kopie(RECHTSterm,variablen).abgeleitetefunktionsauswertung:INT VARlambda:=1,anzahlderargumente:=LAENGE ARGUMENTEterm;TERM VARkettenregel:=newkonstante(0.0,"0");FORlambdaFROM1UPTOanzahlderargumenteREPkettenregel:=reduce(kettenregel,reduce(aeussereableitung,innereableitung,multiplikationssymbol),plussymbol)END REP;kettenregel.innereableitung:diff(AUSDRUCK((ARGUMENTEterm)ELEMENTlambda),variablenindex,variablen).aeussereableitung:objekt:=ABBILDUNGSAUSDRUCKterm;IFobjektISstandardfunktionTHENstandardableitungELIF(objektISabbildungsdyade)COR(objektISabbildungsmonade)THENnewfunktionsauswertung(difffunktionsoperation(objekt),kopie(ARGUMENTEterm,variablen),KOMPONENTEterm)ELSEnewfunktionsauswertung(newableitungsoperation(abbildungskopie(objekt),lambda,KOMPONENTEterm,differenzieroperator),kopie(ARGUMENTEterm,variablen),KOMPONENTEterm)END IF.differenzieroperator:IFobjektISableitungsoperationTHEN OPERATIONobjektELIFtermanzahl(objekt)>1CORvariablenanzahl(objekt)>1THENdifferenziersymbolELSEstrichsymbolEND IF.standardableitung:operation:=NAMEobjekt;IFabschnittweisedefiniertefunktion(operation)THENerrorstop( +anwendungstext(56))END IF;IFoperation=sinussymbolTHENableitungdersinusfunktionELIFoperation=cosinussymbolTHENableitungdercosinusfunktionELIFoperation=tangenssymbolTHENableitungdertangensfunktionELIFoperation=cotangenssymbolTHENableitungdercotangensfunktionELIFoperation=arcussinussymbolTHENableitungderarcussinusfunktionELIFoperation=arcuscosinussymbolTHENableitungderarcuscosinusfunktionELIFoperation=arcustangenssymbolTHENableitungderarcustangensfunktionELIFoperation=arcuscotangenssymbolTHENableitungderarcuscotangensfunktionELIFoperation=lnsymbolTHENableitungderlnfunktionELIFoperation=log2symbolTHENableitungderlog2funktionELIFoperation=log10symbolTHENableitungderlog10funktionELIFoperation=wurzelsymbolTHENableitungderwurzelfunktionELSEableitungderexponentialfunktionEND IF.ableitungdersinusfunktion:newfunktionsauswertung(listenposition(standardfunktionen,cosinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex).ableitungdercosinusfunktion:newmonade(newfunktionsauswertung(listenposition(standardfunktionen,sinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),minussymbol).ableitungdertangensfunktion:newdyade(newdyade(newfunktionsauswertung(listenposition(standardfunktionen,tangenssymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),newkonstante(2.0,"2"),speziellespotenzsymbol),newkonstante(1.0,"1"),plussymbol).ableitungdercotangensfunktion:newdyade(newkonstante(-1.0,"-1"),newdyade(newfunktionsauswertung(listenposition(standardfunktionen,sinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),newkonstante(2.0,"2"),speziellespotenzsymbol),divisionssymbol).ableitungderarcussinusfunktion:reduce(newkonstante(1.0,"1"),reduce(reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newkonstante(2.0,"2"),speziellespotenzsymbol),minussymbol),newkonstante(0.5,"0.5"),allgemeinespotenzsymbol),divisionssymbol).ableitungderarcuscosinusfunktion:signreduce(ableitungderarcussinusfunktion,minussymbol).ableitungderarcustangensfunktion:reduce(newkonstante(1.0,"1"),reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newkonstante(2.0,"2"),speziellespotenzsymbol),plussymbol),divisionssymbol).ableitungderarcuscotangensfunktion:signreduce(ableitungderarcustangensfunktion,minussymbol).ableitungderlnfunktion:reduce(newkonstante(1.0,"1"),kopie(erstesargument(term),variablen),divisionssymbol).ableitungderlog2funktion:zeiger:=newterm(newkonstante(2.0,"2"));reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderlog10funktion:zeiger:=newterm(newkonstante(10.0,"10"));reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderwurzelfunktion:newdyade(newkonstante(1.0,"1"),newdyade(newkonstante(2.0,"2"),newfunktionsauswertung(listenposition(standardfunktionen,wurzelsymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderexponentialfunktion:newfunktionsauswertung(listenposition(standardfunktionen,exponentialsymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex)END PROCdiff;TERM PROCdifffunktionsoperation(TERM CONSTterm):IFtermISabbildungsdyadeTHENabgeleiteterdyadischertermELIFtermISabbildungsmonadeTHENabgeleitetermonadischertermELSEeinfacheableitungEND IF.abgeleiteterdyadischerterm:TEXT VARoperation:=OPERATIONterm;IFoperation=plussymbolCORoperation=minussymbolTHENadditionsregelELIFoperation=multiplikationssymbolTHENmultiplikationsregelELIFoperation=divisionssymbolTHENdivisionsregelELSEkettenregelEND IF.additionsregel:newabbildungsdyade(difffunktionsoperation(LINKSterm),difffunktionsoperation(RECHTSterm), +operation).multiplikationsregel:newabbildungsdyade(newabbildungsdyade(difffunktionsoperation(LINKSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),newabbildungsdyade(abbildungskopie(LINKSterm),difffunktionsoperation(RECHTSterm),multiplikationssymbol),plussymbol).divisionsregel:newabbildungsdyade(newabbildungsdyade(newabbildungsdyade(difffunktionsoperation(LINKSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),newabbildungsdyade(abbildungskopie(LINKSterm),difffunktionsoperation(RECHTSterm),multiplikationssymbol),minussymbol),newabbildungsdyade(abbildungskopie(RECHTSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),divisionssymbol).kettenregel:newabbildungsdyade(aeussereableitung,innereableitung,multiplikationssymbol).aeussereableitung:newabbildungsdyade(newableitungsoperation(abbildungskopie(LINKSterm),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol),abbildungskopie(RECHTSterm),verkettungssymbol).innereableitung:newableitungsoperation(abbildungskopie(RECHTSterm),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol).abgeleitetermonadischerterm:IF(OPERATIONterm=minussymbol)THENnewabbildungsmonade(difffunktionsoperation(OPERANDterm),minussymbol)ELSEdifffunktionsoperation(OPERANDterm)END IF.einfacheableitung:IFableitungsverbot(term)THENerrorstop(anwendungstext(56))END IF;newableitungsoperation(abbildungskopie(term),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol).END PROCdifffunktionsoperation;TERM PROCreduce(TERM CONSTl,r,TEXT CONSToperator):REAL VARwert;TERM VARlinks:=l,rechts:=r;IFlISdyadischTHENlinks:=reduce(LINKSl,RECHTSl,OPERATIONl);LOESCHElEND IF;IFrISdyadischTHENrechts:=reduce(LINKSr,RECHTSr,OPERATIONr);LOESCHErEND IF;IFoperator=plussymbolTHENvereinfachteadditionELIFoperator=minussymbolTHENvereinfachtesubtraktionELIFoperator=multiplikationssymbolTHENvereinfachtemultiplikationELIFoperator=divisionssymbolTHENvereinfachtedivisionELIFoperator=speziellespotenzsymbolTHENvereinfachtespeziellepotenzELSEvereinfachteallgemeinepotenzEND IF.vereinfachteaddition:IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHErechts;newdyade(newkonstante(2.0,"2"),links,multiplikationssymbol)ELIF(linksISkonstante)CAND(rechtsISkonstante)CAND NOTvordefiniertekonstante(links)CAND NOTvordefiniertekonstante(rechts)THENwert:=WERTlinks+WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THEN LOESCHElinks;rechtsELIFrechtsIST0.0THEN LOESCHErechts;linksELIFidentischevariablen(links,rechts)THENnewdyade(newkonstante(2.0,"2"),links,multiplikationssymbol)ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);rechtsELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(rechts);linksELSEnewdyade(links,rechts,operator)END IF.vereinfachtesubtraktion:IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHElinks;LOESCHErechts;newkonstante(0.0,"0")ELIF((linksISkonstante)CAND(rechtsISkonstante))CAND NOT(vordefiniertekonstante(links)CORvordefiniertekonstante(rechts))THENwert:=WERTlinks-WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THEN LOESCHElinks;signreduce(rechts,minussymbol)ELIFrechtsIST0.0THEN LOESCHErechts;linksELIFidentischevariablen(links,rechts)THENnewkonstante(0.0,"0")ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);rechtsELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(rechts);linksELSEnewdyade(links,rechts,operator)END IF.vereinfachtemultiplikation:TERM VARneuerterm;IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHElinks;newdyade(newkonstante(2.0,"2"),rechts,speziellespotenzsymbol)ELIF(linksISkonstante)CAND(rechtsISkonstante)CAND NOT(vordefiniertekonstante(links)CORvordefiniertekonstante(rechts))THENwert:=WERTlinks*WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THENbeseitige(rechts);linksELIFlinksIST1.0THEN LOESCHElinks;rechtsELIFlinksIST-1.0THEN LOESCHElinks;signreduce(rechts,minussymbol)ELIF(linksIS +konstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISdyadisch)CAND(OPERATIONrechts=multiplikationssymbol)CAND(LINKSrechtsISkonstante)CAND NOTvordefiniertekonstante(LINKSrechts)THENwert:=WERTlinks*WERT LINKSrechts;LOESCHElinks;LOESCHE LINKSrechts;neuerterm:=reduce(newkonstante(wert,text(wert)),RECHTSrechts,multiplikationssymbol);LOESCHErechts;neuertermELIF(linksISkonstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISdyadisch)CAND(OPERATIONrechts=multiplikationssymbol)CAND(RECHTSrechtsISkonstante)CAND NOTvordefiniertekonstante(RECHTSrechts)THENwert:=WERTlinks*WERT RECHTSrechts;LOESCHElinks;LOESCHE RECHTSrechts;neuerterm:=reduce(newkonstante(wert,text(wert)),LINKSrechts,multiplikationssymbol);LOESCHErechts;neuertermELIFrechtsIST0.0THENbeseitige(links);rechtsELIFrechtsIST1.0THEN LOESCHErechts;linksELIFrechtsIST-1.0THEN LOESCHErechts;signreduce(links,minussymbol)ELIF(rechtsISkonstante)CAND NOTvordefiniertekonstante(rechts)CAND(linksISdyadisch)CAND(OPERATIONlinks=multiplikationssymbol)CAND(LINKSlinksISkonstante)CAND NOTvordefiniertekonstante(LINKSlinks)THENwert:=WERTrechts*WERT LINKSlinks;LOESCHErechts;LOESCHE LINKSlinks;neuerterm:=reduce(newkonstante(wert,text(wert)),RECHTSlinks,multiplikationssymbol);LOESCHElinks;neuertermELIF(rechtsISkonstante)CAND NOTvordefiniertekonstante(rechts)CAND(linksISdyadisch)CAND(OPERATIONlinks=multiplikationssymbol)CAND(RECHTSlinksISkonstante)CAND NOTvordefiniertekonstante(RECHTSlinks)THENwert:=WERTrechts*WERT RECHTSlinks;LOESCHErechts;LOESCHE RECHTSlinks;neuerterm:=reduce(newkonstante(wert,text(wert)),LINKSlinks,multiplikationssymbol);LOESCHElinks;neuertermELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THEN LOESCHElinks;beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(links);LOESCHErechts;newkonstante(0.0,"0")ELIF(linksISmonadisch)CAND((OPERANDlinks)IST1.0)THEN IF(OPERATIONlinks=minussymbol)THENbeseitige(links);signreduce(rechts,minussymbol)ELSEbeseitige(links);rechtsEND IF ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST1.0)THEN IF(OPERATIONrechts=minussymbol)THENbeseitige(rechts);signreduce(links,minussymbol)ELSEbeseitige(rechts);linksEND IF ELIF(linksISmonadisch)CAND(rechtsISmonadisch)THEN IF(OPERATIONlinks)=(OPERATIONrechts)THENnewdyade(OPERANDlinks,OPERANDrechts,multiplikationssymbol)ELSEnewmonade(newdyade(OPERANDlinks,OPERANDrechts,multiplikationssymbol),minussymbol)END IF ELIFidentischevariablen(links,rechts)THENnewdyade(links,newkonstante(2.0,"2"),speziellespotenzsymbol)ELSEnewdyade(links,rechts,operator)END IF.vereinfachtedivision:IFlinksIST0.0THENbeseitige(rechts);linksELIFrechtsIST1.0THEN LOESCHErechts;linksELIFrechtsIST-1.0THEN LOESCHErechts;signreduce(links,minussymbol)ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST1.0)THEN IF(OPERATIONrechts=minussymbol)THENbeseitige(rechts);signreduce(links,minussymbol)ELSEbeseitige(rechts);linksEND IF ELIF(linksISmonadisch)CAND(rechtsISmonadisch)THEN IF(OPERATIONlinks)=(OPERATIONrechts)THENnewdyade(OPERANDlinks,OPERANDrechts,divisionssymbol)ELSEnewmonade(newdyade(OPERANDlinks,OPERANDrechts,divisionssymbol),minussymbol)END IF ELIFidentischevariablen(links,rechts)THENnewkonstante(1.0,"1")ELSEnewdyade(links,rechts,operator)END IF.vereinfachteallgemeinepotenz:IFrechtsistganzzahlCAND(linksISkonstante)CAND NOTvordefiniertekonstante(links)THENwert:=WERTlinks**WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST1.0THEN LOESCHElinks;beseitige(rechts);newkonstante(1.0,"1")ELIFrechtsIST0.0THENbeseitige(links);LOESCHErechts;newkonstante(1.0,"1")ELIFrechtsIST1.0THEN LOESCHErechts;linksELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(1.0,"1")ELSEnewdyade(links,rechts,operator)END IF.rechtsistganzzahl:(rechtsIS +konstante)CAND(floor(WERTrechts)=WERTrechts).vereinfachtespeziellepotenz:IFrechtsIST0.0THENbeseitige(links);LOESCHErechts;newkonstante(1.0,"1")ELIFrechtsIST1.0THEN LOESCHErechts;linksELIF(linksISkonstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISkonstante)CAND(real(int(WERTrechts))=WERTrechts)THENwert:=(WERTlinks)**int(WERTrechts);LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST1.0THEN LOESCHErechts;linksELIFlinksIST-1.0THEN IFwertvonrechtsistgeradeTHEN LOESCHElinks;LOESCHErechts;newkonstante(1.0,"1")ELSE LOESCHErechts;linksEND IF ELSEnewdyade(links,rechts,operator)END IF.wertvonrechtsistgerade:(rechtsISkonstante)CANDint(WERTrechts)MOD2=0.END PROCreduce;TERM PROCsignreduce(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm;IFoperandISmonadischTHEN IFresultierendertermistnegativTHENneuerterm:=newmonade(OPERANDoperand,minussymbol);ELSEneuerterm:=OPERANDoperandEND IF;LOESCHEoperandELIFoperandIST0.0THENneuerterm:=operandELSEneuerterm:=newmonade(operand,operator)END IF;neuerterm.resultierendertermistnegativ:OPERATIONoperand<>operator.END PROCsignreduce;ABBILDUNG PROCaufloesung(ABBILDUNG CONSTf):enablestop;testeexistenz(f);loeseauf.loeseauf:LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);neueabbildung(neuevariablen,aufgeloestetermliste(listenanfang(f.termliste),neuevariablen))END PROCaufloesung;LISTE PROCaufgeloestetermliste(TERM CONSTtermlistenanfang,LISTE CONSTneuevariablen):LISTE VARneueterme:=neueliste(nil,nil);TERM VARlaufterm:=termlistenanfang;WHILElaufterm<>nilREPanhaengen(neueterme,newterm(aufloesendekopie(AUSDRUCKlaufterm,neuevariablen)));laufterm:=nachfolger(laufterm)END REP;neuetermeEND PROCaufgeloestetermliste;TERM PROCaufloesendekopie(TERM CONSTterm,LISTE CONSTvariablen):IFtermISvariableTHENauswahl(variablen,PLATZterm)ELIFtermISdyadischTHENreduce(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELIFtermISmonadischTHENsignreduce(aufloesendekopie(OPERANDterm,variablen),OPERATIONterm)ELIFtermISfunktionsauswertungTHENaufloesungderauswertungELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(aufloesendekopie(BEDINGUNGterm,variablen),aufloesendekopie(AKTIONterm,variablen),aufloesendekopie(ALTERNATIVEterm,variablen))ELIFtermISlogischedyadeTHENnewlogischedyade(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELSEnilEND IF.aufloesungderauswertung:ABBILDUNG VARscratchfunktion;TERM VARobjekt;LISTE VARargumente:=aufgeloestetermliste(LISTENANFANG ARGUMENTEterm,variablen);IF(ABBILDUNGSAUSDRUCKterm)ISstandardfunktionTHENaufgeloestestandardfunktionELSEobjekt:=ersetzung(zuersetzenderterm,argumente,variablen);loeschetemporaereabbildung(scratchfunktion);loescheterme(listenanfang(argumente));objektEND IF.aufgeloestestandardfunktion:newfunktionsauswertung(ABBILDUNGSAUSDRUCKterm,newtermliste(listenanfang(argumente),listenende(argumente),1),defaultfuerkomponentenindex).zuersetzenderterm:IF(ABBILDUNGSAUSDRUCKterm)ISeigenefunktionTHENausgewaehlterfunktionsterm(term)ELSEscratchfunktion:=auswertung(ABBILDUNGSAUSDRUCKterm);AUSDRUCKlistenanfang(scratchfunktion.termliste)END IF END PROCaufloesendekopie;TERM PROCersetzung(TERM CONSTterm,LISTE CONSTargumentliste,variablen):IFtermISvariableTHENkopie(AUSDRUCKauswahl(argumentliste,PLATZterm),variablen)ELIFtermISdyadischTHENreduce(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELIFtermISmonadischTHENsignreduce(ersetzung(OPERANDterm,argumentliste,variablen),OPERATIONterm)ELIFtermISfunktionsauswertungTHENaufloesungderauswertungELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(ersetzung(BEDINGUNGterm,argumentliste,variablen),ersetzung(AKTIONterm,argumentliste,variablen),ersetzung(ALTERNATIVEterm,argumentliste, +variablen))ELIFtermISlogischedyadeTHENnewlogischedyade(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELSEnilEND IF.aufloesungderauswertung:ABBILDUNG VARscratchfunktion;TERM VARobjekt;IF(ABBILDUNGSAUSDRUCKterm)ISstandardfunktionTHENaufgeloestestandardfunktionELSEobjekt:=ersetzung(zuersetzenderterm,ersetzteargumentliste,variablen);loeschetemporaereabbildung(scratchfunktion);loescheterme(listenanfang(argumente));objektEND IF.aufgeloestestandardfunktion:TERM VARargument:=newterm(ersetzung(erstesargument(term),argumentliste,variablen));newfunktionsauswertung(ABBILDUNGSAUSDRUCKterm,newtermliste(argument,argument,1),defaultfuerkomponentenindex).zuersetzenderterm:IF(ABBILDUNGSAUSDRUCKterm)ISeigenefunktionTHENausgewaehlterfunktionsterm(term)ELSEscratchfunktion:=auswertung(ABBILDUNGSAUSDRUCKterm);AUSDRUCKlistenanfang(scratchfunktion.termliste)END IF.ersetzteargumentliste:LISTE VARargumente:=neueliste(nil,nil);TERM VARlaufterm:=LISTENANFANG ARGUMENTEterm;WHILElaufterm<>nilREPanhaengen(argumente,newterm(ersetzung(AUSDRUCKlaufterm,argumentliste,variablen)));laufterm:=nachfolger(laufterm)END REP;argumenteEND PROCersetzung;PROCloeschebenannteabbildung(TEXT CONSTname):enablestop;IFlistenposition(eigenefunktionen,name)=nilTHENerrorstop(anwendungstext(48))END IF;loescheabbildung(abbildung(name))END PROCloeschebenannteabbildung;PROCloeschetemporaereabbildung(ABBILDUNG CONSTf):enablestop;IFadresse(f)IStemporaerefunktionTHENloescheabbildung(f)END IF END PROCloeschetemporaereabbildung;PROCloescheabbildung(ABBILDUNG CONSTf):enablestop;TERM VARdefinition,eintrag:=adresse(f);IF(eintragISeigenefunktion)COR(eintragIStemporaerefunktion)THENloescheterme(listenanfang(f.termliste));loeschevariablen(listenanfang(f.variablenliste));definition:=DEFINITIONeintrag;LOESCHE VARIABLENdefinition;LOESCHE TERMEdefinition;LOESCHEdefinition;IFeintragIStemporaerefunktionTHENentfernenaustemporaerenfunktionen(eintrag)ELSEentfernenauseigenenfunktionen(eintrag)END IF;LOESCHEeintragELSEerrorstop(anwendungstext(48))END IF END PROCloescheabbildung;PROCloescheterme(TERM CONSTtermlistenanfang):TERM VARloeschelement:=termlistenanfang,naechsteselement;WHILEloeschelement<>nilREPnaechsteselement:=nachfolger(loeschelement);beseitige(loeschelement);loeschelement:=naechsteselementEND REP END PROCloescheterme;PROCloeschevariablen(TERM CONSTvariablenlistenanfang):TERM VARloeschelement:=variablenlistenanfang,naechsteselement;WHILEloeschelement<>nilREPnaechsteselement:=nachfolger(loeschelement);LOESCHEloeschelement;loeschelement:=naechsteselementEND REP END PROCloeschevariablen;PROCbeseitige(TERM CONSTterm):IFtermISausdruckTHENbeseitige(AUSDRUCKterm)ELIF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THENbeseitige(LINKSterm);beseitige(RECHTSterm)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENbeseitige(OPERANDterm);ELIFtermISfunktionsauswertungTHENbeseitige(ABBILDUNGSAUSDRUCKterm);loescheterme(LISTENANFANG ARGUMENTEterm);LOESCHE ARGUMENTEtermELIFtermISableitungsoperationTHENbeseitige(ABBILDUNGSAUSDRUCKterm)ELIFtermISselektionTHENbeseitige(BEDINGUNGterm);beseitige(AKTIONterm);IF(ALTERNATIVEterm)<>nilTHENbeseitige(ALTERNATIVEterm)END IF;ELIF NOT(termISkonstante)THEN LEAVEbeseitigeEND IF;LOESCHEtermEND PROCbeseitige;BOOL PROCableitungsverbot(TERM CONSTterm):IF(termISdyadisch)COR(termISabbildungsdyade)THENableitungsverbot(LINKSterm)CORableitungsverbot(RECHTSterm)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENableitungsverbot(OPERANDterm)ELIFtermISstandardfunktionTHENabschnittweisedefiniertefunktion(NAMEterm)ELIF(termISeigenefunktion)COR(termIStemporaerefunktion)THENgetesteteliste(LISTENANFANG TERME DEFINITIONterm)ELIFtermISfunktionsauswertungTHENableitungsverbot(auswertungsobjekt)CORgetesteteliste(LISTENANFANG ARGUMENTEterm)ELIFtermIS +ableitungsoperationTHENableitungsverbot(ABBILDUNGSAUSDRUCKterm)ELSEtermISselektionEND IF.auswertungsobjekt:TERM VARobjekt:=ABBILDUNGSAUSDRUCKterm;IFobjektISeigenefunktionTHEN AUSDRUCK((TERME DEFINITIONobjekt)ELEMENT(KOMPONENTEterm))ELSEobjektEND IF END PROCableitungsverbot;BOOL PROCabschnittweisedefiniertefunktion(TEXT CONSTname):name=signumsymbolCORname=betragssymbolCORname=intsymbolCORname=gaussklammersymbolCORname=rundsymbolCORname=fracsymbolEND PROCabschnittweisedefiniertefunktion;BOOL PROCgetesteteliste(TERM CONSTlistenelement):IFlistenelement=nilTHEN FALSE ELSEableitungsverbot(AUSDRUCKlistenelement)CORgetesteteliste(nachfolger(listenelement))END IF END PROCgetesteteliste;BOOL PROCvariablenidentitaet(ABBILDUNG CONSTl,r):variablenidentitaet(l.variablenliste,r.variablenliste)END PROCvariablenidentitaet;ABBILDUNG PROCvergleichsfunktion(TERM CONSTterm):IF(termISstandardfunktion)COR(termISeigenefunktion)THENabbildung(NAMEterm)ELIFtermISabbildungsdyadeTHENvergleichsfunktion(LINKSterm)ELIFtermISabbildungsmonadeTHENvergleichsfunktion(OPERANDterm)ELSEvergleichsfunktion(ABBILDUNGSAUSDRUCKterm)END IF END PROCvergleichsfunktion;TERM PROCadresse(ABBILDUNG CONSTf):TERM VARvergleichsterm:=listenanfang(f.termliste),suchterm:=nil;durchforste(temporaerefunktionen,suchterm,vergleichsterm);IFsuchterm=nilTHENdurchforste(eigenefunktionen,suchterm,vergleichsterm)END IF;suchtermEND PROCadresse;PROCdurchforste(LISTE CONSTsuchliste,TERM VARsuchterm,TERM CONSTvergleichsterm):IFlaenge(suchliste)>0THENsuchterm:=listenanfang(suchliste);WHILE(suchterm<>nil)CAND NOTgefundenREPsuchterm:=nachfolger(suchterm)END REP;END IF.gefunden:vergleichsterm=LISTENANFANG TERME DEFINITIONsuchterm.END PROCdurchforste;PROCtesteexistenz(ABBILDUNG CONSTf):IFadresse(f)=nilTHENerrorstop(anwendungstext(48))END IF END PROCtesteexistenz;LISTE PROCkopiedervariablenliste(LISTE CONSToriginal):LISTE VARkopie:=neueliste(nil,nil);TERM VARlaufterm:=listenanfang(original);WHILElaufterm<>nilREPanhaengen(kopie,newvariable(PLATZlaufterm,NAMElaufterm));laufterm:=nachfolger(laufterm)END REP;kopieEND PROCkopiedervariablenliste;ABBILDUNG PROCauswertung(TERM CONSTterm):IF(termISstandardfunktion)COR(termISeigenefunktion)THENabbildung(NAMEterm)ELIFtermIStemporaerefunktionTHENabbildung(DEFINITIONterm)ELIFtermISabbildungsdyadeTHENausgewerteteabbildungsdyadeELIFtermISabbildungsmonadeTHENausgewerteterabbildungsmonadeELSEausgewerteteableitungsoperationEND IF.ausgewerteteabbildungsdyade:IF OPERATIONterm=plussymbolTHENauswertung(LINKSterm)+auswertung(RECHTSterm)ELIF OPERATIONterm=minussymbolTHENauswertung(LINKSterm)-auswertung(RECHTSterm)ELIF OPERATIONterm=multiplikationssymbolTHENauswertung(LINKSterm)*auswertung(RECHTSterm)ELIF OPERATIONterm=divisionssymbolTHENauswertung(LINKSterm)/auswertung(RECHTSterm)ELSEauswertung(LINKSterm)Oauswertung(RECHTSterm)END IF.ausgewerteterabbildungsmonade:IF OPERATIONterm=minussymbolTHEN-auswertung(OPERANDterm)ELSEauswertung(OPERANDterm)END IF.ausgewerteteableitungsoperation:ABBILDUNG VARloeschelement:=auswertung(ABBILDUNGSAUSDRUCKterm),neuefunktion:=ableitung(loeschelement,KOMPONENTEterm,INDEXterm);loeschetemporaereabbildung(loeschelement);neuefunktionEND PROCauswertung;TERM PROCkopie(TERM CONSTterm,LISTE CONSTvariablenliste):IFtermISvariableTHENauswahl(variablenliste,PLATZterm)ELIFtermIStermlisteTHENtermlistenkopie(term,variablenliste)ELIFtermISdyadischTHENnewdyade(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste),OPERATIONterm)ELIFtermISmonadischTHENnewmonade(kopie(OPERANDterm,variablenliste),OPERATIONterm)ELIFtermISfunktionsauswertungTHENnewfunktionsauswertung(abbildungskopie(ABBILDUNGSAUSDRUCKterm),kopie(ARGUMENTEterm,variablenliste),KOMPONENTEterm)ELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(kopie(BEDINGUNGterm,variablenliste),kopie(AKTIONterm,variablenliste),kopie(ALTERNATIVEterm,variablenliste))ELIFtermISlogischedyadeTHENnewlogischedyade(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste), +OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste),OPERATIONterm)ELSEtermEND IF END PROCkopie;TERM PROCabbildungskopie(TERM CONSTterm):IFtermISabbildungsdyadeTHENnewabbildungsdyade(abbildungskopie(LINKSterm),abbildungskopie(RECHTSterm),OPERATIONterm)ELIFtermISabbildungsmonadeTHENnewabbildungsmonade(abbildungskopie(OPERANDterm),OPERATIONterm)ELIFtermISableitungsoperationTHENnewableitungsoperation(abbildungskopie(ABBILDUNGSAUSDRUCKterm),INDEXterm,KOMPONENTEterm,OPERATIONterm)ELSEtermEND IF END PROCabbildungskopie;TERM PROCtermlistenkopie(TERM CONSTterm,LISTE CONSTvariablenliste):LISTE VARausdruecke:=neueliste(nil,nil);TERM VARlaufterm:=LISTENANFANGterm;WHILElaufterm<>nilREPanhaengen(ausdruecke,newterm(kopie(AUSDRUCKlaufterm,variablenliste)));laufterm:=nachfolger(laufterm)END REP;newtermliste(listenanfang(ausdruecke),listenende(ausdruecke),laenge(ausdruecke))END PROCtermlistenkopie;TERM PROCausgewaehlterfunktionsterm(TERM CONSTterm):IF NOT(termISfunktionsauswertung)THENerrorstop(anwendungstext(1))END IF;AUSDRUCK((TERME DEFINITION ABBILDUNGSAUSDRUCKterm)ELEMENT(KOMPONENTEterm))END PROCausgewaehlterfunktionsterm;BOOL PROCidentischevordefiniertekonstanten(TERM CONSTl,r):vordefiniertekonstante(l)CANDvordefiniertekonstante(r)CAND NAMEl=NAMErEND PROCidentischevordefiniertekonstanten;BOOL PROCidentischevariablen(TERM CONSTl,r):(lISvariable)CAND(rISvariable)CAND(PLATZl=PLATZr)END PROCidentischevariablen;BOOL PROCvordefiniertekonstante(TERM CONSTpruefterm):(prueftermISkonstante)CAND((NAMEpruefterm=esymbol)COR(NAMEpruefterm=pisymbol))END PROCvordefiniertekonstante;BOOL PROCselektionshaltigetermliste(TERM CONSTt):IF NOT(tISausdruck)THENerrorstop(anwendungstext(203))END IF;TERM VARlauf:=t;WHILElauf<>nilREP IF(AUSDRUCKlauf)ISselektionTHEN LEAVEselektionshaltigetermlisteWITH TRUE END IF;lauf:=nachfolger(lauf)END REP;FALSE END PROCselektionshaltigetermliste;BOOL OP IST(TERM CONSTpruefterm,REAL CONSTpruefwert):(prueftermISkonstante)CAND(WERTpruefterm=pruefwert)END OP IST;TERM PROCerstesargument(TERM CONSTterm):AUSDRUCK LISTENANFANG ARGUMENTEtermEND PROCerstesargument;END PACKETabbildung + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.ausgabe b/app/schulis-mathematiksystem/1.0/src/mat.ausgabe new file mode 100644 index 0000000..41f9677 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.ausgabe @@ -0,0 +1,2 @@ +PACKETausgabeDEFINES:=,plot,endgeraetbreite:LETtypnummer=1055;REAL VARdruckerfaktor:=1.0,horcm,vertcm,width,height;INT VARpixhor,pixvert;drawingarea(horcm,vertcm,pixhor,pixvert);width:=horcm;height:=vertcm;REAL VARbuchsthoehe:=stdhoehe,minyabstand:=0.1;REAL VARhoehe:=buchsthoehe+3.0*minyabstand,links:=0.0,rechts:=horcm,oben:=vertcm-hoehe,unten:=hoehe,rahmenoben:=vertcm,rahmenunten:=0.0;TYPE PICROW=BOUND STRUCT(INTeofROW128PICTUREzeichnungROW4REALfenstergroesseREALquellbreite,quellhoehe);OP:=(PICROW VARneu,DATASPACE CONSTspace):CONCR(neu):=space;END OP:=;PROCplot(THESAURUS CONSTth):do(PROC(TEXT CONST)plot,th)END PROCplot;PROCplot(TEXT CONSTdsname):enablestop;IFexists(dsname)THEN PICROW VARobjekt:=old(dsname);IFtype(old(dsname))<>typnummerTHEN LEAVEplotEND IF ELSE LEAVEplotEND IF;beginplot;setzeabmessungenbezueglichendgeraet;clear;viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor*rahmenoben);window(objekt.fenstergroesse(1),objekt.fenstergroesse(2),objekt.fenstergroesse(3),objekt.fenstergroesse(4));pen(0,1,0,1);plottedarstellung;plotend.setzeabmessungenbezueglichendgeraet:IFwidth>horcmTHENwidth:=horcmEND IF;height:=width/objekt.quellbreite*objekt.quellhoehe;IFheight>vertcmTHENheight:=vertcm;width:=height/objekt.quellhoehe*objekt.quellbreiteEND IF;hoehe:=0.0;rechts:=objekt.quellbreite;oben:=objekt.quellhoehe;unten:=hoehe;rahmenoben:=objekt.quellhoehe;rahmenunten:=0.0;druckerfaktor:=width/objekt.quellbreite;cmfaktor(druckerfaktor).plottedarstellung:INT VARi;pen(1,1,1,1);box;FORiFROM1UPTOobjekt.eofREP IFlength(objekt.zeichnung(i))<>0THENpen(1,1,1,pen(objekt.zeichnung(i)));plot(objekt.zeichnung(i))END IF END REP END PROCplot;PROCendgeraetbreite(REAL CONSTbreite):width:=min(breite,horcm)END PROCendgeraetbreite;REAL PROCendgeraetbreite:widthEND PROCendgeraetbreite;END PACKETausgabe; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.basis plot b/app/schulis-mathematiksystem/1.0/src/mat.basis plot new file mode 100644 index 0000000..3581885 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.basis plot @@ -0,0 +1,2 @@ +PACKETbasisplotDEFINESviewport,window,windowxmin,windowxmax,windowymin,windowymax,move,draw,where,box,xpixel,ypixel:INT VARxpixelanzahl,ypixelanzahl;REAL VARxpixelprocm,ypixelprocm,xcmgroesse,ycmgroesse,xpos,ypos,viewxmin:=0.0,viewxmax:=1.0,viewymin:=0.0,viewymax:=1.0,winxmin:=0.0,winxmax:=1.0,winymin:=0.0,winymax:=1.0,xkonst,ykonst,xfaktor,yfaktor;initialisierewerte;PROCinitialisierewerte:drawingarea(xcmgroesse,ycmgroesse,xpixelanzahl,ypixelanzahl);xpixelprocm:=real(xpixelanzahl)/xcmgroesse;ypixelprocm:=real(ypixelanzahl)/ycmgroesse;viewport(0.0,xcmgroesse,0.0,ycmgroesse);window(0.0,xcmgroesse,0.0,ycmgroesse);homeEND PROCinitialisierewerte;PROCviewport(REAL CONSTxmin,xmax,ymin,ymax):IFxmin<0.0CORxmax>xcmgroesseCORymin<0.0CORymax>ycmgroesseCORxmin=xmaxCORymin=ymaxCORaltewerteTHEN LEAVEviewportEND IF;viewxmin:=xmin;viewxmax:=xmax;viewymin:=ymin;viewymax:=ymax;setvalues.altewerte:viewxmin=xminCANDviewxmax=xmaxCANDviewymin=yminCANDviewymax=ymaxEND PROCviewport;PROCwindow(REAL CONSTxmin,xmax,ymin,ymax):IFxmin>=xmaxCORymin>=ymaxCORaltewerteTHEN LEAVEwindowEND IF;winxmin:=xmin;winxmax:=xmax;winymin:=ymin;winymax:=ymax;setvalues.altewerte:winxmin=xminCANDwinxmax=xmaxCANDwinymin=yminCANDwinymax=ymaxEND PROCwindow;REAL PROCwindowxmin:winxminEND PROCwindowxmin;REAL PROCwindowxmax:winxmaxEND PROCwindowxmax;REAL PROCwindowymin:winyminEND PROCwindowymin;REAL PROCwindowymax:winymaxEND PROCwindowymax;PROCsetvalues:xkonst:=0.5+viewxmin*xpixelprocm;ykonst:=0.5+viewymin*ypixelprocm;xfaktor:=xpixelprocm*(viewxmax-viewxmin)/(winxmax-winxmin);yfaktor:=ypixelprocm*(viewymax-viewymin)/(winymax-winymin)END PROCsetvalues;PROCmove(REAL CONSTx,y):INT VARi,j;IFx>winxmaxCORxwinymaxCORywinxmaxCORxwinymaxCORy",druckart="I",schrifttyp="H",formfeed="�",linefeed=" +",cr=" ";INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord,anzahldernadelspalten,i,printerchannel:=15;REAL VARhorfaktor,vertfaktor,faktor;horpixel:=1360;verpixel:=900;anzahldernadelspalten:=900;horfaktor:=50.3937;vertfaktor:=47.24409;REAL VARbuchstabenhoehe:=0.762,buchstabenbreite:=0.3373438;BOUND ROWhorpixelmaxdurch16TEXT VARbitmap;INT VARplotterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=26.9875;ycm:=19.05;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1).ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT VARspaltenzaehler;bitmap:=old(namederbitmap);druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+unterstreichenaus);out(esc+fettdruckaus);out(esc+zeilenabstand);out(esc+druckrichtung);out(esc+schrifttyp).seitenvorschub:out(formfeed).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask,plotterchannel).bitmapdrucken:FORspaltenzaehlerFROM(groesstexkoordDIV16)+1DOWNTO1REPbefehlssequenzschickenPER.zeilenbeginn:groessteykoord+1.befehlssequenzschicken:out(esc+druckart+neueanzahldernadelspalten);teilzeileausgeben;out(cr+linefeed).neueanzahldernadelspalten:nullen+text(zeilenbeginn).nullen:(4-LENGTHtext(zeilenbeginn))*"0".teilzeileausgeben:outsubtext(bitmap(spaltenzaehler),vontextpos,bistextpos).vontextpos:2*(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:2*anzahldernadelspaltenEND PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet)END PROCplotend;PROCclear:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);xpos:=0;ypos:=0;pen(0,1,0,1);INT VARj;TEXT VARleerespalte:=(2*verpixel)*"�";FORjFROM1UPTOhorpixelmaxdurch16REPbitmap(j):=leerespaltePER;groesstexkoord:=0;groessteykoord:=0END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorEND IF PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystepEND PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:xanzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IF(textcopySUB1)>code(31)THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die CGA-Karte (oder eine kompatible");putline("Karte, z.B. EGA-Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"cga"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE;ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE;ENDPROCplotend;PROCclear:control(-5,6,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):pos.xDRAWpos.y;control(-6,x,anzahly-1-y,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THEN +oldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,anzahly-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,anzahly-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>maximumxTHENx:=maximumxELIFx<0THENx:=0END IF;IFy>maximumyTHENy:=maximumyELIFy<0THENy:=0END IF END PROCgrenzkontrolle;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:8END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETcgaplot;zeichensatz("ZEICHEN 8*8") + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen b/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen new file mode 100644 index 0000000..d76be56 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen @@ -0,0 +1,5 @@ +PACKETdialoghilfenDEFINESscratchfunctionname,scroll,belegeparameter,schreibestatuszeile,schreibearbeitsfunktion,gibmeldung,gibinfofensteraus,warte,strich,definieredruckseitenformat,druckseitenformat,druckspalten,aufbereitetdrucken,druckversuch:LETniltext="",bell="�",carrreturn=" ",beginmark="",endmark="",left="�",right="�",runter=" +",hoch="�",hop="�",esc="�",blank=" ",unterstrichzeichen="_",systemname=" s c h u l i s - Mathematiksystem",niveau="Ebene ",seitenvorschub="#page#",stddruckbreite=45,stddrucklaenge=60;TEXT CONSTkurzerstrich:=25*unterstrichzeichen,basiszeile:=beginmark+systemname+44*blank+endmark;TEXT PROCscratchfunctionname:TEXT VARfunctionname:="hilfsfunktion";INT VARi:=1;WHILElistenposition(eigenefunktionen,functionname+text(i))<>nilREPiINCR1END REP;functionname+text(i)END PROCscratchfunctionname;PROCscroll(WINDOW VARw,TEXT CONSTdatname,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatz,erstespalte,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):BOOL VARveraenderungderkopfzeilen:=TRUE,veraenderungdervariablenspalte:=TRUE;bestimmemaximalwertederdatei;bereiteausgabevor;REPzeigedateiausschnitt;IFsonderzeichen=niltextTHEN LEAVEscrollEND IF;werteeingabezeichenaus;veraenderungdervariablenspalte:=NOTveraenderungderkopfzeilenEND REP.bestimmemaximalwertederdatei:TEXT VARzeile;FILE VARf:=sequentialfile(input,datname);INT VARmaxspalten:=0,maxzeilen:=lines(f);WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>maxspaltenTHENmaxspalten:=length(zeile)END IF END REP.bereiteausgabevor:INT CONSTbreite:=areaxsize(w),laenge:=areaysize(w),xbeginn:=areax(w),ybeginn:=areay(w),letzterzeilenanfang:=maxzeilen-laenge+yscroll,ausgabebreite:=breite-xscroll-1,ausgabelaenge:=laenge-yscroll+1,letzterspaltenanfang:=jenachdem;modify(f).jenachdem:INT VARsucher:=xscroll;WHILEsucherlaenge-1END REP.werteeingabezeichenaus:TEXT VARch;REPinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENscrollelinksEND IF ELIFch=rightTHEN IFerstespalteyscrollTHENscrollezurueckEND IF ELIFch=runterTHEN IFerstersatzxscrollTHENblaetterelinksEND IF ELIFch=rightTHEN IFerstespalteyscrollTHENblaetterezurueckEND IF ELIFch=runterTHEN IFerstersatzyscrollTHENspringeandenanfangELIFausstiegzeichen="9"CANDerstersatz0THEN LEAVEscrollEND IF END IF END REP.scrollelinks:erstespalteDECRhorizontalscroll;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollerechts:erstespalteINCRhorizontalscroll;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollezurueck:erstersatzDECR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.scrollevor:erstersatzINCR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterelinks:erstespalteDECRausgabebreite;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVE +werteeingabezeichenaus.blaettererechts:erstespalteINCRausgabebreite;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaetterezurueck:erstersatzDECRausgabelaenge;erstersatz:=max(erstersatz,yscroll);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterevor:erstersatzINCRausgabelaenge;erstersatz:=min(erstersatz,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandenanfang:erstersatz:=yscroll;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandasende:erstersatz:=max(yscroll,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenausEND PROCscroll;PROCbelegeparameter(VECTOR VARv,INT CONSTvarindex,LISTE CONSTvariablenliste,TEXT CONSTescapeausstieg,TEXT VARausstieg):TEXT VAReingabetext,ausstiegszeichen;INT CONSTende:=laenge(variablenliste),eingabelaenge:=40,scrollbeginn:=12;TEXT CONSTseparatoren:=hoch+runter;INT VARxpos,ypos,aktuellerparameterindex:=naechsterparameter(ende,varindex,0);getcursor(xpos,ypos);REPzeigeaktuellenparameter;editieredenaktuellenparameter;werteausstiegscodeausEND REP.zeigeaktuellenparameter:TEXT VARvariablenname:=text(NAMEauswahl(variablenliste,aktuellerparameterindex),8);variablennameCAT" = ";cursor(xpos,ypos);out(variablenname).editieredenaktuellenparameter:eingabetext:=compress(wandle(vSUBaktuellerparameterindex));eingabetextCATkurzerstrich;IFsystemimgraphicmodusTHENgrapheditget(eingabetext,scrollbeginn,escapeausstieg,ausstiegszeichen)ELSEout(beginmark);out(left);editget(eingabetext,eingabelaenge,scrollbeginn,separatoren,escapeausstieg,ausstiegszeichen);out(endmark)END IF.werteausstiegscodeaus:IFausstiegszeichen=niltextCORpos(hoch+runter+carrreturn,ausstiegszeichen)<>0THENchangeall(eingabetext,unterstrichzeichen,niltext);REAL VAReingegebenerwert:=realzahl(eingabetext);IF NOTiserrorTHENreplace(v,aktuellerparameterindex,eingegebenerwert);IFausstiegszeichen<>hochTHENaktuellerparameterindex:=naechsterparameter(ende,varindex,aktuellerparameterindex)ELSEaktuellerparameterindex:=letzterparameter(ende,varindex,aktuellerparameterindex)END IF ELSEclearerrorEND IF ELSE IFsystemimgraphicmodusTHENausstieg:=ausstiegszeichenELSEausstieg:=ausstiegszeichenSUB2END IF;IFpos(escapeausstieg,ausstieg)<>0THENchangeall(eingabetext,unterstrichzeichen,niltext);eingegebenerwert:=realzahl(eingabetext);IF NOTiserrorTHENreplace(v,aktuellerparameterindex,eingegebenerwert)ELSEclearerrorEND IF;LEAVEbelegeparameterEND IF END IF END PROCbelegeparameter;INT PROCnaechsterparameter(INT CONSTende,verboten,aktuellerwert):INT CONSTnaechsterwert:=aktuellerwertMODende+1;IFnaechsterwert=verbotenTHENnaechsterparameter(ende,verboten,aktuellerwert+1)ELSEnaechsterwertEND IF END PROCnaechsterparameter;INT PROCletzterparameter(INT CONSTende,verboten,aktuellerwert):INT CONSTnaechsterwert:=(aktuellerwert-2)MODende+1;IFnaechsterwert=verbotenTHENletzterparameter(ende,verboten,aktuellerwert-1)ELSEnaechsterwertEND IF END PROCletzterparameter;PROCschreibestatuszeile(TEXT CONSTverfahrensname):TEXT VARzeile:=basiszeile,teilbereich:=niveau+text(ebene)+" "+verfahrensname;replace(zeile,78-length(teilbereich),teilbereich);cursor(1,1);out(zeile)END PROCschreibestatuszeile;PROCschreibearbeitsfunktion(ABBILDUNG CONSTfkt):cursor(1,2);out(text(funktionsstring(fkt),80))END PROCschreibearbeitsfunktion;PROCstrich(INT CONSTzeile):cursor(1,zeile);out(79*waagerecht)END PROCstrich;PROCwarte:clearbuffer;footnote(anwendungstext(77));pauseEND PROCwarte;PROCgibmeldung(TEXT CONSTmeldung):WINDOW VARstdmeldungsfenster:=window(2,22,77,1);outframe(stdmeldungsfenster);out(stdmeldungsfenster,text(meldung,77));warte;page(stdmeldungsfenster,TRUE)END PROCgibmeldung;PROCgibinfofensteraus(WINDOW VARw,INT CONSTn):outframe(w);show(formular(n));warte;page(w,TRUE)END PROCgibinfofensteraus;ROW2INT VARdruckbreite:=ROW2INT:(stddruckbreite,stddruckbreite),drucklaenge:=ROW2INT:(stddrucklaenge,stddrucklaenge);PROCdefinieredruckseitenformat(INT CONST +breite,laenge):druckbreite(ebene):=breite;drucklaenge(ebene):=laengeEND PROCdefinieredruckseitenformat;INT PROCdruckspalten:druckbreite(ebene)END PROCdruckspalten;PROCdruckseitenformat(INT VARspalten,zeilen):spalten:=druckbreite(ebene);zeilen:=drucklaenge(ebene)END PROCdruckseitenformat;PROCaufbereitetdrucken(TEXT CONSTfname,ueberschrift,INT CONSTspaltenbeginn,zeilenbeginn,spaltenbreite):FILE VARf,fdruck;INT VARdateibreite,dateilaenge,i,j,verfuegbarerplatz,zulaessigebreite;TEXT CONSTneuername:=scratchdateiname;TEXT VARzeile,druckzeile;testeumfangderzudruckendendatei;bereitedateiauf;druckversuch(neuername);forget(neuername,quiet).testeumfangderzudruckendendatei:f:=sequentialfile(input,fname);dateilaenge:=lines(f);dateibreite:=0;WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>dateibreiteTHENdateibreite:=length(zeile)END IF END REP;verfuegbarerplatz:=drucklaenge(ebene)-zeilenbeginn+1;IFueberschrift<>niltextTHENverfuegbarerplatzDECR2END IF;zulaessigebreite:=0;REPzulaessigebreiteINCRspaltenbreiteUNTILzulaessigebreite>druckbreite(ebene)-spaltenbeginn+1END REP;zulaessigebreiteDECRspaltenbreite.bereitedateiauf:INT VARspaltenpointer,zeilenpointer;modify(f);fdruck:=sequentialfile(output,neuername);spaltenpointer:=spaltenbeginn;WHILEspaltenpointerniltextTHENputline(fdruck,ueberschrift);line(fdruck)END IF;FORjFROM1UPTOzeilenbeginn-1REPdruckzeile:=niltext;toline(f,j);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite-1);putline(fdruck,druckzeile)END REP.schreiberumpfzeilen:FORiFROM1UPTOverfuegbarerplatzREPdruckzeile:=niltext;toline(f,zeilenpointer);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite-1);putline(fdruck,druckzeile);zeilenpointerINCR1;IFzeilenpointer>dateilaengeTHEN LEAVEschreibeseitenEND IF END REP END PROCaufbereitetdrucken;PROCdruckversuch(TEXT CONSTdatname):disablestop;print(datname);IFiserrorTHENgibmeldung(errormessage);clearerror;ELSEgibmeldung(anwendungstext(219))END IF END PROCdruckversuch;END PACKETdialoghilfen; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.druckermenu b/app/schulis-mathematiksystem/1.0/src/mat.druckermenu new file mode 100644 index 0000000..45b036d --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.druckermenu @@ -0,0 +1,2 @@ +PACKETdruckermenuDEFINESdruckeingang,druckezeichnungen,loeschezeichnungen,stellezeichenbreiteein,definieredruckerkanal,stoppedrucker,plottereingestellt:LETdepottaskname="MATHE-PRINTERDEPOT",druckprocindex=1,loeschprocindex=2,untenlinks=3,zentral=5,bell="�",abbruch="!",niltext="",arbeitertaskname="workertask",minimalekanalnr=2,maximalekanalnr=32,text1="Bitte warten bis der letzte Druckauftrag bearbeitet ist.",text2="Drucken von Zeichnungen",text3="Auswahl der Zeichnungen durch ankreuzen",text4="Löschen von Zeichnungen",text5="Sollen die ausgewählten Zeichnungen gelöscht werden",text6="Die Zeichnungen werden gelöscht: ",text7=" Wert zwischen 5.0 cm und ",text8=" cm eingeben! ",text9=" Bitte Zahl zwischen 2 und 32 für Kanalnummer des Druckers eingeben! ",text10="Speicher für Zeichnungen ist nicht eingerichtet.",text11="Ist für die nächste Zeichnung Papier eingelegt",text12="Auswahl einer Zeichnung durch ankreuzen";TEXT VARzeichnungsname;TASK VARarbeitertask,depottask;BOOL VARplotteraktiv:=TRUE;THESAURUS VARauswahl;PROCdruckeingang:IF NOTexiststask(depottaskname)THENerrorstop(text10)END IF;depottask:=/depottaskname;IFhighestentry(ALLdepottask)=0THENdeactivate(druckprocindex);deactivate(loeschprocindex)ELSEactivate(druckprocindex);activate(loeschprocindex)END IF END PROCdruckeingang;PROCdruckezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEdruckezeichnungenEND IF;IF NOTplottereingestelltTHENauswahl:=menusome(ALLdepottask,text2,text3,TRUE);IFnotempty(auswahl)THENbegin(arbeitertaskname,PROCzeichnungendrucken,arbeitertask)END IF ELSEzeichnungsname:=menuone(ALLdepottask,text2,text12,TRUE);IFzeichnungsname<>niltextCANDmenuyes(text11,zentral)THENbegin(arbeitertaskname,PROCdruckeeinezeichnung,arbeitertask)END IF END IF END PROCdruckezeichnungen;PROCzeichnungendrucken:disablestop;fetch(auswahl,depottask);plot(auswahl);end(myself)END PROCzeichnungendrucken;PROCdruckeeinezeichnung:disablestop;fetch(zeichnungsname,depottask);plot(zeichnungsname);end(myself)END PROCdruckeeinezeichnung;PROCloeschezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEloeschezeichnungenEND IF;auswahl:=menusome(ALLdepottask,text4,text3,TRUE);IF NOTnotempty(auswahl)THEN LEAVEloeschezeichnungenEND IF;IFmenuyes(text5,zentral)THENcommanddialogue(FALSE);footnote(text6);cursor(36,24);erase(auswahl,depottask);commanddialogue(TRUE);oldfootnote;druckeingangEND IF END PROCloeschezeichnungen;PROCstellezeichenbreiteein:LETminimum=5.0;REAL VARmaximum,maxlaenge,breite;INT VARxpixel,ypixel;TEXT VAReingabe;drawingarea(maximum,maxlaenge,xpixel,ypixel);maximum:=floor(maximum);IFendgeraetbreite>maximumTHENendgeraetbreite(maximum)END IF;REPeingabe:=menuanswer(text7+text(maximum)+text8,text(endgeraetbreite),zentral);IFcompress(eingabe)=niltextTHEN LEAVEstellezeichenbreiteeinEND IF;breite:=real(eingabe);IFlastconversionokCANDbreite>=minimumCANDbreite<=maximumTHENendgeraetbreite(breite);LEAVEstellezeichenbreiteeinEND IF;out(bell)END REP END PROCstellezeichenbreiteein;PROCdefinieredruckerkanal:TEXT VAReingabe;INT VARnr;REPeingabe:=menuanswer(text9,text(plotterkanal),zentral);IFcompress(eingabe)=niltextTHEN LEAVEdefinieredruckerkanalEND IF;nr:=int(eingabe);IFlastconversionokCANDnr>=minimalekanalnrCANDnr<=maximalekanalnrTHENplotterkanal(nr);LEAVEdefinieredruckerkanalEND IF;out(bell)END REP END PROCdefinieredruckerkanal;PROCstoppedrucker:IFexiststask(arbeitertaskname)THENend(/arbeitertaskname)END IF END PROCstoppedrucker;PROCplottereingestellt(BOOL CONSTwert):plotteraktiv:=wertEND PROCplottereingestellt;BOOL PROCplottereingestellt:plotteraktivEND PROCplottereingestellt;END PACKETdruckermenu; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.ega plot b/app/schulis-mathematiksystem/1.0/src/mat.ega plot new file mode 100644 index 0000000..5fc377b --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.ega plot @@ -0,0 +1,4 @@ +PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETegaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,cursor,getcursor,out,zeichensatz,where,zeichenbreite,zeichenhoehe,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=25.54745,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=350,ykonst=349,xkonst=639,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die EGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"ega"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARx,y):xcm:=22.0;ycm:=13.7;x:=xkonst;y:=ykonstEND PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,16,0,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,-1,foregroundcode,dummy).foregroundcode:IFforeground=deleteTHEN0ELSElinetypecodeFI.linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:15CASEgepunktet:13CASEkurzgestrichelt:12CASElanggestrichelt:11CASEstrichpunkt:10OTHERWISElinetypeEND SELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):xDRAWy;pos:=POS:(x,y)END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y,xold:=xpos,yold:=ypos;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;xoldMOVEyold;pos.x:=xold;pos.y:=yold.setcharacterheightandwidth:IFwidth=0.0CANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];pos.xMOVEpos.y;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExpos+xDRAWypos+yFI;pos.x:=xpos+x;pos.y:=ypos+yPER;xposINCRxstep;yposINCRystep;pos.x:=xpos;pos.y:=ypos;.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ykonst-ywert, +dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y,anfang:=ykonst-pos.y,ziel;grenzkontrolle(xwert,ywert);ziel:=ykonst-ywert;IFgeradelinienTHENcontrol(-6,pos.x,anfang,dummy);control(-6,xwert,ziel,dummy)ELSEcontrol(-6,xwert,ziel,dummy);control(-6,pos.x,anfang,dummy);control(-7,xwert,ziel,dummy)END IF.geradelinien:xwert=pos.xCORywert=pos.yEND OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>xkonstTHENx:=xkonstELIFx<0THENx:=0END IF;IFy>ykonstTHENy:=ykonstELIFy<0THENy:=0FI END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=ypixel-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>xpixelDIVzeichen.widthTHENtextcopy:=subtext(text,1,xpixelDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>xpixelDIVzeichen.widthTHENspalte:=xpixelDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>ypixelDIVzeichen.heightTHENzeile:=ypixelDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:14END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=14;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(14,2,3,4,9,8,7,6,5,13,12,11,10,1);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:12END PROCsekantenstift;INT PROCnormalenstift:12END PROCnormalenstift;INT PROCtangentenstift:12END PROCtangentenstift;INT PROClotstift:10END PROClotstift;INT PROCpunktstift:12END PROCpunktstift;END PACKETegaplot;zeichensatz("ZEICHEN 8*14") + + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot b/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot new file mode 100644 index 0000000..508b9b2 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot @@ -0,0 +1,4 @@ +PACKETepsonfxplotDEFINESdrawingarea,beginplot,clear,endplot,plotend,stdhoehe,stdbreite,move,draw,pen,zeichensatz,plotterkanal:LEThorpixelmaxdurch24=97,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",esc="�",modus="L",schrifttyp="P",formfeed="�",zeilenvorschub="J�",minivorschub="J�",cr=" ";INT VARhorpixel,verpixel,horpixeldurch24,ausgewaehlt,groesstexkoord,groessteykoord;TEXT VARneueanzahldernadelspalten;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,plotterchannel:=15;horpixel:=2328;verpixel:=905;horfaktor:=85.03937;vertfaktor:=47.24409;horpixeldurch24:=horpixelDIV24;neueanzahldernadelspalten:=code(verpixelMOD256)+code(verpixelDIV256);LET GRUPPE=STRUCT(ROW3TEXTspalte);BOUND ROWhorpixelmaxdurch24GRUPPE VARbitmap;INT VARprinterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.7662334,buchstabenbreite:=0.3421944;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=real(horpixel)/horfaktor;ycm:=real(verpixel)/vertfaktor;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT CONSTmeinkanal:=channel;INT VARi,j;bitmap:=old("Plotter");druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+schrifttyp).seitenvorschub:out(formfeed+cr).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bitmapdrucken:neueanzahldernadelspalten:=code(zeilenbeginnMOD256)+code(zeilenbeginnDIV256);FORiFROM(groesstexkoordDIV24)+1DOWNTO1REP FORjFROM3DOWNTO1REPdruckeeinespalteeinergruppe;PER;vorschubPER.druckeeinespalteeinergruppe:out(esc+modus+neueanzahldernadelspalten);teilzeileausgeben;out(esc+minivorschub+cr).zeilenbeginn:groessteykoord+1.anzahldernadelspalten:verpixel.teilzeileausgeben:outsubtext(bitmap(i).spalte(j),vontextpos,bistextpos).vontextpos:(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:anzahldernadelspalten.vorschub:out(esc+zeilenvorschub+cr).END PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet);END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;.richtebitmapein:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);groesstexkoord:=0;groessteykoord:=0.loeschebitmap:INT VARi,j;TEXT CONSTleer:=verpixel*"�";FORiFROM1UPTOhorpixeldurch24REP FORjFROM1UPTO3REPbitmap(i).spalte(j):=leerPER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:819CASE3:975CASE4:255CASE5:3711OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:= +totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0 +UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:xniltextTHENarithnotation(aktuellearbeitsfkt);ELSEaktuellearbeitsfkt:=niltext;arithnotation(niltext)END IF;footnote(anwendungstext(326));REP REP IFiserrorTHENclearerror;out(bell);loescheformelfenster;aktuellearbeitsfkt:=niltextEND IF;editformulaUNTIL NOTiserrorEND REP;TEXT VARausstieg:=formeditexitkeySUB2;SELECTpos(erlaubtezeichen,ausstieg)OF CASE1:gibinformationenzumformeleditorCASE2:schaltemarkierungumCASE3:loescheformelfensterCASE4:arithnotation(niltext);verlasseformeleditorCASE5:verlasseformeleditorEND SELECT END REP.gibinformationenzumformeleditor:footnote(anwendungstext(327));formeleditorinfo(ausstieg);IFausstieg="m"THENarithnotation(niltext);verlasseformeleditorEND IF;footnote(anwendungstext(326)).schaltemarkierungum:defformeditmark(NOTformeditmark).loescheformelfenster:cursorgrundeinstellungen;arithnotation(niltext).verlasseformeleditor:forget(tempdatname,quiet);aktuellearbeitsfkt:=arithnotation;BOUND TEXT VARfstring:=new(tempdatname);fstring:=parserformat(aktuellearbeitsfkt);forget(ds);ds:=old(tempdatname);forget(tempdatname,quiet);nachricht:=allesok;LEAVEeditieredieformelEND PROCformelmanager;PROCgrundeinstellungen:resetformulaeditor;defformeditwindow(2,6,78,18);defformeditexitkeys(niltext,niltext,erlaubtezeichen);defformeditmark(" "," ");defformeditmark(TRUE);defformeditbeep(FALSE);defformeditlearn(FALSE);defformeditbuffer(0,0,78);defformeditarith(0,0,78);defformediterror(1,21,78);defformeditrubin(2,20);defformeditlearn(0,0);defformeditkeys(0,0);aktuellearbeitsfkt:=niltext;arithnotation(niltext)END PROCgrundeinstellungen;PROCcursorgrundeinstellungen:defformeditoffset(1,5);defformeditcursor(3,5)END PROCcursorgrundeinstellungen;TEXT PROCparserformat(TEXT CONSTstring):TEXT VARstr:=string;IFpos(str,differenziersymbol)<>0THENsonderbehandlungableitungenEND IF;defaultbehandlung;IFpos(str,selektionsklammeraufsymbol)<>0THENsonderbehandlungselektionEND IF;str.sonderbehandlungableitungen:changeall(str,diffklammeraufsymbol,niltext);changeall(str,diffklammerzusymbol,niltext);changeall(str,"(: D ",differenziersymbol);changeall(str, +":) / D","/ D").defaultbehandlung:changeall(str,funktionsauswertungssymbol,niltext);changeall(str,unsichtbareklammerauf,klammeraufsymbol);changeall(str,unsichtbareklammerzu,klammerzusymbol).sonderbehandlungselektion:changeall(str,selektionsklammeraufsymbol,ifsymbol);changeall(str,selektionsklammerzusymbol,endifsymbol);changeall(str,selektionsthensymbol,thensymbol);changeall(str,selektionselifsymbol,elifsymbol);changeall(str,formeleditorundsymbol,undsymbol);changeall(str,formeleditorodersymbol,odersymbol)END PROCparserformat;PROCformeleditorinfo(TEXT VARausstieg):INT VARersteausgabezeile:=1,maximum:=anzahlzeilen-fensterzeilen;BOOL VARneuausgeben:=TRUE;REP IFneuausgebenTHENgibteiltextausEND IF;werteeingabezeichenausEND REP.gibteiltextaus:INT VARi,zeile:=erstefensterzeile,letzteausgabezeile:=ersteausgabezeile+fensterzeilen;FORiFROMersteausgabezeileUPTOletzteausgabezeileREPcursor(erstefensterspalte,zeile);out(text(anwendungstext(i+offset),77));zeileINCR1END REP.werteeingabezeichenaus:TEXT VARch;inchar(ch);IFch=aufCANDersteausgabezeile>1THENersteausgabezeileDECR1;neuausgeben:=TRUE ELIFch=abCANDersteausgabezeile1THENersteausgabezeileDECRfensterzeilen;ersteausgabezeile:=max(ersteausgabezeile,1);neuausgeben:=TRUE ELIFch=abTHENersteausgabezeileINCRfensterzeilen;ersteausgabezeile:=min(ersteausgabezeile,maximum);neuausgeben:=TRUE ELSEneuausgeben:=FALSE END IF ELIFch=escTHENinchar(ch);SELECTpos(verlasszeichen,ch)OF CASE1:neuausgeben:=ersteausgabezeile<>1;ersteausgabezeile:=1CASE2:neuausgeben:=ersteausgabezeile<>maximum;ersteausgabezeile:=maximumCASE3,4:ausstieg:=ch;LEAVEformeleditorinfoOTHERWISEneuausgeben:=FALSE END SELECT ELSEneuausgeben:=FALSE END IF END PROCformeleditorinfo;END PACKETformeleditormanager; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek b/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek new file mode 100644 index 0000000..0be980c --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek @@ -0,0 +1,2 @@ +PACKETfunktionsbibliothekDEFINEScot,arcsin,arccos,arccot,gauss,rund,ganz,frak,realzahl,wandle,setzenachkommastellen,gesamtstellen,nachkomma,scratchdateiname:LETpisymbol="pi",esymbol="e",pihalbe=1.570796326794896619231,epsilon=0.000000000000000000001,meldung="Falscher Parameter bei realzahl",multiplikationssymbol="*",divisionssymbol="/",minussymbol="-",plussymbol="+",niltext="",blank=" ",zahlentyp=3;REAL PROCcot(REAL CONSTx):IFabs(tan(x))1.0THENerrorstop(anwendungstext(54))END IF;arctan(x/sqrt(1.0-x*x))END PROCarcsin;REAL PROCarccos(REAL CONSTx):pihalbe-arcsin(x)END PROCarccos;REAL PROCarccot(REAL CONSTx):pihalbe-arctan(x)END PROCarccot;REAL PROCgauss(REAL CONSTx):IFx>=0.0CORfloor(x)=xTHENfloor(x)ELSEfloor(x)-1.0END IF END PROCgauss;REAL PROCrund(REAL CONSTx):round(x,0)END PROCrund;REAL PROCganz(REAL CONSTx):floor(x)END PROCganz;REAL PROCfrak(REAL CONSTx):frac(x)END PROCfrak;TEXT VARsym;INT VARtyp;REAL PROCrealzahl(TEXT CONSTt):enablestop;REAL VARzahl:=0.0;scan(t);nextsymbol(sym,typ);IFsym=minussymbolTHENnextsymbol(sym,typ);zahl:=-ueberprueftezahlELIFsym=plussymbolTHENnextsymbol(sym,typ);zahl:=ueberprueftezahlELSEzahl:=ueberprueftezahlEND IF;WHILEsym=multiplikationssymbolCORsym=divisionssymbolREP IFsym=multiplikationssymbolTHENnextsymbol(sym,typ);zahl:=zahl*ueberprueftezahlELIFsym=divisionssymbolTHENnextsymbol(sym,typ);zahl:=zahl/ueberprueftezahlEND IF END REP;IFsym<>niltextTHENerrorstop(meldung)END IF;zahlEND PROCrealzahl;REAL PROCueberprueftezahl:REAL VARwert;IFsym=esymbolTHENwert:=eELIFsym=pisymbolTHENwert:=piELIFtyp=zahlentypTHENwert:=real(sym)ELSEerrorstop(meldung)END IF;nextsymbol(sym,typ);wertEND PROCueberprueftezahl;ROW2INT VARnachk:=ROW2INT:(4,4),gesamtst:=ROW2INT:(18,18),grenze:=ROW2INT:(10,10);PROCsetzenachkommastellen(INT CONSTi):nachk(ebene):=i;gesamtst(ebene):=i+14;grenze(ebene):=gesamtst(ebene)-i-4END PROCsetzenachkommastellen;INT PROCgesamtstellen(INT CONSTi):gesamtst(i)END PROCgesamtstellen;INT PROCnachkomma(INT CONSTi):nachk(i)END PROCnachkomma;TEXT PROCwandle(REAL CONSTx):TEXT VARt;INT VARi;IFwertsehrgrossTHENwissenschaftlichesformatELIFwertsehrkleinTHEN IFwertnochdezimaldarstellbarTHENlangesdezimalesformatELSEwissenschaftlichesformatEND IF ELSEkurzesdezimalesformatEND IF.wertsehrgross:abs(x)>10.0**grenze(ebene).wertsehrklein:(abs(x)<10.0**(-nachk(ebene))CANDx<>0.0).wertnochdezimaldarstellbar:INT VARexponent:=abs(decimalexponent(x));exponent0THEN WHILE(tSUBn)="0"REP IF(tSUB(n-1))<>"."THENchange(t,n,n,niltext);END IF;nDECR1END REP;END IF;(gesamtst(ebene)-length(t))*blank+t.kurzesdezimalesformat:t:=text(x,gesamtst(ebene),nachk(ebene));i:=gesamtst(ebene);WHILE(tSUBi)="0"REPreplace(t,i,blank);iDECR1END REP;IF(tSUBi)="."THEN IFnachk(ebene)<>0THENreplace(t,i,blank)ELSEt:=blank+text(t,i-1)END IF END IF;t.langesdezimalesformat:t:=text(x,gesamtst(ebene),exponent);i:=gesamtst(ebene);WHILE(tSUBi)="0"REPt:=blank+text(t,i-1)END REP;t.END PROCwandle;TEXT PROCscratchdateiname:TEXT VARname:="MATHEMATIKDATEI "+date+" "+timeofday;IFexists(name)THEN INT VARzaehler:=1;nameCAT":";WHILEexists(name+text(zaehler))REPzaehlerINCR1END REP;nameCATtext(zaehler)END IF;nameEND PROCscratchdateiname;END PACKETfunktionsbibliothek; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren b/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren new file mode 100644 index 0000000..2f073b1 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren @@ -0,0 +1,14 @@ +PACKETgraphicverfahrenDEFINESerstellegraph,normalgraphzeichnen,setzedefaultgraph,bauegraphbildschirmauf,initkoordinatensystem,berechnekoordinatensystem,nullpunkteinbeziehen,zeichnekoordinatensystem,zeichnefunktionsgraphen,zeichneasymptote,zeichnefusszeile,graphfenstereinstellen,gesamtfenstereinstellen,definitionsmenu,initprotokoll,gibprotokollaus,druckegraph,druckeprotokoll,loescheprotokoll,beendegraphikarbeit,gibgraphicmeldung,koordinatensystemxmin,koordinatensystemxmax,koordinatensystemymin,koordinatensystemymax,automatischerskalierungsmodus,zeichnetexte,loeschetexte:LETsondermenubeginn=0.65,graphrand=0.2,links="�",rechts="�",bell="�",verfahrenverlassen="qm",standardoptionen="wqm",graphicausschalten="üqmv",protokolloptionen="dwüqm",drucken="d",ueberlagerung="ü",weiterarbeit="w",graphicdefinieren="e",protokollzeigen="p",punktmarkierungszeichen="p",sekantenzeichen="s",tangentenzeichen="t",normalenzeichen="n",ableitungszeichen="a",xlotzeichen="x",ylotzeichen="y",druckzeichen="D",wischzeichen="L",parameterwahl="P",bereichswahl="B",achsenbereichzeichen="a",achsenbezeichnungszeichen="b",rasterzeichen="r",xtransformationszeichen="x",ytransformationszeichen="y",linienmoduszeichen="z",punktanzahlzeichen="p",zeichnungabbrechen="!",zeichnunganhalten=":",escapezeichen="�",minimumstuetzpunkte=5,niltext="",blank=" ",unterstrich="_",durchgezogen=TRUE,anzahltestpunkte=20.0,defaultstuetzpunkte=150,korrekturfaktor=0.4,erstemenuzeile=7,erstemenuspalte=55,punkteingabezeile=21,punkteingabelaenge=12,anzahlsondermenupunkte=12,anzahldefinitionspunkte=8,grundstift=1,stdtransformation1="y * cos (x)",stdtransformation2="y * sin (x)",xsymbol="x",ysymbol="y",maximalerachsenbetrag=1000000.0,minimaledifferenz=0.0000001,seitenabstand=8,hoehenabstand=8;TEXT VARxachsenbezeichnung:=niltext,yachsenbezeichnung:=niltext;TEXT CONSTkurzeleerzeile:=(80-erstemenuspalte)*blank,langeleerzeile:=60*blank,kurzerstrich:=12*unterstrich,loeschzeile:=kurzeleerzeile+" ";REAL VARxmin:=0.0,xmax:=1.0,ymin:=0.0,ymax:=1.0,xdistanz:=1.0,ydistanz:=1.0,deltax:=1.0,deltay:=1.0,cmbreite,cmhoehe,graphmaximum,graphminimum,graphbreite;INT VARpixelbreite,pixelhoehe,stuetzpunktanzahl:=defaultstuetzpunkte,imin,imax,i0,j0,jmin,jmax;ROW2ABBILDUNG VARtransformation;ROW2TEXT VARtransformationsvorgabe:=ROW2TEXT:(stdtransformation1,stdtransformation2);ROW2BOOL VARtransformiert:=ROW2BOOL:(FALSE,FALSE);ROWanzahlsondermenupunkteTEXT CONSTsmpunkt:=ROWanzahlsondermenupunkteTEXT:(anwendungstext(191),anwendungstext(192),anwendungstext(193),anwendungstext(194),anwendungstext(195),anwendungstext(196),anwendungstext(197),anwendungstext(198),anwendungstext(199),anwendungstext(200),anwendungstext(201),anwendungstext(202));ROWanzahldefinitionspunkteTEXT CONSTdefpunkt:=ROWanzahldefinitionspunkteTEXT:(anwendungstext(118),anwendungstext(120),anwendungstext(121),anwendungstext(122),anwendungstext(123),anwendungstext(124),anwendungstext(125),anwendungstext(126));ABBILDUNG VARfkt,fktstrich;VECTOR VARfunktionsparameter;INT VARlaufvariablenindex:=1;REAL VARanfangswert:=-5.0,endwert:=5.0;BOOL VARlinienmodus:=durchgezogen,ursprungobligatorisch:=TRUE,automatischeskalierung:=TRUE,graphgerastert:=FALSE,bereichseingabegewuenscht:=TRUE,parametereingabegewuenscht:=TRUE,mitkoordinatensystem:=TRUE,asymptotensichtbar:=TRUE,parameterdarstellung:=FALSE,vorzeitigerabbruch:=FALSE,unterbrechenerlaubt:=TRUE,koordinatensysteminitialisiert:=FALSE,ueberlagern:=FALSE;PICTURE VARkoordinatensystem:=nilpicture;PROCerstellegraph(ABBILDUNG CONSTf):TEXT VARausstieg;disablestop;ueberpruefeverwendbarkeitderfunktion;bauegraphbildschirmauf(f,titel);initialisierediebearbeitung;bearbeitefunktion;beendearbeit.ueberpruefeverwendbarkeitderfunktion:fkt:=f;IFlaenge(abbildungsterme(fkt))>2THENgibmeldung(anwendungstext(88));LEAVEerstellegraphEND IF;IFueberlagernCAND NOT(parameterdarstellungXORlaenge(abbildungsterme(fkt))=1)THENgibmeldung(anwendungstext(177));LEAVEerstellegraphEND IF;parameterdarstellung:=laenge(abbildungsterme(f))=2;IFkomplexefunktion(fkt) +THENfkt:=aufloesung(fkt)END IF.initialisierediebearbeitung:unterbrechenerlaubt:=TRUE;IFueberlagernTHENgraphfenstereinstellen;plotscreenmemoryELSEinitkoordinatensystemEND IF.titel:IFparameterdarstellungTHEN"Graph - Parameterdarstellung"ELSE"Graph"END IF.bearbeitefunktion:TEXT VARvariablenname:=NAMElistenanfang(abbildungsvariablen(fkt));laufvariablenindex:=1;funktionsparameter:=vector(laenge(abbildungsvariablen(fkt)));cursor(2,3);out("Variable :");cursor(22,3);out("von");cursor(39,3);out("bis");bereichseingabegewuenscht:=TRUE;WHILEbereichseingabegewuenschtREPbestimmelaufvariablenindexundbereich;mitkoordinatensystem:=NOTueberlagern;parametereingabegewuenscht:=TRUE;WHILEparametereingabegewuenschtREPbestimmeggfparameterwerte;zeichnefusszeile(anwendungstext(144));IFmitkoordinatensystemTHENinitkoordinatensystem;bestimmekoordinatenundzeichnekoordinatensystem;mitkoordinatensystem:=FALSE END IF;vorzeitigerabbruch:=FALSE;zeichnediefunktion;graphictools(ausstieg)END REP END REP.bestimmelaufvariablenindexundbereich:initialisierebereichseingabemaske;REPbearbeitebereichseingabemaske;werteausstiegausEND REP.initialisierebereichseingabemaske:LETfeldanzahl=3,yposition=3;INT VARi,feldptr;TEXT VARerlaubteausstiegszeichen:=graphicdefinieren+standardoptionen,verlasszeichen;ROWfeldanzahlTEXT VARfeld:=ROWfeldanzahlTEXT:(variablenname,compress(wandle(anfangswert)),compress(wandle(endwert)));ROWfeldanzahlINT CONSTxposition:=ROWfeldanzahlINT:(13,26,43),feldlaenge:=ROWfeldanzahlINT:(8,12,12);ROWfeldanzahlBOOL CONSTgesperrt:=ROWfeldanzahlBOOL:(ebene=1CORlaenge(abbildungsvariablen(fkt))=1,ueberlagern,ueberlagern);FORfeldptrFROM1UPTOfeldanzahlREP IF NOTgesperrt(feldptr)THENfeld(feldptr)CATkurzerstrichEND IF;cursor(xposition(feldptr),yposition);out(text(feld(feldptr),feldlaenge(feldptr)))END REP;feldptr:=0;bereichseingabegewuenscht:=NOT(gesperrt(1)CANDgesperrt(2)CANDgesperrt(3));IF NOTbereichseingabegewuenschtTHEN LEAVEbestimmelaufvariablenindexundbereichEND IF;IFueberlagernTHENerlaubteausstiegszeichenCATueberlagerungEND IF;verlasszeichen:=erlaubteausstiegszeichen+links+rechts.bearbeitebereichseingabemaske:IFueberlagernTHENzeichnefusszeile(anwendungstext(176))ELSEzeichnefusszeile(anwendungstext(128))END IF;REP IFausstieg=linksTHEN IFfeldptr>1THENfeldptrDECR1END IF ELSEfeldptr:=feldptrMODfeldanzahl+1END IF;IFgesperrt(feldptr)THEN IFfeldptr=1THENfeldptr:=2ELIFfeldptr=2THENfeldptr:=1END IF END IF;cursor(xposition(feldptr),yposition);grapheditget(feld(feldptr),feldlaenge(feldptr),verlasszeichen,ausstieg)UNTILpos(erlaubteausstiegszeichen,ausstieg)<>0END REP.werteausstiegaus:SELECTpos(erlaubteausstiegszeichen,ausstieg)OF CASE1:IF NOTueberlagernTHENdefinitionsmenu(FALSE,ausstieg);IFpos(verfahrenverlassen,ausstieg)<>0THENverfahrensende(ausstieg);LEAVEbearbeitefunktionEND IF END IF;CASE2:IFwertekorrektTHENbereichseingabegewuenscht:=FALSE;LEAVEbestimmelaufvariablenindexundbereichELSE FORiFROM1UPTOfeldanzahlREP IF NOTgesperrt(i)THENfeld(i)CATkurzerstrichEND IF END REP END IF OTHERWISEverfahrensende(ausstieg);ueberlagern:=ausstieg=ueberlagerung;LEAVEbearbeitefunktionEND SELECT.wertekorrekt:FORiFROM1UPTO3REPchangeall(feld(i),unterstrich,niltext)END REP;(gesperrt(1)CORkorrektervariablenname)CAND(gesperrt(2)CORkorrekteranfangswert)CAND(gesperrt(3)CORkorrekterendwert).korrektervariablenname:TERM VARt:=listenposition(abbildungsvariablen(fkt),feld(1));IFt=nilTHENfeldptr:=0;FALSE ELSEvariablenname:=NAMEt;laufvariablenindex:=PLATZt;TRUE END IF.korrekteranfangswert:REAL VARwert:=realzahl(feld(2));IFiserrorTHENbehandlefehler;feldptr:=1;FALSE ELIFabs(wert)>maximalerachsenbetragTHENfeldptr:=1;FALSE ELSEanfangswert:=wert;replace(funktionsparameter,laufvariablenindex,anfangswert);TRUE END IF.korrekterendwert:wert:=realzahl(feld(3));IFiserrorTHENbehandlefehler;feldptr:=2;FALSE ELIFwert-anfangswert<=minimaledifferenzCORabs(wert)>maximalerachsenbetragTHENfeldptr:=2;FALSE ELSEendwert:=wert;TRUE END IF.bestimmeggfparameterwerte:IFlength(funktionsparameter)=1THENparametereingabegewuenscht +:=FALSE;LEAVEbestimmeggfparameterwerteEND IF;cursor(2,4);out("Parameter:");IFueberlagernTHENzeichnefusszeile(anwendungstext(176))ELSEzeichnefusszeile(anwendungstext(100))END IF;erlaubteausstiegszeichen:=standardoptionen;IFueberlagernTHENerlaubteausstiegszeichenCATueberlagerungEND IF;cursor(13,4);belegeparameter(funktionsparameter,laufvariablenindex,abbildungsvariablen(fkt),erlaubteausstiegszeichen,ausstieg);IFausstieg=weiterarbeitTHENparametereingabegewuenscht:=FALSE;cursor(2,4);out(langeleerzeile)ELSEueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEbearbeitefunktionEND IF.bestimmekoordinatenundzeichnekoordinatensystem:IFautomatischeskalierungTHENberechnekoordinatensystemELIF NOTparameterdarstellungCAND NOTtransformiert(1)THENxmin:=anfangswert;xmax:=endwertEND IF;zeichnekoordinatensystem.zeichnediefunktion:pen(1,1,1,neuerstift);vorzeitigerabbruch:=FALSE;zeichnefunktionsgraphen(fkt);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEbearbeitefunktionEND IF.beendearbeit:IF NOTueberlagernTHENclearscreenmemoryEND IF;loeschetemporaereabbildung(fkt);loeschetemporaereabbildung(fktstrich);plotendEND PROCerstellegraph;PROCgraphictools(TEXT VARausstieg):TEXT VARch;TEXT CONSTgueltigerausstieg:=verfahrenverlassen+ueberlagerung;REAL VARpx:=0.0,py;BOOL VARvollerfunktionsumfang,ableitunggezeichnet:=FALSE;BOOL CONSTzeichnungerweiterbar:=NOTtransformiert(1)CAND NOTtransformiert(2)CAND NOTparameterdarstellung;IFzeichnungerweiterbarTHENtestefunktionsumfangEND IF;zeichnesondermenu;REPclearbuffer;inchar(ch);IFch=punktmarkierungszeichenCANDzeichnungerweiterbarTHENmarkiereauszuwaehlendenpunktELIFch=sekantenzeichenCANDzeichnungerweiterbarTHENzeichneauszuwaehlendesekanteELIFch=tangentenzeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangTHENzeichneauszuwaehlendetangenteELIFch=normalenzeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangTHENzeichneauszuwaehlendenormaleELIFch=xlotzeichenCANDzeichnungerweiterbarTHENzeichnexlotELIFch=ylotzeichenCANDzeichnungerweiterbarTHENzeichneylotELIFch=ableitungszeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangCAND NOTableitunggezeichnetTHENzeichneableitungsfunktionELIFch=wischzeichenTHENerneueregraphicELIFch=druckzeichenTHENdruckegraphELIFch=parameterwahlCANDlaenge(abbildungsvariablen(fkt))<>1THENparametereingabegewuenscht:=TRUE;loeschesondermenu;LEAVEgraphictoolsELIFch=bereichswahlTHENbereichseingabegewuenscht:=TRUE;ueberlagern:=FALSE;loeschesondermenu;graphfenstereinstellen;loeschezeichnung;LEAVEgraphictoolsELIFch=escapezeichenTHENinchar(ausstieg);IFpos(gueltigerausstieg,ausstieg)<>0THENverlassegraphicbildschirmELIFausstieg=protokollzeigenTHENzeigeparameterbelegungELSEout(bell)END IF ELSEout(bell)END IF END REP.testefunktionsumfang:IFadresse(fktstrich)=nilTHENfktstrich:=ableitung(fkt,1,laufvariablenindex);IFiserrorTHENclearerror;vollerfunktionsumfang:=FALSE ELSEvollerfunktionsumfang:=TRUE END IF ELSEvollerfunktionsumfang:=TRUE END IF.zeichnesondermenu:INT VARi,zeile:=erstemenuzeile,anfang:=1;gesamtfenstereinstellen;IF NOTzeichnungerweiterbarTHENanfang:=9END IF;FORiFROManfangUPTOanzahlsondermenupunkteREP IF(laenge(abbildungsvariablen(fkt))<>1CANDi=10)CORi<>10CAND(vollerfunktionsumfangCOR(i<>2CANDi<>4CANDi<>5))THENcursor(erstemenuspalte,zeile);out(smpunkt(i));zeileINCR1END IF END REP;zeichnefusszeile(anwendungstext(178)).markiereauszuwaehlendenpunkt:punkteingabe;IFiserrorTHENbehandlefehlerELSEmarkierepunkt(px,py)END IF.zeichneauszuwaehlendetangente:punkteingabe;IFiserrorTHENbehandlefehlerELSEzeichnetangente(px,py)END IF.zeichneauszuwaehlendesekante:REAL VARpx1:=px,px2:=0.0,py1,py2;liesdiebeidenpunkteein;zeichnefusszeile(anwendungstext(178));graphfenstereinstellen;zeichnegerade(px1,py1,px2,py2).liesdiebeidenpunkteein:liespunktein("x1 = ",anwendungstext(179),px1,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;replace(funktionsparameter,laufvariablenindex,px1);py1:=ergebnis(fkt,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichneauszuwaehlendesekanteEND IF; +REPliespunktein("x2 = ",niltext,px2,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;IFpx2=px1THENout(bell)END IF UNTILpx2<>px1END REP;replace(funktionsparameter,laufvariablenindex,px2);py2:=ergebnis(fkt,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichneauszuwaehlendesekanteEND IF.zeichneauszuwaehlendenormale:punkteingabe;IFiserrorTHENbehandlefehlerELSEzeichnenormale(px,py)END IF.zeichnexlot:punkteingabe;IFiserrorTHENbehandlefehlerELSEgraphfenstereinstellen;newpicture(lotstift);pen(1,1,1,lotstift);matmove(px,py);matdraw(px,0.0)END IF.zeichneylot:punkteingabe;IFiserrorTHENbehandlefehlerELSEgraphfenstereinstellen;pen(1,1,1,lotstift);newpicture(lotstift);matmove(px,py);matdraw(0.0,py)END IF.zeichneableitungsfunktion:asymptotensichtbar:=FALSE;replace(funktionsparameter,laufvariablenindex,anfangswert);zeichnefusszeile(anwendungstext(144));pen(1,1,1,neuerstift);zeichnefunktionsgraphen(fktstrich);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEgraphictoolsEND IF;zeichnefusszeile(anwendungstext(178));asymptotensichtbar:=TRUE;ableitunggezeichnet:=TRUE.erneueregraphic:ueberlagern:=FALSE;graphfenstereinstellen;loeschezeichnungpartiell;initprotokoll;asymptotensichtbar:=TRUE;replace(funktionsparameter,laufvariablenindex,anfangswert);zeichnefusszeile(anwendungstext(144));initstift;pen(1,1,1,neuerstift);zeichnefunktionsgraphen(fkt);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEgraphictoolsEND IF;zeichnefusszeile(anwendungstext(178));ableitunggezeichnet:=FALSE.zeigeparameterbelegung:gibprotokollaus(anwendungstext(214),protokolloptionen,ausstieg);IFausstieg=weiterarbeitTHENzeichnesondermenuELSEverlassegraphicbildschirmEND IF.verlassegraphicbildschirm:ueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEgraphictools.loeschesondermenu:INT VARende:=anzahlsondermenupunkte;IF NOTzeichnungerweiterbarTHENende:=4ELIF NOTvollerfunktionsumfangTHENendeDECR3END IF;IFlaenge(abbildungsvariablen(fkt))=1THENendeDECR1END IF;radiere(erstemenuzeile,erstemenuzeile+ende-1).punkteingabe:liespunktein("x = ",anwendungstext(179),px,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;zeichnefusszeile(anwendungstext(178));replace(funktionsparameter,laufvariablenindex,px);py:=ergebnis(fkt,funktionsparameter)SUB1.testevorzeitigenausstieg:IFausstieg<>niltextTHENueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEgraphictoolsEND IF END PROCgraphictools;PROCmarkierepunkt(REAL CONSTx,y):INT VARi,j;INT CONSTstrichlaenge:=4;REAL VARunten,oben,links,rechts;graphfenstereinstellen;IFxxmaxCORyymaxTHEN LEAVEmarkierepunktEND IF;pen(1,1,1,punktstift);i:=xpixel(x);j:=ypixel(y);links:=xweltkoordinate(i-strichlaenge);rechts:=xweltkoordinate(i+strichlaenge);unten:=yweltkoordinate(j-strichlaenge);oben:=yweltkoordinate(j+strichlaenge);newpicture(punktstift);matmove(links,oben);matdraw(rechts,unten);matmove(links,unten);matdraw(rechts,oben)END PROCmarkierepunkt;PROCzeichnetangente(REAL CONSTx,y):REAL VARm;IFxxmaxTHEN LEAVEzeichnetangenteEND IF;replace(funktionsparameter,laufvariablenindex,x);m:=ergebnis(fktstrich,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichnetangenteEND IF;graphfenstereinstellen;pen(1,1,1,tangentenstift);newpicture(tangentenstift);matmove(xmin,m*(xmin-x)+y);matdraw(xmax,m*(xmax-x)+y)END PROCzeichnetangente;PROCzeichnenormale(REAL CONSTx,y):REAL VARm;IFxxmaxTHEN LEAVEzeichnenormaleEND IF;replace(funktionsparameter,laufvariablenindex,x);m:=ergebnis(fktstrich,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichnenormaleEND IF;graphfenstereinstellen;pen(1,1,1,normalenstift);newpicture(normalenstift);IFm=0.0THENmatmove(x,ymax);matdraw(x,ymin)ELSEmatmove(xmin,-1.0/m*(xmin-x)+y);matdraw(xmax,-1.0/m*(xmax-x)+y)END IF END PROCzeichnenormale;PROCzeichnegerade(REAL CONSTx1,y1,x2,y2):REAL VARm:=(y2-y1)/(x2-x1);newpicture(sekantenstift);pen(1,1,1,sekantenstift);matmove(xmin,m*(xmin-x1)+y1);matdraw(xmax,m*(xmax-x1)+y1)END PROCzeichnegerade; +PROCbauegraphbildschirmauf(ABBILDUNG CONSTf,TEXT CONSTueberschrift):initgraphic;zeichnestatuszeile(ueberschrift);zeichnearbeitsfunktion(f);zeichnebildschirmrasterEND PROCbauegraphbildschirmauf;PROCzeichnestatuszeile(TEXT CONSTverfahrensname):TEXT VARgrundlage:=text(anwendungstext(102),78),anhang:="Ebene "+text(ebene)+" "+verfahrensname;replace(grundlage,77-length(anhang),anhang);cursor(2,1);out(grundlage)END PROCzeichnestatuszeile;PROCzeichnearbeitsfunktion(ABBILDUNG CONSTf):cursor(2,2);out(text(funktionsstring(f),78))END PROCzeichnearbeitsfunktion;PROCzeichnebildschirmraster:pen(1,1,1,grundstift);IFanpassungstyp<>"cga"THENboxEND IF;move(0.0,graphmaximum);draw(cmbreite,graphmaximum);move(graphbreite,graphmaximum);draw(graphbreite,graphminimum);move(0.0,graphminimum);draw(cmbreite,graphminimum)END PROCzeichnebildschirmraster;PROCzeichnefusszeile(TEXT CONSTt):cursor(2,24);out(text(t,78))END PROCzeichnefusszeile;PROCgibgraphicmeldung(TEXT CONSTinhalt):TEXT VARt:=78*waagerecht;cursor(1,21);out(eckeobenlinks+t+eckeobenrechts);cursor(1,22);out(senkrecht+text(inhalt,78)+senkrecht);cursor(1,23);out(eckeuntenlinks+t+eckeuntenrechts);zeichnefusszeile(anwendungstext(77));pauseEND PROCgibgraphicmeldung;PROCsetzedefaultgraph:automatischeskalierung:=TRUE;ursprungobligatorisch:=TRUE;linienmodus:=durchgezogen;xachsenbezeichnung:="A1";yachsenbezeichnung:="A2";stuetzpunktanzahl:=defaultstuetzpunkte;graphgerastert:=FALSE;transformiert:=ROW2BOOL:(FALSE,FALSE);transformationsvorgabe:=ROW2TEXT:(stdtransformation1,stdtransformation2);xmin:=-5.0;xmax:=5.0;ymin:=-5.0;ymax:=5.0;ueberlagern:=FALSE;anfangswert:=-5.0;endwert:=5.0END PROCsetzedefaultgraph;PROCinitkoordinatensystem:koordinatensystem:=nilpicture;koordinatensysteminitialisiert:=FALSE;initprotokoll;initscreenmemory;initstiftEND PROCinitkoordinatensystem;PROCbeendegraphikarbeit:clearscreenmemory;loescheprotokoll;loescheggftransformation(1);loescheggftransformation(2)END PROCbeendegraphikarbeit;PROCloescheggftransformation(INT CONSTi):IFtransformiert(i)THENloescheabbildung(transformation(i))ENDIF END PROCloescheggftransformation;PROCinitgraphic:beginplot;clear;drawingarea(cmbreite,cmhoehe,pixelbreite,pixelhoehe);move(cmbreite,cmhoehe);gesamtfenstereinstellen;berechnebildschirmaufteilungskonstanten.berechnebildschirmaufteilungskonstanten:graphmaximum:=cmhoehe-4.5*stdhoehe;graphminimum:=cmhoehe-23.0*stdhoehe;graphbreite:=sondermenubeginn*cmbreiteEND PROCinitgraphic;PROCgesamtfenstereinstellen:viewport(0.0,cmbreite,0.0,cmhoehe);window(0.0,cmbreite,0.0,cmhoehe)END PROCgesamtfenstereinstellen;PROCgraphfenstereinstellen:viewport(graphrand,graphbreite-graphrand,graphminimum+graphrand,graphmaximum-graphrand);window(xmin,xmax,ymin,ymax)END PROCgraphfenstereinstellen;PROCberechnekoordinatensystem(ABBILDUNG CONSTabb,REAL CONSTlinks,rechts,VECTOR CONSTparam,INT CONSTvindex):parameterdarstellung:=FALSE;fkt:=abb;IFlinks=0.0THENxmin:=-0.15*xmaxEND IF;IFymax<=0.0THENymax:=-0.15*yminELIFymin>=0.0THENymin:=-0.15*ymaxEND IF END PROCnullpunkteinbeziehen;PROCzeichnekoordinatensystem:graphfenstereinstellen;IF NOTkoordinatensysteminitialisiertTHENstellekoordinatensystemneuzusammenEND IF;gibkoordinatensystemaus.stellekoordinatensystemneuzusammen:ueberpruefesichtbarkeit;bestimmepixelmarkanterpunkte;zeichnedasbild;koordinatensysteminitialisiert:=TRUE;putscreenmemory(koordinatensystem).ueberpruefesichtbarkeit:BOOL CONSTxachsesichtbar:=ymin<=0.0CANDymax>=0.0,yachsesichtbar:=xmin<=0.0CANDxmax>=0.0.bestimmepixelmarkanterpunkte:imin:=xpixel(xmin);imax:=xpixel(xmax);jmin:=ypixel(ymin);jmax:=ypixel(ymax);IFxachsesichtbarTHENj0:=ypixel(0.0)END IF;IFyachsesichtbarTHENi0:=xpixel(0.0)END IF.zeichnedasbild:TEXT VARstring;INT VARtextlaenge,schreibzeile,schreibspalte,verfuegbarerplatz;REAL VARwert,letzterwert,start,anfang,ende,schriftbreite:=stdbreite,schrifthoehe:=stdhoehe;BOOL VARwertausgeben;berechneabstaende;pen(koordinatensystem,grundstift);IFxachsesichtbarTHENzeichnexachse;skalierexachse;beschriftexachseEND IF;IFyachsesichtbarTHENzeichneyachse;skaliereyachse;beschrifteyachseEND IF;IFgraphgerastertTHENlegerasteruebergraphEND IF.berechneabstaende:deltax:=xmax-xmin;deltay:=ymax-ymin;xdistanz:=10.0**decimalexponent(max(abs(xmax),abs(xmin)));ydistanz:=10.0**decimalexponent(max(abs(ymax),abs(ymin)));WHILExdistanz>=0.33*deltaxREPxdistanz:=0.1*xdistanzEND REP;WHILEydistanz>=0.33*deltayREPydistanz:=0.1*ydistanzEND REP.zeichnexachse:move(koordinatensystem,xmin,0.0);draw(koordinatensystem,xmax,0.0).skalierexachse:bestimmelaengederxskalierungsstriche;zeichnediexachsenstriche.bestimmelaengederxskalierungsstriche:REAL CONSTyabstand:=deltay/80.0;anfang:=min(yabstand,ymax);ende:=max(-yabstand,ymin).zeichnediexachsenstriche:start:=xmax-xmax +MODxdistanz;WHILEstart>=xminREPmove(koordinatensystem,start,anfang);draw(koordinatensystem,start,ende);start:=start-xdistanzEND REP.beschriftexachse:gibxeinheitenaus;gibxachsenbezeichnungaus.gibxeinheitenaus:INT VARrechtegrenze:=imax,linkegrenze:=imin;REAL VARschreibzeilenweltlage;schreibzeile:=j0-zeichenhoehe-hoehenabstand;IFschreibzeile=xminREP IFwertausgebenTHENstring:=compress(wandle(wert));textlaenge:=length(string)*zeichenbreite;schreibspalte:=xpixel(wert)-textlaengeDIV2;IFschreibspalte+textlaenge<=rechtegrenzeCANDschreibspalte>=linkegrenzeTHENmove(koordinatensystem,xweltkoordinate(schreibspalte),schreibzeilenweltlage);draw(koordinatensystem,string,0.0,schrifthoehe,schriftbreite);wertausgeben:=FALSE;letzterwert:=wert;rechtegrenze:=schreibspalte-3*zeichenbreiteEND IF ELSEwertausgeben:=TRUE END IF;wert:=wert-xdistanz;IFwert=0.0THENwert:=-letzterwert;rechtegrenze:=i0-seitenabstand;wertausgeben:=TRUE END IF;IFwertjmaxTHEN LEAVEgibxachsenbezeichnungausEND IF;IFyachsesichtbarTHENlinkegrenze:=i0+seitenabstandELSElinkegrenze:=iminEND IF;verfuegbarerplatz:=imax-linkegrenze;IFverfuegbarerplatz=yminREPmove(koordinatensystem,anfang,start);draw(koordinatensystem,ende,start);start:=start-ydistanzEND REP.beschrifteyachse:gibyeinheitenaus;gibyachsenbezeichnungaus.gibyeinheitenaus:INT VARoberegrenze:=jmax,unteregrenze:=jmin,zentrierung:=zeichenhoeheDIV2;REAL VARschreibspaltenweltlage;schreibspalte:=i0+seitenabstand;IFschreibspalte>imaxTHEN LEAVEgibyeinheitenausEND IF;schreibspaltenweltlage:=xweltkoordinate(schreibspalte);IFxachsesichtbarTHENunteregrenze:=j0+hoehenabstandEND IF;wertausgeben:=ymax<=2.5*ydistanz;letzterwert:=ydistanz;verfuegbarerplatz:=imax-i0-seitenabstand;wert:=ymax-ymaxMODydistanz;WHILEwert>=yminREP IFwertausgebenTHENschreibzeile:=ypixel(wert)-zentrierung;IFschreibzeile+zeichenhoehe<=oberegrenzeCANDschreibzeile>=unteregrenzeTHENstring:=compress(wandle(wert));IFlength(string)*zeichenbreite<=verfuegbarerplatzTHENmove(koordinatensystem,schreibspaltenweltlage,yweltkoordinate(schreibzeile));draw(koordinatensystem,string,0.0,schrifthoehe,schriftbreite);wertausgeben:=FALSE;letzterwert:=wert;oberegrenze:=schreibzeile-zeichenhoeheEND IF END IF ELSEwertausgeben:=TRUE END IF;wert:=wert-ydistanz;IFwert=0.0THENwert:=-letzterwert;oberegrenze:=j0-hoehenabstand;wertausgeben:=TRUE END IF;IFwertschreibzeileTHEN LEAVEgibyachsenbezeichnungausEND IF;verfuegbarerplatz:=i0-imin-seitenabstand;IFverfuegbarerplatz=yminREPanfang:=xmax-xmaxMODxdistanz;WHILEanfang>=xminREPmove(koordinatensystem,anfang,ende);draw(koordinatensystem,anfang,ende);anfang:=anfang-xdistanzEND REP;ende:=ende-ydistanzEND REP.gibkoordinatensystemaus:pen(1,1,1,pen(koordinatensystem));plot(koordinatensystem)END PROCzeichnekoordinatensystem;PROCnormalgraphzeichnen(ABBILDUNG CONSTabb,VECTOR CONSTparam,INT CONSTvindex):initstift;pen(1,1,1,neuerstift);parameterdarstellung:=FALSE;fkt:=abb;anfangswert:=xmin;endwert:=xmax;unterbrechenerlaubt:=FALSE;funktionsparameter:=param;laufvariablenindex:=vindex;zeichnefunktionsgraphen(fkt)END PROCnormalgraphzeichnen;PROCzeichnefunktionsgraphen(ABBILDUNG CONSTf):graphfenstereinstellen;newpicture(aktuellerstift);IFtransformiert(1)CORtransformiert(2)CORparameterdarstellungTHENzeichnefunktiontransformiert(f)ELIFlinienmodusTHENzeichnefunktionmitasymptotenroutine(f)ELSEzeichnefunktioneinfach(f)END IF;protokollierekurve(f,funktionsparameter,laufvariablenindex)END PROCzeichnefunktionsgraphen;PROCzeichnefunktiontransformiert(ABBILDUNG CONSTf):INT VARi,j;TERM VARfktterm1:=listenanfang(abbildungsterme(f)),fktterm2;REAL VARx:=anfangswert,step:=(endwert-anfangswert)/real(stuetzpunktanzahl-1);ROW2REAL VARy;VECTOR VARv:=funktionsparameter;BOOL VARfehlerzustand:=TRUE;IFparameterdarstellungTHENfktterm2:=AUSDRUCKnachfolger(fktterm1)END IF;fktterm1:=AUSDRUCKfktterm1;bestimmegegebenenfallstransformationsparameter;WHILExendwertTHEN IFmindestenseindefinierterwertTHENxundef:=xdef+step;ydef:=verfeinerterwert(fktterm,xdef,xundef);zeichneasymptote(xundef);END IF;LEAVEzeichnefunktionmitasymptotenroutineEND IF ELSExdef:=x1;IFxdef>endwertTHEN LEAVEzeichnefunktionmitasymptotenroutineEND IF;LEAVEsuchschleifeEND IF END REP.verfeineregegebenenfalls:IF NOTwertdirektgefundenTHENxundef:=x1-step;y1:=verfeinerterwert(fktterm,x1,xundef);zeichneasymptote(xundef)END IF.zeichneerstenwert:mindestenseindefinierterwert:=TRUE;matmove(x1,y1);matdraw(x1,y1).suchezweitenwert:x2:=x1+step;replace(funktionsparameter,laufvariablenindex,x2);y2:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x1,x2);x1:=x2;LEAVEuntersuchedreiaufeinanderfolgendewerteELSExdef:=x2END IF.suchedrittenwert:x3:=x2+step;replace(funktionsparameter,laufvariablenindex,x3);y3:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x2,x3);x1:=x3;LEAVEuntersuchedreiaufeinanderfolgendewerteELSExdef:=x3END IF.untersuchediewerte:IFsign(y3-y2)<>sign(y2-y1)THENspezialroutineEND IF;befragetastatur;matdraw(x2,y2);IFx2>endwertTHEN LEAVEzeichnefunktionmitasymptotenroutineEND IF;x1:=x2;y1:=y2;x2:=x3;y2:=y3.spezialroutine:REAL VARx11:=x1,y11:=y1,x22:=x2,y22:=y2,x33:=x3,y33:=y3,xm,ym;INT VARcounter:=0;REPxm:=0.5*(x22+x33);replace(funktionsparameter,laufvariablenindex,xm);ym:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x22,xm);x1:=xm;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFcounter=20THENmatdraw(xm,ym);x1:=xm;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFidentischebildpunkteTHEN LEAVEspezialroutineELIFasymptotenbedingungTHENmatdraw(x22,y22);zeichneasymptote(xm);x1:=x33;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFsign(y22-y11)=sign(ym-y22)THENx11:=x22;y11:=y22;x22:=xm;y22:=ymELSEx33:=xm;y33:=ymEND IF;counterINCR1END REP.asymptotenbedingung:IFautomatischeskalierungTHENabs(y22)>4.0*deltayCANDabs(y33)>4.0*deltayELSEabs(y22)>1000000.0CANDabs(y33)>1000000.0END IF.identischebildpunkte:INT VARp1:=ypixel(y11),p2:=ypixel(y22),p3:=ypixel(ym),p4:=ypixel(y33);IFiserrorTHENclearerror;FALSE ELSEp1=p2CANDp2=p3CANDp3=p4END IF.befragetastatur:IF NOTunterbrechenerlaubtTHEN LEAVEbefragetastaturEND IF;TEXT VARtaste:=incharety;IFtaste=zeichnungabbrechenTHENvorzeitigerabbruch:=TRUE;LEAVEzeichnefunktionmitasymptotenroutineELIFtaste=zeichnunganhaltenTHENunterbrechezeichnungEND IF END PROCzeichnefunktionmitasymptotenroutine;PROCfehlerroutine(TERM CONSTfktterm,REAL CONSTx1,x2):REAL VARxdef,ydef,xundef;clearerror;xdef:=x1;xundef:=x2;ydef:=verfeinerterwert(fktterm,xdef,xundef);matdraw(xdef,ydef);zeichneasymptote(xundef)END PROCfehlerroutine;REAL PROCverfeinerterwert(TERM CONSTfktterm,REAL VARxdef,xundef):REAL VARxneu,yneu;INT VARcounter:=0;WHILEweiteresuchesinnvollREPxneu:=0.5*(xundef+xdef);replace(funktionsparameter,laufvariablenindex,xneu);yneu:=result(fktterm,funktionsparameter);IFiserrorTHENclearerror;xundef:=xneuELSExdef:=xneuEND IF;counterINCR1END REP;replace(funktionsparameter,laufvariablenindex,xdef);result(fktterm,funktionsparameter).weiteresuchesinnvoll:counter<40CANDxpixel(xdef)<>xpixel(xundef)END PROCverfeinerterwert;LETdoppelpunkt=":",gleichzeichen="=",graphname="Graph ",ueberschrift1=" Dargestellte Graphen ",ueberschrift2=" Dargestellter Graph ",linie="--------------------------";TEXT VARprotokollname:=niltext;FILE VARf;WINDOW VARfenster:=window(54,8,26,14);INT VARgraphzaehler:=1;PROCinitprotokoll:forget(protokollname,quiet);protokollname:=scratchdateiname;f:=sequentialfile(output,protokollname);graphzaehler:=1END PROCinitprotokoll;PROCprotokollierekurve(ABBILDUNG CONSTabb,VECTOR CONSTbetraege,INT CONSTvarindex):IFlines(f)>=4000THEN LEAVEprotokollierekurveEND IF;protokollierefktstring;protokolliereparameter;setzezaehlerweiter. +protokollierefktstring:output(f);IFgraphzaehler>=2THENputline(f,graphname+text(graphzaehler)+doppelpunkt)END IF;putline(f,funktionsstring(abb));IFgraphzaehler=2THENmodify(f);toline(f,1);insertrecord(f);writerecord(f,graphname+"1")END IF.protokolliereparameter:INT VARi;LISTE CONSTvarliste:=abbildungsvariablen(abb);output(f);FORiFROM1UPTOlaenge(varliste)REP IFi<>varindexTHENputline(f,text(NAMEauswahl(varliste,i),8)+gleichzeichen+compress(wandle(betraegeSUBi)))END IF END REP.setzezaehlerweiter:line(f);graphzaehlerINCR1END PROCprotokollierekurve;PROCergaenzetransformationen:INT VARi;ROW2TEXT CONSTkennung:=ROW2TEXT:("x","y");output(f);FORiFROM1UPTO2REP IFtransformiert(i)THENputline(f,kennung(i)+"-Transformation");putline(f,reststring)END IF;END REP.reststring:TEXT VARt:=funktionsstring(transformation(i));subtext(t,1+pos(t,":"))END PROCergaenzetransformationen;PROCentfernetransformationen:INT VARi,j;modify(f);FORiFROM1UPTO2REP IFtransformiert(i)THEN FORjFROM1UPTO2REPtoline(f,lines(f));deleterecord(f)END REP END IF END REP END PROCentfernetransformationen;PROCgibprotokollaus(TEXT CONSTfussnote,zeichen,TEXT VARausstieg):LETverfuegbarezeilenanzahl=14;INT VARspalte:=1,zeile:=1,letzteausgegebenezeile:=6,i;schreibeprotokollueberschrift;ergaenzetransformationen;IFlines(f)>verfuegbarezeilenanzahlTHENzeile:=lines(f)-verfuegbarezeilenanzahl+1END IF;zeichnefusszeile(fussnote);REPscroll(fenster,protokollname,1,1,1,zeile,spalte,zeichen,ausstieg);IFausstieg=druckenTHENdruckeprotokollEND IF UNTILausstieg<>druckenEND REP;letzteausgegebenezeileINCRleerzeilen;IFletzteausgegebenezeile>22THENletzteausgegebenezeile:=22END IF;entfernetransformationen;loeschegegebenenfallsbildschirmausgabe.schreibeprotokollueberschrift:cursor(54,6);out(ausgewaehlteueberschrift);cursor(54,7);out(linie).ausgewaehlteueberschrift:IFgraphzaehler=2THENueberschrift2ELSEueberschrift1END IF.leerzeilen:2+lines(f)-zeile.loeschegegebenenfallsbildschirmausgabe:IFpos(graphicausschalten,ausstieg)=0THEN FORiFROMletzteausgegebenezeileDOWNTO6REPcursor(54,i);out(kurzeleerzeile+blank)END REP END IF END PROCgibprotokollaus;PROCdruckeprotokoll:disablestop;IFprotokollname<>niltextTHENergaenzetransformationen;print(protokollname);entfernetransformationen;IF NOTiserrorTHEN LEAVEdruckeprotokollEND IF;behandlefehlerEND IF;out(bell)END PROCdruckeprotokoll;PROCloescheprotokoll:forget(protokollname,quiet);protokollname:=niltextEND PROCloescheprotokoll;REAL PROCkoordinatensystemxmin:xminEND PROCkoordinatensystemxmin;REAL PROCkoordinatensystemxmax:xmaxEND PROCkoordinatensystemxmax;REAL PROCkoordinatensystemymin:yminEND PROCkoordinatensystemymin;REAL PROCkoordinatensystemymax:ymaxEND PROCkoordinatensystemymax;BOOL PROCautomatischerskalierungsmodus:automatischeskalierungEND PROCautomatischerskalierungsmodus;PROCzeichneasymptote(REAL CONSTx):IFasymptotensichtbarTHEN REAL CONSTschritt:=deltay/20.0;REAL VARlauf:=ymax;WHILElauf>=yminREPmatmove(x,lauf);matdraw(x,lauf-0.5*schritt);lauf:=lauf-schrittEND REP END IF END PROCzeichneasymptote;PROCdefinitionsmenu(BOOL CONSTspezialverfahren,TEXT VARausstieg):INT VARi,eingabezeile:=16;koordinatensystem:=nilpicture;koordinatensysteminitialisiert:=FALSE;bauemenuauf;verarbeiteeingaben;IFausstieg=weiterarbeitTHENloeschemenuEND IF.bauemenuauf:INT VARausgabezeile:=erstemenuzeile;gesamtfenstereinstellen;FORiFROM1UPTOanzahldefinitionspunkteREPcursor(erstemenuspalte,ausgabezeile);IFzulaessigermenupunktTHENout(defpunkt(i));ausgabezeileINCR1END IF END REP;IFebene=1CORspezialverfahrenTHENeingabezeileDECR2END IF.zulaessigermenupunkt:IFi=4CORi=5THENebene=2CAND NOTspezialverfahrenELSE TRUE END IF.verarbeiteeingaben:TEXT VARch;BOOL VARfusszeileschreiben:=TRUE;REPclearbuffer;IFfusszeileschreibenTHENzeichnefusszeile(anwendungstext(100))END IF;fusszeileschreiben:=TRUE;inchar(ch);IFch=achsenbereichzeichenTHENlegedarstellungsbereichfestELIFch=achsenbezeichnungszeichenTHENlegeachsenbezeichnungfestELIFch=rasterzeichenTHENlegerasterungfestELIFch=linienmoduszeichenTHENlegelinienmodusfestELIFch +=punktanzahlzeichenTHENlegepunktanzahlfestELIF NOTspezialverfahrenCANDch=xtransformationszeichenCANDebene=2THENlegextransformationfestELIF NOTspezialverfahrenCANDch=ytransformationszeichenCANDebene=2THENlegeytransformationfestELIFch=escapezeichenTHENinchar(ausstieg)ELSEfusszeileschreiben:=FALSE END IF UNTILpos(standardoptionen,ausstieg)<>0END REP.legedarstellungsbereichfest:REAL VARx1:=xmin,x2:=xmax,y1:=ymin,y2:=ymax;automatischeskalierung:=graphyes(anwendungstext(103),eingabezeile);IF NOTautomatischeskalierungTHEN IFspezialverfahrenCORparameterdarstellungCORtransformiert(1)THENliesxminimumein;liesxmaximumein;xmin:=x1;xmax:=x2;IFspezialverfahrenTHENanfangswert:=xmin;endwert:=xmaxEND IF END IF;liesyminimumein;liesymaximumein;ymin:=y1;ymax:=y2;ursprungobligatorisch:=FALSE ELSEursprungobligatorisch:=graphyes(anwendungstext(109),eingabezeile)END IF.liesxminimumein:REPliespunktein(anwendungstext(104),anwendungstext(186),x1,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILx1>=-maximalerachsenbetragEND REP.liesxmaximumein:REPliespunktein(anwendungstext(105),niltext,x2,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILx2>x1CANDx2<=maximalerachsenbetragEND REP.liesyminimumein:REPliespunktein(anwendungstext(107),anwendungstext(186),y1,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILy1>=-maximalerachsenbetragEND REP.liesymaximumein:REPliespunktein(anwendungstext(108),niltext,y2,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILy2>y1CANDy2<=maximalerachsenbetragEND REP.legeachsenbezeichnungfest:liesxbezeichnungein;liesybezeichnungein.liesxbezeichnungein:cursor(erstemenuspalte,eingabezeile);out(anwendungstext(110));grapheditget(xachsenbezeichnung,punkteingabelaenge,standardoptionen,ausstieg);IFausstieg<>niltextTHENradiere(eingabezeile);LEAVElegeachsenbezeichnungfestEND IF.liesybezeichnungein:cursor(erstemenuspalte,eingabezeile);out(anwendungstext(111));grapheditget(yachsenbezeichnung,punkteingabelaenge,standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHEN LEAVElegeachsenbezeichnungfestEND IF.legerasterungfest:graphgerastert:=graphyes(anwendungstext(112),eingabezeile).legelinienmodusfest:linienmodus:=graphyes(anwendungstext(113),eingabezeile).legepunktanzahlfest:TEXT VAReingabe;INT VARwert;cursor(erstemenuspalte,eingabezeile);out(anwendungstext(129));zeichnefusszeile(anwendungstext(186));REPcursor(68,eingabezeile);eingabe:=text(stuetzpunktanzahl);grapheditget(eingabe,punkteingabelaenge,standardoptionen,ausstieg);IFausstieg<>niltextTHENradiere(eingabezeile);LEAVElegepunktanzahlfestEND IF;wert:=int(eingabe);IFiserrorTHENbehandlefehlerELIFwert>=minimumstuetzpunkteTHENradiere(eingabezeile);stuetzpunktanzahl:=wert;LEAVElegepunktanzahlfestELSEbehandlefehlerEND IF END REP.legextransformationfest:BOOL VARachsewartransformiert:=transformiert(1);loescheggftransformation(1);transformiert(1):=graphyes(anwendungstext(131),eingabezeile);IF NOTtransformiert(1)THEN LEAVElegextransformationfestEND IF;cursor(erstemenuspalte,eingabezeile);out("x-Transformation:");liestransformationsfunktionein(transformation(1),transformationsvorgabe(1),standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHENradiere(eingabezeile+1);transformiert(1):=FALSE END IF;IFtransformiert(1)CAND NOTachsewartransformiertCAND NOTautomatischeskalierungTHENliesextremafuerxachseeinEND IF.liesextremafuerxachseein:REAL VARxlow:=xmin,xhigh:=xmax;liesxminein;liesxmaxein;xmin:=xlow;xmax:=xhigh.liesxminein:REPliespunktein(anwendungstext(104),anwendungstext(186),xlow,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVEliesextremafuerxachseeinEND IF UNTILxlow>=-maximalerachsenbetragEND REP.liesxmaxein:REPliespunktein(anwendungstext(105),niltext,xhigh,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN + LEAVEliesextremafuerxachseeinEND IF UNTILxhigh>xlowCANDxhigh<=maximalerachsenbetragEND REP.legeytransformationfest:loescheggftransformation(2);transformiert(2):=graphyes(anwendungstext(143),eingabezeile);IF NOTtransformiert(2)THEN LEAVElegeytransformationfestEND IF;cursor(erstemenuspalte,eingabezeile);out("y-Transformation:");liestransformationsfunktionein(transformation(2),transformationsvorgabe(2),standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHENradiere(eingabezeile+1);transformiert(2):=FALSE END IF.loeschemenu:INT VARende:=anzahldefinitionspunkte;IFebene=1THENendeDECR2END IF;radiere(erstemenuzeile,erstemenuzeile+ende-1)END PROCdefinitionsmenu;PROCliestransformationsfunktionein(ABBILDUNG VARtransfunktion,TEXT VARvorgabetext,TEXT CONSTerlaubteausstiegszeichen,TEXT VARausstieg):initialisiereeingaben;liesformelein.initialisiereeingaben:TEXT CONSTfname:=scratchfunctionname;TEXT VAReingabe:=vorgabetext;ausstieg:=niltext.liesformelein:LETeingabezeile=16;INT VARcursorx,cursory;zeichnefusszeile(anwendungstext(186));cursor(erstemenuspalte,eingabezeile+1);out("x,y -> ");getcursor(cursorx,cursory);REPcursor(cursorx,cursory);grapheditget(eingabe,15,erlaubteausstiegszeichen,ausstieg);IFausstieg<>niltextCANDpos(erlaubteausstiegszeichen,ausstieg)<>0THEN LEAVEliestransformationsfunktioneinEND IF;bildefunktionsstring;bewertefunktionsstringEND REP.bildefunktionsstring:TEXT VARsym,formel;BOOL VARxvorhanden:=FALSE,yvorhanden:=FALSE;scan(eingabe);nextsymbol(sym);WHILEsym<>niltextREPxvorhanden:=xvorhandenCORsym=xsymbol;yvorhanden:=yvorhandenCORsym=ysymbol;nextsymbol(sym)END REP;formel:=fname;IFxvorhandenCAND NOTyvorhandenTHENformelCAT":x->"ELSEformelCAT":x,y->"END IF;formelCATeingabe.bewertefunktionsstring:transfunktion:=neuefunktion(formel);IFiserrorTHENbehandlefehler;eingabe:=vorgabetextELSEtransfunktion:=aufloesung(transfunktion);loeschebenannteabbildung(fname);vorgabetext:=eingabe;radiere(cursory);LEAVEliesformeleinEND IF END PROCliestransformationsfunktionein;PROCbehandlefehler:clearerror;out(bell)END PROCbehandlefehler;PROCradiere(INT CONSTzeile):cursor(erstemenuspalte,zeile);out(kurzeleerzeile)END PROCradiere;PROCradiere(INT CONSTvon,bis):INT VARi;FORiFROMbisDOWNTOvonREPradiere(i)END REP END PROCradiere;BOOL PROCgraphyes(TEXT CONSTfrage,INT CONSTzeile):LETerlaubt="JYjyNn";INT VARi;cursor(erstemenuspalte,zeile);out(frage+" (j/n)?");zeichnefusszeile(anwendungstext(141));clearbuffer;REPi:=pos(erlaubt,incharety);UNTILi<>0END REP;radiere(zeile);i<5END PROCgraphyes;PROCliespunktein(TEXT CONSTcommando,fussnotiz,REAL VARxp,TEXT CONSTescausstieg,TEXT VARexit,INT CONSTzeile):TEXT VARt:=compress(wandle(xp))+kurzerstrich;initialisiereeingabe;gibein;loescheeingabefeld.initialisiereeingabe:gesamtfenstereinstellen;IFfussnotiz<>niltextTHENzeichnefusszeile(fussnotiz)END IF;cursor(erstemenuspalte,zeile);out(commando).gibein:REPgrapheditget(t,punkteingabelaenge,escausstieg,exit);IFexit<>niltextTHEN LEAVEgibeinEND IF;changeall(t,unterstrich,niltext);xp:=realzahl(t);IF NOTiserrorTHEN LEAVEgibeinEND IF;behandlefehler;tCATkurzerstrich;cursor(erstemenuspalte+length(commando),zeile)END REP.loescheeingabefeld:radiere(zeile)END PROCliespunktein;PROCsetzewertezurueck:ueberlagern:=FALSE;asymptotensichtbar:=TRUE;initkoordinatensystemEND PROCsetzewertezurueck;PROCunterbrechezeichnung:INT VARxkoord,ykoord;where(xkoord,ykoord);zeichnefusszeile(anwendungstext(77));clearbuffer;pause;zeichnefusszeile(anwendungstext(144));pen(1,1,1,aktuellerstift);move(xkoord,ykoord);graphfenstereinstellenEND PROCunterbrechezeichnung;REAL PROCxweltkoordinate(INT CONSTxpic):xmin+(xmax-xmin)*real(xpic-imin)/real(imax-imin)END PROCxweltkoordinate;REAL PROCyweltkoordinate(INT CONSTypic):ymin+(ymax-ymin)*real(ypic-jmin)/real(jmax-jmin)END PROCyweltkoordinate;PROCdruckegraph:vervollstaendigeaktuellezeichnung(xmin,xmax,ymin,ymax,graphbreite-2.0*graphrand,graphmaximum-graphminimum-2.0*graphrand);druckeaktuellezeichnungEND PROCdruckegraph;PROCzeichnetexte:zeichnefusszeile( +anwendungstext(210));cursor(54,10);out(anwendungstext(247));cursor(54,12);out(anwendungstext(248));cursor(54,15);out(anwendungstext(249));cursor(54,18);out(anwendungstext(250));cursor(54,19);out(anwendungstext(251));cursor(54,20);out(anwendungstext(252))END PROCzeichnetexte;PROCloeschetexte:cursor(54,20);out(loeschzeile);cursor(54,19);out(loeschzeile);cursor(54,18);out(loeschzeile);cursor(54,16);out(loeschzeile);cursor(54,15);out(loeschzeile);cursor(54,13);out(loeschzeile);cursor(54,12);out(loeschzeile);cursor(54,10);out(loeschzeile);END PROCloeschetexte;END PACKETgraphicverfahren; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hercules plot b/app/schulis-mathematiksystem/1.0/src/mat.hercules plot new file mode 100644 index 0000000..e4607b3 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.hercules plot @@ -0,0 +1,3 @@ +PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETsimselherculesplotDEFINESbeginplot,endplot,clear,move,draw,stdhoehe,stdbreite,pen,plotend,zeichensatz,cursor,getcursor,out,terminalkorrekt,anpassungstyp,drawingarea,where,zeichenhoehe,zeichenbreite,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=30.6383,vertfaktor=19.33333,bit14=16384,anzahlx=720,anzahly=348;INT VARxalt,yalt;ROW5INT VARzaehler:=ROW5INT:(0,0,0,0,0),i:=zaehler;INT VARlinientyp:=0,foreground:=0,background:=0;INT VARdummy;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=23.5;ycm:=18.0;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:0.72END PROCstdhoehe;REAL PROCstdbreite:0.29375END PROCstdbreite;PROCbeginplot:xalt:=0;yalt:=0;graphicon:=TRUE END PROCbeginplot;PROCendplot:END PROCendplot;PROCclear:control(-5,512,0,dummy);pen(0,1,0,1);move(0,0)END PROCclear;PROCplotend:control(-5,2,0,dummy);graphicon:=FALSE END PROCplotend;PROCpen(INT CONSTb,f,t,l):IF NOT(f=0)THENforeground:=1ELSEforeground:=0;FI;linientyp:=l;SELECTfOF CASE0:loeschstift;CASE1:sichtbarelinien;ENDSELECT.loeschstift:control(-9,0,0,dummy);control(-10,0,0,dummy).sichtbarelinien:SELECTlOF CASE0:CASE1:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy)CASE2:control(-9,257,257,dummy);control(-10,257,257,dummy)CASE3:control(-9,17,17,dummy);control(-10,17,17,dummy)CASE4:control(-9,0,4369,dummy);control(-10,0,4369,dummy)CASE5:control(-9,256,4369,dummy);control(-10,256,4369,dummy)OTHERWISE:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy)ENDSELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEyEND PROCmove;PROCdraw(INT CONSTx,y):xDRAWyEND PROCdraw;ZEICHENSATZ VARzeichen;INT VARxfak,yfak;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichenELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=xalt,ypos:=yalt,x0:=xalt,y0:=yalt,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;x0MOVEy0.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+yELSExpos+xDRAWypos+yFI PER;xposINCRxstep;yposINCRystepEND PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):control(-7,x,347-y,dummy);xalt:=x;yalt:=yEND OP MOVE;OP DRAW(INT CONSTx,y):IFlinientyp>0THENcontrol(-11,foreground,zaehler(linientyp),i(linientyp));control(-6,xalt,347-yalt,dummy);control(-6,x,347-y,dummy);control(-11,foreground,zaehler(linientyp),i(linientyp));zaehler(linientyp):=((i(linientyp)-2)MOD16);FI;xalt:=x;yalt:=y;END OP DRAW;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE; +PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an ");putline("Bildschirmen mit HERCULES-Karte arbeiten.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"hercules"END PROCanpassungstyp;PROCwhere(INT VARx,y):x:=xalt;y:=yaltEND PROCwhere;INT PROCzeichenbreite:9END PROCzeichenbreite;INT PROCzeichenhoehe:14END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETsimselherculesplot;zeichensatz("ZEICHEN 9*14") + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot b/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot new file mode 100644 index 0000000..d197007 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot @@ -0,0 +1,3 @@ +PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=37.0,ycm=27.7,papierx1=1200,papierx2=16000,papiery1=320,papiery2=11400,plotterunitspercm=100.0;TEXT CONSTschlange:=code(126),terminator:=code(125);INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);BOUND TEXT VARpicture;INT VARterminalchannel,plotterchannel:=5;LET POS=STRUCT(INTx,y);POS VARposition:=POS:(0,0);REAL VARbuchstabenhoehe:=1.108,buchstabenbreite:=0.4625;INT VARvelocity:=10;LETbackspace="�",alt="",stand="",pktklein="}",pktgross="{";PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):IFx>0ANDx<37THENvelocity:=xFI END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:TEXT VARhp:="";move(0,0);sendepicture;hpCAT("v"+sbn(0));hpCAT"�"+".)";toplotterchannel;out(hp);toterminalchannel;ENDPROCplotend;PROCclear:terminalchannel:=channel;forget("picture ds",quiet);picture:=new("picture ds");picture:="";TEXT VARhp;hp:="�.(";hpout(hp);hp:="�.M:";hpout(hp);hp:="�.I1000;17;13:";hpout(hp);hp:=schlange;hpCAT"W";hpCATplotput(papierx1,papiery1);hpCATplotput(papierx2,papiery2);hpCATterminator;hpout(hp);hp:=schlange;hpCAT"S";hpCATplotput(xunits,yunits);hpCATterminator;hpout(hp);hpout("vA");hpout(schlange+"Q");hpout(schlange+"V"+sbn(velocity)+terminator);hpout(schlange+"P"+plotput(0,3));END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linetypesenden;verifypen;switchtopen;.verifypen:INT VARpen;pen:=max(0,foreground);pen:=min(4,pen).switchtopen:TEXT VARhp;hp:=("v"+sbn(pen));hpout(hp).linetypesenden:hp:=schlange+"Q";hpCATlinetypecode;hpout(hp).linetypecode:TEXT VARtt;tt:="";IFlinetype=0THENtt:=terminator;ELIFlinetype=1THENtt:=terminator;ELIFlinetype=2THENtt:=sbn(32+0)+sbn(1)+mbn(15)+terminator;ELIFlinetype=3THENtt:=sbn(32+1)+sbn(2)+mbn(15)+terminator;ELIFlinetype=4THENtt:=sbn(32+1)+sbn(2)+mbn(30)+terminator;ELIFlinetype=5THENtt:=sbn(32+1)+sbn(2)+sbn(32+2)+sbn(2)+mbn(28)+terminator;ELSEtt:=terminatorFI;ttEND PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:="";hpCAT"p";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:="";hpCAT"q";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp;INT VARspace:=int(width*plotterunitspercm),size:=int(height*plotterunitspercm*1.5);hp:=schlange+"%";hpCATplotput(space,size);hpout(hp);hp:=schlange+"'";ersetzeumlaute;hpCATumgesetztertext;hpCATcode(3);hpout(hp);move(position.x,position.y).ersetzeumlaute:TEXT VARumgesetztertext:="";INT VARi;FORiFROM1UPTO LENGTHrecordREPbildeneuentextPER.bildeneuentext:IF(pos("äöüÄÖÜß",(recordSUBi)))=0THENumgesetztertextCAT(recordSUBi)ELSEumgesetztertextCATersetzterumlautFI.ersetzterumlaut:IF"ä"=(recordSUBi)THENalt+"a"+pktklein+standELIF"ö"=(recordSUBi)THENalt+"o"+pktklein+standELIF"ü"=(recordSUBi)THENalt+"u"+pktklein+standELIF"Ä"=(recordSUBi)THENalt+"A"+pktgross+standELIF"Ö"=(recordSUBi)THENalt+"O"+pktgross+standELIF"Ü"=(recordSUBi)THENalt+"U"+pktgross+standELIF"ß"=(recordSUBi)THEN"P"+backspace+"p"ELSE""FI.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;TEXT PROCplotput(INT CONSTnx,ny):INT VARn,nx1,nx2,nx3,ny2,ny3,ny4,ny5,nxr,nyr;TEXT VARmbpformat;INT VARnp1,np2,np3,np4,np5;n:=nx;IF NOT(nx>ny)THENn:=ny;FI;IFn<256THEN IFn>31 +THENthreebyteformatELIFn>3THENtwobyteformatELSEonebyteformatFI;ELSE IFn<2048THENfourbyteformatELIFn<16384THENfivebyteformatELSEerrorstop("out of range: "+text(n));FI;FI;mbpformat.onebyteformat:np1:=ny+96+4*nx;mbpformat:=code(np1);.twobyteformat:nx1:=nxDIV2;nx2:=nx-2*nx1;np1:=nx1+96;np2:=ny+32*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;mbpformat:=code(np1)+code(np2);.threebyteformat:nx1:=nxDIV16;nx2:=nx-16*nx1;ny2:=nyDIV64;ny3:=ny-64*ny2;np1:=nx1+96;np2:=ny2+4*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3;IF NOT(np3>31)THENnp3:=np3+64;FI;mbpformat:=code(np1)+code(np2)+code(np3);.fourbyteformat:nx1:=nxDIV128;nxr:=nx-128*nx1;nx2:=nxrDIV2;nx3:=nxr-2*nx2;ny3:=nyDIV64;ny4:=ny-64*ny3;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+32*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4);.fivebyteformat:nx1:=nxDIV1024;nxr:=nx-1024*nx1;nx2:=nxrDIV16;nx3:=nxr-16*nx2;ny3:=nyDIV4096;nyr:=ny-4096*ny3;ny4:=nyrDIV64;ny5:=nyr-64*ny4;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+4*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;np5:=ny5;IF NOT(np5>31)THENnp5:=np5+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4)+code(np5);.END PROCplotput;TEXT PROCmbn(INT CONSTnn):TEXT VARmbnformat;INT VARnp1,np2,np3,nn1,nn2,nn3,nr;IFnn<16THENonebyteformatELIFnn<1024THENtwobyteformatELIFnn<=32767THENthreebyteformatELSEerrorstop("out of range: "+text(nn));FI;mbnformat.onebyteformat:np1:=nn+96;mbnformat:=code(np1).twobyteformat:nn1:=nnDIV64;nn2:=nn-64*nn1;assemble2;mbnformat:=code(np1)+code(np2);.threebyteformat:nn1:=nnDIV4096;nr:=nn-nn1*4096;nn2:=nrDIV64;nn3:=nr-64*nn2;assemble1;assemble2;mbnformat:=code(np1)+code(np2)+code(np3);.assemble1:np3:=nn3;IF NOT(np3>31)THENnp3:=np3+64;FI;.assemble2:np2:=nn2;IF NOT(np2>31)THENnp2:=np2+64;FI;np1:=nn1+96;.END PROCmbn;TEXT PROCsbn(INT CONSTnn):INT VARnp;np:=nn;IF NOT(np>31)THENnp:=np+64;FI;code(np).END PROCsbn;PROChpout(TEXT CONSTplotcommand):pictureCATplotcommand;IFlength(picture)>800THENsendepictureFI END PROChpout;PROCsendepicture:getlen;toplotterchannel;out(text(picture,len));picture:="";getacknowledge.getlen:INT VARlen:=min(1000,length(picture)).getacknowledge:clearinputbuffer;out("�");readhandshakechar.clearinputbuffer:WHILEincharety<>""REP PER.readhandshakechar:TEXT VARchar:="";INT VARsession;WHILEchar<>" "REPinchar(char)PER;toterminalchannel.END PROCsendepicture;PROCtoplotterchannel:continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKEThpplot;plotterkanal(7) + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot b/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot new file mode 100644 index 0000000..137f6c6 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot @@ -0,0 +1,3 @@ +PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=40.19,ycm=27.46,plotterunitspercm=402.0,buffersize=1024;LETinitcmd="IN",textcmd="LB",separator=",",terminator=";",outputterminator=" ",movecmd="PU",drawcmd="PD",pencmd="SP",charsizecmd="SI",linetypecmd="LT",plotabscmd="PA",askbuffersize="�.B",stdcharpre="�CS33;LB",stdcharpost="�SS;LB",etx="�";ROW22TEXT CONSTnichtasciizeichen:=ROW22TEXT:(stdcharpre+"["+stdcharpost,stdcharpre+"\"+stdcharpost,stdcharpre+"]"+stdcharpost,stdcharpre+"{"+stdcharpost,stdcharpre+"|"+stdcharpost,stdcharpre+"}"+stdcharpost,"k","-","#"," ",stdcharpre+"~"+stdcharpost,"�UC3,0,99,0,16,-99,0,-8,99,-3,0;LB","�UC3,0,99,0,16;LB","�UC3,0,99,0,8,-4,0;LB","�UC0,8,99,3,0,0,8;LB","�UC3,16,99,0,-8,3,0;LB","�UC3,0,99,0,8,3,0;LB","�UC0,8,99,6,0,-99,-3,0,99,0,8;LB","�UC0,8,99,6,0,-99,-3,0,99,0,-8;LB","�UC3,0,99,0,16,-99,0,-8,99,3,0;LB","�UC0,8,99,6,0;LB","�UC0,8,99,6,0,-99,-3,-8,99,0,16;LB");INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=5;INT VARfreebytes;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoehe;END PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breite;END PROCstdbreite;PROCbeginplot:freebytes:=9;toplotterchannel;clear;TEXT VARhp:=pencmd;hpCAT"1";hpCATterminator;sendtoplotter(hp)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:clear;TEXT VARhp:=pencmd;hpCAT"0";hpCATterminator;hpCATinitcmd;hpCATterminator;sendtoplotter(hp);toterminalchannelENDPROCplotend;PROCclear:TEXT VARhp:=initcmd;hpCATterminator;hpCATplotabscmd;hpCATterminator;sendtoplotter(hp);END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):TEXT VARhp:=pencmd;IFforeground>6ORforeground<1THENhpCAT"1"ELSEhpCATtext(foreground)END IF;hpCATterminator;hpCATlinetypecmd;IFlinetype>1ANDlinetype<6THENhpCATtext(linetype-1);hpCATseparator;hpCAT"0.75";END IF;hpCATterminator;sendtoplotter(hp)END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:=movecmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:=drawcmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp:=charsizecmd,konvertiertertext:="";konvertieretext;hpCATtext(width*0.66666667,8,4);hpCATseparator;hpCATtext(height*0.5,8,4);hpCATterminator;hpCATtextcmd;hpCATkonvertiertertext;hpCATetx;sendtoplotter(hp).konvertieretext:INT VARstelle;INT VARzeichen;FORstelleFROM1UPTO LENGTHrecordREPEATzeichen:=code(recordSUBstelle);IFzeichen=251THENkonvertiertertextCATnichtasciizeichen[11]ELIFzeichen>=185ANDzeichen<=188THENkonvertiertertextCATnichtasciizeichen[zeichen-173]ELIFzeichen>=200ANDzeichen<=206THENkonvertiertertextCATnichtasciizeichen[zeichen-184]ELIFzeichen>=214ANDzeichen<=223THENkonvertiertertextCATnichtasciizeichen[zeichen-213]ELSEkonvertiertertextCATcode(zeichen)END IF END REPEAT END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;PROCsendtoplotter(TEXT CONSTstring):INT VARlaenge;laenge:= +LENGTHstring;IFfreebytesbuffersizeDIV2ANDfreebytes-9>=laengePER.checkforerror:out("OE;");TEXT VARc,t;inchar(c);inchar(t);IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)FI;out("�.E");inchar(c);inchar(t);IFt<>outputterminatorTHENcCATt;inchar(t);END IF;IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)END IF;freebytesDECR6END PROCsendtoplotter;END PACKEThpplot;plotterkanal(7) + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren b/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren new file mode 100644 index 0000000..a8ae08d --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren @@ -0,0 +1,7 @@ +PACKETintegrationsverfahrenDEFINESberechneintegral:LETweiter="w",naechste="q",menue="m",graphdefinieren="e",protokoll="p",escdrucken="d",drucken="D",info="?",abbruch="!",blank=" ",del="�",bell="�",esc="�",folgenvariable="n",folgentext=" a(n)",defaultfolge="n",varstellen=8,zahlstellen=12,maxiter=4048,rowlaenge=4049,rombergmaxspalten=13,anzahlnumerischeverfahren=4,anzahlverfahreninsgesamt=6,maxueberschriftlaenge=17,maxfehlermeldunglaenge=46,rechteckverfahren=1,trapezverfahren=2,simpsonverfahren=3,rombergverfahren=4;ROW4TEXT CONSTfehlermeldung:=ROW4TEXT:(anwendungstext(51),anwendungstext(52),"-","-");ROWanzahlnumerischeverfahrenTEXT CONSTueberschrift:=ROWanzahlnumerischeverfahrenTEXT:(anwendungstext(220),anwendungstext(221),anwendungstext(222),anwendungstext(223));ROW2TEXT CONSTunterstrich:=ROW2TEXT:("-----------------","---------------");ROWanzahlverfahreninsgesamtTEXT CONSTverfahrensname:=ROWanzahlverfahreninsgesamtTEXT:(anwendungstext(235),anwendungstext(236),anwendungstext(237),anwendungstext(238),anwendungstext(239),anwendungstext(240));ROW3TEXT CONSTrechteckstuetztext:=ROW3TEXT:(anwendungstext(89),anwendungstext(90),anwendungstext(91));ROWrombergmaxspaltenROWrombergmaxspaltenREAL VARmatrix;THESAURUS VARverfuegbareverfahren;INT VARzaehler,spaltenbreite,nrofinitializedpoints:=0;TEXT VARintegrationsfehler:="",tabellenname;BOUND ROWrowlaengeREAL VARstuetzpunkte;DATASPACE VARds;BOOL VARfirsttime:=TRUE;REAL VARschrittweite;TEXT CONSTloeschzeile:=23*" ";verfuegbareverfahren:=emptythesaurus;FORzaehlerFROM1UPTOanzahlverfahreninsgesamtREPinsert(verfuegbareverfahren,verfahrensname[zaehler])PER PROCinitstuetzpunkte(ABBILDUNG CONSTabb,REAL CONSTuntergrenze,obergrenze,INT CONSTanzahlstuetzpunkte,varnr,VECTOR CONSTparameter,BOOL VARfehler):INT VARi;TERM CONSTt:=AUSDRUCKlistenanfang(abbildungsterme(abb));schrittweite:=(obergrenze-untergrenze)/real(anzahlstuetzpunkte-1);VECTOR VARvec:=parameter;nrofinitializedpoints:=0;forget(ds);ds:=nilspace;stuetzpunkte:=ds;FORiFROM1UPTOanzahlstuetzpunkteREPreplace(vec,varnr,untergrenze+real(i-1)*schrittweite);stuetzpunkte[i]:=result(t,vec);IFiserrorTHENclearerror;fehler:=TRUE;integrationsfehler:=fehlermeldung[1];LEAVEinitstuetzpunkteEND IF END REP;nrofinitializedpoints:=anzahlstuetzpunkteEND PROCinitstuetzpunkte;BOOL PROCispoweroftwo(INT VARi):INT VARdoppel:=1,log:=0;REPEAT IFdoppel=iTHENi:=log;LEAVEispoweroftwoWITH TRUE END IF;doppelINCRdoppel;logINCR1UNTILdoppel>iCORiserrorPER;clearerror;FALSE END PROCispoweroftwo;REAL PROCtrapezintegration:INT VARi;REAL VARsumme:=0.5*(stuetzpunkte[1]+stuetzpunkte[nrofinitializedpoints]);FORiFROM2UPTOnrofinitializedpoints-1REPsumme:=summe+stuetzpunkte[i]END REPEAT;summe*schrittweiteEND PROCtrapezintegration;LETlinks=1,mitte=2,rechts=3;INT VARrechteckstuetze:=links;REAL PROCrechtecksintegration:REAL VARsumme;INT VARi;IFrechteckstuetzenrofinitializedpoints-1PER;summe*schrittweite/3.0END PROCsimpsonintegration;REAL PROCrombergintegration:INT VARintervallgroesse,anzahlschachtelungen,i,j;REAL VARnenner:=4.0;berechneanzahlderschachtelungen;berechneintegrale;erzeugerombergschema;ergebnis.berechneanzahlderschachtelungen:anzahlschachtelungen:=nrofinitializedpoints-1;IF NOTispoweroftwo(anzahlschachtelungen)THENintegrationsfehler:=fehlermeldung[3];LEAVErombergintegrationWITH0.0END IF.berechneintegrale:intervallgroesse:=1;FORiFROManzahlschachtelungenDOWNTO0REPmatrix[1][i+1]:=trapezintegralspezial;intervallgroesseINCRintervallgroesseEND REP. +trapezintegralspezial:REAL VARsumme:=(stuetzpunkte[1]+stuetzpunkte[nrofinitializedpoints])/2.0;j:=1+intervallgroesse;WHILEj1THENspaltenbreite:=max(spaltenbreite,varstellen+zahlstellen+2)END IF;ELSEspaltenbreite:=gesamtstellen(ebene)+1END IF.schreibetabellenkopf:TEXT VARkopfzeile,trennlinie;IFlength(parameter)<=10THENtrageparametereinEND IF;IFmatrixzeigenTHENkopfzeile:=ueberschrift[rombergverfahren]+" "+folgenvariable+" = "+text(untergrenzefolge)+" "+folgentext+" = "+text(ntesfolgenglied);trennlinie:=(schachtelungen+1)*spaltenbreite*waagerecht;maxlinelength(f,max(LENGTHtrennlinie+1,maxfehlermeldunglaenge+16))ELSEkopfzeile:=" "+folgenvariable+" "+senkrecht;kopfzeileCATfolgentext;trennlinie:=5*waagerecht+kreuz+5*waagerecht;FORiFROM1UPTOanzahlnumerischeverfahrenREP IFreihenfolge[i]<>0THENkopfzeileCATsenkrecht+center(spaltenbreite,ueberschrift[reihenfolge[i]]);trennlinieCATkreuz+spaltenbreite*waagerechtEND IF PER;maxlinelength(f,max(LENGTHtrennlinie+1,maxfehlermeldunglaenge+16))END IF;write(f,kopfzeile);line(f);write(f,trennlinie);line(f).trageparameterein:FORiFROM1UPTO LENGTHparameterREP IFi<>varnrTHENwrite(f,text(NAMEauswahl(abbildungsvariablen(funktion),i),varstellen)+"="+(12-varstellen)*blank+wandle(parameterSUBi));line(f)END IF END REPEAT.berechnewerteundschreibeindatei:cursor(36,24);FORiFROMuntergrenzefolgeUPTOobergrenzefolgeREPcout(i);ermittlefolgenglied;IF NOTfehlerTHENinitstuetzpunkte(funktion,untergrenzefkt,obergrenzefkt,ntesfolgenglied+1,varnr,parameter,fehler);IFincharety=abbruchTHEN LEAVEberechnewerteundschreibeindateiELIFfehlerTHENschreibefehlermeldungindatei;LEAVEberechnewerteundschreibeindateiEND IF ELSEschreibefehlermeldungindatei;LEAVEberechnewerteundschreibeindateiEND IF;ermittlenaeherungenEND REP.ermittlefolgenglied:replace(folgenvector,1,real(i));ntesfolgenglied:=int(result(folgenterm,folgenvector));IFiserrorORntesfolgenglied<=0ORntesfolgenglied>maxiterTHENclearerror;fehler:=TRUE;integrationsfehler:=fehlermeldung[2]ELSEfehler:=FALSE END IF.ermittlenaeherungen:FORjFROM1UPTOanzahlnumerischeverfahrenREPnaeherungen[j]:=itesangekreuztesverfahrenPER;IFmatrixzeigenTHENschreiberombergmatrixELSEschreibeergebnisseindateiEND IF.itesangekreuztesverfahren:SELECTreihenfolge[j]OF CASErechteckverfahren:sonderbehandlungrechteckverfahrenCASEtrapezverfahren:berechneundueberpruefefehler(REAL PROCtrapezintegration)CASEsimpsonverfahren:berechneundueberpruefefehler(REAL PROCsimpsonintegration)CASErombergverfahren:berechneundueberpruefefehler(REAL PROC +rombergintegration)OTHERWISE""END SELECT.sonderbehandlungrechteckverfahren:IFrechteckstuetze<>mitteTHENberechneundueberpruefefehler(REAL PROCrechtecksintegration)ELSE DATASPACE VARstdstuetzpunkte:=ds;REAL VARhalbesintervall:=(obergrenzefkt-untergrenzefkt)/real(ntesfolgenglied)/2.0;TEXT VARzwischenergebnis;initstuetzpunkte(funktion,untergrenzefkt+halbesintervall,obergrenzefkt+halbesintervall,ntesfolgenglied+1,varnr,parameter,fehler);IFincharety=abbruchTHEN LEAVEermittlenaeherungenEND IF;IFfehlerTHENintegrationsfehlerELSEzwischenergebnis:=berechneundueberpruefefehler(REAL PROCrechtecksintegration);forget(ds);ds:=stdstuetzpunkte;forget(stdstuetzpunkte);zwischenergebnisEND IF END IF.schreibefehlermeldungindatei:put(f,text(i,4)+blank+senkrecht+text(ntesfolgenglied,4));write(f,senkrecht+blank+integrationsfehler);line(f);fehler:=FALSE.schreibeergebnisseindatei:put(f,text(i,4)+blank+senkrecht+text(ntesfolgenglied,4));FORjFROM1UPTOanzahlnumerischeverfahrenREP IFreihenfolge[j]<>0THENwrite(f,senkrecht+text(naeherungen[j],spaltenbreite))END IF PER;line(f).schreiberombergmatrix:INT VARzeile,spalte;FORzeileFROM1UPTOschachtelungen+1REP FORspalteFROM1UPTOzeileREPput(f,wandle(matrix[spalte][zeile+1-spalte]))PER;line(f)PER.setzekoordinaten:IFmatrixzeigenTHENerstespalte:=1ELSEerstespalte:=13;END IF;erstersatz:=2+LENGTHparameterEND PROCerzeugenaeherungsfolge;TEXT PROCberechneundueberpruefefehler(REAL PROCverfahren):REAL VARergebnis;TEXT VARzeile;integrationsfehler:="";ergebnis:=verfahren;IFintegrationsfehler=""THENzeile:=wandle(ergebnis)ELSEzeile:=center(spaltenbreite,integrationsfehler)END IF;zeileEND PROCberechneundueberpruefefehler;PROCberechneintegral(ABBILDUNG CONSTeingegebenefunktion):ABBILDUNG VARabb:=eingegebenefunktion,folge;VECTOR VARvec:=vector(laenge(abbildungsvariablen(abb)));TERM VARvarterm;TAG VARt:=formular(20);ROW100TEXT VARtexte;INT VARfeldnummer,varindex,lowerfolge,upperfolge,nrgraphverfahren,i,zeile,spalte;REAL VARlowerfkt,upperfkt;TEXT VARfolgenname,fehlermeldung;BOOL VARnumerisch;ROWanzahlnumerischeverfahrenINT VARreihenfolge;WINDOW VARw:=window(2,7,77,16);FORiFROM1UPTOlength(vec)REPreplace(vec,i,0.0)END REP;disablestop;setzedefaultgraph;firsttime:=TRUE;ueberpruefeeingangsfunktion;schreibearbeitsfunktion(eingegebenefunktion);setzedefaultwerteinmaske;REPfootnote(anwendungstext(115));bearbeiteeinefunktionUNTILausstiegszeichen=naechsteORausstiegszeichen=menueEND REPEAT;forget(ds);verfahrensende(ausstiegszeichen).ueberpruefeeingangsfunktion:IFlaenge(abbildungsterme(abb))<>1THENverfahrensende(naechste);gibmeldung(anwendungstext(155));LEAVEberechneintegralELIFkomplexefunktion(abb)THENabb:=aufloesung(abb)END IF.setzedefaultwerteinmaske:BOOL VARfeld2sperren:=ebene=1CORlaenge(abbildungsvariablen(abb))=1;INT VARersteseingabefeld;feldnummer:=2;IFfeld2sperrenTHENsetfieldinfos(t,2,TRUE,TRUE,FALSE);feldnummer:=3END IF;texte[2]:=NAMElistenanfang(abbildungsvariablen(abb));texte[3]:="0.0";texte[4]:="1.0";texte[5]:=defaultfolge;texte[6]:="1";texte[7]:="10";ersteseingabefeld:=feldnummer.bearbeiteeinefunktion:strich(6);show(t);REPergaenzeunterstriche;putget(t,texte,feldnummer,ausstiegszeichen);IFiserrorTHENgibmeldung(errormessage);clearerror;ausstiegszeichen:=naechsteEND IF UNTILpos(weiter+naechste+menue+info,ausstiegszeichen)>0END REPEAT;ueberpruefeverlasszeichen.ergaenzeunterstriche:FORiFROMersteseingabefeldUPTO7REPtexte[i]CAT((zahlstellen-length(texte[i]))*"_")PER.ueberpruefeverlasszeichen:IFausstiegszeichen=naechsteORausstiegszeichen=menueTHENverfahrensende(ausstiegszeichen);LEAVEberechneintegralELIFausstiegszeichen=infoTHEN IFfeld2sperrenTHENgibinfofensteraus(w,18)ELSEgibinfofensteraus(w,19)END IF ELSEueberpruefeargumente;lasseggfparametereingeben;lasseverfahrenauswaehlen;berechneundzeigeergebnis;loeschetemporaerevariablenEND IF.ueberpruefeargumente:FORiFROM2UPTO7REPchangeall(texte[i],"_","")PER;ueberpruefevariable;ueberpruefefunktionsgrenzen;ueberpruefefolge;ueberpruefefolgengrenzen.ueberpruefevariable:varterm:=listenposition( +abbildungsvariablen(abb),texte[2]);IFvarterm=nilTHENgibmeldung(anwendungstext(147)+compress(texte[2])+anwendungstext(148));feldnummer:=2;zurueckzumaskeELSEvarindex:=PLATZvartermEND IF.ueberpruefefunktionsgrenzen:lowerfkt:=realzahl(texte[3]);IFiserrorTHENclearerror;feldnummer:=3;gibmeldung(anwendungstext(149));zurueckzumaskeEND IF;upperfkt:=realzahl(texte[4]);IFiserrorTHENclearerror;feldnummer:=4;gibmeldung(anwendungstext(150));zurueckzumaskeEND IF;IFlowerfkt>upperfktTHENfeldnummer:=4;gibmeldung(anwendungstext(160));zurueckzumaskeEND IF.ueberpruefefolge:folgenname:=scratchfunctionname;folge:=neuefunktion(folgenname+":n->"+texte[5]);IFkomplexefunktion(folge)THEN ABBILDUNG VARzwischen:=folge;folge:=aufloesung(folge);loescheabbildung(zwischen)END IF;IFiserrorTHENclearerror;gibmeldung(errormessage);feldnummer:=5;zurueckzumaskeELIFlaenge(abbildungsvariablen(folge))<>1THENgibmeldung(anwendungstext(151));loescheabbildung(folge);feldnummer:=4;zurueckzumaskeELIFlaenge(abbildungsterme(folge))<>1THENgibmeldung(anwendungstext(162));loescheabbildung(folge);feldnummer:=4;zurueckzumaskeEND IF.ueberpruefefolgengrenzen:lowerfolge:=int(realzahl(texte[6]));IFiserrorTHENclearerror;loescheabbildung(folge);feldnummer:=6;gibmeldung(anwendungstext(149));zurueckzumaskeEND IF;upperfolge:=int(realzahl(texte[7]));IFiserrorTHENclearerror;loescheabbildung(folge);feldnummer:=7;gibmeldung(anwendungstext(150));zurueckzumaskeEND IF;IFlowerfolge>upperfolgeTHENfeldnummer:=6;gibmeldung(anwendungstext(161));loescheabbildung(folge);zurueckzumaskeEND IF.zurueckzumaske:ausstiegszeichen:=weiter;LEAVEbearbeiteeinefunktion.lasseggfparametereingeben:IF LENGTHvec<>1THENcursor(1,5);out(anwendungstext(74));REPcursor(12,5);belegeparameter(vec,varindex,abbildungsvariablen(abb),menue+weiter+naechste+info,ausstiegszeichen);IFausstiegszeichen=infoTHENgibinfofensteraus(w,8);strich(6);footnote(anwendungstext(115))ELIFausstiegszeichen=menueORausstiegszeichen=naechsteTHENverfahrensende(ausstiegszeichen);loescheabbildung(folge);LEAVEberechneintegralEND IF UNTILausstiegszeichen=weiterEND REPEAT;cursor(1,5);out(del)END IF.lasseverfahrenauswaehlen:THESAURUS VARth:=emptythesaurus;REPth:=some(24,7,56,15,verfuegbareverfahren,anwendungstext(173),anwendungstext(182));IFlsexitkey=menueTHENverfahrensende(menue);loescheabbildung(folge);LEAVEberechneintegralEND IF;IFauswahlgueltig(th,reihenfolge,nrgraphverfahren,fehlermeldung,numerisch)THEN LEAVElasseverfahrenauswaehlenEND IF;gibmeldung(fehlermeldung)END REP.berechneundzeigeergebnis:INT VARerstersatz,erstespalte;TEXT VARausstiegszeichen;IFrechteckverfahrenausgewaehltTHENsonderfunktionenrechteckverfahren;IFrechteckstuetze=0THENloescheabbildung(folge);verfahrensende(menue);LEAVEberechneintegralEND IF END IF;IFnumerischTHENfootnote(anwendungstext(117));tabellenname:=scratchdateiname;erzeugenaeherungsfolge(lowerfkt,upperfkt,lowerfolge,upperfolge,folge,abb,varindex,vec,reihenfolge,erstersatz,erstespalte);zeile:=erstersatz;spalte:=erstespalte;outframe(w);REPfootnote(anwendungstext(115));scroll(w,tabellenname,spalte,zeile,spaltenbreite+1,erstersatz,erstespalte,weiter+naechste+menue+info+escdrucken,ausstiegszeichen);IFausstiegszeichen=infoTHENgibinfoaus(9)ELIFausstiegszeichen=escdruckenTHENdruckedietabelleEND IF UNTILausstiegszeichen<>infoCANDausstiegszeichen<>escdruckenEND REPEAT;forget(tabellenname,quiet)ELSEgraphischeveranschaulichung(nrgraphverfahren,texte,eingegebenefunktion,abb,varindex,lowerfkt,upperfkt,vec,folge,lowerfolge,upperfolge,ausstiegszeichen)END IF.druckedietabelle:aufbereitetdrucken(tabellenname,funktionsstring(eingegebenefunktion),spalte,zeile,spaltenbreite+1);outframe(w).loeschetemporaerevariablen:loescheabbildung(folge);feldnummer:=ersteseingabefeld.rechteckverfahrenausgewaehlt:nrgraphverfahren=rechteckverfahrenOR(thCONTAINSverfahrensname[1])END PROCberechneintegral;PROCgibinfoaus(INT CONSTnr):show(formular(nr));warteEND PROCgibinfoaus;BOOL PROCauswahlgueltig(THESAURUS CONSTauswahl,ROWanzahlnumerischeverfahrenINT VARreihenfolge,INT + VARnrgraphverfahren,TEXT VARevtlfehlertext,BOOL VARnumerisch):INT VARindex:=0,index2,naechstereintraginreihung:=1,numerischeverfahrenausgewaehlt:=0,graphischeverfahrenausgewaehlt:=0;TEXT VAReintrag;bildelisten;listensindkorrekt.bildelisten:nrgraphverfahren:=0;get(auswahl,eintrag,index);WHILEeintrag<>""REPindex2:=link(verfuegbareverfahren,eintrag);IFindex2=2CORindex2=4THENgraphischeverfahrenausgewaehltINCR1;nrgraphverfahren:=index2DIV2ELSEnumerischeverfahrenausgewaehltINCR1;reihenfolge[naechstereintraginreihung]:=(index2+2)DIV2;naechstereintraginreihungINCR1END IF;get(auswahl,eintrag,index)END REPEAT;FORindexFROMnaechstereintraginreihungUPTOanzahlnumerischeverfahrenREPreihenfolge[index]:=0END REPEAT.listensindkorrekt:numerisch:=numerischeverfahrenausgewaehlt<>0;IFnumerischTHEN IFgraphischeverfahrenausgewaehlt<>0THENevtlfehlertext:=anwendungstext(164);FALSE ELSE TRUE END IF ELSE IFgraphischeverfahrenausgewaehlt=1THEN TRUE ELSE IFgraphischeverfahrenausgewaehlt=0THENevtlfehlertext:=anwendungstext(167)ELSEevtlfehlertext:=anwendungstext(165)END IF;FALSE END IF END IF END PROCauswahlgueltig;PROCgraphischeveranschaulichung(INT CONSTnr,ROW100TEXT VARtexte,ABBILDUNG CONSToriginal,fkt,INT CONSTvarind,REAL CONSTlinkegrenze,rechtegrenze,VECTOR CONSTparameterwerte,ABBILDUNG CONSTfolge,INT CONSTfolgenanfang,folgenende,TEXT VARausstiegszeichen):TEXT VARmessage;BOOL VARzeichnungliegtvor:=FALSE;bereitegraphischeveranschaulichungvor;fuehregraphischeveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(original,"Integral");cursor(2,3);out(funktionszeile);cursor(2,4);out(folgenzeile);schreibebegleittext(nr).funktionszeile:"Variable "+texte[2]+" von "+texte[3]+" bis "+texte[4].folgenzeile:"Anzahl der Intervalle a(n) = "+texte[5]+" für n von "+texte[6]+" bis "+texte[7].fuehregraphischeveranschaulichungdurch:BOOL VARaufbauen;initialisierevariablen;REPaufbauen:=TRUE;gibdasbildderfunktionaus;berechnedasfolgenglied;berechnestuetzpunkte;gibinfos;zeichnevierecke;verarbeiteeingabezeichen;zeichnefusszeile("");IF NOTaufbauenTHENzeichnevierecke;deletelastpictureEND IF PER.initialisierevariablen:BOOL VARfehler:=FALSE;INT VARaktuellesfolgenglied:=folgenanfang,folgenresultat,offset1,offset2;VECTOR VARfolgenvector:=vector(1);TERM VARfolgenterm:=AUSDRUCKlistenanfang(abbildungsterme(folge));REAL VARrand:=0.1*(rechtegrenze-linkegrenze),linkerrand:=linkegrenze-rand,rechterrand:=rechtegrenze+rand;IFnr=2THENoffset1:=1;offset2:=2ELIFrechteckstuetzemaxiterTHENclearerror;fehler:=TRUE;message:=anwendungstext(212);LEAVEfuehregraphischeveranschaulichungdurchEND IF.berechnestuetzpunkte:IFnr=1CANDrechteckstuetze=mitteTHEN REAL VARhalbesintervall:=(rechtegrenze-linkegrenze)/real(folgenresultat*2);initstuetzpunkte(fkt,linkegrenze+halbesintervall,rechtegrenze+halbesintervall,folgenresultat+1,varind,parameterwerte,fehler)ELSEinitstuetzpunkte(fkt,linkegrenze,rechtegrenze,folgenresultat+1,varind,parameterwerte,fehler)END IF;IFfehlerTHENmessage:=anwendungstext(213);LEAVEfuehregraphischeveranschaulichungdurchEND IF.gibinfos:cursor(56,11);out(text(folgenresultat,4));cursor(56,14);out(text(compress(wandle(wert)),23)).wert:IFnr=1THENrechtecksintegrationELSEtrapezintegrationEND IF.zeichnevierecke:INT VARz;REAL VARxwert1:=linkegrenze, +streifenbreite:=(rechtegrenze-linkegrenze)/real(folgenresultat);IFaufbauenTHENpen(1,1,1,lotstift)ELSEpen(0,0,0,1)END IF;newpicture(lotstift);FORzFROM0UPTOfolgenresultat-1REPmatmove(xwert1,0.0);matdraw(xwert1,stuetzpunkte[z+offset1]);xwert1:=linkegrenze+real(z+1)*streifenbreite;matdraw(xwert1,stuetzpunkte[z+offset2]);matdraw(xwert1,0.0)END REP;IF NOTaufbauenTHENdeletelastpictureEND IF.verarbeiteeingabezeichen:TEXT VARch;zeichnefusszeile(anwendungstext(206));REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstiegszeichen);SELECTpos(graphdefinieren+weiter+naechste+menue,ausstiegszeichen)OF CASE1:definierebereich;LEAVEverarbeiteeingabezeichenCASE2,3,4:LEAVEfuehregraphischeveranschaulichungdurchOTHERWISEout(bell)END SELECT ELIFmehrerefolgengliederCANDch="+"CANDaktuellesfolgengliedfolgenanfangTHENaktuellesfolgengliedDECR1;aufbauen:=FALSE;LEAVEverarbeiteeingabezeichenELIFch=druckenTHENdruckegraphELIFch=protokollTHENzeigeprotokolldesgraphenELSEout(bell)END IF END REP.zeigeprotokolldesgraphen:gibprotokollaus(anwendungstext(99),"dwqm",ausstiegszeichen);IFausstiegszeichen=weiterTHENschreibebegleittext(nr);gibinfos;zeichnefusszeile(anwendungstext(206))ELSE LEAVEfuehregraphischeveranschaulichungdurchEND IF.mehrerefolgenglieder:folgenanfang<>folgenende.definierebereich:cursor(56,19);out(loeschzeile);cursor(56,18);out(loeschzeile);cursor(56,17);out(loeschzeile);cursor(56,16);out(loeschzeile);cursor(56,14);out(loeschzeile);cursor(56,13);out(loeschzeile);graphfenstereinstellen;loeschezeichnung;definitionsmenu(TRUE,ausstiegszeichen);IFausstiegszeichen<>weiterTHEN LEAVEfuehregraphischeveranschaulichungdurchEND IF;initkoordinatensystem;zeichnungliegtvor:=FALSE;firsttime:=TRUE;linkerrand:=koordinatensystemxmin;rechterrand:=koordinatensystemxmax;schreibebegleittext(nr).beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(message);fehler:=FALSE END IF;beendegraphikarbeit;endplot;plotend;IFausstiegszeichen=weiterTHENschreibestatuszeile("Integral");schreibearbeitsfunktion(original);IFfehlerTHENgibmeldung(message)END IF END IF END PROCgraphischeveranschaulichung;PROCschreibebegleittext(INT CONSTnr):cursor(56,7);out(ueberschrift[nr]);cursor(56,8);out(unterstrich[nr]);cursor(56,10);out(anwendungstext(241));cursor(56,13);out(anwendungstext(242));cursor(56,16);out(anwendungstext(243));cursor(56,17);out(anwendungstext(244));cursor(56,18);out(anwendungstext(245));cursor(56,19);out(anwendungstext(246))END PROCschreibebegleittext;PROCsonderfunktionenrechteckverfahren:THESAURUS VARth:=emptythesaurus;INT VARi;FORiFROM1UPTO3REPinsert(th,rechteckstuetztext[i])PER;rechteckstuetze:=0;REPrechteckstuetze:=link(th,one(24,7,56,15,th,anwendungstext(79),anwendungstext(80)));IFrechteckstuetze=0ANDlsexitkey<>menueTHENgibmeldung(anwendungstext(167))END IF UNTILrechteckstuetze<>0ORlsexitkey=menuePER END PROCsonderfunktionenrechteckverfahren;END PACKETintegrationsverfahren; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren b/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren new file mode 100644 index 0000000..5c6c90e --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren @@ -0,0 +1,5 @@ +PACKETiterationsverfahrenDEFINESberechnefixpunkt:LETesc="�",bell="�",unterstrich="_",graphicstandardtasten="wvqm",protokoll="p",protokolldrucken="d",drucken="D",abbruchzeichen="!",niltext="",del="�",maxfelder=100,menupunktende="m",weiterarbeit="w",standardtasten="?wvqm",standardunddrucktasten="?dwvqm",graphdefinieren="e",anzahlmoeglicherteilverfahren=2,fixpunktverfahren1="Iterationsverfahren - tabellarisch",fixpunktverfahren2="Iterationsverfahren - graphisch",PARAMETER=ROWmaxfelderTEXT,kurzerstrich="____________________";TEXT VARausstieg;PROCberechnefixpunkt(ABBILDUNG CONSTf):pruefedieverwendbarkeitderfunktion;zeigeaktuellearbeitsfunktion;initialisieredienoetigenvariablen;REPbestimmeanzuwendendeoperation;fuehreoperationausEND REP.pruefedieverwendbarkeitderfunktion:IFlaenge(abbildungsterme(f))<>1CANDlaenge(abbildungsvariablen(f))<>laenge(abbildungsterme(f))THENgibmeldung(anwendungstext(183));LEAVEberechnefixpunktEND IF.zeigeaktuellearbeitsfunktion:page;schreibearbeitsfunktion(f);strich(5).bestimmeanzuwendendeoperation:WINDOW VARwausgabe:=window(2,7,77,16);TEXT VARverfahrensname;INT VARzeile;schreibestatuszeile("Iteration");IFlaenge(abbildungsterme(f))<>1THENverfahrensname:=fixpunktverfahren1;LEAVEbestimmeanzuwendendeoperationEND IF;REPverfahrensname:=one(24,7,56,15,fixpunktverfahrensnamen,anwendungstext(173),anwendungstext(185));IFverfahrensname<>niltextTHEN FORzeileFROM7UPTO20REPcursor(24,zeile);out(del)END REP;LEAVEbestimmeanzuwendendeoperationELIFlsexitkey=menupunktendeTHENverfahrensende(menupunktende);LEAVEberechnefixpunktEND IF END REP.initialisieredienoetigenvariablen:INT VARvariablenindex:=1,anzahlderiterationsschritte:=10;REAL VARstartwert:=0.0;VECTOR VAReingabevektor:=vector(laenge(abbildungsvariablen(f)),0.0);BOOL VARvariablenvectorbestimmt:=LENGTHeingabevektor=1,variablenindexbestimmt:=ebene=1CORvariablenvectorbestimmt,firsttime:=TRUE;setzedefaultgraph.fuehreoperationaus:REP IFlaenge(abbildungsterme(f))=1THENbestimmevorgabenfuereinfacheiterationsfolgeELSE IFverfahrensname=fixpunktverfahren2THENgibmeldung(anwendungstext(88));LEAVEfuehreoperationausEND IF;bestimmevorgabenfuerkomplexeiterationsfolgeEND IF;IFverfahrensname=fixpunktverfahren1THEN TEXT VARdatname:=scratchdateiname;FILE VARsf:=sequentialfile(output,datname);iteration(sf,f,eingabevektor,variablenindex,anzahlderiterationsschritte);zeigeergebnisse;forget(datname,quiet)ELSEzeichnecobwebmusterEND IF UNTILausstieg<>weiterarbeitEND REP.bestimmevorgabenfuereinfacheiterationsfolge:initialisiereeingabemaskefueriterationsfolge;REPeditiereeingabemaske;werteausstiegszeichenausEND REP.initialisiereeingabemaskefueriterationsfolge:TAG VAReingabemaske:=formular(6);PARAMETER VARraster;INT VARstartfeld:=2;raster(1):=niltext;IFvariablenindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),variablenindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF.editiereeingabemaske:IF NOTvariablenindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3):=text(startwert)+kurzerstrich;raster(4):=text(anzahlderiterationsschritte)+kurzerstrich;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);LEAVEfuehreoperationausEND IF.werteausstiegszeichenaus:INT VARhilf1;REAL VARhilf2;SELECTpos(standardtasten,ausstieg)OF CASE1:IFvariablenindexbestimmtTHENgibinfofensteraus(wausgabe,15)ELSEgibinfofensteraus(wausgabe,14)END IF;CASE2:footnote(anwendungstext(114));IFalleeingabenkorrektTHENanzahlderiterationsschritte:=hilf1;startwert:=hilf2;IF NOTvariablenvectorbestimmtTHENcursor(1,4);out("Parameter :");belegediefunktionsparameterEND IF;LEAVEbestimmevorgabenfuereinfacheiterationsfolgeEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT.alleeingabenkorrekt:korrektervariablenbezeichnerCANDkorrekteranfangswertCANDkorrektefolgengliedanzahl.korrektervariablenbezeichner:TERM VARvaradresse:= +listenanfang(abbildungsvariablen(f));IFebene=1CORlaenge(abbildungsvariablen(f))=1THENvariablenindex:=1;TRUE ELSEchangeall(raster(2),unterstrich,niltext);varadresse:=listenposition(abbildungsvariablen(f),raster(2));IFvaradresse<>nilTHENvariablenindex:=PLATZvaradresse;TRUE ELSEstartfeld:=2;gibmeldung(anwendungstext(147)+raster(2)+anwendungstext(148));FALSE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrich,niltext);hilf2:=realzahl(raster(3));IF NOTiserrorTHENreplace(eingabevektor,variablenindex,hilf2);TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrektefolgengliedanzahl:changeall(raster(4),unterstrich,niltext);hilf1:=int(raster(4));IFiserrorTHENgibmeldung(anwendungstext(97));clearerror;FALSE ELIFlastconversionokCANDhilf1>0CANDhilf1<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=4;FALSE END IF.belegediefunktionsparameter:REPfootnote(anwendungstext(184));cursor(14,4);belegeparameter(eingabevektor,variablenindex,abbildungsvariablen(f),standardtasten,ausstieg);SELECTpos(standardtasten,ausstieg)OF CASE1:outframe(wausgabe);show(formular(8));warte;page(wausgabe,TRUE)CASE2:cursor(1,4);out(del);LEAVEbelegediefunktionsparameterCASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT;END REP.bestimmevorgabenfuerkomplexeiterationsfolge:bestimmeschrittanzahl;bestimmestartwerte.bestimmeschrittanzahl:INT VARhilf;cursor(1,3);out(anwendungstext(98));REPfootnote(anwendungstext(184));TEXT VAReingabe:=text(anzahlderiterationsschritte);eingabeCATkurzerstrich;cursor(32,3);enablestop;editget(eingabe,20,5,niltext,standardtasten,ausstieg);disablestop;SELECTpos(standardtasten,ausstiegSUB2)OF CASE1:gibinfofensteraus(wausgabe,21)CASE2:IFeingabekorrektTHENanzahlderiterationsschritte:=hilf;LEAVEbestimmeschrittanzahlELSEgibmeldung(anwendungstext(116))END IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstiegSUB2);LEAVEberechnefixpunktEND SELECT END REP.eingabekorrekt:changeall(eingabe,unterstrich,niltext);hilf:=int(eingabe);IFiserrorTHENclearerror;FALSE ELSElastconversionokCANDhilf>0CANDhilf<4001END IF.bestimmestartwerte:variablenindex:=0;cursor(1,4);out(anwendungstext(119));belegediefunktionsparameter.zeigeergebnisse:INT VARersterauszugebendersatz:=3,ersteauszugebendespalte:=8,scrzeile;IFlaenge(abbildungsterme(f))=1THENersterauszugebendersatzINCR(length(eingabevektor)-1)END IF;scrzeile:=ersterauszugebendersatz;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,scrzeile,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,scrzeile,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnisseCASE4:page(wausgabe,TRUE);forget(datname,quiet);LEAVEfuehreoperationausCASE5,6:forget(datname,quiet);verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT END REP.zeichnecobwebmuster:bereitegraphischeveranschaulichungvor;fuehreveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(f,"Iteration");cursor(2,3);out(funktionszeile).funktionszeile:"Anfangswert "+raster[2]+" = "+raster[3]+" "+"Anzahl der Iterationsschritte: "+raster[4].fuehreveranschaulichungdurch:initialisierevariablen;zeichnegraphenderarbeitsfunktion(fbild,eingabevektor,variablenindex,linkerrand,rechterrand,folgenwert);REPberechneundzeichnedenfunktionswert;verarbeiteeingabezeichenPER.initialisierevariablen:INT VARaktuellesfolgenglied:=0;ABBILDUNG VARfbild:=f;BOOL VARloeschflag:=FALSE,fehler:=FALSE;VECTOR VAReingaben:=eingabevektor;REAL VARfolgenwert:=eingabenSUBvariablenindex,funktionswert,linkerrand,rechterrand;IFkomplexefunktion(f)THENloeschflag:=TRUE;fbild:=aufloesung(f)END IF;berechnegraphintervall;IFfirsttimeTHENberechnekoordinatensystem(fbild,linkerrand, +rechterrand,eingabevektor,variablenindex);firsttime:=FALSE END IF.berechnegraphintervall:linkerrand:=startwert-5.0;rechterrand:=startwert+5.0;IFlinkerrand>0.0THENlinkerrand:=-linkerrandEND IF;IFrechterrand<0.0THENrechterrand:=-rechterrandEND IF.berechneundzeichnedenfunktionswert:funktionswert:=ergebnis(fbild,eingaben)SUB1;IFiserrorTHENclearerror;fehler:=TRUE;ausstieg:=weiterarbeit;LEAVEfuehreveranschaulichungdurchEND IF;gibinfos;graphfenstereinstellen;pen(1,1,1,aktuellerstift);move(folgenwert,folgenwert);matdraw(folgenwert,funktionswert);matdraw(funktionswert,funktionswert).gibinfos:cursor(54,10);out(text(aktuellesfolgenglied,4));cursor(54,13);out(text(compress(wandle(folgenwert)),25));cursor(54,16);out(text(compress(wandle(funktionswert)),25)).verarbeiteeingabezeichen:TEXT VARch;REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstieg);IFpos(graphicstandardtasten,ausstieg)<>0THEN LEAVEfuehreveranschaulichungdurchELIFausstieg=graphdefinierenTHENdefinierebereich;LEAVEverarbeiteeingabezeichenEND IF;out(bell)ELIFch="+"CANDaktuellesfolgengliedweiterarbeitTHEN LEAVEfuehreveranschaulichungdurchEND IF;aktuellesfolgenglied:=0;folgenwert:=startwert;replace(eingaben,variablenindex,startwert);IFautomatischerskalierungsmodusTHENberechnekoordinatensystem(fbild,koordinatensystemxmin,koordinatensystemxmax,eingabevektor,variablenindex)END IF;zeichnegraphenderarbeitsfunktion(fbild,eingabevektor,variablenindex,linkerrand,rechterrand,folgenwert).zeigeprotokoll:gibprotokollaus(anwendungstext(211),protokolldrucken+graphicstandardtasten,ausstieg);IFausstieg=weiterarbeitTHENzeichnetexte;gibinfosELSE LEAVEfuehreveranschaulichungdurchEND IF.beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(anwendungstext(175))END IF;endplot;plotend;beendegraphikarbeit;SELECTpos(graphicstandardtasten,ausstieg)OF CASE1:schreibestatuszeile("Iteration");schreibearbeitsfunktion(f);strich(5)CASE2:schreibestatuszeile("Iteration");schreibearbeitsfunktion(f);strich(5);IFloeschflagTHENloescheabbildung(fbild)END IF;LEAVEfuehreoperationausCASE3,4:verfahrensende(ausstieg);IFloeschflagTHENloescheabbildung(fbild)END IF;LEAVEberechnefixpunktEND SELECT END PROCberechnefixpunkt;PROCzeichnegraphenderarbeitsfunktion(ABBILDUNG CONSTf,VECTOR CONSTeingabevektor,INT CONSTvariablenindex,REAL CONSTlinkerrand,rechterrand,folgenwert):zeichnekoordinatensystem;normalgraphzeichnen(f,eingabevektor,variablenindex);newpicture(sekantenstift);pen(1,1,1,sekantenstift);matmove(linkerrand,linkerrand);matdraw(rechterrand,rechterrand);pen(1,1,1,neuerstift);newpicture(aktuellerstift);zeichnetexte;graphfenstereinstellen;matmove(folgenwert,0.0)END PROCzeichnegraphenderarbeitsfunktion;THESAURUS PROCfixpunktverfahrensnamen:THESAURUS VARt:=emptythesaurus;INT VARi;ROWanzahlmoeglicherteilverfahrenTEXT CONSTvname:=ROWanzahlmoeglicherteilverfahrenTEXT:(fixpunktverfahren1,fixpunktverfahren2);FORiFROM1UPTOanzahlmoeglicherteilverfahrenREPt:=t+vname(i)END REP;tEND PROCfixpunktverfahrensnamen;PROCiteration(FILE VARf,ABBILDUNG CONSToriginalfunktion,VECTOR CONSTeingaben,INT CONSTvarindex,anzahlfolgenglieder):ABBILDUNG VARf1:=originalfunktion;BOOL VARloeschflag:=FALSE;IFkomplexefunktion(f1)THENf1:=aufloesung(f1);loeschflag:=TRUE END IF;footnote(anwendungstext(117));cursor(36,24);maxlinelength(f,1000);schreibetabellenueberschriften;schreibetabellenzeilen;IFloeschflagTHENloescheabbildung(f1)END IF.schreibetabellenueberschriften:IFlaenge(abbildungsterme(f1))>1THENspeziellestabellentitelformatELSEallgemeinestabellentitelformatEND IF.speziellestabellentitelformat:TEXT VARtitelzeile:="n ";FORiFROM1UPTOlength(eingaben)REP +titelzeileCATsenkrecht;titelzeileCATtext(NAMEauswahl(abbildungsvariablen(f1),i),gesamtstellen(ebene))END REP;putline(f,titelzeile);titelzeile:=6*waagerecht;FORiFROM1UPTOlength(eingaben)REPtitelzeileCATkreuz;titelzeileCATgesamtstellen(ebene)*waagerechtEND REP;putline(f,titelzeile).allgemeinestabellentitelformat:FORiFROM1UPTOlength(eingaben)REP IFi<>varindexTHENputline(f,text(NAMEauswahl(abbildungsvariablen(f1),i),8)+" = "+wandle(eingabenSUBi))END IF END REP;putline(f,"n "+senkrecht+text(NAMEauswahl(abbildungsvariablen(originalfunktion),varindex),gesamtstellen(ebene))+senkrecht+text("Fktswert",gesamtstellen(ebene)));putline(f,6*waagerecht+2*(kreuz+gesamtstellen(ebene)*waagerecht)).schreibetabellenzeilen:VECTOR VAReingabevector:=eingaben;INT VARi,j;FORiFROM0UPTOanzahlfolgengliederREPcout(i);testetaste;write(f,text(i,6));IFlaenge(abbildungsterme(f1))>1THENspeziellestabellenzeilenformatELSEallgemeinestabellenzeilenformatEND IF END REP.speziellestabellenzeilenformat:FORjFROM1UPTOlength(eingaben)REPwrite(f,senkrecht+wandle(eingabevectorSUBj))END REP;line(f);eingabevector:=ergebnis(f1,eingabevector);IFiserrorTHENclearerror;putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF.allgemeinestabellenzeilenformat:REAL VARy:=ergebnis(f1,eingabevector)SUB1;IFiserrorTHENclearerror;putline(f,senkrecht+wandle(eingabevectorSUBvarindex)+senkrecht+gesamtstellen(ebene)*"-");putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF;putline(f,senkrecht+wandle(eingabevectorSUBvarindex)+senkrecht+wandle(y));replace(eingabevector,varindex,y).testetaste:IFincharety=abbruchzeichenTHEN LEAVEschreibetabellenzeilenEND IF END PROCiteration;END PACKETiterationsverfahren; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot b/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot new file mode 100644 index 0000000..781c3f9 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot @@ -0,0 +1,3 @@ +PACKETkyoceraplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz:LETxcm=29.7,ycm=19.7,bit14=16384,plotterunitspercm=118.1102;LETinitcmd="!R! UNIT d; SPO L;";LETleavecmd="SPO P; EXIT;",separator=",",terminator=";",movecmd="MZP ",drawcmd="DZP ";INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=15;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,printerchannel:=15;horpixel:=3507;verpixel:=2330;horfaktor:=300.0/2.54;vertfaktor:=300.0/2.54;INT VARxpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:toplotterchannel;out(initcmd)ENDPROCbeginplot;PROCendplot:plotendENDPROCendplot;PROCplotend:IFchannel=plotterchannelTHENout(leavecmd);toterminalchannelEND IF ENDPROCplotend;PROCclear:END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.movetoxy:xpos:=xx;ypos:=yy;TEXT VARky:=movecmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.drawtoxy:xpos:=xx;ypos:=yy;TEXT VARky:=drawcmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move( +xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:disablestop;continue(terminalchannel);IFiserrorTHENclearerror;break(quiet)END IF;enablestopEND PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETkyoceraplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16"); + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot b/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot new file mode 100644 index 0000000..d7a888d --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot @@ -0,0 +1,3 @@ +PACKETlaserjetplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LETesc="�",reset="�E",graphicsresolution="�*t75R",formfeed="�",landscape="�&I1O",horpixel=800,verpixel=560,intsperscanline=50,horfaktor=29.52756,vertfaktor=29.52756,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARxpos,ypos,xfak,yfak,plotterchannel,groesstexkoord,groessteykoord,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.76,buchstabenbreite:=0.3375,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=27.0;ycm:=19.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARspaltenbeginn:=(groesstexkoordDIV16)+1,zeilenbeginn:=groessteykoord+1;TEXT VARdoppelbyte:="xx";druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out(reset);out(landscape);out(graphicsresolution);out("�*r1A").gibdiebitmapaus:INT VARzeilenzaehler;FORzeilenzaehlerFROMzeilenbeginnDOWNTO1REPbefehlssequenzschickenPER.befehlssequenzschicken:out(esc+"*b"+text(neueanzahlderbytes)+"W");gibteilzeileaus.neueanzahlderbytes:(spaltenbeginnDIV8)+1.gibteilzeileaus:INT VARspaltenzaehler;FORspaltenzaehlerFROM1UPTOneueanzahlderbytesDIV2REPreplace(doppelbyte,1,bitmap(zeilenzaehler)(spaltenzaehler));out(doppelbyte)PER.druckedieseite:out("�*rB");out("�E").END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x0END PROCfieldexists;PROCsetinfo(TEXT CONSTstring,INT CONSTpos):workint:=stringVSUBpos;IFworkint>0THENsetallvaluesELSEnormal:=TRUE END IF.setallvalues:closedbit:=hbit;protectbit:=hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit;normal:=FALSE.hbit:workint:=workint*2;IFworkint>255THENworkintDECR256;TRUE ELSE FALSE END IF END PROCsetinfo;PROCfieldinfos(TAG CONSTt,INT CONSTfeld,INT VARgeheimcode,BOOL VARclosed,protected,secret,special,left):geheimcode:=code(t.darstSUBfeld);setinfo(t.diainfo,feld);IFnormalTHENclosed:=FALSE;protected:=FALSE;secret:=FALSE;special:=FALSE;left:=FALSE ELSEclosed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit;left:=leftbitEND IF END PROCfieldinfos;PROCsetfieldinfos(TAG VARt,INT CONSTfeld,BOOL CONSTclosed,protected,secret):INT VARcd:=(t.diainfoVSUBfeld)MOD32;IFsecretTHENcdINCR32END IF;IFprotectedTHENcdINCR64END IF;IFclosedTHENcdINCR128END IF;replaceiac(t.diainfo,feld,code(cd))END PROCsetfieldinfos;INT VARafeld,ax,ay,al,ael,tlen,tout;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld):eput(ff,t,elfeld,1)END PROCeput;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld,INT CONSTabwo):zumerstenelementarfeld;WHILEnochgenugtextdaREPfuelleelementarfeld;elementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputEND IF;zumelementarfeld;PER;gibrestaus;REPelementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputEND IF;zumelementarfeld;gibhintergrundausPER.zumerstenelementarfeld:tlen:=LENGTHt;tout:=abwo-1;afeld:=ff.feldVSUBelfeld;ael:=elfeld;positionieren(ff).fuelleelementarfeld:outsubtext(t,tout+1,tout+al);toutINCRal.nochgenugtextda:tout+alafeld.gibrestaus:outsubtext(t,tout+1,tlen);IFtout+al>tlenTHENoutsubtext(grund,ax+tlen-tout,ax+al-1)END IF.gibhintergrundaus:outsubtext(grund,ax,ax+al-1).grund:ff.formblatt(ay)END PROCeput;PROCpositionieren(TAG CONSTff):al:=ff.lenVSUBael;ax:=ff.xVSUBael;ay:=ff.yVSUBael;cursor(ax,ay)END PROCpositionieren;PROCcursor(TAG CONSTff,INT CONSTfeld):ael:=ff.erstelVSUBfeld;positionieren(ff)END PROCcursor;INT PROClength(TAG CONSTff,INT CONSTfeld):zumerstenelementarfeld;IFael<1THEN LEAVElengthWITH0END IF;INT VARlen:=0;REPlenINCRfeldlaenge;zumnaechstenelementarfeldUNTILgehoertzumnaechstenfeldPER;len.zumerstenelementarfeld:ael:=ff.erstelVSUBfeld.zumnaechstenelementarfeld:aelINCR1.gehoertzumnaechstenfeld:(ff.feldVSUBael)<>feld.feldlaenge:ff.lenVSUBaelEND PROClength;PROCshow(TAG CONSTff):INT VARi;FORiFROM1UPTOff.ymaxREPcursor(1,i);out(ff.formblatt(i))END REP END PROCshow;INT VARcharcode:=0,lastx,lasty;INT VARaktbegin,aktfeld,aktel,wo;INT VARnextfeld,nextel,nextwo,nextbegin;PROCsetneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin;aktel:=nextel;wo:=nextwo;END PROCsetneweditvalues;PROCsearchfield(TAG CONSTt,INT CONSTx,y,BOOL VARerfolg):erfolg:=FALSE;nextel:=0;REPsucheelementinrichtigerzeileUNTILkeinsmehrdaCORxposstimmtPER;IFerfolgTHENnextfeld:=t.feldVSUBnextel;nextbegin:=1;INT VARi:=t.erstelVSUBnextfeld;WHILEix;erfolg.anfang:t.xVSUBnextel.ende:(t.xVSUBnextel)+(t.lenVSUBnextel).END PROCsearchfield;PROCputget(TAG CONSTff,ROWmaxfieldsTEXT VARv,INT VAReinstieg,TEXT VARtaste):enablestop;put(ff,v);get(ff,v,einstieg,taste)END PROCputget;PROCput(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues):INT VARiFORiFROM1UPTO LENGTHff.erstelREP IFfieldexists(ff,i)THENput(ff,fieldvalues(i),i)END IF PER END PROCput;PROCput(TAG CONSTff,TEXT CONSTv,INT CONSTfeld):setinfo(ff.diainfo,feld);INT VARerstelem:=ff.erstelVSUBfeld;IFerstelem>0THEN IFnormalCOR NOTdarstbitTHENeput(ff,v,erstelem)ELSEeput(ff,LENGTHv*(ff.darstSUBfeld),erstelem)END IF END IF END PROCput;PROCget(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues,INT VARfeld,TEXT VARtaste):TEXT VARexittaste:="";INT VARaltesfeld;IF NOTfieldexists(ff,feld)THENerrorstop("startfeld nicht im tag")ELSE REPaltesfeld:=feld;setinfo(ff.diainfo,feld);IF NOTgeschuetztTHENeingabefeldELSEgeschuetztesfeldEND IF;charcode:=code(subtext(exittaste,1,1));IFcharcode=ctabTHENcharcode:=cfeldrueckELIFcharcode=cescTHEN IFsubtext(exittaste,2,2)=leftTHENcharcode:=cfeldrueckELIFsubtext(exittaste,2,2)=rightTHENcharcode:=cfeldvorEND IF END IF;executecommandcode(ff,feld);IFfeld=1THENfeld:=2END IF UNTILcharcode=cescPER;END IF.geschuetzt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);protect.ankreuzen:cl.geschuetztesfeld:cursor(ff,feld);getcursor(lastx,lasty);REPinchar(exittaste)UNTILexittaste="�"PER;inchar(taste).eingabefeld:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(fieldvalues(feld),length(ff,feld)+30,length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);cursor(lastx+length(ff,feld),lasty);out(endmark);IFankreuzenTHENerrorstop("Ankreuzfelder gibt's bei 'Mathe' nicht!")END IF;cursor(lastx,lasty);put(ff,fieldvalues(feld),feld);IFlength(exittaste)>1THENtaste:=subtext(exittaste,2,2)END IF END PROCget;PROCexecutecommandcode(TAG CONSTff,INT VARfeld):SELECTcharcodeOF CASEcfeldrueck:topriorfieldCASEcfeldvor:tonextfieldCASEchoch:goupifpossibleCASEcrunter:godownifpossibleCASEchome:tohomefieldCASEctab:END SELECT.topriorfield:REPEATfeld:=priorfield(ff,feld)UNTILwarerstesCORnichtgesperrtPER;IFwarerstesTHENtohomefieldEND IF.tonextfield:REPfeld:=nextfield(ff,feld)UNTILwarletztesCORnichtgesperrtPER;IFwarletztesTHENtohomefieldEND IF.tohomefield:feld:=firstfield(ff);WHILEgesperrtREPfeld:=nextfield(ff,feld)PER.goupifpossible:BOOL VARerfolg;searchfield(ff,lastx,lasty-1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldEND IF.godownifpossible:searchfield(ff,lastx,lasty+1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldEND IF.nichtgesperrt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);NOTprotect.nextnichtgesperrt:fieldinfos(ff,nextfeld,geheim,cl,protect,s,sp,l);NOTprotect.gesperrt:NOTnichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROCexecutecommandcode;INT PROCfirstfield(TAG CONSTt):t.feldVSUB1END PROCfirstfield;INT PROCnextfield(TAG CONSTt,INT CONSTfeld):INT VARel:=(t.erstelVSUBfeld)+1;WHILE(t.feldVSUBel)=feldREPelINCR1PER;t.feldVSUBelEND PROCnextfield;INT PROCpriorfield(TAG CONSTt,INT CONSTfeld):t.feldVSUB((t.erstelVSUBfeld)-1)END PROCpriorfield;LETmaxtags=50,dsname="mathe formulare",depottask="ls-MENUKARTEN";BOUND ROWmaxtagsTAG VARmatheformulare;PROCtagsankoppeln:IF NOTexists(dsname)THENfetch("mathe formulare",/depottask)END IF;matheformulare:=old("mathe formulare")END PROCtagsankoppeln;TAG PROCformular(INT CONSTi):IFi>maxtagsTHENerrorstop("So viele TAGs gibt es nicht: "+text(i))END IF;matheformulare(i)END PROCformular;LETnil13byte="�������������",nil4byte="����",nilbyte="�";PROCreplaceiac(TEXT VARstring,INT CONSTwo,TEXT CONSTwas):IF LENGTHstring<=LENGTHwas+wo-1THENstretch(string,LENGTHwas+wo-1)FI;replace(string,wo,was)END PROCreplaceiac;PROCstretch(TEXT VARt,INT CONSTwo):WHILE LENGTHt<=wo-13REPtCAT +nil13bytePER;WHILE LENGTHt<=wo-4REPtCATnil4bytePER;WHILE LENGTHt0;eingabeaktiviert:=laenge(eigenefunktionen)0REP IFdsname<>"mathematikobjekte 1"CANDdsname<>"mathematikobjekte 2"CANDdsname<>"mathe formulare"THENforget(dsname,quiet)END IF;get(th,dsname,i)END REP END PROCausgang;PROCeingabe:disablestop;ABBILDUNG VARg;TEXT VARstring:=niltext;INT VARx0:=2,y0:=6,xbreite:=77,ylaenge:=13;WINDOW VAReingabefenster:=window(x0,y0,xbreite,ylaenge),ueberschriftfenster;IFeingabeuebereditorTHENueberschriftfenster:=window(2,3,77,1);outframe(ueberschriftfenster);out(ueberschriftfenster,center(ueberschriftfenster,invers("Funktionseingabe")));show(eingabefenster)END IF;REPnimmeingabenentgegen;werteeingabenausEND REP.nimmeingabenentgegen:clearbuffer;IFeingabeuebereditorTHENlasseformeleditorarbeitenELSEstring:=boxanswer(eingabefenster,text(anwendungstext(63),74),string,zentral,x0,y0,xbreite,ylaenge)END IF;IFstring=niltextTHENregeneratemenuscreen;LEAVEeingabeEND IF.lasseformeleditorarbeiten:initialisierevorgabenfuerformeleditor;werteformeleditoreingabeaus.initialisierevorgabenfuerformeleditor:INT VARreplycode,workchannel:=channel;BOUND TEXT VARtextstring:=new("datenbehaelter");textstring:=string;DATASPACE VARds:=old("datenbehaelter");forget("datenbehaelter",quiet);break(quiet);call(formeleditor,formeleditieren,ds,replycode);continue(workchannel).werteformeleditoreingabeaus:textstring:=ds;string:=textstring;forget(ds).werteeingabenaus:g:=neuefunktion(string);IFiserrorTHENgibmeldung(errormessage);clearerrorELSEgibmeldung(anwendungstext(134));IF NOTausgabeaktiviertTHENaktiviere;ausgabeaktiviert:=TRUE ELIFlaenge(eigenefunktionen)>=maximalanzahlfunktionenTHEN +eingabeaktiviert:=FALSE;deactivate(eingabeprocname);deactivate(ladeprocname);regeneratemenuscreen;LEAVEeingabeEND IF;string:=niltextEND IF END PROCeingabe;PROCausgabe:disablestop;THESAURUS VARwunschliste:=menusome(funktionsnamenthesaurus,anwendungstext(64),niltext,ohnereinigung);IFnotempty(wunschliste)THENschreibedieausgewaehltenfunktionenineinedatei;gibdiegewuenschtenfunktionenausEND IF;regeneratemenuscreen.schreibedieausgewaehltenfunktionenineinedatei:ABBILDUNG VARfkt;TEXT CONSTdatname:=scratchdateiname;FILE VARf:=sequentialfile(output,datname);TEXT VARfunktionsname;INT VARi:=0;REPget(wunschliste,funktionsname,i);IFfunktionsname=niltextTHEN LEAVEschreibedieausgewaehltenfunktionenineinedateiEND IF;fkt:=abbildung(funktionsname);IFformeleditoraktivTHENliefereformeleditorformat(f,fkt);line(f)ELSEputline(f,funktionsstring(fkt))END IF END REP.gibdiegewuenschtenfunktionenaus:WINDOW VARu:=window(2,4,77,1),w:=window(2,7,77,16);INT VARersterauszugebendersatz:=1,ersteauszugebendespalte:=1;TEXT CONSTerlaubtezeichen:="?dm";show(u);out(u,center(u,anwendungstext(154)));outframe(w);REPfootnote(anwendungstext(135));scroll(w,datname,1,1,1,ersterauszugebendersatz,ersteauszugebendespalte,erlaubtezeichen,letztesescapezeichen);werteausstiegausEND REP.werteausstiegaus:SELECTpos(erlaubtezeichen,letztesescapezeichen)OF CASE1:show(formular(13));warteCASE2:druckversuch(datname);outframe(w)CASE3:forget(datname,quiet);LEAVEgibdiegewuenschtenfunktionenausEND SELECT END PROCausgabe;PROCzeigen:disablestop;WINDOW VARw:=window(35,10,40,12);zeigeelementarefunktionsnamen;zeigebenutzerdefiniertefunktionsnamen;warte;page(w,TRUE);oldfootnote.zeigeelementarefunktionsnamen:TEXT VARtheselement,zeile;INT VARi:=0;show(w);cursor(w,1,1);out(w,center(w,anwendungstext(68)));get(verzeichnisderstandardfunktionen,theselement,i);WHILEtheselement<>niltextREPzeile:=niltext;WHILEtheselement<>niltextCANDlength(zeile)+length(theselement)<40REPzeileCATtheselement;zeileCATblank;get(verzeichnisderstandardfunktionen,theselement,i)END REP;out(w,center(w,zeile))END REP;line(w).zeigebenutzerdefiniertefunktionsnamen:THESAURUS VARthes:=funktionsnamenthesaurus;i:=0;out(w,center(w,anwendungstext(69)));get(thes,theselement,i);WHILEtheselement<>niltextREPzeile:=niltext;IFlength(theselement)>40THENzeileCATtheselement;get(thes,theselement,i);ELSE WHILEtheselement<>niltextCANDlength(zeile)+length(theselement)<40REPzeileCATtheselement;zeileCATblank;get(thes,theselement,i)END REP END IF;out(w,center(w,zeile));IFremaininglines(w)=0THENwarte;page(w)END IF;END REP;out(w,center(w,anwendungstext(70)+text(laenge(eigenefunktionen))))END PROCzeigen;PROCbeseitigen:disablestop;clearbuffer;SELECTmenualternative(anwendungstext(34),anwendungstext(50),zusatztasten,zentral,ohneabbruch)MOD100OF CASE1:waehlediezuloeschendenfunktionenaus;IFnotempty(auswahl)THENzeigeloeschfensterundinitialisierevariablen;IFebene=1THENloeschedieausgewaehltenfunktionenELSEloeschedieausgewaehltenfunktionenvorsichtigEND IF;warte;IFlaenge(eigenefunktionen)=0THENdeaktiviere;ausgabeaktiviert:=FALSE ELIFlaenge(eigenefunktionen)niltextREPeintrag:=listenposition(eigenefunktionen,name);frage:=anwendungstext(75)+funktionsstring(abbildung(name))+anwendungstext(76);footnote(anwendungstext(141));IFyes(w,frage)THENloeschebenannteabbildung(name);putline(w,anwendungstext(137))END IF;get(auswahl,name,i)END REP. +loeschedieausgewaehltenfunktionenvorsichtig:THESAURUS VARfunktionenmitloeschverbot:=emptythesaurus;get(auswahl,name,i);WHILEname<>niltextREPeintrag:=listenposition(eigenefunktionen,name);IFreferenziertefunktion(eintrag)THENfunktionenmitloeschverbot:=funktionenmitloeschverbot+nameELSEfrage:=anwendungstext(75)+funktionsstring(abbildung(name))+anwendungstext(76);footnote(anwendungstext(141));IFyes(w,frage)THENloeschebenannteabbildung(name);putline(w,anwendungstext(137))END IF;auswahl:=auswahl-name;funktionenmitloeschverbot:=funktionenmitloeschverbot-nameEND IF;get(auswahl,name,i)END REP;IFnotempty(funktionenmitloeschverbot)THENgibhinweisaufreferenziertefunktionenEND IF.gibhinweisaufreferenziertefunktionen:line(w);putline(w,anwendungstext(152));i:=0;get(funktionenmitloeschverbot,name,i);WHILEname<>niltextREPput(w,name);get(funktionenmitloeschverbot,name,i)END REP;line(w);putline(w,anwendungstext(153))END PROCbeseitigen;PROCsichern:disablestop;TEXT VARmeldung:=niltext,dateiname;IFarchivangemeldet(meldung)THENclearbuffer;sichereausgewaehltefunktionenELIFmeldung<>niltextTHENgibmeldung(meldung)END IF;release(archive);oldfootnote.sichereausgewaehltefunktionen:waehlefunktionenaus;IFnotempty(wunschliste)THENwaehlefunktionendateikennung;schreibefunktioneninausgewaehltedatei;sicheredateiaufdasarchiv(dateiname)END IF.waehlefunktionenaus:THESAURUS VARwunschliste:=menusome(funktionsnamenthesaurus,anwendungstext(139),niltext,mitreinigung).waehlefunktionendateikennung:TEXT CONSTfktdateipraefix:=fktdatname+text(ebene,2);dateiname:=eingegebenerdateiname(fktdateipraefix);IFdateiname=niltextTHEN LEAVEsichereausgewaehltefunktionenEND IF.schreibefunktioneninausgewaehltedatei:TEXT VARfunktionsname;INT VARi:=0;FILE VARf:=sequentialfile(output,dateiname);get(wunschliste,funktionsname,i);WHILEfunktionsname<>niltextREPwrite(f,funktionsstring(abbildung(funktionsname))+trennzeichen);get(wunschliste,funktionsname,i)END REP END PROCsichern;TEXT PROCeingegebenerdateiname(TEXT CONSTpraefix):TEXT VARkurzname:=niltext,langname:=niltext;REPclearbuffer;kurzname:=compress(menuanswer(anwendungstext(65),kurzname,zentral))UNTILkurzname=niltextCORdateinamefreigegebenEND REP;IFkurzname=niltextTHENniltextELSElangnameEND IF.dateinamefreigegeben:langname:=praefix+doppelpunkt+kurzname;NOT(archivinhaltCONTAINSlangname)CORmenuyes(anwendungstext(66),zentral)END PROCeingegebenerdateiname;PROCsicheredateiaufdasarchiv(TEXT CONSTdateiname):footnote(anwendungstext(67));commanddialogue(FALSE);save(dateiname,archive);IFiserrorTHENgibmeldung(errormessage);clearerrorELSEgibmeldung(anwendungstext(72))END IF;commanddialogue(TRUE);forget(dateiname,quiet)END PROCsicheredateiaufdasarchiv;PROCladen:disablestop;TEXT VARmeldung:=niltext,dateiname:=niltext;TEXT CONSTfktdateipraefix:=fktdatname+text(ebene,2);IFarchivangemeldet(meldung)THEN IFnotempty(archivinhaltLIKE(fktdateipraefix+":*"))THENholeausgewaehltefunktionen;release(archive);ueberpruefeaktivierungELSErelease(archive);gibmeldung(anwendungstext(78))END IF ELIFmeldung<>niltextTHENrelease(archive);gibmeldung(meldung)END IF;oldfootnote.holeausgewaehltefunktionen:bestimmedateinamen;IFdateierfolgreicheingelesen(dateiname)THENlesefunktionenein;forget(dateiname,quiet)END IF.bestimmedateinamen:dateiname:=ausgewaehlterdateiname(fktdateipraefix,anwendungstext(81),anwendungstext(82));IFdateiname=niltextTHEN LEAVEholeausgewaehltefunktionenEND IF.lesefunktionenein:ABBILDUNG VARfkt;FILE VARf:=sequentialfile(input,dateiname);TEXT VARfunktionstext;WHILE NOTeof(f)REPget(f,funktionstext,trennzeichen);footnote(anwendungstext(145)+funktionstext+anwendungstext(146));versuchefunktioneinzutragenEND REP.versuchefunktioneinzutragen:REP IFlaenge(eigenefunktionen)>=maximalanzahlfunktionenTHENgibmeldung(anwendungstext(205));eingabeaktiviert:=FALSE;LEAVElesefunktioneneinEND IF;fkt:=neuefunktion(funktionstext);IFiserrorTHENclearerror;clearbuffer;funktionstext:=menuanswer(anwendungstext(83),funktionstext,zentral);IFlsexitkey=menupunktendeTHEN LEAVElesefunktionenein +ELIFfunktionstext=niltextTHEN LEAVEversuchefunktioneinzutragenEND IF ELSE LEAVEversuchefunktioneinzutragenEND IF END REP END PROCladen;TEXT PROCausgewaehlterdateiname(TEXT CONSTpraefix,botschaft,ueberschrift):THESAURUS VARarchivdateien:=archivinhaltLIKE(praefix+":*");IFnotempty(archivdateien)THENmenuone(archivdateien,ueberschrift,niltext,mitreinigung)ELSEgibmeldung(botschaft);niltextEND IF END PROCausgewaehlterdateiname;BOOL PROCdateierfolgreicheingelesen(TEXT CONSTdateiname):forget(dateiname,quiet);footnote(anwendungstext(163));fetch(dateiname,archive);IFiserrorTHENgibmeldung(errormessage);clearerror;FALSE ELSE TRUE END IF END PROCdateierfolgreicheingelesen;BOOL PROCarchivangemeldet(TEXT VARmeldung):TEXT CONSTvorlaeufigerarchivname:="Mathematik";IFmenuno(anwendungstext(84),zentral)THEN LEAVEarchivangemeldetWITH FALSE END IF;footnote(anwendungstext(138));archive(vorlaeufigerarchivname);IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSEarchivinhalt:=ALLarchive;IFiserrorTHENergebnisderzweitenanmeldungELSE TRUE END IF END IF.ergebnisderzweitenanmeldung:meldung:=errormessage;clearerror;IFsubtext(meldung,1,14)="Archiv heisst "CANDsubtext(meldung,16,20)<>"?????"THENarchive(subtext(meldung,16,length(meldung)-1));IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSEarchivinhalt:=ALLarchive;IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSE TRUE END IF END IF ELSEmeldung:=anwendungstext(85);FALSE END IF END PROCarchivangemeldet;LETmaxnachkommastellen=12;PROCbestimmenachkommastellen:INT VARzahl;REPclearbuffer;TEXT VARanzahlnachkommastellen:=menuanswer(anwendungstext(86),text(nachkomma(ebene)),zentral);IFcompress(anzahlnachkommastellen)=niltextTHEN LEAVEbestimmenachkommastellenEND IF;zahl:=int(anzahlnachkommastellen);IFlastconversionokCANDzahl>-1CANDzahl<=maxnachkommastellenTHENsetzenachkommastellen(zahl);LEAVEbestimmenachkommastellenEND IF;out(bell)END REP END PROCbestimmenachkommastellen;PROCbestimmehalbgraphiczeichen:SELECTmenualternative(anwendungstext(93),anwendungstext(92),"ism",zentral,ohneabbruch)MOD100OF CASE1:ibmgraphiccharCASE2:stdgraphiccharOTHERWISE LEAVEbestimmehalbgraphiczeichenEND SELECT;regeneratemenuscreenEND PROCbestimmehalbgraphiczeichen;PROCbestimmeformeleditoreinsatz:SELECTmenualternative(anwendungstext(94),anwendungstext(95),"1234m",zentral,ohneabbruch)MOD100OF CASE1:formeleditoraktiv(TRUE);eingabeuebereditor(TRUE)CASE2:formeleditoraktiv(FALSE);eingabeuebereditor(TRUE)CASE3:formeleditoraktiv(TRUE);eingabeuebereditor(FALSE)CASE4:formeleditoraktiv(FALSE);eingabeuebereditor(FALSE)END SELECT END PROCbestimmeformeleditoreinsatz;PROCbestimmeformeleditorzeichensatz:forget("formelzeichensatz",quiet);BOUND TEXT VARformelzeichensatz:=new("formelzeichensatz");SELECTmenualternative(anwendungstext(207),anwendungstext(92),"ism",zentral,ohneabbruch)MOD100OF CASE1:formelzeichensatz:="ibmoperatoren"CASE2:formelzeichensatz:="standardoperatoren"OTHERWISEforget("formelzeichensatz",quiet);LEAVEbestimmeformeleditorzeichensatzEND SELECT;DATASPACE VARds:=old("formelzeichensatz");INT VARreplycode;call(formeleditor,zeichensatzumstellen,ds,replycode);forget(ds);forget("formelzeichensatz",quiet)END PROCbestimmeformeleditorzeichensatz;PROCbestimmedruckseitenformat:LETminimum=20,maximum=200;INT VARspaltenanzahl,zeilenanzahl,breite,laenge;TEXT VAReingabe;INT VARx0:=2,y0:=6,xbreite:=77,ylaenge:=13;WINDOW VAReingabefenster:=window(x0,y0,xbreite,ylaenge);druckseitenformat(spaltenanzahl,zeilenanzahl);liesspaltenanzahlein;lieszeilenanzahlein;definieredruckseitenformat(breite,laenge).liesspaltenanzahlein:REPclearbuffer;eingabe:=boxanswer(eingabefenster,text(anwendungstext(215),74),text(spaltenanzahl),zentral,x0,y0,xbreite,ylaenge);IFcompress(eingabe)=niltextTHENraeumebildschirmauf;LEAVEbestimmedruckseitenformatEND IF;breite:=int(eingabe);IFlastconversionokCANDbreite>=minimumCANDbreite<=maximumTHEN LEAVEliesspaltenanzahleinEND IF;out(bell)END REP.lieszeilenanzahlein:REPclearbuffer;eingabe:=boxanswer(eingabefenster,text(anwendungstext(216 +),74),text(zeilenanzahl),zentral,x0,y0,xbreite,ylaenge);IFcompress(eingabe)=niltextTHENraeumebildschirmauf;LEAVEbestimmedruckseitenformatEND IF;laenge:=int(eingabe);IFlastconversionokCANDlaenge>=minimumCANDlaenge<=maximumTHENraeumebildschirmauf;LEAVElieszeilenanzahleinEND IF;out(bell)END REP END PROCbestimmedruckseitenformat;PROCraeumebildschirmauf:INT VARi;FORiFROM9UPTO14REPcursor(1,i);out(del)END REP;refreshsubmenuEND PROCraeumebildschirmauf;ROW2BOOL VARformeleditoreingeschaltet:=ROW2BOOL:(FALSE,FALSE),formeleditoreingabe:=ROW2BOOL:(FALSE,FALSE);PROCformeleditoraktiv(BOOL CONSTschalter):formeleditoreingeschaltet(ebene):=schalterEND PROCformeleditoraktiv;BOOL PROCformeleditoraktiv:formeleditoreingeschaltet(ebene)END PROCformeleditoraktiv;PROCeingabeuebereditor(BOOL CONSTschalter):formeleditoreingabe(ebene):=schalterEND PROCeingabeuebereditor;BOOL PROCeingabeuebereditor:formeleditoreingabe(ebene)END PROCeingabeuebereditor;PROCliefereformeleditorformat(FILE VARf,ABBILDUNG CONSTfkt):forget("temporaerer datenraum",quiet);BOUND TEXT VARtextformat:=new("temporaerer datenraum");textformat:=formel(fkt);DATASPACE VARds:=old("temporaerer datenraum");INT VARreplycode;call(formeleditor,formelindateischreiben,ds,replycode);wertereplycodeaus;forget(ds);forget("temporaerer datenraum",quiet).wertereplycodeaus:TEXT VARzeile,tempdat:=scratchdateiname;IFreplycode=allesokTHENcopy(ds,tempdat);FILE VARf2:=sequentialfile(input,tempdat);output(f);WHILE NOTeof(f2)REPgetline(f2,zeile);putline(f,zeile)END REP;forget(tempdat,quiet)ELSEputline(f,funktionsstring(fkt))END IF END PROCliefereformeleditorformat;PROCverfahren(PROC(ABBILDUNG CONST)auszufuehrendeprozedur,TEXT CONSTprozedurname):disablestop;ABBILDUNG VARarbeitsfunktion;REPeditierearbeitsfunktionen;ergaenzeumunterstriche;IFletztesescapezeichen=menupunktendeTHENregeneratemenuscreen;LEAVEverfahrenEND IF;auszufuehrendeprozedur(arbeitsfunktion);IFiserrorTHENclearerror;schreibestatuszeile(prozedurname);show(eingabemaske);gibmeldung(errormessage)END IF;loeschetemporaereabbildung(arbeitsfunktion)UNTILletztesescapezeichen=menupunktendeEND REP;regeneratemenuscreen.editierearbeitsfunktionen:initialisieredievariablen;schreibestatuszeile(prozedurname);editiere.initialisieredievariablen:PARAMETER VARraster;INT VARi;TAG VAReingabemaske:=formular(1);raster(1):=niltext;FORiFROM1UPTOmaxfunktionenREPraster(i+1):=fkttext(i)END REP.editiere:REPbearbeiteeingabeformular;werteausstiegausEND REP.bearbeiteeingabeformular:footnote(anwendungstext(189));show(eingabemaske);putget(eingabemaske,raster,letztearbeitsfkt,letztesescapezeichen);IFiserrorTHENclearerror;schreibestatuszeile(prozedurname);show(eingabemaske);gibmeldung(errormessage);letztesescapezeichen:=menupunktende;LEAVEeditiereEND IF.werteausstiegaus:SELECTpos("?zwm",letztesescapezeichen)OF CASE1:gibinformationzumformularCASE2:zeigenCASE3:IFkorrekteeingabeTHEN LEAVEeditierearbeitsfunktionenEND IF CASE4:LEAVEeditiereEND SELECT.korrekteeingabe:INT VARdoppelpunktlage:=pos(raster(letztearbeitsfkt),doppelpunkt);TEXT VARfstring:=raster(letztearbeitsfkt);footnote(anwendungstext(114));changeall(fstring,unterstrichzeichen,niltext);IFcompress(fstring)=niltextTHENgibmeldung(anwendungstext(190));FALSE ELSE IFselbstdefiniertefunktionTHEN IF NOTeingabeaktiviertTHENgibmeldung(anwendungstext(205));LEAVEkorrekteeingabeWITH FALSE END IF;arbeitsfunktion:=neuefunktion(fstring)ELSEarbeitsfunktion:=funktionsaufruf(fstring)END IF;IFiserrorTHENgibmeldung(errormessage);clearerror;FALSE ELSE IFselbstdefiniertefunktionTHENraster(letztearbeitsfkt):=text(raster(letztearbeitsfkt),doppelpunktlage-1);ausgabeaktiviert:=laenge(eigenefunktionen)>=1;eingabeaktiviert:=laenge(eigenefunktionen)0.gibinformationzumformular:WINDOW VARw:=window(3,6,75,17);outframe(w);IFebene=1THENshow(formular(4))ELSEshow(formular(23))END IF;warte.ergaenzeumunterstriche:FORiFROM1UPTOmaxfunktionenREPchangeall(raster(i+1),blank, +unterstrichzeichen);raster(i+1)CAT((100-length(raster(i+1)))*unterstrichzeichen);fkttext(i):=raster(i+1)END REP END PROCverfahren;PROCraeumeauf:schreibeselbstdefiniertefunktionenindatei;initialisieren;trageselbstdefiniertefunktionenein;oldfootnote.schreibeselbstdefiniertefunktionenindatei:TEXT VARbeliebig:=scratchdateiname;FILE VARf:=sequentialfile(output,beliebig);TERM VARt:=listenanfang(eigenefunktionen);WHILEt<>nilREPputline(f,funktionsstring(abbildung(NAMEt)));t:=nachfolger(t)END REP.trageselbstdefiniertefunktionenein:TEXT VARzeile;ABBILDUNG VARabb;f:=sequentialfile(input,beliebig);WHILE NOTeof(f)REPgetline(f,zeile);abb:=neuefunktion(zeile)END REP;forget(beliebig,quiet)END PROCraeumeauf;PROCverfahrensende(TEXT CONSTzeichen):letztesescapezeichen:=zeichenEND PROCverfahrensende;PROCueberpruefeaktivierung:IFlaenge(eigenefunktionen)>0CAND NOTausgabeaktiviertTHENaktiviere;ausgabeaktiviert:=TRUE;refreshsubmenuELIFlaenge(eigenefunktionen)=0CANDausgabeaktiviertTHENdeaktiviere;ausgabeaktiviert:=FALSE;refreshsubmenuEND IF END PROCueberpruefeaktivierung;PROCaktiviere:activate(loeschprocname);activate(ausgabeprocname);activate(sicherungsprocname)END PROCaktiviere;PROCdeaktiviere:deactivate(loeschprocname);deactivate(ausgabeprocname);deactivate(sicherungsprocname)END PROCdeaktiviere;END PACKETmenufunktionen; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.nullstellen b/app/schulis-mathematiksystem/1.0/src/mat.nullstellen new file mode 100644 index 0000000..3900a28 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.nullstellen @@ -0,0 +1,6 @@ +PACKETnullstellenDEFINESberechnenullstelle:LETesc="�",bell="�",unterstrich="_",abbruchzeichen="!",niltext="",del="�",maxfelder=100,menupunktende="m",weiterarbeit="w",graphdefinieren="e",naechste="q",protokoll="p",protokolldrucken="d",drucken="D",graphicstandardtasten="wvqm",standardtasten="?wvqm",standardunddrucktasten="?dwvqm",anzahlmoeglicherteilverfahren=3,nullstellenverfahrensname="Nullstellen",nullstellenverfahren1="Intervallhalbierungsverfahren - tabellarisch",nullstellenverfahren2="Newtonverfahren - tabellarisch",nullstellenverfahren3="Newtonverfahren - graphisch",titelzeile12="Nullstellen: Newtonverfahren",titelzeile3="Nullstellen: Intervallhalbierung",PARAMETER=ROWmaxfelderTEXT,kurzerstrich="____________________";TEXT VARausstieg;THESAURUS CONSTmoeglicheteilverfahren:=nullstellenverfahrensnamen;PROCberechnenullstelle(ABBILDUNG CONSTf):pruefedieverwendbarkeitderfunktion;zeigeaktuellearbeitsfunktion;initialisieredienoetigenvariablen;REPbestimmeanzuwendendeoperation;fuehreoperationausEND REP.pruefedieverwendbarkeitderfunktion:IFlaenge(abbildungsterme(f))<>1THENgibmeldung(anwendungstext(88));LEAVEberechnenullstelleEND IF.zeigeaktuellearbeitsfunktion:page;schreibearbeitsfunktion(f);strich(5).initialisieredienoetigenvariablen:WINDOW VARwausgabe:=window(2,7,77,16);TAG VAReingabemaske;PARAMETER VARraster;INT VARstartfeld:=2,ersterauszugebendersatz,ersteauszugebendespalte,varindex:=1,anzahlderiterationsschritte:=10,parameingabespalte,endederueberschrift;VECTOR VAReingabevektor:=vector(laenge(abbildungsvariablen(f)),0.0);ABBILDUNG VARfbild;BOOL VARvariablenvectorbestimmt:=LENGTHeingabevektor=1,varindexbestimmt:=ebene=1CORvariablenvectorbestimmt,firsttime:=TRUE;TEXT VARverfahrensname;setzedefaultgraph.bestimmeanzuwendendeoperation:INT VARzeile;schreibestatuszeile(nullstellenverfahrensname);REPverfahrensname:=one(24,7,56,15,moeglicheteilverfahren,anwendungstext(173),anwendungstext(185));IFverfahrensname<>niltextTHEN FORzeileFROM7UPTO20REPcursor(24,zeile);out(del)END REP;LEAVEbestimmeanzuwendendeoperationELIFlsexitkey=menupunktendeTHENverfahrensende(menupunktende);LEAVEberechnenullstelleEND IF END REP.fuehreoperationaus:TEXT VARdatname;FILE VARsf;IFverfahrensname=nullstellenverfahren1THENintervallhalbierungsverfahrenELSEbildedienewtonfolgeEND IF.bildedienewtonfolge:REAL VARstartwert:=0.0;anzahlderiterationsschritte:=10;schreibestatuszeile(titelzeile12);IFableitungsverbot(adresse(f))THENgibmeldung(anwendungstext(87));LEAVEbildedienewtonfolgeEND IF;REPbestimmeparameterfuernewtonfolge;bildenewtonvorschrift;IFverfahrensname=nullstellenverfahren2THENermittleergebnisse;zeigeergebnisse;raeumeaufELSEgraphischeveranschaulichungdesnewtonverfahrensEND IF UNTILausstieg<>weiterarbeitEND REP.bestimmeparameterfuernewtonfolge:initialisiereeingabemaskefuernewtonfolge;REPeditiereeingabemaske;werteausstiegausEND REP.initialisiereeingabemaskefuernewtonfolge:eingabemaske:=formular(6);startfeld:=2;raster(1):=niltext;IFvarindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),varindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF;raster(3):=text(startwert);raster(4):=text(anzahlderiterationsschritte).editiereeingabemaske:IF NOTvarindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3)CATkurzerstrich;raster(4)CATkurzerstrich;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);LEAVEfuehreoperationausEND IF.werteausstiegaus:SELECTpos(standardtasten,ausstieg)OF CASE1:IF NOTvarindexbestimmtTHENgibinfofensteraus(wausgabe,14)ELSEgibinfofensteraus(wausgabe,15)END IF CASE2:footnote(anwendungstext(114));IFalleeingabenkorrektTHEN IF NOTvariablenvectorbestimmtTHENparameingabespalte:=1;belegediefunktionsparameterEND IF;LEAVEbestimmeparameterfuernewtonfolgeEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT.alleeingabenkorrekt: +korrektervariablenbezeichnerCANDkorrekteranfangswertCANDkorrektefolgengliedanzahl.korrektervariablenbezeichner:TERM VARvaradresse:=listenanfang(abbildungsvariablen(f));IFebene=1CORlaenge(abbildungsvariablen(f))=1THENvarindex:=1;TRUE ELSEchangeall(raster(2),unterstrich,niltext);varadresse:=listenposition(abbildungsvariablen(f),raster(2));IFvaradresse<>nilTHENvarindex:=PLATZvaradresse;TRUE ELSEstartfeld:=2;gibmeldung(anwendungstext(147)+raster(2)+anwendungstext(148));FALSE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrich,niltext);REAL VARanfangswert:=realzahl(raster(3));IF NOTiserrorTHENreplace(eingabevektor,varindex,anfangswert);startwert:=anfangswert;TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrektefolgengliedanzahl:changeall(raster(4),unterstrich,niltext);anzahlderiterationsschritte:=int(raster(4));IFiserrorTHENgibmeldung(anwendungstext(187));clearerror;FALSE ELIFlastconversionokCANDanzahlderiterationsschritte>0CANDanzahlderiterationsschritte<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=4;FALSE END IF.bildenewtonvorschrift:fbild:=newtonvorschrift(f,varindex);IFiserrorTHENgibmeldung(errormessage);clearerror;LEAVEbildedienewtonfolgeEND IF.ermittleergebnisse:datname:=scratchdateiname;sf:=sequentialfile(output,datname);iteration(sf,f,fbild,eingabevektor,varindex,anzahlderiterationsschritte).zeigeergebnisse:endederueberschrift:=3;IFlength(eingabevektor)>1CANDlength(eingabevektor)<=10THENendederueberschriftINCR(length(eingabevektor)-1)END IF;ersterauszugebendersatz:=endederueberschrift;ersteauszugebendespalte:=8;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,endederueberschrift,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,endederueberschrift,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnisseCASE4:page(wausgabe,TRUE);raeumeauf;LEAVEfuehreoperationausCASE5,6:raeumeauf;verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP.raeumeauf:forget(datname,quiet);loescheabbildung(fbild).graphischeveranschaulichungdesnewtonverfahrens:bereitegraphischeveranschaulichungvor;fuehregraphischeveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(f,titelzeile12);cursor(2,3);out(funktionszeile).funktionszeile:"Anfangswert "+raster[2]+" = "+raster[3]+" "+anwendungstext(98)+raster[4].fuehregraphischeveranschaulichungdurch:initialisierevariablen;zeichnegraphenderarbeitsfunktion(f1,eingaben,varindex);REPberechneundzeichnedenfunktionswert;verarbeiteeingabezeichenPER.initialisierevariablen:INT VARaktuellesfolgenglied:=0;ABBILDUNG VARf1:=f,f2:=fbild;BOOL VARloeschflag1:=FALSE,loeschflag2:=FALSE,fehler:=FALSE;VECTOR VAReingaben:=eingabevektor;REAL VARfolgenwert:=eingabenSUBvarindex,funktionswert,linkerrand,rechterrand;IFkomplexefunktion(f1)THENloeschflag1:=TRUE;f1:=aufloesung(f1)END IF;IFkomplexefunktion(f2)THENloeschflag2:=TRUE;f2:=aufloesung(f2)END IF;berechnegraphintervall;IFfirsttimeTHENberechnekoordinatensystem(f1,linkerrand,rechterrand,eingabevektor,varindex);firsttime:=FALSE END IF.berechnegraphintervall:linkerrand:=startwert-5.0;rechterrand:=startwert+5.0;IFlinkerrand>0.0THENlinkerrand:=-linkerrandEND IF;IFrechterrand<0.0THENrechterrand:=-rechterrandEND IF.berechneundzeichnedenfunktionswert:funktionswert:=ergebnis(f1,eingaben)SUB1;IFiserrorTHENclearerror;fehler:=TRUE;ausstieg:=weiterarbeit;LEAVEfuehregraphischeveranschaulichungdurchEND IF;pen(1,1,1,aktuellerstift);matmove(folgenwert,0.0);matdraw(folgenwert,funktionswert);gibinfos.gibinfos:cursor(54,10);out(text(aktuellesfolgenglied,4));cursor(54,13);out(text(compress(wandle(folgenwert)),25));cursor(54,16);out(text(compress(wandle(funktionswert)),25)). +verarbeiteeingabezeichen:TEXT VARch;REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstieg);IFpos(graphicstandardtasten,ausstieg)<>0THEN LEAVEfuehregraphischeveranschaulichungdurchELIFausstieg=graphdefinierenTHENdefinierebereich;LEAVEverarbeiteeingabezeichenEND IF;out(bell)ELIFch="+"CANDaktuellesfolgengliedweiterarbeitTHEN LEAVEfuehregraphischeveranschaulichungdurchEND IF;aktuellesfolgenglied:=0;folgenwert:=startwert;replace(eingaben,varindex,startwert);IFautomatischerskalierungsmodusTHENberechnekoordinatensystem(f1,koordinatensystemxmin,koordinatensystemxmax,eingabevektor,varindex)END IF;zeichnegraphenderarbeitsfunktion(f1,eingabevektor,varindex).zeigedasprotokoll:gibprotokollaus(anwendungstext(211),protokolldrucken+graphicstandardtasten,ausstieg);IFausstieg=weiterarbeitTHENzeichnetexte;gibinfosELSE LEAVEfuehregraphischeveranschaulichungdurchEND IF.berechneundzeichnenaechstesfolgenglied:graphfenstereinstellen;move(folgenwert,funktionswert);folgenwert:=naechstesfolgenglied(f2,eingaben,varindex);IFiserrorTHENclearerror;fehler:=TRUE;LEAVEfuehregraphischeveranschaulichungdurchEND IF;pen(1,1,1,aktuellerstift);matdraw(folgenwert,0.0).beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(anwendungstext(175))END IF;IFloeschflag1THENloeschetemporaereabbildung(f1)END IF;IFloeschflag2THENloeschetemporaereabbildung(f2)END IF;endplot;plotend;beendegraphikarbeit;SELECTpos(graphicstandardtasten,ausstieg)OF CASE1:erneuerebildschirmCASE2:erneuerebildschirm;loeschetemporaereabbildung(fbild);LEAVEfuehreoperationausCASE3,4:verfahrensende(ausstieg);loeschetemporaereabbildung(fbild);LEAVEberechnenullstelleEND SELECT.erneuerebildschirm:schreibestatuszeile(titelzeile12);schreibearbeitsfunktion(f);strich(5).intervallhalbierungsverfahren:REAL VARlinkegrenze:=-5.0,rechtegrenze:=5.0;schreibestatuszeile(titelzeile3);REPbestimmeparameterfuerintervallhalbierung;datname:=scratchdateiname;sf:=sequentialfile(output,datname);intervallhalbierung(sf,f,eingabevektor,varindex,anzahlderiterationsschritte,linkegrenze,rechtegrenze);zeigeergebnissederintervallhalbierung;forget(datname,quiet)UNTILausstieg<>weiterarbeitEND REP.bestimmeparameterfuerintervallhalbierung:initialisiereeingabemaskefuerintervallhalbierung;REPeditiereeingabemaskefuerintervallhalbierung;werteausstiegbeiintervallhalbierungausEND REP.initialisiereeingabemaskefuerintervallhalbierung:eingabemaske:=formular(7);startfeld:=2;raster(1):=niltext;IFvarindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),varindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF.editiereeingabemaskefuerintervallhalbierung:REAL VARhilf1,hilf2;INT VARhilf3,i;IF NOTvarindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3):=text(linkegrenze);raster(4):=text(rechtegrenze);raster(5):=text(anzahlderiterationsschritte);FORiFROM3UPTO5REPraster(i)CATkurzerstrichEND REP;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENgibmeldung(errormessage);clearerror;ausstieg:=naechsteEND IF.werteausstiegbeiintervallhalbierungaus:SELECTpos(standardtasten,ausstieg)OF CASE1:IFebene=2CANDlaenge(abbildungsvariablen(f))>1THENgibinfofensteraus(wausgabe,17)ELSEgibinfofensteraus(wausgabe,16)END IF CASE2:footnote(anwendungstext(114));IFallebisektionseingabenkorrektTHENlinkegrenze:=hilf1;rechtegrenze:=hilf2;anzahlderiterationsschritte:=hilf3;IF NOTvariablenvectorbestimmtTHENparameingabespalte:=40;belegediefunktionsparameterEND IF;LEAVEbestimmeparameterfuerintervallhalbierungEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg); +LEAVEberechnenullstelleEND SELECT.allebisektionseingabenkorrekt:korrektervariablenbezeichnerCANDkorrektelinkegrenzeCANDkorrekterechtegrenzeCANDkorrekteteilungsanzahl.korrektelinkegrenze:changeall(raster(3),unterstrich,niltext);hilf1:=realzahl(raster(3));IF NOTiserrorTHEN TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrekterechtegrenze:changeall(raster(4),unterstrich,niltext);hilf2:=realzahl(raster(4));IF NOTiserrorTHEN IFhilf1>=hilf2THENstartfeld:=4;gibmeldung(anwendungstext(160));FALSE ELSE TRUE END IF ELSEclearerror;startfeld:=4;gibmeldung(anwendungstext(157));FALSE END IF.korrekteteilungsanzahl:changeall(raster(5),unterstrich,niltext);hilf3:=int(raster(5));IFiserrorTHENgibmeldung(anwendungstext(187));clearerror;FALSE ELIFlastconversionokCANDhilf3>0CANDhilf3<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=5;FALSE END IF.zeigeergebnissederintervallhalbierung:endederueberschrift:=3;IFlength(eingabevektor)>1CANDlength(eingabevektor)<=10THENendederueberschriftINCR(length(eingabevektor)-1)END IF;ersterauszugebendersatz:=endederueberschrift;ersteauszugebendespalte:=8;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,endederueberschrift,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,endederueberschrift,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnissederintervallhalbierungCASE4:page(wausgabe,TRUE);forget(datname,quiet);LEAVEfuehreoperationausCASE5,6:forget(datname,quiet);verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP.belegediefunktionsparameter:REPfootnote(anwendungstext(184));cursor(parameingabespalte,4);out("Parameter :");cursor(parameingabespalte+13,4);belegeparameter(eingabevektor,varindex,abbildungsvariablen(f),standardtasten,ausstieg);SELECTpos(standardtasten,ausstieg)OF CASE1:gibinfofensteraus(wausgabe,8)CASE2:cursor(parameingabespalte,4);out(del);LEAVEbelegediefunktionsparameterCASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP END PROCberechnenullstelle;PROCzeichnegraphenderarbeitsfunktion(ABBILDUNG CONSTf,VECTOR CONSTeingaben,INT CONSTvarindex):zeichnekoordinatensystem;normalgraphzeichnen(f,eingaben,varindex);zeichnetexte;pen(1,1,1,neuerstift);newpicture(aktuellerstift)END PROCzeichnegraphenderarbeitsfunktion;PROCiteration(FILE VARf,ABBILDUNG CONSToriginalfunktion,iterationsfunktion,VECTOR CONSTeingaben,INT CONSTlaufvarindex,anzahlfolgenglieder):ABBILDUNG VARf1:=originalfunktion,f2:=iterationsfunktion;BOOL VARloeschflag1:=FALSE,loeschflag2:=FALSE;footnote(anwendungstext(117));cursor(36,24);IFkomplexefunktion(f1)THENloeschflag1:=TRUE;f1:=aufloesung(f1)END IF;IFkomplexefunktion(f2)THENloeschflag2:=TRUE;f2:=aufloesung(f2)END IF;schreibetabellenueberschriften;schreibetabellenzeilen;IFloeschflag1THENloeschetemporaereabbildung(f1)END IF;IFloeschflag2THENloeschetemporaereabbildung(f2)END IF.schreibetabellenueberschriften:ergaenzeparameter(f,originalfunktion,eingaben,laufvarindex);putline(f,"n "+senkrecht+text(NAMEauswahl(abbildungsvariablen(originalfunktion),laufvarindex),gesamtstellen(ebene))+senkrecht+text("Fktswert",gesamtstellen(ebene)));putline(f,6*waagerecht+2*(kreuz+gesamtstellen(ebene)*waagerecht)).schreibetabellenzeilen:VECTOR VAReingabevektor:=eingaben;INT VARi;REAL VARfolgenglied:=eingabevektorSUBlaufvarindex,funktionswert;FORiFROM0UPTOanzahlfolgengliederREPcout(i);testetaste;write(f,text(i,6)+senkrecht);write(f,wandle(folgenglied)+senkrecht);funktionswert:=ergebnis(f1,eingabevektor)SUB1;testefehler;putline(f,wandle(funktionswert));folgenglied:=naechstesfolgenglied(f2,eingabevektor,laufvarindex);testefehlerEND REP.testetaste:IFincharety=abbruchzeichenTHEN LEAVEschreibetabellenzeilenEND IF.testefehler:IFiserrorTHENclearerror; +putline(f,gesamtstellen(ebene)*"-");putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF END PROCiteration;REAL PROCnaechstesfolgenglied(ABBILDUNG CONSTbildungsvorschrift,VECTOR VAReingaben,INT CONSTindexfuereingabevektor):REAL VARneuerwert:=ergebnis(bildungsvorschrift,eingaben)SUB1;replace(eingaben,indexfuereingabevektor,neuerwert);neuerwertEND PROCnaechstesfolgenglied;PROCintervallhalbierung(FILE VARf,ABBILDUNG CONSTfunktion,VECTOR VAReingabevektor,INT CONSTvarindex,anzahliterationsschritte,REAL CONSTlinks,rechts):BOOL VARloeschflag:=FALSE;ABBILDUNG VARfkt:=funktion;TERM VARfktterm;INT VARi;erstellegegebenenfallsaufloesungderfunktion;footnote(anwendungstext(117));cursor(36,24);ergaenzeparameter(f,funktion,eingabevektor,varindex);schreibekopfzeileninausgabedatei;berechnemittlerenwert;IFloeschflagTHENloescheabbildung(fkt)END IF.erstellegegebenenfallsaufloesungderfunktion:IFkomplexefunktion(fkt)THENfkt:=aufloesung(fkt);loeschflag:=TRUE END IF;fktterm:=AUSDRUCKlistenanfang(abbildungsterme(fkt)).schreibekopfzeileninausgabedatei:LETanzahlueberschriften=6;ROWanzahlueberschriftenTEXT CONSTueberschrift:=ROWanzahlueberschriftenTEXT:(anwendungstext(253),anwendungstext(254),anwendungstext(255),anwendungstext(256),anwendungstext(257),anwendungstext(258));TEXT VARtitelzeile:="n ";FORiFROM1UPTOanzahlueberschriftenREPtitelzeileCAT(senkrecht+text(ueberschrift(i),gesamtstellen(ebene)))END REP;maxlinelength(f,2000);putline(f,titelzeile);titelzeile:=6*waagerecht+anzahlueberschriften*(kreuz+(gesamtstellen(ebene)*waagerecht));putline(f,titelzeile).berechnemittlerenwert:REAL VARx1:=links,x2:=rechts,xm,y1,y2,ym;FORiFROM0UPTOanzahliterationsschritteREPcout(i);testetaste;xm:=0.5*(x1+x2);write(f,text(i,6));write(f,senkrecht+wandle(x1));write(f,senkrecht+wandle(xm));write(f,senkrecht+wandle(x2));IFwertdefiniert(f,fktterm,eingabevektor,varindex,x1,y1)CANDwertdefiniert(f,fktterm,eingabevektor,varindex,xm,ym)CANDwertdefiniert(f,fktterm,eingabevektor,varindex,x2,y2)THENvergleiche;line(f)ELSE LEAVEberechnemittlerenwertEND IF END REP.testetaste:IFincharety=abbruchzeichenTHEN LEAVEberechnemittlerenwertEND IF.vergleiche:IFym=0.0THEN LEAVEberechnemittlerenwertELIFym*y1<=0.0THENx2:=xmELSEx1:=xmEND IF.END PROCintervallhalbierung;BOOL PROCwertdefiniert(FILE VARf,TERM CONSTfktterm,VECTOR VAReingabevektor,INT CONSTlaufvarindex,REAL CONSTx,REAL VARy):replace(eingabevektor,laufvarindex,x);y:=result(fktterm,eingabevektor);IFiserrorTHENclearerror;write(f,senkrecht+gesamtstellen(ebene)*"-");line(f);write(f,anwendungstext(175));FALSE ELSEwrite(f,senkrecht+wandle(y));TRUE END IF END PROCwertdefiniert;THESAURUS PROCnullstellenverfahrensnamen:THESAURUS VARt:=emptythesaurus;INT VARi;ROWanzahlmoeglicherteilverfahrenTEXT CONSTvname:=ROWanzahlmoeglicherteilverfahrenTEXT:(nullstellenverfahren1,nullstellenverfahren2,nullstellenverfahren3);FORiFROM1UPTOanzahlmoeglicherteilverfahrenREPt:=t+vname(i)END REP;tEND PROCnullstellenverfahrensnamen;PROCergaenzeparameter(FILE VARsf,ABBILDUNG CONSTf,VECTOR CONSTeingabevektor,INT CONSTlaufvarindex):INT VARi,varlistenlaenge:=laenge(abbildungsvariablen(f));IFvarlistenlaenge>10THEN LEAVEergaenzeparameterEND IF;FORiFROM1UPTOvarlistenlaengeREP IFi<>laufvarindexTHENputline(sf,text(NAMEauswahl(abbildungsvariablen(f),i),8)+"="+wandle(eingabevektorSUBi))END IF END REP END PROCergaenzeparameter;END PACKETnullstellen; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.parser b/app/schulis-mathematiksystem/1.0/src/mat.parser new file mode 100644 index 0000000..fc53883 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.parser @@ -0,0 +1,12 @@ +PACKETparserDEFINESneuefunktion,funktionsaufruf,funktionsstring,formel,gibnamen,loescheunreferenzierteabbildung,referenziertefunktion,funktionsnamenthesaurus,standardfunktionsthesaurus:LETniltext="",blank=" ",ifsymbol="<",fuersymbol=":",elifsymbol=";",endifsymbol=">",undsymbol="UND",odersymbol="ODER",zuweisungssymbol="->",kleinersymbol="<",kleinergleichsymbol="<=",groessersymbol=">",groessergleichsymbol=">=",gleichsymbol="=",ungleichsymbol="<>",plussymbol="+",minussymbol="-",divisionssymbol="/",multiplikationssymbol="*",speziellespotenzsymbol="^",allgemeinespotenzsymbol="**",strichsymbol="'",klammeraufsymbol="(",klammerzusymbol=")",doppelpunktsymbol=":",dezimalpunktsymbol=".",esymbol="e",pisymbol="pi",betragssymbol="abs",signumsymbol="sign",gaussklammersymbol="gauss",rundsymbol="rund",intsymbol="ganz",fracsymbol="frak",funktionsklammeraufsymbol="[",funktionsklammerzusymbol="]",punktsymbol=".",kommasymbol=",",verkettungssymbol="O",differenziersymbol="D",selektionssymbol="S",bruchsymbol="/",unsichtbareklammerauf=" (: ",unsichtbareklammerzu=" :) ",selektionsklammeraufsymbol=" {{ ",selektionsklammerzusymbol=" }} ",selektionsfuersymbol=" :: ",selektionselifsymbol=" ;; ",funktionsauswertungssymbol=" A ",diffklammeraufsymbol=" D: ",diffklammerzusymbol=" :D ",bezeichnertyp=1,konstantentyp=3,begrenzertyp=6,defaultfuerkomponentenindex=1,defaultfuervariablenindex=1,defaultstdfktvarname="x";TEXT VARsymbol,symbolspeicher,aktuellerabbildungsname;INT VARsymboltyp,speichertyp;LISTE VARlistedervariablen,listederterme;TERM VARknoten;BOOL VAReliferwartet:=FALSE;ABBILDUNG PROCneuefunktion(TEXT CONSTfunktionsstring):enablestop;TEXT VARfehlzeichen:=niltext;IFfunktionsstring=niltextTHENerrorstop(anwendungstext(58))ELIFfehlerhaftebuchstabenvorhanden(funktionsstring,fehlzeichen)THENerrorstop(anwendungstext(170)+fehlzeichen)END IF;listedervariablen:=neueliste(nil,nil);listederterme:=neueliste(nil,nil);aktuellerabbildungsname:=niltext;knoten:=nil;IFebene=1THENparseeinfachefunktion(funktionsstring)ELSEsymbolspeicher:=niltext;speichertyp:=0;parsekomplexefunktion(funktionsstring)END IF END PROCneuefunktion;ABBILDUNG PROCparseeinfachefunktion(TEXT CONSTfunktionsstring):initialisieredenscanvorgang;verarbeitenderlinkenhaelfte;verarbeitezuweisungssymbol;verarbeitendesfunktionsterms;eintragenderfunktion;abbildung(aktuellerabbildungsname).initialisieredenscanvorgang:scan(funktionsstring);nextsymbol(symbol,symboltyp).verarbeitenderlinkenhaelfte:testegueltigkeit;IFlistenposition(eigenefunktionen,symbol)<>nilTHENerrorstop(hinweisaufungueltigennamen)END IF;aktuellerabbildungsname:=symbol;nextsymbol(symbol,symboltyp);IFsymbol<>doppelpunktsymbolTHENerrorstop(anwendungstext(15))END IF;nextsymbol(symbol,symboltyp);testegueltigkeit;anhaengen(listedervariablen,newvariable(1,symbol));nextsymbol(symbol,symboltyp).verarbeitezuweisungssymbol:IFsymbol<>minussymbolTHENerrorstop(anwendungstext(32))END IF;nextsymbol(symbol,symboltyp);IFsymbol<>groessersymbolTHENerrorstop(anwendungstext(32))END IF.verarbeitendesfunktionsterms:nextsymbol(symbol,symboltyp);IFsymboltyp>6THENerrorstop(anwendungstext(33))ELIFsymbol=ifsymbolTHENeliferwartet:=FALSE;nextsymbol(symbol,symboltyp);abschnittweisedefinierteeinfachefunktion(listederterme)ELSEeinfacherausdruck(listederterme)END IF;IFsymboltyp<7THENerrorstop(hinweisauffehlerhaftessymbol)END IF END PROCparseeinfachefunktion;PROCabschnittweisedefinierteeinfachefunktion(LISTE VARtermliste):knoten:=naechsteeinfacheklausel;IFknoten=nilTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;anhaengen(termliste,newterm(knoten));IFsymbol<>endifsymbolTHENerrorstop(anwendungstext(39))END IF;nextsymbol(symbol,symboltyp)END PROCabschnittweisedefinierteeinfachefunktion;TERM PROCnaechsteeinfacheklausel:TERM VARthenzeiger,bedingungszeiger;IFsymbol=endifsymbolTHENnilELSE IFeliferwartetTHEN IFsymbol<>elifsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nextsymbol(symbol,symboltyp);ELSEeliferwartet:=TRUE END IF;einfacherarithmetischerausdruck;thenzeiger:=knoten; +IFsymbol<>fuersymbolTHENerrorstop(anwendungstext(38))END IF;nextsymbol(symbol,symboltyp);einfachebedingung;bedingungszeiger:=knoten;newselektion(bedingungszeiger,thenzeiger,naechsteeinfacheklausel)END IF END PROCnaechsteeinfacheklausel;PROCeinfachebedingung:TEXT VARoperator;TERM VARlinkszeiger;einfacheslogischeselement;WHILEsymbol=undsymbolCORsymbol=odersymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacheslogischeselement;knoten:=newlogischedyade(linkszeiger,knoten,operator)END REP END PROCeinfachebedingung;PROCeinfacheslogischeselement:TEXT VARoperator;TERM VARlinkszeiger;IFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELSEverarbeitevergleichEND IF.verarbeitegeklammertenausdruck:nextsymbol(symbol,symboltyp);einfachebedingung;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp).verarbeitevergleich:einfacherarithmetischerausdruck;IF(symbol<>kleinersymbol)CAND(symbol<>kleinergleichsymbol)CAND(symbol<>groessersymbol)CAND(symbol<>groessergleichsymbol)CAND(symbol<>ungleichsymbol)CAND(symbol<>gleichsymbol)THENerrorstop(anwendungstext(40))END IF;operator:=symbol;linkszeiger:=knoten;nextsymbol(symbol,symboltyp);einfacherarithmetischerausdruck;knoten:=newvergleich(linkszeiger,knoten,operator)END PROCeinfacheslogischeselement;PROCeinfacherausdruck(LISTE VARtermliste):einfacherarithmetischerausdruck;anhaengen(termliste,newterm(knoten))END PROCeinfacherausdruck;PROCeinfacherarithmetischerausdruck:TEXT VARoperator;TERM VARlinkszeiger;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nextsymbol(symbol,symboltyp);einfacherterm;knoten:=newmonade(knoten,operator)ELSEeinfachertermEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacherterm;knoten:=newdyade(linkszeiger,knoten,operator)END REP END PROCeinfacherarithmetischerausdruck;PROCeinfacherterm:TEXT VARoperator;TERM VARlinkszeiger;einfacherfaktor;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacherfaktor;knoten:=newdyade(linkszeiger,knoten,operator)END REP END PROCeinfacherterm;PROCeinfacherfaktor:TERM VARbasiszeiger;TEXT VARpotenzsymbol;einfacheselement;WHILEsymbol=allgemeinespotenzsymbolCORsymbol=speziellespotenzsymbolREPbasiszeiger:=knoten;nextsymbol(symbol,symboltyp);einfacheselement;IFganzzahligerexponentTHENpotenzsymbol:=speziellespotenzsymbolELSEpotenzsymbol:=allgemeinespotenzsymbolEND IF;knoten:=newdyade(basiszeiger,knoten,potenzsymbol)END REP END PROCeinfacherfaktor;PROCeinfacheselement:TERM VARobjektzeiger;LISTE VARlistederargumente;IFsymboltyp=konstantentypCORsymbol=esymbolCORsymbol=pisymbolTHENverarbeitekonstanteELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFsymboltyp=bezeichnertypTHENverarbeitebezeichnerELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitekonstante:knoten:=newkonstante(wert,symbol);nextsymbol(symbol,symboltyp).verarbeitegeklammertenausdruck:nextsymbol(symbol,symboltyp);einfacherarithmetischerausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp).verarbeitebezeichner:IFsymbol=aktuellerabbildungsnameTHENerrorstop(hinweisaufungueltigennamen)ELIFelementarefunktionTHENverarbeiteabbildungsausdruckELSEverarbeitevariableEND IF.elementarefunktion:objektzeiger:=listenposition(standardfunktionen,symbol);objektzeiger<>nil.verarbeiteabbildungsausdruck:TEXT VARfunktionsname:=symbol;nextsymbol(symbol,symboltyp);IFsymbol=strichsymbolCAND(funktionsname=betragssymbolCORfunktionsname=signumsymbolCORfunktionsname=gaussklammersymbolCORfunktionsname=rundsymbolCORfunktionsname=intsymbolCORfunktionsname=fracsymbol)THENerrorstop(anwendungstext(56))END IF;WHILEsymbol=strichsymbolREPobjektzeiger:=newableitungsoperation(objektzeiger,defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol);nextsymbol(symbol,symboltyp)END REP;knoten:=newfunktionsauswertung( +objektzeiger,argumentzeiger,defaultfuerkomponentenindex).argumentzeiger:IFsymbol<>klammeraufsymbolTHENerrorstop(anwendungstext(37))END IF;nextsymbol(symbol,symboltyp);listederargumente:=neueliste(nil,nil);einfacherausdruck(listederargumente);IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp);newtermliste(listenanfang(listederargumente),listenende(listederargumente),1).verarbeitevariable:knoten:=listenposition(listedervariablen,symbol);IFknoten=nilTHENknoten:=alphasort(listedervariablen,symbol)END IF;nextsymbol(symbol,symboltyp)END PROCeinfacheselement;ABBILDUNG PROCparsekomplexefunktion(TEXT CONSTfunktionsstring):initialisieredenscanvorgang;linkehaelfte;verarbeitezuweisungssymbol;verarbeitenderfunktionsterme;eintragenderfunktion;abbildung(aktuellerabbildungsname).initialisieredenscanvorgang:scan(funktionsstring);nimmsymbol.linkehaelfte:testegueltigkeit;IFlistenposition(eigenefunktionen,symbol)<>nilTHENerrorstop(hinweisaufungueltigennamen)END IF;aktuellerabbildungsname:=symbol;nimmsymbol;IFsymbol<>doppelpunktsymbolTHENerrorstop(anwendungstext(15))END IF;nimmsymbol;variablenliste.verarbeitezuweisungssymbol:IFsymbol<>minussymbolTHENerrorstop(anwendungstext(32))END IF;nimmsymbol;IFsymbol<>groessersymbolTHENerrorstop(anwendungstext(32))END IF.verarbeitenderfunktionsterme:komplexeausdruecke(listederterme);IFsymboltyp<>7THENerrorstop(hinweisauffehlerhaftessymbol)END IF END PROCparsekomplexefunktion;PROCvariablenliste:testegueltigkeit;WHILEsymboltyp=bezeichnertypREPanhaengen(listedervariablen,newvariable(laenge(listedervariablen)+1,symbol));nimmsymbol;IFsymbol=kommasymbolTHENnimmsymbol;testegueltigkeitEND IF END REP END PROCvariablenliste;PROCkomplexeausdruecke(LISTE VARtermliste):REPnimmsymbol;IFsymbol=ifsymbolTHENeliferwartet:=FALSE;nimmsymbol;abschnittweisedefinierterkomplexertermELSEkomplexerarithmetischerausdruckEND IF;anhaengen(termliste,newterm(knoten))UNTILsymbol<>kommasymbolEND REP END PROCkomplexeausdruecke;PROCabschnittweisedefinierterkomplexerterm:knoten:=naechstekomplexeklausel;IFknoten=nilTHENerrorstop(hinweisauffehlerhaftessymbol)ELIFsymbol<>endifsymbolTHENerrorstop(anwendungstext(39))END IF;nimmsymbolEND PROCabschnittweisedefinierterkomplexerterm;TERM PROCnaechstekomplexeklausel:TERM VARbedingungszeiger,thenzeiger;IFsymbol=endifsymbolTHENnilELSE IFeliferwartetTHEN IFsymbol<>elifsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEeliferwartet:=TRUE END IF;komplexerarithmetischerausdruck;thenzeiger:=knoten;IFsymbol<>fuersymbolTHENerrorstop(anwendungstext(38))END IF;nimmsymbol;komplexebedingung;bedingungszeiger:=knoten;newselektion(bedingungszeiger,thenzeiger,naechstekomplexeklausel)END IF END PROCnaechstekomplexeklausel;PROCkomplexebedingung:TEXT VARoperator;TERM VARlinks;komplexeslogischeselement;WHILEsymbol=undsymbolCORsymbol=odersymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;komplexeslogischeselement;knoten:=newlogischedyade(links,knoten,operator)END REP END PROCkomplexebedingung;PROCkomplexeslogischeselement:IFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELSEverarbeitevergleichEND IF.verarbeitegeklammertenausdruck:nimmsymbol;komplexebedingung;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbol.verarbeitevergleich:TERM VARlinks;TEXT VARoperator;komplexerarithmetischerausdruck;IFsymbol<>kleinersymbolCANDsymbol<>kleinergleichsymbolCANDsymbol<>groessersymbolCANDsymbol<>groessergleichsymbolCANDsymbol<>ungleichsymbolCANDsymbol<>gleichsymbolTHENerrorstop(anwendungstext(40))END IF;operator:=symbol;links:=knoten;nimmsymbol;komplexerarithmetischerausdruck;knoten:=newvergleich(links,knoten,operator).END PROCkomplexeslogischeselement;PROCkomplexerarithmetischerausdruck:TEXT VARoperator;TERM VARlinks;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nimmsymbol;komplexerterm;knoten:=newmonade(knoten,operator)ELSEkomplexerterm;END IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=knoten;operator:=symbol;nimmsymbol; +komplexerterm;knoten:=newdyade(links,knoten,operator)END REP END PROCkomplexerarithmetischerausdruck;PROCkomplexerterm:TEXT VARoperator;TERM VARlinks;komplexerfaktor;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;komplexerfaktor;knoten:=newdyade(links,knoten,operator)END REP END PROCkomplexerterm;PROCkomplexerfaktor:TERM VARbasis;TEXT VARpotenzsymbol;komplexeselement;WHILEsymbol=allgemeinespotenzsymbolCORsymbol=speziellespotenzsymbolREPbasis:=knoten;nimmsymbol;komplexeselement;IFganzzahligerexponentTHENpotenzsymbol:=speziellespotenzsymbolELSEpotenzsymbol:=allgemeinespotenzsymbolEND IF;knoten:=newdyade(basis,knoten,potenzsymbol)END REP END PROCkomplexerfaktor;PROCkomplexeselement:IFsymboltyp=konstantentypCORsymbol=esymbolCORsymbol=pisymbolTHENverarbeitekonstanteELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFvariablenbezeichnerTHENverarbeitevariablenbezeichnerELSEverarbeitefunktionsauswertungEND IF.verarbeitekonstante:knoten:=newkonstante(wert,symbol);nimmsymbol.verarbeitegeklammertenausdruck:nimmsymbol;komplexerarithmetischerausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbol.variablenbezeichner:symboltyp=bezeichnertypCANDbezeichnerfuervariable.bezeichnerfuervariable:knoten:=listenposition(listedervariablen,symbol);knoten<>nil.verarbeitevariablenbezeichner:nimmsymbol.verarbeitefunktionsauswertung:INT VARtermzahl,variablenzahl,komponentenindex;TERM VARausdruckzeiger;abbildungsobjekt(termzahl,variablenzahl);ausdruckzeiger:=knoten;komponentenindex:=komponente(termzahl);argumentliste(variablenzahl);knoten:=newfunktionsauswertung(ausdruckzeiger,knoten,komponentenindex)END PROCkomplexeselement;BOOL VARelementeinerfunktionsverknuepfunggefunden;TEXT VARerlaubtervariablenname;PROCabbildungsobjekt(INT VARanzahlterme,anzahlvariablen):IFsymboltyp=bezeichnertypTHENverarbeitebezeichner;IFanzahlterme=1CANDanzahlvariablen=1THENeinfachesableitungsformatEND IF ELIFsymbol=funktionsklammeraufsymbolTHENverarbeitegeklammertenausdruck;einfachesableitungsformatELIFsymbol=differenziersymbolTHENverarbeiteallgemeinesableitungsformatELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitebezeichner:IFelementarefunktionCORselbstdefiniertefunktionTHENverarbeiteabbildungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.elementarefunktion:knoten:=listenposition(standardfunktionen,symbol);knoten<>nil.selbstdefiniertefunktion:knoten:=listenposition(eigenefunktionen,symbol);IFknoten<>nilCANDselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;knoten<>nil.verarbeiteabbildung:anzahlterme:=termanzahl(knoten);anzahlvariablen:=variablenanzahl(knoten);nimmsymbol.verarbeitegeklammertenausdruck:elementeinerfunktionsverknuepfunggefunden:=FALSE;nimmsymbol;abbildungsausdruck;IFsymbol<>funktionsklammerzusymbolTHENerrorstop(anwendungstext(35))END IF;anzahlterme:=1;anzahlvariablen:=1;nimmsymbol.verarbeiteallgemeinesableitungsformat:allgemeinesableitungsformat(anzahlvariablen);anzahlterme:=1.END PROCabbildungsobjekt;PROCeinfachesableitungsformat:WHILEsymbol=strichsymbolREP IFableitungsverbot(knoten)THENerrorstop(anwendungstext(56))END IF;knoten:=newableitungsoperation(knoten,defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol);nimmsymbolEND REP END PROCeinfachesableitungsformat;PROCallgemeinesableitungsformat(INT VARvariablenzahl):INT VARableitungsgrad,komponentenindex,termzahl;ABBILDUNG VARvergleichsabbildung;bestimmeableitungsgrad;bestimmeobjektderableitungsoperation;überlesebruchsymbol;bestimmevariablenundallokiereableitungspointer.bestimmeableitungsgrad:nimmsymbol;IFsymboltyp=konstantentypTHEN IFpos(symbol,dezimalpunktsymbol)<>0THENerrorstop(anwendungstext(47))END IF;ableitungsgrad:=int(symbol);IFableitungsgrad<1THENerrorstop(anwendungstext(47))END IF;nimmsymbolELSEableitungsgrad:=1END IF.bestimmeobjektderableitungsoperation:abbildungsobjekt(termzahl,variablenzahl);IFableitungsverbot(knoten)THEN +errorstop(anwendungstext(56))END IF;vergleichsabbildung:=vergleichsfunktion(knoten);komponentenindex:=komponente(termzahl).überlesebruchsymbol:IFsymbol<>bruchsymbolTHENerrorstop(anwendungstext(43))END IF;nimmsymbol.bestimmevariablenundallokiereableitungspointer:INT VARzaehler,variablenindex;FORzaehlerFROM1UPTOableitungsgradREPbestimmeabzuleitendevariable;trageableitungein;nimmsymbolEND REP;loeschetemporaereabbildung(vergleichsabbildung).bestimmeabzuleitendevariable:TERM VARvergleichszeiger;IFsymbol<>differenziersymbolTHENerrorstop(anwendungstext(44))END IF;nimmsymbol;vergleichszeiger:=listenposition(abbildungsvariablen(vergleichsabbildung),symbol);IFvergleichszeiger=nilTHENerrorstop(hinweisaufungueltigennamen)END IF;variablenindex:=PLATZvergleichszeiger.trageableitungein:TERM VARpruefterm;IFknotenISeigenefunktionTHENpruefterm:=(TERME DEFINITIONknoten)ELEMENTkomponentenindexELSEpruefterm:=knotenEND IF;knoten:=newableitungsoperation(knoten,variablenindex,komponentenindex,differenziersymbol).END PROCallgemeinesableitungsformat;PROCabbildungsausdruck:TEXT VARoperator;TERM VARlinks;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nimmsymbol;abbildungsterm;knoten:=newabbildungsmonade(knoten,operator)ELSEabbildungstermEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;abbildungsterm;knoten:=newabbildungsdyade(links,knoten,operator)END REP END PROCabbildungsausdruck;PROCabbildungsterm:TEXT VARoperator;TERM VARlinks;abbildungsverkettung;WHILE(symbol=multiplikationssymbol)COR(symbol=divisionssymbol)REPlinks:=knoten;operator:=symbol;nimmsymbol;abbildungsverkettung;knoten:=newabbildungsdyade(links,knoten,operator)END REP END PROCabbildungsterm;PROCabbildungsverkettung:TERM VARlinks;abbildungselement;WHILEsymbol=verkettungssymbolREPlinks:=knoten;nimmsymbol;abbildungselement;knoten:=newabbildungsdyade(links,knoten,verkettungssymbol)END REP END PROCabbildungsverkettung;PROCabbildungselement:IFsymboltyp=bezeichnertypTHENverarbeitebezeichner;einfachesableitungsformatELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruck;einfachesableitungsformatELIFsymbol=differenziersymbolTHEN INT VARanzahlvariablen:=1;allgemeinesableitungsformat(anzahlvariablen)ELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitebezeichner:TEXT VARneuervariablenname;IFelementarefunktionTHEN IF NOTelementeinerfunktionsverknuepfunggefundenTHENerlaubtervariablenname:=defaultstdfktvarname;elementeinerfunktionsverknuepfunggefunden:=TRUE ELIFerlaubtervariablenname<>defaultstdfktvarnameTHENerrorstop(anwendungstext(45))END IF ELIFselbstdefiniertefunktionTHEN IF(termanzahl(knoten)<>1)COR(variablenanzahl(knoten)<>1)THENerrorstop(anwendungstext(45))ELIFselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;neuervariablenname:=NAMElistenanfang(abbildungsvariablen(abbildung(symbol)));IF NOTelementeinerfunktionsverknuepfunggefundenTHENerlaubtervariablenname:=neuervariablenname;elementeinerfunktionsverknuepfunggefunden:=TRUE ELIFneuervariablenname<>erlaubtervariablennameTHENerrorstop(anwendungstext(45))END IF ELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol.elementarefunktion:knoten:=listenposition(standardfunktionen,symbol);knoten<>nil.selbstdefiniertefunktion:knoten:=listenposition(eigenefunktionen,symbol);IFselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;knoten<>nil.verarbeitegeklammertenausdruck:nimmsymbol;abbildungsausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbolEND PROCabbildungselement;INT PROCkomponente(INT CONSTtermzahl):INT VARkompwert:=defaultfuerkomponentenindex;IFtermzahl>1THEN IFsymbol<>selektionssymbolTHENerrorstop(anwendungstext(42))END IF;nimmsymbol;IFsymboltyp<>konstantentypCORpos(symbol,dezimalpunktsymbol)<>0THENerrorstop(anwendungstext(42))END IF;kompwert:=int(symbol);IFkompwert>termzahlCORkompwert<1THENerrorstop(anwendungstext(42))END IF;nimmsymbol +END IF;kompwertEND PROCkomponente;PROCargumentliste(INT CONSTnotwendigeargumentanzahl):LISTE VARlistederargumente;IFsymbol<>klammeraufsymbolTHENerrorstop(anwendungstext(37))END IF;listederargumente:=neueliste(nil,nil);REPnimmsymbol;komplexerarithmetischerausdruck;anhaengen(listederargumente,newterm(knoten))UNTILsymbol<>kommasymbolEND REP;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))ELIFlaenge(listederargumente)<>notwendigeargumentanzahlTHENerrorstop(anwendungstext(46))END IF;nimmsymbol;knoten:=newtermliste(listenanfang(listederargumente),listenende(listederargumente),laenge(listederargumente))END PROCargumentliste;BOOL PROCganzzahligerexponent:REAL VARhilfswert;IF(knotenISkonstante)COR((knotenISmonadisch)CAND(OPERANDknotenISkonstante))THEN IFknotenISkonstanteTHENhilfswert:=WERTknotenELSEhilfswert:=WERT OPERANDknotenEND IF;IFhilfswert>32767.0CORhilfswert<-32768.0THEN FALSE ELSEhilfswert=floor(hilfswert)END IF ELSE FALSE END IF END PROCganzzahligerexponent;PROCtestegueltigkeit:IFsymboltyp<>bezeichnertypCORlistenposition(standardfunktionen,symbol)<>nilCORsymbol=esymbolCORsymbol=pisymbolCORsymbol=aktuellerabbildungsnameTHENerrorstop(hinweisaufungueltigennamen)ELIFebene=2CAND(listenposition(listedervariablen,symbol)<>nil)THENerrorstop(anwendungstext(41))END IF END PROCtestegueltigkeit;REAL PROCwert:IFsymbol=esymbolTHENeELIFsymbol=pisymbolTHENpiELSEreal(symbol)END IF END PROCwert;PROCeintragenderfunktion:anhaengenaneigenefunktionen(neweigenefunktion(newfunktionsdefinition(newvariablenliste(listenanfang(listedervariablen),listenende(listedervariablen),laenge(listedervariablen)),newtermliste(listenanfang(listederterme),listenende(listederterme),laenge(listederterme))),aktuellerabbildungsname))END PROCeintragenderfunktion;ABBILDUNG PROCfunktionsaufruf(TEXT CONSTaufrufstring):TEXT VARfehlzeichen:=niltext;ABBILDUNG VARarbeitsobjekt;enablestop;scan(aufrufstring);symbolspeicher:=niltext;nimmsymbol;IFsymbol=niltextTHENerrorstop(anwendungstext(33))ELIFfehlerhaftebuchstabenvorhanden(aufrufstring,fehlzeichen)THENerrorstop(anwendungstext(170)+fehlzeichen)END IF;arbeitsobjekt:=funktionsterm;IFsymbol<>niltextTHENloeschetemporaereabbildung(arbeitsobjekt);errorstop(hinweisauffehlerhaftessymbol)END IF;arbeitsobjektEND PROCfunktionsaufruf;ABBILDUNG PROCfunktionsterm:TEXT VARoperator;ABBILDUNG VARlinks,rechts,result;IFsymbol=plussymbolTHENnimmsymbol;result:=funktionsfaktorELIFsymbol=minussymbolTHENnimmsymbol;result:=-funktionsfaktorELSEresult:=funktionsfaktorEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=result;operator:=symbol;nimmsymbol;rechts:=funktionsfaktor;IF NOTvariablenidentitaet(links,rechts)CORlaenge(abbildungsterme(links))<>laenge(abbildungsterme(rechts))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;IFoperator=plussymbolTHENresult:=links+rechtsELSEresult:=links-rechtsEND IF;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsterm;ABBILDUNG PROCfunktionsfaktor:TEXT VARoperator;ABBILDUNG VARlinks,rechts,result:=funktionsverkettung;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPoperator:=symbol;links:=result;nimmsymbol;rechts:=funktionsverkettung;IF NOTvariablenidentitaet(links,rechts)COR(laenge(abbildungsterme(rechts))<>laenge(abbildungsterme(links)))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;IFoperator=multiplikationssymbolTHENresult:=links*rechtsELSE IFebene=2CANDlaenge(abbildungsterme(links))<>1THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;result:=links/rechtsEND IF;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsfaktor;ABBILDUNG PROCfunktionsverkettung:ABBILDUNG VARlinks,rechts,result:=funktionselement;WHILEsymbol=verkettungssymbolREPlinks:=result;nimmsymbol;rechts:=funktionselement;IFlaenge(abbildungsvariablen( +links))<>laenge(abbildungsterme(rechts))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;result:=linksOrechts;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsverkettung;ABBILDUNG PROCfunktionselement:ABBILDUNG VARelement;IF(listenposition(standardfunktionen,symbol)<>nil)COR(listenposition(eigenefunktionen,symbol)<>nil)THENverarbeitebezeichnerELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFebene=2CANDsymbol=differenziersymbolTHENelement:=komplexefunktionsableitungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;element.verarbeitebezeichner:element:=abbildung(symbol);IFebene=1COR(laenge(abbildungsterme(element))=1CANDlaenge(abbildungsvariablen(element))=1CAND NOTableitungsverbot(adresse(element)))THENelement:=einfachefunktionsableitung(element)ELSEnimmsymbolEND IF.verarbeitegeklammertenausdruck:nimmsymbol;element:=funktionsterm;IFsymbol<>klammerzusymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;IFebene=1COR(laenge(abbildungsterme(element))=1CANDlaenge(abbildungsvariablen(element))=1CAND NOTableitungsverbot(adresse(element)))THENelement:=einfachefunktionsableitung(element)ELSEnimmsymbolEND IF END PROCfunktionselement;ABBILDUNG PROCeinfachefunktionsableitung(ABBILDUNG VARelement):ABBILDUNG VARobjekt;nimmsymbol;WHILEsymbol=strichsymbolREPobjekt:=element;element:=ableitung(objekt,1,1);loeschetemporaereabbildung(objekt);nimmsymbolEND REP;elementEND PROCeinfachefunktionsableitung;ABBILDUNG PROCkomplexefunktionsableitung:ABBILDUNG VARelement,objekt;INT VARableitungsgrad,komponentenindex,variablenindex,i;bestimmeableitungsgrad;bestimmeobjektderableitung;leiteab;element.bestimmeableitungsgrad:nimmsymbol;IFpos(symbol,punktsymbol)<>0THENerrorstop(hinweisauffehlerhaftessymbol)ENDIF;ableitungsgrad:=int(symbol);IFlastconversionokTHEN IFableitungsgrad<1THENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEableitungsgrad:=1END IF.bestimmeobjektderableitung:IF(listenposition(standardfunktionen,symbol)<>nil)COR(listenposition(eigenefunktionen,symbol)<>nil)THENobjekt:=abbildung(symbol);IFlaenge(abbildungsvariablen(objekt))=1CANDlaenge(abbildungsterme(objekt))=1CAND NOTableitungsverbot(adresse(objekt))THENobjekt:=einfachefunktionsableitung(objekt)ELSEnimmsymbolEND IF ELIFsymbol=funktionsklammeraufsymbolTHENnimmsymbol;objekt:=funktionsterm;IFsymbol<>funktionsklammerzusymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;IFlaenge(abbildungsvariablen(objekt))=1CANDlaenge(abbildungsterme(objekt))=1CAND NOTableitungsverbot(adresse(objekt))THENobjekt:=einfachefunktionsableitung(objekt)ELSEnimmsymbolEND IF ELIFsymbol=differenziersymbolTHENobjekt:=komplexefunktionsableitungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;IFlaenge(abbildungsterme(objekt))>1THEN IFsymbol<>selektionssymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol;komponentenindex:=int(symbol);IF NOTlastconversionokTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEkomponentenindex:=1END IF;IFableitungsverbot(adresse(objekt))THENerrorstop(anwendungstext(56))END IF.leiteab:TERM VARsuchterm;INT VARtempkompindex:=komponentenindex;IFsymbol<>bruchsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol;FORiFROM1UPTOableitungsgradREP IFi>1THENtempkompindex:=1END IF;IFsymbol<>differenziersymbolTHENerrorstop(anwendungstext(43))END IF;nimmsymbol;suchterm:=listenposition(abbildungsvariablen(objekt),symbol);IFsuchterm=nilTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;variablenindex:=PLATZsuchterm;element:=ableitung(objekt,tempkompindex,variablenindex);loeschetemporaereabbildung(objekt);objekt:=element;nimmsymbolEND REP END PROCkomplexefunktionsableitung;PROCnimmsymbol:TEXT VARsym1,sym2;INT VARtyp1,typ2;besorgedaserstesymbol;besorgegegebenenfallseinzweitessymbol;reichesymbolundtypnachaussen.besorgedaserstesymbol:IFspeichergefuelltTHENverarbeitespeicher;loeschespeicherELSEnextsymbol(sym1,typ1);END IF. +speichergefuellt:symbolspeicher<>niltext.verarbeitespeicher:sym1:=symbolspeicher;typ1:=speichertyp.loeschespeicher:symbolspeicher:=niltext;speichertyp:=0.besorgegegebenenfallseinzweitessymbol:IFsym1=klammeraufsymbolTHENnextsymbol(sym2,typ2);IFsym2=punktsymbolTHENsym1:=funktionsklammeraufsymbol;typ1:=begrenzertypELSEfuellespeicherEND IF ELIFsym1=punktsymbolTHENnextsymbol(sym2,typ2);IFsym2=klammerzusymbolTHENsym1:=funktionsklammerzusymbol;typ1:=begrenzertypELSEfuellespeicherEND IF END IF.fuellespeicher:symbolspeicher:=sym2;speichertyp:=typ2.reichesymbolundtypnachaussen:symbol:=sym1;symboltyp:=typ1END PROCnimmsymbol;BOOL PROCfehlerhaftebuchstabenvorhanden(TEXT CONSTt,TEXT VARz):LETanzahlfehler=8;ROWanzahlfehlerTEXT CONSTungueltigezeichen:=ROWanzahlfehlerTEXT:("ä","ö","ü","ß","{","}","(*","*)");INT VARi;z:=niltext;FORiFROM1UPTOanzahlfehlerREP IFpos(t,ungueltigezeichen(i))<>0THENzCATungueltigezeichen(i)END IF END REP;z<>niltextEND PROCfehlerhaftebuchstabenvorhanden;TEXT PROChinweisauffehlerhaftessymbol:anwendungstext(36)+strichsymbol+symbol+strichsymbolEND PROChinweisauffehlerhaftessymbol;TEXT PROChinweisaufungueltigennamen:anwendungstext(31)+strichsymbol+symbol+strichsymbolEND PROChinweisaufungueltigennamen;BOOL VARlinear;FILE VARfktdat;TEXT PROCfunktionsstring(ABBILDUNG CONSTfkt):linear:=TRUE;fktstring(fkt)END PROCfunktionsstring;TEXT PROCformel(ABBILDUNG CONSTfkt):linear:=FALSE;fktstring(fkt)END PROCformel;TEXT PROCfktstring(ABBILDUNG CONSTfunktion):enablestop;pruefeparameter;erstellefunktionsstring;reichetextnachaussen.pruefeparameter:TERM VARsuchterm:=adresse(funktion);IFsuchterm=nilTHENerrorstop(anwendungstext(48))END IF.erstellefunktionsstring:sammletextbestandteileindatei;wandledateiintextum.sammletextbestandteileindatei:TEXT CONSTdatname:=scratchdateiname;fktdat:=sequentialfile(output,datname);disablestop;darstellung(suchterm);IFiserrorTHENclearerror;enablestop;forget(datname,quiet);errorstop(anwendungstext(49))END IF;enablestop.wandledateiintextum:TEXT VARstring:=niltext,zeile;input(fktdat);WHILE NOTeof(fktdat)REPgetline(fktdat,zeile);stringCATzeileEND REP;forget(datname,quiet).reichetextnachaussen:stringEND PROCfktstring;PROCdarstellung(TERM CONSTterm):enablestop;IFtermISeigenefunktionTHENgibfunktionsnamenausEND IF;variablenausgabe;gibzuweisungssymbolaus;gibtermlisteaus.gibfunktionsnamenaus:write(fktdat,NAMEterm);write(fktdat,doppelpunktsymbol).variablenausgabe:giberstevariableaus;IFebene=2THENgibweiterevariablenausEND IF.giberstevariableaus:TERM VARlaufterm:=LISTENANFANG VARIABLEN DEFINITIONterm;write(fktdat,NAMElaufterm).gibweiterevariablenaus:laufterm:=nachfolger(laufterm);WHILElaufterm<>nilREPwrite(fktdat,kommasymbol);write(fktdat,NAMElaufterm);laufterm:=nachfolger(laufterm)END REP.gibzuweisungssymbolaus:put(fktdat,blank+zuweisungssymbol).gibtermlisteaus:ausgabederterme(LISTENANFANG TERME DEFINITIONterm)END PROCdarstellung;PROCausgabederterme(TERM CONSTlaufterm):IFlaufterm<>nilTHENausgabe(AUSDRUCKlaufterm);IFnachfolger(laufterm)<>nilTHENput(fktdat,kommasymbol);ausgabederterme(nachfolger(laufterm))END IF END IF END PROCausgabederterme;PROCausgabe(TERM CONSTterm):TEXT VARoperator;TERM VARoperand;BOOL VARunsichtbareklammernnoetig;IF(termISstandardfunktion)COR(termISeigenefunktion)COR(termISvariable)THENgibnamenausELIFtermISkonstanteTHENgibkonstanteausELIFtermISdyadischTHENgibdyadeausELIFtermISmonadischTHENgibmonadeausELIFtermISfunktionsauswertungTHENgibfunktionsauswertungausELIFtermISableitungsoperationTHENgibableitungsoperationausELIFtermISabbildungsdyadeTHENgibabbildungsdyadeausELIFtermISabbildungsmonadeTHENgibabbildungsmonadeausELIFtermISselektionTHENgibselektionausELIFtermISlogischedyadeTHENgiblogischedyadeausELIFtermISvergleichTHENgibvergleichausELSEerrorstop(anwendungstext(49))END IF.gibnamenaus:write(fktdat,NAMEterm).gibkonstanteaus:REAL VARwert:=WERTterm;IF(NAMEterm=esymbol)COR(NAMEterm=pisymbol)THENwrite(fktdat,NAMEterm)ELIFwert=floor(wert)CANDwert<=32767.0CANDwert>=-32768.0THENwrite(fktdat,text(int(wert)))ELSE +write(fktdat,text(wert))END IF.gibdyadeaus:operator:=OPERATIONterm;operand:=LINKSterm;unsichtbareklammernnoetig:=NOTlinearCAND(operator=divisionssymbolCORoperator=allgemeinespotenzsymbolCORoperator=speziellespotenzsymbol);IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFlinkeklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF;IFoperator=allgemeinespotenzsymbolTHENput(fktdat,blank+speziellespotenzsymbol)ELSEput(fktdat,blank+operator)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;operand:=RECHTSterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF.gibmonadeaus:operator:=OPERATIONterm;write(fktdat,operator);operand:=OPERANDterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF.gibfunktionsauswertungaus:operand:=ABBILDUNGSAUSDRUCKterm;IF(operandISabbildungsdyade)COR(operandISabbildungsmonade)THENwrite(fktdat,funktionsklammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,funktionsklammerzusymbol)ELSEausgabe(operand)END IF;IF(operandISeigenefunktion)CANDlaenge(abbildungsterme(abbildung(NAMEoperand)))>1THENput(fktdat,selektionssymbol+text(KOMPONENTEterm))END IF;IF NOTlinearTHENwrite(fktdat,funktionsauswertungssymbol)END IF;write(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabederterme(LISTENANFANG ARGUMENTEterm);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol).gibableitungsoperationaus:bestimmeanzahlderableitungen;operator:=OPERATIONterm;IFoperator=strichsymbolTHENgibeinfachesableitungsformatausELSEgibkomplexesableitungsformatausEND IF.bestimmeanzahlderableitungen:INT VARableitungsgrad:=1,komponentenindex:=KOMPONENTEterm;operand:=ABBILDUNGSAUSDRUCKterm;WHILEoperandISableitungsoperationREPkomponentenindex:=KOMPONENTEoperand;operand:=ABBILDUNGSAUSDRUCKoperand;ableitungsgradINCR1END REP.gibeinfachesableitungsformataus:IF(operandISeigenefunktion)COR(operandISstandardfunktion)THENausgabe(operand)ELSEwrite(fktdat,funktionsklammeraufsymbol);ausgabe(operand);write(fktdat,funktionsklammerzusymbol)END IF;write(fktdat,ableitungsgrad*strichsymbol).gibkomplexesableitungsformataus:ABBILDUNG VARvergleichsabbildung;IF NOTlinearTHENwrite(fktdat,unsichtbareklammerauf);write(fktdat,diffklammeraufsymbol)END IF;write(fktdat,differenziersymbol);IFableitungsgrad<>1THENwrite(fktdat,text(ableitungsgrad))END IF;write(fktdat,blank);IF(operandISabbildungsdyade)COR(operandISabbildungsmonade)THENwrite(fktdat,funktionsklammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,funktionsklammerzusymbol)ELSEausgabe(operand);IF NOT((operandISstandardfunktion)COR(laenge(abbildungsterme(abbildung(NAMEoperand)))=1))THENwrite(fktdat,selektionssymbol+text(komponentenindex))END IF END IF;IFlinearTHENwrite(fktdat,bruchsymbol);ELSEwrite(fktdat,unsichtbareklammerzu);write(fktdat,bruchsymbol+blank)END IF;vergleichsabbildung:=vergleichsfunktion(operand);ableitungsvariablenausgabe(term,abbildungsvariablen(vergleichsabbildung));IF NOTlinearTHENwrite(fktdat,diffklammerzusymbol)END IF;loeschetemporaereabbildung(vergleichsabbildung).gibabbildungsdyadeaus:operator:=OPERATIONterm;operand:=LINKSterm;unsichtbareklammernnoetig:=NOTlinearCANDoperator=divisionssymbol; +IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFlinkeklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF;put(fktdat,blank+operator);operand:=RECHTSterm;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF.gibabbildungsmonadeaus:operator:=OPERATIONterm;write(fktdat,operator);operand:=OPERANDterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF.gibselektionaus:IFlinearTHENput(fktdat,ifsymbol);ausgabe(AKTIONterm);put(fktdat,blank+fuersymbol);ausgabe(BEDINGUNGterm);operand:=ALTERNATIVEterm;WHILEoperand<>nilREPput(fktdat,blank+elifsymbol);ausgabe(AKTIONoperand);put(fktdat,blank+fuersymbol);ausgabe(BEDINGUNGoperand);operand:=ALTERNATIVEoperandEND REP;write(fktdat,blank+endifsymbol)ELSEwrite(fktdat,selektionsklammeraufsymbol);ausgabe(AKTIONterm);write(fktdat,selektionsfuersymbol);ausgabe(BEDINGUNGterm);operand:=ALTERNATIVEterm;WHILEoperand<>nilREPwrite(fktdat,selektionselifsymbol);ausgabe(AKTIONoperand);write(fktdat,selektionsfuersymbol);ausgabe(BEDINGUNGoperand);operand:=ALTERNATIVEoperandEND REP;write(fktdat,selektionsklammerzusymbol)END IF.giblogischedyadeaus:ausgabe(LINKSterm);put(fktdat,blank+OPERATIONterm);IF(RECHTSterm)ISlogischedyadeTHENwrite(fktdat,klammeraufsymbol);ausgabe(RECHTSterm);write(fktdat,klammerzusymbol)ELSEausgabe(RECHTSterm)END IF.gibvergleichaus:ausgabe(LINKSterm);put(fktdat,blank+OPERATIONterm);ausgabe(RECHTSterm)END PROCausgabe;PROCableitungsvariablenausgabe(TERM CONSTterm,LISTE CONSTvglvariablenliste):IF(ABBILDUNGSAUSDRUCKterm)ISableitungsoperationTHENableitungsvariablenausgabe(ABBILDUNGSAUSDRUCKterm,vglvariablenliste)END IF;write(fktdat,differenziersymbol+NAME(auswahl(vglvariablenliste,INDEXterm)))END PROCableitungsvariablenausgabe;BOOL PROClinkeklammernnoetig(TERM CONSToperand,TEXT CONSToperator):IF NOTlinearCANDoperator=divisionssymbolTHEN FALSE ELSEregel1CORregel2END IF.regel1:((operandISdyadisch)COR(operandISabbildungsdyade))CAND(prioritaet(OPERATIONoperand)bezeichnertypTHENerrorstop(anwendungstext(31))END IF;nextsymbol(symbol);IFsymbol<>niltextTHENerrorstop(anwendungstext(31))END IF.ueberpruefegueltigkeitdesnamens:TEXT VARzk;IFfehlerhaftebuchstabenvorhanden(name,zk)COR(name=esymbol)COR(name=pisymbol)COR(listenposition(standardfunktionen,name)<>nil)THENerrorstop(anwendungstext(31))ELIFlistenposition(abbildungsvariablen(f),name)<>nilTHENerrorstop(anwendungstext(3))ELIFlistenposition(eigenefunktionen,name)<>nilTHENerrorstop(anwendungstext(60))END IF.fuehreaktionaus:anhaengenaneigenefunktionen(neweigenefunktion(DEFINITIONeintrag,name));entfernenaustemporaerenfunktionen(eintrag);LOESCHEeintragEND PROCgibnamen;PROCloescheunreferenzierteabbildung(TEXT CONSTfunktionsname):enablestop;TERM VAReintrag:=listenposition(eigenefunktionen,funktionsname);IFreferenziertefunktion(eintrag)THENerrorstop(NAMEeintrag+anwendungstext(71))END IF;loeschebenannteabbildung(funktionsname)END PROCloescheunreferenzierteabbildung;BOOL PROCreferenziertefunktion(TERM CONSTeintrag):TERM VARlaufterm:=listenanfang(eigenefunktionen);BOOL VARreferenziert:=FALSE;WHILE(laufterm<>nil)CAND NOTreferenziertREP IFlaufterm<>eintragTHENreferenziert:=durchsuchteliste(LISTENANFANG TERME DEFINITIONlaufterm,eintrag)END IF;laufterm:=nachfolger(laufterm)END REP;IF NOTreferenziertTHENlaufterm:=listenanfang(temporaerefunktionen);WHILE(laufterm<>nil)CAND NOTreferenziertREPreferenziert:=durchsuchteliste(LISTENANFANG TERME DEFINITIONlaufterm,eintrag);laufterm:=nachfolger(laufterm);END REP END IF;referenziertEND PROCreferenziertefunktion;BOOL PROCdurchsuchteliste(TERM CONSTterm,eintrag):durchsuchterterm(AUSDRUCKterm,eintrag)COR((nachfolger(term)<>nil)CANDdurchsuchteliste(nachfolger(term),eintrag))END PROCdurchsuchteliste;BOOL PROCdurchsuchterterm(TERM CONSTterm,eintrag):IFtermISeigenefunktionTHENterm=eintragELIF(termISdyadisch)COR(termISlogischedyade)COR(termISvergleich)COR(termISabbildungsdyade)THENdurchsuchterterm(LINKSterm,eintrag)CORdurchsuchterterm(RECHTSterm,eintrag)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENdurchsuchterterm(OPERANDterm,eintrag)ELIFtermISfunktionsauswertungTHEN((ABBILDUNGSAUSDRUCKterm)=eintrag)CORdurchsuchterterm(ABBILDUNGSAUSDRUCKterm,eintrag)CORdurchsuchteliste(LISTENANFANG ARGUMENTEterm,eintrag)ELIFtermISableitungsoperationTHENdurchsuchterterm(ABBILDUNGSAUSDRUCKterm,eintrag)ELIFtermISselektionTHENdurchsuchterterm(BEDINGUNGterm,eintrag)CORdurchsuchterterm(AKTIONterm,eintrag)CORdurchsuchterterm(ALTERNATIVEterm,eintrag)ELSE FALSE END IF END PROCdurchsuchterterm;THESAURUS PROCfunktionsnamenthesaurus:THESAURUS VARthes:=emptythesaurus;TERM VARfunktion:=listenanfang(eigenefunktionen);WHILEfunktion<>nilREPinsert(thes,NAMEfunktion);funktion:=nachfolger(funktion)END REP;thesEND PROCfunktionsnamenthesaurus;THESAURUS PROCstandardfunktionsthesaurus:THESAURUS VARthes:=emptythesaurus;TERM VARfunktion:=listenanfang(standardfunktionen);WHILEfunktion<>nilREPinsert(thes,NAMEfunktion);funktion:=nachfolger(funktion)END REP;thesEND PROCstandardfunktionsthesaurus;END PACKETparser + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.picture b/app/schulis-mathematiksystem/1.0/src/mat.picture new file mode 100644 index 0000000..e6af50f --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.picture @@ -0,0 +1,2 @@ +PACKETpictureDEFINES PICTURE,:=,nilpicture,move,draw,length,pen,plot,cmfaktor:LETdrawkey=1,movekey=2,textkey=3,max2dim=31983,maxtext=31974;TYPE PICTURE=STRUCT(INTpen,TEXTpoints);INT VARreadpos;REAL VARfak:=1.0;TEXT VARr2:=16*"�",r3:=24*"�",i1:="��";OP:=(PICTURE VARl,PICTURE CONSTr):CONCR(l):=CONCR(r)END OP:=;PICTURE PROCnilpicture:PICTURE:(1,"")END PROCnilpicture;PROCdraw(PICTURE VARp,TEXT CONSTtext):draw(p,text,0.0,0.0,0.0)END PROCdraw;PROCdraw(PICTURE VARp,TEXT CONSTt,REAL CONSTangle,height,bright):write(p,t,angle,height,bright,textkey)END PROCdraw;PROCwrite(PICTURE VARp,TEXT CONSTt,REAL CONSTangle,height,bright,INT CONSTkey):IFmaxtext-length(p.points)>=length(t)THENp.pointsCATcode(key);replace(i1,1,length(t));p.pointsCATi1;p.pointsCATt;replace(r3,1,angle);replace(r3,2,height);replace(r3,3,bright);p.pointsCATr3FI END PROCwrite;PROCmove(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movekey)END PROCmove;PROCdraw(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawkey)END PROCdraw;PROCwrite(PICTURE VARp,REAL CONSTx,y,INT CONSTkey):IFlength(p.points)16THENerrorstop("pen out of range [0-16]")END IF;p.pen:=penEND PROCpen;INT PROCpen(PICTURE CONSTp):p.penEND PROCpen;INT PROClength(PICTURE CONSTp):length(p.points)END PROClength;PROCplot(PICTURE CONSTp):INT CONSTpiclength:=length(p.points);readpos:=0;plottwodimpic.plottwodimpic:WHILEreadpos,:=,nil,lowlevel,highlevel,ebene,initialisieren,neueliste,anhaengen,nachfolger,listenanfang,listenende,laenge,auswahl,standardfunktionen,eigenefunktionen,temporaerefunktionen,listenposition,termanzahl,variablenanzahl,anhaengenaneigenefunktionen,anhaengenantemporaerefunktionen,entfernenauseigenenfunktionen,entfernenaustemporaerenfunktionen,alphasort,variablenidentitaet,standardfunktion,eigenefunktion,temporaerefunktion,funktionsdefinition,variablenliste,variable,termliste,ausdruck,dyadisch,monadisch,funktionsauswertung,abbildungsdyade,abbildungsmonade,ableitungsoperation,konstante,selektion,logischedyade,vergleich,neweigenefunktion,newtemporaerefunktion,newfunktionsdefinition,newvariablenliste,newvariable,newtermliste,newterm,newdyade,newmonade,newfunktionsauswertung,newabbildungsdyade,newabbildungsmonade,newableitungsoperation,newkonstante,newselektion,newlogischedyade,newvergleich,LOESCHE,IS,LINKS,RECHTS,OPERAND,WERT,OPERATION,NAME,ARGUMENTE,DEFINITION,TERME,VARIABLEN,PLATZ,LISTENANFANG,LISTENENDE,LAENGE,ELEMENT,ABBILDUNGSAUSDRUCK,KOMPONENTE,INDEX,AUSDRUCK,BEDINGUNG,AKTION,ALTERNATIVE:LETtabellengroesse=16000,OBJEKTTABELLE=STRUCT(TERMzeigerauffreientabellenplatz,LISTElistederstandardfunktionen,listeeigenerfunktionen,listetemporaererfunktionen,dummyROWtabellengroesseTEXTzeile);TYPE TERM=INT,LISTE=STRUCT(TERManfang,ende,INTlaenge),ART=INT;TERM CONSTwurzel:=TERM:(tabellengroesse),nil:=TERM:(0);ART CONSTstandardfunktion:=ART:(1),eigenefunktion:=ART:(2),temporaerefunktion:=ART:(3),funktionsdefinition:=ART:(4),variablenliste:=ART:(5),variable:=ART:(6),termliste:=ART:(7),ausdruck:=ART:(8),dyadisch:=ART:(9),monadisch:=ART:(10),funktionsauswertung:=ART:(11),abbildungsdyade:=ART:(12),abbildungsmonade:=ART:(13),ableitungsoperation:=ART:(14),konstante:=ART:(15),selektion:=ART:(16),logischedyade:=ART:(17),vergleich:=ART:(18);BOUND OBJEKTTABELLE VARtabelle;TEXT VARdatenraumname:="mathematikobjekte 1";TEXT CONSTtextvonnil:=textvon(nil);OP:=(TERM VARlinks,TERM CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;BOOL OP=(TERM CONSTlinks,rechts):CONCR(links)=CONCR(rechts)END OP=;BOOL OP<>(TERM CONSTlinks,rechts):CONCR(links)<>CONCR(rechts)END OP<>;OP:=(LISTE VARlinks,LISTE CONSTrechts):links.anfang:=rechts.anfang;links.ende:=rechts.ende;links.laenge:=rechts.laengeEND OP:=;TERM PROClistenanfang(LISTE CONSTliste):liste.anfangEND PROClistenanfang;TERM PROClistenende(LISTE CONSTliste):liste.endeEND PROClistenende;INT PROClaenge(LISTE CONSTliste):liste.laengeEND PROClaenge;LISTE PROCneueliste(TERM CONSTanfang,ende):LISTE VARliste;initialisierediezeiger;bestimmelistenlaenge;liste.initialisierediezeiger:liste.anfang:=anfang;liste.ende:=ende.bestimmelistenlaenge:TERM VARzeiger:=liste.anfang;liste.laenge:=0;WHILEzeiger<>nilREPliste.laengeINCR1;zeiger:=nachfolger(zeiger)END REP END PROCneueliste;PROCanhaengen(LISTE VARliste,TERM CONSTneueselement):IFneueselement=nilTHENerrorstop(anwendungstext(1))END IF;IFleerelisteTHENliste.anfang:=neueselementELSEliste.endeZEIGTAUFneueselementEND IF;liste.ende:=neueselement;neueselementZEIGTAUFnil;liste.laengeINCR1.leereliste:liste.laenge=0END PROCanhaengen;PROCentfernen(LISTE VARliste,TERM CONSTloeschelement):IF(loeschelement=nil)CORleerelisteTHENerrorstop(anwendungstext(1))ELIFloeschelement=liste.anfangTHENliste.anfang:=nachfolger(liste.anfang);IFliste.laenge=1THENliste.ende:=nilEND IF ELIFloeschelement=listenende(liste)THENliste.ende:=vorgaenger(liste,loeschelement);vorgaenger(liste,loeschelement)ZEIGTAUFnilELSEvorgaenger(liste,loeschelement)ZEIGTAUFnachfolger(loeschelement)END IF;loeschelementZEIGTAUFnil;liste.laengeDECR1.leereliste:liste.laenge=0END PROCentfernen;TERM PROCnachfolger(TERM CONSTp):TERM VARnaechster;IF(p=nil)COR(tabelle.zeile(CONCR(p))="")THENerrorstop(anwendungstext(1))END IF;CONCR(naechster):=subtext(tabelle.zeile(CONCR(p)),2)ISUB1;naechsterEND PROCnachfolger;TERM PROCvorgaenger(LISTE CONSTliste,TERM CONSTzeiger):TERM VARlaufterm,merker;IF(zeiger=liste. +anfang)COR(liste.laenge<=1)THENerrorstop(anwendungstext(4))END IF;laufterm:=liste.anfang;WHILE(laufterm<>zeiger)CAND(laufterm<>nil)REP IFlaufterm<>zeigerTHENmerker:=laufterm;laufterm:=nachfolger(laufterm)END IF END REP;IFlaufterm=nilTHENerrorstop(anwendungstext(4))END IF;merkerEND PROCvorgaenger;OP ZEIGTAUF(TERM CONSTlinks,rechts):IFlinks=nilTHENerrorstop(anwendungstext(1))END IF;replace(tabelle.zeile(CONCR(links)),2,textvon(rechts))END OP ZEIGTAUF;TERM PROCauswahl(LISTE CONSTliste,INT CONSTgewuenschteselement):TERM VARsuchzeiger:=listenanfang(liste);INT VARi;IFlaenge(liste)nil)REP IFnameohneblanks=NAMEsuchzeigerTHEN LEAVElistenpositionWITHsuchzeigerELSEsuchzeiger:=nachfolger(suchzeiger)END IF END REP;suchzeigerEND PROClistenposition;INT PROCtermanzahl(TERM CONSTabbildungszeiger):IFabbildungszeigerISstandardfunktionTHEN1ELIF(abbildungszeigerISeigenefunktion)COR(abbildungszeigerIStemporaerefunktion)THEN LAENGE TERME DEFINITIONabbildungszeigerELSEerrorstop(anwendungstext(5));1END IF END PROCtermanzahl;INT PROCvariablenanzahl(TERM CONSTabbildungszeiger):IFabbildungszeigerISstandardfunktionTHEN1ELIF(abbildungszeigerISeigenefunktion)COR(abbildungszeigerIStemporaerefunktion)THEN LAENGE VARIABLEN DEFINITIONabbildungszeigerELSEerrorstop(anwendungstext(6));1END IF END PROCvariablenanzahl;LISTE PROCstandardfunktionen:tabelle.listederstandardfunktionenEND PROCstandardfunktionen;LISTE PROCeigenefunktionen:tabelle.listeeigenerfunktionenEND PROCeigenefunktionen;LISTE PROCtemporaerefunktionen:tabelle.listetemporaererfunktionenEND PROCtemporaerefunktionen;PROCanhaengenanstandardfunktionen(TERM CONSTneueselement):anhaengen(tabelle.listederstandardfunktionen,neueselement)END PROCanhaengenanstandardfunktionen;PROCanhaengenaneigenefunktionen(TERM CONSTneueselement):anhaengen(tabelle.listeeigenerfunktionen,neueselement)END PROCanhaengenaneigenefunktionen;PROCanhaengenantemporaerefunktionen(TERM CONSTneueselement):anhaengen(tabelle.listetemporaererfunktionen,neueselement)END PROCanhaengenantemporaerefunktionen;PROCentfernenauseigenenfunktionen(TERM CONSTzeiger):entfernen(tabelle.listeeigenerfunktionen,zeiger)END PROCentfernenauseigenenfunktionen;PROCentfernenaustemporaerenfunktionen(TERM CONSTzeiger):entfernen(tabelle.listetemporaererfunktionen,zeiger)END PROCentfernenaustemporaerenfunktionen;TERM PROCalphasort(LISTE VARliste,TEXT CONSTvariablenname):testeparameter;sortiereein.testeparameter:IF NOT((liste.anfang<>nil)CAND(liste.anfangISvariable))THENerrorstop(anwendungstext(1))END IF.sortiereein:TERM VARvorgaenger:=liste.anfang,lauf:=nachfolger(vorgaenger),neuerterm;INT VARanzahl:=2;WHILE(lauf<>nil)CAND(NAMElauf)nilREPanzahlINCR1;replace(tabelle.zeile(CONCR(lauf)),4,textvon(anzahl));lauf:=nachfolger(lauf)END REP END IF;liste.laenge:=anzahl;neuertermEND PROCalphasort;BOOL PROCvariablenidentitaet(LISTE CONSTlinks,rechts):laenge(links)=laenge(rechts)CANDidentischenamen.identischenamen:TERM VARlauf1:=listenanfang(links),lauf2:=listenanfang(rechts)WHILElauf2<>nilREP IF(NAMElauf1<>NAMElauf2)THEN LEAVEvariablenidentitaetWITH FALSE END IF;lauf1:=nachfolger(lauf1);lauf2:=nachfolger(lauf2)END REP;TRUE END PROCvariablenidentitaet;TERM PROCnewstandardfunktion(TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewstandardfunktion;TERM PROC +neweigenefunktion(TERM CONSTdefinition,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(definition);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCneweigenefunktion;TERM PROCnewtemporaerefunktion(TERM CONSTdefinition):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(definition);neuertermEND PROCnewtemporaerefunktion;TERM PROCnewfunktionsdefinition(TERM CONSTvariablenliste,termliste):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(variablenliste);tabelle.zeile(CONCR(neuerterm))CATtextvon(termliste);neuertermEND PROCnewfunktionsdefinition;TERM PROCnewvariablenliste(TERM CONSTerstevariable,letztevariable,INT CONSTlaenge):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(erstevariable);tabelle.zeile(CONCR(neuerterm))CATtextvon(letztevariable);tabelle.zeile(CONCR(neuerterm))CATtextvon(laenge);neuertermEND PROCnewvariablenliste;TERM PROCnewvariable(INT CONSTposition,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(position);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewvariable;TERM PROCnewtermliste(TERM CONSTersterterm,letzterterm,INT CONSTlaenge):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(ersterterm);tabelle.zeile(CONCR(neuerterm))CATtextvon(letzterterm);tabelle.zeile(CONCR(neuerterm))CATtextvon(laenge);neuertermEND PROCnewtermliste;TERM PROCnewterm(TERM CONSTarithmetischerausdruck):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(arithmetischerausdruck);neuertermEND PROCnewterm;TERM PROCnewdyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewdyade;TERM PROCnewmonade(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):=" +";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(operand);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewmonade;TERM PROCnewfunktionsauswertung(TERM CONSTabbildungsausdruck,argumentliste,INT CONSTkomponente):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(abbildungsausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(argumentliste);tabelle.zeile(CONCR(neuerterm))CATtextvon(komponente);neuertermEND PROCnewfunktionsauswertung;TERM PROCnewabbildungsdyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewabbildungsdyade;TERM PROCnewabbildungsmonade(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):=" ";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(operand);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewabbildungsmonade;TERM PROCnewableitungsoperation(TERM CONST +abbildungsausdruck,INT CONSTvariable,komponente,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(abbildungsausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(variable);tabelle.zeile(CONCR(neuerterm))CATtextvon(komponente);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewableitungsoperation;TERM PROCnewkonstante(REAL CONSTwert,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(wert);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewkonstante;TERM PROCnewselektion(TERM CONSTbedingung,ausdruck,naechsteselektion):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(bedingung);tabelle.zeile(CONCR(neuerterm))CATtextvon(ausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(naechsteselektion);neuertermEND PROCnewselektion;TERM PROCnewlogischedyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewlogischedyade;TERM PROCnewvergleich(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuerterm.END PROCnewvergleich;TERM PROCallokiereterm:TERM VARfreierterm;bestimmedenallokiertenzeiger;tabelle.zeigerauffreientabellenplatz:=naechsterfreierplatz;freierterm.bestimmedenallokiertenzeiger:IFtabelle.zeigerauffreientabellenplatz=nilTHENerrorstop(anwendungstext(2))END IF;freierterm:=tabelle.zeigerauffreientabellenplatz.naechsterfreierplatz:TERM VARsucher:=freierterm;REP CONCR(sucher)DECR1;IFsucher=nilTHEN CONCR(sucher):=tabellengroesse+1ELIFsucher=freiertermTHEN LEAVEnaechsterfreierplatzWITHnilELIFtabelle.zeile(CONCR(sucher))=""THEN LEAVEnaechsterfreierplatzWITHsucherEND IF END REP;sucherEND PROCallokiereterm;TEXT PROCtextvon(REAL CONSTwert):TEXT VARachtbyte:=" ";replace(achtbyte,1,wert);achtbyteEND PROCtextvon;TEXT PROCtextvon(INT CONSTwert):TEXT VARzweibyte:=" ";replace(zweibyte,1,wert);zweibyteEND PROCtextvon;TEXT PROCtextvon(TERM CONSTzeiger):textvon(CONCR(zeiger))END PROCtextvon;TEXT OP NAME(TERM CONSTterm):IFtermISstandardfunktionTHENsubtext(tabelle.zeile(CONCR(term)),4)ELIF(termISvariable)COR(termISeigenefunktion)THENsubtext(tabelle.zeile(CONCR(term)),6)ELIFtermISkonstanteTHENsubtext(tabelle.zeile(CONCR(term)),12)ELSEerrorstop(anwendungstext(12));""END IF END OP NAME;TERM OP DEFINITION(TERM CONSTterm):TERM VARdefinition;IF(termISeigenefunktion)COR(termIStemporaerefunktion)THEN CONCR(definition):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(16))END IF;definitionEND OP DEFINITION;TERM OP VARIABLEN(TERM CONSTterm):TERM VARvariablen;IFtermISfunktionsdefinitionTHEN CONCR(variablen):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(19))END IF;variablenEND OP VARIABLEN;TERM OP TERME(TERM CONSTterm):TERM VARterme;IF(termISfunktionsdefinition)THEN CONCR(terme):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(17))END IF;termeEND OP TERME;TERM OP LISTENANFANG(TERM CONSTterm):TERM VARanfang;IF(termISvariablenliste)COR(termIStermliste)THEN CONCR(anfang):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(21))END IF;anfangEND OP LISTENANFANG;TERM OP LISTENENDE(TERM CONSTterm):TERM VARende;IF(termISvariablenliste)COR(termIStermliste)THEN CONCR(ende):=subtext(tabelle.zeile(CONCR( +term)),6)ISUB1ELSEerrorstop(anwendungstext(22))END IF;endeEND OP LISTENENDE;INT OP LAENGE(TERM CONSTterm):IF NOT((termISvariablenliste)COR(termIStermliste))THENerrorstop(anwendungstext(20))END IF;subtext(tabelle.zeile(CONCR(term)),8)ISUB1END OP LAENGE;TERM OP ELEMENT(TERM CONSTlistenzeiger,INT CONSTnteselement):IF NOT((listenzeigerIStermliste)XOR(listenzeigerISvariablenliste))THENerrorstop(anwendungstext(18))END IF;auswahl(neueliste(LISTENANFANGlistenzeiger,LISTENENDElistenzeiger),nteselement)END OP ELEMENT;INT OP PLATZ(TERM CONSTterm):IF NOT(termISvariable)THENerrorstop(anwendungstext(25))END IF;subtext(tabelle.zeile(CONCR(term)),4)ISUB1END OP PLATZ;TERM OP AUSDRUCK(TERM CONSTterm):TERM VARformel;IF(termISausdruck)THEN CONCR(formel):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(27))END IF;formelEND OP AUSDRUCK;TERM OP LINKS(TERM CONSTterm):TERM VARlinks;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THEN CONCR(links):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(7))END IF;linksEND OP LINKS;TERM OP RECHTS(TERM CONSTterm):TERM VARrechts;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THEN CONCR(rechts):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(8))END IF;rechtsEND OP RECHTS;TEXT OP OPERATION(TERM CONSTterm):TEXT VARop;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THENop:=subtext(tabelle.zeile(CONCR(term)),8)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENop:=subtext(tabelle.zeile(CONCR(term)),6)ELIFtermISableitungsoperationTHENop:=subtext(tabelle.zeile(CONCR(term)),10)ELSEerrorstop(anwendungstext(10))END IF;opEND OP OPERATION;TERM OP OPERAND(TERM CONSTterm):TERM VARoperand;IF(termISmonadisch)COR(termISabbildungsmonade)THEN CONCR(operand):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(9))END IF;operandEND OP OPERAND;TERM OP ABBILDUNGSAUSDRUCK(TERM CONSTterm):TERM VARfunktionsterm;IF(termISfunktionsauswertung)COR(termISableitungsoperation)THEN CONCR(funktionsterm):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(23))END IF;funktionstermEND OP ABBILDUNGSAUSDRUCK;TERM OP ARGUMENTE(TERM CONSTterm):TERM VARargumente;IF(termISfunktionsauswertung)THEN CONCR(argumente):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(13))END IF;argumenteEND OP ARGUMENTE;INT OP KOMPONENTE(TERM CONSTterm):IF NOT((termISfunktionsauswertung)COR(termISableitungsoperation))THENerrorstop(anwendungstext(24))END IF;subtext(tabelle.zeile(CONCR(term)),8)ISUB1END OP KOMPONENTE;INT OP INDEX(TERM CONSTterm):IF NOT(termISableitungsoperation)THENerrorstop(anwendungstext(26))END IF;subtext(tabelle.zeile(CONCR(term)),6)ISUB1END OP INDEX;REAL OP WERT(TERM CONSTterm):IF NOT(termISkonstante)THENerrorstop(anwendungstext(11))END IF;subtext(tabelle.zeile(CONCR(term)),4)RSUB1END OP WERT;TERM OP BEDINGUNG(TERM CONSTterm):TERM VARbedingung;IFtermISselektionTHEN CONCR(bedingung):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(28))END IF;bedingungEND OP BEDINGUNG;TERM OP AKTION(TERM CONSTterm):TERM VARaktion;IFtermISselektionTHEN CONCR(aktion):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(29))END IF;aktionEND OP AKTION;TERM OP ALTERNATIVE(TERM CONSTterm):TERM VARalternative;IFtermISselektionTHEN CONCR(alternative):=subtext(tabelle.zeile(CONCR(term)),8)ISUB1ELSEerrorstop(anwendungstext(30))END IF;alternativeEND OP ALTERNATIVE;PROClowlevel:datenraumname:="mathematikobjekte 1";ankoppelnEND PROClowlevel;PROChighlevel:datenraumname:="mathematikobjekte 2";ankoppelnEND PROChighlevel;INT PROCebene:int(datenraumnameSUB19)END PROCebene;PROCankoppeln:IFexists(datenraumname)THENtabelle:=old(datenraumname);IFdatenraumstrukturokCAND NOTiserrorTHENenablestop;LEAVEankoppelnEND IF;IFiserrorTHENclearerror;enablestopEND IF END IF;initialisieren.datenraumstrukturok:disablestop;( +listenanfang(standardfunktionen)ISstandardfunktion)AND NAMEnachfolger(listenanfang(standardfunktionen))="cos"END PROCankoppeln;PROCinitialisieren:LETanzahlelementarerfunktionen=19;INT VARi;ROWanzahlelementarerfunktionenTEXT CONSTname:=ROWanzahlelementarerfunktionenTEXT:("sin","cos","tan","cot","arcsin","arccos","arctan","arccot","ln","log2","log10","exp","sign","abs","wurzel","gauss","rund","ganz","frak");disablestop;footnote(anwendungstext(61));koppleeinendatenrauman;initialisieredieobjekttabelle;initialisieredielisten;tragedieelementarenabbildungenein;enablestop.koppleeinendatenrauman:forget(datenraumname,quiet);tabelle:=new(datenraumname).initialisieredieobjekttabelle:FORiFROMtabellengroesseDOWNTO1REPtabelle.zeile(i):=""END REP.initialisieredielisten:tabelle.zeigerauffreientabellenplatz:=wurzel;tabelle.listederstandardfunktionen:=neueliste(nil,nil);tabelle.listeeigenerfunktionen:=neueliste(nil,nil);tabelle.listetemporaererfunktionen:=neueliste(nil,nil);tabelle.dummy:=neueliste(nil,nil).tragedieelementarenabbildungenein:FORiFROM1UPTOanzahlelementarerfunktionenREPanhaengenanstandardfunktionen(newstandardfunktion(name(i)))END REP.END PROCinitialisieren;OP LOESCHE(TERM CONSTp):tabelle.zeile(CONCR(p)):="";IFtabellevoelliggefuelltTHENtabelle.zeigerauffreientabellenplatz:=pEND IF.tabellevoelliggefuellt:tabelle.zeigerauffreientabellenplatz=nil.END OP LOESCHE;BOOL OP IS(TERM CONSTt,ART CONSTtyp):(t<>nil)CAND(tabelle.zeile(CONCR(t))<>"")CANDcode(tabelle.zeile(CONCR(t))SUB1)=CONCR(typ)END OP IS;OP:=(ART VARlinks,ART CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;END PACKETreferenzobjekte; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic b/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic new file mode 100644 index 0000000..2de7226 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic @@ -0,0 +1,4 @@ +PACKETspezialgraphicDEFINESmatmove,matdraw,grapheditget,initscreenmemory,clearscreenmemory,plotscreenmemory,loeschezeichnung,loeschezeichnungpartiell,putscreenmemory,newpicture,deletelastpicture,vervollstaendigeaktuellezeichnung,druckeaktuellezeichnung:LEThop="�",rechts="�",bell="�",links="�",rubin="�",rubout="�",return=" ",escapezeichen="�",rubinmark="^",cursorverschiebung=1,blank=" ",niltext="",bildspeichertyp=1055,maximalanzahl=128,maxzeichnungen=25,printerdepot="MATHE-PRINTERDEPOT";TYPE PICROW=STRUCT(INTeof,ROWmaximalanzahlPICTUREzeichnung,ROW4REALfenstergroesseREALquellbreite,quellhoehe);BOUND PICROW VARscreenmemory;DATASPACE VARds;INT CONSTcursorbreite:=zeichenbreite-1;BOOL VARcursoron:=FALSE;INT VARaltx,alty,xpixelanzahl,ypixelanzahl;REAL VARxcmgroesse,ycmgroesse,startpunktx,startpunkty;PROCmatmove(REAL CONSTx,y):startpunktx:=x;startpunkty:=yEND PROCmatmove;PROCmatdraw(REAL CONSTx,y):BOOL VARunsichtbar;REAL VARendpunktx:=x,endpunkty:=y,letzterendpunktx,letzterendpunkty;clip(startpunktx,startpunkty,endpunktx,endpunkty,unsichtbar);IF NOTunsichtbarTHEN IFlength(screenmemory.zeichnung(screenmemory.eof))>31960THENstretchpictureEND IF;where(letzterendpunktx,letzterendpunkty);IFstartpunktx<>letzterendpunktxCORstartpunkty<>letzterendpunktyTHENmove(startpunktx,startpunkty);move(screenmemory.zeichnung(screenmemory.eof),startpunktx,startpunkty)END IF;IFletzterendpunktx<>endpunktxCORletzterendpunkty<>endpunktyTHENdraw(endpunktx,endpunkty);draw(screenmemory.zeichnung(screenmemory.eof),endpunktx,endpunkty)END IF END IF;matmove(x,y)END PROCmatdraw;PROCclip(REAL VARxbeg,ybeg,xend,yend,BOOL VARnothingvisible):REAL VARdifbeg,difend;REAL CONSTxdif:=xend-xbeg,ydif:=yend-ybeg;BOOL VARcutbeg,cutend;windowlinksclip;windowrechtsclip;windowuntenclip;windowobenclip.windowlinksclip:difbeg:=windowxmin-xbeg;difend:=windowxmin-xend;cutbeg:=(difbeg>0.0);cutend:=(difend>0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENybeg:=ybeg+ydif/xdif*difbeg;xbeg:=windowxminELIFcutendTHENyend:=yend+ydif/xdif*difend;xend:=windowxminEND IF.windowrechtsclip:difbeg:=windowxmax-xbeg;difend:=windowxmax-xend;cutbeg:=(difbeg<0.0);cutend:=(difend<0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENybeg:=ybeg+ydif/xdif*difbeg;xbeg:=windowxmaxELIFcutendTHENyend:=yend+ydif/xdif*difend;xend:=windowxmaxEND IF.windowuntenclip:difbeg:=windowymin-ybeg;difend:=windowymin-yend;cutbeg:=(difbeg>0.0);cutend:=(difend>0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENxbeg:=xbeg+xdif/ydif*difbeg;ybeg:=windowyminELIFcutendTHENxend:=xend+xdif/ydif*difend;yend:=windowyminEND IF.windowobenclip:difbeg:=windowymax-ybeg;difend:=windowymax-yend;cutbeg:=(difbeg<0.0);cutend:=(difend<0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENxbeg:=xbeg+xdif/ydif*difbeg;ybeg:=windowymaxELIFcutendTHENxend:=xend+xdif/ydif*difend;yend:=windowymaxEND IF END PROCclip;PROCeditgetcursor(INT CONSTi,j):loeschecursor;altx:=(i-1)*zeichenbreite;alty:=ypixelanzahl-(j*zeichenhoehe)-cursorverschiebung;move(altx,alty);draw(altx+cursorbreite,alty);cursoron:=TRUE;cursor(i,j)END PROCeditgetcursor;PROCloeschecursor:IFcursoronTHENpen(0,0,0,1);move(altx,alty);draw(altx+cursorbreite,alty);pen(1,1,1,1);cursoron:=FALSE END IF END PROCloeschecursor;PROCgrapheditget(TEXT VAReingabe,INT CONSTfeldlaenge,TEXT CONSTescausstiegszeichen,TEXT VARausstieg):TEXT VARch;INT VARxanfang,yanfang,cursorpos,textpointer,maxcursorpos,zielpos;BOOL VARrubinmode;initialisiereeditor;REPinchar(ch);IFch=returnTHENausstieg:=niltext;loeschecursor;eingabe:=compress(eingabe);LEAVEgrapheditgetELIFch=escapezeichenTHENinchar(ausstieg);IFpos(escausstiegszeichen,ausstieg)<>0THENloeschecursor;LEAVEgrapheditgetEND IF ELIFch=linksTHENfuehrecursorlinksausELIFch=rechtsTHENfuehrecursorrechtsausELIFch=rubinTHENfuehrerubinausELIFch=ruboutTHENfuehreruboutausELIFch=hopTHENinchar(ch);IFch=linksTHENfuehrehoplinksausELIFch=rechtsTHENfuehrehoprechtsausELIFch= +ruboutTHENfuehrehopruboutausEND IF ELIFcode(ch)>=32THENfuehrenormaleszeichenausEND IF END REP.initialisiereeditor:clearbuffer;drawingarea(xcmgroesse,ycmgroesse,xpixelanzahl,ypixelanzahl);rubinmode:=FALSE;textpointer:=1;getcursor(xanfang,yanfang);cursorpos:=xanfang;maxcursorpos:=xanfang+feldlaenge;out(text(eingabe,feldlaenge,textpointer));editgetcursor(xanfang,yanfang).fuehrecursorlinksaus:IFcursorpos>xanfangTHENcursorposDECR1;editgetcursor(cursorpos,yanfang)ELIFtextpointer>1THENtextpointerDECR1;cursor(xanfang,yanfang);out(text(eingabe,feldlaenge,textpointer));editgetcursor(xanfang,yanfang)END IF.fuehrecursorrechtsaus:IFcursorpos-xanfang+textpointer<=length(eingabe)THEN IFcursorpos1THENcursor(xanfang,yanfang);textpointer:=1;out(text(eingabe,feldlaenge,textpointer))END IF;cursorpos:=xanfang;editgetcursor(cursorpos,yanfang).fuehrehoprechtsaus:IFlength(eingabe)length(eingabe)THENeingabeCATblankEND IF;replace(eingabe,zielpos,ch);IFcursorpos0THENpen(1,1,1,pen(screenmemory.zeichnung(i)));plot(screenmemory.zeichnung(i))END IF END REP END PROCplotscreenmemory;PROCloeschezeichnung:INT VARi;pen(0,0,0,1);FORiFROMscreenmemory.eofDOWNTO1REP IFlength(screenmemory.zeichnung(i))<>0THENplot(screenmemory.zeichnung(i))END IF END REP END PROCloeschezeichnung;PROCloeschezeichnungpartiell:INT VARi;pen(0,0,0,1);FORiFROMscreenmemory.eofDOWNTO2REP IFlength(screenmemory.zeichnung(i))<>0THENplot(screenmemory.zeichnung(i))END IF END REP;screenmemory.eof:=2;plotscreenmemoryEND PROCloeschezeichnungpartiell;PROCputscreenmemory(PICTURE CONSTp):IFscreenmemory.eof=maximalanzahlTHENscreenmemory.eof:=1END IF;screenmemory.zeichnung(screenmemory.eof):=p;screenmemory.eofINCR1;screenmemory.zeichnung(screenmemory.eof):=nilpictureEND PROCputscreenmemory;PROCvervollstaendigeaktuellezeichnung(REAL CONSTxmin,xmax,ymin,ymax,breite,hoehe):screenmemory.fenstergroesse(1):=xmin;screenmemory.fenstergroesse(2):=xmax;screenmemory.fenstergroesse(3):= +ymin;screenmemory.fenstergroesse(4):=ymax;screenmemory.quellbreite:=breite;screenmemory.quellhoehe:=hoeheEND PROCvervollstaendigeaktuellezeichnung;INT VARanzahlfolgebilder:=0;PROCstretchpicture:anzahlfolgebilderINCR1;setzeweiter(pen(screenmemory.zeichnung(screenmemory.eof)))END PROCstretchpicture;PROCnewpicture(INT CONSTnr):anzahlfolgebilder:=0;setzeweiter(nr)END PROCnewpicture;PROCsetzeweiter(INT CONSTnr):screenmemory.eofINCR1;IFscreenmemory.eof>maximalanzahlTHENscreenmemory.eof:=2END IF;screenmemory.zeichnung(screenmemory.eof):=nilpicture;pen(screenmemory.zeichnung(screenmemory.eof),nr)END PROCsetzeweiter;PROCdeletelastpicture:IFscreenmemory.eof>1+anzahlfolgebilderTHENscreenmemory.eofDECR(1+anzahlfolgebilder)END IF END PROCdeletelastpicture;PROCdruckeaktuellezeichnung:enablestop;bestimmezieltaskname;benennedatenraum;versendedatenraum.bestimmezieltaskname:IF NOTexiststask(printerdepot)CORinhalt(ALL(/printerdepot))>=maxzeichnungenTHENout(bell);LEAVEdruckeaktuellezeichnungEND IF.benennedatenraum:TEXT VARbilddatenraum:="ZEICHNUNG "+date+" "+timeofday;IFexists(bilddatenraum,/printerdepot)THEN INT VARzaehler:=1;bilddatenraumCAT":";WHILEexists(bilddatenraum+text(zaehler),/printerdepot)REPzaehlerINCR1END REP;bilddatenraumCATtext(zaehler)END IF;type(ds,bildspeichertyp);copy(ds,bilddatenraum).versendedatenraum:IFstatus(/printerdepot)=2THENsave(bilddatenraum,/printerdepot)ELSEout(bell)END IF;forget(bilddatenraum,quiet)END PROCdruckeaktuellezeichnung;INT PROCinhalt(THESAURUS CONSTth):INT VARi:=0,zaehler:=0;TEXT VARname;get(th,name,i);WHILEi<>0REP IFname<>niltextTHENzaehlerINCR1END IF;get(th,name,i);END REP;zaehlerEND PROCinhalt;END PACKETspezialgraphic + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.umformung b/app/schulis-mathematiksystem/1.0/src/mat.umformung new file mode 100644 index 0000000..001c0ca --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.umformung @@ -0,0 +1,3 @@ +PACKETumformungDEFINESinitialisiereausgabedatei,formeum,loescheausgabedatei:LETniltext="",bell="�",beginmark="",endmark="",left="�",right="�",del="�",esc="�",blank=" ",arbeitsfunktionstitel="Arbeitsfunktion",titel1="Ableitung",titel2="Auflösung",titel3="aufgelöste Ableitung";FILE VARufdat;TEXT VARufdatname;INT VARausgabezeilennummer;INT VARfktwahl;PROCinitialisiereausgabedatei:ufdatname:=scratchdateiname;ufdat:=sequentialfile(output,ufdatname);ausgabezeilennummer:=1;fktwahl:=1END PROCinitialisiereausgabedatei;PROCformeum(ABBILDUNG CONSTf):WINDOW VARwt:=window(2,4,77,19);INT VARzeilenoffset:=0,ersteauszugebendespalte,ersteauszugebendezeile,alterwert;BOOL VARtemporaerefktexistiert:=FALSE;ABBILDUNG VARtempfkt;TEXT VARzulaessigeeingaben,ausstieg;bereiteprotokolldateivor;bearbeitedasobjekt;bereiteprotokolldateinach.bereiteprotokolldateivor:ersteauszugebendespalte:=1;ersteauszugebendezeile:=ausgabezeilennummer;output(ufdat);putline(ufdat,arbeitsfunktionstitel);IF NOTformeleditoraktivTHENputline(ufdat,funktionsstring(f));zeilenoffsetINCR3ELSEalterwert:=lines(ufdat);liefereformeleditorformat(ufdat,f);line(ufdat);zeilenoffsetINCR(2+lines(ufdat)-alterwert)END IF;outframe(wt).bearbeitedasobjekt:REPzeigeprotokolldatei;bestimmeaktivitaet;fuehreaktivitaetausEND REP.zeigeprotokolldatei:scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132)).bestimmeaktivitaet:TEXT VARchar;ROW3TEXT CONSTkommandozeile:=ROW3TEXT:(anwendungstext(230),anwendungstext(231),anwendungstext(232));REPclearbuffer;cursor(3,2);out(kommandozeile(fktwahl));cursor(78,24);inchar(char);IFchar=leftTHENfktwahl:=(fktwahl-2)MOD3+1ELIFchar=rightTHENfktwahl:=fktwahlMOD3+1ELIFchar=escTHENwerteescapesequenzausEND IF END REP.werteescapesequenzaus:zulaessigeeingaben:="?fnwqmd";inchar(ausstieg);SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:show(formular(10));warte;scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132))CASE2:betrachtedieausgabedateiCASE3:IFtemporaerefktexistiertTHENbenennedieletztetemporaerefunktion;outframe(wt);scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132))END IF CASE4:LEAVEbestimmeaktivitaetCASE5,6:loeschetemporaereabbildung(tempfkt);verfahrensende(ausstieg);LEAVEbearbeitedasobjektCASE7:druckversuch(ufdatname);outframe(wt);footnote(anwendungstext(132))END SELECT.betrachtedieausgabedatei:zulaessigeeingaben:="?dwqm";INT VARersterauszugebendersatz:=ausgabezeilennummer;cursor(1,2);out(del);REPfootnote(anwendungstext(133));scroll(wt,ufdatname,1,1,1,ersterauszugebendersatz,ersteauszugebendespalte,zulaessigeeingaben,ausstieg);SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:show(formular(12));warteCASE2:druckversuch(ufdatname);outframe(wt)CASE3:LEAVEbetrachtedieausgabedateiCASE4,5:IFtemporaerefktexistiertTHENloeschetemporaereabbildung(tempfkt)END IF;verfahrensende(ausstieg);LEAVEbearbeitedasobjektEND SELECT END REP.benennedieletztetemporaerefunktion:TEXT VARvorgesehenername:=niltext;cursor(3,2);out(del);cursor(3,2);out(anwendungstext(172));REPfootnote(anwendungstext(174));cursor(23,2);out(beginmark);out(left);enablestop;editget(vorgesehenername,40,20);disablestop;cursor(43,2);out(endmark);IFvorgesehenername=niltextTHEN LEAVEbenennedieletztetemporaerefunktionEND IF;gibnamen(tempfkt,vorgesehenername);IFiserrorTHENgibmeldung(errormessage+vorgesehenername);clearerrorELSEgibmeldung(anwendungstext(227)+vorgesehenername+anwendungstext(228));temporaerefktexistiert:=FALSE;LEAVEbenennedieletztetemporaerefunktionEND IF END REP.fuehreaktivitaetaus:TEXT VARueberschrift;IFfktwahl<>2THENbestimmeableitungsparameterEND IF;footnote(anwendungstext(166));IFtemporaerefktexistiertTHENloeschetemporaereabbildung(tempfkt)END IF;SELECTfktwahlOF CASE1:ueberschrift:=titel1+ueberschriftrest;tempfkt:=ableitung(f,kompindex,varindex)CASE2:ueberschrift:=titel2;tempfkt:=aufloesung(f)CASE3:ueberschrift:=titel3+ +ueberschriftrest;ABBILDUNG VARtemp:=aufloesung(f);tempfkt:=ableitung(temp,kompindex,varindex);loeschetemporaereabbildung(temp)END SELECT;output(ufdat);putline(ufdat,ueberschrift);IFiserrorTHENclearerror;putline(ufdat,errormessage);zeilenoffsetINCR2ELIFformeleditoraktivTHENalterwert:=lines(ufdat);liefereformeleditorformat(ufdat,tempfkt);line(ufdat);temporaerefktexistiert:=TRUE;zeilenoffsetINCR(1+lines(ufdat)-alterwert)ELSEputline(ufdat,funktionsstring(tempfkt));temporaerefktexistiert:=TRUE;zeilenoffsetINCR2END IF.bestimmeableitungsparameter:INT VARkompindex:=1,varindex:=1;BOOL CONSTtermeingabeerforderlich:=laenge(abbildungsterme(f))>1,variableneingabeerforderlich:=(ebene=2)CANDlaenge(abbildungsvariablen(f))>1;TEXT VARueberschriftrest:=niltext,variablenname:=NAMElistenanfang(abbildungsvariablen(f));IFtermeingabeerforderlichCORvariableneingabeerforderlichTHEN IFtermeingabeerforderlichTHENcursor(51,2);out("des Terms")END IF;IFvariableneingabeerforderlichTHENcursor(64,2);out("nach "+text(variablenname,8))END IF;lieswerteein;IFtermeingabeerforderlichTHENueberschriftrestCAT(" des "+text(kompindex)+". Terms")END IF;IFvariableneingabeerforderlichTHENueberschriftrestCAT(" nach "+variablenname)END IF;cursor(51,2);out(del)END IF.lieswerteein:zulaessigeeingaben:="?wqm";footnote(anwendungstext(209));REP IFtermeingabeerforderlichTHENbestimmeterm;werteausstiegausEND IF;IFvariableneingabeerforderlichTHENbestimmevariable;werteausstiegausEND IF END REP.bestimmeterm:TEXT VARtermziffer:=text(kompindex);BOOL VARgueltigerterm;REPcursor(61,2);out("�");enablestop;editget(termziffer,12,2,niltext,zulaessigeeingaben,ausstieg);disablestop;out(endmark);kompindex:=int(termziffer);gueltigerterm:=NOTiserrorCANDkorrektetermbezeichnung;IFgueltigertermTHENcursor(61,2);out(termziffer);LEAVEbestimmetermEND IF;IFiserrorTHENclearerrorEND IF;out(bell)UNTILpos(zulaessigeeingaben,(ausstiegSUB2))<>0END REP.korrektetermbezeichnung:lastconversionokCANDkompindex>0CANDkompindex<=laenge(abbildungsterme(f)).bestimmevariable:BOOL VARgueltigevariable;REPcursor(69,2);out("�");enablestop;editget(variablenname,20,8,niltext,zulaessigeeingaben,ausstieg);disablestop;out(endmark);cursor(69,2);out(text(variablenname,8,1));gueltigevariable:=korrektevariablenbezeichnung;IFgueltigevariableTHENvarindex:=PLATZt;LEAVEbestimmevariableEND IF;out(bell)UNTILpos(zulaessigeeingaben,(ausstiegSUB2))<>0END REP.korrektevariablenbezeichnung:changeall(variablenname,blank,niltext);TERM VARt:=listenposition(abbildungsvariablen(f),variablenname);t<>nil.werteausstiegaus:ausstieg:=ausstiegSUB2;SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:gibinformationzurparametereingabeCASE2:IFtermeingabeerforderlichCAND NOTgueltigertermTHEN LEAVEwerteausstiegausEND IF;IFvariableneingabeerforderlichCAND NOTgueltigevariableTHEN LEAVEwerteausstiegausEND IF;LEAVElieswerteeinCASE3,4:loeschetemporaereabbildung(tempfkt);verfahrensende(ausstieg);LEAVEbearbeitedasobjektEND SELECT.gibinformationzurparametereingabe:show(formular(11));warte;scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132)).bereiteprotokolldateinach:output(ufdat);line(ufdat);ausgabezeilennummerINCRzeilenoffsetEND PROCformeum;PROCloescheausgabedatei:forget(ufdatname,quiet)END PROCloescheausgabedatei;END PACKETumformung; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.vector b/app/schulis-mathematiksystem/1.0/src/mat.vector new file mode 100644 index 0000000..03439bc --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.vector @@ -0,0 +1,2 @@ +PACKETvectorDEFINES VECTOR,:=,vector,SUB,LENGTH,length,nilvector,replace,=,<>,+,-,*,/:TYPE VECTOR=STRUCT(INTlng,TEXTelem),INITVECTOR=STRUCT(INTlng,REALvalue);INT VARi;TEXT VARt:="12345678";VECTOR VARv:=nilvector;OP:=(VECTOR VARl,VECTOR CONSTr):l.lng:=r.lng;l.elem:=r.elemEND OP:=;OP:=(VECTOR VARl,INITVECTOR CONSTr):l.lng:=r.lng;replace(t,1,r.value);l.elem:=r.lng*tEND OP:=;INITVECTOR PROCnilvector:vector(1,0.0)END PROCnilvector;INITVECTOR PROCvector(INT CONSTlng,REAL CONSTvalue):IFlng<=0THENerrorstop("PROC vector : lng <= 0")FI;INITVECTOR:(lng,value)END PROCvector;INITVECTOR PROCvector(INT CONSTlng):vector(lng,0.0)END PROCvector;REAL OP SUB(VECTOR CONSTv,INT CONSTi):test("REAL OP SUB : ",v,i);v.elemRSUBiEND OP SUB;INT OP LENGTH(VECTOR CONSTv):v.lngEND OP LENGTH;INT PROClength(VECTOR CONSTv):v.lngEND PROClength;PROCreplace(VECTOR VARv,INT CONSTi,REAL CONSTr):test("PROC replace : ",v,i);replace(v.elem,i,r)END PROCreplace;BOOL OP=(VECTOR CONSTl,r):l.elem=r.elemEND OP=;BOOL OP<>(VECTOR CONSTl,r):l.elem<>r.elemEND OP<>;VECTOR OP+(VECTOR CONSTv):vEND OP+;VECTOR OP+(VECTOR CONSTl,r):test("VECTOR OP + : ",l,r);v:=l;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(l.elemRSUBi)+(r.elemRSUBi))PER;vEND OP+;VECTOR OP-(VECTOR CONSTa):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,-(a.elemRSUBi))PER;vEND OP-;VECTOR OP-(VECTOR CONSTl,r):test("VECTOR OP - : ",l,r);v:=l;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(l.elemRSUBi)-(r.elemRSUBi))PER;vEND OP-;REAL OP*(VECTOR CONSTl,r):test("REAL OP * : ",l,r);REAL VARx:=0.0;FORiFROM1UPTOl.lngREPxINCR((l.elemRSUBi)*(r.elemRSUBi))PER;xEND OP*;VECTOR OP*(VECTOR CONSTv,REAL CONSTr):r*vEND OP*;VECTOR OP*(REAL CONSTr,VECTOR CONSTa):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,r*(a.elemRSUBi))PER;vEND OP*;VECTOR OP/(VECTOR CONSTa,REAL CONSTr):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(a.elemRSUBi)/r)PER;vEND OP/;TEXT VARerror:="";PROCtest(TEXT CONSTproc,VECTOR CONSTv,INT CONSTi):IFi>v.lngTHENerror:=proc;errorCAT"subscript overflow (LENGTH v=";errorCATtext(v.lng);errorCAT", i=";errorCATtext(i);errorCAT")";errorstop(error)ELIFi<1THENerror:=proc;errorCAT"subscript underflow (i = ";errorCATtext(i);errorCAT")";errorstop(error)FI END PROCtest;PROCtest(TEXT CONSTproc,VECTOR CONSTa,b):IFa.lng<>b.lngTHENerror:=proc;errorCAT"LENGTH a (";IFa.lng<=0THENerrorCAT"undefined"ELSEerrorCATtext(a.lng)FI;errorCAT") <> LENGTH b (";errorCATtext(b.lng);errorCAT")";errorstop(error)FI END PROCtest;END PACKETvector; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.verwaltung b/app/schulis-mathematiksystem/1.0/src/mat.verwaltung new file mode 100644 index 0000000..c65e789 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.verwaltung @@ -0,0 +1,1032 @@ +PACKET mathe verwaltung DEFINES mathe, + installiere mathesystem: + +(**************************************************) +(* G l o b a l e D e k l a r a t i o n e n *) +(**************************************************) + +(* L E T - D e n o t e r *) + +(* Ausgabetexte *) + +LET systemname = "s c h u l i s - Mathematiksystem Version 1.0", + titel 1 = "Systemverwaltung", + titel 2 = "Installation", + titel 3 = "Installation: Drucker", + meldung 1 = "Das Mathematiksystem ist noch nicht installiert.", + meldung 2 = "Kein Druckertreiber für Graphiken installiert.", + meldung 3 = "1 ... Mathematiksystem - Ebene 1", + meldung 4 = "2 ... Mathematiksystem - Ebene 2", + meldung 5 = "3 ... Zeichnungen drucken", + meldung 6 = "---------------------------------------", + meldung 7 = "4 ... Neuinstallation: Mathematiksystem", + meldung 8 = "5 ... Neuinstallation: Graphikdrucker", + meldung 9 = "q ... Mathematiksystem verlassen", + meldung 10 = "Gewünschte Funktion:", + meldung 11 = "Bitte wählen Sie unter folgenden Anpassungen eine", + meldung 12 = "für Ihr Terminal und die zugehörige Grafikkarte", + meldung 13 = "angemessene heraus:", + meldung 14 = " hercules-Anpassung", + meldung 15 = " cga-Anpassung", + meldung 16 = " ega-Anpassung", + meldung 17 = " vga-Anpassung", + meldung 18 = "Solange vorgeschlagene Anpassung verneinen ", + meldung 19 = "bis passende genannt wird.", + meldung 20 = "Diese bejahen .", + meldung 21 = "Installation korrekt beendet", + meldung 22 = "Installation wegen Systemfehler gestoppt", + meldung 23 = "Verfügt das Terminal über den IBM-Zeichensatz", + meldung 24 = "Soll das vorhandene Mathematiksystem gelöscht werden", + meldung 25 = "Soll der vorhandene Druckertreiber gelöscht werden", + meldung 26 = "Weiter mit beliebiger Taste", + meldung 27 = "Geladen wird Datei Nr. ", + meldung 28 = "Die benötigten Dateien sind vollständig geladen.", + meldung 29 = "Sie können die Diskette aus dem Laufwerk nehmen.", + meldung 30 = "Bitte warten - das Mathematiksystem wird installiert.", + meldung 31 = "Installiert wird Datei von ", + meldung 32 = "Fehler bei der Übersetzung der Programme.", + meldung 33 = " richtige Anpassung", + meldung 34 = "für Ihren Drucker geeigenete aus:", + meldung 35 = " DRUCKER PLOTTER", + meldung 36 = " xerox 4045 hp 72xx", + meldung 37 = " epson sq hp 74xx", + meldung 38 = " epson fx", + meldung 39 = " binder 8600", + meldung 40 = " kyocera", + meldung 41 = " hp laserjet", + meldung 42 = "Bitte warten - der Druckertreiber wird installiert", + meldung 43 = "Bitte zunächst das Mathematiksystem installieren.", + meldung 44 = + "Zunächst müssen die erforderlichen Dateien geladen werden.", + meldung 45 = "Passwort: ", + meldung 46 = "Soll das System mit einem Passwort geschützt werden", + meldung 47 = + "Fehler: Die Diskette ist ungültig oder nicht korrekt eingelegt!", + meldung 49 = "Installation vorzeitig abgebrochen", + meldung 50 = "Bitte legen sie eine Diskette der Anwendung", + meldung 51 = "in das Laufwerk und schließen es.", + meldung 52 = "Installation fortsetzen: ", + meldung 53 = "Installation abbrechen : ", + meldung 54 = "Bitte legen Sie eine weitere Diskette der Anwendung", + menutasten = "12345q", + zeilen menu 1 = 10, + zeilen menu 2 = 12, + zeilen menu 3 = 14, + +(* d o - Kommandos *) + + menu ankoppeln = "install menu (""ls-MENUKARTE:Mathematik"", FALSE)", + ebene 1 handle = "handle menu (""Ebene 1"")", + ebene 2 handle = "handle menu (""Ebene 2"")", + druckmenu handle = "handle menu (""Drucken"")", + ibmsatzzeichen = "ibmgraphicchar", + stdsatzzeichen = "stdgraphicchar", + ibmops ankoppeln = "load ops (""ibmoperatoren"")", + stdops ankoppeln = "load ops (""standardoperatoren"")", + fe manager = "formelmanager", + plotter ein = "plotter eingestellt (TRUE)", + plotter aus = "plotter eingestellt (FALSE)", + +(* Tasknamen *) + + depot taskname = "mathe depot", + ls mk taskname = "ls-MENUKARTEN", + ls taskname = "ls-ANWENDUNG", + fe taskname = "FORMELEDITOR", + mathe taskname = "Mathematik", + printer taskname = "MATHE-PRINTER", + pridepot taskname = "MATHE-PRINTERDEPOT", + umstell taskname = "DRUCKERANPASSUNGEN", + archivname = "mathe", + +(* Bezeichner für Menükarte, Maskendatenraum und Programmanzahl *) + + menukarte = "ls-MENUKARTE:Mathematik", + maskenname = "mathe formulare", + mathe kuerzel = "mat.", + plot kuerzel = " plot", + ls kuerzel = "ls-DIALOG ", + mathe extension = ".mathe", + operatorendatei 1 = "ibmoperatoren", + operatorendatei 2 = "standardoperatoren", + anzahl gesamt = 29, + anzahl feprocs = 6, + anzahl ls procs = 5, + anzahl matheprocs = 18, + anzahl pri procs = 6, + anzahl drucker ds = 16, + +(* Codes für Task-Kommunikation *) + + ok = 1111, + fehler = 9999, + insertieren = 2525, + drucker erzeugen = 3260, + drucker1 erzeugen = 3261, + drucker8 erzeugen = 3268, + system starten = 4444, + ebene 1 behandeln = 4445, + ebene 2 behandeln = 4446, + arbeitskanal = 1, (* Es wird ohnehin nur das Terminal 1 genutzt!*) + +(* Sonstiges *) + + del = ""5"", + delpage = ""4"", + bell = ""7"", + left = ""8"", + beginmark = ""15"", + endmark = ""14"", + weiter = "w", + abbruch = ""27"", + niltext = ""; + +(* G l o b a l e V a r i a b l e n *) + +TASK VAR depot task, ls mk task, fe task, mathe task, ls task, + pridepot task, printer task, order task, umstelltask; +THESAURUS VAR archivinhalt; +TEXT VAR graphicart, + installationspassword := niltext; +INT VAR druckerindex; +BOOL VAR ibmsatz; +INT VAR installationszaehler, antwort, order code; +DATASPACE VAR message ds; +BOOL VAR mathematiksystem installiert := FALSE, + graphikdrucker installiert := FALSE; +ROW anzahl druckerds TEXT CONST druckerdatei :: +ROW anzahl druckerds TEXT : ("ZEICHEN 8*8", + "ZEICHEN 6*10", + "ZEICHEN 8*16", + "spool cmd", + "mat.xerox4045 plot", + "mat.epson-sq plot", + "mat.epson-fx plot", + "mat.binder plot", + "mat.kyocera plot", + "mat.laserjet plot", + "mat.hp72xx plot", + "mat.hp74xx plot", + "mat.basis plot", + "mat.picture", + "mat.ausgabe", + "mat.druckermenu"); +ROW zeilen menu 1 TEXT CONST menu 1 :: +ROW zeilen menu 1 TEXT : (meldung 3, meldung 4, meldung 5, meldung 6, + meldung 7, meldung 8, niltext, meldung 9, + niltext, meldung 10); +ROW zeilen menu 2 TEXT CONST menu 2 :: +ROW zeilen menu 2 TEXT : (meldung 11, meldung 12, meldung 13, niltext, + meldung 14, meldung 15, meldung 16, meldung 17, + niltext, meldung 18, meldung 19, meldung 20); +ROW zeilen menu 3 TEXT CONST menu 3 :: +ROW zeilen menu 3 TEXT : (meldung 11, meldung 34, niltext, meldung 35, + meldung 36, meldung 37, meldung 38, meldung 39, + meldung 40, meldung 41, niltext, meldung 18, + meldung 19, meldung 20); + +(**************************************************************************) +(* H a u p t m e n ü *) +(**************************************************************************) +(* Die folgende Prozeduren realisieren ein Menü mit 6 Optionen: *) +(* 1, 2: Ausführung des Mathematiksystems - sofern es noch nicht ein- *) +(* gerichtet ist erfolgt eine Meldung. *) +(* Die Ausführung erfolgt durch Übergabe des Bildschirms an die *) +(* Task 'Mathematik' *) +(* 3 : Ausführung eines Menüs in der Druckertask. Die Option setzt *) +(* voraus, daß eine entsprechende Task eingerichtet ist. Ist dies*) +(* nicht der Fall erfolgt eine Meldung *) +(* 4 : Installation des Mathematiksystems. Sofern es schon eingerich-*) +(* tet ist, erfolgt die Installation nur bei der Bejahung einer *) +(* Abfrage, ob das vorhandene System gelöscht werden soll. *) +(* 5 : Installation des Druckertreibers. Sofern er schon eingerichtet*) +(* ist, erfolgt die Installation nur bei der Bejahung einer Ab- *) +(* frage, ob das vorhandene System gelöscht werden soll. *) +(* Ferner gilt: Ohne Mathematiksystem kann kein Druckertreiber *) +(* eingerichtet werden. Ein Löschen des Mathematik- *) +(* systems löscht automatisch auch den Druckertrei- *) +(* ber *) +(* q : Verlassen des Menüs *) +(* *) +(* Die exportierte Schnittstelle 'mathe' dient als Fängerebene für die *) +(* eigentliche Menü-Prozedur 'start system' *) +(**************************************************************************) + +PROC mathe: + + disable stop; + zeige kopierhinweis; (* 5.2.1991 *) + start system; + WHILE is error REP + clear error; + command dialogue (FALSE); + forget (all); + commanddialogue (TRUE); + zeige titelzeile (titel 1); + gib meldung (errormessage); + start system + END REP + +END PROC mathe; + +PROC start system: + + TEXT VAR ch; + INT VAR rang, zeile, xpos, ypos; + grundeinstellungen; + REP + zeige verwaltungsmenu; + warte auf korrekte eingabe; + werte eingabe aus + END REP. + + grundeinstellungen: + enable stop; + check off; + warnings off. + + zeige verwaltungsmenu: + zeige titelzeile (titel 1); + FOR zeile FROM 7 UPTO 16 REP + cursor (24, zeile); out (menu 1 (zeile - 6)) + END REP; + clear buffer. + + warte auf korrekte eingabe: + get cursor (xpos, ypos); + REP + inchar (ch); + rang := pos (menutasten, ch); + IF rang = 0 THEN + out (bell) + ELSE + cursor (xpos + 1, ypos); out (ch); + END IF + UNTIL rang <> 0 END REP. + + werte eingabe aus: + SELECT rang OF + CASE 1, 2: fuehre mathesystem aus + CASE 3 : fuehre druckermenu aus + CASE 4 : installiere mathesystem + CASE 5 : installiere druckeranpassung + OTHERWISE LEAVE start system (* = 6 *) + END SELECT. + + fuehre mathesystem aus: + IF NOT mathematiksystem installiert THEN + out (bell); + gib meldung (meldung 1); + LEAVE fuehre mathesystem aus + END IF; + uebergib bildschirm (mathe task, system starten + rang). + + fuehre druckermenu aus: + IF NOT graphikdrucker installiert THEN + out (bell); + gib meldung (meldung 2); + LEAVE fuehre druckermenu aus + END IF; + uebergib bildschirm (/printer taskname, system starten). + + installiere druckeranpassung: + IF NOT mathematiksystem installiert THEN + out (bell); + gib meldung (meldung 43); + LEAVE installiere druckeranpassung + END IF; + IF graphikdrucker installiert CAND NOT ja (meldung 25) THEN + LEAVE installiere druckeranpassung + END IF; + start printer installation; + IF is error THEN + clear error; + gib meldung (errormessage); + ELSE + zeige installationsergebnis (titel 3, graphikdrucker installiert) + END IF + +END PROC start system; + +PROC zeige kopierhinweis: (* Eingefügt 5.2.1991 - R.Kraft *) + +LET z1 = "schulis - Mathematiksystem", + z2 = "Lizenzfreie Software der", + z3 = "Gesellschaft für Mathematik und Datenverarbeitung mbH", + z4 = "Die Nutzung der Software ist nur im Schul- und Hochschulbereich", + z5 = "für nichtkommerzielle Zwecke gestattet.", + z6 = "Gewährleistung und Haftung werden ausgeschlossen.", + z7 = "Weiter mit beliebiger Taste"; + + page; + cursor (26, 3); out (z1); + cursor (27, 8); out (z2); + cursor (13,10); out (z3); + cursor ( 8,14); out (z4); + cursor (20,15); out (z5); + cursor (16,17); out (z6); + cursor (26,23); out (z7); + pause (50) + +END PROC zeige kopierhinweis; + +(***********************************************************************) +(* I n s t a l l a t i o n d e s M a t h e m a t i k s y s t e m s *) +(***********************************************************************) +(* Das folgende Programm installiert das Mathematiksystem. *) +(* Dabei werden ggf existierende Tasks eines alten Mathematiksystems *) +(* gelöscht. Es handelt sich dabei um die ls-Task als Vatertask für *) +(* Druckeranpassung, Formeleditor und Mathematiksystem sowie die *) +(* Depottask (= Zwischenspeicher für die benötigten Quelldateien). *) +(* Die erforderliche Graphik und Halbgraphikanpassung werden im Dialog *) +(* bestimmt. *) +(* Die Dateien werden vom Archiv gelesen und in die Zwischenspeicher *) +(* Tasks geschickt. Anschließend erfolgt die Installation folgender *) +(* Taskstruktur: ls-ANWENDUNG *) +(* Mathematik *) +(* FORMELEDITOR *) +(* ls-MENUKARTEN *) +(* DRUCKERANPASSUNGEN *) +(* Die Zwischenspeichertask wird abschließend gelöscht. *) +(***********************************************************************) + +PROC installiere mathesystem: + + IF NOT korrektes password THEN + LEAVE installiere mathesystem + END IF; + IF mathematiksystem installiert CAND NOT ja (meldung 24) THEN + LEAVE installiere mathesystem + END IF; + start mathe installation; + zeige installationsergebnis (titel 2, mathematiksystem installiert); + IF mathematiksystem installiert THEN + definiere password + END IF; + graphikdrucker installiert := FALSE. + +END PROC installiere mathesystem; + +PROC start mathe installation: + + INT VAR i; + bestimme graphic und halbgraphic; + IF NOT erforderliche systemdateien eingelesen THEN + errorstop (meldung 49) + END IF; + loesche ggf vorhandene tasks; + richte ggf lsmenukarten ein; + richte sicherungstasks ein; + sichere dateien; + melde installationsbeginn; + richte ls task ein; + richte formeleditor ein; + richte mathetask ein; + loesche depottask. + + bestimme graphic und halbgraphic: + graphicart := graphikkarte; + ibmsatz := ja (meldung 23). + + loesche ggf vorhandene tasks: + IF exists task (depot taskname) THEN end (/depot taskname) END IF; + IF exists task (ls taskname) THEN end (/ls taskname) END IF. + + richte ggf lsmenukarten ein: + IF NOT exists task (ls mk taskname) THEN + begin (ls mk taskname, PROC free global manager, ls mk task) + ELSE + ls mk task := /ls mk taskname + END IF. + + richte sicherungstasks ein: + begin (depot taskname, PROC free global manager, depot task); + IF NOT exists task (umstell taskname) THEN + begin (umstell taskname, PROC free global manager, umstell task) + ELSE + umstell task := /umstell taskname + END IF. + + sichere dateien: + commanddialogue (FALSE); + save (menukarte, ls mk task); + save (maskenname, ls mk task); + save (archivinhalt, depot task); + FOR i FROM 1 UPTO anzahl drucker ds REP + IF NOT exists (druckerdatei (i), umstelltask) THEN + save (druckerdatei (i), umstelltask) + END IF + END REP; + forget (archivinhalt). + + melde installationsbeginn: + zeige titelzeile (titel 2); + cursor (15, 10); out (meldung 30); + cursor (15, 12); out (meldung 31 + text (anzahl gesamt) + " Dateien"); + installationszaehler := 0. + + richte ls task ein: + begin (ls taskname, PROC install ls, ls task); + FOR i FROM 1 UPTO anzahl ls procs REP + insertiere programme (ls task) + END REP. + + richte formeleditor ein: + REP UNTIL exists task (fe taskname) CAND + status (/fe taskname) = 2 END REP; + fe task := /fe taskname; + FOR i FROM 1 UPTO anzahl fe procs REP + insertiere programme (fe task) + END REP. + + richte mathetask ein: + REP UNTIL exists task (mathe taskname) CAND + status (/mathe taskname) = 2 END REP; + mathe task := /mathe taskname; + FOR i FROM 1 UPTO anzahl mathe procs REP + insertiere programme (mathe task) + END REP. + + loesche depottask: + end (depot task) + +END PROC start mathe installation; + +(* Einlesen der benötigten Dateien *) + +BOOL PROC erforderliche systemdateien eingelesen: + + LET dateien = 53, + nicht geladen = "0", + geladen = "1"; + ROW dateien TEXT CONST systemdatei :: + ROW dateien TEXT : ("mat.ega plot", "mat.cga plot", + "mat.hercules plot", "mat.vga plot", + "ls-DIALOG 1.mathe", "ls-DIALOG 2.mathe", + "ls-DIALOG 3.mathe", "ls-DIALOG 4.mathe", + "ls-DIALOG 5.mathe", "PAC text row", + "PAC element row", "PAC op store-anpassung", + "PAC formula analyzer", "PAC formula editor-anpassung", + "mat.formeleditormanager", "mat.vector", + "mat.referenzobjekte", "mat.funktionsbibliothek", + "mat.abbildung", "mat.parser", + "mat.basis plot", "mat.picture", + "mat.specialgraphic", "mat.dialoghilfen", + "mat.masken", "mat.menufunktionen", + "mat.wertetabelle", "mat.graphicverfahren", + "mat.integrationsverfahren", "mat.iterationsverfahren", + "mat.nullstellen", "mat.umformung", + "mat.xerox4045 plot", "mat.epson-sq plot", + "mat.epson-fx plot", "mat.binder plot", + "mat.kyocera plot", "mat.laserjet plot", + "mat.hp72xx plot", "mat.hp74xx plot", + "spool cmd", "mat.ausgabe", + "mat.druckermenu", "ZEICHEN 8*8", + "ZEICHEN 9*14", "ZEICHEN 8*19", + "ZEICHEN 8*14", "ZEICHEN 6*10", + "ZEICHEN 8*16", "mathe formulare", + "ls-MENUKARTE:Mathematik", "ibmoperatoren", + "standardoperatoren"); + TEXT VAR anweisung := meldung 50, + pruefleiste := dateien * nicht geladen; + TEXT CONST ziel := dateien * geladen, + anpassung := mathe kuerzel + graphicart + plot kuerzel; + INT VAR i, zaehler := 1; + THESAURUS VAR diskinhalt; + zeige titelzeile (titel 2); + archivinhalt := empty thesaurus; + FOR i FROM 1 UPTO 4 REP + IF systemdatei (i) <> anpassung THEN + replace (pruefleiste, i, geladen) + END IF + END REP; + REP + warte auf eingabe; + FOR i FROM 1 UPTO dateien REP + IF (pruefleiste SUB i) = nicht geladen CAND + (diskinhalt CONTAINS systemdatei (i)) THEN + lade die datei + END IF + END REP; + anweisung := meldung 54 + UNTIL pruefleiste = ziel END REP; + abschlussaktivitaeten; + TRUE. + + zeige texte: + cursor (8, 8); out (meldung 44); + cursor (8, 9); out (anweisung); + cursor (8, 10); out (meldung 51); + cursor (8, 12); out (meldung 52); + cursor (8, 13); out (meldung 53). + + warte auf eingabe: + TEXT VAR ch; + REP + zeige texte; + inchar (ch); + IF ch = abbruch THEN + release (archive); + LEAVE erforderliche systemdateien eingelesen WITH FALSE + ELIF ch = weiter THEN + disable stop; + cursor (8, 9); out (del); + cursor (8,10); out (del); + cursor (8,12); out (del); + cursor (8,13); out (del); + cursor (8,15); out (del); + archive (archivname); + diskinhalt := ALL archive; + IF is error THEN + clear error; + cursor (8, 15); out (meldung 47); + enable stop; + ELSE + enable stop; + LEAVE warte auf eingabe + END IF + ELSE + out (bell) + END IF + END REP. + + lade die datei: + cursor (8, 9); out (meldung 27 + text (zaehler) + " von 50 Dateien"); + fetch (systemdatei (i), archive); + replace (pruefleiste, i, geladen); + insert (archivinhalt, systemdatei (i)); + zaehler INCR 1. + + abschlussaktivitaeten: + release (archive); + cursor (8, 8); out (meldung 28 + del); + cursor (8, 9); out (meldung 29 + del); + pause (50) + +END PROC erforderliche systemdateien eingelesen; + +(* Installation der ls task *) + +PROC install ls: + + INT VAR i; + FOR i FROM 1 UPTO anzahl ls procs REP + insertiere (lskuerzel + text (i) + mathe extension, depot task) + END REP; + do (menu ankoppeln); + IF ibmsatz THEN + do (ibmsatzzeichen) + ELSE + do (stdsatzzeichen) + END IF; + begin (fe taskname, PROC install formeleditor, fe task); + begin (mathe taskname, PROC install mathe, mathe task); + disable stop; + REP + REP + warte auf auftrag + UNTIL order code >= drucker1 erzeugen CAND + order code <= drucker8 erzeugen END REP; + druckerindex := order code - drucker erzeugen; + begin (printer taskname, PROC install printer, printer task); + gib antwort (ok) + END REP + +END PROC install ls; + +(* Installation des Formeleditors *) + +PROC install formeleditor: + + ROW anzahl feprocs TEXT CONST feproc :: + ROW anzahl feprocs TEXT : ("PAC text row", + "PAC element row", + "PAC op store-anpassung", + "PAC formula analyzer", + "PAC formula editor-anpassung", + "mat.formeleditormanager"); + INT VAR i; + FOR i FROM 1 UPTO anzahl fe procs REP + insertiere (feproc (i), depot task) + END REP; + do (menu ankoppeln); + hole notfalls (operatorendatei 1, depot task); + hole notfalls (operatorendatei 2, depot task); + IF ibmsatz THEN + do (ibmops ankoppeln) + ELSE + do (std ops ankoppeln) + END IF; + do (fe manager) + +END PROC install formeleditor; + +(* Installation des eigentlichen Mathematiksystems *) + +PROC install mathe: + + ROW anzahl matheprocs TEXT CONST dname := + ROW anzahl matheprocs TEXT : ("mat.vector", + "mat.referenzobjekte", + "mat.funktionsbibliothek", + "mat.abbildung", + "mat.parser", + "mat.masken", + mathekuerzel + graphicart + plotkuerzel, + "mat.basis plot", + "mat.picture", + "mat.specialgraphic", + "mat.dialoghilfen", + "mat.menufunktionen", + "mat.graphicverfahren", + "mat.wertetabelle", + "mat.nullstellen", + "mat.umformung", + "mat.integrationsverfahren", + "mat.iterationsverfahren"); + INT VAR i; + TEXT CONST zugehoerende zeichen := passender zeichensatz; + insertiere mathesystem; + beende installation. + + passenderzeichensatz: + IF graphicart = "vga" THEN + "ZEICHEN 8*19" + ELIF graphicart = "ega" THEN + "ZEICHEN 8*14" + ELIF graphicart = "cga" THEN + "ZEICHEN 8*8" + ELSE (* "hercules" *) + "ZEICHEN 9*14" + END IF. + + insertiere mathesystem: + do (menu ankoppeln); + hole notfalls (zugehoerende zeichen, depot task); + FOR i FROM 1 UPTO anzahl matheprocs REP + insertiere (dname (i), depot task) + PER. + + beende installation: + TEXT VAR arbeitsauftrag; + commanddialogue (FALSE); + forget (all - maskenname); + commanddialogue (TRUE); + disable stop; + REP + REP + warte auf auftrag + UNTIL order code = ebene 1 behandeln COR + order code = ebene 2 behandeln END REP; + continue (arbeitskanal); + IF order code = ebene 1 behandeln THEN + arbeitsauftrag := ebene 1 handle + ELSE + arbeitsauftrag := ebene 2 handle + END IF; + do (arbeitsauftrag); + gib bildschirm frei (ok) + END REP + +END PROC install mathe; + +(*********************************************************************) +(* I n s t a l l a t i o n d e s D r u c k e r t r e i b e r s *) +(*********************************************************************) + +PROC start printer installation: + + loesche ggf vorhandene task; + bestimme druckeranpassung; + melde installationsbeginn; + richte druckertasks ein. + + loesche ggf vorhandene task: + IF exists task (printer taskname) THEN end (/printer taskname) END IF. + + bestimme druckeranpassung: + druckerindex := druckertreiber. + + melde installationsbeginn: + INT VAR ende := anzahl pri procs; + IF druckerindex > 6 THEN + ende DECR 1 + END IF; + zeige titelzeile (titel 2); + cursor (15, 10); out (meldung 42); + cursor (15, 12); out (meldung 31 + text (ende) + " Dateien"); + installationszaehler := 0. + + richte druckertasks ein: + INT VAR i; + IF NOT exists task (pridepot taskname) THEN + begin (pridepot taskname, PROC free global manager, pridepot task) + END IF; + ls task := /ls taskname; + rufe (ls task, drucker erzeugen + druckerindex); + REP UNTIL exists task (printer taskname) CAND + status (/printer taskname) = 2 END REP; + printer task := /printer taskname; + FOR i FROM 1 UPTO ende REP + insertiere programme (printer task) + END REP + +END PROC start printer installation; + +(* Installation des Druckers *) + +PROC install printer: + + LET anzahl zeichensaetze = 3; + ROW anzahl priprocs TEXT CONST programm :: + ROW anzahl priprocs TEXT : (druckerdatei (4), + druckerdatei (4 + druckerindex), + druckerdatei (13), druckerdatei (14), + druckerdatei (15), druckerdatei (16)); + INT VAR i; + BOOL VAR plotter wird installiert := druckerindex > 6; + do (menu ankoppeln); + IF NOT plotter wird installiert THEN + hole zeichensaetze + END IF; + insertiere die einzelnen programme; + abschlussaktivitaet. + + hole zeichensaetze: + FOR i FROM 1 UPTO anzahl zeichensaetze REP + hole notfalls (druckerdatei (i), /umstell taskname) + PER. + + insertiere die einzelnen programme: + INT VAR anfang := 1; + IF plotter wird installiert THEN + anfang := 2 + END IF; + FOR i FROM anfang UPTO anzahl pri procs REP + insertiere (programm (i), /umstell taskname) + END REP. + + abschlussaktivitaet: + IF NOT plotter wird installiert THEN + FOR i FROM 1 UPTO anzahl zeichensaetze REP + forget (druckerdatei (i), quiet) + END REP + END IF; + IF plotter wird installiert THEN + do (plotter ein) + ELSE + do (plotter aus) + END IF; + disable stop; + REP + REP + warte auf auftrag + UNTIL order code = system starten END REP; + continue (arbeitskanal); + do (druckmenu handle); + gib bildschirm frei (ok) + END REP + +END PROC install printer; + +(*********************************) +(* H i l f s p r o g r a m m e *) +(*********************************) + +(* Programme zur Ausführung des 'insert' *) + +PROC insertiere programme (TASK VAR zieltask): + + installationszaehler INCR 1; + cursor (40, 12); out (text (installationszaehler)); + rufe (zieltask, insertieren); + IF antwort <> ok THEN + errorstop (meldung 32) + END IF + +END PROC insertiere programme; + +PROC insertiere (TEXT CONST name, TASK CONST herkunft): + + REP + warte auf auftrag + UNTIL order code = insertieren END REP; + disable stop; + hole notfalls (name, herkunft); + insert (name); + IF is error THEN + clear error; + gib antwort (fehler) + ELSE + gib antwort (ok) + END IF; + forget (name, quiet); + enable stop + +END PROC insertiere; + +PROC hole notfalls (TEXT CONST name, TASK CONST herkunft): + + IF NOT exists (name) THEN + fetch (name, herkunft) + END IF + +END PROC hole notfalls; + +(***********************************************) +(* Prozeduren zur Intertaskkommunikation *) +(***********************************************) + +(* Die folgenden Prozeduren werden immer da eingesetzt, wo bei + 'call', 'send' und 'wait' der übergebene Datenraum ignoriert + werden kann *) + +PROC rufe (TASK CONST zieltask, INT CONST auftrag): + + message ds := nilspace; + call (zieltask, auftrag, message ds, antwort); + forget (message ds) + +END PROC rufe; + +PROC warte auf auftrag: + + wait (message ds, order code, order task); + forget (message ds) + +END PROC warte auf auftrag; + +PROC gib antwort (INT CONST antwortcode): + + message ds := nilspace; + send (order task, antwortcode, message ds); +(*forget (message ds) *) + +END PROC gib antwort; + +PROC uebergib bildschirm (TASK CONST t, INT CONST auftrag): + + break (quiet); + rufe (t, auftrag); + continue (arbeitskanal) + +END PROC uebergib bildschirm; + +PROC gib bildschirm frei (INT CONST antwortcode): + + break (quiet); + gib antwort (antwortcode) + +END PROC gib bildschirm frei; + +(********************************************************) +(* Auswahlmenüs für Endgeräteanpassungen *) +(********************************************************) + +TEXT PROC graphikkarte: + + LET anzahl plotprocs = 4; + ROW anzahl plotprocs TEXT CONST plotname := + ROW anzahl plotprocs TEXT : ("hercules","cga","ega","vga"); + INT VAR i := 1, zeile; + commanddialogue (TRUE); + zeige titelzeile (titel 2); + FOR zeile FROM 6 UPTO 17 REP + cursor (16, zeile); out (menu 2 (zeile - 5)) + END REP; + REP + cursor (16, 20); out (invers (text (plotname (i), 11))); + IF yes (meldung 33) THEN + commanddialogue (FALSE); + LEAVE graphikkarte WITH plotname (i) + END IF; + i := i MOD anzahl plotprocs + 1 + END REP; + plotname (i) + +END PROC graphikkarte; + +INT PROC druckertreiber: + + LET anzahl plotterprocs = 8; + ROW anzahl plotterprocs TEXT CONST plotname := + ROW anzahl plotterprocs TEXT : ("xerox4045", "epson-sq", "epson-fx", + "binder", "kyocera", "laserjet", + "hp72xx", "hp74xx"); + INT VAR i, zeile; + commanddialogue (TRUE); + zeige titelzeile (titel 3); + FOR zeile FROM 3 UPTO 16 REP + cursor (16, zeile); out (menu 3 (zeile - 2)) + END REP; + i := 1; + REP + cursor (16, 20); out (invers (text (plotname (i), 11))); + IF yes (meldung 33) THEN + commanddialogue (FALSE); + LEAVE druckertreiber WITH i + END IF; + i := i MOD anzahl plotterprocs + 1 + END REP; + i + +END PROC druckertreiber; + +(************************************************) +(* Bildschirmausgaben *) +(************************************************) + +PROC zeige titelzeile (TEXT CONST fktbezeichner): + + TEXT CONST zeile := text (systemname, 78 - length (fktbezeichner)) + + fktbezeichner; + page; + cursor (1,1); out (invers (text (zeile, 79))) + +END PROC zeige titelzeile; + +PROC zeige installationsergebnis (TEXT CONST ziel, BOOL VAR erfolg): + + zeige titelzeile (ziel); + IF is error THEN + clear error; + gib meldung (meldung 22); + erfolg := FALSE + ELSE + gib meldung (meldung 21); + erfolg := TRUE + END IF + +END PROC zeige installationsergebnis; + +PROC gib meldung (TEXT CONST meldungstext): + + cursor (1, 23); out (meldungstext); + cursor (1, 24); out (invers (text (meldung 26, 77))); + clear buffer; pause + +END PROC gib meldung; + +PROC clear buffer: + + REP UNTIL incharety = niltext PER + +END PROC clear buffer; + +BOOL PROC ja (TEXT CONST frage): + + BOOL VAR antwort; + commanddialogue (TRUE); + cursor (1, 22); antwort := yes (frage); + cursor (1, 22); out (del); + commanddialogue (FALSE); + antwort + +END PROC ja; + +TEXT PROC invers (TEXT CONST t): + + beginmark + t + endmark + +END PROC invers; + +(*************************************************************************) +(* P a s s w o r t s c h u t z *) +(*************************************************************************) +(* Zur Vermeidung einer irrtümlichen oder 'böswilligen' Neuinstallation *) +(* des Mathesystems kann nach erfolgter Installation ein Passwort verge- *) +(* ben werden, das beim Versuch der Neuinstallation abgefragt wird. *) +(*************************************************************************) + +BOOL PROC korrektes password: + + installationspassword = niltext COR password getroffen. + + password getroffen: + TEXT VAR eingabe; + cursor (24, 18); out (meldung 45 + del); + get secret line (eingabe); + IF eingabe = installationspassword THEN + cursor (24, 18); out (del); + LEAVE password getroffen WITH TRUE + END IF; + out (bell); + FALSE + +END PROC korrektes password; + +PROC definiere password: + + installationspassword := niltext; + cursor (1, 23); out (delpage); + IF ja (meldung 46) THEN + cursor (1, 23); out (meldung 45 + beginmark + left); + editget (installationspassword, 40, 20); + out (endmark) + END IF + +END PROC definiere password; + +END PACKET mathe verwaltung; + + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.vga plot b/app/schulis-mathematiksystem/1.0/src/mat.vga plot new file mode 100644 index 0000000..730434b --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.vga plot @@ -0,0 +1,3 @@ +PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETvgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,cursor,getcursor,out,zeichensatz,where,zeichenhoehe,zeichenbreite,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=35.0365,anzahlx=640,anzahly=480,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=480,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die VGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"vga"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,17,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):pos.xDRAWpos.y;control(-6,x,ypixel-1-y,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT + CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ypixel-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,ypixel-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>xpixel-1THENx:=xpixel-1ELIFx<0THENx:=0END IF;IFy>ypixel-1THENy:=ypixel-1ELIFy<0THENy:=0END IF END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:19END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETvgaplot;zeichensatz("ZEICHEN 8*19") + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle b/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle new file mode 100644 index 0000000..223d7b8 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle @@ -0,0 +1,4 @@ +PACKETwertetabelleDEFINESerstellewertetabelle:LETniltext="",del="�",blank=" ",unterstrichzeichen="_",maximalanzahl=4000.0,maxfelder=100,weiterarbeit="w",naechste="q",abbruchzeichen="!",fktbezeichnung="Fktswert",PARAMETER=ROWmaxfelderTEXT;PROCerstellewertetabelle(ABBILDUNG CONSTfunktion):VECTOR VAReingabewerte;REAL VARendwert,schrittweite;INT VARlaufvariablenindex,durchgangsnummer:=1,i;WINDOW VARwt:=window(2,7,77,16);TEXT VARausstieg,zulaessigezeichen;TEXT CONSTkurzerstrich:=25*unterstrichzeichen,wert1:="-5.0"+kurzerstrich,wert2:="5.0"+kurzerstrich,wert3:="1.0"+kurzerstrich,tabellendateiname:=scratchdateiname;FILE VARh:=sequentialfile(modify,tabellendateiname);schreibearbeitsfunktion(funktion);bestimmelaufvariablenwerte;erstellegegebenenfallsaufloesungderfunktion;bearbeitediefunktion;loeschegegebenenfallsaufloesungderfunktion.bestimmelaufvariablenwerte:TAG VAReingabemaske:=formular(2);initialisierelaufvariablenformular;editierelaufvariablenformular.initialisierelaufvariablenformular:PARAMETER VARraster;INT VARstartfeld:=2;raster(1):=niltext;raster(2):=NAMElistenanfang(abbildungsvariablen(funktion));raster(3):=wert1;raster(4):=wert2;raster(5):=wert3;IFebene=1CORlaenge(abbildungsvariablen(funktion))=1THENsetfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2)CATkurzerstrichEND IF;zulaessigezeichen:="?wqm".editierelaufvariablenformular:REPbearbeitelaufvariablenformular;werteausstiegszeichenausEND REP.bearbeitelaufvariablenformular:footnote(anwendungstext(115));show(eingabemaske);strich(5);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);ausstieg:=naechsteEND IF.werteausstiegszeichenaus:SELECTpos(zulaessigezeichen,ausstieg)OF CASE1:gibinformationenzumlaufvariablenformularCASE2:verarbeiteeingabenCASE3,4:forget(tabellendateiname,quiet);verfahrensende(ausstieg);LEAVEerstellewertetabelleEND SELECT.verarbeiteeingaben:footnote(anwendungstext(114));IFkorrektervariablenindexCANDkorrekteranfangswertCANDkorrekterendwertCANDkorrekteschrittweiteTHEN FORiFROM2UPTO5REPraster(i)CAT((20-length(raster(i)))*unterstrichzeichen);changeall(raster(i),blank,unterstrichzeichen)END REP;LEAVEeditierelaufvariablenformularEND IF;FORiFROM2UPTO5REPraster(i)CAT((20-length(raster(i)))*unterstrichzeichen);changeall(raster(i),blank,unterstrichzeichen)END REP.korrektervariablenindex:TERM VARvaradresse:=listenanfang(abbildungsvariablen(funktion));IFebene=1CORlaenge(abbildungsvariablen(funktion))=1THENlaufvariablenindex:=1;TRUE ELSEchangeall(raster(2),unterstrichzeichen,blank);varadresse:=listenposition(abbildungsvariablen(funktion),raster(2));IFvaradresse=nilTHENgibmeldung(anwendungstext(156));startfeld:=2;FALSE ELSElaufvariablenindex:=PLATZvaradresse;TRUE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrichzeichen,blank);REAL VARanfangswert:=realzahl(raster(3));IFiserrorTHENclearerror;gibmeldung(anwendungstext(157));startfeld:=3;FALSE ELSEeingabewerte:=vector(laenge(abbildungsvariablen(funktion)));replace(eingabewerte,laufvariablenindex,anfangswert);TRUE END IF.korrekterendwert:changeall(raster(4),unterstrichzeichen,blank);endwert:=realzahl(raster(4));IFiserrorTHENclearerror;gibmeldung(anwendungstext(158));startfeld:=4;FALSE ELIFendwert1CANDlaenge(abbildungsvariablen(f))<10THENtrageparameterbelegunginwertetabelleeinEND IF;schreibediewertetabellenueberschriften;schreibewertetabellenzeilen.trageparameterbelegunginwertetabelleein:INT VARk:=1;WHILEk<=laenge(abbildungsvariablen(f))REP IFk<>laufvariablenindexTHEN IFdurchgangsnummer=1THENergaenzewertetabellendatei(h,zeilennummer,text(NAMEauswahl(abbildungsvariablen(f),k),gesamtstellen(ebene)))END IF;ergaenzewertetabellendatei(h,zeilennummer,senkrecht+text(wandle(eingabewerteSUBk),laenge(abbildungsterme(f))*gesamtstellen(ebene)+laenge(abbildungsterme(f))-1));zeilennummerINCR1END IF;kINCR1END REP.schreibediewertetabellenueberschriften:ergaenzewertetabellendatei(h,zeilennummer,ueberschrift);zeilennummerINCR1;ergaenzewertetabellendatei(h,zeilennummer,unterstrich).ueberschrift:TEXT VARzeile:=niltext;IFdurchgangsnummer=1THENzeileCATtext(variablenname,gesamtstellen(ebene))END IF;IFlaenge(abbildungsterme(f))=1THENzeileCATtext(senkrecht+fktbezeichnung,gesamtstellen(ebene)+1)ELSE FORiFROM1UPTOlaenge(abbildungsterme(f))REPzeileCATtext(senkrecht+fktbezeichnung+text(i,2),gesamtstellen(ebene)+1)END REP END IF;zeile.unterstrich:TEXT VARus:=niltext;IFdurchgangsnummer=1THENusCAT(gesamtstellen(ebene)*waagerecht);END IF;FORiFROM1UPTOlaenge(abbildungsterme(f))REPusCAT(kreuz+gesamtstellen(ebene)*waagerecht)END REP;us.schreibewertetabellenzeilen:footnote(anwendungstext(117));cursor(36,24);REPbefragetastatur;zeilennummerINCR1;x:=parameterSUBlaufvariablenindex;ausgabezeile:=niltext;IFdurchgangsnummer=1THENausgabezeileCATwandle(x)END IF;y:=ergebnis(f,parameter);IFiserrorTHENclearerror;FORiFROM1UPTOlaenge(abbildungsterme(f))REPausgabezeileCATsenkrecht;ausgabezeileCATgesamtstellen(ebene)*"-"END REP ELSE FORiFROM1UPTOlaenge(abbildungsterme(f))REPausgabezeileCATsenkrecht;ausgabezeileCATwandle(ySUBi)END REP END IF;ergaenzewertetabellendatei(h,zeilennummer,ausgabezeile);cout(zeilennummer-yscrollbeginn+1);IFx=endwertTHEN LEAVEberechnediewertetabelleELIFx+schrittweite>endwertTHENx:=endwertELSEx:=x+schrittweiteEND IF;replace(parameter,laufvariablenindex,x)END REP.befragetastatur:IFincharety=abbruchzeichenTHENforget(tabellendateiname,quiet);LEAVEbearbeitediefunktionEND IF.zeigewertetabelle:TEXT VARfusszeile;zulaessigezeichen:="?dqm";IFlaenge(abbildungsvariablen(f))<>1THENzulaessigezeichenCATweiterarbeit;fusszeile:=anwendungstext(133)ELSEfusszeile:=anwendungstext(171)END IF;ersterauszugebendersatz:=yscrollbeginn;ersteauszugebendespalte:=gesamtstellen(ebene)+2+(durchgangsnummer-1)*laenge(abbildungsterme(f))*(gesamtstellen(ebene)+1);outframe(wt);REPfootnote(fusszeile);scroll(wt,tabellendateiname,gesamtstellen(ebene)+2,yscrollbeginn,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,zulaessigezeichen,ausstieg);SELECTpos(zulaessigezeichen,ausstieg)OF CASE1:zeigeinformationstextCASE2:aufbereitetdrucken(tabellendateiname,text(funktionsstring(funktion), +druckspalten),gesamtstellen(ebene)+2,yscrollbeginn,gesamtstellen(ebene)+1);outframe(wt)CASE3,4:forget(tabellendateiname,quiet);verfahrensende(ausstieg);LEAVEerstellewertetabelleCASE5:LEAVEzeigewertetabelleEND SELECT END REP.zeigeinformationstext:show(formular(9));warte.loeschegegebenenfallsaufloesungderfunktion:IFloeschflagTHENloescheabbildung(f)END IF END PROCerstellewertetabelle;PROCergaenzewertetabellendatei(FILE VARf,INT CONSTzeile,TEXT CONSTergaenzung):TEXT VARsatz;toline(f,zeile);readrecord(f,satz);IFsatz=niltextTHENinsertrecord(f);END IF;writerecord(f,satz+ergaenzung)END PROCergaenzewertetabellendatei;END PACKETwertetabelle; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot b/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot new file mode 100644 index 0000000..ec5eb2c --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot @@ -0,0 +1,4 @@ +PACKETxeroxplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LEThorpixel=720,verpixel=532,intsperscanline=45,horfaktor=29.528,vertfaktor=29.528,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARanzahlgleichersixel,altessixel,plotterchannel:=15;INT VARxpos,ypos,xfak,yfak,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.75,buchstabenbreite:=0.305,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=24.4;ycm:=18.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARbitsleft:=0,bits,hilfsvariable,buffer;anzahlgleichersixel:=1;druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterkanal).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out("�+X �+0XCP12.5iso-L �0"+"�+P �m2480,0,0,0,3508 �gw");magnification4;out(";236,312,"+text(horpixel)+","+text(verpixel)+" ");altessixel:=-53.magnification4:out("4").gibdiebitmapaus:INT VARi;FORiFROMverpixelDOWNTO1REPgibeinezeilederbitmapausPER.gibeinezeilederbitmapaus:INT VARj;FORjFROM1UPTOintsperscanlineREPbits:=bitmap(i)(j);gibdie16bitsalssixelausPER.gibdie16bitsalssixelaus:SELECTbitsleftOF CASE0:sendemitshift0CASE2:sendemitshift2CASE4:sendemitshift4END SELECT.sendemitshift0:sixelsend(firstsixbits);sixelsend((bitsAND1008)DIV16);buffer:=((bitsAND15)*4);bitsleft:=4.firstsixbits:hilfsvariable:=bits;rotate(hilfsvariable,6);hilfsvariableAND63.sendemitshift2:sixelsend(buffer+firstfourbits);sixelsend((bitsAND4032)DIV64);sixelsend(bitsAND63);bitsleft:=0.firstfourbits:hilfsvariable:=bits;rotate(hilfsvariable,4);hilfsvariableAND15.sendemitshift4:sixelsend(buffer+firsttwobits);sixelsend((bitsAND16128)DIV256);sixelsend((bitsAND252)DIV4);buffer:=((bitsAND3)*16);bitsleft:=2.firsttwobits:hilfsvariable:=bits;rotate(hilfsvariable,2);hilfsvariableAND3.druckedieseite:sendeletztessixel;out("��+P ").sendeletztessixel:sixelsend(-1).END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;korrigierenextpointnr.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs< +totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTi,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(i):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:xaltessixelTHENsendealtessixel;altessixel:=neuessixelELIFanzahlgleichersixel<32000THENanzahlgleichersixelINCR1ELSEsendealtessixel;altessixel:=neuessixelFI.sendealtessixel:IFanzahlgleichersixel=1THENout(code(altessixel+63))ELSEout(text(anzahlgleichersixel)+code(altessixel+63));anzahlgleichersixel:=1FI.END PROCsixelsend;INT PROCplotterkanal:plotterchannel +END PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETxeroxplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16"); + diff --git a/app/schulis-mathematiksystem/1.0/src/mathe formulare b/app/schulis-mathematiksystem/1.0/src/mathe formulare new file mode 100644 index 0000000..8a6400e Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/mathe formulare differ diff --git a/app/schulis-mathematiksystem/1.0/src/spool cmd b/app/schulis-mathematiksystem/1.0/src/spool cmd new file mode 100644 index 0000000..6a78cc1 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/spool cmd @@ -0,0 +1,3 @@ +PACKETspoolcmdDEFINESspoolcontrolpassword,killspool,firstspool,startspool,stopspool,haltspool,waitforhalt:LETerrornak=2,entrylinecode=23,killercode=24,firstcode=25,startcode=26,stopcode=27,haltcode=28,waitforhaltcode=29;DATASPACE VARds;BOUND STRUCT(TEXTentryline,INTindex,TEXTactualentries,password)VARcontrolmsg;BOUND TEXT VARerrormsg;INT VARreply;INITFLAG VARinthistask:=FALSE;BOOL VARdialogue;TEXT VARcontrolpassword,password;controlpassword:="";PROCspoolcontrolpassword(TEXT CONSTnewpassword):IFonlineTHENsay("� �")FI;disablestop;do("enter spool control password (""+newpassword+"")");clearerror;nodoagain;covertracks;covertracks(controlpassword);controlpassword:=newpassword;END PROCspoolcontrolpassword;PROCcallspool(INT CONSTopcode,TEXT CONSTname,TASK CONSTspool):dialogue:=commanddialogue;password:=writepassword;passwordCAT"/";passwordCATreadpassword;disablestop;commanddialogue(FALSE);enterpassword(controlpassword);commanddialogue(dialogue);call(opcode,name,spool);commanddialogue(FALSE);enterpassword(password);commanddialogue(dialogue);END PROCcallspool;PROCstartspool(TASK CONSTspool):enablestop;callspool(haltcode,"",spool);callspool(startcode,"",spool);END PROCstartspool;PROCstartspool(TASK CONSTspool,INT CONSTnewchannel):enablestop;callspool(haltcode,"",spool);callspool(startcode,text(newchannel),spool);END PROCstartspool;PROCstopspool(TASK CONSTspool):callspool(stopcode,"",spool);END PROCstopspool;PROCstopspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(stopcode,deactivemsg,spool);END PROCstopspool;PROChaltspool(TASK CONSTspool):callspool(haltcode,"",spool);END PROChaltspool;PROChaltspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(haltcode,deactivemsg,spool);END PROChaltspool;PROCwaitforhalt(TASK CONSTspool):callspool(waitforhaltcode,"",spool);END PROCwaitforhalt;PROCwaitforhalt(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(waitforhaltcode,deactivemsg,spool);END PROCwaitforhalt;PROCcontrolspool(TASK CONSTspool,INT CONSTcontrolcode,TEXT CONSTquestion,BOOL CONSTleave):enablestop;initializecontrolmsg;WHILEvalidspoolentryREP IFcontrolquestionTHENcontrolspoolentryFI PER;.initializecontrolmsg:IF NOTinitialized(inthistask)THENds:=nilspaceFI;forget(ds);ds:=nilspace;controlmsg:=ds;controlmsg.entryline:="";controlmsg.password:=controlpassword;controlmsg.index:=0;say(" +");.validspoolentry:call(spool,entrylinecode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;controlmsg.index<>0.controlquestion:say(controlmsg.entryline);yes(question).controlspoolentry:call(spool,controlcode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;IFleaveTHEN LEAVEcontrolspoolFI;END PROCcontrolspool;PROCkillspool(TASK CONSTspool):controlspool(spool,killercode," loeschen",FALSE)END PROCkillspool;PROCfirstspool(TASK CONSTspool):controlspool(spool,firstcode," als erstes",TRUE)END PROCfirstspool;END PACKETspoolcmd; + diff --git a/app/schulis-mathematiksystem/1.0/src/standardoperatoren b/app/schulis-mathematiksystem/1.0/src/standardoperatoren new file mode 100644 index 0000000..647611b Binary files /dev/null and b/app/schulis-mathematiksystem/1.0/src/standardoperatoren differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie" new file mode 100644 index 0000000..e2ef232 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 code info ds" new file mode 100644 index 0000000..c754ba3 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 originalkurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 originalkurve ds" new file mode 100644 index 0000000..ff1a5a1 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 originalkurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 vergleichskurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 vergleichskurve ds" new file mode 100644 index 0000000..1d35616 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 1 vergleichskurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 10 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 10 code info ds" new file mode 100644 index 0000000..e542599 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 10 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 11 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 11 code info ds" new file mode 100644 index 0000000..00f3658 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 11 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 12 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 12 code info ds" new file mode 100644 index 0000000..0b56808 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 12 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 13 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 13 code info ds" new file mode 100644 index 0000000..2b7b5c9 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 13 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 14 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 14 code info ds" new file mode 100644 index 0000000..18005f1 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 14 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 code info ds" new file mode 100644 index 0000000..f9cf1eb Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 originalkurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 originalkurve ds" new file mode 100644 index 0000000..c8a90e9 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 originalkurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 vergleichskurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 vergleichskurve ds" new file mode 100644 index 0000000..6cb6376 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 2 vergleichskurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 code info ds" new file mode 100644 index 0000000..ebfbf3d Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 originalkurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 originalkurve ds" new file mode 100644 index 0000000..718d2fd Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 originalkurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 vergleichskurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 vergleichskurve ds" new file mode 100644 index 0000000..a0101f3 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 3 vergleichskurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 code info ds" new file mode 100644 index 0000000..9fdce06 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 originalkurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 originalkurve ds" new file mode 100644 index 0000000..15e7407 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 originalkurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 vergleichskurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 vergleichskurve ds" new file mode 100644 index 0000000..165f8d9 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 4 vergleichskurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 code info ds" new file mode 100644 index 0000000..4870f1a Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 originalkurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 originalkurve ds" new file mode 100644 index 0000000..e568313 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 originalkurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 vergleichskurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 vergleichskurve ds" new file mode 100644 index 0000000..b0487d1 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 5 vergleichskurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 code info ds" new file mode 100644 index 0000000..00410ea Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 originalkurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 originalkurve ds" new file mode 100644 index 0000000..c7c0891 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 originalkurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 vergleichskurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 vergleichskurve ds" new file mode 100644 index 0000000..7924b84 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 6 vergleichskurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 code info ds" new file mode 100644 index 0000000..8bfc365 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 originalkurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 originalkurve ds" new file mode 100644 index 0000000..136a763 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 originalkurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 vergleichskurve ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 vergleichskurve ds" new file mode 100644 index 0000000..0360f1e Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 7 vergleichskurve ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 8 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 8 code info ds" new file mode 100644 index 0000000..f489af2 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 8 code info ds" differ diff --git "a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 9 code info ds" "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 9 code info ds" new file mode 100644 index 0000000..e89f437 Binary files /dev/null and "b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populations\303\266kologie 9 code info ds" differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik new file mode 100644 index 0000000..3e04b6f Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 code info ds new file mode 100644 index 0000000..8b0d00a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 originalkurve ds new file mode 100644 index 0000000..9dce7dc Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 vergleichskurve ds new file mode 100644 index 0000000..bd49cc8 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 code info ds new file mode 100644 index 0000000..26dd66c Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 originalkurve ds new file mode 100644 index 0000000..1836f9f Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 vergleichskurve ds new file mode 100644 index 0000000..cc48114 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 3 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 3 code info ds new file mode 100644 index 0000000..c6e9603 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 4 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 4 code info ds new file mode 100644 index 0000000..6a36c07 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall new file mode 100644 index 0000000..5297fb8 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 code info ds new file mode 100644 index 0000000..f6bbe2c Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 originalkurve ds new file mode 100644 index 0000000..1fbd808 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 vergleichskurve ds new file mode 100644 index 0000000..1090174 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 10 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 10 code info ds new file mode 100644 index 0000000..1d797c1 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 10 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 code info ds new file mode 100644 index 0000000..dc0df36 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 originalkurve ds new file mode 100644 index 0000000..9a8dc0d Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 vergleichskurve ds new file mode 100644 index 0000000..8aa32d2 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 code info ds new file mode 100644 index 0000000..a9d16e8 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 originalkurve ds new file mode 100644 index 0000000..40e4655 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 vergleichskurve ds new file mode 100644 index 0000000..02d1eff Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 3 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 code info ds new file mode 100644 index 0000000..709b811 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 originalkurve ds new file mode 100644 index 0000000..828b9d4 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 vergleichskurve ds new file mode 100644 index 0000000..013aed8 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 4 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 code info ds new file mode 100644 index 0000000..4faa893 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 originalkurve ds new file mode 100644 index 0000000..fc98ea6 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 vergleichskurve ds new file mode 100644 index 0000000..c7f314e Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 5 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 6 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 6 code info ds new file mode 100644 index 0000000..e220e44 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 6 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 7 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 7 code info ds new file mode 100644 index 0000000..cf64601 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 7 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 8 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 8 code info ds new file mode 100644 index 0000000..ad5d290 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 8 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 9 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 9 code info ds new file mode 100644 index 0000000..f04cb25 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall 9 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I new file mode 100644 index 0000000..47a1b43 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 code info ds new file mode 100644 index 0000000..283c544 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 originalkurve ds new file mode 100644 index 0000000..570d5ba Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 vergleichskurve ds new file mode 100644 index 0000000..05334a2 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 code info ds new file mode 100644 index 0000000..da9189a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 originalkurve ds new file mode 100644 index 0000000..4fed8cf Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 vergleichskurve ds new file mode 100644 index 0000000..7f60ffe Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 code info ds new file mode 100644 index 0000000..e74f5e9 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 originalkurve ds new file mode 100644 index 0000000..2addd88 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 vergleichskurve ds new file mode 100644 index 0000000..29e37d9 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 3 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 4 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 4 code info ds new file mode 100644 index 0000000..c5b70f6 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 5 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 5 code info ds new file mode 100644 index 0000000..8fb5b48 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 5 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 6 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 6 code info ds new file mode 100644 index 0000000..58e62c6 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I 6 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II new file mode 100644 index 0000000..5b87476 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 code info ds new file mode 100644 index 0000000..cb2d987 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 originalkurve ds new file mode 100644 index 0000000..fc951fe Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 vergleichskurve ds new file mode 100644 index 0000000..4653751 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 10 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 10 code info ds new file mode 100644 index 0000000..a97b17f Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 10 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 11 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 11 code info ds new file mode 100644 index 0000000..cbc3b0f Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 11 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 12 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 12 code info ds new file mode 100644 index 0000000..54dfcb7 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 12 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 13 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 13 code info ds new file mode 100644 index 0000000..295d3d7 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 13 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 14 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 14 code info ds new file mode 100644 index 0000000..87c3018 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 14 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 code info ds new file mode 100644 index 0000000..63d2732 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 originalkurve ds new file mode 100644 index 0000000..8f55a2b Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 vergleichskurve ds new file mode 100644 index 0000000..25716cc Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 code info ds new file mode 100644 index 0000000..035b736 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 originalkurve ds new file mode 100644 index 0000000..06f7413 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 vergleichskurve ds new file mode 100644 index 0000000..e16c385 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 3 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 code info ds new file mode 100644 index 0000000..d2fc78b Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 originalkurve ds new file mode 100644 index 0000000..b9a35d7 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 vergleichskurve ds new file mode 100644 index 0000000..e58437e Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 4 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 code info ds new file mode 100644 index 0000000..423d615 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 originalkurve ds new file mode 100644 index 0000000..d181d07 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 vergleichskurve ds new file mode 100644 index 0000000..3ff5fac Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 5 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 code info ds new file mode 100644 index 0000000..9253113 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 originalkurve ds new file mode 100644 index 0000000..66d5c63 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 vergleichskurve ds new file mode 100644 index 0000000..177253b Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 6 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 code info ds new file mode 100644 index 0000000..0c946cc Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 originalkurve ds new file mode 100644 index 0000000..0934e00 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 vergleichskurve ds new file mode 100644 index 0000000..c0119a7 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 7 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 8 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 8 code info ds new file mode 100644 index 0000000..d5ed310 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 8 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 9 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 9 code info ds new file mode 100644 index 0000000..c18fb36 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II 9 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld new file mode 100644 index 0000000..e06a384 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 code info ds new file mode 100644 index 0000000..f629a5a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 originalkurve ds new file mode 100644 index 0000000..e7b91fb Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 vergleichskurve ds new file mode 100644 index 0000000..a9137ed Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 code info ds new file mode 100644 index 0000000..f57e3a3 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 originalkurve ds new file mode 100644 index 0000000..3f9f40b Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 vergleichskurve ds new file mode 100644 index 0000000..08eec77 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 code info ds new file mode 100644 index 0000000..0f99938 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 originalkurve ds new file mode 100644 index 0000000..45d0365 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 vergleichskurve ds new file mode 100644 index 0000000..09c3d4c Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 3 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 code info ds new file mode 100644 index 0000000..dc4c950 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 originalkurve ds new file mode 100644 index 0000000..657df6d Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 vergleichskurve ds new file mode 100644 index 0000000..b636a09 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 4 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 5 code info ds new file mode 100644 index 0000000..51b2221 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 5 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 6 code info ds new file mode 100644 index 0000000..c245d8f Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 6 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 7 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 7 code info ds new file mode 100644 index 0000000..a3d59ad Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 7 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 8 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 8 code info ds new file mode 100644 index 0000000..c8c84b8 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld 8 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen new file mode 100644 index 0000000..217bfdc Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 code info ds new file mode 100644 index 0000000..458a4b8 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 originalkurve ds new file mode 100644 index 0000000..36d0bb8 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 vergleichskurve ds new file mode 100644 index 0000000..7117015 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 code info ds new file mode 100644 index 0000000..d8cc452 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 originalkurve ds new file mode 100644 index 0000000..a719225 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 vergleichskurve ds new file mode 100644 index 0000000..44b86db Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 code info ds new file mode 100644 index 0000000..638820a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 originalkurve ds new file mode 100644 index 0000000..f5f626d Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 vergleichskurve ds new file mode 100644 index 0000000..7f84ec1 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 3 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 4 code info ds new file mode 100644 index 0000000..23017d4 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 5 code info ds new file mode 100644 index 0000000..9c708b1 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 5 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 6 code info ds new file mode 100644 index 0000000..2173675 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen 6 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern new file mode 100644 index 0000000..b3a005a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 code info ds new file mode 100644 index 0000000..da668bc Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 originalkurve ds new file mode 100644 index 0000000..ab2524c Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 vergleichskurve ds new file mode 100644 index 0000000..d61fcce Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 10 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 10 code info ds new file mode 100644 index 0000000..7188064 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 10 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 code info ds new file mode 100644 index 0000000..10ae13f Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 originalkurve ds new file mode 100644 index 0000000..8cb0350 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 vergleichskurve ds new file mode 100644 index 0000000..25047b5 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 code info ds new file mode 100644 index 0000000..bca8bc0 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 originalkurve ds new file mode 100644 index 0000000..ebfee05 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 vergleichskurve ds new file mode 100644 index 0000000..bfdc85a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 3 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 code info ds new file mode 100644 index 0000000..7e51cda Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 originalkurve ds new file mode 100644 index 0000000..6b95da2 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 vergleichskurve ds new file mode 100644 index 0000000..cf3a9bc Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 4 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 code info ds new file mode 100644 index 0000000..5824c74 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 originalkurve ds new file mode 100644 index 0000000..bec3fdd Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 vergleichskurve ds new file mode 100644 index 0000000..9afdb18 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 5 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 6 code info ds new file mode 100644 index 0000000..7c57776 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 6 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 7 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 7 code info ds new file mode 100644 index 0000000..f20f4c7 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 7 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 8 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 8 code info ds new file mode 100644 index 0000000..86f7138 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 8 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 9 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 9 code info ds new file mode 100644 index 0000000..152400e Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern 9 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen new file mode 100644 index 0000000..800d852 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 code info ds new file mode 100644 index 0000000..dd1bf34 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 originalkurve ds new file mode 100644 index 0000000..e247d03 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 vergleichskurve ds new file mode 100644 index 0000000..fd28612 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 10 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 10 code info ds new file mode 100644 index 0000000..3213b89 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 10 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 11 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 11 code info ds new file mode 100644 index 0000000..d727472 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 11 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 12 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 12 code info ds new file mode 100644 index 0000000..d90d730 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 12 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 13 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 13 code info ds new file mode 100644 index 0000000..2d8e131 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 13 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 14 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 14 code info ds new file mode 100644 index 0000000..8fc92c9 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 14 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 code info ds new file mode 100644 index 0000000..5b45740 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 originalkurve ds new file mode 100644 index 0000000..b95226d Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 vergleichskurve ds new file mode 100644 index 0000000..56add2a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 code info ds new file mode 100644 index 0000000..17f584c Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 originalkurve ds new file mode 100644 index 0000000..2f9dadf Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 vergleichskurve ds new file mode 100644 index 0000000..b09599a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 3 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 code info ds new file mode 100644 index 0000000..5042dc5 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 originalkurve ds new file mode 100644 index 0000000..e7969e2 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 vergleichskurve ds new file mode 100644 index 0000000..c057670 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 4 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 code info ds new file mode 100644 index 0000000..6f83eb0 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 originalkurve ds new file mode 100644 index 0000000..2ae1122 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 vergleichskurve ds new file mode 100644 index 0000000..a43b502 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 5 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 code info ds new file mode 100644 index 0000000..38232c1 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 originalkurve ds new file mode 100644 index 0000000..ea08e21 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 vergleichskurve ds new file mode 100644 index 0000000..030b66f Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 6 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 code info ds new file mode 100644 index 0000000..9a4739c Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 originalkurve ds new file mode 100644 index 0000000..44d1712 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 vergleichskurve ds new file mode 100644 index 0000000..813c12d Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 7 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 8 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 8 code info ds new file mode 100644 index 0000000..db2af96 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 8 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 9 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 9 code info ds new file mode 100644 index 0000000..87ded51 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen 9 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen new file mode 100644 index 0000000..770bc44 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 code info ds new file mode 100644 index 0000000..172cd62 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 originalkurve ds new file mode 100644 index 0000000..01b19cf Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 vergleichskurve ds new file mode 100644 index 0000000..25c11d3 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 1 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 code info ds new file mode 100644 index 0000000..1ef5fa5 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 originalkurve ds new file mode 100644 index 0000000..7b11c58 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 vergleichskurve ds new file mode 100644 index 0000000..059ddcd Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 2 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 code info ds new file mode 100644 index 0000000..2b9d6df Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 originalkurve ds new file mode 100644 index 0000000..ab1c8c5 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 originalkurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 vergleichskurve ds new file mode 100644 index 0000000..5132825 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 3 vergleichskurve ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 4 code info ds new file mode 100644 index 0000000..0ea6486 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 4 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 5 code info ds new file mode 100644 index 0000000..f75da5e Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 5 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 6 code info ds new file mode 100644 index 0000000..0af2e7c Binary files /dev/null and b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen 6 code info ds differ diff --git a/app/schulis-simulationssystem/3.0/source-disk b/app/schulis-simulationssystem/3.0/source-disk new file mode 100644 index 0000000..cfd911d --- /dev/null +++ b/app/schulis-simulationssystem/3.0/source-disk @@ -0,0 +1,4 @@ +schulis-simulationssystem-3.0/04_simulationssystem-startdiskette.img +schulis-simulationssystem-3.0/05_modelldatenbank-biologie.img +schulis-simulationssystem-3.0/06_modelldatenbank-chemie.img +schulis-simulationssystem-3.0/07_modelldatenbank-physik.img diff --git a/app/schulis-simulationssystem/3.0/src/TEXTE deutsch b/app/schulis-simulationssystem/3.0/src/TEXTE deutsch new file mode 100644 index 0000000..2f6bd23 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/TEXTE deutsch differ diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 6*10 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 6*10 new file mode 100644 index 0000000..373245e Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/ZEICHEN 6*10 differ diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*14 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*14 new file mode 100644 index 0000000..cdb76cb Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*14 differ diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*16 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*16 new file mode 100644 index 0000000..49b821a Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*16 differ diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*19 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*19 new file mode 100644 index 0000000..caff4ba Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*19 differ diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*8 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*8 new file mode 100644 index 0000000..5a455fa Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*8 differ diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 9*14 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 9*14 new file mode 100644 index 0000000..46e2f95 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/ZEICHEN 9*14 differ diff --git a/app/schulis-simulationssystem/3.0/src/bs b/app/schulis-simulationssystem/3.0/src/bs new file mode 100644 index 0000000..8cd5e0a --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/bs @@ -0,0 +1,2 @@ +PACKETbildschirmspeicherDEFINESgibdiagrammausschnitt,newout,lineout,zwischenraumohnebox,inboxspeicher,bsspeicherinit,bsspeicherlesen:LETblank=" ",stdlaenge=80,linealzeile=22;LET BILDSCHIRMSPEICHER=STRUCT(ROW24TEXTboxspeicher,bildspeicher);DATASPACE VARbsds;BOUND BILDSCHIRMSPEICHER VARbs;BOOL VARlinealein:=TRUE;WINDOW VARfenster:=standardfenster;OP:=(BILDSCHIRMSPEICHER VARleft,BILDSCHIRMSPEICHER CONSTright):left:=rightEND OP:=;PROCbsspeicherinit:bsspeicherinit(TRUE)END PROCbsspeicherinit;PROCbsspeicherinit(BOOL CONSTmitbildschirmausgabe):INT VARi;TEXT VARblank:=stdlaenge*" ";forget(bsds);bsds:=nilspace;bs:=bsds;zeileninitialisieren;linealinitialisieren.zeileninitialisieren:FORiFROM1UPTO24REPbs.boxspeicher(i):=blank;bs.bildspeicher(i):=blankPER;bs.bildspeicher(linealzeile):=(stdlaenge-1)*waagerecht.linealinitialisieren:linealausgeben(mitbildschirmausgabe).END PROCbsspeicherinit;PROCbsspeicherlesen(AREA CONSTa):INT VARi,ax,axs;ax:=areax(a);axs:=ax+areaxsize(a)-1;FORiFROMareay(a)UPTOareay(a)+areaysize(a)-1REPcursor(ax,i);outsubtext(bs.bildspeicher(i),ax,axs)PER;END PROCbsspeicherlesen;PROCbsspeicherlesen(WINDOW CONSTw):AREA VARareazuw;fill(areazuw,areax(w)-1,areay(w)-1,areaxsize(w)+2,areaysize(w)+2);bsspeicherlesen(areazuw);END PROCbsspeicherlesen;PROCgibdiagrammausschnitt(FILE VARf):modify(f);insertrecord(f);writerecord(f,blank);bsspeicherinfile;unterkantedesrahmens.zwischenstueck:(stdlaenge-1)*waagerecht.bsspeicherinfile:INT VARi;TEXT VARzeile;FORiFROM2UPTOlinealzeile-1REPzeile:=bs.bildspeicher(i);IF(zeileSUB1)=blankTHENreplace(zeile,1,senkrecht)FI;neuedateizeile(f,zeile)PER.unterkantedesrahmens:neuedateizeile(f,eckeuntenlinks+subtext(bs.bildspeicher(linealzeile),2,stdlaenge)).END PROCgibdiagrammausschnitt;PROCneuedateizeile(FILE VARf,TEXT CONSTt):down(f);insertrecord(f);writerecord(f,compress(t))END PROCneuedateizeile;PROCnewout(WINDOW VARw,INT CONSTi,j,TEXT CONSTt):cursor(w,i,j);out(t);replace(bs.bildspeicher(areay(w)+j-1),areax(w)+i-1,t);replace(bs.boxspeicher(areay(w)+j-1),areax(w)+i-1,t)END PROCnewout;PROClineout(WINDOW VARw,INT CONSTi,j,TEXT CONSTt):INT VARbi,bj;TEXT VARb,char:=t;bi:=areax(w)+i-1;bj:=areay(w)+j-1;b:=(bs.bildspeicher(bj)SUBbi);IF(t=senkrechtANDwaagerechtaufbs)OR(t=waagerechtANDsenkrechtaufbs)THENchar:=kreuzFI;cursor(bi,bj);out(char);replace(bs.bildspeicher(bj),bi,char).waagerechtaufbs:b=waagerechtORb=kreuz.senkrechtaufbs:b=senkrechtORb=kreuz.END PROClineout;BOOL PROCzwischenraumohnebox(INT CONSTzeile,spaltevon,spaltebis):compress(subtext(bs.boxspeicher(zeile),spaltevon,spaltebis))=""END PROCzwischenraumohnebox;TEXT PROCinboxspeicher(INT CONSTzeile,spalte):bs.boxspeicher(zeile)SUBspalteEND PROCinboxspeicher;PROClinealausgeben(BOOL CONSTmitbildschirmausgabe):zeigewaagerechteslineal;zeigesenkrechteslineal.zeigewaagerechteslineal:INT VARi;FORiFROM1UPTOigittersizeREPreplace(bs.bildspeicher(linealzeile),waagerechteposition,zahlinderwaagerechten)PER;IFmitbildschirmausgabeTHENcursor(1,linealzeile);out(bs.bildspeicher(linealzeile))FI.zahlinderwaagerechten:INT VARzahl:=impos(gitterstart)+i-1;anfang+text(zahl).anfang:IFzahleinstelligTHENwaagerechtELSE""FI.zahleinstellig:zahl<10.waagerechteposition:areax(fenster)+iwindowpos(gpos(i,1))+4.zeigesenkrechteslineal:FORiFROM1UPTOjgittersizeREPreplace(bs.bildspeicher(senkrechteposition),1,zahlindersenkrechten);IFmitbildschirmausgabeTHENcursor(1,senkrechteposition);outsubtext(bs.bildspeicher(senkrechteposition),1,2)FI PER.zahlindersenkrechten:zahl:=jmpos(gitterstart)+i-1;text(zahl)+rest.rest:IFzahleinstelligTHENblankELSE""FI.senkrechteposition:areay(fenster)+jwindowpos(gpos(1,i)).END PROClinealausgeben;END PACKETbildschirmspeicher; + diff --git a/app/schulis-simulationssystem/3.0/src/dp2 b/app/schulis-simulationssystem/3.0/src/dp2 new file mode 100644 index 0000000..68b919c --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/dp2 @@ -0,0 +1,10 @@ +PACKETdiagrammpraesentation2DEFINESwderfassen,erfassenamenundwd,copywd:LETtop1=""84""85""86""87""88""89"",top2=""90""91"",auskunftseite1=""28"",fehlerbeiformel=""78""79"",grenzwerte=""80"",fehlerhaftenamen=""81""82"",fehlerhafterausdruck=""83"",esc=""27"",return=""13"",piep=""7"",blank=" "; +LETneuepositionwaehlen=502,zumzielobjekt=505,pfeilbeginnamboxrand=506,pfeilendeamboxrand=504,pfeilamboxrand=590,ausschnittgedruckt=508,singularmodellgroesse=511,singularergebnis=512,singularparameter=513,singularformel=514,singularzeit=515,zeitnichtbeinflussen=521,parameternichtbeinflussen=522,auswahlobjekttyp=540,zyklischeverknuepfung=541,ausgangbeiformel=548,ausgangbeiergebnissen=549,zuvielevariablenundergebnisse=552,zuvieleparameter=553,isoliert=562,formelohneausgang=564,syntaxfehler=565,pruefunglaeuft=567,inkonsistenz=568,speichern=572,pruefungsinnlos=579,allesbelegt=581,nichtsbelegt=582,aktionenfuerzeit=587,aktionensonst=585,tastenfuerzeit=588,tastensonst=586,ueberschriftaktionen=589,wdkopfzeile=509,wdfusszeile=501,wdfusszeilenachpruefung=591,aenderungengespeichert=592,cancel=584,hinweisleerername=523,hinweissyntaxfehler=524,hinweisdoppeltername=525,hinweislangername=526,hinweisformalerfehler=527,hinweisfalscheranfang=529,hinweisleererausdruck=539;LETmaxi=20,maxj=10,maxlink=8,maxvar=20,maxpar=20,maxmodellnamelang=30,maxmodellnamekurz=15,stmenuoderweiter=33,fehlertaste=4,fragehierabspeichern=96,fehlerlangname=80,fehlerkurzname=81,fehlerlangnamefehlt=82,fehlerkurznamefehlt=83,fehlermodellnamedoppelt=92,info="i",drucken="d",bildaufbauen="n",abbruch="a",abbruchmenu="m",abbrechen="a",auskunftstaste="i",auskunftsloeschtaste1="z",abspeichern="s",weitertaste="w",simulation="w",eingabe="z",ueberpruefung="p",janein="JjYyNn",ja="JjYy";LETtag=1,delimiter=6;WINDOW VARmenuwindow:=window(1,1,79,24);WINDOW CONSTzeichenflaeche:=window(2,3,77,19);BOOL VARletzteaenderunggespeichert:=TRUE;BOOL CONSTls:=TRUE;PROCallesspeichern(TEXT CONSTlang,INT VARreturncode):TEXT VARtaste;returncode:=0;doublefootnote(anwendungstext(speichern));REPinchar(taste)UNTILpos(janein,taste)>0PER;IFpos(ja,taste)>0THENaenderungenspeichern(dsname);ELSEreturncode:=1FI.dsname:name(wddsnamen,link(wdmodelle,lang)).END PROCallesspeichern;GPOS VARgp;PROCletzteaenderungnochnichtgespeichert:letzteaenderunggespeichert:=FALSE END PROCletzteaenderungnochnichtgespeichert;PROCeditieren(TEXT VARtaste):CELL VARactualcell;OBJEKT VARaktuellesobjekt;gp:=getgcursor;taste:="";REPbewegecursor(gp,taste,PROCgibbildaus);actualcell:=cell(gp);aktuellesobjekt:=objekt(actualcell);IFtaste=returnTHEN IFpositionbesetztTHENaktionenanbietenundausfuehrenELSEneueselementeinfuegenundzeigenFI;olddoublefootnoteELIFtaste=escTHEN ELSEout(piep)FI UNTILtaste=escPER.positionbesetzt:INT VARi:=impos(mpos(gp)),j:=jmpos(mpos(gp));belegt(i,j).neueselementeinfuegenundzeigen:neuesobjekteditieren(mpos(gp));taste:="".aktionenanbietenundausfuehren:doublefootnote("");INT VARaktion:=boxalternative(menuwindow,info,liste,buchstaben,5,FALSE,FALSE,PROC(AREA CONST)bsspeicherlesen)MOD100;aktionausfuehren.info:anwendungstext(ueberschriftaktionen).liste:anwendungstext(aktionen).buchstaben:anwendungstext(tasten).aktionen:IFtyp(aktuellesobjekt)=zeitTHENaktionenfuerzeitELSEaktionensonstFI.tasten:IFtyp(aktuellesobjekt)=zeitTHENtastenfuerzeitELSEtastensonstFI.aktionausfuehren:IFtyp(aktuellesobjekt)=zeitANDaktion>2THENaktionINCR1FI;SELECTaktionOF CASE1:elementwegnehmenCASE2:elementmerken;zielpositionfestlegen;IF NOTabbruchgewuenschtTHENactualcell:=cell(gp);aktuellesobjekt:=objekt(actualcell);IFtaste=returnAND(NOTpositionbesetzt)THENelementanalterpositionloeschen;elementanneuerpositioneintragenELSEout(piep)FI FI CASE3:alteselementeditierenCASE5:verbindungaufbauen(gp)CASE6:verbindungloesen(gp)END SELECT.alteselementeditieren:objekteditieren(mpos(gp));boxohnerahmen(objekt(mpos(gp)),gp);taste:="".elementwegnehmen:verbindungenloesen;deletecell(mpos(gp));letzteaenderungnochnichtgespeichert;IFalteverbindungenvorhandenTHENgibbildausELSEbox(aktuellesobjekt,gp,FALSE)FI.alteverbindungenvorhanden:z>0.verbindungenloesen:INT VARnr,z:=0;FORnrFROM1UPTOmaxlinkREP IF(actualcellAUSGANGnr)OR(actualcellEINGANGnr)THENzINCR1;loeschelink(mpos(gp),nr)FI PER.abbruchgewuenscht:taste=esc.elementmerken:MPOS VARaltmp:=mpos(gp);INT VARialt:=impos(mpos(gp)),jalt:= +jmpos(mpos(gp)).zielpositionfestlegen:doublefootnote(anwendungstext(neuepositionwaehlen));bewegecursor(gp,taste,PROCgibbildaus).elementanalterpositionloeschen:CELL VARcellalt:=cell(altmp),cellneu;deletecell(altmp);IFimgitter(altmp)THENbox(ialt,jalt)FI.elementanneuerpositioneintragen:newcell(objekt(cellalt),newposition);cellneu:=cellalt;letzteaenderungnochnichtgespeichert;verbindungenaktualisieren;IFalteverbindungenvorhandenTHENgibbildausELSEbox(i,j)FI.verbindungenaktualisieren:z:=0;FORnrFROM1UPTOmaxlinkREP IF NOT((cellneuUEBERnr)=null)THENzINCR1;ggfverweisaufsichselbstaendern;IFcellneuAUSGANGnrTHENlink(newposition,nr,cellneuUEBERnr,cellneuNRnr)ELIFcellneuEINGANGnrTHENlink(cellneuUEBERnr,cellneuNRnr,newposition,nr)FI FI PER.newposition:mpos(gp).ggfverweisaufsichselbstaendern:IF(cellneuAUSGANGnr)AND((cellneuUEBERnr)=altmp)THENlink(newposition,nr,newposition,cellneuNRnr)FI.END PROCeditieren;PROCobjekteditieren(MPOS CONSTmp):OBJEKT CONSTobj:=objekt(mp);BOOL VARgespeichert:=FALSE;fehlercode:=0;fehlermeldung:="";IFtyp(obj)=variableORtyp(obj)=ergebnisTHENvariableeditieren(startcell,gespeichert,fehlercode,fehlermeldung)ELIFtyp(obj)=parameterTHENparametereditieren(startcell,gespeichert,fehlercode,fehlermeldung)ELIFtyp(obj)=formelTHENformeleditieren(startcell,gespeichert,fehlercode,fehlermeldung)FI;IFgespeichertTHENletzteaenderungnochnichtgespeichertFI.startcell:cell(mp).END PROCobjekteditieren;PROCneuesobjekteditieren(MPOS CONSTmp):ROW5INT VARobjekttyp;INT VARi:=0;vorls;erfragetypdesobjektes;IFeingabedestypszulaessigTHENlegecellan;editiereggfobjektFI.erfragetypdesobjektes:doublefootnote("");TEXT VARtasten:="";INT VAReingabedestyps:=boxalternative(menuwindow,info,liste,tasten,position,FALSE,FALSE,PROC(AREA CONST)bsspeicherlesen)MOD100;.eingabedestypszulaessig:eingabedestyps>0ANDeingabedestyps<6.legecellan:newcell(neuesobjekt,mp).neuesobjekt:new(neuertyp).neuertyp:SELECTobjekttyp(eingabedestyps)OF CASE1:variableCASE2:ergebnisCASE3:parameterCASE4:formelCASE5:zeitOTHERWISEnilEND SELECT.editiereggfobjekt:BOOL VARgespeichert:=FALSE;disablestop;fehlercode:=0;fehlermeldung:="";SELECTobjekttyp(eingabedestyps)OF CASE1,2:variableeditieren(startcell,gespeichert,fehlercode,fehlermeldung)CASE3:parametereditieren(startcell,gespeichert,fehlercode,fehlermeldung)CASE4:formeleditieren(startcell,gespeichert,fehlercode,fehlermeldung)CASE5:gespeichert:=TRUE END SELECT;IFiserrorTHENclearerror;gespeichert:=FALSE FI;enablestop;IFgespeichertTHENletzteaenderungnochnichtgespeichert;box(objekt(startcell),gpos(mp),TRUE)ELSEdeletecell(mp)FI.startcell:cell(mp).info:anwendungstext(auswahlobjekttyp).liste:evtlmodellvariable+evtlparameter+evtlevariable+fktzusammenhang+immerzeit+schluss.evtlmodellvariable:IFanzahlmpos(variablenthesaurus)+anzahlmpos(ergebnisthesaurus)>=maxvarTHEN""ELSEiINCR1;objekttyp(i):=1;tastenCAT"v";anwendungstext(singularmodellgroesse)+returnFI.evtlparameter:IFanzahlmpos(parameterthesaurus)>=maxparTHEN""ELSEiINCR1;objekttyp(i):=3;tastenCAT"p";anwendungstext(singularparameter)+returnFI.evtlevariable:iINCR1;objekttyp(i):=2;IFanzahlmpos(variablenthesaurus)+anzahlmpos(ergebnisthesaurus)>=maxvarTHEN""ELSEtastenCAT"e";anwendungstext(singularergebnis)+returnFI.fktzusammenhang:iINCR1;objekttyp(i):=4;tastenCAT"f";anwendungstext(singularformel)+return.immerzeit:iINCR1;objekttyp(i):=5;tastenCAT"z";anwendungstext(singularzeit)+return.schluss:tastenCAT"-c";blank+return+anwendungstext(cancel).position:4.END PROCneuesobjekteditieren;PROCverbindungaufbauen(GPOS CONSTpos):GPOS VARfrompos:=pos,topos;MPOS VARfrom,to;TEXT VARtaste:="";untersuchesourcecell;bestimmetargetcell;merkeverbindung;letzteaenderungnochnichtgespeichert;zeigeneueverbindung.untersuchesourcecell:from:=mpos(frompos);IFstartobjektergebnisTHENweiseaufungeeignetesobjekthin(ausgangbeiergebnissen);leaveELIFalleverknuepfungspunkteamstartbelegtTHENweiseaufungeeignetesobjekthin(allesbelegt);leaveELSEverarbeitestartobjektFI.startobjektergebnis:typ(objekt(sourcecell))=ergebnis. +alleverknuepfungspunkteamstartbelegt:TEXT VARfreiepunkte:=freieverknuepfungspunkte(sourcecell);length(freiepunkte)=0.verarbeitestartobjekt:schreibehinweisstartposition;INT VARvon:=bewegecursorauflinkpositionen(frompos,freiepunkte);gcursor(frompos);IFvon=0THENleaveELIF NOTbeginnfreiTHENout(piep);leaveFI;LEAVEuntersuchesourcecell.bestimmetargetcell:REPschreibehinweistargetcell;gcursor(frompos);bewegecursor(topos,taste,PROCgibbildaus);to:=mpos(topos);IFtaste=escTHENleaveELIFtaste=returnANDbelegt(targetcell)THEN IFzielobjektzeitTHENweiseaufungeeignetesobjekthin(zeitnichtbeinflussen)ELIFzielobjektparameterTHENweiseaufungeeignetesobjekthin(parameternichtbeinflussen)ELIFalleverknuepfungspunkteamzielbelegtTHENweiseaufungeeignetesobjekthin(allesbelegt)ELIFzielobjektformelundnureingaengeTHENweiseaufungeeignetesobjekthin(ausgangbeiformel)ELIFzielobjektformelundrekursionTHENweiseaufungeeignetesobjekthin(zyklischeverknuepfung)ELSEverarbeitezielobjektFI ELSEout(piep)FI;PER.alleverknuepfungspunkteamzielbelegt:freiepunkte:=freieverknuepfungspunkte(targetcell);IFfrom=toTHENchange(freiepunkte,text(von,1),"")FI;length(freiepunkte)=0.zielobjektzeit:typ(aktuellesobjekt)=zeit.zielobjektparameter:typ(aktuellesobjekt)=parameter.zielobjektformelundnureingaenge:IF NOT(typ(aktuellesobjekt)=formel)THEN FALSE ELSE INT VARi,anzahleingaenge:=0;FORiFROM1UPTOmaxlinkREP IFtargetcellEINGANGiTHENanzahleingaengeINCR1FI PER;anzahleingaenge=maxlink-1FI.zielobjektformelundrekursion:(typ(aktuellesobjekt)=formelANDto=from)OR(typ(aktuellesobjekt)=formelANDtyp(startobjekt)=formelAND(fromREKURSIVto)).startobjekt:objekt(sourcecell).aktuellesobjekt:objekt(targetcell).verarbeitezielobjekt:schreibehinweisendposition;INT VARzu:=bewegecursorauflinkpositionen(topos,freiepunkte);gcursor(topos);IFzu=0THENleaveELIF(NOTendefrei)ORanfanggleichendeTHENout(piep);leaveFI;LEAVEbestimmetargetcell.beginnfrei:(sourcecellUEBERvon)=null.endefrei:(targetcellUEBERzu)=null.anfanggleichende:from=toANDvon=zu.sourcecell:cell(from).targetcell:cell(to).merkeverbindung:link(from,von,to,zu).zeigeneueverbindung:zeichneverbindung(from,von,to,zu).schreibehinweistargetcell:doublefootnote(anwendungstext(zumzielobjekt)).schreibehinweisstartposition:doublefootnote(anwendungstext(pfeilbeginnamboxrand)).schreibehinweisendposition:doublefootnote(anwendungstext(pfeilendeamboxrand)).leave:LEAVEverbindungaufbauen.END PROCverbindungaufbauen;BOOL OP REKURSIV(MPOS CONSTstart,ziel):pruefetyp;zielZUstart.pruefetyp:IF NOT(typ(objekt(start))=formel)THEN LEAVE REKURSIV WITH FALSE FI.END OP REKURSIV;BOOL OP ZU(MPOS CONSTstart,ziel):INT VARi;CELL CONSTactualcell:=cell(start);FORiFROM1UPTOmaxlinkREP IF(actualcellAUSGANGi)THEN MPOS CONSTnachbarposition:=(actualcellUEBERi);IFtyp(nachbarobjekt)=formelTHENbehandlebenachbarteformelFI FI PER;FALSE.behandlebenachbarteformel:IFnachbarposition=zielTHEN LEAVE ZU WITH TRUE ELIFnachbarpositionZUzielTHEN LEAVE ZU WITH TRUE FI.nachbarobjekt:objekt(nachbarcell).nachbarcell:cell(nachbarposition).END OP ZU;PROCverbindungloesen(GPOS CONSTfrompos):MPOS VARfrommpos;untersuchesourcecell;loescheverbindung;letzteaenderungnochnichtgespeichert;gcursor(frompos);.untersuchesourcecell:frommpos:=mpos(frompos);pruefeundverarbeiteggfdieangeklicktecell.pruefeundverarbeiteggfdieangeklicktecell:IFallesfreiTHENweiseaufungeeignetesobjekthin(nichtsbelegt)ELSEschreibehinweisstartposition;INT VARvon:=bewegecursorauflinkpositionen(frompos,belegtepunkte);gcursor(frompos);IFkeinelinkpositiongewaehltTHENleaveFI;LEAVEuntersuchesourcecellFI.allesfrei:TEXT VARbelegtepunkte:=belegteverknuepfungspunkte(clickedcell);length(belegtepunkte)=0.keinelinkpositiongewaehlt:von=0.loescheverbindung:loeschelink(frommpos,von);gibbildaus.clickedcell:cell(frommpos).schreibehinweisstartposition:doublefootnote(anwendungstext(pfeilamboxrand)).leave:LEAVEverbindungloesen.END PROCverbindungloesen;PROCdiagrammausschnittdrucken:DATASPACE VARds:=nilspace;FILE VARf:=sequentialfile(modify,ds);diagrammausschnitterzeugen;formelnauflisten; +fileversenden;meldunganbenutzerabsetzen.diagrammausschnitterzeugen:gibdiagrammausschnitt(f).formelnauflisten:INT VARi,j,starti:=impos(gitterstart),endi:=starti+igittersize-1,startj:=jmpos(gitterstart),endj:=startj+jgittersize-1;output(f);line(f,2);FORiFROMstartiUPTOendiREP FORjFROMstartjUPTOendjREP IFbelegt(actualcell)ANDtyp(objekt(actualcell))=formelTHENobjekttext(f,newmpos(i,j))FI PER PER.actualcell:cell(i,j).fileversenden:save(ds,"Diagrammausschnitt",printer);forget(ds).meldunganbenutzerabsetzen:doublefootnote(anwendungstext(ausschnittgedruckt));pause(10);olddoublefootnote.END PROCdiagrammausschnittdrucken;INT VARfehlercode:=0;MPOS VARfehlerposition:=null;TEXT VARfehlermeldung:="";PROCpruefung:initialisierungen;IFpruefungsinnvollTHENcellmatrixabarbeitenELSEfehlerposition:=newmpos(1,1);LEAVEpruefungFI;olddoublefootnote.initialisierungen:TEXT VARbezeichnerliste:=listeallerbezeichner(null);doublefootnote(anwendungstext(pruefunglaeuft));fehlercode:=0;fehlerposition:=null;fehlermeldung:="";.pruefungsinnvoll:IF NOT(anzahlmpos(variablenthesaurus)+anzahlmpos(ergebnisthesaurus)=0)ANDboxvorhandenTHEN TRUE ELSEfehlercode:=pruefungsinnlos;FALSE FI.cellmatrixabarbeiten:INT VARi,j;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREP IFbelegt(cell(i,j))THENpruefecellFI PER PER.pruefecell:CELL CONSTactualcell:=cell(i,j);OBJEKT CONSTaktuellesobjekt:=objekt(actualcell);testeaufisolierung;IFtyp(aktuellesobjekt)=formelTHENtesteformel;zaehleausgaengederformel;sucheimtermunberuecksichtigteeingaenge;FI;.testeaufisolierung:INT VARverbindungszaehler,anzahlverbindungen:=0;FORverbindungszaehlerFROM1UPTOmaxlinkREP IF(actualcellEINGANGverbindungszaehler)OR(actualcellAUSGANGverbindungszaehler)THENanzahlverbindungenINCR1FI PER;IFobjektisoliertTHENfehlerposition:=mpos(actualcell);fehlercode:=isoliert;LEAVEpruefungFI.objektisoliert:anzahlverbindungen=0.testeformel:IFsyntaktischerfehlerTHENfehlercode:=syntaxfehler;fehlerposition:=mpos(actualcell);LEAVEpruefungFI.syntaktischerfehler:NOTtermistkorrekt(actualcell,ausdruck(aktuellesobjekt),bezeichnerliste,fehlermeldung).sucheimtermunberuecksichtigteeingaenge:THESAURUS VAReingaenge,internenamen,nichtverwendetenamen;eingaenge:=elannamenallereinlaufendenflusslinien;internenamen:=scanneformelundsucheinternenamen;nichtverwendetenamen:=eingaenge-(internenamen/eingaenge);schreibewarnungenfuernichtverwendetenamen.elannamenallereinlaufendenflusslinien:THESAURUS VARt:=emptythesaurus;FORverbindungszaehlerFROM1UPTOmaxlinkREP IF(actualcellEINGANGverbindungszaehler)THENinsert(t,elanname(objekt(cell(actualcellUEBERverbindungszaehler))))FI PER;t.scanneformelundsucheinternenamen:t:=emptythesaurus;TEXT VARterm:=ausdruck(aktuellesobjekt),symbol;INT VARtype;scan(term);nextsymbol(symbol,type);WHILE NOTendeerreichtREPverarbeitesymbol;nextsymbol(symbol,type)PER;t.endeerreicht:type>delimiter.verarbeitesymbol:IFtype=tagTHENinsert(t,symbol)FI.schreibewarnungenfuernichtverwendetenamen:INT VARzaehler:=0;IFhighestentry(nichtverwendetenamen)>0THENfehlercode:=inkonsistenz;fehlerposition:=mpos(actualcell);get(nichtverwendetenamen,fehlermeldung,zaehler);LEAVEpruefungFI.zaehleausgaengederformel:anzahlverbindungen:=0;FORverbindungszaehlerFROM1UPTOmaxlinkREP IF(actualcellAUSGANGverbindungszaehler)THENanzahlverbindungenINCR1FI PER;IFobjektohneausgangTHENfehlercode:=formelohneausgang;fehlerposition:=mpos(actualcell);LEAVEpruefungFI.objektohneausgang:anzahlverbindungen=0.END PROCpruefung;PROCwderfassen(TEXT CONSTlang,INT VARreturncode):TEXT VARtaste:="";letzteaenderunggespeichert:=TRUE;returncode:=0;bildschirmaufbauen;gcursor(gpos(newmpos(1,1)));wdeditieren;IF NOTletzteaenderunggespeichertTHENallesspeichern(lang,returncode)FI.bildschirmaufbauen:gitterfenster(newmpos(1,1));page;writehead(anwendungstext(wdkopfzeile));writepermanentdoublefootnote(anwendungstext(wdfusszeile));gibbildaus.wdeditieren:REPwdlauffaehig(FALSE);editieren(taste);verarbeiteescsequenzUNTILabbruchgewuenschtPER.verarbeiteescsequenz:inchar(taste);IFtaste=infoTHENwdinfoausgebenELIFtaste= +ueberpruefungTHEN IF(NOTboxvorhanden)THENdoublefootnote(anwendungstext(pruefungsinnlos));pause(20);olddoublefootnoteELSEwdpruefenFI;ELIFtaste=abspeichernTHEN IF(NOTboxvorhanden)THENdoublefootnote("Keine Eingaben! Speichern sinnlos");pause(20);olddoublefootnoteELSEwdspeichernFI;ELIFtaste=druckenTHENwddruckenELIFtaste=bildaufbauenTHENwdneuausgebenELIFtaste=abbruchTHENletzteaenderunggespeichert:=FALSE;ELSEout(piep)FI.abbruchgewuenscht:taste=abbruch.wdinfoausgeben:infotextauswahl(auskunftzumfehler,compilermeldung,top1,top2);writehead(anwendungstext(wdkopfzeile));writepermanentdoublefootnote(anwendungstext(wdfusszeile));bsspeicherlesen(zeichenflaeche).auskunftzumfehler:IFsyntaktischerfehlerTHENauskunftzumsyntaxfehler(fehlermeldung)ELIFfehlerbeimfunktionalenzusammenhangTHENfehlerbeiformelELIFgrenzenverletztTHENgrenzwerteELIFfehlerbeibenennungTHENfehlerhaftenamenELIFfehlerbeiausdruckTHENfehlerhafterausdruckELSE""FI.syntaktischerfehler:fehlercode=syntaxfehlerORfehlercode=hinweissyntaxfehler.fehlerbeimfunktionalenzusammenhang:fehlercode=zyklischeverknuepfungORfehlercode=ausgangbeiformelORfehlercode=formelohneausgangORfehlercode=inkonsistenz.grenzenverletzt:fehlercode=zuvielevariablenundergebnisseORfehlercode=zuvieleparameterORfehlercode=isoliert.fehlerbeibenennung:fehlercode=hinweisleerernameORfehlercode=hinweisdoppelternameORfehlercode=hinweislangernameORfehlercode=hinweisformalerfehlerORfehlercode=hinweisfalscheranfang.fehlerbeiausdruck:fehlercode=hinweisleererausdruck.compilermeldung:IFsyntaktischerfehlerTHENfehlermeldungELIFfehlergefundenTHENanwendungstext(fehlercode)ELSE""FI.wdpruefen:pruefung;IFfehlergefundenTHENpositioniereauffehlerhaftesobjekt;ELSEweitereverarbeitungFI.fehlergefunden:fehlercode>0.positioniereauffehlerhaftesobjekt:neueposition;doublefootnote(meldung);gcursor(gpos(fehlerposition)).meldung:IFfehlermeldung=""THENanwendungstext(fehlercode)ELSEanwendungstext(fehlercode)+return+fehlermeldungFI.neueposition:IFimgitter(fehlerposition)THENgitterfenster(gitterstart)ELSEgitterfenster(newmpos(i,j));gibbildausFI.i:min(maxi-igittersize+1,impos(fehlerposition)).j:min(maxj-jgittersize+1,jmpos(fehlerposition)).weitereverarbeitung:writepermanentdoublefootnote(anwendungstext(wdfusszeilenachpruefung));wdlauffaehig(TRUE);REP REPbewegecursoraufgitterUNTILtaste=escPER;inchar(taste);IFtaste=simulationTHENwdsimulationELIFtaste=eingabeTHENwritepermanentdoublefootnote(anwendungstext(wdfusszeile));LEAVEweitereverarbeitungELIFtaste=druckenTHENwddruckenELIFtaste=abspeichernTHENwdspeichernELIFtaste=abbrechenTHEN LEAVEwdeditierenELSEout(piep)FI PER.bewegecursoraufgitter:GPOS VARgp:=getgcursor;bewegecursor(gp,taste,PROCgibbildaus).wdsimulation:transformierewirkungsdiagrammundstartesimulation(NOTls,returncode);page;writehead(anwendungstext(wdkopfzeile));olddoublefootnote;bsspeicherlesen(zeichenflaeche).wddrucken:diagrammausschnittdrucken.wdspeichern:aenderungenspeichern(dsname);letzteaenderunggespeichert:=TRUE;doublefootnote(anwendungstext(aenderungengespeichert));pause(10);olddoublefootnote.wdspeichernundverlassen:aenderungenspeichern(dsname);doublefootnote(anwendungstext(aenderungengespeichert));pause(10);returncode:=0;LEAVEwderfassen.dsname:name(wddsnamen,link(wdmodelle,lang)).wdneuausgeben:gibbildaus.END PROCwderfassen;PROCweiseaufungeeignetesobjekthin(INT CONSTnr):out(piep);fehlercode:=nr;doublefootnote(anwendungstext(nr));pause(20)END PROCweiseaufungeeignetesobjekthin;LETauskcompilunbekkomm="\",auskcompilparameter="]",auskcompilsymbole="^",auskfalschertyp="_",auskcompilungueltzw="AB",auskcompilmehrfdekl="C",auskcompilsonstiges="D";LETunbekkommdo="unbekanntes Kommando",undefdyadischop="undefinierter dyadischer",undefmonadop="undefinierter monadischer",paramsindfalsch="Typen der Parameter sind falsch",nurletzteanweisg="nur die letzte Anweisung",anstelledessymb="anstelle des letzten Symbols",unzulselektsymb="unzulaessiges Selektor-Symbol",konstdarfnicht="die Konstante darf nicht veraendert",klammerauffehlt="'(' fehlt",klammerzufehlt= +"')' fehlt",operatorfehlt="';' oder Operator ('+',",ungueltigzwischen="ungueltig zwischen Anweisungen",istmehrfachdekl="ist mehrfach deklariert",falschertypdesresultats="falscher Typ des Resultats";TEXT PROCauskunftzumsyntaxfehler(TEXT CONSTmessage):IFpos(message,unbekkommdo)<>0THENauskcompilunbekkommELIFpos(message,undefdyadischop)<>0CORpos(message,undefmonadop)<>0CORpos(message,paramsindfalsch)<>0THENauskcompilparameterELIFpos(message,nurletzteanweisg)<>0CORpos(message,anstelledessymb)<>0CORpos(message,unzulselektsymb)<>0CORpos(message,konstdarfnicht)<>0THENauskcompilsymboleELIFpos(message,klammerauffehlt)<>0CORpos(message,klammerzufehlt)<>0CORpos(message,operatorfehlt)<>0CORpos(message,ungueltigzwischen)<>0THENauskcompilungueltzwELIFpos(message,istmehrfachdekl)<>0THENauskcompilmehrfdeklELIFpos(message,falschertypdesresultats)<>0THENauskfalschertypELSEauskcompilsonstigesFI.END PROCauskunftzumsyntaxfehler;DATASPACE VARfeldds;BOUND ROW100TEXT VARfeld;INT CONSTseite1:=18;INT VARcursorfeld;TEXT CONSTleeresfeld:=77*" ";PROCerfassenamenundwd(TEXT CONSTmbname,INT CONSTmodellnr,INT VARreturncode):enablestop;BOOL VARfalscheeingaben;TEXT VARinfotext:="",taste:="",lang:="",kurz:="";returncode:=0;forget(feldds);feldds:=nilspace;feld:=feldds;REPkernvonwderfassungPER.kernvonwderfassung:maskefuernamenausgeben;REPputgetformular1(feld,cursorfeld,taste);IFtaste=abbruchmenuTHENeingabendeserstenformularspruefen(lang,kurz,modellnr,falscheeingaben);IF(NOTfalscheeingaben)CANDabspeicherngewuenschtTHEN IFmodellneuTHENwdeinfuegen(mbname,lang,kurz)ELSEwdumbenennen(lang,kurz,modellnr)FI;aenderungenspeichern(dsname);leavewderfassungFI;returncode:=1;leavewderfassungELIFtaste=auskunftstasteTHENinfotext:=auskunftseite1;fehlermeldung:="";auskunftsdienst(infotext,fehlermeldung,auskunftsloeschtaste1);show(formular(seite1));cursorfeld:=2;feld(1):=leeresfeld;footnote(steuerleiste(stmenuoderweiter));ELIFtaste=weitertasteTHENeingabendeserstenformularspruefen(lang,kurz,modellnr,falscheeingaben);IF NOTfalscheeingabenTHEN IFmodellneuTHENwdeinfuegen(mbname,lang,kurz)ELSEwdumbenennen(lang,kurz,modellnr)FI;wderfassen(lang,returncode);IFreturncode=1THENbeseitigedsundpflegethesauri;FI;leavewderfassung;FI;ELSEfeld(1):=meldungstext(fehlertaste)FI PER.beseitigedsundpflegethesauri:loesche((link(wdmodelle,lang)+20),mbname);.maskefuernamenausgeben:lang:=aktuellermodellname;kurz:=aktuellermodellkurzname;maskezurmodellinitialisierungausgeben(lang,kurz).modellneu:modellnr=0.abspeicherngewuenscht:put(formular(seite1),"",1);cursor(3,20);yes(compress(meldungstext(fragehierabspeichern))).dsname:name(wddsnamen,link(wdmodelle,lang)).leavewderfassung:forget(feldds);LEAVEerfassenamenundwd.END PROCerfassenamenundwd;PROCmaskezurmodellinitialisierungausgeben(TEXT CONSTlang,kurz):show(formular(seite1));footnote(steuerleiste(stmenuoderweiter));cursorfeld:=2;feld(1):=leeresfeld;feld(2):=lang+(maxmodellnamelang-length(lang))*"_";feld(3):=kurz+(maxmodellnamekurz-length(kurz))*"_";feld(4):="";feld(5):="";.END PROCmaskezurmodellinitialisierungausgeben;PROCeingabendeserstenformularspruefen(TEXT VARlang,kurz,INT CONSTmodellinbearbeitung,BOOL VARfalscheeingaben):ROW5TEXT VARhilfsfeld;feld(1):=leeresfeld;put(formular(seite1),feld(1),1);langnamenpruefen;aufnamensgleichheitpruefen;kurznamenpruefen;eingabenablegen;falscheeingaben:=FALSE.verlasseeingabendeserstenformularspruefen:falscheeingaben:=TRUE;LEAVEeingabendeserstenformularspruefen.langnamenpruefen:hilfsfeld(2):=feld(2);hilfsfeld(2):=komprimiere(hilfsfeld(2));IFlength(hilfsfeld(2))=0THENfeld(1):=meldungstext(fehlerlangnamefehlt);cursorfeld:=2;verlasseeingabendeserstenformularspruefenELIFlength(hilfsfeld(2))>maxmodellnamelangTHENfeld(1):=meldungstext(fehlerlangname);cursorfeld:=2;verlasseeingabendeserstenformularspruefenFI.kurznamenpruefen:hilfsfeld(3):=feld(3);hilfsfeld(3):=komprimiere(hilfsfeld(3));IFlength(hilfsfeld(3))=0THENfeld(1):=meldungstext(fehlerkurznamefehlt);cursorfeld:=3;verlasseeingabendeserstenformularspruefenELIFlength(hilfsfeld(3))> +maxmodellnamekurzTHENfeld(1):=meldungstext(fehlerkurzname);cursorfeld:=3;verlasseeingabendeserstenformularspruefenFI.aufnamensgleichheitpruefen:IFmodellinbearbeitung<>link(wdmodelle,hilfsfeld(2))CAND(wdmodelleCONTAINShilfsfeld(2))THENfeld(1):=meldungstext(fehlermodellnamedoppelt);cursorfeld:=2;verlasseeingabendeserstenformularspruefenFI.eingabenablegen:lang:=hilfsfeld(2);kurz:=hilfsfeld(3).END PROCeingabendeserstenformularspruefen;DATASPACE VARmodellds;PROCcopywd(INT CONSTnr,TEXT CONSTmodellbank,INT VARreturncode):datenraumkopieren;wdkopieeditieren.datenraumkopieren:forget(modellds);modellds:=old(name(wddsnamen,nr)).wdkopieeditieren:diagrammankoppeln(modellds);erfassenamenundwd(modellbank,0,returncode).END PROCcopywd;END PACKETdiagrammpraesentation2; + + diff --git a/app/schulis-simulationssystem/3.0/src/e b/app/schulis-simulationssystem/3.0/src/e new file mode 100644 index 0000000..f36f65f --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/e @@ -0,0 +1,2 @@ +PACKETergaenzungenzurbenutzerschnittstelleDEFINESvorls,nachls,doublefootnote,olddoublefootnote,writepermanentdoublefootnote:TEXT VARpermanentfootnote:="";PROCvorls:doublefootnote(" ")END PROCvorls;PROCnachls:doublefootnote(" ")END PROCnachls;PROCdoublefootnote(TEXT CONSTt):INT VARx,y;getcursor(x,y);ersterteil;zweiterteil;cursor(x,y).ersterteil:INT VARumbruch:=pos(t," ");cursor(1,23);IFumbruch>0THENout(invers(text(subtext(t,1,umbruch-1),76)))ELSEout(invers(text(t,76)))FI.zweiterteil:cursor(1,24);IFumbruch>0THENout(invers(text(subtext(t,umbruch+1,LENGTHt),76)))ELSEout(invers(76*" "))FI.END PROCdoublefootnote;PROColddoublefootnote:doublefootnote(permanentfootnote)END PROColddoublefootnote;PROCwritepermanentdoublefootnote(TEXT CONSTt):permanentfootnote:=t;doublefootnote(t)END PROCwritepermanentdoublefootnote;END PACKETergaenzungenzurbenutzerschnittstelle; + diff --git a/app/schulis-simulationssystem/3.0/src/g b/app/schulis-simulationssystem/3.0/src/g new file mode 100644 index 0000000..5964efc --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/g @@ -0,0 +1,4 @@ +PACKETkoordinatenDEFINES GPOS,MPOS,null,:=,=,igpos,jgpos,impos,jmpos,iwindowpos,jwindowpos,gpos,mpos,newmpos,gcursor,getgcursor,bewegecursor,standardfenster,imgitter,igittersize,jgittersize,gitterfenster,gitterstart,:LETmaxlength=9,maxheight=1,habstand=4,vabstand=2,xsize=77,ysize=20,maxi=20,maxj=10;TEXT CONSTcursorbewegungen:="��� +��"+return+rubin+rubout;LETreturn=" ",rubin="�",rubout="�",hop="�",piep="�";WINDOW VARfenster:=window(2,2,xsize,ysize);WINDOW PROCstandardfenster:fensterEND PROCstandardfenster;TYPE GITTERFENSTER=STRUCT(MPOSstart,INTisize,jsize);TYPE GPOS=STRUCT(INTi,j);TYPE MPOS=STRUCT(INTi,j);GPOS PROCgpos(INT CONSTi,j):GPOS VARg;g.i:=i;g.j:=j;gENDPROCgpos;OP:=(GPOS VARl,GPOS CONSTr):CONCR(l):=CONCR(r)ENDOP:=;INT PROCigpos(GPOS CONSTg):g.iEND PROCigpos;INT PROCjgpos(GPOS CONSTg):g.jEND PROCjgpos;BOOL OP=(GPOS CONSTl,r):(l.i=r.i)AND(l.j=r.j)END OP=;MPOS PROCnewmpos(INT CONSTi,j):MPOS VARm;m.i:=i;m.j:=j;mEND PROCnewmpos;MPOS PROCnull:MPOS VARm;m.i:=0;m.j:=0;mEND PROCnull;BOOL OP=(MPOS CONSTl,r):(l.i=r.i)AND(l.j=r.j)END OP=;OP:=(MPOS VARl,MPOS CONSTr):CONCR(l):=CONCR(r)ENDOP:=;INT PROCimpos(MPOS CONSTm):m.iEND PROCimpos;INT PROCjmpos(MPOS CONSTm):m.jEND PROCjmpos;MPOS PROCmpos(GPOS CONSTg):newmpos(standardgitter.start.i+g.i-1,standardgitter.start.j+g.j-1)ENDPROCmpos;GPOS PROCgpos(MPOS CONSTm):GPOS VARg;IF NOTimgitter(m)THENg.i:=0;g.j:=0;ELSEg.i:=m.i-standardgitter.start.i+1;g.j:=m.j-standardgitter.start.j+1FI;gENDPROCgpos;INT PROCiwindowpos(GPOS CONSTgitterpos):(gitterpos.i-1)*(maxlength+2+habstand)+3END PROCiwindowpos;INT PROCjwindowpos(GPOS CONSTgitterpos):(gitterpos.j-1)*(maxheight+2+vabstand)+2END PROCjwindowpos;BOOL PROCimgitter(MPOS CONSTmp):standardgitter.start.i<=mp.iANDstandardgitter.start.j<=mp.jANDmp.i-standardgitter.start.imaxiORstart.j<1ORstart.j>maxj.berechneisizeundjsize:standardgitter.start:=start;standardgitter.isize:=(xsize+1)DIVxsizeeinerboxsamtumgebung;standardgitter.jsize:=(ysize+1)DIVysizeeinerboxsamtumgebung.xsizeeinerboxsamtumgebung:(maxlength+habstand+2).ysizeeinerboxsamtumgebung:(maxheight+vabstand+2).END PROCgitterfenster;PROCverschiebegitter(INT CONSThor,vert,PROCkonstruierediagrammimneuengitterfenster):MPOS VARstartmp:=mpos(gpos(1,1));gitterfenster(newmpos(imp,jmp));konstruierediagrammimneuengitterfenster.imp:max(1,min(maxi-igittersize+1,impos(startmp)+hor)).jmp:max(1,min(maxj-jgittersize+1,jmpos(startmp)+vert)).END PROCverschiebegitter;GPOS VARgittercursor;gittercursor.i:=1;gittercursor.j:=1;PROCgcursor(GPOS CONSTg):WINDOW VARw:=fenster;IFimgitter(g)THENgittercursor:=g;cursor(w,iwindowpos(g),jwindowpos(g))FI END PROCgcursor;GPOS PROCgetgcursor:gittercursorEND PROCgetgcursor;PROCbewegecursor(GPOS VARgp,TEXT VARtaste,PROCneuesbild):INT VARsooftwie,schritte;MPOS VARaktuellempos;gcursor(gp);REPgp:=getgcursor;inchar(taste);IFtaste=hopTHENlieshopsequenzELSEsooftwie:=1+clearbufferandcount(taste)FI;SELECTpos(cursorbewegungen,taste)OF CASE1:geheevtlnachrechtsCASE2:geheevtlnachlinksCASE3:geheevtlnachobenCASE4:geheevtlnachuntenOTHERWISEverlasseprozedurENDSELECT PER.geheevtlnachrechts:WHILEsooftwie>0REPgp:=getgcursor;aktuellempos:=mpos(gp);IF NOT(impos(aktuellempos)0REPgp:=getgcursor;aktuellempos:=mpos(gp);IF NOT(10REPgp:=getgcursor;aktuellempos:=mpos(gp);IF NOT(10REPgp:=getgcursor;aktuellempos:=mpos(gp);IF NOT(jmpos(aktuellempos)=istvariableTHENmodifizieretext;END IF END REP.modifizieretext:replace(bildschirmmaske.zeile[zaehler],eingabenoffset,wandle(bildschirmmaske.modellwert[zaehler],laenge,fracs)).erzeugeneuemaske:ZUSTAND VARvaruntergrenze:=zustandunteregrenze,varobergrenze:=zustandoberegrenze;PARAMETER VARparuntergrenze:=parameterunteregrenze,parobergrenze:=parameteroberegrenze;REAL VARdaueruntergrenze:=minbeobachtungsdauer,dauerobergrenze:=maxbeobachtungsdauer,anfanguntergrenze:=minanfangszeitpunkt,anfangobergrenze:=maxanfangszeitpunkt;aktzeile:=1;bildschirmmaske:=new(dsname);bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(TRUE,meldungstext(headvar),0.0,0.0,0.0);bildschirmmaske.zustand[aktzeile]:=istueberschrift;bildschirmmaske.erstevarzeile:=aktzeile;aktzeileINCR1;FORzaehlerFROM1UPTOdimensionREPbildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(FALSE,variablenname(zaehler),variableSUBzaehler,varuntergrenzeSUBzaehler,varobergrenzeSUBzaehler);bildschirmmaske.zustand[aktzeile]:=istvariable;bildschirmmaske.modellwert[aktzeile]:=variableSUBzaehler;bildschirmmaske.modellvon[aktzeile]:=varuntergrenzeSUBzaehler;bildschirmmaske.modellbis[aktzeile]:=varobergrenzeSUBzaehler;aktzeileINCR1PER;bildschirmmaske.zeile[aktzeile]:=(linienoffset-ueberschriftsoffset)*blank+senkrecht+cleol;bildschirmmaske.zustand[aktzeile]:=istleer;aktzeileINCR1;bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(TRUE,meldungstext(headpar),0.0,0.0,0.0);bildschirmmaske.zustand[aktzeile]:=istueberschrift;bildschirmmaske.ersteparzeile:=aktzeile;aktzeileINCR1;FORzaehlerFROM1UPTOparameteranzahlREPbildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(FALSE,parametername(zaehler),parameterSUBzaehler,paruntergrenzeSUBzaehler,parobergrenzeSUBzaehler);bildschirmmaske.zustand[aktzeile]:=istparameter;bildschirmmaske.modellwert[aktzeile]:=parameterSUBzaehler;bildschirmmaske.modellvon[aktzeile]:=paruntergrenzeSUBzaehler;bildschirmmaske.modellbis[aktzeile]:=parobergrenzeSUBzaehler;aktzeileINCR1PER;bildschirmmaske.zeile[aktzeile]:=(linienoffset-ueberschriftsoffset)*blank+senkrecht+ +cleol;bildschirmmaske.zustand[aktzeile]:=istleer;aktzeileINCR1;bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(TRUE,meldungstext(headzeit),0.0,0.0,0.0);bildschirmmaske.zustand[aktzeile]:=istueberschrift;bildschirmmaske.erstezeitzeile:=aktzeile;aktzeileINCR1;bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(FALSE,meldungstext(anfangszeitpunktbezeichner),anfangszeitpunkt,anfanguntergrenze,anfangobergrenze);bildschirmmaske.zustand[aktzeile]:=istzeit;bildschirmmaske.modellwert[aktzeile]:=anfangszeitpunkt;bildschirmmaske.modellvon[aktzeile]:=anfanguntergrenze;bildschirmmaske.modellbis[aktzeile]:=anfangobergrenze;aktzeileINCR1;bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(FALSE,meldungstext(beobachtungsdauerbezeichner),beobachtungsdauer,daueruntergrenze,dauerobergrenze);bildschirmmaske.zustand[aktzeile]:=istzeit;bildschirmmaske.modellwert[aktzeile]:=beobachtungsdauer;bildschirmmaske.modellvon[aktzeile]:=daueruntergrenze;bildschirmmaske.modellbis[aktzeile]:=dauerobergrenze;bildschirmmaske.zeilenanzahl:=aktzeileEND PROCinitbildschirmmaske;TEXT PROCzeilezusammenstellen(BOOL CONSTistueberschrift,TEXT CONSTname,REAL CONSTwert,min,max):TEXT VARt;IFistueberschriftTHENt:=ueberschriftsoffset*blank;tCATcompress(name);tCAT(linienoffset-LENGTHt)*blank;tCATsenkrecht+cleolELSEt:=namensoffset*blank;tCATcompress(name);tCAT(eingabenoffset-LENGTHt-1)*blank;tCATwandle(wert,laenge,fracs);tCAT(linienoffset-LENGTHt)*blank;tCATsenkrecht;tCAT(modellvonoffset-linienoffset-1)*blank;tCATwandle(min,laenge,fracs);tCAT(modellbisoffset-modellvonoffset-laenge)*blank;tCATwandle(max,laenge,fracs);tCATcleolEND IF;tEND PROCzeilezusammenstellen;PROCbauebildschirmauf:errechneletztezeile;gibzeilenaus;loeschedenbildschirmrest.errechneletztezeile:INT VARletztezeile;letztezeile:=min(bildschirmmaske.zeilenanzahl,erstezeile+anzahlzeilen-1);WHILEbildschirmmaske.zustand[letztezeile]abbrechenTHENberechnekurve;END IF;forgetlogischemaske;cursor(1,anfangszeile-3);out(cleop).berechnekurve:gibberechnungsstandzeileaus;speicheremodellwerte(loesung);loesungLOESUNGSABSCHNITTkurve1(PROCfkt,PROCcofkt,STARTWERTloesung,zustandunteregrenze,zustandoberegrenze,STARTZEITloesung,DAUERloesung,PARAMETERSATZloesung,anzahlbeobachtungspunkte,codimension," neue kurve",fehler);loesungDAUER(max(0.0,letztezeit(LOESUNGSABSCHNITTloesung)-(STARTZEITloesung))).END PROCeingabemodellgroessen;PROCgibstdkopfaus:cursor(spaltevon,anfangszeile-3);out(meldungstext(headdefbereich)+cleol);cursor(spaltevon,anfangszeile-2);out((linienoffset-ueberschriftsoffset)*waagerecht+kreuz+(zeilenlaenge-linienoffset-1)*waagerecht);cursor(spaltevon,anfangszeile-1);out((linienoffset-ueberschriftsoffset)*blank+senkrecht+(vonbisoffset-linienoffset-1)*blank+meldungstext(headvonbis)+cleol);footnote(foot)END PROCgibstdkopfaus;PROCcursorup:INT VARi:=index;IFi=2THEN IFerstezeile=1THENout(beep)ELSEerstezeile:=1;bauebildschirmauf;END IF ELSEloeschecursor;REPiDECR1UNTILbildschirmmaske.zustand[i]>=istvariablePER;index:=i;IFi=istvariablePER;index:=i;IFi>erstezeile+anzahlzeilen-1THENscrolldownEND IF END IF.scrolldown:INT VARoberstezeile:=i-anzahlzeilen+1;WHILEbildschirmmaske.zustand[oberstezeile]=istleerREPoberstezeileINCR1PER;erstezeile:=oberstezeile;bauebildschirmaufEND PROCcursordown;PROCloeschecursor:cursor(spaltevon+eingabenoffset-2,index-erstezeile+anfangszeile);out(wandle(bildschirmmaske.modellwert[index],laenge+1,fracs))END PROCloeschecursor;PROClasseeingeben(TEXT CONSTzeichenkette,TEXT VARendetaste):BOOL VARendegewuenscht:=FALSE;TEXT VAReingabe,allezeichen:="",endestring:=escseq+zeichenkette,exitchar;initallezeichen;bestimmeersteseingabefeld;REPlassefeldeditierenUNTILendegewuenschtPER.initallezeichen:INT VARi;FORiFROM1UPTO255REPallezeichenCATcode(i)PER.bestimmeersteseingabefeld:index:=1;REPindexINCR1;UNTILbildschirmmaske.zustand[index]>=istvariablePER;.lassefeldeditieren:eingabe:=markon+wandle(bildschirmmaske.modellwert[index],laenge,fracs);cursor(spaltevon+eingabenoffset-marksize-1,index-erstezeile+anfangszeile);editget(eingabe,laenge+1,laenge+1,up+down,allezeichen,exitchar);out(markoff);IFeingabeokTHENinterpretiereexitcharELSEfehlermeldungEND IF.fehlermeldung:footnote("Ungültige Eingabe! Weiter mit Taste");pause;footnote(foot).eingabeok:eingabespeichern(eingabe).interpretiereexitchar:IF(exitcharSUB1)=escTHENinterpretiereescsequenzELIFexitchar=upTHENcursorupELIF NOT(index=bildschirmmaske.zeilenanzahlANDexitchar<>down)THENcursordownEND IF.interpretiereescsequenz:INT VARstelle:=pos(endestring,exitcharSUB2),alteerstezeile;IFstelle>=3THENendegewuenscht:=TRUE;endetaste:=exitcharSUB2ELIFstelle<>0THENalteerstezeile:=erstezeile;loeschecursor;behandleesc1undesc9;ELSEout(beep)END IF.behandleesc1undesc9:IFstelle=1THENindex:=2;erstezeile:=1ELSEindex:=bildschirmmaske.zeilenanzahl;erstezeile:=max(1,bildschirmmaske.zeilenanzahl-anzahlzeilen+1);WHILEbildschirmmaske.zustand[erstezeile]=istleerREPerstezeileINCR1PER END IF;IFerstezeile<>alteerstezeileTHENbauebildschirmaufEND IF END PROClasseeingeben;BOOL PROCeingabespeichern(TEXT CONSTeingabe):TEXT VARohnesteuerzeichen;REAL VARwert;IF(eingabeSUB1)=markonTHENohnesteuerzeichen:=subtext(eingabe,2)ELSEohnesteuerzeichen:=eingabeEND IF;pruefedefbereich;speicherewertab;TRUE.pruefedefbereich:wert:=real(ohnesteuerzeichen);IF NOTlastconversionokTHEN LEAVEeingabespeichernWITH FALSE END IF;IFwert>bildschirmmaske.modellbis[index]ORwertl.nminCANDalt<=l.nmaxTHEN IFneu>l.nminCANDneu<=l.nmaxTHENstrichsenkrecht(alt,l.dicke,hakt,loeschstift);linksoffenerkasten(alt,neu,l.dicke,hakt,standardstift)ELIFneu>l.nmaxTHENstrichsenkrecht(alt,l.dicke,hakt,loeschstift);zweistriche(alt,l.nmax,l.dicke,hakt,standardstift)FI ELIFalt>l.nmaxTHEN LEAVEbalkenfortfuehrenFI ELIFalt=neuTHEN LEAVEbalkenfortfuehrenELIFalt>neuTHEN IFaltl.nminCANDalt<=l.nmaxTHENlinksoffenerkasten(max(neu,l.nmin),alt,l.dicke,hakt,loeschstift);IFneu>=l.nminCANDneul.nmaxTHEN IFneu=l.nminCANDneul.nmaxTHEN LEAVEbalkenfortfuehrenFI FI FI.richtepicturesein:l.graph(1):=nilpicture;l.graph(2):=nilpicture.ordnepenszu:pen(l.graph(1),durchgezogen);pen(l.graph(2),gepunktet).tragebalkeninpicture1ein:FORz1FROM1UPTOl.anzREPalt:=l.ersterSUBl.p(z1);neu:=zustandSUBl.p(z1);hakt:=hzwihisto+2.1*real(z1)+0.5*standardhoehe-0.2;IFneu>l.nmaxTHENzweistrichepic(l.nmin,l.nmax,l.dicke,hakt,l.graph(1))ELSElinksoffenerkastenpic(l.nmin,neu,l.dicke,hakt,l.graph(1))FI;IFalt=l.nminTHENstrichsenkrechtpic(l.nmin,l.dicke,hakt,l.graph(1))FI;PER.tragezeitinpicture2ein:move(l.graph(2),abbildungtbeihistogramm(l.tmin,l.tmax,l.nmin,l.nmax,l.tmin),hminhisto+1.0);draw(l.graph(2),abbildungtbeihistogramm(l.tmin,l.tmax,l.nmin,l.nmax,zeit),hminhisto+1.0).schreibepictures:putpicture(seite,fenster,l.graph(1));putpicture(seite,fenster,l.graph(2)).END PROCcoroutinehisto;PROCzweistriche(REAL CONSTmin,max,dicke,hoehe,INT CONSTstift):REAL VARhalbedicke:=0.5*dicke;pen(loeschstift,stift,standarddicke,durchgezogen);move(min,hoehe-halbedicke);draw(max,hoehe-halbedicke);move(min,hoehe+halbedicke);draw(max,hoehe+halbedicke).END PROCzweistriche;PROCzweistrichepic(REAL CONSTmin,max,dicke,hoehe,PICTURE VARgraph):REAL VARhalbedicke:=0.5*dicke;move(graph,min,hoehe-halbedicke);draw(graph,max,hoehe-halbedicke);move(graph,min,hoehe+halbedicke);draw(graph,max,hoehe+halbedicke).END PROCzweistrichepic;PROCstrichsenkrecht(REAL CONSTpos,dicke,hoehe,INT CONSTstift):REAL VARhalbedicke:=0.5*dicke;pen(loeschstift,stift,standarddicke,durchgezogen);move(pos,hoehe-halbedicke);draw(pos,hoehe+halbedicke).END PROCstrichsenkrecht;PROCstrichsenkrechtpic(REAL CONSTpos,dicke,hoehe,PICTURE VARgraph):REAL VARhalbedicke:=0.5*dicke;move(graph,pos,hoehe-halbedicke);draw(graph,pos,hoehe+halbedicke).END PROCstrichsenkrechtpic;PROClinksoffenerkasten(REAL CONSTmin,max,dicke,hoehe,INT CONSTstift):REAL VARhalbedicke:=0.5*dicke;pen(loeschstift,stift,standarddicke,durchgezogen);move(min,hoehe-halbedicke);draw(max,hoehe-halbedicke);draw(max,hoehe+halbedicke);draw(min,hoehe+halbedicke).END PROClinksoffenerkasten;PROClinksoffenerkastenpic(REAL CONSTmin,max,dicke,hoehe,PICTURE VARgraph):REAL VARhalbedicke:=0.5*dicke;move(graph,min,hoehe-halbedicke);draw(graph,max,hoehe-halbedicke);draw(graph,max,hoehe+halbedicke);draw(graph,min,hoehe+halbedicke).END PROClinksoffenerkastenpic;PROCcoroutinezeit(OUTPUT VARseite,INT CONSTfenster,KURVE VARkurve,REAL VARzeit,ZUSTAND VARmuster,ZUSTAND VARzustand,DATASPACE VARds1,INT VARwas,REAL VARxmin,xmax,ymin,ymax,BOOL VARdummy):BOUND + STRUCT(REALt,dicke,ZUSTANDz,ROWmaxanzvarproloesungINTp,ROWmaxanzvarproloesungPICTUREgraph,ROW4REALvpk,ROW5ROW5REALkoord,INTanz,REALxmin,xmax,ymin,ymax)VARl:=ds1;INT VARz1;was:=wasMOD10;SELECTwasOF CASEinitialisieren:coroutineinitialisieren;was:=erstersatzCASEkreuzerzeugen:kreuzerzeugenundmalen;was:=erstersatzCASEerstersatz:erstenausgeben;was:=folgendersatzCASEfolgendersatz:folgendenausgebenCASEanfpunktloeschen:was:=erstersatzneuCASEplotten:bildschirminhaltplottenCASEabschluss:CASEerstersatzneu:putparameter(l.koord);erstenneuausgeben;was:=folgendersatzENDSELECT.coroutineinitialisieren:l.t:=0.0;l.z:=neuerzustand(dimension+codimension);l.xmin:=xmin;l.xmax:=xmax;l.ymin:=ymin;l.ymax:=ymax;richtepicturesein;bestimmevariablenanzahl(l.p,l.anz,muster,dummy);ordnepenszu;legefensterfest(seite,l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4),fenster).kreuzerzeugenundmalen:nildiagramm(seite,fenster);beginplot;viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));bestimmeextrema(zeitdiagrammkennzeichen,kurve,l.p,l.anz,l.xmin,l.xmax,l.ymin,l.ymax);window(seite,fenster,l.xmin,l.xmax,l.ymin,l.ymax);window(l.xmin,l.xmax,l.ymin,l.ymax);setzeundschreibekoordinatenkreuz;beschrifte(zeitdiagrammkennzeichen,seite,fenster,l.p,l.anz,l.xmin,l.xmax,l.ymin,l.ymax);endplot.erstenausgeben:erstenneuausgeben;viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));window(l.xmin,l.xmax,l.ymin,l.ymax);getparameter(l.koord).folgendenausgeben:beginplot;putparameter(l.koord);FORz1FROM1UPTOl.anzREPverbindepunkteimzeitdiagramm;PER;endplot;l.t:=zeit;l.z:=zustand.bildschirminhaltplotten:REAL VARstopzeit:=zeit;nildiagrammmitkreuz(seite,fenster);FORz1FROM1UPTOl.anzREPlesekomplettekurvePER;schreibepictures;l.t:=zeit;l.z:=zustand;.erstenneuausgeben:l.t:=zeit;l.z:=zustand.lesekomplettekurve:leseersten(kurve,zeit,zustand);REPleseabschnittmitpunktenausserhalbdessichtbarenbereiches;leseabschnittmitpunkteninnerhalbdessichtbarenbereiches;PER.leseabschnittmitpunktenausserhalbdessichtbarenbereiches:REP IF NOT(zeit(wasMOD10);was:=wasMOD10;SELECTwasOF + CASEinitialisieren:coroutineinitialisieren;was:=erstersatzCASEkreuzerzeugen:kreuzerzeugenundmalen;was:=erstersatzCASEerstersatz:erstenausgeben;was:=folgendersatzCASEfolgendersatz:folgendenausgebenCASEanfpunktloeschen:anfangspunktloeschen;was:=erstersatzneuCASEplotten:bildschirminhaltplotten;was:=folgendersatzCASEabschluss:CASEerstersatzneu:putparameter(l.koord);erstenneuausgeben;was:=folgendersatzENDSELECT.coroutineinitialisieren:l.t:=0.0;l.z:=neuerzustand(dimension+codimension);l.aufbildschirm:=TRUE;l.anfpunkt:=FALSE;l.xmin:=xmin;l.xmax:=xmax;l.ymin:=ymin;l.ymax:=ymax;richtepictureein;ordnepenzu;bestimmevariablenanzahl(l.p,dummy,muster,automatik);IFautomatikTHENvertauscheevtlvariablen(muster,l.xmin,l.xmax,l.ymin,l.ymax);bestimmevariablenanzahl(l.p,dummy,muster,automatik);FI;legefensterfest(seite,l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4),fenster).kreuzerzeugenundmalen:nildiagramm(seite,fenster);beginplot;viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));bestimmeextrema(phasendiagrammkennzeichen,kurve,l.p,anzahlloesung,l.xmin,l.xmax,l.ymin,l.ymax);IFautomatikTHENvertauscheevtlvariablen(muster,l.xmin,l.xmax,l.ymin,l.ymax);bestimmevariablenanzahl(l.p,dummy,muster,automatik);FI;window(seite,fenster,l.xmin,l.xmax,l.ymin,l.ymax);window(l.xmin,l.xmax,l.ymin,l.ymax);setzeundschreibekoordinatenkreuz;beschrifte(phasendiagrammkennzeichen,seite,fenster,l.p,0,l.xmin,l.xmax,l.ymin,l.ymax);endplot.erstenausgeben:viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));window(l.xmin,l.xmax,l.ymin,l.ymax);getparameter(l.koord);erstenneuausgeben.folgendenausgeben:putparameter(l.koord);beginplot;pen(loeschstift,standardstift,standarddicke,durchgezogen);verbindepunkteimphasendiagramm;endplot;l.t:=zeit;l.z:=zustand.anfangspunktloeschen:IFl.anfpunktTHENxwert:=zustandSUBl.p(1);ywert:=zustandSUBl.p(2);beginplot;pen(loeschstift,loeschstift,standarddicke,durchgezogen);move(xwert,ywert);zeichnefadenkreuz;endplot;l.anfpunkt:=FALSE FI.bildschirminhaltplotten:REAL VARstopzeit:=zeit;l.aufbildschirm:=FALSE;leseersten(kurve,zeit,zustand);trageanfangspunktein;lesekomplettekurve;schreibepicture;l.t:=zeit;l.z:=zustand;l.aufbildschirm:=TRUE.erstenneuausgeben:beginplot;pen(loeschstift,standardstift,standarddicke,durchgezogen);trageanfangspunktein;l.t:=zeit;l.z:=zustand;endplot.richtepictureein:l.graph:=nilpicture.ordnepenzu:IFvergleichTHENpen(l.graph,gepunktet)ELSEpen(l.graph,durchgezogen)FI.setzeundschreibekoordinatenkreuz:putkreuz(seite,fenster,kreuzerzeugenundzeichnen(l.xmin,l.xmax,l.ymin,l.ymax,phasendiagrammkennzeichen)).trageanfangspunktein:IF(imausgabefenster(zustand,l.p(1),l.xmin,l.xmax)ANDimausgabefenster(zustand,l.p(2),l.ymin,l.ymax))THENxwert:=zustandSUBl.p(1);ywert:=zustandSUBl.p(2);IFl.aufbildschirmTHENmove(xwert,ywert);zeichnefadenkreuz;l.anfpunkt:=TRUE ELSEmove(l.graph,xwert,ywert);zeichnefadenkreuzimpicFI;FI.zeichnefadenkreuz:drawcmr(0.2,0.0);move(xwert,ywert);drawcmr(-0.2,0.0);move(xwert,ywert);drawcmr(0.0,0.2);move(xwert,ywert);drawcmr(0.0,-0.2);move(xwert,ywert).zeichnefadenkreuzimpic:drawcmr(l.graph,0.2,0.0);move(l.graph,xwert,ywert);drawcmr(l.graph,-0.2,0.0);move(l.graph,xwert,ywert);drawcmr(l.graph,0.0,0.2);move(l.graph,xwert,ywert);drawcmr(l.graph,0.0,-0.2);move(l.graph,xwert,ywert).lesekomplettekurve:REPleseabschnittmitpunktenausserhalbdessichtbarenbereiches;leseabschnittmitpunkteninnerhalbdessichtbarenbereiches;PER.leseabschnittmitpunktenausserhalbdessichtbarenbereiches:REP IF NOT(zeit1.0CANDi<=dimension+codimensionREPiINCR1PER.setze2fuerdiesenindex:IFi<=dimension+codimensionTHENreplace(maske,i,2.0)FI.vertauschexundy:puffer:=ymin;ymin:=xmin;xmin:=puffer;puffer:=ymax;ymax:=xmax;xmax:=puffer;.END PROCvertauscheevtlvariablen;PROCkreuzzeitvergleich(OUTPUT VARseite,KURVE VARk1,k2,ZUSTAND VARmaske,INT CONSTfenster1,fenster2,ROWmaxanzvarproloesungINT VARpos,REAL VARxmin,xmax,x1min,x1max,ymin,ymax,BOOL VARdummy):ROW4REAL VARvpk1,vpk2;REAL VARy1min,y1max;PICTURE VARkreuz;INT VARanzahl;bestimmevariablenanzahl(pos,anzahl,maske,dummy);bestimmeextrema(zeitdiagrammkennzeichen,k1,pos,anzahl,xmin,xmax,ymin,ymax);bestimmeextrema(zeitdiagrammkennzeichen,k2,pos,anzahl,x1min,x1max,y1min,y1max);bestimmegemeinsamenwertebereich;beginplot;zeichneersteskreuzimzeitvergleich;zeichnezweiteskreuzimzeitvergleich;endplot.bestimmegemeinsamenwertebereich:IFy1minymaxTHENymax:=y1maxFI.zeichneersteskreuzimzeitvergleich:nildiagramm(seite,fenster1);legefensterfest(seite,vpk1(1),vpk1(2),vpk1(3),vpk1(4),fenster1);viewport(vpk1(1),vpk1(2),vpk1(3),vpk1(4));window(seite,fenster1,xmin,xmax,ymin,ymax);window(xmin,xmax,ymin,ymax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(xmin,xmax,ymin,ymax,zeitdiagrammkennzeichen);putkreuz(seite,fenster1,kreuz);beschrifte(zeitdiagrammkennzeichen,seite,fenster1,pos,anzahl,xmin,xmax,ymin,ymax).zeichnezweiteskreuzimzeitvergleich:nildiagramm(seite,fenster2);legefensterfest(seite,vpk2(1),vpk2(2),vpk2(3),vpk2(4),fenster2);viewport(vpk2(1),vpk2(2),vpk2(3),vpk2(4));window(seite,fenster2,x1min,x1max,ymin,ymax);window(x1min,x1max,ymin,ymax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(x1min,x1max,ymin,ymax,zeitdiagrammkennzeichen);putkreuz(seite,fenster2,kreuz);beschrifte(zeitdiagrammkennzeichen,seite,fenster2,pos,anzahl,x1min,x1max,ymin,ymax).END PROCkreuzzeitvergleich;PROCkreuzphasevergleich(OUTPUT VARseite,KURVE VARk1,k2,ZUSTAND VARmaske,INT CONSTfenster1,fenster2,ROWmaxanzvarproloesungINT VARpos,REAL VARxmin,xmax,x1min,x1max,ymin,ymax,BOOL VARautomatik):ROW4REAL VARvpk;REAL VARy1min,y1max;PICTURE VARkreuz;INT VARanzahl;bestimmevariablenanzahl(pos,anzahl,maske,automatik);bestimmeextrema(phasendiagrammkennzeichen,k1,pos,anzahl,xmin,xmax,ymin,ymax);bestimmeextrema(phasendiagrammkennzeichen,k2,pos,anzahl,x1min,x1max,y1min,y1max);bestimmegemeinsamebereiche;IFautomatikTHENvertauscheevtlvariablen(maske,xmin,xmax,ymin,ymax)FI;x1min:=xmin;x1max:=xmax;beginplot;schreibeundbeschriftekreuz;endplot.bestimmegemeinsamebereiche:IFx1minxmaxTHENxmax:=x1maxFI;IFy1minymaxTHENymax:=y1maxFI.schreibelegende:REAL VARa,b,abstand;TEXT VARname;INT + VARlaenge;PICTURE VARlegende:=nilpicture,linie1:=nilpicture,linie2:=nilpicture;a:=real(laengebeibeschriftung)*standardbreite;b:=2.0*standardhoehe+0.2;abstand:=9.0*standardbreite;move(legende,xmin,ymin);movecmr(legende,-1.0*a,-1.0*b);draw(legende,meldungstext(legendentext),0.0,standardhoehe,standardbreite);movecmr(legende,abstand,0.0);name:=meldungstext(erstekurve);laenge:=length(name);draw(legende,name,0.0,standardhoehe,standardbreite);movecmr(legende,(real(laenge)+0.5)*standardbreite,0.0);pen(linie1,durchgezogen);move(linie1,xmin,ymin);movecmr(linie1,(-1.0)*a+abstand,((-1.0)*b-0.1));drawcmr(linie1,real(laenge)*standardbreite,0.0);abstand:=abstand+(real(laenge)+0.5)*standardbreite;pen(loeschstift,standardstift,standarddicke,pen(linie1));plot(linie1);name:=meldungstext(zweitekurve);laenge:=length(name);draw(legende,name,0.0,standardhoehe,standardbreite);pen(linie2,gepunktet);move(linie2,xmin,ymin);movecmr(linie2,(-1.0)*a+abstand,((-1.0)*b-0.1));drawcmr(linie2,real(laenge)*standardbreite,0.0);pen(loeschstift,standardstift,standarddicke,pen(linie2));plot(linie2);pen(legende,durchgezogen);pen(loeschstift,standardstift,standarddicke,pen(legende));plot(legende);putkreuz(seite,fenster1,legende);putkreuz(seite,fenster1,linie1);putkreuz(seite,fenster1,linie2).schreibeundbeschriftekreuz:nildiagramm(seite,fenster1);legefensterfest(seite,vpk(1),vpk(2),vpk(3),vpk(4),fenster1);viewport(vpk(1),vpk(2),vpk(3),vpk(4));window(seite,fenster1,xmin,xmax,ymin,ymax);window(xmin,xmax,ymin,ymax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(xmin,xmax,ymin,ymax,phasendiagrammkennzeichen);putkreuz(seite,fenster1,kreuz);beschrifte(phasendiagrammkennzeichen,seite,fenster1,pos,anzahl,xmin,xmax,ymin,ymax);schreibelegende.END PROCkreuzphasevergleich;PROCkreuzhistovergleich(OUTPUT VARseite,KURVE VARk1,k2,ZUSTAND VARmaske,INT CONSTfenster1,fenster2,ROWmaxanzvarproloesungINT VARpos,REAL VARxmin,xmax,x1min,x1max,ymin,ymax,BOOL VARdummy):ROW4REAL VARvpk1,vpk2;REAL VARy1min,y1max,hmin,hzwi,hmax;PICTURE VARkreuz;INT VARanzahl;bestimmevariablenanzahl(pos,anzahl,maske,dummy);bestimmeextrema(histogrammkennzeichen,k1,pos,anzahl,xmin,xmax,ymin,ymax);bestimmeextrema(histogrammkennzeichen,k2,pos,anzahl,x1min,x1max,y1min,y1max);bestimmegemeinsamenwertebereich;beginplot;zeichneersteskreuzimhistogrammvergleich;zeichnezweiteskreuzimhistogrammvergleich;endplot.bestimmegemeinsamenwertebereich:IFy1minymaxTHENymax:=y1maxFI.zeichneersteskreuzimhistogrammvergleich:nildiagramm(seite,fenster1);legefensterfest(seite,vpk1(1),vpk1(2),vpk1(3),vpk1(4),fenster1);viewport(vpk1(1),vpk1(2),vpk1(3),vpk1(4));hmin:=hminhisto;hzwi:=hzwihisto;hmax:=hmaxhisto;window(seite,fenster1,ymin,ymax,hmin,hmax);window(ymin,ymax,hmin,hmax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(xmin,xmax,ymin,ymax,histogrammkennzeichen);putkreuz(seite,fenster1,kreuz);beschrifte(histogrammkennzeichen,seite,fenster1,pos,anzahl,ymin,ymax,hmin,hzwi).zeichnezweiteskreuzimhistogrammvergleich:nildiagramm(seite,fenster2);legefensterfest(seite,vpk2(1),vpk2(2),vpk2(3),vpk2(4),fenster2);viewport(vpk2(1),vpk2(2),vpk2(3),vpk2(4));window(seite,fenster2,ymin,ymax,hmin,hmax);window(ymin,ymax,hmin,hmax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(x1min,x1max,ymin,ymax,histogrammkennzeichen);putkreuz(seite,fenster2,kreuz);beschrifte(histogrammkennzeichen,seite,fenster2,pos,anzahl,ymin,ymax,hmin,hzwi).END PROCkreuzhistovergleich;PROCbestimmevariablenanzahl(ROWmaxanzvarproloesungINT VARpos,INT VARanzahl,ZUSTAND CONSTmuster,BOOL VARautomatik):INT VARz1,z2;FORz1FROM1UPTOmaxanzvarproloesungREPpos(z1):=0PER;z2:=0;automatik:=TRUE;FORz1FROM1UPTOdimension+codimensionREP IF(musterSUBz1)<>0.0THENz2INCR1;IF(musterSUBz1)=1.0THENpos(z2):=z1ELSEpos(2):=z1;z2:=0;automatik:=FALSE FI;FI;PER;anzahl:=z2.END PROCbestimmevariablenanzahl;PROCbestimmeextrema(TEXT CONSTwas,KURVE VARkurve,ROWmaxanzvarproloesungINT CONSTpos,INT CONSTanzahl,REAL VARxmin,xmax,ymin,ymax):INT VARi;ZUSTAND VARzustand:=neuerzustand(dimension ++codimension);IFwas=phasendiagrammkennzeichenTHENeinfacherandwertebestimmenELSErandwerteausmehrerenloesungenbestimmenFI;IFxmin>xmaxTHEN REAL VARhelpx:=xmin;xmin:=xmax;xmax:=helpx;ELIFxmax=xminTHENxmax:=xmin+epsilon;xmin:=xmin-epsilon;FI;IFymin>ymaxTHEN REAL VARhelp:=ymin;ymin:=ymax;ymax:=help;ELIFymax=yminTHENymax:=ymin+epsilon;ymin:=ymin-epsilon;FI.einfacherandwertebestimmen:ymin:=max(minimalwerte(kurve)SUBpos(2),randuntenSUBpos(2));ymax:=min(maximalwerte(kurve)SUBpos(2),randobenSUBpos(2));xmin:=max(minimalwerte(kurve)SUBpos(1),randuntenSUBpos(1));xmax:=min(maximalwerte(kurve)SUBpos(1),randobenSUBpos(1));ymin:=ymin-achsenabstand*(ymax-ymin);xmin:=xmin-achsenabstand*(xmax-xmin).randwerteausmehrerenloesungenbestimmen:ymin:=max(minimalwerte(kurve)SUBpos(1),randuntenSUBpos(1));ymax:=min(maximalwerte(kurve)SUBpos(1),randobenSUBpos(1));FORiFROM2UPTOanzahlREP IFmax(minimalwerte(kurve)SUBpos(i),randuntenSUBpos(i))ymaxTHENymax:=min(maximalwerte(kurve)SUBpos(i),randobenSUBpos(i));FI;PER;IFwas=zeitdiagrammkennzeichenTHENymin:=ymin-achsenabstand*(ymax-ymin)FI;xmax:=letztezeit(kurve);leseersten(kurve,xmin,zustand).END PROCbestimmeextrema;PICTURE PROCkreuzerzeugenundzeichnen(REAL CONSTxmin,xmax,ymin,ymax,TEXT CONSTzeichen):PICTURE VARtransfer;BOUND PICTURE VARkreuz;REAL VARhoehe,stelle;ROW3REAL VARschoenezahl;INT VARpos;BOOL VARzeitachsehisto;IFexists("KREUZ")THENforget("KREUZ",quiet)FI;kreuz:=new("KREUZ");kreuz:=nilpicture;ordnestiftzu;IFzeichen=histogrammkennzeichenTHENzeichnetachse;zeichnenachse;IFmitskalierungTHENtskalierung;nskalierungFI;ELSEzeichnexachse;zeichneyachse;IFmitskalierungTHENxskalierung;yskalierungFI;FI;lieferekreuz.ordnestiftzu:pen(loeschstift,standardstift,standarddicke,durchgezogen);pen(kreuz,durchgezogen).zeichnetachse:move(ymin,hminhisto);draw(ymax,hminhisto);move(kreuz,ymin,hminhisto);draw(kreuz,ymax,hminhisto);zeichnetspitze.zeichnetspitze:move(ymax,hminhisto);drawcmr(-0.2,0.2);move(ymax,hminhisto);drawcmr(-0.2,-0.2);move(kreuz,ymax,hminhisto);drawcmr(kreuz,-0.2,0.2);move(kreuz,ymax,hminhisto);drawcmr(kreuz,-0.2,-0.2).zeichnenachse:move(ymin,hzwihisto);draw(ymax,hzwihisto);move(kreuz,ymin,hzwihisto);draw(kreuz,ymax,hzwihisto);zeichnenspitze.zeichnenspitze:drawcmr(-0.2,0.2);move(ymax,hzwihisto);drawcmr(-0.2,-0.2);drawcmr(kreuz,-0.2,0.2);move(kreuz,ymax,hzwihisto);drawcmr(kreuz,-0.2,-0.2).tskalierung:stelle:=xmin;zahlen(xmin,0.9*(xmax-xmin)+xmin,schoenezahl);zeitachsehisto:=TRUE;hoehe:=hminhisto;histoskalierung.nskalierung:stelle:=ymin;zahlen(ymin,0.9*(ymax-ymin)+ymin,schoenezahl);zeitachsehisto:=FALSE;hoehe:=hzwihisto;histoskalierung.histoskalierung:stelle:=schoenezahl(1);move(abbildungstelle,hoehe);movecmr(0.0,0.2);drawcmr(0.0,-0.3);move(kreuz,abbildungstelle,hoehe);movecmr(kreuz,0.0,0.2);drawcmr(kreuz,0.0,-0.3);beschrifte;FORposFROM2UPTO3REPstelle:=schoenezahl(pos);zeichnehistostrich;zeichnegegenstrich;beschriftePER.zeichnehistostrich:move(abbildungstelle,hoehe);drawcmr(0.0,0.1);move(kreuz,abbildungstelle,hoehe);drawcmr(kreuz,0.0,0.1).zeichnexachse:move(xmin,ymin);draw(xmax,ymin);move(kreuz,xmin,ymin);draw(kreuz,xmax,ymin);zeichnexspitze.zeichnexspitze:drawcmr(-0.2,0.2);move(xmax,ymin);drawcmr(-0.2,-0.2);drawcmr(kreuz,-0.2,0.2);move(kreuz,xmax,ymin);drawcmr(kreuz,-0.2,-0.2).zeichneyachse:move(xmin,ymin);draw(xmin,ymax);move(kreuz,xmin,ymin);draw(kreuz,xmin,ymax);zeichneyspitze.zeichneyspitze:drawcmr(0.0,standardhoehe);drawcmr(0.2,-0.2);move(xmin,ymax);movecmr(0.0,standardhoehe);drawcmr(-0.2,-0.2);drawcmr(kreuz,0.0,standardhoehe);drawcmr(kreuz,0.2,-0.2);move(kreuz,xmin,ymax);movecmr(kreuz,0.0,standardhoehe);drawcmr(kreuz,-0.2,-0.2).xskalierung:stelle:=xmin;zahlen(xmin,0.9*(xmax-xmin)+xmin,schoenezahl);IFzeichen=zeitdiagrammkennzeichenTHENstelle:=schoenezahl(1);beschrifteersten;FI;stelle:=schoenezahl(1);IFzeichen=phasendiagrammkennzeichenTHENmove(stelle,ymin);movecmr(0.0,0.2);drawcmr(0.0,-0.3) +;move(kreuz,stelle,ymin);movecmr(kreuz,0.0,0.2);drawcmr(kreuz,0.0,-0.3);beschrifte;FI;FORposFROM2UPTO3REPstelle:=schoenezahl(pos);zeichnexstrich;zeichnegegenstrich;beschriftePER.zeichnexstrich:move(stelle,ymin);drawcmr(0.0,0.1);move(kreuz,stelle,ymin);drawcmr(kreuz,0.0,0.1).zeichnegegenstrich:drawcmr(0.0,0.1);drawcmr(0.0,-0.3);drawcmr(kreuz,0.0,0.1);drawcmr(kreuz,0.0,-0.3).beschrifteersten:move(stelle,ymin);movecmr(0.0,-1.0*standardhoehe-abstand);draw(compress(wandle(stelle,laengebeibeschriftung,nachkommastellen)),0.0,standardhoehe,standardbreite);move(kreuz,stelle,ymin);movecmr(kreuz,0.0,-1.0*standardhoehe-abstand);draw(kreuz,compress(wandle(stelle,laengebeibeschriftung,nachkommastellen)),0.0,standardhoehe,standardbreite).beschrifte:IFzeichen=histogrammkennzeichenTHENmove(abbildungstelle,hoehe)ELSEmove(stelle,ymin)FI;movecmr(((-1.0)*real(vorkomma))*standardbreite,-1.0*standardhoehe-abstand);draw(wandle(stelle,laengebeibeschriftung,nachkommastellen),0.0,standardhoehe,standardbreite);IFzeichen=histogrammkennzeichenTHENmove(kreuz,abbildungstelle,hoehe)ELSEmove(kreuz,stelle,ymin)FI;movecmr(kreuz,((-1.0)*real(vorkomma))*standardbreite,-1.0*standardhoehe-abstand);draw(kreuz,wandle(stelle,laengebeibeschriftung,nachkommastellen),0.0,standardhoehe,standardbreite).yskalierung:zahlen(ymin,0.9*(ymax-ymin)+ymin,schoenezahl);FORposFROM1UPTO3REPstelle:=schoenezahl(pos);zeichneystrich;zeichneygegenstrich;beschrifteyPER.zeichneystrich:move(xmin,stelle);drawcmr(0.1,0.0);move(kreuz,xmin,stelle);drawcmr(kreuz,0.1,0.0).zeichneygegenstrich:drawcmr(0.1,0.0);drawcmr(kreuz,0.1,0.0).beschriftey:move(xmin,stelle);movecmr((-1.0)*(real(laengebeibeschriftung)+0.5)*standardbreite,-0.5*standardhoehe);draw(wandle(stelle,laengebeibeschriftung,nachkommastellen),0.0,standardhoehe,standardbreite);move(kreuz,xmin,stelle);movecmr(kreuz,(-1.0)*(real(laengebeibeschriftung)+0.5)*standardbreite,-0.5*standardhoehe);draw(kreuz,wandle(stelle,laengebeibeschriftung,nachkommastellen),0.0,standardhoehe,standardbreite).lieferekreuz:transfer:=kreuz;forget("KREUZ",quiet);transfer.abbildungstelle:IFzeitachsehistoTHENabbildungtbeihistogramm(xmin,xmax,ymin,ymax,stelle)ELSEstelleFI.END PROCkreuzerzeugenundzeichnen;PROCbeschrifte(TEXT CONSTwas,OUTPUT VARseite,INT CONSTfenster,ROWmaxanzvarproloesungINT CONSTpos,INT CONSTanzahl,REAL VARxmin,xmax,ymin,ymax):LETbeschriftungzeitxachse="t";INT VARz1;PICTURE VARbeschriftung:=nilpicture;TEXT VARname,varoberbegriff;IFanzahl=1THEN IFpos(1)<=dimensionTHENvaroberbegriff:=variablenkurzform(pos(1));ELSEvaroberbegriff:=covariablenkurzform(pos(1)-dimension);FI;ELIFlength(compress(variablenoberbegriffkurzform))=0THENvaroberbegriff:=compress(auskunftstext(auskoberbegriff))ELSEvaroberbegriff:=variablenoberbegriffkurzform;FI;IFwas=phasendiagrammkennzeichenTHENbeschriftephaseELIFwas=histogrammkennzeichenTHENbeschriftehistoELSEbeschriftezeitFI.beschriftephase:IFpos(1)<=dimensionTHENname:=variablenkurzform(pos(1));ELSEname:=covariablenkurzform(pos(1)-dimension);FI;move(beschriftung,xmax,ymin);movecmr(beschriftung,real((-1)*laengevarkurzform)*standardbreite,-2.0*standardhoehe-0.2);draw(beschriftung,name,0.0,standardhoehe,standardbreite);IFpos(2)<=dimensionTHENname:=variablenkurzform(pos(2));ELSEname:=covariablenkurzform(pos(2)-dimension);FI;move(beschriftung,xmin,ymax);movecmr(beschriftung,real((-1)*laengevarkurzform)*standardbreite-0.1,0.0);draw(beschriftung,name,0.0,standardhoehe,standardbreite);pen(beschriftung,durchgezogen);pen(loeschstift,standardstift,standarddicke,pen(beschriftung));plot(beschriftung);putkreuz(seite,fenster,beschriftung).beschriftehisto:pen(beschriftung,durchgezogen);pen(loeschstift,standardstift,standarddicke,pen(beschriftung));move(xmin,ymin);movecmr(-(real(length(beschriftungzeitxachse))+1.0)*standardbreite,-0.2);draw(beschriftungzeitxachse,0.0,standardhoehe,standardbreite);move(xmin,ymax);movecmr(-(real(length(varoberbegriff))+1.0)*standardbreite,-0.2);draw(varoberbegriff,0.0,standardhoehe,standardbreite);move(beschriftung,xmin, +ymin);movecmr(beschriftung,-(real(length(beschriftungzeitxachse))+1.0)*standardbreite,-0.2);draw(beschriftung,beschriftungzeitxachse,0.0,standardhoehe,standardbreite);move(beschriftung,xmin,ymax);movecmr(beschriftung,-(real(length(varoberbegriff))+1.0)*standardbreite,-0.2);draw(beschriftung,varoberbegriff,0.0,standardhoehe,standardbreite);FORz1FROM1UPTOanzahlREP IFpos(z1)<=dimensionTHENname:=variablenkurzform(pos(z1));ELSEname:=covariablenkurzform(pos(z1)-dimension);FI;move(xmin,ymax);mover(0.0,2.1*real(z1));movecmr(-(real(length(name))+1.0)*standardbreite,-0.2);draw(name,0.0,standardhoehe,standardbreite);move(beschriftung,xmin,ymax);mover(beschriftung,0.0,2.1*real(z1));movecmr(beschriftung,-(real(length(name))+1.0)*standardbreite,-0.2);draw(beschriftung,name,0.0,standardhoehe,standardbreite)PER;putkreuz(seite,fenster,beschriftung).beschriftezeit:REAL VARa,b,abstand;INT VARi,wortlaenge;ROWmaxanzvarproloesungPICTURE VARlinie;FORiFROM1UPTOmaxanzvarproloesungREPlinie(i):=nilpicturePER;INT VARstiftenr:=1;FORiFROM1UPTOanzahlREPpen(linie(i),stiftenr);IFstiftenr=penanzahlTHENstiftenr:=1ELSEstiftenrINCR1FI;PER;a:=real(laengebeibeschriftung)*standardbreite;b:=2.0*standardhoehe+0.2;abstand:=9.0*standardbreite;move(beschriftung,xmin,ymin);movecmr(beschriftung,-1.0*a,-1.0*b);draw(beschriftung,meldungstext(legendentext),0.0,standardhoehe,standardbreite);movecmr(beschriftung,abstand,0.0);FORiFROM1UPTOanzahlREPschreibenamen;unterstreichePER;beschrifteachsen;pen(beschriftung,durchgezogen);pen(loeschstift,standardstift,standarddicke,pen(beschriftung));plot(beschriftung);putkreuz(seite,fenster,beschriftung).schreibenamen:IFpos(i)<=dimensionTHENname:=variablenkurzform(pos(i));ELSEname:=covariablenkurzform(pos(i)-dimension);FI;wortlaenge:=length(name);draw(beschriftung,name,0.0,standardhoehe,standardbreite);movecmr(beschriftung,(real(wortlaenge)+0.5)*standardbreite,0.0).unterstreiche:stiftenr:=pen(linie(i));pen(linie(i),stiftenr);move(linie(i),xmin,ymin);movecmr(linie(i),(-1.0)*a+abstand,((-1.0)*b-0.1));drawcmr(linie(i),real(wortlaenge)*standardbreite,0.0);abstand:=abstand+(real(wortlaenge)+0.5)*standardbreite;pen(loeschstift,standardstift,standarddicke,pen(linie(i)));plot(linie(i));putkreuz(seite,fenster,linie(i)).beschrifteachsen:move(beschriftung,xmin,ymax);movecmr(beschriftung,(-1.0)*real(min(laengevarkurzform,length(varoberbegriff)))*standardbreite-0.1,0.0);draw(beschriftung,varoberbegriff,0.0,standardhoehe,standardbreite);name:=beschriftungzeitxachse;move(beschriftung,xmax,ymin);movecmr(beschriftung,-1.0*standardbreite,0.2);draw(beschriftung,name,0.0,standardhoehe,standardbreite).END PROCbeschrifte;REAL PROCabbildungtbeihistogramm(REAL CONSTtmin,tmax,nmin,nmax,takt):IFtmax=tminTHENnminELSEnmin+((takt-tmin)*(nmax-nmin)/(tmax-tmin))FI.END PROCabbildungtbeihistogramm;REAL PROCberechnetestbeizeitdiagramm(REAL CONSTx1,x2,y1,y2,yzw):IFy1=y2THENx1ELSEx1+((x2-x1)*(yzw-y1))/(y2-y1)FI.END PROCberechnetestbeizeitdiagramm;BOOL PROCimausgabefenster(ZUSTAND CONSTz,INT CONSTi,REAL CONSTmin,max):((zSUBi)<=max)CAND((zSUBi)>=min)END PROCimausgabefenster;FILE PROCtabelle(KURVE VARkurve,ZUSTAND CONSTmuster,BOOL CONSTmusterzeit):LETtabellenname=" tabelle",fracs=4,spaltenbreite=13,laenge=13,zeitbeschr=76,DARSTELLUNG=STRUCT(INTanzahlkurven,ROWmaxkurvenINTindex);REAL VARzeit,zeitdifferenz;ZUSTAND VARz:=neuerzustand(DSUBmuster);INT VARi:=0;ROWmaxkurvenSTRUCT(TEXTzraum,strich)VARspalte;INT VARspaltenanzahl,spaltenzaehler,punktzaehler:=0;TEXT CONSTtrennstrichfuerleerezeit:=(laenge+1)*" "+"!";waehlekurvenaus;richtedateiein;schreibeueberschrift;verarbeiteerstenpunkt;WHILE NOTendedestabspeichers(kurve)REPverarbeitenaechstenpunktPER;WHILE NOTanzahlmoeglicherpunkteerreichtCANDmusterzeitREPverarbeiteleerezeilePER;lieferedatei.waehlekurvenaus:DARSTELLUNG VARtabelle;tabelle.anzahlkurven:=0;FORiFROM1UPTO(DSUBmuster)REP IF(musterSUBi)=1.0THENtabelle.anzahlkurvenINCR1;tabelle.index(tabelle.anzahlkurven):=i;IFtabelle.anzahlkurven=maxkurvenTHEN LEAVEwaehlekurvenausFI FI PER. +richtedateiein:IFexists(tabellenname)THENforget(tabellenname,quiet)FI;FILE VARtab:=sequentialfile(output,tabellenname).schreibeueberschrift:bestimmespaltenanzahl;schreibeerstezeile;schreibeunterstreichung.bestimmespaltenanzahl:spaltenanzahl:=tabelle.anzahlkurven+1;setzetabelle.setzetabelle:FORiFROM1UPTOspaltenanzahlREPspalte(i).zraum:="";spalte(i).strich:=" |"PER.schreibeerstezeile:spaltenzaehler:=1;schreibeevtlzeit;FORiFROM1UPTOtabelle.anzahlkurvenREPschreibekoordinatenueberschriftPER;schreibezeileindatei;setzetabelle.schreibeevtlzeit:TEXT VARzeittext:=meldungstext(zeitbeschr);IFlength(zeittext)=normaleanzahlvonausgegebenenpunkten.verarbeiteleerezeile:IFzeitdifferenz=0.0THENspalte(1).zraum:=trennstrichfuerleerezeit;ELSEzeit:=real(punktzaehler)*zeitdifferenz;spalte(1).zraum:=wandle(zeit,laenge,fracs);FI;putline(tab,spalte(1).zraum);punktzaehlerINCR1;.ENDPROCtabelle;END PACKETcoroutinenundco; + diff --git a/app/schulis-simulationssystem/3.0/src/ls dateiscroll b/app/schulis-simulationssystem/3.0/src/ls dateiscroll new file mode 100644 index 0000000..fa923cf --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls dateiscroll @@ -0,0 +1,5 @@ +PACKETlsscrollDEFINESscroll,grossesrahmenfenster,tabellenfensteroben,tabellenfensterunten,scrollfenster:LETniltext="",bell="�",left="�",right="�",runter=" +",hoch="�",hop="�",esc="�";PROCscroll(WINDOW VARw,TEXT CONSTdatname,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatz,erstespalte,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):FILE VARf:=sequentialfile(input,datname);scroll(w,f,xscroll,yscroll,horizontalscroll,erstersatz,erstespalte,sonderzeichen,ausstiegzeichen)END PROCscroll;PROCscroll(WINDOW VARw,FILE VARf,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatz,erstespalte,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):BOOL VARveraenderungderkopfzeilen:=TRUE,veraenderungdervariablenspalte:=TRUE;bestimmemaximalwertederdatei;bereiteausgabevor;REPzeigedateiausschnitt;IFsonderzeichen=niltextTHEN LEAVEscrollEND IF;werteeingabezeichenaus;veraenderungdervariablenspalte:=NOTveraenderungderkopfzeilenEND REP.bestimmemaximalwertederdatei:TEXT VARzeile;input(f);INT VARmaxspalten:=0,maxzeilen:=lines(f);WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>maxspaltenTHENmaxspalten:=length(zeile)END IF END REP.bereiteausgabevor:INT CONSTbreite:=areaxsize(w),laenge:=areaysize(w),xbeginn:=areax(w),ybeginn:=areay(w),letzterzeilenanfang:=maxzeilen-laenge+yscroll,ausgabebreite:=breite-xscroll-1,ausgabelaenge:=laenge-yscroll+1,letzterspaltenanfang:=jenachdem;modify(f).jenachdem:IFhorizontalscroll>1THENmaxspalten-horizontalscroll+2ELSEmaxspalten-ausgabebreiteEND IF.zeigedateiausschnitt:TEXT VARsatz,ausgabezeile;INT VARi,ypos;IFveraenderungderkopfzeilenTHENypos:=ybeginn;FORiFROM1UPTOyscroll-1REPtoline(f,i);readrecord(f,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginn+yscroll-1END IF;i:=erstersatz;REPtoline(f,i);readrecord(f,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginn>laenge-1END REP.werteeingabezeichenaus:TEXT VARch;REPinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENscrollelinksEND IF ELIFch=rightTHEN IFerstespalteyscrollTHENscrollezurueckEND IF ELIFch=runterTHEN IFerstersatzxscrollTHENblaetterelinksEND IF ELIFch=rightTHEN IFerstespalteyscrollTHENblaetterezurueckEND IF ELIFch=runterTHEN IFerstersatzyscrollTHENspringeandenanfangELIFausstiegzeichen="9"CANDerstersatz0THEN LEAVEscrollEND IF END IF END REP.scrollelinks:erstespalteDECRhorizontalscroll;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollerechts:erstespalteINCRhorizontalscroll;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollezurueck:erstersatzDECR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.scrollevor:erstersatzINCR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterelinks:erstespalteDECRausgabebreite;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaettererechts:erstespalteINCRausgabebreite;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaetterezurueck:erstersatzDECRausgabelaenge;erstersatz:=max(erstersatz,yscroll);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterevor:erstersatzINCRausgabelaenge;erstersatz:=min( +erstersatz,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandenanfang:erstersatz:=yscroll;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandasende:erstersatz:=max(yscroll,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenausEND PROCscroll;PROCscroll(WINDOW VARwo,wu,TEXT CONSTdatnameo,datnameu,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatzo,erstespalte,erstersatzu,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):BOOL VARveraenderungderkopfzeilen:=TRUE,veraenderungdervariablenspalte:=TRUE;bestimmemaximalwertederdatei;bereiteausgabevor;REPzeigedateiausschnittoben;zeigedateiausschnittunten;IFsonderzeichen=niltextTHEN LEAVEscrollEND IF;werteeingabezeichenaus;veraenderungdervariablenspalte:=NOTveraenderungderkopfzeilenEND REP.bestimmemaximalwertederdatei:TEXT VARzeile;FILE VARfo:=sequentialfile(input,datnameo),fu:=sequentialfile(input,datnameu);INT VARmaxspalten:=0,maxzeileno:=lines(fo),maxzeilenu:=lines(fu);WHILE NOTeof(fo)REPgetline(fo,zeile);IFlength(zeile)>maxspaltenTHENmaxspalten:=length(zeile)END IF END REP.bereiteausgabevor:INT CONSTbreite:=areaxsize(wo),laenge:=areaysize(wo),xbeginn:=areax(wo),ybeginno:=areay(wo),ybeginnu:=areay(wu),letzterzeilenanfango:=maxzeileno-laenge+yscroll,letzterzeilenanfangu:=maxzeilenu-laenge+yscroll,ausgabebreite:=breite-xscroll-1,ausgabelaenge:=laenge-yscroll+1,letzterspaltenanfang:=jenachdem;modify(fo);modify(fu);.jenachdem:IFhorizontalscroll>1THENmaxspalten-horizontalscroll+2ELSEmaxspalten-ausgabebreiteEND IF.zeigedateiausschnittoben:TEXT VARsatz,ausgabezeile;INT VARi,ypos;IFveraenderungderkopfzeilenTHENypos:=ybeginno;FORiFROM1UPTOyscroll-1REPtoline(fo,i);readrecord(fo,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginno+yscroll-1END IF;i:=erstersatzo;REPtoline(fo,i);readrecord(fo,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginno>laenge-1END REP.zeigedateiausschnittunten:IFveraenderungderkopfzeilenTHENypos:=ybeginnu;FORiFROM1UPTOyscroll-1REPtoline(fu,i);readrecord(fu,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginnu+yscroll-1END IF;i:=erstersatzu;REPtoline(fu,i);readrecord(fu,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginnu>laenge-1END REP.werteeingabezeichenaus:TEXT VARch;REPinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENscrollelinksEND IF ELIFch=rightTHEN IFerstespalteyscrollCORerstersatzu>yscrollTHENscrollezurueckEND IF ELIFch=runterTHEN IFerstersatzoxscrollTHENblaetterelinksEND IF ELIFch=rightTHEN IFerstespalteyscrollORerstersatzu>yscrollTHENblaetterezurueckEND IF ELIFch=runterTHEN IFerstersatzoyscrollORerstersatzu>yscroll)THENspringeandenanfangELIFausstiegzeichen="9"CAND(erstersatzo0THEN LEAVEscrollEND IF END IF END REP.scrollelinks:erstespalteDECRhorizontalscroll;erstespalte:=max(erstespalte,xscroll); +veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollerechts:erstespalteINCRhorizontalscroll;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollezurueck:IFerstersatzo>yscrollTHENerstersatzoDECR1;FI;IFerstersatzu>yscrollTHENerstersatzuDECR1;FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.scrollevor:IFerstersatzoyscrollTHENerstersatzoDECRausgabelaenge;erstersatzo:=max(erstersatzo,yscroll);FI;IFerstersatzu>yscrollTHENerstersatzuDECRausgabelaenge;erstersatzu:=max(erstersatzu,yscroll);FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterevor:IFerstersatzoyscroll)THENerstersatzo:=yscroll;FI;IF(erstersatzu>yscroll)THENerstersatzu:=yscroll;FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandasende:IFerstersatzo1CANDmitphasendiagrammTHENmdlinfo:=auskunftindatei(auskdiagrammarten);ELSEmdlinfo:=auskunftindatei(auskdiagrammartenohnephasendiagr)FI;footnote(steuerleiste(stinfo));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimitinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,taste);IFtaste=abbrechenTHENleavedemonstrationELSEzeigezeitdiagrammFI.zeigezeitdiagramm:zeitdiagrammausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENzeigehistogrammELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.zeitdiagrammausgeben:ausdiagr:=niloutput(strukt1fenster,outputausdiagr);hilfskurve:=LOESUNGSABSCHNITTmodellauf.original;steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomuster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,16,stgraphik,sendetaste,weiter+abbrechen,taste,PROCcoroutinezeit,PROCcoroutinedummy);.zeigehistogramm:histogrammausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHEN IFcodimension+dimension>1CANDmitphasendiagrammTHENzeigephasendiagrammELSEzeigetabelleFI ELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.histogrammausgeben:ausdiagr:=niloutput(strukt1fenster,outputausdiagr);hilfskurve:=LOESUNGSABSCHNITTmodellauf.original;steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomuster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,27,stgraphik,sendetaste,weiter+abbrechen,taste,PROCcoroutinehisto,PROCcoroutinedummy).zeigephasendiagramm:phasendiagrammausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENzeigetabelleELSEgibmeldungaus(falschetaste)FI PER.phasendiagrammausgeben:ausdiagr:=niloutput(strukt1fenster, +outputausdiagr);ZUSTAND VARdemomusterphase:=neuerzustand(dimension+codimension);hilfskurve:=LOESUNGSABSCHNITTmodellauf.original;replace(demomusterphase,demoxindex,1.0);IFdemoautomatikTHENreplace(demomusterphase,demoyindex,1.0)ELSEreplace(demomusterphase,demoyindex,2.0)FI;steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomusterphase,neuerzustand(dimension+codimension),fensterganz,fensterdummy,17,stgraphik,sendetaste,weiter+abbrechen,taste,PROCcoroutinephase,PROCcoroutinedummy).zeigetabelle:tabelleausgeben;IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENinformation2FI.tabelleausgeben:WINDOW VARtabwindow:=grossesrahmenfenster;plotend;hilfskurve:=LOESUNGSABSCHNITTmodellauf.original;mdlinfo:=tabelle(hilfskurve,demomuster,TRUE);forget(dateitab,quiet);rename(erzeugtetabelle,dateitab);outframe(tabwindow);cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(18),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stmodellgroessen));erstersatz1:=scrollzeile1tab;erstespalte1:=scrollsp1tab;scroll(tabwindow,dateitab,scrollsp1tab,scrollzeile1tab,scrollbreitetab,erstersatz1,erstespalte1,scrollausstiegohnedrucken,taste);erase(tabwindow);.information2:plotend;IFcodimension+dimension>1CANDmitphasendiagrammTHENmdlinfo:=auskunftindatei(2)ELSEmdlinfo:=auskunftindatei(4);FI;cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(13),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stinfo));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimitinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,taste);IFtaste=abbrechenTHENleavedemonstrationELSEzeigekombiniertedarstellungFI.zeigekombiniertedarstellung:kombiniertedarstellungausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENzeigevergleichskurveELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.kombiniertedarstellungausgeben:IFcodimension+dimension>1CANDmitphasendiagrammTHENausdiagr:=niloutput(strukt2diagramme1text,outputausdiagr);replace(ausdiagr,fensterrechts,modellwerteausgeben(modellauf.original));steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomuster,demomusterphase,fensterlinksoben,fensterlinksunten,19,stkombinationzeitphasen,sendetaste+blaettern,weiter+abbrechen,taste,PROCcoroutinezeit,PROCcoroutinephase)ELSEausdiagr:=niloutput(strukttabelleunten,outputausdiagr);replace(ausdiagr,fensterunten,tabelle(hilfskurve,demomuster,TRUE));replace(ausdiagr,fensterrechtsoben,modellwerteausgeben(modellauf.original));steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomuster,neuerzustand(dimension+codimension),fensterlinksoben,fensterlinksunten,19,stkombinationzeittabelle,sendetaste+blaetternoben+blaetternunten,weiter+abbrechen,taste,PROCcoroutinezeit,PROCcoroutinedummy)FI.zeigevergleichskurve:vergleichskurveausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterCANDmitphasendiagrammCAND(dimension+codimension>1)THENzeigevergleichskurveimphasendiagrammELIFtaste=weiterCANDmitzusatzdarstellungTHENinformation3ELIFtaste=weiterTHENzeigeletzteseiteELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.vergleichskurveausgeben:ausdiagr:=niloutput(strukt4fenster,outputausdiagr);KURVE VARkurve1,kurve2;replace(ausdiagr,fensterrechtsoben,modellwerteausgeben(modellauf.original));replace(ausdiagr,fensterrechtsunten,modellwerteausgeben(modellauf.vergleich));kurve2:=LOESUNGSABSCHNITTmodellauf.vergleich;kurve1:=LOESUNGSABSCHNITTmodellauf.original;steuerprozessfuerzweiloesungen(ausdiagr,kurve1,kurve2,demomuster,fensterlinksoben,fensterlinksunten,20,stvergleichzeit,sendetaste+blaetternoben+blaetternunten,weiter+abbrechen,taste,PROCcoroutinezeit,PROCkreuzzeitvergleich).zeigevergleichskurveimphasendiagramm:vergleichskurveimphasendiagrammausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterCANDmitzusatzdarstellungTHENinformation3ELIFtaste=weiterTHENzeigeletzteseiteELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.vergleichskurveimphasendiagrammausgeben:ausdiagr:=niloutput(strukt1fenster, +outputausdiagr);kurve2:=LOESUNGSABSCHNITTmodellauf.vergleich;kurve1:=LOESUNGSABSCHNITTmodellauf.original;steuerprozessfuerzweiloesungen(ausdiagr,kurve1,kurve2,demomusterphase,fensterganz,fensterganz,20,stvergleichphasen,sendetaste,weiter+abbrechen,taste,PROCcoroutinephase,PROCkreuzphasevergleich);.information3:plotend;mdlinfo:=auskunftindatei(auskunftzusatzdarst);cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(13),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stinfo));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimitinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,taste);IFtaste=abbrechenTHENleavedemonstrationELSEzeigezusatzdarstFI.zeigezusatzdarst:darst4(loesung,indemo,taste);IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENzeigeletzteseiteFI;.zeigeletzteseite:plotend;mdlinfo:=auskunftindatei(auskletzteseite);cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(13),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stmitbeliebigertaste));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimitinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,"",taste);inchar(taste);leavedemonstration.END PROCdemonstration;PROCforgetdemooutput:forget(dateimitwerten,quiet);forget(dateimitinfo,quiet);forget(outputmodellgroessen,quiet);forget(outputaus,quiet);forget(outputinfo,quiet);forget(outputausdiagr,quiet);forget(dateitab,quiet);forget(dateimodellwerte,quiet);forget(erzeugtetabelle,quiet);END PROCforgetdemooutput;END PACKETdemonstration; + diff --git a/app/schulis-simulationssystem/3.0/src/ls dialoghilfen b/app/schulis-simulationssystem/3.0/src/ls dialoghilfen new file mode 100644 index 0000000..086d78d --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls dialoghilfen @@ -0,0 +1,9 @@ +PACKETlsdialoghilfenDEFINESreturn,gibmeldungaus,meldungaufbildschirm,zeigeauskunft,auskunftindatei,texteankoppeln,meldungstext,auskunftstext,kopfzeile,steuerleiste,loescheaktuellemeldung,zeigemeldung:LETdatenraumnamed="TEXTE deutsch",maxsize=100,editorfenster=79,eol=""254"",stop=""223"",simseltask="ls-MENUKARTEN",error=1110,sendetexte=1119,umbruch=""223"",untenletztezeile=22,dateiname="temporaer";LETnegmldzeile1mbankdialog=17,negmldzeile1simuldialog=16,posmldzeile1=20,zeilenlaengemld=75,simulationsmenu=1;INITFLAG VARinthistask:=FALSE;LET DIRFILE=STRUCT ( ROWmaxsizeTEXTmeldung,ROWmaxsizeTEXTauskunft,ROWmaxsizeTEXTueberschrift,ROWmaxsizeTEXTleiste,ROWmaxsizeTEXTmenuezeile);BOUND DIRFILE VARtexte;BOOL VARmeldunggezeigt::FALSE;AREA VARallgmld;fill(allgmld,3,negmldzeile1mbankdialog,zeilenlaengemld,3);PROCtexteankoppeln:IF NOTinitialized(inthistask)THEN TEXT VARtextdatenraum:=sprachversionbestimmen;IF NOTexists(textdatenraum)THEN IF NOTexists(textdatenraum,/simseltask)THENerrorstop("TEXTE fehlen!")ELSEfetch(textdatenraum,/simseltask);kopplean;FI;ELSEkopplean;FI;FI;.sprachversionbestimmen:datenraumnamed.kopplean:DATASPACE VARtextds:=old(textdatenraum);texte:=textds;forget(textdatenraum,quiet);END PROCtexteankoppeln;TEXT PROCmeldungstext(INT CONSTindex):texte.meldung(index)END PROCmeldungstext;TEXT PROCauskunftstext(INT CONSTindex):texte.auskunft(index)END PROCauskunftstext;TEXT PROCsteuerleiste(INT CONSTindex):texte.leiste(index)END PROCsteuerleiste;TEXT PROCkopfzeile(INT CONSTindex):texte.ueberschrift(index)END PROCkopfzeile;TEXT PROCmenuezeile(INT CONSTindex):texte.menuezeile(index)END PROCmenuezeile;PROCgibmeldungaus(INT CONSTmeldungsnr):gibmeldungaus(meldungstext(meldungsnr));END PROCgibmeldungaus;PROCgibmeldungaus(TEXT CONSTmeldungstxt):TEXT VARtxt:=meldungstxt;INT CONSTgrenzelinks:=4,grenzerechts:=79;loeschealtemeldung;IFcompress(meldungstxt)<>""THENschreibemeldungFI.loeschealtemeldung:textout(grenzelinks,untenletztezeile-1,(grenzerechts-grenzelinks+1)*" ");textout(grenzelinks,untenletztezeile,(grenzerechts-grenzelinks+1)*" ");.schreibemeldung:IFeinezeileTHENgibinvorletzterzeileausELSEgibinvorvorletzterzeileausFI;.einezeile:length(txt)<=(grenzerechts-grenzelinks)CANDkeineumbruchstelle.gibinvorletzterzeileaus:textout(grenzelinks,untenletztezeile,txt).gibinvorvorletzterzeileaus:textout(grenzelinks,untenletztezeile-1,subtext(txt,1,pos(txt,umbruch)-1));txt:=subtext(txt,pos(txt,umbruch)+1);textout(grenzelinks,untenletztezeile,subtext(txt,1,grenzerechts-grenzelinks+1)).keineumbruchstelle:pos(txt,umbruch)=0.END PROCgibmeldungaus;PROCmeldungaufbildschirm(BOOL CONSTausgegeben):IFausgegebenTHENmeldunggezeigt:=TRUE ELSEmeldunggezeigt:=FALSE FI;END PROCmeldungaufbildschirm;BOOL PROCmeldungaufbildschirm:meldunggezeigt.END PROCmeldungaufbildschirm;PROCzeigeauskunft(TEXT CONSTatext,INT CONSTvonzeile,biszeile,abspalte):TEXT CONSTleerzeile:=75*" ";INT VARi,i1:=vonzeile,i2:=75;INT CONSTlaenge:=length(atext);WHILEi2<=laengeREPsubstringausgebenUNTILi1>biszeilePER;FORiFROMi1UPTObiszeileREPleerzeileausgebenPER.substringausgeben:textout(abspalte,i1,subtext(atext,i2-75+1,i2));i2INCR75;i1INCR1.leerzeileausgeben:cursor(abspalte,i);out(leerzeile).END PROCzeigeauskunft;FILE PROCauskunftindatei(INT CONSTauskunftsnr):IFexists(dateiname)THENforget(dateiname,quiet)FI;TEXT CONSTte:=auskunftstext(auskunftsnr);FILE VARdat:=sequentialfile(output,dateiname);INT VARbottom:=1,top:=1;TEXT VARzeile,auskunft:=te;INT VARl:=length(auskunft);formatierezeile;REPschreibe;formatierezeile;UNTILzeile=""PER;dat.formatierezeile:zeile:="";IFbottom>=lTHENzeile:=""ELSEtop:=min(bottom+editorfenster-1,l);zeile:=subtext(auskunft,bottom,top,eol,stop,FALSE);topINCR1;bottom:=topFI.schreibe:putline(dat,zeile).END PROCauskunftindatei;TEXT PROCsubtext(TEXT VARauskunft,INT CONSTbottom,INT VARtop,TEXT CONSTloe,TEXT CONSTstp,BOOL CONSTinfenster):LETb=" ";TEXT VARoberster;INT VARlastblank;INT VARi;TEXT +VARt,vergleich;konstruieret;t.konstruieret:FORiFROMbottomUPTOtopREPvergleich:=subtext(auskunft,i,i);IF vergleich=loeTHEN IF NOTinfensterTHENt:=subtext(auskunft,bottom,i-1);top:=i;LEAVEkonstruieretFI;replace(auskunft,i,b);lastblank:=iELIFvergleich=stpTHENt:=subtext(auskunft,bottom,i-1);IF NOTinfensterTHENt:=t+bFI;top:=i;LEAVEkonstruieretELIFvergleich=bTHENlastblank:=iFI;PER;oberster:=subtext(auskunft,top+1,top+1);IF(lastblank<>top)CAND((oberster<>b)CAND(oberster<>loe)CAND(oberster<>stp))THENtop:=lastblankFI;t:=subtext(auskunft,bottom,top).END PROCsubtext;PROCtextout(INT CONSTsp,z,TEXT CONSTausg):cursor(sp,z);out(ausg);END PROCtextout;TEXT PROCreturn:code(13).END PROCreturn;PROCzeigemeldung(TEXT CONSTmld,BOOL CONSTposmeldung,INT CONSTdialogsituation):TEXT VARt1:="";IFposmeldungTHENfill(allgmld,3,posmldzeile1,zeilenlaengemld,3);ELIFdialogsituation=simulationsmenuTHENfill(allgmld,3,negmldzeile1simuldialog,zeilenlaengemld,3);ELSEfill(allgmld,3,negmldzeile1mbankdialog,zeilenlaengemld,3);FI;pageup(allgmld);outframe(areax(allgmld),areay(allgmld),areaxsize(allgmld),areaysize(allgmld));t1:=invers(center(areaxsize(allgmld)-5,mld));out(allgmld,2,2,t1);.END PROCzeigemeldung;PROCzeigemeldung(TEXT CONSTmld,BOOL CONSTposmeldung):zeigemeldung(mld,posmeldung,simulationsmenu);END PROCzeigemeldung;PROCloescheaktuellemeldung(INT CONSTdialogsituation):IFdialogsituation=simulationsmenuTHENfill(allgmld,3,negmldzeile1simuldialog,zeilenlaengemld,3);ELSEfill(allgmld,3,negmldzeile1mbankdialog,zeilenlaengemld,3);FI;pageup(allgmld);END PROCloescheaktuellemeldung;PROCloescheaktuellemeldung:pageup(allgmld);END PROCloescheaktuellemeldung;END PACKETlsdialoghilfen; + + + + + + + diff --git a/app/schulis-simulationssystem/3.0/src/ls dp1 b/app/schulis-simulationssystem/3.0/src/ls dp1 new file mode 100644 index 0000000..6c82b94 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls dp1 @@ -0,0 +1,4 @@ +PACKETdiagrammpraesentation1DEFINESgibbildaus,transformierewirkungsdiagrammundstartesimulation,modellinfo:LETbitteumgeduld=576,prozedurdeklarationfuerdgl=616,realconst=602,parameter=604,dquotientdeklaration=605,replacefuerzustand=606,dquotientliefern=607,prozedurfussfuerdgl=617,prozedurdeklarationfueregl=618,prozedurfussfueregl=619,prozedurkopfzusatzdarst=620,prozedurfusszusatzdarst=621,evektor=611,replacefuerergebnis=612,evektorliefern=613,startwert=614,singularmodellgroesse=511,singularergebnis=512,singularparameter=513,singularformel=514,pluralformel=538,simulationneustarten=10,terminaltaskname="ARBEITSPLATZ";LETnull="0.0",maxlink=8,standardkanal=1;PROCgibbildaus:INT VARi,j,k,starti:=impos(gitterstart),endi:=starti+igittersize-1,startj:=jmpos(gitterstart),endj:=startj+jgittersize-1;initialisierezeichenflaeche;zeichnealleboxen;zeichnealleverbindungen.initialisierezeichenflaeche:page(area(standardfenster));bsspeicherinit.zeichnealleboxen:FORiFROMstartiUPTOendiREP FORjFROMstartjUPTOendjREP IFbelegt(actualcell)THENbox(i,j)FI PER PER.zeichnealleverbindungen:FORiFROMstartiUPTOendiREP FORjFROMstartjUPTOendjREP IFbelegt(actualcell)THENbearbeiteausgehendeundankommendelinien;FI PER PER.actualcell:cell(i,j).bearbeiteausgehendeundankommendelinien:FORkFROM1UPTOmaxlinkREP IFactualcellAUSGANGkTHENausgehendelinie;ELIFeineliniekommtanANDliniekommtvonaussenTHENvonaussenankommendelinieFI PER.ausgehendelinie:zeichneverbindung(mpos(actualcell),k,actualcellUEBERk,actualcellNRk).vonaussenankommendelinie:zeichneverbindung(actualcellUEBERk,actualcellNRk,mpos(actualcell),k).eineliniekommtan:actualcellEINGANGk.liniekommtvonaussen:NOTimgitter(actualcellUEBERk).END PROCgibbildaus;PROCmodellinfo(FILE VARf):allevariablen;alleergaenzungsvariablen;alleparameter;alleformeln.allevariablen:IFanzahlmpos(variablenthesaurus)=1THENputline(f,anwendungstext(singularmodellgroesse)+":");line(f);objekttexte(f,variablenthesaurus)ELIFanzahlmpos(variablenthesaurus)>1THENputline(f,anwendungstext(singularmodellgroesse)+"n:");line(f);objekttexte(f,variablenthesaurus)FI.alleergaenzungsvariablen:IFanzahlmpos(ergebnisthesaurus)=1THENputline(f,anwendungstext(singularergebnis)+":");line(f);objekttexte(f,ergebnisthesaurus);line(f)ELIFanzahlmpos(ergebnisthesaurus)>1THENputline(f,anwendungstext(singularergebnis)+"n:");line(f);objekttexte(f,ergebnisthesaurus);line(f)FI.alleparameter:IFanzahlmpos(parameterthesaurus)>0THENputline(f,anwendungstext(singularparameter)+":");line(f);objekttexte(f,parameterthesaurus);line(f)FI.alleformeln:IFanzahlmpos(formelthesaurus)=1THENputline(f,anwendungstext(singularformel)+":");line(f);objekttexte(f,formelthesaurus);line(f)ELIFanzahlmpos(formelthesaurus)>1THENputline(f,anwendungstext(pluralformel)+":");line(f);objekttexte(f,formelthesaurus);line(f)FI.END PROCmodellinfo;PROCobjekttexte(FILE VARf,THESAURUS CONSTt):INT VARi:=0;MPOS VARmp;WHILEisimulationneustarten.bereiteinformationstextvor:FILE VARinfofile:=sequentialfile(output,infodsp);putline(infofile,anwendungstext(btmodell)+aktuellermodellname);putline(infofile,length(anwendungstext(btmodell)+aktuellermodellname)*"=");line(infofile);modellinfo(infofile);.modellbearbeiten:IFretcode=simulationneustartenTHENpage;footnote(anwendungstext(btwartenallgemein));FI;bereiteinformationstextvor;retcode:=0;schickemodelldaten;IFokTHENschickemodellinfos;IFokTHENstartesimulationFI;FI;forget(infodsp);continue(standardkanal);.schickemodelldaten:transportdsp:=modellds;schickezumanager(transportdsp,2,retcode);forget(transportdsp);.schickemodellinfos:transportdsp:=infodsp;schickezumanager(transportdsp,7,retcode);forget(transportdsp);.startesimulation:transportdsp:=codeds;break(quiet);schickezumanager(transportdsp,9,retcode);forget(transportdsp);.END PROCversendemodellundstartesimulation;PROCschickezumanager(DATASPACE VARdatenraum,INT CONSTverarbeitung,INT VARmesscode):INT CONSTeingabevomkanal:=-4;TASK VARmanagertask:=/terminaltaskname,kontrolltask:=/terminaltaskname;enablestop;REPkernvonschickezumanagerPER.kernvonschickezumanager:managertask:=kontrolltask;send(managertask,verarbeitung,datenraum,messcode);forget(datenraum);REP IFmesscode=existiertnichtTHENleaveschickezumanager;ELIFmesscode=nichtempfangsbereitTHENleaveschickezumanager;ELSEwarteaufquittungFI PER.warteaufquittung:managertask:=/terminaltaskname;wait(datenraum,messcode,managertask);forget(datenraum);IFquerschlaegersendungTHEN IFcontinueversuchTHENleaveschickezumanager;ELSE IFmesscode=eingabevomkanalTHEN REP UNTILincharety=""PER;forget(datenraum);FI;FI ELSEleaveschickezumanager;FI.querschlaegersendung:NOT(managertask=kontrolltask).continueversuch:managertask=supervisorAND((task(messcodeMOD100)=niltask)OR(task(messcodeMOD100)=myself)).leaveschickezumanager:LEAVEschickezumanager;END PROCschickezumanager;PROCerzeugequelltext(DATASPACE VARds):ds:=nilspace;q:=sequentialfile(output,ds);erzeugedgl;erzeugeegl;erzeugepseudozusatzdarstellung;END PROCerzeugequelltext;PROCerzeugedgl:dimensiondesmodells:=anzahlvariablen;schreibeprozedurkopffuerdgl;schreibeprozedurrumpffuerdgl;schreibeprozedurfussfuerdgl;.schreibeprozedurkopffuerdgl:putline(q,anwendungstext(prozedurdeklarationfuerdgl)).schreibeprozedurrumpffuerdgl:deklariereundinitialisierestartwerte;deklariereundinitialisiereparameter;berechnedifferentialquotienten;listerefinementsfuerformeln.schreibeprozedurfussfuerdgl:putline(q,anwendungstext(prozedurfussfuerdgl)).berechnedifferentialquotienten:INT VARi:=0,j:=0;TEXT VARzeile:=anwendungstext(dquotientdeklaration)+text(dimensiondesmodells)+");";;putline(q,zeile);WHILEi0.END PROCdeklariereundinitialisierestartwerte;PROCdeklariereundinitialisiereparameter:INT VARi:=0,j:=0;TEXT VARzeile:=anwendungstext(realconst);WHILEi0.END PROCdeklariereundinitialisiereparameter;PROClisterefinementsfuerformeln:INT VARi:=0;WHILEi0THENreplace(summe,length(summe)," ");ELSEsumme:=nullFI;summeEND PROCsummedereinlaufendenpfeile;INT PROCanzahlvariablen:anzahlmpos(variablenthesaurus)END PROCanzahlvariablen;INT PROCanzahlergaenzungsvariablen:anzahlmpos(ergebnisthesaurus)END PROCanzahlergaenzungsvariablen;END PACKETdiagrammpraesentation1; + diff --git a/app/schulis-simulationssystem/3.0/src/ls kombination b/app/schulis-simulationssystem/3.0/src/ls kombination new file mode 100644 index 0000000..c2b8162 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls kombination @@ -0,0 +1,3 @@ +PACKETlskombinationDEFINESzeigekombiniertedarstellung:LETsendetaste="p",abbruchtaste="m",outputkombination=" kombination",blaettern="b",blaetternoben="o",blaetternunten="u",mitzeitdiagramm=1,mitphasen=2,mittabelle=3,mithistogramm=4;LETdruckdateitab=" tabelle.p",erzeugtetabelle=" tabelle",steuerlgraphiktabelle=24,steuerlgraphikgraphik=25,steuerleistetabelle=28,steuerleistewarten=31,scrollsp1=16,scrollzeile1=3,scrollbreitetab=15;TEXT CONSTscrollausstiegohnedrucken:="m"+sendetaste;LETstrukt2diagramme1text=3,strukttabelleunten=5,strukttabelleoben=6,fensterdummy=0,fensteroben=2,fensterunten=3,fensterlinksoben=4,fensterlinksunten=5,fensterrechtsoben=6,fensterrechtsunten=7,fensterrechts=8;TEXT CONSTsendenundblaettern:=sendetaste+blaettern,sendenblaetternobenundunten:=sendetaste+blaetternoben+blaetternunten;INT VARsteuerzeilenschluessel,kopfzeilenschluessel;PROCzeigekombiniertedarstellung(TEXT VARtaste,LOESUNG VARloesung,INT CONSTdarstellung1,INT CONSTdarstellung2,ZUSTAND VARmuster1,muster2):OUTPUT VARbskombination;KURVE VARhilfskurve:=LOESUNGSABSCHNITTloesung;TEXT VARtastenraus:=abbruchtaste;IFdarstellung1=mittabelleTHENzeigekombinationtabelle(taste,loesung,darstellung2,muster1,muster2);ELSEzeigeanderedarstellungenFI;.zeigeanderedarstellungen:IFdarstellung2=mitzeitdiagrammCORdarstellung2=mithistogrammTHENkombinieremitzeitdiagrammoderhistogrammELIF(codimension+dimension>=2)CANDmitphasendiagrammCAND(darstellung2=mitphasen)THENkombinieremitphasendiagrammELIFdarstellung2=mittabelleTHENkombinieremittabelleFI.leavezeigekombiniertedarstellung:forget(outputkombination,quiet);LEAVEzeigekombiniertedarstellung.kombinieremitphasendiagramm:bskombination:=niloutput(strukt2diagramme1text,outputkombination);replace(bskombination,fensterrechts,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphikgraphik;SELECTdarstellung1OF CASE1:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinephase)CASE2:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinephase,PROCcoroutinephase)CASE4:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinephase)ENDSELECT.kombinieremittabelle:FILE VARtabaktuell:=tabelle(hilfskurve,muster2,TRUE);bskombination:=niloutput(strukttabelleunten,outputkombination);replace(bskombination,fensterunten,tabaktuell);replace(bskombination,fensterrechtsoben,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphiktabelle;SELECTdarstellung1OF CASE1:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,neuerzustand(dimension+codimension),fensterlinksoben,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinedummy)CASE2:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,neuerzustand(dimension+codimension),fensterlinksoben,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinephase,PROCcoroutinedummy)CASE4:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,neuerzustand(dimension+codimension),fensterlinksoben,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinedummy)ENDSELECT.kombinieremitzeitdiagrammoderhistogramm:bskombination:=niloutput(strukt2diagramme1text,outputkombination);replace(bskombination,fensterrechts,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphikgraphik;IFdarstellung2=mitzeitdiagrammTHEN SELECTdarstellung1 +OF CASE1:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinezeit)CASE2:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinephase,PROCcoroutinezeit)CASE4:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinezeit)ENDSELECT;ELSE SELECTdarstellung1OF CASE1:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinehisto)CASE2:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinephase,PROCcoroutinehisto)CASE4:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinehisto)ENDSELECT;FI.END PROCzeigekombiniertedarstellung;PROCzeigekombinationtabelle(TEXT VARtaste,LOESUNG VARloesung,INT CONSTdarstellung2,ZUSTAND VARmuster1,muster2):OUTPUT VARbskombination;KURVE VARhilfskurve:=LOESUNGSABSCHNITTloesung;TEXT CONSTtastenraus:=abbruchtaste;IFdarstellung2=mitzeitdiagrammCORdarstellung2=mithistogrammTHENkombinieremitdiagrammELIF(codimension+dimension>=2)CANDmitphasendiagrammCANDdarstellung2=mitphasenTHENkombinieremitphasendiagrammELIFdarstellung2=mittabelleTHENkombinieremittabelleFI.kombinieremitphasendiagramm:bskombination:=niloutput(strukttabelleoben,outputkombination);replace(bskombination,fensteroben,tabelle(hilfskurve,muster1,TRUE));replace(bskombination,fensterrechtsunten,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphiktabelle;steuerprozessfuereineloesung(bskombination,hilfskurve,muster2,neuerzustand(dimension+codimension),fensterlinksunten,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinephase,PROCcoroutinedummy).kombinieremittabelle:FILE VARtbl:=tabelle(hilfskurve,muster1,TRUE);WINDOW VARtabwindow:=grossesrahmenfenster;INT VARerstersatz1:=3,erstespalte1:=scrollsp1;forget(druckdateitab,quiet);rename(erzeugtetabelle,druckdateitab);outframe(tabwindow);footnote(steuerleiste(steuerleistetabelle));scroll(tabwindow,druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,scrollausstiegohnedrucken,taste);erase(tabwindow);.kombinieremitdiagramm:bskombination:=niloutput(strukttabelleoben,outputkombination);replace(bskombination,fensteroben,tabelle(hilfskurve,muster1,TRUE));replace(bskombination,fensterrechtsunten,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphiktabelle;IFdarstellung2=mitzeitdiagrammTHENsteuerprozessfuereineloesung(bskombination,hilfskurve,muster2,neuerzustand(dimension+codimension),fensterlinksunten,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinedummy)ELSEsteuerprozessfuereineloesung(bskombination,hilfskurve,muster2,neuerzustand(dimension+codimension),fensterlinksunten,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinedummy)FI.END PROCzeigekombinationtabelle;END PACKETlskombination; + diff --git a/app/schulis-simulationssystem/3.0/src/ls simsel.masken b/app/schulis-simulationssystem/3.0/src/ls simsel.masken new file mode 100644 index 0000000..e343284 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls simsel.masken @@ -0,0 +1,4 @@ +PACKETsimselmaskenDEFINES TAG,:=,nil,tagsankoppeln,formular,show,put,get,putget,leavingcode,fieldexists,cursor,fieldinfos,setfieldinfos:LETbeginmark="",endmark="",chop=1,chome=1,cvor=2,cfeldende=18,crueck=8,cfeldanf=20,choch=3,cfeldrueck=19,crunter=10,ctab=9,csettab=21,ceinf=11,caufbrech=22,causf=12,clearn=26,cfeldvor=13,cloeschende=24,cmark=16,cneu=17,cesc=27,cseiterueck=15,cseitevor=14;LETright="�",left="�",home="�";LETsimseltask="ls-MENUKARTEN",error=1110,sendetags=1120;INITFLAG VARinthistask:=FALSE;TEXT VARabc:="";INT VARi;FORiFROM33UPTO126REPabcCATcode(i);PER;FORiFROM214UPTO222REPabcCATcode(i);PER;abcCATcode(251);LEThoptasten="?aouAOUBb§(!)-k'= #",hopcodes="�äöüÄÖÜßßß[\]{|}­k^~ \#";LETtaglines=24,maxfields=100;BOOL VARbeimletztenrausfallen:=FALSE;BOOL VARclosedbit,protectbit,darstbit,tabbit,leftbit,exitbit,rollbit,normal:=TRUE;INT VARworkint;PROCxoutsubtext(TEXT CONSTwas,INT CONSTvon,bis):out(subtext(was,von,bis))END PROCxoutsubtext;TYPE TAG=STRUCT(TEXTerstel,darst,diainfo,dbnam,ausknam,feld,x,y,len,tab,ROWtaglinesTEXTformblatt,INTxmax,ymax,xs,ys,dbp,ver,durchs,art);OP:=(TAG VARa,TAG CONSTb):CONCR(a):=CONCR(b)END OP:=;PROCnil(TAG VARt):t.formblatt:=ROWtaglinesTEXT:("","","","","","","","","","","","","","","","","","","","","","","","");t.xmax:=0;t.ymax:=0;t.xs:=1;t.ys:=1;t.dbp:=0;t.ver:=1;t.durchs:=0;t.art:=0;t.darst:="";t.erstel:="";t.diainfo:="";t.dbnam:="";t.ausknam:="";t.feld:="";t.x:="";t.y:="";t.tab:="";t.len:="";END PROCnil;BOOL PROCfieldexists(TAG CONSTa,INT CONSTfeldnr):(a.erstelVSUBfeldnr)>0END PROCfieldexists;PROCsetinfo(TEXT CONSTstring,INT CONSTpos):workint:=stringVSUBpos;IFworkint>0THENsetallvaluesELSEnormal:=TRUE FI.setallvalues:closedbit:=hbit;protectbit:=hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit;normal:=FALSE.hbit:workint:=workint*2;IFworkint>255THENworkintDECR256;TRUE ELSE FALSE FI.END PROCsetinfo;PROCfieldinfos(TAG CONSTt,INT CONSTfeld,INT VARgeheimcode,BOOL VARclosed,protected,secret,special,left):geheimcode:=code(t.darstSUBfeld);setinfo(t.diainfo,feld);IFnormalTHENclosed:=FALSE;protected:=FALSE;secret:=FALSE;special:=FALSE;left:=FALSE;ELSEclosed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit;left:=leftbit;FI END PROCfieldinfos;PROCsetfieldinfos(TAG VARt,INT CONSTfeld,BOOL CONSTclosed,protected,secret):INT VARcd:=(t.diainfoVSUBfeld)MOD32;IFsecretTHENcdINCR32FI;IFprotectedTHENcdINCR64FI;IFclosedTHENcdINCR128FI;replaceiac(t.diainfo,feld,code(cd))END PROCsetfieldinfos;INT VARafeld,ax,ay,al,ael,tlen,tout;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld):eput(ff,t,elfeld,1)END PROCeput;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld,INT CONSTabwo):zumerstenelementarfeld;WHILEnochgenugtextdaREPfuelleelementarfeld;elementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputFI;zumelementarfeld;PER;gibrestaus;REPelementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputFI;zumelementarfeld;gibhintergrundausPER.zumerstenelementarfeld:tlen:=LENGTHt;tout:=abwo-1;afeld:=ff.feldVSUBelfeld;ael:=elfeld;positionieren(ff).fuelleelementarfeld:xoutsubtext(t,tout+1,tout+al);toutINCRal.nochgenugtextda:tout+alafeld.gibrestaus:xoutsubtext(t,tout+1,tlen);IFtout+al>tlenTHENxoutsubtext(grund,ax+tlen-tout,ax+al-1)FI.gibhintergrundaus:xoutsubtext(grund,ax,ax+al-1).grund:ff.formblatt(ay).END PROCeput;PROCpositionieren(TAG CONSTff):al:=ff.lenVSUBael;ax:=ff.xVSUBael;ay:=ff.yVSUBael;cursor(ax,ay).END PROCpositionieren;PROCcursor(TAG CONSTff,INT CONSTfeld):ael:=ff.erstelVSUBfeld;positionieren(ff)END PROCcursor;INT PROClength(TAG CONSTff,INT CONSTfeld):zumerstenelementarfeld;IFael<1THEN LEAVElengthWITH0FI;INT VARlen:=0;REPlenINCRfeldlaenge;zumnaechstenelementarfeld;UNTILgehoertzumnaechstenfeldPER;len.zumerstenelementarfeld:ael:=ff.erstelVSUBfeld.zumnaechstenelementarfeld:aelINCR1.gehoertzumnaechstenfeld:(ff.feldVSUBael)<>feld.feldlaenge:ff.lenVSUBael +.END PROClength;PROCshow(TAG CONSTff):INT VARi;out(home);out(ff.formblatt(1));FORiFROM2UPTOff.ymaxREPline;out(ff.formblatt(i))PER.END PROCshow;INT VARcharcode:=0,lastx,lasty;PROCtranslatecode:charcode:=code(char);SELECTcharcodeOF CASEchop:charcode:=chomeCASEcvor:charcode:=cfeldendeCASEcrueck:charcode:=cfeldanfCASEchoch:charcode:=cseiterueckCASEcrunter:charcode:=cseitevorCASEctab:charcode:=csettabCASEceinf:charcode:=caufbrechCASEcausf:charcode:=cloeschendeCASEcfeldvor:charcode:=cfeldrueckCASEcmark:charcode:=cneuCASEcesc:charcode:=clearnOTHERWISEcharcode:=pos(hoptasten,char);IFcharcode=0THEN IFischarTHEN FI ELSEchar:=hopcodesSUBcharcode;charcode:=code(char)FI END SELECT END PROCtranslatecode;TEXT VARchar;BOOL PROCischar:inchar(char);charcode:=code(char);IFcharcode>31THEN TRUE ELIFcharcode=chopTHENinchar(char);translatecode;charcode>31ELSE FALSE FI END PROCischar;INT VARaktbegin,aktfeld,aktline,aktlen,aktanf,aktel,wo;PROCsetfieldvalues(TAG CONSTta):aktlen:=ta.lenVSUBaktel;aktanf:=ta.xVSUBaktel;aktline:=ta.yVSUBaktelEND PROCsetfieldvalues;INT VARnextfeld,nextel,nextwo,nextbegin;PROCsetlasteditvalues:preset:=TRUE END PROCsetlasteditvalues;PROCsetneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin;aktel:=nextel;wo:=nextwo;preset:=TRUE END PROCsetneweditvalues;BOOL VARpreset:=FALSE;PROCsearchfield(TAG CONSTt,INT CONSTx,y,BOOL VARerfolg):erfolg:=FALSE;nextel:=0;REPsucheelementinrichtigerzeileUNTILkeinsmehrdaCORxposstimmtPER;IFerfolgTHENnextfeld:=t.feldVSUBnextel;nextbegin:=1;INT VARi:=t.erstelVSUBnextfeld;WHILEix;erfolg.anfang:t.xVSUBnextel.ende:(t.xVSUBnextel)+(t.lenVSUBnextel).END PROCsearchfield;PROCput(TAG CONSTff,TEXT CONSTv,INT CONSTfeld):setinfo(ff.diainfo,feld);INT VARerstelem:=ff.erstelVSUBfeld;IFerstelem>0THEN IFnormalCOR NOTdarstbitTHENeput(ff,v,erstelem)ELSEeput(ff,LENGTHv*(ff.darstSUBfeld),erstelem)FI FI END PROCput;INT PROCleavingcode:charcodeEND PROCleavingcode;PROCputget(TAG CONSTff,ROWmaxfieldsTEXT VARv,INT VAReinstieg,TEXT VARtaste):put(ff,v);get(ff,v,einstieg,taste)END PROCputget;PROCput(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues):INT VARiFORiFROM1UPTO LENGTHff.erstelREP IFfieldexists(ff,i)THENput(ff,fieldvalues(i),i)FI PER END PROCput;PROCget(TAG CONSTff,TEXT VAReingabe,INT CONSTfeld,TEXT VARexittaste):setinfo(ff.diainfo,feld);editieren.editieren:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(eingabe,length(eingabe),length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);out(endmark);cursor(lastx,lasty);put(ff,eingabe,feld);IFlength(exittaste)>1THENexittaste:=subtext(exittaste,2,2);FI.END PROCget;PROCputget(TAG CONSTff,TEXT VAReingabe,INT CONSTfeld,TEXT VARtaste):get(ff,eingabe,feld,taste)END PROCputget;PROCget(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues,INT VARfeld,TEXT VARtaste):TEXT VARexittaste:="";INT VARaltesfeld;IF NOTfieldexists(ff,feld)THENerrorstop("startfeld nicht im tag")ELSE REPEATaltesfeld:=feld;setinfo(ff.diainfo,feld);IF NOTgeschuetztTHENeingabefeldELSEgeschuetztesfeldFI;charcode:=code(subtext(exittaste,1,1));IFcharcode=ctabTHENcharcode:=cfeldrueckELIFcharcode=cescTHEN IFsubtext(exittaste,2,2)=leftTHENcharcode:=cfeldrueckELIFsubtext(exittaste,2,2)=rightTHENcharcode:=cfeldvorFI;FI;executecommandcode(ff,feld);IFfeld=1THENfeld:=2FI;UNTILcharcode=cescPER;FI;.geschuetzt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);protect.ankreuzen:cl.geschuetztesfeld:cursor(ff,feld);getcursor(lastx,lasty);REPinchar(exittaste)UNTILexittaste="�"PER;inchar(taste);.eingabefeld:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(fieldvalues(feld),length(fieldvalues(feld)),length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);out(endmark);IFankreuzenTHENankreuzfeldbehandlung; +FI;cursor(lastx,lasty);put(ff,fieldvalues(feld),feld);IFlength(exittaste)>1THENtaste:=subtext(exittaste,2,2);FI;.ankreuzfeldbehandlung:IFlength(fieldvalues(feld))>0THENfieldvalues(feld):=subtext(fieldvalues(feld),1,1)ELSEfieldvalues(feld):="_"FI;IFpos("_ ",fieldvalues(feld))>0THENfieldvalues(feld):="_"ELSEfieldvalues(feld):="X"FI;.END PROCget;PROCexecutecommandcode(TAG CONSTff,INT VARfeld):SELECTcharcodeOF CASEcfeldrueck:topriorfieldCASEcfeldvor:tonextfieldCASEchoch:goupifpossibleCASEcrunter:godownifpossibleCASEchome:tohomefieldCASEctab:setlasteditvaluesEND SELECT.topriorfield:REPEATfeld:=priorfield(ff,feld)UNTILwarerstesCORnichtgesperrtPER;IFwarerstesTHENtohomefieldFI.tonextfield:INT VARoldfeld:=feld;REPfeld:=nextfield(ff,feld)UNTILwarletztesCORnichtgesperrtPER;IFwarletztesTHENfeld:=oldfeld;IFbeimletztenrausfallenTHENcharcode:=cesc;beimletztenrausfallen:=FALSE FI FI.tohomefield:feld:=firstfield(ff);WHILEgesperrtREPfeld:=nextfield(ff,feld)PER.goupifpossible:BOOL VARerfolg;searchfield(ff,lastx,lasty-1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldELSEsetlasteditvaluesFI.godownifpossible:searchfield(ff,lastx,lasty+1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldELSEsetlasteditvaluesFI.nichtgesperrt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);NOTprotect.nextnichtgesperrt:fieldinfos(ff,nextfeld,geheim,cl,protect,s,sp,l);NOTprotect.gesperrt:NOTnichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROCexecutecommandcode;INT PROCfirstfield(TAG CONSTt):t.feldVSUB1END PROCfirstfield;INT PROCnextfield(TAG CONSTt,INT CONSTfeld):INT VARel:=(t.erstelVSUBfeld)+1;WHILE(t.feldVSUBel)=feldREPelINCR1PER;t.feldVSUBelEND PROCnextfield;INT PROCpriorfield(TAG CONSTt,INT CONSTfeld):t.feldVSUB((t.erstelVSUBfeld)-1)END PROCpriorfield;LETmaxtags=20,dsname="simsel formulare";BOUND ROWmaxtagsTAG VARsimselformulare;PROCtagsankoppeln:IF NOTinitialized(inthistask)THEN IF NOTexists(dsname)THEN IF NOTexists(dsname,/simseltask)THENerrorstop("TAGs fehlen!")ELSEfetch(dsname,/simseltask);kopplean;FI;ELSEkopplean;FI;FI;.kopplean:DATASPACE VARtagds:=old(dsname);simselformulare:=tagds;forget(dsname,quiet);.END PROCtagsankoppeln;TAG PROCformular(INT CONSTi):IFi>maxtagsTHENerrorstop("So viele TAGs gibt es nicht: "+text(i))FI;simselformulare(i)END PROCformular;END PACKETsimselmasken; + diff --git a/app/schulis-simulationssystem/3.0/src/ls simselstarter b/app/schulis-simulationssystem/3.0/src/ls simselstarter new file mode 100644 index 0000000..9a56405 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls simselstarter @@ -0,0 +1,11 @@ +PACKETlssimselDEFINESmodellnamenderbank,startoperationen,initbankmenu,initmodellmenu,deactivatemodellfkt,bankenauflisten,initialisierebank,ladebanken,sicherebanken,loeschebanken,modelleauflisten,bankzumarbeitenwaehlen,modellwaehlen,modellbearbeiten,modellerzeugen,modellveraendern,wirkungsdiagrammerzeugen,modellkopieren,modellloeschen,modellinformationen:LETstandardkanal=1;WINDOW VARfsingle:=grossesrahmenfenster;WINDOW VARfshow:=scrollfenster;LETsinglesp1=1,zl1=4,singlebr=78,hoe=19,scrollzeile=3;LETmodellbanktyp=1199,typnrwdausfuehrbar=1207,letztemenuwindowzeile=19,erstezeile=3,erstespalte=1,scrollbreite=0,ls=TRUE,negativemld=FALSE,modellbankdialog=2,ok=0,simulationneustarten=10,floppyname="simselmodelle",return=" ",abbruch="m",showverlasszeichen="m",nichtdefiniert="",stleistefileverlassen=28,fktbankinitial=1,fktbankladen=2,fktbanksichern=3,fktbankloeschen=4,fktbankinhaltzeigen=7,fktbankwaehlen=1,fktmodellbearbeiten=3,fktmodellerfassen=4,fktwirkdgerfassen=5,fktmodellaendern=6,fktmodellkopieren=7,fktmodellloeschen=8,fktmodelleauflisten=10,fktmodellinfos=12;LETbtueberschriftloeschen=1,btbanknameneingeben=2,btbankengeloescht=4,btkeinebankzumarbeiten=6,btkeinebankenenthalten=7,btkeingueltigerbankname=8,btbankeingerichtet=9,btkeinebankgeloescht=10,btkeinebankgewaehlt=11,btkeinmodellinbank=12,btbankgewaehlt=13,btbittemodellbankdiskette=14,btwartenformatieren=16,btbittedisketteeinlegen=18,btaufdiskueberschreiben=19,btbankenschreiben=20,btdiskettevoll=21,btbankgesichert=22,btsicherungabgebrochen=23,btwartenbeisichern=24,btintaskueberschreiben=25,btnichtueberschriebenladen=26,btwartenbeipruefen=27,btarchivnichtfrei=28,btkannnichtgesichert=29,btbankenladen=30,btwartenbeiladen=31,btmodellveraendertabgelegt=32,btkannnichtgeladen=33,btladenfehlerhaft=34,btbankgeladen=35,btkeinmodellgewaehlt=36,btkeinmodellgeloescht=37,btmodellgeloescht=38,btmodellnichtabgelegt=39,btmodellabgelegt=40,btsimulationbeendet=41,btmodellunveraendertabgelegt=42,btfragemodellloeschen=43,btwartenallgemein=44,btmodellnichtablauffaehig1=45,btmodellnichtablauffaehig2=46,btmodellnichtablauffaehig3=47,btmodellnichtablauffaehig4=48,btmodellnichtablauffaehig5=49,btmodellablauffaehig=105,btmodell=106,btmodellverzeichnis=50,btfrageloeschen=51,btbankexistiert=52,btdateiexistiert=104,btbanknamezulang=53,btmodellbankenverzeichnis=54,btnichtueberschriebensichern=55,btbanknichtgeladen=56,btueberschriftsicherungsaltn=58,btsicherungsalternativen=59,btsimulationunmoeglich=63,bteinrichtenabgebrochen=66,btbitte1bankwaehlen=67,btbittemodellwaehlen=68,btdisketteeinlundweiter=71,btverzeichnisaufarchiv=72,btbittegewuenschtebanken=73,btladevorgangabgebrochen=74,btformatwahlueberschrift=75,btformatwahlbeschreibung=76,btformatwahlbuchstaben=77,btkeinformatgewaehlt=78,btbankevtgeloescht1=79,btbankevtgeloescht2=80,btbankenimsystemwaehlen=81,btbankenankreuzensichern=82,btbankenankreuzenloeschen=83,btbankloeschenabgebrochen=84,btmodellbankvolldgl=85,btmodellbankvollwd=86,maxmodelle=40,maxdglmodelle=20,maxwdmodelle=20,maxnamenlaengeselbsterfasstebank=40,maxmusslaengebankname=50;LETcleararchiv=1,allarchiv=2,schreiben=3,loeschen=4,ladenhauptds=5,laden=6,formatarchiv=7;LETmenuformatieren=2,menuclear=3,menusichern=1,menusichernabbrechen=5;LETmodellcodeds=" code info ds",originalkurve=" originalkurve ds",vergleichskurve=" vergleichskurve ds";INT CONSTexistiertnicht:=-1,nichtempfangsbereit:=-2;INT VARi,anzahldermodelle:=0,anzahlbankenintask:=0;THESAURUS VARbankenintask;WINDOW VARaktuelleswindow;BOOL VARsubmenuvorprozedurausfuehren:=FALSE,submenuaufgeklappt:=FALSE;TEXT VARletztebank:="";PROCstartoperationen:texteankoppeln;tagsankoppeln;letztebank:="";submenuaufgeklappt:=FALSE;submenuvorprozedurausfuehren:=TRUE;initmodellmenu;submenuaufgeklappt:=TRUE;submenuvorprozedurausfuehren:=FALSE;END PROCstartoperationen;PROCinitmodellmenu:IFsubmenuvorprozedurausfuehrenTHENloescheaktuellemeldung;taskstatusbzgbanken;letztebank:="";activatemodellfkt;FI;IF NOTbankintaskANDsubmenuaufgeklapptTHENzeigemeldung( +anwendungstext(btkeinebankzumarbeiten),negativemld,modellbankdialog)FI;submenuvorprozedurausfuehren:=TRUE END PROCinitmodellmenu;PROCinitbankmenu:loescheaktuellemeldung;activatebankfktEND PROCinitbankmenu;PROCactivatemodellfkt:INT VARveraenderbare,ablauffaehige;IFbankintaskTHENactivate(fktbankwaehlen);ELSEdeactivate(fktbankwaehlen);FI;IFletztebank=""THENdeactivatemodellfkt;ELSEactivaterestlichefkt;FI;.activaterestlichefkt:listedermodelle(veraenderbare,ablauffaehige);activate(fktmodelleauflisten);IFmodellbankvolldglTHENdeactivate(fktmodellerfassen)ELSEactivate(fktmodellerfassen);FI;IFmodellbankvollwdTHENdeactivate(fktwirkdgerfassen);ELSEactivate(fktwirkdgerfassen);FI;IFanzahldglmodelle+anzahlwdmodelle>=1THENactivate(fktmodellinfos);ELSEdeactivate(fktmodellinfos);FI;IFablauffaehige>=1THENactivate(fktmodellbearbeiten);ELSEdeactivate(fktmodellbearbeiten);FI;IFveraenderbare>=1THENactivate(fktmodellaendern);activate(fktmodellloeschen);ELSEdeactivate(fktmodellaendern);deactivate(fktmodellloeschen);FI;IFveraenderbare>=1CAND(NOTmodellbankvoll)THENactivate(fktmodellkopieren);ELSEdeactivate(fktmodellkopieren);FI;END PROCactivatemodellfkt;PROCdeactivatemodellfkt:deactivate(fktmodellbearbeiten);deactivate(fktmodellerfassen);deactivate(fktwirkdgerfassen);deactivate(fktmodellaendern);deactivate(fktmodellkopieren);deactivate(fktmodellloeschen);deactivate(fktmodelleauflisten);deactivate(fktmodellinfos);deactivate(fktmodellloeschen);END PROCdeactivatemodellfkt;PROCactivatebankfkt:IFbankintaskTHENactivate(fktbanksichern);activate(fktbankloeschen);activate(fktbankinhaltzeigen);ELSEdeactivate(fktbanksichern);deactivate(fktbankloeschen);deactivate(fktbankinhaltzeigen);FI;activate(fktbankinitial);activate(fktbankladen);END PROCactivatebankfkt;PROCinitialisierebank:TEXT VARbankname:="";BOOL VARnameok:=FALSE;loescheaktuellemeldung;liesneuennamenein;kontrolliereneuennamen;richteggfbankein;.liesneuennamenein:bankname:=menuanswer(anwendungstext(btbanknameneingeben)+((10+maxnamenlaengeselbsterfasstebank-length(anwendungstext(btbanknameneingeben)))*" "),"",5);.kontrolliereneuennamen:IFlsexitkey=abbruchTHENzeigemeldung(anwendungstext(bteinrichtenabgebrochen),negativemld,modellbankdialog);LEAVEinitialisierebankELIFcompress(bankname)=""THENzeigemeldung(anwendungstext(btkeingueltigerbankname),negativemld,modellbankdialog);LEAVEinitialisierebankELIFlength(bankname)>maxnamenlaengeselbsterfasstebankTHENzeigemeldung(anwendungstext(btbanknamezulang),negativemld,modellbankdialog)ELSE IFexists(bankname)THEN IFtype(old(bankname))=modellbanktypTHENzeigemeldung(anwendungstext(btbankexistiert),negativemld,modellbankdialog)ELSEzeigemeldung(anwendungstext(btdateiexistiert),negativemld,modellbankdialog)FI ELSEnameok:=TRUE;FI;FI;.richteggfbankein:IFnameokTHENletztebank:=bankname;neuebank(letztebank);zeigemeldung(anwendungstext(btbankeingerichtet),NOTnegativemld,modellbankdialog);taskstatusbzgbanken;activatebankfktFI.END PROCinitialisierebank;PROCladebanken:THESAURUS VARausgewaehlte,archivliste,inhaltderbank;TEXT VARfehlertext:="",bankname;BOOL VARerfolgreich:=FALSE,ladenok;INT VARbanknr,modellnr,currentx,currenty;loescheaktuellemeldung;erstellelistederbankenaufarchiv;modellbankenwaehlen(ausgewaehlte,anwendungstext(btverzeichnisaufarchiv),anwendungstext(btbittegewuenschtebanken),TRUE);IFnotempty(ausgewaehlte)THENladediegewaehltenELSEzeigemeldung(anwendungstext(btladevorgangabgebrochen),negativemld,modellbankdialog);oldfootnote;refreshsubmenu;FI;.erstellelistederbankenaufarchiv:menuinfo(anwendungstext(btdisketteeinlundweiter),5);archivanmelden(fehlertext);IFarchivnichtfreiTHENzeigemeldung(fehlertext,negativemld,modellbankdialog);refreshsubmenu;leaveladebanken;ELSEfootnote(anwendungstext(btwartenbeipruefen));archivoperation(allarchiv,"",archivliste,erfolgreich);IF NOTerfolgreichTHENzeigemeldung(anwendungstext(btbittemodellbankdiskette),negativemld,modellbankdialog);refreshsubmenu;leaveladebanken;ELSEsortierebankenausarchivlisteheraus;FI;FI;.sortierebankenausarchivlisteheraus: +banknr:=0;ausgewaehlte:=emptythesaurus;get(archivliste,bankname,banknr);WHILEbankname<>""REP IFlength(bankname)<=maxmusslaengebanknameCANDdskeinmodelldatenraum(bankname)THENinsert(ausgewaehlte,bankname);FI;get(archivliste,bankname,banknr)PER.bildschirmleeren:showmenuwindow.ladediegewaehlten:bildschirmleeren;bildeschnittmengetaskarchiv;IFbankendoppeltTHENfragewelcheueberschreibenFI;ladelistebearbeiten.bildeschnittmengetaskarchiv:THESAURUS VARschnittmenge:=bankenintask;schnittmenge:=schnittmenge/ausgewaehlte;.bankendoppelt:notempty(schnittmenge).fragewelcheueberschreiben:menuwindowcursor(2,2);menuwindowout(anwendungstext(btintaskueberschreiben));menuwindowline(2);banknr:=0;get(schnittmenge,bankname,banknr);WHILEbankname<>""REP IFmenuwindowno(" "+code(34)+bankname+code(34)+" ")THENausgewaehlte:=ausgewaehlte-bankname;FI;get(schnittmenge,bankname,banknr);PER;menuwindowline(2);IFkeinezuueberschreibendeTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btnichtueberschriebenladen),negativemld,modellbankdialog);LEAVEladebanken;ELSEmenuwindowpage;FI;.keinezuueberschreibende:NOTnotempty(ausgewaehlte).archivnichtfrei:fehlertext<>"".ladelistebearbeiten:ueberschriftfuergeladenebanken;archivanmelden(fehlertext);IFarchivnichtfreiTHENloescheaktuellesfenster;zeigemeldung(fehlertext,negativemld,modellbankdialog);LEAVEladebanken;ELSEladenok:=TRUE;banknr:=0;get(ausgewaehlte,bankname,banknr);WHILEbankenzuladenCANDladenokREPladenaechstebank;get(ausgewaehlte,bankname,banknr);PER;ladenauswerten;FI;.bankenzuladen:banknr>0.ladenaechstebank:menuwindowout("--> "+bankname);getmenuwindowcursor(currentx,currenty);archivoperation(ladenhauptds,bankname,erfolgreich);IFerfolgreichTHEN IFtype(old(bankname))=modellbanktypTHENstelledatenraeumederbankzusammen;archivoperation(laden,"",inhaltderbank,erfolgreich);IFerfolgreichTHENmeldungeinebankgeladenFI;ELSEforget(bankname,quiet);meldungbanknichtgeladen;FI;FI;ladenok:=erfolgreich;.stelledatenraeumederbankzusammen:kopplean(bankname);inhaltderbank:=emptythesaurus;FORmodellnrFROM1UPTOanzahldglmodelleREPkopplean(modellnr);IFarchivlisteCONTAINSmodelldatenraumTHENinsert(inhaltderbank,modelldatenraum);FI;IFarchivlisteCONTAINSvorgabekurveTHENinsert(inhaltderbank,vorgabekurve);FI;IFarchivlisteCONTAINSvorgabevergleichskurveTHENinsert(inhaltderbank,vorgabevergleichskurve);FI;PER;inhaltderbank:=inhaltderbank+wddsnamen.ladenauswerten:IFladenokTHENloeschewartehinweis;menuwindowcursor(1,currenty);clearbuffer;taskstatusbzgbanken;menuwindowstop;activatebankfkt;loescheaktuellesfenster;ELSEloeschewartehinweis;menuwindowcursor(1,currenty);menuwindowout(" ");currentx:=7;currentyINCR1;menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btkannnichtgeladen));clearbuffer;menuwindowstop;loescheaktuellesfenster;zeigemeldung(anwendungstext(btladenfehlerhaft),negativemld,modellbankdialog);FI;LEAVEladebanken;.ueberschriftfuergeladenebanken:menuwindowcursor(1,1);menuwindowout(menuwindowcenter(anwendungstext(btbankenladen)));menuwindowcursor(1,letztemenuwindowzeile);menuwindowout(anwendungstext(btwartenbeiladen));menuwindowcursor(1,3);.meldungeinebankgeladen:menuwindowcursor(1,currenty);menuwindowout(" ");menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btbankgeladen));menuwindowline;.meldungbanknichtgeladen:menuwindowcursor(1,currenty);menuwindowout(" ");currentx:=7;currentyINCR1;menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btbanknichtgeladen));menuwindowline;.loeschewartehinweis:menuwindowcursor(1,letztemenuwindowzeile);menuwindowout(71*" ");.leaveladebanken:oldfootnote;LEAVEladebanken;.END PROCladebanken;PROCloeschebanken:BOOL VARmindestenseinegeloescht:=FALSE;INT VARz;THESAURUS VARauswahlbanken:=bankenintask;loescheaktuellemeldung;modellbankenwaehlen(auswahlbanken,anwendungstext(btbankenimsystemwaehlen),anwendungstext(btbankenankreuzenloeschen),TRUE);IFnotempty(auswahlbanken)THENloeschegewaehltebanken;ELSEzeigemeldung(anwendungstext(btbankloeschenabgebrochen),negativemld, +modellbankdialog);refreshsubmenu;FI;oldfootnote;.loeschegewaehltebanken:showmenuwindow;menuwindowout(menuwindowcenter(invers(anwendungstext(btueberschriftloeschen))));menuwindowline(2);loeschederreihenach;zeigeabschlusskommentar;.loeschederreihenach:FORzFROM1UPTOhighestentry(auswahlbanken)REP IFname(auswahlbanken,z)<>""ANDexists(name(auswahlbanken,z))ANDmenuwindowyes(" "+code(34)+name(auswahlbanken,z)+code(34)+" "+anwendungstext(btfrageloeschen))THENmindestenseinegeloescht:=TRUE;loesche(name(auswahlbanken,z));FI;PER.zeigeabschlusskommentar:loescheaktuellesfenster;IFmindestenseinegeloeschtTHENtaskstatusbzgbanken;activatebankfkt;zeigemeldung(anwendungstext(btbankengeloescht),NOTnegativemld,modellbankdialog);refreshsubmenu;ELSEzeigemeldung(anwendungstext(btkeinebankgeloescht),negativemld,modellbankdialog);FI.END PROCloeschebanken;PROCsicherebanken:TEXT VARfehlertext:="",bankname;BOOL VARerfolgreich:=FALSE,sichernok;INT VARbanknr,modellnr,format:=0,currentx,currenty;THESAURUS VARausgewaehlte:=bankenintask,archivliste,inhaltderbank;loescheaktuellemeldung;modellbankenwaehlen(ausgewaehlte,anwendungstext(btbankenimsystemwaehlen),anwendungstext(btbankenankreuzensichern),TRUE);IFnotempty(ausgewaehlte)THENsicherediegewaehltenELSErefreshsubmenu;zeigemeldung(anwendungstext(btsicherungabgebrochen),negativemld,modellbankdialog);leavesicherebanken;FI.sicherediegewaehlten:REPkernvonsichernPER.kernvonsichern:WINDOW VARfenster:=window(4,4,75,18);TEXT CONSTinfo:=anwendungstext(btueberschriftsicherungsaltn)+return,liste:=anwendungstext(btsicherungsalternativen),tasten:=" - ";INT VARauswahl;auswahl:=boxalternative(fenster,info,liste,tasten,1,FALSE)MOD100;loescheaktuellemeldung;IFauswahl=menusichernabbrechenTHENrefreshsubmenu;zeigemeldung(anwendungstext(btsicherungabgebrochen),negativemld,modellbankdialog);leavesicherebanken;ELSE IFauswahl=menuformatierenTHENformatierearchiv;ELIFauswahl=menuclearTHENloeschearchiv;FI;startesicherung;FI;.loeschearchiv:footnote(anwendungstext(btwartenallgemein));archivanmelden(fehlertext);IFarchivnichtfreiTHENzeigemeldung(fehlertext,negativemld,modellbankdialog);refreshsubmenu;leavesicherebanken;ELSEarchivoperation(cleararchiv,"",erfolgreich);oldfootnote;IF NOTerfolgreichTHENzeigemeldung(anwendungstext(btbittedisketteeinlegen),negativemld,modellbankdialog);reentersichern;FI;FI.formatierearchiv:footnote(anwendungstext(btwartenallgemein));archivanmelden(fehlertext);IFarchivnichtfreiTHENzeigemeldung(fehlertext,negativemld,modellbankdialog);refreshsubmenu;leavesicherebanken;ELSEwaehleformataus;IF NOTformatausgewaehltTHENzeigemeldung(anwendungstext(btkeinformatgewaehlt),negativemld,modellbankdialog);refreshsubmenu;leavesicherebanken;ELSEfootnote(anwendungstext(btwartenformatieren));archivoperation(formatarchiv,text(format),erfolgreich);IF NOTerfolgreichTHENoldfootnote;zeigemeldung(anwendungstext(btbittedisketteeinlegen),negativemld,modellbankdialog);reentersichern;FI FI FI.waehleformataus:cursor(1,4);out("�");format:=boxalternative(fenster,anwendungstext(btformatwahlueberschrift),anwendungstext(btformatwahlbeschreibung),anwendungstext(btformatwahlbuchstaben),5,FALSE)MOD100.formatausgewaehlt:format<>5.startesicherung:archivanmelden(fehlertext);IFarchivnichtfreiTHENrefreshsubmenu;zeigemeldung(fehlertext,negativemld,modellbankdialog);leavesicherebanken;ELSElistedesarchivserstellen;IF NOTerfolgreichTHENloescheaktuellesfenster;IFauswahl=menusichernTHENzeigemeldung(anwendungstext(btbittemodellbankdiskette),negativemld,modellbankdialog);ELSEzeigemeldung(anwendungstext(btbittedisketteeinlegen),negativemld,modellbankdialog);FI;reentersichern;ELSEerstellesicherungsliste;FI;FI;.listedesarchivserstellen:bildschirmleeren;menuwindowcursor(2,letztemenuwindowzeile);menuwindowout(anwendungstext(btwartenbeipruefen));archivoperation(allarchiv,"",archivliste,erfolgreich);.erstellesicherungsliste:bildeschnittmenge;IFbankendoppeltTHENfragewelcheueberschreiben;FI;sicherungslistebearbeiten;.bildschirmleeren:showmenuwindow;.bildeschnittmenge: +THESAURUS VARschnittmenge:=archivliste/ausgewaehlte;.bankendoppelt:notempty(schnittmenge).fragewelcheueberschreiben:loeschewartehinweis;menuwindowcursor(2,2);menuwindowout(anwendungstext(btaufdiskueberschreiben));menuwindowline(2);banknr:=0;WHILEbanknr"".sicherungslistebearbeiten:ueberschriftfuergesichertebanken;archivanmelden(fehlertext);IFarchivnichtfreiTHENloescheaktuellesfenster;zeigemeldung(fehlertext,negativemld,modellbankdialog);LEAVEsicherebanken;ELSEsichernok:=TRUE;banknr:=0;WHILEbankenzusichernCANDsichernokREPget(ausgewaehlte,bankname,banknr);sicherenaechstebank;PER;sichernauswerten;FI;.bankenzusichern:banknr "+bankname);getmenuwindowcursor(currentx,currenty);archivoperation(schreiben,"",inhaltderbank,erfolgreich);IFerfolgreichTHENmeldungeinebankgesichertFI;sichernok:=erfolgreich;.stelledatenraeumederbankzusammen:kopplean(bankname);inhaltderbank:=emptythesaurus;insert(inhaltderbank,bankname);FORmodellnrFROM1UPTOanzahldglmodelleREPkopplean(modellnr);IFexists(modelldatenraum)THENinsert(inhaltderbank,modelldatenraum);FI;IFexists(vorgabekurve)THENinsert(inhaltderbank,vorgabekurve);FI;IFexists(vorgabevergleichskurve)THENinsert(inhaltderbank,vorgabevergleichskurve);FI;PER;inhaltderbank:=inhaltderbank+wddsnamen.sichernauswerten:IFsichernokTHENloeschewartehinweis;menuwindowcursor(1,currenty);clearbuffer;menuwindowstop;loescheaktuellesfenster;ELSEloescheggfdatenraeume;loeschewartehinweis;menuwindowcursor(1,currenty);menuwindowout(" ");currentx:=7;currentyINCR1;menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btkannnichtgesichert));IFbankendoppeltTHENmenuwindowcursor(3,currenty+2);menuwindowout(anwendungstext(btbankevtgeloescht1));menuwindowcursor(3,currenty+3);menuwindowout(anwendungstext(btbankevtgeloescht2));FI;clearbuffer;menuwindowstop;loescheaktuellesfenster;zeigemeldung(anwendungstext(btdiskettevoll),negativemld,modellbankdialog);FI;LEAVEsicherebanken;.ueberschriftfuergesichertebanken:menuwindowcursor(1,1);menuwindowout(menuwindowcenter(anwendungstext(btbankenschreiben)));menuwindowcursor(1,letztemenuwindowzeile);menuwindowout(anwendungstext(btwartenbeisichern));menuwindowcursor(1,3);.meldungeinebankgesichert:menuwindowcursor(1,currenty);menuwindowout(" ");menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btbankgesichert));menuwindowline;.loescheggfdatenraeume:inhaltderbank:=(inhaltderbank-remainder)+(remainder/archivliste);IFnotempty(inhaltderbank)THENarchivoperation(loeschen,"",inhaltderbank,erfolgreich);IF NOTerfolgreichTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btbittedisketteeinlegen),negativemld,modellbankdialog);LEAVEsicherebanken;FI;FI;.leavesicherebanken:oldfootnote;LEAVEsicherebanken;.reentersichern:LEAVEkernvonsichern.END PROCsicherebanken;PROCmodellbankenwaehlen(THESAURUS VARgewaehlt,TEXT CONSTt1,t2,BOOL CONSTbildrekonstruieren):waehlebankenaus;.waehlebankenaus:gewaehlt:=some(singlesp1,zl1,singlebr,hoe,gewaehlt,t1,t2);IFbildrekonstruierenTHENerase(fsingle);FI;.END PROCmodellbankenwaehlen;PROCmodellbankwaehlen(TEXT VARgewaehlt):gewaehlt:="";waehlebankaus;koppleggfbankan;.waehlebankaus:gewaehlt:=one(singlesp1,zl1,singlebr,hoe,bankenintask,anwendungstext(btmodellbankenverzeichnis),anwendungstext(btbitte1bankwaehlen));erase(fsingle).koppleggfbankan:IFcompress(gewaehlt)<>""THENkopplean(gewaehlt);letztebank:=gewaehlt;FI.END PROCmodellbankwaehlen;PROCbankenauflisten:FILE VARbankliste;TEXT VARausstieg:="";INT VARerstersatz1:=3, +erstespalte1:=1;loescheaktuellemeldung;forget(listends);listends:=nilspace;bankliste:=sequentialfile(output,listends);line(bankliste);putline(bankliste,anwendungstext(btmodellbankenverzeichnis));line(bankliste);IFbankintaskTHENbanklisteFILLBYbankenintask;ELSEputline(bankliste,anwendungstext(btkeinebankenenthalten));FI;footnote(steuerleiste(stleistefileverlassen));erase(fsingle);outframe(fsingle);scroll(fshow,bankliste,erstespalte,erstezeile,scrollbreite,erstersatz1,erstespalte1,showverlasszeichen,ausstieg);forget(listends);loescheaktuellesfenster;.END PROCbankenauflisten;DATASPACE VARlistends;PROCmodelleauflisten(BOOL CONSTmitauswahlderbank):ROWmaxmodelleINT VARmodellnummern;FILE VARmodelliste;TEXT VARbankinbearbeitung;TEXT VARausstieg:="";INT VARerstersatz1:=3,erstespalte1:=1;loescheaktuellemeldung;IFmitauswahlderbankTHENmodellbankwaehlen(bankinbearbeitung);ELSEbankinbearbeitung:=letztebank;FI;IFbankinbearbeitung<>""THENletztebank:=bankinbearbeitung;holemodellnamenderbank;zeigemodellnamen;loescheaktuellesfenster;ELSEloescheaktuellesfenster;zeigemeldung(anwendungstext(btkeinebankgewaehlt),NOTnegativemld,modellbankdialog);FI;.holemodellnamenderbank:forget(listends);listends:=nilspace;modelliste:=sequentialfile(output,listends);line(modelliste);putline(modelliste,anwendungstext(btmodellverzeichnis)+evtverkuerzterbankname(letztebank));line(modelliste);modellisteFILLBYmodellnamenderbank(allemodelle,modellnummern,anzahldermodelle);IFanzahldermodelle<=0THENputline(modelliste,anwendungstext(btkeinmodellinbank))FI.zeigemodellnamen:footnote(steuerleiste(stleistefileverlassen));outframe(fsingle);scroll(fshow,modelliste,erstespalte,erstezeile,scrollbreite,erstersatz1,erstespalte1,showverlasszeichen,ausstieg);forget(listends).END PROCmodelleauflisten;PROCbankzumarbeitenwaehlen:TEXT VARbankinbearbeitung:="";loescheaktuellemeldung;modellbankwaehlen(bankinbearbeitung);IFbankinbearbeitung<>""THENzeigemeldung(anwendungstext(btbankgewaehlt),NOTnegativemld,modellbankdialog);activatemodellfkt;refreshsubmenu;ELSErefreshsubmenu;zeigemeldung(anwendungstext(btkeinebankgewaehlt),negativemld,modellbankdialog);FI;oldfootnote;.END PROCbankzumarbeitenwaehlen;PROCmodellwaehlen(INT VARgewaehlt,KRITERIUM CONSTkriterium):ROWmaxmodelleINT VARmodellnummern;TEXT VARgewaehltesmodell;THESAURUS VARmengedermodelle:=emptythesaurus;holemodellnamenderbank;waehlenamenaus.holemodellnamenderbank:mengedermodelle:=modellnamenderbank(kriterium,modellnummern,anzahldermodelle).waehlenamenaus:gewaehltesmodell:=one(singlesp1,zl1,singlebr,hoe,mengedermodelle,anwendungstext(btmodellverzeichnis)+evtverkuerzterbankname(letztebank),anwendungstext(btbittemodellwaehlen));IFcompress(gewaehltesmodell)<>""THENgewaehlt:=modellnummern(link(mengedermodelle,gewaehltesmodell));ELSEloescheaktuellesfenster;gewaehlt:=0FI.END PROCmodellwaehlen;BOOL PROCbankgewaehlt:NOT(letztebank=nichtdefiniert).END PROCbankgewaehlt;PROCmodellbearbeiten:BOUND MODELLDGL VARaktmodell;DATASPACE VARtransportdsp;INT CONSTursprungstask:=standardkanal;INT VARnr,retcode:=0;loescheaktuellemeldung;modellwaehlen(nr,allelauffaehigen);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);LEAVEmodellbearbeitenELSE IFdglmodellTHENsimulieremitdglmodell;ELSEforget(transportdsp);transportdsp:=old(name(wddsnamen,nr-maxdglmodelle));diagrammankoppeln(transportdsp);transformierewirkungsdiagrammundstartesimulation(ls,retcode);forget(transportdsp)FI;FI;continue(ursprungstask);IFokTHENregeneratemenuscreen;zeigemeldung(anwendungstext(btsimulationbeendet),NOTnegativemld,modellbankdialog);ELSEloescheaktuellesfenster;zeigemeldung(anwendungstext(btsimulationunmoeglich),negativemld,modellbankdialog);FI;.dglmodell:nr<=maxdglmodelle.simulieremitdglmodell:REPversendeundbearbeite;UNTILordnungsgemaessbeendetodertasknichtempfangsbereitPER;.ordnungsgemaessbeendetodertasknichtempfangsbereit:retcode<>simulationneustarten.versendeundbearbeite:continue(ursprungstask);IFretcode=simulationneustartenTHEN +regeneratemenuscreen;FI;footnote(anwendungstext(btwartenallgemein));kopplean(nr);retcode:=0;schickemodelldaten;IFokTHENschickeoriginalkurve;FI;IFokTHENschickevergleichskurve;FI;IFokTHENschickegleichungen;IFokTHENstartesimulationFI;FI;.ok:retcode=0.schickemodelldaten:transportdsp:=nilspace;aktmodell:=transportdsp;aktmodell:=modellaktuell(nr);schickeanmanagertask(transportdsp,2,retcode);forget(transportdsp);.schickeoriginalkurve:IFexists(vorgabekurve)THENtransportdsp:=old(vorgabekurve);schickeanmanagertask(transportdsp,3,retcode);forget(transportdsp);FI;.schickevergleichskurve:IFexists(vorgabevergleichskurve)THENtransportdsp:=old(vorgabevergleichskurve);schickeanmanagertask(transportdsp,4,retcode);forget(transportdsp);FI;.schickegleichungen:IFexists(modelldatenraum)THENtransportdsp:=old(modelldatenraum);schickeanmanagertask(transportdsp,5,retcode);forget(transportdsp);ELSEretcode:=99;FI.startesimulation:break(quiet);transportdsp:=nilspace;schickeanmanagertask(transportdsp,6,retcode);END PROCmodellbearbeiten;PROCmodellerzeugen:INT VARreturncode;loescheaktuellemeldung;richteneuesmodellein;.richteneuesmodellein:cursoron;fuegeein(aufgeblaehtername(letztebank),returncode);cursoroff;IF NOT(returncode=ok)THENregeneratemenuscreen;zeigemeldung(anwendungstext(btmodellnichtabgelegt),negativemld,modellbankdialog);ELSEactivatemodellfkt;regeneratemenuscreen;zeigemeldung(anwendungstext(btmodellabgelegt),NOTnegativemld,modellbankdialog);FI;.END PROCmodellerzeugen;PROCwirkungsdiagrammerzeugen:INT VARreturncode;loescheaktuellemeldung;richteneuesmodellein;.richteneuesmodellein:initcellmatrix;cursoron;erfassenamenundwd(aufgeblaehtername(letztebank),0,returncode);cursoroff;IF NOT(returncode=ok)THENregeneratemenuscreen;zeigemeldung(anwendungstext(btmodellnichtabgelegt),negativemld,modellbankdialog);ELSEactivatemodellfkt;regeneratemenuscreen;zeigemeldung(anwendungstext(btmodellabgelegt),NOTnegativemld,modellbankdialog);FI.END PROCwirkungsdiagrammerzeugen;PROCmodellkopieren:INT VARnr,returncode;loescheaktuellemeldung;modellwaehlen(nr,alleaenderbaren);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);ELSEkopiervorgangFI;.kopiervorgang:IFdglmodellTHEN IFmodellbankvolldglTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btmodellbankvolldgl),negativemld,modellbankdialog);LEAVEmodellkopierenELSEkopplean(nr);cursoron;copy(nr,aufgeblaehtername(letztebank),returncode);cursoroffFI;ELIFwdmodellTHEN IFmodellbankvollwdTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btmodellbankvollwd),negativemld,modellbankdialog);LEAVEmodellkopierenELSEcursoron;copywd(nr-maxdglmodelle,aufgeblaehtername(letztebank),returncode);cursoroffFI;FI;IF NOT(returncode=ok)THENregeneratemenuscreen;zeigemeldung(anwendungstext(btmodellnichtabgelegt),negativemld,modellbankdialog);ELSEactivatemodellfkt;regeneratemenuscreen;zeigemeldung(anwendungstext(btmodellabgelegt),NOTnegativemld,modellbankdialog);FI.dglmodell:nr<=maxdglmodelle.wdmodell:nr>maxdglmodelle.END PROCmodellkopieren;PROCmodellloeschen:INT VARnr;loescheaktuellemeldung;modellwaehlen(nr,alleaenderbaren);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);ELSEkopplean(nr);loescheaktuellesfenster;IFmenuyes(modellname+anwendungstext(btfragemodellloeschen),5)THENloesche(nr,aufgeblaehtername(letztebank));zeigemeldung(anwendungstext(btmodellgeloescht),NOTnegativemld,modellbankdialog);activatemodellfkt;ELSEzeigemeldung(anwendungstext(btkeinmodellgeloescht),negativemld,modellbankdialog)FI;FI.modellname:IFdglmodellTHENkopplean(nr);modellbezeichnungELSEname(wdmodelle,nr-maxdglmodelle)FI.dglmodell:nr<=maxdglmodelle.END PROCmodellloeschen;PROCmodellveraendern:DATASPACE VARtransportdsp;BOOL VARerfassenok:=FALSE;INT VARnr,returncode:=0;loescheaktuellemeldung;modellwaehlen(nr,alleaenderbaren);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);ELSEcursoron;IFdglmodellTHENmodellerfassung(nr,aufgeblaehtername(letztebank), +erfassenok);IF NOTerfassenokTHENloesche(nr,aufgeblaehtername(letztebank))FI; +ELSEforget(transportdsp);transportdsp:=old(name(wddsnamen,modellindex));diagrammankoppeln(transportdsp);erfassenamenundwd(aufgeblaehtername(letztebank),modellindex,returncode);erfassenok:=(returncode=0);forget(transportdsp)FI;cursoroff;IFerfassenokTHENactivatemodellfkt;regeneratemenuscreen;zeigemeldung(anwendungstext(btmodellveraendertabgelegt),NOTnegativemld,modellbankdialog);ELSEregeneratemenuscreen;zeigemeldung(anwendungstext(btmodellnichtabgelegt),negativemld,modellbankdialog);FI FI.modellindex:nr-maxdglmodelle.dglmodell:nr<=maxdglmodelle.END PROCmodellveraendern;PROCmodellinformationen:DATASPACE VARmodellds;FILE VARmdlinfo;TEXT VARausstieg:="";INT VARerstersatz1:=3,erstespalte1:=1,nr;forget(listends);listends:=nilspace;mdlinfo:=sequentialfile(output,listends);loescheaktuellemeldung;modellwaehlen(nr,allemodelle);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);LEAVEmodellinformationenELIFdglmodellTHENkopplean(nr);putline(mdlinfo,anwendungstext(btmodell)+modellbezeichnung);IF NOTexists(modelldatenraum)THENputline(mdlinfo,modellbezeichnung+":");line(mdlinfo,2);putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig5));ELSEforget(listends);informationstext(mdlinfo);IF NOTcompilierbaregleichungenTHENinfofuerfehlerhaftesmodell(mdlinfo)ELSEinfofuerfehlerfreiesmodell(mdlinfo)FI FI ELIFwdmodellTHENforget(modellds);modellds:=old(name(wddsnamen,modellindex));diagrammankoppeln(modellds);putline(mdlinfo,anwendungstext(btmodell)+wdmodellname);putline(mdlinfo,length(anwendungstext(btmodell)+wdmodellname)*"=");line(mdlinfo);IF NOTwdmodelllauffaehigTHENinfofuerfehlerhaftesmodell(mdlinfo)ELSEinfofuerfehlerfreiesmodell(mdlinfo)FI;line(mdlinfo);modellinfo(mdlinfo);forget(modellds)FI;footnote(steuerleiste(stleistefileverlassen));erase(fsingle);outframe(fsingle);scroll(fshow,mdlinfo,1,scrollzeile,1,erstersatz1,erstespalte1,showverlasszeichen,ausstieg);forget(listends);loescheaktuellesfenster.modellindex:nr-maxdglmodelle.dglmodell:nr<=maxdglmodelle.wdmodell:NOTdglmodell.wdmodelllauffaehig:type(old(name(wddsnamen,nr-maxdglmodelle)))=typnrwdausfuehrbar.wdmodellname:name(wdmodelle,nr-maxdglmodelle).END PROCmodellinformationen;PROCinfofuerfehlerhaftesmodell(FILE VARmdlinfo):putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig1));putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig2));putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig3));putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig4))END PROCinfofuerfehlerhaftesmodell;PROCinfofuerfehlerfreiesmodell(FILE VARmdlinfo):putline(mdlinfo,anwendungstext(btmodellablauffaehig))END PROCinfofuerfehlerfreiesmodell;BOOL PROCbankintask:anzahlbankenintask>0END PROCbankintask;PROCtaskstatusbzgbanken:bankenintask:=infixnamen(all,modellbanktyp);anzahlbankenintask:=highestentry(bankenintask)END PROCtaskstatusbzgbanken;THESAURUS PROCmodellnamenderbank(KRITERIUM CONSTkriterium,ROWmaxmodelleINT VARmodellnummern,INT VARanzahldermodelle):THESAURUS VARbankliste:=emptythesaurus;ROWmaxmodelleTEXT VARmodellnamen;listedermodelle(modellnamen,modellnummern,kriterium,anzahldermodelle);IFanzahldermodelle>0THENschreibenameninverzeichnisFI;bankliste.schreibenameninverzeichnis:FORiFROM1UPTOanzahldermodelleREPinsert(bankliste,modellnamen(i))PER.END PROCmodellnamenderbank;PROCarchivanmelden(TEXT VARarchivfehler):disablestop;archive(floppyname);IFiserrorTHENarchivfehler:=errormessage;clearerror;enablestop;IFlength(archivfehler)<=62THENarchivfehler:=archivfehler;ELSEarchivfehler:=anwendungstext(btarchivnichtfrei);FI;ELSEenablestop;archivfehler:="";FI.END PROCarchivanmelden;PROCarchivoperation(INT CONSToperation,TEXT CONSTdatenraum,BOOL VARmiterfolg):THESAURUS VARarchivinhalt;archivoperation(operation,datenraum,archivinhalt,miterfolg);END PROCarchivoperation;PROCarchivoperation(INT CONSToperation,TEXT CONSTtextparam,THESAURUS VARarchivliste,BOOL VARmiterfolg):disablestop;archive(floppyname);commanddialogue(FALSE);SELECToperationOF CASE1:clear(archive)CASE2: +archivliste:=ALLarchive;CASE3:menuwindowcursor(length(anwendungstext(btwartenbeisichern))+3,letztemenuwindowzeile);save(archivliste,archive);CASE4:menuwindowcursor(length(anwendungstext(btwartenbeisichern))+3,letztemenuwindowzeile);erase(archivliste,archive);CASE5:menuwindowcursor(length(anwendungstext(btwartenbeiladen))+3,letztemenuwindowzeile);fetch(textparam,archive);CASE6:menuwindowcursor(length(anwendungstext(btwartenbeiladen))+3,letztemenuwindowzeile);fetch(archivliste,archive);CASE7:format(int(textparam),archive)END SELECT;IFiserrorTHENclearerror;enablestop;miterfolg:=FALSE;ELSEenablestop;miterfolg:=TRUE;FI;commanddialogue(TRUE);release(archive);.END PROCarchivoperation;BOOL PROCdskeinmodelldatenraum(TEXT CONSTdataspacename):pos(dataspacename,originalkurve)=0CANDpos(dataspacename,vergleichskurve)=0CANDpos(dataspacename,modellcodeds)=0.END PROCdskeinmodelldatenraum;PROCloeschewartehinweis:menuwindowcursor(1,letztemenuwindowzeile);menuwindowout(71*" ");END PROCloeschewartehinweis;PROCloescheaktuellesfenster:aktuelleswindow:=currentmenuwindow;erase(aktuelleswindow);refreshsubmenu;oldfootnote;END PROCloescheaktuellesfenster;TEXT PROCevtverkuerzterbankname(TEXT CONSTbankname):TEXT CONSTbn:=compress(bankname);IFlength(bn)>maxnamenlaengeselbsterfasstebankTHENverkuerzternameELSEbnFI.verkuerztername:IFpos(bn,":")>0THENsubtext(bn,abdoppelpunkt)ELSEsubtext(bn,1,maxnamenlaengeselbsterfasstebank)FI.abdoppelpunkt:pos(bn,":")+2.END PROCevtverkuerzterbankname;TEXT PROCaufgeblaehtername(TEXT CONSTbankname):text(bankname,maxmusslaengebankname).END PROCaufgeblaehtername;END PACKETlssimsel; + diff --git a/app/schulis-simulationssystem/3.0/src/ls simulation b/app/schulis-simulationssystem/3.0/src/ls simulation new file mode 100644 index 0000000..c673fa0 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls simulation @@ -0,0 +1,5 @@ +PACKETlssimulationDEFINESberechne,berechnefortfuehrung,forgetmodellauf,zeigediagramm,zeigephasendiagramm,zeigevergleichskurve,zeigevergleichfuertabelle,zeigevergleichskurvefuerphasendiagramm:LETabbruch=36,mldruckertaskexistiertnicht=37,mldrucktasknichtempfangsbereit=38,mldruckunmoeglich=39,druckok=0,printertaskname="PRINTER",kurveleer=99,oueberschrift=67,vueberschrift=68,steuerleisteberechnung=26,steuerleistegraphik=27,steuerleistevergleichgraphik=29,steuerleistetabelle=30,steuerleistewarten=31,produktname=21,sendetaste="p",vglbeendenz="z",vglbeendent="t",vglbeendenh="h",lsabbruch="m",lsabbrucheingabe="m",blaetternoben="o",blaetternunten="u",weiter="w",druckdateitab=" tabelle.p",druckdateitab2=" tabelle.p.2",dateimodellwerte=" modellwerte",erzeugtetabelle=" tabelle";LETstrukt1fenster=1,strukt4fenster=4,fensterdummy=0,fensterganz=1,fensterlinksoben=4,fensterrechtsoben=6,fensterrechtsunten=7,fensterlinksunten=5;TEXT CONSTscrollausstiegmitdrucken:="md";INT VARfehlercode:=0,fehlernummer;LETscrollsp1=16,scrollzeile1=3,scrollbreitetab=15;LETniltext="",seitenvorschub="#page#",headanfang="#head#",nummerierung="#right# Seite: ",center="#center#",headende="#end#",druckbreite=78,drucklaenge=60;LETpausendauer=30;TEXT CONSTsendenblaetternuntenundoben:=sendetaste+blaetternunten+blaetternoben;INT VARsteuerzeilennr,kopfzeilennr;PROCberechne(LOESUNG VARergebnis,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,TEXT VARtaste):enablestop;taste:="";forgetlogischemaske;REPkernvonberechne;PER.kernvonberechne:forgetmodellauf;eingabemodellgroessen(ergebnis,PROCf,PROCcof,kopfzeilezusammenstellen(kopfzeile(21),modellkurzbezeichnung,77),steuerleiste(steuerleisteberechnung),taste,zeichenkette,fehlercode);IFfehlercode=abbruchCORfehlercode=kurveleerTHENpausebeifehlern;reenterberechneELSEpausebeifehlernFI;IFtaste=lsabbrucheingabeCORtaste=weiterTHENleaveberechneFI;.zeichenkette:weiter.leaveberechne:LEAVEberechne.reenterberechne:forget("aus",quiet);LEAVEkernvonberechne.END PROCberechne;PROCforgetmodellauf:forget(dateimodellwerte,quiet);forget("aus",quiet);forget("aus diagramm",quiet);forget(" neue kurve",quiet);forget(druckdateitab,quiet);END PROCforgetmodellauf;PROCzeigediagramm(TEXT CONSTart,LOESUNG VARdieloesung,ZUSTAND VARmuster,BOOL CONSTinfortsetzung,TEXT VARtaste):TEXT VARdiagrammart:=art;OUTPUT VARausdiagramm;fehlernummer:=0;gibdiagrammaus(ausdiagramm,muster,dieloesung,infortsetzung,diagrammart,taste);.END PROCzeigediagramm;PROCgibdiagrammaus(OUTPUT VARausdiagramm,ZUSTAND CONSTmuster,LOESUNG VARloesungx,BOOL CONSTinfortsetzung,TEXT CONSTdiagrammart,TEXT VARtaste):KURVE VARhilfskurve:=LOESUNGSABSCHNITTloesungx;TEXT CONSTtastenraus:=lsabbruch;;ausdiagramm:=niloutput(strukt1fenster,"aus diagramm");IFdiagrammart=vglbeendenzTHENgibzeitdiagrammausELIFdiagrammart=vglbeendentTHENgibtabelleausELIFdiagrammart=vglbeendenhTHENgibhistogrammausFI.gibzeitdiagrammaus:IFinfortsetzungTHENkopfzeilennr:=4ELSEkopfzeilennr:=3FI;steuerzeilennr:=steuerleistegraphik;pausebeifehlern;steuerprozessfuereineloesung(ausdiagramm,hilfskurve,muster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,kopfzeilennr,steuerzeilennr,sendetaste,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinedummy).gibtabelleaus:FILE VARtbl:=tabelle(hilfskurve,muster,TRUE);WINDOW VARtabwindow:=grossesrahmenfenster;INT VARerstersatz1:=3,erstespalte1:=scrollsp1,seitenzaehler:=1;INT VARok:=0;forget(druckdateitab,quiet);rename(erzeugtetabelle,druckdateitab);outframe(tabwindow);footnote(steuerleiste(steuerleistetabelle));scroll(tabwindow,druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,scrollausstiegmitdrucken,taste);WHILEtaste<>lsabbruchREPdruckeevt;scroll(tabwindow,druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,scrollausstiegmitdrucken,taste);PER;erase(tabwindow);.druckeevt:footnote(steuerleiste(steuerleistewarten));seitenzaehler:=1;druckemodellwerteaus(originalwerte,seitenzaehler +,ok);IFok=druckokTHENtabelleaufbereitetdrucken(druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,seitenzaehler,ok);FI;IFok=druckokTHENfootnote(steuerleiste(steuerleistetabelle));ELSEfootnote(meldungstext(ok));pause;footnote(steuerleiste(steuerleistetabelle));FI;.gibhistogrammaus:IFinfortsetzungTHENkopfzeilennr:=29ELSEkopfzeilennr:=28FI;steuerzeilennr:=steuerleistegraphik;pausebeifehlern;steuerprozessfuereineloesung(ausdiagramm,hilfskurve,muster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,kopfzeilennr,steuerzeilennr,sendetaste,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinedummy).END PROCgibdiagrammaus;PROCpausebeifehlern:IFfehlercode>0THENzeigemeldung(meldungstext(fehlercode),FALSE);pause(pausendauer);fehlercode:=0;loescheaktuellemeldung;FI.END PROCpausebeifehlern;PROCzeigephasendiagramm(LOESUNG VARdieloesung,ZUSTAND VARmuster,BOOL CONSTinfortsetzung,TEXT VARtaste):TEXT CONSTtastenraus:=lsabbruch;gibphasendiagrammaus;.gibphasendiagrammaus:KURVE VARhilfskurve:=LOESUNGSABSCHNITTdieloesung;OUTPUT VARausphasen:=niloutput(strukt1fenster,"aus phasen");kopfzeilennr:=kopf;steuerzeilennr:=steuerleistegraphik;steuerprozessfuereineloesung(ausphasen,hilfskurve,muster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,kopfzeilennr,steuerzeilennr,sendetaste,tastenraus,taste,PROCcoroutinephase,PROCcoroutinedummy).kopf:IFinfortsetzungTHEN9ELSE8FI.END PROCzeigephasendiagramm;PROCzeigevergleichskurve(TEXT VARtaste,LOESUNG VARlsga,lsgb,ZUSTAND CONSTmuster,TEXT CONSTwas):KURVE VARkurvea,kurveb;TEXT VARtastenraus:=lsabbruch;originalundvergleichskurveausgeben.originalundvergleichskurveausgeben:OUTPUT VARausvergl2:=niloutput(strukt4fenster,"ausvergl2");kurvea:=LOESUNGSABSCHNITTlsga;kurveb:=LOESUNGSABSCHNITTlsgb;modellwertefuervergleich(ausvergl2,fensterrechtsoben,lsga,fensterrechtsunten,lsgb);kopfzeilennr:=6;steuerzeilennr:=steuerleistevergleichgraphik;aufrufvergleichhistogrammodervergleichzeit.aufrufvergleichhistogrammodervergleichzeit:IFwas=vglbeendenzTHENsteuerprozessfuerzweiloesungen(ausvergl2,kurvea,kurveb,muster,fensterlinksoben,fensterlinksunten,kopfzeilennr,steuerzeilennr,sendenblaetternuntenundoben,tastenraus,taste,PROCcoroutinezeit,PROCkreuzzeitvergleich)ELSEsteuerprozessfuerzweiloesungen(ausvergl2,kurvea,kurveb,muster,fensterlinksoben,fensterlinksunten,kopfzeilennr,steuerzeilennr,sendenblaetternuntenundoben,tastenraus,taste,PROCcoroutinehisto,PROCkreuzhistovergleich)FI.ENDPROCzeigevergleichskurve;PROCzeigevergleichfuertabelle(TEXT VARtaste,LOESUNG VARla,lb,ZUSTAND CONSTmuster):KURVE VARkurvea:=LOESUNGSABSCHNITTla,kurveb:=LOESUNGSABSCHNITTlb;WINDOW VARtabwindowo:=tabellenfensteroben,tabwindowu:=tabellenfensterunten;INT VARerstersatz1:=3,erstersatz2:=3,erstespalte1:=scrollsp1,seitenzaehler:=1;INT VARok:=0;originalundvergleichausgeben;forget(druckdateitab2,quiet);forget(druckdateitab,quiet);.originalundvergleichausgeben:FILE VARtbl;kopfzeilennr:=6;steuerzeilennr:=steuerleistetabelle;forget(druckdateitab2,quiet);forget(druckdateitab,quiet);tbl:=tabelle(kurvea,muster,TRUE);rename(erzeugtetabelle,druckdateitab);tbl:=tabelle(kurveb,muster,TRUE);rename(erzeugtetabelle,druckdateitab2);footnote(steuerleiste(steuerzeilennr));outframe(tabwindowo);outframe(tabwindowu);scroll(tabwindowo,tabwindowu,druckdateitab,druckdateitab2,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,erstersatz2,scrollausstiegmitdrucken,taste);WHILEtaste<>lsabbruchREPdruckeevt;scroll(tabwindowo,tabwindowu,druckdateitab,druckdateitab2,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,erstersatz2,scrollausstiegmitdrucken,taste);PER;erase(tabwindowo);erase(tabwindowu);.druckeevt:footnote(steuerleiste(steuerleistewarten));seitenzaehler:=1;druckemodellwerteaus(la,seitenzaehler,ok);IFok=druckokTHENtabelleaufbereitetdrucken(druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,seitenzaehler,ok);IFok=druckokTHENdruckemodellwerteaus(lb,seitenzaehler,ok);IFok=druckokTHENtabelleaufbereitetdrucken(druckdateitab2,scrollsp1, +scrollzeile1,scrollbreitetab,seitenzaehler,ok);FI;FI;FI;IFok=druckokTHENfootnote(steuerleiste(steuerleistetabelle));ELSEfootnote(meldungstext(ok));pause;footnote(steuerleiste(steuerleistetabelle));FI;.ENDPROCzeigevergleichfuertabelle;PROCzeigevergleichskurvefuerphasendiagramm(TEXT VARtaste,KURVE CONSTkva,kvb,ZUSTAND VARmuster):TEXT VARtastenraus:=lsabbruch;originalundvergleichskurveausgeben;.originalundvergleichskurveausgeben:OUTPUT VARausvergl2:=niloutput(strukt1fenster,"ausvergl2");KURVE VARkurvea,kurveb;kurvea:=kva;kurveb:=kvb;steuerprozessfuerzweiloesungenaufrufen.steuerprozessfuerzweiloesungenaufrufen:kopfzeilennr:=6;steuerzeilennr:=steuerleistegraphik;steuerprozessfuerzweiloesungen(ausvergl2,kurvea,kurveb,muster,fensterganz,fensterganz,kopfzeilennr,steuerzeilennr,sendetaste,tastenraus,taste,PROCcoroutinephase,PROCkreuzphasevergleich).ENDPROCzeigevergleichskurvefuerphasendiagramm;PROCmodellwertefuervergleich(OUTPUT VARseite,INT CONSToben,LOESUNG CONSToriginal,INT CONSTunten,LOESUNG CONSTvergleich):FILE VARzfile;zfile:=modellwerteausgeben(original);modify(zfile);toline(zfile,1);insertrecord(zfile);writerecord(zfile,meldungstext(oueberschrift));toline(zfile,2);insertrecord(zfile);writerecord(zfile," ");replace(seite,oben,zfile);zfile:=modellwerteausgeben(vergleich);modify(zfile);toline(zfile,1);insertrecord(zfile);writerecord(zfile,meldungstext(vueberschrift));toline(zfile,2);insertrecord(zfile);writerecord(zfile," ");replace(seite,unten,zfile);END PROCmodellwertefuervergleich;PROCforgetds:forget("groessen vergl",quiet);forget("ausvergl",quiet);forget("ausvergl2",quiet);END PROCforgetds;PROCberechnefortfuehrung(LOESUNG VARoriginal,gesamtloesung,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof):ZUSTAND VARstartwert:=neuerzustand(dimension),letzterpunkt:=letzterwert(LOESUNGSABSCHNITTgesamtloesung);INT VARi;FORiFROM1UPTOdimensionREPreplace(startwert,i,(letzterpunktSUBi));PER KURVE VARzkurve1,zkurve2;gibberechnungsstandzeileaus;zkurve1:=kurve1(PROCf,PROCcof,startwert,zustandunteregrenze,zustandoberegrenze,letztezeit(LOESUNGSABSCHNITTgesamtloesung),DAUERoriginal,PARAMETERSATZgesamtloesung,anzahlbeobachtungspunkte,codimension,"fortfuehrung",fehlercode);zkurve2:=LOESUNGSABSCHNITTgesamtloesung;zkurve2CATzkurve1;forget("fortfuehrung",quiet);gesamtloesungLOESUNGSABSCHNITTzkurve2;gesamtloesungDAUER(letztezeit(LOESUNGSABSCHNITTgesamtloesung)-(STARTZEIToriginal));pausebeifehlern;END PROCberechnefortfuehrung;PROCtabelleaufbereitetdrucken(TEXT CONSTfname,INT CONSTspaltenbeginn,zeilenbeginn,spaltenbreite,INT VARseitenzahl,INT VARret):FILE VARf,fdruck;INT VARdateibreite,dateilaenge,i,j,verfuegbarerplatz,zulaessigebreite;TEXT CONSTneuername:=fname+"."+timeofday+text(seitenzahl);TEXT VARzeile,druckzeile;testeumfangderzudruckendendatei;bereitedateiauf;ret:=erfolgreicherdruckversuch(neuername);IFret=druckokTHENforget(neuername,quiet);ELSE END IF.testeumfangderzudruckendendatei:f:=sequentialfile(input,fname);dateilaenge:=lines(f);dateibreite:=0;WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>dateibreiteTHENdateibreite:=length(zeile)END IF END REP;verfuegbarerplatz:=drucklaenge-zeilenbeginn+1;verfuegbarerplatzDECR5;zulaessigebreite:=0;REPzulaessigebreiteINCRspaltenbreiteUNTILzulaessigebreite>druckbreite-spaltenbeginn+1END REP;zulaessigebreiteDECRspaltenbreite.bereitedateiauf:INT VARspaltenpointer,zeilenpointer;modify(f);fdruck:=sequentialfile(output,neuername);spaltenpointer:=spaltenbeginn;WHILEspaltenpointerdateilaengeTHEN LEAVEschreibeseitenEND IF END REP.END PROCtabelleaufbereitetdrucken;PROCdruckemodellwerteaus(LOESUNG CONSTloesungx,INT VARseitenzahl,INT VARret):FILE VARmdw,fdruck;TEXT VARzeilentext,eindeutigerwertname;initialisieredruckdateimitueberschrift;lesemodellwertdateiein;druckemodellwerte;.initialisieredruckdateimitueberschrift:mdw:=modellwerteausgeben(loesungx);eindeutigerwertname:=dateimodellwerte+"."+timeofday+text(seitenzahl);IFexists(eindeutigerwertname)THENforget(eindeutigerwertname,quiet);FI;fdruck:=sequentialfile(output,eindeutigerwertname);putline(fdruck,seitenvorschub);putline(fdruck,headanfang);putline(fdruck,auskunftstext(produktname)+nummerierung+text(seitenzahl));line(fdruck);putline(fdruck,center+modellbezeichnung);putline(fdruck,headende);line(fdruck,2);.lesemodellwertdateiein:input(mdw);WHILE NOTeof(mdw)REPgetline(mdw,zeilentext);putline(fdruck,zeilentext);PER;.druckemodellwerte:seitenzahlINCR1;ret:=erfolgreicherdruckversuch(eindeutigerwertname);IFret=druckokTHENforget(dateimodellwerte,quiet);forget(eindeutigerwertname,quiet);FI;.END PROCdruckemodellwerteaus;INT PROCerfolgreicherdruckversuch(TEXT CONSTdatname):disablestop;IFexiststask(printertaskname)THEN IFstatus(/printertaskname)=2THENsicherezuprinterELSEenablestop;mldrucktasknichtempfangsbereitFI ELSEenablestop;mldruckertaskexistiertnichtFI.sicherezuprinter:commanddialogue(FALSE);save(datname,/printertaskname);commanddialogue(TRUE);IFiserrorTHENclearerror;enablestop;mldruckunmoeglichELSEenablestop;druckokEND IF.END PROCerfolgreicherdruckversuch;END PACKETlssimulation; + diff --git a/app/schulis-simulationssystem/3.0/src/ls starte bearbeitung b/app/schulis-simulationssystem/3.0/src/ls starte bearbeitung new file mode 100644 index 0000000..f8cf9d4 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls starte bearbeitung @@ -0,0 +1,2 @@ +PACKETlsstartebearbeitungDEFINESwahlderbearbeitung:PROCwahlderbearbeitung(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarst):enablestop;LETabbruch=0,btbuchstabenmitdemo=57,btauswahlhead=60,btalternmitdemo=61,btalternohnedemo=62,btbuchstabenohnedemo=70;TEXT CONSTreturn:=code(13),info:=" "+modellbezeichnung+return+return;INT VARauswahl;WINDOW VARfenster:=grossesrahmenfenster;page;show(fenster);REPclearbuffer;IFexists(vorgabekurve)ANDexists(vorgabevergleichskurve)THENauswahlmitangebotdemoELSEauswahlohneangebotdemoFI;UNTILauswahl=abbruchPER;.auswahlmitangebotdemo:auswahl:=boxalternative(fenster,info,anwendungstext(btalternmitdemo),anwendungstext(btbuchstabenmitdemo),5,FALSE);SELECTauswahlOF CASE1,101,106:handlemenu("Simulation",PROCf,PROCcof,PROCzusatzdarst);page;show(fenster);CASE2,102,107:demonstration(PROCzusatzdarst);page;show(fenster);CASE3,103,108:infoszummodell;page(fenster);CASE5,105,110:auswahl:=abbruch;OTHERWISE END SELECT;.auswahlohneangebotdemo:auswahl:=boxalternative(fenster,info,anwendungstext(btalternohnedemo),anwendungstext(btbuchstabenohnedemo),5,FALSE);SELECTauswahlOF CASE1,101,105:handlemenu("Simulation",PROCf,PROCcof,PROCzusatzdarst);page;show(fenster);CASE2,102,106:infoszummodell;page(fenster);CASE4,104,108:auswahl:=abbruch;OTHERWISE END SELECT;.END PROCwahlderbearbeitung;END PACKETlsstartebearbeitung; + diff --git a/app/schulis-simulationssystem/3.0/src/ls zustaende parameter kurve b/app/schulis-simulationssystem/3.0/src/ls zustaende parameter kurve new file mode 100644 index 0000000..4b16b2a --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls zustaende parameter kurve @@ -0,0 +1,6 @@ +PACKETzustaendeparameterkurveDEFINESneuekurve,neuerzustand,text,neuerparameter,platz,replace,SUB,schreibe,schreibebeobachtungspunkt,minimalwerte,maximalwerte,leseerstenbeobachtungspunkt,lesenaechstenbeobachtungspunkt,leseersten,lesenaechsten,lesevorherigen,naechstezeit,vorherigezeit,KURVE,ZUSTAND,PARAMETER,DSUB,:=,CAT,copy,zustand,parameter,endederloesung,anfangderloesung,endedestabspeichers,letzterwert,letztezeit,PLUS,kurve1,epsilon,imdefbereich:LETmaxdimension=20;LETmaxpunktspeicher=1000,maxbpunktspeicher=1000;LETreallaenge=8;LETtypnrkurve=1088;REAL CONSTdelta:=0.001;REAL CONSTminusdelta:=-0.001;LETstoptaste="a",abbruch=36,kurveleer=99;TYPE ZUSTAND=STRUCT(ROWmaxdimensionREALkoordinate,INTdimension);TYPE PARAMETER=STRUCT(ZUSTANDvektor);LET PUNKT=STRUCT(TEXTvektor,REALzeit);LET PUNKTE=STRUCT(INTzeilen,INTzeilenposition,ROWmaxpunktspeicherPUNKTtupel);LET BEOBACHTUNGSPUNKTE=STRUCT(INTzeilen,INTzeilenposition,ROWmaxbpunktspeicherPUNKTtupel);TYPE KURVE=BOUND STRUCT(INTinternedimension,PUNKTEpunkte,TEXTdsname,BEOBACHTUNGSPUNKTEbpunkte,ZUSTANDminimum,maximum);REAL VAReps:=0.0000000005;LETminh=0.00005;REAL CONSTnull:=1.0/1.0e60;PROCepsilon(REAL CONSTepseingabe):eps:=epseingabeEND PROCepsilon;ZUSTAND OP+(ZUSTAND CONSTa,ZUSTAND CONSTb):INT VARi;ZUSTAND VARz;FORiFROM1UPTOa.dimensionREPz.koordinate(i):=a.koordinate(i)+b.koordinate(i)PER;z.dimension:=a.dimension;z.END OP+;ZUSTAND OP PLUS(ZUSTAND CONSTa,ZUSTAND CONSTb):INT VARi;ZUSTAND VARz;FORiFROM1UPTOa.dimensionREPz.koordinate(i):=a.koordinate(i)PER;FORiFROMa.dimension+1UPTOa.dimension+b.dimensionREPz.koordinate(i):=b.koordinate(i-a.dimension)PER;z.dimension:=a.dimension+b.dimension;z.END OP PLUS;ZUSTAND OP*(REAL CONSTzahl,ZUSTAND CONSTb):INT VARi;ZUSTAND VARz;z.dimension:=b.dimension;FORiFROM1UPTOb.dimensionREPz.koordinate(i):=zahl*b.koordinate(i)PER;z.END OP*;ZUSTAND OP-(ZUSTAND CONSTa,ZUSTAND CONSTb):a+((-1.0)*b)END OP-;INT OP DSUB(ZUSTAND CONSTz):z.dimensionEND OP DSUB;ZUSTAND PROCneuerzustand(INT CONSTdimension):ZUSTAND VARz;INT VARi;FORiFROM1UPTOdimensionREPz.koordinate(i):=0.0PER;z.dimension:=dimension;zEND PROCneuerzustand;PARAMETER PROCneuerparameter(INT CONSTdimension):PARAMETER VARp;p.vektor:=neuerzustand(dimension);pEND PROCneuerparameter;PROCreplace(ZUSTAND VARzustand,INT CONSTi,REAL CONSTwert):IFdecimalexponent(wert)<-126THENzustand.koordinate(i):=0.0ELSEzustand.koordinate(i):=wertFI END PROCreplace;PROCreplace(PARAMETER VARparameter,INT CONSTindex,REAL CONSTwert):replace(parameter.vektor,index,wert);END PROCreplace;REAL OP SUB(ZUSTAND CONSTzustand,INT CONSTi):zustand.koordinate(i)ENDOP SUB;REAL OP SUB(PARAMETER CONSTparameter,INT CONSTi):parameter.vektorSUBiENDOP SUB;TEXT PROCtext(ZUSTAND CONSTz):INT VARi;TEXT VARt:=(z.dimension*reallaenge)*"�";FORiFROM1UPTOz.dimensionREP IFdecimalexponent(z.koordinate(i))<-126THENreplace(t,i,0.0)ELSEreplace(t,i,z.koordinate(i))FI PER;tEND PROCtext;TEXT PROCtext(PARAMETER CONSTparameter):text(parameter.vektor)END PROCtext;ZUSTAND PROCzustand(TEXT CONSTt):INT VARi;ZUSTAND VARz:=neuerzustand(length(t)DIVreallaenge);FORiFROM1UPTOz.dimensionREPz.koordinate(i):=tRSUBiPER;zEND PROCzustand;PARAMETER PROCparameter(TEXT CONSTt):PARAMETER VARp;p.vektor:=zustand(t);pEND PROCparameter;OP:=(KURVE VARkurve,DATASPACE CONSTspace):CONCR(kurve):=spaceENDOP:=;DATASPACE PROCneuekurve(INT CONSTdimension,TEXT CONSTdsname):KURVE VARkurve;forget(dsname,quiet);kurve:=new(dsname);kurve.dsname:=dsname;kurve.minimum:=neuerzustand(dimension);kurve.maximum:=neuerzustand(dimension);kurve.internedimension:=dimension+1;kurve.punkte.zeilenposition:=1;kurve.punkte.zeilen:=0;kurve.bpunkte.zeilenposition:=1;kurve.bpunkte.zeilen:=0;type(old(dsname),typnrkurve);old(dsname).ENDPROCneuekurve;PROCschreibe(KURVE VARkurve,REAL CONSTzeit,ZUSTAND CONSTz):IFnochplatzda(kurve)THEN IFkurve.punkte.zeilenposition=1THENkurve.minimum:=z;kurve.maximum:=z;ELSEpruefeobkomponentenminimalodermaximalFI;kurve.punkte.tupel(kurve.punkte.zeilenposition).vektor:=text(z);IFdecimalexponent(zeit)<-126 +THENkurve.punkte.tupel(kurve.punkte.zeilenposition).zeit:=0.0ELSEkurve.punkte.tupel(kurve.punkte.zeilenposition).zeit:=zeit;FI;kurve.punkte.zeilenpositionINCR1;kurve.punkte.zeilenINCR1FI.pruefeobkomponentenminimalodermaximal:INT VARi;FORiFROM1UPTOz.dimensionREP IFz.koordinate(i)kurve.maximum.koordinate(i)THENkurve.maximum.koordinate(i):=z.koordinate(i)FI PER.ENDPROCschreibe;PROCschreibebeobachtungspunkt(KURVE VARkurve,REAL CONSTzeit,ZUSTAND CONSTz):IFnochtabplatzda(kurve)CANDnochplatzda(kurve)THENschreibe(kurve,zeit,z);schreibeintabspeicherFI.schreibeintabspeicher:kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).vektor:=text(z);kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).zeit:=zeit;kurve.bpunkte.zeilenpositionINCR1;kurve.bpunkte.zeilenINCR1.ENDPROCschreibebeobachtungspunkt;ZUSTAND PROCminimalwerte(KURVE CONSTkurve):kurve.minimumENDPROCminimalwerte;ZUSTAND PROCmaximalwerte(KURVE CONSTkurve):kurve.maximumENDPROCmaximalwerte;BOOL PROCnochplatzda(KURVE VARkurve):NOT(kurve.punkte.zeilenposition>maxpunktspeicher)END PROCnochplatzda;BOOL PROCnochtabplatzda(KURVE VARkurve):NOT(kurve.bpunkte.zeilenposition>maxbpunktspeicher)END PROCnochtabplatzda;BOOL PROCplatz(KURVE CONSTkurve):NOT(kurve.punkte.zeilenposition>maxpunktspeicher)END PROCplatz;PROCleseersten(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):kurve.punkte.zeilenposition:=1;lieszeit;lieskoordinaten.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition).zeit.lieskoordinaten:z:=zustand(kurve.punkte.tupel(kurve.punkte.zeilenposition).vektor).END PROCleseersten;PROClesenaechsten(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):IF NOTendederloesung(kurve)THENkurve.punkte.zeilenpositionINCR1;lieszeit;lieskoordinaten;ELSEz:=neuerzustand(kurve.internedimension-1)FI.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition).zeit.lieskoordinaten:z:=zustand(kurve.punkte.tupel(kurve.punkte.zeilenposition).vektor).END PROClesenaechsten;PROClesevorherigen(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):IF NOTanfangderloesung(kurve)THENkurve.punkte.zeilenpositionDECR1;lieszeit;lieskoordinaten;ELSEz:=neuerzustand(kurve.internedimension-1)FI.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition).zeit.lieskoordinaten:z:=zustand(kurve.punkte.tupel(kurve.punkte.zeilenposition).vektor).END PROClesevorherigen;PROCvorherigezeit(KURVE VARkurve,REAL VARzeit):IF NOTanfangderloesung(kurve)THENlieszeit;FI.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition-1).zeit.END PROCvorherigezeit;PROCnaechstezeit(KURVE VARkurve,REAL VARzeit):IF NOTendederloesung(kurve)THENlieszeit;FI.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition+1).zeit.END PROCnaechstezeit;PROCleseerstenbeobachtungspunkt(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):kurve.bpunkte.zeilenposition:=1;lieszeit;lieskoordinaten;kurve.bpunkte.zeilenpositionINCR1.lieszeit:zeit:=kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).zeit.lieskoordinaten:z:=zustand(kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).vektor).END PROCleseerstenbeobachtungspunkt;PROClesenaechstenbeobachtungspunkt(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):IF NOTendedestabspeichers(kurve)THENzeitlesen;koordinatenlesen;kurve.bpunkte.zeilenpositionINCR1ELSEz:=neuerzustand(kurve.internedimension-1)FI.zeitlesen:zeit:=kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).zeit.koordinatenlesen:z:=zustand(kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).vektor).END PROClesenaechstenbeobachtungspunkt;BOOL PROCendederloesung(KURVE VARkurve):kurve.punkte.zeilenposition>=kurve.punkte.zeilenEND PROCendederloesung;BOOL PROCanfangderloesung(KURVE VARkurve):kurve.punkte.zeilenposition<=1END PROCanfangderloesung;BOOL PROCendedestabspeichers(KURVE CONSTkurve):kurve.bpunkte.zeilenposition>kurve.bpunkte.zeilenEND PROCendedestabspeichers;OP:=(KURVE VARa,KURVE CONSTb):CONCR(a):=old(b.dsname)END OP:=;PROCcopy(KURVE VARa,TEXT CONSTdsname,KURVE CONSTb):IFexists(dsname)THENforget(dsname, +quiet)FI;copy(b.dsname,dsname);CONCR(a):=old(dsname);a.dsname:=dsname;ENDPROCcopy;OP:=(ZUSTAND VARa,ZUSTAND CONSTb):a.dimension:=b.dimension;INT VARi;FORiFROM1UPTOb.dimensionREP IFdecimalexponent(b.koordinate(i))<-126THENa.koordinate(i):=0.0ELSEa.koordinate(i):=b.koordinate(i)FI PER END OP:=;OP:=(PARAMETER VARa,PARAMETER CONSTb):a.vektor:=b.vektorEND OP:=;OP CAT(KURVE VARa,b):ersterpunkt;ersterbpunkt;WHILEnochplatzda(a)CAND NOTendederloesung(b)REPfuegenaechstenpunktanPER;WHILEnochtabplatzda(a)CAND NOTendedestabspeichers(b)REPfuegenaechstenbeobachtungspunktanPER.ersterpunkt:REAL VARt;ZUSTAND VARz;leseersten(b,t,z);a.punkte.zeilenposition:=a.punkte.zeilen+1.ersterbpunkt:leseerstenbeobachtungspunkt(b,t,z);a.bpunkte.zeilenposition:=a.bpunkte.zeilen+1.fuegenaechstenpunktan:lesenaechsten(b,t,z);schreibe(a,t,z).fuegenaechstenbeobachtungspunktan:lesenaechstenbeobachtungspunkt(b,t,z);a.bpunkte.tupel(a.bpunkte.zeilenposition).vektor:=text(z);a.bpunkte.tupel(a.bpunkte.zeilenposition).zeit:=t;a.bpunkte.zeilenpositionINCR1;a.bpunkte.zeilenINCR1.END OP CAT;ZUSTAND PROCletzterwert(KURVE CONSTkurve):zustand(kurve.punkte.tupel(kurve.punkte.zeilen).vektor)END PROCletzterwert;REAL PROCletztezeit(KURVE CONSTkurve):IFkurve.punkte.zeilen=0THEN0.0ELSEkurve.punkte.tupel(kurve.punkte.zeilen).zeitFI END PROCletztezeit;REAL CONSTsechzehnneuntel:=16.0/9.0,vierundsechzigneuntel:=64.0/9.0,zweihundertsechsundfuenfzigneuntel:=256.0/9.0,neunviertel:=9.0/4.0;PROCdiffsys(REAL VARx,h0,zwischenzeit,ZUSTAND VARy,s,zwischenzustand,PARAMETER CONSTp,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)funk):REAL VARa,b,b1,c,g,u,v,ta,fc;INT VARi,j,k,kk,jj,l,m,r,sr,n,kplus1,jplus1,jjplus1;ZUSTAND VARya,yl,ym,dy,dz;BOOL VARkonv,bo,bh;ROW7ZUSTAND VARdt;ROW7REAL VARd;ROW8ZUSTAND VARyg,yh;enablestop;initialisierungen;berechneschrittweitefallsnoetig;REPa:=h0+x;fc:=1.5;bo:=FALSE;m:=1;r:=2;sr:=3;jj:=-1;FORjFROM0UPTO9REPabbruchfallsgewuenscht;jplus1:=j+1;IFboTHENd(2):=sechzehnneuntel;d(4):=vierundsechzigneuntel;d(6):=zweihundertsechsundfuenfzigneuntelELSEd(2):=neunviertel;d(4):=9.0;d(6):=36.0FI;konv:=(j>2);IFj>6THENl:=6;d(7):=64.0;fc:=0.6*fcELSEl:=j;d(jplus1):=real(m*m)FI;m:=m+m;g:=h0/real(m);b:=g+g;IFbhCANDj<8THEN FORiFROM1UPTOnREPym.koordinate(i):=yh(jplus1).koordinate(i);yl.koordinate(i):=yg(jplus1).koordinate(i)PER ELSEkk:=(m-2)DIV2;m:=m-1;FORiFROM1UPTOnREPyl.koordinate(i):=ya.koordinate(i);ym.koordinate(i):=ya.koordinate(i)+(g*dz.koordinate(i));PER;FORkFROM1UPTOmREPdy:=funk(x+(real(k)*g),ym,p);FORiFROM1UPTOnREPu:=(yl.koordinate(i))+b*(dy.koordinate(i));yl.koordinate(i):=ym.koordinate(i);ym.koordinate(i):=u;u:=abs(u);IFu>s.koordinate(i)THENs.koordinate(i):=uFI PER;IFk=kkCANDk<>2THENjj:=1+jj;jjplus1:=jj+1;yh(jjplus1).koordinate:=ym.koordinate;zwischenzustand.koordinate:=ym.koordinate;yg(jjplus1).koordinate:=yl.koordinate;zwischenzeit:=x+(real(k+1)*g);FI PER FI;dy:=funk(a,ym,p);FORiFROM1UPTOnREPv:=dt(1).koordinate(i);dt(1).koordinate(i):=(ym.koordinate(i)+yl.koordinate(i)+g*dy.koordinate(i))/2.0;c:=dt(1).koordinate(i);ta:=c;FORkFROM1UPTOlREPkplus1:=k+1;b1:=d(kplus1)*v;b:=b1-c;u:=v;IFabs(b)>0.0THENb:=(c-v)/b;u:=c*b;c:=b1*b;FI;v:=dt(kplus1).koordinate(i);dt(kplus1).koordinate(i):=u;ta:=u+taPER;IFabs(y.koordinate(i)-ta)>eps*s.koordinate(i)THENkonv:=FALSE FI;y.koordinate(i):=taPER;IFkonvTHENendeFI;d(3):=4.0;d(5):=16.0;bo:=NOTbo;m:=r;r:=sr;sr:=m+mPER;bh:=NOTbh;IFdecimalexponent(h0)>-120THENh0:=(h0/2.0);IFkleinstmoeglicheschrittweite(x,h0)>h0THENh0:=h0+h0;endeFI;ELSEendeFI PER.abbruchfallsgewuenscht:IFincharety=stoptasteTHENerrorstop(abbruch,"");FI;.initialisierungen:n:=y.dimension;IFn=0THENzwischenzeit:=x+h0/2.0;x:=x+h0;LEAVEdiffsys;FI;ya.dimension:=n;yl.dimension:=n;ym.dimension:=n;dy.dimension:=n;dz.dimension:=n;FORiFROM1UPTOnREPya.koordinate(i):=0.0;yl.koordinate(i):=0.0;ym.koordinate(i):=0.0;dy.koordinate(i):=0.0;dz.koordinate(i):=0.0;PER;FORiFROM1UPTO7REP FORjFROM1UPTOnREPdt(i).koordinate(j):=0.0PER;d(i):=0.0;dt(i).dimension:=n;PER;FORiFROM1UPTO8REP FORjFROM1UPTOnREPyg(i). +koordinate(j):=0.0;yh(i).koordinate(j):=0.0PER;yg(i).dimension:=n;yh(i).dimension:=n;PER;dz:=funk(x,y,p);bh:=FALSE;ya.koordinate:=y.koordinate;.berechneschrittweitefallsnoetig:IFkomponentennahe0THENberechneschrittweite(y,dz,x,h0)FI.komponentennahe0:FORiFROM1UPTOnREP IFabs(ySUBi)0.0CANDabs(ySUBi)>0.0THENh0:=min(h0,abs((ySUBi)/(dzSUBi)));FI;PER;IFh0=0.0THENh0:=hFI;h0:=max(h0,kleinstmoeglicheschrittweite(t,h0));.END PROCberechneschrittweite;REAL PROCkleinstmoeglicheschrittweite(REAL CONSTt,h0):REAL VARzw:=5.0;INT CONSTexponentvont:=decimalexponent(t);IFt=0.0THENh0ELIF(exponentvont-decimalexponent(h0))>12THENsetexp(exponentvont-12,zw);zwELSEh0FI.END PROCkleinstmoeglicheschrittweite;KURVE PROCkurve1(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)fkt,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cofkt,ZUSTAND CONSTanfangswert,ZUSTAND CONSTunteregrenze,oberegrenze,REAL CONSTanfangszeitpunkt,REAL CONSTbeobachtungsdauer,PARAMETER CONSTparameter,INT CONSTbeo,codimension,TEXT CONSTdsname,INT VARfehler):KURVE VARkurve:=neuekurve(codimension+anfangswert.dimension,dsname);bereiteanfangvor;bearbeiteerstenpunkt;bearbeiteallenaechstenpunkte;kurve.bereiteanfangvor:INT VARm,n:=anfangswert.dimension;REAL VARbeobachtungszeitpunkt,beobachtungsabstand:=0.0,t,h0,h,hmax,zwischenzeit;ZUSTAND VARx:=neuerzustand(n),zwischenzustand:=neuerzustand(n),s:=neuerzustand(n);beobachtungsabstand:=beobachtungsdauer/real(beo-1);beobachtungsabstand:=max(kleinstmoeglicheschrittweite(anfangszeitpunkt,beobachtungsabstand),beobachtungsabstand);h0:=beobachtungsabstand;hmax:=h0;x:=anfangswert;t:=anfangszeitpunkt;berechneschrittweitemittest;beobachtungszeitpunkt:=anfangszeitpunkt;fehler:=0.berechneschrittweitemittest:disablestop;berechneschrittweite(x,fkt(t,x,parameter),t,h0);IFerrorda(fehler)CORbeobachtungsdauer=0.0THENfehler:=kurveleer;LEAVEkurve1WITHkurveFI.bearbeiteerstenpunkt:schreibeundtestebeomitcof(PROCcofkt,kurve,anfangszeitpunkt,anfangswert,parameter,fehler);IFaufgetreten(fehler)CORbeobachtungsdauer=0.0THENfehler:=kurveleer;LEAVEkurve1WITHkurveFI.bearbeiteallenaechstenpunkte:INT VARcursx:=0,cursy:=0;getcursor(cursx,cursy);FORmFROM1UPTObeo-1REPcursor(cursx,cursy);out(text(m));beobachtungszeitpunkt:=beobachtungszeitpunkt+beobachtungsabstand;verarbeitenaechstepunkte;IFaufgetreten(fehler)THEN LEAVEbearbeiteallenaechstenpunkteFI;schreibeundtestepunktmitcof(PROCcofkt,kurve,zwischenzeit,zwischenzustand,parameter,fehler);IF NOTaufgetreten(fehler)THENschreibeundtestebeomitcof(PROCcofkt,kurve,t,x,parameter,fehler);FI;IFaufgetreten(fehler)THEN LEAVEkurve1WITHkurveFI;PER.verarbeitenaechstepunkte:REP IFh0>hmaxTHENh0:=hmaxFI;IFt+h0>beobachtungszeitpunktTHENh:=h0;h0:=beobachtungszeitpunkt-t;IFh0>=kleinstmoeglicheschrittweite(t,h0)THENerhaltenaechstenpunkt;ELSE LEAVEverarbeitenaechstepunkteFI;h0:=hELSEerhaltenaechstenpunktFI;IFabs(t-beobachtungszeitpunkt)beobachtungszeitpunktTHEN LEAVEverarbeitenaechstepunkteFI;schreibepunktinkurvePER.erhaltenaechstenpunkt:disablestop;diffsys(t,h0,zwischenzeit,x,s,zwischenzustand,parameter,PROCfkt);IF NOTerrorda(fehler)THENfehler:=imdefbereich(x,unteregrenze,oberegrenze);FI;IFaufgetreten(fehler)THEN LEAVEverarbeitenaechstepunkteFI;.schreibepunktinkurve:schreibeundtestepunktmitcof(PROCcofkt,kurve,zwischenzeit,zwischenzustand,parameter,fehler);IFaufgetreten(fehler)THEN LEAVEkurve1WITHkurveFI.END PROCkurve1;BOOL PROCaufgetreten(INT CONSTfehler):fehler<>0.END PROCaufgetreten;PROCschreibeundtestepunktmitcof(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cofkt,KURVE VARkurve,REAL CONSTzwischenzeit,ZUSTAND CONSTzwischenzustand,PARAMETER CONSTparamliste,INT VARfehlernr):ZUSTAND VARhilfsvar;disablestop;hilfsvar:=cofkt( +zwischenzeit,zwischenzustand,paramliste);IF NOTerrorda(fehlernr)THENschreibe(kurve,zwischenzeit,zwischenzustandPLUShilfsvar);FI;END PROCschreibeundtestepunktmitcof;PROCschreibeundtestebeomitcof(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cofkt,KURVE VARkurve,REAL CONSTzeitpunkt,ZUSTAND CONSTzwischenzustand,PARAMETER CONSTparamliste,INT VARfehlernr):ZUSTAND VARhilfsvar;disablestop;hilfsvar:=cofkt(zeitpunkt,zwischenzustand,paramliste);IF NOTerrorda(fehlernr)THENschreibebeobachtungspunkt(kurve,zeitpunkt,zwischenzustandPLUShilfsvar);FI;.END PROCschreibeundtestebeomitcof;BOOL PROCerrorda(INT VARerrornr):IFiserrorTHENsetzeerrornr;clearerror;enablestop;TRUE ELSEerrornr:=0;FALSE FI.setzeerrornr:IFerrorcode=abbruchTHENerrornr:=abbruchELSEerrornr:=1FI.END PROCerrorda;INT PROCimdefbereich(ZUSTAND CONSTz,zug,zog):INT CONSTn:=z.dimension;INT VARi,fehler:=0;FORiFROM1UPTOnREPpruefekomponentePER;fehler.pruefekomponente:IF(z.koordinate(i)-zug.koordinate(i)delta)THENfehler:=2FI.END PROCimdefbereich;END PACKETzustaendeparameterkurve; + diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 1.korrektur b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 1.korrektur new file mode 100644 index 0000000..7ef9540 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 1.korrektur @@ -0,0 +1,4 @@ +PACKETlsdialog1DEFINESeckeobenlinks,balkenoben,eckeobenrechts,balkenrechts,eckeuntenlinks,balkenlinks,eckeuntenrechts,balkenunten,waagerecht,senkrecht,kreuz,cursoron,cursoroff,clearbuffer,clearbufferandcount,center,invers,page,pageup,outframe,outmenuframe,eraseframe,stdgraphicchar,ft20graphicchar,ibmgraphicchar,AREA,:=,fill,areax,areay,areaxsize,areaysize,cursor,getcursor,out,outinvers,outwithbeam,outinverswithbeam,erase,eraseinvers,erasewithbeam,writepermanentfootnote,oldfootnote,footnote:TYPE AREA=STRUCT(INTx,y,xsize,ysize);LETblank=" ",markein="",markaus="",cleol="�";TEXT CONSTfehlermeldung:="Unzulässige Größen!";TEXT VAReol:="+",eor:="+",eul:="+",eur:="+",bo:="+",br:="+",bl:="+",bu:="+",waa:="-",sen:="|",kr:="+",cursorsichtbar:="",cursorunsichtbar:="";TEXT VARpermanentefusszeile:="";PROCwritepermanentfootnote(TEXT CONSTt):permanentefusszeile:=t;footnote(t)END PROCwritepermanentfootnote;PROColdfootnote:footnote(permanentefusszeile)END PROColdfootnote;PROCfootnote(TEXT CONSTt):INT VARx,y;getcursor(x,y);cursor(1,24);out(invers(text(t,76)));cursor(x,y)END PROCfootnote;TEXT PROCeckeobenlinks:eolEND PROCeckeobenlinks;TEXT PROCeckeobenrechts:eorEND PROCeckeobenrechts;TEXT PROCeckeuntenlinks:eulEND PROCeckeuntenlinks;TEXT PROCeckeuntenrechts:eurEND PROCeckeuntenrechts;TEXT PROCbalkenoben:boEND PROCbalkenoben;TEXT PROCbalkenlinks:blEND PROCbalkenlinks;TEXT PROCbalkenrechts:brEND PROCbalkenrechts;TEXT PROCbalkenunten:buEND PROCbalkenunten;TEXT PROCwaagerecht:waaEND PROCwaagerecht;TEXT PROCsenkrecht:senEND PROCsenkrecht;TEXT PROCkreuz:krEND PROCkreuz;PROCeckeobenlinks(TEXT CONSTt):eol:=tEND PROCeckeobenlinks;PROCeckeobenrechts(TEXT CONSTt):eor:=tEND PROCeckeobenrechts;PROCeckeuntenlinks(TEXT CONSTt):eul:=tEND PROCeckeuntenlinks;PROCeckeuntenrechts(TEXT CONSTt):eur:=tEND PROCeckeuntenrechts;PROCbalkenoben(TEXT CONSTt):bo:=tEND PROCbalkenoben;PROCbalkenlinks(TEXT CONSTt):bl:=tEND PROCbalkenlinks;PROCbalkenrechts(TEXT CONSTt):br:=tEND PROCbalkenrechts;PROCbalkenunten(TEXT CONSTt):bu:=tEND PROCbalkenunten;PROCwaagerecht(TEXT CONSTt):waa:=tEND PROCwaagerecht;PROCsenkrecht(TEXT CONSTt):sen:=tEND PROCsenkrecht;PROCkreuz(TEXT CONSTt):kr:=tEND PROCkreuz;PROCstdgraphicchar:eckeobenlinks("+");eckeobenrechts("+");eckeuntenlinks("+");eckeuntenrechts("+");balkenoben("+");balkenrechts("+");balkenlinks("+");balkenunten("+");waagerecht("-");senkrecht("|");kreuz("+");cursorsichtbar:="";cursorunsichtbar:=""END PROCstdgraphicchar;PROCft20graphicchar:eckeobenlinks("�R��S");eckeobenrechts("�RD�S");eckeuntenlinks("�RH�S");eckeuntenrechts("�RL�S");balkenoben("�RP�S");balkenrechts("�RT�S");balkenlinks("�RX�S");balkenunten("�R\�S");waagerecht("�R`�S");senkrecht("�Rd�S");kreuz("�Rh�S");cursorsichtbar:="�-1";cursorunsichtbar:="�-0";ft20statuszeilenausEND PROCft20graphicchar;PROCft20statuszeilenaus:out("�.A")END PROCft20statuszeilenaus;PROCft20statuszeilenan:out("�.�")END PROCft20statuszeilenan;PROCibmgraphicchar:eckeobenlinks("�");eckeobenrechts("�");eckeuntenlinks("̈");eckeuntenrechts("�");balkenoben("̗");balkenrechts("ω");balkenlinks("�");balkenunten("̊");waagerecht("̊");senkrecht("�");kreuz("�");cursorsichtbar:="";cursorunsichtbar:=""END PROCibmgraphicchar;PROCcursoron:out(cursorsichtbar)END PROCcursoron;PROCcursoroff:out(cursorunsichtbar)END PROCcursoroff;PROCcursoron(TEXT CONSTt):cursorsichtbar:=tEND PROCcursoron;PROCcursoroff(TEXT CONSTt):cursorunsichtbar:=tEND PROCcursoroff;PROCclearbuffer:REP UNTILincharety=""PER END PROCclearbuffer;INT PROCclearbufferandcount(TEXT CONSTzeichen):INT VARzaehler:=0;TEXT VARzeichenkette:="",ch;IFzeichen=""THENclearbuffer;LEAVEclearbufferandcountWITH0FI;ermittlediezeichenkette;untersucheaufvorhandenezeichen;zaehler.ermittlediezeichenkette:REPch:=incharety(1);zeichenketteCATchUNTILch=""PER.untersucheaufvorhandenezeichen:INT VARi;FORiFROM1UPTOlength(zeichenkette)REP IFpos(subtext(zeichenkette,i),zeichen)=1THENzaehlerINCR1FI PER.END PROCclearbufferandcount;TEXT PROCcenter(INT CONSTxsize,TEXT CONSTt):TEXT VARzeile:=compress(t +);zeile:=((xsize-length(zeile))DIV2)*blank+zeile;zeileCAT(xsize-length(zeile))*blank;zeileEND PROCcenter;TEXT PROCcenter(TEXT CONSTt):center(79,t)END PROCcenter;TEXT PROCinvers(TEXT CONSTt):TEXT VARneu:=markein;neuCATt;neuCAT" ";neuCATmarkaus;neuEND PROCinvers;PROCpage(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI;cursor(x,y).ineinemstreich:FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(leerzeile)PER.END PROCpage;PROCpage(AREA CONSTa):page(a.x,a.y,a.xsize,a.ysize)END PROCpage;PROCpageup(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI.ineinemstreich:FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(leerzeile)PER.END PROCpageup;PROCpageup(AREA CONSTa):pageup(a.x,a.y,a.xsize,a.ysize)END PROCpageup;PROCoutframe(INT CONSTx,y,xsize,ysize):TEXT VARlinie:=(xsize-2)*waagerecht;INT VARzeiger;IFx<1CORy<1CORxsize<8CORysize<3CORx+xsize>80CORy+ysize>25THEN LEAVEoutframeFI;maleoben;maleseiten;maleunten.maleoben:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).maleseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(senkrecht);cursor(x+xsize-1,y+zeiger);out(senkrecht)PER.maleunten:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts)END PROCoutframe;PROCoutframe(AREA CONSTa):IFa.x-1<1ORa.y-1<1ORa.xsize+2>79ORa.ysize+2>24ORa.x+a.xsize+1>80ORa.y+a.ysize+1>25THEN LEAVEoutframeFI;outframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutframe;PROCoutmenuframe(INT CONSTx,y,xsize,ysize):INT VARi;TEXT VARlinie;untersucheangaben;schreiberahmen.untersucheangaben:IFx<0CORy<0CORx+xsize>81CORy+ysize>26THEN LEAVEoutmenuframeFI.schreiberahmen:IFx=0CORy=0CORxsize=81CORysize=26THENlinie:=xsize*waagerecht;zeichnereduziertenrahmenELSElinie:=(xsize-2)*waagerecht;zeichnevollenrahmenFI.zeichnereduziertenrahmen:zeichneoberlinie;zeichneunterlinie.zeichneoberlinie:cursor(1,2);out(linie).zeichneunterlinie:cursor(1,23);out(linie).zeichnevollenrahmen:schreibekopf;schreiberumpf;schreibefuss;schreibekopfleiste;schreibefussleiste.schreibekopf:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreiberumpf:FORiFROMy+1UPTOy+ysize-2REPcursor(x,i);out(senkrecht);cursor(x+xsize-1,i);out(senkrecht)PER.schreibefuss:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).schreibekopfleiste:cursor(x,y+2);schreibebalkenlinie.schreibefussleiste:cursor(x,y+ysize-3);schreibebalkenlinie.schreibebalkenlinie:out(balkenlinks);out(linie);out(balkenrechts).END PROCoutmenuframe;PROCoutmenuframe(AREA CONSTa):outmenuframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutmenuframe;PROCeraseframe(INT CONSTx,y,xsize,ysize):INT VARzeiger;TEXT VARleerzeile:=xsize*blank;loescheoben;loescheseiten;loescheunten.loescheoben:cursor(x,y);out(leerzeile).loescheseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(blank);cursor(x+xsize-1,y+zeiger);out(blank)PER.loescheunten:cursor(x,y+ysize-1);out(leerzeile).END PROCeraseframe;OP:=(AREA VARziel,AREA CONSTquelle):CONCR(ziel):=CONCR(quelle)END OP:=;PROCfill(AREA VARziel,INT CONSTa,b,c,d):IFa<1CORb<1CORa>79CORb>24CORc<8CORd<1CORc>79CORd>24CORa+c>80CORb+d>25THENerrorstop(fehlermeldung)FI;ziel.x:=a;ziel.y:=b;ziel.xsize:=c;ziel.ysize:=dEND PROCfill;INT PROCareax(AREA CONSTa):a.xEND PROCareax;INT PROCareay(AREA CONSTa):a.yEND PROCareay;INT PROCareaxsize(AREA CONSTa):a.xsizeEND PROCareaxsize;INT PROCareaysize(AREA CONSTa):a.ysizeEND PROCareaysize;PROCout(TEXT CONSTt,INT CONSTbreite):outtext(t,1,breite)END PROCout;PROCerase(INT CONSTbreite):out(breite*blank)END PROCerase;PROCcursor(AREA CONSTa,INT CONSTspa,zei):cursor(a.x+spa-1,a.y+zei-1)END PROCcursor;PROCgetcursor(AREA CONSTa,INT VARspalte,zeile):INT VARx,y;getcursor(x,y);spalte:=x-a.x+1;zeile:=y-a.y+1END PROCgetcursor;PROCout(AREA CONSTa,INT CONST +spa,zei,TEXT CONSTt):out(a,spa,zei,t,LENGTHt)END PROCout;PROCout(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEouttext(t,1,laenge)FI.ueberpruefecursorangaben:IFspa>a.xsizeCORzei>a.ysizeCORspa<1CORzei<1THEN LEAVEoutFI.positionierecursor:cursor(a.x+spa-1,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa+1.verkuerzteausgabe:outtext(t,1,a.xsize-spa+1)END PROCout;PROCerase(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):out(a,spa,zei,laenge*blank,laenge)END PROCerase;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinvers(a,spa,zei,t,LENGTHt)END PROCoutinvers;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=markein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-1);ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;out(hilf).ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEoutinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1.END PROCoutinvers;PROCeraseinvers(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+3)FI.ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEeraseinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1.verkuerzteausgabe:erase(a.xsize-spa+2).END PROCeraseinvers;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outwithbeam(a,spa,zei,t,LENGTHt)END PROCoutwithbeam;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCAT" ";IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCAT" ";hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutwithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.END PROCoutwithbeam;PROCerasewithbeam(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+6)FI.ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEerasewithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.verkuerzteausgabe:erase(a.xsize-spa+4).END PROCerasewithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinverswithbeam(a,spa,zei,t,LENGTHt)END PROCoutinverswithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCATblank;hilfCATmarkein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutinverswithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.END PROCoutinverswithbeam;END PACKETlsdialog1; + diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 2.simsel b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 2.simsel new file mode 100644 index 0000000..b2a5323 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 2.simsel @@ -0,0 +1,9 @@ +PACKETls dialog 2DEFINES some, one,ls exit key,some with max, some exactly,double some,infix namen,ohne praefix,not empty:LET maxentries=200;LET zeichenstring= ""1""27""3""10""13""12""8""2"o ?",oben untenreturnruboutkringelblank=""3""10""13""12"o ",qeinsneunh="w19m";LETzurueck=""8"",piep=""7"",hop=1,esc=2,oben=3,unten=4,return=5,rubout=6,links=7,rechts=8,kringel=9,leertaste=10,fragezeichen=11,letztes zeichen=11;LET punkt = ".",blank = " ";LET zwei thesauri = TRUE; +INT VARx,y,xsize,ysize,maxeintraege,anzahl:=0,ersteauswahlzeile,virtuellercursor,reellercursor,ausgewaehlte,aufbauzaehler,minsel,maxsel;TEXT VARkennzeile1,kennzeile2,registrierkette:="",exitkey:="",hopmoeglichkeiten,eingabemoeglichkeiten;BOOL VARabbruch,auswahlende,wechsel,linkerth,info,parallelauswahl;THESAURUS VARthes1,thes2;DATASPACE VARds;BOUND ROWmaxentriesTEXT VAReintrag;ROW2TEXT CONSTfehlermeldung:=ROW2TEXT:("Unzulässige Cursorwerte bei der Auswahl","Fenster für Auswahl zu klein (x < 56 / y < 15)");ROW18TEXT CONSThinweis:=ROW18TEXT:(" Bitte warten...!"," Info: Weiter: Menü: ","Weitere Einträge"," Info: Menü: "," INFORMATIONEN ZUR AUSWAHL AUS DER LISTE"," Positionierung der Schreibmarke:"," Pfeil auf/ab : eine Position nach oben/unten"," HOP Pfeil auf/ab : auf erste/letzte Pos. der Seite"," ESC 1/ESC 9 : auf erste/letzte Pos. der Liste"," Ankreuzen und Löschen von Kreuzen:"," RETURN/x : den Eintrag ankreuzen"," RUBOUT/o/Leertaste: Kreuz vor dem Eintrag löschen"," HOP RETURN/HOP x : alle folgenden Eintr. ankreuzen"," HOP RUBOUT/HOP o : alle folgenden Kreuze löschen"," /HOP Leertaste","Die Anzahl der ausgewählten Einträge ist falsch. Weiter mit beliebiger Taste"," Weiter mit beliebiger Taste!"," Pfeil links/rechts: zwischen den beiden Listen wechseln");TEXT PROClsexitkey:exitkeyEND PROClsexitkey;PROClsexitkey(TEXT CONSTausgang):exitkey:=ausgang;END PROClsexitkey;PROCauswahl(THESAURUS CONSTt,TEXT CONSTtext1,text2,TEXT VARmarkers):IFaufbauzaehler>0THENwerteinitialisieren;namenbesorgen;bildschirmaufbauen;wechsel:=TRUE END IF;IFparallelauswahlTHENaufbauzaehlerDECR1ELSEaufbauzaehlerDECR2END IF;IFaufbauzaehler<0THENauswaehlenlassenEND IF.werteinitialisieren:eintrag:=ds;kennzeile1:=text1;kennzeile2:=text2;abbruch:=FALSE;wechsel:=FALSE;virtuellercursor:=1;reellercursor:=1;ersteauswahlzeile:=y+4;anzahl:=0;eingabemoeglichkeiten:=zeichenstring+markers;hopmoeglichkeiten:=obenuntenreturnruboutkringelblank+markers;ausgewaehlte:=0;maxeintraege:=ysize-6.namenbesorgen:fischedienamenausdemthesaurus;registrierkette:=anzahl*"o";IFkeineintragvorhandenTHENabbruch:=TRUE;auswahlende:=TRUE;LEAVEauswahlFI.bildschirmaufbauen:gibhinweisaus(kennzeile1,kennzeile2);bauebildschirmauf(1).auswaehlenlassen:kreuzean.fischedienamenausdemthesaurus:INT VARzeiger;FORzeigerFROM1UPTOhighestentry(t)REP IFname(t,zeiger)<>""THENanzahlINCR1;eintrag[anzahl]:=name(t,zeiger)FI PER.keineintragvorhanden:anzahl=0.END PROCauswahl;PROCreellencursorsetzen:INT CONSTmaxlaenge:=min(65,xsize-9);TEXT VARhilf:=marke(virtuellercursor);hilfCATzurueck;hilfCATinvers(subtext(eintrag(virtuellercursor),1,maxlaenge));cursor(x+1,ersteauswahlzeile+reellercursor-1);out(hilf)END PROCreellencursorsetzen;PROCbauebildschirmauf(INT CONSTanfang):gibkopfzeileaus;gibnamenstabelleaus;gibfusszeileaus;loescheggfrestbereich.gibkopfzeileaus:cursor(x+1,ersteauswahlzeile-1);IFreellercursor=virtuellercursorTHENout((xsize-2)*punkt)ELSEout((xsize-length(hinweis[3])-5)*punkt);out(invers(hinweis[3]))FI;line.gibnamenstabelleaus:INT VARzeiger,zaehler:=-1;FORzeigerFROManfangUPTOgrenzeREPzaehlerINCR1;cursor(x+1,ersteauswahlzeile+zaehler);outtext(marke(zeiger)+subtext(eintrag[zeiger],1,65),1,xsize-4);out(" ");PER.gibfusszeileaus:cursor(x+1,ersteauswahlzeile+zaehler+1);IF NOT((virtuellercursor+maxeintraege-reellercursor)"o"END PROC +angekreuzt;PROCkreuzean:auswahlende:=FALSE;wechsel:=FALSE;reellencursorsetzen;REPzeichenlesen;zeicheninterpretierenUNTILauswahlendePER.zeichenlesen:TEXT VARzeichen;inchar(zeichen).zeicheninterpretieren:SELECTpos(eingabemoeglichkeiten,zeichen)OF CASEhop:hopkommandoverarbeitenCASEesc:esckommandoverarbeitenCASEoben:nachobenCASEunten:nachuntenCASEreturn:ankreuzenweiter;evtlaufhoerenCASErubout:auskreuzenweiterCASEkringel,leertaste:auskreuzen(virtuellercursor,TRUE)CASElinks:nachlinkswennerlaubtCASErechts:nachrechtswennerlaubtCASEfragezeichen:info:=TRUE;auswahlende:=TRUE CASE0:out(piep)OTHERWISEankreuzen(virtuellercursor,zeichen,TRUE);evtlaufhoerenEND SELECT.evtlaufhoeren:IFmaxsel=1THENauswahlende:=TRUE;IFparallelauswahlTHENwechsel:=TRUE END IF;loeschecursor;LEAVEkreuzeanFI.END PROCkreuzean;PROChopkommandoverarbeiten:zweiteszeichenlesen;zeicheninterpretieren.zweiteszeichenlesen:TEXT VARzweiteszeichen;inchar(zweiteszeichen).zeicheninterpretieren:SELECTpos(hopmoeglichkeiten,zweiteszeichen)OF CASE0:out(piep)CASE1:hopnachobenCASE2:hopnachuntenCASE3:zweiteszeichen:=eingabemoeglichkeitenSUB(letzteszeichen+1);alledarunterankreuzenCASE4,5,6:alledarunterloeschenOTHERWISEalledarunterankreuzenEND SELECT.alledarunterankreuzen:INT VARi;FORiFROMvirtuellercursorUPTOanzahlREPankreuzen(i,zweiteszeichen,FALSE)PER;bildaktualisieren;reellencursorsetzen.alledarunterloeschen:INT VARj;FORjFROMvirtuellercursorUPTOanzahlREPauskreuzen(j,FALSE)PER;bildaktualisieren;reellencursorsetzen.hopnachoben:IFganzobenTHENout(piep)ELIFobenaufderseiteTHENraufblaetternELSEtopofpageFI.ganzoben:virtuellercursor=1.obenaufderseite:reellercursor=1.raufblaettern:virtuellercursorDECRmaxeintraege;virtuellercursor:=max(virtuellercursor,1);bauebildschirmauf(virtuellercursor);reellencursorsetzen.topofpage:loeschecursor;virtuellercursorDECR(reellercursor-1);reellercursor:=1;reellencursorsetzen.hopnachunten:IFganzuntenTHENout(piep)ELIFuntenaufderseiteTHENrunterblaetternELSEbottomofpageFI.ganzunten:virtuellercursor=anzahl.untenaufderseite:reellercursor>maxeintraege-1.runterblaettern:INT VARaltervirtuellercursor:=virtuellercursor;virtuellercursorINCRmaxeintraege;virtuellercursor:=min(virtuellercursor,anzahl);reellercursor:=virtuellercursor-altervirtuellercursor;bauebildschirmauf(altervirtuellercursor+1);reellencursorsetzen.bottomofpage:loeschecursor;altervirtuellercursor:=virtuellercursor;virtuellercursorINCR(maxeintraege-reellercursor);virtuellercursor:=min(anzahl,virtuellercursor);reellercursorINCR(virtuellercursor-altervirtuellercursor);reellencursorsetzen.END PROChopkommandoverarbeiten;PROCesckommandoverarbeiten:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(qeinsneunh,zweiteszeichen)OF CASE1:pruefeobausstiegerlaubtCASE2:zeigeanfangCASE3:zeigeendeCASE4:loeschecursor;abbruch:=TRUE;auswahlende:=TRUE;registrierkette:=""OTHERWISEout(piep)END SELECT.zeigeanfang:IFvirtuellercursor=1THENout(piep)ELIFvirtuellercursor=reellercursorTHENloeschecursor;virtuellercursor:=1;reellercursor:=1;reellencursorsetzenELSEvirtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzenFI.zeigeende:IFvirtuellercursor=anzahlTHENout(piep)ELIFendeaufbildschirmTHENloeschecursor;reellercursorINCR(anzahl-virtuellercursor);virtuellercursor:=anzahl;reellencursorsetzenELSEvirtuellercursor:=anzahl;reellercursor:=maxeintraege;bauebildschirmauf(anzahl-(maxeintraege-1));reellencursorsetzenFI.endeaufbildschirm:(reellercursor+anzahl-virtuellercursor)=minselANDausgewaehlte<=maxselTHENloeschecursor;auswahlende:=TRUE ELSEout(piep);footnote(hinweis[16]);pause;IFmaxsel>1THENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF END IF END PROCesckommandoverarbeiten;PROCankreuzen(INT CONSTeintrag,TEXT CONSTzeichen,BOOL CONSTcursorsetzen):IF NOTangekreuzt(eintrag)THENausgewaehlteINCR1END IF;replace(registrierkette,eintrag,zeichen);IFcursorsetzenTHENreellencursorsetzen;END IF END PROCankreuzen;PROCankreuzenweiter:ankreuzen(virtuellercursor, +eingabemoeglichkeitenSUB(letzteszeichen+1),FALSE);IFvirtuellercursor1.gehenachoben:IFreellercursor=1THENscrolldownELSEcursorupFI.scrolldown:virtuellercursorDECR1;bauebildschirmauf(virtuellercursor);reellencursorsetzen.cursorup:loeschecursor;virtuellercursorDECR1;reellercursorDECR1;reellencursorsetzenEND PROCnachoben;PROCnachunten:IFnochnichtuntenTHENgehenachuntenELSEout(piep)FI.nochnichtunten:virtuellercursormaxeintraege-1THENscrollupELSEcursordownFI.scrollup:virtuellercursorINCR1;bauebildschirmauf(virtuellercursor-(maxeintraege-1));reellencursorsetzen.cursordown:loeschecursor;virtuellercursorINCR1;reellercursorINCR1;reellencursorsetzenEND PROCnachunten;PROCnachlinkswennerlaubt:IFparallelauswahlAND NOTlinkerthTHENwechsel:=TRUE;auswahlende:=TRUE;loeschecursorELSEout(piep)END IF END PROCnachlinkswennerlaubt;PROCnachrechtswennerlaubt:IFparallelauswahlANDlinkerthTHENwechsel:=TRUE;auswahlende:=TRUE;loeschecursorELSEout(piep)END IF END PROCnachrechtswennerlaubt;PROCloeschecursor:cursor(x+1,ersteauswahlzeile+reellercursor-1);outtext(marke(virtuellercursor)+subtext(eintrag(virtuellercursor),1,65),1,xsize-4);out(" ");END PROCloeschecursor;PROCgibhinweisaus(TEXT CONSTt1,t2):cursor(x+1,y+1);out(center(xsize-2,invers(t1)));cursor(x+1,y+2);out(center(xsize-2,t2));END PROCgibhinweisaus;PROCuntersuchebildschirmmasszahlen(TEXT CONSTt1,t2):IFunzulaessigecursorwerteTHENerrorstop(fehlermeldung[1])ELIFfensteristzukleinTHENerrorstop(fehlermeldung[2])FI.unzulaessigecursorwerte:(x+xsize)>80COR(y+ysize)>25CORx<1CORy<1CORxsize>79CORysize>24.fensteristzuklein:(xsize)<39COR(ysize)<15CORlength(t1)>(xsize-5)CORlength(t2)>(xsize-5)COR(xsize<39AND NOTparallelauswahl)END PROCuntersuchebildschirmmasszahlen;TEXT PROCggfgekuerztertext(TEXT CONSTtext):IFlength(text)>(xsize-8)THENsubtext(text,1,xsize-10)+".."ELSEtextFI END PROCggfgekuerztertext;PROCzeigebedieninfo(INT CONSTspalte,zeile,breite,hoehe):INT VARi,extrazeile:=0;IFparallelauswahlTHENextrazeile:=1END IF;notierehinweisueberschrift;notierepositionierhinweise;IFnochplatzvorhandenTHENnotiereauswahlmoeglichkeitenaufalterseiteELSEwechsleaufnaechsteseite;notierehinweisueberschrift;notiereauswahlmoeglichkeitenaufneuerseiteFI;stellealtenbildschirmzustandwiederher.notierehinweisueberschrift:cursor(spalte+1,zeile+1);out(center(breite-2,hinweis[5]));cursor(spalte+1,zeile+2);out("",breite-2).notierepositionierhinweise:cursor(spalte+1,zeile+3);out(hinweis[6],breite-2);cursor(spalte+1,zeile+4);out("",breite-2);IFparallelauswahlTHENcursor(spalte+1,zeile+5);out(hinweis[18],breite-2)END IF;FORiFROM5UPTO7REPcursor(spalte+1,zeile+i+extrazeile);out(hinweis[i+2],breite-2)PER.notiereauswahlmoeglichkeitenaufalterseite:cursor(spalte+1,zeile+8+extrazeile);out("",breite-2);cursor(spalte+1,zeile+9+extrazeile);out(hinweis[10],breite-2);cursor(spalte+1,zeile+10+extrazeile);out("",breite-2);FORiFROM11UPTO15REPcursor(spalte+1,zeile+i+extrazeile);out(hinweis[i],breite-2)PER;loeschedierestlichenzeilen;footnote(hinweis[17]); +cursorinruhestellung;clearbuffer.loeschedierestlichenzeilen:FORiFROMzeile+16+extrazeileUPTOzeile+hoehe-2REPcursor(spalte+1,i);out("",breite-2)PER.wechsleaufnaechsteseite:loescheseitenrest;footnote(hinweis[17]);cursorinruhestellung;clearbuffer;pause.loescheseitenrest:INT VARzaehler;FORzaehlerFROM8+extrazeileUPTOhoehe-2REPcursor(spalte+1,zeile+zaehler);out("",breite-2)PER.notiereauswahlmoeglichkeitenaufneuerseite:cursor(spalte+1,zeile+3);out(hinweis[10],breite-2);cursor(spalte+1,zeile+4);out("",breite-2);FORiFROM5UPTO9REPcursor(spalte+1,zeile+i);out(hinweis[i+6],breite-2)PER;FORzaehlerFROM10UPTOhoehe-2REPcursor(spalte+1,zeile+zaehler);out("",breite-2)PER.cursorinruhestellung:cursor(spalte+1,zeile+hoehe-1).stellealtenbildschirmzustandwiederher:clearbuffer;pause;IFparallelauswahlORmaxsel>1THENfootnote(hinweis[2])ELSEfootnote(hinweis[4])END IF.nochplatzvorhanden:hoehe>16+extrazeileEND PROCzeigebedieninfo;THESAURUS PROCinit(INT CONSTspalte,zeile,breite,hoehe,lminauswahl,lmaxauswahl,rminauswahl,rmaxauswahl,THESAURUS CONSTth1,th2,BOOL CONSTzweith,TEXT CONSTt1,t2,t3,t4,TEXT VARlmarkers,rmarkers):INT VARlx,rx,lxsize,rxsize,lvirtcursor,rvirtcursor,lsel:=0,rsel:=0,lanzahl:=0,ranzahl:=0;TEXT VARlregistrierkette,rregistrierkette,lhopmoeglichkeiten,leingabemoeglichkeiten,rhopmoeglichkeiten,reingabemoeglichkeiten,text1,text2,text3,text4;DATASPACE VARlds,rds;AREA VARa;ueberpruefegroesse;IFzweithTHENsteuerezweithesaurusauswahlenELSEsteuereeinethesaurusauswahlEND IF.ueberpruefegroesse:fill(a,spalte,zeile,breite,hoehe+1).steuerezweithesaurusauswahlen:doppelinit;REPEATbearbeitelinkenthesaurus;wechslevonlinksnachrechts;bearbeiterechtenthesaurus;wechslevonrechtsnachlinks;PER;emptythesaurus.steuereeinethesaurusauswahl:einzelinit;minsel:=lminauswahl;maxsel:=lmaxauswahl;REPauswahl(th1,text1,text2,lmarkers);IFinfoTHENzeigebedieninfo(spalte,zeile,breite,hoehe);info:=FALSE;auswahlende:=FALSE;gibhinweisaus(text1,text2);bauebildschirmauf(virtuellercursor-reellercursor+1)END IF UNTILauswahlendeEND REPEAT;einzelaufraeumen.einzelinit:aufbauzaehler:=1;x:=spalte;y:=zeile;xsize:=breite;ysize:=hoehe;info:=FALSE;auswahlende:=FALSE;parallelauswahl:=FALSE;ds:=nilspace;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);zeichneeinzelkasten;setzestdfussnote.zeichneeinzelkasten:fill(a,x+1,y+1,xsize-2,ysize-2);outframe(a).einzelaufraeumen:footnote(hinweis[1]);thes1:=emptythesaurus;lmarkers:="";IF NOTabbruchTHENthes1:=erzeugeausgabe(registrierkette,lmarkers);END IF;forget(lds);forget(rds);forget(ds);thes1.doppelinit:aufbauzaehler:=2;lx:=spalte;lxsize:=(breite+1)DIV2;rx:=spalte+lxsize-1;rxsize:=lxsize;lvirtcursor:=1;rvirtcursor:=1;lregistrierkette:="";rregistrierkette:="";leingabemoeglichkeiten:="";lhopmoeglichkeiten:="";reingabemoeglichkeiten:="";rhopmoeglichkeiten:="";lanzahl:=1;ranzahl:=1;lds:=nilspace;rds:=nilspace;thes1:=emptythesaurus;thes2:=emptythesaurus;y:=zeile;ysize:=hoehe;x:=lx;xsize:=lxsize;forget(ds);ds:=lds;parallelauswahl:=TRUE;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);text3:=ggfgekuerztertext(t3);text4:=ggfgekuerztertext(t4);untersuchebildschirmmasszahlen(text1,text2);schreibedoppelkasten;footnote(hinweis[2]).bearbeitelinkenthesaurus:linkerth:=TRUE;auswahl(th1,text1,text2,lmarkers);lsel:=ausgewaehlte;IFabbruchTHENbearbeiteabbruchELIFinfoTHENzeigebedieninfo(spalte,zeile,breite,hoehe);schreibemittellinie;gibhinweisaus(text1,text2);bauebildschirmauf(virtuellercursor-reellercursor+1)ELIF NOTwechselTHEN IFrsel>=rminauswahlANDrsel<=rmaxauswahlTHENforget(lds);lds:=ds;lregistrierkette:=registrierkette;lanzahl:=anzahl;abganginordnungELSEauswahlendeungueltigEND IF END IF.wechslevonlinksnachrechts:x:=rx;xsize:=rxsize;wechsel:=FALSE;lanzahl:=anzahl;anzahl:=ranzahl;auswahlende:=FALSE;lvirtcursor:=virtuellercursor-reellercursor+1;virtuellercursor:=rvirtcursor;reellercursor:=1;lregistrierkette:=registrierkette;registrierkette:=rregistrierkette;lhopmoeglichkeiten:=hopmoeglichkeiten;hopmoeglichkeiten:= +rhopmoeglichkeiten;leingabemoeglichkeiten:=eingabemoeglichkeiten;eingabemoeglichkeiten:=reingabemoeglichkeiten;ausgewaehlte:=rsel;forget(lds);lds:=ds;forget(ds);ds:=rds;forget(rds);minsel:=rminauswahl;maxsel:=rmaxauswahl;linkerth:=FALSE;IFinfoTHENinfo:=FALSE;auswahlende:=FALSE;gibhinweisaus(text3,text4);bauebildschirmauf(virtuellercursor-reellercursor+1)END IF.bearbeiterechtenthesaurus:auswahl(th2,text3,text4,rmarkers);rsel:=ausgewaehlte;IFabbruchTHENbearbeiteabbruchELIFinfoTHENzeigebedieninfo(spalte,zeile,breite,hoehe);schreibemittellinie;gibhinweisaus(text3,text4);bauebildschirmauf(virtuellercursor-reellercursor+1)ELIF NOTwechselTHEN IFlsel>=lminauswahlANDlsel<=lmaxauswahlTHENforget(rds);rds:=ds;rregistrierkette:=registrierkette;ranzahl:=anzahl;abganginordnungELSEauswahlendeungueltigEND IF END IF.wechslevonrechtsnachlinks:x:=lx;xsize:=lxsize;wechsel:=FALSE;auswahlende:=FALSE;rvirtcursor:=virtuellercursor-reellercursor+1;virtuellercursor:=lvirtcursor;reellercursor:=1;rregistrierkette:=registrierkette;registrierkette:=lregistrierkette;rhopmoeglichkeiten:=hopmoeglichkeiten;hopmoeglichkeiten:=lhopmoeglichkeiten;reingabemoeglichkeiten:=eingabemoeglichkeiten;eingabemoeglichkeiten:=leingabemoeglichkeiten;ausgewaehlte:=lsel;forget(rds);rds:=ds;forget(ds);ds:=lds;forget(lds);minsel:=lminauswahl;maxsel:=lmaxauswahl;ranzahl:=anzahl;anzahl:=lanzahl;IFinfoTHENinfo:=FALSE;auswahlende:=FALSE;gibhinweisaus(text1,text2);bauebildschirmauf(virtuellercursor-reellercursor+1)END IF.abganginordnung:footnote(hinweis[1]);eintrag:=lds;anzahl:=lanzahl;thes1:=erzeugeausgabe(lregistrierkette,lmarkers);eintrag:=rds;anzahl:=ranzahl;thes2:=erzeugeausgabe(rregistrierkette,rmarkers);forget(lds);forget(rds);forget(ds);LEAVEinitWITHemptythesaurus.bearbeiteabbruch:footnote(hinweis[1]);lmarkers:="";rmarkers:="";forget(lds);forget(rds);forget(ds);LEAVEinitWITHemptythesaurus.auswahlendeungueltig:out(piep);footnote(hinweis[16]);pause;footnote(hinweis[2]).setzestdfussnote:IFlmaxauswahl>1THENfootnote(hinweis[2])ELSEfootnote(hinweis[4])END IF.schreibedoppelkasten:fill(a,spalte+1,zeile+1,breite-2,hoehe-2);outframe(a);cursor(rx,zeile);out(balkenoben);schreibemittellinie;cursor(rx,zeile+hoehe-1);out(balkenunten).schreibemittellinie:INT VARi;FORiFROMzeile+1UPTOzeile+hoehe-2REPcursor(rx,i);out(senkrecht)PER END PROCinit;THESAURUS PROCerzeugeausgabe(TEXT CONSTkette,TEXT VARmarkers):INT VARi;THESAURUS VARausgabe:=emptythesaurus;markers:="";FORiFROM1UPTOanzahlREPEAT IF(ketteSUBi)<>"o"THENinsert(ausgabe,eintrag[i]);markersCAT(ketteSUBi);END IF PER;ausgabeEND PROCerzeugeausgabe;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:pos(eintrag,infix)<>0END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:eintrag<>""CANDtype(old(eintrag))=dateityp.END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)AND(type(old(eintrag))=dateityp).END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,infix2):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)OR(pos(eintrag,infix2)<>0)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix):infixnamen(ALLmyself,infix)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix1,infix2):infixnamen(ALLmyself,infix1,infix2)END PROCinfixnamen;THESAURUS PROC +ohnepraefix(THESAURUS CONSTthesaurus,TEXT CONSTpraefix):THESAURUS VARt:=emptythesaurus;INT VARzaehler;FORzaehlerFROM1UPTOhighestentry(thesaurus)REP IFname(thesaurus,zaehler)<>""ANDpos(name(thesaurus,zaehler),praefix)=1THENinsert(t,subtext(name(thesaurus,zaehler),length(praefix)+1))FI;PER;tEND PROCohnepraefix;BOOL PROCnotempty(THESAURUS CONSTt):INT VARi;FORiFROM1UPTOhighestentry(t)REP IFname(t,i)<>""THEN LEAVEnotemptyWITH TRUE FI PER;FALSE END PROCnotempty;THESAURUS PROCsome(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,TEXT CONSTt1,t2):TEXT VARreturn:="x";init(spalte,zeile,breite,hoehe,0,maxentries,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",return,return)END PROCsome;THESAURUS PROCsome(INT CONSTspalte,zeile,THESAURUS CONSTt,TEXT CONSTt1,t2):some(spalte,zeile,79-spalte+1,24-zeile,t,t1,t2)END PROCsome;THESAURUS PROCsome(THESAURUS CONSTth,TEXT CONSTt1,t2):TEXT VARreturn:="x";init(1,1,79,23,0,maxentries,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",return,return)END PROCsome;TEXT PROCone(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,TEXT CONSTt1,t2):TEXT VARreturn:="x";name(init(spalte,zeile,breite,hoehe,0,1,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",return,return),1)END PROCone;TEXT PROCone(INT CONSTspalte,zeile,THESAURUS CONSTt,TEXT CONSTt1,t2):one(spalte,zeile,79-spalte+1,24-zeile,t,t1,t2)END PROCone;TEXT PROCone(THESAURUS CONSTth,TEXT CONSTt1,t2):TEXT VARreturn:="x";name(init(1,1,79,23,0,1,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",return,return),1)END PROCone;PROCdoublesome(INT CONSTzeile,hoehe,leftmin,leftmax,rightmin,rightmax,THESAURUS VARth1,th2,TEXT CONSTt1,t2,t3,t4):TEXT VARreturn:="x";th1:=init(1,zeile,79,hoehe,leftmin,leftmax,rightmin,rightmax,th1,th2,zweithesauri,t1,t2,t3,t4,return,return);th1:=thes1;th2:=thes2;END PROCdoublesome;PROCdoublesome(INT CONSTleftmin,leftmax,rightmin,rightmax,THESAURUS VARth1,th2,TEXT CONSTt1,t2,t3,t4):TEXT VARreturn:="x";th1:=init(1,1,79,23,leftmin,leftmax,rightmin,rightmax,th1,th2,zweithesauri,t1,t2,t3,t4,return,return);th1:=thes1;th2:=thes2;END PROCdoublesome;PROCdoublesome(INT CONSTzeile,hoehe,leftmin,leftmax,rightmin,rightmax,THESAURUS VARth1,th2,TEXT CONSTt1,t2,t3,t4,TEXT VARlmarkers,rmarkers):th1:=init(1,zeile,79,hoehe,leftmin,leftmax,rightmin,rightmax,th1,th2,zweithesauri,t1,t2,t3,t4,lmarkers,rmarkers);th1:=thes1;th2:=thes2;END PROCdoublesome;PROCdoublesome(INT CONSTleftmin,leftmax,rightmin,rightmax,THESAURUS VARth1,th2,TEXT CONSTt1,t2,t3,t4,TEXT VARlmarkers,rmarkers):th1:=init(1,1,79,23,leftmin,leftmax,rightmin,rightmax,th1,th2,zweithesauri,t1,t2,t3,t4,lmarkers,rmarkers);th1:=thes1;th2:=thes2;END PROCdoublesome;THESAURUS PROCsomewithmax(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,INT CONSTmax,TEXT CONSTt1,t2,TEXT VARmarkers):init(spalte,zeile,breite,hoehe,0,max,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",markers,markers)END PROCsomewithmax;THESAURUS PROCsomewithmax(THESAURUS CONSTth,INT CONSTmax,TEXT CONSTt1,t2,TEXT VARmarkers):init(1,1,79,23,0,max,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",markers,markers)END PROCsomewithmax;THESAURUS PROCsomewithmax(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,INT CONSTmax,TEXT CONSTt1,t2):TEXT VARmarker:="x";init(spalte,zeile,breite,hoehe,0,max,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",marker,marker)END PROCsomewithmax;THESAURUS PROCsomewithmax(THESAURUS CONSTth,INT CONSTmax,TEXT CONSTt1,t2):TEXT VARmarker:="x";init(1,1,79,23,0,max,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",marker,marker)END PROCsomewithmax;THESAURUS PROCsomeexactly(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,INT CONSTanzahl,TEXT CONSTt1,t2):TEXT VARtx:="x";init(spalte,zeile,breite,hoehe,anzahl,anzahl,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",tx,tx)END PROCsomeexactly;THESAURUS PROCsomeexactly(THESAURUS CONSTth,INT CONSTanzahl,TEXT CONSTt1,t2):TEXT VARtx:="x";init(1,1,79,23,anzahl,anzahl,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",tx,tx)END PROCsomeexactly;THESAURUS PROC +someexactly(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,INT CONSTanzahl,TEXT CONSTt1,t2,TEXT VARmarkers):init(spalte,zeile,breite,hoehe,anzahl,anzahl,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",markers,markers)END PROCsomeexactly;THESAURUS PROCsomeexactly(THESAURUS CONSTth,INT CONSTanzahl,TEXT CONSTt1,t2,TEXT VARmarkers):init(1,1,79,23,anzahl,anzahl,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",markers,markers)END PROCsomeexactly;END PACKETlsdialog2; + diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 3.korrektur b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 3.korrektur new file mode 100644 index 0000000..3408f21 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 3.korrektur @@ -0,0 +1,3 @@ +PACKETlsdialog3DEFINES WINDOW,:=,window,show,page,erase,line,remaininglines,cursor,getcursor,outframe,outmenuframe,out,put,putline,get,getline,yes,no,edit,center,stop,area,areax,areay,areaxsize,areaysize:LETpiep="�",cr=" ";LETjaneinkette="jJyYnN",blank=" ",niltext="";TYPE WINDOW=STRUCT(AREAfenster,INTcspalte,czeile,belegbarezeilen,BOOLfensterendeerreicht);ROW3TEXT CONSTaussage:=ROW3TEXT:(" 'Window' ungültig!"," (j/n) ?"," Weiter mit beliebiger Taste!");TEXT VARnumberword,exitchar;OP:=(WINDOW VARlinks,WINDOW CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;WINDOW PROCwindow(INT CONSTx,y,xsize,ysize):WINDOW VARw;fill(w.fenster,x,y,xsize,ysize);initialize(w);wEND PROCwindow;PROCinitialize(WINDOW VARw):w.czeile:=1;w.cspalte:=1;w.fensterendeerreicht:=FALSE;w.belegbarezeilen:=areaysize(w.fenster)END PROCinitialize;PROCshow(WINDOW VARw):zeigerahmen;fensterputzen.zeigerahmen:outframe(w.fenster).fensterputzen:page(w).END PROCshow;PROCpage(WINDOW VARw):initialize(w);page(w,FALSE)END PROCpage;PROCpage(WINDOW CONSTw,BOOL CONSTmitrahmen):IFareax(w)=1ANDareay(w)=1ANDareaxsize(w)=79ANDareaysize(w)=24THENpage;ELSEloeschebereichFI.loeschebereich:IFmitrahmenTHENpage(areax(w)-1,areay(w)-1,areaxsize(w)+2,areaysize(w)+2)ELSEpage(area(w))FI END PROCpage;PROCerase(WINDOW VARw):page(w,TRUE)END PROCerase;PROCline(WINDOW VARw):w.cspalte:=1;IFw.czeileareaxsize(w)ORzeile>areaysize(w)THENpage(w);ELSEw.cspalte:=spalte;w.czeile:=zeile;FI;cursor(w.fenster,w.cspalte,w.czeile)END PROCcursor;PROCgetcursor(WINDOW CONSTw,INT VARspalte,zeile):IF(w.cspalte<1)OR(w.cspalte>areaxsize(w.fenster))OR(w.czeile<1)OR(w.czeile>areaysize(w.fenster))THENspalte:=0;zeile:=0ELSEspalte:=w.cspalte;zeile:=w.czeileFI END PROCgetcursor;PROCout(WINDOW VARw,TEXT CONSTtext):INT VARrestlaenge;IF(w.cspalte>=1)AND(w.cspalte<=areaxsize(w.fenster))AND(w.czeile>=1)AND(w.czeile<=w.belegbarezeilen)THENputzeggffenster;cursor(w.fenster,w.cspalte,w.czeile);outtext(text,1,textende);setzefenstercursorneu;setzeausgabeggfinnaechsterzeilefortFI.putzeggffenster:IFw.fensterendeerreichtTHENpage(w);w.fensterendeerreicht:=FALSE FI.textende:restlaenge:=areaxsize(w.fenster)-w.cspalte+1;min(length(text),restlaenge).setzefenstercursorneu:IFlength(text)>=restlaengeTHENw.cspalte:=1;w.czeileINCR1;schlageggfneueseiteaufELSEw.cspalteINCRlength(text)FI.schlageggfneueseiteauf:IFw.czeile>w.belegbarezeilenTHENw.fensterendeerreicht:=TRUE;w.czeile:=1;w.cspalte:=1FI.setzeausgabeggfinnaechsterzeilefort:IFlength(text)>restlaengeTHENout(w,subtext(text,restlaenge+1))FI.END PROCout;PROCoutframe(WINDOW VARw):outframe(area(w))END PROCoutframe;PROCoutmenuframe(WINDOW VARw):outmenuframe(area(w))END PROCoutmenuframe;PROCput(WINDOW VARw,TEXT CONSTword):out(w,word);out(w,blank)END PROCput;PROCput(WINDOW VARw,INT CONSTnumber):put(w,text(number))END PROCput;PROCput(WINDOW VARw,REAL VARnumber):put(w,text(number))END PROCput;PROCputline(WINDOW VARw,TEXT CONSTtextline):out(w,textline);line(w)END PROCputline;PROCprivateget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator,INT CONSTlength):INT VARx,y;INT VARrestlaenge:=areaxsize(w.fenster)-w.cspalte-1;ggfzurnaechstenzeile;getcursor(x,y);cursoron;cursor(x,y);REPword:="";editget(word,laenge,laenge,separator,"",exitchar);out(w,word);echoeexitchar(w)UNTILword<>niltextANDword<>blankPER;cursoroff;deleteleadingblanks.ggfzurnaechstenzeile:IFrestlaenge<5THENline(w);restlaenge:=areaxsize(w.fenster)-2FI.deleteleadingblanks:WHILE(wordSUB1)=blankREPword:=subtext(word,2)PER.laenge:min(length,restlaenge).END PROCprivateget;PROCget(WINDOW VARw,TEXT VARword): +privateget(w,word," ",maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator):privateget(w,word,separator,maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,INT CONSTlength):privateget(w,word,"",length)END PROCget;PROCget(WINDOW VARw,INT VARnumber):get(w,numberword);number:=int(numberword)END PROCget;PROCget(WINDOW VARw,REAL VARnumber):get(w,numberword);number:=real(numberword)END PROCget;PROCgetline(WINDOW VARw,TEXT VARtextline):privateget(w,textline,"",maxtextlength)END PROCgetline;PROCechoeexitchar(WINDOW VARfenster):IFexitchar=crTHENline(fenster)ELSEout(fenster,exitchar)FI END PROCechoeexitchar;TEXT PROCcenter(WINDOW CONSTw,TEXT CONSTtext):IFlength(text)>=areaxsize(w.fenster)THENsubtext(text,1,areaxsize(w.fenster))ELSEcenter(areaxsize(w.fenster),text)FI END PROCcenter;BOOL PROCyes(WINDOW VARw,TEXT CONSTfrage):TEXT VARzeichen,internefrage:=frage;internefrageCATaussage[2];wechselggfaufneueseite;out(w,internefrage);holeeingabezeichen;wertezeichenaus.wechselggfaufneueseite:IFremaininglines(w)<1THENpage(w)FI.holeeingabezeichen:cursoron;clearbuffer;REPinchar(zeichen);piepseggfUNTILpos(janeinkette,zeichen)>0PER;out(w,blank+zeichen);cursoroff;line(w).piepseggf:IFpos(janeinkette,zeichen)=0THENout(piep)FI.wertezeichenaus:IFpos(janeinkette,zeichen)<5THEN TRUE ELSE FALSE FI.END PROCyes;PROCedit(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);cursoron;edit(f,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoroffEND PROCedit;PROCedit(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);edit(w,f)END PROCedit;PROCshow(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);openeditor(groesstereditor+1,f,FALSE,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoron;edit(groesstereditor,"eqvw19dpgn�",PROC(TEXT CONST)stdkommandointerpreter);cursoroffEND PROCshow;PROCshow(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);show(w,f)END PROCshow;PROCloescherechtespalten(WINDOW VARw):INT VARi;FORiFROM1UPTOareaysize(w.fenster)REPcursor(w,areaxsize(w.fenster)-2,i);out(" ")PER END PROCloescherechtespalten;BOOL PROCno(WINDOW VARw,TEXT CONSTfrage):NOTyes(w,frage)END PROCno;PROCstop(WINDOW VARw):stop(w,2)END PROCstop;PROCstop(WINDOW VARw,INT CONSTzeilenzahl):INT VARi;FORiFROM1UPTOzeilenzahlREPline(w)PER;out(w,aussage[3]);pauseEND PROCstop;AREA PROCarea(WINDOW CONSTw):w.fensterEND PROCarea;INT PROCareax(WINDOW CONSTw):areax(w.fenster)END PROCareax;INT PROCareay(WINDOW CONSTw):areay(w.fenster)END PROCareay;INT PROCareaxsize(WINDOW CONSTw):areaxsize(w.fenster)END PROCareaxsize;INT PROCareaysize(WINDOW CONSTw):areaysize(w.fenster)END PROCareaysize;END PACKETlsdialog3 + diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 4.wd b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 4.wd new file mode 100644 index 0000000..a320e06 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 4.wd @@ -0,0 +1,6 @@ +PACKETlsdialog4DEFINESboxinfo,boxnotice,boxalternative,boxyes,boxno,boxanswer,boxone,boxanswerone,boxsome,boxanswersome:LETmarkein=""15"",markaus=""14"",delimiter=""13"",piep=""7"",cleol=""5"",rechtslinksescreturn=""2""8""27""13"",rechtslinksnullreturn=""2""8""0""13"" ,gueltigezeichen=""10""3""13"",esc=""27"",auswahl="z",abbruch="m", +trennliniensymbol="-",blank=" ",niltext="",janeintasten="jn";ROW8TEXT CONSTaussage:=ROW8TEXT:(" Weiter mit beliebiger Taste!"," Wählen: Bestätigen: Menü: "," Wählen: Bestätigen: Ja: Nein: "," Wählen: Bestätigen: "," Bestätigen: Zeigen: Menü: "," Bestätigen: Menü: ","Ja Nein"," Eingabe: ");PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,BOOL CONSTtrennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit):boxinfo(w,t,position,timelimit,TRUE)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt):boxinfo(w,t,5,maxint,TRUE)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,PROC(AREA CONST)restore):boxinfo(w,t,5,maxint,TRUE,PROCrestore)END PROCboxinfo;PROCboxnotice(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibenotiz(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxnotice;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize):INT VARergebnis,spa,zei;getcursor(w,spa,zei);schreibealternativen(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize,ergebnis);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,trennlinieweg):INT VARx,y,xsize,ysize,ergebnis,spa,zei;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,trennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,ergebnis,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,TRUE)END PROCboxalternative;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);BOOL CONSTwert:=ja(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition):boxyes(w,t,position,TRUE)END PROCboxyes;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt +,INT CONSTposition,INT VARx,y,xsize,ysize):NOTboxyes(w,t,position,x,y,xsize,ysize)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg):NOTboxyes(w,t,position,trennlinieweg)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition):NOTboxyes(w,t,position)END PROCboxno;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;TEXT VARwert;getcursor(w,spa,zei);wert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);oldfootnote;cursor(spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition):boxanswer(w,t,vorgabe,position,TRUE)END PROCboxanswer;TEXT PROCboxone(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);TEXT VARwert:=one(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));FI;oldfootnote;cursor(w,spa,zei);wertEND PROCboxone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung,trennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);wert.lasseauswaehlen:IFmitreinigungTHENwert:=boxone(w,thesaurus,t1,t2,TRUE)ELSEwert:=boxone(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnoteFI.END PROCboxanswerone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):boxanswerone(w,text,vorgabe,thesaurus,t1,t2,mitreinigung,TRUE)END PROCboxanswerone;THESAURUS PROCboxsome(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);THESAURUS VARwert:=some(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));oldfootnoteFI;cursor(w,spa,zei);wertEND PROCboxsome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung,trennlinieweg):THESAURUS VARergebnis:=emptythesaurus;INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);ergebnis.lasseauswaehlen:IFmitreinigungTHENergebnis:=boxsome(w,thesaurus,t1,t2,TRUE)ELSEergebnis:=boxsome(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFwert<>niltextTHENinsert(ergebnis,wert)FI;IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnoteFI.END PROCboxanswersome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):boxanswersome(w,text,vorgabe,thesaurus,t1,t2,mitreinigung,TRUE)END PROCboxanswersome;PROCzerteiletexte(TEXT CONSTt,ROW24TEXT VARtexte,INT VARbelegt):TEXT VARintern:=t;INT VARende:=0;belegt:=0;entfernefuehrendedelimiter;WHILEende<>maxint-1REPende:=pos(intern,delimiter);belegtINCR1;IFende=0THENende:=maxint-1END IF;texte(belegt):=subtext(intern,1,ende-1);intern:=subtext(intern,ende+1)PER.entfernefuehrendedelimiter:WHILE(internSUB1)=delimiterREPintern:=subtext(intern,2)PER END PROCzerteiletexte;PROCermittleboxgroesse(WINDOW VARw,INT CONSTposition,zusatzlaenge,minbreite,minhoehe,belegt,ROW24TEXT CONSTtexte,INT VARx,y,xsize,ysize):ermittleboxbreiteundboxhoehe;ermittlerahmenwerte.ermittleboxbreiteundboxhoehe:xsize:=0;FORysizeFROM1UPTObelegtREPEATxsize:=max(xsize,LENGTHtexte(ysize)) +PER;ysize:=belegt.ermittlerahmenwerte:schlagenotwendigegroessenauf;killueberlaengen;legebildschirmpositionenfest.schlagenotwendigegroessenauf:xsize:=max(xsize,minbreite);ysize:=max(ysize,minhoehe);ysizeINCRzusatzlaenge;ysizeINCR2;xsizeINCR2.killueberlaengen:ysize:=min(ysize,areaysize(w)-4);xsize:=min(xsize,areaxsize(w)-4).legebildschirmpositionenfest:SELECTpositionOF CASE1:plazierunglinksobenCASE2:plazierungrechtsobenCASE3:plazierunglinksuntenCASE4:plazierungrechtsuntenOTHERWISEplazierungimzentrumEND SELECT.plazierunglinksoben:x:=areax(w)+2;y:=areay(w)+2.plazierungrechtsoben:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+2.plazierunglinksunten:x:=areax(w)+2;y:=areay(w)+areaysize(w)-ysize-2.plazierungrechtsunten:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+areaysize(w)-ysize-2.plazierungimzentrum:x:=areax(w)+((areaxsize(w)-(xsize+2))DIV2)+1;y:=areay(w)+((areaysize(w)-ysize)DIV2)END PROCermittleboxgroesse;PROCschreibeboxtext(WINDOW VARw,TEXT CONSTt,INT CONSTposition,zusatzlaenge,mindestbreite,mindesthoehe,INT VARx,y,xsize,ysize):ROW24TEXT VARtexte;INT VARanzahltexte;INT VARi;zerteiletexte(t,texte,anzahltexte);FORiFROManzahltexte+1UPTO24REPEATtexte(i):=""PER;ermittleboxgroesse(w,position,zusatzlaenge,mindestbreite,mindesthoehe,anzahltexte,texte,x,y,xsize,ysize);schreibeboxkopf;schreibeboxrumpf.schreibeboxkopf:cursor(x,y);out(eckeobenlinks);out((xsize-2)*waagerecht);out(eckeobenrechts).schreibeboxrumpf:FORiFROM1UPTOysize-zusatzlaenge-2REPcursor(x,y+i);out(senkrecht+text(texte(i),xsize-2)+senkrecht)PER.END PROCschreibeboxtext;PROCschreibeboxfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize,limit):schreibeabschlusszeile;footnote(aussage[1]);cursorinpositionundwarten.schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).cursorinpositionundwarten:cursorparken(w);clearbuffer;pause(limit)END PROCschreibeboxfuss;PROCcursorparken(WINDOW VARw):cursor(w,1,2)END PROCcursorparken;PROCschreibebox(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibeboxfuss(w,x,y,xsize,ysize,timelimit)END PROCschreibebox;PROCschreibenotizfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize):schreibeabschlusszeile;cursorparken(w).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).END PROCschreibenotizfuss;PROCschreibenotiz(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibenotizfuss(w,x,y,xsize,ysize)END PROCschreibenotiz;PROCschreibealternativen(WINDOW VARw,TEXT CONSTt,altzeile,sonst,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize,ergebnis):ROW24TEXT VARtexte;TEXT VARtasten:=gueltigezeichen+sonst;INT VARbelegt,obersteauswahlzeile,untersteauswahlzeile,maxlaenge,kommando,aktpos;BOOL VARausgewaehlt:=FALSE;IFmitabbruchTHENtastenCATescFI;zerteiletexte(altzeile,texte,belegt);errechnemaximalelaengederalternativen;cursoroff;schreibeboxtext(w,t,position,belegt,maxlaenge+9,0,x,y,xsize,ysize);schreibepraefixintexte;obersteauswahlzeile:=ysize-belegt;untersteauswahlzeile:=ysize;schreibealternativenaufbildschirm;schreibefusszeile;lasseauswaehlen;cursoron.errechnemaximalelaengederalternativen:INT VARi;maxlaenge:=0;FORiFROM1UPTObelegtREPEATmaxlaenge:=max(maxlaenge,LENGTHtexte(i))PER.schreibepraefixintexte:FORiFROM1UPTObelegtREPEAT IF(sonstSUBi)=trennliniensymbolTHENtexte(i):=(xsize-2)*trennliniensymbolELSEtexte(i):=(sonstSUBi)+" "+texte(i)END IF PER.schreibealternativenaufbildschirm:WINDOW VARhilf:=window(x,y,xsize,ysize);markiere(hilf,texte(1),obersteauswahlzeile);FORiFROM2UPTObelegtREPEATdemarkiere(hilf,texte(i),obersteauswahlzeile+i-1)PER.schreibefusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks+(xsize-2)*waagerecht+eckeuntenrechts);IFmitabbruchTHENfootnote(aussage[2])ELSEberuecksichtigejaneinhinweisFI.beruecksichtigejaneinhinweis:IFsonst=janeintastenTHENfootnote(aussage[3])ELSEfootnote(aussage[4])FI. +lasseauswaehlen:aktpos:=1;REPlieszeichen;interpretierezeichenUNTILausgewaehltEND REP;ergebnis:=aktpos.lieszeichen:TEXT VARzeichen;REPinchar(zeichen)UNTILzeichengueltigEND REP.zeichengueltig:kommando:=pos(tasten,zeichen);IFkommando=0THENout(piep);FALSE ELSE TRUE FI.interpretierezeichen:demarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);IFzeichen=escTHENpruefeaufescabbruchELSE SELECTkommandoOF CASE1:einsnachuntenCASE2:einsnachobenCASE3:ausgewaehlt:=TRUE OTHERWISEmittasteausgewaehltEND SELECT;IF NOTausgewaehltTHENmarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);END IF END IF.einsnachunten:REPaktpos:=aktposMODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.einsnachoben:REPaktpos:=(aktpos+belegt-2)MODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.mittasteausgewaehlt:IFzeichen=trennliniensymbolTHENout(piep)ELSEaktpos:=kommando-3+100;ausgewaehlt:=TRUE END IF.pruefeaufescabbruch:inchar(zeichen);IFzeichen=abbruchTHENausgewaehlt:=TRUE;aktpos:=0ELSEout(piep)FI END PROCschreibealternativen;PROCmarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outinverswithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCmarkiere;PROCdemarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outwithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCdemarkiere;BOOL PROCja(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARergebnis;schreibealternativen(w,t+"?",aussage[7],janeintasten,position,FALSE,x,y,xsize,ysize,ergebnis);ergebnis=1ORergebnis=101END PROCja;TEXT PROCholeantwort(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTmitauswahl,INT VARx,y,xsize,ysize):TEXT VAReingabe:=compress(vorgabe);schreibeboxtext(w,t,position,2,length(aussage[8])+12,2,x,y,xsize,ysize);schreibeantwortfuss;clearbuffer;REP IFeingabe="break"THENeingabe:=""FI;lasseeintragenUNTILeingabe<>"break"PER;liefereergebnis.schreibeantwortfuss:schreibeleerzeile;schreibeeingabezeile;schreibeabschlusszeile;IFmitauswahlTHENfootnote(aussage[5])ELSEfootnote(aussage[6])FI.schreibeleerzeile:cursor(x,y+ysize-3);out(senkrecht);out((xsize-2)*blank);out(senkrecht).schreibeeingabezeile:cursor(x,y+ysize-2);out(senkrecht);out(aussage[8]);out((xsize-2-length(aussage[8]))*blank);out(senkrecht).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).lasseeintragen:TEXT VARexit:="";cursoron;cursor(x+length(aussage[8])+1,y+ysize-2);IFmitauswahlTHENeditget(eingabe,maxtextlength,textlaenge,"",abbruch+auswahl,exit)ELSEeditget(eingabe,maxtextlength,textlaenge,"",abbruch,exit)FI;cursoroff;IFexit=esc+abbruchTHENeingabe:=""ELIFmitauswahlAND(exit=esc+auswahl)THENeingabe:=esc+auswahlELSEeingabe:=compress(eingabe)FI.textlaenge:xsize-2-length(aussage[8]).liefereergebnis:eingabe.END PROCholeantwort;END PACKETlsdialog4; + diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.korrektur b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.korrektur new file mode 100644 index 0000000..8cee148 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.korrektur @@ -0,0 +1,12 @@ +PACKETlsdialog5DEFINESwritehead,restorehead,setwindow2,menuinfo,menualternative,menuyes,menuno,menuone,menusome,menuanswer,menuanswerone,menuanswersome,installmenu,handlemenu,refreshsubmenu,deactivate,regeneratemenuscreen,activate,writemenunotice,erasemenunotice,menubasistext,anwendungstext,showmenuwindow,menuwindowpage,menuwindowout,menuwindowget,menuwindoweditget,menuwindowedit,menuwindowshow,menuwindowline,menuwindowyes,menuwindowno,menuwindowcursor,getmenuwindowcursor,remainingmenuwindowlines,menuwindowcenter,menuwindowstop,editorinformationen,stdinfoedit,menukartenname,currentmenuwindow,resetdialog,onlyintern,ausstieg,direktstart:LETsystemkuerzel="ls-DIALOG",menutafeltaskname="ls-MENUKARTEN",menutafeltype=1954,menutafelpraefix="ls-MENUKARTE:",stdmenukartenname="ls-MENUKARTE:Archiv",versionsnummer="1.1",copyright1=" (C) 1987/88 Eva Latta-Weber",copyright2=" (C) 1988 ERGOS GmbH";LETmaxmenus=6,maxmenutexte=300,maxinfotexte=2000,maxhauptmenupunkte=10,maxuntermenupunkte=15,ersteuntermenuzeile=3;LETblank=" ",verlassen="q",piep="�",cleol="�",cleop="�",trennzeilensymbol="###",bleibtleersymbol="***",hauptmenuluecke=" ";LETauswahlstring1="�� +� �?";TYPE MENUPUNKT=STRUCT(TEXTpunktkuerzel,punktname,procname,boxtext,BOOLaktiv,angewaehlt),EINZELMENU=STRUCT(INTbelegt,TEXTueberschrift,INTanfangsposition,maxlaenge,ROWmaxuntermenupunkteMENUPUNKTmenupunkt,INTaktuelleruntermenupunkt,TEXTstartprozedurname,leaveprozedurname),MENU=STRUCT(TEXTmenuname,kopfzeile,INTanzahlhauptmenupunkte,ROWmaxhauptmenupunkteEINZELMENUeinzelmenu,TEXTmenueingangsprozedur,menuausgangsprozedur,menuinfo,lizenznummer,versionsnummer,INThauptmenuzeiger,untermenuanfang,untermenuzeiger),INFOTEXT=STRUCT(INTanzahlinfotexte,ROWmaxinfotexteTEXTstelle),MENUTEXT=STRUCT(INTanzahlmenutexte,ROWmaxmenutexteTEXTplatz),MENULEISTE=STRUCT(INTbelegt,zeigeraktuell,zeigerhintergrund,ROWmaxmenusMENUmenu,MENUTEXTmenutext,INFOTEXTinfotext);BOUND MENULEISTE VARmenuleiste;DATASPACE VARds;WINDOW VARmenuwindow,schreibfenster,editorinfofenster;WINDOW VARzweitesmenu:=window(6,5,73,19);INITFLAG VARinthistask:=FALSE;INT VARanzahloffenermenus:=0;INT VARmenunotizx,menunotizxsize,menunotizy,menunotizysize,menunotizposition;TEXT VARangekoppeltemenutafel:="",menunotiztext;BOOL VARmenunotizistgesetzt:=FALSE,nurinterneverwendung:=FALSE,mitausstieg:=FALSE,hochruntererlaubt:=TRUE,activationchanged:=FALSE;REAL VARzeitpunkt:=clock(1);ROW13TEXT CONSTfehlermeldung:=ROW13TEXT:("Die Task '"+menutafeltaskname+"' existiert nicht!","Die Menükarte '","' existiert nicht in der Task '"+menutafeltaskname+"'!","' hat falschen Typ/Bezeichnung (keine 'MENÜKARTE')!","Das Menü '","' ist nicht in der angekoppelten Menükarte!","Zu viele geöffnete Menüs ( > 2 )!","Kein Menü geöffnet!","Menü enthält keine Menüpunkte!","Menüpunkt ist nicht im Menü enthalten!","Kein Text vorhanden!","Zugriff unmöglich!","Einschränkung unzulässig!");ROW1TEXT CONSTvergleichstext:=ROW1TEXT:("gibt es nicht");ROW3TEXT CONSThinweis:=ROW3TEXT:(" Info:/ Wählen: Bestätigen: Verlassen:"," Weiter mit beliebiger Taste!"," Bitte warten...!");ROW3TEXT CONSTinfotext:=ROW3TEXT:(" Für diesen Menüpunkt ist (noch) keine Funktion eingetragen!"," Möchten Sie dieses Menü tatsächlich verlassen"," Leider ist zu diesem Menüpunkt kein Info - Text eingetragen!");PROCinstallmenu(TEXT CONSTmenutafelname):installmenu(menutafelname,TRUE)END PROCinstallmenu;PROCinstallmenu(TEXT CONSTmenutafelname,BOOL CONSTmitkennung):TEXT VARletzterparameter;IFmitkennungTHENzeigemenukennungFI;initialisieremenuggf;IFmenutafelnochnichtangekoppeltTHENletzterparameter:=std;holemenutafel;kopplemenutafelan;lastparam(letzterparameter)FI.initialisieremenuggf:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;nurinterneverwendung:=FALSE FI.menutafelnochnichtangekoppelt:menutafelname<>angekoppeltemenutafel.holemenutafel:IF NOTexiststask(menutafeltaskname)THENbereinigesituation;cursoron;errorstop( +fehlermeldung[1])FI;disablestop;fetch(menutafelname,/menutafeltaskname);IFiserrorANDpos(errormessage,vergleichstext[1])>0THENclearerror;enablestop;bereinigesituation;cursoron;errorstop(fehlermeldung[2]+menutafelname+fehlermeldung[3])ELIFiserrorTHENclearerror;enablestop;bereinigesituation;cursoron;errorstop(errormessage)ELSEenablestopFI.kopplemenutafelan:IFtype(old(menutafelname))=menutafeltypeANDpos(menutafelname,menutafelpraefix)=1THENforget(ds);ds:=old(menutafelname);menuleiste:=ds;angekoppeltemenutafel:=menutafelname;forget(menutafelname,quiet)ELSEbereinigesituation;cursoron;errorstop("'"+menutafelname+fehlermeldung[4])FI.END PROCinstallmenu;PROConlyintern(BOOL CONSTwert):nurinterneverwendung:=wertEND PROConlyintern;PROCausstieg(BOOL CONSTwert):mitausstieg:=wertEND PROCausstieg;TEXT PROCmenukartenname:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI;angekoppeltemenutafelEND PROCmenukartenname;PROChandlemenu(TEXT CONSTmenuname):nurinterneverwendung:=FALSE;mitausstieg:=TRUE;handlemenu(menuname,"")END PROChandlemenu;PROChandlemenu(TEXT CONSTmenuname,ausstiegsproc):cursoroff;IFnurinterneverwendungTHENoeffnemenu(menuname)ELSEbietemenuanFI;lassemenupunkteauswaehlen;IFnurinterneverwendungTHENdo(ausstiegsproc);anzahloffenermenusDECR1;IFanzahloffenermenus<1THENerasemenunoticeFI;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);nurinterneverwendung:=FALSE;mitausstieg:=TRUE;cursoronELSEschliessemenu;leereggfdenbildschirmFI.bietemenuan:REAL VARzwischenzeit:=clock(1)-zeitpunkt;IFzwischenzeit<2.0THENpause(20-int(10.0*zwischenzeit))FI;oeffnemenu(menuname).leereggfdenbildschirm:IFanzahloffenermenus<1THENerasemenunotice;page;cursoronFI.lassemenupunkteauswaehlen:TEXT VARkuerzelkette:="";starteaktuelleuntermenuoperationen;disablestop;REPcursorinwarteposition;ermittleaktuellekuerzelkette(kuerzelkette);nimmzeichenauf;interpretierezeichenUNTILmenuverlassengewuenschtPER.nimmzeichenauf:TEXT CONSTerlaubtezeichen:=auswahlstring1+kuerzelkette;TEXT VAReingabezeichen;INT VARzeichenposition;REPinchar(eingabezeichen);pruefeobfehler;zeichenposition:=pos(erlaubtezeichen,eingabezeichen);piepseggfUNTILzeichenposition>0PER.piepseggf:IFzeichenposition=0THENout(piep)FI.menuverlassengewuenscht:zeichenposition=6AND(zweiteszeichen=verlassen).interpretierezeichen:SELECTzeichenpositionOF CASE1:geheeinenhauptmenupunktnachlinksCASE2:geheeinenhauptmenupunktnachrechtsCASE3:geheeinenuntermenupunktnachuntenCASE4:geheeinenuntermenupunktnachobenCASE5:fuehreaktuellenmenupunktausCASE6:holeescsequenzCASE7:zeigeerklaerungstextimmenuanOTHERWISEwertekuerzeleingabeausEND SELECT.pruefeobfehler:IFiserrorTHENclearerror;regeneratemenuscreen;menuinfo(errormessage)END IF.geheeinenhauptmenupunktnachlinks:INT VARanzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;anzahlschritteINCRclearbufferandcount("�");ermittlelinkemenuposition;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.geheeinenhauptmenupunktnachrechts:anzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;anzahlschritteINCRclearbufferandcount("�");ermittlerechtemenuposition;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.loeschealtehauptmenumarkierung:eraseinvers(area(menuwindow),startpos,1,ueberschriftlaenge);out(area(menuwindow),startpos,1,ueberschrifttext).startpos:aktuellesuntermenu.anfangsposition.ueberschriftlaenge:length(ueberschrifttext).ueberschrifttext:aktuellesuntermenu.ueberschrift.ermittlelinkemenuposition:INT VARpositionszaehler;FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwertrunterPER.ermittlerechtemenuposition:FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwerthochPER. +drehediemenupositionumeinenwertrunter:IFaktuellesmenu.hauptmenuzeiger>1THENaktuellesmenu.hauptmenuzeigerDECR1ELSEaktuellesmenu.hauptmenuzeiger:=aktuellesmenu.anzahlhauptmenupunkteFI.drehediemenupositionumeinenwerthoch:IFaktuellesmenu.hauptmenuzeiger0)CAND(naechsteraktiver>0).gehezumfolgendenuntermenupunkt:aktuellesmenu.untermenuzeiger:=naechsteraktiver.stelleaktuellenhauptmenupunktinversdar:outinvers(area(menuwindow),startpos,1,ueberschrifttext).fuehreaktuellenmenupunktaus:IFaktuellesmenu.untermenuzeiger<>0THEN IFnurinterneverwendungANDmitausstiegTHENkennzeichnealsangetickt;disablestop;do(ausstiegsproc);do(menuanweisung);aktuellermenupunkt.angewaehlt:=FALSE;IFiserrorTHENputerror;clearerrorFI;enablestop;anzahloffenermenusDECR1;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);nurinterneverwendung:=FALSE;cursoron;LEAVEhandlemenuELSEkennzeichnealsangetickt;fuehreoperationaus(menuanweisung);IFactivationchangedTHENactivationchanged:=FALSE;refreshsubmenu;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF END IF;nimmkennzeichnungzurueckFI ELSEout(piep)FI.kennzeichnealsangetickt:aktuellermenupunkt.angewaehlt:=TRUE;markiereaktuellenuntermenupunkt.nimmkennzeichnungzurueck:IFaktuellesmenu.untermenuzeiger<>0THENaktuellermenupunkt.angewaehlt:=FALSE;markiereaktuellenuntermenupunktEND IF.menuanweisung:compress(aktuellermenupunkt.procname).aktuellermenupunkt:aktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].holeescsequenz:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(verlassen+"?$",zweiteszeichen)OF CASE1:CASE2:menuinfo(menuleiste.menutext.platz[4],5,maxint)CASE3:gibinfoausOTHERWISEout(piep)END SELECT.wertekuerzeleingabeaus:naechsteraktiver:=pos(kuerzelkette,eingabezeichen);nimmummarkierungvor;fuehreaktuellenmenupunktaus.gibinfoaus:menuinfo(menuleiste.menutext.platz[20]).zeigeerklaerungstextimmenuan:IFaktuellesmenu.untermenuzeiger>0THEN IFcompress(erklaerungstext)=""THENmenuinfo(infotext[3])ELSEmenuinfo(erklaerungstext)FI FI.erklaerungstext:aktuellermenupunkt.boxtext.beendeaktuelleuntermenuoperationen:kuerzelkette:="".starteaktuelleuntermenuoperationen:ermittleaktuellekuerzelkette(kuerzelkette);IFstartoperation<>""THENfuehreoperationaus(startoperation)FI.startoperation:compress(aktuellesuntermenu.startprozedurname).END PROChandlemenu;PROCermittleaktuellekuerzelkette(TEXT VARkuerzelkette):kuerzelkette:="";INT VARkuerzelzeiger;FORkuerzelzeigerFROM1UPTOaktuellesuntermenu.belegtREP IFcompress(aktuellespunktkuerzel)=""THENkuerzelketteCAT"�"ELSEhaengeggfkuerzelanFI PER.aktuellespunktkuerzel:aktuellesuntermenu.menupunkt[kuerzelzeiger].punktkuerzel.haengeggfkuerzelan:IFbetrachteterpunktistaktivTHENkuerzelketteCATaktuellespunktkuerzelELSEkuerzelketteCAT"�"FI.betrachteterpunktistaktiv:aktuellesuntermenu.menupunkt[kuerzelzeiger].aktivEND PROCermittleaktuellekuerzelkette;PROCoeffnemenu(TEXT CONSTmenuname):cursoroff;sucheeingestelltesmenu;IFmenuexistiertnichtTHENcursoron;page;errorstop(fehlermeldung[5]+menuname+fehlermeldung[6])FI;anzahloffenermenusINCR1;ggfneueseiteaufschlagen;ueberpruefeanzahloffenermenus;legeggfaktuellesmenuaufeis;initialisieredenmenubildschirm;IF NOTnurinterneverwendungTHENaktuellesmenu.hauptmenuzeiger:=1;aktuellesmenu.untermenuzeiger:= +0;aktuellesmenu.untermenuanfang:=0;FI;fuehreggfmenueingangsprozeduraus;showmenu;zeigeggfmenukenndatenan.sucheeingestelltesmenu:INT VARi,suchzeiger;BOOL VARgefunden:=FALSE;FORiFROM1UPTOmenuleiste.belegtREP IFmenuleiste.menu[i].menuname=menunameTHENgefunden:=TRUE;suchzeiger:=i;FI UNTILmenuleiste.menu[i].menuname=menunamePER.menuexistiertnicht:NOTgefunden.ueberpruefeanzahloffenermenus:IFanzahloffenermenus>2THENanzahloffenermenus:=0;cursoron;errorstop(fehlermeldung[7])FI.legeggfaktuellesmenuaufeis:IFanzahloffenermenus=2THENmenuleiste.zeigerhintergrund:=menuleiste.zeigeraktuellFI;menuleiste.zeigeraktuell:=suchzeiger.initialisieredenmenubildschirm:hochruntererlaubt:=TRUE;IFanzahloffenermenus=2THENmenuwindow:=zweitesmenu;ELSEmenuwindow:=window(1,2,79,23);FI.fuehreggfmenueingangsprozeduraus:IFaktuellesmenu.menueingangsprozedur<>""THENfuehreoperationaus(aktuellesmenu.menueingangsprozedur)FI.ggfneueseiteaufschlagen:IFanzahloffenermenus=1THENpageFI.zeigeggfmenukenndatenan:IFanzahloffenermenus=1ANDaktuellesmenu.menuinfo<>bleibtleersymbolTHENwritemenunotice(vollstaendigerinfotext,4);pause(100);erasemenunoticeFI.vollstaendigerinfotext:aktuellesmenu.menuinfo+aktuellesmenu.lizenznummer+aktuellesmenu.versionsnummerEND PROCoeffnemenu;PROCshowmenu:ueberpruefemenudaten;page(menuwindow,FALSE);schreibekopfzeile;zeigeinformationszeilean;stellehauptmenuleistezusammen;zeigehauptmenuan;stelleaktuellenhauptmenupunktinversdar;schreibeaktuellesuntermenuaufbildschirm.ueberpruefemenudaten:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFaktuellesmenu.anzahlhauptmenupunkte<1THENerrorstop(fehlermeldung[9])FI.schreibekopfzeile:IFaktuellesmenu.kopfzeile<>""THENcursor(1,1);out(invers(text(aktuellesmenu.kopfzeile,77)))END IF.stellehauptmenuleistezusammen:TEXT VARhauptmenuzeile:=aktuellesmenu.menuname;INT VARzeiger;hauptmenuzeileCAT":";FORzeigerFROM1UPTOaktuellesmenu.anzahlhauptmenupunkteREPhaengehauptmenupunktanPER.haengehauptmenupunktan:hauptmenuzeileCAThauptmenuluecke;hauptmenuzeileCAThauptmenupunktname.hauptmenupunktname:aktuellesmenu.einzelmenu[zeiger].ueberschrift.zeigehauptmenuan:cursor(menuwindow,1,1);out(menuwindow,hauptmenuzeile);cursor(menuwindow,1,2);out(areaxsize(menuwindow)*waagerecht).stelleaktuellenhauptmenupunktinversdar:cursor(menuwindow,startposition,1);out(menuwindow,invers(ueberschrifttext)).startposition:aktuellesuntermenu.anfangsposition-1.ueberschrifttext:aktuellesuntermenu.ueberschrift.zeigeinformationszeilean:writepermanentfootnote(hinweis[1])END PROCshowmenu;PROCschreibeaktuellesuntermenuaufbildschirm:ermittlelinkeobereeckedesuntermenukastens;zeichnequerlinieneu;wirfuntermenuaus;showmenunotice;cursorinwarteposition.ermittlelinkeobereeckedesuntermenukastens:aktuellesmenu.untermenuanfang:=menumitte-halbemenubreite;achteaufrandextrema.menumitte:startposition+(length(ueberschrifttext)DIV2)-1.startposition:aktuellesuntermenu.anfangsposition.ueberschrifttext:aktuellesuntermenu.ueberschrift.halbemenubreite:aktuellesuntermenu.maxlaengeDIV2.achteaufrandextrema:gleicheggflinkenrandaus;gleicheggfrechtenrandaus.zeichnequerlinieneu:cursor(1,3);out(79*waagerecht).gleicheggflinkenrandaus:IFaktuellesmenu.untermenuanfang<4THENaktuellesmenu.untermenuanfang:=4FI.gleicheggfrechtenrandaus:IF(aktuellesmenu.untermenuanfang+aktuellesuntermenu.maxlaenge)>(areaxsize(menuwindow)-3)THENaktuellesmenu.untermenuanfang:=areaxsize(menuwindow)-aktuellesuntermenu.maxlaenge-3FI.wirfuntermenuaus:TEXT VARlinie:=(aktuellesuntermenu.maxlaenge+5)*waagerecht;IFaktuellesmenu.untermenuzeiger=0THENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI;wirfuntermenukopfzeileaus;wirfuntermenurumpfaus;wirfuntermenufusszeileaus;markiereaktuellenuntermenupunkt.wirfuntermenukopfzeileaus:cursor(menuwindow,spalte,anfangszeile);out(balkenoben);out(linie);out(balkenoben).wirfuntermenufusszeileaus:cursor(menuwindow,spalte,endezeile);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.endezeile: +ersteuntermenuzeile+aktuellesuntermenu.belegt.wirfuntermenurumpfaus:INT VARlaufvar;INT CONSTaktuellepunktlaenge:=aktuellesuntermenu.maxlaenge+1;FORlaufvarFROM1UPTOaktuellesuntermenu.belegtREPwirfeineeinzelnemenuzeileausPER.wirfeineeinzelnemenuzeileaus:outwithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.aktuellerpunktname:untermenubezeichnung(laufvar).laenge:aktuellepunktlaengeEND PROCschreibeaktuellesuntermenuaufbildschirm;PROCloescheaktuellesuntermenuaufbildschirm:beendeaktuelleuntermenuoperationen;loescheuntermenuaufbildschirm;schreibebalkenwiederhin;aktuellesmenu.untermenuzeiger:=1.beendeaktuelleuntermenuoperationen:IFleaveoperation<>""THENfuehreoperationaus(leaveoperation)FI.leaveoperation:compress(aktuellesuntermenu.leaveprozedurname).loescheuntermenuaufbildschirm:INT VARlaufvar;FORlaufvarFROMaktuellesuntermenu.belegt+1DOWNTO1REPloescheeineeinzelnemenuzeilePER.loescheeineeinzelnemenuzeile:erasewithbeam(area(menuwindow),menuspalte,menuzeile,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.laenge:aktuellesuntermenu.maxlaenge+1.schreibebalkenwiederhin:cursor(menuwindow,spalte,anfangszeile);out((aktuellesuntermenu.maxlaenge+7)*waagerecht).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.END PROCloescheaktuellesuntermenuaufbildschirm;PROCmarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENlaufeggfzumnaechstenaktivenmenupunkt;IFaktuellesmenu.untermenuzeiger<>0THENoutinverswithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF ELSEhochruntererlaubt:=FALSE FI.laufeggfzumnaechstenaktivenmenupunkt:IF NOTaktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].aktivTHENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCmarkiereaktuellenuntermenupunkt;PROCdemarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENeraseinvers(area(menuwindow),menuspalte,menuzeile,laenge);out(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCdemarkiereaktuellenuntermenupunkt;INT PROCfolgenderaktiveruntermenupunkt:INT VARnaechster,aktueller,anzahl,zeiger;zeiger:=aktuellesmenu.untermenuzeiger;IFzeiger=0THEN IFaktuellesuntermenu.menupunkt[1].aktivTHEN LEAVEfolgenderaktiveruntermenupunktWITH 1 ELSEaktueller:=1END IF ELSEaktueller:=zeigerEND IF;naechster:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugenachfolger;IFnaechster=aktuellerTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[naechster].aktivTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITHnaechsterEND IF PER;0.erzeugenachfolger:naechster:=(naechsterMODanzahl)+1END PROCfolgenderaktiveruntermenupunkt;INT PROCvorausgehenderaktiveruntermenupunkt:INT VARvoriger,aktueller,anzahl;aktueller:=aktuellesmenu.untermenuzeiger;voriger:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugevorgaenger;IFvoriger=aktuellerTHEN LEAVEvorausgehenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[voriger].aktivTHEN LEAVEvorausgehenderaktiveruntermenupunktWITHvorigerEND IF PER;0.erzeugevorgaenger:voriger:=((voriger+anzahl-2)MODanzahl)+1END PROCvorausgehenderaktiveruntermenupunkt;PROCcursorinwarteposition:cursor(areax(menuwindow),areay(menuwindow)+1)END PROCcursorinwarteposition;TEXT PROCuntermenubezeichnung(INT CONSTposition):TEXT +VAR bezeichnung:="";bezeichnungCATkennzeichnung;bezeichnungCATpunktkennung;bezeichnung.kennzeichnung:IFaktuellermenupunkt.aktivTHEN IFaktuellermenupunkt.angewaehltTHEN"*"ELIFaktuellermenupunkt.punktkuerzel<>""THENaktuellermenupunkt.punktkuerzelELIFaktuellermenupunkt.punktkuerzel=""THENblankELSE"-"FI ELSE"-"FI.punktkennung:IFmenupunktisttrennzeileTHENstrichellinieELSEaktuellermenupunkt.punktnameFI.menupunktisttrennzeile:aktuellermenupunkt.punktname=(blank+trennzeilensymbol).strichellinie:(aktuellesuntermenu.maxlaenge+1)*"-".aktuellermenupunkt:aktuellesuntermenu.menupunkt[position]END PROCuntermenubezeichnung;PROCfuehreoperationaus(TEXT CONSToperation):disablestop;IFoperation=""THENmenuinfo(infotext[1]);LEAVEfuehreoperationausFI;do(operation);IFiserrorTHENclearerror;oldfootnote;regeneratemenuscreen;menuinfo(errormessage,5)FI;enablestop;cursoroffEND PROCfuehreoperationaus;PROCveraendereaktivierung(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereaktivierung.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;LEAVEveraendereaktivierung.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereaktivierung:veraendereaktivierung(unterpunktposition,eintrag)END PROCveraendereaktivierung;PROCveraendereaktivierung(INT CONSTpunktnummer,BOOL CONSTeintrag):IFpunktnummer>=1ANDpunktnummer<=untermenuendeTHENaktuellesuntermenu.menupunkt[punktnummer].angewaehlt:=FALSE;aktuellesuntermenu.menupunkt[punktnummer].aktiv:=eintrag;activationchanged:=TRUE;FI.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegtEND PROCveraendereaktivierung;PROCveraendereanwahl(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereanwahl.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;enablestop;errorstop(fehlermeldung[10]).untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereanwahl:aktuellesuntermenu.menupunkt[unterpunktposition].angewaehlt:=eintragEND PROCveraendereanwahl;PROCactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,TRUE)END PROCactivate;PROCactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,TRUE)END PROCactivate;PROCdeactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,FALSE)END PROCdeactivate;PROCdeactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,FALSE)END PROCdeactivate;PROCselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,TRUE)END PROCselect;PROCdeselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,FALSE)END PROCdeselect;PROCschliessemenu:IFaktuellesmenu.menuausgangsprozedur<>""THENfootnote(hinweis[3]);fuehreoperationaus(aktuellesmenu.menuausgangsprozedur)FI;anzahloffenermenusDECR1;IFanzahloffenermenus=1THENaktivieredasaufeisgelegtemenuFI.aktivieredasaufeisgelegtemenu:hochruntererlaubt:=TRUE;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);showmenuEND PROCschliessemenu;PROCrefreshsubmenu:schreibeaktuellesuntermenuaufbildschirm;showmenunotice;activationchanged:=FALSE END PROCrefreshsubmenu;PROCregeneratemenuscreen:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFanzahloffenermenus=1THENpage;showmenu;showmenunoticeELSEzeigeerstesmenuan;zeigezweitesmenuan;showmenunoticeFI;activationchanged:=FALSE.zeigeerstesmenuan:INT VARmenuzeiger:=menuleiste.zeigeraktuell;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);anzahloffenermenus:=1;showmenu.zeigezweitesmenuan:menuleiste.zeigeraktuell:=menuzeiger;menuwindow:=zweitesmenu;anzahloffenermenus:=2;showmenu.END PROC +regeneratemenuscreen;PROCmenuinfo(TEXT CONSTt,INT CONSTposition,timelimit):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);boxinfo(w,t,position,timelimit,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt,INT CONSTposition):menuinfo(t,position,maxint)END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt):menuinfo(t,5,maxint)END PROCmenuinfo;INT PROCmenualternative(TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);INT VARergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;ergebnisEND PROCmenualternative;BOOL PROCmenuyes(TEXT CONSTfrage,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);BOOL VARwert:=boxyes(w,frage,position,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuyes;BOOL PROCmenuno(TEXT CONSTfrage,INT CONSTposition):NOTmenuyes(frage,position)END PROCmenuno;TEXT PROCmenuone(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT CONSTwert:=boxone(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuone;THESAURUS PROCmenusome(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS CONSTthesaurus:=boxsome(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;thesaurusEND PROCmenusome;TEXT PROCmenuanswer(TEXT CONSTt,vorgabe,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswer(w,t,vorgabe,position,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuanswer;TEXT PROCmenuanswerone(TEXT CONSTt,vorgabe,THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswerone(w,t,vorgabe,thes,t1,t2,mitreinigung,FALSE)IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuanswerone;THESAURUS PROCmenuanswersome(TEXT CONSTt,vorgabe,THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS VARwert:=boxanswersome(w,t,vorgabe,thes,t1,t2,mitreinigung,FALSE)IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuanswersome;TEXT PROCmenubasistext(INT CONSTnummer):IFnummer<=20THENfehlermeldung[12]ELIFnummer>menuleiste.menutext.anzahlmenutexteTHENfehlermeldung[11]ELSEmenuleiste.menutext.platz[nummer]FI END PROCmenubasistext;TEXT PROCanwendungstext(INT CONSTnummer):IFnummer>menuleiste.infotext.anzahlinfotexteTHENfehlermeldung[11]ELSEmenuleiste.infotext.stelle[nummer]FI END PROCanwendungstext;PROCzeigemenukennung:IFanzahloffenermenus=0THENzeigeangabenundemblem;FI.zeigeangabenundemblem:ROW5WINDOW VARw;w[1]:=window(40,4,30,9);w[2]:=window(36,6,30,9);w[3]:=window(30,8,30,9);w[4]:=window(22,10,30,9);w[5]:=window(12,12,30,9);page;show(w[1]);out(w[1],center(w[1],invers(systemkuerzel)));show(w[2]);out(w[2]," Version "+versionsnummer);show(w[3]);out(w[3],copyright1);show(w[4]);out(w[4],copyright2);show(w[5]);cursor(w[5],1,2);out(w[5]," lll sssssssss ");cursor(w[5],1,3);out(w[5]," lll sss sss ");cursor(w[5],1,4);out(w[5]," lll sss ");cursor(w[5],1,5);out(w[5]," lll sssssssss ");cursor(w[5],1,6);out(w[5]," lll sss ");cursor(w[5],1,7);out(w[ +5]," lll latta soft sss ");cursor(w[5],1,8);out(w[5]," lllllllll sssssssss ");cursor(79,24);zeitpunkt:=clock(1);END PROCzeigemenukennung;PROCresetdialog:angekoppeltemenutafel:="";anzahloffenermenus:=0END PROCresetdialog;PROCwritemenunotice(TEXT CONSTt,INT CONSTposition):erasemenunotice;boxnotice(menuwindow,t,position,menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotiztext:=t;menunotizposition:=position;menunotizistgesetzt:=TRUE END PROCwritemenunotice;PROCshowmenunotice:IFmenunotizistgesetztTHENboxnotice(menuwindow,menunotiztext,menunotizposition,menunotizx,menunotizy,menunotizxsize,menunotizysize);FI END PROCshowmenunotice;PROCerasemenunotice:INT VARspa,zei;getcursor(spa,zei);IFmenunotizistgesetztTHENpageup(menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotizistgesetzt:=FALSE;cursor(spa,zei)FI END PROCerasemenunotice;PROCinitializemenuwindow:schreibfenster:=window(areax(menuwindow)+1,areay(menuwindow)+3,areaxsize(menuwindow)-2,areaysize(menuwindow)-4)END PROCinitializemenuwindow;PROCshowmenuwindow:initializemenuwindow;show(schreibfenster);END PROCshowmenuwindow;PROCmenuwindowpage:initializemenuwindow;page(schreibfenster)END PROCmenuwindowpage;PROCmenuwindowout(TEXT CONSTtext):out(schreibfenster,text)END PROCmenuwindowout;PROCmenuwindowget(TEXT VARtext):get(schreibfenster,text)END PROCmenuwindowget;PROCmenuwindoweditget(TEXT VARtext):edit(schreibfenster,text)END PROCmenuwindoweditget;PROCmenuwindowedit(TEXT CONSTdateiname):initializemenuwindow;edit(schreibfenster,dateiname)END PROCmenuwindowedit;PROCmenuwindowedit(FILE VARf):initializemenuwindow;edit(schreibfenster,f)END PROCmenuwindowedit;PROCmenuwindowshow(TEXT CONSTdateiname):initializemenuwindow;show(schreibfenster,dateiname)END PROCmenuwindowshow;PROCmenuwindowshow(FILE VARf):initializemenuwindow;show(schreibfenster,f)END PROCmenuwindowshow;BOOL PROCmenuwindowyes(TEXT CONSTfrage):yes(schreibfenster,frage)END PROCmenuwindowyes;BOOL PROCmenuwindowno(TEXT CONSTfrage):no(schreibfenster,frage)END PROCmenuwindowno;PROCmenuwindowline:menuwindowline(1)END PROCmenuwindowline;PROCmenuwindowline(INT CONSTanzahl):line(schreibfenster,anzahl)END PROCmenuwindowline;PROCmenuwindowcursor(INT CONSTspa,zei):cursor(schreibfenster,spa,zei)END PROCmenuwindowcursor;PROCgetmenuwindowcursor(INT VARspa,zei):getcursor(schreibfenster,spa,zei)END PROCgetmenuwindowcursor;INT PROCremainingmenuwindowlines:remaininglines(schreibfenster)END PROCremainingmenuwindowlines;TEXT PROCmenuwindowcenter(TEXT CONSTt):center(schreibfenster,t)END PROCmenuwindowcenter;PROCmenuwindowstop:menuwindowstop(2)END PROCmenuwindowstop;PROCmenuwindowstop(INT CONSTanzahl):stop(schreibfenster,anzahl)END PROCmenuwindowstop;WINDOW PROCcurrentmenuwindow:initializemenuwindow;schreibfensterEND PROCcurrentmenuwindow;PROCstdinfoedit(FILE VARf,INT CONSToberstezeile):IFoberstezeile<1ORoberstezeile>3THENerrorstop(fehlermeldung[13]);FI;garantieremenukarte;cursor(1,oberstezeile);out(cleop);cursor(1,24);out(invers(text(menubasistext(141),76)));editorinfofenster:=window(1,oberstezeile+2,79,24-oberstezeile);kommandoauftastelegen("?","editorinformationen");commanddialogue(FALSE);cursoron;edit(f,1,oberstezeile+1,79,23-oberstezeile);commanddialogue(TRUE);kommandoauftastelegen("?","").garantieremenukarte:TEXT VARname:=compress(menukartenname);IFname=""THENinstallmenu(stdmenukartenname,FALSE)FI.END PROCstdinfoedit;PROCstdinfoedit(FILE VARf):stdinfoedit(f,1)END PROCstdinfoedit;PROCstdinfoedit(TEXT CONSTdateiname,INT CONSToberstezeile):FILE VARf:=sequentialfile(modify,dateiname);stdinfoedit(f,oberstezeile);END PROCstdinfoedit;PROCstdinfoedit(TEXT CONSTdateiname):stdinfoedit(dateiname,1)END PROCstdinfoedit;PROCeditorinformationen:BOOL VARendegewuenscht:=FALSE;INT VARz;FORzFROMstartwertUPTO22REPcursor(1,z);out(cleol);PER;REP INT VARerg:=boxalternative(editorinfofenster,menubasistext(149),menubasistext(150),menubasistext(151),5,FALSE,FALSE);erfuelledenwunschUNTILendegewuenschtPER;cursor(1,24);out(invers(text(menubasistext( +141),76))).startwert:areay(editorinfofenster)+1.erfuelledenwunsch:IFerg>100THENergDECR100END IF;SELECTergOF CASE1,9:boxinfo(editorinfofenster,menubasistext(142),5,maxint,FALSE)CASE2,10:boxinfo(editorinfofenster,menubasistext(143),5,maxint,FALSE)CASE3,11:boxinfo(editorinfofenster,menubasistext(144),5,maxint,FALSE)CASE4,12:boxinfo(editorinfofenster,menubasistext(145),5,maxint,FALSE)CASE5,13:boxinfo(editorinfofenster,menubasistext(146),5,maxint,FALSE)CASE6,14:boxinfo(editorinfofenster,menubasistext(147),5,maxint,FALSE)CASE7,15:boxinfo(editorinfofenster,menubasistext(148),5,maxint,FALSE)CASE8,16:endegewuenscht:=TRUE END SELECT END PROCeditorinformationen;PROCbereinigesituation:page;forget(ds);resetdialogEND PROCbereinigesituation;PROCdirektstart(TEXT CONSTprocname,BOOL CONSTautoloeschen):TEXT VARdatname:="Selbststartergenerierungsdatei",letzter:=std;kopplearchivmenukartean;schreibeprogramm;insertiereprogramm;abkoppeln.kopplearchivmenukartean:installmenu(stdmenukartenname,FALSE).schreibeprogramm:forget(datname,quiet);FILE VARf:=sequentialfile(output,datname);putline(f,menubasistext(191));putline(f,"do ("+code(34)+"reset dialog; erase menunotice; "+procname+code(34)+");");putline(f,menubasistext(192));IFautoloeschenTHENputline(f,menubasistext(193))ELSEputline(f,menubasistext(194))FI;putline(f,menubasistext(195));putline(f,menubasistext(196)).insertiereprogramm:TEXT VARt:="insert ("+code(34)+datname+code(34)+")";do(t).abkoppeln:forget(datname,quiet);lastparam(letzter);resetdialog;globalmanager.END PROCdirektstart;PROCwritehead(TEXT CONSTt):INT VARx,y;getcursor(x,y);IFt<>""THENcursor(1,1);out(invers(text(t,77)))END IF;cursor(x,y)END PROCwritehead;PROCrestorehead:TEXT VARkopf:=menuleiste.menu[menuleiste.zeigeraktuell].kopfzeile;writehead(kopf)END PROCrestorehead;PROCsetwindow2(INT CONSTx2,y2,xsize2,ysize2):IFy2<2THENerrorstop("Kopfzeile wird überschrieben")END IF;zweitesmenu:=window(x2,y2,xsize2,ysize2);END PROCsetwindow2;.aktuellesuntermenu:aktmenu.einzelmenu[aktmenu.hauptmenuzeiger].aktmenu:menuleiste.menu[menuleiste.zeigeraktuell].aktuellesmenu:menuleiste.menu[menuleiste.zeigeraktuell].;END PACKETlsdialog5; + + diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.simsel b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.simsel new file mode 100644 index 0000000..c6bed08 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.simsel @@ -0,0 +1,12 @@ +PACKETlsdialog5DEFINESwritehead,restorehead,setwindow2,menuinfo,menualternative,menuyes,menuno,menuone,menusome,menuanswer,menuanswerone,menuanswersome,installmenu,handlemenu,refreshsubmenu,deactivate,regeneratemenuscreen,activate,writemenunotice,erasemenunotice,menubasistext,anwendungstext,showmenuwindow,menuwindowpage,menuwindowout,menuwindowget,menuwindoweditget,menuwindowedit,menuwindowshow,menuwindowline,menuwindowyes,menuwindowno,menuwindowcursor,getmenuwindowcursor,remainingmenuwindowlines,menuwindowcenter,menuwindowstop,editorinformationen,stdinfoedit,menukartenname,currentmenuwindow,resetdialog,onlyintern,ausstieg,direktstart:LETsystemkuerzel="ls-DIALOG",menutafeltaskname="ls-MENUKARTEN",menutafeltype=1954,menutafelpraefix="ls-MENUKARTE:",stdmenukartenname="ls-MENUKARTE:Archiv",versionsnummer="1.1",copyright1=" (C) 1987/88 Eva Latta-Weber",copyright2=" (C) 1988 ERGOS GmbH";LETmaxmenus=6,maxmenutexte=300,maxinfotexte=2000,maxhauptmenupunkte=10,maxuntermenupunkte=15,ersteuntermenuzeile=3;LETblank=" ",verlassen="q",piep="�",cleol="�",cleop="�",trennzeilensymbol="###",bleibtleersymbol="***",headzeilenlaenge=77,headproduktname="schulis Simulationssystem",hauptmenuluecke=" ";LETauswahlstring1="�� +� �?";TYPE MENUPUNKT=STRUCT(TEXTpunktkuerzel,punktname,procname,boxtext,BOOLaktiv,angewaehlt),EINZELMENU=STRUCT(INTbelegt,TEXTueberschrift,INTanfangsposition,maxlaenge,ROWmaxuntermenupunkteMENUPUNKTmenupunkt,INTaktuelleruntermenupunkt,TEXTstartprozedurname,leaveprozedurname),MENU=STRUCT(TEXTmenuname,kopfzeile,INTanzahlhauptmenupunkte,ROWmaxhauptmenupunkteEINZELMENUeinzelmenu,TEXTmenueingangsprozedur,menuausgangsprozedur,menuinfo,lizenznummer,versionsnummer,INThauptmenuzeiger,untermenuanfang,untermenuzeiger),INFOTEXT=STRUCT(INTanzahlinfotexte,ROWmaxinfotexteTEXTstelle),MENUTEXT=STRUCT(INTanzahlmenutexte,ROWmaxmenutexteTEXTplatz),MENULEISTE=STRUCT(INTbelegt,zeigeraktuell,zeigerhintergrund,ROWmaxmenusMENUmenu,MENUTEXTmenutext,INFOTEXTinfotext);BOUND MENULEISTE VARmenuleiste;DATASPACE VARds;WINDOW VARmenuwindow,schreibfenster,editorinfofenster;WINDOW VARzweitesmenu:=window(6,5,73,19);INITFLAG VARinthistask:=FALSE;INT VARanzahloffenermenus:=0;INT VARmenunotizx,menunotizxsize,menunotizy,menunotizysize,menunotizposition;TEXT VARangekoppeltemenutafel:="",menunotiztext;BOOL VARmenunotizistgesetzt:=FALSE,nurinterneverwendung:=FALSE,mitausstieg:=FALSE,hochruntererlaubt:=TRUE,activationchanged:=FALSE;REAL VARzeitpunkt:=clock(1);ROW13TEXT CONSTfehlermeldung:=ROW13TEXT:("Die Task '"+menutafeltaskname+"' existiert nicht!","Die Menükarte '","' existiert nicht in der Task '"+menutafeltaskname+"'!","' hat falschen Typ/Bezeichnung (keine 'MENÜKARTE')!","Das Menü '","' ist nicht in der angekoppelten Menükarte!","Zu viele geöffnete Menüs ( > 2 )!","Kein Menü geöffnet!","Menü enthält keine Menüpunkte!","Menüpunkt ist nicht im Menü enthalten!","Kein Text vorhanden!","Zugriff unmöglich!","Einschränkung unzulässig!");ROW1TEXT CONSTvergleichstext:=ROW1TEXT:("gibt es nicht");ROW3TEXT CONSThinweis:=ROW3TEXT:(" Info:/ Wählen: Bestätigen: Verlassen:"," Weiter mit beliebiger Taste!"," Bitte warten...!");ROW3TEXT CONSTinfotext:=ROW3TEXT:(" Für diesen Menüpunkt ist (noch) keine Funktion eingetragen!"," Möchten Sie dieses Menü tatsächlich verlassen"," Leider ist zu diesem Menüpunkt kein Info - Text eingetragen!");PROCinstallmenu(TEXT CONSTmenutafelname):installmenu(menutafelname,TRUE)END PROCinstallmenu;PROCinstallmenu(TEXT CONSTmenutafelname,BOOL CONSTmitkennung):TEXT VARletzterparameter;IFmitkennungTHENzeigemenukennungFI;initialisieremenuggf;IFmenutafelnochnichtangekoppeltTHENletzterparameter:=std;holemenutafel;kopplemenutafelan;lastparam(letzterparameter)FI.initialisieremenuggf:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;nurinterneverwendung:=FALSE FI.menutafelnochnichtangekoppelt:menutafelname<>angekoppeltemenutafel.holemenutafel:IF NOTexiststask +(menutafeltaskname)THENbereinigesituation;cursoron;errorstop(fehlermeldung[1])FI;disablestop;fetch(menutafelname,/menutafeltaskname);IFiserrorANDpos(errormessage,vergleichstext[1])>0THENclearerror;enablestop;bereinigesituation;cursoron;errorstop(fehlermeldung[2]+menutafelname+fehlermeldung[3])ELIFiserrorTHENclearerror;enablestop;bereinigesituation;cursoron;errorstop(errormessage)ELSEenablestopFI.kopplemenutafelan:IFtype(old(menutafelname))=menutafeltypeANDpos(menutafelname,menutafelpraefix)=1THENforget(ds);ds:=old(menutafelname);menuleiste:=ds;angekoppeltemenutafel:=menutafelname;forget(menutafelname,quiet)ELSEbereinigesituation;cursoron;errorstop("'"+menutafelname+fehlermeldung[4])FI.END PROCinstallmenu;PROConlyintern(BOOL CONSTwert):nurinterneverwendung:=wertEND PROConlyintern;PROCausstieg(BOOL CONSTwert):mitausstieg:=wertEND PROCausstieg;TEXT PROCmenukartenname:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI;angekoppeltemenutafelEND PROCmenukartenname;PROChandlemenu(TEXT CONSTmenuname,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarst):nurinterneverwendung:=FALSE;mitausstieg:=TRUE;handlemenu(menuname,"",PROCf,PROCcof,PROCzusatzdarst)END PROChandlemenu;PROChandlemenu(TEXT CONSTmenuname,ausstiegsproc,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarst):cursoroff;IFnurinterneverwendungTHENoeffnemenu(menuname)ELSEbietemenuanFI;lassemenupunkteauswaehlen;IFnurinterneverwendungTHENdo(ausstiegsproc);anzahloffenermenusDECR1;IFanzahloffenermenus<1THENerasemenunoticeFI;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);nurinterneverwendung:=FALSE;mitausstieg:=TRUE;cursoronELSEschliessemenu;leereggfdenbildschirmFI.bietemenuan:REAL VARzwischenzeit:=clock(1)-zeitpunkt;IFzwischenzeit<2.0THENpause(20-int(10.0*zwischenzeit))FI;oeffnemenu(menuname).leereggfdenbildschirm:IFanzahloffenermenus<1THENerasemenunotice;page;cursoronFI.lassemenupunkteauswaehlen:TEXT VARkuerzelkette:="";starteaktuelleuntermenuoperationen;disablestop;REPcursorinwarteposition;ermittleaktuellekuerzelkette(kuerzelkette);nimmzeichenauf;interpretierezeichenUNTILmenuverlassengewuenschtPER.nimmzeichenauf:TEXT CONSTerlaubtezeichen:=auswahlstring1+kuerzelkette;TEXT VAReingabezeichen;INT VARzeichenposition;REPinchar(eingabezeichen);pruefeobfehler;zeichenposition:=pos(erlaubtezeichen,eingabezeichen);piepseggfUNTILzeichenposition>0PER.piepseggf:IFzeichenposition=0THENout(piep)FI.menuverlassengewuenscht:zeichenposition=6AND(zweiteszeichen=verlassen).pruefeobfehler:IFiserrorTHENregeneratemenuscreen;menuinfo(errormessage);clearerrorEND IF.interpretierezeichen:SELECTzeichenpositionOF CASE1:geheeinenhauptmenupunktnachlinksCASE2:geheeinenhauptmenupunktnachrechtsCASE3:geheeinenuntermenupunktnachuntenCASE4:geheeinenuntermenupunktnachobenCASE5:fuehreaktuellenmenupunktausCASE6:holeescsequenzCASE7:zeigeerklaerungstextimmenuanOTHERWISEwertekuerzeleingabeausEND SELECT.geheeinenhauptmenupunktnachlinks:INT VARanzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;anzahlschritteINCRclearbufferandcount("�");ermittlelinkemenuposition;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.geheeinenhauptmenupunktnachrechts:anzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;anzahlschritteINCRclearbufferandcount("�");ermittlerechtemenuposition;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.loeschealtehauptmenumarkierung:eraseinvers(area(menuwindow),startpos,1,ueberschriftlaenge);out(area(menuwindow),startpos,1,ueberschrifttext). +startpos:aktuellesuntermenu.anfangsposition.ueberschriftlaenge:length(ueberschrifttext).ueberschrifttext:aktuellesuntermenu.ueberschrift.ermittlelinkemenuposition:INT VARpositionszaehler;FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwertrunterPER.ermittlerechtemenuposition:FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwerthochPER.drehediemenupositionumeinenwertrunter:IFaktuellesmenu.hauptmenuzeiger>1THENaktuellesmenu.hauptmenuzeigerDECR1ELSEaktuellesmenu.hauptmenuzeiger:=aktuellesmenu.anzahlhauptmenupunkteFI.drehediemenupositionumeinenwerthoch:IFaktuellesmenu.hauptmenuzeiger0)CAND(naechsteraktiver>0).gehezumfolgendenuntermenupunkt:aktuellesmenu.untermenuzeiger:=naechsteraktiver.stelleaktuellenhauptmenupunktinversdar:outinvers(area(menuwindow),startpos,1,ueberschrifttext).fuehreaktuellenmenupunktaus:IFaktuellesmenu.untermenuzeiger>0THEN IFnurinterneverwendungANDmitausstiegTHENkennzeichnealsangetickt;disablestop;do(ausstiegsproc);do(menuanweisung);aktuellermenupunkt.angewaehlt:=FALSE;IFiserrorTHENputerror;clearerrorFI;enablestop;anzahloffenermenusDECR1;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);nurinterneverwendung:=FALSE;cursoron;LEAVEhandlemenuELSEkennzeichnealsangetickt;IFmenuanweisung=""THENverteiler(aktuellesmenu.hauptmenuzeiger,aktuellesmenu.untermenuzeiger,PROCf,PROCcof,PROCzusatzdarst);ELSEfuehreoperationaus(menuanweisung);FI;IFactivationchangedTHENactivationchanged:=FALSE;refreshsubmenu;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF END IF;nimmkennzeichnungzurueckFI ELSEout(piep)FI.kennzeichnealsangetickt:aktuellermenupunkt.angewaehlt:=TRUE;markiereaktuellenuntermenupunkt.nimmkennzeichnungzurueck:IFaktuellesmenu.untermenuzeiger<>0THENaktuellermenupunkt.angewaehlt:=FALSE;markiereaktuellenuntermenupunktEND IF.menuanweisung:compress(aktuellermenupunkt.procname).aktuellermenupunkt:aktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].holeescsequenz:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(verlassen+"?$",zweiteszeichen)OF CASE1:CASE2:menuinfo(menuleiste.menutext.platz[4],5,maxint)CASE3:gibinfoausOTHERWISEout(piep)END SELECT.gibinfoaus:menuinfo(menuleiste.menutext.platz[20]).zeigeerklaerungstextimmenuan:IFaktuellesmenu.untermenuzeiger>0THEN IFcompress(erklaerungstext)=""THENmenuinfo(infotext[3])ELSEmenuinfo(erklaerungstext)FI FI.erklaerungstext:aktuellermenupunkt.boxtext.wertekuerzeleingabeaus:naechsteraktiver:=pos(kuerzelkette,eingabezeichen);nimmummarkierungvor;fuehreaktuellenmenupunktaus.starteaktuelleuntermenuoperationen:ermittleaktuellekuerzelkette(kuerzelkette);IFstartoperation<>""THENfuehreoperationaus(startoperation)FI.startoperation:compress(aktuellesuntermenu.startprozedurname).beendeaktuelleuntermenuoperationen:kuerzelkette:="".END PROChandlemenu;PROCermittleaktuellekuerzelkette(TEXT VARkuerzelkette):kuerzelkette:="";INT VARkuerzelzeiger;FORkuerzelzeigerFROM1UPTOaktuellesuntermenu.belegtREP IFcompress(aktuellespunktkuerzel)=""THENkuerzelketteCAT"�"ELSEhaengeggfkuerzelanFI PER.aktuellespunktkuerzel:aktuellesuntermenu.menupunkt[kuerzelzeiger].punktkuerzel.haengeggfkuerzelan:IFbetrachteterpunktistaktivTHENkuerzelketteCATaktuellespunktkuerzelELSEkuerzelkette +CAT"�"FI.betrachteterpunktistaktiv:aktuellesuntermenu.menupunkt[kuerzelzeiger].aktivEND PROCermittleaktuellekuerzelkette;PROCoeffnemenu(TEXT CONSTmenuname):cursoroff;sucheeingestelltesmenu;IFmenuexistiertnichtTHENcursoron;page;errorstop(fehlermeldung[5]+menuname+fehlermeldung[6])FI;anzahloffenermenusINCR1;ggfneueseiteaufschlagen;ueberpruefeanzahloffenermenus;legeggfaktuellesmenuaufeis;initialisieredenmenubildschirm;IF NOTnurinterneverwendungTHENaktuellesmenu.hauptmenuzeiger:=1;aktuellesmenu.untermenuzeiger:=0;aktuellesmenu.untermenuanfang:=0;FI;fuehreggfmenueingangsprozeduraus;showmenu;zeigeggfmenukenndatenan.sucheeingestelltesmenu:INT VARi,suchzeiger;BOOL VARgefunden:=FALSE;FORiFROM1UPTOmenuleiste.belegtREP IFmenuleiste.menu[i].menuname=menunameTHENgefunden:=TRUE;suchzeiger:=i;FI UNTILmenuleiste.menu[i].menuname=menunamePER.menuexistiertnicht:NOTgefunden.ueberpruefeanzahloffenermenus:IFanzahloffenermenus>2THENanzahloffenermenus:=0;cursoron;errorstop(fehlermeldung[7])FI.legeggfaktuellesmenuaufeis:IFanzahloffenermenus=2THENmenuleiste.zeigerhintergrund:=menuleiste.zeigeraktuellFI;menuleiste.zeigeraktuell:=suchzeiger.initialisieredenmenubildschirm:hochruntererlaubt:=TRUE;IFanzahloffenermenus=2THENmenuwindow:=zweitesmenu;ELSEmenuwindow:=window(1,2,79,23);FI.fuehreggfmenueingangsprozeduraus:IFaktuellesmenu.menueingangsprozedur<>""THENfuehreoperationaus(aktuellesmenu.menueingangsprozedur)FI.ggfneueseiteaufschlagen:IFanzahloffenermenus=1THENpageFI.zeigeggfmenukenndatenan:IFanzahloffenermenus=1ANDaktuellesmenu.menuinfo<>bleibtleersymbolTHENwritemenunotice(vollstaendigerinfotext,4);pause(100);erasemenunoticeFI.vollstaendigerinfotext:aktuellesmenu.menuinfo+aktuellesmenu.lizenznummer+aktuellesmenu.versionsnummerEND PROCoeffnemenu;PROCshowmenu:ueberpruefemenudaten;page(menuwindow,FALSE);schreibekopfzeile;zeigeinformationszeilean;stellehauptmenuleistezusammen;zeigehauptmenuan;stelleaktuellenhauptmenupunktinversdar;schreibeaktuellesuntermenuaufbildschirm.ueberpruefemenudaten:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFaktuellesmenu.anzahlhauptmenupunkte<1THENerrorstop(fehlermeldung[9])FI.schreibekopfzeile:zeigekopfbalken;.stellehauptmenuleistezusammen:TEXT VARhauptmenuzeile:=aktuellesmenu.menuname;INT VARzeiger;hauptmenuzeileCAT":";FORzeigerFROM1UPTOaktuellesmenu.anzahlhauptmenupunkteREPhaengehauptmenupunktanPER.haengehauptmenupunktan:hauptmenuzeileCAThauptmenuluecke;hauptmenuzeileCAThauptmenupunktname.hauptmenupunktname:aktuellesmenu.einzelmenu[zeiger].ueberschrift.zeigehauptmenuan:cursor(menuwindow,1,1);out(menuwindow,hauptmenuzeile);cursor(menuwindow,1,2);out(areaxsize(menuwindow)*waagerecht).stelleaktuellenhauptmenupunktinversdar:cursor(menuwindow,startposition,1);out(menuwindow,invers(ueberschrifttext)).startposition:aktuellesuntermenu.anfangsposition-1.ueberschrifttext:aktuellesuntermenu.ueberschrift.zeigeinformationszeilean:writepermanentfootnote(hinweis[1])END PROCshowmenu;PROCschreibeaktuellesuntermenuaufbildschirm:ermittlelinkeobereeckedesuntermenukastens;zeichnequerlinieneu;wirfuntermenuaus;showmenunotice;cursorinwarteposition.ermittlelinkeobereeckedesuntermenukastens:aktuellesmenu.untermenuanfang:=menumitte-halbemenubreite;achteaufrandextrema.menumitte:startposition+(length(ueberschrifttext)DIV2)-1.startposition:aktuellesuntermenu.anfangsposition.ueberschrifttext:aktuellesuntermenu.ueberschrift.halbemenubreite:aktuellesuntermenu.maxlaengeDIV2.achteaufrandextrema:gleicheggflinkenrandaus;gleicheggfrechtenrandaus.zeichnequerlinieneu:cursor(1,3);out(79*waagerecht).gleicheggflinkenrandaus:IFaktuellesmenu.untermenuanfang<4THENaktuellesmenu.untermenuanfang:=4FI.gleicheggfrechtenrandaus:IF(aktuellesmenu.untermenuanfang+aktuellesuntermenu.maxlaenge)>(areaxsize(menuwindow)-3)THENaktuellesmenu.untermenuanfang:=areaxsize(menuwindow)-aktuellesuntermenu.maxlaenge-3FI.wirfuntermenuaus:TEXT VARlinie:=(aktuellesuntermenu.maxlaenge+5)*waagerecht;IFaktuellesmenu.untermenuzeiger=0THENaktuellesmenu.untermenuzeiger:= +folgenderaktiveruntermenupunktFI;wirfuntermenukopfzeileaus;wirfuntermenurumpfaus;wirfuntermenufusszeileaus;markiereaktuellenuntermenupunkt.wirfuntermenukopfzeileaus:cursor(menuwindow,spalte,anfangszeile);out(balkenoben);out(linie);out(balkenoben).wirfuntermenufusszeileaus:cursor(menuwindow,spalte,endezeile);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.endezeile:ersteuntermenuzeile+aktuellesuntermenu.belegt.wirfuntermenurumpfaus:INT VARlaufvar;INT CONSTaktuellepunktlaenge:=aktuellesuntermenu.maxlaenge+1;FORlaufvarFROM1UPTOaktuellesuntermenu.belegtREPwirfeineeinzelnemenuzeileausPER.wirfeineeinzelnemenuzeileaus:outwithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.aktuellerpunktname:untermenubezeichnung(laufvar).laenge:aktuellepunktlaengeEND PROCschreibeaktuellesuntermenuaufbildschirm;PROCloescheaktuellesuntermenuaufbildschirm:beendeaktuelleuntermenuoperationen;loescheuntermenuaufbildschirm;schreibebalkenwiederhin;aktuellesmenu.untermenuzeiger:=1.beendeaktuelleuntermenuoperationen:IFleaveoperation<>""THENfuehreoperationaus(leaveoperation)FI.leaveoperation:compress(aktuellesuntermenu.leaveprozedurname).loescheuntermenuaufbildschirm:INT VARlaufvar;FORlaufvarFROMaktuellesuntermenu.belegt+1DOWNTO1REPloescheeineeinzelnemenuzeilePER.loescheeineeinzelnemenuzeile:erasewithbeam(area(menuwindow),menuspalte,menuzeile,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.laenge:aktuellesuntermenu.maxlaenge+1.schreibebalkenwiederhin:cursor(menuwindow,spalte,anfangszeile);out((aktuellesuntermenu.maxlaenge+7)*waagerecht).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.END PROCloescheaktuellesuntermenuaufbildschirm;PROCmarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENlaufeggfzumnaechstenaktivenmenupunkt;IFaktuellesmenu.untermenuzeiger<>0THENoutinverswithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF ELSEhochruntererlaubt:=FALSE FI.laufeggfzumnaechstenaktivenmenupunkt:IF NOTaktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].aktivTHENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCmarkiereaktuellenuntermenupunkt;PROCdemarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENeraseinvers(area(menuwindow),menuspalte,menuzeile,laenge);out(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCdemarkiereaktuellenuntermenupunkt;INT PROCfolgenderaktiveruntermenupunkt:INT VARnaechster,aktueller,anzahl,zeiger;zeiger:=aktuellesmenu.untermenuzeiger;IFzeiger=0THEN IFaktuellesuntermenu.menupunkt[1].aktivTHEN LEAVEfolgenderaktiveruntermenupunktWITH1ELSEaktueller:=1END IF ELSEaktueller:=zeigerEND IF;naechster:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugenachfolger;IFnaechster=aktuellerTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[naechster].aktivTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITHnaechsterEND IF PER;0.erzeugenachfolger:naechster:=(naechsterMODanzahl)+1END PROCfolgenderaktiveruntermenupunkt;INT PROCvorausgehenderaktiveruntermenupunkt:INT +VARvoriger,aktueller,anzahl;aktueller:=aktuellesmenu.untermenuzeiger;voriger:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugevorgaenger;IF +voriger=aktuellerTHEN LEAVEvorausgehenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[voriger].aktivTHEN LEAVEvorausgehenderaktiveruntermenupunktWITHvorigerEND IF PER;0.erzeugevorgaenger:voriger:=((voriger+anzahl-2)MODanzahl)+1END PROCvorausgehenderaktiveruntermenupunkt;PROCcursorinwarteposition:cursor(areax(menuwindow),areay(menuwindow)+1)END PROCcursorinwarteposition;TEXT PROCuntermenubezeichnung(INT CONSTposition):TEXT VARbezeichnung:="";bezeichnungCATkennzeichnung;bezeichnungCATpunktkennung;bezeichnung.kennzeichnung:IFaktuellermenupunkt.aktivTHEN IFaktuellermenupunkt.angewaehltTHEN"*"ELIFaktuellermenupunkt.punktkuerzel<>""THENaktuellermenupunkt.punktkuerzelELIFaktuellermenupunkt.punktkuerzel=""THENblankELSE"-"FI ELSE"-"FI.punktkennung:IFmenupunktisttrennzeileTHENstrichellinieELSEaktuellermenupunkt.punktnameFI.menupunktisttrennzeile:aktuellermenupunkt.punktname=(blank+trennzeilensymbol).strichellinie:(aktuellesuntermenu.maxlaenge+1)*"-".aktuellermenupunkt:aktuellesuntermenu.menupunkt[position]END PROCuntermenubezeichnung;PROCfuehreoperationaus(TEXT CONSToperation):disablestop;IFoperation=""THENmenuinfo(infotext[1]);LEAVEfuehreoperationausFI;do(operation);IFiserrorTHENclearerror;regeneratemenuscreen;menuinfo(errormessage,5);activationchanged:=TRUE;FI;enablestop;cursoroffEND PROCfuehreoperationaus;PROCveraendereaktivierung(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereaktivierung.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;LEAVEveraendereaktivierung.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereaktivierung:veraendereaktivierung(unterpunktposition,eintrag)END PROCveraendereaktivierung;PROCveraendereaktivierung(INT CONSTpunktnummer,BOOL CONSTeintrag):IFpunktnummer>=1ANDpunktnummer<=untermenuendeTHENaktuellesuntermenu.menupunkt[punktnummer].angewaehlt:=FALSE;aktuellesuntermenu.menupunkt[punktnummer].aktiv:=eintrag;activationchanged:=TRUE;FI.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegtEND PROCveraendereaktivierung;PROCveraendereanwahl(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereanwahl.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;enablestop;errorstop(fehlermeldung[10]).untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereanwahl:aktuellesuntermenu.menupunkt[unterpunktposition].angewaehlt:=eintragEND PROCveraendereanwahl;PROCactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,TRUE)END PROCactivate;PROCactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,TRUE)END PROCactivate;PROCdeactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,FALSE)END PROCdeactivate;PROCdeactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,FALSE)END PROCdeactivate;PROCselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,TRUE)END PROCselect;PROCdeselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,FALSE)END PROCdeselect;PROCschliessemenu:IFaktuellesmenu.menuausgangsprozedur<>""THENfootnote(hinweis[3]);fuehreoperationaus(aktuellesmenu.menuausgangsprozedur)FI;anzahloffenermenusDECR1;IFanzahloffenermenus=1THENaktivieredasaufeisgelegtemenuFI.aktivieredasaufeisgelegtemenu:hochruntererlaubt:=TRUE;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);showmenuEND PROCschliessemenu;PROCrefreshsubmenu:schreibeaktuellesuntermenuaufbildschirm;showmenunotice;activationchanged:=FALSE END PROCrefreshsubmenu;PROCregeneratemenuscreen:IFanzahloffenermenus=0THENerrorstop( +fehlermeldung[8])ELIFanzahloffenermenus=1THENplotend;showmenu;showmenunoticeELSEzeigeerstesmenuan;zeigezweitesmenuan;showmenunoticeFI;activationchanged:=FALSE.zeigeerstesmenuan:INT VARmenuzeiger:=menuleiste.zeigeraktuell;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);anzahloffenermenus:=1;showmenu.zeigezweitesmenuan:menuleiste.zeigeraktuell:=menuzeiger;menuwindow:=zweitesmenu;anzahloffenermenus:=2;showmenu.END PROCregeneratemenuscreen;PROCmenuinfo(TEXT CONSTt,INT CONSTposition,timelimit):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);boxinfo(w,t,position,timelimit,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt,INT CONSTposition):menuinfo(t,position,maxint)END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt):menuinfo(t,5,maxint)END PROCmenuinfo;INT PROCmenualternative(TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);INT VARergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;ergebnisEND PROCmenualternative;BOOL PROCmenuyes(TEXT CONSTfrage,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);BOOL VARwert:=boxyes(w,frage,position,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuyes;BOOL PROCmenuno(TEXT CONSTfrage,INT CONSTposition):NOTmenuyes(frage,position)END PROCmenuno;TEXT PROCmenuone(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT CONSTwert:=boxone(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuone;THESAURUS PROCmenusome(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS CONSTthesaurus:=boxsome(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;thesaurusEND PROCmenusome;TEXT PROCmenuanswer(TEXT CONSTt,vorgabe,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswer(w,t,vorgabe,position,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuanswer;TEXT PROCmenuanswerone(TEXT CONSTt,vorgabe,THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswerone(w,t,vorgabe,thes,t1,t2,mitreinigung,FALSE)IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuanswerone;THESAURUS PROCmenuanswersome(TEXT CONSTt,vorgabe,THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS VARwert:=boxanswersome(w,t,vorgabe,thes,t1,t2,mitreinigung,FALSE)IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuanswersome;TEXT PROCmenubasistext(INT CONSTnummer):IFnummer<=20THENfehlermeldung[12]ELIFnummer>menuleiste.menutext.anzahlmenutexteTHENfehlermeldung[11]ELSEmenuleiste.menutext.platz[nummer]FI END PROCmenubasistext;TEXT PROCanwendungstext(INT CONSTnummer):IFnummer>menuleiste.infotext.anzahlinfotexteTHENfehlermeldung[11]ELSEmenuleiste.infotext.stelle[nummer]FI END PROCanwendungstext;PROCzeigemenukennung:page;END PROCzeigemenukennung;PROCresetdialog:angekoppeltemenutafel:="";anzahloffenermenus:=0END PROCresetdialog;PROCwritemenunotice(TEXT CONSTt,INT CONSTposition):erasemenunotice;boxnotice(menuwindow,t,position,menunotizx,menunotizy, +menunotizxsize,menunotizysize);menunotiztext:=t;menunotizposition:=position;menunotizistgesetzt:=TRUE END PROCwritemenunotice;PROCshowmenunotice:IFmenunotizistgesetztTHENboxnotice(menuwindow,menunotiztext,menunotizposition,menunotizx,menunotizy,menunotizxsize,menunotizysize);FI END PROCshowmenunotice;PROCerasemenunotice:INT VARspa,zei;getcursor(spa,zei);IFmenunotizistgesetztTHENpageup(menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotizistgesetzt:=FALSE;cursor(spa,zei)FI END PROCerasemenunotice;PROCinitializemenuwindow:schreibfenster:=window(areax(menuwindow)+1,areay(menuwindow)+3,areaxsize(menuwindow)-2,areaysize(menuwindow)-4)END PROCinitializemenuwindow;PROCshowmenuwindow:initializemenuwindow;show(schreibfenster);END PROCshowmenuwindow;PROCmenuwindowpage:initializemenuwindow;page(schreibfenster)END PROCmenuwindowpage;PROCmenuwindowout(TEXT CONSTtext):out(schreibfenster,text)END PROCmenuwindowout;PROCmenuwindowget(TEXT VARtext):get(schreibfenster,text)END PROCmenuwindowget;PROCmenuwindoweditget(TEXT VARtext):edit(schreibfenster,text)END PROCmenuwindoweditget;PROCmenuwindowedit(TEXT CONSTdateiname):initializemenuwindow;edit(schreibfenster,dateiname)END PROCmenuwindowedit;PROCmenuwindowedit(FILE VARf):initializemenuwindow;edit(schreibfenster,f)END PROCmenuwindowedit;PROCmenuwindowshow(TEXT CONSTdateiname):initializemenuwindow;show(schreibfenster,dateiname)END PROCmenuwindowshow;PROCmenuwindowshow(FILE VARf):initializemenuwindow;show(schreibfenster,f)END PROCmenuwindowshow;BOOL PROCmenuwindowyes(TEXT CONSTfrage):yes(schreibfenster,frage)END PROCmenuwindowyes;BOOL PROCmenuwindowno(TEXT CONSTfrage):no(schreibfenster,frage)END PROCmenuwindowno;PROCmenuwindowline:menuwindowline(1)END PROCmenuwindowline;PROCmenuwindowline(INT CONSTanzahl):line(schreibfenster,anzahl)END PROCmenuwindowline;PROCmenuwindowcursor(INT CONSTspa,zei):cursor(schreibfenster,spa,zei)END PROCmenuwindowcursor;PROCgetmenuwindowcursor(INT VARspa,zei):getcursor(schreibfenster,spa,zei)END PROCgetmenuwindowcursor;INT PROCremainingmenuwindowlines:remaininglines(schreibfenster)END PROCremainingmenuwindowlines;TEXT PROCmenuwindowcenter(TEXT CONSTt):center(schreibfenster,t)END PROCmenuwindowcenter;PROCmenuwindowstop:menuwindowstop(2)END PROCmenuwindowstop;PROCmenuwindowstop(INT CONSTanzahl):stop(schreibfenster,anzahl)END PROCmenuwindowstop;WINDOW PROCcurrentmenuwindow:initializemenuwindow;schreibfensterEND PROCcurrentmenuwindow;PROCstdinfoedit(FILE VARf,INT CONSToberstezeile):IFoberstezeile<1ORoberstezeile>3THENerrorstop(fehlermeldung[13]);FI;garantieremenukarte;cursor(1,oberstezeile);out(cleop);cursor(1,24);out(invers(text(menubasistext(141),76)));editorinfofenster:=window(1,oberstezeile+2,79,24-oberstezeile);kommandoauftastelegen("?","editorinformationen");commanddialogue(FALSE);cursoron;edit(f,1,oberstezeile+1,79,23-oberstezeile);commanddialogue(TRUE);kommandoauftastelegen("?","").garantieremenukarte:TEXT VARname:=compress(menukartenname);IFname=""THENinstallmenu(stdmenukartenname,FALSE)FI.END PROCstdinfoedit;PROCstdinfoedit(FILE VARf):stdinfoedit(f,1)END PROCstdinfoedit;PROCstdinfoedit(TEXT CONSTdateiname,INT CONSToberstezeile):FILE VARf:=sequentialfile(modify,dateiname);stdinfoedit(f,oberstezeile);END PROCstdinfoedit;PROCstdinfoedit(TEXT CONSTdateiname):stdinfoedit(dateiname,1)END PROCstdinfoedit;PROCeditorinformationen:BOOL VARendegewuenscht:=FALSE;INT VARz;FORzFROMstartwertUPTO22REPcursor(1,z);out(cleol);PER;REP INT VARerg:=boxalternative(editorinfofenster,menubasistext(149),menubasistext(150),menubasistext(151),5,FALSE,FALSE);erfuelledenwunschUNTILendegewuenschtPER;cursor(1,24);out(invers(text(menubasistext(141),76))).startwert:areay(editorinfofenster)+1.erfuelledenwunsch:IFerg>100THENergDECR100END IF;SELECTergOF CASE1,9:boxinfo(editorinfofenster,menubasistext(142),5,maxint,FALSE)CASE2,10:boxinfo(editorinfofenster,menubasistext(143),5,maxint,FALSE)CASE3,11:boxinfo(editorinfofenster,menubasistext(144),5,maxint,FALSE)CASE4,12:boxinfo(editorinfofenster, +menubasistext(145),5,maxint,FALSE)CASE5,13:boxinfo(editorinfofenster,menubasistext(146),5,maxint,FALSE)CASE6,14:boxinfo(editorinfofenster,menubasistext(147),5,maxint,FALSE)CASE7,15:boxinfo(editorinfofenster,menubasistext(148),5,maxint,FALSE)CASE8,16:endegewuenscht:=TRUE END SELECT END PROCeditorinformationen;PROCbereinigesituation:page;forget(ds);resetdialogEND PROCbereinigesituation;PROCdirektstart(TEXT CONSTprocname,BOOL CONSTautoloeschen):TEXT VARdatname:="Selbststartergenerierungsdatei",letzter:=std;kopplearchivmenukartean;schreibeprogramm;insertiereprogramm;abkoppeln.kopplearchivmenukartean:installmenu(stdmenukartenname,FALSE).schreibeprogramm:forget(datname,quiet);FILE VARf:=sequentialfile(output,datname);putline(f,menubasistext(191));putline(f,"do ("+code(34)+"reset dialog; erase menunotice; "+procname+code(34)+");");putline(f,menubasistext(192));IFautoloeschenTHENputline(f,menubasistext(193))ELSEputline(f,menubasistext(194))FI;putline(f,menubasistext(195));putline(f,menubasistext(196)).insertiereprogramm:TEXT VARt:="insert ("+code(34)+datname+code(34)+")";do(t).abkoppeln:forget(datname,quiet);lastparam(letzter);resetdialog;globalmanager.END PROCdirektstart;PROCwritehead(TEXT CONSTt):INT VARx,y;getcursor(x,y);IFt<>""THENcursor(1,1);out(invers(text(t,77)))END IF;cursor(x,y)END PROCwritehead;PROCrestorehead:INT VARx,y;TEXT VARkopf:=menuleiste.menu[menuleiste.zeigeraktuell].kopfzeile;writehead(kopf)END PROCrestorehead;PROCsetwindow2(INT CONSTx2,y2,xsize2,ysize2):IFy2<2THENerrorstop("Kopfzeile wird überschrieben")END IF;zweitesmenu:=window(x2,y2,xsize2,ysize2);END PROCsetwindow2;PROCverteiler(INT CONSTmenunr,menuzeile,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarst):IFmenunr=1THEN IFmenuzeile=1THENlsgberechnen(PROCf,PROCcof);ELIFmenuzeile=2THENftsberechnen(PROCf,PROCcof);FI;ELIFmenunr=2THEN IFmenuzeile=5THENdisablestop;ausgabezusatzdarstellung(PROCzusatzdarst);IFiserrorTHENclearerror;oldfootnote;regeneratemenuscreen;menuinfo(errormessage,5)FI;enablestop;cursoroffFI FI;END PROCverteiler;.aktuellesuntermenu:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].aktuellesmenu:menuleiste.menu[menuleiste.zeigeraktuell].;END PACKETlsdialog5; + diff --git a/app/schulis-simulationssystem/3.0/src/ls-MENUKARTE:Simsel b/app/schulis-simulationssystem/3.0/src/ls-MENUKARTE:Simsel new file mode 100644 index 0000000..3a954c0 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/ls-MENUKARTE:Simsel differ diff --git a/app/schulis-simulationssystem/3.0/src/ltbearb b/app/schulis-simulationssystem/3.0/src/ltbearb new file mode 100644 index 0000000..f21741e --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/ltbearb @@ -0,0 +1,8 @@ +PACKETlsbearbeitungsmenuDEFINESzeigekopfbalken,initialisieresimulation,anfangsaktivierungloesungen,lsgberechnen,ftsberechnen,lsgumschalten,wechselezu,anfangsaktivierungdarstellung,ausgabezeitdiagramm,ausgabephasendiagramm,ausgabehistogramm,ausgabetabelle,ausgabezusatzdarstellung,anfangsaktivierungkombination,kombinationzusammenstellen,parameterkombination,anfangsaktivierungvergleich,endprocvergleich,ausgabevergleichzeitdiagramm,ausgabevergleichphasendiagramm,ausgabevergleichhistogramm,ausgabevergleichtabelle,uebergebeinfotextfuerwd,infoszummodell:LETnichtseingegeben="m";LETausknichtgraphikfaehig=72,auskkeinelsgberechnet=73,ausknureinelsgberechnet=74,showverlasszeichen="m",stleistefileverlassen=28,kopfmax4variablen=50,kopfbeliebigvielevar=51,kopfgenaueinexykombin=52,kopfxyeingabe=53,headzeilenlaenge=77,headproduktname="schulis Simulationssystem",dialogsituationsimulation=1;LETmodellauforiginal="modellauf.original",modellauffortsetzung="modellauf.fortsetzung",anzahlloesungen=2;LET LSG=STRUCT(TEXTname,LOESUNGanfang,BOOLberechnet,LOESUNGgesamt,BOOLftsberechnet);ROWanzahlloesungenLSG VARlsg;INT VARlsgaktuell:=0;LETmax=20,negativemld=FALSE;LETloesungsmenu=1,darstellungsmenu=2,kombmenu=3,vergleichsmenu=4;LETloesungenberechnen=0,einfach=1,komb1=2;LETzeitdg=1,phasdg=2,tabdg=3,histdg=4,zusdg=5;LETzuebers="Zeitdiagramm",puebers="Phasendiagramm",tuebers="Tabelle",huebers="Histogramm";WINDOW VARfsingle:=grossesrahmenfenster;LETsinglesp1=1,zl1=4,singlebr=78,hoe=19,scrollzeile=3;LETbw="";ROW2BOOL VARkombgewaehlt;ROW2TEXT VARdarstname1,darstname2;ROW2INT VARdarstnrkomb1,darstnrkomb2;TEXT VARlsgnrtext1:="",lsgnrtext2:="";INT VARsubmenu1lsgnr:=1;BOOL VARaktivierunggeaendert:=FALSE;ROW4ROW8BOOL VARaktivierung;ROW8BOOL VARaktivaktuell;ROW4BOOL VARerstesaufklappen;DATASPACE VARinfofuerwd:=nilspace;TEXT VARkopfbalken:="";PROCinitialisieresimulation:kopfbalken:=headproduktname+(headzeilenlaenge-length(modellkurzbezeichnung)-length(headproduktname))*" "+modellkurzbezeichnung;zeigekopfbalken;INT VARi,j;FORiFROM1UPTOanzahlloesungenREPlsg(i).berechnet:=FALSE;lsg(i).ftsberechnet:=FALSE;lsg(i).name:="Lösung "+text(i);lsg(i).anfangVONoriginalwerte;lsg(i).gesamtVONoriginalwerte;PER;lsgaktuell:=1;kombgewaehlt(1):=FALSE;kombgewaehlt(2):=FALSE;darstnrkomb1(1):=0;darstnrkomb2(1):=0;darstnrkomb1(2):=0;darstnrkomb2(2):=0;aktivierunggeaendert:=FALSE;submenu1lsgnr:=0;lsgnrtext1:="Voreinstellung auf:";lsgnrtext2:=""+lsg(lsgaktuell).name+" "+code(14);FORiFROM1UPTO4REP FORjFROM1UPTO8REPaktivierung(i)(j):=FALSE;aktivaktuell(j):=FALSE;PER;PER;FORiFROM1UPTO4REPerstesaufklappen(i):=TRUE;PER;do("deactivate (2);");do("deactivate (3);");aktivierung(1)(2):=FALSE;aktivierung(1)(3):=FALSE;END PROCinitialisieresimulation;PROCanfangsaktivierungloesungen:loescheaktuellemeldung(dialogsituationsimulation);IFerstesaufklappen(loesungsmenu)THENdo("activate (1);");do("activate (5);");do("activate (6);");aktivierung(loesungsmenu)(1):=TRUE;aktivierung(loesungsmenu)(5):=TRUE;aktivierung(loesungsmenu)(6):=TRUE;FI;IFlsgaktuell<>submenu1lsgnrTHENaktivaktuell:=aktivierung(loesungsmenu);IFlsg(lsgaktuell).berechnetTHENaktivaktuell(2):=TRUE;ELSEaktivaktuell(2):=FALSE;FI;IFlsg(lsgaktuell).ftsberechnetTHENaktivaktuell(3):=TRUE;ELSEaktivaktuell(3):=FALSE;FI;evtneueaktivierungausgeben(loesungsmenu);IFsubmenu1lsgnr=0THENgiblsgnraus;FI;submenu1lsgnr:=lsgaktuell;FI;END PROCanfangsaktivierungloesungen;PROClsgberechnen(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof):INT VARlg:=lsgaktuell;TEXT VARtaste:="";LOESUNG VARergebnis;KURVE VARzkurve;ergebnisVONlsg(lg).anfang;berechne(ergebnis,PROCf,PROCcof,taste);trageergebnisalsneuelsgein;do("regenerate menuscreen;");giblsgnraus;.trageergebnisalsneuelsgein:IFtaste<>nichtseingegebenTHEN IFvorhernichtberechnetTHENaktivierung(loesungsmenu)(2):=TRUE;do("activate(2)");ELIFfortsetzberechnetTHENaktivierung(loesungsmenu)(3):=FALSE;do("deactivate (3)");FI;lsg(lg).anfang:=ergebnis;copy(zkurve, +modellauforiginal+lsgindex,LOESUNGSABSCHNITTergebnis);lsg(lg).anfangLOESUNGSABSCHNITTzkurve;lsg(lg).gesamt:=ergebnis;copy(zkurve,modellauffortsetzung+lsgindex,LOESUNGSABSCHNITTergebnis);lsg(lg).gesamtLOESUNGSABSCHNITTzkurve;lsg(lg).berechnet:=TRUE;lsg(lg).ftsberechnet:=FALSE;FI;.vorhernichtberechnet:NOTlsg(lg).berechnet.fortsetzberechnet:lsg(lg).ftsberechnet.lsgindex:"."+text(lg).END PROClsgberechnen;PROCftsberechnen(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof):INT CONSTlg:=lsgaktuell;berechnefortfuehrung(lsg(lg).anfang,lsg(lg).gesamt,PROCf,PROCcof);IF NOTlsg(lg).ftsberechnetTHENaktivierung(loesungsmenu)(3):=TRUE;do("activate (3);");FI;lsg(lg).ftsberechnet:=TRUE;oldfootnote;.END PROCftsberechnen;PROClsgumschalten:INT CONSTi:=lsgaktuell;KURVE VARzkurve;lsg(i).ftsberechnet:=FALSE;lsg(i).gesamt:=lsg(i).anfang;copy(zkurve,modellauffortsetzung+lsgindex,LOESUNGSABSCHNITTlsg(i).anfang);lsg(i).gesamtLOESUNGSABSCHNITTzkurve;aktivierung(loesungsmenu)(3):=FALSE;do("deactivate (3);");.lsgindex:"."+text(i).END PROClsgumschalten;PROCwechselezu(INT CONSTneuelsgnr,darstellungsform):IFlsgaktuell<>neuelsgnrTHEN IFdarstellungsform=loesungenberechnenTHENlsgaktuell:=neuelsgnr;anfangsaktivierungloesungen;lsgnrtext1:="Momentan aktiv:";lsgnrtext2:=code(15)+lsg(lsgaktuell).name+" "+code(14);ELIFlsg(neuelsgnr).berechnetTHENlsgaktuell:=neuelsgnr;lsgnrtext1:="Momentan aktiv:";lsgnrtext2:=code(15)+lsg(lsgaktuell).name+" "+code(14);IFdarstellungsform=einfachTHENanfangsaktivierungdarstellung;ELIFdarstellungsform=komb1THENaktivierungkombination(TRUE);FI;FI;IF NOTaktivierunggeaendertTHENdo("refresh submenu;");ELSE FI;giblsgnraus;FI;END PROCwechselezu;PROCanfangsaktivierungdarstellung:INT VARi;loescheaktuellemeldung;aktivaktuell:=aktivierung(darstellungsmenu);IF NOTeinelsgberechnetTHENdeaktivieredarstellungen;aktivaktuell(7):=FALSE;aktivaktuell(8):=FALSE;zeigemeldung(auskunftstext(auskkeinelsgberechnet),negativemld);ELIFlsg(lsgaktuell).berechnetTHENaktivieredarstellungen;aktivierelsgwechsel;ELSEdeaktivieredarstellungen;aktivierelsgwechsel;FI;evtneueaktivierungausgeben(darstellungsmenu);IFaktivierunggeaendertTHENdo("refresh submenu")FI;.aktivieredarstellungen:FORiFROM1UPTO5REPaktivaktuell(i):=darstellungzugelassen(i);PER;.aktivierelsgwechsel:aktivaktuell(7):=lsg(1).berechnet;aktivaktuell(8):=lsg(2).berechnet;.deaktivieredarstellungen:FORiFROM1UPTO5REPaktivaktuell(i):=FALSE;PER;END PROCanfangsaktivierungdarstellung;PROCausgabezeitdiagramm:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,zeitdg,variablengewaehlt,zuebers);IFvariablengewaehltTHENzeigediagramm("z",lsg(lsgaktuell).gesamt,variablenmuster,lsg(lsgaktuell).ftsberechnet,taste);fehlerbehandlungnachgraphik(TRUE);ELSEerase(fsingle);refreshundnrausgabe;oldfootnote;FI;END PROCausgabezeitdiagramm;PROCausgabephasendiagramm:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,phasdg,variablengewaehlt,puebers);IFvariablengewaehltTHENzeigephasendiagramm(lsg(lsgaktuell).gesamt,variablenmuster,lsg(lsgaktuell).ftsberechnet,taste);fehlerbehandlungnachgraphik(TRUE);ELSEerase(fsingle);refreshundnrausgabe;oldfootnote;FI;END PROCausgabephasendiagramm;PROCausgabehistogramm:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,histdg,variablengewaehlt,huebers);IFvariablengewaehltTHENzeigediagramm("h",lsg(lsgaktuell).gesamt,variablenmuster,lsg(lsgaktuell).ftsberechnet,taste);fehlerbehandlungnachgraphik(TRUE);ELSEerase(fsingle);refreshundnrausgabe;oldfootnote;FI;END PROCausgabehistogramm;PROCausgabetabelle:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,tabdg,variablengewaehlt,tuebers);IFvariablengewaehltTHENzeigediagramm("t",lsg(lsgaktuell).gesamt,variablenmuster,lsg(lsgaktuell). +ftsberechnet,taste);FI;erase(fsingle);refreshundnrausgabe;oldfootnote;END PROCausgabetabelle;PROCausgabezusatzdarstellung(PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarstellung):BOOL VARnichtindemo:=FALSE;TEXT VARtaste:="";zusatzdarstellung(lsg(lsgaktuell).gesamt,nichtindemo,taste);fehlerbehandlungnachgraphik(TRUE);END PROCausgabezusatzdarstellung;PROCanfangsaktivierungkombination(BOOL CONSTmldloeschen):darstname1(lsgaktuell):="";darstname2(lsgaktuell):="";kombgewaehlt(1):=FALSE;kombgewaehlt(2):=FALSE;aktivierungkombination(mldloeschen);END PROCanfangsaktivierungkombination;PROCaktivierungkombination(BOOL CONSTmldloeschen):INT VARi;IFmldloeschenTHENloescheaktuellemeldung;FI;aktivaktuell:=aktivierung(kombmenu);IFeinelsgberechnetTHENaktivieredarstellungenELSEzeigemeldung(auskunftstext(auskkeinelsgberechnet),negativemld);deaktivieredarstellungenFI;evtneueaktivierungausgeben(kombmenu);.aktivieredarstellungen:aktivaktuell(1):=lsg(lsgaktuell).berechnet;aktivaktuell(3):=kombgewaehlt(lsgaktuell);aktivaktuell(5):=lsg(1).berechnet;aktivaktuell(6):=lsg(2).berechnet;.deaktivieredarstellungen:FORiFROM1UPTO6REP IFi<>4CANDi<>2THENaktivaktuell(i):=FALSE;FI;PER;.END PROCaktivierungkombination;PROCkombinationzusammenstellen:TEXT VARtaste:="";ZUSTAND VARmusterkomb1,musterkomb2;BOOL VARkombvarblgewaehlt:=FALSE,mldloeschen:=TRUE;musterkomb1:=neuerzustand(dimension+codimension);musterkomb2:=neuerzustand(dimension+codimension);waehledarstellungkombaus;waehlevariablenfuerdarstellungkombaus;gebekombiniertedarstellungaus;.waehledarstellungkombaus:THESAURUS VARangebot1:=emptythesaurus,auswahl1:=emptythesaurus,auswahl2:=emptythesaurus;INT VARi:=0;insert(angebot1,zuebers,i);IFmitphasendiagrammCAND(dimension+codimension>=2)THENinsert(angebot1,puebers,i);FI;insert(angebot1,tuebers,i);insert(angebot1,huebers,i);auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,1,1,1,1,auswahl1,auswahl2,"Darstellung 1",bw,"Darstellung 2",bw);IFnotempty(auswahl1)ANDnotempty(auswahl2)THENkombgewaehlt(lsgaktuell):=TRUE;i:=0;get(auswahl1,darstname1(lsgaktuell),i);darstnrkomb1(lsgaktuell):=darstellungsart(darstname1(lsgaktuell));i:=0;get(auswahl2,darstname2(lsgaktuell),i);darstnrkomb2(lsgaktuell):=darstellungsart(darstname2(lsgaktuell));do("activate (3)");aktivaktuell(3):=TRUE;ELSEleavekombinationzusammenstellen;FI;.waehlevariablenfuerdarstellungkombaus:variableneinstellendouble(musterkomb1,musterkomb2,darstnrkomb1(lsgaktuell),darstnrkomb2(lsgaktuell),kombvarblgewaehlt,darstname1(lsgaktuell),darstname2(lsgaktuell));IF NOTkombvarblgewaehltTHENleavekombinationzusammenstellen;FI;.gebekombiniertedarstellungaus:zeigekombiniertedarstellung(taste,lsg(lsgaktuell).gesamt,darstnrkomb1(lsgaktuell),darstnrkomb2(lsgaktuell),musterkomb1,musterkomb2);IFdarstname1(lsgaktuell)=tuebersANDdarstname2(lsgaktuell)=tuebersTHENaktivierungkombination(mldloeschen);oldfootnote;giblsgnraus;ELSEaktivierungkombination(NOTmldloeschen);fehlerbehandlungnachgraphik(TRUE);FI;.leavekombinationzusammenstellen:erase(fsingle);aktivierungkombination(FALSE);refreshundnrausgabe;oldfootnote;LEAVEkombinationzusammenstellen;.END PROCkombinationzusammenstellen;PROCparameterkombination:ZUSTAND VARmusterkomb1,musterkomb2;TEXT VARtaste;BOOL VARkombvarblgewaehlt:=FALSE;musterkomb1:=neuerzustand(dimension+codimension);musterkomb2:=neuerzustand(dimension+codimension);variableneinstellendouble(musterkomb1,musterkomb2,darstnrkomb1(lsgaktuell),darstnrkomb2(lsgaktuell),kombvarblgewaehlt,darstname1(lsgaktuell),darstname2(lsgaktuell));IFkombvarblgewaehltTHENzeigekombiniertedarstellung(taste,lsg(lsgaktuell).gesamt,darstnrkomb1(lsgaktuell),darstnrkomb2(lsgaktuell),musterkomb1,musterkomb2);IFdarstname1(lsgaktuell)=tuebersANDdarstname2(lsgaktuell)=tuebersTHENoldfootnote;ELSEfehlerbehandlungnachgraphik(TRUE);FI;ELSEerase(fsingle);refreshundnrausgabe;oldfootnote;FI;.END PROCparameterkombination;PROCanfangsaktivierungvergleich:INT VARi;loescheaktuellemeldung;erase(lsgwindow);aktivaktuell:=aktivierung(vergleichsmenu);IF NOTeinelsgberechnet +THENzeigemeldung(auskunftstext(auskkeinelsgberechnet),negativemld);deaktivieredarstellungenELIF NOTmindzweilsgberechnetTHENzeigemeldung(auskunftstext(ausknureinelsgberechnet),negativemld);deaktivieredarstellungenELSEaktivieredarstellungenFI;evtneueaktivierungausgeben(vergleichsmenu);.aktivieredarstellungen:FORiFROM1UPTO4REPaktivaktuell(i):=darstellungzugelassen(i);PER;.deaktivieredarstellungen:FORiFROM1UPTO4REPaktivaktuell(i):=FALSE;PER;END PROCanfangsaktivierungvergleich;PROCendprocvergleich:giblsgnraus;END PROCendprocvergleich;PROCausgabevergleichzeitdiagramm:ZUSTAND VARvariablenmuster;TEXT VARtaste:="";BOOL VARvariablengewaehlt:=FALSE;variableneinstellensingle(variablenmuster,zeitdg,variablengewaehlt,zuebers);IFvariablengewaehltTHENzeigevergleichskurve(taste,lsg(1).gesamt,lsg(2).gesamt,variablenmuster,"z");fehlerbehandlungnachgraphik(FALSE);ELSEerase(fsingle);do("refresh submenu");oldfootnote;FI;END PROCausgabevergleichzeitdiagramm;PROCausgabevergleichphasendiagramm:ZUSTAND VARvariablenmuster;TEXT VARtaste:="";BOOL VARvariablengewaehlt:=FALSE;variableneinstellensingle(variablenmuster,phasdg,variablengewaehlt,puebers);IFvariablengewaehltTHENzeigevergleichskurvefuerphasendiagramm(taste,LOESUNGSABSCHNITTlsg(1).gesamt,LOESUNGSABSCHNITTlsg(2).gesamt,variablenmuster);fehlerbehandlungnachgraphik(FALSE);ELSEerase(fsingle);do("refresh submenu");oldfootnote;FI;END PROCausgabevergleichphasendiagramm;PROCausgabevergleichhistogramm:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,histdg,variablengewaehlt,huebers);IFvariablengewaehltTHENzeigevergleichskurve(taste,lsg(1).gesamt,lsg(2).gesamt,variablenmuster,"h");fehlerbehandlungnachgraphik(FALSE);ELSEerase(fsingle);do("refresh submenu");oldfootnote;FI;END PROCausgabevergleichhistogramm;PROCausgabevergleichtabelle:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,tabdg,variablengewaehlt,tuebers);IFvariablengewaehltTHENzeigevergleichfuertabelle(taste,lsg(1).gesamt,lsg(2).gesamt,variablenmuster);FI;erase(fsingle);do("refresh submenu");oldfootnote;END PROCausgabevergleichtabelle;PROCinfoszummodell:LETdateienname="liste",spaltenbreite=0;WINDOW VARfshow:=scrollfenster;FILE VARmdlinfo;TEXT VARausstieg:="";INT VARerstersatz1:=3,erstespalte1:=1;TEXT CONSTausstiegszeichen:=showverlasszeichen;IFwirkungsdgrTHENmdlinfo:=sequentialfile(output,infofuerwd);zeigeinfo;ELSEforget(dateienname,quiet);mdlinfo:=sequentialfile(output,dateienname);mdlinfo:=informationstext(dateienname);zeigeinfo;forget(dateienname,quiet);FI;.zeigeinfo:footnote(steuerleiste(stleistefileverlassen));scroll(fshow,mdlinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,ausstieg);.END PROCinfoszummodell;BOOL PROCeinelsgberechnet:(lsg(1).berechnet)COR(lsg(2).berechnet).END PROCeinelsgberechnet;BOOL PROCdarstellungzugelassen(INT CONSTdarst):SELECTdarstOF CASEzeitdg:TRUE CASEphasdg:mitphasendiagrammCANDdimension+codimension>=2CASEtabdg:TRUE CASEhistdg:TRUE CASEzusdg:mitzusatzdarstellungOTHERWISE FALSE END SELECT.END PROCdarstellungzugelassen;BOOL PROCmindzweilsgberechnet:(lsg(1).berechnetCANDlsg(2).berechnet).END PROCmindzweilsgberechnet;PROCvariableneinstellensingle(ZUSTAND VARmuster1,INT CONSTart1,BOOL VARgewaehlt,TEXT CONSTueberschr1):TEXT VARkombinationsname:="";ROWmaxTEXT VARkombnamen;INT VARanzahlkombinationen:=0,stelle1,stelle2,knr:=0;BOOL VARautomatik:=FALSE;TEXT VARmarkers1:="";THESAURUS VARangebot1:=emptythesaurus,auswahl1:=emptythesaurus;muster1:=neuerzustand(dimension+codimension);IFart1=phasdgANDmitkombinationenTHENermittlevariablenpkELIFart1=phasdgAND NOTmitkombinationenTHENermittlevariablenpELIFart1=tabdgTHENermittlevariablentELIFwiezeitdiagramm(art1)THENermittlevariablenzFI;.ermittlevariablent:ermittlevariablenliste(angebot1);auswahl1:=somewithmax(singlesp1,zl1,singlebr,hoe,angebot1,dimension+codimension,ueberschr1,kopfzeile(kopfbeliebigvielevar));gewaehlt:= +notempty(auswahl1);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1);FI;.ermittlevariablenz:ermittlevariablenliste(angebot1);auswahl1:=somewithmax(singlesp1,zl1,singlebr,hoe,angebot1,max4variablen,ueberschr1,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl1);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1);FI;.ermittlevariablenpk:listekombinationen(kombnamen,anzahlkombinationen);IFanzahlkombinationen=1THENknr:=1;gewaehlt:=TRUE;ELSEangebot1:=mengederkombinationen(kombnamen,anzahlkombinationen);kombinationsname:=one(singlesp1,zl1,singlebr,hoe,angebot1,ueberschr1,kopfzeile(kopfgenaueinexykombin));gewaehlt:=kombinationsname<>"";IFgewaehltTHENknr:=link(angebot1,kombinationsname);FI;FI;IFgewaehltTHENindiceskombinationen(knr,stelle1,stelle2,automatik);belegemuster(muster1,stelle1,stelle2,automatik);FI;.ermittlevariablenp:markers1:="xy";ermittlevariablenliste(angebot1);auswahl1:=someexactly(singlesp1,zl1,singlebr,hoe,angebot1,2,ueberschr1,kopfzeile(kopfxyeingabe),markers1);gewaehlt:=notempty(auswahl1);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1,markers1);FI;.max4variablen:min(4,dimension+codimension).END PROCvariableneinstellensingle;PROCvariableneinstellendouble(ZUSTAND VARmuster1,muster2,INT CONSTart1,art2,BOOL VARgewaehlt,TEXT CONSTueberschr1,ueberschr2):TEXT VARkombinationsname:="";ROWmaxTEXT VARkombnamen;INT VARanzahlkombinationen:=0,stelle1,stelle2,knr:=0;BOOL VARautomatik:=FALSE;TEXT VARmarkers1:="",markers2:="";THESAURUS VARangebot1:=emptythesaurus,auswahl1:=emptythesaurus,angebot2:=emptythesaurus,auswahl2:=emptythesaurus;IFart1=phasdgANDwiezeitdiagramm(art2)AND NOTmitkombinationenTHENermittlevariablenpundzELIFwiezeitdiagramm(art1)ANDart2=phasdgAND NOTmitkombinationenTHENermittlevariablenzundpELIFart1=phasdgANDwiezeitdiagramm(art2)ANDmitkombinationenTHENermittlevariablenpkundzELIFwiezeitdiagramm(art1)ANDart2=phasdgANDmitkombinationenTHENermittlevariablenzundpkELIFart1=phasdgANDart2=phasdgANDmitkombinationenTHENermittlevariablenpkundpkELIFart1=phasdgANDart2=phasdgAND NOTmitkombinationenTHENermittlevariablenpundpELIFwiezeitdiagramm(art1)ANDwiezeitdiagramm(art1)THENermittlevariablenzundzFI;.ermittlevariablenpundz:ermittlevariablenliste(angebot1);markers1:="xy";markers2:="x";auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,2,2,1,4,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfxyeingabe),ueberschr2,kopfzeile(kopfmax4variablen),markers1,markers2);gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1,markers1);belegemuster(auswahl2,angebot1,muster2);FI;.ermittlevariablenzundp:ermittlevariablenliste(angebot1);markers1:="x";markers2:="xy";auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,1,4,2,2,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfmax4variablen),ueberschr2,kopfzeile(kopfxyeingabe),markers1,markers2);gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1);belegemuster(auswahl2,angebot1,muster2,markers2);FI;.ermittlevariablenpkundz:ermittlevariablenliste(angebot2);listekombinationen(kombnamen,anzahlkombinationen);IFanzahlkombinationen=1THENknr:=1;auswahl2:=somewithmax(singlesp1,zl1,singlebr,hoe,angebot2,4,ueberschr1,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl2);ELSEangebot1:=mengederkombinationen(kombnamen,anzahlkombinationen);auswahl1:=angebot1;auswahl2:=angebot2;doublesome(zl1,hoe,1,1,1,4,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfgenaueinexykombin),ueberschr2,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENknr:=0;get(auswahl1,kombinationsname,knr);knr:=link(angebot1,kombinationsname);FI;FI;IFgewaehltTHENindiceskombinationen(knr,stelle1,stelle2,automatik);belegemuster(muster1,stelle1,stelle2,automatik);belegemuster(auswahl2,angebot2,muster2);FI;.ermittlevariablenzundpk:ermittlevariablenliste(angebot1);listekombinationen(kombnamen,anzahlkombinationen);IFanzahlkombinationen=1THENknr:=1;auswahl1:=somewithmax(singlesp1,zl1,singlebr,hoe, +angebot1,4,ueberschr1,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl1);ELSEangebot2:=mengederkombinationen(kombnamen,anzahlkombinationen);auswahl1:=angebot1;auswahl2:=angebot2;doublesome(zl1,hoe,1,4,1,1,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfmax4variablen),ueberschr2,kopfzeile(kopfgenaueinexykombin));gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENknr:=0;get(auswahl2,kombinationsname,knr);knr:=link(angebot2,kombinationsname);FI;FI;IFgewaehltTHENindiceskombinationen(knr,stelle1,stelle2,automatik);belegemuster(auswahl1,angebot1,muster1);belegemuster(muster2,stelle1,stelle2,automatik);FI;.ermittlevariablenpkundpk:INT VARknr2:=0;listekombinationen(kombnamen,anzahlkombinationen);IFanzahlkombinationen=1THENknr:=1;knr2:=1;gewaehlt:=TRUE;ELSEangebot1:=mengederkombinationen(kombnamen,anzahlkombinationen);auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,1,1,1,1,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfgenaueinexykombin),ueberschr2,kopfzeile(kopfgenaueinexykombin));gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENknr:=0;get(auswahl1,kombinationsname,knr);knr:=link(angebot1,kombinationsname);knr2:=0;get(auswahl2,kombinationsname,knr2);knr2:=link(angebot1,kombinationsname);FI;FI;IFgewaehltTHENindiceskombinationen(knr,stelle1,stelle2,automatik);belegemuster(muster1,stelle1,stelle2,automatik);indiceskombinationen(knr2,stelle1,stelle2,automatik);belegemuster(muster2,stelle1,stelle2,automatik);FI;.ermittlevariablenpundp:markers1:="xy";markers2:="xy";ermittlevariablenliste(angebot1);auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,2,2,2,2,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfxyeingabe),ueberschr2,kopfzeile(kopfxyeingabe),markers1,markers2);gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1,markers1);belegemuster(auswahl2,angebot1,muster2,markers2);FI;.ermittlevariablenzundz:ermittlevariablenliste(angebot1);auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,1,4,1,4,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfmax4variablen),ueberschr2,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1);belegemuster(auswahl2,angebot1,muster2);FI;.END PROCvariableneinstellendouble;PROCbelegemuster(ZUSTAND VARmuster,INT VARplace1,place2,BOOL CONSTvertauschbar):replace(muster,place1,1.0);IFvertauschbarTHENreplace(muster,place2,1.0)ELSEreplace(muster,place2,2.0)FI;END PROCbelegemuster;PROCbelegemuster(THESAURUS CONSTauswahl,angebot,ZUSTAND VARmuster,TEXT CONSTmarkers):TEXT VARname1:="",name2:="";INT VARplacea:=0,placeb:=1;get(auswahl,name1,placea);get(auswahl,name2,placeb);placea:=link(angebot,name1);placeb:=link(angebot,name2);IF(markersSUB1)=(markersSUB2)THENreplace(muster,placea,1.0);replace(muster,placeb,1.0);ELIF(markersSUB1)="x"THENreplace(muster,placea,1.0);replace(muster,placeb,2.0);ELSEreplace(muster,placeb,1.0);replace(muster,placea,2.0);FI;END PROCbelegemuster;PROCbelegemuster(THESAURUS CONSTauswahl,angebot,ZUSTAND VARmuster):TEXT VARvname;INT VARzeiger;get(auswahl,vname,zeiger);WHILEvname<>""REPreplace(muster,link(angebot,vname),1.0);get(auswahl,vname,zeiger);PER;END PROCbelegemuster;PROCermittlevariablenliste(THESAURUS VARangebot):INT VARi;FORiFROM1UPTOdimensionREPinsert(angebot,variablenname(i));PER;FORiFROM1UPTOcodimensionREPinsert(angebot,covariablenname(i));PER;.END PROCermittlevariablenliste;THESAURUS PROCmengederkombinationen(ROWmaxTEXT CONSTkombnamen,INT CONSTanzahlkombinationen):THESAURUS VARangebot:=emptythesaurus;INT VARi;FORiFROM1UPTOanzahlkombinationenREPinsert(angebot,kombnamen(i));PER;angebot.END PROCmengederkombinationen;BOOL PROCwiezeitdiagramm(INT CONSTart):art=zeitdgORart=histdgORart=tabdg.END PROCwiezeitdiagramm;INT PROCdarstellungsart(TEXT CONSTdarstellungsname):IFdarstellungsname=zuebersTHENzeitdgELIFdarstellungsname=puebersTHENphasdgELIFdarstellungsname=huebersTHENhistdgELIFdarstellungsname=tuebersTHENtabdgELSE0FI.END PROC +darstellungsart;PROCrefreshundnrausgabe:giblsgnraus;do("refresh submenu");END PROCrefreshundnrausgabe;PROCplotendundregenerate:plotendundregenerate(TRUE);END PROCplotendundregenerate;PROCplotendundregenerate(BOOL CONSTmitlsgnrausgabe):plotend;do("regenerate menuscreen;");IFmitlsgnrausgabeTHENgiblsgnraus;FI;END PROCplotendundregenerate;PROCfehlerbehandlungnachgraphik(BOOL CONSTmitlsgnr):enablestop;IF NOTiserrorTHENplotendundregenerate(mitlsgnr)ELSEzeigekopfbalken;FI;END PROCfehlerbehandlungnachgraphik;LETlsgwindowy=20,lsgwindowx=3,lsgwindowb=30,lsgwindowh=2;WINDOW VARlsgwindow:=window(lsgwindowx,lsgwindowy,lsgwindowb,lsgwindowh);PROCgiblsgnraus:erase(lsgwindow);outframe(lsgwindow);cursor(lsgwindow,1,1);putline(lsgwindow,lsgnrtext1);put(lsgwindow,lsgnrtext2);.END PROCgiblsgnraus;PROCevtneueaktivierungausgeben(INT CONSTsubmenu):INT VARi;aktivierunggeaendert:=FALSE;FORiFROM1UPTO8REP IF(aktivierung(submenu)(i)XORaktivaktuell(i))ORerstesaufklappen(submenu)THENaktivierunggeaendert:=TRUE;aktivierung(submenu)(i):=aktivaktuell(i);IFaktivaktuell(i)THENdo("activate ("+text(i)+")");ELSEdo("deactivate ("+text(i)+")");FI;FI;PER;erstesaufklappen(submenu):=FALSE;.END PROCevtneueaktivierungausgeben;PROCuebergebeinfotextfuerwd(DATASPACE CONSTwdinfo):infofuerwd:=wdinfo;END PROCuebergebeinfotextfuerwd;PROCzeigekopfbalken:cursor(1,1);out(invers(subtext(kopfbalken,1,headzeilenlaenge)));END PROCzeigekopfbalken;END PACKETlsbearbeitungsmenu; + diff --git a/app/schulis-simulationssystem/3.0/src/m b/app/schulis-simulationssystem/3.0/src/m new file mode 100644 index 0000000..5825df6 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/m @@ -0,0 +1,3 @@ +PACKETmatrixDEFINESdiagrammankoppeln,aenderungenspeichern,initcellmatrix,WRITE,NR,AUSGANG,EINGANG,UEBER,CELL,newcell,deletecell,cell,:=,mpos,objekt,typbezeichner,belegt,freieverknuepfungspunkte,belegteverknuepfungspunkte,link,loeschelink,variablenthesaurus,ergebnisthesaurus,formelthesaurus,parameterthesaurus,diagrammnameneintragen,aktuellermodellname,aktuellermodellkurzname,wdlauffaehig,anzahlmpos,getmpos:LETmaxi=20,maxj=10,maxlink=8,matrixtyp1=1107,matrixtyp2=1207,lengthfuerintimtext=2,to=1,from=2;TYPE LINK=STRUCT(INTrichtung,MPOSmpos,INTnr);TYPE CELL=STRUCT(BOOLstatus,MPOSmpos,ROWmaxlinkLINKfromorto,OBJEKTobj);TYPE MATRIX=STRUCT(ROWmaxiROWmaxjCELLmat,THESAURUSvthesaurus,ethesaurus,pthesaurus,fthesaurus,TEXTmodellname,modellkurzname,BOOLlauffaehig);BOUND MATRIX VARmatrix;DATASPACE VARds,nilwd;INITFLAG VARnilwdeingerichtet:=FALSE;PROCdiagrammankoppeln(DATASPACE VARmodellds):forget(ds);ds:=modellds;IFmatrixtyp1=type(ds)CORmatrixtyp2=type(ds)THENmatrix:=dsELSEerrorstop("Datenraum hat falschen Typ!")FI;forget(modellds)END PROCdiagrammankoppeln;PROCdiagrammnameneintragen(TEXT CONSTlangname,kurzname):matrix.modellname:=langname;matrix.modellkurzname:=kurznameEND PROCdiagrammnameneintragen;PROCaenderungenspeichern(TEXT CONSTdsname):IFmatrix.lauffaehigTHENtype(ds,matrixtyp2)ELSEtype(ds,matrixtyp1)FI;forget(dsname,quiet);copy(ds,dsname)END PROCaenderungenspeichern;PROCinitcellmatrix:INT VARi,j,l;forget(ds);IF NOTinitialized(nilwdeingerichtet)THENnilwd:=nilspace;felderinitialisieren;type(nilwd,matrixtyp1)FI;ds:=nilwd;matrix:=ds.felderinitialisieren:matrix:=nilwd;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREPcell.obj:=new(nil);cell.mpos:=newmpos(i,j);cell.status:=FALSE;FORlFROM1UPTOmaxlinkREPcell.fromorto(l).richtung:=0;cell.fromorto(l).mpos:=null;cell.fromorto(l).nr:=0PER PER PER;matrix.vthesaurus:=emptythesaurus;matrix.ethesaurus:=emptythesaurus;matrix.pthesaurus:=emptythesaurus;matrix.fthesaurus:=emptythesaurus;matrix.modellname:="";matrix.modellkurzname:="";matrix.lauffaehig:=FALSE.cell:matrix.mat(i)(j).END PROCinitcellmatrix;OP:=(LINK VARl,LINK CONSTr):l.richtung:=r.richtung;l.mpos:=r.mpos;l.nr:=r.nrEND OP:=;CELL PROCcell(MPOS CONSTmpos):matrix.mat(impos(mpos))(jmpos(mpos))END PROCcell;CELL PROCcell(GPOS CONSTgpos):cell(mpos(gpos))END PROCcell;CELL PROCcell(INT CONSTi,j):matrix.mat(i)(j)END PROCcell;THESAURUS PROCvariablenthesaurus:matrix.vthesaurusEND PROCvariablenthesaurus;THESAURUS PROCergebnisthesaurus:matrix.ethesaurusEND PROCergebnisthesaurus;THESAURUS PROCparameterthesaurus:matrix.pthesaurusEND PROCparameterthesaurus;THESAURUS PROCformelthesaurus:matrix.fthesaurusEND PROCformelthesaurus;TEXT PROCaktuellermodellname:matrix.modellnameEND PROCaktuellermodellname;TEXT PROCaktuellermodellkurzname:matrix.modellkurznameEND PROCaktuellermodellkurzname;BOOL PROCwdlauffaehig:matrix.lauffaehigEND PROCwdlauffaehig;PROCwdlauffaehig(BOOL CONSTwert):matrix.lauffaehig:=wertEND PROCwdlauffaehig;PROCnewcell(OBJEKT CONSTobj,MPOS CONSTpos):initialisieren;verbindungen;inthesauruseinordnen.initialisieren:cell.obj:=obj;cell.mpos:=pos;cell.status:=TRUE;.verbindungen:INT VARi;FORiFROM1UPTOmaxlinkREPcell.fromorto(i).richtung:=0;cell.fromorto(i).mpos:=null;cell.fromorto(i).nr:=0PER.inthesauruseinordnen:i:=0;TEXT VARmposimtext:=text(impos(pos),lengthfuerintimtext)+text(jmpos(pos),lengthfuerintimtext);IFtyp(obj)=variableTHENinsert(matrix.vthesaurus,mposimtext,i)ELIFtyp(obj)=ergebnisTHENinsert(matrix.ethesaurus,mposimtext,i)ELIFtyp(obj)=parameterTHENinsert(matrix.pthesaurus,mposimtext,i)ELIFtyp(obj)=formelTHENinsert(matrix.fthesaurus,mposimtext,i)FI.cell:matrix.mat(impos(pos))(jmpos(pos)).END PROCnewcell;OP:=(CELL VARl,CELL CONSTr):CONCR(l):=CONCR(r)END OP:=;PROCdeletecell(MPOS CONSTm):deletecell(impos(m),jmpos(m))END PROCdeletecell;PROCdeletecell(INT CONSTi,j):matrix.mat(i)(j).status:=FALSE;INT VARd:=0;TEXT VARmposimtext:=text(i,lengthfuerintimtext)+text(j,lengthfuerintimtext);IFtyp(obj)=variableTHENdelete(matrix.vthesaurus,mposimtext,d)ELIFtyp(obj)=ergebnis +THENdelete(matrix.ethesaurus,mposimtext,d)ELIFtyp(obj)=parameterTHENdelete(matrix.pthesaurus,mposimtext,d)ELIFtyp(obj)=formelTHENdelete(matrix.fthesaurus,mposimtext,d)FI.obj:matrix.mat(i)(j).obj.END PROCdeletecell;BOOL OP AUSGANG(CELL CONSTc,INT CONSTi):c.fromorto(i).richtung=toEND OP AUSGANG;BOOL OP EINGANG(CELL CONSTc,INT CONSTi):c.fromorto(i).richtung=fromEND OP EINGANG;MPOS OP UEBER(CELL CONSTc,INT CONSTi):c.fromorto(i).mposEND OP UEBER;INT OP NR(CELL CONSTc,INT CONSTi):c.fromorto(i).nrEND OP NR;TEXT PROCfreieverknuepfungspunkte(CELL CONSTc):TEXT VARfreiepunkte:="";INT VARi;FORiFROM1UPTOmaxlinkREP IF(c.fromorto(i).mpos=null)THENfreiepunkteCATtext(i,1)FI PER;freiepunkteEND PROCfreieverknuepfungspunkte;TEXT PROCbelegteverknuepfungspunkte(CELL CONSTc):TEXT VARfreiepunkte:="";INT VARi;FORiFROM1UPTOmaxlinkREP IF NOT(c.fromorto(i).mpos=null)THENfreiepunkteCATtext(i,1)FI PER;freiepunkteEND PROCbelegteverknuepfungspunkte;PROClink(MPOS CONSTsourcepos,INT CONSTsourcelinkpos,MPOS CONSTtargetpos,INT CONSTtargetlinkpos):source.fromorto(sourcelinkpos).richtung:=to;source.fromorto(sourcelinkpos).mpos:=targetpos;source.fromorto(sourcelinkpos).nr:=targetlinkpos;target.fromorto(targetlinkpos).richtung:=from;target.fromorto(targetlinkpos).mpos:=sourcepos;target.fromorto(targetlinkpos).nr:=sourcelinkpos.source:matrix.mat(impos(sourcepos))(jmpos(sourcepos)).target:matrix.mat(impos(targetpos))(jmpos(targetpos)).END PROClink;PROCloeschelink(MPOS CONSTactualmpos,INT CONSTnr):IFactualcellissourceTHENtarget.fromorto(targetlinkpos).richtung:=0;target.fromorto(targetlinkpos).mpos:=null;target.fromorto(targetlinkpos).nr:=0;source.fromorto(nr).richtung:=0;source.fromorto(nr).mpos:=null;source.fromorto(nr).nr:=0;ELIFactualcellistargetTHENsource.fromorto(sourcelinkpos).richtung:=0;source.fromorto(sourcelinkpos).mpos:=null;source.fromorto(sourcelinkpos).nr:=0;target.fromorto(nr).richtung:=0;target.fromorto(nr).mpos:=null;target.fromorto(nr).nr:=0FI.actualcell:matrix.mat(impos(actualmpos))(jmpos(actualmpos)).actualcellissource:INT VARsi:=impos(actualmpos),sj:=jmpos(actualmpos),ti:=impos(othermpos),tj:=jmpos(othermpos);actualcell.fromorto(nr).richtung=to.actualcellistarget:ti:=impos(actualmpos);tj:=jmpos(actualmpos);si:=impos(othermpos);sj:=jmpos(othermpos);actualcell.fromorto(nr).richtung=from.othermpos:actualcell.fromorto(nr).mpos.source:matrix.mat(si)(sj).target:matrix.mat(ti)(tj).targetlinkpos:source.fromorto(nr).nr.sourcelinkpos:target.fromorto(nr).nr.END PROCloeschelink;BOOL PROCbelegt(CELL CONSTc):c.statusENDPROCbelegt;BOOL PROCbelegt(MPOS CONSTm):matrix.mat(impos(m))(jmpos(m)).statusENDPROCbelegt;BOOL PROCbelegt(INT CONSTi,j):matrix.mat(i)(j).statusENDPROCbelegt;OBJEKT PROCobjekt(CELL CONSTc):c.objEND PROCobjekt;OBJEKT PROCobjekt(MPOS CONSTm):matrix.mat(impos(m))(jmpos(m)).objEND PROCobjekt;TEXT PROCtypbezeichner(CELL CONSTc):typbezeichner(objekt(c))END PROCtypbezeichner;OP WRITE(OBJEKT CONSTo,MPOS CONSTm):matrix.mat(impos(m))(jmpos(m)).obj:=oEND OP WRITE;MPOS PROCmpos(CELL CONSTc):c.mposEND PROCmpos;PROCgetmpos(THESAURUS CONSTt,MPOS VARm,INT VARi):TEXT VARmposimtext:="";get(t,mposimtext,i);IFmposimtext<>""THENm:=newmpos(int(subtext(mposimtext,1,lengthfuerintimtext)),int(subtext(mposimtext,1+lengthfuerintimtext,2*lengthfuerintimtext)))FI END PROCgetmpos;INT PROCanzahlmpos(THESAURUS CONSTt):INT VARi:=0,anzahl:=0;TEXT VARmposimtext:="";WHILEi""THENanzahlINCR1FI PER;anzahlEND PROCanzahlmpos;END PACKETmatrix; + diff --git a/app/schulis-simulationssystem/3.0/src/mat.binder plot b/app/schulis-simulationssystem/3.0/src/mat.binder plot new file mode 100644 index 0000000..b5c8b10 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/mat.binder plot @@ -0,0 +1,5 @@ +PACKETbinderplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz,plotterkanal:LEThorpixelmaxdurch16=85,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",esc=""27"",unterstreichenaus="Y",fettdruckaus="""",zeilenabstand="T15",druckrichtung=">",druckart="I",schrifttyp="H",formfeed=""12"",linefeed=""10"",cr=""13"";;INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord,anzahldernadelspalten,i,printerchannel:=15;REAL VARhorfaktor,vertfaktor,faktor;horpixel:=1360;verpixel:=900;anzahldernadelspalten:=900;horfaktor:=50.3937;vertfaktor:=47.24409;REAL VARbuchstabenhoehe:=0.762,buchstabenbreite:=0.3373438;BOUND ROWhorpixelmaxdurch16TEXT VARbitmap;INT VARplotterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=26.9875;ycm:=19.05;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1).ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT VARspaltenzaehler;bitmap:=old(namederbitmap);druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+unterstreichenaus);out(esc+fettdruckaus);out(esc+zeilenabstand);out(esc+druckrichtung);out(esc+schrifttyp).seitenvorschub:out(formfeed).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask,plotterchannel).bitmapdrucken:FORspaltenzaehlerFROM(groesstexkoordDIV16)+1DOWNTO1REPbefehlssequenzschickenPER.zeilenbeginn:groessteykoord+1.befehlssequenzschicken:out(esc+druckart+neueanzahldernadelspalten);teilzeileausgeben;out(cr+linefeed).neueanzahldernadelspalten:nullen+text(zeilenbeginn).nullen:(4-LENGTHtext(zeilenbeginn))*"0".teilzeileausgeben:outsubtext(bitmap(spaltenzaehler),vontextpos,bistextpos).vontextpos:2*(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:2*anzahldernadelspaltenEND PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet)END PROCplotend;PROCclear:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);xpos:=0;ypos:=0;pen(0,1,0,1);INT VARj;TEXT VARleerespalte:=(2*verpixel)*"�";FORjFROM1UPTOhorpixelmaxdurch16REPbitmap(j):=leerespaltePER;groesstexkoord:=0;groessteykoord:=0END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT +VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorEND IF PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystepEND PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:= +totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0 +UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x0ANDx<37THENvelocity:=xFI END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:TEXT VARhp:="";move(0,0);sendepicture;hpCAT("v"+sbn(0));hpCAT"�"+".)";toplotterchannel;out(hp);toterminalchannel;ENDPROCplotend;PROCclear:terminalchannel:=channel;forget("picture ds",quiet);picture:=new("picture ds");picture:="";TEXT VARhp;hp:="�.(";hpout(hp);hp:="�.M:";hpout(hp);hp:="�.I1000;17;13:";hpout(hp);hp:=schlange;hpCAT"W";hpCATplotput(papierx1,papiery1);hpCATplotput(papierx2,papiery2);hpCATterminator;hpout(hp);hp:=schlange;hpCAT"S";hpCATplotput(xunits,yunits);hpCATterminator;hpout(hp);hpout("vA");hpout(schlange+"Q");hpout(schlange+"V"+sbn(velocity)+terminator);hpout(schlange+"P"+plotput(0,3));END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linetypesenden;verifypen;switchtopen;.verifypen:INT VARpen;pen:=max(0,foreground);pen:=min(4,pen).switchtopen:TEXT VARhp;hp:=("v"+sbn(pen));hpout(hp).linetypesenden:hp:=schlange+"Q";hpCATlinetypecode;hpout(hp).linetypecode:TEXT VARtt;tt:="";IFlinetype=0THENtt:=terminator;ELIFlinetype=1THENtt:=terminator;ELIFlinetype=2THENtt:=sbn(32+0)+sbn(1)+mbn(15)+terminator;ELIFlinetype=3THENtt:=sbn(32+1)+sbn(2)+mbn(15)+terminator;ELIFlinetype=4THENtt:=sbn(32+1)+sbn(2)+mbn(30)+terminator;ELIFlinetype=5THENtt:=sbn(32+1)+sbn(2)+sbn(32+2)+sbn(2)+mbn(28)+terminator;ELSEtt:=terminatorFI;ttEND PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:="";hpCAT"p";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:="";hpCAT"q";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp;INT VARspace:=int(width*plotterunitspercm),size:=int(height*plotterunitspercm*1.5);hp:=schlange+"%";hpCATplotput(space,size);hpout(hp);hp:=schlange+"'";ersetzeumlaute;hpCATumgesetztertext;hpCATcode(3);hpout(hp);move(position.x,position.y).ersetzeumlaute:TEXT VARumgesetztertext:="";INT VARi;FORiFROM1UPTO LENGTHrecordREPbildeneuentextPER.bildeneuentext:IF(pos("äöüÄÖÜß",(recordSUBi)))=0THENumgesetztertextCAT(recordSUBi)ELSEumgesetztertextCATersetzterumlautFI.ersetzterumlaut:IF"ä"=(recordSUBi)THENalt+"a"+pktklein+standELIF"ö"=(recordSUBi)THENalt+"o"+pktklein+standELIF"ü"=(recordSUBi)THENalt+"u"+pktklein+standELIF"Ä"=(recordSUBi)THENalt+"A"+pktgross+standELIF"Ö"=(recordSUBi)THENalt+"O"+pktgross+standELIF"Ü"=(recordSUBi)THENalt+"U"+pktgross+standELIF"ß"=(recordSUBi)THEN"P"+backspace+"p"ELSE""FI.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;TEXT PROCplotput(INT CONSTnx,ny):INT VARn,nx1,nx2,nx3,ny2,ny3,ny4,ny5,nxr,nyr;TEXT VARmbpformat;INT VARnp1,np2,np3,np4,np5;n:=nx;IF NOT(nx>ny)THENn:=ny;FI;IFn<256THEN IFn>31 +THENthreebyteformatELIFn>3THENtwobyteformatELSEonebyteformatFI;ELSE IFn<2048THENfourbyteformatELIFn<16384THENfivebyteformatELSEerrorstop("out of range: "+text(n));FI;FI;mbpformat.onebyteformat:np1:=ny+96+4*nx;mbpformat:=code(np1);.twobyteformat:nx1:=nxDIV2;nx2:=nx-2*nx1;np1:=nx1+96;np2:=ny+32*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;mbpformat:=code(np1)+code(np2);.threebyteformat:nx1:=nxDIV16;nx2:=nx-16*nx1;ny2:=nyDIV64;ny3:=ny-64*ny2;np1:=nx1+96;np2:=ny2+4*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3;IF NOT(np3>31)THENnp3:=np3+64;FI;mbpformat:=code(np1)+code(np2)+code(np3);.fourbyteformat:nx1:=nxDIV128;nxr:=nx-128*nx1;nx2:=nxrDIV2;nx3:=nxr-2*nx2;ny3:=nyDIV64;ny4:=ny-64*ny3;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+32*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4);.fivebyteformat:nx1:=nxDIV1024;nxr:=nx-1024*nx1;nx2:=nxrDIV16;nx3:=nxr-16*nx2;ny3:=nyDIV4096;nyr:=ny-4096*ny3;ny4:=nyrDIV64;ny5:=nyr-64*ny4;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+4*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;np5:=ny5;IF NOT(np5>31)THENnp5:=np5+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4)+code(np5);.END PROCplotput;TEXT PROCmbn(INT CONSTnn):TEXT VARmbnformat;INT VARnp1,np2,np3,nn1,nn2,nn3,nr;IFnn<16THENonebyteformatELIFnn<1024THENtwobyteformatELIFnn<=32767THENthreebyteformatELSEerrorstop("out of range: "+text(nn));FI;mbnformat.onebyteformat:np1:=nn+96;mbnformat:=code(np1).twobyteformat:nn1:=nnDIV64;nn2:=nn-64*nn1;assemble2;mbnformat:=code(np1)+code(np2);.threebyteformat:nn1:=nnDIV4096;nr:=nn-nn1*4096;nn2:=nrDIV64;nn3:=nr-64*nn2;assemble1;assemble2;mbnformat:=code(np1)+code(np2)+code(np3);.assemble1:np3:=nn3;IF NOT(np3>31)THENnp3:=np3+64;FI;.assemble2:np2:=nn2;IF NOT(np2>31)THENnp2:=np2+64;FI;np1:=nn1+96;.END PROCmbn;TEXT PROCsbn(INT CONSTnn):INT VARnp;np:=nn;IF NOT(np>31)THENnp:=np+64;FI;code(np).END PROCsbn;PROChpout(TEXT CONSTplotcommand):pictureCATplotcommand;IFlength(picture)>800THENsendepictureFI END PROChpout;PROCsendepicture:getlen;toplotterchannel;out(text(picture,len));picture:="";getacknowledge.getlen:INT VARlen:=min(1000,length(picture)).getacknowledge:clearinputbuffer;out("�");readhandshakechar.clearinputbuffer:WHILEincharety<>""REP PER.readhandshakechar:TEXT VARchar:="";INT VARsession;WHILEchar<>" "REPinchar(char)PER;toterminalchannel.END PROCsendepicture;PROCtoplotterchannel:continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKEThpplot;plotterkanal(7) + diff --git a/app/schulis-simulationssystem/3.0/src/mat.hp74xx plot b/app/schulis-simulationssystem/3.0/src/mat.hp74xx plot new file mode 100644 index 0000000..137f6c6 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/mat.hp74xx plot @@ -0,0 +1,3 @@ +PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=40.19,ycm=27.46,plotterunitspercm=402.0,buffersize=1024;LETinitcmd="IN",textcmd="LB",separator=",",terminator=";",outputterminator=" ",movecmd="PU",drawcmd="PD",pencmd="SP",charsizecmd="SI",linetypecmd="LT",plotabscmd="PA",askbuffersize="�.B",stdcharpre="�CS33;LB",stdcharpost="�SS;LB",etx="�";ROW22TEXT CONSTnichtasciizeichen:=ROW22TEXT:(stdcharpre+"["+stdcharpost,stdcharpre+"\"+stdcharpost,stdcharpre+"]"+stdcharpost,stdcharpre+"{"+stdcharpost,stdcharpre+"|"+stdcharpost,stdcharpre+"}"+stdcharpost,"k","-","#"," ",stdcharpre+"~"+stdcharpost,"�UC3,0,99,0,16,-99,0,-8,99,-3,0;LB","�UC3,0,99,0,16;LB","�UC3,0,99,0,8,-4,0;LB","�UC0,8,99,3,0,0,8;LB","�UC3,16,99,0,-8,3,0;LB","�UC3,0,99,0,8,3,0;LB","�UC0,8,99,6,0,-99,-3,0,99,0,8;LB","�UC0,8,99,6,0,-99,-3,0,99,0,-8;LB","�UC3,0,99,0,16,-99,0,-8,99,3,0;LB","�UC0,8,99,6,0;LB","�UC0,8,99,6,0,-99,-3,-8,99,0,16;LB");INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=5;INT VARfreebytes;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoehe;END PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breite;END PROCstdbreite;PROCbeginplot:freebytes:=9;toplotterchannel;clear;TEXT VARhp:=pencmd;hpCAT"1";hpCATterminator;sendtoplotter(hp)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:clear;TEXT VARhp:=pencmd;hpCAT"0";hpCATterminator;hpCATinitcmd;hpCATterminator;sendtoplotter(hp);toterminalchannelENDPROCplotend;PROCclear:TEXT VARhp:=initcmd;hpCATterminator;hpCATplotabscmd;hpCATterminator;sendtoplotter(hp);END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):TEXT VARhp:=pencmd;IFforeground>6ORforeground<1THENhpCAT"1"ELSEhpCATtext(foreground)END IF;hpCATterminator;hpCATlinetypecmd;IFlinetype>1ANDlinetype<6THENhpCATtext(linetype-1);hpCATseparator;hpCAT"0.75";END IF;hpCATterminator;sendtoplotter(hp)END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:=movecmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:=drawcmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp:=charsizecmd,konvertiertertext:="";konvertieretext;hpCATtext(width*0.66666667,8,4);hpCATseparator;hpCATtext(height*0.5,8,4);hpCATterminator;hpCATtextcmd;hpCATkonvertiertertext;hpCATetx;sendtoplotter(hp).konvertieretext:INT VARstelle;INT VARzeichen;FORstelleFROM1UPTO LENGTHrecordREPEATzeichen:=code(recordSUBstelle);IFzeichen=251THENkonvertiertertextCATnichtasciizeichen[11]ELIFzeichen>=185ANDzeichen<=188THENkonvertiertertextCATnichtasciizeichen[zeichen-173]ELIFzeichen>=200ANDzeichen<=206THENkonvertiertertextCATnichtasciizeichen[zeichen-184]ELIFzeichen>=214ANDzeichen<=223THENkonvertiertertextCATnichtasciizeichen[zeichen-213]ELSEkonvertiertertextCATcode(zeichen)END IF END REPEAT END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;PROCsendtoplotter(TEXT CONSTstring):INT VARlaenge;laenge:= +LENGTHstring;IFfreebytesbuffersizeDIV2ANDfreebytes-9>=laengePER.checkforerror:out("OE;");TEXT VARc,t;inchar(c);inchar(t);IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)FI;out("�.E");inchar(c);inchar(t);IFt<>outputterminatorTHENcCATt;inchar(t);END IF;IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)END IF;freebytesDECR6END PROCsendtoplotter;END PACKEThpplot;plotterkanal(7) + diff --git a/app/schulis-simulationssystem/3.0/src/mat.kyocera plot b/app/schulis-simulationssystem/3.0/src/mat.kyocera plot new file mode 100644 index 0000000..6e75223 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/mat.kyocera plot @@ -0,0 +1,3 @@ +PACKETkyoceraplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz:LETxcm=29.7,ycm=19.7,bit14=16384,plotterunitspercm=118.1102;LETinitcmd="!R! UNIT d; SPO L;";LETleavecmd="SPO P; EXIT;",separator=",",terminator=";",movecmd="MZP ",drawcmd="DZP ";INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=15;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,printerchannel:=15;horpixel:=3507;verpixel:=2330;horfaktor:=300.0/2.54;vertfaktor:=300.0/2.54;INT VARxpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:toplotterchannel;out(initcmd)ENDPROCbeginplot;PROCendplot:plotendENDPROCendplot;PROCplotend:IFchannel=plotterchannelTHENout(leavecmd);toterminalchannelEND IF ENDPROCplotend;PROCclear:END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.movetoxy:xpos:=xx;ypos:=yy;TEXT VARky:=movecmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.drawtoxy:xpos:=xx;ypos:=yy;TEXT VARky:=drawcmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move( +xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:disablestop;continue(terminalchannel);IFiserrorTHENclearerror;break(quiet)END IF;enablestopEND PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETkyoceraplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16"); + diff --git a/app/schulis-simulationssystem/3.0/src/mat.laserjet plot b/app/schulis-simulationssystem/3.0/src/mat.laserjet plot new file mode 100644 index 0000000..0f5360b --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/mat.laserjet plot @@ -0,0 +1,3 @@ +PACKETlaserjetplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LETesc="�",reset="�E",graphicsresolution="�*t75R",formfeed="�",landscape="�&I1O",horpixel=800,verpixel=560,intsperscanline=50,horfaktor=29.52756,vertfaktor=29.52756,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARxpos,ypos,xfak,yfak,plotterchannel,groesstexkoord,groessteykoord,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.76,buchstabenbreite:=0.3375,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=27.0;ycm:=19.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARspaltenbeginn:=(groesstexkoordDIV16)+1,zeilenbeginn:=groessteykoord+1;TEXT VARdoppelbyte:="xx";druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out(reset);out(landscape);out(graphicsresolution);out("�*r1A").gibdiebitmapaus:INT VARzeilenzaehler;FORzeilenzaehlerFROMzeilenbeginnDOWNTO1REPbefehlssequenzschickenPER.befehlssequenzschicken:out(esc+"*b"+text(neueanzahlderbytes)+"W");gibteilzeileaus.neueanzahlderbytes:(spaltenbeginnDIV8)+1.gibteilzeileaus:INT VARspaltenzaehler;FORspaltenzaehlerFROM1UPTOneueanzahlderbytesDIV2REPreplace(doppelbyte,1,bitmap(zeilenzaehler)(spaltenzaehler));out(doppelbyte)PER.druckedieseite:out("�*rB");out("�E").END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;korrigierenextpointnr.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs< +totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTi,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(i):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:xaltessixelTHENsendealtessixel;altessixel:=neuessixelELIFanzahlgleichersixel<32000THENanzahlgleichersixelINCR1ELSEsendealtessixel;altessixel:=neuessixelFI.sendealtessixel:IFanzahlgleichersixel=1THENout(code(altessixel+63))ELSEout(text(anzahlgleichersixel)+code(altessixel+63));anzahlgleichersixel:=1FI.END PROCsixelsend;INT PROCplotterkanal:plotterchannel +END PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETxeroxplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16"); + diff --git a/app/schulis-simulationssystem/3.0/src/modellbasis dialog b/app/schulis-simulationssystem/3.0/src/modellbasis dialog new file mode 100644 index 0000000..17202fe --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/modellbasis dialog @@ -0,0 +1,24 @@ +PACKETmodellbasisDEFINESinfotextauswahl,auskunftsdienst,modellmitdatenfuellen,listemodellbanken,anzahlmodellbanken,listedermodelle,anzahldglmodelle,anzahlwdmodelle,anzahlausfuehrbarerwdmodelle,fuegeein,loesche,modelldatenraum,neuebank,modellbankvolldgl,modellbankvollwd,modellbankvoll,copy,modellaktuell,MODELLDGL,compilierbaregleichungen,modellname,modellbezeichnung,informationstext,vorgabekurve,vorgabevergleichskurve,:=,modellerfassung,nilmodell,kopplean,wdmodelle,wddsnamen,wdeinfuegen,wdumbenennen,komprimiere,KRITERIUM,allemodelle,alleaenderbaren,allelauffaehigen,schickeanmanagertask,putgetformular1: +LETesc=""27"",return=""13"",rechts=""2"",links=""8"",hoch=""3"",runter=""10"",tab=""9"",dsname="Modell Infodatei",auskunftseite1=""28"",allgemeineauskunftseite2=""29""30""31"",auskeingabebeispiel=""42"",auskdatenkorrekt=""43"",auskfehlerfestgestellt=""44"",auskgleichungunvollstaendig=""45"",ausklabelzulang=""46"",ausklabeldoppelt=""47""48"",auskcompilunbekkomm=""49"" ,auskcompilparameter=""50"" ,auskcompilsymbole=""51""52"" ,auskkeinegleichungen=""53"",auskunftzummodellerfassenseite2=""54""56"",auskvariablen=59,auskmodell=62,auskgleichungen=63,auskparameter=64,auskcompilungueltzw=""65""66"" ,auskcompilmehrfdekl=""67"" ,auskcompilsonstiges=""68"" ; +LETmaxmodelle=40,maxdglmodelle=20,maxwdmodelle=20,maxdialogpkt=20,maxinterpretlaenge=2000,terminaltaskname="ARBEITSPLATZ",geraetekanal=1,simulationneustarten=10,typnrmodellbank=1199,typnrwdausfuehrbar=1207,dglsuffix="(DGL)",wdsuffix=" (WD)",maxdimension=20,maxparameter=20,typnrmodell=1077,maxvarlaenge=30,maxinfo=50,maxgleichungen=50,maxdarstellungszeilen=500,uebersetzbar=0,notuebersetzbar=1,endezeichen="zZz",sp=" ",praefix="d ",modellcode=" code info ds",originalkurve=" originalkurve ds",vergleichskurve=" vergleichskurve ds",darstellungskopf=" PROC darstellung 4 (LOESUNG VAR lsg, BOOL VAR in demo, TEXT VAR taste):",darstellungsende=" END PROC darstellung 4 ;";LETbtsimulationunmoeglich=63,btwartenallgemein=44,btwartenwaehrendspeichern=87,btwartenwaehrenddrucken=88;INT CONSTexistiertnicht:=-1,nichtempfangsbereit:=-2;LETabbruchtaste="a",abbruchtastemenu="m",auskunftstaste="i",auskunftsloeschtaste1="z",auskunftsloeschtaste2="l",weitertaste="w",blaettertaste="b",speichertaste="s",zuruecktaste="z",simulationstaste="w",prueftaste="p",drucktaste="d",dupliziertaste="k",loeschtaste="-",wiedergabetaste="+",spalte3=3,infozeilenanfang=19,ersteseingabefeld=2,beginnseite1=1,endeseite1=10,beginnseite2=11,endeseite2=20,bildschirmzeilen=10,maxzeileneingabe=20,maxvarparaanzahl=61,maxvariablenlaenge=7,maxparlaenge=30,maxmodellnamelang=30,maxmodellnamelangaufgeblaeht=40,maxmodellnamekurz=15,stmenuoderweiter=33,auskihrfehler=7,auskpruefung=13,auskgespeichert=14,auskinfogedruckt=15;LETunbekkommdo="unbekanntes Kommando",undefdyadischop="undefinierter dyadischer",undefmonadop="undefinierter monadischer",paramsindfalsch="Typen der Parameter sind falsch",nurletzteanweisg="nur die letzte Anweisung",anstelledessymb="anstelle des letzten Symbols",unzulselektsymb="unzulaessiges Selektor-Symbol",konstdarfnicht="die Konstante darf nicht veraendert",klammerauffehlt="'(' fehlt",klammerzufehlt="')' fehlt",operatorfehlt="';' oder Operator ('+',",ungueltigzwischen="ungueltig zwischen Anweisungen",istmehrfachdekl="ist mehrfach deklariert";LETfehlertaste=4,fehlerparameterzulang=28,fehlerkopierposition=29,fehlerlangname=80,fehlerkurzname=81,fehlerlangnamefehlt=82,fehlerkurznamefehlt=83,fehlergleichungsart=85,fehlergleichungsartfehlt=86,fehlergleichungfehlt=87,fehlervariable=88,fehlervariablefehlt=89,fehlervariablezulang=90,fehlerdoppeldeklaration=91,fehlermodellnamedoppelt=92,fragenochmalspeichern=93,fehlervundgdoppelt=94,fehlerzeitvariabledoppelt=95,fragehierabspeichern=96,mldcursorbenutzung=97,mldnichtablauffaehig=98;TEXT CONSTgleichungsunterstriche:=60*"_"+140*" ",variablenunterstriche:=maxvariablenlaenge*"_",parameterunterstriche:=8*"_"+22*" ",leeresfeld:=77*" ",unterstrichfeld:=77*"-";TYPE KRITERIUM=INT;KRITERIUM CONSTallemodelle:=0,alleaenderbaren:=1,allelauffaehigen:=2;OP:=(KRITERIUM VARt,INT CONSTi):CONCR(t):=iENDOP:=;BOOL OP=(KRITERIUM CONSTlinks,rechts):CONCR(links)=CONCR(rechts)END OP=;LET ZEILE=STRUCT(TEXTgleichungsart,gleichung,variable,INTnummer);TYPE MODELLBANK=STRUCT(INTanzahldglmodelle,ROWmaxdglmodelleMODELLDGLmodelle,THESAURUSwdmodelle,wddsnamen);TYPE DEMOLAUF=STRUCT(VORGABEoriginal,vergleich,INTxindex,yindex,BOOLautomatisch,TEXTvariablenwahl);TYPE VORGABE=STRUCT(TEXTstartwert,parameter,REALanfangszeitpunkt,beobachtungsdauer,TEXTkurve);TYPE LOESUNG=STRUCT(ZUSTANDstartwert,PARAMETERparameter,REALanfangszeitpunkt,beobachtungsdauer,KURVEkurve);TYPE NAMEN=STRUCT(TEXTelan,lang,kurz);TYPE ZUSTANDSDATEN=STRUCT(INTanzahl,TEXToberbegriff,oberbegriffkurzform,ROWmaxdimensionTEXTnamelang,namekurz,TEXTunteregrenze,oberegrenze,randoben,randunten);TYPE COVARIABLENDATEN=STRUCT(INTanzahl,ROWmaxdimensionTEXTnamelang,namekurz);TYPE KOMBINATION=STRUCT(TEXTname,INTxindex,yindex,BOOLautomatisch);TYPE KOMBINATIONSANGEBOT=STRUCT(BOOLmitkombinationen,INTanzahl,ROWmaxdimensionKOMBINATIONpaar);TYPE PARAMETERDATEN=STRUCT(INTanzahl,ROWmaxparameterTEXTnamelang,nameelan,TEXTunteregrenze,oberegrenze);TYPE DARSTELLUNGSDATEN=STRUCT(BOOLimmodell,TEXTname);TYPE BESCHRAENKUNG=STRUCT( +REALminbeobachtungsdauer,maxbeobachtungsdauer,minanfangszeitpunkt,maxanfangszeitpunkt,INTanzahlbeobachtungspunkte);LET TEXTDATEN=BOUND STRUCT(ROWmaxinfoTEXTinfo,ROWmaxgleichungenTEXTgleichungen,cogleichungen,ROWmaxdarstellungszeilenTEXTdarstellungscode);TYPE MODELLDGL=STRUCT(NAMENname,ZUSTANDSDATENvariablen,COVARIABLENDATENcovariablen,PARAMETERDATENparameter,DARSTELLUNGSDATENdarstellung,BOOLmitphasendiagramm,BOOLganzzahlig,KOMBINATIONSANGEBOTkombinationen,TEXTcodeundinfo,BESCHRAENKUNGbeschraenkung,DEMOLAUFdemolauf,INTmodellzustand,BOOLgeschuetzt);BOUND MODELLBANK VARmb;MODELLDGL VARmodell;TEXTDATEN VARtextdaten;TEXT PROCmodellbezeichnung:modell.name.lang.END PROCmodellbezeichnung;TEXT PROCmodellkurzbezeichnung:modell.name.kurz.END PROCmodellkurzbezeichnung;TEXT PROCmodellname:modell.name.elan.END PROCmodellname;TEXT PROCmodelldatenraum:modell.codeundinfo.END PROCmodelldatenraum;BOOL PROCcompilierbaregleichungen:modell.modellzustand=uebersetzbarEND PROCcompilierbaregleichungen;INT PROCdimension:modell.variablen.anzahl.END PROCdimension;INT PROCcodimension:modell.covariablen.anzahl.END PROCcodimension;INT PROCparameteranzahl:modell.parameter.anzahl.END PROCparameteranzahl;BOOL PROCmitzusatzdarstellung:modell.darstellung.immodell.END PROCmitzusatzdarstellung;BOOL PROCmitphasendiagramm:modell.mitphasendiagramm.END PROCmitphasendiagramm;BOOL PROCergebnisganzzahlig:modell.ganzzahlig.END PROCergebnisganzzahlig;DATASPACE VARtextds;PROCinformationstext(FILE VARtexte):forget(textds);textds:=nilspace;texte:=sequentialfile(output,textds);holeinformationstext.holeinformationstext:TEXT VARsatz:="";INT VARi;IFmodell.geschuetztTHENputline(texte," "+modellbezeichnung);putline(texte," "+(areaxsize(grossesrahmenfenster)-2)*waagerecht);FI;FORiFROM1UPTOmaxinfoWHILEtextdaten.info(i)<>endezeichenREPsatz:=textdaten.info(i);putline(texte,satz);PER;.END PROCinformationstext;TEXT PROCvariablenname(INT CONSTi):TEXT CONSTt:=(modell.variablen.namelang(i));t+(maxvarlaenge-LENGTH(t))*" ".END PROCvariablenname;TEXT PROCvariablenkurzform(INT CONSTi):modell.variablen.namekurz(i).END PROCvariablenkurzform;TEXT PROCcovariablenname(INT CONSTi):TEXT CONSTt:=modell.covariablen.namelang(i);t+(maxvarlaenge-LENGTH(t))*" ".END PROCcovariablenname;TEXT PROCcovariablenkurzform(INT CONSTi):modell.covariablen.namekurz(i).END PROCcovariablenkurzform;TEXT PROCparametername(INT CONSTi):modell.parameter.namelang(i).END PROCparametername;TEXT PROCparameterkurzform(INT CONSTi):modell.parameter.nameelan(i).END PROCparameterkurzform;TEXT PROCdarstellungsname:modell.darstellung.name.END PROCdarstellungsname;PARAMETER PROCvorgabeparameter:parameter(modell.demolauf.original.parameter).END PROCvorgabeparameter;REAL PROCvorgabeanfangszeitpunkt:modell.demolauf.original.anfangszeitpunkt.END PROCvorgabeanfangszeitpunkt;ZUSTAND PROCvorgabevergleichssystemzustand:zustand(modell.demolauf.vergleich.startwert).END PROCvorgabevergleichssystemzustand;PARAMETER PROCvorgabevergleichsparameter:parameter(modell.demolauf.vergleich.parameter).END PROCvorgabevergleichsparameter;ZUSTAND PROCzustandunteregrenze:zustand(modell.variablen.unteregrenze).END PROCzustandunteregrenze;ZUSTAND PROCzustandoberegrenze:zustand(modell.variablen.oberegrenze).END PROCzustandoberegrenze;PARAMETER PROCparameteroberegrenze:parameter(modell.parameter.oberegrenze).END PROCparameteroberegrenze;PARAMETER PROCparameterunteregrenze:parameter(modell.parameter.unteregrenze).END PROCparameterunteregrenze;ZUSTAND PROCrandoben:zustand(modell.variablen.randoben).END PROCrandoben;ZUSTAND PROCrandunten:zustand(modell.variablen.randunten).END PROCrandunten;REAL PROCminbeobachtungsdauer:modell.beschraenkung.minbeobachtungsdauer.END PROCminbeobachtungsdauer;REAL PROCmaxbeobachtungsdauer:modell.beschraenkung.maxbeobachtungsdauer.END PROCmaxbeobachtungsdauer;REAL PROCminanfangszeitpunkt:modell.beschraenkung.minanfangszeitpunkt.END PROCminanfangszeitpunkt;REAL PROCmaxanfangszeitpunkt:modell.beschraenkung.maxanfangszeitpunkt.END PROC +maxanfangszeitpunkt;INT PROCanzahlbeobachtungspunkte:modell.beschraenkung.anzahlbeobachtungspunkte.END PROCanzahlbeobachtungspunkte;BOOL PROCmitkombinationen:modell.kombinationen.mitkombinationen.END PROCmitkombinationen;PROClistekombinationen(ROWmaxdimensionTEXT VARnamen,INT VARanzahl):INT VARi;anzahl:=modell.kombinationen.anzahl;FORiFROM1UPTOanzahlREPnamen(i):=modell.kombinationen.paar(i).name;PER;END PROClistekombinationen;PROCindiceskombinationen(INT CONSTkombnr,INT VARxachse,yachse,BOOL VARvertauschbar):xachse:=modell.kombinationen.paar(kombnr).xindex;yachse:=modell.kombinationen.paar(kombnr).yindex;vertauschbar:=modell.kombinationen.paar(kombnr).automatisch;END PROCindiceskombinationen;ZUSTAND PROCvorgabesystemzustand:zustand(modell.demolauf.original.startwert).END PROCvorgabesystemzustand;REAL PROCvorgabebeobachtungsdauer:modell.demolauf.original.beobachtungsdauer.END PROCvorgabebeobachtungsdauer;TEXT PROCvorgabekurve:modell.demolauf.original.kurve.END PROCvorgabekurve;REAL PROCvorgabevergleichsanfangszeitpunkt:modell.demolauf.vergleich.anfangszeitpunkt.END PROCvorgabevergleichsanfangszeitpunkt;REAL PROCvorgabevergleichsbeobachtungsdauer:modell.demolauf.vergleich.beobachtungsdauer.END PROCvorgabevergleichsbeobachtungsdauer;TEXT PROCvorgabevergleichskurve:modell.demolauf.vergleich.kurve.END PROCvorgabevergleichskurve;ZUSTAND PROCdemomuster:zustand(modell.demolauf.variablenwahl).END PROCdemomuster;BOOL PROCdemoautomatik:modell.demolauf.automatisch.END PROCdemoautomatik;INT PROCdemoxindex:modell.demolauf.xindexEND PROCdemoxindex;INT PROCdemoyindex:modell.demolauf.yindexEND PROCdemoyindex;TEXT PROCgleichung(INT CONSTi):textdaten.gleichungen(i)END PROCgleichung;TEXT PROCcogleichung(INT CONSTi):textdaten.cogleichungen(i)END PROCcogleichung;TEXT PROCdarstellungszeile(INT CONSTi):textdaten.darstellungscode(i)END PROCdarstellungszeile;PROCkopplean(MODELLDGL VARaktuellesmodell):modell:=aktuellesmodell;IFexists(modell.codeundinfo)THENtextdaten:=old(modell.codeundinfo);FI END PROCkopplean;PROCkopplean(INT CONSTaktuellesmodell):IFdglmodellTHENmodell:=mb.modelle(aktuellesmodell);IFexists(modell.codeundinfo)THENtextdaten:=old(modell.codeundinfo)FI FI.dglmodell:aktuellesmodell<=maxdglmodelle.END PROCkopplean;MODELLDGL PROCmodellaktuell(INT CONSTaktuellesmodell):mb.modelle(aktuellesmodell).END PROCmodellaktuell;PROCnilmodell(MODELLDGL VARmod):initialisieremodell.initialisieremodell:INT VARi;mod.name.elan:="";mod.name.lang:="";mod.name.kurz:="";mod.variablen.anzahl:=0;mod.variablen.oberbegriff:="";mod.variablen.oberbegriffkurzform:="";FORiFROM1UPTOmaxdimensionREPmod.variablen.namelang(i):="";mod.variablen.namekurz(i):="";PER;mod.variablen.unteregrenze:="";mod.variablen.oberegrenze:="";mod.variablen.randoben:="";mod.variablen.randunten:="";mod.covariablen.anzahl:=0;FORiFROM1UPTOmaxdimensionREPmod.covariablen.namelang(i):="";mod.covariablen.namekurz(i):="";PER;mod.parameter.anzahl:=0;FORiFROM1UPTOmaxparameterREPmod.parameter.namelang(i):="";mod.parameter.nameelan(i):="";PER;mod.parameter.unteregrenze:="";mod.parameter.oberegrenze:="";mod.darstellung.immodell:=FALSE;mod.darstellung.name:="";mod.mitphasendiagramm:=FALSE;mod.ganzzahlig:=FALSE;mod.demolauf.vergleich.startwert:="";mod.demolauf.vergleich.parameter:="";mod.demolauf.vergleich.beobachtungsdauer:=0.0;mod.demolauf.vergleich.anfangszeitpunkt:=0.0;mod.demolauf.vergleich.kurve:="";mod.demolauf.original.startwert:="";mod.demolauf.original.parameter:="";mod.demolauf.original.anfangszeitpunkt:=0.0;mod.demolauf.original.beobachtungsdauer:=0.0;mod.demolauf.original.kurve:="";mod.demolauf.xindex:=0;mod.demolauf.yindex:=0;mod.demolauf.automatisch:=FALSE;mod.demolauf.variablenwahl:="";mod.kombinationen.mitkombinationen:=FALSE;mod.kombinationen.anzahl:=0;FORiFROM1UPTOmaxdimensionREPmod.kombinationen.paar(i).xindex:=0;mod.kombinationen.paar(i).yindex:=0;mod.kombinationen.paar(i).automatisch:=FALSE;mod.kombinationen.paar(i).name:="";PER;mod.beschraenkung.minbeobachtungsdauer:=0.0;mod.beschraenkung +.maxbeobachtungsdauer:=0.0;mod.beschraenkung.minanfangszeitpunkt:=0.0;mod.beschraenkung.maxanfangszeitpunkt:=0.0;mod.beschraenkung.anzahlbeobachtungspunkte:=0;mod.modellzustand:=notuebersetzbar;mod.geschuetzt:=FALSE;END PROCnilmodell;PROCbildedsnamenneu(MODELLDGL VARmod,TEXT CONSTmodellbank,INT CONSTmodellnr):mod.codeundinfo:=modellbank+sp+text(modellnr)+modellcode;mod.demolauf.original.kurve:=modellbank+sp+text(modellnr)+originalkurve;mod.demolauf.vergleich.kurve:=modellbank+sp+text(modellnr)+vergleichskurve;END PROCbildedsnamenneu;PROCgleichungsprozeduren(TEXT CONSTdateiname):forget(dateiname,quiet);FILE VARprog:=sequentialfile(output,dateiname);schreibegleichungsproz;schreibecogleichungsproz;schreibedarstellung4;.schreibegleichungsproz:putline(prog,"ZUSTAND PROC f (REAL CONST zeit, "+" ZUSTAND CONST alter zustand, "+" PARAMETER CONST alle parameter):");deklarationen;gleichungen;ergebnis;putline(prog,"END PROC f;");.schreibecogleichungsproz:putline(prog,"ZUSTAND PROC co f (REAL CONST zeit, "+" ZUSTAND CONST alter zustand, "+" PARAMETER CONST alle parameter):");deklarationenvoncof;cogleichungen;cofergebnis;putline(prog,"END PROC co f;").gleichungen:FORiFROM1UPTOmaxgleichungenWHILEgleichung(i)<>endezeichenREPputline(prog,gleichung(i));PER.cogleichungen:INT VARi;FORiFROM1UPTOmaxgleichungenWHILEcogleichung(i)<>endezeichenREPputline(prog,cogleichung(i));PER;.deklarationen:putline(prog,"ZUSTAND VAR dvektorxyx"+" := neuer zustand (DSUB alter zustand);");IFdimension>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOdimensionREPput(prog,elan(variablenkurzform(i))+" :: ");IFi=dimensionTHENputline(prog,"alter zustand SUB "+text(i)+" ;");ELSEputline(prog,"alter zustand SUB "+text(i)+" ,");FI PER FI;IFparameteranzahl>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOparameteranzahlREPput(prog,elan(parameterkurzform(i))+" :: ");IFi=parameteranzahlTHENputline(prog,"alle parameter SUB "+text(i)+" ;");ELSEputline(prog,"alle parameter SUB "+text(i)+" ,");FI;PER;FI;IFdimension>0THENput(prog,"REAL VAR ");FORiFROM1UPTOdimensionREPput(prog,praefix+elan(variablenkurzform(i)));IFi=dimensionTHENputline(prog,";")ELSEputline(prog,",")FI;PER;FI;.ergebnis:putline(prog,"ergebnisxyx .");putline(prog,"ergebnisxyx : ");FORiFROM1UPTOdimensionREPputline(prog,"replace (dvektorxyx ,"+text(i)+","+praefix+elan(variablenkurzform(i))+" );");PER;putline(prog,"dvektorxyx.");.deklarationenvoncof:putline(prog,"ZUSTAND VAR dvektorxyx"+" := neuer zustand ( co dimension);");IFdimension>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOdimensionREPput(prog,elan(variablenkurzform(i))+" :: ");IFi=dimensionTHENputline(prog,"alter zustand SUB "+text(i)+" ;");ELSEputline(prog,"alter zustand SUB "+text(i)+" ,");FI;PER;FI;IFparameteranzahl>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOparameteranzahlREPput(prog,elan(parameterkurzform(i))+" :: ");IFi=parameteranzahlTHENputline(prog,"alle parameter SUB "+text(i)+" ;");ELSEputline(prog,"alle parameter SUB "+text(i)+" ,");FI;PER;FI;IFcodimension>0THENput(prog,"REAL VAR ");FORiFROM1UPTOcodimensionREPput(prog,elan(covariablenkurzform(i)));IFi=codimensionTHENputline(prog,";")ELSEputline(prog,",")FI;PER;FI;.cofergebnis:putline(prog,"ergebnisxyx .");putline(prog,"ergebnisxyx : ");FORiFROM1UPTOcodimensionREPputline(prog,"replace (dvektorxyx ,"+text(i)+","+elan(covariablenkurzform(i))+" );");PER;putline(prog,"dvektorxyx.");.schreibedarstellung4:IFmitzusatzdarstellungTHENschreibedarstellungscodeELSEschreibeleerenprozedurkopfFI.schreibeleerenprozedurkopf:putline(prog,darstellungskopf);putline(prog,darstellungsende);.schreibedarstellungscode:FORiFROM1UPTOmaxdarstellungszeilenWHILEdarstellungszeile(i)<>endezeichenREPputline(prog,darstellungszeile(i));PER.END PROCgleichungsprozeduren;TEXT PROCelan(TEXT CONSTalt):INT VARi:=1;TEXT VARt:="";FORiFROM1UPTO(LENGTHalt)REP IF(tanderstellei>=97CANDtanderstellei<=122)COR(tanderstellei>216CANDtanderstellei<=219)COR(tanderstellei>=48CANDtanderstellei<=57)THENtCATsubtext(alt,i,i)ELIF(tanderstellei>=65CANDtanderstellei<= +90)THENtCATcode(tanderstellei+32)ELIF(tanderstellei>=214CANDtanderstellei<=216)THENtCATcode(tanderstellei+3)ELSEtCAT" "FI PER;t.tanderstellei:code(subtext(alt,i,i))END PROCelan;OP:=(MODELLDGL VARmod,MODELLDGL CONSTm):CONCR(mod.name):=CONCR(m.name);CONCR(mod.variablen):=CONCR(m.variablen);CONCR(mod.covariablen):=CONCR(m.covariablen);CONCR(mod.parameter):=CONCR(m.parameter);CONCR(mod.darstellung):=CONCR(m.darstellung);mod.mitphasendiagramm:=m.mitphasendiagramm;mod.ganzzahlig:=m.ganzzahlig;mod.kombinationen.mitkombinationen:=m.kombinationen.mitkombinationen;mod.kombinationen.anzahl:=m.kombinationen.anzahl;INT VARi;FORiFROM1UPTOmaxdimensionREP CONCR(mod.kombinationen.paar(i)):=CONCR(m.kombinationen.paar(i))PER;mod.codeundinfo:=m.codeundinfo;CONCR(mod.beschraenkung):=CONCR(m.beschraenkung);CONCR(mod.demolauf.original):=CONCR(m.demolauf.original);CONCR(mod.demolauf.vergleich):=CONCR(m.demolauf.vergleich);mod.demolauf.xindex:=m.demolauf.xindex;mod.demolauf.yindex:=m.demolauf.yindex;mod.demolauf.automatisch:=m.demolauf.automatisch;mod.demolauf.variablenwahl:=m.demolauf.variablenwahl;mod.modellzustand:=m.modellzustand;mod.geschuetzt:=m.geschuetztEND OP:=;PROCloesche(INT CONSTmodellnr,TEXT CONSTmodellbankname):INT VARi;disablestop;IFdglmodellTHENforget(mb.modelle(modellnr).demolauf.original.kurve,quiet);forget(mb.modelle(modellnr).demolauf.vergleich.kurve,quiet);forget(mb.modelle(modellnr).codeundinfo,quiet);rueckedieanderenmodelleaufELSEforget(name(wddsnamen,modellindex),quiet);delete(mb.wddsnamen,modellindex);delete(mb.wdmodelle,modellindex);FI;enablestop.dglmodell:modellnr<=maxdglmodelle.modellindex:modellnr-maxdglmodelle.rueckedieanderenmodelleauf:FORiFROMmodellnr+1UPTOmb.anzahldglmodelleREPmb.modelle(i-1):=mb.modelle(i);bildedsnamenneu(mb.modelle(i-1),modellbankname,i-1);IFexists(mb.modelle(i).codeundinfo)THENrename(mb.modelle(i).codeundinfo,mb.modelle(i-1).codeundinfo);FI;KURVE VARkurvezurumbenennung,altekurve;IFexists(mb.modelle(i).demolauf.original.kurve)THENaltekurve:=old(mb.modelle(i).demolauf.original.kurve);copy(kurvezurumbenennung,mb.modelle(i-1).demolauf.original.kurve,altekurve);forget(mb.modelle(i).demolauf.original.kurve,quiet);FI;IFexists(mb.modelle(i).demolauf.vergleich.kurve)THENaltekurve:=old(mb.modelle(i).demolauf.vergleich.kurve);copy(kurvezurumbenennung,mb.modelle(i-1).demolauf.vergleich.kurve,altekurve);forget(mb.modelle(i).demolauf.vergleich.kurve,quiet);FI;PER;mb.anzahldglmodelleDECR1;.END PROCloesche;PROCneuebank(TEXT CONSTmodellbankname):INT VARi;IF NOTexists(modellbankname)CAND NOT(modellbankname="")THENmb:=new(modellbankname);type(old(modellbankname),typnrmodellbank);initialisierebank;FI.initialisierebank:mb.anzahldglmodelle:=0;FORiFROM1UPTOmaxdglmodelleREPnilmodell(mb.modelle(i));PER;mb.wdmodelle:=emptythesaurus;mb.wddsnamen:=emptythesaurus.END PROCneuebank;PROCkopplean(TEXT CONSTmodellbankname):IFexists(modellbankname)THENmb:=old(modellbankname)FI END PROCkopplean;PROClistemodellbanken(ROWmaxdialogpktTEXT VARnamensliste,INT VARanzahlbanken):suchedateienmitrichtigemtyp;.suchedateienmitrichtigemtyp:anzahlbanken:=0;TEXT VARname,d;beginlist;getlistentry(name,d);WHILEname<>""REP IFtype(old(name))=typnrmodellbankTHENanzahlbankenINCR1;namensliste(anzahlbanken):=name;FI;getlistentry(name,d);PER.END PROClistemodellbanken;INT PROCanzahlmodellbanken:INT VARanzahlbanken;suchedateienmitrichtigemtyp;anzahlbanken.suchedateienmitrichtigemtyp:anzahlbanken:=0;TEXT VARname,d;beginlist;getlistentry(name,d);WHILEname<>""REP IFtype(old(name))=typnrmodellbankTHENanzahlbankenINCR1;FI;getlistentry(name,d);PER;.END PROCanzahlmodellbanken;PROCloesche(TEXT CONSTmbname):kopplean(mbname);INT VARi;FORiFROM1UPTOmb.anzahldglmodelleREPforget(mb.modelle(i).demolauf.original.kurve,quiet);forget(mb.modelle(i).demolauf.vergleich.kurve,quiet);forget(mb.modelle(i).codeundinfo,quiet)PER;doquiet(PROC(TEXT CONST,QUIET CONST)forget,mb.wddsnamen);forget(mbname,quiet);END PROCloesche;PROCdoquiet(PROC(TEXT CONST,QUIET CONST)f,THESAURUS CONSTt):INT + VARi:=0;TEXT VARname;WHILEi""THENf(name,quiet)FI PER;END PROCdoquiet;PROClistedermodelle(ROWmaxmodelleTEXT VARnamensliste,ROWmaxmodelleINT VARmodelliste,KRITERIUM CONSTkriterium,INT VARmodellzaehler):INT VARmodnr;holemodellnamen.holemodellnamen:modellzaehler:=0;FORmodnrFROM1UPTOmb.anzahldglmodelleREPholedglnamen;PER;modnr:=0;WHILEmodnr=maxmodelleEND PROCmodellbankvoll;BOOL PROCmodellbankvolldgl:mb.anzahldglmodelle>=maxdglmodelleEND PROCmodellbankvolldgl;BOOL PROCmodellbankvollwd:anzahlwdmodelle>=maxwdmodelleEND PROCmodellbankvollwd;PROCfuegeein(TEXT CONSTmodellbank):INT VARreturncode;fuegeein(modellbank,returncode)END PROCfuegeein;PROCwdeinfuegen(TEXT CONSTmodellbank,TEXT CONSTlangname,kurzname):INT VARneuerindex:=0;THESAURUS VARt1:=mb.wdmodelle,t2:=mb.wddsnamen;disablestop;insert(mb.wdmodelle,langname,neuerindex);insert(mb.wddsnamen,modellbank+sp+text(neuerindex+maxdglmodelle)+sp+wdsuffix);diagrammnameneintragen(langname,kurzname);forget(name(mb.wddsnamen,neuerindex),quiet);aenderungenspeichern(name(mb.wddsnamen,neuerindex));IFiserrorTHENkonsistenzherstellenFI;.konsistenzherstellen:forget(name(mb.wddsnamen,neuerindex),quiet);mb.wdmodelle:=t1;mb.wddsnamen:=t2.END PROCwdeinfuegen;PROCwdumbenennen(TEXT CONSTlangname,kurzname,INT CONSTmodellnr):THESAURUS VARt:=mb.wdmodelle;disablestop;diagrammnameneintragen(langname,kurzname);rename(mb.wdmodelle,modellnr,langname);IFiserrorTHENclearerror;konsistenzherstellenFI;enablestop;.konsistenzherstellen:mb.wdmodelle:=t.END PROCwdumbenennen;PROCfuegeein(TEXT CONSTmodellbank,INT VARreturncode):INT VARneuesmodell;returncode:=1;BOOL VARmodellabgelegt:=FALSE;IF NOTmodellbankvolldglTHENmb.anzahldglmodelleINCR1;neuesmodell:=mb.anzahldglmodelle;nilmodell(mb.modelle(neuesmodell));bildedsnamenneu(mb.modelle(neuesmodell),modellbank,neuesmodell);loescheleereds;initgleichungsds;disablestop;modellerfassung(neuesmodell,modellbank,modellabgelegt);IFiserrorTHENclearerror;enablestop;loesche(neuesmodell,modellbank);errorstop(errormessage);ELIFlength(compress(mb.modelle(neuesmodell).name.lang))=0THENloesche(neuesmodell,modellbank);ELSE IFmodellabgelegtTHENreturncode:=0;FI;enablestop;FI FI.loescheleereds:forget(mb.modelle(neuesmodell).codeundinfo,quiet);forget(mb.modelle(neuesmodell).demolauf.original.kurve,quiet);forget(mb.modelle(neuesmodell).demolauf.vergleich.kurve,quiet);.initgleichungsds:textdaten:=new(mb.modelle( +neuesmodell).codeundinfo);type(old(mb.modelle(neuesmodell).codeundinfo),typnrmodell);textdaten.info(1):=endezeichen;textdaten.gleichungen(1):=endezeichen;textdaten.cogleichungen(1):=endezeichen;textdaten.darstellungscode(1):=endezeichen;.END PROCfuegeein;PROCcopy(INT CONSTaltesmodell,TEXT CONSTmodellbank):INT VARreturncode;copy(altesmodell,modellbank,returncode);END PROCcopy;PROCcopy(INT CONSTaltesmodell,TEXT CONSTmodellbank,INT VARreturncode):INT VARneuesmodell;returncode:=1;IF NOTmodellbankvolldglTHENmb.anzahldglmodelleINCR1;neuesmodell:=mb.anzahldglmodelle;mb.modelle(neuesmodell):=mb.modelle(altesmodell);bildedsnamenneu(mb.modelle(neuesmodell),modellbank,neuesmodell);IF(mb.modelle(altesmodell).codeundinfo)<>(mb.modelle(neuesmodell).codeundinfo)THENforget(mb.modelle(neuesmodell).codeundinfo,quiet);IFexists(mb.modelle(altesmodell).codeundinfo)THENcopy(mb.modelle(altesmodell).codeundinfo,mb.modelle(neuesmodell).codeundinfo);FI;disablestop;modellerfassung(neuesmodell,modellbank);IFiserrorTHENclearerror;enablestop;loesche(neuesmodell,modellbank);errorstop(errormessage);ELIFlength(compress(mb.modelle(neuesmodell).name.lang))=0CORmb.modelle(neuesmodell).name.lang=mb.modelle(altesmodell).name.langTHENloesche(neuesmodell,modellbank);ELSEreturncode:=0;FI;enablestop;FI;FI;END PROCcopy;THESAURUS PROCwdmodelle:mb.wdmodelleEND PROCwdmodelle;THESAURUS PROCwddsnamen:mb.wddsnamenEND PROCwddsnamen;INT PROCanzahlwdmodelle:INT VARi:=0,anzahl:=0;TEXT VARwdname:="";WHILEi""THENanzahlINCR1FI PER;anzahlEND PROCanzahlwdmodelle;INT PROCanzahlausfuehrbarerwdmodelle:INT VARi:=0,anzahl:=0;TEXT VARwdname:="";WHILEi""CANDausfuehrbarTHENanzahlINCR1FI PER;anzahl.ausfuehrbar:type(old(wdname))=typnrwdausfuehrbar.END PROCanzahlausfuehrbarerwdmodelle;DATASPACE VARfeldds,glzeileds,eingabeparameternameds;BOUND ROW100TEXT VARfeld;BOUND ROWmaxzeileneingabeZEILE VARglzeile;BOUND ROWmaxzeileneingabeTEXT VAReingabeparametername;TEXTDATEN VARgleichungsraum;TAG VARzweiteseite;INT VARzeilenzaehler,cursorfeld,pmerker,zmerker,anzahlparameter,gleichungsanzahl,egleichungsanzahl,dgleichungsanzahl;TEXT VARfehlertext,fehlermeldung,taste;INT CONSTseite1:=18,seite2:=2,infowahllang:=3,steuerzseite2:=4,steuerzseite3:=5,infoseite:=6,teilfeld:=7,infowahlkurz:=8;PROCmodellerfassung(INT VARmodellnr,TEXT CONSTmodellbank):enablestop;BOOL VARmodellabgelegt:=FALSE;modellerfassung(modellnr,modellbank,modellabgelegt);END PROCmodellerfassung;PROCmodellerfassung(INT VARmodellnr,TEXT CONSTmodellbank,BOOL VARmodellabgelegt):enablestop;MODELLDGL VARvorabmodell:=mb.modelle(modellnr);ZEILE VARzeilenmerker;INT VARfeldart,altefeldart;TEXT VARfeldmerker,modellcodeinfo,infotext,infos,lang:="",kurz:="",meldungsmerker;BOOL VARfalscheeingaben:=FALSE,tastenfehleralsletztes:=FALSE,explizitgespeichertaufseitezwei:=FALSE,explizitgespeichert:=FALSE;modellabgelegt:=FALSE;forget(feldds);feldds:=nilspace;feld:=feldds;fehlertext:="";initialisierungenfuermodelldatenerfassung;allefelderfreigeben;REPkernvonmodellerfassungPER.kernvonmodellerfassung:maskezurmodellinitialisierungausgeben(vorabmodell.name.lang,vorabmodell.name.kurz);REPexplizitgespeichert:=FALSE;putgetformular1(feld,cursorfeld,taste);IFtaste=abbruchtastemenuTHEN IFabspeicherngewuenschtTHENeingabendeserstenformularspruefen(lang,kurz,modellnr,falscheeingaben);IF NOTfalscheeingabenTHENvorabmodell.name.lang:=lang;vorabmodell.name.kurz:=kurz;vorabmodell.name.elan:=elan(kurz);speichereaufseiteeins;leavemodellerfassungFI;ELSEleavemodellerfassungFI ELIFtaste=auskunftstasteTHENinfotext:=auskunftseite1;fehlermeldung:="";auskunftsdienst(infotext,fehlermeldung,auskunftsloeschtaste1);show(formular(seite1));cursorfeld:=2;feld(1):=leeresfeld;footnote(steuerleiste(stmenuoderweiter));ELIFtaste=weitertasteTHENeingabendeserstenformularspruefen(lang,kurz,modellnr,falscheeingaben);IF NOTfalscheeingabenTHENvorabmodell.name.lang:=lang; +vorabmodell.name.kurz:=kurz;vorabmodell.name.elan:=elan(kurz);modelldatenerfassungFI ELSEfeld(1):=meldungstext(fehlertaste)FI;PER.speichereaufseiteeins:mb.modelle(modellnr):=vorabmodell;modellabgelegt:=TRUE;.leavemodellerfassung:forget(feldds);forget(glzeileds);forget(eingabeparameternameds);LEAVEmodellerfassung.modelldatenerfassung:REPkernvonmodelldatenerfassungPER.initialisierungenfuermodelldatenerfassung:forget(glzeileds);forget(eingabeparameternameds);glzeileds:=nilspace;eingabeparameternameds:=nilspace;glzeile:=glzeileds;eingabeparametername:=eingabeparameternameds;zweiteseite:=formular(seite2);bildedsnamenneu(vorabmodell,modellbank,modellnr);modellcodeinfo:=vorabmodell.codeundinfo;zwischenspeichermitmodelldatenfuellen(vorabmodell);.kernvonmodelldatenerfassung:maskezurmodelldatenerfassungausgeben(infos);meldungsmerker:=meldungstext(mldcursorbenutzung);tastenfehleralsletztes:=FALSE;explizitgespeichertaufseitezwei:=FALSE;REPexplizitgespeichert:=FALSE;vorabmodell.modellzustand:=notuebersetzbar;put(formular(teilfeld),infos,2);IFtastenfehleralsletztesTHENtastenfehleralsletztes:=FALSE;ELSEfeld(1):=meldungsmerker;FI;putget(zweiteseite,feld,cursorfeld,taste);feld(1):=meldungstext(mldcursorbenutzung);IFtaste=abbruchtasteTHEN IFabspeicherngewuenschtTHENspeichereaufseitezweiFI;leavemodellerfassungELIFtaste=blaettertasteTHENnaechsteseitezeigen;ELIFtaste=dupliziertasteTHENzeilebzwfeldkopierenELIFtaste=loeschtasteTHENzeilebzwfeldmerkenundloeschenELIFtaste=wiedergabetasteTHENspeicherinhaltaufaktuellepositionuebertragenELIFtaste=auskunftstasteTHENinfotextauswahl(fehlertext,fehlermeldung);show(zweiteseite);show(formular(teilfeld));show(formular(steuerzseite2));cursorfeld:=2;infos:=auskunftstext(code(auskeingabebeispiel))ELIFtaste=speichertasteTHENfeld(1):=anwendungstext(btwartenwaehrendspeichern);put(zweiteseite,feld(1),1);speichereaufseitezwei;explizitgespeichertaufseitezwei:=TRUE;ELIFtaste=drucktasteTHENfeld(1):=anwendungstext(btwartenwaehrenddrucken);put(zweiteseite,feld(1),1);druckeinfotextaufseitezwei;ELIFtaste=prueftasteTHENfeld(1):=auskunftstext(auskpruefung);put(zweiteseite,feld(1),1);eingabenzwischenspeichern;eingabendeszweitenformularsordnen;eingabendeszweitenformularspruefen(falscheeingaben);IF NOTfalscheeingabenTHENinfos:=auskunftstext(code(auskdatenkorrekt));weiterebearbeitungdesmodellsELIFfehlertext=""THENinfos:=auskunftstext(code(auskkeinegleichungen));ELSEinfos:=auskunftstext(code(auskfehlerfestgestellt))FI;meldungsmerker:=feld(1);ELSEfeld(1):=meldungstext(fehlertaste);tastenfehleralsletztes:=TRUE;FI PER.speichereaufseitezwei:eingabenzwischenspeichern;eingabendeszweitenformularsordnen;gleichungenundparameterzaehlen(falscheeingaben);forget(vorabmodell.codeundinfo,quiet);bildedsnamenneu(vorabmodell,modellbank,modellnr);modellmitdatenfuellen(vorabmodell);infotextablegen(vorabmodell);mb.modelle(modellnr):=vorabmodell;modellabgelegt:=TRUE.druckeinfotextaufseitezwei:eingabenzwischenspeichern;eingabendeszweitenformularsordnen;gleichungenundparameterzaehlen(falscheeingaben);forget(vorabmodell.codeundinfo,quiet);bildedsnamenneu(vorabmodell,modellbank,modellnr);modellmitdatenfuellen(vorabmodell);infodateiausdrucken(vorabmodell,modellbank);.naechsteseitezeigen:cursorfeld:=2;IFzeilenzaehler=endeseite1THENzwischenspeichern(beginnseite1,endeseite1);formularfuellen(beginnseite2,endeseite2);ELSEzwischenspeichern(beginnseite2,endeseite2);formularfuellen(beginnseite1,endeseite1)FI.zeilebzwfeldkopieren:altefeldart:=cursorfeldMOD4;IFaltefeldart=2THENzeilenmerkerfuellenELSEfeldmerker:=feld(cursorfeld)FI.zeilenmerkerfuellen:zeilenmerker.gleichungsart:=feld(cursorfeld);zeilenmerker.gleichung:=feld(cursorfeld+1);zeilenmerker.variable:=feld(cursorfeld+2).zeilebzwfeldmerkenundloeschen:altefeldart:=cursorfeldMOD4;IFaltefeldart=2THENzeilenmerkerfuellen;feld(cursorfeld):="_";feld(cursorfeld+1):=gleichungsunterstriche;feld(cursorfeld+2):=variablenunterstriche;ELSEfeldmerker:=feld(cursorfeld);IFaltefeldart=3THENfeld(cursorfeld):=gleichungsunterstriche +ELIFaltefeldart=0THENfeld(cursorfeld):=variablenunterstricheELSEfeld(cursorfeld):=parameterunterstricheFI FI.speicherinhaltaufaktuellepositionuebertragen:feldart:=cursorfeldMOD4;IFaltefeldart=feldartTHEN IFfeldart=2THENfeld(cursorfeld):=zeilenmerker.gleichungsart;feld(cursorfeld+1):=zeilenmerker.gleichung;feld(cursorfeld+2):=zeilenmerker.variableELSEfeld(cursorfeld):=feldmerkerFI ELSEfeld(1):=meldungstext(fehlerkopierposition);tastenfehleralsletztes:=TRUE;FI.eingabenzwischenspeichern:IFzeilenzaehler=endeseite1THENzwischenspeichern(beginnseite1,endeseite1)ELSEzwischenspeichern(beginnseite2,endeseite2)FI.weiterebearbeitungdesmodells:REPkernvonweiterebearbeitungdesmodellsPER.kernvonweiterebearbeitungdesmodells:put(zweiteseite,feld);vorabmodell.modellzustand:=uebersetzbar;put(formular(teilfeld),infos,2);show(formular(steuerzseite3));REPfeld(1):=leeresfeld;cursor(77,23);warteaufesc;tasteeinlesen(taste);IFtaste=zuruecktasteTHENallefelderfreigeben;cursorfeld:=2;show(formular(steuerzseite2));infos:=auskunftstext(code(auskeingabebeispiel));feld(1):=meldungstext(mldcursorbenutzung);leaveweiterebearbeitungdesmodellsELIFtaste=speichertasteTHENspeichereaufseitedrei;feld(1):=auskunftstext(auskgespeichert);put(zweiteseite,feld(1),1);explizitgespeichert:=TRUE;ELIFtaste=abbruchtasteTHEN IF NOTexplizitgespeichertCANDabspeicherngewuenschtTHENspeichereaufseitedreiFI;leavemodellerfassungELIFtaste=simulationstasteTHENfuehreggfdiesimulationaus;ELIFtaste=drucktasteTHENinfodateiausdrucken(vorabmodell,modellbank);put(zweiteseite,feld(1),1)ELSEfeld(1):=meldungstext(fehlertaste);put(zweiteseite,feld(1),1)FI PER.speichereaufseitedrei:vorabmodell.codeundinfo:=modellcodeinfo;forget(vorabmodell.codeundinfo,quiet);modellmitdatenfuellen(vorabmodell);infotextablegen(vorabmodell);mb.modelle(modellnr):=vorabmodell;modellabgelegt:=TRUE;.leaveweiterebearbeitungdesmodells:LEAVEweiterebearbeitungdesmodells.reenterweiterebearbeitungdesmodells:show(zweiteseite);LEAVEkernvonweiterebearbeitungdesmodells.fuehreggfdiesimulationaus:feld(1):=anwendungstext(btwartenallgemein);put(zweiteseite,feld(1),1);simulieremitdglmodell;IFokTHENfeld(1):="";put(zweiteseite,feld(1),1);reenterweiterebearbeitungdesmodellsELSEfeld(1):=anwendungstext(btsimulationunmoeglich);put(zweiteseite,feld(1),1)FI.ok:retcode=0.simulieremitdglmodell:DATASPACE VARdsp;BOUND INT VARkanalnummer;BOUND MODELLDGL VARaktmodell;INT VARretcode:=0;vorabmodell.codeundinfo:=modellbank+sp+"X"+sp+"hilfscode";forget(vorabmodell.codeundinfo,quiet);modellmitdatenfuellen(vorabmodell);vorabmodell.modellzustand:=uebersetzbar;infotextablegen(vorabmodell);kopplean(vorabmodell);REPmodellbearbeiten;UNTILordnungsgemaessbeendetodertasknichtempfangsbereitPER;forget(vorabmodell.codeundinfo,quiet);enablestop;.ordnungsgemaessbeendetodertasknichtempfangsbereit:retcode<>simulationneustarten.modellbearbeiten:IFretcode=simulationneustartenTHENshow(zweiteseite);feld(1):=anwendungstext(btwartenallgemein);put(zweiteseite,feld(1),1);FI;retcode:=0;schickemodelldaten;IFokTHENschickegleichungen;IFokTHENstartesimulationFI FI;continue(geraetekanal);.schickemodelldaten:dsp:=nilspace;aktmodell:=dsp;aktmodell:=vorabmodell;schickeanmanagertask(dsp,2,retcode);.schickegleichungen:IFexists(modelldatenraum)THENdsp:=old(modelldatenraum);schickeanmanagertask(dsp,5,retcode);ELSEretcode:=99;FI.startesimulation:break(quiet);dsp:=nilspace;schickeanmanagertask(dsp,6,retcode);.abspeicherngewuenscht:IFvorabmodell.modellzustand=notuebersetzbarTHEN IFexplizitgespeichertaufseitezweiTHENput(formular(seite2),meldungstext(fragenochmalspeichern),1);cursor(51,21);ELSEput(formular(seite2),meldungstext(mldnichtablauffaehig),1);cursor(63,21);FI;yes(" ")ELSEput(formular(seite2),"",1);cursor(spalte3,20);yes(compress(meldungstext(fragehierabspeichern)))FI.ENDPROCmodellerfassung;PROCschickeanmanagertask(DATASPACE VARdatenraum,INT CONSTverarbeitung,INT VARmesscode):INT CONSTeingabevomkanal:=-4;TASK VARmanagertask:=/terminaltaskname,kontrolltask:=/terminaltaskname;REPmanagertask:= +kontrolltask;send(managertask,verarbeitung,datenraum,messcode);forget(datenraum);IFmesscode<>existiertnichtCANDmesscode<>nichtempfangsbereitTHENwarteaufquittungELSE LEAVEschickeanmanagertaskFI PER.warteaufquittung:managertask:=/terminaltaskname;wait(datenraum,messcode,managertask);forget(datenraum);IFquerschlaegersendungTHEN IFcontinueversuchTHEN LEAVEschickeanmanagertask;ELSE IFmesscode=eingabevomkanalTHEN REP UNTILincharety=""PER;forget(datenraum);FI;FI ELSE LEAVEschickeanmanagertask;FI.querschlaegersendung:NOT(managertask=kontrolltask).continueversuch:managertask=supervisorAND((task(messcodeMOD100)=niltask)OR(task(messcodeMOD100)=myself))END PROCschickeanmanagertask;PROCzwischenspeichermitmodelldatenfuellen(MODELLDGL VARzwmodell):INT VARi;IFexists(zwmodell.codeundinfo)THENgleichungsraum:=old(zwmodell.codeundinfo);FORiFROM1UPTOzwmodell.variablen.anzahlREPglzeile(i).gleichungsart:="d";glzeile(i).variable:=zwmodell.variablen.namelang(i);glzeile(i).gleichung:=gleichungsraum.gleichungen(i)PER;FORiFROMzwmodell.variablen.anzahl+1UPTOzwmodell.variablen.anzahl+zwmodell.covariablen.anzahlREPglzeile(i).gleichungsart:="e";glzeile(i).variable:=zwmodell.covariablen.namelang(i-zwmodell.variablen.anzahl);glzeile(i).gleichung:=gleichungsraum.cogleichungen(i-zwmodell.variablen.anzahl)PER;FORiFROMzwmodell.variablen.anzahl+zwmodell.covariablen.anzahl+1UPTOmaxzeileneingabeREPglzeile(i).gleichungsart:="_";glzeile(i).gleichung:="";glzeile(i).variable:=""PER;FORiFROM1UPTOzwmodell.parameter.anzahlREPeingabeparametername(i):=zwmodell.parameter.namelang(i)PER;FORiFROMzwmodell.parameter.anzahl+1UPTOmaxzeileneingabeREPeingabeparametername(i):=""PER ELSE FORiFROM1UPTOmaxzeileneingabeREPglzeile(i).gleichungsart:="_";glzeile(i).variable:="";glzeile(i).gleichung:="";eingabeparametername(i):=""PER FI.END PROCzwischenspeichermitmodelldatenfuellen;PROCallefelderfreigeben:INT VARfeldzaehler;FORfeldzaehlerFROM2UPTO4*bildschirmzeilenREPprotect(zweiteseite,feldzaehler,FALSE)PER.END PROCallefelderfreigeben;PROCmaskezurmodellinitialisierungausgeben(TEXT CONSTlang,kurz):show(formular(seite1));footnote(steuerleiste(stmenuoderweiter));cursorfeld:=2;feld(1):=leeresfeld;feld(2):=lang+(maxmodellnamelang-length(lang))*"_";feld(3):=kurz+(maxmodellnamekurz-length(kurz))*"_";feld(4):="";feld(5):="";.END PROCmaskezurmodellinitialisierungausgeben;PROCeingabendeserstenformularspruefen(TEXT VARlang,kurz,INT CONSTmodellinbearbeitung,BOOL VARfalscheeingaben):INT VARi;ROW5TEXT VARhilfsfeld;feld(1):=leeresfeld;put(formular(seite1),feld(1),1);langnamenpruefen;aufnamensgleichheitpruefen;kurznamenpruefen;eingabenablegen;falscheeingaben:=FALSE.verlasseeingabendeserstenformularspruefen:falscheeingaben:=TRUE;LEAVEeingabendeserstenformularspruefen.langnamenpruefen:hilfsfeld(2):=feld(2);hilfsfeld(2):=komprimiere(hilfsfeld(2));IFlength(hilfsfeld(2))=0THENfeld(1):=meldungstext(fehlerlangnamefehlt);cursorfeld:=2;verlasseeingabendeserstenformularspruefenELIFlength(hilfsfeld(2))>maxmodellnamelangTHENfeld(1):=meldungstext(fehlerlangname);cursorfeld:=2;verlasseeingabendeserstenformularspruefenFI.kurznamenpruefen:hilfsfeld(3):=feld(3);hilfsfeld(3):=komprimiere(hilfsfeld(3));IFlength(hilfsfeld(3))=0THENfeld(1):=meldungstext(fehlerkurznamefehlt);cursorfeld:=3;verlasseeingabendeserstenformularspruefenELIFlength(hilfsfeld(3))>maxmodellnamekurzTHENfeld(1):=meldungstext(fehlerkurzname);cursorfeld:=3;verlasseeingabendeserstenformularspruefenFI.aufnamensgleichheitpruefen:FORiFROM1UPTOmb.anzahldglmodelleREP IFi<>modellinbearbeitungCANDhilfsfeld(2)=mb.modelle(i).name.langTHENfeld(1):=meldungstext(fehlermodellnamedoppelt);cursorfeld:=2;verlasseeingabendeserstenformularspruefenFI;PER;.eingabenablegen:lang:=hilfsfeld(2);kurz:=hilfsfeld(3).END PROCeingabendeserstenformularspruefen;PROCmaskezurmodelldatenerfassungausgeben(TEXT VARinformation):show(zweiteseite);show(formular(steuerzseite2));cursorfeld:=2;formularfuellen(beginnseite1,endeseite1);information:=auskunftstext(code(auskeingabebeispiel)).END PROC +maskezurmodelldatenerfassungausgeben;PROCformularfuellen(INT CONSTseitenbeginn,seitenende):INT VARfeldzaehler;feldzaehlerauferstesfeldsetzen;FORzeilenzaehlerFROMseitenbeginnUPTOseitenendeREPformularzeilefuellenPER;zeilenzaehler:=seitenende.feldzaehlerauferstesfeldsetzen:feldzaehler:=ersteseingabefeld.formularzeilefuellen:feld(feldzaehler):="_";replace(feld(feldzaehler),1,glzeile(zeilenzaehler).gleichungsart);feldzaehlerINCR1;feld(feldzaehler):=gleichungsunterstriche;IFlength(glzeile(zeilenzaehler).gleichung)>length(gleichungsunterstriche)THENfeld(feldzaehler):=glzeile(zeilenzaehler).gleichungELSEreplace(feld(feldzaehler),1,glzeile(zeilenzaehler).gleichung);FI;feldzaehlerINCR1;feld(feldzaehler):=variablenunterstriche;replace(feld(feldzaehler),1,glzeile(zeilenzaehler).variable);feldzaehlerINCR1;feld(feldzaehler):=parameterunterstriche;replace(feld(feldzaehler),1,eingabeparametername(zeilenzaehler));feldzaehlerINCR1.END PROCformularfuellen;PROCzwischenspeichern(INT CONSTseitenbeginn,seitenende):INT VARfeldzaehler;feldzaehlerauferstesfeldsetzen;FORzeilenzaehlerFROMseitenbeginnUPTOseitenendeREPzwischenspeicherfuellenPER;zeilenzaehler:=seitenende.feldzaehlerauferstesfeldsetzen:feldzaehler:=ersteseingabefeld.zwischenspeicherfuellen:glzeile(zeilenzaehler).gleichungsart:=subtext(feld(feldzaehler),1,1);feldzaehlerINCR1;glzeile(zeilenzaehler).gleichung:=feld(feldzaehler);glzeile(zeilenzaehler).gleichung:=komprimiere(glzeile(zeilenzaehler).gleichung);ohneumlauteundeszet(glzeile(zeilenzaehler).gleichung);IFlength(glzeile(zeilenzaehler).gleichung)>0CANDsubtext(glzeile(zeilenzaehler).gleichung,length(glzeile(zeilenzaehler).gleichung))<>";"THENglzeile(zeilenzaehler).gleichungCAT";"FI;feldzaehlerINCR1;glzeile(zeilenzaehler).variable:=feld(feldzaehler);glzeile(zeilenzaehler).variable:=komprimiere(glzeile(zeilenzaehler).variable);ohneumlauteundeszet(glzeile(zeilenzaehler).variable);feldzaehlerINCR1;eingabeparametername(zeilenzaehler):=feld(feldzaehler);eingabeparametername(zeilenzaehler):=komprimiere(eingabeparametername(zeilenzaehler));ohneumlauteundeszet(eingabeparametername(zeilenzaehler));feldzaehlerINCR1;END PROCzwischenspeichern;PROCeingabendeszweitenformularsordnen:INT VARi,zzaehler;FORzzaehlerFROM1UPTOmaxzeileneingabeREPohneumlauteundeszet(glzeile(zzaehler).variable);glzeile(zzaehler).nummer:=zzaehlerPER;zmerkerundpmerkerbestimmen;glzeilenordnen(1,zmerker);parameterordnen;formularfuellen(beginnseite1,endeseite1).zmerkerundpmerkerbestimmen:i:=maxzeileneingabe+1;REPiDECR1;zmerker:=iUNTILi=0CORzeilenichtleerPER;i:=maxzeileneingabe+1;REPiDECR1;pmerker:=iUNTILi=0CORlength(eingabeparametername(i))>0PER.zeilenichtleer:NOT(length(glzeile(i).gleichungsart)=0CANDlength(glzeile(i).gleichung)=0CANDlength(glzeile(i).variable)=0).END PROCeingabendeszweitenformularsordnen;PROCglzeilenordnen(INT CONSTanfang,ende):INT VARpivotadresse,zeigeroben,zeigerunten,adrgroesserpivot,adrkleinerpivot;ZEILE VARpivotzeile;IFanfang=prioritaet(glzeile(adrgroesserpivot))REPadrgroesserpivotINCR1PER.suchevonuntenkleinergleichpivotwennnoetig:IFadrgroesserpivot>zeigeruntenTHENmacheletztenplatzfreiundsetzepivotdahin;zeigeroben:=zeigeruntenELSEsuchevonuntenelementkleinergleichpivotundvertauscheesmitdemgroesserenFI.macheletztenplatzfreiundsetzepivotdahin:glzeile(zeigeroben):=glzeile(zeigerunten);glzeile(zeigerunten):=pivotzeile. +suchevonuntenelementkleinergleichpivotundvertauscheesmitdemgroesseren:adrkleinerpivot:=zeigerunten;WHILEadrkleinerpivot>=adrgroesserpivotCANDprioritaet(glzeile(adrkleinerpivot))>prioritaet(pivotzeile)REPadrkleinerpivotDECR1PER;IFadrkleinerpivot1THENpruefeobsortierbereichveraendert;glzeilenordnen(anfang,zeigeroben);glzeilenordnen(zeigeroben+1,ende)FI.pruefeobsortierbereichveraendert:IFzeigeroben=endeTHENzeigeroben:=zeigeroben-1FI.END PROCglzeilenordnen;INT PROCprioritaet(ZEILE CONSTgleichungszeile):INT VARnummer:=gleichungszeile.nummer;TEXT VARart:=gleichungszeile.gleichungsart;IFart=" "THENchange(art," ","_")FI;IFart="d"THENnummerELIFart="e"THENnummer+maxzeileneingabeELIFart<>"_"THENnummer+(2*maxzeileneingabe)ELIFleeresgleichungsfeldCANDleeresvariablenfeldTHENnummer+(4*maxzeileneingabe)ELSEnummer+(3*maxzeileneingabe)FI.leeresgleichungsfeld:length(gleichungszeile.gleichung)=0.leeresvariablenfeld:length(gleichungszeile.variable)=0.END PROCprioritaet;PROCparameterordnen:ROWmaxzeileneingabeTEXT VARsortierhilfe;INT VARzzaehler,leerzeilenmerker:=0;FORzzaehlerFROM1UPTOpmerkerREPohneumlauteundeszet(eingabeparametername(zzaehler));parametersortierenPER;FORzzaehlerFROM(pmerker-leerzeilenmerker)+1UPTOpmerkerREPsortierhilfe(zzaehler):="";PER;FORzzaehlerFROM1UPTOpmerkerREPeingabeparametername(zzaehler):=sortierhilfe(zzaehler)PER.parametersortieren:IFlength(eingabeparametername(zzaehler))>0THENsortierhilfe(zzaehler-leerzeilenmerker):=eingabeparametername(zzaehler)ELSEleerzeilenmerkerINCR1FI.END PROCparameterordnen;PROCgleichungenundparameterzaehlen(BOOL VARfalscheeingaben):INT VARi:=1;WHILEi<=maxzeileneingabeCANDglzeile(i).gleichungsart="d"REPiINCR1PER;dgleichungsanzahl:=i-1;WHILEi<=maxzeileneingabeCANDglzeile(i).gleichungsart="e"REPiINCR1PER;egleichungsanzahl:=i-dgleichungsanzahl-1;gleichungsanzahl:=i-1;i:=1;WHILEi<=maxzeileneingabeCANDlength(eingabeparametername(i))>0REPiINCR1PER;anzahlparameter:=i-1;IFgleichungsanzahl=0THENfeld(1):=meldungstext(mldcursorbenutzung);fehlertext:="";falscheeingaben:=TRUE FI.END PROCgleichungenundparameterzaehlen;PROCeingabendeszweitenformularspruefen(BOOL VARfalscheeingaben):INT VARzzaehler,i,pruefling,fehlerfeldvariable,feldzaehler;TEXT VARprozeduranfangd,deklarationend,prozedurended,prozeduranfange,deklarationene,prozedurendee,procd,proce,prozedurd,prozedure;BOOL VARdoppeltdeklariert:=FALSE,vorherigefelderleer:=FALSE;falscheeingaben:=FALSE;FORzzaehlerFROM1UPTOmaxzeileneingabeREPgleichungsartpruefen;gleichungpruefen;variablepruefen;parameterpruefenPER;gleichungenundparameterzaehlen(falscheeingaben);IFfalscheeingabenTHENfehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);verlasseeingabendeszweitenformularspruefenFI;variableundparametereinzelnaufuebersetzbarkeitpruefen;doppeltdeklariert:=FALSE;aufdoppeldeklarationenpruefen(doppeltdeklariert);IFdoppeltdeklariertTHEN IFcursorfeld>41THENcursorfeldDECR40;formularfuellen(beginnseite2,endeseite2)FI;fehlertext:=ausklabeldoppelt;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);verlasseeingabendeszweitenformularspruefenFI;gleichungenpruefen;fehlertext:="";fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);feld(1):=leeresfeld;put(zweiteseite,feld(1),1);allefeldersperren.cursorpositionierenundggfformularfuellen:IFzzaehler>endeseite1THENcursorfeld:=(zzaehler-endeseite1)*4+fehlerfeldvariable;formularfuellen(beginnseite2,endeseite2)ELSEcursorfeld:=(zzaehler*4)+fehlerfeldvariable;FI;verlasseeingabendeszweitenformularspruefen. +verlasseeingabendeszweitenformularspruefen:falscheeingaben:=TRUE;LEAVEeingabendeszweitenformularspruefen.gleichungsartpruefen:IFglzeile(zzaehler).gleichungsart=""THENglzeile(zzaehler).gleichungsart:="_"FI;IFpos("de_",glzeile(zzaehler).gleichungsart)=0THENfehlerfeldvariable:=-2;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlergleichungsart);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenELSEvorherigefelderleer:=(glzeile(zzaehler).gleichungsart="_")FI.gleichungpruefen:IFlength(glzeile(zzaehler).gleichung)=0CAND NOTvorherigefelderleerTHENfehlerfeldvariable:=-1;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlergleichungfehlt);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenELIFlength(glzeile(zzaehler).gleichung)>0CANDvorherigefelderleerTHENfehlerfeldvariable:=-2;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlergleichungsartfehlt);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI.variablepruefen:IFvorherigefelderleerTHEN IFlength(glzeile(zzaehler).variable)>0THENfehlerfeldvariable:=0;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlervariable);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI ELIFlength(glzeile(zzaehler).variable)=0THENfehlerfeldvariable:=0;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlervariablefehlt);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenELIFlength(glzeile(zzaehler).variable)>maxvariablenlaengeTHENfehlerfeldvariable:=0;fehlertext:=ausklabelzulang;feld(1):=meldungstext(fehlervariablezulang);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI.parameterpruefen:IFlength(eingabeparametername(zzaehler))>maxparlaengeTHENfehlerfeldvariable:=1;fehlertext:=ausklabelzulang;feld(1):=meldungstext(fehlerparameterzulang);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI.variableundparametereinzelnaufuebersetzbarkeitpruefen:allevariableneinzelnaufuebersetzbarkeitpruefen;alleparametereinzelnaufuebersetzbarkeitpruefen.allevariableneinzelnaufuebersetzbarkeitpruefen:FORiFROM1UPTOgleichungsanzahlREP IFnichtuebersetzbar("REAL VAR"+elan(glzeile(i).variable)+";")THENzzaehler:=i;fehlerfeldvariable:=0;fehlertext:=ausklabelzulang;feld(1):=errormessage;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI PER.alleparametereinzelnaufuebersetzbarkeitpruefen:FORiFROM1UPTOanzahlparameterREP IFnichtuebersetzbar("REAL VAR"+elan(eingabeparametername(i))+";")THENzzaehler:=i;fehlerfeldvariable:=1;fehlertext:=ausklabelzulang;feld(1):=errormessage;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI PER.gleichungenpruefen:IFdgleichungsanzahl>0THENprozeduranfangderzeugen;prozedurendederzeugen;alledgleichungeneinzelnpruefen;alledgleichungenzusammenpruefenFI;IFegleichungsanzahl>0THENprozeduranfangeerzeugen;prozedurendeeerzeugen;alleegleichungeneinzelnpruefen;alleegleichungenzusammenpruefenFI.prozeduranfangderzeugen:prozedurkopfderzeugen;deklarationenderzeugen.prozedurkopfderzeugen:prozeduranfangd:="PROC diff gleichungen:".prozedurendederzeugen:prozedurended:="END PROC diff gleichungen;".deklarationenderzeugen:deklarationend:="REAL CONST";FORiFROM1UPTOdgleichungsanzahlREPdeklarationendCAT(elan(glzeile(i).variable)+":= 0.0,")PER;FORiFROM1UPTOanzahlparameterREPdeklarationendCAT(elan(eingabeparametername(i))+":= 0.0,")PER;deklarationendCAT"zeit:= 0.0;";prozeduranfangdCATdeklarationend.alledgleichungeneinzelnpruefen:FORiFROM1UPTOdgleichungsanzahlREPprocd:="";procdCATprozeduranfangd;procdCAT("REAL VAR d"+elan(glzeile(i).variable)+";");procdCATglzeile(i).gleichung;procdCATprozedurended;IFnichtuebersetzbar(procd)THENzzaehler:=i; +fehlerfeldvariable:=-1;fehlertext:=errorauswertung(errormessage);feld(1):=errormessage;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI PER.alledgleichungenzusammenpruefen:prozedurd:="";prozedurdCATprozeduranfangd;prozedurdCAT("REAL VAR d"+elan(glzeile(1).variable));FORiFROM2UPTOdgleichungsanzahlREPprozedurdCAT(", d"+elan(glzeile(i).variable))PER;prozedurdCAT";";FORiFROM1UPTOdgleichungsanzahlREPprozedurdCATglzeile(i).gleichungPER;prozedurdCATprozedurended;IFlength(compress(prozedurd))<=maxinterpretlaengeCANDnichtuebersetzbar(prozedurd)THENfeld(1):=errormessage;fehlertext:=errorauswertung(errormessage);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorfeld:=ersteseingabefeld;verlasseeingabendeszweitenformularspruefenFI.prozeduranfangeerzeugen:prozedurkopfeerzeugen;deklarationeneerzeugen.prozedurkopfeerzeugen:prozeduranfange:="PROC ergaenzungsgleichungen:".prozedurendeeerzeugen:prozedurendee:="END PROC ergaenzungsgleichungen;".deklarationeneerzeugen:deklarationene:="REAL CONST";FORiFROM1UPTOdgleichungsanzahlREPdeklarationeneCAT(elan(glzeile(i).variable)+":= 0.0,")PER;FORiFROM1UPTOanzahlparameterREPdeklarationeneCAT(elan(eingabeparametername(i))+":= 0.0,")PER;deklarationeneCAT("zeit:= 0.0;");prozeduranfangeCATdeklarationene.alleegleichungeneinzelnpruefen:FORprueflingFROMdgleichungsanzahl+1UPTOgleichungsanzahlREPproce:="";proceCATprozeduranfange;objektealskonstanten;proceCATglzeile(pruefling).gleichung;proceCATprozedurendee;IFnichtuebersetzbar(proce)THENzzaehler:=pruefling;fehlerfeldvariable:=-1;fehlertext:=errorauswertung(errormessage);feld(1):=errormessage;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI PER.objektealskonstanten:proceCAT"REAL VAR"+elan(glzeile(pruefling).variable)+";";IFegleichungsanzahl>1THENproceCAT"REAL CONST";IFpruefling=dgleichungsanzahl+1THENi:=dgleichungsanzahl+2;ELSEi:=dgleichungsanzahl+1;FI;proceCAT(elan(glzeile(i).variable))+":= 0.0";iINCR1;WHILEi<=gleichungsanzahlREP IFi<>prueflingTHENproceCAT(","+elan(glzeile(i).variable))+":= 0.0"FI;iINCR1;PER;proceCAT";";FI;.alleegleichungenzusammenpruefen:prozedure:="";prozedureCATprozeduranfange;objektealsvariablen;FORiFROMdgleichungsanzahl+1UPTOgleichungsanzahlREPprozedureCATglzeile(i).gleichungPER;prozedureCATprozedurendee;IFlength(compress(prozedure))<=maxinterpretlaengeCANDnichtuebersetzbar(prozedure)THENfeld(1):=errormessage;fehlertext:=errorauswertung(errormessage);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorfeld:=ersteseingabefeld;verlasseeingabendeszweitenformularspruefenFI.objektealsvariablen:prozedureCAT"REAL VAR";prozedureCAT(elan(glzeile(dgleichungsanzahl+1).variable));FORiFROMdgleichungsanzahl+2UPTOgleichungsanzahlREPprozedureCAT(","+elan(glzeile(i).variable))PER;prozedureCAT";";.allefeldersperren:FORfeldzaehlerFROM2UPTO4*bildschirmzeilenREPprotect(zweiteseite,feldzaehler,TRUE)PER.END PROCeingabendeszweitenformularspruefen;PROCaufdoppeldeklarationenpruefen(BOOL VARdoppeltdeklariert):ROWmaxvarparaanzahlTEXT VARpruefung;INT VARzaehler,counter:=1,sortierende:=gleichungsanzahl+dgleichungsanzahl+anzahlparameter+1;zupruefenderowmitwertenfuellen;pruefung(sortierende):="00"+"z"+"zeit";quicksort(pruefung,1,sortierende);zaehler:=1;WHILEzaehler0THENauskcompilunbekkommELIFpos(message,undefdyadischop)<>0CORpos(message,undefmonadop)<>0CORpos(message,paramsindfalsch)<>0THENauskcompilparameterELIFpos(message,nurletzteanweisg)<>0CORpos(message,anstelledessymb)<>0CORpos(message,unzulselektsymb)<>0CORpos(message,konstdarfnicht)<>0THENauskcompilsymboleELIFpos(message,klammerauffehlt)<>0CORpos(message,klammerzufehlt)<>0CORpos(message,operatorfehlt)<>0CORpos(message,ungueltigzwischen)<>0THENauskcompilungueltzwELIFpos(message,istmehrfachdekl)<>0THENauskcompilmehrfdeklELSEauskcompilsonstigesFI.END PROCerrorauswertung;PROCquicksort(ROWmaxvarparaanzahlTEXT VARpruefung,INT CONSTanfang,ende):INT VARpivotadresse,zeigeroben,zeigerunten,adrgroesserpivot,adrkleinerpivot;TEXT VARpivot;IFanfang=name(pruefung(adrgroesserpivot))REPadrgroesserpivotINCR1PER.suchevonuntenkleinergleichpivotwennnoetig:IFadrgroesserpivot>zeigeruntenTHENmacheletztenplatzfreiundsetzepivotdahin;zeigeroben:=zeigeruntenELSEsuchevonuntenelementkleinergleichpivotundvertauscheesmitdemgroesserenFI.macheletztenplatzfreiundsetzepivotdahin:pruefung(zeigeroben):=pruefung(zeigerunten);pruefung(zeigerunten):=pivot.suchevonuntenelementkleinergleichpivotundvertauscheesmitdemgroesseren:adrkleinerpivot:=zeigerunten;WHILEadrkleinerpivot>=adrgroesserpivotCANDname(pruefung(adrkleinerpivot))>name(pivot)REP +adrkleinerpivotDECR1PER;IFadrkleinerpivot1THENpruefeobsortierbereichveraendert;quicksort(pruefung,anfang,zeigeroben);quicksort(pruefung,zeigeroben+1,ende)FI.pruefeobsortierbereichveraendert:IFzeigeroben=endeTHENzeigeroben:=zeigeroben-1FI.END PROCquicksort;PROCmodellmitdatenfuellen(MODELLDGL VARzwmodell):INT VARvz,i;ZUSTAND VARz1:=neuerzustand(dgleichungsanzahl),z2:=z1;PARAMETER VARp1:=neuerparameter(anzahlparameter),p2:=p1;FORvzFROM1UPTOdgleichungsanzahlREPreplace(z1,vz,0.0)PER;zwmodell.demolauf.original.startwert:=text(z1);zwmodell.demolauf.vergleich.startwert:=text(z1);FORvzFROM1UPTOdgleichungsanzahlREPreplace(z1,vz,-1.0e+126);replace(z2,vz,1.0e+126)PER;zwmodell.variablen.unteregrenze:=text(z1);zwmodell.variablen.oberegrenze:=text(z2);z1:=neuerzustand(gleichungsanzahl);z2:=z1;FORvzFROM1UPTOgleichungsanzahlREPreplace(z1,vz,-1.0e+126);replace(z2,vz,1.0e+126)PER;zwmodell.variablen.randoben:=text(z2);zwmodell.variablen.randunten:=text(z1);FORvzFROM1UPTOanzahlparameterREPreplace(p1,vz,0.0)PER;zwmodell.demolauf.original.parameter:=text(p1);zwmodell.demolauf.vergleich.parameter:=text(p1);FORvzFROM1UPTOanzahlparameterREPreplace(p1,vz,-1.0e+126);replace(p2,vz,1.0e+126)PER;zwmodell.parameter.unteregrenze:=text(p1);zwmodell.parameter.oberegrenze:=text(p2);zwmodell.demolauf.original.anfangszeitpunkt:=0.0;zwmodell.demolauf.original.beobachtungsdauer:=0.0;zwmodell.demolauf.vergleich.anfangszeitpunkt:=0.0;zwmodell.demolauf.vergleich.beobachtungsdauer:=0.0;zwmodell.beschraenkung.minbeobachtungsdauer:=0.0;zwmodell.beschraenkung.maxbeobachtungsdauer:=1.0e+126;zwmodell.beschraenkung.minanfangszeitpunkt:=-1.0e+126;zwmodell.beschraenkung.maxanfangszeitpunkt:=1.0e+126;zwmodell.beschraenkung.anzahlbeobachtungspunkte:=21;forget(zwmodell.codeundinfo,quiet);gleichungsraum:=new(zwmodell.codeundinfo);FORiFROM1UPTOdgleichungsanzahlREPzwmodell.variablen.namelang(i):=glzeile(i).variable;zwmodell.variablen.namekurz(i):=glzeile(i).variable;gleichungsraum.gleichungen(i):=glzeile(i).gleichungPER;gleichungsraum.gleichungen(dgleichungsanzahl+1):=endezeichen;FORiFROMdgleichungsanzahl+1UPTOgleichungsanzahlREPzwmodell.covariablen.namelang(i-dgleichungsanzahl):=glzeile(i).variable;zwmodell.covariablen.namekurz(i-dgleichungsanzahl):=glzeile(i).variable;gleichungsraum.cogleichungen(i-dgleichungsanzahl):=glzeile(i).gleichungPER;gleichungsraum.cogleichungen(egleichungsanzahl+1):=endezeichen;FORiFROM1UPTOanzahlparameterREPzwmodell.parameter.namelang(i):=eingabeparametername(i);zwmodell.parameter.nameelan(i):=elan(eingabeparametername(i))PER;zwmodell.variablen.anzahl:=dgleichungsanzahl;zwmodell.covariablen.anzahl:=egleichungsanzahl;zwmodell.parameter.anzahl:=anzahlparameter;zwmodell.mitphasendiagramm:=TRUE;zwmodell.geschuetzt:=FALSE;.END PROCmodellmitdatenfuellen;PROCmodellmitdatenfuellen(MODELLDGL VARzwmodell,THESAURUS CONSTvnamenlang,vnamenkurz,enamenlang,enamenkurz,pnamen):INT VARvz,i;ZUSTAND VARz1:=neuerzustand(dgleichungsanzahl),z2:=z1;PARAMETER VARp1:=neuerparameter(anzahlparameter),p2:=p1;zwmodell.name.lang:=aktuellermodellname;zwmodell.name.kurz:=aktuellermodellkurzname;zwmodell.name.elan:=elan(aktuellermodellkurzname);FORvzFROM1UPTOdgleichungsanzahlREPreplace(z1,vz,0.0)PER;zwmodell.demolauf.original.startwert:=text(z1);zwmodell.demolauf.vergleich.startwert:=text(z1);FORvzFROM1UPTOdgleichungsanzahlREPreplace(z1,vz,-1.0e+126);replace(z2,vz,1.0e+126)PER;zwmodell.variablen.unteregrenze:=text(z1);zwmodell.variablen.oberegrenze:=text(z2);z1:=neuerzustand( +gleichungsanzahl);z2:=z1;FORvzFROM1UPTOgleichungsanzahlREPreplace(z1,vz,-1.0e+126);replace(z2,vz,1.0e+126)PER;zwmodell.variablen.randoben:=text(z2);zwmodell.variablen.randunten:=text(z1);FORvzFROM1UPTOanzahlparameterREPreplace(p1,vz,0.0)PER;zwmodell.demolauf.original.parameter:=text(p1);zwmodell.demolauf.vergleich.parameter:=text(p1);FORvzFROM1UPTOanzahlparameterREPreplace(p1,vz,-1.0e+126);replace(p2,vz,1.0e+126)PER;zwmodell.parameter.unteregrenze:=text(p1);zwmodell.parameter.oberegrenze:=text(p2);zwmodell.demolauf.original.anfangszeitpunkt:=0.0;zwmodell.demolauf.original.beobachtungsdauer:=0.0;zwmodell.demolauf.vergleich.anfangszeitpunkt:=0.0;zwmodell.demolauf.vergleich.beobachtungsdauer:=0.0;zwmodell.beschraenkung.minbeobachtungsdauer:=0.0;zwmodell.beschraenkung.maxbeobachtungsdauer:=1.0e+126;zwmodell.beschraenkung.minanfangszeitpunkt:=-1.0e+126;zwmodell.beschraenkung.maxanfangszeitpunkt:=1.0e+126;zwmodell.beschraenkung.anzahlbeobachtungspunkte:=21;zwmodell.variablen.namelang:=vnamenlang;zwmodell.variablen.namekurz:=vnamenkurz;zwmodell.covariablen.namelang:=enamenlang;zwmodell.covariablen.namekurz:=enamenkurz;zwmodell.parameter.namelang:=pnamen;FORiFROM1UPTOanzahlparameterREPzwmodell.parameter.nameelan(i):=""PER;zwmodell.variablen.anzahl:=dgleichungsanzahl;zwmodell.covariablen.anzahl:=egleichungsanzahl;zwmodell.parameter.anzahl:=anzahlparameter;zwmodell.mitphasendiagramm:=TRUE;zwmodell.geschuetzt:=FALSE;zwmodell.modellzustand:=uebersetzbar;zwmodell.codeundinfo:="";.dgleichungsanzahl:highestentry(vnamenlang).egleichungsanzahl:highestentry(enamenlang).anzahlparameter:highestentry(pnamen).gleichungsanzahl:egleichungsanzahl+dgleichungsanzahl.END PROCmodellmitdatenfuellen;OP:=(ROWmaxdimensionTEXT VARrow,THESAURUS CONSTthes):TEXT VARname;INT VARi:=0;WHILEilength(infotext)THENseitenzahl:=1FI;reenterauskunftsdienst;ELIFtaste=loeschtasteTHENleaveauskunftsdienstELSEput(formular(infoseite),meldungstext(fehlertaste),1);FI PER.maskezumauskunftsdienstausgeben:show(formular(infoseite));seitenzahl:=1;erstesfeld:=fehler.reenterauskunftsdienst:LEAVEkernvonauskunftsdienst.leaveauskunftsdienst:LEAVEauskunftsdienst.infotextundsteuerzeileausgeben:IFlength(infotext)>seitenzahlTHENdrittesfeld:=steuerleiste(17)ELIFlength(infotext)>1THENdrittesfeld:=steuerleiste(16)ELIFloeschtaste=auskunftsloeschtaste2THENdrittesfeld:=steuerleiste(18)ELSEdrittesfeld:=steuerleiste(15)FI;IFinfotext=""THENzweitesfeld:=""ELSEzweitesfeld:=auskunftstext(code(infotextSUBseitenzahl))FI;put(formular(infoseite),zweitesfeld,2);put(formular(infoseite),erstesfeld,1);put(formular(infoseite),drittesfeld,3);erstesfeld:=fehler;.END PROCauskunftsdienst;PROCinfotextauswahl(TEXT CONSTfehlertext,fehler):infotextauswahl(fehlertext,fehler,allgemeineauskunftseite2,auskunftzummodellerfassenseite2)END PROCinfotextauswahl;PROCinfotextauswahl(TEXT CONSTfehlertext,fehler,top1,top2):INT VARformularnr,eingabezeile;TEXT VARerstesfeld,auskunftzufehler,auskunft;BOOL VARfalscheeingaben;IFfehlertext=""THENformularnr:=infowahlkurz;eingabezeile:=15;ELSEformularnr:=infowahllang;eingabezeile:=17;FI;REPkernvoninfotextauswahlPER.kernvoninfotextauswahl:maskezurinfotextauswahlausgeben;REPput(formular(formularnr),erstesfeld,1);falscheeingaben:=FALSE;cursor(60,eingabezeile);tasteeinlesen(taste);IFtaste="1"THENauskunft:=top1;fehlermeldung:=""ELIFtaste="2"THENauskunft:=top2;fehlermeldung:=""ELIFtaste="3"CANDfehlertext<>""THEN TEXT VARtt:=compress(fehlermeldung);changeall(tt," ","");auskunft:=fehlertext;fehlermeldung:=tt;ELIFtaste=auskunftsloeschtaste1THENleaveinfotextauswahlELSEerstesfeld:=meldungstext(fehlertaste +);falscheeingaben:=TRUE FI;IF NOTfalscheeingabenTHEN IFauskunft=""THENerstesfeld:="Hierzu existiert noch keine Auskunft!"ELSEauskunftsdienst(auskunft,fehlermeldung,auskunftsloeschtaste2);reenterinfotextauswahlFI FI PER.maskezurinfotextauswahlausgeben:show(formular(formularnr));erstesfeld:=leeresfeld.reenterinfotextauswahl:LEAVEkernvoninfotextauswahl.leaveinfotextauswahl:LEAVEinfotextauswahl.END PROCinfotextauswahl;PROCwarteaufesc:TEXT VAReingabe;REPeingabe:=incharetyUNTILeingabe=escPER.END PROCwarteaufesc;PROCinfotextablegen(MODELLDGL VARzwmodell):FILE VARinformation;INT VARz;TEXT VARzeile;IF NOTexists(zwmodell.codeundinfo)THENgleichungsraum:=new(zwmodell.codeundinfo);FI;information:=modellinfo(zwmodell,dsname);infotextimdatenraumablegen;forget(dsname,quiet).infotextimdatenraumablegen:input(information);z:=1;WHILE NOTeof(information)REPgetline(information,zeile);IFz>maxinfo-1THENgleichungsraum.info(z):=endezeichen;LEAVEinfotextimdatenraumablegenFI;gleichungsraum.info(z):=zeile;zINCR1PER;gleichungsraum.info(z):=endezeichen.END PROCinfotextablegen;PROCtasteeinlesen(TEXT VAReinlesetaste):REPeinlesetaste:=incharetyUNTILeinlesetaste<>""PER END PROCtasteeinlesen;INT PROClfdnummer(TEXT CONSTtext):int(subtext(text,1,2))END PROClfdnummer;TEXT PROCzweistelligezahl(INT CONSTzahl):IFlength(text(zahl))=1THEN"0"+text(zahl)ELSEtext(zahl)FI END PROCzweistelligezahl;TEXT PROCnameohneblanks(TEXT VARtext):changeall(text," ","");subtext(text,4)END PROCnameohneblanks;TEXT PROCname(TEXT CONSTtext):subtext(text,4)END PROCname;TEXT PROCkomprimiere(TEXT CONSTt):TEXT VARergebnis,z;INT VARi,l;suchevonvorne;suchevonhinten;ersetzekern;ergebnis.suchevonvorne:l:=LENGTHt;FORiFROM1UPTOlREPz:=(tSUBi)UNTIL NOT(z=" "CORz="_")PER;IFi>lTHENergebnis:=""ELSEergebnis:=subtext(t,i,l);FI.suchevonhinten:l:=LENGTHergebnis;FORiFROMlDOWNTO1REPz:=(ergebnisSUBi)UNTIL NOT(z=" "CORz="_")PER;IFi<1THENergebnis:=""ELSEergebnis:=subtext(ergebnis,1,i);FI.ersetzekern:changeall(ergebnis,"_"," ").END PROCkomprimiere;PROCohneumlauteundeszet(TEXT VARtext):changeall(text,"ß","ss");END PROCohneumlauteundeszet;BOOL PROCnichtuebersetzbar(TEXT CONSTtext):BOOL VARergebnis;disablestop;do(text);ergebnis:=iserror;IFiserrorTHENclearerrorFI;enablestop;ergebnisEND PROCnichtuebersetzbar;PROCprotect(TAG VARt,INT CONSTfeld,BOOL CONSTprneu):INT VARdummy;BOOL VARcl,se,sp,le,pr;fieldinfos(t,feld,dummy,cl,pr,se,sp,le);setfieldinfos(t,feld,cl,prneu,se)END PROCprotect;PROCvertauschezeilen(ZEILE VARzeile1,zeile2):ZEILE VARhilfe;hilfe:=zeile1;zeile1:=zeile2;zeile2:=hilfeEND PROCvertauschezeilen;LETtrennzeichen=6,klammerauf="(",semikolon=";",thenwort="THEN",elsewort="ELSE",repwort="REP";FILE PROCmodellinfo(MODELLDGL VARzwmodell,TEXT CONSTdatenraum):forget(datenraum,quiet);FILE VARinfo:=sequentialfile(output,datenraum);INT VARz,typ1,typ2,zeilenanfang,filler;TEXT VARersteszeichen,zweiteszeichen;TEXT VARggfluecke:="";modellnameangeben;putline(info,auskunftstext(auskgleichungen));putline(info,unterstrichfeld);IFdgleichungsanzahl>0THEN FORzFROM1UPTOdgleichungsanzahlREPdgleichungausgeben;PER FI;IFegleichungsanzahl>0THEN FORzFROM1UPTOegleichungsanzahlREPegleichungausgeben;PER FI;line(info);IFanzahlparameter>0THENputline(info,compress(auskunftstext(auskvariablen))+10*" "+compress(auskunftstext(auskparameter)));putline(info,unterstrichfeld);FORzFROM1UPTOmax(anzahlparameter,gleichungsanzahl)REPvariableundparameterausgeben;line(info)PER;ELSEputline(info,compress(auskunftstext(auskvariablen)));putline(info,unterstrichfeld);FORzFROM1UPTOdgleichungsanzahlREPputline(info,zwmodell.variablen.namekurz(z))PER;FORzFROM1UPTOegleichungsanzahlREPputline(info,zwmodell.covariablen.namekurz(z))PER FI;info.modellnameangeben:putline(info,compress(auskunftstext(auskmodell))+" "+zwmodell.name.lang);putline(info,length(unterstrichfeld)*"=");line(info,2).dgleichungausgeben:zeilenanfang:=1;scan(gleichungsraum.gleichungen(z));nextsymbol(ersteszeichen,typ1);dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende;WHILEtyp1<7REP +dasnaechstezeichenschreibenmitruecksichtaufdaszeilenendePER.egleichungausgeben:zeilenanfang:=1;scan(gleichungsraum.cogleichungen(z));nextsymbol(ersteszeichen,typ1);dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende;WHILEtyp1<7REPdasnaechstezeichenschreibenmitruecksichtaufdaszeilenendePER.dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende:IF(zeilenanfang+length(ersteszeichen)+1)>=77THENzeilenanfang:=1;FI;zeilenanfangINCRlength(ersteszeichen);nextsymbol(zweiteszeichen,typ2);SELECTtyp2OF CASEtrennzeichen:IFzweiteszeichen=klammeraufCANDtyp1<>trennzeichenTHENggfluecke:=" "ELSEggfluecke:=""FI;OTHERWISEggfluecke:=" "END SELECT;SELECTtyp1OF CASE1:write(info,ersteszeichen+ggfluecke);CASE2:IFersteszeichen=thenwortCORersteszeichen=elsewortTHENline(info);put(info,ersteszeichen);ELIFersteszeichen=repwortTHENput(info,ersteszeichen);line(info)ELSEput(info,ersteszeichen);FI;CASE3:write(info,ersteszeichen+ggfluecke);CASE4:write(info,ersteszeichen+ggfluecke);CASE5:put(info,ersteszeichen);CASE6:write(info,ersteszeichen);IFersteszeichen=semikolonTHENline(info);ggfluecke:=""ELIFersteszeichen=klammeraufTHENggfluecke:=""FI;write(info,ggfluecke);ENDSELECT;IFggfluecke=" "THENzeilenanfangINCR1;FI;ersteszeichen:=zweiteszeichen;typ1:=typ2.variableundparameterausgeben:IFz<=dgleichungsanzahlTHENgebevariableausELIFz<=gleichungsanzahlTHENgebecovariableausFI;IFz<=anzahlparameterTHENgebeparameterausFI;.gebevariableaus:put(info,zwmodell.variablen.namekurz(z));IFz<=anzahlparameterTHENfiller:=infozeilenanfang-length(compress(zwmodell.variablen.namekurz(z)));IFfiller=infozeilenanfangTHENfillerINCR1FI;FI.gebecovariableaus:put(info,zwmodell.covariablen.namekurz(z-dgleichungsanzahl));IFz<=anzahlparameterTHENfiller:=infozeilenanfang-length(compress(zwmodell.covariablen.namekurz(z-dgleichungsanzahl)));IFfiller=infozeilenanfangTHENfillerINCR1FI;FI.gebeparameteraus:IFz>gleichungsanzahlTHENfiller:=infozeilenanfang+1;FI;write(info,filler*" ");put(info,zwmodell.parameter.namelang(z));.END PROCmodellinfo;PROCinfodateiausdrucken(MODELLDGL VARzwmodell,TEXT CONSTmodellbank):INT VARi;TEXT CONSTdsnameaktuell:=dsname+"."+timeofday;gleichungsraummitdatenfuellen;infodateifuellen;print(dsnameaktuell);feld(1):=auskunftstext(auskinfogedruckt);forget(dsnameaktuell,quiet);forget(zwmodell.codeundinfo,quiet).gleichungsraummitdatenfuellen:zwmodell.codeundinfo:=modellbank+sp+"X"+sp+"hilfscode";forget(zwmodell.codeundinfo,quiet);gleichungsraum:=new(zwmodell.codeundinfo);FORiFROM1UPTOdgleichungsanzahlREPgleichungsraum.gleichungen(i):=glzeile(i).gleichungPER;gleichungsraum.gleichungen(dgleichungsanzahl+1):=endezeichen;FORiFROMdgleichungsanzahl+1UPTOgleichungsanzahlREPgleichungsraum.cogleichungen(i-dgleichungsanzahl):=glzeile(i).gleichungPER;gleichungsraum.cogleichungen(egleichungsanzahl+1):=endezeichen.infodateifuellen:forget(dsnameaktuell,quiet);FILE VARinfo:=sequentialfile(output,dsnameaktuell);INT VARz,typ1,typ2,zeilenanfang,filler;TEXT VARersteszeichen,zweiteszeichen;TEXT VARggfluecke:="";modellnameangeben;putline(info,auskunftstext(auskgleichungen));putline(info,unterstrichfeld);FORzFROM1UPTOdgleichungsanzahlREPdgleichungausgeben;PER;FORzFROM1UPTOegleichungsanzahlREPegleichungausgeben;PER;line(info);IFanzahlparameter>0THENueberschriftschreiben;FORzFROM1UPTOmax(anzahlparameter,gleichungsanzahl)REPvariableundparameterausgeben;line(info)PER;ELSEputline(info,compress(auskunftstext(auskvariablen)));putline(info,unterstrichfeld);FORzFROM1UPTOgleichungsanzahlREPgebevariableaus;line(info)PER;FI;.modellnameangeben:putline(info,compress(auskunftstext(auskmodell))+" "+zwmodell.name.lang);putline(info,length(unterstrichfeld)*"=");line(info,2).ueberschriftschreiben:putline(info,compress(auskunftstext(auskvariablen))+10*" "+compress(auskunftstext(auskparameter)));putline(info,unterstrichfeld);.dgleichungausgeben:zeilenanfang:=1;scan(gleichungsraum.gleichungen(z));nextsymbol(ersteszeichen,typ1);dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende;WHILEtyp1<7REP +dasnaechstezeichenschreibenmitruecksichtaufdaszeilenendePER.egleichungausgeben:zeilenanfang:=1;scan(gleichungsraum.cogleichungen(z));nextsymbol(ersteszeichen,typ1);dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende;WHILEtyp1<7REPdasnaechstezeichenschreibenmitruecksichtaufdaszeilenendePER.dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende:IF(zeilenanfang+length(ersteszeichen)+1)>=77THENzeilenanfang:=1;FI;zeilenanfangINCRlength(ersteszeichen);nextsymbol(zweiteszeichen,typ2);SELECTtyp2OF CASEtrennzeichen:IFzweiteszeichen=klammeraufCANDtyp1<>trennzeichenTHENggfluecke:=" "ELSEggfluecke:=""FI;OTHERWISEggfluecke:=" "END SELECT;SELECTtyp1OF CASE1:write(info,ersteszeichen+ggfluecke);CASE2:IFersteszeichen=thenwortCORersteszeichen=elsewortTHENline(info);put(info,ersteszeichen);ELIFersteszeichen=repwortTHENput(info,ersteszeichen);line(info)ELSEput(info,ersteszeichen);FI;CASE3:write(info,ersteszeichen+ggfluecke);CASE4:write(info,ersteszeichen+ggfluecke);CASE5:put(info,ersteszeichen);CASE6:write(info,ersteszeichen);IFersteszeichen=semikolonTHENline(info);ggfluecke:=""ELIFersteszeichen=klammeraufTHENggfluecke:=""FI;write(info,ggfluecke);ENDSELECT;IFggfluecke=" "THENzeilenanfangINCR1;FI;ersteszeichen:=zweiteszeichen;typ1:=typ2;.variableundparameterausgeben:IFz<=gleichungsanzahlTHENgebevariableaus;FI;IFz<=anzahlparameterTHENgebeparameterausFI;.gebevariableaus:put(info,glzeile(z).variable);IFz<=anzahlparameterTHENfiller:=infozeilenanfang-length(compress(glzeile(z).variable));IFfiller=infozeilenanfangTHENfillerINCR1FI;FI;.gebeparameteraus:IFz>gleichungsanzahlTHENfiller:=infozeilenanfang+1;FI;write(info,filler*" ");put(info,eingabeparametername(z)).END PROCinfodateiausdrucken;PROCputgetformular1(ROW100TEXT VARfeld,INT VARcursorfeld,TEXT VARtaste):TEXT CONSTinternetasten:=return+hoch+runter+tab;put(formular(seite1),feld);REPput(formular(seite1),feld(cursorfeld),cursorfeld);get(formular(seite1),feld(cursorfeld),cursorfeld,taste);IFtaste=runterTHENcursorfeld:=3FI;IFtaste=hochTHENcursorfeld:=2FI;IFtaste=returnTHEN IFcursorfeld=2THENcursorfeld:=3ELSEcursorfeld:=2FI FI UNTILpos(internetasten,taste)=0PER END PROCputgetformular1;END PACKETmodellbasis; + + diff --git a/app/schulis-simulationssystem/3.0/src/modellbasis geraet b/app/schulis-simulationssystem/3.0/src/modellbasis geraet new file mode 100644 index 0000000..2a0a82a --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/modellbasis geraet @@ -0,0 +1,9 @@ +PACKETmodellbasisDEFINESmodelldatenraum,compilierbaregleichungen,MODELLDGL,modellname,modellbezeichnung,modellkurzbezeichnung,dimension,codimension,parameteranzahl,mitzusatzdarstellung,mitphasendiagramm,informationstext,variablenoberbegriff,variablenoberbegriffkurzform,variablenname,variablenkurzform,covariablenname,covariablenkurzform,parametername,parameterkurzform,darstellungsname,zustandunteregrenze,zustandoberegrenze,parameterunteregrenze,parameteroberegrenze,randoben,randunten,vorgabesystemzustand,vorgabeparameter,vorgabebeobachtungsdauer,vorgabeanfangszeitpunkt,vorgabekurve,vorgabevergleichssystemzustand,vorgabevergleichsparameter,vorgabevergleichsbeobachtungsdauer,vorgabevergleichsanfangszeitpunkt,vorgabevergleichskurve,demomuster,demoxindex,demoyindex,demoautomatik,minbeobachtungsdauer,maxbeobachtungsdauer,minanfangszeitpunkt,maxanfangszeitpunkt,anzahlbeobachtungspunkte,mitkombinationen,listekombinationen,indiceskombinationen,ergebnisganzzahlig,:=,VON,LOESUNG,STARTZEIT,DAUER,STARTWERT,PARAMETERSATZ,LOESUNGSABSCHNITT,KURVENDIMENSION,vergleichswerte,originalwerte,gleichungsprozeduren,setzemodelltyp,wirkungsdgr,kopplean:LETmaxdimension=20,maxparameter=20,typnrmodell=1077,maxvarlaenge=30,maxinfo=50,maxgleichungen=50,maxdarstellungszeilen=500,uebersetzbar=0,notuebersetzbar=1,initialisierungds="x",endezeichen="zZz",sp=" ",praefix="d ",modellcode=" code info ds",originalkurve=" originalkurve ds",vergleichskurve=" vergleichskurve ds",uebersetzungsfile="uebersetzungsdatei",darstellungskopf=" PROC darstellung 4 (LOESUNG VAR lsg, BOOL VAR in demo, TEXT VAR taste):",darstellungsende=" END PROC darstellung 4 ;";LETabbruchtaste="a",auskunftstaste="i",auskunftsloeschtaste1="z",auskunftsloeschtaste2="l",weitertaste="w",blaettertaste="b",speichertaste="s",zuruecktaste="z",simulationstaste="w",drucktaste="d",esc="�";LET ZEILE=STRUCT(TEXTgleichungsart,gleichung,variable,INTnummer);TYPE DEMOLAUF=STRUCT(VORGABEoriginal,vergleich,INTxindex,yindex,BOOLautomatisch,TEXTvariablenwahl);TYPE VORGABE=STRUCT(TEXTstartwert,parameter,REALanfangszeitpunkt,beobachtungsdauer,TEXTkurve);TYPE LOESUNG=STRUCT(ZUSTANDstartwert,PARAMETERparameter,REALanfangszeitpunkt,beobachtungsdauer,KURVEkurve);TYPE NAMEN=STRUCT(TEXTelan,ohneumlaute,kurz);TYPE ZUSTANDSDATEN=STRUCT(INTanzahl,TEXToberbegriff,oberbegriffkurzform,ROWmaxdimensionTEXTnamelang,namekurz,TEXTunteregrenze,oberegrenze,randoben,randunten);TYPE COVARIABLENDATEN=STRUCT(INTanzahl,ROWmaxdimensionTEXTnamelang,namekurz);TYPE KOMBINATION=STRUCT(TEXTname,INTxindex,yindex,BOOLautomatisch);TYPE KOMBINATIONSANGEBOT=STRUCT(BOOLmitkombinationen,INTanzahl,ROWmaxdimensionKOMBINATIONpaar);TYPE PARAMETERDATEN=STRUCT(INTanzahl,ROWmaxparameterTEXTnamelang,nameelan,TEXTunteregrenze,oberegrenze);TYPE DARSTELLUNGSDATEN=STRUCT(BOOLimmodell,TEXTname);TYPE BESCHRAENKUNG=STRUCT(REALminbeobachtungsdauer,maxbeobachtungsdauer,minanfangszeitpunkt,maxanfangszeitpunkt,INTanzahlbeobachtungspunkte);LET TEXTDATEN=BOUND STRUCT(ROWmaxinfoTEXTinfo,ROWmaxgleichungenTEXTgleichungen,cogleichungen,ROWmaxdarstellungszeilenTEXTdarstellungscode);TYPE MODELLDGL=STRUCT(NAMENname,ZUSTANDSDATENvariablen,COVARIABLENDATENcovariablen,PARAMETERDATENparameter,DARSTELLUNGSDATENdarstellung,BOOLmitphasendiagramm,BOOLganzzahlig,KOMBINATIONSANGEBOTkombinationen,TEXTcodeundinfo,BESCHRAENKUNGbeschraenkung,DEMOLAUFdemolauf,INTmodellzustand,BOOLgeschuetzt);MODELLDGL VARmodell;TEXTDATEN VARtextdaten;BOOL VARwd:=FALSE;OP:=(LOESUNG VARlinks,LOESUNG CONSTrechts):links.startwert:=rechts.startwert;links.parameter:=rechts.parameter;links.anfangszeitpunkt:=rechts.anfangszeitpunkt;links.beobachtungsdauer:=rechts.beobachtungsdauer;links.kurve:=rechts.kurve;END OP:=;OP VON(LOESUNG VARlinks,LOESUNG CONSTrechts):links.startwert:=rechts.startwert;links.parameter:=rechts.parameter;links.anfangszeitpunkt:=rechts.anfangszeitpunkt;links.beobachtungsdauer:=rechts.beobachtungsdauer;END OP VON;LOESUNG PROCvergleichswerte:LOESUNG VARlsg;lsg.startwert:=vorgabevergleichssystemzustand; +lsg.parameter:=vorgabevergleichsparameter;lsg.anfangszeitpunkt:=vorgabevergleichsanfangszeitpunkt;lsg.beobachtungsdauer:=vorgabevergleichsbeobachtungsdauer;lsg.kurve:=old(vorgabevergleichskurve);lsg.END PROCvergleichswerte;LOESUNG PROCoriginalwerte:LOESUNG VARlsg;lsg.startwert:=vorgabesystemzustand;lsg.parameter:=vorgabeparameter;lsg.anfangszeitpunkt:=vorgabeanfangszeitpunkt;lsg.beobachtungsdauer:=vorgabebeobachtungsdauer;IFexists(vorgabekurve)THENlsg.kurve:=old(vorgabekurve);FI;lsg.END PROCoriginalwerte;OP STARTZEIT(LOESUNG VARlsg,REAL CONSTstartzeit):lsg.anfangszeitpunkt:=startzeitEND OP STARTZEIT;REAL OP STARTZEIT(LOESUNG CONSTlsg):lsg.anfangszeitpunktEND OP STARTZEIT;OP DAUER(LOESUNG VARlsg,REAL CONSTdauer):lsg.beobachtungsdauer:=dauerEND OP DAUER;REAL OP DAUER(LOESUNG CONSTlsg):lsg.beobachtungsdauerEND OP DAUER;OP STARTWERT(LOESUNG VARlsg,ZUSTAND CONSTstartwert):lsg.startwert:=startwertEND OP STARTWERT;ZUSTAND OP STARTWERT(LOESUNG CONSTlsg):lsg.startwertEND OP STARTWERT;OP PARAMETERSATZ(LOESUNG VARlsg,PARAMETER CONSTparameter):lsg.parameter:=parameterEND OP PARAMETERSATZ;PARAMETER OP PARAMETERSATZ(LOESUNG CONSTlsg):lsg.parameterEND OP PARAMETERSATZ;OP LOESUNGSABSCHNITT(LOESUNG VARlsg,KURVE CONSTkurve):lsg.kurve:=kurveEND OP LOESUNGSABSCHNITT;KURVE OP LOESUNGSABSCHNITT(LOESUNG CONSTlsg):lsg.kurveEND OP LOESUNGSABSCHNITT;INT OP KURVENDIMENSION(KURVE CONSTkurve):dimension+codimension+1.END OP KURVENDIMENSION;TEXT PROCmodellbezeichnung:modell.name.ohneumlaute.END PROCmodellbezeichnung;TEXT PROCmodellkurzbezeichnung:modell.name.kurzEND PROCmodellkurzbezeichnung;TEXT PROCmodellname:modell.name.elanEND PROCmodellname;TEXT PROCmodelldatenraum:modell.codeundinfoEND PROCmodelldatenraum;BOOL PROCcompilierbaregleichungen:modell.modellzustand=uebersetzbarEND PROCcompilierbaregleichungen;INT PROCdimension:modell.variablen.anzahlEND PROCdimension;INT PROCcodimension:modell.covariablen.anzahlEND PROCcodimension;INT PROCparameteranzahl:modell.parameter.anzahlEND PROCparameteranzahl;BOOL PROCmitzusatzdarstellung:modell.darstellung.immodellEND PROCmitzusatzdarstellung;BOOL PROCmitphasendiagramm:modell.mitphasendiagrammEND PROCmitphasendiagramm;BOOL PROCergebnisganzzahlig:modell.ganzzahligEND PROCergebnisganzzahlig;FILE PROCinformationstext(TEXT CONSTdateiname):forget(dateiname,quiet);FILE VARtexte:=sequentialfile(output,dateiname);holeinformationstext;texte.holeinformationstext:TEXT VARsatz:="";INT VARi;IFmodell.geschuetztTHENputline(texte," "+modellbezeichnung);putline(texte," "+(areaxsize(grossesrahmenfenster)-2)*waagerecht);FI;FORiFROM1UPTOmaxinfoWHILEtextdaten.info(i)<>endezeichenREPsatz:=textdaten.info(i);putline(texte,satz);PER;.END PROCinformationstext;TEXT PROCvariablenoberbegriff:modell.variablen.oberbegriff.END PROCvariablenoberbegriff;TEXT PROCvariablenoberbegriffkurzform:modell.variablen.oberbegriffkurzform.END PROCvariablenoberbegriffkurzform;TEXT PROCvariablenname(INT CONSTi):TEXT CONSTt:=(modell.variablen.namelang(i));t+(maxvarlaenge-LENGTH(t))*" ".END PROCvariablenname;TEXT PROCvariablenkurzform(INT CONSTi):modell.variablen.namekurz(i).END PROCvariablenkurzform;TEXT PROCcovariablenname(INT CONSTi):TEXT CONSTt:=modell.covariablen.namelang(i);t+(maxvarlaenge-LENGTH(t))*" ".END PROCcovariablenname;TEXT PROCcovariablenkurzform(INT CONSTi):modell.covariablen.namekurz(i).END PROCcovariablenkurzform;TEXT PROCparametername(INT CONSTi):modell.parameter.namelang(i).END PROCparametername;TEXT PROCparameterkurzform(INT CONSTi):modell.parameter.nameelan(i).END PROCparameterkurzform;TEXT PROCdarstellungsname:modell.darstellung.name.END PROCdarstellungsname;PARAMETER PROCvorgabeparameter:parameter(modell.demolauf.original.parameter).END PROCvorgabeparameter;REAL PROCvorgabeanfangszeitpunkt:modell.demolauf.original.anfangszeitpunkt.END PROCvorgabeanfangszeitpunkt;ZUSTAND PROCvorgabevergleichssystemzustand:zustand(modell.demolauf.vergleich.startwert).END PROCvorgabevergleichssystemzustand;PARAMETER PROCvorgabevergleichsparameter:parameter( +modell.demolauf.vergleich.parameter).END PROCvorgabevergleichsparameter;ZUSTAND PROCzustandunteregrenze:zustand(modell.variablen.unteregrenze).END PROCzustandunteregrenze;ZUSTAND PROCzustandoberegrenze:zustand(modell.variablen.oberegrenze).END PROCzustandoberegrenze;PARAMETER PROCparameteroberegrenze:parameter(modell.parameter.oberegrenze).END PROCparameteroberegrenze;PARAMETER PROCparameterunteregrenze:parameter(modell.parameter.unteregrenze).END PROCparameterunteregrenze;ZUSTAND PROCrandoben:zustand(modell.variablen.randoben).END PROCrandoben;ZUSTAND PROCrandunten:zustand(modell.variablen.randunten).END PROCrandunten;REAL PROCminbeobachtungsdauer:modell.beschraenkung.minbeobachtungsdauer.END PROCminbeobachtungsdauer;REAL PROCmaxbeobachtungsdauer:modell.beschraenkung.maxbeobachtungsdauer.END PROCmaxbeobachtungsdauer;REAL PROCminanfangszeitpunkt:modell.beschraenkung.minanfangszeitpunkt.END PROCminanfangszeitpunkt;REAL PROCmaxanfangszeitpunkt:modell.beschraenkung.maxanfangszeitpunkt.END PROCmaxanfangszeitpunkt;INT PROCanzahlbeobachtungspunkte:modell.beschraenkung.anzahlbeobachtungspunkte.END PROCanzahlbeobachtungspunkte;BOOL PROCmitkombinationen:modell.kombinationen.mitkombinationen.END PROCmitkombinationen;PROClistekombinationen(ROWmaxdimensionTEXT VARnamen,INT VARanzahl):INT VARi;anzahl:=modell.kombinationen.anzahl;FORiFROM1UPTOanzahlREPnamen(i):=modell.kombinationen.paar(i).name;PER;END PROClistekombinationen;PROCindiceskombinationen(INT CONSTkombnr,INT VARxachse,yachse,BOOL VARvertauschbar):xachse:=modell.kombinationen.paar(kombnr).xindex;yachse:=modell.kombinationen.paar(kombnr).yindex;vertauschbar:=modell.kombinationen.paar(kombnr).automatisch;END PROCindiceskombinationen;ZUSTAND PROCvorgabesystemzustand:zustand(modell.demolauf.original.startwert).END PROCvorgabesystemzustand;REAL PROCvorgabebeobachtungsdauer:modell.demolauf.original.beobachtungsdauer.END PROCvorgabebeobachtungsdauer;TEXT PROCvorgabekurve:modell.demolauf.original.kurve.END PROCvorgabekurve;REAL PROCvorgabevergleichsanfangszeitpunkt:modell.demolauf.vergleich.anfangszeitpunkt.END PROCvorgabevergleichsanfangszeitpunkt;REAL PROCvorgabevergleichsbeobachtungsdauer:modell.demolauf.vergleich.beobachtungsdauer.END PROCvorgabevergleichsbeobachtungsdauer;TEXT PROCvorgabevergleichskurve:modell.demolauf.vergleich.kurve.END PROCvorgabevergleichskurve;ZUSTAND PROCdemomuster:zustand(modell.demolauf.variablenwahl).END PROCdemomuster;BOOL PROCdemoautomatik:modell.demolauf.automatisch.END PROCdemoautomatik;INT PROCdemoxindex:modell.demolauf.xindex.END PROCdemoxindex;INT PROCdemoyindex:modell.demolauf.yindex.END PROCdemoyindex;TEXT PROCgleichung(INT CONSTi):TEXT VARt:=textdaten.gleichungen(i);t.END PROCgleichung;TEXT PROCcogleichung(INT CONSTi):TEXT VARt:=textdaten.cogleichungen(i);t.END PROCcogleichung;TEXT PROCdarstellungszeile(INT CONSTi):TEXT VARt:=textdaten.darstellungscode(i);t.END PROCdarstellungszeile;PROCkopplean(MODELLDGL VARaktuellesmodell):modell:=aktuellesmodell;IFexists(modell.codeundinfo)THENtextdaten:=old(modell.codeundinfo);FI;END PROCkopplean;PROCgleichungsprozeduren(TEXT CONSTdateiname):forget(dateiname,quiet);FILE VARprog:=sequentialfile(output,dateiname);schreibegleichungsproz;schreibecogleichungsproz;schreibedarstellung4;.schreibegleichungsproz:putline(prog,"ZUSTAND PROC f (REAL CONST zeit, "+" ZUSTAND CONST alter zustand, "+" PARAMETER CONST alle parameter):");deklarationen;gleichungen;ergebnis;putline(prog,"END PROC f;");.schreibecogleichungsproz:putline(prog,"ZUSTAND PROC co f (REAL CONST zeit, "+" ZUSTAND CONST alter zustand, "+" PARAMETER CONST alle parameter):");deklarationenvoncof;cogleichungen;cofergebnis;putline(prog,"END PROC co f;");.gleichungen:FORiFROM1UPTOmaxgleichungenWHILEgleichung(i)<>endezeichenREPputline(prog,gleichung(i));PER;.cogleichungen:INT VARi;FORiFROM1UPTOmaxgleichungenWHILEcogleichung(i)<>endezeichenREPputline(prog,cogleichung(i));PER;.deklarationen:putline(prog,"ZUSTAND VAR dvektorxyx"+ +" := neuer zustand (DSUB alter zustand);");IFdimension>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOdimensionREPput(prog,elan(variablenkurzform(i))+" :: ");IFi=dimensionTHENputline(prog,"alter zustand SUB "+text(i)+" ;");ELSEputline(prog,"alter zustand SUB "+text(i)+" ,");FI;PER;FI;IFparameteranzahl>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOparameteranzahlREPput(prog,elan(parameterkurzform(i))+" :: ");IFi=parameteranzahlTHENputline(prog,"alle parameter SUB "+text(i)+" ;");ELSEputline(prog,"alle parameter SUB "+text(i)+" ,");FI;PER;FI;IFdimension>0THENput(prog,"REAL VAR ");FORiFROM1UPTOdimensionREPput(prog,praefix+elan(variablenkurzform(i)));IFi=dimensionTHENputline(prog,";")ELSEputline(prog,",")FI;PER;FI;.ergebnis:putline(prog,"ergebnisxyx .");putline(prog,"ergebnisxyx : ");FORiFROM1UPTOdimensionREPputline(prog,"replace (dvektorxyx ,"+text(i)+","+praefix+elan(variablenkurzform(i))+" );");PER;putline(prog,"dvektorxyx.");.deklarationenvoncof:putline(prog,"ZUSTAND VAR dvektorxyx"+" := neuer zustand ( co dimension);");IFdimension>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOdimensionREPput(prog,elan(variablenkurzform(i))+" :: ");IFi=dimensionTHENputline(prog,"alter zustand SUB "+text(i)+" ;");ELSEputline(prog,"alter zustand SUB "+text(i)+" ,");FI;PER;FI;IFparameteranzahl>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOparameteranzahlREPput(prog,elan(parameterkurzform(i))+" :: ");IFi=parameteranzahlTHENputline(prog,"alle parameter SUB "+text(i)+" ;");ELSEputline(prog,"alle parameter SUB "+text(i)+" ,");FI;PER;FI;IFcodimension>0THENput(prog,"REAL VAR ");FORiFROM1UPTOcodimensionREPput(prog,elan(covariablenkurzform(i)));IFi=codimensionTHENputline(prog,";")ELSEputline(prog,",")FI;PER;FI;.cofergebnis:putline(prog,"ergebnisxyx .");putline(prog,"ergebnisxyx : ");FORiFROM1UPTOcodimensionREPputline(prog,"replace (dvektorxyx ,"+text(i)+","+elan(covariablenkurzform(i))+" );");PER;putline(prog,"dvektorxyx.");.schreibedarstellung4:IFmitzusatzdarstellungTHENschreibedarstellungscodeELSEschreibeleerenprozedurkopfFI;.schreibeleerenprozedurkopf:putline(prog,darstellungskopf);putline(prog,darstellungsende);.schreibedarstellungscode:FORiFROM1UPTOmaxdarstellungszeilenWHILEdarstellungszeile(i)<>endezeichenREPputline(prog,darstellungszeile(i));PER;.END PROCgleichungsprozeduren; +TEXT PROCelan(TEXT CONSTalt):INT VARi:=1;TEXT VARt:="";FORiFROM1UPTO(LENGTHalt)REP IF(tanderstellei>=97CANDtanderstellei<=122)COR(tanderstellei>216CANDtanderstellei<=219)COR(tanderstellei>=48CANDtanderstellei<=57)THENtCATsubtext(alt,i,i)ELIF(tanderstellei>=65CANDtanderstellei<= +90)THENtCATcode(tanderstellei+32)ELIF(tanderstellei>=214CANDtanderstellei<=216)THENtCATcode(tanderstellei+3)ELSEtCAT" "FI PER;t.tanderstellei:code(subtext(alt,i,i))END PROCelan; +;OP:=(MODELLDGL VARmod,MODELLDGL CONSTm):CONCR(mod.name):=CONCR(m.name);CONCR(mod.variablen):=CONCR(m.variablen);CONCR(mod.covariablen):=CONCR(m.covariablen);CONCR(mod.parameter):=CONCR(m.parameter);CONCR(mod.darstellung):=CONCR(m.darstellung);mod.mitphasendiagramm:=m.mitphasendiagramm;mod.ganzzahlig:=m.ganzzahlig;mod.kombinationen.mitkombinationen:=m.kombinationen.mitkombinationen;mod.kombinationen.anzahl:=m.kombinationen.anzahl;INT VARi;FORiFROM1UPTOmaxdimensionREP CONCR(mod.kombinationen.paar(i)):=CONCR(m.kombinationen.paar(i))PER;mod.codeundinfo:=m.codeundinfo;CONCR(mod.beschraenkung):=CONCR(m.beschraenkung);CONCR(mod.demolauf.original):=CONCR(m.demolauf.original);CONCR(mod.demolauf.vergleich):=CONCR(m.demolauf.vergleich);mod.demolauf.xindex:=m.demolauf.xindex;mod.demolauf.yindex:=m.demolauf.yindex;mod.demolauf.automatisch:=m.demolauf.automatisch;mod.demolauf.variablenwahl:=m.demolauf.variablenwahl;mod.modellzustand:=m.modellzustand;mod.geschuetzt:=m.geschuetztEND OP:=;PROCwarteaufesc:TEXT VAReingabe;REPeingabe:=incharetyUNTILeingabe=escPER.END PROCwarteaufesc;PROCtasteeinlesen(TEXT VAReinlesetaste):REPeinlesetaste:=incharetyUNTIL +einlesetaste<>""PER END PROCtasteeinlesen;TEXT PROCkomprimiere(TEXT CONSTt):TEXT VARergebnis,z;INT VARi,l;suchevonvorne;suchevonhinten;ersetzekern;ergebnis.suchevonvorne:l:=LENGTHt;FORiFROM1UPTOlREPz:=(tSUBi)UNTIL NOT(z=" "CORz="_")PER;IFi>lTHENergebnis:=""ELSEergebnis:=subtext(t,i,l);FI.suchevonhinten:l:=LENGTHergebnis;FORiFROMlDOWNTO1REPz:=(ergebnisSUBi)UNTIL NOT(z=" "CORz="_")PER;IFi<1THENergebnis:=""ELSEergebnis:=subtext(ergebnis,1,i);FI.ersetzekern:changeall(ergebnis,"_"," ").END PROCkomprimiere;BOOL PROCnichtuebersetzbar(TEXT CONSTtext):BOOL VARergebnis;disablestop;do(text);ergebnis:=iserror;IFiserrorTHENclearerrorFI;enablestop;ergebnisEND PROCnichtuebersetzbar;PROCsetzemodelltyp(BOOL CONSTwirkungsdiagramm):wd:=wirkungsdiagramm;END PROCsetzemodelltyp;BOOL PROCwirkungsdgr:wdEND PROCwirkungsdgr;END PACKETmodellbasis; + diff --git a/app/schulis-simulationssystem/3.0/src/modellwerte b/app/schulis-simulationssystem/3.0/src/modellwerte new file mode 100644 index 0000000..931df75 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/modellwerte @@ -0,0 +1,3 @@ +PACKETmodellwerteDEFINESwandle,modellwerteausgeben,delta,zahlen:LETheadvar=49,headpar=50,headzeit=51,headanfpkt=52,headbeob=53,headblanks=" ";LETintervallaenge=0.25;TEXT PROCwandle(REAL CONSTx,INT CONSTlaenge,frac):TEXT VARausgabe:="";INT VARi:=0;xgleichnull;xindezimaldarstellung;IFxzugrossTHENausgabe:=text(x,laenge);LEAVEwandleWITHausgabe;ELSE FORiFROMfrac+1UPTOlaenge-2REP IFxnichtzukleinTHENausgabe:=text(x,laenge,i);nullenstreichenmitverschieben(ausgabe);LEAVEwandleWITHausgabeFI;PER;ausgabe:=text(x,laenge);FI;ausgabe.xnichtzuklein:abs(x)>=10.0**(-i).xzugross:abs(x)>(10.0**(laenge-2))-10.0**(-1).ximnormalbereich:abs(x)<=(10.0**(laenge-frac+i-2))-10.0**(-frac+i-1)CANDabs(x)>=(10.0**(-frac+i)).xindezimaldarstellung:FORiFROM0UPTOfracREP IFximnormalbereichTHENausgabe:=text(x,laenge,frac-i);nullenstreichenohneverschieben(ausgabe);LEAVEwandleWITHausgabeFI;PER.xgleichnull:IFx=0.0THENausgabe:=text(0.0,laenge,frac);nullenstreichenohneverschieben(ausgabe);replace(ausgabe,laenge-frac+1,"0");LEAVEwandleWITHausgabe;FI.ENDPROCwandle;PROCnullenstreichenohneverschieben(TEXT VARausgabe):INT VARi;FORiFROMlength(ausgabe)DOWNTO1REP IFsubtext(ausgabe,i,i)="0"THENreplace(ausgabe,i," ")ELSE LEAVEnullenstreichenohneverschiebenFI;PER;ENDPROCnullenstreichenohneverschieben;PROCnullenstreichenmitverschieben(TEXT VARausgabe):INT VARi;FORiFROMlength(ausgabe)DOWNTO1REP IFsubtext(ausgabe,length(ausgabe),length(ausgabe))="0"THENausgabe:=" "+subtext(ausgabe,1,length(ausgabe)-1)ELSE LEAVEnullenstreichenmitverschiebenFI;PER;ENDPROCnullenstreichenmitverschieben;FILE PROCmodellwerteausgeben(LOESUNG CONSTloesung):LETdateiname=" modellwerte";ZUSTAND CONSTzustand:=STARTWERTloesung;PARAMETER CONSTparameter:=PARAMETERSATZloesung;REAL CONSTzeitpunkt:=STARTZEITloesung,beobachtungsdauer:=DAUERloesung;IFexists(dateiname)THENforget(dateiname,quiet)FI;FILE VARausgabe:=sequentialfile(output,dateiname);TEXT VARueberschrift,zahl;STRUCT(TEXTbezeichnung,REALmodellwert)VARzeile;INT VARi,laenge:=8,fracs:=2;IFdimension>0THENschreibevariablen;FI;IFparameteranzahl>0THENschreibeparameter;FI;schreibezeitangaben;ausgabe.schreibevariablen:ueberschrift:=headblanks+compress(meldungstext(headvar));putline(ausgabe,ueberschrift);FORiFROM1UPTOdimensionREPvariablenzeileausgebenPER.variablenzeileausgeben:zeile.bezeichnung:=(variablenname(i)+(30-(length(variablenname(i))))*" ");zeile.modellwert:=zustandSUBi;zahl:=wandle(zeile.modellwert,laenge,fracs);putline(ausgabe,zeile.bezeichnung+zahl).schreibeparameter:putline(ausgabe," ");ueberschrift:=headblanks+compress(meldungstext(headpar));putline(ausgabe,ueberschrift);FORiFROM1UPTOparameteranzahlREPparameterzeileausgebenPER.parameterzeileausgeben:zeile.bezeichnung:=(parametername(i)+(30-(length(parametername(i))))*" ");zeile.modellwert:=parameterSUBi;zahl:=wandle(zeile.modellwert,laenge,fracs);putline(ausgabe,zeile.bezeichnung+zahl).schreibezeitangaben:putline(ausgabe," ");ueberschrift:=headblanks+compress(meldungstext(headzeit));putline(ausgabe,ueberschrift);zeile.bezeichnung:=meldungstext(headanfpkt);zeile.bezeichnung:=zeile.bezeichnung+(30-length(zeile.bezeichnung))*" ";zeile.modellwert:=zeitpunkt;zahl:=wandle(zeile.modellwert,laenge,fracs);putline(ausgabe,zeile.bezeichnung+zahl);zeile.bezeichnung:=meldungstext(headbeob);zeile.bezeichnung:=zeile.bezeichnung+(30-length(zeile.bezeichnung))*" ";zeile.modellwert:=beobachtungsdauer;zahl:=wandle(zeile.modellwert,laenge,fracs);putline(ausgabe,zeile.bezeichnung+zahl).ENDPROCmodellwerteausgeben;PROCzahlen(REAL CONSTmin,max,ROW3REAL VARschoenezahlen):REAL VARmi,ma,g1,g2,g3;bildenderteilintervalle;ermittelnschoenerzahlen.bildenderteilintervalle:g1:=(min+(max-min)*intervallaenge/2.0);g2:=(((max-min)*(intervallaenge/2.0)));g3:=(max-(max-min)*intervallaenge/2.0);.intervall1:mi:=min;ma:=g1.intervall2:mi:=((min+max)/2.0)-g2;ma:=((min+max)/2.0)+g2.intervall3:mi:=g3;ma:=max.ermittelnschoenerzahlen:intervall1;schoenezahlen(1):=schoenezahl(mi,ma);intervall2;schoenezahlen(2):=schoenezahl(mi,ma);intervall3; +schoenezahlen(3):=schoenezahl(mi,ma).END PROCzahlen;REAL PROCschoenezahl(REAL CONSTminimum,maximum,):INT VARschalter:=0;REAL VARz,a;IFnullimintervallTHENa:=0.0ELSE IFminimum>=0.0THENmax:=maximum;min:=minimum;a:=positivesintervallELIFmaximum<=0.0THEN REAL VARmax:=ABSminimum;REAL VARmin:=ABSmaximum;schalter:=1;a:=positivesintervallELSEa:=0.0FI;FI;a.nullimintervall:0.0>=minimumAND0.0<=minimum.positivesintervall:exponentenermitteln;zahlermitteln.exponentenermitteln:INT VARi:=decimalexponent(max);.zahlermitteln:REAL VARd:=0.0,zplus5;REPd:=10.0**(i);z:=floor(max/d)*(d);zplus5:=z+5.0*10.0**(i-1);IFmin<=zANDz<=maxTHEN IFschalter=1THENz:=-zFI;LEAVEzahlermittelnWITHzELIFmin<=zplus5ANDzplus5<=maxTHENz:=zplus5;IFschalter=1THENz:=-zFI;LEAVEzahlermittelnWITHzELSEiDECR1FI PER;0.0.END PROCschoenezahl;LETcaschritte=5.0;REAL PROCdelta(REAL CONSTminimum,maximum):REAL VARlaenge:=(maximum-minimum)/caschritte;exponentenermitteln;zahlermitteln.exponentenermitteln:INT VARi:=decimalexponent(laenge);.zahlermitteln:REAL VARd,z,fuenfmald;d:=10.0**i;z:=floor(laenge/d)*d;fuenfmald:=5.0*d;IFfuenfmald<=laengeTHENfuenfmaldELSEzFI END PROCdelta;ENDPACKETmodellwerte; + diff --git a/app/schulis-simulationssystem/3.0/src/neue startschl b/app/schulis-simulationssystem/3.0/src/neue startschl new file mode 100644 index 0000000..850f251 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/neue startschl @@ -0,0 +1,3 @@ +PACKETstartinmanagergrafiktaskDEFINESmanagerschleife:INT CONSTeingabevomkanal:=-4,existiertnicht:=-1,nichtempfangsbereit:=-2;LETuebersetzungsfile="uebersetzungsdatei",kanalgeraetetask=1,modellbankverwaltung="MODELLBANKVERWALTUNG",menukarteinstallieren="installmenu(""ls-MENUKARTE:Simsel"",FALSE)",dglmodell=1,wdmodell=2,okcode=0,tasknamefuersohn="-",msgmodelldaten=2,msgoriginalkurve=3,msgvergleichskurve=4,msggleichungen=5,msgdglsimulation=6,msgwdinfotext=7,msgwdsimulation=9,wiederaufsetzen=10,aufruf="wahl der bearbeitung (PROC f , PROC co f, PROC darstellung 4) ;";TASK VARsohntask:=niltask;TEXT VARfehlertext:="";PROCmanagerschleife:DATASPACE VARtransportds;INT VARmesscode,retcode;INT VARinfoint:=0;TASK VARauftraggeber,kontrolltask:=/modellbankverwaltung;disablestop;break(quiet);REPkernvonmanagerschleifePER.kernvonmanagerschleife:retcode:=0;wait(transportds,messcode,auftraggeber);IFauftraggeber=kontrolltaskTHEN IFmesscode=msgmodelldatenTHENrichtesohneinundsendemodelldaten;ELIFmesscode=msgoriginalkurveTHENsendeaktuellenmesscode;ELIFmesscode=msgvergleichskurveTHENsendeaktuellenmesscode;ELIFmesscode=msggleichungenTHENsendeaktuellenmesscode;ELIFmesscode=msgdglsimulationTHENstartedglsimulationinsohntask;ELIFmesscode=msgwdinfotextTHENsendeaktuellenmesscode;ELIFmesscode=msgwdsimulationTHENstartewdsimulationinsohntask;FI;transportds:=nilspace;auftraggeber:=kontrolltask;infoint:=0;send(auftraggeber,retcode,transportds,infoint);forget(transportds);FI;fehlerbehandlung.fehlerbehandlung:IFiserrorTHENclearerrorFI.richtesohneinundsendemodelldaten:IFexists(son(myself))THENend(son(myself));FI;begin(tasknamefuersohn,PROCstartprocfuersimulationstask,sohntask);REP UNTILexists(sohntask)CANDstatus(sohntask)=2PER;schickeansohntask(transportds,messcode,retcode);.sendeaktuellenmesscode:schickeansohntask(transportds,messcode,retcode);.startedglsimulationinsohntask:schickeansohntask(transportds,messcode,retcode);end(son(myself));.startewdsimulationinsohntask:schickeansohntask(transportds,messcode,retcode);end(son(myself));.END PROCmanagerschleife;PROCschickeansohntask(DATASPACE VARdatenraum,INT CONSTverarbeitung,INT VARret):TASK VARzieltask:=sohntask,kontrolltask:=sohntask;ret:=okcode;REP REP UNTILstatus(zieltask)=2PER;zieltask:=sohntask;send(zieltask,verarbeitung,datenraum,ret);forget(datenraum);IFret<>existiertnichtCANDret<>nichtempfangsbereitTHENzieltask:=kontrolltask;wait(datenraum,ret,zieltask);forget(datenraum);FI;LEAVEschickeansohntask;PER;END PROCschickeansohntask;PROCstartprocfuersimulationstask:disablestop;bearbeiteauftrag;IFiserrorTHENclearerror;DATASPACE VARtransporter:=nilspace;INT VARnachricht:=wiederaufsetzen,return:=0;TASK VARdestinationtask:=father;REP UNTILstatus(destinationtask)=2PER;send(destinationtask,nachricht,transporter,return);FI;.END PROCstartprocfuersimulationstask;PROCbearbeiteauftrag:FILE VARfx;BOUND TEXT VARtx;DATASPACE VARtransportdatenraum;INT VARmsgtype;TASK VARsourcetask:=father,destinationtask:=father;enablestop;REPwait(transportdatenraum,msgtype,sourcetask);verarbeitebotschaft;UNTILinstallationfertigPER;.installationfertig:msgtype=msgdglsimulationORmsgtype=msgwdsimulation.verarbeitebotschaft:IFsourcetask=fatherTHEN IFmsgtype=msgmodelldatenTHENkopieremodelldaten;ELIFmsgtype=msgoriginalkurveTHENkopiereoriginalkurve;ELIFmsgtype=msgvergleichskurveTHENkopierevergleichskurve;ELIFmsgtype=msggleichungenTHENkopieregleichungen;ELIFmsgtype=msgdglsimulationTHENstartedglsimulation;ELIFmsgtype=msgwdinfotextTHENkopiereinfotextwd;ELIFmsgtype=msgwdsimulationTHENstartewdsimulation;ELIFmsgtype=eingabevomkanalTHEN REP UNTILincharety=""PER;forget(transportdatenraum);LEAVEverarbeitebotschaftELSEforget(transportdatenraum);LEAVEverarbeitebotschaftFI;ELSE IFmsgtype=eingabevomkanalTHEN REP UNTILincharety=""PER;FI;forget(transportdatenraum);LEAVEverarbeitebotschaftFI;sendeantwort;.kopieremodelldaten:BOUND MODELLDGL VARmodelltransporter;MODELLDGL VARaktuellesmodell;texteankoppeln;modelltransporter:=transportdatenraum;aktuellesmodell:= +modelltransporter;kopplean(aktuellesmodell);.kopiereoriginalkurve:forget(vorgabekurve,quiet);copy(transportdatenraum,vorgabekurve);.kopierevergleichskurve:forget(vorgabevergleichskurve,quiet);copy(transportdatenraum,vorgabevergleichskurve);.kopieregleichungen:forget(modelldatenraum,quiet);copy(transportdatenraum,modelldatenraum);kopplean(aktuellesmodell);.kopiereinfotextwd:uebergebeinfotextfuerwd(transportdatenraum);.startedglsimulation:startesimulation(dglmodell,transportdatenraum);forget(vorgabekurve,quiet);forget(vorgabevergleichskurve,quiet);forget(modelldatenraum,quiet);.startewdsimulation:startesimulation(wdmodell,transportdatenraum);.sendeantwort:transportdatenraum:=nilspace;msgtype:=okcode;destinationtask:=father;REP UNTILstatus(destinationtask)=2PER;send(destinationtask,msgtype,transportdatenraum).END PROCbearbeiteauftrag;PROCstartesimulation(INT CONSTmodelltyp,DATASPACE VARwddsfertigegleichungen):FILE VARrundatei;enablestop;continue(kanalgeraetetask);setzemodelltyp(modelltyp=wdmodell);forget(uebersetzungsfile,quiet);IFmodelltyp=dglmodellTHENgleichungsprozeduren(uebersetzungsfile)ELIFmodelltyp=wdmodellTHENcopy(wddsfertigegleichungen,uebersetzungsfile)FI;rundatei:=sequentialfile(output,uebersetzungsfile);putline(rundatei,"continue ( "+text(kanalgeraetetask)+");");putline(rundatei,aufruf);do(menukarteinstallieren);break(quiet);uebersetze;break(quiet);.uebersetze:run(uebersetzungsfile);forget(uebersetzungsfile,quiet);.END PROCstartesimulation;END PACKETstartinmanagergrafiktask; + diff --git a/app/schulis-simulationssystem/3.0/src/o b/app/schulis-simulationssystem/3.0/src/o new file mode 100644 index 0000000..b5ca640 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/o @@ -0,0 +1,2 @@ +PACKETobjektDEFINES OBJEKT,variable,ergebnis,parameter,formel,zeit,nil,:=,=,typ,typbezeichner,typkennzeichen,new,name,variablenname,ergaenzungsvariablenname,parametername,formelname,langname,kurzname,ausdruck,elanname:LETtypbezeichnervariable=511,typbezeichnerergebnis=512,typbezeichnerparameter=513,typbezeichnerformel=514,typbezeichnerzeit=515;LETelannamederzeit="zeit";TYPE TYP=INT;TYPE OBJEKT=STRUCT(TYPtyp,TEXTlangname,kurzname,elanname);TYP CONSTnil:=0,variable:=1,ergebnis:=2,parameter:=3,formel:=4,zeit:=5;OP:=(TYP VARt,INT CONSTi):CONCR(t):=iENDOP:=;OP:=(TYP VARl,TYP CONSTr):CONCR(l):=CONCR(r)ENDOP:=;BOOL OP=(TYP CONSTl,TYP CONSTr):CONCR(l)=CONCR(r)ENDOP=;TEXT PROCtypbezeichner(OBJEKT CONSTobj):TYP VARobjekttyp:=obj.typ;IFobjekttyp=variableTHENanwendungstext(typbezeichnervariable)ELIFobjekttyp=ergebnisTHENanwendungstext(typbezeichnerergebnis)ELIFobjekttyp=parameterTHENanwendungstext(typbezeichnerparameter)ELIFobjekttyp=formelTHENanwendungstext(typbezeichnerformel)ELIFobjekttyp=zeitTHENanwendungstext(typbezeichnerzeit)ELSE""FI END PROCtypbezeichner;TEXT PROCtypkennzeichen(OBJEKT CONSTobj):TYP VARobjekttyp:=obj.typ;IFobjekttyp=variableTHEN"v"ELIFobjekttyp=ergebnisTHEN"e"ELIFobjekttyp=parameterTHEN"p"ELIFobjekttyp=formelTHEN"f"ELIFobjekttyp=zeitTHEN"z"ELSEwaagerechtFI END PROCtypkennzeichen;OBJEKT PROCnew(TYP CONSTtyp):OBJEKT VARo;IFtyp=zeitTHENnewtimeELSE CONCR(o.typ):=CONCR(typ);o.langname:="";o.kurzname:="";o.elanname:="";oFI END PROCnew;OBJEKT PROCnewtime:OBJEKT VARo;CONCR(o.typ):=CONCR(zeit);o.langname:=anwendungstext(typbezeichnerzeit);o.kurzname:=o.langname;o.elanname:=elannamederzeit;oEND PROCnewtime;OP:=(OBJEKT VARl,OBJEKT CONSTr):CONCR(l):=CONCR(r);END OP:=;TEXT PROCname(OBJEKT CONSTo):o.langnameEND PROCname;TYP PROCtyp(OBJEKT CONSTo):o.typEND PROCtyp;TEXT PROClangname(OBJEKT CONSTo):o.langnameEND PROClangname;TEXT PROCkurzname(OBJEKT CONSTo):o.kurznameEND PROCkurzname;TEXT PROCausdruck(OBJEKT CONSTo):o.kurznameEND PROCausdruck;TEXT PROCelanname(OBJEKT CONSTo):o.elannameEND PROCelanname;PROCname(OBJEKT VARo,TEXT CONSTt):o.langname:=tEND PROCname;PROCvariablenname(OBJEKT VARo,TEXT CONSTl,k,e):IFo.typ=variableTHENo.langname:=l;o.kurzname:=k;o.elanname:=eFI END PROCvariablenname;PROCergaenzungsvariablenname(OBJEKT VARo,TEXT CONSTl,k,e):IFo.typ=ergebnisTHENo.langname:=l;o.kurzname:=k;o.elanname:=eFI END PROCergaenzungsvariablenname;PROCparametername(OBJEKT VARo,TEXT CONSTl,e):IFo.typ=parameterTHENo.langname:=l;o.elanname:=eFI END PROCparametername;PROCformelname(OBJEKT VARo,TEXT CONSTl,e,a):IFo.typ=formelTHENo.langname:=l;o.elanname:=e;o.kurzname:=aFI END PROCformelname;END PACKETobjekt; + diff --git a/app/schulis-simulationssystem/3.0/src/op1 b/app/schulis-simulationssystem/3.0/src/op1 new file mode 100644 index 0000000..1874496 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/op1 @@ -0,0 +1,4 @@ +PACKETobjektrepraesentation1DEFINESbewegecursorauflinkpositionen,zeichneverbindung,gibinformation,box,boxohnerahmen,objekttext:LETmaxlink=8;LETrechts=1,links=2,oben=3,unten=4,stern="*",blank=" ",maxlength=9,plus=" + ",differentialzeichen="d ",rand=" ",zuweisung=" = ";WINDOW VARfenster:=standardfenster;PROCboxaufbs(OBJEKT CONSTobj,INT CONSTi,j,BOOL CONSTbelegt):IFbelegtTHENschreibevolleboxaufbs;ELSEschreibeleereboxaufbs;FI.schreibevolleboxaufbs:newout(fenster,i,j,eckeobenlinks+typkennzeichen(obj)+((maxlength-1)*waagerecht)+eckeobenrechts);newout(fenster,i,j+1,senkrecht+objektname(obj)+senkrecht);newout(fenster,i,j+2,eckeuntenlinks+(maxlength*waagerecht)+eckeuntenrechts);.schreibeleereboxaufbs:TEXT CONSTleer:=(maxlength+2)*blank;newout(fenster,i,j,leer);newout(fenster,i,j+1,leer);newout(fenster,i,j+2,leer).END PROCboxaufbs;PROCbox(INT CONSTi,j):CELL CONSTc:=cell(i,j);box(objekt(c),gpos(mpos(c)),belegt(c))END PROCbox;PROCbox(OBJEKT CONSTobj,GPOS CONSTgitterpos,BOOL CONSTstatus):IFimgitter(gitterpos)THENboxaufbs(obj,iwindowpos(gitterpos),jwindowpos(gitterpos),status)FI END PROCbox;TEXT PROCobjektname(OBJEKT CONSTobj):blank+text(name(obj),maxlength-2)+ggfstern.ggfstern:IFlength(name(obj))>(maxlength-2)THENsternELSEblankFI.END PROCobjektname;PROCboxohnerahmen(OBJEKT CONSTobj,GPOS CONSTgitterpos):IFimgitter(gitterpos)THENboxohnerahmenaufbs(obj,iwindowpos(gitterpos),jwindowpos(gitterpos))FI END PROCboxohnerahmen;PROCboxohnerahmenaufbs(OBJEKT CONSTobj,INT CONSTi,j):newout(fenster,i+1,j+1,objektname(obj))END PROCboxohnerahmenaufbs;PROCnewout(TEXT CONSTt):INT VARi,j;getcursor(fenster,i,j);newout(fenster,i,j,t)END PROCnewout;PROClineout(TEXT CONSTt):INT VARi,j;getcursor(fenster,i,j);lineout(fenster,i,j,t)END PROClineout;INT PROCbewegecursorauflinkpositionen(GPOS CONSTgp,TEXT CONSTzulaessigepositionen):bewegebscursorauflinkpositionen(i,j,zulaessigepositionen).i:iwindowpos(gp).j:jwindowpos(gp).END PROCbewegecursorauflinkpositionen;INT PROCbewegebscursorauflinkpositionen(INT CONSTi,j,TEXT CONSTzulaessigepositionen):LETesc="�",return=" ";TEXT CONSTcursorbewegungen:="��";INT VARergebnis:=1;startpositioneinnehmen;REPlesetaste;bewegeggfcursorUNTILabbruchgewuenschtPER;behandleabbruch.startpositioneinnehmen:setzelinkposition(position,i,j).position:int(zulaessigepositionenSUBergebnis).lesetaste:TEXT VARtaste;inchar(taste).bewegeggfcursor:SELECTpos(cursorbewegungen,taste)OF CASE1:rechtsCASE2:linksEND SELECT.rechts:IFergebnis=length(zulaessigepositionen)THENergebnis:=1ELSEergebnisINCR1FI;setzelinkposition(position,i,j).links:IFergebnis=1THENergebnis:=length(zulaessigepositionen)ELSEergebnisDECR1FI;setzelinkposition(position,i,j).abbruchgewuenscht:taste=escORtaste=return.behandleabbruch:IFtaste=escTHEN0ELSEpositionFI.END PROCbewegebscursorauflinkpositionen;PROCsetzelinkposition(INT CONSTergebnis,i,j):SELECTergebnisOF CASE1,2,3:cursor(fenster,i+2*ergebnis+1,j)CASE4:cursor(fenster,i+maxlength+1,j+1)CASE5,6,7:cursor(fenster,i+2*(maxlink-ergebnis)+1,j+2)CASE8:cursor(fenster,i,j+1)ENDSELECT END PROCsetzelinkposition;PROCsetzelinkposition(INT CONSTergebnis,GPOS CONSTgp):setzelinkposition(ergebnis,i,j).i:iwindowpos(gp).j:jwindowpos(gp).END PROCsetzelinkposition;PROCsetzestartposition(INT CONSTergebnis,INT VARi,j):SELECTergebnisOF CASE1,2,3:i:=i+2*ergebnis+1;jDECR1CASE4:i:=i+maxlength+2;jINCR1CASE5,6,7:i:=i+2*(maxlink-ergebnis)+1;jINCR3CASE8:iDECR1;jINCR1ENDSELECT END PROCsetzestartposition;PROCzeichneverbindung(MPOS CONSTvon,INT CONSTvonnr,MPOS CONSTbis,INT CONSTbisnr):INT VARvi,vj,bi,bj,ai,aj,alterichtung,neuerichtung;GPOS VARgvon,gbis;IF NOT(imgitter(von)ORimgitter(bis))THEN LEAVEzeichneverbindungFI;bestimmeviundvj;bestimmebiundbj;gehevonspalteviinzeilevjnachzeilebj;gehenachspaltebi;IFimgitter(bis)THENschreibeendsymbolFI.bestimmeviundvj:IFimgitter(von)THENgvon:=gpos(von);vi:=iwindowpos(gvon);vj:=jwindowpos(gvon);setzelinkposition(vonnr,gvon);schreibestartsymbol;setzestartposition(vonnr,vi,vj);IF NOTimgitter(bis)THENbi:=randwertfuerbi;bj:=randwertfuerbj +FI;FI.bestimmebiundbj:IFimgitter(bis)THENgbis:=gpos(bis);bi:=iwindowpos(gbis);bj:=jwindowpos(gbis);setzestartposition(bisnr,bi,bj);IF NOTimgitter(von)THENvi:=randwertfuervi;vj:=randwertfuervjFI;FI.randwertfuerbi:IFimpos(bis)=impos(von)THENviELIFimpos(bis)=bi.nordost:aj>=bjANDaibj)OR(NOTzeilefrei)REP IFobenplatzTHENgeheevtlnachobenELIFrechtsplatzTHENnachrechts(alterichtung,neuerichtung,ai,aj)FI PER.gehetendenziellnachnordwest:WHILE(aj>bj)OR(NOTzeilefrei)REP IFobenplatzTHENgeheevtlnachobenELIFlinksplatzTHENnachlinks(alterichtung,neuerichtung,ai,aj)FI PER.gehenachspaltebi:IFaibiTHEN WHILE NOT(ai=bi)REPnachlinks(alterichtung,neuerichtung,ai,aj)PER FI;IFajbjTHEN WHILE NOT(aj=bj)REPnachoben(alterichtung,neuerichtung,ai,aj)PER FI.geheevtlnachunten:IFobjektenichtingleichergitterspalteANDletzterichtunglinksoderrechtsANDstartpunktuntenoderobenanderboxTHENfuehreeinenschrittindieletzterichtungausFI;nachunten(alterichtung,neuerichtung,ai,aj).objektenichtingleichergitterspalte:igpos(gvon)<>igpos(gbis).letzterichtunglinksoderrechts:neuerichtung=rechtsORneuerichtung=links.startpunktuntenoderobenanderbox:vonnr<4OR(vonnr>4ANDvonnr<8).geheevtlnachoben:IFobjektenichtingleichergitterspalteANDletzterichtunglinksoderrechtsANDstartpunktuntenoderobenanderboxTHENfuehreeinenschrittindieletzterichtungausFI;nachoben(alterichtung,neuerichtung,ai,aj).fuehreeinenschrittindieletzterichtungaus:IFneuerichtung=rechtsTHENnachrechts(alterichtung,neuerichtung,ai,aj)ELSEnachlinks(alterichtung,neuerichtung,ai,aj)FI.zeilefrei:INT VARax:=areax(fenster);zwischenraumohnebox(areay(fenster)+aj-1,min(ax+ai-1,ax+bi-1),max(ax+ai-1,ax+bi-1)).anfangsrichtung:SELECTvonnrOF CASE1,2,3:lineout(fenster,ai,aj,senkrecht);obenCASE4:lineout(fenster,ai,aj,waagerecht);rechtsCASE5,6,7:lineout(fenster,ai,aj,senkrecht);untenCASE8:lineout(fenster,ai,aj,waagerecht);linksOTHERWISE0END SELECT.obenplatz:NOTinbox(ai,aj-1).untenplatz:NOTinbox(ai,aj+1).rechtsplatz:NOTinbox(ai+1,aj).linksplatz:NOTinbox(ai-1,aj).schreibestartsymbol:lineout(startsymbol).startsymbol:SELECTvonnrOF CASE1,2,3:"^"CASE4:">"CASE5,6,7:"v"CASE8:"<"OTHERWISE""END SELECT.schreibeendsymbol:TEXT VARendsymbol:=pfeil;setzelinkposition(bisnr,gbis);lineout(endsymbol).pfeil:SELECTbisnrOF CASE1,2,3:lineout(fenster,bi,bj,ecksymbol(neuerichtung,unten));"v"CASE4:lineout(fenster,bi,bj,ecksymbol(neuerichtung,links));"<"CASE5,6,7:lineout(fenster,bi,bj,ecksymbol( +neuerichtung,oben));"^"CASE8:lineout(fenster,bi,bj,ecksymbol(neuerichtung,rechts));">"OTHERWISE""END SELECT.END PROCzeichneverbindung;PROCnachrechts(INT VARalterichtung,neuerichtung,ai,aj):alterichtung:=neuerichtung;neuerichtung:=rechts;richtungswechsel(alterichtung,neuerichtung,ai,aj);aiINCR1;lineout(fenster,ai,aj,waagerecht)END PROCnachrechts;PROCnachlinks(INT VARalterichtung,neuerichtung,ai,aj):alterichtung:=neuerichtung;neuerichtung:=links;richtungswechsel(alterichtung,neuerichtung,ai,aj);aiDECR1;lineout(fenster,ai,aj,waagerecht)END PROCnachlinks;PROCnachoben(INT VARalterichtung,neuerichtung,ai,aj):alterichtung:=neuerichtung;neuerichtung:=oben;richtungswechsel(alterichtung,neuerichtung,ai,aj);ajDECR1;lineout(fenster,ai,aj,senkrecht)END PROCnachoben;PROCnachunten(INT VARalterichtung,neuerichtung,ai,aj):alterichtung:=neuerichtung;neuerichtung:=unten;richtungswechsel(alterichtung,neuerichtung,ai,aj);ajINCR1;lineout(fenster,ai,aj,senkrecht)END PROCnachunten;PROCrichtungswechsel(INT CONSTalterichtung,neuerichtung,ai,aj):IFalterichtung<>neuerichtungTHEN TEXT VARecke:=ecksymbol(alterichtung,neuerichtung);IFecke<>""THENlineout(fenster,ai,aj,ecke)FI FI END PROCrichtungswechsel;TEXT PROCecksymbol(INT CONSTalt,neu):SELECTaltOF CASEunten:altuntenCASEoben:altobenCASErechts:altrechtsCASElinks:altlinksOTHERWISE""END SELECT.altunten:SELECTneuOF CASErechts:eckeuntenlinksCASElinks:eckeuntenrechtsOTHERWISE""END SELECT.altrechts:SELECTneuOF CASEunten:eckeobenrechtsCASEoben:eckeuntenrechtsOTHERWISE""END SELECT.altoben:SELECTneuOF CASErechts:eckeobenlinksCASElinks:eckeobenrechtsOTHERWISE""END SELECT.altlinks:SELECTneuOF CASEunten:eckeobenlinksCASEoben:eckeuntenlinksOTHERWISE""END SELECT.END PROCecksymbol;BOOL PROCinbox(INT CONSTi,j):inboxspeicher(areay(fenster)+j-1,areax(fenster)+i-1)<>blankEND PROCinbox;PROCgibinformation(INT CONSTnr):IFnr>0THEN WINDOW VARw:=window(1,2,79,23);boxinfo(w,anwendungstext(nr))FI END PROCgibinformation;PROCobjekttext(FILE VARf,MPOS CONSTmp):IFtyp(objekt(mp))=variableTHENstelledifferentialquotientenzusammenELIFtyp(objekt(mp))=ergebnisTHENstellesummezusammenELIFtyp(objekt(mp))=parameterTHENzeigenamenELIFtyp(objekt(mp))=formelTHENinformiereueberarithmetischenausdruckFI.zeigenamen:putline(f,rand+elanname(objekt(mp)));line(f).stelledifferentialquotientenzusammen:stellelinkeseitederdglzusammen;schreibenenner;schreibebruchstrichundrechteseite;schreibezaehler;line(f).stellesummezusammen:putline(f,rand+elanname(objekt(mp))+zuweisung+summederankommendenpfeile);line(f).stellelinkeseitederdglzusammen:TEXT VARnenner:=differentialzeichen+elanname(objekt(mp)),zaehler:=differentialzeichen+elanname(new(zeit)),strich:=max(LENGTHnenner,LENGTHzaehler)*"-".schreibenenner:putline(f,rand+(abs((LENGTHstrich)-(LENGTHnenner))DIV2)*blank+nenner).schreibebruchstrichundrechteseite:putline(f,rand+strich+zuweisung+summederankommendenpfeile).schreibezaehler:putline(f,rand+(abs((LENGTHstrich)-(LENGTHzaehler))DIV2)*blank+zaehler).summederankommendenpfeile:IFkeineverbindungvonanderenobjektenaufgebautTHEN"0.0"ELSE TEXT VARterm:="";FORiFROM1UPTOmaxlinkREPnotiereeinquellobjektPER;subtext(term,1,(LENGTHterm)-(LENGTHplus))FI.notiereeinquellobjekt:IFcEINGANGiTHENtermCATnamederquelle;termCATplusFI.namederquelle:elanname(objekt(quelle)).quelle:quellenposition.quellenposition:cUEBERi.keineverbindungvonanderenobjektenaufgebaut:INT VARi,z:=0;FORiFROM1UPTOmaxlinkREP IFcEINGANGiTHENzINCR1FI PER;z=0.c:cell(mp).informiereueberarithmetischenausdruck:putline(f,rand+elanname(objekt(mp))+zuweisung+ausdruck(objekt(mp)));line(f).END PROCobjekttext;END PACKETobjektrepraesentation1; + diff --git a/app/schulis-simulationssystem/3.0/src/op2 b/app/schulis-simulationssystem/3.0/src/op2 new file mode 100644 index 0000000..861939f --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/op2 @@ -0,0 +1,11 @@ +PACKETobjektrepraesentation2DEFINESvariableeditieren,parametereditieren,formeleditieren,termistkorrekt,listeallerbezeichner,boxvorhanden:LETzeitnichtalsvariable=520,leerebezeichnerlisteteil1=532,leerebezeichnerlisteteil2=533,leerebezeichnerlisteteil3=534,nurdieseelannamen=551,quithinweis=519,singularmodellgroesse=511,singularergebnis=512,singularparameter=513,singularformel=514,pluralformel=538,listedernamen=536,nochkeinenamenvergeben=537,tabellenkopf1=543,tabellenkopf2=550,tabellenkopf3=545,tabellenrumpf=546,tabellenfuss=547,hinweisleerername=523,hinweissyntaxfehler=524,hinweisdoppeltername=525,hinweislangername=526,hinweisformalerfehler=527,standardhinweis=528,hinweisfalscheranfang=529,ueberschriftfuervariable=530,ueberschriftfuerergaenzungsvariable=531,hinweisleererausdruck=539;LETlang=3,elan=4,kurz=5,aus=5,maxi=20,maxj=10,maxlink=8,maxlaengefuerdo=2000,hoch="�",runter=" +",return=" ",blank=" ",underscore="_",stern="*",info="?",pruefen="p",halt="v",zurueck="z",vtag=9,ptag=10,ftag=11,laengefuerformeln=300,laengefuernamen=30,laengefuerkurznamen=7,realvar="REAL VAR ",tag=1,delimiter=6;ROW100TEXT VARfeld;INT VARi;FORiFROM1UPTO100REPfeld(i):=""PER;ROWmaxlinkTEXT VARname;TEXT VARtaste;INT VARfeldnummer;BOOL VARboxaufgebaut:=FALSE;BOOL PROCboxvorhanden:boxaufgebautEND PROCboxvorhanden;PROCvariableeditieren(CELL CONSTactualcell,BOOL VARgespeichert,INT VARfehlercode,TEXT VARfehlermeldung):enablestop;TEXT VARzwischenspeicher:="",zwischenspeicherl:="",zwischenspeichere:="",zwischenspeicherk:="";taste:="";boxaufgebaut:=FALSE;BOOL VARlangnameok,elannameok,kurznameok;OBJEKT VARaktuellesobjekt:=objekt(actualcell);MPOS CONSTmp:=mpos(actualcell);gespeichert:=FALSE;pruefedentyp;baueboxumeingabefelderauf;repeatwechslezwischendeneingabefeldern;raeumebildschirmauf.pruefedentyp:.baueboxumeingabefelderauf:WINDOW VAReingabefenster:=window(6,3,32,8);TAG VARvariablentag:=formular(vtag);show(variablentag);outframe(eingabefenster);feld(2):=anwendungstext(ueberschrift);put(variablentag,feld(2),2);zeigealleeingabefelder;doublefootnote(anwendungstext(standardhinweis));setzecursoraufersteseingabefeld.ueberschrift:IFtyp(aktuellesobjekt)=variableTHENueberschriftfuervariableELSEueberschriftfuerergaenzungsvariableFI.zeigealleeingabefelder:belegefeld(langname(aktuellesobjekt),feld(lang),zwischenspeicherl,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerelannamen,feld(elan),zwischenspeichere,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerkurznamen,feld(kurz),zwischenspeicherk,laengefuerkurznamen);langnameok:=(length(langname(aktuellesobjekt))>0);elannameok:=(length(elanname(aktuellesobjekt))>0);kurznameok:=(length(kurzname(aktuellesobjekt))>0);BOOL VARersteeingabefuerkurznamen:=TRUE,ersteeingabefuerelannamen:=TRUE;put(variablentag,feld);.vorschlagoderletzteeingabefuerelannamen:elanname(aktuellesobjekt).vorschlagoderletzteeingabefuerkurznamen:kurzname(aktuellesobjekt).setzecursoraufersteseingabefeld:feldnummer:=lang;get(variablentag,feld(feldnummer),feldnummer,taste).repeatwechslezwischendeneingabefeldern:REP IFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=pruefenANDpruefenunsinnigTHENmeldeleerenausdruck(fehlercode)FI;wechslezwischendeneingabefeldernPER.pruefenunsinnig:NOTboxaufgebautANDfeld(lang)="".wechslezwischendeneingabefeldern:boxaufgebaut:=TRUE;SELECTfeldnummerOF CASElang:pruefelangnameCASEelan:pruefeelannameCASEkurz:pruefekurznameEND SELECT;behandletaste;gibggfstandardhinweisaus;gibggfvorgabefuerelannamenundkurznamen;putget(variablentag,feld(feldnummer),feldnummer,taste);.gibggfstandardhinweisaus:IFeingabenohnefehlundtadelTHENdoublefootnote(anwendungstext(standardhinweis));FI.gibggfvorgabefuerelannamenundkurznamen:IFkurznamebisherleerTHENersteeingabefuerkurznamen:=FALSE;belegefeld(letzteeingabefuerlangnamen,feld(kurz),zwischenspeicherk,laengefuerkurznamen);ELIFelannamebisherleerTHENersteeingabefuerelannamen:=FALSE;belegefeld(elanname(letzteeingabefuerlangnamen),feld(elan),zwischenspeichere,laengefuernamen);FI. +kurznamebisherleer:ersteeingabefuerkurznamenAND(NOTkurznameok)ANDfeldnummer=kurz.elannamebisherleer:ersteeingabefuerelannamenAND(NOTelannameok)ANDfeldnummer=elan.letzteeingabefuerlangnamen:bereinigt(zwischenspeicherl).pruefelangname:IFlangnamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(lang));langnameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFlangnamegleichzeitTHENmeldezeitunzulaessig(fehlercode,fehlermeldung)ELIFlangnamezulangTHENmeldezulangennamen(fehlercode)ELIFlangnamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELSElangnameok:=TRUE;zwischenspeicherl:=feld(lang);vsetzeneuenfeldindexFI ELSEvsetzeneuenfeldindexFI.langnamemussgeprueftwerden:(zwischenspeicherl<>feld(lang))ORlangnamegleichzeitOR((zwischenspeicherl=feld(lang))AND NOTlangnameok).langnamegleichzeit:TEXT VARx:=zwischenspeicher;changeall(x," ","");(((xSUB1)="z")COR((xSUB1)="Z"))CAND(((xSUB2)="e")COR((xSUB2)="E"))CAND(((xSUB3)="i")COR((xSUB3)="I"))CAND(((xSUB4)="t")COR((xSUB4)="T"))AND(length(x)=4).pruefeelanname:IFelannamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(elan));elannameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFelannamemitfalschemanfangTHENmeldefalschenanfang(fehlercode)ELIFelannamemitfalschenzeichenTHENmeldeformalenfehler(fehlercode)ELIFelannamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELIFeingabeentsprichtnichtelannotationTHENmeldesyntaxverletzung(fehlercode,fehlermeldung)ELSEelannameok:=TRUE;zwischenspeichere:=feld(elan);vsetzeneuenfeldindexFI ELSEvsetzeneuenfeldindexFI.elannamemussgeprueftwerden:(zwischenspeichere<>feld(elan))OR((zwischenspeichere=feld(elan))AND NOTelannameok).pruefekurzname:IFkurznamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(kurz));kurznameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFkurznamezulangTHENmeldezulangennamen(fehlercode)ELIFkurznamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELSEzwischenspeicherk:=feld(kurz);kurznameok:=TRUE;vsetzeneuenfeldindexFI ELSEvsetzeneuenfeldindexFI.kurznamemussgeprueftwerden:(zwischenspeicherk<>feld(kurz))OR((zwischenspeicherk=feld(kurz))AND NOTkurznameok).behandletaste:IFtaste=pruefenANDeingabenohnefehlundtadelTHENschreibeeditiertesobjektzurueck;LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=infoTHENgibeditierhilfeFI.eingabenohnefehlundtadel:langnameokANDelannameokANDkurznameok.schreibeeditiertesobjektzurueck:zwischenspeichere:=bereinigt(zwischenspeichere);changeall(zwischenspeichere," ","");IFzwischenspeichere<>elanname(aktuellesobjekt)ANDelanname(aktuellesobjekt)<>""THENfuehrenamensaenderunginallenabhaengigenformelnaus(actualcell,zwischenspeichere)FI;IFtyp(aktuellesobjekt)=variableTHENvariablenname(aktuellesobjekt,bereinigt(zwischenspeicherl),bereinigt(zwischenspeicherk),zwischenspeichere);ELSEergaenzungsvariablenname(aktuellesobjekt,bereinigt(zwischenspeicherl),bereinigt(zwischenspeicherk),zwischenspeichere);FI;gespeichert:=TRUE;aktuellesobjektWRITEmp.nameleer:zwischenspeicher="".langnamenichteindeutig:NOTlangnameeindeutig(zwischenspeicher,mpos(actualcell)).elannamenichteindeutig:NOTelannameeindeutig(zwischenspeicher,mpos(actualcell)).elannamemitfalschemanfang:NOTimkleinenalphabet(zwischenspeicherSUB1).elannamemitfalschenzeichen:NOTelannamealphabetisch(zwischenspeicher).eingabeentsprichtnichtelannotation:fehlermeldung:="";NOTelannameistelanbezeichner(zwischenspeicher,fehlermeldung).kurznamenichteindeutig:NOTkurznameeindeutig(zwischenspeicher,mpos(actualcell)).langnamezulang:length(zwischenspeicher)>laengefuernamen.kurznamezulang:length(zwischenspeicher)>laengefuerkurznamen.raeumebildschirmauf:bsspeicherlesen(eingabefenster);raeumeeditierhilfeweg.END PROCvariableeditieren;PROCvsetzeneuenfeldindex:IFtaste=hochTHENfeldnummerDECR1ELIFtaste=runterORtaste=returnTHENfeldnummerINCR1FI;IFfeldnummerkurzTHENfeldnummer:=langFI END PROCvsetzeneuenfeldindex;PROCformeleditieren(CELL CONSTactualcell,BOOL VAR +gespeichert,INT VARfehlercode,TEXT VARfehlermeldung):enablestop;TEXT VARzwischenspeicher:="",zwischenspeicherl:="",zwischenspeichere:="",zwischenspeicherf:="";taste:="";BOOL VARlangnameok,elannameok,formelok;OBJEKT VARaktuellesobjekt:=objekt(actualcell);MPOS CONSTmp:=mpos(actualcell);gespeichert:=FALSE;pruefedentyp;baueboxumeingabefelderauf;repeatwechslezwischendeneingabefeldern;raeumebildschirmauf.pruefedentyp:.baueboxumeingabefelderauf:WINDOW VAReingabefenster:=window(6,3,32,8);TAG VARformeltag:=formular(ftag);show(formeltag);outframe(eingabefenster);zulaessigebezeichnerzeigen;zeigealleeingabefelder;doublefootnote(anwendungstext(standardhinweis));setzecursoraufersteseingabefeld.zulaessigebezeichnerzeigen:INT VARi,k:=0,j:=0;TEXT VARzw:="";WINDOW VARbezeichnerfenster:=window(40,3,36,8);outframe(bezeichnerfenster);page(bezeichnerfenster);FORiFROM1UPTOmaxlinkREP IF(actualcellEINGANGi)THENzw:=compress(elanname(objekt(actualcellUEBERi)));name(i):=zw;changeall(name(i)," ","");IFname(i)<>""AND(NOTschondagewesen)THENschreibeggfueberschrift;out(bezeichnerfenster,ausgabevonzw);line(bezeichnerfenster)FI;kINCR1ELSEname(i):=""FI PER;IFkeinbezeichnervorhandenTHENputline(bezeichnerfenster,anwendungstext(leerebezeichnerlisteteil1));putline(bezeichnerfenster,anwendungstext(leerebezeichnerlisteteil2));putline(bezeichnerfenster,anwendungstext(leerebezeichnerlisteteil3))FI.schreibeggfueberschrift:IFersterbezeichnerTHENout(bezeichnerfenster,ueberschrift)FI.ersterbezeichner:k=0.keinbezeichnervorhanden:k=0.ueberschrift:center(bezeichnerfenster,invers(anwendungstext(nurdieseelannamen))).ausgabevonzw:IFlength(zw)>30THENsubtext(zw,1,30)+sternELSEzwFI.schondagewesen:FORjFROM1UPTOi-1REP IFname(j)=name(i)THEN LEAVEschondagewesenWITH TRUE FI PER;FALSE.zeigealleeingabefelder:belegefeld(langname(aktuellesobjekt),feld(lang),zwischenspeicherl,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerelannamen,feld(elan),zwischenspeichere,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerausdruck,feld(aus),zwischenspeicherf,max(laengefuerformeln,length(feld(aus))));langnameok:=(length(langname(aktuellesobjekt))>0);elannameok:=(length(elanname(aktuellesobjekt))>0);formelok:=arithmetischerausdruckistkorrekt(actualcell,bereinigt(zwischenspeicherf),fehlermeldung);BOOL VARersteeingabefuerelannamen:=TRUE;put(formeltag,feld);.vorschlagoderletzteeingabefuerelannamen:elanname(aktuellesobjekt).vorschlagoderletzteeingabefuerausdruck:BOOL VARfeldfuerausdruckgesperrt:=FALSE;IFausdruck(aktuellesobjekt)=""THENfeldfuerausdruckgesperrt:=TRUE;"0.0"ELSEausdruck(aktuellesobjekt)FI.setzecursoraufersteseingabefeld:IF NOTformelokTHENmeldesyntaxverletzung(fehlercode,fehlermeldung);feldnummer:=ausELSEfeldnummer:=langFI;get(formeltag,feld(feldnummer),feldnummer,taste).repeatwechslezwischendeneingabefeldern:REP IFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernFI;wechslezwischendeneingabefeldernPER.wechslezwischendeneingabefeldern:boxaufgebaut:=TRUE;SELECTfeldnummerOF CASElang:pruefelangnameCASEelan:pruefeelannameCASEaus:pruefeausdruckEND SELECT;behandletaste;gibggfstandardhinweisaus;gibggfvorgabefuerelannamen;putget(formeltag,feld(feldnummer),feldnummer,taste);.gibggfstandardhinweisaus:IFeingabenohnefehlundtadelTHENdoublefootnote(anwendungstext(standardhinweis))FI.gibggfvorgabefuerelannamen:IFelannamebisherleerTHENersteeingabefuerelannamen:=FALSE;belegefeld(elanname(letzteeingabefuerlangnamen),feld(elan),zwischenspeichere,laengefuernamen);FI.elannamebisherleer:ersteeingabefuerelannamenAND(NOTelannameok)ANDfeldnummer=elan.letzteeingabefuerlangnamen:bereinigt(zwischenspeicherl).pruefelangname:IFlangnamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(lang));langnameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFlangnamezulangTHENmeldezulangennamen(fehlercode)ELIFlangnamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELSElangnameok:=TRUE;zwischenspeicherl:=feld(lang);fsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI ELSEfsetzeneuenfeldindex( +feldfuerausdruckgesperrt)FI.langnamemussgeprueftwerden:(zwischenspeicherl<>feld(lang))OR((zwischenspeicherl=feld(lang))AND NOTlangnameok).pruefeelanname:IFelannamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(elan));elannameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFelannamemitfalschemanfangTHENmeldefalschenanfang(fehlercode)ELIFelannamemitfalschenzeichenTHENmeldeformalenfehler(fehlercode)ELIFelannamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELIFeingabeentsprichtnichtelannotationTHENmeldesyntaxverletzung(fehlercode,fehlermeldung)ELSEelannameok:=TRUE;zwischenspeichere:=feld(elan);fsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI ELSEfsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI.elannamemussgeprueftwerden:(zwischenspeichere<>feld(elan))OR((zwischenspeichere=feld(elan))AND NOTelannameok).pruefeausdruck:IFausdruckmussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(aus));formelok:=FALSE;IFausdruckleerTHENmeldeleerenausdruck(fehlercode)ELIFcompilermeldetfehlerTHENmeldesyntaxverletzung(fehlercode,fehlermeldung)ELSEzwischenspeicherf:=feld(aus);formelok:=TRUE;fsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI ELSEfsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI.ausdruckmussgeprueftwerden:(zwischenspeicherf<>feld(aus))OR((zwischenspeicherf=feld(aus))AND NOTformelok).behandletaste:IFtaste=pruefenANDeingabenohnefehlundtadelTHENschreibeeditiertesobjektzurueck;LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=infoTHENgibeditierhilfeFI.eingabenohnefehlundtadel:(langnameokANDelannameokANDformelok)OR(feldfuerausdruckgesperrtANDlangnameokANDelannameok).schreibeeditiertesobjektzurueck:zwischenspeichere:=bereinigt(zwischenspeichere);changeall(zwischenspeichere," ","");IFzwischenspeichere<>elanname(aktuellesobjekt)ANDelanname(aktuellesobjekt)<>""THENfuehrenamensaenderunginallenabhaengigenformelnaus(actualcell,zwischenspeichere)FI;formelname(aktuellesobjekt,bereinigt(zwischenspeicherl),zwischenspeichere,bereinigt(zwischenspeicherf));gespeichert:=TRUE;aktuellesobjektWRITEmp.ausdruckleer:zwischenspeicher="".nameleer:zwischenspeicher="".langnamenichteindeutig:NOTlangnameeindeutig(zwischenspeicher,mpos(actualcell)).elannamenichteindeutig:NOTelannameeindeutig(zwischenspeicher,mpos(actualcell)).elannamemitfalschemanfang:NOTimkleinenalphabet(zwischenspeicherSUB1).elannamemitfalschenzeichen:NOTelannamealphabetisch(zwischenspeicher).eingabeentsprichtnichtelannotation:fehlermeldung:="";NOTelannameistelanbezeichner(zwischenspeicher,fehlermeldung).compilermeldetfehler:fehlermeldung:="";NOTarithmetischerausdruckistkorrekt(actualcell,zwischenspeicher,fehlermeldung).langnamezulang:length(zwischenspeicher)>laengefuernamen.raeumebildschirmauf:bsspeicherlesen(eingabefenster);bsspeicherlesen(bezeichnerfenster);raeumeeditierhilfeweg.END PROCformeleditieren;PROCfsetzeneuenfeldindex(BOOL CONSTfeldfuerausdruckgesperrt):IFtaste=hochTHENfeldnummerDECR1ELIFtaste=runterORtaste=returnTHENfeldnummerINCR1FI;IFfeldfuerausdruckgesperrtTHEN IFfeldnummerelanTHENfeldnummer:=langFI ELSE IFfeldnummerausTHENfeldnummer:=langFI FI END PROCfsetzeneuenfeldindex;PROCparametereditieren(CELL CONSTactualcell,BOOL VARgespeichert,INT VARfehlercode,TEXT VARfehlermeldung):enablestop;TEXT VARzwischenspeicher:="",zwischenspeicherl:="",zwischenspeichere:="";taste:="";BOOL VARlangnameok,elannameok;OBJEKT VARaktuellesobjekt:=objekt(actualcell);MPOS CONSTmp:=mpos(actualcell);gespeichert:=FALSE;pruefedentyp;baueboxumeingabefelderauf;repeatwechslezwischendeneingabefeldern;raeumebildschirmauf.pruefedentyp:.baueboxumeingabefelderauf:WINDOW VAReingabefenster:=window(6,3,32,6);TAG VARvariablentag:=formular(ptag);show(variablentag);outframe(eingabefenster);zeigealleeingabefelder;doublefootnote(anwendungstext(standardhinweis));setzecursoraufersteseingabefeld.zeigealleeingabefelder:belegefeld(langname(aktuellesobjekt),feld(lang), +zwischenspeicherl,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerelannamen,feld(elan),zwischenspeichere,laengefuernamen);langnameok:=(length(langname(aktuellesobjekt))>0);elannameok:=(length(elanname(aktuellesobjekt))>0);BOOL VARersteeingabefuerelannamen:=TRUE;put(variablentag,feld);.vorschlagoderletzteeingabefuerelannamen:elanname(aktuellesobjekt).setzecursoraufersteseingabefeld:feldnummer:=lang;get(variablentag,feld(feldnummer),feldnummer,taste).repeatwechslezwischendeneingabefeldern:REP IFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernFI;wechslezwischendeneingabefeldernPER.wechslezwischendeneingabefeldern:boxaufgebaut:=TRUE;SELECTfeldnummerOF CASElang:pruefelangnameCASEelan:pruefeelannameEND SELECT;behandletaste;gibggfstandardhinweisaus;gibggfvorgabefuerelannamen;putget(variablentag,feld(feldnummer),feldnummer,taste);.gibggfstandardhinweisaus:IFeingabenohnefehlundtadelTHENdoublefootnote(anwendungstext(standardhinweis))FI.gibggfvorgabefuerelannamen:IFelannamebisherleerTHENersteeingabefuerelannamen:=FALSE;belegefeld(elanname(letzteeingabefuerlangnamen),feld(elan),zwischenspeichere,laengefuernamen);FI.elannamebisherleer:ersteeingabefuerelannamenAND(NOTelannameok)ANDfeldnummer=elan.letzteeingabefuerlangnamen:bereinigt(zwischenspeicherl).pruefelangname:IFlangnamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(lang));langnameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFlangnamezulangTHENmeldezulangennamen(fehlercode)ELIFlangnamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELSElangnameok:=TRUE;zwischenspeicherl:=feld(lang);psetzeneuenfeldindexFI ELSEpsetzeneuenfeldindexFI.langnamemussgeprueftwerden:(zwischenspeicherl<>feld(lang))OR((zwischenspeicherl=feld(lang))AND NOTlangnameok).pruefeelanname:IFelannamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(elan));elannameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFelannamemitfalschemanfangTHENmeldefalschenanfang(fehlercode)ELIFelannamemitfalschenzeichenTHENmeldeformalenfehler(fehlercode)ELIFelannamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELIFeingabeentsprichtnichtelannotationTHENmeldesyntaxverletzung(fehlercode,fehlermeldung)ELSEelannameok:=TRUE;zwischenspeichere:=feld(elan);psetzeneuenfeldindexFI ELSEpsetzeneuenfeldindexFI.elannamemussgeprueftwerden:(zwischenspeichere<>feld(elan))OR((zwischenspeichere=feld(elan))AND NOTelannameok).behandletaste:IFtaste=pruefenANDeingabenohnefehlundtadelTHENschreibeeditiertesobjektzurueck;LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=infoTHENgibeditierhilfeFI.eingabenohnefehlundtadel:langnameokANDelannameok.schreibeeditiertesobjektzurueck:zwischenspeichere:=bereinigt(zwischenspeichere);changeall(zwischenspeichere," ","");IFzwischenspeichere<>elanname(aktuellesobjekt)ANDelanname(aktuellesobjekt)<>""THENfuehrenamensaenderunginallenabhaengigenformelnaus(actualcell,zwischenspeichere)FI;parametername(aktuellesobjekt,bereinigt(zwischenspeicherl),zwischenspeichere);gespeichert:=TRUE;aktuellesobjektWRITEmp.nameleer:zwischenspeicher="".langnamenichteindeutig:NOTlangnameeindeutig(zwischenspeicher,mpos(actualcell)).elannamenichteindeutig:NOTelannameeindeutig(zwischenspeicher,mpos(actualcell)).elannamemitfalschemanfang:NOTimkleinenalphabet(zwischenspeicherSUB1).elannamemitfalschenzeichen:NOTelannamealphabetisch(zwischenspeicher).eingabeentsprichtnichtelannotation:fehlermeldung:="";NOTelannameistelanbezeichner(zwischenspeicher,fehlermeldung).langnamezulang:length(zwischenspeicher)>laengefuernamen.raeumebildschirmauf:bsspeicherlesen(eingabefenster);raeumeeditierhilfeweg.END PROCparametereditieren;PROCpsetzeneuenfeldindex:IFtaste=hochTHENfeldnummerDECR1ELIFtaste=runterORtaste=returnTHENfeldnummerINCR1FI;IFfeldnummerelanTHENfeldnummer:=langFI END PROCpsetzeneuenfeldindex;TEXT PROCtextfuereingabefeld(TEXT CONSTfeld,INT CONSTlaenge):TEXT VARergebnis:=text(feld,laenge);changeall(ergebnis," ", +"_");ergebnisEND PROCtextfuereingabefeld;TEXT PROCbereinigt(TEXT CONSTfeld):TEXT VARergebnis:=feld;changeall(ergebnis,underscore,blank);compress(ergebnis)END PROCbereinigt;PROCbelegefeld(TEXT CONSToriginal,TEXT VARfuerfeld,fuerzwischenspeicher,INT CONSTlaenge):fuerfeld:=textfuereingabefeld(original,laenge);fuerzwischenspeicher:=fuerfeld;END PROCbelegefeld;BOOL PROCelannamealphabetisch(TEXT CONSTname):INT VARi;IFersterbuchstabenichtimkleinenalphabetTHEN FALSE ELSE FORiFROM1UPTOlength(name)REP IFiteszeichennichtimkleinenalphabetodernumerischoderblankTHEN LEAVEelannamealphabetischWITH FALSE FI PER;TRUE FI.ersterbuchstabenichtimkleinenalphabet:NOTimkleinenalphabet(nameSUB1).iteszeichennichtimkleinenalphabetodernumerischoderblank:NOT(imkleinenalphabet(nameSUBi)ORnumerisch(nameSUBi)ORblank=(nameSUBi)).END PROCelannamealphabetisch;TEXT PROCelanname(TEXT CONSTname):INT VARi;TEXT VARneuername:="";FORiFROM1UPTOlength(name)REP IFiteszeichenimgrossenalphabetTHENneuernameCATcode(code(nameSUBi)+32)ELIFiteszeichenimkleinenalphabetodernumerischTHENneuernameCAT(nameSUBi)ELIFiteszeichenszTHENneuernameCAT"ss"FI PER;neuername.iteszeichenimgrossenalphabet:imgrossenalphabet(nameSUBi).iteszeichenimkleinenalphabetodernumerisch:imkleinenalphabet(nameSUBi)ORnumerisch(nameSUBi).iteszeichensz:(nameSUBi)="ß".END PROCelanname;BOOL PROCimgrossenalphabet(TEXT CONSTc):(code("A")<=code(c)ANDcode(c)<=code("Z"))ORpos("ÄÖÜ",c)>0END PROCimgrossenalphabet;BOOL PROCimkleinenalphabet(TEXT CONSTc):(code("a")<=code(c)ANDcode(c)<=code("z"))ORpos("äöü",c)>0END PROCimkleinenalphabet;BOOL PROCnumerisch(TEXT CONSTc):(code("0")<=code(c)ANDcode(c)<=code("9"))END PROCnumerisch;BOOL PROClangnameeindeutig(TEXT CONSTbezeichner,MPOS CONSTmp):INT VARimp:=impos(mp),jmp:=jmpos(mp),i,j;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREP IFpositionbelegtCANDijnichtaktuellepositionTHEN IFlangname(objekt(cell(i,j)))=bezeichnerTHEN LEAVElangnameeindeutigWITH FALSE FI FI PER PER;TRUE.ijnichtaktuelleposition:NOT(i=impANDj=jmp).positionbelegt:belegt(cell(i,j)).END PROClangnameeindeutig;BOOL PROCelannameeindeutig(TEXT CONSTbezeichner,MPOS CONSTmp):INT VARimp:=impos(mp),jmp:=jmpos(mp),i,j;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREP IFpositionbelegtANDijnichtaktuellepositionTHEN IFelanname(objekt(cell(i,j)))=bezeichnerTHEN LEAVEelannameeindeutigWITH FALSE FI FI PER PER;TRUE.ijnichtaktuelleposition:NOT(i=impANDj=jmp).positionbelegt:belegt(cell(i,j)).END PROCelannameeindeutig;BOOL PROCkurznameeindeutig(TEXT CONSTbezeichner,MPOS CONSTmp):INT VARimp:=impos(mp),jmp:=jmpos(mp),i,j;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREP IFpositionbelegtANDijnichtaktuellepositionTHEN IFkurzname(objekt(cell(i,j)))=bezeichnerTHEN LEAVEkurznameeindeutigWITH FALSE FI FI PER PER;TRUE.ijnichtaktuelleposition:NOT(i=impANDj=jmp).positionbelegt:CELL CONSTc:=cell(i,j);belegt(c)AND NOT(typ(objekt(c))=parameter).END PROCkurznameeindeutig;BOOL PROCelannameistelanbezeichner(TEXT CONSTzwischenspeicher,TEXT VARfehlermeldung):TEXT CONSTvariablendefinition:=realvar+zwischenspeicher+";";ergebnisdescompilers(variablendefinition,fehlermeldung)END PROCelannameistelanbezeichner;BOOL PROCergebnisdescompilers(TEXT CONSTausdruck,TEXT VARfehlermeldung):BOOL VARfehler;fehlermeldung:="";IFausdruckzulangTHEN TRUE ELSEdisablestop;do(ausdruck);fehler:=iserror;IFiserrorTHENclearerror;enablestop;fehlermeldung:=errormessageELSEenablestopFI;NOTfehlerFI.ausdruckzulang:length(ausdruck)>maxlaengefuerdo.END PROCergebnisdescompilers;BOOL PROCarithmetischerausdruckistkorrekt(CELL CONSTactualcell,TEXT CONSTeingabe,TEXT VARfehlermeldung):TEXT CONSTrefinementname:="abcdefghijklmnopqrstuvwxyz0123456789";INT VARi,j;erstertestmitlokalenbezeichnern;zweitertestmitallenbezeichnern;TRUE.erstertestmitlokalenbezeichnern:kleinevariablenlistezusammenstellen;variablenlistemiteingabeverknuepfen;ausdruckpruefen.zweitertestmitallenbezeichnern:grossevariablenlistezusammenstellen;variablenlistemiteingabeverknuepfen;ausdruckpruefen.kleinevariablenlistezusammenstellen:TEXT VARausdruck:=""; +FORiFROM1UPTOmaxlinkREP IFname(i)<>""CAND(NOTschondagewesen)THENausdruckCAT(realvar+name(i)+";")FI PER.grossevariablenlistezusammenstellen:ausdruck:=listeallerbezeichner(mpos(actualcell)).schondagewesen:FORjFROM1UPTOi-1REP IFname(j)=name(i)THEN LEAVEschondagewesenWITH TRUE FI PER;FALSE.variablenlistemiteingabeverknuepfen:ausdruckCAT("REAL "+procname+":"+refinementname+"."+refinementname+":"+eingabe+"END "+procname).procname:"PROC proc "+refinementname.ausdruckpruefen:IF NOTergebnisdescompilers(ausdruck,fehlermeldung)THEN LEAVEarithmetischerausdruckistkorrektWITH FALSE FI.END PROCarithmetischerausdruckistkorrekt;BOOL PROCtermistkorrekt(CELL CONSTactualcell,TEXT CONSTeingabe,liste,TEXT VARfehlermeldung):INT VARi,j;TEXT CONSTrefinementname:="abcdefghijklmnopqrstuvwxyz0123456789";erstertestmitlokalenbezeichnern;zweitertestmitallenbezeichnern;TRUE.erstertestmitlokalenbezeichnern:kleinevariablenlistezusammenstellen;variablenlistemiteingabeverknuepfen;ausdruckpruefen.zweitertestmitallenbezeichnern:grossevariablenlistezusammenstellen;variablenlistemiteingabeverknuepfen;ausdruckpruefen.kleinevariablenlistezusammenstellen:zulaessigebezeichnerzusammenstellen(actualcell);TEXT VARausdruck:="";FORiFROM1UPTOmaxlinkREP IFname(i)<>""CAND(NOTschondagewesen)THENausdruckCAT(realvar+name(i)+";")FI PER.grossevariablenlistezusammenstellen:ausdruck:=liste.schondagewesen:FORjFROM1UPTOi-1REP IFname(j)=name(i)THEN LEAVEschondagewesenWITH TRUE FI PER;FALSE.variablenlistemiteingabeverknuepfen:ausdruckCAT("REAL "+procname+":"+refinementname+"."+refinementname+":"+eingabe+"END "+procname).procname:"PROC proc "+refinementname.ausdruckpruefen:IF NOTergebnisdescompilers(ausdruck,fehlermeldung)THEN LEAVEtermistkorrektWITH FALSE FI.END PROCtermistkorrekt;PROCzulaessigebezeichnerzusammenstellen(CELL CONSTactualcell):INT VARi;FORiFROM1UPTOmaxlinkREP IF(actualcellEINGANGi)THENname(i):=compress(elanname(objekt(actualcellUEBERi)));changeall(name(i)," ","");ELSEname(i):=""FI PER END PROCzulaessigebezeichnerzusammenstellen;PROCfuehrenamensaenderunginallenabhaengigenformelnaus(CELL CONSTactualcell,TEXT CONSTneuername):OBJEKT CONSTaktuellesobjekt:=objekt(actualcell);INT VARi;FORiFROM1UPTOmaxlinkREP IFiterpfeilweistaufformelTHENaendereelannameninnachbarformelFI PER.iterpfeilweistaufformel:(actualcellAUSGANGi)AND(typ(objekt(actualcellUEBERi))=formel).aendereelannameninnachbarformel:TEXT CONSTaltername:=elanname(aktuellesobjekt);MPOS CONSTzielposition:=(actualcellUEBERi);OBJEKT VARzielformel:=objekt(zielposition);TEXT CONSTterm:=ausdruck(zielformel);TEXT VARneuerterm:="";scanneterminzielformel;schreibeneuentermzurueck.scanneterminzielformel:TEXT VARsymbol:="";INT VARtype:=0,lasttype:=0;scan(term);nextsymbol(symbol,type);WHILE NOTendeerreichtREPverarbeitesymbol;nextsymbol(symbol,type)PER.endeerreicht:type>delimiter.verarbeitesymbol:SELECTtypeOF CASEtag:neuertermCAT(ggfneuername+" ")CASEdelimiter:verarbeitedelimiterOTHERWISEneuertermCAT(symbol+" ")ENDSELECT;lasttype:=type.ggfneuername:IFsymbol=alternameTHENneuernameELSEsymbolFI.verarbeitedelimiter:IFletzteszeichenimneuentermblankAND(lasttype=delimiterORsymbol=")")THENneuerterm:=subtext(neuerterm,1,length(neuerterm)-1)FI;neuertermCATsymbol.letzteszeichenimneuentermblank:(neuertermSUBlength(neuerterm))=" ".schreibeneuentermzurueck:formelname(zielformel,namederformel,elannamederformel,neuerterm);zielformelWRITEzielposition.namederformel:langname(zielformel).elannamederformel:elanname(zielformel).END PROCfuehrenamensaenderunginallenabhaengigenformelnaus;TEXT PROClisteallerbezeichner(MPOS CONSTmp):TEXT VARdeklarationen:=realvar+"zeit";variablenanhaengen;ergebnisseanhaengen;parameteranhaengen;formelnanhaengen;listeabschliessen.variablenanhaengen:deklarationenCATteilliste(variablenthesaurus).ergebnisseanhaengen:deklarationenCATteilliste(ergebnisthesaurus).parameteranhaengen:deklarationenCATteilliste(parameterthesaurus).formelnanhaengen:deklarationenCATteilliste(formelthesaurus,mp).listeabschliessen:deklarationenCAT";";deklarationen. +END PROClisteallerbezeichner;TEXT PROCteilliste(THESAURUS CONSTpositionen):INT VARi:=0;MPOS VARmp;TEXT VARliste:="";WHILEi0THENputline(hf,anwendungstext(tabellenfuss));line(hf)FI.behandlevariable:IFv=0THENschreibeueberschriftfuernichtleerevlisteFI;vINCR1;neuezeile(langname(objekt(mp)),elanname(objekt(mp)),kurzname(objekt(mp)));.fischeergaenzungsvariablenundihrenamenausmatrix:i:=0;WHILEi0THENputline(hf,anwendungstext(tabellenfuss));line(hf)FI.behandleergebnis:IFe=0THENschreibeueberschriftfuernichtleereelisteFI;eINCR1;neuezeile(langname(objekt(mp)),elanname(objekt(mp)),kurzname(objekt(mp))).fischeparameterundihrenamenausmatrix:i:=0;WHILEi0THENputline(hf,anwendungstext(tabellenfuss));line(hf)FI.behandleparameter:IFp=0THENschreibeueberschriftfuernichtleereplisteFI;pINCR1;neuezeile(langname(objekt(mp)),elanname(objekt(mp)),3*"-").fischeformelnundihrenamenausmatrix:i:=0;WHILEi0THENputline(hf,anwendungstext(tabellenfuss));line(hf)FI.behandleformel:IFf=0THENschreibeueberschriftfuernichtleereflisteFI;fINCR1;neuezeile(langname(objekt(mp)),elanname(objekt(mp)),3*"-");.schreibeueberschriftfuernichtleerevliste:ggfueberschrift;putline(hf,anwendungstext(singularmodellgroesse)+"n");ueberschrift.schreibeueberschriftfuernichtleereeliste:ggfueberschrift;putline(hf,anwendungstext(singularergebnis)+"n");ueberschrift.schreibeueberschriftfuernichtleerepliste:ggfueberschrift;putline(hf,anwendungstext(singularparameter));ueberschrift.schreibeueberschriftfuernichtleerefliste:ggfueberschrift;putline(hf,anwendungstext(ueberschriftfuerformel));ueberschrift.ueberschriftfuerformel:IFf=1THENsingularformelELSEpluralformelFI.ggfueberschrift:IFv+e+f+p=0THENputline(hf,anwendungstext(listedernamen));putline(hf,length(anwendungstext(listedernamen))*waagerecht);line(hf)FI.END PROCgibeditierhilfe;PROCueberschrift:putline(hf,anwendungstext(tabellenkopf1));putline(hf,anwendungstext(tabellenkopf2));putline(hf,anwendungstext(tabellenkopf3));END PROCueberschrift;PROCneuezeile(TEXT CONSTl,e,k):TEXT VARzeile:=anwendungstext(tabellenrumpf);replace(zeile,3,l);replace(zeile,35,ausgabefuerelannamen);replace(zeile,56,k);putline(hf,zeile).ausgabefuerelannamen:IFlength(e)>17THEN +subtext(e,1,17)+"*"ELSEeFI.END PROCneuezeile;PROCmeldeleerennamen(INT VARfehlercode):fehlercode:=hinweisleerername;outfehler(fehlercode)END PROCmeldeleerennamen;PROCmeldeleerenausdruck(INT VARfehlercode):fehlercode:=hinweisleererausdruck;outfehler(fehlercode)END PROCmeldeleerenausdruck;PROCmeldefalschenanfang(INT VARfehlercode):fehlercode:=hinweisfalscheranfang;outfehler(fehlercode)END PROCmeldefalschenanfang;PROCmeldeformalenfehler(INT VARfehlercode):fehlercode:=hinweisformalerfehler;outfehler(fehlercode)END PROCmeldeformalenfehler;PROCmeldesyntaxverletzung(INT VARfehlercode,TEXT CONSTfehlermeldung):fehlercode:=hinweissyntaxfehler;doublefootnote(anwendungstext(hinweissyntaxfehler)+return+fehlermeldung)END PROCmeldesyntaxverletzung;PROCmeldezeitunzulaessig(INT VARfehlercode,TEXT CONSTfehlermeldung):fehlercode:=zeitnichtalsvariable;doublefootnote(anwendungstext(zeitnichtalsvariable)+return+fehlermeldung)END PROCmeldezeitunzulaessig;PROCmeldedoppeltennamen(INT VARfehlercode):fehlercode:=hinweisdoppeltername;outfehler(fehlercode)END PROCmeldedoppeltennamen;PROCmeldezulangennamen(INT VARfehlercode):fehlercode:=hinweislangername;outfehler(fehlercode)END PROCmeldezulangennamen;PROCoutfehler(INT CONSTfehlercode):doublefootnote(anwendungstext(fehlercode))END PROCoutfehler;END PACKETobjektrepraesentation2; + diff --git a/app/schulis-simulationssystem/3.0/src/output b/app/schulis-simulationssystem/3.0/src/output new file mode 100644 index 0000000..79fb6f5 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/output @@ -0,0 +1,7 @@ +PACKEToutputDEFINES OUTPUT,:=,niloutput,replace,FILESUB,gebeaufbildschirmaus,plotterahmendoppelt,plottefusszeile,blaettere,blaetternoben,blaetternunten,blaettern,putpicture,putkreuz,nildiagramm,nildiagrammmitkreuz,nilkreuz,window,legefensterfest,versendeoutput,setzerahmen,kopfzeilezusammenstellen,forget:LETstrukt1fenster=1,strukt2texte=2,strukt2diagramme1text=3,strukt4fenster=4,strukttabelleunten=5,strukttabelleoben=6,fensterganz=1,fensteroben=2,fensterunten=3,fensterlinksoben=4,fensterlinksunten=5,fensterrechtsoben=6,fensterrechtsunten=7,fensterrechts=8,stdfarbe=1,stddicke=0,durchgezogen=1,hintergrund=0,vordergrund=1,maxpictures=10,blockstartwerte=9,neuerplottertaskname="SIMSEL-PRINTERDEPOT",alterplottertaskname="simsel plotter",maxplotobjekteinplottertask=25,mlplottertaskzuvoll=31,mlplottertaskexistiertnicht=40,mlplottertasknichtempfangsbereit=41,mlplotunmoeglich=43,plotok=0,produktname=21,zwischenraum=" ",maxfilezeilen=500,teilfenster="teiltextname",anfangszeile=1,typnummer=1055,lkszeilenanfang=4,rtszeilenanfang=42,rtszeilenende=79,obenerstezeile=3,obenletztezeile=12,untenerstezeile=14,untenletztezeile=23;REAL VARhorcm,vertcm;INT VARpixhor,pixvert;drawingarea(horcm,vertcm,pixhor,pixvert);REAL CONSTbuchsthoehe:=stdhoehe,buchstbreite:=stdbreite,minyabstand:=0.1,minxabstand:=buchstbreite/3.0;REAL CONSThoehe:=buchsthoehe+3.0*minyabstand,links:=0.0,rechts:=horcm,spaltenmitte:=(vertcm)/2.0,oben:=vertcm-hoehe,unten:=hoehe,zeilenmitte:=horcm/2.0,rahmenoben:=vertcm,rahmenunten:=0.0,abstand:=0.1;REAL VARverkleinerunghoehe:=2.5,verkleinerungbreite:=1.5;ROW6PICTURE VARrahmenmitkreuz;erstellerahmen;TYPE OUTPUT=BOUND STRUCT(INTaufbau,TEXTkopfzeilentext,INTschluesselfusszeile,BOOLmitrahmen,REALstandardhoehe,standardbreite,sourcewidth,sourceheight,TEXTmodellbezeichner,dsname,ROW2DIAGRAMMdiag,NURTEXTtext1,text2,startwerte,PICTURErahmen);TYPE NURTEXT=STRUCT(BOOLbelegt,INTaktzeile,naechsteseite,SIMSELFILEinhalt);TYPE DIAGRAMM=STRUCT(BOOLbelegt,INTanzahlpictures,anzahlpicfuerkreuz,REALxmin,xmax,ymin,ymax,ROWmaxpicturesPICTUREkreuz,ROWmaxpicturesPICTUREinhalt);TYPE SIMSELFILE=STRUCT(ROWmaxfilezeilenTEXTfilezeile,INTzeilenanzahl);PROCversendeoutput(OUTPUT VARobjekt,TEXT CONSTmodellbezeichner,kopfzeilentext,INT CONSTsteuerzeilennr,TEXT CONSTziel):INT VARret;TEXT VARdsname:=kopfzeilentext+"."+modellbezeichner+". "+timeofday;changeall(dsname,":",".");changeall(dsname," ","");change(dsname,"Demonstration","D");forget(dsname,quiet);copy(objekt.dsname,dsname);OUTPUT VARkopie;CONCR(kopie):=old(dsname);kopie.dsname:=dsname;kopie.modellbezeichner:=modellbezeichner;kopie.kopfzeilentext:=kopfzeilentext;kopie.schluesselfusszeile:=steuerzeilennr;IF NOTframeTHENkopie.mitrahmen:=FALSE;kopie.sourceheight:=kopie.sourceheight-2.0*hoeheeinerrandzeileELSEplotteallerandzeilen(kopie);FI;ret:=erfolgreicherplotversuch(kopie.dsname,ziel);IFret=plotokTHENforget(kopie.dsname,quiet);ELSEforget(kopie.dsname,quiet);plotend;errorstop(meldungstext(ret));FI;.hoeheeinerrandzeile:kopie.standardhoehe+3.0*minyabstand.END PROCversendeoutput;PROCversendeoutput(OUTPUT VARobjekt,TEXT CONSTmodellbezeichner,INT CONSTkopfzeilennr,steuerzeilennr,TEXT CONSTziel):versendeoutput(objekt,modellbezeichner,kopfzeile(kopfzeilennr),steuerzeilennr,ziel);END PROCversendeoutput;INT PROCerfolgreicherplotversuch(TEXT CONSTdatname,TEXT CONSTdestination):TEXT VARzieltask:="";disablestop;IFdestination=alterplottertasknameTHENzieltask:=neuerplottertasknameELSEzieltask:=destinationFI;IFexiststask(zieltask)THEN IFstatus(/zieltask)=2THEN IFplottertaskzuvoll(/zieltask)THENenablestop;mlplottertaskzuvollELSEsicherezuplotterFI ELSEenablestop;mlplottertasknichtempfangsbereitFI ELSEenablestop;mlplottertaskexistiertnichtFI.sicherezuplotter:commanddialogue(FALSE);save(datname,/zieltask);commanddialogue(TRUE);IFiserrorTHENclearerror;enablestop;mlplotunmoeglichELSEenablestop;plotokEND IF.END PROCerfolgreicherplotversuch;BOOL PROCplottertaskzuvoll(TASK CONSTziel):THESAURUS VARth:=ALLziel;INT VARi:=0,anzahl:=0;TEXT VARt; +WHILEi<=highestentry(th)REPget(th,t,i);IFt<>""THENanzahlINCR1;FI;UNTILi=0PER;anzahl>=maxplotobjekteinplottertask.END PROCplottertaskzuvoll;PROCplotohneclear(DIAGRAMM VARp):INT VARi;PICTURE VARpic;beginplot;FORiFROM1UPTOp.anzahlpicfuerkreuzREPpic:=p.kreuz(i);plottepic;PER;FORiFROM1UPTOp.anzahlpicturesREPpic:=p.inhalt(i);plottepic;PER;endplot.plottepic:IFpen(pic)<>0THENpen(0,stdfarbe,stddicke,pen(pic));plot(pic)FI.END PROCplotohneclear;OP:=(OUTPUT VARneu,DATASPACE CONSTspace):CONCR(neu):=space;END OP:=;PROCforget(OUTPUT VARalt):forget(alt.dsname,quiet);END PROCforget;DATASPACE PROCniloutput(INT CONSTbildaufbau,TEXT CONSTspacename):OUTPUT VARneu;forget(spacename,quiet);neu:=new(spacename);type(old(spacename),typnummer);neu.aufbau:=bildaufbau;neu.dsname:=spacename;neu.text1.belegt:=FALSE;neu.text1.aktzeile:=anfangszeile;simselfile(neu.text1.inhalt);neu.text1.naechsteseite:=anfangszeile;neu.text2.belegt:=FALSE;neu.text2.aktzeile:=anfangszeile;simselfile(neu.text2.inhalt);neu.text2.naechsteseite:=anfangszeile;neu.startwerte.belegt:=FALSE;neu.startwerte.aktzeile:=anfangszeile;simselfile(neu.startwerte.inhalt);neu.startwerte.naechsteseite:=anfangszeile;neu.standardhoehe:=stdhoehe;neu.standardbreite:=stdbreite;neu.sourcewidth:=horcm;neu.sourceheight:=vertcm;neu.diag(1).belegt:=FALSE;neu.diag(1).anzahlpictures:=0;neu.diag(2).anzahlpictures:=0;neu.diag(1).anzahlpicfuerkreuz:=0;neu.diag(2).anzahlpicfuerkreuz:=0;neu.diag(2).belegt:=FALSE;neu.mitrahmen:=TRUE;neu.rahmen:=rahmenmitkreuz(bildaufbau);old(neu.dsname).END PROCniloutput;PROCerstellerahmen:INT VARi;PICTURE VARgrenzen;FORiFROM1UPTO6REPgrenzen:=nilpicture;plrahmenunten;plrahmenlinks;plrahmenoben;plrahmenrechts;innererrahmenoben;innererrahmenunten;erstellekreuz;rahmenmitkreuz(i):=grenzen;PER;.plrahmenunten:movecm(grenzen,links,rahmenunten);drawcm(grenzen,rechts,rahmenunten).plrahmenlinks:movecm(grenzen,links,rahmenunten);drawcm(grenzen,links,rahmenoben).plrahmenoben:movecm(grenzen,links,rahmenoben);drawcm(grenzen,rechts,rahmenoben).plrahmenrechts:movecm(grenzen,rechts,rahmenoben);drawcm(grenzen,rechts,rahmenunten).innererrahmenoben:movecm(grenzen,links,oben);drawcm(grenzen,rechts,oben).innererrahmenunten:movecm(grenzen,links,unten);drawcm(grenzen,rechts,unten).erstellekreuz:SELECTiOF CASEstrukt2texte:waagerechtlks;waagerechtrts;CASEstrukttabelleunten:waagerechtlks;waagerechtrts;senkrechtoben;CASEstrukt4fenster:waagerechtlks;waagerechtrts;senkrechtoben;senkrechtunten;CASEstrukttabelleoben:waagerechtlks;waagerechtrts;senkrechtunten;CASEstrukt2diagramme1text:waagerechtlks;senkrechtoben;senkrechtunten;END SELECT;.waagerechtlks:movecm(grenzen,links,spaltenmitte);drawcm(grenzen,zeilenmitte,spaltenmitte).waagerechtrts:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,rechts,spaltenmitte).senkrechtoben:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,zeilenmitte,oben).senkrechtunten:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,zeilenmitte,unten).END PROCerstellerahmen;PROCplotterahmen(OUTPUT VARoutput):beginplot;clear;pen(hintergrund,vordergrund,stddicke,durchgezogen);viewport(links,rechts,rahmenunten,rahmenoben);window(0.0,1.0,0.0,1.0);plot(output.rahmen);endplot;.END PROCplotterahmen;PROCplotterahmendoppelt(OUTPUT VARoutput):viewport(links,rechts,rahmenunten,rahmenoben);window(0.0,1.0,0.0,1.0);beginplot;pen(hintergrund,vordergrund,stddicke,durchgezogen);plot(output.rahmen);endplot;.END PROCplotterahmendoppelt;PROCgebeaufbildschirmaus(OUTPUT VARobjekt,TEXT CONSTbezeichnung,textkopfzeile,INT CONSTsteuerzeilennr):objekt.modellbezeichner:=bezeichnung;objekt.kopfzeilentext:=textkopfzeile;objekt.schluesselfusszeile:=steuerzeilennr;plotterahmen(objekt);plottekopfzeile(objekt.kopfzeilentext,objekt.modellbezeichner);plottedarstellung;plotterahmendoppelt(objekt);loescheeingabepuffer;beginplot;plottefusszeile(objekt,objekt.schluesselfusszeile);endplot;.loescheeingabepuffer:TEXT VARt:="";REPt:=incharetyUNTILt=""PER.plottedarstellung:SELECTobjekt.aufbauOF CASEstrukt1fenster:IF +objekt.text1.belegtTHENplot(fensterganz,objekt.text1)ELIFobjekt.diag(1).belegtTHENplot(fensterganz,objekt)FI;CASEstrukt2texte:IFobjekt.text1.belegtTHENplot(fensteroben,objekt.text1);FI;IFobjekt.text2.belegtTHENplot(fensterunten,objekt.text2)FI;CASEstrukt2diagramme1text:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text1.belegtTHENplot(fensterrechts,objekt.text1);FI;CASEstrukt4fenster:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text1.belegtTHENplot(fensterrechtsoben,objekt.text1);FI;IFobjekt.text2.belegtTHENplot(fensterrechtsunten,objekt.text2);FI;CASEstrukttabelleunten:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.text1.belegtTHENplot(fensterrechtsoben,objekt.text1);FI;IFobjekt.text2.belegtTHENplot(fensterunten,objekt.text2);FI;CASEstrukttabelleoben:IFobjekt.text1.belegtTHENplot(fensteroben,objekt.text1);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text2.belegtTHENplot(fensterrechtsunten,objekt.text2);FI;END SELECT.END PROCgebeaufbildschirmaus;PROCgebeaufbildschirmaus(OUTPUT VARobjekt,TEXT CONSTbezeichnung,INT CONSTkopfzeilennr,steuerzeilennr):IFkopfzeilennr=0THENgebeaufbildschirmaus(objekt,bezeichnung," ",steuerzeilennr);ELSEgebeaufbildschirmaus(objekt,bezeichnung,kopfzeile(kopfzeilennr),steuerzeilennr);FI;END PROCgebeaufbildschirmaus;PROCplotteallerandzeilen(OUTPUT VARobjekt):PICTURE VARrandzeilen:=nilpicture;REAL CONSTgrenzeunten:=2.0*minyabstand+rahmenunten,grenzeoben:=oben+2.0*minyabstand,textende:=rechts-2.0*minyabstand,textanfang:=2.0*minyabstand+links;erstellekopfzeile;erstellesteuerleiste;objekt.rahmenCATrandzeilen;.erstellekopfzeile:TEXT VARzeilentext:=kopfzeilezusammenstellen(objekt.kopfzeilentext,objekt.modellbezeichner,int((textende-textanfang)/buchstbreite));steckekopfzeileinpicture;.steckekopfzeileinpicture:movecm(randzeilen,textanfang,grenzeoben);draw(randzeilen,zeilentext,0.0,buchsthoehe,buchstbreite);.erstellesteuerleiste:IFobjekt.schluesselfusszeile<>0THENmovecm(randzeilen,textanfang,grenzeunten);draw(randzeilen,steuerleiste(objekt.schluesselfusszeile),0.0,buchsthoehe,buchstbreite)FI.END PROCplotteallerandzeilen;PROCplottekopfzeile(TEXT CONSTkopfzeilentext,namedesmodells):REAL CONSTgrenzeoben:=oben+2.0*minyabstand,textende:=rechts-minyabstand,textanfang:=((2.0*minxabstand)+links);erstellekopfzeile;.erstellekopfzeile:TEXT VARzeilentext:=kopfzeilezusammenstellen(kopfzeilentext,namedesmodells,int((textende-textanfang)/buchstbreite));steckekopfzeileinpicture;.steckekopfzeileinpicture:beginplot;viewport(links,rechts,rahmenunten,rahmenoben);pen(0,1,0,1);movecm(textanfang,grenzeoben);draw(zeilentext,0.0,buchsthoehe,buchstbreite);endplot;.END PROCplottekopfzeile;PROCplottefusszeile(OUTPUT VARobjekt,INT CONSTtextnr):REAL CONSTgrenzeunten:=2.0*minyabstand+rahmenunten,textanfang:=((2.0*minxabstand)+links);objekt.schluesselfusszeile:=textnr;erstellesteuerleiste;.erstellesteuerleiste:IFtextnr<>0THENviewport(links,rechts,rahmenunten,rahmenoben);pen(0,1,0,1);movecm(textanfang,grenzeunten);draw(steuerleiste(textnr),0.0,buchsthoehe,buchstbreite)FI.END PROCplottefusszeile;PROCgibzeileaus(PICTURE VARrandzeile):viewport(links,rechts,rahmenunten,rahmenoben);beginplot;plot(randzeile);endplot;END PROCgibzeileaus;OP:=(OUTPUT VARneu,OUTPUT VARalt):CONCR(neu):=old(alt.dsname)END OP:=;PROCdraw(INT CONSTfenster,OUTPUT VARobjekt):SIMSELFILE VARtxt;IF(fenster=fensterganz)COR(fenster=fensteroben)COR(fenster=fensterrechtsoben)COR(fenster=fensterrechts)THENtxt:=objekt.text1.inhaltELIF(fenster=fensterrechtsunten)COR(fenster=fensterunten)THENtxt:=objekt.text2.inhaltFI;setzefensterdaten;schreibeintextfenster;plottetextfenster;.setzefensterdaten:REAL VARlks,rts,un,ob;legefensterfest(objekt,lks,rts,un,ob,fenster);ob:=ob-stdhoehe;INT VARzeilenlaenge:=int((rts-lks)/(stdbreite/verkleinerungbreite));.schreibeintextfenster:PICTURE + VARplotobj:=nilpicture;REAL VARzeile:=ob;INT VARzeiger;TEXT VARzeilentext;zeiger:=1;WHILEzeile>unCAND NOTeof(txt,zeiger)REPgetline(txt,zeiger,zeilentext);movecm(plotobj,lks,zeile);draw(plotobj,subtext(zeilentext,1,zeilenlaenge),0.0,stdhoehe/verkleinerunghoehe+abstand,stdbreite/verkleinerungbreite);zeigerINCR1;zeile:=zeile-(stdhoehe/verkleinerunghoehe)-abstand;PER;.plottetextfenster:viewport(lks,rts,un,ob);window(0.0,1.0,0.0,1.0);beginplot;plot(plotobj);endplot;.END PROCdraw;PROCplot(INT CONSTfenster,OUTPUT VARobj):DIAGRAMM VARdiagramm;IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENdiagramm:=obj.diag(1)ELSEdiagramm:=obj.diag(2)FI;REAL VARx1,x2,y1,y2;IFdiagramm.belegtTHENplottediagr;FI;.plottediagr:legefensterfest(obj,x1,x2,y1,y2,fenster);window(diagramm.xmin,diagramm.xmax,diagramm.ymin,diagramm.ymax);viewport(x1,x2,y1,y2);plotohneclear(diagramm);.END PROCplot;PROClegefensterfest(OUTPUT VARobj,REAL VARlks,rts,un,ob,INT CONSTfensterlage):SELECTfensterlageOF CASEfensterganz:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=horcm-2.0*abstand;un:=hoehe+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=vertcm-hoehe-abstand-obj.standardhoehe;CASEfensteroben:lks:=(3.0*abstand)+2.0*obj.standardbreite;rts:=horcm-abstand;un:=(vertcm/2.0)+(3.0*abstand);ob:=vertcm-hoehe-2.0*abstand;CASEfensterunten:lks:=(3.0*abstand)+2.0*obj.standardbreite;rts:=horcm-abstand;un:=hoehe+(3.0*abstand);ob:=(vertcm/2.0)-2.0*abstand;CASEfensterlinksoben:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=(horcm/2.0)-2.0*abstand;un:=(vertcm/2.0)+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=vertcm-hoehe-abstand-obj.standardhoehe;CASEfensterlinksunten:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=(horcm/2.0)-2.0*abstand;un:=hoehe+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=(vertcm/2.0)-abstand-obj.standardhoehe;CASEfensterrechts:lks:=horcm/2.0+(3.0*abstand)+obj.standardbreite;rts:=horcm-abstand;un:=hoehe+(2.0*abstand);ob:=vertcm-hoehe-2.0*abstand;CASEfensterrechtsoben:lks:=horcm/2.0+(2.0*abstand);rts:=horcm-abstand;un:=(vertcm/2.0)+(2.0*abstand);ob:=vertcm-hoehe-2.0*abstand;CASEfensterrechtsunten:lks:=horcm/2.0+(2.0*abstand);rts:=horcm-abstand;un:=hoehe+(2.0*abstand);ob:=(vertcm/2.0)-2.0*abstand;END SELECT;END PROClegefensterfest;PROClegefensterfest(INT VARlks,rts,un,ob,INT CONSTfensterlage,):SELECTfensterlageOF CASEfensterganz:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=obenerstezeile;CASEfensteroben:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=obenletztezeile;ob:=obenerstezeile;CASEfensterunten:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=untenerstezeile;CASEfensterrechtsoben:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=obenletztezeile;ob:=obenerstezeile;CASEfensterrechtsunten:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=untenerstezeile;CASEfensterrechts:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=obenerstezeile;CASEblockstartwerte:lks:=40+1;rts:=78;un:=12;ob:=3;END SELECT;END PROClegefensterfest;OP:=(DIAGRAMM VARa,DIAGRAMM CONSTb):INT VARi;FORiFROM1UPTOb.anzahlpicturesREPa.inhalt(i):=b.inhalt(i)PER;FORiFROMb.anzahlpictures+1UPTOmaxpicturesREPa.inhalt(i):=nilpicture;PER;FORiFROM1UPTOb.anzahlpicfuerkreuzREPa.kreuz(i):=b.kreuz(i)PER;FORiFROMb.anzahlpicfuerkreuz+1UPTOmaxpicturesREPa.kreuz(i):=nilpicture;PER;a.belegt:=b.belegt;a.anzahlpictures:=b.anzahlpictures;a.anzahlpicfuerkreuz:=b.anzahlpicfuerkreuz;a.xmin:=b.xmin;a.xmax:=b.xmax;a.ymin:=b.ymin;a.ymax:=b.ymax;END OP:=;PROCnilkreuz(OUTPUT VARa,INT CONSTfenster):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENa.diag(1).anzahlpicfuerkreuz:=0;ELSEa.diag(2).anzahlpicfuerkreuz:=0;FI;END PROCnilkreuz;PROCnildiagramm(OUTPUT VARa,INT CONSTfenster):nildiagrammmitkreuz(a,fenster);nilkreuz(a,fenster);END PROCnildiagramm;PROCnildiagrammmitkreuz(OUTPUT VARa,INT CONSTfenster):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENa.diag(1).anzahlpictures:=0;a.diag(1).belegt:=TRUE;IFa.aufbau=strukt1fensterTHENa.text1.belegt:=FALSE FI;ELSEa.diag(2) +.anzahlpictures:=0;a.diag(2).belegt:=TRUE;FI;END PROCnildiagrammmitkreuz;PROCputpicture(OUTPUT VARa,INT CONSTfenster,PICTURE CONSTpic):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THEN IFa.diag(1).anzahlpictureszeilenanzahl(n).END PROCeof;OP:=(SIMSELFILE VARa,FILE VARb):INT VARi;input(b);FORiFROM1UPTOmaxfilezeilenWHILE NOTeof(b)REPgetline(b,a.filezeile(i));PER;a.zeilenanzahl:=i-1;END OP:=;OP:=(SIMSELFILE VARa,SIMSELFILE VARb):INT VARi;FORiFROM1UPTOb.zeilenanzahlREPa.filezeile(i):=b.filezeile(i);PER;a.zeilenanzahl:=b.zeilenanzahl;END OP:=;PROCsimselfile(SIMSELFILE VARsf):sf.zeilenanzahl:=0;END PROCsimselfile;PROCgetline(SIMSELFILE VARsf,INT CONSTzeiger,TEXT VARinhalt):IFzeiger<=sf.zeilenanzahlTHENinhalt:=sf.filezeile(zeiger);FI;END PROCgetline;INT PROCzeilenanzahl(SIMSELFILE VARsf):sf.zeilenanzahl.END PROCzeilenanzahl;BOOL VARframe:=TRUE;PROCsetzerahmen(BOOL CONSTx):frame:=xEND PROCsetzerahmen;TEXT PROCkopfzeilezusammenstellen(TEXT CONSTkopfzeilentext,namedesmodells,INT CONSTlaenge):TEXT VARzeilenanfang:=compress(auskunftstext(produktname))+zwischenraum,produktn:=compress(auskunftstext(produktname)),zeilenende:="";IFlength(namedesmodells)0THENpen(0,stdfarbe,stddicke,pen(pic));plot(pic)FI.END PROCplotohneclear;OP:=(OUTPUT VARneu,DATASPACE CONSTspace):CONCR(neu):=space;END OP:=;PROCforget(OUTPUT VARalt):forget(alt.dsname,quiet);END PROCforget;DATASPACE PROCniloutput(INT CONSTbildaufbau,TEXT CONSTspacename):OUTPUT VARneu;forget(spacename,quiet);neu:=new(spacename);type(old(spacename),typnummer);neu.aufbau:=bildaufbau;neu.dsname:=spacename;neu.text1.belegt:=FALSE;neu.text1.aktzeile:=anfangszeile;simselfile(neu.text1.inhalt);neu.text1.naechsteseite:=anfangszeile;neu.text2.belegt:=FALSE;neu.text2.aktzeile:=anfangszeile;simselfile(neu.text2.inhalt);neu.text2.naechsteseite:=anfangszeile;neu.startwerte.belegt:=FALSE;neu.startwerte.aktzeile:=anfangszeile;simselfile(neu.startwerte.inhalt);neu.startwerte.naechsteseite:=anfangszeile;neu.standardhoehe:=stdhoehe;neu.standardbreite:=stdbreite;neu.sourcewidth:=horcm;neu.sourceheight:=vertcm;neu.diag(1).belegt:=FALSE;neu.diag(1).anzahlpictures:=0;neu.diag(2).anzahlpictures:=0;neu.diag(1).anzahlpicfuerkreuz:=0;neu.diag(2).anzahlpicfuerkreuz:=0;neu.diag(2).belegt:=FALSE;neu.mitrahmen:=TRUE;neu.rahmen:=rahmenmitkreuz(bildaufbau);old(neu.dsname).END PROCniloutput;PROCerstellerahmen:INT VARi;FORiFROM1UPTO6REPrahmenmitkreuz(i):=erstellerahmen(i)PER;END PROCerstellerahmen;PICTURE PROCerstellerahmen(INT CONSTi):PICTURE VARgrenzen;grenzen:=nilpicture;plrahmenunten;plrahmenlinks;plrahmenoben;plrahmenrechts;innererrahmenoben;innererrahmenunten;erstellekreuz;grenzen.plrahmenunten:movecm(grenzen,links,rahmenunten);drawcm(grenzen,rechts,rahmenunten).plrahmenlinks:movecm(grenzen,links,rahmenunten);drawcm(grenzen,links,rahmenoben).plrahmenoben:movecm(grenzen,links,rahmenoben);drawcm(grenzen,rechts,rahmenoben).plrahmenrechts:movecm(grenzen,rechts,rahmenoben);drawcm(grenzen,rechts,rahmenunten).innererrahmenoben:movecm(grenzen,links,oben);drawcm(grenzen,rechts,oben).innererrahmenunten:movecm(grenzen,links,unten);drawcm(grenzen,rechts,unten).erstellekreuz:SELECTiOF CASEstrukt2texte:waagerechtlks;waagerechtrts;CASEstrukttabelleunten: +waagerechtlks;waagerechtrts;senkrechtoben;CASEstrukt4fenster:waagerechtlks;waagerechtrts;senkrechtoben;senkrechtunten;CASEstrukttabelleoben:waagerechtlks;waagerechtrts;senkrechtunten;CASEstrukt2diagramme1text:waagerechtlks;senkrechtoben;senkrechtunten;END SELECT;.waagerechtlks:movecm(grenzen,links,spaltenmitte);drawcm(grenzen,zeilenmitte,spaltenmitte).waagerechtrts:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,rechts,spaltenmitte).senkrechtoben:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,zeilenmitte,oben).senkrechtunten:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,zeilenmitte,unten).END PROCerstellerahmen;PROCplotterahmen(OUTPUT VARoutput):beginplot;clear;pen(hintergrund,vordergrund,stddicke,durchgezogen);viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor*rahmenoben);window(0.0,1.0,0.0,1.0);plot(output.rahmen);endplot;END PROCplotterahmen;PROCplotteoutput(THESAURUS CONSTth):do(PROC(TEXT CONST)plotteoutput,th)END PROCplotteoutput;PROCplotteoutput(TEXT CONSTdsname):enablestop;IFexists(dsname)THEN OUTPUT VARobjekt:=old(dsname)IF NOT(type(old(dsname))=typnummer)THENputline("Datenraum hat falschen Typ!");LEAVEplotteoutput;FI;ELSEputline("Datenraum existiert nicht!");LEAVEplotteoutputFI;setzeabmessungenbezueglichendgeraet;beginplot;clear;viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor*rahmenoben);window(0.0,1.0,0.0,1.0);pen(0,1,0,1);IFobjekt.mitrahmenTHENplot(objekt.rahmen)FI;plottedarstellung;plotend;.setzeabmessungenbezueglichendgeraet:IFwidth>horcmTHENwidth:=horcmFI;height:=(width/objekt.sourcewidth)*objekt.sourceheight;IFheight>vertcmTHENheight:=vertcm;width:=(height/objekt.sourceheight)*objekt.sourcewidthFI;IFobjekt.mitrahmenTHENhoehe:=objekt.standardhoehe+3.0*minyabstandELSEhoehe:=0.0FI;rechts:=objekt.sourcewidth;spaltenmitte:=objekt.sourceheight/2.0;oben:=objekt.sourceheight-hoehe;unten:=hoehe;zeilenmitte:=objekt.sourcewidth/2.0;rahmenoben:=objekt.sourceheight;rahmenunten:=0.0;abstand:=0.1;druckerfaktor:=width/objekt.sourcewidth;cmfaktor(druckerfaktor).plottedarstellung:SELECTobjekt.aufbauOF CASEstrukt1fenster:IFobjekt.text1.belegtTHENdraw(fensterganz,objekt)ELIFobjekt.diag(1).belegtTHENplot(fensterganz,objekt)FI;CASEstrukt2texte:IFobjekt.text1.belegtTHENdraw(fensteroben,objekt);FI;IFobjekt.text2.belegtTHENdraw(fensterunten,objekt);FI;CASEstrukt2diagramme1text:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text1.belegtTHENdraw(fensterrechts,objekt);FI;CASEstrukt4fenster:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text1.belegtTHENdraw(fensterrechtsoben,objekt);FI;IFobjekt.text2.belegtTHENdraw(fensterrechtsunten,objekt);FI;CASEstrukttabelleunten:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.text1.belegtTHENdraw(fensterrechtsoben,objekt);FI;IFobjekt.text2.belegtTHENdraw(fensterunten,objekt);FI;CASEstrukttabelleoben:IFobjekt.text1.belegtTHENdraw(fensteroben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text2.belegtTHENdraw(fensterrechtsunten,objekt);FI;END SELECT.END PROCplotteoutput;PROCendgeraetbreite(REAL CONSTbreite):width:=min(breite,horcm)END PROCendgeraetbreite;REAL PROCendgeraetbreite:widthEND PROCendgeraetbreite;PROCgraphikbreite(OUTPUT CONSTobj,REAL VARpapierbreite,endbreite):papierbreite:=min(vertcm,papierbreite);endbreite:=papierbreite/obj.sourceheight*obj.sourcewidth;IFendbreite>horcmTHENendbreite:=horcm;papierbreite:=endbreite/obj.sourcewidth*obj.sourceheightFI END PROCgraphikbreite;PROCrealarea(TEXT CONSToutputname,REAL VARquellbreite,quellhoehe):OUTPUT VARobj:=old(outputname);quellbreite:=obj.sourcewidth;quellhoehe:=obj.sourceheightEND PROCrealarea;PROCgibzeileaus(PICTURE VARrandzeile):viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor* +rahmenoben);beginplot;plot(randzeile);endplot;END PROCgibzeileaus;OP:=(OUTPUT VARneu,OUTPUT VARalt):CONCR(neu):=old(alt.dsname)END OP:=;PROCdraw(INT CONSTfenster,OUTPUT VARobjekt):SIMSELFILE VARtxt;IF(fenster=fensterganz)COR(fenster=fensteroben)COR(fenster=fensterrechtsoben)COR(fenster=fensterrechts)THENtxt:=objekt.text1.inhaltELIF(fenster=fensterrechtsunten)COR(fenster=fensterunten)THENtxt:=objekt.text2.inhaltFI;setzefensterdaten;schreibeintextfenster;plottetextfenster;.setzefensterdaten:REAL VARlks,rts,un,ob;legefensterfest(objekt,lks,rts,un,ob,fenster);ob:=ob-objekt.standardhoehe;INT VARzeilenlaenge:=int((rts-lks)/(objekt.standardbreite/verkleinerungbreite));.schreibeintextfenster:PICTURE VARplotobj:=nilpicture;REAL VARzeile:=ob;INT VARzeiger;TEXT VARzeilentext;zeiger:=1;WHILEzeile>unCAND NOTeof(txt,zeiger)REPgetline(txt,zeiger,zeilentext);movecm(plotobj,lks,zeile);draw(plotobj,subtext(zeilentext,1,zeilenlaenge),0.0,objekt.standardhoehe/verkleinerunghoehe,objekt.standardbreite/verkleinerungbreite);zeigerINCR1;zeile:=zeile-(objekt.standardhoehe/verkleinerunghoehe)-abstand;PER;.plottetextfenster:viewport(druckerfaktor*lks,druckerfaktor*rts,druckerfaktor*un,druckerfaktor*ob);window(0.0,1.0,0.0,1.0);beginplot;pen(0,stdfarbe,stddicke,durchgezogen);plot(plotobj);endplot;.END PROCdraw;PROCplot(INT CONSTfenster,OUTPUT VARobj):DIAGRAMM VARdiagramm;IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENdiagramm:=obj.diag(1)ELSEdiagramm:=obj.diag(2)FI;REAL VARx1,x2,y1,y2;IFdiagramm.belegtTHENplottediagr;FI;.plottediagr:legefensterfest(obj,x1,x2,y1,y2,fenster);window(diagramm.xmin,diagramm.xmax,diagramm.ymin,diagramm.ymax);viewport(druckerfaktor*x1,druckerfaktor*x2,druckerfaktor*y1,druckerfaktor*y2);plotohneclear(diagramm);.END PROCplot;PROClegefensterfest(OUTPUT VARobj,REAL VARlks,rts,un,ob,INT CONSTfensterlage):SELECTfensterlageOF CASEfensterganz:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=obj.sourcewidth-2.0*abstand;un:=hoehe+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=obj.sourceheight-hoehe-abstand-obj.standardhoehe;CASEfensteroben:lks:=(3.0*abstand)+2.0*obj.standardbreite;rts:=obj.sourcewidth-abstand;un:=(obj.sourceheight/2.0)+(3.0*abstand);ob:=obj.sourceheight-hoehe-2.0*abstand;CASEfensterunten:lks:=(3.0*abstand)+2.0*obj.standardbreite;rts:=obj.sourcewidth-abstand;un:=hoehe+(3.0*abstand);ob:=(obj.sourceheight/2.0)-2.0*abstand;CASEfensterlinksoben:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=(obj.sourcewidth/2.0)-2.0*abstand;un:=(obj.sourceheight/2.0)+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=obj.sourceheight-hoehe-abstand-obj.standardhoehe;CASEfensterlinksunten:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=(obj.sourcewidth/2.0)-2.0*abstand;un:=hoehe+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=(obj.sourceheight/2.0)-abstand-obj.standardhoehe;CASEfensterrechts:lks:=obj.sourcewidth/2.0+(3.0*abstand)+obj.standardbreite;rts:=obj.sourcewidth-abstand;un:=hoehe+(2.0*abstand);ob:=obj.sourceheight-hoehe-2.0*abstand;CASEfensterrechtsoben:lks:=obj.sourcewidth/2.0+(2.0*abstand);rts:=obj.sourcewidth-abstand;un:=(obj.sourceheight/2.0)+(2.0*abstand);ob:=obj.sourceheight-hoehe-2.0*abstand;CASEfensterrechtsunten:lks:=obj.sourcewidth/2.0+(2.0*abstand);rts:=obj.sourcewidth-abstand;un:=hoehe+(2.0*abstand);ob:=(obj.sourceheight/2.0)-2.0*abstand;END SELECT;END PROClegefensterfest;PROClegefensterfest(INT VARlks,rts,un,ob,INT CONSTfensterlage,):SELECTfensterlageOF CASEfensterganz:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=obenerstezeile;CASEfensteroben:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=obenletztezeile;ob:=obenerstezeile;CASEfensterunten:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=untenerstezeile;CASEfensterrechtsoben:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=obenletztezeile;ob:=obenerstezeile;CASEfensterrechtsunten:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=untenerstezeile;CASEfensterrechts:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=obenerstezeile; +CASEblockstartwerte:lks:=40+1;rts:=78;un:=12;ob:=3;END SELECT;END PROClegefensterfest;OP:=(DIAGRAMM VARa,DIAGRAMM CONSTb):INT VARi;FORiFROM1UPTOb.anzahlpicturesREPa.inhalt(i):=b.inhalt(i)PER;FORiFROMb.anzahlpictures+1UPTOmaxpicturesREPa.inhalt(i):=nilpicture;PER;FORiFROM1UPTOb.anzahlpicfuerkreuzREPa.kreuz(i):=b.kreuz(i)PER;FORiFROMb.anzahlpicfuerkreuz+1UPTOmaxpicturesREPa.kreuz(i):=nilpicture;PER;a.belegt:=b.belegt;a.anzahlpictures:=b.anzahlpictures;a.anzahlpicfuerkreuz:=b.anzahlpicfuerkreuz;a.xmin:=b.xmin;a.xmax:=b.xmax;a.ymin:=b.ymin;a.ymax:=b.ymax;END OP:=;BOOL PROCeof(SIMSELFILE VARn,INT CONSTaktuellezeile):aktuellezeile>zeilenanzahl(n).END PROCeof;OP:=(SIMSELFILE VARa,FILE VARb):INT VARi;input(b);FORiFROM1UPTOmaxfilezeilenWHILE NOTeof(b)REPgetline(b,a.filezeile(i));PER;a.zeilenanzahl:=i-1;END OP:=;OP:=(SIMSELFILE VARa,SIMSELFILE VARb):INT VARi;FORiFROM1UPTOb.zeilenanzahlREPa.filezeile(i):=b.filezeile(i);PER;a.zeilenanzahl:=b.zeilenanzahl;END OP:=;PROCsimselfile(SIMSELFILE VARsf):sf.zeilenanzahl:=0;END PROCsimselfile;PROCgetline(SIMSELFILE VARsf,INT CONSTzeiger,TEXT VARinhalt):IFzeiger<=sf.zeilenanzahlTHENinhalt:=sf.filezeile(zeiger);FI;END PROCgetline;INT PROCzeilenanzahl(SIMSELFILE VARsf):sf.zeilenanzahl.END PROCzeilenanzahl;END PACKEToutput; + diff --git a/app/schulis-simulationssystem/3.0/src/simsel basis plot b/app/schulis-simulationssystem/3.0/src/simsel basis plot new file mode 100644 index 0000000..a4bf17d --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/simsel basis plot @@ -0,0 +1,4 @@ +PACKETsimselbasisplotDEFINEStransform,setvalues,getvalues,getparameter,putparameter,newvalues,drawingarea,window,viewport,view,box,move,draw,mover,drawr,movecm,drawcm,movecmr,drawcmr,kreispunkte,circle,where:BOOL VARnewlimits:=TRUE,valuesnew:=TRUE,perspectiveprojektion:=FALSE;INT VARpixelhor,pixelvert;REAL VARdisplayhor,displayvert,sizehor,sizevert;drawingarea(sizehor,sizevert,pixelhor,pixelvert);displayhor:=real(pixelhor);displayvert:=real(pixelvert);REAL VARhminlimit:=0.0,hmaxlimit:=displayhor,vminlimit:=0.0,vmaxlimit:=displayvert,hmin:=0.0,hmax:=sizehor,vmin:=0.0,vmax:=sizevert,horrelation:=displayhor/sizehor,vertrelation:=displayvert/sizevert,relation:=sizehor/sizevert;ROW5ROW5REAL VARp:=ROW5ROW5REAL:(ROW5REAL:(1.0,0.0,0.0,0.0,0.0),ROW5REAL:(0.0,1.0,0.0,0.0,0.0),ROW5REAL:(0.0,0.0,1.0,0.0,0.0),ROW5REAL:(0.0,0.0,0.0,1.0,0.0),ROW5REAL:(0.0,0.0,0.0,0.0,1.0));ROW3ROW2REAL VARsized:=ROW3ROW2REAL:(ROW2REAL:(0.0,1.0),ROW2REAL:(0.0,1.0),ROW2REAL:(0.0,1.0));ROW2ROW2REAL VARlimitsd:=ROW2ROW2REAL:(ROW2REAL:(0.0,relation),ROW2REAL:(0.0,1.0));ROW4REAL VARanglesd:=ROW4REAL:(0.0,0.0,0.0,0.0);ROW2REAL VARobliqued:=ROW2REAL:(0.0,0.0);ROW3REAL VARperspectived:=ROW3REAL:(0.0,0.0,0.0);REAL VARsizehord:=sizehor,sizevertd:=sizevert;INT VARpixelhord:=pixelhor,pixelvertd:=pixelvert;INT VARi,j;REAL VARkreisschritt:=18.0;PROCkreispunkte(INT CONSTp):kreisschritt:=360.0/real(p)END PROCkreispunkte;BOOL OP=(ROW3ROW2REAL CONSTl,r):FORiFROM1UPTO3REP IFl[i][1]<>r[i][1]ORl[i][2]<>r[i][2]THEN LEAVE=WITH FALSE FI PER;TRUE END OP=;BOOL OP=(ROW2ROW2REAL CONSTl,r):FORiFROM1UPTO2REP IFl[i][1]<>r[i][1]ORl[i][2]<>r[i][2]THEN LEAVE=WITH FALSE FI PER;TRUE END OP=;BOOL OP=(ROW2REAL CONSTl,r):l[1]=r[1]ANDl[2]=r[2]END OP=;BOOL OP=(ROW3REAL CONSTl,r):l[1]=r[1]ANDl[2]=r[2]ANDl[3]=r[3]END OP=;BOOL OP=(ROW4REAL CONSTl,r):l[1]=r[1]ANDl[2]=r[2]ANDl[3]=r[3]ANDl[4]=r[4]END OP=;PROCwindow(BOOL CONSTdev):newlimits:=devEND PROCwindow;PROCwindow(REAL CONSTxmin,xmax,ymin,ymax):window(xmin,xmax,ymin,ymax,0.0,1.0)END PROCwindow;PROCwindow(REAL CONSTxmin,xmax,ymin,ymax,zmin,zmax):setvalues(ROW3ROW2REAL:(ROW2REAL:(xmin,xmax),ROW2REAL:(ymin,ymax),ROW2REAL:(zmin,zmax)),limitsd,anglesd,obliqued,perspectived)END PROCwindow;PROCviewport(REAL CONSThmin,hmax,vmin,vmax):setvalues(sized,ROW2ROW2REAL:(ROW2REAL:(hmin,hmax),ROW2REAL:(vmin,vmax)),anglesd,obliqued,perspectived)END PROCviewport;PROCview(REAL CONSTalpha):setvalues(sized,limitsd,ROW4REAL:(alpha,anglesd(2),anglesd(3),anglesd(4)),obliqued,perspectived)END PROCview;PROCview(REAL CONSTphi,theta):setvalues(sized,limitsd,ROW4REAL:(anglesd(1),sind(theta)*cosd(phi),sind(theta)*sind(phi),cosd(theta)),obliqued,perspectived)END PROCview;PROCview(REAL CONSTx,y,z):setvalues(sized,limitsd,ROW4REAL:(anglesd(1),x,y,z),obliqued,perspectived)END PROCview;setvalues(sized,limitsd,anglesd,obliqued,perspectived);PROCdrawingarea(REAL VARminh,maxh,minv,maxv):minh:=hminlimit;maxh:=hmaxlimit;minv:=vminlimit;maxv:=vmaxlimitEND PROCdrawingarea;BOOL PROCnewvalues:IFvaluesnewTHENvaluesnew:=FALSE;TRUE ELSE FALSE FI END PROCnewvalues;PROCgetparameter(ROW5ROW5REAL VARvalues):values:=p;END PROCgetparameter;PROCputparameter(ROW5ROW5REAL CONSTvalues):p:=values;END PROCputparameter;PROCgetvalues(ROW3ROW2REAL VARsize,ROW2ROW2REAL VARlimits,ROW4REAL VARangles,ROW2REAL VARoblique,ROW3REAL VARperspective):size:=sized;limits:=limitsd;angles:=anglesd;oblique:=obliqued;perspective:=perspectived;END PROCgetvalues;PROCsetvalues(ROW3ROW2REAL CONSTsize,ROW2ROW2REAL CONSTlimits,ROW4REAL CONSTangles,ROW2REAL CONSToblique,ROW3REAL CONSTperspective):drawingarea(sizehor,sizevert,pixelhor,pixelvert);displayhor:=real(pixelhor);displayvert:=real(pixelvert);IF NOTsamevaluesTHENvaluesnew:=TRUE;copyvalues;setviews;checkperspectiveprojektion;calclimits;changeprojektionFI.samevalues:sizehord=sizehorANDsizevertd=sizevertANDpixelhord=pixelhorANDpixelvertd=pixelvertANDsized=sizeANDlimitsd=limitsANDanglesd=anglesANDobliqued=obliqueANDperspectived=perspective.copyvalues:sizehord:=sizehor;sizevertd:= +sizevert;pixelhord:=pixelhor;pixelvertd:=pixelvert;hmaxlimit:=displayhor;vmaxlimit:=displayvert;hmax:=sizehor;vmax:=sizevert;horrelation:=displayhor/sizehor;vertrelation:=displayvert/sizevert;relation:=sizehor/sizevert;sized:=size;limitsd:=limits;anglesd:=angles;obliqued:=oblique;perspectived:=perspective.setviews:REAL VARdiagonale:=sqrt(angles[2]*angles[2]+angles[3]*angles[3]+angles[4]*angles[4]),projektion:=sqrt(angles[2]*angles[2]+angles[4]*angles[4]),sinp,cosp,sint,cost,sina,cosa;IFdiagonale=0.0THENsinp:=0.0;cosp:=1.0;sint:=0.0;cost:=1.0ELIFprojektion=0.0THENsinp:=angles[3]/diagonale;cosp:=projektion/diagonale;sint:=0.0;cost:=1.0ELSEsinp:=angles[3]/diagonale;cosp:=projektion/diagonale;sint:=angles[2]/projektion;cost:=angles[4]/projektionFI;REAL VARsinpsint:=sinp*sint,sinpcost:=sinp*cost,cospsint:=cosp*sint,cospcost:=cosp*cost,dx:=size[1][2]-size[1][1],dy:=size[2][2]-size[2][1],dz:=size[3][2]-size[3][1],normaz:=oblique[1],normbz:=oblique[2],normcx:=perspective[1]/dx,normcy:=perspective[2]/dy,normcz:=perspective[3]/dz;p:=ROW5ROW5REAL:(ROW5REAL:(cost/dx-cospsint/dx*normaz,-sinpsint/dx-cospsint/dx*normbz,0.0,-cospsint/dx*normcz,0.0),ROW5REAL:(-sinp/dy*normaz,cosp/dy-sinp/dy*normbz,0.0,-sinp/dy*normcz,0.0),ROW5REAL:(sint/dz+cospcost/dz*normaz,+sinpcost/dz+cospcost/dz*normbz,0.0,cospcost/dz*normcz,0.0),ROW5REAL:(-normcx,-normcy,0.0,1.0,0.0),ROW5REAL:(0.0,0.0,0.0,0.0,1.0));IFangles(1)=0.0THENsetalphaasyverticalELSEsina:=sind(angles(1));cosa:=cosd(angles(1))FI;FORjFROM1UPTO5REP REAL CONSTpj1:=p(j)(1);p(j)(1):=pj1*cosa-p(j)(2)*sina;p(j)(2):=pj1*sina+p(j)(2)*cosaPER.setalphaasyvertical:REAL VARr:=sqrt(p(2)(1)**2+p(2)(2)**2);IFr=0.0THENsina:=0.0;cosa:=1.0ELSEsina:=-p(2)(1)/r;cosa:=p(2)(2)/rFI.checkperspectiveprojektion:perspectiveprojektion:=perspective[3]<>0.0.calclimits:IFnewlimitsTHENcalctwodimextrema;IFalllimitssmallerthan2THENprozenteELSEzentimeterFI FI.calctwodimextrema:hmin:=maxreal;hmax:=-maxreal;vmin:=maxreal;vmax:=-maxreal;extrema(size[1][1],size[2][1],size[3][1],hmin,hmax,vmin,vmax);extrema(size[1][2],size[2][1],size[3][1],hmin,hmax,vmin,vmax);extrema(size[1][2],size[2][2],size[3][1],hmin,hmax,vmin,vmax);extrema(size[1][1],size[2][2],size[3][1],hmin,hmax,vmin,vmax);extrema(size[1][1],size[2][1],size[3][2],hmin,hmax,vmin,vmax);extrema(size[1][2],size[2][1],size[3][2],hmin,hmax,vmin,vmax);extrema(size[1][2],size[2][2],size[3][2],hmin,hmax,vmin,vmax);extrema(size[1][1],size[2][2],size[3][2],hmin,hmax,vmin,vmax).alllimitssmallerthan2:limits(1)(2)<2.0ANDlimits(2)(2)<2.0.prozente:hminlimit:=displayhor*limits(1)(1)/relation;hmaxlimit:=displayhor*limits(1)(2)/relation;vminlimit:=limits(2)(1)*displayvert;vmaxlimit:=limits(2)(2)*displayvert.zentimeter:hminlimit:=displayhor*(limits(1)(1)/sizehor);hmaxlimit:=displayhor*(limits(1)(2)/sizehor);vminlimit:=displayvert*(limits(2)(1)/sizevert);vmaxlimit:=displayvert*(limits(2)(2)/sizevert).changeprojektion:REAL VARsh:=(hmaxlimit-hminlimit)/(hmax-hmin),sv:=(vmaxlimit-vminlimit)/(vmax-vmin),dh:=hminlimit-hmin*sh,dv:=vminlimit-vmin*sv;FORjFROM1UPTO5REPp(j)(1):=p(j)(1)*sh;p(j)(2):=p(j)(2)*svPER;p(5)(1):=dh;p(5)(2):=dv.END PROCsetvalues;PROCtransform(REAL CONSTx,y,z,INT VARh,v):disablestop;IFperspectiveprojektionTHEN REAL CONSTw:=1.0/(x*p(1)(4)+y*p(2)(4)+z*p(3)(4)+1.0);h:=int((x*p(1)(1)+y*p(2)(1)+z*p(3)(1)+p(4)(1))*w+p(5)(1));v:=int((x*p(1)(2)+y*p(2)(2)+z*p(3)(2)+p(4)(2))*w+p(5)(2))ELSEh:=int(x*p(1)(1)+y*p(2)(1)+z*p(3)(1)+p(5)(1));v:=int(x*p(1)(2)+y*p(2)(2)+z*p(3)(2)+p(5)(2));FI;IFiserrorTHENh:=-1;v:=-1;clearerror;FI;enablestop;END PROCtransform;PROCextrema(REAL CONSTx,y,z,REAL VARhmin,hmax,vmin,vmax):REAL VARh,v;IFperspectiveprojektionTHEN REAL CONSTw:=1.0/(x*p(1)(4)+y*p(2)(4)+z*p(3)(4)+1.0);h:=(x*p(1)(1)+y*p(2)(1)+z*p(3)(1)+p(4)(1))*w;v:=(x*p(1)(2)+y*p(2)(2)+z*p(3)(2)+p(4)(2))*wELSEh:=(x*p(1)(1)+y*p(2)(1)+z*p(3)(1));v:=(x*p(1)(2)+y*p(2)(2)+z*p(3)(2))FI;IFhhmaxTHENhmax:=hFI;IFvvmaxTHENvmax:=vFI END PROCextrema;LET POS=STRUCT(REALx,y,z);POS VARpos:=POS +:(0.0,0.0,0.0);INT VARh:=0,v:=0;PROCbox:move(int(hminlimit+0.5),int(vminlimit+0.5));draw(int(hmaxlimit+0.5),int(vminlimit+0.5));draw(int(hmaxlimit+0.5),int(vmaxlimit+0.5));draw(int(hminlimit+0.5),int(vmaxlimit+0.5));draw(int(hminlimit+0.5),int(vminlimit+0.5))END PROCbox;PROCmove(REAL CONSTx,y):transform(x,y,0.0,h,v);move(h,v);pos:=POS:(x,y,0.0)END PROCmove;PROCdraw(REAL CONSTx,y):transform(x,y,0.0,h,v);draw(h,v);pos:=POS:(x,y,0.0)END PROCdraw;PROCmover(REAL CONSTx,y):transform(pos.x+x,pos.y+y,pos.z,h,v);move(h,v);pos:=POS:(pos.x+x,pos.y+y,pos.z)END PROCmover;PROCdrawr(REAL CONSTx,y):transform(pos.x+x,pos.y+y,pos.z,h,v);draw(h,v);pos:=POS:(pos.x+x,pos.y+y,pos.z)END PROCdrawr;PROCmovecm(REAL CONSTxcm,ycm):h:=int(xcm*horrelation+0.5);v:=int(ycm*vertrelation+0.5);move(h,v)END PROCmovecm;PROCdrawcm(REAL CONSTxcm,ycm):h:=int(xcm*horrelation+0.5);v:=int(ycm*vertrelation+0.5);draw(h,v);END PROCdrawcm;PROCmovecmr(REAL CONSTxcm,ycm):hINCRint(xcm*horrelation+0.5);vINCRint(ycm*vertrelation+0.5);move(h,v)END PROCmovecmr;PROCdrawcmr(REAL CONSTxcm,ycm):hINCRint(xcm*horrelation+0.5);vINCRint(ycm*vertrelation+0.5);draw(h,v)END PROCdrawcmr;PROCwhere(REAL VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;PROCcircle(REAL CONSTr,from,to,INT CONSTpattern):REAL VARt:=from;INT VARi,j;transform(pos.x,pos.y,0.0,h,v);i:=h;j:=v;h:=i+int(horrelation*r*cosd(t));v:=j+int(vertrelation*r*sind(t));WHILEt<=toREPh:=i+int(horrelation*r*cosd(t));v:=j+int(vertrelation*r*sind(t));draw(h,v);tINCRkreisschrittPER;draw(h,v).END PROCcircle;ENDPACKETsimselbasisplot; + diff --git a/app/schulis-simulationssystem/3.0/src/simsel cga plot b/app/schulis-simulationssystem/3.0/src/simsel cga plot new file mode 100644 index 0000000..03b2685 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/simsel cga plot @@ -0,0 +1,3 @@ +PACKEToldproceduresDEFINESoldout,oldcursor,oldgetcursor:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETcgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,clear,pen,move,draw,out,cursor,getcursor,zeichensatz:LEThorfaktor=29.09091,vertfaktor=14.59854,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,anzahlx=640,anzahly=200,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.525167,buchstabenbreite:=0.275;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IF(textcopySUB1)>code(31)THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die CGA-Karte (oder eine kompatible");putline("Karte, z.B. EGA-Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE;ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE;ENDPROCplotend;PROCclear:control(-5,6,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):pos.xDRAWpos.y;control(-6,x,anzahly-1-y,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x; +yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,anzahly-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,anzahly-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):INT VARxwert,ywert;IFx>anzahlx-1THENxwert:=anzahlx-1ELIFx<0THENxwert:=0ELSExwert:=xFI;IFy>anzahly-1THENywert:=anzahly-1ELIFy<0THENywert:=0ELSEywert:=yFI;x:=xwert;y:=ywert;END PROCgrenzkontrolle;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;END PACKETcgaplot;zeichensatz("ZEICHEN 8*8") + diff --git a/app/schulis-simulationssystem/3.0/src/simsel ega plot b/app/schulis-simulationssystem/3.0/src/simsel ega plot new file mode 100644 index 0000000..07f7fe3 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/simsel ega plot @@ -0,0 +1,3 @@ +PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETegaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,clear,pen,move,draw,cursor,getcursor,out,zeichensatz:LEThorfaktor=29.09091,vertfaktor=25.54745,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=350,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die EGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARx,y):xcm:=22.0;ycm:=13.7;x:=xpixel-1;y:=ypixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,16,0,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,-1,foregroundcode,dummy).foregroundcode:IFforeground=deleteTHEN0ELSElinetypecodeFI.linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:15CASEgepunktet:1CASEkurzgestrichelt:2CASElanggestrichelt:3CASEstrichpunkt:4OTHERWISElinetypeEND SELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):xDRAWy;pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y,xold:=xpos,yold:=ypos;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;xoldMOVEyold;pos.x:=xold;pos.y:=yold;.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];pos.xMOVEpos.y;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExpos+xDRAWypos+yFI;pos.x:=xpos+x;pos.y:=ypos+y;PER;xposINCRxstep;yposINCRystep;pos.x:=xpos;pos.y:=ypos;.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ypixel-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,ypixel-1-ywert,dummy);control(-6,pos.x,ypixel-1-pos.y,dummy);control(-7,xwert,ypixel-1-ywert,dummy)END OP DRAW;PROC +grenzkontrolle(INT VARx,y):INT VARxwert,ywert;IFx>xpixel-1THENxwert:=xpixel-1ELIFx<0THENxwert:=0ELSExwert:=xFI;IFy>ypixel-1THENywert:=ypixel-1ELIFy<0THENywert:=0ELSEywert:=yFI;x:=xwert;y:=ywert;END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=ypixel-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>xpixelDIVzeichen.widthTHENtextcopy:=subtext(text,1,xpixelDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>xpixelDIVzeichen.widthTHENspalte:=xpixelDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>ypixelDIVzeichen.heightTHENzeile:=ypixelDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;END PACKETegaplot;zeichensatz("ZEICHEN 8*14") + diff --git a/app/schulis-simulationssystem/3.0/src/simsel formulare b/app/schulis-simulationssystem/3.0/src/simsel formulare new file mode 100644 index 0000000..b7a1377 Binary files /dev/null and b/app/schulis-simulationssystem/3.0/src/simsel formulare differ diff --git a/app/schulis-simulationssystem/3.0/src/simsel hercules plot b/app/schulis-simulationssystem/3.0/src/simsel hercules plot new file mode 100644 index 0000000..b0b61a3 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/simsel hercules plot @@ -0,0 +1,3 @@ +PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETsimselherculesplotDEFINESbeginplot,endplot,clear,move,draw,stdhoehe,stdbreite,pen,plotend,zeichensatz,cursor,getcursor,out,terminalkorrekt,drawingarea:LEThorfaktor=30.6383,vertfaktor=19.33333,bit14=16384,anzahlx=720,anzahly=348;INT VARxalt,yalt;ROW5INT VARzaehler:=ROW5INT:(0,0,0,0,0),i:=zaehler;INT VARlinientyp:=0,foreground:=0,background:=0;INT VARdummy;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=23.5;ycm:=18.0;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:0.72END PROCstdhoehe;REAL PROCstdbreite:0.29375END PROCstdbreite;PROCbeginplot:xalt:=0;yalt:=0;graphicon:=TRUE END PROCbeginplot;PROCendplot:END PROCendplot;PROCclear:control(-5,512,0,dummy);pen(0,1,0,1);move(0,0);END PROCclear;PROCplotend:control(-5,2,0,dummy);graphicon:=FALSE END PROCplotend;PROCpen(INT CONSTb,f,t,l):IF NOT(f=0)THENforeground:=1ELSEforeground:=0;FI;linientyp:=l;SELECTfOF CASE0:loeschstift;CASE1:sichtbarelinien;ENDSELECT.loeschstift:control(-9,0,0,dummy);control(-10,0,0,dummy).sichtbarelinien:SELECTlOF CASE0:CASE1:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy);CASE2:control(-9,257,257,dummy);control(-10,257,257,dummy);CASE3:control(-9,17,17,dummy);control(-10,17,17,dummy);CASE4:control(-9,0,4369,dummy);control(-10,0,4369,dummy);CASE5:control(-9,256,4369,dummy);control(-10,256,4369,dummy);OTHERWISE:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy);ENDSELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEyEND PROCmove;PROCdraw(INT CONSTx,y):xDRAWyEND PROCdraw;ZEICHENSATZ VARzeichen;INT VARxfak,yfak;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichenELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=xalt,ypos:=yalt,x0:=xalt,y0:=yalt,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;x0MOVEy0.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+yELSExpos+xDRAWypos+yFI PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):control(-7,x,347-y,dummy);xalt:=x;yalt:=y;END OP MOVE;OP DRAW(INT CONSTx,y):IFlinientyp>0THENcontrol(-11,foreground,zaehler(linientyp),i(linientyp));control(-6,xalt,347-yalt,dummy);control(-6,x,347-y,dummy);control(-11,foreground,zaehler(linientyp),i(linientyp));zaehler(linientyp):=((i(linientyp)-2)MOD16);FI;xalt:=x;yalt:=y;END OP DRAW;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIV +zeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an ");putline("Bildschirmen mit HERCULES-Karte arbeiten.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;END PACKETsimselherculesplot;zeichensatz("ZEICHEN 9*14") + diff --git a/app/schulis-simulationssystem/3.0/src/simsel picture b/app/schulis-simulationssystem/3.0/src/simsel picture new file mode 100644 index 0000000..52ee52d --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/simsel picture @@ -0,0 +1,3 @@ +PACKETsimselpictureDEFINES PICTURE,:=,CAT,nilpicture,cmfaktor,draw,drawr,drawcm,drawcmr,move,mover,movecm,movecmr,circle,length,dim,pen,where,extrema,rotate,stretch,translate,text,picture,plot:LETdrawkey=1,movekey=2,textkey=3,moverkey=4,drawrkey=5,movecmkey=6,drawcmkey=7,movecmrkey=8,drawcmrkey=9,circlekey=11,max2dim=31983,maxtext=31974,maxbar=31982,maxcircle=31974,maxlength=32000;TYPE PICTURE=STRUCT(INTdim,pen,TEXTpoints);INT VARreadpos;REAL VARx,y,z,fak:=1.0;TEXT VARr2:=16*"�",r3:=24*"�",i1:="��",i2:="����";OP:=(PICTURE VARl,PICTURE CONSTr):CONCR(l):=CONCR(r)END OP:=;OP CAT(PICTURE VARl,PICTURE CONSTr):IFl.dim<>r.dimTHENerrorstop("OP CAT : left dimension <> right dimension")ELIFlength(l.points)>maxlength-length(r.points)THENerrorstop("OP CAT : Picture overflow")FI;l.pointsCATr.pointsEND OP CAT;PICTURE PROCnilpicture:PICTURE:(2,1,"")END PROCnilpicture;PROCdraw(PICTURE VARp,TEXT CONSTtext):draw(p,text,0.0,0.0,0.0)END PROCdraw;PROCcmfaktor(REAL CONSTn):fak:=nEND PROCcmfaktor;PROCdraw(PICTURE VARp,TEXT CONSTtext,REAL CONSTangle,height,bright):write(p,text,angle,height,bright,textkey)END PROCdraw;PROCdraw(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawkey)END PROCdraw;PROCdrawr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawrkey)END PROCdrawr;PROCdrawcm(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawcmkey)END PROCdrawcm;PROCdrawcmr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawcmrkey)END PROCdrawcmr;PROCmove(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movekey)END PROCmove;PROCmover(PICTURE VARp,REAL CONSTx,y):write(p,x,y,moverkey)END PROCmover;PROCmovecm(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movecmkey)END PROCmovecm;PROCmovecmr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movecmrkey)END PROCmovecmr;PROCcircle(PICTURE VARp,REAL CONSTradius,from,to,INT CONSTpattern):write(p,radius,from,to,pattern,circlekey)END PROCcircle;PROCwrite(PICTURE VARp,REAL CONSTx,y,INT CONSTkey):IFlength(p.points)=length(t)THENp.pointsCATcode(key);replace(i1,1,length(t));p.pointsCATi1;p.pointsCATt;replace(r3,1,angle);replace(r3,2,height);replace(r3,3,bright);p.pointsCATr3FI;END PROCwrite;INT PROClength(PICTURE CONSTp):length(p.points)END PROClength;INT PROCdim(PICTURE CONSTpic):pic.dimEND PROCdim;PROCpen(PICTURE VARp,INT CONSTpen):IFpen<0ORpen>16THENerrorstop("pen out of range [0-16]")FI;p.pen:=penEND PROCpen;INT PROCpen(PICTURE CONSTp):p.penEND PROCpen;PROCwhere(PICTURE CONSTp,REAL VARx,y):IFp.dim=0THENx:=0.0;y:=0.0ELIFp.dim=3THENerrorstop("Picture is 3 dimensional")ELSEx:=subtext(p.points,length(p.points)-15,length(p.points)-8)RSUB1;y:=subtext(p.points,length(p.points)-7,length(p.points))RSUB1FI END PROCwhere;PROCextrema(PICTURE CONSTp,REAL VARxmin,xmax,ymin,ymax):xmin:=maxreal;xmax:=-maxreal;ymin:=maxreal;ymax:=-maxreal;readpos:=0;INT CONSTpiclength:=length(p.points);WHILEreadpos0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ypixel-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y; +grenzkontrolle(xwert,ywert);control(-6,xwert,ypixel-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):INT VARxwert,ywert;IFx>xpixel-1THENxwert:=xpixel-1ELIFx<0THENxwert:=0ELSExwert:=xFI;IFy>ypixel-1THENywert:=ypixel-1ELIFy<0THENywert:=0ELSEywert:=yFI;x:=xwert;y:=ywert;END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;END PACKETvgaplot;zeichensatz("ZEICHEN 8*19") + diff --git a/app/schulis-simulationssystem/3.0/src/simsel.druckermenu b/app/schulis-simulationssystem/3.0/src/simsel.druckermenu new file mode 100644 index 0000000..16f983e --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/simsel.druckermenu @@ -0,0 +1,2 @@ +PACKETdruckermenuDEFINESdruckeingang,druckezeichnungen,loeschezeichnungen,stellezeichenbreiteein,definieredruckerkanal,stoppedrucker,plottereingestellt:LETdepottaskname="SIMSEL-PRINTERDEPOT",druckprocindex=1,loeschprocindex=2,untenlinks=3,zentral=5,bell="�",abbruch="!",niltext="",arbeitertaskname="workertask",minimalekanalnr=2,maximalekanalnr=32,text1="Bitte warten bis der letzte Druckauftrag bearbeitet ist.",text2="Drucken von Zeichnungen",text3="Auswahl der Zeichnungen durch ankreuzen",text4="Löschen von Zeichnungen",text5="Sollen die ausgewählten Zeichnungen gelöscht werden",text6="Die Zeichnungen werden gelöscht: ",text7=" Wert zwischen 5.0 cm und ",text8=" cm eingeben! ",text9=" Bitte Zahl zwischen 2 und 32 für Kanalnummer des Druckers eingeben! ",text10="Speicher für Zeichnungen ist nicht eingerichtet.",text11="Ist für die nächste Zeichnung Papier eingelegt",text12="Auswahl einer Zeichnung durch ankreuzen";TEXT VARzeichnungsname;TASK VARarbeitertask,depottask;BOOL VARplotteraktiv:=TRUE;THESAURUS VARauswahl;PROCdruckeingang:IF NOTexiststask(depottaskname)THENerrorstop(text10)END IF;depottask:=/depottaskname;IFhighestentry(ALLdepottask)=0THENdeactivate(druckprocindex);deactivate(loeschprocindex)ELSEactivate(druckprocindex);activate(loeschprocindex)END IF END PROCdruckeingang;PROCdruckezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEdruckezeichnungenEND IF;IF NOTplottereingestelltTHENauswahl:=menusome(ALLdepottask,text2,text3,TRUE);IFnotempty(auswahl)THENbegin(arbeitertaskname,PROCzeichnungendrucken,arbeitertask)END IF ELSEzeichnungsname:=menuone(ALLdepottask,text2,text12,TRUE);IFzeichnungsname<>niltextCANDmenuyes(text11,zentral)THENbegin(arbeitertaskname,PROCdruckeeinezeichnung,arbeitertask)END IF END IF END PROCdruckezeichnungen;PROCzeichnungendrucken:disablestop;fetch(auswahl,depottask);plotteoutput(auswahl);end(myself)END PROCzeichnungendrucken;PROCdruckeeinezeichnung:disablestop;fetch(zeichnungsname,depottask);plotteoutput(zeichnungsname);end(myself)END PROCdruckeeinezeichnung;PROCloeschezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEloeschezeichnungenEND IF;auswahl:=menusome(ALLdepottask,text4,text3,TRUE);IF NOTnotempty(auswahl)THEN LEAVEloeschezeichnungenEND IF;IFmenuyes(text5,zentral)THENcommanddialogue(FALSE);footnote(text6);cursor(36,24);erase(auswahl,depottask);commanddialogue(TRUE);oldfootnote;druckeingangEND IF END PROCloeschezeichnungen;PROCstellezeichenbreiteein:LETminimum=5.0;REAL VARmaximum,maxlaenge,breite;INT VARxpixel,ypixel;TEXT VAReingabe;drawingarea(maximum,maxlaenge,xpixel,ypixel);maximum:=floor(maximum);IFendgeraetbreite>maximumTHENendgeraetbreite(maximum)END IF;REPeingabe:=menuanswer(text7+text(maximum)+text8,text(endgeraetbreite),zentral);IFcompress(eingabe)=niltextTHEN LEAVEstellezeichenbreiteeinEND IF;breite:=real(eingabe);IFlastconversionokCANDbreite>=minimumCANDbreite<=maximumTHENendgeraetbreite(breite);LEAVEstellezeichenbreiteeinEND IF;out(bell)END REP END PROCstellezeichenbreiteein;PROCdefinieredruckerkanal:TEXT VAReingabe;INT VARnr;REPeingabe:=menuanswer(text9,text(plotterkanal),zentral);IFcompress(eingabe)=niltextTHEN LEAVEdefinieredruckerkanalEND IF;nr:=int(eingabe);IFlastconversionokCANDnr>=minimalekanalnrCANDnr<=maximalekanalnrTHENplotterkanal(nr);LEAVEdefinieredruckerkanalEND IF;out(bell)END REP END PROCdefinieredruckerkanal;PROCstoppedrucker:IFexiststask(arbeitertaskname)THENend(/arbeitertaskname)END IF END PROCstoppedrucker;PROCplottereingestellt(BOOL CONSTwert):plotteraktiv:=wertEND PROCplottereingestellt;BOOL PROCplottereingestellt:plotteraktivEND PROCplottereingestellt;END PACKETdruckermenu; + diff --git a/app/schulis-simulationssystem/3.0/src/simsel.text als row b/app/schulis-simulationssystem/3.0/src/simsel.text als row new file mode 100644 index 0000000..0bdc52d --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/simsel.text als row @@ -0,0 +1,2 @@ +PACKETtextalsrowDEFINESins,del,CAT,ipos,dump,replaceiac,VSUB,VISUB:LETnil13byte="�������������",nil4byte="����",nilbyte="�";TEXT VARg1,code2:="��";PROCins(TEXT VARrow,INT CONSTwo,was):replace(code2,1,was);g1:=subtext(row,2*wo-1);row:=subtext(row,1,2*wo-2);rowCATcode2;rowCATg1END PROCins;PROCdel(TEXT VARrow,INT CONSTwo):g1:=subtext(row,2*wo+1);row:=subtext(row,1,2*wo-2);rowCATg1END PROCdel;OP CAT(TEXT VARrow,INT CONSTwas):replace(code2,1,was);rowCATcode2END OP CAT;INT PROCipos(TEXT CONSTrow,INT CONSTwas):INT VARstart:=0;replace(code2,1,was);REPstart:=pos(row,code2,start+1)UNTILstartMOD2=1ORstart=0PER;(start+1)DIV2END PROCipos;PROCdump(TEXT VARrow):INT VARi;FORiFROM1UPTOlength(row)DIV2REPput(rowISUBi)PER END PROCdump;PROCreplaceiac(TEXT VARstring,INT CONSTwo,TEXT CONSTwas):IF LENGTHstring<=LENGTHwas+wo-1THENstretch(string,LENGTHwas+wo-1)FI;replace(string,wo,was)END PROCreplaceiac;PROCstretch(TEXT VARt,INT CONSTwo):WHILE LENGTHt<=wo-13REPtCATnil13bytePER;WHILE LENGTHt<=wo-4REPtCATnil4bytePER;WHILE LENGTHt0END REP.werteeingabeaus:SELECTrangOF CASE1:fuehresimselsystemausCASE2:fuehredruckermenuausCASE3:installieresimselsystemCASE4:installieredruckeranpassungOTHERWISE LEAVEstartsystemEND SELECT.fuehresimselsystemaus:IF NOTsimselsysteminstalliertTHENout(bell);gibmeldung(meldung1);LEAVEfuehresimselsystemausEND IF;uebergibbildschirm(mbverwtask,ebenembvbehandeln).fuehredruckermenuaus:IF NOTgraphikdruckerinstalliertTHENout(bell);gibmeldung(meldung2);LEAVEfuehredruckermenuausEND IF;uebergibbildschirm(/printertaskname,systemstarten).installieredruckeranpassung:IF NOTsimselsysteminstalliertTHENout(bell);gibmeldung(meldung43);LEAVEinstallieredruckeranpassungEND IF;IFgraphikdruckerinstalliertCAND NOTja(meldung25)THEN LEAVEinstallieredruckeranpassungEND IF;startprinterinstallation;IFiserrorTHENclearerror;gibmeldung(errormessage);ELSEzeigeinstallationsergebnis(titel3,graphikdruckerinstalliert)END IF END PROCstartsystem;PROCinstallieresimselsystem:IF NOTkorrektespasswordTHEN LEAVEinstallieresimselsystemEND IF;IFsimselsysteminstalliertCAND NOTja(meldung24)THEN LEAVEinstallieresimselsystemEND IF;startsimselinstallation;zeigeinstallationsergebnis(titel2,simselsysteminstalliert);IFsimselsysteminstalliertTHENdefinierepasswordEND IF;graphikdruckerinstalliert:=FALSE.END PROCinstallieresimselsystem;PROCstartsimselinstallation:INT VARi;bestimmegraphicundhalbgraphic;IF NOTerforderlichesystemdateieneingelesenTHENerrorstop(meldung49)END IF; +loescheggfvorhandenetasks;stellebeziehungzulsmenukartenher;richtesicherungstasksein;sicheredateien;meldeinstallationsbeginn;richtelstaskein;richtesimulationstaskein;richtembverwtaskein;loeschedepottask.bestimmegraphicundhalbgraphic:graphicart:=graphikkarte;ibmsatz:=ja(meldung23).loescheggfvorhandenetasks:IFexiststask(depottaskname)THENend(/depottaskname)END IF;IFexiststask(lstaskname)THENend(/lstaskname)END IF.stellebeziehungzulsmenukartenher:IF NOTexiststask(lsmktaskname)THENerrorstop(meldung49)ELSElsmktask:=/lsmktasknameEND IF.richtesicherungstasksein:begin(depottaskname,PROCfreeglobalmanager,depottask);IF NOTexiststask(umstelltaskname)THENerrorstop(meldung49)ELSEumstelltask:=/umstelltasknameEND IF.sicheredateien:commanddialogue(FALSE);save(menukarte,lsmktask);save(maskenname,lsmktask);save(textdsname,lsmktask);save(archivinhalt,depottask);FORiFROM1UPTOanzahldruckerdsREP IF NOTexists(druckerdatei(i),umstelltask)THENsave(druckerdatei(i),umstelltask)END IF END REP;forget(archivinhalt).meldeinstallationsbeginn:zeigetitelzeile(titel2);cursor(15,10);out(meldung30);cursor(15,12);out(meldung31+text(anzahlgesamt)+" Dateien");installationszaehler:=0.richtelstaskein:begin(lstaskname,PROCinstallls,lstask);FORiFROM1UPTOanzahllsprocsREPinsertiereprogramme(lstask)END REP.richtesimulationstaskein:REP UNTILexiststask(simulationstaskname)CANDstatus(/simulationstaskname)=2END REP;simulationstask:=/simulationstaskname;FORiFROM1UPTOanzahlsimprocsREPinsertiereprogramme(simulationstask)END REP.richtembverwtaskein:REP UNTILexiststask(mbverwtaskname)CANDstatus(/mbverwtaskname)=2END REP;mbverwtask:=/mbverwtaskname;FORiFROM1UPTOanzahlmbverwprocsREPinsertiereprogramme(mbverwtask)END REP.loeschedepottask:end(depottask)END PROCstartsimselinstallation;BOOL PROCerforderlichesystemdateieneingelesen:LETdateien=60,nichtgeladen="0",geladen="1";ROWdateienTEXT CONSTsystemdatei:=ROWdateienTEXT:("simsel cga plot","simsel ega plot","simsel vga plot","simsel hercules plot","ZEICHEN 8*8","ZEICHEN 9*14","ZEICHEN 8*19","ZEICHEN 8*14","ZEICHEN 6*10","ZEICHEN 8*16","simsel formulare","TEXTE deutsch","ls-MENUKARTE:Simsel","ls-DIALOG 1.korrektur","ls-DIALOG 2.simsel","ls-DIALOG 3.korrektur","ls-DIALOG 4.wd","ls-DIALOG 5.korrektur","ls-DIALOG 5.simsel","spool cmd","mat.xerox4045 plot","mat.epson-sq plot","mat.epson-fx plot","mat.binder plot","mat.kyocera plot","mat.laserjet plot","mat.hp72xx plot","mat.hp74xx plot","simsel.druckermenu","ls zustaende parameter kurve","ls dateiscroll","modellbasis geraet","modellwerte","ls bildschirmeingaben","simsel basis plot","simsel picture","ls dialoghilfen","output","output test","ls co routinen und co","steuerung","ls demonstration","ls kombination","ls simulation","ltbearb","neue startschl","ls starte bearbeitung","simsel.text als row","ls simsel.masken","e","g","bs","o","m","op1","op2","modellbasis dialog","ls dp1","dp2","ls simselstarter");TEXT VARanweisung:=meldung50,pruefleiste:=dateien*nichtgeladen;TEXT CONSTziel:=dateien*geladen,anpassung:=mathekuerzel+graphicart+plotkuerzel;INT VARi,zaehler:=1;THESAURUS VARdiskinhalt;zeigetitelzeile(titel2);archivinhalt:=emptythesaurus;FORiFROM1UPTO4REP IFsystemdatei(i)<>anpassungTHENreplace(pruefleiste,i,geladen)END IF END REP;REPwarteaufeingabe;FORiFROM1UPTOdateienREP IF(pruefleisteSUBi)=nichtgeladenCAND(diskinhaltCONTAINSsystemdatei(i))THENladediedateiEND IF END REP;anweisung:=meldung54UNTILpruefleiste=zielEND REP;abschlussaktivitaeten;TRUE.zeigetexte:cursor(8,8);out(meldung44);cursor(8,9);out(anweisung);cursor(8,10);out(meldung51);cursor(8,12);out(meldung52);cursor(8,13);out(meldung53).warteaufeingabe:TEXT VARch;REPzeigetexte;inchar(ch);IFch=abbruchTHENrelease(archive);LEAVEerforderlichesystemdateieneingelesenWITH FALSE ELIFch=weiterTHENdisablestop;cursor(8,9);out(del);cursor(8,10);out(del);cursor(8,12);out(del);cursor(8,13);out(del);cursor(8,15);out(del);archive(archivname);diskinhalt:=ALLtestarchive;IFiserrorTHENclearerror;cursor(8,15);out(meldung47);enablestop;ELSEenablestop;LEAVE +warteaufeingabeEND IF ELSEout(bell)END IF END REP.ladediedatei:cursor(8,9);out(meldung27+text(zaehler)+" von "+text(dateien-3)+" Dateien");fetch(systemdatei(i),testarchive);replace(pruefleiste,i,geladen);insert(archivinhalt,systemdatei(i));zaehlerINCR1.abschlussaktivitaeten:release(archive);cursor(8,8);out(meldung28+del);cursor(8,9);out(meldung29+del);pause(50).testarchive:archive.END PROCerforderlichesystemdateieneingelesen;PROCinstallls:INT VARi;FORiFROM1UPTOanzahllsprocsREPinsertiere(vorlaufdatei(i),depottask)END REP;IFibmsatzTHENdo(ibmzeichensatz)ELSEdo(stdsatzzeichen)END IF;begin(simulationstaskname,PROCinstallsimulationstask,simulationstask);begin(mbverwtaskname,PROCinstallmodellbankverwaltung,mbverwtask);disablestop;REP REPwarteaufauftragUNTILordercode>=drucker1erzeugenCANDordercode<=drucker8erzeugenEND REP;druckerindex:=ordercode-druckererzeugen;begin(printertaskname,PROCinstallprinter,printertask);gibantwort(ok)END REP END PROCinstallls;PROCinstallsimulationstask:ROWanzahlsimprocsTEXT CONSTsimproc:=ROWanzahlsimprocsTEXT:("ls dateiscroll",mathekuerzel+graphicart+plotkuerzel,"ls dialoghilfen","modellbasis geraet","modellwerte","ls bildschirmeingaben","simsel basis plot","simsel picture","output","ls co routinen und co","steuerung","ls demonstration","ls kombination","ls simulation","ltbearb","ls-DIALOG 5.simsel","neue startschl","ls starte bearbeitung");TEXT CONSTzugehoerendezeichen:=passenderzeichensatz;holenotfalls(zugehoerendezeichen,depottask);INT VARi;FORiFROM1UPTOanzahlsimprocsREPinsertiere(simproc(i),depottask)END REP;forget(zugehoerendezeichen,quiet);do(startschleifeaufrufen);.passenderzeichensatz:IFgraphicart="vga"THEN"ZEICHEN 8*19"ELIFgraphicart="ega"THEN"ZEICHEN 8*14"ELIFgraphicart="cga"THEN"ZEICHEN 8*8"ELSE"ZEICHEN 9*14"END IF.END PROCinstallsimulationstask;PROCinstallmodellbankverwaltung:ROWanzahlmbverwprocsTEXT CONSTdname:=ROWanzahlmbverwprocsTEXT:("ls dateiscroll","ls-DIALOG 5.korrektur","ls dialoghilfen","simsel.text als row","ls simsel.masken","e","g","bs","o","m","op1","op2","modellbasis dialog","ls dp1","dp2","ls simselstarter");INT VARi;insertierembverwsystem;beendeinstallation.insertierembverwsystem:FORiFROM1UPTOanzahlmbverwprocsREPinsertiere(dname(i),depottask)PER;do(menuankoppeln);.beendeinstallation:commanddialogue(FALSE);forget(all-textdsname-maskenname);commanddialogue(TRUE);disablestop;REP REPwarteaufauftragUNTILordercode=ebenembvbehandelnEND REP;continue(arbeitskanal);do(ebenembvhandle);gibbildschirmfrei(ok)END REP;END PROCinstallmodellbankverwaltung;PROCstartprinterinstallation:loescheggfvorhandenetask;bestimmedruckeranpassung;meldeinstallationsbeginn;richtedruckertasksein.loescheggfvorhandenetask:IFexiststask(printertaskname)THENend(/printertaskname)END IF.bestimmedruckeranpassung:druckerindex:=druckertreiber.meldeinstallationsbeginn:INT VARende:=anzahlpriprocs;IFdruckerindex>6THENendeDECR1END IF;zeigetitelzeile(titel2);cursor(15,10);out(meldung42);cursor(15,12);out(meldung31+text(ende)+" Dateien");installationszaehler:=0.richtedruckertasksein:INT VARi;IF NOTexiststask(pridepottaskname)THENbegin(pridepottaskname,PROCfreeglobalmanager,pridepottask)END IF;lstask:=/lstaskname;rufe(lstask,druckererzeugen+druckerindex);REP UNTILexiststask(printertaskname)CANDstatus(/printertaskname)=2END REP;printertask:=/printertaskname;FORiFROM1UPTOendeREPinsertiereprogramme(printertask)END REP END PROCstartprinterinstallation;PROCinstallprinter:LETanzahlzeichensaetze=3;ROWanzahlpriprocsTEXT CONSTprogramm:=ROWanzahlpriprocsTEXT:(druckerdatei(4),druckerdatei(4+druckerindex),druckerdatei(13),druckerdatei(14),druckerdatei(15),druckerdatei(16),druckerdatei(17),druckerdatei(18));INT VARi;BOOL VARplotterwirdinstalliert:=druckerindex>6;IF NOTplotterwirdinstalliertTHENholezeichensaetzeEND IF;insertieredieeinzelnenprogramme;do(menuankoppeln);abschlussaktivitaet.holezeichensaetze:FORiFROM1UPTOanzahlzeichensaetzeREPholenotfalls(druckerdatei(i),/umstelltaskname)PER.insertieredieeinzelnenprogramme:INT VARanfang:=1;IF +plotterwirdinstalliertTHENanfang:=2END IF;FORiFROManfangUPTOanzahlpriprocsREPinsertiere(programm(i),/umstelltaskname)END REP.abschlussaktivitaet:IF NOTplotterwirdinstalliertTHEN FORiFROM1UPTOanzahlzeichensaetzeREPforget(druckerdatei(i),quiet)END REP END IF;IFplotterwirdinstalliertTHENdo(plotterein)ELSEdo(plotteraus)END IF;disablestop;REP REPwarteaufauftragUNTILordercode=systemstartenEND REP;continue(arbeitskanal);do(druckmenuhandle);gibbildschirmfrei(ok)END REP END PROCinstallprinter;PROCinsertiereprogramme(TASK VARzieltask):installationszaehlerINCR1;cursor(40,12);out(text(installationszaehler));rufe(zieltask,insertieren);IFantwort<>okTHENerrorstop(meldung32)END IF END PROCinsertiereprogramme;PROCinsertiere(TEXT CONSTname,TASK CONSTherkunft):REPwarteaufauftragUNTILordercode=insertierenEND REP;disablestop;holenotfalls(name,herkunft);insert(name);forget(name,quiet);IFiserrorTHENclearerror;gibantwort(fehler)ELSEgibantwort(ok)END IF;enablestopEND PROCinsertiere;PROCholenotfalls(TEXT CONSTname,TASK CONSTherkunft):IF NOTexists(name)THENfetch(name,herkunft)END IF END PROCholenotfalls;PROCrufe(TASK CONSTzieltask,INT CONSTauftrag):messageds:=nilspace;call(zieltask,auftrag,messageds,antwort);forget(messageds)END PROCrufe;PROCwarteaufauftrag:wait(messageds,ordercode,ordertask);forget(messageds)END PROCwarteaufauftrag;PROCgibantwort(INT CONSTantwortcode):messageds:=nilspace;send(ordertask,antwortcode,messageds);END PROCgibantwort;PROCuebergibbildschirm(TASK CONSTt,INT CONSTauftrag):break(quiet);rufe(t,auftrag);continue(arbeitskanal)END PROCuebergibbildschirm;PROCgibbildschirmfrei(INT CONSTantwortcode):break(quiet);gibantwort(antwortcode)END PROCgibbildschirmfrei;TEXT PROCgraphikkarte:LETanzahlplotprocs=4;ROWanzahlplotprocsTEXT CONSTplotname:=ROWanzahlplotprocsTEXT:("hercules","cga","ega","vga");INT VARi:=1,zeile;commanddialogue(TRUE);zeigetitelzeile(titel2);FORzeileFROM6UPTO17REPcursor(16,zeile);out(menu2(zeile-5))END REP;REPcursor(16,20);out(invers(text(plotname(i),11)));IFyes(meldung33)THENcommanddialogue(FALSE);LEAVEgraphikkarteWITHplotname(i)END IF;i:=iMODanzahlplotprocs+1END REP;plotname(i)END PROCgraphikkarte;INT PROCdruckertreiber:LETanzahlplotterprocs=8;ROWanzahlplotterprocsTEXT CONSTplotname:=ROWanzahlplotterprocsTEXT:("xerox4045","epson-sq","epson-fx","binder","kyocera","laserjet","hp72xx","hp74xx");INT VARi,zeile;commanddialogue(TRUE);zeigetitelzeile(titel3);FORzeileFROM3UPTO16REPcursor(16,zeile);out(menu3(zeile-2))END REP;i:=1;REPcursor(16,20);out(invers(text(plotname(i),11)));IFyes(meldung33)THENcommanddialogue(FALSE);LEAVEdruckertreiberWITHiEND IF;i:=iMODanzahlplotterprocs+1END REP;iEND PROCdruckertreiber;PROCzeigetitelzeile(TEXT CONSTfktbezeichner):TEXT CONSTzeile:=text(systemname,78-length(fktbezeichner))+fktbezeichner;page;cursor(1,1);out(invers(text(zeile,79)))END PROCzeigetitelzeile;PROCzeigeinstallationsergebnis(TEXT CONSTziel,BOOL VARerfolg):zeigetitelzeile(ziel);IFiserrorTHENclearerror;gibmeldung(meldung22);erfolg:=FALSE ELSEgibmeldung(meldung21);erfolg:=TRUE END IF END PROCzeigeinstallationsergebnis;PROCgibmeldung(TEXT CONSTmeldungstext):cursor(1,23);out(meldungstext);cursor(1,24);out(invers(text(meldung26,77)));clearbuffer;pauseEND PROCgibmeldung;PROCclearbuffer:REP UNTILincharety=niltextPER END PROCclearbuffer;BOOL PROCja(TEXT CONSTfrage):BOOL VARantwort;commanddialogue(TRUE);cursor(1,22);antwort:=yes(frage);cursor(1,22);out(del);commanddialogue(FALSE);antwortEND PROCja;TEXT PROCinvers(TEXT CONSTt):beginmark+t+endmarkEND PROCinvers;BOOL PROCkorrektespassword:installationspassword=niltextCORpasswordgetroffen.passwordgetroffen:TEXT VAReingabe;cursor(24,18);out(meldung45+del);getsecretline(eingabe);IFeingabe=installationspasswordTHENcursor(24,18);out(del);LEAVEpasswordgetroffenWITH TRUE END IF;out(bell);FALSE END PROCkorrektespassword;PROCdefinierepassword:installationspassword:=niltext;cursor(1,23);out(delpage);IFja(meldung46)THENcursor(1,23);out(meldung45+beginmark+left);editget(installationspassword,40,20);out( +endmark)END IF END PROCdefinierepassword;END PACKETsimselverwaltung; + diff --git a/app/schulis-simulationssystem/3.0/src/spool cmd b/app/schulis-simulationssystem/3.0/src/spool cmd new file mode 100644 index 0000000..966ab79 --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/spool cmd @@ -0,0 +1,3 @@ +PACKETspoolcmdDEFINESspoolcontrolpassword,killspool,firstspool,startspool,stopspool,haltspool,waitforhalt:LETerrornak=2,entrylinecode=23,killercode=24,firstcode=25,startcode=26,stopcode=27,haltcode=28,waitforhaltcode=29;DATASPACE VARds;BOUND STRUCT(TEXTentryline,INTindex,TEXTactualentries,password)VARcontrolmsg;BOUND TEXT VARerrormsg;INT VARreply;INITFLAG VARinthistask:=FALSE;BOOL VARdialogue;TEXT VARcontrolpassword,password;controlpassword:="";PROCspoolcontrolpassword(TEXT CONSTnewpassword):IFonlineTHENsay("� �")FI;disablestop;do("enterspoolcontrolpassword(""+newpassword+"")");clearerror;nodoagain;covertracks;covertracks(controlpassword);controlpassword:=newpassword;END PROCspoolcontrolpassword;PROCcallspool(INT CONSTopcode,TEXT CONSTname,TASK CONSTspool):dialogue:=commanddialogue;password:=writepassword;passwordCAT"/";passwordCATreadpassword;disablestop;commanddialogue(FALSE);enterpassword(controlpassword);commanddialogue(dialogue);call(opcode,name,spool);commanddialogue(FALSE);enterpassword(password);commanddialogue(dialogue);END PROCcallspool;PROCstartspool(TASK CONSTspool):enablestop;callspool(haltcode,"",spool);callspool(startcode,"",spool);END PROCstartspool;PROCstartspool(TASK CONSTspool,INT CONSTnewchannel):enablestop;callspool(haltcode,"",spool);callspool(startcode,text(newchannel),spool);END PROCstartspool;PROCstopspool(TASK CONSTspool):callspool(stopcode,"",spool);END PROCstopspool;PROCstopspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(stopcode,deactivemsg,spool);END PROCstopspool;PROChaltspool(TASK CONSTspool):callspool(haltcode,"",spool);END PROChaltspool;PROChaltspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(haltcode,deactivemsg,spool);END PROChaltspool;PROCwaitforhalt(TASK CONSTspool):callspool(waitforhaltcode,"",spool);END PROCwaitforhalt;PROCwaitforhalt(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(waitforhaltcode,deactivemsg,spool);END PROCwaitforhalt;PROCcontrolspool(TASK CONSTspool,INT CONSTcontrolcode,TEXT CONSTquestion,BOOL CONSTleave):enablestop;initializecontrolmsg;WHILEvalidspoolentryREP IFcontrolquestionTHENcontrolspoolentryFI PER;.initializecontrolmsg:IF NOTinitialized(inthistask)THENds:=nilspaceFI;forget(ds);ds:=nilspace;controlmsg:=ds;controlmsg.entryline:="";controlmsg.password:=controlpassword;controlmsg.index:=0;say(" +");.validspoolentry:call(spool,entrylinecode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;controlmsg.index<>0.controlquestion:say(controlmsg.entryline);yes(question).controlspoolentry:call(spool,controlcode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;IFleaveTHEN LEAVEcontrolspoolFI;END PROCcontrolspool;PROCkillspool(TASK CONSTspool):controlspool(spool,killercode," loeschen",FALSE)END PROCkillspool;PROCfirstspool(TASK CONSTspool):controlspool(spool,firstcode," als erstes",TRUE)END PROCfirstspool;END PACKETspoolcmd; + diff --git a/app/schulis-simulationssystem/3.0/src/steuerung b/app/schulis-simulationssystem/3.0/src/steuerung new file mode 100644 index 0000000..94e029c --- /dev/null +++ b/app/schulis-simulationssystem/3.0/src/steuerung @@ -0,0 +1,6 @@ +PACKETsteuerungDEFINESsteuerprozessfuereineloesung,steuerprozessfuerzweiloesungen:LETesc="�",hop="�",rechts="�",links="�",plotten="p",tasteblaettern="b",tasteblaetternoben="o",tasteblaetternunten="u",piepton="�",plottask="SIMSEL-PRINTERDEPOT",initialisieren=0,kreuzerzeugen=1,anfpunktloeschen=4,bildschirminhaltplotten=5,abschluss=6,warten1=0,warten2=1;LETfusszeileleer=0;DATASPACE VARdsco1,dsco2;KURVE VARk1,k2;REAL VARzeitt1,zeitt2;ZUSTAND VARzustand1,zustand2;PROCsteuerprozessfuereineloesung(OUTPUT VARseite,KURVE VARk,ZUSTAND CONSTmaske1,maske2,INT CONSTfenster1,fenster2,kopfzeile,steuerzeile,TEXT CONSTtasteninnen,tastenraus,TEXT VARabbruchtaste,PROC(OUTPUT VAR,INT CONST,KURVE VAR,REAL VAR,ZUSTAND VAR,ZUSTAND VAR,DATASPACE VAR,INT VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,BOOL VAR)coroutine1,PROC(OUTPUT VAR,INT CONST,KURVE VAR,REAL VAR,ZUSTAND VAR,ZUSTAND VAR,DATASPACE VAR,INT VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,BOOL VAR)coroutine2):TEXT VARtaste;REAL VARzeitt,null:=0.0;BOOL VARauto1,auto2,vorwaertslesen,richtungswechsel;ZUSTAND VARzustand,maske1intern,maske2intern;INT VARmerker,co1wastun,co1wastunalt,co2wastun,co2wastunalt;vorwaertsundrueckwaerts;fuehreabschlussarbeitenaus.vorwaertsundrueckwaerts:INT VARinternerzustand:=0;initialisieredensteuerprozess;initialisierecoroutine1;initialisierecoroutine2;leseersten(k,zeitt,zustand);internerzustand:=4;REPvorwaerts;rueckwaertsPER.fuehreabschlussarbeitenaus:schliessecoroutine1ab;schliessecoroutine2ab.initialisieredensteuerprozess:forget(dsco1);forget(dsco2);dsco1:=nilspace;dsco2:=nilspace;auto1:=FALSE;auto2:=FALSE;vorwaertslesen:=TRUE;maske1intern:=maske1;maske2intern:=maske2;merker:=warten1;gebeaufbildschirmaus(seite,modellkurzbezeichnung,kopfzeile,fusszeileleer);beginplot;plottefusszeile(seite,steuerzeile);endplot.initialisierecoroutine1:co1wastun:=initialisieren;coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1);co1wastun:=kreuzerzeugen;coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1).initialisierecoroutine2:co2wastun:=initialisieren;coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2);co2wastun:=kreuzerzeugen;coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2).vorwaerts:REP SELECTinternerzustandOF CASE4:vorwaerts4CASE9:vorwaerts9CASE13:vorwaerts13ENDSELECT;liesoderwarteaufbenutzereingaben;IFrichtungswechselTHEN LEAVEvorwaertsFI;internerzustand:=neuervzustand;PER.rueckwaerts:REP SELECTinternerzustandOF CASE4:rueckwaerts4CASE9:rueckwaerts9CASE13:rueckwaerts13ENDSELECT;liesoderwarteaufbenutzereingaben;IFrichtungswechselTHEN LEAVErueckwaertsFI;internerzustand:=neuerrzustand;PER.vorwaerts4:uebergibpunktancoroutine1;uebergibpunktancoroutine2.vorwaerts9:lesenaechsten(k,zeitt,zustand);uebergibpunktancoroutine1;uebergibpunktancoroutine2.vorwaerts13:merker:=warten2.rueckwaerts4:uebergibpunktancoroutine1;uebergibpunktancoroutine2;merker:=warten2.rueckwaerts9:lesevorherigen(k,zeitt,zustand);uebergibpunktancoroutine1;uebergibpunktancoroutine2.rueckwaerts13:.uebergibpunktancoroutine1:coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1).uebergibpunktancoroutine2:coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2).neuervzustand:SELECTinternerzustandOF CASE4:iznach4vCASE9:iznach9vCASE13:13OTHERWISE0ENDSELECT.neuerrzustand:SELECTinternerzustandOF CASE4:4CASE9:iznach9rCASE13:iznach13rOTHERWISE0ENDSELECT.iznach4v:IFendederloesung(k)THEN13ELSE9FI.iznach9v:iznach4v.iznach9r:IFanfangderloesung(k)THEN4ELSE9FI.iznach13r:9.liesoderwarteaufbenutzereingaben:REPliesbenutzereingaben(taste,tasteninnen,tastenraus,merker);IFtaste<>""THENinterpretieretasteundfuehreaktionausELSErichtungswechsel:=FALSE;LEAVEliesoderwarteaufbenutzereingabenFI;PER.interpretieretasteundfuehreaktionaus:IF(pos(tastenraus,taste)>0)THENabbruchtaste:=taste;LEAVE +vorwaertsundrueckwaertsFI;IFtaste=rechtsTHENrichtungswechsel:=NOTvorwaertslesen;vorwaertslesen:=TRUE;LEAVEliesoderwarteaufbenutzereingabenELIFtaste=linksTHENrichtungswechsel:=vorwaertslesen;vorwaertslesen:=FALSE;LEAVEliesoderwarteaufbenutzereingabenELIFtaste=plottenTHENplotteloesungskurveELIFtaste=tasteblaetternTHENblaettern(seite);out(hop)ELIFtaste=tasteblaetternobenTHENblaetternoben(seite);out(hop)ELIFtaste=tasteblaetternuntenTHENblaetternunten(seite);out(hop)FI.plotteloesungskurve:nildiagrammmitkreuz(seite,fenster1);nildiagrammmitkreuz(seite,fenster2);co1wastunalt:=co1wastun;co1wastun:=bildschirminhaltplotten;coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1);co1wastun:=co1wastunalt;co2wastunalt:=co2wastun;co2wastun:=bildschirminhaltplotten;coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2);co2wastun:=co2wastunalt;versendeoutput(seite,modellkurzbezeichnung,kopfzeile,steuerzeile,plottask);piep.piep:out(piepton).schliessecoroutine1ab:co1wastun:=abschluss;coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1).schliessecoroutine2ab:co2wastun:=abschluss;coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2).END PROCsteuerprozessfuereineloesung;PROCsteuerprozessfuerzweiloesungen(OUTPUT VARseite,KURVE VARkurve1,kurve2,ZUSTAND CONSTmaske,INT CONSTfenster1,fenster2,kopfzeile,steuerzeile,TEXT CONSTtasteninnen,tastenraus,TEXT VARabbruchtaste,PROC(OUTPUT VAR,INT CONST,KURVE VAR,REAL VAR,ZUSTAND VAR,ZUSTAND VAR,DATASPACE VAR,INT VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,BOOL VAR)coroutine,PROC(OUTPUT VAR,KURVE VAR,KURVE VAR,ZUSTAND VAR,INT CONST,INT CONST,ROW4INT VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,BOOL VAR)kreuzvergleich):LETmaxloe=4;ROWmaxloeINT VARposition;TEXT VARtaste;BOOL VARautomatik,vorwaertslesen,richtungswechsel;ZUSTAND VARmaskeintern;INT VARco1wastun,co1wastunalt,co2wastun,co2wastunalt,merker;REAL VARx1min,x1max,x2min,x2max,ymin,ymax;k1:=kurve1;k2:=kurve2;vorwaertsundrueckwaerts.vorwaertsundrueckwaerts:INT VARinternerzustand:=0;initialisieredensteuerprozess;initialisierediecoroutinedoppelt;leseersten(k1,zeitt1,zustand1);leseersten(k2,zeitt2,zustand2);internerzustand:=internerzustandnach0v;REPvorwaerts;rueckwaertsPER.initialisieredensteuerprozess:forget(dsco1);forget(dsco2);dsco1:=nilspace;dsco2:=nilspace;automatik:=FALSE;merker:=warten1;vorwaertslesen:=TRUE;maskeintern:=maske;gebeaufbildschirmaus(seite,modellkurzbezeichnung,kopfzeile,fusszeileleer);beginplot;plottefusszeile(seite,steuerzeile);kreuzvergleich(seite,k1,k2,maskeintern,fenster1,fenster2,position,x1min,x1max,x2min,x2max,ymin,ymax,automatik);endplot.initialisierediecoroutinedoppelt:co1wastun:=initialisieren;coroutine(seite,fenster1,k1,zeitt1,maskeintern,zustand1,dsco1,co1wastun,x1min,x1max,ymin,ymax,automatik);co2wastun:=initialisieren+10;coroutine(seite,fenster2,k2,zeitt2,maskeintern,zustand2,dsco2,co2wastun,x2min,x2max,ymin,ymax,automatik).vorwaerts:REP SELECTinternerzustandOF CASE1:vorwaerts1CASE2:vorwaerts2CASE3:vorwaerts3CASE4:vorwaerts4CASE5:vorwaerts5CASE6:vorwaerts6CASE7:vorwaerts7CASE8:vorwaerts8CASE9:vorwaerts9CASE10:vorwaerts10CASE11:vorwaerts11CASE12:vorwaerts12CASE13:vorwaerts13ENDSELECT;liesoderwarteaufbenutzereingaben;IFrichtungswechselTHEN LEAVEvorwaertsFI;internerzustand:=neuervzustand;PER.rueckwaerts:REP SELECTinternerzustandOF CASE1:rueckwaerts1CASE2:rueckwaerts2CASE3:rueckwaerts3CASE4:rueckwaerts4CASE5:rueckwaerts5CASE6:rueckwaerts6CASE7:rueckwaerts7CASE8:rueckwaerts8CASE9:rueckwaerts9CASE10:rueckwaerts10CASE11:rueckwaerts11CASE12:rueckwaerts12CASE13:rueckwaerts13ENDSELECT;liesoderwarteaufbenutzereingaben;IFrichtungswechselTHEN LEAVErueckwaertsFI;loescheggfanfpunkteinerkurve;internerzustand:=neuerrzustand;PER.neuervzustand:SELECTinternerzustandOF CASE1:internerzustandnach1vCASE2:internerzustandnach2vCASE3:internerzustandnach3vCASE4: +internerzustandnach4vCASE5:internerzustandnach5vCASE6:internerzustandnach6vCASE7:internerzustandnach7vCASE8:internerzustandnach8vCASE9:internerzustandnach9vCASE10:internerzustandnach10vCASE11:internerzustandnach11vCASE12:internerzustandnach12vCASE13:13OTHERWISE0ENDSELECT.neuerrzustand:SELECTinternerzustandOF CASE1:1CASE2:internerzustandnach2rCASE3:internerzustandnach3rCASE4:4CASE5:5CASE6:internerzustandnach6rCASE7:internerzustandnach7rCASE8:internerzustandnach8rCASE9:internerzustandnach9rCASE10:internerzustandnach10rCASE11:internerzustandnach11rCASE12:internerzustandnach12rCASE13:internerzustandnach13rOTHERWISE0ENDSELECT.loescheggfanfpunkteinerkurve:SELECTinternerzustandOF CASE3:loescheerstenfuerkurve2CASE7:loescheerstenfuerkurve1ENDSELECT.vorwaerts1:zeichnefuerkurve1.vorwaerts2:lesenaechsten(k1,zeitt1,zustand1);zeichnefuerkurve1.vorwaerts3:zeichnefuerkurve2.vorwaerts4:zeichnefuerkurve1;zeichnefuerkurve2.vorwaerts5:zeichnefuerkurve2.vorwaerts6:lesenaechsten(k2,zeitt2,zustand2);zeichnefuerkurve2.vorwaerts7:zeichnefuerkurve1.vorwaerts8:lesenaechsten(k1,zeitt1,zustand1);zeichnefuerkurve1.vorwaerts9:lesenaechsten(k1,zeitt1,zustand1);lesenaechsten(k2,zeitt2,zustand2);zeichnefuerkurve1;zeichnefuerkurve2.vorwaerts10:lesenaechsten(k2,zeitt2,zustand2);zeichnefuerkurve2.vorwaerts11:lesenaechsten(k2,zeitt2,zustand2);zeichnefuerkurve2.vorwaerts12:lesenaechsten(k1,zeitt1,zustand1);zeichnefuerkurve1.vorwaerts13:merker:=warten2.rueckwaerts1:zeichnefuerkurve1;merker:=warten2.rueckwaerts2:lesevorherigen(k1,zeitt1,zustand1);zeichnefuerkurve1.rueckwaerts3:zeichnefuerkurve2.rueckwaerts4:zeichnefuerkurve1;zeichnefuerkurve2;merker:=warten2.rueckwaerts5:zeichnefuerkurve2;merker:=warten2.rueckwaerts6:lesevorherigen(k2,zeitt2,zustand2);zeichnefuerkurve2.rueckwaerts7:zeichnefuerkurve1.rueckwaerts8:lesevorherigen(k1,zeitt1,zustand1);zeichnefuerkurve1.rueckwaerts9:lesevorherigen(k1,zeitt1,zustand1);zeichnefuerkurve1;lesevorherigen(k2,zeitt2,zustand2);zeichnefuerkurve2.rueckwaerts10:lesevorherigen(k2,zeitt2,zustand2);zeichnefuerkurve2.rueckwaerts11:lesevorherigen(k2,zeitt2,zustand2);zeichnefuerkurve2.rueckwaerts12:lesevorherigen(k1,zeitt1,zustand1);zeichnefuerkurve1.rueckwaerts13:.zeichnefuerkurve1:uebergibpunktdererstenkurveancoroutine.zeichnefuerkurve2:uebergibpunktderzweitenkurveancoroutine.loescheerstenfuerkurve1:co1wastun:=anfpunktloeschen;uebergibpunktdererstenkurveancoroutine.loescheerstenfuerkurve2:co2wastun:=anfpunktloeschen;uebergibpunktderzweitenkurveancoroutine.uebergibpunktdererstenkurveancoroutine:coroutine(seite,fenster1,k1,zeitt1,maskeintern,zustand1,dsco1,co1wastun,x1min,x1max,ymin,ymax,automatik).uebergibpunktderzweitenkurveancoroutine:coroutine(seite,fenster2,k2,zeitt2,maskeintern,zustand2,dsco2,co2wastun,x2min,x2max,ymin,ymax,automatik).liesoderwarteaufbenutzereingaben:REPliesbenutzereingaben(taste,tasteninnen,tastenraus,merker);IFtaste<>""THENinterpretieretasteundfuehreaktionausELSErichtungswechsel:=FALSE;LEAVEliesoderwarteaufbenutzereingabenFI;PER.interpretieretasteundfuehreaktionaus:IF(pos(tastenraus,taste)>0)THENabbruchtaste:=taste;LEAVEvorwaertsundrueckwaertsFI;IFtaste=rechtsTHENrichtungswechsel:=NOTvorwaertslesen;vorwaertslesen:=TRUE;LEAVEliesoderwarteaufbenutzereingabenELIFtaste=linksTHENrichtungswechsel:=vorwaertslesen;vorwaertslesen:=FALSE;LEAVEliesoderwarteaufbenutzereingabenELIFtaste=plottenTHENplotteloesungskurveELIFtaste=tasteblaetternTHENblaettern(seite);out(hop)ELIFtaste=tasteblaetternobenTHENblaetternoben(seite);out(hop)ELIFtaste=tasteblaetternuntenTHENblaetternunten(seite);out(hop)FI.plotteloesungskurve:nildiagrammmitkreuz(seite,fenster1);nildiagrammmitkreuz(seite,fenster2);co1wastunalt:=co1wastun;co1wastun:=bildschirminhaltplotten;coroutine(seite,fenster1,k1,zeitt1,maskeintern,zustand1,dsco1,co1wastun,x1min,x1max,ymin,ymax,automatik);co1wastun:=co1wastunalt;co2wastunalt:=co2wastun;co2wastun:=bildschirminhaltplotten;coroutine(seite,fenster2,k2,zeitt2,maskeintern,zustand2,dsco2,co2wastun,x2min,x2max,ymin,ymax,automatik) +;co2wastun:=co2wastunalt;versendeoutput(seite,modellkurzbezeichnung,kopfzeile,steuerzeile,plottask);piep.piep:out(piepton).END PROCsteuerprozessfuerzweiloesungen;PROCliesbenutzereingaben(TEXT VARtaste,TEXT CONSTtasteninnen,tastenraus,INT VARmerker):SELECTmerkerOF CASEwarten1:erkenneescCASEwarten2:warteaufnaechstetasteEND SELECT.erkenneesc:taste:=incharety;IFtaste=escTHENwarteaufnaechstetasteELSEtaste:=""FI.warteaufnaechstetaste:inchar(taste);WHILE NOTtastezulaessigREP IFtaste<>escTHENpiepFI;inchar(taste);PER;IF(pos(tastenraus,taste)>0)THEN LEAVEliesbenutzereingabenELIFtaste=hopTHENrichtungfestlegenELSEmerker:=warten2FI.tastezulaessig:(pos(tasteninnen+tastenraus,taste)>0)COR(taste=hop)COR(taste=rechts)COR(taste=links).richtungfestlegen:inchar(taste);WHILE NOT((taste=rechts)COR(taste=links))REPpiep;inchar(taste);PER;merker:=warten1.piep:out(code(7)).END PROCliesbenutzereingaben;INT PROCinternerzustandnach0v:IFzeitt1zeitt2THEN5ELSE4FI.END PROCinternerzustandnach0v;INT PROCinternerzustandnach1v:IFendederloesung(k1)THEN3ELSEnaechstezeit(k1,zeitt1);IFzeitt1<=zeitt2THEN2ELSE3FI FI.END PROCinternerzustandnach1v;INT PROCinternerzustandnach2v:internerzustandnach1vEND PROCinternerzustandnach2v;INT PROCinternerzustandnach3v:IFendederloesung(k1)CANDendederloesung(k2)THEN13ELIFendederloesung(k1)THEN11ELIFendederloesung(k2)THEN12ELSEnaechstezeit(k1,zeitt1);naechstezeit(k2,zeitt2);IFzeitt1zeitt2THEN10ELSE9FI FI.END PROCinternerzustandnach3v;INT PROCinternerzustandnach4v:internerzustandnach3vEND PROCinternerzustandnach4v;INT PROCinternerzustandnach5v:IFendederloesung(k2)THEN7ELSEnaechstezeit(k2,zeitt2);IFzeitt2<=zeitt1THEN6ELSE7FI FI.END PROCinternerzustandnach5v;INT PROCinternerzustandnach6v:internerzustandnach5vEND PROCinternerzustandnach6v;INT PROCinternerzustandnach7v:internerzustandnach3vEND PROCinternerzustandnach7v;INT PROCinternerzustandnach8v:IFendederloesung(k1)THEN11ELSEnaechstezeit(k1,zeitt1);IFzeitt1zeitt2THEN10ELSE9FI FI.END PROCinternerzustandnach8v;INT PROCinternerzustandnach9v:internerzustandnach3v.END PROCinternerzustandnach9v;INT PROCinternerzustandnach10v:IFendederloesung(k2)THEN12ELSEnaechstezeit(k2,zeitt2);IFzeitt1zeitt2THEN10ELSE9FI FI.END PROCinternerzustandnach10v;INT PROCinternerzustandnach11v:IFendederloesung(k2)THEN13ELSE11FI.END PROCinternerzustandnach11v;INT PROCinternerzustandnach12v:IFendederloesung(k1)THEN13ELSE12FI.END PROCinternerzustandnach12v;INT PROCinternerzustandnach2r:IFanfangderloesung(k1)THEN1ELSE2FI.END PROCinternerzustandnach2r;INT PROCinternerzustandnach3r:internerzustandnach2r.END PROCinternerzustandnach3r;INT PROCinternerzustandnach6r:IFanfangderloesung(k2)THEN5ELSE6FI.END PROCinternerzustandnach6r;INT PROCinternerzustandnach7r:internerzustandnach6r.END PROCinternerzustandnach7r;INT PROCinternerzustandnach8r:IFanfangderloesung(k1)CANDanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN7ELIFzeitt1=zeitt2THEN7ELSE10FI ELIFanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN8ELSE3FI ELIFzeitt1>zeitt2THEN8ELIFzeitt1zeitt2THEN7ELIFzeitt1=zeitt2THEN7ELSE11FI ELIFanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN8ELSE3FI ELIFzeitt1>zeitt2THEN8ELIFzeitt1zeitt2THEN7ELIFzeitt1=zeitt2THEN7ELSE10FI ELIFanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN12ELSE3FI ELIFzeitt1>zeitt2THEN12ELIFzeitt1zeitt2THEN7ELIFzeitt1=zeitt2THEN7ELSE11FI ELIFanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN12ELSE3FI ELIFzeitt1>zeitt2THEN12ELIFzeitt1 +<503 > + +<504 > <501 > + + + + + +<511%v#<20> <21%#*<21> ><3>#m#<29> <30%#*<30> ><28>> +<24 >> + +<25 >> + + + + + + +<511%v#Ihre Anmeldung an unsere Schule zum Schuljahr <507>><512%w#Anmeldung der Schülerin #m#Anmeldung des Schülers ><511%m#<20> <21%#*<21> ><3>> +<511%m#an unsere Schule zum Schuljahr <507>> + + +Wir bestätigen hiermit, daß <511%v#Sie><512%w#die Schülerin #m#der Schüler ><511%m#<20> <21%#*<21> ><3>> +entsprechend Ihrem Wunsch zum Schuljahr <507 >> in die Jahrgangsstufe 11 +unserer Schule aufgenommen <511%v#werden#m#wird>. Diese Zusage erfolgt unter der +Bedingung, daß <511%v#Sie><512%m#der Schüler#w#die Schülerin> bis zum 3. Schultag +des kommenden Schuljahres die entsprechenden Voraussetzungen <511%v#erfüllen#m#erfüllt>. + +In der Anlage finden Sie weitere Informationen und Termine. + +Es ist unbedingt erforderlich, daß <511%v#Sie><512%w#die Schülerin#m#der Schüler> an den +Kurswahlen termingerecht <511%v#teilnehmen#m#teilnimmt>, damit die Schule das +Unterrichtsangebot für das kommende Schuljahr gewährleisten kann. Aus dem +gleichen Grund bitten wir auch, uns unverzüglich zu informieren, wenn +<511%v#Sie><512%w#die Schülerin#m#der Schüler> nicht wie vorgesehen in unsere Schule +eintreten <511%v#werden#m#wird>. + + +Mit freundlichen Grüßen + + + + +<506 >> +(Schulleiter) + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 5 b/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 5 new file mode 100644 index 0000000..d9eff7f --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 5 @@ -0,0 +1,38 @@ +<502 > +<503 > + +<504 > <501 > + + + + +<29 >> <30%#*<30> ><28 >> +<31 >> + +<32 >> + + + + + + +Aufnahme <12%m#des Schülers#w#der Schülerin> <20 >> <21%#*<21> ><3 >> an +unsere Schule zur Jahrgangsstufe 5 + + +Wir bestätigen hiermit, daß <12%w#Ihre Tochter#m#Ihr Sohn> <20 >> +entsprechend Ihrem Wunsch zum Schuljahr <507 >> in die Jahrgangsstufe 5 +unserer Schule aufgenommen wurde. + +Einzelheiten zum Schulbeginn entnehmen Sie bitte dem beiliegenden +Informationsblatt. + + +Mit freundlichen Grüßen + + + + +<506 >> +(Schulleiter) + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 11 b/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 11 new file mode 100644 index 0000000..c61cb47 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 11 @@ -0,0 +1,15 @@ +Anmeldung von Schülern zur Jahrgangsstufe 11 + + +Sehr geehrte Damen und Herren, + +die nachstehend genannten Schülerinnen und Schüler Ihrer Schule wurden zum +kommenden Schuljahr für die Jahrgangsstufe 11 an unserer Schule angemeldet. +Wir bitten Sie, uns jeweils zu bestätigen, ob die Schülerin/der Schüler eine +2. Fremdsprache gelernt hat, die den Bedingungen der Ausbildungs- und +Prüfungsordnung der gymnasialen Oberstufe genügt. Wir bitten um Antwort bis +zum Beginn des kommenden Schuljahrs. + + +Mit freundlichen Grüßen + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 5 b/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 5 new file mode 100644 index 0000000..d6593ac --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 5 @@ -0,0 +1,13 @@ +Anmeldung von Schülern zur Jahrgangsstufe 5 + + +Sehr geehrte Damen und Herren, + +die nachstehend genannten Schülerinnen und Schüler Ihrer Schule wurden zum +kommenden Schuljahr für die Jahrgangsstufe 5 an unserer Schule angemeldet. +Wir bitten Sie, uns jeweils das Grundschulgutachten und das letzte Zeugnis +dieser Schüler im Verlauf der nächsten zwei Wochen zuzusenden. + + +Mit freundlichen Grüßen + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck fuer wiederholer b/app/schulis/2.2.1/data/vordrucke/vordruck fuer wiederholer new file mode 100644 index 0000000..6f5a224 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck fuer wiederholer @@ -0,0 +1,44 @@ +<502 > +<503 > + +<504 > <501 > + + + + +<511%v#<20> <21%#*<21> ><3>#m#<29> <30%#*<30> ><28>> +<24 >> + +<25 > + + + + + +Versetzung zum Ende des Schuljahres <505 >> + + +Laut Beschluß der Versetzungskonferenz<511%v# haben Sie> +<512%w#hat Ihre Tochter #m#hat Ihr Sohn ><511%m#<20> >die Versetzung in die +Jahrgangsstufe <513>> nicht erreicht. + +Das diesem Beschluß zugrundeliegende Zeugnis fügen wir als Anlage bei. Wir +überlassen es Ihrer Entscheidung, ob<511%v# Sie> +<512%w#Ihre Tochter #m#Ihr Sohn >am letzten Schultag +<511%v#teilnehmen#m#teilnimmt>. + +Falls Sie wünschen, daß <511%v#Sie><512%w#Ihre Tochter#m#Ihr Sohn> in eine +bestimmte Klasse/Tutorenkurs aufgenommen <511%v#werden#m#wird>, sind wir +bemüht, dies zu realisieren, sofern Sie uns Ihren Wunsch und die Gründe +dafür bis zum ersten Ferientag wissen lassen. + + +Mit freundlichen Grüßen + + + + +<506 >> +(Schulleiter) + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck klassenbuchliste b/app/schulis/2.2.1/data/vordrucke/vordruck klassenbuchliste new file mode 100644 index 0000000..880662a --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck klassenbuchliste @@ -0,0 +1,5 @@ +<511%#*<511>> +<503 > + +<512%#*<512>> + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine abmeldung b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine abmeldung new file mode 100644 index 0000000..1493b9f --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine abmeldung @@ -0,0 +1,54 @@ +<502 > +<503 > + +<504 > <501 > + + + + + +Mitteilung über eine Abmeldung + + + +Am <512%#___________*<512>> verläßt unsere Schule: + + Schüler: <513 > + Geburtsdatum: <514 > + + Abgangsgrund: <515 > + + +Klasse/Tutorenkurs: <519 >><520%#*, <520>> + + + +Kurs Fachlehrer Unterschr. Note Anz.entl + Bücher +-------:------------------------------------:----------:----:-------- + +<530 >><531 >><530%#<590>* <591>> +<532 >><533 >><532%#<590>* <591>> +<534 >><535 >><534%#<590>* <591>> +<536 >><537 >><536%#<590>* <591>> +<538 >><539 >><538%#<590>* <591>> +<540 >><541 >><540%#<590>* <591>> +<542 >><543 >><542%#<590>* <591>> +<544 >><545 >><544%#<590>* <591>> +<546 >><547 >><546%#<590>* <591>> +<548 >><549 >><548%#<590>* <591>> +<550 >><551 >><550%#<590>* <591>> +<552 >><553 >><552%#<590>* <591>> +<554 >><555 >><554%#<590>* <591>> +<556 >><557 >><556%#<590>* <591>> +<558 >><559 >><558%#<590>* <591>> + + + + erreichter Abschluß: <516 > + + Zeugnis ausgestellt am: ____________________ + +Unterschrift Klassenlehrer/Tutor: ______________________________ + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit diffd b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit diffd new file mode 100644 index 0000000..8fbfa16 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit diffd @@ -0,0 +1,44 @@ +<502 > +<503 > + +<504 > <501 > + + + + + +Mitteilung über eine Anmeldung + + + +Ab dem <512 >> nimmt am Unterricht teil: + + + Schüler: <513 > + Geburtsdatum: <514 > + + Adresse: <516 > + <517 > + Telefon: <518 > + + + +Klasse/Tutorenkurs: <519 >><520%#*, <520>> + + +<530%#*Der Schüler nimmt teil am Unterricht in:> + +<<530 > <531 > +<<532 > <533 > +<<534 > <535 > +<<536 > <537 > +<<538 > <539 > +<<540 > <541 > +<<542 > <543 > +<<544 > <545 > +<<546 > <547 > +<<548 > <549 > +<<550 > <551 > +<<552 > <553 > +<<554 > <555 > + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit hjd b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit hjd new file mode 100644 index 0000000..fa551f8 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit hjd @@ -0,0 +1,48 @@ +<502 > +<503 > + +<504 > <501 > + + + + + +Mitteilung über eine Anmeldung + + + +Ab dem <512 >> nimmt am Unterricht teil: + + + Schüler: <513 > + Geburtsdatum: <514 > + + Adresse: <516 > + <517 > + Telefon: <518 > + + + +Klasse/Tutorenkurs: <519 >><520%#*, <520>> + + +<530%#*Der Schüler nimmt teil am Unterricht in:> + +<530%#*Kurs Fach Fachlehrer> +<530%#*-------:-------------------------------:-----------------------------> +<530 > <531 > <532 >> +<533 > <534 > <535 >> +<536 > <537 > <538 >> +<539 > <540 > <541 >> +<542 > <543 > <544 >> +<545 > <546 > <547 >> +<548 > <549 > <550 >> +<551 > <552 > <553 >> +<554 > <555 > <556 >> +<557 > <558 > <559 >> +<560 > <561 > <562 >> +<563 > <564 > <565 >> +<566 > <567 > <568 >> +<569 > <570 > <571 >> +<572 > <573 > <574 >> + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungsbescheinigung b/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungsbescheinigung new file mode 100644 index 0000000..406c2c7 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungsbescheinigung @@ -0,0 +1,34 @@ +<502 > +<503 > + +<504 > <501 > + + + + + + + +Bescheinigung + + +Gemäß <519%#*<519>> hat <514%m#der Schüler#w#die Schülerin> +<513 >> <512%#*<512> ><511 >>, +geboren am <515 >>, in Jahrgangsstufe <517>> im +Fach <518%# *<518 >> an einer Prüfung +teilgenommen. +<514%m#Er#w#Sie> hat die Nachprüfung <516%x#nicht >bestanden und damit +<520%# *<520>> <516%x#nicht >erreicht. + +Diese Bescheinigung ist nur in Verbindung mit dem Versetzungszeugnis des +Schuljahres <508 >> gültig. Auf Antrag wird ein neues Zeugnis mit +der in der Nachprüfung erreichten Note ausgestellt. + + + + + + +<506 >> +(Schulleiter) + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungszulassung b/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungszulassung new file mode 100644 index 0000000..032afcb --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungszulassung @@ -0,0 +1,48 @@ +<502 > +<503 > + +<504 > <501 > + + + + + +<515%v#<513> <512%#*<512> ><511>#m#<521> <520%#*<520> ><519>> +<515%v#<517>#m#<522>> + +<515%v#<518>#m#<523>> + + + + + +Versetzung zum Ende des Schuljahres <505 >> + + +Gemäß <524%#*<524>> hat die Versetzungskonferenz festgestellt, daß +<515%v#Sie#m#<514%m#Ihr Sohn#w#Ihre Tochter> <513>> eine Nachprüfung +<525%#*in <525>> ablegen <515 %v#können#m#kann>. + +Durch die Nachprüfung kann nachträglich <526%# *<526>> +erworben werden. + +Die Prüfung findet in den ersten Tagen nach den Schulferien statt. +Meldungen sind unter Angabe des Prüfungsfaches bis zum Ende der +zweiten Ferienwoche im Sekretariat abzugeben. Die genauen +Prüfungstermine erfragen Sie bitte in der letzten Ferienwoche im +Sekretariat. + +Das diesem Beschluß zugrundeliegende Zeugnis fügen wir als Anlage +bei. Wir überlassen es Ihrer Entscheidung, ob +<515%v#Sie#m#<514%m#Ihr Sohn#w#Ihre Tochter> <513>> am letzten +Schultag am Unterricht <515%v#teilnehmen#m#teilnimmt>. + + +Mit freundlichen Grüßen + + + + +<506 >> +(Schulleiter) + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck schulbescheinigung b/app/schulis/2.2.1/data/vordrucke/vordruck schulbescheinigung new file mode 100644 index 0000000..84c95a8 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck schulbescheinigung @@ -0,0 +1,29 @@ +<502 > +<503 > + +<504 > <501 > + + + + + +Bescheinigung + + + + +<12%m#Der Schüler#w#Die Schülerin> <20 >> <21%#*<21> ><3 >>, + +geboren am <5 >>, + +ist im Schuljahr <505 >> <12%m#Schüler#w#Schülerin> der Jahrgangsstufe <7>> +unserer Schule. + + + + + + +<506 >> +(Schulleiter) + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft betroffene new file mode 100644 index 0000000..c922e82 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft betroffene @@ -0,0 +1,60 @@ +<502 > <501 > +<504 > + +Auskunft über die im schulis-System gespeicherten Daten des Schülers + +Familienname: <3 > +Namenszusatz: <21 > Geburtsname: <22 > + Rufname: <4 > Vornamen: <20 > +Geburtsdatum: <5 > + + Status: <6 > <583 > + + Adresse: <24 > + <511 > + Telefon: <26 > + <512 > + Ortsteil: <27>> <513 >> + +erziehungsberechtigt: <34>> <514 >> + Name: <28 > + Vornamen: <29 > + Namenszusätze: <30 > + Adresse: <568 > + <515 > + Telefon: <569 > + + Geburtsort/Kreis: <40 >> / <41 >> + Staatsangehörigkeit: <35 >> <516 >> + Muttersprache: <39 >> <517 >> + Spätaussiedler: <518 >> + Geschlecht: <12>> <519 >> + Religionszugehörigkeit: <36 >> <520 >> +Zeugnisvermerk Religion: <521>> + + Einschulungsjahr: <42>> + letzte Schule: <570 > + <571 > + <522 > + letzte Klasse dort: <15> Schulform: <582>> <523 >> + + Eintritt in diese Schule: <43 > in Jahrgangsstufe: <13>> + Eintritt in Sek.II: <524> + aktuelle Schülergruppe: <7 >> <8 >> +Zugang zur akt. Jahrgangsstufe: <10>> <525 >> + neuer Zug/Tutor: <11> + + Abgangsdatum: <16 > Abgangsgrund: <17 >> <526 >> +erworbener Abschluß: <18 >> <527 >> + neue Schule: <572 > + <573 > + <528 > + + Vermerk1: <45 > + Vermerk2: <46 > + Vermerk3: <47 > + Vermerk4: <48 > + Vermerk5: <49 > + Vermerk6: <50 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft lehrer new file mode 100644 index 0000000..7bedad8 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft lehrer @@ -0,0 +1,38 @@ +<502 > +<503 > +<504 > <501 > + + Auskunft an Betroffene im Sinne des Datenschutzesgesetzes + für: <511> <151%#*<151>> <513 > + + (Stunden- und Aufsichtsplan werden auf Wunsch gesondert erstellt.) + + Paraphe: <147> + Familienname: <148 > + Rufname: <149 > + Namenszusatz: <150 > + Amtsbezeichnung, Titel: <151 > + Geschlecht: <152> + + Adresse Straße, Nr.: <164 > + PLZ, Ort: <165 > + Tel.Nr.: <166 > + + Sprechzeiten: <163 > + + Sollstunden: <153> + Pflichtstunden: <154> + Ermäßigung 1: <155> Grund: <156>(<550 >>) + Ermäßigung 2: <157> Grund: <158>(<551 >>) + Ermäßigung 3: <159> Grund: <160>(<552 >>) + Ermäßigung 4: <161> Grund: <162>(<553 >>) + + Lehrbefähigung Fach 1: <514 > Art: <515>(<554 >>) + Fach 2: <516 > Art: <517>(<555 >>) + Fach 3: <518 > Art: <519>(<556 >>) + Fach 4: <520 > Art: <521>(<557 >>) + Fach 5: <522 > Art: <523>(<558 >>) + Fach 6: <524 > Art: <525>(<559 >>) + + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl lehrer new file mode 100644 index 0000000..5dc680e --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl lehrer @@ -0,0 +1,13 @@ +<502 > <501 > +<504 > + + +Stundenplan für <511>> <151%#*<151>> <512 >> +Schuljahr <514>>, <515>>. Halbjahr + + + +Std: Montag : Dienstag : Mittwoch : Donnerstag: Freitag : Samstag : +---+-----------+-----------+-----------+-----------+-----------+-----------: + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl raeume b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl raeume new file mode 100644 index 0000000..2158494 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl raeume @@ -0,0 +1,13 @@ +<502 > <501 > +<504 > + + +Belegungsplan für Raum <511>> (<514 >>) +Schuljahr <512>>, <513>>. Halbjahr + + + +Std: Montag : Dienstag : Mittwoch : Donnerstag: Freitag : Samstag : +---+-----------+-----------+-----------+-----------+-----------+-----------: + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek1 new file mode 100644 index 0000000..e58f75f --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek1 @@ -0,0 +1,14 @@ +<502 > <501 > +<504 > + + +Stundenplan für Klasse <511> +Schuljahr <512>>, <513>>. Halbjahr + + Klassenleiter: <514 > +Stellvertreter: <516 > + +Std: Montag : Dienstag : Mittwoch : Donnerstag: Freitag : Samstag : +---+-----------+-----------+-----------+-----------+-----------+-----------: + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek2 b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek2 new file mode 100644 index 0000000..662b9f2 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek2 @@ -0,0 +1,14 @@ +<502 > <501 > +<504 > + + +Stundenplan für <511 >> <512 >>, geb. <513 > +Schuljahr <514>>, <515>>. Halbjahr + +Tutorkurs: <516 > + + +Std: Montag : Dienstag : Mittwoch : Donnerstag: Freitag : Samstag : +---+-----------+-----------+-----------+-----------+-----------+-----------: + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 kursli kopfueb b/app/schulis/2.2.1/data/vordrucke/vordruck1 kursli kopfueb new file mode 100644 index 0000000..b9a87c7 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 kursli kopfueb @@ -0,0 +1,10 @@ +<502 > <501 > +<504 > + + Kurs : <520 > +Lehrer : <521>><522 > + +Hinweis: Familienname, Rufname, Geburtsdatum +-------+------------------------------------------------------------------- + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 protokoll versetzkonf b/app/schulis/2.2.1/data/vordrucke/vordruck1 protokoll versetzkonf new file mode 100644 index 0000000..d064f40 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 protokoll versetzkonf @@ -0,0 +1,6 @@ +<502 > <501 > +<503 > + + +Versetzungskonferenz zum Ende des Schuljahrs 19<505>, <511 > + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 unterrichtsvertlg fuer lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck1 unterrichtsvertlg fuer lehrer new file mode 100644 index 0000000..0d85b97 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 unterrichtsvertlg fuer lehrer @@ -0,0 +1,21 @@ +<502 > +<503 > +<504 > <501 > + +Unterrichtsverteilung im Schuljahr <520>, <521>>. Halbjahr + +<522>> <151>> <150 >> <148 >> + + + Paraphe: <147> + + Sollstunden: <153> + Pflichtstunden: <154> + Ermäßigung 1: <155> Grund: <156>(<530 >>) + Ermäßigung 2: <157> Grund: <158>(<531 >>) + Ermäßigung 3: <159> Grund: <160>(<532 >>) + Ermäßigung 4: <161> Grund: <162>(<533 >>) + + Lehrveranstaltungen : <<183> <534>> <535> Wstd.: <<536> + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 vertretungen b/app/schulis/2.2.1/data/vordrucke/vordruck1 vertretungen new file mode 100644 index 0000000..e1b636d --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 vertretungen @@ -0,0 +1,14 @@ +<502 > +<503 > +<504 > <501 > + +Aufstellung der Daten über Vertretungen und Freistunden + +für: <550 > + + +Datum Zeit Art ausgefallene/vertretene + Lehrveranstaltungen +--------+------+-----+----------------------------- + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft betroffene new file mode 100644 index 0000000..2531674 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft betroffene @@ -0,0 +1,3 @@ +Familienname: <3 > +Namenszusatz: <21 > Rufname: <4 > (Fortsetzung) + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft lehrer new file mode 100644 index 0000000..2be3ff8 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft lehrer @@ -0,0 +1,7 @@ + +Unterrichtsverteilung Schuljahr <526>>, <527>>.Halbjahr + +Jgst. Fach Kurs Wochenstd. + + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl lehrer new file mode 100644 index 0000000..f9e0f34 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl lehrer @@ -0,0 +1,9 @@ + + Klassenleitung/Tutor für: <540 > + +stellv. Klassenleitung für: <541 > + + Aufsichten: Ort Zeit + + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl raeume b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl raeume new file mode 100644 index 0000000..538fa14 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl raeume @@ -0,0 +1,4 @@ +<520>> : <521 >: <522 >: <523 >: <524 >: <525 >: <526 >: + : <527> : <528> : <529> : <530> : <531> : <532> : + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek1 new file mode 100644 index 0000000..16a5152 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek1 @@ -0,0 +1,3 @@ +<520>> : <521 > : <522 > : <523 > : <524 > : <525 > : <526 > : + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek2 b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek2 new file mode 100644 index 0000000..a44f64b --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek2 @@ -0,0 +1,3 @@ +<540 > <541 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 kursli zeile b/app/schulis/2.2.1/data/vordrucke/vordruck2 kursli zeile new file mode 100644 index 0000000..32a345c --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 kursli zeile @@ -0,0 +1,3 @@ + <523> : <524 >>, <525 >>, <526 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 protokoll versetzkonf b/app/schulis/2.2.1/data/vordrucke/vordruck2 protokoll versetzkonf new file mode 100644 index 0000000..288806c --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 protokoll versetzkonf @@ -0,0 +1,13 @@ + + +Datum: ________ Beginn:_____ Uhr, Ende:_____ Uhr + + +Anwesend: + + <512%#*<512>> + +Ort, Zeit und Tagesordnung sind den Mitgliedern ordnungsgemäß bekannt +gegeben worden. Der Vorsitzende hat die Beschlußfähigkeit der Konferenz +festgestellt. + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 unterrichtsvertlg fuer lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck2 unterrichtsvertlg fuer lehrer new file mode 100644 index 0000000..f29b7d5 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 unterrichtsvertlg fuer lehrer @@ -0,0 +1,3 @@ + <<183> <534>> <535> <<536> + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 vertretungen b/app/schulis/2.2.1/data/vordrucke/vordruck2 vertretungen new file mode 100644 index 0000000..441742c --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 vertretungen @@ -0,0 +1,3 @@ +<520 > <521> <522 > <523 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft betroffene new file mode 100644 index 0000000..aad98ea --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft betroffene @@ -0,0 +1,28 @@ + +Differenzierungsdaten: + 1. Fremdsprache: <55 >> <537 >> + von: <538> bis: <539> + 2. Fremdsprache: <58 >> <540 >> + von: <541> bis: <542> + 3. Fremdsprache: <61 >> <543 >> + von: <544> bis: <545> + 4. Fremdsprache: <64 >><546 >> + von: <547> bis: <548> + Religionsunterricht in: <67>> <549 >> + abgemeldet: <68 > wiederangemeldet: <69 > + Kunst/Musik: <70>> <550 >> +Wahlpflichtfächer in 09.1: <71 >> <551 >> + <72 >> <552 >> +Wahlpflichtfächer in 09.2: <73 >> <553 >> + <74 >> <554 >> +Wahlpflichtfächer in 10.1: <75 >> <555 >> + <76 >> <556 >> +Wahlpflichtfächer in 10.2: <77 >> <557 >> + <78 >> <558 >> + Arbeitsgemeinschaften: <79 >> <559 >> + von: <560> bis: <561> + Arbeitsgemeinschaften: <82 >> <562 >> + von: <563> bis: <564> + Arbeitsgemeinschaften: <85 >> <565 >> + von: <566> bis: <567> + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft lehrer new file mode 100644 index 0000000..6616e46 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft lehrer @@ -0,0 +1,3 @@ + <528 > <529> <530> <531> + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl lehrer new file mode 100644 index 0000000..f54fce2 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl lehrer @@ -0,0 +1,3 @@ + <543> <542 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl sek1 new file mode 100644 index 0000000..e72e32c --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl sek1 @@ -0,0 +1,7 @@ + +Erläuterungen: + +Fach (Kopplung) Fach Lehrer +----:-----------:--------------------:-------------------------- + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 protokoll versetzkonf b/app/schulis/2.2.1/data/vordrucke/vordruck3 protokoll versetzkonf new file mode 100644 index 0000000..cd69816 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 protokoll versetzkonf @@ -0,0 +1,9 @@ + + + +Abkürzungen in Spalte "Bem.": w/x = Schüler wiederholte diese Jgst. + ab = Schüler abgemeldet + + +Vorsitzender:______________________ Protokollführer:______________________ + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft betroffene new file mode 100644 index 0000000..2b24d03 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft betroffene @@ -0,0 +1,23 @@ + + +Daten zum Schuljahr <511>, <93>>. Halbjahr, Jgst. <94> Zug/Tutor: <95 > + + Versetzung: <518> <519 > + Warnung: <512> mit Bem.Nr.: <513> + Nachwarnung: <515> mit Bem.Nr.: <516> + <517%#*<517>> + Nachpr.mögl.in: <520> <521 > + <522> <523 > + <524> <525 > + abgelegt in: <526> mit Note: <527>> +Zeugnis Bem.Nr.: <528> + <529%#*<529>> + <530> + <531%#*<531>> + <532> + <533%#*<533>> + +Bemerkung zur Nachprüfung: <108> <537 >> + +Versäumt mit/ohne Entschuldigung: <534>>/<535>> Std. verspätet: <536>> mal + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft lehrer new file mode 100644 index 0000000..31bf2b0 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft lehrer @@ -0,0 +1,7 @@ + + +Leitung von Schülergruppen: <526 > + Klassenleiter/Tutor: <580 > <582 > <584 > <586 > <588 > + Stellvertreter: <581 > <583 > <585 > <587 > <589 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck4 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck4 einzelstdpl sek1 new file mode 100644 index 0000000..810e66f --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck4 einzelstdpl sek1 @@ -0,0 +1,3 @@ +<518>> <519 > <520 > <521 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft betroffene new file mode 100644 index 0000000..43c0388 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft betroffene @@ -0,0 +1,38 @@ + +Wahl geprüft: <537 > + +Fach <538 > +Art <539 > +Klausur <541 > +Kurs Nr. <542 > +Warnung <543 > +Note <544 > +Bem. dazu<545 > + +Bem. Nr. <546>: + <547%#*<547>> + <548>: + <549%#*<549>> + <550>: + <551%#*<551>> + <552>: + <553%#*<553>> + <554>: + <555%#*<555>> + <556>: + <557%#*<557>> + <558>: + <559%#*<559>> + <560>: + <561%#*<561>> + <562>: + <563%#*<563>> + <564>: + <565%#*<565>> + <566>: + <567%#*<567>> + <568>: + <569%#*<569>> + <570>: + <571%#*<571>> + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft lehrer new file mode 100644 index 0000000..2b5f0dd --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft lehrer @@ -0,0 +1,20 @@ + + +Zeitwünsche <526 > +Wünsche für bestimmte Zeiten: + 1 2 3 4 5 6 7 8 9 10 11 12 + ----------------------------------------------------- + Mo <531>> <532>> <533>> <534>> <535>> <536>> <537>> <538>> <539>> <540>> <541>> <542>> + Di <543>> <544>> <545>> <546>> <547>> <548>> <549>> <550>> <551>> <552>> <553>> <554>> + Mi <555>> <556>> <557>> <558>> <559>> <560>> <561>> <562>> <563>> <564>> <565>> <566>> + Do <567>> <568>> <569>> <570>> <571>> <572>> <573>> <574>> <575>> <576>> <577>> <578>> + Fr <579>> <580>> <581>> <582>> <583>> <584>> <585>> <586>> <587>> <588>> <589>> <590>> + Sa <591>> <592>> <593>> <594>> <595>> <596>> + +insgesamt sollen frei sein (incl. den o.g. Wünschen) : + Anzahl Gewicht + ganze Tage <520> <521> + Vormittage <522> <523> + zusätzliche Nachmittage <524> <525> + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck5 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck5 einzelstdpl sek1 new file mode 100644 index 0000000..d7bd03e --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck5 einzelstdpl sek1 @@ -0,0 +1,9 @@ + + +Räume für gekoppelten Unterricht: + +Kopplung Zeiten + Fach Räume +--------:-------:------:------:------:------:------:------:------:------: + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck6 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck6 auskunft lehrer new file mode 100644 index 0000000..90c1a7a --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck6 auskunft lehrer @@ -0,0 +1,5 @@ + +Vertretungen: +Datum: <520 > Zeit: <521> Art: <522 >> Lehrveranst.: <523 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck6 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck6 einzelstdpl sek1 new file mode 100644 index 0000000..d7c5b14 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck6 einzelstdpl sek1 @@ -0,0 +1,3 @@ +<530 > <531> <532> <533> <534> <535> <536> <537> <538> + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck7 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck7 auskunft lehrer new file mode 100644 index 0000000..0ac9975 --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck7 auskunft lehrer @@ -0,0 +1,3 @@ + <520 > <521> <522 >> <523 > + + diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck7 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck7 einzelstdpl sek1 new file mode 100644 index 0000000..b64618e --- /dev/null +++ b/app/schulis/2.2.1/data/vordrucke/vordruck7 einzelstdpl sek1 @@ -0,0 +1,3 @@ + <540 > <541> <542> <543> <544> <545> <546> <547> <548> + + diff --git a/app/schulis/2.2.1/source-disk b/app/schulis/2.2.1/source-disk new file mode 100644 index 0000000..0fbb9d3 --- /dev/null +++ b/app/schulis/2.2.1/source-disk @@ -0,0 +1,5 @@ +schulis-grundpaket-schulverwaltung-2.2.1/03_schulis-quellen.img +schulis-grundpaket-schulverwaltung-2.2.1/04_schulis-quellen.img +schulis-grundpaket-schulverwaltung-2.2.1/05_schulis-quellen.img +schulis-grundpaket-schulverwaltung-2.2.1/06_vordrucke.img +schulis-grundpaket-schulverwaltung-2.2.1/07_baisy-schulis-db.img diff --git a/app/schulis/2.2.1/src/0.ANSCHREIBEN.files b/app/schulis/2.2.1/src/0.ANSCHREIBEN.files new file mode 100644 index 0000000..1352f80 --- /dev/null +++ b/app/schulis/2.2.1/src/0.ANSCHREIBEN.files @@ -0,0 +1,14 @@ +1.anschr.schulbescheinigung +1.anschr.anmeldebestaetigung fuer jgst 5 und 11 +1.anschr.wiederholer +1.anschr.nachpruefungsbescheinigung +1.anschr.nachpruefungszulassung +1.auskunft.betroffene +1.anschr.mitteilungen neuangemeldete und abgemeldete +1.listen.anherk +3.anschr.betroffene lehrer +4.anschr.unterrichtsvertlg fuer lehrer +4.anschr.vertretungen + + + diff --git a/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE TEIL2.files b/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE TEIL2.files new file mode 100644 index 0000000..22746c7 --- /dev/null +++ b/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE TEIL2.files @@ -0,0 +1,6 @@ +0.anschr.druckereinstellung +0.listen.werkzeuge +0.listen.druckbearbeitung +0.listen.steuerung + + diff --git a/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE.files b/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE.files new file mode 100644 index 0000000..aec57ff --- /dev/null +++ b/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE.files @@ -0,0 +1,6 @@ +0.anschr.grundfunktionen +0.anschr.steuerfunktionen einfach +0.anschr.steuerfunktionen zusammengesetzt +0.schulis schrifttyp + + diff --git a/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN 2.files b/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN 2.files new file mode 100644 index 0000000..07e60dd --- /dev/null +++ b/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN 2.files @@ -0,0 +1,10 @@ +3.erf lehrer +0.erf.faecher +0.schulkenndaten bearbeiten +0.erf.schuldaten +0.klassengruppen definieren +0.raumgruppen bearbeiten +0.erf zeitraster +0.erf aufsichtszeiten + + diff --git a/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN.files b/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN.files new file mode 100644 index 0000000..9931455 --- /dev/null +++ b/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN.files @@ -0,0 +1,15 @@ +0.kurswahlbasis bereinigen +0.hjd grundfunktionen +1.erf.schuelerdaten +1.erf.abmeldedaten +1.abgegangene aussortieren +1.schuelerjgst aendern +1.halbjahresdaten bearbeiten +1.hoeherstufen anw do.prog +1.stat grundfunktionen +1.stat intern + + + + + diff --git a/app/schulis/2.2.1/src/0.ERFASSUNGEN LISTENWEISE.files b/app/schulis/2.2.1/src/0.ERFASSUNGEN LISTENWEISE.files new file mode 100644 index 0000000..51bb04d --- /dev/null +++ b/app/schulis/2.2.1/src/0.ERFASSUNGEN LISTENWEISE.files @@ -0,0 +1,10 @@ +0.hjd grundfunktionen +0.listenweise grundfunktionen +0.kurswahlbasis bereinigen +0.listenweise klassen erf +1.listenweise erg vers konf +1.listenweise erg nachpr +1.listenweise dif dat erf +1.listenweise klassenbildung +3.listenweise lehrer erf + diff --git a/app/schulis/2.2.1/src/0.ERFASSUNGEN.files b/app/schulis/2.2.1/src/0.ERFASSUNGEN.files new file mode 100644 index 0000000..139597f --- /dev/null +++ b/app/schulis/2.2.1/src/0.ERFASSUNGEN.files @@ -0,0 +1,2 @@ + + diff --git a/app/schulis/2.2.1/src/0.IDA SERVER.files b/app/schulis/2.2.1/src/0.IDA SERVER.files new file mode 100644 index 0000000..504c576 --- /dev/null +++ b/app/schulis/2.2.1/src/0.IDA SERVER.files @@ -0,0 +1,4 @@ +0.ida.data +0.ida.server + + diff --git a/app/schulis/2.2.1/src/0.IDA SICHERUNG.files b/app/schulis/2.2.1/src/0.IDA SICHERUNG.files new file mode 100644 index 0000000..6a7804e --- /dev/null +++ b/app/schulis/2.2.1/src/0.IDA SICHERUNG.files @@ -0,0 +1,4 @@ +0.ida.data +0.ida.form + + diff --git a/app/schulis/2.2.1/src/0.LISTEN 2.files b/app/schulis/2.2.1/src/0.LISTEN 2.files new file mode 100644 index 0000000..bfb49ca --- /dev/null +++ b/app/schulis/2.2.1/src/0.LISTEN 2.files @@ -0,0 +1,18 @@ +0.listen.faecher +0.listen.schuelergruppen +3.listen.paraphen +3.listen.sprechzeiten +3.listen.wochenstunden +3.listen.lehrbef faecherweise +3.listen.lehrbef lehrerweise +4.faecherangebot drucken +0.liste der zeitrasterdaten +4.listen.unterrichtsverteilung +0.listen.raumgruppen +0.listen.klassengruppen +4.zeitwuensche drucken +0.liste der aufsichtszeiten +4.listen.aufsichtsplan +4.liste ausgewaehlter kopplungen drucken + + diff --git a/app/schulis/2.2.1/src/0.LISTEN.files b/app/schulis/2.2.1/src/0.LISTEN.files new file mode 100644 index 0000000..af0173b --- /dev/null +++ b/app/schulis/2.2.1/src/0.LISTEN.files @@ -0,0 +1,15 @@ +1.listen.neuan +1.listen.gesamt +1.listen.gebu +1.listen.adressen +1.listen.klassenbuch +1.listen.klassen +1.listen.abgem +0.listen.benutz +1.listen.wiederholer +1.listen.nachpruefung +1.listen.prot versetzkonferenz +0.listen.schlueabku +0.listen.schulen + + diff --git a/app/schulis/2.2.1/src/0.LOCAL.files b/app/schulis/2.2.1/src/0.LOCAL.files new file mode 100644 index 0000000..1731322 --- /dev/null +++ b/app/schulis/2.2.1/src/0.LOCAL.files @@ -0,0 +1,4 @@ +0.grundfunktionen local +0.hoeherstufen local.prog + + diff --git a/app/schulis/2.2.1/src/0.anschr.druckereinstellung b/app/schulis/2.2.1/src/0.anschr.druckereinstellung new file mode 100644 index 0000000..5e014bf --- /dev/null +++ b/app/schulis/2.2.1/src/0.anschr.druckereinstellung @@ -0,0 +1,69 @@ +PACKET anschrdruckereinstellungDEFINES einstellungderausgabefueranschreiben, +einstellungderausgabefuermitteilung, +leseveraenderteausgabeneinstellunganschreiben, +leseveraenderteausgabeneinstellungmitteilung, +initialisieredruckerfueranschreiben,initialisieredruckerfuermitteilung,:REAL +VAR anschreibenstartx:=2.54,anschreibenstarty:=2.35,mitteilungstartx:=2.54, +mitteilungstarty:=2.35;INT VAR anschreibendruckbreite:=70, +mitteilungdruckbreite:=70;INT CONST minbreiteanschreiben:=50, +minbreitemitteilung:=70;LET maske="ms einstellung druck anschreiben";LET +schriftfeldnr=2,druckbreitefeldnr=3,mindruckbreitefeldnr=4,startxfeldnr=5, +startyfeldnr=6;LET maxstartxy=10.0,textnull="0.0",realnull=0.0, +eingabenichtsinnvoll=162;LET niltext="";PROC +initialisieredruckerfueranschreiben:setzeanzahlderzeichenprozeile( +anschreibendruckbreite);schrift(anschreibenschrifttyp);start( +anschreibenstartx,anschreibenstarty);END PROC +initialisieredruckerfueranschreiben;PROC einstellungderausgabefueranschreiben +:standardstartproc(maske);standardmaskenfeld(anschreibenschrifttyp, +schriftfeldnr);standardmaskenfeld(text(anschreibendruckbreite), +druckbreitefeldnr);standardmaskenfeld(text(minbreiteanschreiben), +mindruckbreitefeldnr);standardmaskenfeld(text(anschreibenstartx),startxfeldnr +);standardmaskenfeld(text(anschreibenstarty),startyfeldnr);standardnprocEND +PROC einstellungderausgabefueranschreiben;PROC +leseveraenderteausgabeneinstellunganschreiben:INT VAR testdruckzeilenbreite; +TEXT VAR teststartx,teststarty;BOOL VAR werteinordnung:=TRUE ; +testdruckzeilenbreite:=int(standardmaskenfeld(druckbreitefeldnr));teststartx +:=compress(standardmaskenfeld(startxfeldnr));teststarty:=compress( +standardmaskenfeld(startyfeldnr));ueberpruefendergegebenenwerte;IF +werteinordnungTHEN werteuebernehmen;enter(2)ELSE meldefehler;return(1)FI . +ueberpruefendergegebenenwerte:IF testdruckzeilenbreite +textnullAND real(teststartx)=realnull)OR real(teststartx)>maxstartxyOR real( +teststartx)textnullAND real(teststarty)=realnull)OR real(teststarty)> +maxstartxyOR real(teststarty) +textnullAND real(teststartx)=realnull)OR real(teststartx)>maxstartxyOR real( +teststartx)textnullAND real(teststarty)=realnull)OR real(teststarty)> +maxstartxyOR real(teststarty)( +kennzahlsonderwert+anzahlsonderwerteschulkenndaten))AND (index<= +laengedessonderwertpuffers+kennzahlsonderwert)THEN sonderwertpuffer(index- +kennzahlsonderwert):=sondertextFI END PROC setzesonderwert;PROC +sonderwertefuernaechstesundvorangehendesschuljahr(TEXT CONST +aktuellesschuljahr):sonderwertfuernaechstesschuljahr; +sonderwertfuervorangehendesschuljahr.sonderwertfuernaechstesschuljahr: +sonderwertpuffer(swindexnaechstesschuljahr):=addierezumerstenjahreins+"/"+ +addierezumzweitenjahreins;.addierezumerstenjahreins:text((int(subtext( +aktuellesschuljahr,1,2))+1)MOD 100).addierezumzweitenjahreins:text((int( +subtext(aktuellesschuljahr,3,4))+1)MOD 100). +sonderwertfuervorangehendesschuljahr:sonderwertpuffer( +swindexvorangehendesschuljahr):=subtrahierevomerstenjahreins+"/"+ +subtrahierevomzweitenjahreins;.subtrahierevomerstenjahreins:text((int(subtext +(aktuellesschuljahr,1,2))+99)MOD 100).subtrahierevomzweitenjahreins:text((int +(subtext(aktuellesschuljahr,3,4))+99)MOD 100).END PROC +sonderwertefuernaechstesundvorangehendesschuljahr;PROC zeigeallesonderwerte: +INT VAR z,z1;page;z:=1;REP FOR z1FROM 1UPTO 20REP putline(text(z)+" "+ +sonderwertpuffer(z));zINCR 1;PER ;pauseUNTIL z>=laengedessonderwertpuffers +PER ;END PROC zeigeallesonderwerte;TEXT PROC sonderwert(INT CONST swindex): +IF swindex>kennzahlsonderwertAND swindex<=kennzahlsonderwert+ +laengedessonderwertpuffersTHEN sonderwertpuffer(swindex-kennzahlsonderwert) +ELSE niltextFI END PROC sonderwert;PROC adressat(TEXT CONST name): +sonderwertpuffer(indexadressat-kennzahlsonderwert):=compress(subtext(name,1, +20))END PROC adressat;TEXT PROC lueckenwert(INT CONST fnr1):IF fnr1<= +kennzahlsonderwertTHEN aufbereiteterdbwertELSE sonderwertpuffer(fnr1- +kennzahlsonderwert)FI .aufbereiteterdbwert:IF (feldtyp(fnr1)=intfeldCAND +intwert(fnr1)=0)COR (feldtyp(fnr1)=datumfeldCAND wert(fnr1)="01.01.00")THEN +""ELSE wert(fnr1)FI .END PROC lueckenwert;TEXT PROC zeilenalternative(TEXT +CONST eingabe,BOOL CONST rekursiveraufruf):INT VAR positionlinkeklammer:=1, +positionrechteklammer:=1,positionlinkeskreuz,positionrechteskreuz, +positionmittlereskreuz,positionparametergrenze,parameter1,parameter2, +positionparametertrennzeichen,laenge,pufferlaenge,aktuelleposition, +positionotherwise,anzahldergeoeffnetenklammern;BOOL VAR ausdruckvorhanden, +caseaufruf,linkeseitevariabel,rechteseitevariabel;TEXT VAR puffer, +vergleichswert,aktuellessymbol,ausgabe:=eingabe;REP +auffindeneinesspitzgeklammertenausdrucks;IF ausdruckvorhandenTHEN +bestimmungderuebergabeparameterfuerdieprozedurlueckenwert; +aufrufderprozedurlueckenwert;IF NOT caseaufrufTHEN bestimmungdesteiltextes +ELSE bestimmungderrichtigenalternativeFI ; +einsetzendesteiltextesoderderalternative;FI ;UNTIL NOT ausdruckvorhandenPER ; +ausgabe.auffindeneinesspitzgeklammertenausdrucks:aktuelleposition:=0; +linkeseitevariabel:=FALSE ;rechteseitevariabel:=FALSE ;aktuelleposition:=pos( +ausgabe,linkeklammer);ausdruckvorhanden:=aktuelleposition<>0; +positionlinkeklammer:=aktuelleposition. +bestimmungderuebergabeparameterfuerdieprozedurlueckenwert: +ueberpruefeoblinkeseitedoppeltgeklammert;bestimmedenerstenuebergabeparameter; +IF aktuellessymbol<>parametertrennzeichenTHEN parameter2:=1;ELSE +bestimmedenzweitenuebergabeparameterFI ;IF aktuellessymbol=rechteklammerTHEN +caseaufruf:=FALSE ;fuehreleseoperationaus; +ueberpruefeobrechteseitedoppeltgeklammertELSE caseaufruf:=TRUE ; +positionparametergrenze:=aktuellepositionFI .fuehreleseoperationaus: +aktuellepositionINCR 1;aktuellessymbol:=ausgabeSUB aktuelleposition;IF +aktuellessymbol=linkeklammerTHEN anzahldergeoeffnetenklammernINCR 1ELIF +aktuellessymbol=rechteklammerTHEN anzahldergeoeffnetenklammernDECR 1FI . +ueberpruefeoblinkeseitedoppeltgeklammert:fuehreleseoperationaus; +linkeseitevariabel:=aktuellessymbol=linkeklammer. +bestimmedenerstenuebergabeparameter:WHILE NOT (aktuellessymbol= +parametertrennzeichenOR aktuellessymbol=parametergrenzeOR aktuellessymbol= +rechteklammer)REP fuehreleseoperationausPER ;IF linkeseitevariabelTHEN +parameter1:=int(subtext(ausgabe,positionlinkeklammer+2,aktuelleposition-1)) +ELSE parameter1:=int(subtext(ausgabe,positionlinkeklammer+1,aktuelleposition- +1))FI .bestimmedenzweitenuebergabeparameter:positionparametertrennzeichen:= +aktuelleposition;REP fuehreleseoperationausUNTIL aktuellessymbol= +parametergrenzeOR aktuellessymbol=rechteklammerPER ;parameter2:=int(subtext( +ausgabe,positionparametertrennzeichen+1,aktuelleposition-1)). +ueberpruefeobrechteseitedoppeltgeklammert:IF aktuellessymbol=rechteklammer +THEN rechteseitevariabel:=TRUE ;positionrechteklammer:=aktuellepositionELSE +positionrechteklammer:=aktuelleposition-1FI .bestimmungdesteiltextes:IF NOT +rekursiveraufrufTHEN bestimmungderlaengederauszufuellendenluecke; +entsprechendenabschnittdeserhaltenenwortesbestimmenFI . +aufrufderprozedurlueckenwert:puffer:=lueckenwert(parameter1#,parameter2#). +bestimmungderlaengederauszufuellendenluecke:laenge:=positionrechteklammer- +positionlinkeklammer+1.entsprechendenabschnittdeserhaltenenwortesbestimmen: +pufferlaenge:=length(puffer);IF pufferlaenge<=laengeTHEN IF NOT ( +linkeseitevariabelOR rechteseitevariabel)THEN puffer:=puffer+((laenge- +pufferlaenge)*" ")ELIF linkeseitevariabelTHEN puffer:=((laenge-pufferlaenge)* +" ")+pufferFI ;ELSE IF NOT linkeseitevariabelTHEN puffer:=subtext(puffer,1, +laenge);ELSE puffer:=subtext(puffer,pufferlaenge-laenge+1,pufferlaenge)FI ; +FI .bestimmungderrichtigenalternative:bestimmungdeserstenvergleichswertes; +WHILE vergleichswertstimmtnichtuebereinundeinweiterervorhandenREP +suchenaechstenvergleichswertPER ;positionrechteklammerbeicaseaufrufbestimmen; +IF vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufuebereinTHEN +bereitstellenderentsprechendenalternativeELIF (ausgabeSUB positionotherwise)= +otherwiseTHEN puffer:=zeilenalternative(subtext(ausgabe,positionotherwise+1, +positionrechteklammer-1),TRUE )ELSE bereitstelleneinerleerenalternativeFI . +bestimmungdeserstenvergleichswertes:positionlinkeskreuz:= +positionparametergrenze;positionmittlereskreuz:=pos(ausgabe, +parametertrennzeichen,positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe, +positionlinkeskreuz+1,positionmittlereskreuz-1);rechteskreuzbestimmen. +suchenaechstenvergleichswert:positionlinkeskreuz:=positionrechteskreuz; +positionmittlereskreuz:=pos(ausgabe,parametertrennzeichen,positionlinkeskreuz ++1);vergleichswert:=subtext(ausgabe,positionlinkeskreuz+1, +positionmittlereskreuz-1);rechteskreuzbestimmen.rechteskreuzbestimmen: +aktuelleposition:=positionmittlereskreuz;anzahldergeoeffnetenklammern:=0;REP +fuehreleseoperationausUNTIL (anzahldergeoeffnetenklammern=0AND ( +aktuellessymbol=parametertrennzeichenOR aktuellessymbol=otherwise))OR +anzahldergeoeffnetenklammern<0PER ;positionrechteskreuz:=aktuelleposition; +positionotherwise:=aktuelleposition. +vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufueberein: +vergleichswert=puffer.bereitstellenderentsprechendenalternative:puffer:= +zeilenalternative(subtext(ausgabe,positionmittlereskreuz+1, +positionrechteskreuz-1),TRUE ).bereitstelleneinerleerenalternative:puffer:="" +.vergleichswertstimmtnichtuebereinundeinweiterervorhanden:NOT +vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufuebereinAND +einweiterervergleichswertistvorhanden.einweiterervergleichswertistvorhanden: +aktuellessymbol=parametertrennzeichen. +positionrechteklammerbeicaseaufrufbestimmen:anzahldergeoeffnetenklammern:=0; +IF aktuellessymbol<>rechteklammerTHEN WHILE NOT (anzahldergeoeffnetenklammern +<0AND aktuellessymbol=rechteklammer)REP fuehreleseoperationausPER FI ; +positionrechteklammer:=aktuelleposition. +einsetzendesteiltextesoderderalternative:change(ausgabe,positionlinkeklammer, +positionrechteklammer,puffer).END PROC zeilenalternative;PROC +setzeanzahlderzeichenprozeile(INT CONST anzahl):zeilenlaenge:=anzahlEND PROC +setzeanzahlderzeichenprozeile;PROC schrift(TEXT CONST typ):schrifttyp:=typ +END PROC schrift;PROC start(REAL CONST x,y):ersterparameterstartanweisung:= +text(x);zweiterparameterstartanweisung:=text(y)END PROC start;PROC +schreibesteuerzeichenzeile(TEXT CONST dateiname):FILE VAR f:=sequentialfile( +output,dateiname);LET druckersteuerzeichen="#",praefixschrifttypanweisung= +"type(""",praefixstartanweisung="start(",komma=",",suffixstartanweisung=")", +suffixschrifttypanweisung=""")",pagelengthanweisung="#pagelength(29.0)#"; +putline(f,druckersteuerzeichen+praefixschrifttypanweisung+schrifttyp+ +suffixschrifttypanweisung+druckersteuerzeichen+druckersteuerzeichen+ +praefixstartanweisung+ersterparameterstartanweisung+komma+ +zweiterparameterstartanweisung+suffixstartanweisung+druckersteuerzeichen+ +pagelengthanweisung)END PROC schreibesteuerzeichenzeile;PROC briefalternative +(TEXT CONST eingabedatei,ausgabedatei):TEXT VAR ausgabe:=ausgabedatei;TEXT +VAR zeile:="",text:="",praefixdernaechstenzeile:="",briefzeile:="";BOOL VAR +absatzende;INT VAR postrennzeichen:=1,z;LET trennzeichen=" ";FILE VAR f:= +sequentialfile(output,ausgabe);FILE VAR eingabe:=sequentialfile(input, +eingabedatei);WHILE NOT eof(eingabe)REP holezeileausdemvordruck; +einrueckendererstenbriefzeilevorbereiten;REP ueberpruefeaufabsatzende; +ersetzeindergeholtenzeilediegeklammertenausdruecke; +konkatenierediegeholtezeilemitdemrestdervorangehenden;IF briefzeilelanggenug +OR absatzendeTHEN zeilenumbruch;WHILE absatzendeAND nochtextvorhandenREP +bildedenrestdesumbruchs;zeilenumbruchPER FI ;IF NOT absatzendeTHEN +holezeileausdemvordruck;einrueckendernaechstenbriefzeilevorbereiten;FI ; +UNTIL absatzendePER PER .holezeileausdemvordruck:getline(eingabe,zeile). +konkatenierediegeholtezeilemitdemrestdervorangehenden:briefzeile:=text+zeile+ +trennzeichen;text:=briefzeile.ueberpruefeaufabsatzende:absatzende:=(zeileSUB +(length(zeile)))=trennzeichen.briefzeilelanggenug:(length(briefzeile))>= +zeilenlaenge.bildedenrestdesumbruchs:briefzeile:=text.nochtextvorhanden: +length(subtext(text,length(praefixdernaechstenzeile)+1))>1.zeilenumbruch:IF ( +zeilenlaengetrennzeichenREP postrennzeichen:=postrennzeichen-1PER ;putline(f,subtext( +briefzeile,1,postrennzeichen-1));text:=praefixdernaechstenzeile+subtext( +briefzeile,postrennzeichen+1);.einrueckendernaechstenbriefzeilevorbereiten: +praefixdernaechstenzeile:="";z:=1;WHILE ((zeileSUB z)=trennzeichen)AND ( +length(zeile)>z)REP praefixdernaechstenzeile:=praefixdernaechstenzeile+ +trennzeichen;z:=z+1PER ;zeile:=subtext(zeile,z);. +einrueckendererstenbriefzeilevorbereiten:praefixdernaechstenzeile:="";z:=1; +WHILE ((zeileSUB z)=trennzeichen)AND (length(zeile)>z)REP +praefixdernaechstenzeile:=praefixdernaechstenzeile+trennzeichen;z:=z+1PER ; +text:="";.ersetzeindergeholtenzeilediegeklammertenausdruecke:zeile:= +zeilenalternative(zeile,FALSE ).END PROC briefalternative;PROC +setzesonderwerteschulkenndaten:TEXT VAR schlsicherung;savetupel(dnrschluessel +,schlsicherung);TEXT VAR aktj:=schulkenndatum("Schuljahr");sonderwertpuffer( +swindexschulname):=schulkenndatum("Schulname");sonderwertpuffer( +swindexschulstrasse):=schulkenndatum("Schulstraße");sonderwertpuffer( +swindexschulort):=schulkenndatum("Schulort");sonderwertpuffer( +swindexschuljahr):=aktj;insertchar(sonderwertpuffer(swindexschuljahr),"/",3); +sonderwertpuffer(swindexschulleiter):=schulkenndatum("Schulleiter"); +sonderwertpuffer(swindexhalbjahr):=schulkenndatum("Schulhalbjahr"); +sonderwertpuffer(swindexdatum):=date; +sonderwertefuernaechstesundvorangehendesschuljahr(aktj);restoretupel( +dnrschluessel,schlsicherung);ENDPROC setzesonderwerteschulkenndaten; +initialisiereallesonderwerte;initialisiereschriftundstart. +initialisiereschriftundstart:schrift("pica");.END PACKET +anschrgrundfunktionenfueranschreiben; + diff --git a/app/schulis/2.2.1/src/0.anschr.steuerfunktionen einfach b/app/schulis/2.2.1/src/0.anschr.steuerfunktionen einfach new file mode 100644 index 0000000..e0024ca --- /dev/null +++ b/app/schulis/2.2.1/src/0.anschr.steuerfunktionen einfach @@ -0,0 +1,96 @@ +PACKET anschrsteuerfunktionenfuereinfacheanschreibenDEFINES anschreibenstart, +naechstesanschreiben:LET anschreibentext="Text des Anschreibens";LET manager= +"anschreiben server";LET niltext="",nildatum="01.01.00";LET nproc=1, +eingangsbildschirm=2;LET vorwaertstaste="a";LET tupelstackgroesse=10;LET +ROWTEXT =ROW 10TEXT ;LET druckmeldnr=125,existiertnichtnr=126,leermeldnr=127, +endemeldnr=128,weitereangabenr=129,nichterstellbarmeldnr=130;TEXT VAR +druckmeld:="";LET meldkz="#";INT VAR dateinummer,aktuellerindex,anzgeftupel; +TEXT VAR anschreibenvordruck;BOOL VAR einzelbearbeitung;PROC anschreibenstart +(INT CONST aktuellerinx,TEXT CONST vordruck,BOOL CONST anschreibenzeigen, +peinzelbearbeitung,BOOL PROC sonderwerteundueberpruefungauferstellbarkeit, +BOOL PROC pruefespeziell):ROWTEXT VAR schluesselsve1,schluesselsve2;INT VAR i +;vorbereitungen;IF einzelbearbeitungTHEN einzelanschreibenELSE +anschreibenfuerbestandFI .anschreibenfuerbestand:IF leererbestandTHEN +meldeleerenbestand;zurueckzumeingangsbildschirmELSE +bearbeiteallediesesbestandesFI .bearbeiteallediesesbestandes:IF +anschreibenzeigenTHEN erstenbearbeitenELSE anschreibenleseschleife(BOOL PROC +sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell); +meldeendederbrieferstellung;zurueckzumeingangsbildschirmFI .erstenbearbeiten: +BOOL VAR erstellbar:=TRUE ;BOOL VAR bestandleer:=FALSE ;erstellbar:= +sonderwerteundueberpruefungauferstellbarkeit;IF erstellbarTHEN +bearbeitenzumzeigenELSE REP IF anzgeftupel=0THEN anzgeftupel:= +tupelstackgroesse;multisucc(aktuellerindex,anzgeftupel)FI ;IF anzgeftupel<>0 +THEN multisucc;anzgeftupelDECR 1;bestandleer:=NOT pruefespeziellELSE +bestandleer:=TRUE FI UNTIL bestandleerCOR +sonderwerteundueberpruefungauferstellbarkeitPER ;IF NOT bestandleerTHEN +bearbeitenzumzeigenELSE zurueckzumeingangsbildschirm; +meldeendederbrieferstellungFI FI .bearbeitenzumzeigen:IF einzelbearbeitung +CAND NOT sonderwerteundueberpruefungauferstellbarkeitTHEN +meldenichterstellbar;zurueckzumeingangsbildschirmELSE +schreibesteuerzeichenzeile(anschreibentext);briefalternative( +anschreibenvordruck,anschreibentext);editierebriefFI .einzelanschreiben: +direktlesen;IF gefundenTHEN IF eindeutigTHEN datenlesen;IF anschreibenzeigen +THEN bearbeitenzumzeigenELSE einzelbriefschreiben; +zurueckzumeingangsbildschirmFI ELSE meldeanforderunggenauererangaben; +zurueckzumeingangsbildschirmFI ELSE meldenichtgefunden; +zurueckzumeingangsbildschirmFI .vorbereitungen:dateinummer:=dateinr(primdatid +(aktuellerinx));aktuellerindex:=aktuellerinx;einzelbearbeitung:= +peinzelbearbeitung;meldungstext(druckmeldnr,druckmeld); +setzesonderwerteschulkenndaten;setzewerte;holeanschreibenvordruck.setzewerte: +anschreibenvordruck:=vordruck.holeanschreibenvordruck:loeschealtenvordruck; +fetch(anschreibenvordruck,/manager).loeschealtenvordruck:forget(vordruck, +quiet).direktlesen:gesetztenschluesselsichern(schluesselsve1);anzgeftupel:=2; +multisearchforward(aktuellerindex,anzgeftupel).gefunden:IF anzgeftupel=0THEN +FALSE ELSE multisucc;pruefespeziellCAND schluesselgleichFI .schluesselgleich: +NOT schluesselungleich(schluesselsve1,schluesselsve1).eindeutig:anzgeftupel=1 +COR naechsterungleich.naechsterungleich:gesetztenschluesselsichern( +schluesselsve2);multisucc;IF NOT pruefespeziellTHEN TRUE ELSE +schluesselungleich(schluesselsve1,schluesselsve2)FI .datenlesen:stackentry(1) +.einzelbriefschreiben:IF NOT sonderwerteundueberpruefungauferstellbarkeit +THEN meldenichterstellbarELSE briefschreibenFI .meldenichtgefunden: +standardmeldung(existiertnichtnr,niltext).meldeanforderunggenauererangaben: +standardmeldung(weitereangabenr,niltext).meldenichterstellbar:standardmeldung +(nichterstellbarmeldnr,sonderwert(indexadressat)+meldkz). +meldeendederbrieferstellung:standardmeldung(endemeldnr,niltext). +zurueckzumeingangsbildschirm:return(nproc).leererbestand:anzgeftupel:= +tupelstackgroesse;multisearchforward(aktuellerindex,anzgeftupel);IF +anzgeftupel<>0THEN multisucc;anzgeftupelDECR 1;NOT pruefespeziellELSE TRUE +FI .meldeleerenbestand:standardmeldung(leermeldnr,niltext).END PROC +anschreibenstart;BOOL PROC schluesselungleich(ROWTEXT CONST sve1,sve2):INT +VAR i;FOR iFROM 1UPTO anzkey(dateinummer)REP IF sve1[i]=""COR (feldtyp( +dateinummer+i)=datumfeldCAND sve1[i]=nildatum)THEN LEAVE schluesselungleich +WITH FALSE FI ;IF sve2[i]<>wert(dateinummer+i)THEN LEAVE schluesselungleich +WITH TRUE FI PER ;FALSE ENDPROC schluesselungleich;PROC +gesetztenschluesselsichern(ROW 10TEXT VAR schluesselsve):INT VAR i;FOR iFROM +1UPTO anzkey(dateinummer)REP schluesselsve[i]:=wert(dateinummer+i)PER +ENDPROC gesetztenschluesselsichern;PROC briefschreiben: +schreibesteuerzeichenzeile(anschreibentext);briefalternative( +anschreibenvordruck,anschreibentext);print(anschreibentext);standardmeldung( +druckmeldnr,sonderwert(indexadressat)+meldkz);forget(anschreibentext,quiet) +END PROC briefschreiben;PROC anschreibenleseschleife(BOOL PROC +sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell):BOOL +VAR schluss:=FALSE ;vorlesen;leseschleife.leseschleife:WHILE NOT schlussREP +IF sonderwerteundueberpruefungauferstellbarkeitTHEN briefschreibenELSE +standardmeldung(nichterstellbarmeldnr,sonderwert(indexadressat)+meldkz)FI ; +lesenPER .lesen:IF anzgeftupel=0THEN anzgeftupel:=tupelstackgroesse;multisucc +(aktuellerindex,anzgeftupel)FI ;satzlesen.vorlesen:anzgeftupel:= +tupelstackgroesse;multisearchforward(aktuellerindex,anzgeftupel);satzlesen. +satzlesen:IF anzgeftupel<>0THEN multisucc;anzgeftupelDECR 1;schluss:=NOT +pruefespeziellELSE schluss:=TRUE FI .END PROC anschreibenleseschleife;PROC +editierebrief:editiere(anschreibentext,vorwaertstaste,FALSE )END PROC +editierebrief;PROC naechstesanschreiben(BOOL PROC +sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell,BOOL +CONST drucken):BOOL VAR bestandleer:=FALSE ;IF druckenTHEN print( +anschreibentext);standardmeldung(druckmeld#nr,#,sonderwert(indexadressat)+ +meldkz)FI ;forget(anschreibentext,quiet);IF einzelbearbeitungTHEN enter( +eingangsbildschirm)ELSE REP IF anzgeftupel=0THEN anzgeftupel:= +tupelstackgroesse;multisucc(aktuellerindex,anzgeftupel)FI ;IF anzgeftupel<>0 +THEN multisucc;anzgeftupelDECR 1;bestandleer:=NOT pruefespeziellELSE +bestandleer:=TRUE FI UNTIL bestandleerCOR +sonderwerteundueberpruefungauferstellbarkeitPER ;IF NOT bestandleerTHEN +schreibesteuerzeichenzeile(anschreibentext);briefalternative( +anschreibenvordruck,anschreibentext);return(nproc)ELSE standardmeldung( +endemeldnr,niltext);#enter(eingangsbildschirm)#return(eingangsbildschirm)FI +FI END PROC naechstesanschreiben;END PACKET +anschrsteuerfunktionenfuereinfacheanschreiben; + diff --git a/app/schulis/2.2.1/src/0.anschr.steuerfunktionen zusammengesetzt b/app/schulis/2.2.1/src/0.anschr.steuerfunktionen zusammengesetzt new file mode 100644 index 0000000..0b77e49 --- /dev/null +++ b/app/schulis/2.2.1/src/0.anschr.steuerfunktionen zusammengesetzt @@ -0,0 +1,87 @@ +PACKET anschrsteuerfunktionenfuerzusammengesetzteanschreibenDEFINES +zusammengesetztesanschreiben,naechsteszusammengesetztesanschreiben:LET +niltext="",nildatum="01.01.00";LET nproc=1,eingangsbildschirm=2;LET +vorwaertstaste="a";LET tupelstackgroesse=10;LET druckmeldnr=125, +existiertnichtnr=126,leermeldnr=127,endemeldnr=128,weitereangabenr=129, +nichterstellbarmeldnr=130;TEXT VAR druckmeld:="",anschreibentext;LET meldkz= +"#";INT VAR dateinummer,aktuellerindex,anzgeftupel;BOOL VAR einzelbearbeitung +;PROC zusammengesetztesanschreiben(INT CONST aktuellerinx,BOOL CONST +anschreibenzeigen,peinzelbearbeitung,BOOL PROC sonderwerteundueberpruefungauf +erstellbarkeit,BOOL PROC pruefespeziell,TEXT PROC druckdatei):ROW 10TEXT VAR +schluesselsve1,schluesselsve2;INT VAR i;vorbereitungen;IF einzelbearbeitung +THEN einzelanschreibenELSE anschreibenfuerbestandFI .anschreibenfuerbestand: +IF leererbestandTHEN meldeleerenbestand;zurueckzumeingangsbildschirmELSE +bearbeiteallediesesbestandesFI .bearbeiteallediesesbestandes:IF +anschreibenzeigenTHEN erstenbearbeitenELSE anschreibenleseschleife(BOOL PROC +sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell,TEXT +PROC druckdatei);meldeendederbrieferstellung;zurueckzumeingangsbildschirmFI . +erstenbearbeiten:BOOL VAR erstellbar:=TRUE ;BOOL VAR bestandleer:=FALSE ; +erstellbar:=sonderwerteundueberpruefungauferstellbarkeit;IF erstellbarTHEN +bearbeitenzumzeigenELSE REP IF anzgeftupel=0THEN anzgeftupel:= +tupelstackgroesse;multisucc(aktuellerindex,anzgeftupel)FI ;IF anzgeftupel<>0 +THEN multisucc;anzgeftupelDECR 1;bestandleer:=NOT pruefespeziellELSE +bestandleer:=TRUE FI UNTIL bestandleerCOR +sonderwerteundueberpruefungauferstellbarkeitPER ;IF NOT bestandleerTHEN +bearbeitenzumzeigenELSE zurueckzumeingangsbildschirm; +meldeendederbrieferstellungFI FI .bearbeitenzumzeigen:IF einzelbearbeitung +CAND NOT sonderwerteundueberpruefungauferstellbarkeitTHEN +meldenichterstellbar;zurueckzumeingangsbildschirmELSE anschreibentext:= +druckdatei;editierebriefFI .einzelanschreiben:direktlesen;IF gefundenTHEN IF +eindeutigTHEN datenlesen;IF anschreibenzeigenTHEN bearbeitenzumzeigenELSE +einzelbriefschreiben;zurueckzumeingangsbildschirmFI ELSE +meldeanforderunggenauererangaben;return(1)FI ELSE meldenichtgefunden;return(1 +)FI .vorbereitungen:dateinummer:=dateinr(primdatid(aktuellerinx)); +aktuellerindex:=aktuellerinx;einzelbearbeitung:=peinzelbearbeitung; +meldungstext(druckmeldnr,druckmeld);setzesonderwerteschulkenndaten;. +direktlesen:gesetztenschluesselsichern(schluesselsve1);anzgeftupel:=2; +multisearchforward(aktuellerindex,anzgeftupel).gefunden:IF anzgeftupel=0THEN +FALSE ELSE multisucc;pruefespeziellFI .eindeutig:anzgeftupel=1COR +naechsterungleich.naechsterungleich:gesetztenschluesselsichern(schluesselsve2 +);multisucc;IF NOT pruefespeziellTHEN TRUE ELSE FOR iFROM 1UPTO anzkey( +dateinummer)REP IF schluesselsve1[i]=""COR (feldtyp(dateinummer+i)=datumfeld +CAND schluesselsve1[i]=nildatum)THEN LEAVE naechsterungleichWITH FALSE FI ; +IF schluesselsve2[i]<>wert(dateinummer+i)THEN LEAVE naechsterungleichWITH +TRUE FI PER ;FALSE FI .datenlesen:stackentry(1).einzelbriefschreiben:IF NOT +sonderwerteundueberpruefungauferstellbarkeitTHEN meldenichterstellbarELSE +briefschreibenFI .meldenichtgefunden:standardmeldung(existiertnichtnr,niltext +).meldeanforderunggenauererangaben:standardmeldung(weitereangabenr,niltext). +meldenichterstellbar:standardmeldung(nichterstellbarmeldnr,sonderwert( +indexadressat)+meldkz).meldeendederbrieferstellung:standardmeldung(endemeldnr +,niltext).zurueckzumeingangsbildschirm:enter(nproc).leererbestand:anzgeftupel +:=tupelstackgroesse;multisearchforward(aktuellerindex,anzgeftupel);IF +anzgeftupel<>0THEN multisucc;anzgeftupelDECR 1;NOT pruefespeziellELSE TRUE +FI .meldeleerenbestand:standardmeldung(leermeldnr,niltext).briefschreiben: +anschreibentext:=druckdatei;print(anschreibentext);standardmeldung( +druckmeldnr,sonderwert(indexadressat)+meldkz);forget(anschreibentext,quiet). +END PROC zusammengesetztesanschreiben;PROC gesetztenschluesselsichern(ROW 10 +TEXT VAR schluesselsve):INT VAR i;FOR iFROM 1UPTO anzkey(dateinummer)REP +schluesselsve[i]:=wert(dateinummer+i)PER ENDPROC gesetztenschluesselsichern; +PROC anschreibenleseschleife(BOOL PROC sonderwerteundueberpruefungauf +erstellbarkeit,BOOL PROC pruefespeziell,TEXT PROC druckdatei):BOOL VAR +schluss:=FALSE ;vorlesen;leseschleife.leseschleife:WHILE NOT schlussREP IF +sonderwerteundueberpruefungauferstellbarkeitTHEN briefschreibenELSE +standardmeldung(nichterstellbarmeldnr,sonderwert(indexadressat)+meldkz)FI ; +lesenPER .lesen:IF anzgeftupel=0THEN anzgeftupel:=tupelstackgroesse;multisucc +(aktuellerindex,anzgeftupel)FI ;satzlesen.vorlesen:anzgeftupel:= +tupelstackgroesse;multisearchforward(aktuellerindex,anzgeftupel);satzlesen. +satzlesen:IF anzgeftupel<>0THEN multisucc;anzgeftupelDECR 1;schluss:=NOT +pruefespeziellELSE schluss:=TRUE FI .briefschreiben:anschreibentext:= +druckdatei;print(anschreibentext);standardmeldung(druckmeldnr,sonderwert( +indexadressat)+meldkz);forget(anschreibentext,quiet).END PROC +anschreibenleseschleife;PROC editierebrief:editiere(anschreibentext, +vorwaertstaste,FALSE )END PROC editierebrief;PROC +naechsteszusammengesetztesanschreiben(BOOL PROC +sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell,BOOL +CONST drucken,TEXT PROC druckdatei):BOOL VAR bestandleer:=FALSE ;IF drucken +THEN print(anschreibentext);standardmeldung(druckmeld#nr,#,sonderwert( +indexadressat)+meldkz)FI ;forget(anschreibentext,quiet);IF einzelbearbeitung +THEN enter(eingangsbildschirm)ELSE REP IF anzgeftupel=0THEN anzgeftupel:= +tupelstackgroesse;multisucc(aktuellerindex,anzgeftupel)FI ;IF anzgeftupel<>0 +THEN multisucc;anzgeftupelDECR 1;bestandleer:=NOT pruefespeziellELSE +bestandleer:=TRUE FI UNTIL bestandleerCOR +sonderwerteundueberpruefungauferstellbarkeitPER ;IF NOT bestandleerTHEN +anschreibentext:=druckdatei;return(nproc)ELSE standardmeldung(endemeldnr, +niltext);enter(eingangsbildschirm)FI FI END PROC +naechsteszusammengesetztesanschreiben;END PACKET +anschrsteuerfunktionenfuerzusammengesetzteanschreiben; + diff --git a/app/schulis/2.2.1/src/0.erf aufsichtszeiten b/app/schulis/2.2.1/src/0.erf aufsichtszeiten new file mode 100644 index 0000000..443be9d --- /dev/null +++ b/app/schulis/2.2.1/src/0.erf aufsichtszeiten @@ -0,0 +1,201 @@ +PACKET erfaufsichtszeitenDEFINES aufsichtszeitenveraendern, +aufsichtszeitenspeichern,aufsichtszeitenzeileentfernen, +aufsichtszeitenzeileeinfuegen,aufsichtszeitenuebernehmen, +aufsichtszeitenkopieren:LET niltext="",titelanfang="Aufsichtszeiten für das " +,titelmitte=". Halbjahr ",trennerfuerschuljahr="/",null=0,eins=1;LET +fnrfueruebernehmen=2,fnrfuergeplbearb=3,fnrabtagfuergepl=4,fnrfueraktbearb=5, +fnrabtagfuerakt=6,fnrcursorruhepos=7,allewochentagsbezeichnungen= +"MODIMIDOFRSAMoDiMiDoFrSamodimidofrsa",maske="ms aufsichtszeiten", +fnrwochentag=2,fnrerstebezeichnung=3,felderprozeile=5,offsetstundevor=1, +offsetstundenach=2,offsetbeginnuhr=3,offsetendeuhr=4,fnrerstesfeldletztezeile +=73,fnrletztesfeld=77,erstestundeamtag=1,stundenprowochentag=12, +stundenamsamstag=6,stelledestages=100,datensaetzepromaske=15;LET +textschuljahr="Schuljahr",textschulhalbjahr="Schulhalbjahr";LET +meldungfeldleerlassen=390,meldungzeilezutief=391,meldungmindeinestunde=392, +meldungspeicherung=50,meldungfalschezeitangabe=54,meldungeingabesinnlos=56, +meldungplausi=57,meldungdatenfehlen=68,meldungspeicherfehler=73, +meldungfrageuebernehmen=300,meldunguebernehmen=301,meldungzeitangabezulang= +341,meldungfalschezeitfolge=342,meldungfalschetagesbez=385, +meldungstdnachfolgend=386;TEXT VAR schuljahr:=niltext,halbjahr:=niltext;BOOL +VAR datenvorhanden;INT VAR tagnr;LET nummerfürmo=1,kürzelfürmo="Mo", +nummerfürdi=2,kürzelfürdi="Di",nummerfürmi=3,kürzelfürmi="Mi",nummerfürdo=4, +kürzelfürdo="Do",nummerfürfr=5,kürzelfürfr="Fr",nummerfürsa=6,kürzelfürsa= +"Sa";ROW datensaetzepromaskeTEXT VAR alteaufsichtszeiten;INT VAR aktindex; +PROC aufsichtszeitenzeileeinfuegen:INT VAR i,cursorfeld:=infeld;IF cursorfeld +>=fnrerstesfeldletztezeileTHEN standardmeldung(meldungzeilezutief,niltext); +ELSE cursorfeld:=cursorfeld-((cursorfeld-fnrerstebezeichnung)MOD +felderprozeile)+felderprozeile;FOR iFROM fnrletztesfeldDOWNTO cursorfeld+ +felderprozeileREP standardmaskenfeld(standardmaskenfeld(i-felderprozeile),i) +PER ;FOR iFROM cursorfeldUPTO cursorfeld+offsetendeuhrREP standardmaskenfeld( +niltext,i)PER ;FI ;return(1);END PROC aufsichtszeitenzeileeinfuegen;PROC +aufsichtszeitenzeileentfernen:INT VAR i,cursorfeld:=infeld;cursorfeld:= +cursorfeld-((cursorfeld-fnrerstebezeichnung)MOD felderprozeile);FOR iFROM +cursorfeldUPTO cursorfeld+offsetendeuhrREP standardmaskenfeld(niltext,i)PER ; +infeld(cursorfeld);return(1);END PROC aufsichtszeitenzeileentfernen;PROC +aufsichtszeitenveraendern:INT VAR aktfnr;pruefeplausidereingangsmaske; +setzeschulhalbjahrindenmaskekopf;holealledatendestages;infeld(fnrwochentag); +standardfelderausgeben;infeld(fnrerstebezeichnung);standardnproc. +pruefeplausidereingangsmaske:IF standardmaskenfeld(fnrfueruebernehmen)<> +niltextOR NOT (standardmaskenfeld(fnrfuergeplbearb)<>niltextXOR +standardmaskenfeld(fnrfueraktbearb)<>niltext)THEN standardmeldung( +meldungeingabesinnlos,niltext);IF standardmaskenfeld(fnrfueruebernehmen)= +niltextTHEN infeld(fnrfuergeplbearb)ELSE infeld(fnrfueruebernehmen)FI ;return +(1);LEAVE aufsichtszeitenveraendernFI ;IF standardmaskenfeld(fnrfuergeplbearb +)=niltextTHEN aktfnr:=fnrabtagfuergeplELSE aktfnr:=fnrabtagfueraktFI ;IF +standardmaskenfeld(aktfnr)<>niltextTHEN standardmeldung(meldungfeldleerlassen +,niltext);infeld(aktfnr);return(1);LEAVE aufsichtszeitenveraendernFI ;IF +standardmaskenfeld(fnrfuergeplbearb)=niltextTHEN aktfnr:=fnrabtagfueraktELSE +aktfnr:=fnrabtagfuergeplFI ;IF standardmaskenfeld(aktfnr)=niltextTHEN tagnr:= +nummerfürmo;ELSE tagnr:=pos(allewochentagsbezeichnungen,standardmaskenfeld( +aktfnr));IF tagnr=0THEN standardmeldung(meldungfalschetagesbez,niltext); +infeld(aktfnr);return(1);LEAVE aufsichtszeitenveraendernFI ;tagnr:=(tagnrMOD +12)DIV 2+1;FI .setzeschulhalbjahrindenmaskekopf:schuljahr:=schulkenndatum( +textschuljahr);halbjahr:=schulkenndatum(textschulhalbjahr);IF +standardmaskenfeld(fnrfuergeplbearb)<>niltextTHEN geplanteshjundsjberechnen( +halbjahr,schuljahr)FI ;standardstartproc(maske); +standardkopfmaskeaktualisieren(titelanfang+halbjahr+titelmitte+text(schuljahr +,2)+trennerfuerschuljahr+subtext(schuljahr,3)).END PROC +aufsichtszeitenveraendern;PROC aufsichtszeitenspeichern(BOOL CONST speichern) +:INT VAR fehlerstatus:=null,aktfnr,aznr,beginn,ende,letztestd,i;IF speichern +THEN pruefeplausibilitaet;IF fehlerstatus<>nullTHEN infeld(fehlerstatus); +return(1);LEAVE aufsichtszeitenspeichernFI ;speicherungdurchfuehren;FI ;IF +tagnrniltextCOR standardmaskenfeld(aktfnr+ +offsetbeginnuhr)<>niltextCOR standardmaskenfeld(aktfnr+offsetendeuhr)<> +niltext)CAND standardmaskenfeld(aktfnr+offsetstundevor)=niltextCAND +standardmaskenfeld(aktfnr+offsetstundenach)=niltextTHEN standardmeldung( +meldungmindeinestunde,niltext);fehlerstatus:=aktfnr+offsetstundevor;LEAVE +pruefeplausibilitaetFI ;IF tagnr=nummerfürsaTHEN letztestd:=stundenamsamstag +ELSE letztestd:=stundenprowochentagFI ;aktfnrINCR 1;IF standardmaskenfeld( +aktfnr)<>niltextTHEN standardpruefe(2,aktfnr,null,null,niltext,fehlerstatus); +IF fehlerstatus<>0THEN LEAVE pruefeplausibilitaetFI ;standardpruefe(3,aktfnr, +erstestundeamtag,letztestd,niltext,fehlerstatus);IF fehlerstatus<>0THEN +LEAVE pruefeplausibilitaetFI ;FI ;beginn:=int(standardmaskenfeld(aktfnr)); +aktfnrINCR 1;IF standardmaskenfeld(aktfnr)<>niltextTHEN standardpruefe(2, +aktfnr,null,null,niltext,fehlerstatus);IF fehlerstatus<>0THEN LEAVE +pruefeplausibilitaetFI ;standardpruefe(3,aktfnr,erstestundeamtag,letztestd, +niltext,fehlerstatus);IF fehlerstatus<>0THEN LEAVE pruefeplausibilitaetFI ; +FI ;ende:=int(standardmaskenfeld(aktfnr));IF beginn>0AND ende>0AND ende<> +beginn+1THEN standardmeldung(meldungstdnachfolgend,niltext);fehlerstatus:= +aktfnr-1;LEAVE pruefeplausibilitaetFI ;aktfnrINCR 1;beginn:=int( +standardmaskenfeld(aktfnr));IF falschezeitangabe(beginn,aktfnr,fehlerstatus) +THEN LEAVE pruefeplausibilitaetFI ;aktfnrINCR 1;ende:=int(standardmaskenfeld( +aktfnr));IF falschezeitangabe(ende,aktfnr,fehlerstatus)THEN LEAVE +pruefeplausibilitaetFI ;IF beginn>endeAND ende>0THEN standardmeldung( +meldungfalschezeitfolge,niltext);fehlerstatus:=aktfnr-1;LEAVE +pruefeplausibilitaetFI PER .speicherungdurchfuehren:standardmeldung( +meldungspeicherung,niltext);aktfnr:=fnrerstebezeichnung;aznr:=1; +suchenächstenichtleerezeile;WHILE aktfnr<=fnrerstesfeldletztezeileREP infeld( +aktfnr);fülleprimärindexfelder;search(dnraufsichtszeiten,true); +füllerestlichedbfelder;IF dbstatus<>nullTHEN insert(dnraufsichtszeiten)ELSE +update(dnraufsichtszeiten)FI ;speicherfehlerabfangen;aktfnrINCR +felderprozeile;aznrINCR 1;suchenächstenichtleerezeile;PER ;dbstatus(0);WHILE +dbstatus=0CAND aznr<=datensaetzepromaskeREP fülleprimärindexfelder;delete( +dnraufsichtszeiten);aznrINCR 1;PER .suchenächstenichtleerezeile:WHILE aktfnr +<=fnrerstesfeldletztezeileCAND zeileistleerREP aktfnrINCR felderprozeilePER . +zeileistleer:standardmaskenfeld(aktfnr)+standardmaskenfeld(aktfnr+ +offsetbeginnuhr)+standardmaskenfeld(aktfnr+offsetendeuhr)+standardmaskenfeld( +aktfnr+offsetstundevor)+standardmaskenfeld(aktfnr+offsetstundenach)=niltext. +fülleprimärindexfelder:putwert(fnrazsj,schuljahr);putwert(fnrazhj,halbjahr); +putintwert(fnrazaufsichtszeit,tagnr*stelledestages+aznr);. +füllerestlichedbfelder:putwert(fnrazbezeichnung,standardmaskenfeld(aktfnr)); +IF standardmaskenfeld(aktfnr+offsetstundevor)=niltextTHEN putintwert( +fnraztagstdvor,null)ELSE putintwert(fnraztagstdvor,(tagnr-1)* +stundenprowochentag+int(standardmaskenfeld(aktfnr+offsetstundevor)))FI ;IF +standardmaskenfeld(aktfnr+offsetstundenach)=niltextTHEN putintwert( +fnraztagstdnach,null)ELSE putintwert(fnraztagstdnach,(tagnr-1)* +stundenprowochentag+int(standardmaskenfeld(aktfnr+offsetstundenach)))FI ; +putwert(fnrazbeginnuhr,standardmaskenfeld(aktfnr+offsetbeginnuhr));putwert( +fnrazendeuhr,standardmaskenfeld(aktfnr+offsetendeuhr)).speicherfehlerabfangen +:IF dbstatus<>nullTHEN standardmeldung(meldungspeicherfehler,niltext);return( +1);LEAVE aufsichtszeitenspeichernFI .END PROC aufsichtszeitenspeichern;PROC +aufsichtszeitenkopieren:INT VAR i,altetagnr;aktindex:=null;altetagnr:=tagnr; +tagnr:=nummerfürmo;inittupel(dnraufsichtszeiten);statleseschleife( +dnraufsichtszeiten,schuljahr,halbjahr,fnrazsj,fnrazhj,PROC fuellenurmaske); +FOR iFROM aktindex*felderprozeile+fnrerstebezeichnungUPTO fnrletztesfeldREP +standardmaskenfeld(niltext,i)PER ;tagnr:=altetagnr;infeld(fnrerstebezeichnung +);return(1);END PROC aufsichtszeitenkopieren;PROC aufsichtszeitenuebernehmen( +BOOL CONST hauptaktion):TEXT VAR geplhj,geplsj;INT VAR i,j,altetagnr;IF NOT +hauptaktionTHEN prüfeobeingangsmaskerichtigangekreuzt;schuljahr:= +schulkenndatum(textschuljahr);halbjahr:=schulkenndatum(textschulhalbjahr); +tagnr:=nummerfürmo;fuelledenpuffermitdenaufsichtszeiten;IF datenvorhanden +THEN standardmeldung(meldungfrageuebernehmen,niltext);feldschutz( +fnrfueruebernehmen);feldschutz(fnrfuergeplbearb);feldschutz(fnrabtagfuergepl) +;feldschutz(fnrfueraktbearb);feldschutz(fnrabtagfuerakt);feldfrei( +fnrcursorruhepos);infeld(fnrcursorruhepos);standardnproc;ELSE standardmeldung +(meldungdatenfehlen,niltext);infeld(fnrfueruebernehmen);return(1)FI ELSE +standardmeldung(meldunguebernehmen,niltext);geplhj:=halbjahr;geplsj:= +schuljahr;geplanteshjundsjberechnen(geplhj,geplsj);WHILE datenvorhandenREP +löschealletagebiszumvorliegenden;speicheredenvorliegendentag;tagnrINCR 1; +fuelledenpuffermitdenaufsichtszeiten;PER ;löscheallerestlichentage;enter(2) +FI .prüfeobeingangsmaskerichtigangekreuzt:IF standardmaskenfeld( +fnrfueruebernehmen)=niltextOR standardmaskenfeld(fnrfuergeplbearb)<>niltext +OR standardmaskenfeld(fnrfueraktbearb)<>niltextTHEN standardmeldung( +meldungeingabesinnlos,niltext);infeld(fnrfueruebernehmen);return(1);LEAVE +aufsichtszeitenuebernehmenFI ;IF standardmaskenfeld(fnrabtagfuergepl)<> +niltextTHEN standardmeldung(meldungfeldleerlassen,niltext);infeld( +fnrabtagfuergepl);return(1);LEAVE aufsichtszeitenuebernehmenFI ;IF +standardmaskenfeld(fnrabtagfuerakt)<>niltextTHEN standardmeldung( +meldungfeldleerlassen,niltext);infeld(fnrabtagfuerakt);return(1);LEAVE +aufsichtszeitenuebernehmenFI ;.fuelledenpuffermitdenaufsichtszeiten:aktindex +:=null;datenvorhanden:=FALSE ;altetagnr:=tagnr;inittupel(dnraufsichtszeiten); +statleseschleife(dnraufsichtszeiten,schuljahr,halbjahr,fnrazsj,fnrazhj,PROC +fuellenurpuffer);.löschealletagebiszumvorliegenden:FOR iFROM altetagnrUPTO +tagnr-1REP löschedateneinestagesPER .löschedateneinestages:j:=1;dbstatus(0); +WHILE dbstatus=0CAND j<=datensaetzepromaskeREP putwert(fnrazsj,geplsj); +putwert(fnrazhj,geplhj);putintwert(fnrazaufsichtszeit,i*stelledestages+j); +delete(dnraufsichtszeiten);jINCR 1;PER .speicheredenvorliegendentag:i:=1; +WHILE i<=aktindexREP fülleprimärindexfelder;search(dnraufsichtszeiten,true); +füllerestlichedbfelder;IF dbstatus<>nullTHEN insert(dnraufsichtszeiten)ELSE +update(dnraufsichtszeiten)FI ;speicherfehlerabfangen;iINCR 1;PER ;WHILE +dbstatus=0CAND i<=datensaetzepromaskeREP fülleprimärindexfelder;delete( +dnraufsichtszeiten);iINCR 1;PER .fülleprimärindexfelder:putwert(fnrazsj, +geplsj);putwert(fnrazhj,geplhj);putintwert(fnrazaufsichtszeit,tagnr* +stelledestages+i);.füllerestlichedbfelder:restoretupel(dnraufsichtszeiten, +alteaufsichtszeiten(i));putwert(fnrazsj,geplsj);putwert(fnrazhj,geplhj);. +speicherfehlerabfangen:IF dbstatus<>nullTHEN standardmeldung( +meldungspeicherfehler,niltext);infeld(fnrfueruebernehmen);return(2);LEAVE +aufsichtszeitenuebernehmenFI .löscheallerestlichentage:FOR iFROM altetagnr +UPTO nummerfürsaREP löschedateneinestagesPER .END PROC +aufsichtszeitenuebernehmen;PROC holealledatendestages:TEXT VAR tag;INT VAR i; +setzewochentagindiemaske;holegewünschtentagindiemaske. +setzewochentagindiemaske:SELECT tagnrOF CASE nummerfürmo:tag:=kürzelfürmo +CASE nummerfürdi:tag:=kürzelfürdiCASE nummerfürmi:tag:=kürzelfürmiCASE +nummerfürdo:tag:=kürzelfürdoCASE nummerfürfr:tag:=kürzelfürfrCASE nummerfürsa +:tag:=kürzelfürsaEND SELECT ;standardmaskenfeld(tag,fnrwochentag). +holegewünschtentagindiemaske:aktindex:=null;inittupel(dnraufsichtszeiten); +statleseschleife(dnraufsichtszeiten,schuljahr,halbjahr,fnrazsj,fnrazhj,PROC +fuellenurmaske);FOR iFROM aktindex*felderprozeile+fnrerstebezeichnungUPTO +fnrletztesfeldREP standardmaskenfeld(niltext,i)PER ;.END PROC +holealledatendestages;PROC fuellenurmaske(BOOL VAR b):INT VAR feldnr,stunde; +IF wert(fnrazsj)>schuljahrCOR wert(fnrazhj)>halbjahrCOR intwert( +fnrazaufsichtszeit)>tagnr*stelledestages+datensaetzepromaskeCOR dbstatus<>0 +THEN b:=TRUE ELSE IF intwert(fnrazaufsichtszeit)>tagnr*stelledestagesTHEN +aktindexINCR eins;feldnr:=fnrerstebezeichnung+(aktindex-1)*felderprozeile; +standardmaskenfeld(wert(fnrazbezeichnung),feldnr);feldnrINCR 1;stunde:= +intwert(fnraztagstdvor);IF stunde>0THEN stunde:=(stunde-1)MOD +stundenprowochentag+1;standardmaskenfeld(text(stunde),feldnr);ELSE +standardmaskenfeld(niltext,feldnr);FI ;feldnrINCR 1;stunde:=intwert( +fnraztagstdnach);IF stunde>0THEN stunde:=(stunde-1)MOD stundenprowochentag+1; +standardmaskenfeld(text(stunde),feldnr);ELSE standardmaskenfeld(niltext, +feldnr);FI ;feldnrINCR 1;standardmaskenfeld(wert(fnrazbeginnuhr),feldnr); +feldnrINCR 1;standardmaskenfeld(wert(fnrazendeuhr),feldnr);FI FI END PROC +fuellenurmaske;PROC fuellenurpuffer(BOOL VAR b):IF wert(fnrazsj)>schuljahr +COR wert(fnrazhj)>halbjahrCOR (datenvorhandenCAND intwert(fnrazaufsichtszeit) +>tagnr*stelledestages+datensaetzepromaske)COR dbstatus<>0THEN b:=TRUE ELSE +IF intwert(fnrazaufsichtszeit)>tagnr*stelledestagesTHEN IF NOT datenvorhanden +THEN datenvorhanden:=TRUE ;tagnr:=intwert(fnrazaufsichtszeit)DIV +stelledestagesFI ;aktindexINCR eins;savetupel(dnraufsichtszeiten, +alteaufsichtszeiten(aktindex));FI FI END PROC fuellenurpuffer;BOOL PROC +falschezeitangabe(INT CONST zeit,fnr,INT VAR status):IF standardmaskenfeld( +fnr)=niltextTHEN LEAVE falschezeitangabeWITH FALSE FI ;IF length( +standardmaskenfeld(fnr))>4THEN standardmeldung(meldungzeitangabezulang, +niltext);status:=fnr;LEAVE falschezeitangabeWITH TRUE FI ;standardpruefe(2, +fnr,null,null,niltext,status);IF status<>nullTHEN LEAVE falschezeitangabe +WITH TRUE FI ;IF zeit59OR zeitDIV 100>24THEN +standardmeldung(meldungfalschezeitangabe,niltext);status:=fnr;TRUE ELSE +FALSE FI END PROC falschezeitangabe;END PACKET erfaufsichtszeiten; + diff --git a/app/schulis/2.2.1/src/0.erf zeitraster b/app/schulis/2.2.1/src/0.erf zeitraster new file mode 100644 index 0000000..b1b1bd7 --- /dev/null +++ b/app/schulis/2.2.1/src/0.erf zeitraster @@ -0,0 +1,145 @@ +PACKET erfzeitrasterDEFINES zeitrasterveraendern,zeitrasterspeichern, +zeitrasteruebernehmen,zeitrasterkopieren:LET trenner="�",niltext="", +titelanfang="Zeitraster für das ",titelmitte=". Halbjahr ", +trennerfuerschuljahr="/",null=0,eins=1;LET fnrfueruebernehmen=2, +fnrfuergeplbearb=3,fnrfueraktbearb=4,fnrcursorruhepos=5,maske="ms zeitraster" +,fnrerstertagesteil=2,wochentage=6,stundenprowochentag=12,stundenamsamstag=6, +vormittagsstunden=6,nachmittagsstunden=6,zeitfelderprowochentag=24, +felderprowochentag=36,datensaetzepromaske=66,erstesfeldfuersamstag=182;LET +textschuljahr="Schuljahr",textschulhalbjahr="Schulhalbjahr";LET +kennungvormittag="v",kennungnachmittag="n",allekennungen="vnx", +kennungmoerstestd=1;LET meldungeingabesinnlos=56,meldungfalschekennung=55, +meldungfalschezeitangabe=54,meldungzeitangabezulang=341, +meldungfalschezeitfolge=342,meldungplausi=57,meldungdatenfehlen=68, +meldungfrageuebernehmen=300,meldunguebernehmen=301,meldungfeldfuellen=52, +meldungspeicherfehler=73,meldungspeicherung=50;TEXT VAR schuljahr:=niltext, +halbjahr:=niltext;BOOL VAR datenvorhanden,datenlueckenhaft;ROW +datensaetzepromaskeTEXT VAR alteszeitraster;INT VAR aktindex;PROC +zeitrasterveraendern:INT VAR i,j,aktfnr;IF standardmaskenfeld( +fnrfueruebernehmen)=niltextAND (standardmaskenfeld(fnrfuergeplbearb)<>niltext +XOR standardmaskenfeld(fnrfueraktbearb)<>niltext)THEN schuljahr:= +schulkenndatum(textschuljahr);halbjahr:=schulkenndatum(textschulhalbjahr);IF +standardmaskenfeld(fnrfuergeplbearb)<>niltextTHEN geplanteshjundsjberechnen( +halbjahr,schuljahr)FI ;standardstartproc(maske); +standardkopfmaskeaktualisieren(titelanfang+halbjahr+titelmitte+text(schuljahr +,2)+trennerfuerschuljahr+subtext(schuljahr,3));aktindex:=null;inittupel( +dnrzeitraster);statleseschleife(dnrzeitraster,schuljahr,halbjahr,fnrzrsj, +fnrzrhj,PROC fuellemaskeundpuffer);datenvorhanden:=aktindex>null; +datenlueckenhaft:=datenvorhandenCAND aktindexnullTHEN infeld(fehlerstatus);return(1);LEAVE +zeitrasterspeichernELSE speicherungdurchfuehrenFI ;enter(2). +pruefeplausibilitaet:standardmeldung(meldungplausi,niltext);FOR iFROM null +UPTO datensaetzepromaske-einsREP aktfnr:=fnrerstertagesteil+iMOD +stundenprowochentag+(iDIV stundenprowochentag)*felderprowochentag;IF aktfnr>= +erstesfeldfuersamstagTHEN aktfnrbeginn:=aktfnr+stundenamsamstag;aktfnrende:= +aktfnrbeginn+stundenamsamstagELSE aktfnrbeginn:=aktfnr+stundenprowochentag; +aktfnrende:=aktfnrbeginn+stundenprowochentagFI ;IF standardmaskenfeld(aktfnr) +=niltextTHEN standardmeldung(meldungfeldfuellen,niltext);fehlerstatus:=aktfnr +;LEAVE pruefeplausibilitaetFI ;IF pos(allekennungen,standardmaskenfeld(aktfnr +))=nullTHEN standardmeldung(meldungfalschekennung,niltext);fehlerstatus:= +aktfnr;LEAVE pruefeplausibilitaetFI ;beginnzeit:=int(standardmaskenfeld( +aktfnrbeginn));IF falschezeitangabe(beginnzeit,aktfnrbeginn,fehlerstatus) +THEN LEAVE pruefeplausibilitaetFI ;endezeit:=int(standardmaskenfeld( +aktfnrende));IF falschezeitangabe(endezeit,aktfnrende,fehlerstatus)THEN +LEAVE pruefeplausibilitaetFI ;IF beginnzeit>endezeitAND endezeit>0THEN +standardmeldung(meldungfalschezeitfolge,niltext);fehlerstatus:=aktfnrbeginn; +LEAVE pruefeplausibilitaetFI PER .speicherungdurchfuehren:standardmeldung( +meldungspeicherung,niltext);FOR aktindexFROM einsUPTO datensaetzepromaskeREP +berechnemaskenunddbgroessen;IF datenvorhandenTHEN IF stundewurdeveraendert +THEN infeld(aktfnr);putwert(fnrzrsj,schuljahr);putwert(fnrzrhj,halbjahr); +putintwert(fnrzrtagstunde,aktindex);search(dnrzeitraster,true);putwert( +fnrzrkennungteil,standardmaskenfeld(aktfnr));putwert(fnrzrbeginnuhr, +standardmaskenfeld(aktfnrbeginn));putwert(fnrzrendeuhr,standardmaskenfeld( +aktfnrende));IF dbstatus<>nullTHEN insert(dnrzeitraster)ELSE update( +dnrzeitraster)FI ;speicherfehlerabfangenFI ELSE infeld(aktfnr);putwert( +fnrzrsj,schuljahr);putwert(fnrzrhj,halbjahr);putintwert(fnrzrtagstunde, +aktindex);putwert(fnrzrkennungteil,standardmaskenfeld(aktfnr));putwert( +fnrzrbeginnuhr,standardmaskenfeld(aktfnrbeginn));putwert(fnrzrendeuhr, +standardmaskenfeld(aktfnrende));insert(dnrzeitraster)FI PER . +berechnemaskenunddbgroessen:aktfnr:=fnrerstertagesteil+(aktindex-eins)MOD +stundenprowochentag+((aktindex-eins)DIV stundenprowochentag)* +felderprowochentag;IF aktfnr>=erstesfeldfuersamstagTHEN aktfnrbeginn:=aktfnr+ +stundenamsamstag;aktfnrende:=aktfnrbeginn+stundenamsamstagELSE aktfnrbeginn:= +aktfnr+stundenprowochentag;aktfnrende:=aktfnrbeginn+stundenprowochentagFI ;. +stundewurdeveraendert:datenlueckenhaftCOR standardmaskenfeld(aktfnr)+trenner+ +standardmaskenfeld(aktfnrbeginn)+trenner+standardmaskenfeld(aktfnrende)<> +alteszeitraster(aktindex).speicherfehlerabfangen:IF dbstatus<>nullTHEN +standardmeldung(meldungspeicherfehler,niltext);return(1);LEAVE +zeitrasterspeichernFI .END PROC zeitrasterspeichern;PROC zeitrasterkopieren: +TEXT VAR tagesteil,beginn,ende;INT VAR i,j,aktfnr:=fnrerstertagesteil;FOR i +FROM 0UPTO stundenprowochentag-1REP aktfnr:=fnrerstertagesteil+i;tagesteil:= +standardmaskenfeld(aktfnr);aktfnrINCR stundenprowochentag;beginn:= +standardmaskenfeld(aktfnr);aktfnrINCR stundenprowochentag;ende:= +standardmaskenfeld(aktfnr);aktfnrINCR stundenprowochentag;FOR jFROM 1UPTO +wochentage-2REP standardmaskenfeld(tagesteil,aktfnr);aktfnrINCR +stundenprowochentag;standardmaskenfeld(beginn,aktfnr);aktfnrINCR +stundenprowochentag;standardmaskenfeld(ende,aktfnr);aktfnrINCR +stundenprowochentagPER ;IF iniltextAND standardmaskenfeld(fnrfuergeplbearb)=niltextAND +standardmaskenfeld(fnrfueraktbearb)=niltext.fuelledenpuffermitdemzeitraster: +aktindex:=null;inittupel(dnrzeitraster);statleseschleife(dnrzeitraster, +schuljahr,halbjahr,fnrzrsj,fnrzrhj,PROC fuellenurpuffer);datenvorhanden:= +aktindex>null.testeobdatenschonvorhanden:putwert(fnrzrsj,schuljahr);putwert( +fnrzrhj,halbjahr);putintwert(fnrzrtagstunde,kennungmoerstestd);search( +dnrzeitraster,TRUE );ueberschreiben:=dbstatus=null.ladedendatenbankpuffer: +putwert(fnrzrsj,schuljahr);putwert(fnrzrhj,halbjahr);satz:=alteszeitraster(i) +;posi:=pos(satz,trenner);putwert(fnrzrtagstunde,text(satz,posi-eins));IF +ueberschreibenTHEN search(dnrzeitraster,TRUE )FI ;satz:=subtext(satz,posi+ +eins);posi:=pos(satz,trenner);putwert(fnrzrkennungteil,text(satz,posi-eins)); +satz:=subtext(satz,posi+eins);posi:=pos(satz,trenner);putwert(fnrzrbeginnuhr, +text(satz,posi-eins));satz:=subtext(satz,posi+eins);putwert(fnrzrendeuhr,satz +).speicherfehlerabfangen:IF ueberschreibenCAND dbstatus<>nullTHEN +standardmeldung(meldungspeicherfehler,niltext);infeld(fnrfueruebernehmen); +return(1);LEAVE zeitrasteruebernehmenFI .END PROC zeitrasteruebernehmen;PROC +fuellemaskeundpuffer(BOOL VAR b):INT VAR feldnr,feldnr2;IF wert(fnrzrsj)> +schuljahrCOR wert(fnrzrhj)>halbjahrCOR dbstatus<>0THEN b:=TRUE ELSE feldnr:= +fnrerstertagesteil+aktindexMOD stundenprowochentag+(aktindexDIV +stundenprowochentag)*felderprowochentag;aktindexINCR eins;alteszeitraster( +aktindex):=wert(fnrzrkennungteil)+trenner+wert(fnrzrbeginnuhr)+trenner+wert( +fnrzrendeuhr);standardmaskenfeld(wert(fnrzrkennungteil),feldnr);IF feldnr>= +erstesfeldfuersamstagTHEN feldnrINCR stundenamsamstag;feldnr2:=feldnr+ +stundenamsamstagELSE feldnrINCR stundenprowochentag;feldnr2:=feldnr+ +stundenprowochentagFI ;standardmaskenfeld(wert(fnrzrbeginnuhr),feldnr); +standardmaskenfeld(wert(fnrzrendeuhr),feldnr2);FI END PROC +fuellemaskeundpuffer;PROC fuellenurpuffer(BOOL VAR b):IF wert(fnrzrsj)> +schuljahrCOR wert(fnrzrhj)>halbjahrCOR dbstatus<>0THEN b:=TRUE ELSE aktindex +INCR eins;alteszeitraster(aktindex):=wert(fnrzrtagstunde)+trenner+wert( +fnrzrkennungteil)+trenner+wert(fnrzrbeginnuhr)+trenner+wert(fnrzrendeuhr)FI +END PROC fuellenurpuffer;BOOL PROC falschezeitangabe(INT CONST zeit,fnr,INT +VAR status):IF standardmaskenfeld(fnr)=niltextTHEN LEAVE falschezeitangabe +WITH FALSE FI ;IF length(standardmaskenfeld(fnr))>4THEN standardmeldung( +meldungzeitangabezulang,niltext);status:=fnr;LEAVE falschezeitangabeWITH +TRUE FI ;standardpruefe(2,fnr,null,null,niltext,status);IF status<>nullTHEN +LEAVE falschezeitangabeWITH TRUE FI ;IF zeit59OR zeitDIV +100>24THEN standardmeldung(meldungfalschezeitangabe,niltext);status:=fnr; +TRUE ELSE FALSE FI END PROC falschezeitangabe;END PACKET erfzeitraster; + diff --git a/app/schulis/2.2.1/src/0.erf.faecher b/app/schulis/2.2.1/src/0.erf.faecher new file mode 100644 index 0000000..b3cc71b --- /dev/null +++ b/app/schulis/2.2.1/src/0.erf.faecher @@ -0,0 +1,38 @@ +PACKET erffaecherDEFINES erfassungfaecher:LET maskenname="ms erf faecher", +fnrletztesfeld=5,fnrkennung=2,fnrlangtext=3,fnrgruppe=4,fnrbereich=5,trenner= +" = ";LET maxlaengefach=2;LET meldnrfachzulang=60;PROC erfassungfaecher(INT +CONST proznr):systemdboff;reinitparsing;SELECT proznrOF CASE 1: +setzeerfassungsparameterCASE 2:zeigefachzurbearbeitungCASE 3: +pruefeplausibilitaetCASE 4:setzewertefuerdbspeicherungCASE 5: +setzeidentiobjektfuerobjektlisteCASE 6:faecherlesenCASE 7:faecheraendernCASE +8:faechereinfuegenCASE 9:faecherloeschenEND SELECT END PROC erfassungfaecher; +PROC setzeerfassungsparameter:setzeerfassungsparameter(dnrfaecher,maskenname, +fnrletztesfeld)END PROC setzeerfassungsparameter;PROC zeigefachzurbearbeitung +:setzeerfassungsfeld(wert(fnrffach),fnrkennung);setzeerfassungsfeld(wert( +fnrffachbez),fnrlangtext);setzeerfassungsfeld(textnichtnull(wert(fnrffachgrp) +),fnrgruppe);setzeerfassungsfeld(wert(fnrffachbereich),fnrbereich);END PROC +zeigefachzurbearbeitung;PROC pruefeplausibilitaet:LET leer="",null=0;INT VAR +fehlerstatus;pruefe(1,erfassungsmaske,PROC erfassungswert,fnrkennung,null, +null,leer,fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus +);LEAVE pruefeplausibilitaetELIF length(erfassungswert(fnrkennung))> +maxlaengefachTHEN meldeauffaellig(erfassungsmaske,meldnrfachzulang); +setzefehlerstatus(fnrkennung);LEAVE pruefeplausibilitaetFI ;pruefe(1, +erfassungsmaske,PROC erfassungswert,fnrlangtext,null,null,leer,fehlerstatus); +IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);FI ;END PROC +pruefeplausibilitaet;PROC setzewertefuerdbspeicherung:putwert(fnrffach, +compress(erfassungswert(fnrkennung)));putwert(fnrffachbez,erfassungswert( +fnrlangtext));putwert(fnrffachgrp,erfassungswert(fnrgruppe));putwert( +fnrffachbereich,erfassungswert(fnrbereich));END PROC +setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET +trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert(fnrffach)+ +trenner+wert(fnrffachbez);setzeidentiwert(identizeilemitschluesselanhang). +identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+wert(fnrffach) +.END PROC setzeidentiobjektfuerobjektliste;PROC faecherlesen:putwert(fnrffach +,compress(schluessel));search(dnrfaecher,TRUE );IF dbstatus=okTHEN +saveupdateposition(dnrfaecher)FI END PROC faecherlesen;PROC faecheraendern: +restoreupdateposition(dnrfaecher);update(dnrfaecher)END PROC faecheraendern; +PROC faechereinfuegen:insert(dnrfaecher)END PROC faechereinfuegen;PROC +faecherloeschen:delete(dnrfaecher)END PROC faecherloeschen;TEXT PROC +schluessel:erfassungswert(fnrkennung)END PROC schluessel;END PACKET +erffaecher + diff --git a/app/schulis/2.2.1/src/0.erf.schuldaten b/app/schulis/2.2.1/src/0.erf.schuldaten new file mode 100644 index 0000000..d2bedbd --- /dev/null +++ b/app/schulis/2.2.1/src/0.erf.schuldaten @@ -0,0 +1,51 @@ +PACKET erfschuldatenDEFINES erfassungschuldaten:LET maskenname= +"ms erf schuldaten",fnrletztesfeld=9,fnrkennung=2,fnrschulname=3, +fnrstrasseundnummer=4,fnrtelefon=5,fnrplzort=6,fnrschulart=7,fnrschulnr=8, +fnrbundesland=9,trenner=" = ";LET maxlaengekennung=7,meldkennungzulang=60; +LET bestandschulart="c02 schulart";PROC erfassungschuldaten(INT CONST proznr) +:systemdboff;reinitparsing;SELECT proznrOF CASE 1:setzeerfassungsparameter +CASE 2:zeigeschluesselzurbearbeitungCASE 3:pruefeplausibilitaetCASE 4: +setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6: +schuldatenlesenCASE 7:schuldatenaendernCASE 8:schuldateneinfuegenCASE 9: +schuldatenloeschenEND SELECT END PROC erfassungschuldaten;PROC +setzeerfassungsparameter:setzeerfassungsparameter(dnrschulen,maskenname, +fnrletztesfeld)END PROC setzeerfassungsparameter;PROC +zeigeschluesselzurbearbeitung:setzeerfassungsfeld(wert(fnrschkennung), +fnrkennung);setzeerfassungsfeld(wert(fnrschname),fnrschulname); +setzeerfassungsfeld(wert(fnrschstrnr),fnrstrasseundnummer); +setzeerfassungsfeld(wert(fnrschtelnr),fnrtelefon);setzeerfassungsfeld(wert( +fnrschplzort),fnrplzort);setzeerfassungsfeld(wert(fnrschart),fnrschulart); +setzeerfassungsfeld(wert(fnrschamtlnr),fnrschulnr);setzeerfassungsfeld(wert( +fnrschbundesland),fnrbundesland);END PROC zeigeschluesselzurbearbeitung;PROC +pruefeplausibilitaet:LET leer="",null=0;INT VAR fehlerstatus;pruefe(1, +erfassungsmaske,PROC erfassungswert,fnrkennung,null,null,leer,fehlerstatus); +ueberpruefefehlerstatus;IF length(erfassungswert(fnrkennung))> +maxlaengekennungTHEN meldeauffaellig(erfassungsmaske,meldkennungzulang); +setzefehlerstatus(fnrkennung);LEAVE pruefeplausibilitaetFI ;pruefe(1, +erfassungsmaske,PROC erfassungswert,fnrschulname,null,null,leer,fehlerstatus) +;ueberpruefefehlerstatus;pruefe(1,erfassungsmaske,PROC erfassungswert, +fnrschulart,null,null,leer,fehlerstatus);ueberpruefefehlerstatus;pruefe(4, +erfassungsmaske,PROC erfassungswert,fnrschulart,null,null,bestandschulart, +fehlerstatus);ueberpruefefehlerstatus;.ueberpruefefehlerstatus:IF +fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);LEAVE +pruefeplausibilitaetFI ;.END PROC pruefeplausibilitaet;PROC +setzewertefuerdbspeicherung:putwert(fnrschkennung,erfassungswert(fnrkennung)) +;putwert(fnrschname,erfassungswert(fnrschulname));putwert(fnrschstrnr, +erfassungswert(fnrstrasseundnummer));putwert(fnrschtelnr,erfassungswert( +fnrtelefon));putwert(fnrschplzort,erfassungswert(fnrplzort));putwert( +fnrschart,erfassungswert(fnrschulart));putwert(fnrschamtlnr,erfassungswert( +fnrschulnr));putwert(fnrschbundesland,erfassungswert(fnrbundesland));END +PROC setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET +trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert(dnrschulen+1)+ +trenner+wert(dnrschulen+2);identizeile:=subtext(identizeile,1, +maxidentizeilenlaenge);setzeidentiwert(identizeilemitschluesselanhang). +identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+wert( +dnrschulen+1).END PROC setzeidentiobjektfuerobjektliste;PROC schuldatenlesen: +putwert(fnrschkennung,schluessel);search(dnrschulen,TRUE );IF dbstatus=ok +THEN saveupdateposition(dnrschulen);FI END PROC schuldatenlesen;PROC +schuldatenaendern:restoreupdateposition(dnrschulen);update(dnrschulen);END +PROC schuldatenaendern;PROC schuldateneinfuegen:insert(dnrschulen)END PROC +schuldateneinfuegen;PROC schuldatenloeschen:delete(dnrschulen)END PROC +schuldatenloeschen;TEXT PROC schluessel:erfassungswert(fnrkennung)END PROC +schluessel;END PACKET erfschuldaten; + diff --git a/app/schulis/2.2.1/src/0.grundfunktionen local b/app/schulis/2.2.1/src/0.grundfunktionen local new file mode 100644 index 0000000..d7b0fc8 --- /dev/null +++ b/app/schulis/2.2.1/src/0.grundfunktionen local @@ -0,0 +1,132 @@ +PACKET ispgrundfunktionenlocalDEFINES lieferehalbjahreszeile, +lieferehjdgrenzen,schulisdbname,baisydbname,putwert,wert,init, +halbjahresdatenloeschen,schluesselfuerhjdsetzen, +neueklasseinhalbjahresdateneintragen,schulkenndatum,datumskonversion, +datumrekonversion,melde,jgstaufber:LET punkt=".",anzkenndat=3;LET null=0, +niltext="",blank=" ";LET dnrhalbjahresdaten=88,fnrhjdjgst=94,fnrhjdkennung=95 +,dnrschluessel=137,fnrschlsachgebiet=138,fnrschlschluessel=139, +fnrschllangtext=140,ixhjdfamrufgebjgsthj=263;INT VAR jgstgrenze;TEXT VAR +halbjahrgrenze;LET maxhalbjahre=18,anzahlhalbjahrevoraktuell=5, +gesamtanzahlhalbjahre=12,laengehalbjahreseintrag=4;TEXT CONST zeilehalbjahre +:="05.105.206.106.207.107.208.108.209.109.2"+ +"10.110.211.111.212.112.213.113.2";INT CONST gesamtzeilenlaenge:= +gesamtanzahlhalbjahre*laengehalbjahreseintrag;INT VAR ihalbjahr;ROW +maxhalbjahreSTRUCT (INT vorher,nachher)VAR anzahlhjd; +initialisierehalbjahresdatentabelle;PROC lieferehalbjahreszeile(TEXT VAR +zeile,TEXT CONST hjdkennung):INT VAR subtextbeginn:=pos(zeilehalbjahre, +hjdkennung);INT VAR subtextende;ihalbjahr:=(subtextbeginnDIV +laengehalbjahreseintrag)+1;TEXT VAR blanksvorher:=((anzahlhalbjahrevoraktuell +-anzahlhjd(ihalbjahr).vorher)*laengehalbjahreseintrag)*blank;subtextbeginn:=( +ihalbjahr-anzahlhjd(ihalbjahr).vorher-1)*laengehalbjahreseintrag+1; +subtextende:=(ihalbjahr+anzahlhjd(ihalbjahr).nachher)*laengehalbjahreseintrag +;TEXT VAR interessanterteilderzeilehalbjahre:=subtext(zeilehalbjahre, +subtextbeginn,subtextende);zeile:=text(blanksvorher+ +interessanterteilderzeilehalbjahre,gesamtzeilenlaenge).END PROC +lieferehalbjahreszeile;PROC initialisierehalbjahresdatentabelle:anzahlhjd(1). +vorher:=0;anzahlhjd(1).nachher:=1;anzahlhjd(2).vorher:=1;anzahlhjd(2).nachher +:=1;anzahlhjd(3).vorher:=1;anzahlhjd(3).nachher:=1;anzahlhjd(4).vorher:=2; +anzahlhjd(4).nachher:=1;anzahlhjd(5).vorher:=1;anzahlhjd(5).nachher:=1; +anzahlhjd(6).vorher:=2;anzahlhjd(6).nachher:=1;anzahlhjd(7).vorher:=1; +anzahlhjd(7).nachher:=1;anzahlhjd(8).vorher:=2;anzahlhjd(8).nachher:=1; +anzahlhjd(9).vorher:=1;anzahlhjd(9).nachher:=1;anzahlhjd(10).vorher:=2; +anzahlhjd(10).nachher:=1;anzahlhjd(11).vorher:=1;anzahlhjd(11).nachher:=1; +anzahlhjd(12).vorher:=2;anzahlhjd(12).nachher:=6;anzahlhjd(13).vorher:=1; +anzahlhjd(13).nachher:=5;anzahlhjd(14).vorher:=2;anzahlhjd(14).nachher:=4; +anzahlhjd(15).vorher:=2;anzahlhjd(15).nachher:=3;anzahlhjd(16).vorher:=3; +anzahlhjd(16).nachher:=2;anzahlhjd(17).vorher:=4;anzahlhjd(17).nachher:=1; +anzahlhjd(18).vorher:=5;anzahlhjd(18).nachher:=0.END PROC +initialisierehalbjahresdatentabelle;PROC lieferehjdgrenzen(INT VAR anfang, +ende,TEXT CONST hjdkennung):ihalbjahr:=(poshjdkennungDIV +laengehalbjahreseintrag)+1;anfang:=-anzahlhjd(ihalbjahr).vorher;ende:= +anzahlhjd(ihalbjahr).nachher.poshjdkennung:pos(zeilehalbjahre,hjdkennung). +END PROC lieferehjdgrenzen;TEXT PROC schulisdbname:"EUMELbase.schulis"END +PROC schulisdbname;TEXT PROC baisydbname:"EUMELbase.baisy"END PROC +baisydbname;TEXT PROC wert(INT CONST fnr,posi,laenge):TEXT VAR teiltext:= +subtext(wert(fnr),posi,posi+laenge-1);INT VAR anfang:=pos(teiltext," ");IF +teiltext=laenge*" "THEN teiltext:=""ELSE WHILE anfang>0REP IF subtext( +teiltext,anfang,laenge)=(laenge-anfang+1)*" "THEN teiltext:=text(teiltext, +anfang-1);anfang:=0ELSE anfang:=pos(teiltext," ",anfang+1)FI PER FI ;teiltext +END PROC wert;PROC putwert(INT CONST fnr,TEXT CONST t,INT CONST posi,laenge): +INT VAR i:=length(wert(fnr));TEXT VAR string:=wert(fnr);IF i +niltextTHEN stringCAT ((posi-i-1)*" ");stringCAT (text(t,laenge))FI ELSE +replace(string,posi,text(t,laenge))FI ;putwert(fnr,string)END PROC putwert; +PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR iFROM 1UPTO 100REP feld(i):="" +PER .END PROC init;TEXT PROC datumskonversion(TEXT CONST datum):TEXT VAR d:= +datum;IF nurblanksoderleer(datum)OR d=" . . "THEN "01.01.00"ELSE changeall +(d," ","0");IF nochnichtkonvertiertTHEN insertchar(d,".",3);insertchar(d,".", +6);FI ;dFI .nochnichtkonvertiert:pos(d,".")=0.ENDPROC datumskonversion;BOOL +PROC nurblanksoderleer(TEXT CONST t):INT VAR i;FOR iFROM 1UPTO length(t)REP +IF (tSUB i)<>" "THEN LEAVE nurblanksoderleerWITH FALSE FI PER ;TRUE ENDPROC +nurblanksoderleer;TEXT PROC datumrekonversion(TEXT CONST datum):TEXT VAR d:= +datum;changeall(d,".","");IF d="010100"THEN d:=""FI ;dENDPROC +datumrekonversion;PROC melde(TEXT CONST txt):melde(txt,24)END PROC melde; +PROC melde(TEXT CONST txt,INT CONST zeile):LET maxlaenge=72,spalte=4;INT VAR +txtlaenge,pos;TEXT VAR ausgabetxt:="";txtlaenge:=min(length(txt),maxlaenge); +pos:=(maxlaenge-txtlaenge)DIV 2;ausgabetxtCAT (pos*" ");ausgabetxtCAT txt; +cursor(spalte,zeile);out(text(ausgabetxt,maxlaenge))END PROC melde;TEXT PROC +jgstaufber(TEXT CONST jgst):LET erstestellejgst="0",maxsek1=10;INT VAR ijgst +:=int(jgst);IF ijgst>=maxsek1THEN jgstELIF ijgst=0THEN ""ELSE erstestellejgst ++text(ijgst)FI END PROC jgstaufber;PROC halbjahresdatenloeschen(ROW +anzkenndatTEXT CONST kenndatum,TEXT CONST altejgst,neuejgst,neueshalbjahr): +BOOL CONST jgsthochgesetzt:=neuejgst>altejgst;INT VAR loeschevorher, +loeschenachher,jgstpos,maxhjdvorherneu,maxhjdnachherneu;TEXT VAR +jgstcathalbjahr:=neuejgst+punkt+neueshalbjahr,grenzehalbjahr:="";IF neuejgst +<>altejgstTHEN loeschenderhalbjahresdatenvorbereiten; +loeschenderhalbjahresdatenFI .loeschenderhalbjahresdatenvorbereiten: +lieferehjdgrenzen(maxhjdvorherneu,maxhjdnachherneu,jgstcathalbjahr);jgstpos:= +pos(zeilehalbjahre,jgstcathalbjahr);IF jgsthochgesetztTHEN loeschevorher:=(( +abs(maxhjdvorherneu))*4);grenzehalbjahr:=subtext(zeilehalbjahre,jgstpos- +loeschevorher,jgstpos-loeschevorher+3);ELSE loeschenachher:=(maxhjdnachherneu +*4);grenzehalbjahr:=subtext(zeilehalbjahre,jgstpos+loeschenachher,jgstpos+ +loeschenachher+3);FI ;jgstgrenze:=int(subtext(grenzehalbjahr,1,2)); +halbjahrgrenze:=subtext(grenzehalbjahr,4);.loeschenderhalbjahresdaten:IF +jgsthochgesetztTHEN halbjahresdatenloeschen(PROC (INT CONST )pred,kenndatum, +halbjahrgrenze,jgstgrenze,jgsthochgesetzt);ELSE halbjahresdatenloeschen(PROC +(INT CONST )succ,kenndatum,halbjahrgrenze,jgstgrenze,jgsthochgesetzt);FI . +END PROC halbjahresdatenloeschen;PROC halbjahresdatenloeschen(PROC (INT +CONST )step,ROW anzkenndatTEXT CONST kenndatum,TEXT CONST hjgrenze,INT CONST +jgstgrenze,BOOL CONST vorher):hjddatenloeschen(PROC step,kenndatum, +dnrhalbjahresdaten,ixhjdfamrufgebjgsthj,hjgrenze,jgstgrenze,vorher);.END +PROC halbjahresdatenloeschen;PROC hjddatenloeschen(PROC (INT CONST )step,ROW +anzkenndatTEXT CONST kenndatum,INT CONST dateinummer,index,TEXT CONST +hjgrenze,INT CONST jgstgrenze,BOOL CONST vorher):TEXT VAR hj,jg; +parsenooffields(8);schluesselfuerhjdsetzen(dateinummer,kenndatum,hjgrenze, +jgstgrenze);hj:=wert(dateinummer+5);#vorläufig#jg:=wert(dateinummer+6);# +vorläufig#search(index,FALSE );IF dbstatus=0CAND richtigersatz#CAND +eigentlichunnötig#THEN #beisucheTRUE #hj:=wert(dateinummer+5);jg:=wert( +dateinummer+6);step(index);IF NOT vorherCAND dbstatus=okCAND wiederholerTHEN +step(index);FI ;loeschschleife;ELIF dbstatus=okCAND gleicherschuelerTHEN IF +vorherTHEN step(index);FI ;loeschschleifeFI ;#vorläufig#reinitparsing. +wiederholer:gleicherschuelerCAND hj=wert(dateinummer+5)CAND jg=wert( +dateinummer+6).gleicherschueler:kenndatum(1)=wert(dateinummer+1)CAND +kenndatum(2)=wert(dateinummer+2)CAND kenndatum(3)=datumrekonversion(wert( +dateinummer+3)).richtigersatz:#hoffentlichüberflüssig#gleicherschuelerCAND +wert(dateinummer+5)=hjCAND wert(dateinummer+6)=jg.loeschschleife:WHILE +dbstatus=okCAND gleicherschuelerREP delete(dateinummer);step(index);PER .END +PROC hjddatenloeschen;PROC schluesselfuerhjdsetzen(INT CONST dateinummer,ROW +anzkenndatTEXT CONST kenndatum,TEXT CONST halbjahrgrenze,INT CONST jgstgrenze +):TEXT VAR jgsttext:=text(jgstgrenze);inittupel(dateinummer);putwert( +dateinummer+1,kenndatum(1));putwert(dateinummer+2,kenndatum(2));putwert( +dateinummer+3,datumskonversion(kenndatum(3)));putwert(dateinummer+5, +halbjahrgrenze);putwert(dateinummer+6,jgstaufber(jgsttext)).END PROC +schluesselfuerhjdsetzen;PROC schluesselfuerhjdsetzen(INT CONST dateinummer, +ROW anzkenndatTEXT CONST kenndatum,TEXT CONST sj,hj,jgst):inittupel( +dateinummer);putwert(dateinummer+1,kenndatum(1));putwert(dateinummer+2, +kenndatum(2));putwert(dateinummer+3,datumskonversion(kenndatum(3)));putwert( +dateinummer+4,sj);putwert(dateinummer+5,hj);putwert(dateinummer+6,jgstaufber( +jgst)).END PROC schluesselfuerhjdsetzen;PROC +neueklasseinhalbjahresdateneintragen(ROW anzkenndatTEXT CONST kenndatum,TEXT +CONST sj,hj,jgst,neueklasse):halbjahresdatensuchen;IF datenvorhandenTHEN IF +schuelergruppegeaendertTHEN halbjahresdatenaendernFI ;FI . +halbjahresdatensuchen:schluesselfuerhjdsetzen(dnrhalbjahresdaten,kenndatum,sj +,hj,niltext);search(dnrhalbjahresdaten,TRUE );.datenvorhanden:dbstatus=null. +schuelergruppegeaendert:wert(fnrhjdjgst)<>jgstOR wert(fnrhjdkennung)<> +neueklasse.halbjahresdatenaendern:putwert(fnrhjdjgst,jgst);putwert( +fnrhjdkennung,neueklasse);update(dnrhalbjahresdaten);.END PROC +neueklasseinhalbjahresdateneintragen;TEXT PROC schulkenndatum(TEXT CONST +schluessel):LET schulkenndaten="c02 schulkenndaten";TEXT VAR schuldaten:=""; +systemdboff;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,schulkenndaten +);putwert(fnrschlschluessel,schluessel);search(dnrschluessel,TRUE );IF +dbstatus=okTHEN schuldaten:=wert(fnrschllangtext)ELSE schuldaten:=""FI ; +schuldatenENDPROC schulkenndatum;END PACKET ispgrundfunktionenlocal + diff --git a/app/schulis/2.2.1/src/0.hjd grundfunktionen b/app/schulis/2.2.1/src/0.hjd grundfunktionen new file mode 100644 index 0000000..f553908 --- /dev/null +++ b/app/schulis/2.2.1/src/0.hjd grundfunktionen @@ -0,0 +1,110 @@ +PACKET isphjdgrundfunktionenDEFINES lieferehalbjahreszeile,lieferehjdgrenzen, +put,putwert,wert,init,halbjahresdatenloeschen,schluesselfuerhjdsetzen, +neueklasseinhalbjahresdateneintragen,:LET maxanzfelder=100;LET punkt=".", +anzkenndat=3;LET null=0,niltext="",blank=" ";INT VAR jgstgrenze;TEXT VAR +halbjahrgrenze;LET maxhalbjahre=18,anzahlhalbjahrevoraktuell=5, +gesamtanzahlhalbjahre=12,laengehalbjahreseintrag=4;TEXT CONST zeilehalbjahre +:="05.105.206.106.207.107.208.108.209.109.2"+ +"10.110.211.111.212.112.213.113.2";INT CONST gesamtzeilenlaenge:= +gesamtanzahlhalbjahre*laengehalbjahreseintrag;INT VAR ihalbjahr;ROW +maxhalbjahreSTRUCT (INT vorher,nachher)VAR anzahlhjd; +initialisierehalbjahresdatentabelle;PROC lieferehalbjahreszeile(TEXT VAR +zeile,TEXT CONST hjdkennung):INT VAR subtextbeginn:=pos(zeilehalbjahre, +hjdkennung);INT VAR subtextende;ihalbjahr:=(subtextbeginnDIV +laengehalbjahreseintrag)+1;TEXT VAR blanksvorher:=((anzahlhalbjahrevoraktuell +-anzahlhjd(ihalbjahr).vorher)*laengehalbjahreseintrag)*blank;subtextbeginn:=( +ihalbjahr-anzahlhjd(ihalbjahr).vorher-1)*laengehalbjahreseintrag+1; +subtextende:=(ihalbjahr+anzahlhjd(ihalbjahr).nachher)*laengehalbjahreseintrag +;TEXT VAR interessanterteilderzeilehalbjahre:=subtext(zeilehalbjahre, +subtextbeginn,subtextende);zeile:=text(blanksvorher+ +interessanterteilderzeilehalbjahre,gesamtzeilenlaenge).END PROC +lieferehalbjahreszeile;PROC initialisierehalbjahresdatentabelle:anzahlhjd(1). +vorher:=0;anzahlhjd(1).nachher:=1;anzahlhjd(2).vorher:=1;anzahlhjd(2).nachher +:=1;anzahlhjd(3).vorher:=1;anzahlhjd(3).nachher:=1;anzahlhjd(4).vorher:=2; +anzahlhjd(4).nachher:=1;anzahlhjd(5).vorher:=1;anzahlhjd(5).nachher:=1; +anzahlhjd(6).vorher:=2;anzahlhjd(6).nachher:=1;anzahlhjd(7).vorher:=1; +anzahlhjd(7).nachher:=1;anzahlhjd(8).vorher:=2;anzahlhjd(8).nachher:=1; +anzahlhjd(9).vorher:=1;anzahlhjd(9).nachher:=1;anzahlhjd(10).vorher:=2; +anzahlhjd(10).nachher:=1;anzahlhjd(11).vorher:=1;anzahlhjd(11).nachher:=1; +anzahlhjd(12).vorher:=2;anzahlhjd(12).nachher:=6;anzahlhjd(13).vorher:=1; +anzahlhjd(13).nachher:=5;anzahlhjd(14).vorher:=2;anzahlhjd(14).nachher:=4; +anzahlhjd(15).vorher:=2;anzahlhjd(15).nachher:=3;anzahlhjd(16).vorher:=3; +anzahlhjd(16).nachher:=2;anzahlhjd(17).vorher:=4;anzahlhjd(17).nachher:=1; +anzahlhjd(18).vorher:=5;anzahlhjd(18).nachher:=0.END PROC +initialisierehalbjahresdatentabelle;PROC lieferehjdgrenzen(INT VAR anfang, +ende,TEXT CONST hjdkennung):ihalbjahr:=(poshjdkennungDIV +laengehalbjahreseintrag)+1;anfang:=-anzahlhjd(ihalbjahr).vorher;ende:= +anzahlhjd(ihalbjahr).nachher.poshjdkennung:pos(zeilehalbjahre,hjdkennung). +END PROC lieferehjdgrenzen;TEXT PROC wert(INT CONST fnr,posi,laenge):TEXT +VAR teiltext:=subtext(wert(fnr),posi,posi+laenge-1);INT VAR anfang:=pos( +teiltext," ");IF teiltext=laenge*" "THEN teiltext:=""ELSE WHILE anfang>0REP +IF subtext(teiltext,anfang,laenge)=(laenge-anfang+1)*" "THEN teiltext:=text( +teiltext,anfang-1);anfang:=0ELSE anfang:=pos(teiltext," ",anfang+1)FI PER FI +;teiltextEND PROC wert;PROC putwert(INT CONST fnr,TEXT CONST t,INT CONST posi +,laenge):INT VAR i:=length(wert(fnr));TEXT VAR string:=wert(fnr);IF iniltextTHEN stringCAT ((posi-i-1)*" ");stringCAT (text(t,laenge)) +FI ELSE replace(string,posi,text(t,laenge))FI ;putwert(fnr,string)END PROC +putwert;PROC put(TAG CONST t,ROW maxanzfelderTEXT VAR pfeld,INT CONST von,bis +):INT VAR i;FOR iFROM vonUPTO bisREP IF fieldexists(t,i)THEN put(t,pfeld(i),i +)FI ;PER ;END PROC put;PROC put(TAG CONST t,ROW maxanzfelderTEXT VAR pfeld, +INT CONST pos):INT VAR i;FOR iFROM posUPTO maxanzfelderREP IF fieldexists(t,i +)THEN put(t,pfeld(i),i)FI ;PER ;END PROC put;PROC init(ROW maxanzfelderTEXT +VAR feld):INT VAR i;FOR iFROM 1UPTO maxanzfelderREP feld(i):=""PER .END PROC +init;PROC halbjahresdatenloeschen(ROW anzkenndatTEXT CONST kenndatum,TEXT +CONST altejgst,neuejgst,neueshalbjahr):BOOL CONST jgsthochgesetzt:=neuejgst> +altejgst;INT VAR loeschevorher,loeschenachher,jgstpos,maxhjdvorherneu, +maxhjdnachherneu;TEXT VAR jgstcathalbjahr:=neuejgst+punkt+neueshalbjahr, +grenzehalbjahr:="";IF neuejgst<>altejgstTHEN +loeschenderhalbjahresdatenvorbereiten;loeschenderhalbjahresdatenFI . +loeschenderhalbjahresdatenvorbereiten:lieferehjdgrenzen(maxhjdvorherneu, +maxhjdnachherneu,jgstcathalbjahr);jgstpos:=pos(zeilehalbjahre,jgstcathalbjahr +);IF jgsthochgesetztTHEN loeschevorher:=((abs(maxhjdvorherneu))*4); +grenzehalbjahr:=subtext(zeilehalbjahre,jgstpos-loeschevorher,jgstpos- +loeschevorher+3);ELSE loeschenachher:=(maxhjdnachherneu*4);grenzehalbjahr:= +subtext(zeilehalbjahre,jgstpos+loeschenachher,jgstpos+loeschenachher+3);FI ; +jgstgrenze:=int(subtext(grenzehalbjahr,1,2));halbjahrgrenze:=subtext( +grenzehalbjahr,4);.loeschenderhalbjahresdaten:IF jgsthochgesetztTHEN +halbjahresdatenloeschen(PROC (INT CONST )pred,kenndatum,halbjahrgrenze, +jgstgrenze,jgsthochgesetzt);ELSE halbjahresdatenloeschen(PROC (INT CONST ) +succ,kenndatum,halbjahrgrenze,jgstgrenze,jgsthochgesetzt);FI .END PROC +halbjahresdatenloeschen;PROC halbjahresdatenloeschen(PROC (INT CONST )step, +ROW anzkenndatTEXT CONST kenndatum,TEXT CONST hjgrenze,INT CONST jgstgrenze, +BOOL CONST vorher):hjddatenloeschen(PROC step,kenndatum,dnrhalbjahresdaten, +ixhjdfamrufgebjgsthj,hjgrenze,jgstgrenze,vorher);.END PROC +halbjahresdatenloeschen;PROC hjddatenloeschen(PROC (INT CONST )step,ROW +anzkenndatTEXT CONST kenndatum,INT CONST dateinummer,index,TEXT CONST +hjgrenze,INT CONST jgstgrenze,BOOL CONST vorher):TEXT VAR hj,jg; +schluesselfuerhjdsetzen(dateinummer,kenndatum,hjgrenze,jgstgrenze);hj:=wert( +dateinummer+5);#vorläufig#jg:=wert(dateinummer+6);#vorläufig#search(index, +FALSE );IF dbstatus=0CAND richtigersatz#CAND eigentlichunnötig#THEN #beisuche +TRUE #hj:=wert(dateinummer+5);jg:=wert(dateinummer+6);step(index);IF NOT +vorherCAND dbstatus=okCAND wiederholerTHEN step(index);FI ;loeschschleife; +ELIF dbstatus=okCAND gleicherschuelerTHEN IF vorherTHEN step(index);FI ; +loeschschleifeFI #vorläufig#.wiederholer:gleicherschuelerCAND hj=wert( +dateinummer+5)CAND jg=wert(dateinummer+6).gleicherschueler:kenndatum(1)=wert( +dateinummer+1)CAND kenndatum(2)=wert(dateinummer+2)CAND kenndatum(3)= +datumrekonversion(wert(dateinummer+3)).richtigersatz:#hoffentlichüberflüssig# +gleicherschuelerCAND wert(dateinummer+5)=hjCAND wert(dateinummer+6)=jg. +loeschschleife:WHILE dbstatus=okCAND gleicherschuelerREP delete(dateinummer); +step(index);PER .END PROC hjddatenloeschen;PROC schluesselfuerhjdsetzen(INT +CONST dateinummer,ROW anzkenndatTEXT CONST kenndatum,TEXT CONST +halbjahrgrenze,INT CONST jgstgrenze):TEXT VAR jgsttext:=text(jgstgrenze); +inittupel(dateinummer);putwert(dateinummer+1,kenndatum(1));putwert( +dateinummer+2,kenndatum(2));putwert(dateinummer+3,datumskonversion(kenndatum( +3)));putwert(dateinummer+5,halbjahrgrenze);putwert(dateinummer+6,jgstaufber( +jgsttext)).END PROC schluesselfuerhjdsetzen;PROC schluesselfuerhjdsetzen(INT +CONST dateinummer,ROW anzkenndatTEXT CONST kenndatum,TEXT CONST sj,hj,jgst): +inittupel(dateinummer);putwert(dateinummer+1,kenndatum(1));putwert( +dateinummer+2,kenndatum(2));putwert(dateinummer+3,datumskonversion(kenndatum( +3)));putwert(dateinummer+4,sj);putwert(dateinummer+5,hj);putwert(dateinummer+ +6,jgstaufber(jgst)).END PROC schluesselfuerhjdsetzen;PROC +neueklasseinhalbjahresdateneintragen(ROW anzkenndatTEXT CONST kenndatum,TEXT +CONST sj,hj,jgst,neueklasse):halbjahresdatensuchen;IF datenvorhandenTHEN IF +schuelergruppegeaendertTHEN halbjahresdatenaendernFI ;FI . +halbjahresdatensuchen:schluesselfuerhjdsetzen(dnrhalbjahresdaten,kenndatum,sj +,hj,niltext);search(dnrhalbjahresdaten,TRUE );.datenvorhanden:dbstatus=null. +schuelergruppegeaendert:wert(fnrhjdjgst)<>jgstOR wert(fnrhjdkennung)<> +neueklasse.halbjahresdatenaendern:putwert(fnrhjdjgst,jgst);putwert( +fnrhjdkennung,neueklasse);selupdate(dnrhalbjahresdaten);.END PROC +neueklasseinhalbjahresdateneintragen;END PACKET isphjdgrundfunktionen; + diff --git a/app/schulis/2.2.1/src/0.hoeherstufen local.prog b/app/schulis/2.2.1/src/0.hoeherstufen local.prog new file mode 100644 index 0000000..73f5b20 --- /dev/null +++ b/app/schulis/2.2.1/src/0.hoeherstufen local.prog @@ -0,0 +1,312 @@ +PACKET hoeherstufenlocalprogDEFINES schuljahreswechsel,halbjahreswechsel:LET +dnrschueler=2,fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums=5,fnrsustatuss=6 +,fnrsusgrpjgst=7,fnrsusgrpzugtut=8,fnrsutidakthjd=9,fnrsuartzugang=10, +fnrsuneuerzugtut=11,fnrsujgsteintr=13,#fnrsuskennlschule=14,dr13.05.88# +fnrsuabgdats=16,fnrsuabschluss=18,fnrsueintrittinsek=44,dnrhalbjahresdaten=88 +,fnrhjdfamnames=89,fnrhjdrufnames=90,fnrhjdgebdats=91,fnrhjdsj=92,fnrhjdhj=93 +,fnrhjdjgst=94,fnrhjdkennung=95,fnrhjdversetzung=96,#dnrschulen=120,dr13. +05.88##fnrschkennung=121,dr13.05.88#dnraktschuelergruppen=129,fnrsgrpsj=130, +fnrsgrphj=131,fnrsgrpjgst=132,fnrsgrpkennung=133,ixsustatfamrufgeb=243, +ixsustatjgstzug=244,ixsustatjgst=250;LET hellan="",hellaus=" ",meldz=23; +LET neuanmeld5="n05",neuanmeld11="n11",neuanmeldsonst="nso";LET jgst13="13", +jgst11="11";LET posvers=1,posnachpr=2,posspringer=3,posfreiwillig=4, +posnichtvers=5,poshoeherstufen=2,kennzeichenneuan="z",kennzeichenabitur="K", +gueltigekennzeichen="vnsfw",dreizehnnachpr="N";LET null=0,niltext="", +trennername=", ",sgtrenner="/",blank=" ",maxjahr=100,minjahr="00",klammerauf= +" (",klammerzu=")",leerdatum="01.01.00";LET halbjahr1="1",halbjahr2="2", +zumschuljahresende=1,zumhalbjahresende=0;LET schluesselschuljahr="Schuljahr", +schluesselhalbjahr="Schulhalbjahr",schluesselendeschulhalbjahr= +"Ende Schulhalbjahr";LET bestandabgegangene="abg",aktbestand="ls";LET +anzkenndaten=3;LET protname="Fehlerprotokoll";LET schulname="Schulname", +schulort="Schulort",zeilenlaenge=77,datumslaenge=8,ordnungstrenner=". ", +absatztrenner=" - ",protueberschrift= +"Fehlerprotokoll zum automatischen Hochsetzen";LET weiterefehler= +"Abbruch des Programmes, da zu viele Fehler",maxfehler=50;LET +fehlerkeinverserg=1,fehlerkeinneuertutor=2,fehlerungueltigesverserg=3, +fehlerungueltigesg=4,fehlerungueltigehjd=5,fehlerstatus=6,fehlerplanung=7; +LET maxfehlerart=7;LET fehleraendern="Ändern: ",fehlerloeschen="Löschen: "; +LET rcodeprot=1001,rcodenoprot=1002;BOOL VAR updatenoetig:=FALSE ;DATASPACE +VAR ds:=nilspace;FILE VAR fehlerprot;INT VAR fehlerzahl,kanal;TEXT VAR +stichtag:="";TEXT VAR letztername,letzterrufname,letztesgebdatum, +letzterstatus;ROW anzkenndatenTEXT VAR key;ROW maxfehlerartTEXT CONST +fehlertext:=ROW maxfehlerartTEXT :("Es liegt kein Versetzungsergebnis vor", +"Es wurde kein neuer Zug/Tutor eingetragen", +"Das eingetragene Versetzungsergebnis ist nicht zulässig", +"Die eingetragene Schülergruppe ist nicht vorgesehen", +"Zu diesem Schüler liegen keine oder unvollständige Halbjahresdaten vor", +"Fehler beim Datenbankzugriff","Keine Schülergruppen im Planungsbestand"); +TEXT VAR geplschuelergruppen,aufbermeld,aufberprot,aktschuljahr,akthalbjahr, +kommendesschuljahr;PROC schuljahreswechsel:abschnittsendebearbeitung( +zumschuljahresende)END PROC schuljahreswechsel;PROC halbjahreswechsel: +abschnittsendebearbeitung(zumhalbjahresende)END PROC halbjahreswechsel;PROC +abschnittsendebearbeitung(INT CONST zeitpunkt):forget(ds);kanal:=int( +getrcvparam(1));continue(kanal);reinitparsing;stichtag:=schulkenndatum( +schluesselendeschulhalbjahr);aktschuljahr:=schulkenndatum(schluesselschuljahr +);akthalbjahr:=schulkenndatum(schluesselhalbjahr);kommendesschuljahr:=subtext +(aktschuljahr,3,4);kommendesschuljahrCAT (jahrestext(int(kommendesschuljahr)+ +1));fehlerbehandlungvorbereiten;verarbeitung;fehlerauswertung;break(quiet). +fehlerbehandlungvorbereiten:disablestop;forget(protname,quiet);fehlerzahl:= +null.verarbeitung:IF zeitpunkt=zumschuljahresendeTHEN hochsetzenderschueler +ELSE halbjahreswechselderschuelerFI .fehlerauswertung:IF fehleraufgetreten +THEN schickefehlerprotokollananwenderELSE putsndcode(rcodenoprot);ds:= +nilspace;putsndds(ds);forget(ds)FI ;forget(protname,quiet).fehleraufgetreten: +fehlerzahl>null.schickefehlerprotokollananwender:clearerror;enablestop; +putsndcode(rcodeprot);ds:=old(protname);putsndds(ds);forget(ds).END PROC +abschnittsendebearbeitung;PROC halbjahreswechselderschueler:enablestop; +schuelergruppenausplanunguebernehmen;IF fehlerzahl=nullTHEN +aktuellanderschulebefindlicheschuelerdurchgehen(zumhalbjahresende)FI .END +PROC halbjahreswechselderschueler;PROC hochsetzenderschueler:enablestop; +schuelergruppenausplanunguebernehmen;IF fehlerzahl=nullTHEN +aktuellanderschulebefindlicheschuelerdurchgehen(zumschuljahresende); +neuanmeldungenuebernehmenFI .neuanmeldungenuebernehmen: +neuanmeldungenzur5uebernehmen;neuanmeldungenzur11uebernehmen; +sonstigeneuanmeldungenuebernehmen.END PROC hochsetzenderschueler;PROC +schuelergruppenausplanunguebernehmen:TEXT VAR folgesj,folgehj; +geplschuelergruppen:=niltext;neuewertefuerschuljahrhalbjahrbestimmen; +inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,folgesj);putwert(fnrsgrphj +,folgehj);search(dnraktschuelergruppen,FALSE );WHILE dbstatus=okCAND +richtigesschulhalbjahrREP leseeinesg;succ(dnraktschuelergruppen)PER ;IF +geplschuelergruppen=niltextTHEN fehler(niltext,fehlerplanung)ELSE +alteschuelergruppenloeschen;#statistikwuerfelvorbereitendr11.05.88#FI . +neuewertefuerschuljahrhalbjahrbestimmen:IF akthalbjahr=halbjahr1THEN folgesj +:=aktschuljahr;folgehj:=halbjahr2ELSE folgesj:=kommendesschuljahr;folgehj:= +halbjahr1FI .richtigesschulhalbjahr:wert(fnrsgrpsj)=folgesjCAND wert( +fnrsgrphj)=folgehj.#dr11.05.88statistikwuerfelvorbereiten:melde(hellan+ +"Die speziellen Statistiken werden initialisiert"+hellaus,meldz);initstatraum +(TRUE );bestaendeinstatraumeintragen(folgesj,folgehj); +kuerzelnameninstatraumeintragen.#END PROC +schuelergruppenausplanunguebernehmen;PROC alteschuelergruppenloeschen:TEXT +VAR sg:="";inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,aktschuljahr); +putwert(fnrsgrphj,akthalbjahr);search(dnraktschuelergruppen,FALSE );WHILE +altesschuljahrhalbjahrREP sg:=wert(fnrsgrpjgst)+wert(fnrsgrpkennung);delete( +dnraktschuelergruppen);IF dbstatus<>nullTHEN fehler(sg,fehlerstatus, +fehlerloeschen+text(dbstatus))ELSE melde("Die aktuelle Schülergruppe "+hellan ++sg+hellaus+"wird gelöscht",meldz)FI ;search(dnraktschuelergruppen,FALSE ) +PER .altesschuljahrhalbjahr:dbstatus=nullCAND wert(fnrsgrpsj)=aktschuljahr +CAND wert(fnrsgrphj)=akthalbjahr.END PROC alteschuelergruppenloeschen;PROC +leseeinesg:TEXT CONST jgstkurz:=wert(fnrsgrpjgst),jgstlang:=jgstaufber( +jgstkurz),zug:=compress(wert(fnrsgrpkennung));melde( +"Die aktuelle Schülergruppe "+hellan+jgstlang+zug+hellaus+"wird eingerichtet" +,meldz);geplschuelergruppenCAT jgstlang;geplschuelergruppenCAT zug; +geplschuelergruppenCAT sgtrennerEND PROC leseeinesg;PROC +aktuellanderschulebefindlicheschuelerdurchgehen(INT CONST zeitpunkt):TEXT +VAR schuelertid:="";bereitevor;erstenlesen;WHILE nochwelchedaREP schuelertid +:=gettid;saveupdateposition(dnrschueler);verarbeiten;aenderungspeichern; +updatenoetig:=TRUE ;naechstenlesen;PER .bereitevor:inittupel(dnrschueler); +putwert(fnrsustatuss,aktbestand);updatenoetig:=TRUE .erstenlesen:search( +ixsustatfamrufgeb,FALSE );merkealleschluesselwerte.naechstenlesen:IF wert( +fnrsustatuss)=bestandabgegangeneTHEN putwert(fnrsustatuss,aktbestand);search( +ixsustatfamrufgeb,FALSE )ELSE succ(ixsustatfamrufgeb)FI ;IF +selbensatznochmalgelesenTHEN succ(ixsustatfamrufgeb)FI ; +merkealleschluesselwerte.merkealleschluesselwerte:letztername:=wert( +fnrsufamnames);letzterrufname:=wert(fnrsurufnames);letztesgebdatum:=wert( +fnrsugebdatums);letzterstatus:=wert(fnrsustatuss).selbensatznochmalgelesen: +letztername=wert(fnrsufamnames)CAND letzterrufname=wert(fnrsurufnames)CAND +letztesgebdatum=wert(fnrsugebdatums)CAND letzterstatus=wert(fnrsustatuss). +nochwelcheda:dbstatus=nullCAND wert(fnrsustatuss)=aktbestand.verarbeiten: +setzekenndaten;setzejgstundsg;meldebearbeitung;IF abgemeldetTHEN +anderschulebefindlicheabmeldenELIF zeitpunkt=zumschuljahresendeTHEN +anderschulebefindlichebehandeln(aktjgst,aktsg)ELSE +schuelerzumhalbjahreswechselbehandeln(aktjgst,aktsg)FI .setzejgstundsg:TEXT +VAR aktjgst:=jgstaufber(wert(fnrsusgrpjgst)),aktsg:=compress(wert( +fnrsusgrpzugtut)).meldebearbeitung:melde("Die Daten von "+hellan+aufbermeld+ +hellaus+", "+hellan+aktjgst+aktsg+hellaus+"werden bearbeitet",meldz). +abgemeldet:INT VAR aktabmeldedatum:=datum(wert(fnrsuabgdats));( +aktabmeldedatum<>datum(leerdatum))CAND (datum(stichtag)>=aktabmeldedatum). +anderschulebefindlicheabmelden:putwert(fnrsustatuss,bestandabgegangene); +updatenoetig:=TRUE ;hjdnaechstesschulhalbjahrbearbeiten(aktjgst,aktsg). +aenderungspeichern:IF dbstatus=okTHEN IF updatenoetigTHEN +restoreupdateposition(dnrschueler);selupdate(dnrschueler);ELSE replace( +dnrschueler,schuelertid);putptid(schuelertid);insertinindex(ixsustatjgstzug); +IF zeitpunkt=zumschuljahresendeTHEN insertinindex(ixsustatjgst)FI FI ;IF +dbstatus<>nullTHEN fehler(aufberprot,fehlerstatus,fehleraendern+text(dbstatus +))FI FI .END PROC aktuellanderschulebefindlicheschuelerdurchgehen;PROC +schuelerzumhalbjahreswechselbehandeln(TEXT CONST aktjgst,aktsg):TEXT VAR +neueklasse,neuesg;tutorloeschen;neueklassepruefen;dbstatus(ok).tutorloeschen: +#removeoutoffindex(ixsustatjgstzug);##dr18.08.88#neuesg:=compress(wert( +fnrsuneuerzugtut));IF neuesg<>niltextTHEN putwert(fnrsusgrpzugtut,niltext)FI +.neueklassepruefen:IF neuesg=niltextTHEN neueklasse:=aktjgst+aktsg;neuesg:= +aktsgELSE neueklasse:=aktjgst+neuesg;putwert(fnrsuneuerzugtut,niltext); +putwert(fnrsusgrpzugtut,neuesg);FI ;IF NOT gueltigesg(neueklasse)THEN fehler( +aufberprot,fehlerungueltigesg,neueklasse);dbstatus(9);LEAVE +schuelerzumhalbjahreswechselbehandelnELSE hjdnaechstesschulhalbjahrbearbeiten +(aktjgst,neuesg)FI .END PROC schuelerzumhalbjahreswechselbehandeln;PROC +anderschulebefindlichebehandeln(TEXT CONST aktjgst,aktsg):holehjd; +analysierehalbjahresdaten;aendere.holehjd:IF wert(fnrsutidakthjd)<>niltext +THEN readtid(dnrhalbjahresdaten,wert(fnrsutidakthjd));IF iserrorTHEN +clearerror;dbstatus(notfound)FI ELSE dbstatus(notfound)FI ;IF +keinehalbjahresdatenvorhandenTHEN fehler(aufberprot,fehlerungueltigehjd); +LEAVE anderschulebefindlichebehandelnFI .keinehalbjahresdatenvorhanden: +dbstatus<>okCOR aktschuljahr<>wert(fnrhjdsj)COR akthalbjahr<>wert(fnrhjdhj) +COR key[1]<>wert(fnrhjdfamnames)COR key[2]<>wert(fnrhjdrufnames)COR key[3]<> +datumrekonversion(wert(fnrhjdgebdats))COR aktjgst<>jgstaufber(wert(fnrhjdjgst +))COR aktsg<>compress(wert(fnrhjdkennung)).analysierehalbjahresdaten:TEXT +VAR versetzung:=wert(fnrhjdversetzung);pruefeversetzungskennzeichen. +pruefeversetzungskennzeichen:BOOL VAR datenkorrekt:=FALSE ;TEXT CONST +neuerzugtutor:=wert(fnrsuneuerzugtut);IF versetzung=niltextTHEN fehler( +aufberprot,fehlerkeinverserg)ELIF pos(gueltigekennzeichen,versetzung)<=null +THEN fehler(aufberprot,fehlerungueltigesverserg,versetzung);ELIF +nichtnormalhoeherstufenCAND keinzugtutorTHEN fehler(aufberprot, +fehlerkeinneuertutor);ELSE datenkorrekt:=TRUE FI ;IF NOT datenkorrektTHEN +LEAVE anderschulebefindlichebehandelnFI .nichtnormalhoeherstufen:pos( +gueltigekennzeichen,versetzung)>poshoeherstufen.keinzugtutor:neuerzugtutor= +niltext.aendere:TEXT VAR neuesg:=wert(fnrsusgrpzugtut);#removeoutoffindex( +ixsustatjgst);removeoutoffindex(ixsustatjgstzug);##dr18.08.88#IF +neuerzugtutor<>niltextTHEN neuesg:=neuerzugtutorFI ;aendereschueler(aktjgst, +aktsg,neuesg,versetzung).END PROC anderschulebefindlichebehandeln;PROC +aendereschueler(TEXT CONST aktjgst,aktsg,neuesg,versetzung):bereitevor; +setzedaten;hjddatenloeschen;hjdnaechstesschulhalbjahrbearbeiten(neuejgst, +neuesg).bereitevor:TEXT VAR neuejgst:=aktjgst;TEXT VAR loeschjgst:=aktjgst;. +setzedaten:trageversetzungundtutorein;INT CONST kennzeichenpos:=pos( +gueltigekennzeichen,versetzung);SELECT kennzeichenposOF CASE posspringer: +springenCASE posvers:normalversetzenCASE posnachpr:zurnachpruefungversetzen +CASE posnichtvers,posfreiwillig:sitzenbleibenEND SELECT ;TEXT VAR neueklasse +:=neuejgst+neuesg;IF falscherzugtutorTHEN fehler(aufberprot, +fehlerungueltigesg,neueklasse);LEAVE aendereschuelerFI .falscherzugtutor:NOT +gueltigesg(neueklasse).trageversetzungundtutorein:putwert(fnrsuartzugang, +versetzung);putwert(fnrsuneuerzugtut,niltext).springen:IF int(aktjgst)>11 +THEN fehler(aufberprot,fehlerungueltigesverserg,versetzung);LEAVE +aendereschuelerFI ;BOOL VAR sitzenbleiber:=FALSE ;neuejgst:=jgstaufber(text( +int(aktjgst)+2));loeschjgst:=jgstaufber(text(int(aktjgst)+1)); +nachfolgendehjdsloeschen;sgeintragen;eintrittsek2evtleintragen. +normalversetzen:IF inder13THEN dreizehnerabmelden; +hjdnaechstesschulhalbjahrbearbeiten(neuejgst,aktsg);LEAVE aendereschueler +ELSE normalhochsetzenFI .zurnachpruefungversetzen:IF inder13THEN +nachpruefling13ELSE normalhochsetzenFI .normalhochsetzen:sitzenbleiber:= +FALSE ;neuejgst:=jgstaufber(text(int(aktjgst)+1));loeschjgst:=neuejgst; +sgeintragen;eintrittsek2evtleintragen.sgeintragen:putwert(fnrsusgrpjgst, +neuejgst);putwert(fnrsusgrpzugtut,neuesg);.eintrittsek2evtleintragen:IF +neuejgst=jgst11THEN putwert(fnrsueintrittinsek,kommendesschuljahr);FI . +nachpruefling13:sitzenbleiber:=TRUE ;putwert(fnrsuartzugang,dreizehnnachpr); +sgeintragen.sitzenbleiben:sitzenbleiber:=TRUE ;sgeintragen; +nachfolgendehjdsloeschen.nachfolgendehjdsloeschen:halbjahresdatenloeschen( +PROC (INT CONST )succ,key,halbjahr2,int(aktjgst),FALSE );.inder13:aktjgst= +jgst13.hjddatenloeschen:halbjahresdatenloeschen(key,aktjgst,loeschjgst, +halbjahr1).END PROC aendereschueler;PROC dreizehnerabmelden:putwert( +fnrsuabgdats,stichtag);putwert(fnrsuabschluss,kennzeichenabitur);putwert( +fnrsustatuss,bestandabgegangene);updatenoetig:=TRUE ;END PROC +dreizehnerabmelden;PROC neuanmeldungenzur5uebernehmen:uebernehmenaus( +neuanmeld5,1)END PROC neuanmeldungenzur5uebernehmen;PROC +neuanmeldungenzur11uebernehmen:uebernehmenaus(neuanmeld11,1)END PROC +neuanmeldungenzur11uebernehmen;PROC sonstigeneuanmeldungenuebernehmen: +uebernehmenaus(neuanmeldsonst,2)END PROC sonstigeneuanmeldungenuebernehmen; +PROC uebernehmenaus(TEXT CONST bestand,INT CONST meld):BOOL VAR +allesinordnung:=FALSE ;TEXT VAR neuejgst,neuerzug;bereitevor;erstenlesen; +WHILE nochwelchedaREP saveupdateposition(dnrschueler);pruefen;IF +allesinordnungTHEN uebernehmen;putwert(fnrsustatuss,bestand);meldeuebernahme; +FI ;naechstenlesen;PER .bereitevor:inittupel(dnrschueler);putwert( +fnrsustatuss,bestand).erstenlesen:search(ixsustatfamrufgeb,FALSE ). +nochwelcheda:dbstatus=nullCAND wert(fnrsustatuss)=bestand.pruefen: +setzekenndaten;pruefetutorsg(allesinordnung);.uebernehmen:neuejgst:=wert( +fnrsujgsteintr);neuerzug:=wert(fnrsuneuerzugtut);dbwertesetzen; +hjdnaechstesschulhalbjahrbearbeiten(neuejgst,neuerzug);restoreupdateposition( +dnrschueler);selupdate(dnrschueler);IF dbstatus<>nullTHEN fehler(aufberprot, +fehlerstatus,fehleraendern+text(dbstatus))FI .dbwertesetzen:putwert( +fnrsusgrpjgst,jgstaufber(neuejgst));putwert(fnrsusgrpzugtut,neuerzug);putwert +(fnrsuartzugang,kennzeichenneuan);putwert(fnrsuneuerzugtut,niltext). +meldeuebernahme:IF meld=1THEN melde("Bearbeitung der Neuangemeldeten zur "+ +jgstaufber(neuejgst)+": "+hellan+aufbermeld+hellaus,meldz)ELSE melde( +"Bearbeitung sonstiger Neuanmeldungen: "+hellan+aufbermeld+hellaus,meldz)FI . +naechstenlesen:search(ixsustatfamrufgeb,FALSE )#dr18.08.88##succ( +ixsustatfamrufgeb)##eigentlichrichtig#.END PROC uebernehmenaus;PROC fehler( +TEXT CONST name,INT CONST fehlernr):fehler(name,fehlernr,niltext)END PROC +fehler;PROC fehler(TEXT CONST name,INT CONST fehlernr,TEXT CONST ergaenzung): +IF ersterfehlerTHEN fehlerprotokollbeginnenELIF zuvielefehlerTHEN +programmendeFI ;nameinprotokoll;fehler(fehlernr,ergaenzung);dbstatus(notfound +);.ersterfehler:fehlerzahl=null.zuvielefehler:fehlerzahl=maxfehler. +fehlerprotokollbeginnen:fehlerprot:=sequentialfile(output,protname);TEXT VAR +protzeile:=schulkenndatum(schulname);protzeileCAT ((zeilenlaenge-datumslaenge +-length(protzeile))*blank);protzeileCAT date;putline(fehlerprot,protzeile); +putline(fehlerprot,schulkenndatum(schulort));line(fehlerprot,3);putline( +fehlerprot,protueberschrift);line(fehlerprot).programmende:line(fehlerprot); +putline(fehlerprot,weiterefehler);stop.nameinprotokoll:fehlerzahlINCR 1;line( +fehlerprot);protzeile:=text(fehlerzahl)+ordnungstrenner+name;putline( +fehlerprot,protzeile).END PROC fehler;PROC fehler(INT CONST fehlernr,TEXT +CONST ergaenzung):TEXT VAR protzeile:=absatztrenner+fehlertext(fehlernr);IF +ergaenzung<>niltextTHEN protzeileCAT klammerauf;protzeileCAT ergaenzung; +protzeileCAT klammerzuFI ;putline(fehlerprot,protzeile)END PROC fehler;PROC +pruefetutorsg(BOOL VAR allesinordnung):TEXT VAR eintrittjgst:=wert( +fnrsujgsteintr),neuerzug:=wert(fnrsuneuerzugtut);allesinordnung:=neuerzug<> +niltext;IF allesinordnungTHEN allesinordnung:=gueltigesg(eintrittjgst+ +neuerzug);IF NOT allesinordnungTHEN fehler(aufberprot,fehlerungueltigesg, +eintrittjgst+neuerzug)FI ELSE fehler(aufberprot,fehlerkeinneuertutor)FI ;END +PROC pruefetutorsg;BOOL PROC gueltigesg(TEXT CONST sg):pos( +geplschuelergruppen,sg+sgtrenner)>nullEND PROC gueltigesg;PROC setzekenndaten +:key(1):=wert(fnrsufamnames);key(2):=wert(fnrsurufnames);key(3):= +datumrekonversion(wert(fnrsugebdatums));aufbermeld:=key(1)+trennername+key(2) +;aufberprot:=aufbermeld+trennername+datumskonversion(key(3))END PROC +setzekenndaten;TEXT PROC jahrestext(INT CONST jahr):IF jahr=maxjahrTHEN +minjahrELSE text(jahr)FI END PROC jahrestext;PROC +hjdnaechstesschulhalbjahrbearbeiten(TEXT CONST jgst,zug):IF wert(fnrsustatuss +)<>aktbestandTHEN halbjahresdateninitialisierenundverarbeitenELSE +halbjahresdatensuchenundverarbeitenFI ;dbstatus(ok)#dr18.08.88##inittupel( +dnrschulen);dr11.05.88putwert(fnrschkennung,wert(fnrsuskennlschule));search( +dnrschulen,TRUE );einenschuelerinstatraumeinfuegen#. +halbjahresdateninitialisierenundverarbeiten:putwert(fnrsutidakthjd,niltext); +inittupel(dnrhalbjahresdaten);IF wert(fnrsustatuss)<>bestandabgegangeneTHEN +putwert(fnrsustatuss,aktbestand)FI .halbjahresdatensuchenundverarbeiten: +schluesselsetzen;search(dnrhalbjahresdaten,TRUE );IF dbstatus=okTHEN +eventuellneueklasseeintragen;putwert(fnrsutidakthjd,gettid)ELSE putwert( +fnrsutidakthjd,niltext)FI .schluesselsetzen:IF akthalbjahr=halbjahr1THEN +schluesselfuerhjdsetzen(dnrhalbjahresdaten,key,aktschuljahr,halbjahr2,jgst) +ELSE schluesselfuerhjdsetzen(dnrhalbjahresdaten,key,kommendesschuljahr, +halbjahr2,jgst)FI .eventuellneueklasseeintragen:IF schuelergruppegeaendert +THEN halbjahresdatenaendernFI .schuelergruppegeaendert:wert(fnrhjdjgst)<>jgst +OR wert(fnrhjdkennung)<>zug.halbjahresdatenaendern:putwert(fnrhjdjgst,jgst); +putwert(fnrhjdkennung,zug);selupdate(dnrhalbjahresdaten).END PROC +hjdnaechstesschulhalbjahrbearbeiten;LET seperatorzeichen=":./ ", +seperatorzeichen1=".";INT CONST beforefirstday:=-(22*vierjahre)-1;TEXT VAR b; +BOOL VAR conversionerror:=FALSE ;INT PROC nildatum:beforefirstdayEND PROC +nildatum;#L datumslets#LET letzterjanuar=31,letzterfebruar=59,letztermaerz=90 +,letzterapril=120,letztermai=151,letzterjuni=181,letzterjuli=212, +letzteraugust=243,letzterseptember=273,letzteroktober=304,letzternovember=334 +,#letzterdezember=365,#vierjahre=1461;PROC tmj(INT CONST d,INT VAR t,m,j): +INT VAR a;IF d<=beforefirstdayTHEN t:=-1;m:=-1;j:=-1;LEAVE tmjFI ;a:=d;IF a>0 +THEN j:=88ELSE j:=0;aINCR (-(beforefirstday+1))FI ;jINCR 4*(aDIV vierjahre);a +:=aMOD vierjahre;IF a=letzterfebruarTHEN t:=29;m:=2;LEAVE tmjELIF a> +letzterfebruarTHEN aDECR 1FI ;jINCR aDIV 365;a:=(aMOD 365)+1;IF a<= +letzterjuniTHEN januarbisjuniELSE julibisdezemberFI .januarbisjuni:IF a<= +letztermaerzTHEN januarbismaerzELSE aprilbisjuniFI .julibisdezember:IF a<= +letzterseptemberTHEN julibisseptemberELSE oktoberbisdezemberFI . +januarbismaerz:IF a<=letzterjanuarTHEN m:=1;t:=aELIF a<=letzterfebruarTHEN m +:=2;t:=a-letzterjanuarELSE m:=3;t:=a-letzterfebruarFI .aprilbisjuni:IF a<= +letzteraprilTHEN m:=4;t:=a-letztermaerzELIF a<=letztermaiTHEN m:=5;t:=a- +letzteraprilELSE m:=6;t:=a-letztermaiFI .julibisseptember:IF a<=letzterjuli +THEN m:=7;t:=a-letzterjuniELIF a<=letzteraugustTHEN m:=8;t:=a-letzterjuli +ELSE m:=9;t:=a-letzteraugustFI .oktoberbisdezember:IF a<=letzteroktoberTHEN m +:=10;t:=a-letzterseptemberELIF a<=letzternovemberTHEN m:=11;t:=a- +letzteroktoberELSE m:=12;t:=a-letzternovemberFI .END PROC tmj;INT PROC datum( +TEXT CONST a):b:=a;conversionerror:=FALSE ;INT VAR seperator:=seppos,t,m,j; +IF seperator=0THEN IF length(b)=6THEN t:=z(1)*10+z(2);m:=z(3)*10+z(4);j:=z(5) +*10+z(6);INT VAR dummy:=datum(t,m,j);IF conversionerrorTHEN dummy:=nildatum +FI ;LEAVE datumWITH dummyELSE leaveFI ELIF seperator=2THEN t:=z(1);ELIF +seperator=3THEN t:=10*z(1)+z(2);ELSE leaveFI ;b:=subtext(b,seperator+1); +seperator:=seppos;IF seperator=3THEN m:=z(1)*10+z(2);ELIF seperator=2THEN m:= +z(1)ELSE leaveFI ;b:=subtext(b,seperator+1);IF length(b)=2THEN j:=z(1)*10+z(2 +)ELIF length(b)=4THEN j:=z(1)*1000+z(2)*100+z(3)*10+z(4)-1900;ELSE leaveFI ; +IF conversionerrorTHEN nildatumELSE datum(t,m,j)FI .leave:LEAVE datumWITH +nildatum.seppos:INT VAR q;FOR qFROM 2UPTO 3REP IF pos(seperatorzeichen,bSUB q +)>0THEN LEAVE sepposWITH q;FI PER ;0.END PROC datum;INT PROC z(INT CONST wo): +INT VAR e:=code(bSUB wo)-48;IF e<0OR e>9THEN conversionerror:=TRUE ;0ELSE e +FI END PROC z;INT PROC datum(INT CONST t,m,jc):INT VAR j:=jc-1900IF j<0THEN j +INCR 1900FI ;IF (j+160)DIV 160<>1THEN nildatumELIF t<0THEN nildatumELSE +SELECT mOF CASE 1,3,5,7,8,10,12:IF t>31THEN nildatumELSE erg(t,m,j)FI CASE 4, +6,9,11:IF t>30THEN nildatumELSE erg(t,m,j)FI CASE 2:IF t<29THEN erg(t,m,j) +ELIF t=29AND jMOD 4=0THEN erg(t,m,j)ELSE nildatumFI OTHERWISE nildatumEND +SELECT FI END PROC datum;INT PROC erg(INT CONST t,m,jc):INT VAR j:=jc;INT +VAR result:=beforefirstday,tagimzyklus;IF j>=88THEN jDECR 88;result:=-1FI ; +resultINCR ((jDIV 4)*vierjahre);j:=jMOD 4;tagimzyklus:=tagundmonat+365*j;IF +tagimzyklus>erstermaerzimschaltjahrTHEN tagimzyklusINCR 1ELIF tagimzyklus= +erstermaerzimschaltjahrAND m=3THEN tagimzyklusINCR 1FI ;result+tagimzyklus. +erstermaerzimschaltjahr:60.tagundmonat:SELECT mOF CASE 1:tCASE 2:t+ +letzterjanuarCASE 3:t+letzterfebruarCASE 4:t+letztermaerzCASE 5:t+ +letzteraprilCASE 6:t+letztermaiCASE 7:t+letzterjuniCASE 8:t+letzterjuliCASE 9 +:t+letzteraugustCASE 10:t+letzterseptemberCASE 11:t+letzteroktoberCASE 12:t+ +letzternovemberOTHERWISE errorstop("monat > 12 oder < 0");0END SELECT .END +PROC erg;INT PROC jahr(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);j+1900END +PROC jahr;TEXT PROC datum(INT CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j); +IF t<0THEN LEAVE datumWITH ""FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);e +CAT seperatorzeichen1;eCAT code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT +seperatorzeichen1;eCAT code((jMOD 100)DIV 10+48);eCAT code(jMOD 10+48);eEND +PROC datum;END PACKET hoeherstufenlocalprog + diff --git a/app/schulis/2.2.1/src/0.ida.data b/app/schulis/2.2.1/src/0.ida.data new file mode 100644 index 0000000..a9cff8e --- /dev/null +++ b/app/schulis/2.2.1/src/0.ida.data @@ -0,0 +1,170 @@ +PACKET idadataDEFINES putformular,openformular,initformular,getactivformular, +getformtextname,getformularinfo,putformularinfo,getformularname, +getformularindex,getsteuercode,putsteuercode,getdruckaufbereitung, +putdruckaufbereitung,getzeile,putzeile,geteinfuegstellen,puteinfuegstellen, +getzeilenanzahl,putzeilenanzahl,getunterbloecke,putunterbloecke, +getvorzeilennr,putvorzeilennr,getanzahlselfelder,putanzahlselfelder, +getselektion,putselektion,getobjektklasse,putobjektklasse,getleitindex, +putleitindex,getscan,putscan,getanzahlregeln,putanzahlregeln,getregelnummer, +deleteregel,getblockregelnummer,putblockregelnummer,getzugriffsregel, +putzugriffsregel,getanzahlregelfelder,putanzahlregelfelder,getvergleichswert, +putvergleichswert,getblockanzahl,FORMULAR ,openmitloeschen, +setzeidazeichensatz:TEXT VAR idazeichensatz:="";LET maxanw=100,maxblock=11, +maxregel=50,maxobjekt=10,maxfeld=10,maxtext=100,maxsel=200;TYPE FORMULAR = +STRUCT (INFO formularbeschreibung,ROW maxregelREGEL zugriffsregel,INT +anzregeln,ROW maxobjektTEXT objektklassen,ROW maxselSELEKT selektion,INT +anzselfelder,DRUCKFORM druckform);TYPE INFO =STRUCT (TEXT formname, +scanbedingung,INT formindex,leitindex,BOOL formtyp);TYPE REGEL =STRUCT (INT +objektklassennr,regelnummer,indexnr,anzkeyfelder,ROW maxfeldTEXT +vergleichswert);TYPE SELEKT =STRUCT (TEXT selektionsfeld,wert);TYPE BLOCK = +STRUCT (ROW maxtextTEXT zeile,ROW maxtextTEXT einfuegstellen,INT anzzeilen, +zuregelnummer,TEXT unterblock,vorzeilennr);TYPE DRUCKFORM =STRUCT (ROW +maxblockBLOCK block,ROW maxanwSTCODE stcodes,INT anzblock,DRUCK +druckaufbereitung);TYPE STCODE =STRUCT (TEXT steuercode,INT laenge,BOOL +rechtsbuendig,druckvariable);TYPE DRUCK =STRUCT (TEXT schrifttyp,REAL +startlinks,startoben,INT zeilenproseite,REAL zeilenbreite);DATASPACE VAR fds +:=nilspace;BOUND FORMULAR VAR form;INT VAR aktformindex:=0;PROC +setzeidazeichensatz(TEXT CONST schriftart):idazeichensatz:=schriftartEND +PROC setzeidazeichensatz;BOOL VAR loeschenerlaubt:=TRUE ;BOOL PROC +openmitloeschen:loeschenerlaubtENDPROC openmitloeschen;PROC openmitloeschen( +BOOL CONST b):loeschenerlaubt:=bENDPROC openmitloeschen;PROC putformular( +DATASPACE CONST ds):forget(fds);fds:=ds;form:=fds;aktformindex:= +getformularindexENDPROC putformular;PROC openformular(INT CONST index):IF +aktformindex<>indexCAND loeschenerlaubtTHEN letzteformularloeschenFI ; +aktformindex:=index;IF exists(getformdataname)THEN form:=old(getformdataname) +ELSE initformular(index);FI .letzteformularloeschen:forget(getformdataname, +quiet);forget(getformtextname,quiet).ENDPROC openformular;PROC initformular( +INT CONST index):INT VAR i,j;FILE VAR formtext;aktformindex:=index;forget( +getformdataname,quiet);form:=new(getformdataname);putanzahlregeln(0); +putanzahlselfelder(0);putleitindex(0);putscan("");formtext:=sequentialfile( +output,getformtextname);FOR iFROM 1UPTO maxobjektREP putobjektklasse(i,"") +PER ;FOR iFROM 1UPTO maxanwREP putsteuercode(i,"",0,FALSE ,TRUE )PER ;FOR i +FROM 1UPTO maxregelREP FOR jFROM 1UPTO maxfeldREP form.zugriffsregel[i]. +vergleichswert[j]:=""PER PER ;putdruckaufbereitung(idazeichensatz,2.0,2.0,60, +77.0);putformularinfo("",index,TRUE )ENDPROC initformular;INT PROC +getactivformular:aktformindexENDPROC getactivformular;TEXT PROC +getformdataname:"FORMDATA."+text(aktformindex)ENDPROC getformdataname;TEXT +PROC getformtextname:"FORMTEXT."+text(aktformindex)ENDPROC getformtextname; +PROC getsteuercode(INT CONST index,TEXT VAR ausdruck,INT VAR ausglaenge,BOOL +VAR rbuendig,druckvar):IF index<1COR index>maxanwTHEN ausdruck:=""ELSE +ausdruck:=form.druckform.stcodes[index].steuercode;ausglaenge:=form.druckform +.stcodes[index].laenge;rbuendig:=form.druckform.stcodes[index].rechtsbuendig; +druckvar:=form.druckform.stcodes[index].druckvariable;FI ENDPROC +getsteuercode;PROC putsteuercode(INT CONST index,TEXT CONST ausdruck,INT +CONST ausglaenge,BOOL CONST rbuendig,druckvar):form.druckform.stcodes[index]. +steuercode:=ausdruck;form.druckform.stcodes[index].laenge:=ausglaenge;form. +druckform.stcodes[index].rechtsbuendig:=rbuendig;form.druckform.stcodes[index +].druckvariable:=druckvar;ENDPROC putsteuercode;PROC putdruckaufbereitung( +TEXT CONST schriftart,REAL CONST linkerrandlinks,linkerrandoben,INT CONST +zeilenperseite,REAL CONST zeichenperzeile):form.druckform.druckaufbereitung. +schrifttyp:=schriftart;form.druckform.druckaufbereitung.startlinks:= +linkerrandlinks;form.druckform.druckaufbereitung.startoben:=linkerrandoben; +form.druckform.druckaufbereitung.zeilenproseite:=zeilenperseite;form. +druckform.druckaufbereitung.zeilenbreite:=zeichenperzeile;ENDPROC +putdruckaufbereitung;PROC getdruckaufbereitung(TEXT VAR schriftart,REAL VAR +linkerrandlinks,linkerrandoben,INT VAR zeilenperseite,REAL VAR +zeichenperzeile):schriftart:=form.druckform.druckaufbereitung.schrifttyp; +linkerrandlinks:=form.druckform.druckaufbereitung.startlinks;linkerrandoben:= +form.druckform.druckaufbereitung.startoben;zeilenperseite:=form.druckform. +druckaufbereitung.zeilenproseite;zeichenperzeile:=form.druckform. +druckaufbereitung.zeilenbreite;ENDPROC getdruckaufbereitung;TEXT PROC +getzeile(INT CONST blocknr,zeilennr):form.druckform.block[blocknr+1].zeile[ +zeilennr]ENDPROC getzeile;PROC putzeile(INT CONST blocknr,zeilennr,TEXT +CONST textzeile):form.druckform.block[blocknr+1].zeile[zeilennr]:=textzeile; +form.druckform.anzblock:=max(form.druckform.anzblock,blocknr)ENDPROC putzeile +;TEXT PROC geteinfuegstellen(INT CONST blocknr,zeilennr):form.druckform.block +[blocknr+1].einfuegstellen[zeilennr]ENDPROC geteinfuegstellen;PROC +puteinfuegstellen(INT CONST blocknr,zeilennr,TEXT CONST einfueg):form. +druckform.block[blocknr+1].einfuegstellen[zeilennr]:=einfuegENDPROC +puteinfuegstellen;INT PROC getzeilenanzahl(INT CONST blocknr):form.druckform. +block[blocknr+1].anzzeilenENDPROC getzeilenanzahl;PROC putzeilenanzahl(INT +CONST blocknr,zeilennr):form.druckform.block[blocknr+1].anzzeilen:=zeilennr +ENDPROC putzeilenanzahl;INT PROC getblockregelnummer(INT CONST blocknr):form. +druckform.block[blocknr+1].zuregelnummerENDPROC getblockregelnummer;PROC +putblockregelnummer(INT CONST blocknr,regel):form.druckform.block[blocknr+1]. +zuregelnummer:=regelENDPROC putblockregelnummer;INT PROC getblockanzahl:form. +druckform.anzblockENDPROC getblockanzahl;TEXT PROC getunterbloecke(INT CONST +blocknr):form.druckform.block[blocknr+1].unterblockENDPROC getunterbloecke; +PROC putunterbloecke(INT CONST blocknr,TEXT CONST ub):form.druckform.block[ +blocknr+1].unterblock:=ubENDPROC putunterbloecke;TEXT PROC getvorzeilennr( +INT CONST blocknr):form.druckform.block[blocknr+1].vorzeilennrENDPROC +getvorzeilennr;PROC putvorzeilennr(INT CONST blocknr,TEXT CONST zeilenno): +form.druckform.block[blocknr+1].vorzeilennr:=zeilennoENDPROC putvorzeilennr; +TEXT PROC getscan:form.formularbeschreibung.scanbedingungENDPROC getscan; +PROC putscan(TEXT CONST bedingung):form.formularbeschreibung.scanbedingung:= +bedingungENDPROC putscan;TEXT PROC getobjektklasse(INT CONST ix):form. +objektklassen[ix]ENDPROC getobjektklasse;PROC putobjektklasse(INT CONST ix, +TEXT CONST okname):form.objektklassen[ix]:=oknameENDPROC putobjektklasse; +TEXT PROC getformularname:form.formularbeschreibung.formnameENDPROC +getformularname;INT PROC getformularindex:form.formularbeschreibung.formindex +ENDPROC getformularindex;PROC getformularinfo(TEXT VAR name,INT VAR index, +BOOL VAR typ):name:=form.formularbeschreibung.formname;index:=form. +formularbeschreibung.formindex;typ:=form.formularbeschreibung.formtyp; +ENDPROC getformularinfo;PROC putformularinfo(TEXT CONST name,INT CONST index, +BOOL CONST typ):form.formularbeschreibung.formname:=name;form. +formularbeschreibung.formindex:=index;form.formularbeschreibung.formtyp:=typ; +ENDPROC putformularinfo;INT PROC getleitindex:form.formularbeschreibung. +leitindexENDPROC getleitindex;PROC putleitindex(INT CONST neuerindex):form. +formularbeschreibung.leitindex:=neuerindexENDPROC putleitindex;INT PROC +getanzahlregeln:form.anzregelnENDPROC getanzahlregeln;PROC putanzahlregeln( +INT CONST anzahl):form.anzregeln:=anzahlENDPROC putanzahlregeln;PROC +putanzahlselfelder(INT CONST anzahl):form.anzselfelder:=anzahlENDPROC +putanzahlselfelder;INT PROC getanzahlselfelder:form.anzselfelderENDPROC +getanzahlselfelder;OP :=(REGEL VAR left,REGEL CONST right):CONCR (left):= +CONCR (right)ENDOP :=;INT PROC getregelnummer(INT CONST objektklasse,regelnr) +:INT VAR i;FOR iFROM 1UPTO getanzahlregelnREP IF form.zugriffsregel[i]. +objektklassennr=objektklasseCAND form.zugriffsregel[i].regelnummer=regelnr +THEN LEAVE getregelnummerWITH iFI PER ;0ENDPROC getregelnummer;PROC +deleteregel(INT CONST regel):INT VAR i;IF regel<=getanzahlregelnCAND regel>0 +THEN FOR iFROM regelUPTO getanzahlregeln-1REP form.zugriffsregel[i]:=form. +zugriffsregel[i+1]PER ;putanzahlregeln(getanzahlregeln-1)FI ENDPROC +deleteregel;PROC getzugriffsregel(INT CONST nr,INT VAR objekt,regel,index, +anzfelder):objekt:=form.zugriffsregel[nr].objektklassennr;regel:=form. +zugriffsregel[nr].regelnummer;index:=form.zugriffsregel[nr].indexnr;anzfelder +:=form.zugriffsregel[nr].anzkeyfelder;ENDPROC getzugriffsregel;PROC +putzugriffsregel(INT CONST nr,INT CONST objekt,regel,index,anzfelder):form. +anzregeln:=max(nr,form.anzregeln);form.zugriffsregel[nr].objektklassennr:= +objekt;form.zugriffsregel[nr].regelnummer:=regel;form.zugriffsregel[nr]. +indexnr:=index;form.zugriffsregel[nr].anzkeyfelder:=anzfelder;ENDPROC +putzugriffsregel;INT PROC getanzahlregelfelder(INT CONST regelnr):form. +zugriffsregel[regelnr].anzkeyfelderENDPROC getanzahlregelfelder;PROC +putanzahlregelfelder(INT CONST regelnr,anzahl):form.zugriffsregel[regelnr]. +anzkeyfelder:=anzahlENDPROC putanzahlregelfelder;TEXT PROC getvergleichswert( +INT CONST regel,nr):form.zugriffsregel[regel].vergleichswert[nr]ENDPROC +getvergleichswert;PROC putvergleichswert(INT CONST regelnr,TEXT CONST vglwert +):form.zugriffsregel[regelnr].anzkeyfelderINCR 1;form.zugriffsregel[regelnr]. +vergleichswert[form.zugriffsregel[regelnr].anzkeyfelder]:=vglwertENDPROC +putvergleichswert;PROC putselektion(TEXT CONST feldname,vglwert):form. +anzselfelderINCR 1;form.selektion[form.anzselfelder].selektionsfeld:=feldname +;form.selektion[form.anzselfelder].wert:=vglwert;ENDPROC putselektion;PROC +getselektion(INT CONST ix,TEXT VAR feldname,vglwert):feldname:=form.selektion +[ix].selektionsfeld;vglwert:=form.selektion[ix].wert;ENDPROC getselektion; +TEXT PROC getselektion:buildselektionENDPROC getselektion;LET textbegrenzer= +"""",klammerauf="<",klammerzu=">",gleich="=",undoperator=" UND ",operatoren= +"=<>";INT PROC postextende(TEXT CONST ausgabe,INT CONST aktuelleposition): +INT VAR neupos:=aktuelleposition+1;WHILE (ausgabeSUB neupos)<>textbegrenzer +REP neuposINCR 1;IF (ausgabeSUB neupos)=textbegrenzerCAND (ausgabeSUB neupos+ +1)=textbegrenzerTHEN neuposINCR 2;FI ;UNTIL neupos>length(ausgabe)PER ;neupos ++1ENDPROC postextende;INT PROC operatorposition(TEXT VAR ausdruck,INT CONST +abpos):INT VAR p:=abpos;WHILE p<=length(ausdruck)AND pos(operatoren,ausdruck +SUB p)=0REP IF (ausdruckSUB p)=textbegrenzerTHEN insertchar(ausdruck, +klammerauf,p);pINCR 1;p:=postextende(ausdruck,p);insertchar(ausdruck, +klammerzu,p);pINCR 1;ELSE pINCR 1FI ;PER ;IF p>length(ausdruck)THEN 0ELSE p +FI ENDPROC operatorposition;TEXT PROC buildselektion:INT VAR i:=1,oppos, +lastpos;TEXT VAR selausdruck:="",feldname:="",einfacherausdruck:="", +feldausdruck:="";WHILE i<=getanzahlselfelderREP getselektion(i,feldname, +einfacherausdruck);IF einfacherausdruck>""THEN evtlumoperatorergaenzen; +feldausdruck:="";lastpos:=1;oppos:=operatorposition(einfacherausdruck,1); +WHILE oppos>0REP teilausdruckuebernehmen;feldnameneinfuegen;lastpos:=oppos; +opposINCR 1;IF pos(operatoren,einfacherausdruckSUB oppos)>0THEN opposINCR 1 +FI ;oppos:=operatorposition(einfacherausdruck,oppos);PER ;restuebernehmen; +feldausdruckklammern;IF length(selausdruck)>0THEN selausdruckCAT undoperator +FI ;selausdruckCAT feldausdruck;FI ;iINCR 1;PER ;selausdruck. +evtlumoperatorergaenzen:IF pos(operatoren,einfacherausdruckSUB 1)=0THEN +einfacherausdruck:=gleich+einfacherausdruckFI .teilausdruckuebernehmen: +feldausdruckCAT subtext(einfacherausdruck,lastpos,oppos-1).feldnameneinfuegen +:feldausdruck:=feldausdruck+textbegrenzer+feldname+textbegrenzer+" ". +restuebernehmen:feldausdruckCAT subtext(einfacherausdruck,lastpos). +feldausdruckklammern:feldausdruck:="("+feldausdruck+")".ENDPROC +buildselektion;ENDPACKET idadata + diff --git a/app/schulis/2.2.1/src/0.ida.form b/app/schulis/2.2.1/src/0.ida.form new file mode 100644 index 0000000..faa2776 --- /dev/null +++ b/app/schulis/2.2.1/src/0.ida.form @@ -0,0 +1,34 @@ +PACKET formdbDEFINES putform,getform,delform,formexists,formdbstatus:LET +putdatacode=10,puttextcode=11,getdatacodeno=12,gettextcodeno=13, +getdatacodename=19,gettextcodename=20,initializeserver=18,delcodeno=14, +existscodeno=15,delcodename=16,existscodename=17,errornak=2,ok=0, +cformtextname="FORMTEXT.",cformdataname="FORMDATA.";DATASPACE VAR ds;INT VAR +formnr,replycode;TASK VAR formdbserver:=/"ida server";BOUND TEXT VAR +boundinhalt;TEXT VAR id,formname;BOUND FORMULAR VAR form;TEXT PROC +formtextname:cformtextname+text(getformularindex)ENDPROC formtextname;TEXT +PROC formdataname:cformdataname+text(getformularindex)ENDPROC formdataname; +TEXT PROC formtextname(INT CONST formnr):cformtextname+text(formnr)ENDPROC +formtextname;TEXT PROC formdataname(INT CONST formnr):cformdataname+text( +formnr)ENDPROC formdataname;PROC formdbstatus(INT CONST newcode):replycode:= +newcode;ENDPROC formdbstatus;INT PROC formdbstatus:replycodeENDPROC +formdbstatus;PROC putform:forget(ds);formnr:=getformularindex;ds:=old( +formdataname);c(formdbserver,putdatacode,ds,replycode);IF replycode=okTHEN +forget(ds);ds:=old(formtextname(formnr));type(ds,formnr);c(formdbserver, +puttextcode,ds,replycode);forget(ds)FI ENDPROC putform;PROC getform(INT +CONST formnr):call(text(formnr),getdatacodeno);receive(replycode)ENDPROC +getform;PROC getform(TEXT CONST formname):call(formname,getdatacodename); +receive(replycode);ENDPROC getform;PROC receive(INT CONST replycode):IF +replycode=okTHEN putformular(ds);formnr:=getformularindex;forget(formdataname +,quiet);copy(ds,formdataname);call(text(formnr),gettextcodeno);forget( +formtextname(formnr),quiet);type(ds,1003);copy(ds,formtextname(formnr)); +forget(ds)FI ENDPROC receive;PROC delform(INT CONST formnr):call(text(formnr) +,delcodeno)ENDPROC delform;PROC delform(TEXT CONST formname):call(formname, +delcodename)ENDPROC delform;BOOL PROC formexists(INT CONST formnr):call(text( +formnr),existscodeno);replycode=okENDPROC formexists;BOOL PROC formexists( +TEXT CONST formname):call(text(formnr),existscodename);replycode=okENDPROC +formexists;PROC call(TEXT CONST inhalt,INT CONST ordercode):forget(ds);ds:= +nilspace;boundinhalt:=ds;boundinhalt:=inhalt;c(formdbserver,ordercode,ds, +replycode);ENDPROC call;PROC c(TASK CONST t,INT CONST i,DATASPACE VAR d,INT +VAR r):call(t,i,d,r);IF r=errornakTHEN boundinhalt:=ds;errorstop( +"IDA-MANAGER-Fehler: "+boundinhalt);FI ENDPROC c;ENDPACKET formdb; + diff --git a/app/schulis/2.2.1/src/0.ida.server b/app/schulis/2.2.1/src/0.ida.server new file mode 100644 index 0000000..ee1b067 --- /dev/null +++ b/app/schulis/2.2.1/src/0.ida.server @@ -0,0 +1,51 @@ +PACKET idaserverDEFINES idaserver:LET ok=00,#SERVER M essages&E rrors# +notfound=04,noform="",cformtextname="FORMTEXT.",#SERVER const#cformdataname= +"FORMDATA.",putdatacode=10,#SERVER ordercodes#puttextcode=11,getdatacodeno=12 +,gettextcodeno=13,getdatacodename=19,gettextcodename=20,delcodeno=14, +delcodename=16,existscodeno=15,existscodename=17,#initserver=18,#errornak=2,# +EUMEL S ystemerrors#continuecode=100;#EUMEL S ystemcodes#DATASPACE VAR ds:= +nilspace;#BOUND FORMULAR VAR form;#BOUND TEXT VAR errortext,formtext;TASK +VAR ordertask;INT VAR i,ordercode;ROW 100TEXT VAR formname;TEXT VAR id;FOR i +FROM 1UPTO 100REP formname[i]:="";PER ;#TEXT PROC formtextname:cformtextname+ +text(getformularindex)ENDPROC formtextname;#TEXT PROC formdataname: +cformdataname+text(getformularindex)ENDPROC formdataname;TEXT PROC +formtextname(TEXT CONST formnr):cformtextname+formnrENDPROC formtextname; +TEXT PROC formdataname(TEXT CONST formnr):cformdataname+formnrENDPROC +formdataname;TEXT PROC searchid:INT VAR count;TEXT VAR returntext;formtext:= +ds;returntext:=formtext;IF ordercode=delcodenameOR ordercode=existscodename +OR ordercode=getdatacodenameTHEN searchheaderELSE returntextFI .searchheader: +FOR countFROM 1UPTO 100REP IF formname[count]=formtextTHEN LEAVE searchid +WITH text(count);FI ;PER ;noform.ENDPROC searchid;PROC server:SELECT +ordercodeOF CASE putdatacode:writeformdataCASE puttextcode:writeformtextCASE +getdatacodeno,getdatacodename:readformdataCASE gettextcodeno,gettextcodename: +readformtextCASE delcodeno,delcodename:deleteformCASE existscodename, +existscodeno:existsformOTHERWISE :errorstop("Unbekannter Auftrag")ENDSELECT +;eventuellfehlerbehandlung;send(ordertask,ordercode,ds). +eventuellfehlerbehandlung:IF iserrorTHEN ordercode:=errornak;errortext:=ds; +errortext:=errormessage;clearerrorFI .writeformdata:putformular(ds);#form:=ds +;#id:=text(getformularindex);i:=getformularindex;formname[i]:=getformularname +;forget(formdataname,quiet);copy(ds,formdataname);forget(ds);ds:=nilspace; +ordercode:=ok.writeformtext:#form:=ds;#id:=text(type(ds));forget(formtextname +(id),quiet);type(ds,1003);copy(ds,formtextname(id));forget(ds);ordercode:=ok; +ds:=nilspace.readformdata:id:=searchid;IF id=noformTHEN ordercode:=notfound; +LEAVE readformdataFI ;forget(ds);IF exists(formdataname(id))THEN ordercode:= +ok;ds:=old(formdataname(id));ELSE ds:=nilspace;ordercode:=notfoundFI . +readformtext:id:=searchid;IF id=noformTHEN ordercode:=notfound;LEAVE +readformtextFI ;forget(ds);IF exists(formtextname(id))THEN ordercode:=ok;ds:= +old(formtextname(id));ELSE ordercode:=notfound;ds:=nilspaceFI .ENDPROC server +;PROC deleteform:id:=searchid;ordercode:=ok;IF id=noformTHEN LEAVE deleteform +FI ;forget(formtextname(id),quiet);forget(formdataname(id),quiet);forget(ds); +ds:=nilspace;ENDPROC deleteform;PROC existsform:id:=searchid;IF id=noform +THEN ordercode:=notfoundELSE IF exists(formtextname(id))CAND exists( +formdataname(id))THEN ordercode:=okELSE ordercode:=notfoundFI FI ;ENDPROC +existsform;PROC idaserver:globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT +CONST ,TASK CONST )idaserver)ENDPROC idaserver;PROC idaserver(DATASPACE VAR +dsp,INT CONST orderp,phasep,TASK CONST ordertaskp):IF orderp>=continuecode +AND ordertaskp=supervisorTHEN forget(dsp);spoolcommand(orderp)ELSE clearerror +;enablestop;forget(ds);ds:=dsp;ordercode:=orderp;ordertask:=ordertaskp;server +FI ENDPROC idaserver;PROC spoolcommand(INT CONST order):TEXT VAR commandline +:="";enablestop;break(quiet);continue(order-continuecode);disablestop;REP +commanddialogue(TRUE );getcommand("ISP-IDA-MANAGER:",commandline);do( +commandline)UNTIL NOT onlinePER ;commanddialogue(FALSE );break(quiet); +setautonomEND PROC spoolcommand;ENDPACKET idaserver; + diff --git a/app/schulis/2.2.1/src/0.klassengruppen definieren b/app/schulis/2.2.1/src/0.klassengruppen definieren new file mode 100644 index 0000000..0765de9 --- /dev/null +++ b/app/schulis/2.2.1/src/0.klassengruppen definieren @@ -0,0 +1,81 @@ +PACKET erfklassengruppenDEFINES erfassungklassengruppen:LET maskenname= +"ms erf klassengruppen",fnrkennung=2,fnrletztesfeld=32,trenner=" = ", +maxsugruppen=15,laengejgst=2,laengezug=4,laengeeinersugruppe=6, +laengeklassengruppe=4,felderprozeile=2;INT VAR fnrjgst;TEXT VAR sugruppen:="" +;TEXT VAR sugruppe:="";INT VAR anzsugruppen;TEXT VAR gueltigeschuelergruppen +:="";LET postrenner="�";LET fuehrendenull="0",jgst5=5,jgst10=10,jgst13=13; +LET meldnrfehlendeangabe=52,meldnrungueltigesugruppe=55, +meldnrklassengruppezulang=60,meldnrungueltigegruppenbez=86;LET wertaktuell= +"aktuell",wertgeplant="geplant";PROC erfassungklassengruppen(INT CONST proznr +):systemdboff;reinitparsing;SELECT proznrOF CASE 1:setzeerfassungsparameter +CASE 2:zeigeklassengruppezurbearbeitungCASE 3:pruefeplausibilitaetCASE 4: +setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6: +klassengruppenlesenCASE 7:klassengruppenaendernCASE 8:klassengruppeneinfuegen +CASE 9:klassengruppenloeschenEND SELECT END PROC erfassungklassengruppen; +PROC setzeerfassungsparameter:gueltigeschuelergruppen:=""; +setzeerfassungsparameter(dnrklassengruppen,maskenname,fnrletztesfeld)END +PROC setzeerfassungsparameter;PROC zeigeklassengruppezurbearbeitung: +setzeerfassungsfeld(wert(fnrkgklassengrp),fnrkennung);sugruppen:=wert( +fnrkgschuelergrp);anzsugruppen:=(length(sugruppen))DIV laengeeinersugruppe; +INT VAR i:=1;fnrjgst:=fnrkennung+1;WHILE i<=anzsugruppenREP sugruppe:=subtext +(sugruppen,1,laengeeinersugruppe);sugruppen:=subtext(sugruppen, +laengeeinersugruppe+1);setzeerfassungsfeld(subtext(sugruppe,1,laengejgst), +fnrjgst);setzeerfassungsfeld(compress(subtext(sugruppe,laengejgst+1)),fnrjgst ++1);fnrjgstINCR felderprozeile;iINCR 1PER ;WHILE i<=maxsugruppenREP +setzeerfassungsfeld("",fnrjgst);setzeerfassungsfeld("",fnrjgst+1);fnrjgst +INCR felderprozeile;iINCR 1PER ;END PROC zeigeklassengruppezurbearbeitung; +PROC pruefeplausibilitaet:LET leer="",null=0;INT VAR pruefbez;IF +gueltigeschuelergruppen=""THEN +holeallegeplundaktschuelergruppeningueltigesugruppenFI ;INT VAR fehlerstatus; +pruefe(1,erfassungsmaske,PROC erfassungswert,fnrkennung,null,null,leer, +fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);LEAVE +pruefeplausibilitaetELIF length(erfassungswert(fnrkennung))> +laengeklassengruppeTHEN meldeauffaellig(erfassungsmaske, +meldnrklassengruppezulang);setzefehlerstatus(fnrkennung);LEAVE +pruefeplausibilitaetELSE pruefbez:=int(erfassungswert(fnrkennung));IF +lastconversionokTHEN IF pruefbez>=jgst5CAND pruefbez<=jgst13THEN +meldeauffaellig(erfassungsmaske,meldnrungueltigegruppenbez);setzefehlerstatus +(fnrkennung);LEAVE pruefeplausibilitaetFI FI FI ;INT VAR i;fnrjgst:= +fnrkennung+1;FOR iFROM 1UPTO maxsugruppenREP IF erfassungswert(fnrjgst)<>"" +THEN pruefe(3,erfassungsmaske,PROC erfassungswert,fnrjgst,jgst5,jgst13,leer, +fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);LEAVE +pruefeplausibilitaetELIF kennungangegebenCAND ungueltigeschuelergruppenangabe +THEN setzefehlerstatus(fnrjgst);meldeauffaellig(erfassungsmaske, +meldnrungueltigesugruppe);LEAVE pruefeplausibilitaetFI ;ELIF kennungangegeben +THEN setzefehlerstatus(fnrjgst);meldeauffaellig(erfassungsmaske, +meldnrfehlendeangabe);LEAVE pruefeplausibilitaetFI ;fnrjgstINCR +felderprozeilePER .kennungangegeben:erfassungswert(fnrjgst+1)<>"". +ungueltigeschuelergruppenangabe:pos(gueltigeschuelergruppen,suchwert)=0. +suchwert:postrenner+text(int(erfassungswert(fnrjgst)))+compress( +erfassungswert(fnrjgst+1))+postrenner.END PROC pruefeplausibilitaet;PROC +holeallegeplundaktschuelergruppeningueltigesugruppen:gueltigeschuelergruppen +:=postrenner;statleseschleife(dnraktschuelergruppen,"","",fnrsgrpsj,fnrsgrpsj +,PROC sugruppelesen);END PROC +holeallegeplundaktschuelergruppeningueltigesugruppen;PROC sugruppelesen(BOOL +VAR b):IF dbstatus<>0THEN b:=TRUE ELSE gueltigeschuelergruppenCAT wert( +fnrsgrpjgst)+wert(fnrsgrpkennung)+postrennerFI END PROC sugruppelesen;PROC +setzewertefuerdbspeicherung:putwert(fnrkgklassengrp,erfassungswert(fnrkennung +));sugruppen:="";INT VAR i;fnrjgst:=fnrkennung+1;FOR iFROM 1UPTO maxsugruppen +REP sugruppe:=erfassungswert(fnrjgst);IF sugruppe<>""THEN sugruppenCAT +jgstangabe;sugruppenCAT text(erfassungswert(fnrjgst+1),laengezug)FI ;fnrjgst +INCR felderprozeilePER ;putwert(fnrkgschuelergrp,sugruppen).jgstangabe:INT +VAR ijgst:=int(sugruppe);IF ijgst>=jgst10CAND ijgst<=jgst13THEN sugruppeELSE +fuehrendenull+text(ijgst,1)FI .END PROC setzewertefuerdbspeicherung;PROC +setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR +identizeile;identizeile:=wert(fnrkgklassengrp)+trenner+wert(fnrkgschuelergrp) +;setzeidentiwert(identizeilemitschluesselanhang). +identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+wert( +fnrkgklassengrp).END PROC setzeidentiobjektfuerobjektliste;PROC +klassengruppenlesen:putwert(fnrkgklassengrp,schluessel);search( +dnrklassengruppen,TRUE );IF dbstatus=okTHEN saveupdateposition( +dnrklassengruppen)FI END PROC klassengruppenlesen;PROC klassengruppenaendern: +restoreupdateposition(dnrklassengruppen);update(dnrklassengruppen); +aenderungsvermerksetzen(wertaktuell);aenderungsvermerksetzen(wertgeplant)END +PROC klassengruppenaendern;PROC klassengruppeneinfuegen:insert( +dnrklassengruppen);aenderungsvermerksetzen(wertaktuell); +aenderungsvermerksetzen(wertgeplant)END PROC klassengruppeneinfuegen;PROC +klassengruppenloeschen:delete(dnrklassengruppen);aenderungsvermerksetzen( +wertaktuell);aenderungsvermerksetzen(wertgeplant)END PROC +klassengruppenloeschen;TEXT PROC schluessel:erfassungswert(fnrkennung)END +PROC schluessel;END PACKET erfklassengruppen; + diff --git a/app/schulis/2.2.1/src/0.kurswahlbasis bereinigen b/app/schulis/2.2.1/src/0.kurswahlbasis bereinigen new file mode 100644 index 0000000..8be6d56 --- /dev/null +++ b/app/schulis/2.2.1/src/0.kurswahlbasis bereinigen @@ -0,0 +1,34 @@ +PACKET kurswahlbasisbereinigenDEFINES kurswahlserveraktualisieren, +kurswahlserverlvaktualisieren:LET server="kurswahl server",jg9=9,jg14=14,hj1= +"1",hj2="2",dbsj="Schuljahr",dbhj="Schulhalbjahr",kurswahl="Kurswahl-",kw2= +"2 ",kw0="0 ";INT VAR sj1,sj2,sj3,sj4,akthj;TEXT VAR schuljahr,halbjahr;TASK +VAR takuser;PROC kurswahlserveraktualisieren(TEXT CONST jgst,spezjgst,spezhj) +:serveraktualisieren(kw2,jgst,spezjgst,spezhj)END PROC +kurswahlserveraktualisieren;PROC kurswahlserverlvaktualisieren(TEXT CONST +jgst,spezjgst,spezhj):serveraktualisieren(kw0,jgst,spezjgst,spezhj)END PROC +kurswahlserverlvaktualisieren;PROC serveraktualisieren(TEXT CONST ds,jgst, +spezjgst,spezhj):INT VAR jg:=int(jgst),spezjg:=int(spezjgst),jgdiff;IF +existstask(server)THEN takuser:=task(server);schuljahr:=schulkenndatum(dbsj); +halbjahr:=schulkenndatum(dbhj);sj1:=int(schuljahr);sj2:=sj1+101;sj3:=sj2+101; +sj4:=sj3+101;IF jg>jg9CAND jgjg9CAND spezjg=halbjahrTHEN erase(datenraumname( +spezjg,ds,spezhj,schuljahr),takuser)ELIF jgdiff=1THEN erase(datenraumname( +spezjg,ds,spezhj,konvsj(sj2)),takuser)ELIF jgdiff=2THEN erase(datenraumname( +spezjg,ds,spezhj,konvsj(sj3)),takuser)ELIF jgdiff=3THEN erase(datenraumname( +spezjg,ds,spezhj,konvsj(sj4)),takuser)FI FI .END PROC serveraktualisieren; +TEXT PROC datenraumname(INT CONST jgst,TEXT CONST dsp,halbjahr,schuljahr): +TEXT VAR name:=kurswahl;nameCAT dsp;nameCAT text(jgst);nameCAT " ";nameCAT +halbjahr;nameCAT ".";nameCAT schuljahr;nameEND PROC datenraumname;TEXT PROC +konvsj(INT CONST sjbez):IF sjbez<9901THEN text(sjbez)ELSE subtext(text(sjbez) +,2)FI END PROC konvsj;END PACKET kurswahlbasisbereinigen; + diff --git a/app/schulis/2.2.1/src/0.liste der aufsichtszeiten b/app/schulis/2.2.1/src/0.liste der aufsichtszeiten new file mode 100644 index 0000000..c0138c4 --- /dev/null +++ b/app/schulis/2.2.1/src/0.liste der aufsichtszeiten @@ -0,0 +1,93 @@ +PACKET listederaufsichtszeitenDEFINES +aufsichtszeitenlisteerstellenunddruckenggfvorherzeigen:LET fnrausggeplanteshj +=2,fnrausgaktuelleshj=3,fnrausgdrucker=4,fnrausgbild=5;LET +schluesselschuljahr="Schuljahr",schluesselschulhalbjahr="Schulhalbjahr";LET +zusätzlicherlaubtetasten="vr";LET meldunglistewirdaufgebaut=7, +meldunglistewirdausgedruckt=58,meldungbittewarten=69, +meldungkeinedatenvorhanden=68;LET dateinamezumzeigen= +"Liste der Aufsichtszeiten",ueberschrift1fuerdruckdatei= +"Liste der Aufsichtszeiten",ueberschrift2fuerdruckdatei= +"-------------------------",textanfangfuerschulhalbjahr="für Schuljahr ", +trennerfuerschuljahr="/",textmittefuerschulhalbjahr=", ", +textendefuerschulhalbjahr=". Halbjahr",ueberschrift1dertabelle= +" Tag Nr. Bezeichnung Stunde Uhrzeit", +ueberschrift2dertabelle= +" vorher nachher von bis", +trennstrichdertabelle= +"--------+----------------------+-----------------+-----------------", +stelligkeitdestages=100,füllervorbezeichnung=". ",bezeichnungslänge=20, +füllervorstunde=" ",stundenprowochentag=12,leerestunde=" ",füllerinstunde= +". ",füllervoruhrzeit=". ",blankszumauffüllen=" ",stellenfürzeit +=4,füllerinuhrzeit=" ",stdundmintrenner=":",laengederstundenzeit=2, +blanksvorwochentag=" ",leererwochentag=" ",textmontag="Mo",textdienstag= +"Di",textmittwoch="Mi",textdonnerstag="Do",textfreitag="Fr",textsamstag="Sa", +nummerfürsa=6;LET niltext="",blank=" ";BOOL VAR erstaufbildschirm:=FALSE ; +TEXT VAR schuljahr:=niltext,halbjahr:=niltext;INT VAR fehlerstatus;FILE VAR f +;INT VAR akttag;PROC aufsichtszeitenlisteerstellenunddruckenggfvorherzeigen( +INT CONST nr):SELECT nrOF CASE 1:aufsichtszeitenlisteerstellenCASE 2: +aufsichtszeitenlistedruckenENDSELECT .END PROC +aufsichtszeitenlisteerstellenunddruckenggfvorherzeigen;PROC +aufsichtszeitenlisteerstellen:INT VAR i;prüfeobrichtigangekreuztist;IF +fehlerstatus<>0THEN infeld(fehlerstatus);return(1);LEAVE +aufsichtszeitenlisteerstellenFI ;erstaufbildschirm:=standardmaskenfeld( +fnrausgbild)<>niltext;IF erstaufbildschirmTHEN standardmeldung( +meldunglistewirdaufgebaut,niltext)ELSE standardmeldung(meldungbittewarten, +niltext)FI ;berechnebearbeitungsschuljahrundhalbjahr; +fuellediedateimitdenaufsichtszeiten;IF akttag=0THEN standardmeldung( +meldungkeinedatenvorhanden,niltext);forget(dateinamezumzeigen,quiet);return(1 +);LEAVE aufsichtszeitenlisteerstellenFI ;IF erstaufbildschirmTHEN zeigedatei( +dateinamezumzeigen,zusätzlicherlaubtetasten)ELSE standardmeldung( +meldunglistewirdausgedruckt,niltext);aufsichtszeitenlistedruckenFI . +prüfeobrichtigangekreuztist:standardpruefe(5,fnrausggeplanteshj, +fnrausgaktuelleshj,0,niltext,fehlerstatus);IF fehlerstatus=0THEN +standardpruefe(5,fnrausgdrucker,fnrausgbild,0,niltext,fehlerstatus);FI . +fuellediedateimitdenaufsichtszeiten:f:=sequentialfile(output, +dateinamezumzeigen);putline(f,blank);putline(f,zentriert( +textanfangfuerschulhalbjahr+text(schuljahr,2)+trennerfuerschuljahr+subtext( +schuljahr,3)+textmittefuerschulhalbjahr+halbjahr+textendefuerschulhalbjahr, +bildbreite));putline(f,blank);putline(f,blank);putline(f, +ueberschrift1dertabelle+blank);putline(f,ueberschrift2dertabelle+blank); +putline(f,trennstrichdertabelle+blank);akttag:=0;inittupel(dnraufsichtszeiten +);statleseschleife(dnraufsichtszeiten,schuljahr,halbjahr,fnrazsj,fnrazhj, +PROC fuellediedatei);FOR iFROM akttag+1UPTO nummerfürsaREP putline(f,blank); +putline(f,wochentag(i));PER ;.berechnebearbeitungsschuljahrundhalbjahr: +schuljahr:=schulkenndatum(schluesselschuljahr);halbjahr:=schulkenndatum( +schluesselschulhalbjahr);IF standardmaskenfeld(fnrausgaktuelleshj)=niltext +THEN geplanteshjundsjberechnen(halbjahr,schuljahr)FI .END PROC +aufsichtszeitenlisteerstellen;PROC aufsichtszeitenlistedrucken:INT VAR +zeilenzähler;TEXT VAR t;FILE VAR f1:=sequentialfile(input,dateinamezumzeigen) +;initdruckkopf(zentriert(ueberschrift1fuerdruckdatei,druckbreite),zentriert( +ueberschrift2fuerdruckdatei,druckbreite));setzemitseitennummern(TRUE ); +druckvorbereiten;druckkopfschreiben;getline(f1,t);druckzeileschreiben(t); +getline(f1,t);druckzeileschreiben(zentriert(compress(t),druckbreite)); +zeilenzähler:=drucklaenge(2)-2;WHILE NOT eof(f1)REP IF zeilenzähler=0THEN +seitenwechsel;druckkopfschreiben;druckzeileschreiben(ueberschrift1dertabelle) +;druckzeileschreiben(ueberschrift2dertabelle);druckzeileschreiben( +trennstrichdertabelle);zeilenzähler:=drucklaenge(2)-3;FI ;getline(f1,t); +druckzeileschreiben(t);zeilenzählerDECR 1;PER ;drucknachbereiten;forget( +dateinamezumzeigen,quiet);IF erstaufbildschirmTHEN enter(2)ELSE enter(1)FI +END PROC aufsichtszeitenlistedrucken;TEXT PROC wochentag(INT CONST tag):TEXT +VAR t;SELECT tagOF CASE 1:t:=blanksvorwochentag+textmontag+blankCASE 2:t:= +blanksvorwochentag+textdienstag+blankCASE 3:t:=blanksvorwochentag+ +textmittwoch+blankCASE 4:t:=blanksvorwochentag+textdonnerstag+blankCASE 5:t:= +blanksvorwochentag+textfreitag+blankCASE 6:t:=blanksvorwochentag+textsamstag+ +blankEND SELECT ;tEND PROC wochentag;PROC fuellediedatei(BOOL VAR b):INT VAR +i,neuertag;TEXT VAR t,t2;IF wert(fnrazsj)>schuljahrCOR wert(fnrazhj)>halbjahr +COR dbstatus<>okTHEN b:=TRUE ELSE neuertag:=intwert(fnrazaufsichtszeit)DIV +stelligkeitdestages;IF neuertag>akttagTHEN putline(f,blank);FOR iFROM akttag+ +1UPTO neuertag-1REP putline(f,wochentag(i));putline(f,blank);PER ;t:= +wochentag(neuertag);akttag:=neuertag;ELSE t:=leererwochentagFI ;tCAT text( +intwert(fnrazaufsichtszeit)MOD stelligkeitdestages,2);tCAT +füllervorbezeichnung;tCAT text(wert(fnrazbezeichnung),bezeichnungslänge);t +CAT füllervorstunde;IF intwert(fnraztagstdvor)=0THEN tCAT leerestundeELSE i:= +(intwert(fnraztagstdvor)-1)MOD stundenprowochentag+1;tCAT text(i,2);FI ;tCAT +füllerinstunde;IF intwert(fnraztagstdnach)=0THEN tCAT leerestundeELSE i:=( +intwert(fnraztagstdnach)-1)MOD stundenprowochentag+1;tCAT text(i,2);FI ;tCAT +füllervoruhrzeit;t2:=blankszumauffüllen+wert(fnrazbeginnuhr);t2:=subtext(t2, +length(t2)+1-stellenfürzeit);tCAT text(t2,laengederstundenzeit);tCAT +stdundmintrenner;tCAT subtext(t2,laengederstundenzeit+1);tCAT füllerinuhrzeit +;t2:=blankszumauffüllen+wert(fnrazendeuhr);t2:=subtext(t2,length(t2)+1- +stellenfürzeit);tCAT text(t2,laengederstundenzeit);tCAT stdundmintrenner;t +CAT subtext(t2,laengederstundenzeit+1);tCAT blank;putline(f,t);FI END PROC +fuellediedatei;END PACKET listederaufsichtszeiten + diff --git a/app/schulis/2.2.1/src/0.liste der zeitrasterdaten b/app/schulis/2.2.1/src/0.liste der zeitrasterdaten new file mode 100644 index 0000000..51e91c9 --- /dev/null +++ b/app/schulis/2.2.1/src/0.liste der zeitrasterdaten @@ -0,0 +1,101 @@ +PACKET listederzeitrasterdatenDEFINES +zeitrasterlisteerstellenunddruckenggfvorherzeigen:LET fnrausggeplanteshj=2, +fnrausgaktuelleshj=3,fnrausgdrucker=4,fnrausgbild=5;LET schluesselschuljahr= +"Schuljahr",schluesselschulhalbjahr="Schulhalbjahr", +anzahldatensaetzeprozeitraster=66;LET zusätzlicherlaubtetasten="vr";LET +meldunglistewirdaufgebaut=7,meldunglistewirdausgedruckt=58,meldungbittewarten +=69,meldungkeinedatenvorhanden=68;LET dateinamezumzeigen= +"Liste der Zeitrasterdaten",ueberschrift1fuerdruckdatei= +"Liste der Zeitrasterdaten",ueberschrift2fuerdruckdatei= +"-------------------------",blankszumauffuellen=" ", +textanfangfuerschulhalbjahr="für Schuljahr 19",trennerfuerschuljahr="/", +textmittefuerschulhalbjahr=", ",textendefuerschulhalbjahr=". Halbjahr", +ueberschriftdererstentabelle="Uhrzeiten:",unterschriftdererstentabelle= +"----------",zeilederwochentage= +" Mo Di Mi Do Fr Sa",textvorbeginnzeiten= +". von",textvorendezeiten=" bis",trennerdererstentabelle=" ", +stdundmintrenner=":",laengederstundenzeit=2,stellenderstundennummer=2, +zeilenzahldererstentabelle=45,ueberschriftderzweitentabelle= +"Kennzeichnung der Tagesteile:",unterschriftderzweitentabelle= +"-----------------------------",zeilederstunden= +" 1. 2. 3. 4. 5. 6. 7. 8. 9. 10. 11. 12.",textmontag="Mo", +textdienstag="Di",textmittwoch="Mi",textdonnerstag="Do",textfreitag="Fr", +textsamstag="Sa",trennerderzweitentabelle=" ",stundenamsamstag=6, +stundenprowochentag=12,mobissa=6,mobisfr=5,poskennungtagesteil=1, +anfposbeginnzeit=2,endeposbeginnzeit=5,anfposendezeit=6,endeposendezeit=9, +gesamtetextlaenge=9,stellenfuerkennungtagesteil=1,stellenfuerzeit=4;LET +niltext="",blank=" ",null=0,eins=1;BOOL VAR erstaufbildschirm:=FALSE ;TEXT +VAR schuljahr:=niltext,halbjahr:=niltext;INT VAR fehlerstatus;ROW +anzahldatensaetzeprozeitrasterTEXT VAR alteszeitraster;INT VAR aktindex;PROC +zeitrasterlisteerstellenunddruckenggfvorherzeigen(INT CONST nr):SELECT nrOF +CASE 1:zeitrasterlisteerstellenCASE 2:zeitrasterlistedruckenENDSELECT .END +PROC zeitrasterlisteerstellenunddruckenggfvorherzeigen;PROC +zeitrasterlisteerstellen:INT VAR i;prüfeobrichtigangekreuztist;IF +fehlerstatus<>nullTHEN infeld(fehlerstatus);return(1);LEAVE +zeitrasterlisteerstellenFI ;erstaufbildschirm:=standardmaskenfeld(fnrausgbild +)<>niltext;IF erstaufbildschirmTHEN standardmeldung(meldunglistewirdaufgebaut +,niltext)ELSE standardmeldung(meldungbittewarten,niltext)FI ; +berechnebearbeitungsschuljahrundhalbjahr;fuelledenpuffermitdemzeitraster;IF +aktindex=nullTHEN standardmeldung(meldungkeinedatenvorhanden,niltext);return( +1);LEAVE zeitrasterlisteerstellenFI ;fuegeerstetabelleindateian; +fuegezweitetabelleindateian;IF erstaufbildschirmTHEN zeigedatei( +dateinamezumzeigen,zusätzlicherlaubtetasten)ELSE standardmeldung( +meldunglistewirdausgedruckt,niltext);zeitrasterlistedruckenFI . +prüfeobrichtigangekreuztist:standardpruefe(5,fnrausggeplanteshj, +fnrausgaktuelleshj,null,niltext,fehlerstatus);IF fehlerstatus=nullTHEN +standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,fehlerstatus);FI . +fuelledenpuffermitdemzeitraster:aktindex:=null;inittupel(dnrzeitraster); +statleseschleife(dnrzeitraster,schuljahr,halbjahr,fnrzrsj,fnrzrhj,PROC +fuellenurpuffer);FOR iFROM aktindex+einsUPTO anzahldatensaetzeprozeitraster +REP alteszeitraster(i):=gesamtetextlaenge*blankPER . +berechnebearbeitungsschuljahrundhalbjahr:schuljahr:=schulkenndatum( +schluesselschuljahr);halbjahr:=schulkenndatum(schluesselschulhalbjahr);IF +standardmaskenfeld(fnrausgaktuelleshj)=niltextTHEN geplanteshjundsjberechnen( +halbjahr,schuljahr)FI .END PROC zeitrasterlisteerstellen;PROC +zeitrasterlistedrucken:INT VAR i;TEXT VAR t;FILE VAR f1:=sequentialfile(input +,dateinamezumzeigen);initdruckkopf(zentriert(ueberschrift1fuerdruckdatei, +druckbreite),zentriert(ueberschrift2fuerdruckdatei,druckbreite)); +setzemitseitennummern(TRUE );druckvorbereiten;druckkopfschreiben;getline(f1,t +);druckzeileschreiben(t);getline(f1,t);druckzeileschreiben(zentriert(compress +(t),druckbreite));FOR iFROM einsUPTO zeilenzahldererstentabelleREP getline(f1 +,t);druckzeileschreiben(t)PER ;seitenwechsel;druckkopfschreiben;WHILE NOT eof +(f1)REP getline(f1,t);druckzeileschreiben(t)PER ;drucknachbereiten;forget( +dateinamezumzeigen,quiet);IF erstaufbildschirmTHEN enter(2)ELSE enter(1)FI +END PROC zeitrasterlistedrucken;PROC fuegeerstetabelleindateian:INT VAR i,j,k +;TEXT VAR t1,t2,t3;FILE VAR f:=sequentialfile(output,dateinamezumzeigen); +putline(f,blank);putline(f,zentriert(textanfangfuerschulhalbjahr+text( +schuljahr,2)+trennerfuerschuljahr+subtext(schuljahr,3)+ +textmittefuerschulhalbjahr+halbjahr+textendefuerschulhalbjahr,bildbreite)); +putline(f,blank);putline(f,blank);putline(f,ueberschriftdererstentabelle+ +blank);putline(f,unterschriftdererstentabelle+blank);putline(f,blank);putline +(f,zeilederwochentage+blank);FOR iFROM einsUPTO stundenprowochentagREP +putline(f,blank);t1:=text(i,stellenderstundennummer)+textvorbeginnzeiten;t2:= +textvorendezeiten;IF i>stundenamsamstagTHEN k:=mobisfrELSE k:=mobissaFI ;FOR +jFROM einsUPTO kREP t1CAT trennerdererstentabelle;t2CAT +trennerdererstentabelle;t3:=subtext(alteszeitraster(i+(j-eins)* +stundenprowochentag),anfposbeginnzeit,endeposbeginnzeit);t1CAT text(t3, +laengederstundenzeit)+stdundmintrenner+subtext(t3,laengederstundenzeit+1);t3 +:=subtext(alteszeitraster(i+(j-eins)*stundenprowochentag),anfposendezeit, +endeposendezeit);t2CAT text(t3,laengederstundenzeit)+stdundmintrenner+subtext +(t3,laengederstundenzeit+1);PER ;putline(f,t1+blank);putline(f,t2+blank);PER +;putline(f,blank);putline(f,blank);putline(f,blank)END PROC +fuegeerstetabelleindateian;PROC fuegezweitetabelleindateian:INT VAR i,j,k; +TEXT VAR t1;FILE VAR f:=sequentialfile(output,dateinamezumzeigen);putline(f, +blank);putline(f,ueberschriftderzweitentabelle+blank);putline(f, +unterschriftderzweitentabelle+blank);putline(f,blank);putline(f, +zeilederstunden+blank);putline(f,blank);FOR iFROM einsUPTO mobissaREP SELECT +iOF CASE 1:t1:=textmontagCASE 2:t1:=textdienstagCASE 3:t1:=textmittwochCASE 4 +:t1:=textdonnerstagCASE 5:t1:=textfreitagCASE 6:t1:=textsamstagEND SELECT ; +IF i=mobissaTHEN k:=stundenamsamstagELSE k:=stundenprowochentagFI ;FOR jFROM +einsUPTO kREP t1CAT trennerderzweitentabelle+text(alteszeitraster((i-eins)* +stundenprowochentag+j),poskennungtagesteil);PER ;putline(f,t1+blank);PER END +PROC fuegezweitetabelleindateian;PROC fuellenurpuffer(BOOL VAR b):TEXT VAR t; +IF wert(fnrzrsj)>schuljahrCOR wert(fnrzrhj)>halbjahrCOR dbstatus<>okTHEN b:= +TRUE ELSE aktindexINCR eins;t:=blankszumauffuellen+wert(fnrzrkennungteil); +alteszeitraster(aktindex):=subtext(t,length(t)+eins- +stellenfuerkennungtagesteil);t:=blankszumauffuellen+wert(fnrzrbeginnuhr); +alteszeitraster(aktindex)CAT subtext(t,length(t)+eins-stellenfuerzeit);t:= +blankszumauffuellen+wert(fnrzrendeuhr);alteszeitraster(aktindex)CAT subtext(t +,length(t)+eins-stellenfuerzeit)FI END PROC fuellenurpuffer;END PACKET +listederzeitrasterdaten + diff --git a/app/schulis/2.2.1/src/0.listen.benutz b/app/schulis/2.2.1/src/0.listen.benutz new file mode 100644 index 0000000..cabeae1 --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.benutz @@ -0,0 +1,84 @@ +PACKET benutzerlisteDEFINES benulispezielleteile:LET niltext="",blank=" ", +null=0,slash="/",spaltentrenner=" ",ueberschriftenzeilen=1,anzspalten=6, +dateiname="sortdatei",ausgfeldlaenge=9,spaltenbreite=11,AUSGFELD =ROW +ausgfeldlaengeTEXT ,benulieingangsmaske="mu liste einfach eingang", +benulianfpos=2,mnrbearbeitetwerden=104;#LET dnrbenutz=7,fnrbenutzname=9, +fnrbenutzberecht=11;#INT VAR druckzeilenzahl,bildanf,eingabestatus, +aktuelleindexnr,ausgfeldlaengereal;TEXT VAR benuliueberschrift,kennung, +berechtigungen,bearbeitetwerden,startwert,anfbuchstabe,neueranfbuchstabe; +AUSGFELD VAR ausgfeld;BOOL PROC multistop:TRUE END PROC multistop;PROC +benulispezielleteile(INT CONST nr):SELECT nrOF CASE 1:benulidialogvorbereiten +CASE 2:benulieingabenrichtigCASE 3:benulilistenvorbereitenCASE 4: +benulidruckvorbereitenCASE 5:benuliseitedruckenCASE 6: +benulibildschirmvorbereitenCASE 7:benuliseitezeigenENDSELECT .END PROC +benulispezielleteile;PROC benulidialogvorbereiten:systemdbon;#first(dnrbenutz +);startwert:=wert(fnrbenutzname);#benuliueberschrift:=text(vergleichsknoten); +setzeanfangswerte(benulieingangsmaske,benulianfpos).END PROC +benulidialogvorbereiten;PROC benulieingabenrichtig:LET fnrausgdrucker=2, +fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext); +setzeeingabetest(TRUE )FI .END PROC benulieingabenrichtig;PROC +benulilistenvorbereiten:INT VAR i;BOOL VAR b:=FALSE ;initspalten;FOR iFROM 1 +UPTO anzspaltenREP setzespaltenbreite(spaltenbreite)PER ;setzespaltentrenner( +spaltentrenner);aktuelleindexnr:=dnrbenutz;inittupel(dnrbenutz); +setzeidentiwert("");initobli(2);objektlistestarten(aktuelleindexnr,"", +fnrbenutzname,FALSE ,b);setzebestandende(NOT multistop)END PROC +benulilistenvorbereiten;PROC benulibildschirmvorbereiten:LET fnrausganf=2; +standardkopfmaskeaktualisieren(benuliueberschrift);bildanf:=fnrausganf; +setzebildanfangsposition(bildanf).END PROC benulibildschirmvorbereiten;PROC +benuliseitezeigen:blaettern(PROC (INT CONST )benutzerzeigen,aktion,FALSE , +FALSE ,BOOL PROC multistop);END PROC benuliseitezeigen;PROC benutzerzeigen( +INT CONST x):benutzerholen;benutzeraufbereitenbild;benutzeraufbildschirm.END +PROC benutzerzeigen;PROC benutzeraufbereitenbild:INT VAR i; +benutzeraufbereitenallgemein(bildbreite);restbehandlungbild. +restbehandlungbild:FOR iFROM ausgfeldlaengereal+1UPTO ausgfeldlaengeREP +ausgfeld(i):=text(blank,bildbreite)PER .END PROC benutzeraufbereitenbild; +PROC benutzeraufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsEND REP .END PROC +benutzeraufbildschirm;PROC benulidruckvorbereiten:anfbuchstabe:=niltext; +druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(zentriert( +benuliueberschrift,druckbreite));holemeldung;systemdbon;inittupel(dnrbenutz); +setzebestandende(NOT multistop);lesenvorbereitendruck(PROC (INT CONST ,BOOL +PROC ,INT VAR )scanforward,BOOL PROC multistop).holemeldung:meldungstext( +mnrbearbeitetwerden,bearbeitetwerden).variablenfuerdrucksetzen: +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen).END PROC +benulidruckvorbereiten;PROC benuliseitedrucken:benuliueberschriftdrucken; +seitedrucken(PROC (INT VAR )benutzerdrucken,druckzeilenzahl,ausgfeldlaenge, +BOOL PROC multistop);seitenwechsel.END PROC benuliseitedrucken;PROC +benuliueberschriftdrucken:druckkopfschreiben.END PROC +benuliueberschriftdrucken;PROC benutzerdrucken(INT VAR zeilenzaehler):LET +markiert="#";benutzerholen;ggflmeldunganfbuchstabe;benutzeraufbereitendruck; +zeilenzaehlerINCR ausgfeldlaengereal;benutzerindruckdatei. +ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN meldunganfbuchstabeFI . +anfbuchstabegeaendert:neueranfbuchstabe:=kennungSUB 1;anfbuchstabe<> +neueranfbuchstabe.meldunganfbuchstabe:standardmeldung(bearbeitetwerden, +neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC +benutzerdrucken;PROC benutzeraufbereitendruck:benutzeraufbereitenallgemein( +druckbreite).END PROC benutzeraufbereitendruck;PROC benutzerindruckdatei:INT +VAR i;FOR iFROM 1UPTO ausgfeldlaengerealREP druckzeileschreiben(ausgfeld(i)) +PER .END PROC benutzerindruckdatei;PROC benutzeraufbereitenallgemein(INT +CONST breite):INT VAR position,anzahlberechtigungen,anzzeilenreal,i,j,k;FILE +VAR f;TEXT VAR berechtigung;kennungaufbereiten;berechtigungenaufbereiten. +kennungaufbereiten:ausgfeld(1):=text(kennung,breite). +berechtigungenaufbereiten:erstenslashimtextueberlesen; +berechtigungenindateiundsortieren;wirklichezeilenzahlberechnen; +ausgabefelderberechtigungenauffuellen.erstenslashimtextueberlesen:position:= +pos(berechtigungen,slash);berechtigungen:=subtext(berechtigungen,position+1). +berechtigungenindateiundsortieren:f:=sequentialfile(output,dateiname); +anzahlberechtigungen:=null;position:=pos(berechtigungen,slash);WHILE position +<>nullREP anzahlberechtigungenINCR 1;putline(f,subtext(berechtigungen,1, +position-1));berechtigungen:=subtext(berechtigungen,position+1);position:=pos +(berechtigungen,slash)PER ;putline(f,berechtigungen);anzahlberechtigungen +INCR 1;sort(dateiname).wirklichezeilenzahlberechnen:anzzeilenreal:= +anzahlberechtigungenDIV anzspalten;IF (anzahlberechtigungenMOD anzspalten<> +null)THEN anzzeilenrealINCR 1FI .ausgabefelderberechtigungenauffuellen:f:= +sequentialfile(input,dateiname);i:=null;FOR jFROM 1UPTO anzzeilenrealREP FOR +kFROM 1UPTO anzspaltenREP iINCR 1;IF i>anzahlberechtigungenTHEN spaltenweise( +blank)ELSE getline(f,berechtigung);spaltenweise(berechtigung)FI ;PER ; +ausgfeld(j+1):=zeilePER ;forget(dateiname,quiet);ausgfeldlaengereal:= +anzzeilenreal+2;ausgfeld(ausgfeldlaengereal):=text(blank,breite).END PROC +benutzeraufbereitenallgemein;PROC benutzerholen:kennung:=wert(fnrbenutzname); +berechtigungen:=wert(fnrbenutzberecht);END PROC benutzerholen;END PACKET +benutzerliste; + diff --git a/app/schulis/2.2.1/src/0.listen.druckbearbeitung b/app/schulis/2.2.1/src/0.listen.druckbearbeitung new file mode 100644 index 0000000..a7c47be --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.druckbearbeitung @@ -0,0 +1,207 @@ +PACKET listendruckbearbeitungDEFINES einstellungderlistenausgabe, +leseveraendertelisteneinstellung,einstellungdersonderlistenausgabe, +leseveraendertesonderlisteneinstellung, +einstellungderstartwertefueruebersichtsplaene, +leseveraenderteuebersichtsplaneinstellung,lesenvorbereitendruck,seitedrucken, +druckbreite,drucklaenge,initdruckkopf,druckvorbereiten,druckkopfschreiben, +druckzeileschreiben,seitenwechsel,setzemitseitennummern,drucknachbereiten, +drucknachbereitenohneausdrucken:LET niltext="",blank=" ",null=0, +schulnameschluessel="Schulname",schulstrasseschluessel="Schulstraße", +schulortschluessel="Schulort",seitennrtrenner="/",seitenwechselanweisung= +"###page#",stdxeumel=2.54,stdyeumel=2.35,druckdateinamepre="liste.", +dateilaenge=4073,seitenwechselzeilen=2,tatsdruckkopflaenge=7, +eineueberschriftzeilen=1,zweiueberschriftenzeilen=2,ueberschriftenmaxzeilen=2 +,schreiben=FALSE ,lesen=TRUE ,schriftfeldnr=2,druckbreitefeldnr=3, +drucklaengefeldnr=4,mindruckbreitefeldnr=4,startxfeldnr=5,startyfeldnr=6, +startxfeldnruebplan=3,startyfeldnruebplan=4,maxdruckbreite=76,mindruckbreite= +60,mindrucklaenge=26,maxstartxy=10.0,textnull="0.0",realnull=0.0, +eingabenichtsinnvoll=162,stackgroessedrucktupel=3,DRUCKKOPF =STRUCT (ROW +tatsdruckkopflaengeTEXT zeile,BOOL zweiueberschriften);REAL VAR startx:= +stdxeumel,starty:=stdyeumel,schreibflaeche;INT VAR druckzeilenbreite:=75, +druckseitenlaenge:=60,testdruckzeilenbreite,testdruckseitenlaenge, +anzahldrucktupel,bearbeitetedrucktupel,minbreitemitteilung;TEXT VAR +teststartx,teststarty;BOOL VAR werteinordnung,mitseitennummern;INT VAR +maxdateiseiten,schreibbaredrucklaenge,druckzeilennummer,druckseitennummer, +druckdateinummer,zeilenzaehler;TEXT VAR schulname,schulstrasse,schulort, +druckdateiname;DRUCKKOPF VAR druckkopf;FILE VAR druckdatei;INT PROC +druckbreite:druckzeilenbreiteEND PROC druckbreite;PROC +einstellungderlistenausgabe:LET maske="ms einstellung druck listen"; +druckzeilenbreite:=75;standardstartproc(maske);standardmaskenfeld(schrifttyp, +schriftfeldnr);standardmaskenfeld(text(druckzeilenbreite),druckbreitefeldnr); +standardmaskenfeld(text(druckseitenlaenge),drucklaengefeldnr); +standardmaskenfeld(text(startx),startxfeldnr);standardmaskenfeld(text(starty) +,startyfeldnr);standardnprocEND PROC einstellungderlistenausgabe;PROC +einstellungdersonderlistenausgabe:LET maske= +"ms einstellung druck anschreiben";minbreitemitteilung:=70;druckzeilenbreite +:=75;standardstartproc(maske);standardmaskenfeld(schrifttyp,schriftfeldnr); +standardmaskenfeld(text(druckzeilenbreite),druckbreitefeldnr); +standardmaskenfeld(text(minbreitemitteilung),mindruckbreitefeldnr); +standardmaskenfeld(text(startx),startxfeldnr);standardmaskenfeld(text(starty) +,startyfeldnr);standardnprocEND PROC einstellungdersonderlistenausgabe;PROC +einstellungdersonderlistenausgabe(INT CONST anzzeichen):LET maske= +"ms einstellung druck anschreiben";minbreitemitteilung:=anzzeichen; +druckzeilenbreite:=anzzeichen;standardstartproc(maske);standardmaskenfeld( +schrifttyp,schriftfeldnr);standardmaskenfeld(text(druckzeilenbreite), +druckbreitefeldnr);standardmaskenfeld(text(minbreitemitteilung), +mindruckbreitefeldnr);standardmaskenfeld(text(startx),startxfeldnr); +standardmaskenfeld(text(starty),startyfeldnr);standardnprocEND PROC +einstellungdersonderlistenausgabe;PROC +einstellungderstartwertefueruebersichtsplaene:LET maske= +"ms einstellung startwerte";standardstartproc(maske);standardmaskenfeld( +schrifttyp,schriftfeldnr);standardmaskenfeld(text(startx),startxfeldnruebplan +);standardmaskenfeld(text(starty),startyfeldnruebplan);standardnprocEND PROC +einstellungderstartwertefueruebersichtsplaene;PROC +leseveraenderteuebersichtsplaneinstellung:werteinordnung:=TRUE ;teststartx:= +compress(standardmaskenfeld(startxfeldnruebplan));teststarty:=compress( +standardmaskenfeld(startyfeldnruebplan));ueberpruefendergegebenenwerte;IF +werteinordnungTHEN werteuebernehmen;IF fontexists(schrifttyp)THEN +schreibflaeche:=(16.0-(real(teststartx)-stdxeumel));druckzeilenbreite:=(( +xstepconversion(schreibflaeche))DIV (charpitch(font(schrifttyp)," ")))FI ;IF +druckzeilenbreitemaxdruckbreiteTHEN druckzeilenbreite:=maxdruckbreiteFI ; +enter(2)ELSE meldefehler;return(1)FI ;.ueberpruefendergegebenenwerte:IF ( +teststartx<>textnullAND real(teststartx)=realnull)OR real(teststartx)> +maxstartxyOR real(teststartx)textnullAND real(teststarty)= +realnull)OR real(teststarty)>maxstartxyOR real(teststarty)textnullAND real(teststartx)=realnull)OR real(teststartx)> +maxstartxyOR real(teststartx)textnullAND real(teststarty)=realnull +)OR real(teststarty)>maxstartxyOR real(teststarty) +textnullAND real(teststartx)=realnull)OR real(teststartx)>maxstartxyOR real( +teststartx)textnullAND real(teststarty)=realnull)OR real(teststarty)> +maxstartxyOR real(teststarty)0THEN +einendatensatzlesen(PROC (INT CONST ,BOOL PROC )scanstacksucc,PROC multisucc, +TRUE ,BOOL PROC pruefungspeziell);bearbeitetedrucktupel:=1ELSE +setzebestandende(TRUE )FI END PROC lesenvorbereitendruck;PROC lesendruck( +PROC (INT CONST ,BOOL PROC ,INT VAR )mitscanner,BOOL PROC pruefungspeziell): +anzahldrucktupel:=stackgroessedrucktupel;eineseiteeinlesen(PROC (INT CONST , +BOOL PROC ,INT VAR )mitscanner,PROC (INT CONST ,INT VAR )multisucc,TRUE , +BOOL PROC pruefungspeziell,anzahldrucktupel);IF anzahldrucktupel>0THEN +einendatensatzlesen(PROC (INT CONST ,BOOL PROC )scanstacksucc,PROC multisucc, +TRUE ,BOOL PROC pruefungspeziell);bearbeitetedrucktupel:=1ELSE +setzebestandende(TRUE )FI END PROC lesendruck;TEXT PROC tb:IF bestandende +THEN "Bestandsende"ELSE "kein Ende"FI ENDPROC tb;PROC dummy(INT CONST i,INT +VAR j):ENDPROC dummy;PROC dummy:ENDPROC dummy;PROC naechsteseiteeinlesen( +BOOL PROC pruefungspeziell):lesendruck(PROC (INT CONST ,BOOL PROC ,INT VAR ) +scansucc,BOOL PROC pruefungspeziell)ENDPROC naechsteseiteeinlesen;PROC +seitedrucken(PROC (INT VAR )drucken,INT CONST zeilenzahl,maxsatzlaenge,BOOL +PROC pruefespeziell):seitedrucken(PROC (INT VAR )drucken,zeilenzahl, +maxsatzlaenge,PROC dummy,BOOL PROC pruefespeziell)ENDPROC seitedrucken;PROC +seitedrucken(PROC (INT VAR )drucken,INT CONST zeilenzahl,maxsatzlaenge,PROC +bestandendesimulierenbeimerkmalwechsel,BOOL PROC pruefespeziell): +zeilenzaehler:=null;WHILE NOT bestandendeCAND (zeilenzaehler<=zeilenzahl- +maxsatzlaenge)CAND pruefespeziellREP drucken(zeilenzaehler); +naechstensatzlesen;#IF NOT bestandendeTHEN # +bestandendesimulierenbeimerkmalwechsel#FI #PER .naechstensatzlesen:IF +bearbeitetedrucktupel=anzahldrucktupelTHEN IF anzahldrucktupel<> +stackgroessedrucktupelTHEN setzebestandende(TRUE )ELSE naechsteseiteeinlesen( +BOOL PROC pruefespeziell)FI ELSE einendatensatzlesen(PROC (INT CONST ,BOOL +PROC )scanstacksucc,PROC multisucc,TRUE ,BOOL PROC pruefespeziell); +bearbeitetedrucktupelINCR 1FI .END PROC seitedrucken;INT PROC drucklaenge( +INT CONST ueberschriftenzeilen):schreibbaredrucklaenge-druckkopflaenge( +ueberschriftenzeilen).END PROC drucklaenge;INT PROC drucklaenge: +schreibbaredrucklaenge.END PROC drucklaenge;PROC initdruckkopf:initdruckkopf( +niltext,niltext).END PROC initdruckkopf;PROC initdruckkopf(TEXT CONST +ueberschrift):initdruckkopf(ueberschrift,niltext).END PROC initdruckkopf; +PROC initdruckkopf(TEXT CONST ueberschrift1,ueberschrift2):schulname:= +schulkenndatum(schulnameschluessel);schulort:=schulkenndatum( +schulortschluessel);druckkopf.zeile(1):=geblockt(schulname,date, +druckzeilenbreite);IF (ueberschrift1=niltext)AND (ueberschrift2=niltext)THEN +teilbriefkopfELSE teillistenkopfFI ;druckkopf.zeile(4):=ueberschrift1; +druckkopf.zeile(5):=ueberschrift2;druckkopf.zeile(6):=niltext;druckkopf.zeile +(7):=niltext;druckkopf.zweiueberschriften:=ueberschrift2<>niltext. +teilbriefkopf:schulstrasse:=schulkenndatum(schulstrasseschluessel);druckkopf. +zeile(2):=schulstrasse;druckkopf.zeile(3):=schulort.teillistenkopf:druckkopf. +zeile(2):=schulort;druckkopf.zeile(3):=niltext.END PROC initdruckkopf;PROC +druckvorbereiten:druckdateinummer:=0;druckseitennummer:=0;druckzeilennummer:= +0;dateieroeffnen(schreiben).END PROC druckvorbereiten;PROC druckkopfschreiben +:INT VAR i;FOR iFROM 1UPTO druckkopflaengeREPEAT druckzeileschreiben( +druckkopf.zeile[i])END REPEAT .END PROC druckkopfschreiben;PROC +druckzeileschreiben(TEXT CONST inhalt):IF druckzeilennummer< +schreibbaredrucklaengeTHEN put(druckdatei,inhalt);line(druckdatei); +druckzeilennummerINCR 1END IF .END PROC druckzeileschreiben;PROC +seitenwechsel:trageggfleerzeilenein;putline(druckdatei,seitenwechselanweisung +);druckseitennummerINCR 1;druckzeilennummer:=0;ggffolgedateieroeffnen( +schreiben).trageggfleerzeilenein:INT CONST fehlendezeilen:=max(0, +druckseitenlaenge-druckzeilennummer-1);line(druckdatei,fehlendezeilen).END +PROC seitenwechsel;PROC setzemitseitennummern(BOOL CONST ja):mitseitennummern +:=ja.END PROC setzemitseitennummern;PROC drucknachbereiten:INT VAR i; +ggfseitenwechsel;IF mitseitennummernTHEN seitennummerneintragenFI ;FOR iFROM +1UPTO druckdateinummerREPEAT druckdateiname:=druckdateinamepre+text(i); +dateidruckenundloeschenEND REPEAT .ggfseitenwechsel:IF druckzeilennummer>0 +THEN seitenwechselEND IF .dateidruckenundloeschen:print(druckdateiname); +forget(druckdateiname,quiet).END PROC drucknachbereiten;PROC +drucknachbereitenohneausdrucken:ggfseitenwechsel;IF mitseitennummernTHEN +seitennummerneintragenFI .ggfseitenwechsel:IF druckzeilennummer>0THEN +seitenwechselEND IF .END PROC drucknachbereitenohneausdrucken;PROC +seitennummerneintragen:IF mehralseineseiteTHEN +trageseitennummernindruckdateieinEND IF .mehralseineseite:druckseitennummer>1 +.trageseitennummernindruckdateiein:INT CONST seiten:=druckseitennummer; +druckdateinummer:=0;dateieroeffnen(lesen);FOR druckseitennummerFROM 1UPTO +seitenREPEAT down(druckdatei,seitenwechselanweisung);trageseitennummerein; +ggffolgedateieroeffnen(lesen)END REPEAT .trageseitennummerein:writerecord( +druckdatei,seitennummer+seitenwechselanweisung);down(druckdatei).seitennummer +:TEXT CONST seitennr:=nr;blanks+seitennr.nr:text(druckseitennummer)+ +seitennrtrenner+text(seiten).blanks:(druckzeilenbreite-seitennrlaenge)*blank. +seitennrlaenge:length(seitennr).END PROC seitennummerneintragen;PROC +ggffolgedateieroeffnen(BOOL CONST lesen):IF druckseitennummerMOD +maxdateiseiten=0THEN dateieroeffnen(lesen)END IF .END PROC +ggffolgedateieroeffnen;PROC dateieroeffnen(BOOL CONST lesen):druckdateinummer +INCR 1;druckdateiname:=druckdateinamepre+text(druckdateinummer);IF lesenTHEN +lesedateieroeffnenELSE schreibdateieroeffnenEND IF .lesedateieroeffnen: +druckdatei:=sequentialfile(modify,druckdateiname);down(druckdatei, +seitenwechselanweisung).schreibdateieroeffnen:forget(druckdateiname,quiet); +druckdatei:=sequentialfile(output,druckdateiname);maxdateiseiten:=dateilaenge +DIV druckseitenlaenge;schreibbaredrucklaenge:=druckseitenlaenge;IF +mitseitennummernTHEN schreibbaredrucklaenge:=schreibbaredrucklaenge- +seitenwechselzeilenFI ;setzeanzahlderzeichenprozeile(druckzeilenbreite); +schrift(schrifttyp);start(startx,starty);schreibesteuerzeichenzeile( +druckdateiname);putline(druckdatei,seitenwechselanweisung).END PROC +dateieroeffnen;INT PROC druckkopflaenge(INT CONST ueberschriftenzeilen):IF +ueberschriftenzeilen>ueberschriftenmaxzeilenTHEN errorstop("max "+text( +ueberschriftenmaxzeilen)+" Ueberschriften im Druckkopf");0ELSE +tatsdruckkopflaenge-ueberschriftenmaxzeilen+ueberschriftenzeilenEND IF .END +PROC druckkopflaenge;INT PROC druckkopflaenge:druckkopflaenge( +ueberschriftenzeilen).ueberschriftenzeilen:IF druckkopf.zweiueberschriften +THEN zweiueberschriftenzeilenELSE eineueberschriftzeilenEND IF .END PROC +druckkopflaenge;END PACKET listendruckbearbeitung + diff --git a/app/schulis/2.2.1/src/0.listen.faecher b/app/schulis/2.2.1/src/0.listen.faecher new file mode 100644 index 0000000..650efde --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.faecher @@ -0,0 +1,86 @@ +PACKET faecherlistenDEFINES faecherlispezielleteile:LET faechereingangsmaske= +"mu liste einfach eingang",spaltentrenner=" ",faecheranfpos=2,spalte1breite=5 +,spalte2breite=35,spalte3breite=10,spalte4breite=11,niltext="",blank=" ",null +=0,strich="-",ueberschriftenzeilen=2,mnrauswahlnichtsinnvoll=56, +mnrbearbeitetwerden=109,ausgkopflaenge=2,ausgfeldlaenge=1, +anzahlderobjekteprobildschirm=17;TEXT VAR faecherueberschrift:= +"Liste der Fächer",fach,fachbezeichnung,fachgruppe,fachbereich,anfbuchstabe, +neueranfbuchstabe:="",auswahlnichtsinnvoll,bearbeitetwerden;TEXT CONST +leerzeile:=bildbreite*blank,textueberschrift:=("Fach"+2*blank+ +"Fachbezeichnung"+21*blank+"Fachgruppe"+blank+"Fachbereich");INT VAR +eingabestatus,lesestart,bildanfang,spalte2druckbreite,druckzeilenzahl;INT +CONST aktuelleindexnr:=dnrfaecher,fnrfach:=fnrffach,fnrfachbezeichnung:= +fnrffachbez,fnrfachgruppe:=fnrffachgrp,fnrfachbereich:=fnrffachbereich;LET +AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT , +AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR +ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC multistop:TRUE END PROC +multistop;PROC faecherlispezielleteile(INT CONST nr):SELECT nrOF CASE 1: +faecherdialogvorbereitenCASE 2:faechereingabenrichtigCASE 3: +faecherlistenvorbereitenCASE 4:faecherdruckvorbereitenCASE 5: +faecherseitedruckenCASE 6:faecherbildschirmvorbereitenCASE 7: +faecherseitezeigenENDSELECT .END PROC faecherlispezielleteile;PROC +faecherdialogvorbereiten:faecherueberschrift:=text(vergleichsknoten); +setzeanfangswerte(faechereingangsmaske,faecheranfpos)END PROC +faecherdialogvorbereiten;PROC faechereingabenrichtig:LET fnrausgdrucker=2, +fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus);IF eingabestatus=0THEN setzeeingabetest(TRUE ); +setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext)ELSE meldefehler; +setzeeingabetest(FALSE )FI .meldefehler:meldungstext(mnrauswahlnichtsinnvoll, +auswahlnichtsinnvoll);standardmeldung(auswahlnichtsinnvoll,niltext).END PROC +faechereingabenrichtig;PROC faecherlistenvorbereiten:BOOL VAR b;initspalten; +setzespaltentrenner(spaltentrenner);lesestart:=fnrfach;inittupel(dnrfaecher); +setzeidentiwert("");initobli(anzahlderobjekteprobildschirm); +objektlistestarten(aktuelleindexnr,"",lesestart,TRUE ,b);setzebestandende( +NOT multistopCOR b);END PROC faecherlistenvorbereiten;PROC +faecherbildschirmvorbereiten:LET fnrausganf=2;standardkopfmaskeaktualisieren( +faecherueberschrift);bildanfang:=fnrausganf;setzebildanfangsposition( +bildanfang);INT VAR i;setzespaltenbreite(bildbreite);spaltenweise( +textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos; +erhoeheausgabeposumeins;spaltenweise(leerzeile);ausgfeld(1):=zeile;ausgfeld(1 +)IN ausgabepos;erhoeheausgabeposumeins;setzebildanfangsposition(4); +initspalten;setzespaltentrenner(spaltentrenner);setzespaltenbreite( +spalte1breite);setzespaltenbreite(spalte2breite);setzespaltenbreite( +spalte3breite);setzespaltenbreite(spalte4breite);END PROC +faecherbildschirmvorbereiten;PROC faecherseitezeigen:blaettern(PROC (INT +CONST )faecherdatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END PROC +faecherseitezeigen;PROC faecherdatenzeigen(INT CONST x):faecherdatenholen; +faecherdatenaufbereitenbild;faecherdatenaufbildschirm.END PROC +faecherdatenzeigen;PROC faecherdatenholen:fach:=wert(fnrfach);fachbezeichnung +:=wert(fnrfachbezeichnung);IF wert(fnrfachgruppe)=text(null)THEN fachgruppe:= +strichELSE fachgruppe:=wert(fnrfachgruppe);FI ;IF wert(fnrfachbereich)= +niltextTHEN fachbereich:=strichELSE fachbereich:=wert(fnrfachbereich)FI ;END +PROC faecherdatenholen;PROC faecherdatenaufbereitenbild:spaltenweise(fach); +spaltenweise(fachbezeichnung);spaltenweise(fachgruppe);spaltenweise( +fachbereich);END PROC faecherdatenaufbereitenbild;PROC +faecherdatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;END +PROC faecherdatenaufbildschirm;PROC faecherdruckvorbereiten:setzebestandende( +FALSE );anfbuchstabe:=" ";druckvorbereiten;variablenfuerdrucksetzen; +initdruckkopf(zentriert(faecherueberschrift,druckbreite),zentriert(length( +faecherueberschrift)*"-",druckbreite));initspalten;setzespaltenbreite( +spalte1breite);setzespaltenbreite(spalte2breite);setzespaltenbreite( +spalte3breite);setzespaltenbreite(spalte4breite);holemeldung;inittupel( +dnrfaecher);initausgabekopfdruck;lesenvorbereitendruck(PROC (INT CONST ,BOOL +PROC ,INT VAR )scanforward,BOOL PROC multistop);.holemeldung:meldungstext( +mnrbearbeitetwerden,bearbeitetwerden).variablenfuerdrucksetzen: +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC +faecherdruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck(1):= +textueberschrift;ausgkopfdruck(2):=leerzeile;END PROC initausgabekopfdruck; +PROC faecherseitedrucken:faecherueberschriftdrucken;seitedrucken(PROC (INT +VAR )lehrerdrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistop); +seitenwechsel.END PROC faecherseitedrucken;PROC faecherueberschriftdrucken: +INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP +druckzeileschreiben(ausgkopfdruck(i))PER END PROC faecherueberschriftdrucken; +PROC lehrerdrucken(INT VAR zeilenzaehler):LET markiert="#";faecherdatenholen; +ggflmeldunganfbuchstabe;faecheraufbereitendruck;zeilenzaehlerINCR +ausgfeldlaenge;faecherindruckdatei.ggflmeldunganfbuchstabe:IF +anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert: +neueranfbuchstabe:=fachSUB 1;anfbuchstabe<>neueranfbuchstabe. +meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,neueranfbuchstabe+ +markiert);anfbuchstabe:=neueranfbuchstabe.END PROC lehrerdrucken;PROC +faecheraufbereitendruck:spaltenweise(fach);spaltenweise(fachbezeichnung); +spaltenweise(fachgruppe);spaltenweise(fachbereich);ausgfeld(1):=zeile;END +PROC faecheraufbereitendruck;PROC faecherindruckdatei:INT VAR i;FOR iFROM 1 +UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER .END PROC +faecherindruckdatei;END PACKET faecherlisten + diff --git a/app/schulis/2.2.1/src/0.listen.klassengruppen b/app/schulis/2.2.1/src/0.listen.klassengruppen new file mode 100644 index 0000000..7543dad --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.klassengruppen @@ -0,0 +1,104 @@ +PACKET klassengruppenlistenDEFINES klassengruppenspezielleteile:LET +klassengruppeneingangsmaske="mu liste einfach eingang",spaltentrenner=" ", +klassengruppenanfpos=2,spaltenbreite1=12,spaltenbreite2=7,niltext="",blank= +" ",strich="-",null=0,ueberschriftenzeilen=2,ausgkopflaenge=2,ausgfeldlaenge= +1,anzahlderobjekteprobildschirm=5,mnrauswahlnichtsinnvoll=56, +mnrbearbeitetwerden=352;TEXT CONST spaltentext1:="Klassengruppe",spaltentext2 +:="Bezeichnung Zusammensetzung";TEXT VAR klassengrueberschrift:= +"Liste der Raumgruppen",schuelergrfuerzeile1,schuelergrfuerzeile2, +schuelergrfuerzeile3,klassengruppe,alteklassengruppe:="",anfbuchstabe, +neueranfbuchstabe:="",teiltextmeldung:= +"die Klassengruppe dem Anfangsbuchstaben:";INT VAR eingabestatus,bildanfang, +druckzeilenzahl;LET AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW +ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR +ausgfeld;AUSGKOPF VAR ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC +multistop:TRUE END PROC multistop;PROC klassengruppenspezielleteile(INT +CONST nr):SELECT nrOF CASE 1:klassengrdialogvorbereitenCASE 2: +klassengreingabenrichtigCASE 3:klassengrlistenvorbereitenCASE 4: +klassengrdruckvorbereitenCASE 5:klassengrseitedruckenCASE 6: +klassengrbildschirmvorbereitenCASE 7:klassengrseitezeigenENDSELECT .END PROC +klassengruppenspezielleteile;PROC klassengrdialogvorbereiten: +klassengrueberschrift:=text(vergleichsknoten);setzeanfangswerte( +klassengruppeneingangsmaske,klassengruppenanfpos)END PROC +klassengrdialogvorbereiten;PROC klassengreingabenrichtig:LET fnrausgdrucker=2 +,fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus);IF eingabestatus=0THEN setzeeingabetest(TRUE ); +setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);ELSE meldefehler +;setzeeingabetest(FALSE )FI ;.meldefehler:standardmeldung( +mnrauswahlnichtsinnvoll,niltext).END PROC klassengreingabenrichtig;PROC +klassengrlistenvorbereiten:BOOL VAR b;initspalten;setzespaltentrenner( +spaltentrenner);inittupel(dnrklassengruppen);setzeidentiwert("");initobli( +anzahlderobjekteprobildschirm);objektlistestarten(dnrklassengruppen,"", +fnrkgklassengrp,TRUE ,b);setzebestandende(NOT multistopCOR b);END PROC +klassengrlistenvorbereiten;PROC klassengrbildschirmvorbereiten:LET fnrausganf +=2;standardkopfmaskeaktualisieren(klassengrueberschrift);bildanfang:= +fnrausganf;setzebildanfangsposition(bildanfang);initspalten; +setzespaltenbreite(bildbreite);spaltenweise(spaltentext1);ausgfeld(1):=zeile; +ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;spaltenweise(spaltentext2); +ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins; +spaltenweise(blank);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos; +erhoeheausgabeposumeins;setzebildanfangsposition(5);spaltenbreitensetzenEND +PROC klassengrbildschirmvorbereiten;PROC klassengrseitezeigen:blaettern(PROC +(INT CONST )klassengrdatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END +PROC klassengrseitezeigen;PROC klassengrdatenzeigen(INT CONST x): +klassengrdatenholen;klassengrdatenaufbereitenbild1; +klassengrdatenaufbildschirm;klassengrdatenaufbereitenbild2; +klassengrdatenaufbildschirm;klassengrdatenaufbereitenbild3; +klassengrdatenaufbildschirmEND PROC klassengrdatenzeigen;PROC +klassengrdatenaufbereitenbild1:INT VAR y:=1;spaltenweise(klassengruppe); +spaltenweise(subtext(schuelergrfuerzeile1,y,y+5));yINCR 6;spaltenweise( +subtext(schuelergrfuerzeile1,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile1,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile1,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile1,y,y+5));yINCR 6;END PROC klassengrdatenaufbereitenbild1; +PROC klassengrdatenaufbereitenbild2:INT VAR y:=1;spaltenweise(blank); +spaltenweise(subtext(schuelergrfuerzeile2,y,y+5));yINCR 6;spaltenweise( +subtext(schuelergrfuerzeile2,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile2,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile2,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile2,y,y+5));yINCR 6;END PROC klassengrdatenaufbereitenbild2; +PROC klassengrdatenaufbereitenbild3:INT VAR y:=1;spaltenweise(blank); +spaltenweise(subtext(schuelergrfuerzeile3,y,y+5));yINCR 6;spaltenweise( +subtext(schuelergrfuerzeile3,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile3,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile3,y,y+5));yINCR 6;spaltenweise(subtext( +schuelergrfuerzeile3,y,y+5));yINCR 6;END PROC klassengrdatenaufbereitenbild3; +PROC klassengrdatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;END +PROC klassengrdatenaufbildschirm;PROC klassengrdruckvorbereiten: +setzebestandende(FALSE );anfbuchstabe:=" ";druckvorbereiten; +variablenfuerdrucksetzen;initdruckkopf(zentriert(klassengrueberschrift, +druckbreite),zentriert(length(klassengrueberschrift)*strich,druckbreite)); +initausgabekopfdruck;inittupel(dnrklassengruppen);spaltenbreitensetzen; +lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL +PROC multistop);.variablenfuerdrucksetzen:druckzeilenzahl:=drucklaenge( +ueberschriftenzeilen)-ausgkopflaenge.END PROC klassengrdruckvorbereiten;PROC +klassengrseitedrucken:klassengrueberschriftdrucken;seitedrucken(PROC (INT +VAR )klassengrdatendrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistop +);seitenwechsel.END PROC klassengrseitedrucken;PROC +klassengrueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO +ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck(i))PER ;ausgfeld(1):= +zeile;druckzeileschreiben(ausgfeld(1))END PROC klassengrueberschriftdrucken; +PROC klassengrdatendrucken(INT VAR zeilenzaehler):LET markiert="#"; +klassengrdatenholen;ggflmeldunganfbuchstabe;klassengrdatenaufbereitenbild1; +zeilenzaehlerINCR ausgfeldlaenge;klassengrindruckdatei;IF +schuelergrfuerzeile2<>niltextTHEN klassengrdatenaufbereitenbild2; +zeilenzaehlerINCR ausgfeldlaenge;klassengrindruckdatei;IF +schuelergrfuerzeile3<>niltextTHEN klassengrdatenaufbereitenbild3; +zeilenzaehlerINCR ausgfeldlaenge;klassengrindruckdatei;FI FI ;. +ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN meldunganfbuchstabeFI . +anfbuchstabegeaendert:neueranfbuchstabe:=klassengruppeSUB 1;anfbuchstabe<> +neueranfbuchstabe.meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden, +teiltextmeldung+neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe. +END PROC klassengrdatendrucken;PROC initausgabekopfdruck:ausgkopfdruck(1):= +spaltentext1;ausgkopfdruck(2):=spaltentext2;END PROC initausgabekopfdruck; +PROC klassengrindruckdatei:ausgfeld(1):=zeile;INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END PROC +klassengrindruckdatei;PROC spaltenbreitensetzen:INT VAR z;initspalten; +setzespaltenbreite(spaltenbreite1);FOR zFROM 1UPTO 5REP setzespaltenbreite( +spaltenbreite2);PER END PROC spaltenbreitensetzen;PROC klassengrdatenholen: +klassengruppe:=wert(fnrkgklassengrp);schuelergrfuerzeile1:=subtext(wert( +fnrkgschuelergrp),1,30);schuelergrfuerzeile2:=subtext(wert(fnrkgschuelergrp), +31,60);schuelergrfuerzeile3:=subtext(wert(fnrkgschuelergrp),61,90);END PROC +klassengrdatenholen;END PACKET klassengruppenlisten; + diff --git a/app/schulis/2.2.1/src/0.listen.raumgruppen b/app/schulis/2.2.1/src/0.listen.raumgruppen new file mode 100644 index 0000000..9d8b0f4 --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.raumgruppen @@ -0,0 +1,97 @@ +PACKET raumgruppenlistenDEFINES raumgruppenspezielleteile:LET +raumgruppeneingangsmaske="mu liste einfach eingang",spaltentrenner=" ", +raumgruppenanfpos=2,spaltenbreite1=4,spaltenbreite2=12,niltext="",blank=" ", +strich="-",null=0,ueberschriftenzeilen=2,ausgkopflaenge=2,ausgfeldlaenge=1, +anzahlderobjekteprobildschirm=8,mnrauswahlnichtsinnvoll=56, +mnrbearbeitetwerden=352;TEXT VAR raumgrueberschrift:="Liste der Raumgruppen", +spaltentext:="Raumgruppe Räume",raeumefuerzeile1,raeumefuerzeile2,raum1, +raum2,raum3,raum4,raum5,raum6,raum7,raum8,raum9,raum10,raum11,raum12,raum13, +raum14,raum15,raumgruppe,alteraumgruppe:="",anfbuchstabe,neueranfbuchstabe:= +"",teiltextmeldung:="die Raumgruppe dem Anfangsbuchstaben:";INT VAR +eingabestatus,bildanfang,spalte2druckbreite,druckzeilenzahl;LET AUSGFELD = +ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW +ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf; +AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC multistop:TRUE END PROC multistop; +PROC raumgruppenspezielleteile(INT CONST nr):SELECT nrOF CASE 1: +raumgrdialogvorbereitenCASE 2:raumgreingabenrichtigCASE 3: +raumgrlistenvorbereitenCASE 4:raumgrdruckvorbereitenCASE 5:raumgrseitedrucken +CASE 6:raumgrbildschirmvorbereitenCASE 7:raumgrseitezeigenENDSELECT .END +PROC raumgruppenspezielleteile;PROC raumgrdialogvorbereiten: +raumgrueberschrift:=text(vergleichsknoten);setzeanfangswerte( +raumgruppeneingangsmaske,raumgruppenanfpos)END PROC raumgrdialogvorbereiten; +PROC raumgreingabenrichtig:LET fnrausgdrucker=2,fnrausgbild=3;standardpruefe( +5,fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus=0 +THEN setzeeingabetest(TRUE );setzeausgabedrucker(standardmaskenfeld( +fnrausgbild)=niltext);ELSE meldefehler;setzeeingabetest(FALSE )FI ;. +meldefehler:standardmeldung(mnrauswahlnichtsinnvoll,niltext).END PROC +raumgreingabenrichtig;PROC raumgrlistenvorbereiten:BOOL VAR b;initspalten; +setzespaltentrenner(spaltentrenner);inittupel(dnrraumgruppen);setzeidentiwert +("");initobli(anzahlderobjekteprobildschirm);objektlistestarten( +dnrraumgruppen,"",fnrrgraumgrp,TRUE ,b);setzebestandende(NOT multistopCOR b); +END PROC raumgrlistenvorbereiten;PROC raumgrbildschirmvorbereiten:LET +fnrausganf=2;standardkopfmaskeaktualisieren(raumgrueberschrift);bildanfang:= +fnrausganf;setzebildanfangsposition(bildanfang);initspalten; +setzespaltenbreite(bildbreite);spaltenweise(spaltentext);ausgfeld(1):=zeile; +ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;spaltenweise(blank);ausgfeld +(1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins; +setzebildanfangsposition(4);spaltenbreitensetzenEND PROC +raumgrbildschirmvorbereiten;PROC raumgrseitezeigen:blaettern(PROC (INT CONST +)raumgrdatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END PROC +raumgrseitezeigen;PROC raumgrdatenzeigen(INT CONST x):raumgrdatenholen; +raumgrdatenaufbereitenbild1;raumgrdatenaufbildschirm; +raumgrdatenaufbereitenbild2;raumgrdatenaufbildschirmEND PROC +raumgrdatenzeigen;PROC raumgrdatenaufbereitenbild1:spaltenweise(raumgruppe); +spaltenweise(raum1);spaltenweise(raum2);spaltenweise(raum3);spaltenweise( +raum4);spaltenweise(raum5);spaltenweise(raum6);spaltenweise(raum7); +spaltenweise(raum8);spaltenweise(raum9);spaltenweise(raum10);END PROC +raumgrdatenaufbereitenbild1;PROC raumgrdatenaufbereitenbild2:spaltenweise( +blank);spaltenweise(raum11);spaltenweise(raum12);spaltenweise(raum13); +spaltenweise(raum14);spaltenweise(raum15);spaltenweise(blank);spaltenweise( +blank);spaltenweise(blank);spaltenweise(blank);spaltenweise(blank);END PROC +raumgrdatenaufbereitenbild2;PROC raumgrdatenaufbildschirm:INT VAR i;FOR i +FROM 1UPTO ausgfeldlaengeREP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos; +erhoeheausgabeposumeins;PER ;END PROC raumgrdatenaufbildschirm;PROC +raumgrdruckvorbereiten:setzebestandende(FALSE );anfbuchstabe:=" "; +druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(zentriert( +raumgrueberschrift,druckbreite),zentriert(length(raumgrueberschrift)*strich, +druckbreite));initausgabekopfdruck;inittupel(dnrraumgruppen); +spaltenbreitensetzen;lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT +VAR )scanforward,BOOL PROC multistop);.variablenfuerdrucksetzen: +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC +raumgrdruckvorbereiten;PROC raumgrseitedrucken:raumgrueberschriftdrucken; +seitedrucken(PROC (INT VAR )raumgrdatendrucken,druckzeilenzahl,ausgfeldlaenge +,BOOL PROC multistop);seitenwechsel.END PROC raumgrseitedrucken;PROC +raumgrueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO +ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck(i))PER END PROC +raumgrueberschriftdrucken;PROC raumgrdatendrucken(INT VAR zeilenzaehler):LET +markiert="#";raumgrdatenholen;ggflmeldunganfbuchstabe; +raumgrdatenaufbereitenbild1;zeilenzaehlerINCR ausgfeldlaenge; +raumgrindruckdatei;IF raeumefuerzeile2<>niltextTHEN +raumgrdatenaufbereitenbild2;zeilenzaehlerINCR ausgfeldlaenge; +raumgrindruckdatei;FI ;.ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN +meldunganfbuchstabeFI .anfbuchstabegeaendert:neueranfbuchstabe:=raumgruppe +SUB 1;anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe:standardmeldung( +mnrbearbeitetwerden,teiltextmeldung+neueranfbuchstabe+markiert);anfbuchstabe +:=neueranfbuchstabe.END PROC raumgrdatendrucken;PROC initausgabekopfdruck: +TEXT VAR unterstreichung:=druckbreite*strich;ausgkopfdruck(1):=spaltentext; +ausgkopfdruck(2):=unterstreichung;END PROC initausgabekopfdruck;PROC +raumgrindruckdatei:ausgfeld(1):=zeile;INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END PROC +raumgrindruckdatei;PROC spaltenbreitensetzen:initspalten;setzespaltenbreite( +spaltenbreite2);INT VAR x;INT CONST zehnraeumedererstenzeile:=10;FOR xFROM 1 +UPTO zehnraeumedererstenzeileREP setzespaltenbreite(spaltenbreite1);PER ;END +PROC spaltenbreitensetzen;PROC raumgrdatenholen:INT VAR x:=1;raumgruppe:=wert +(fnrrgraumgrp);raeumefuerzeile1:=subtext(wert(fnrrgraeume),1,40); +raeumefuerzeile2:=subtext(wert(fnrrgraeume),41,60);raum1:=subtext( +raeumefuerzeile1,x,x+4);xINCR 4;raum2:=subtext(raeumefuerzeile1,x,x+4);xINCR +4;raum3:=subtext(raeumefuerzeile1,x,x+4);xINCR 4;raum4:=subtext( +raeumefuerzeile1,x,x+4);xINCR 4;raum5:=subtext(raeumefuerzeile1,x,x+4);xINCR +4;raum6:=subtext(raeumefuerzeile1,x,x+4);xINCR 4;raum7:=subtext( +raeumefuerzeile1,x,x+4);xINCR 4;raum8:=subtext(raeumefuerzeile1,x,x+4);xINCR +4;raum9:=subtext(raeumefuerzeile1,x,x+4);xINCR 4;raum10:=subtext( +raeumefuerzeile1,x,x+4);xINCR 4;raum11:=subtext(raeumefuerzeile2,x,x+4);x +INCR 4;raum12:=subtext(raeumefuerzeile2,x,x+4);xINCR 4;raum13:=subtext( +raeumefuerzeile2,x,x+4);xINCR 4;raum14:=subtext(raeumefuerzeile2,x,x+4);x +INCR 4;raum15:=subtext(raeumefuerzeile2,x,x+4);xINCR 4;alteraumgruppe:= +raumgruppe;END PROC raumgrdatenholen;END PACKET raumgruppenlisten; + diff --git a/app/schulis/2.2.1/src/0.listen.schlueabku b/app/schulis/2.2.1/src/0.listen.schlueabku new file mode 100644 index 0000000..54a928d --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.schlueabku @@ -0,0 +1,69 @@ +PACKET schluesselundabkulisteDEFINES schlueabkulieingang, +schlueabkulispezielleteile:LET niltext="",null=0,ueberschriftenzeilen=1, +spalte1breite=10,anzspaltentrenner=1,ausgfeldlaenge=1,AUSGFELD =ROW +ausgfeldlaengeTEXT ,schlueabkulieingangsmaske="mu liste einfach eingang", +schlueabkulianfpos=2;#LET dnrschluessel=137,fnrschlsachgebiet=138, +fnrschlschluessel=139,fnrschllangtext=140,dnrgesamtbestand=--,fnrbestandname= +--,fnrbestandid=--;#INT CONST spalte2bildbreite:=bildbreite-anzspaltentrenner +-spalte1breite;INT VAR spalte2druckbreite,druckzeilenzahl,bildanf, +eingabestatus;TEXT VAR schlueabkuliueberschrift,bestand,schluesselabk, +schluessellangtext;AUSGFELD VAR ausgfeld;#INT VAR sachgebiet;#BOOL PROC +multistop:BOOL VAR b;b:=wert(fnrschlsachgebiet)=bestand;bENDPROC multistop; +BOOL PROC multistopdruck:BOOL VAR b:=multistop;setzebestandende(NOT b);b +ENDPROC multistopdruck;PROC schlueabkulieingang(TEXT CONST spezbestand): +bestand:=spezbestand;eingangsmaskezeigenundparameterlesen(PROC +schlueabkulispezielleteile).END PROC schlueabkulieingang;PROC +schlueabkulispezielleteile(INT CONST nr):SELECT nrOF CASE 1: +schlueabkulidialogvorbereitenCASE 2:schlueabkulieingabenrichtigCASE 3: +schlueabkulilistenvorbereitenCASE 4:schlueabkulidruckvorbereitenCASE 5: +schlueabkuliseitedruckenCASE 6:schlueabkulibildschirmvorbereitenCASE 7: +schlueabkuliseitezeigenENDSELECT .END PROC schlueabkulispezielleteile;PROC +schlueabkulidialogvorbereiten:schlueabkuliueberschrift:=text(vergleichsknoten +);setzeanfangswerte(schlueabkulieingangsmaske,schlueabkulianfpos).END PROC +schlueabkulidialogvorbereiten;PROC schlueabkulieingabenrichtig:LET +fnrausgdrucker=2,fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild, +null,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus); +setzeeingabetest(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld( +fnrausgbild)=niltext);setzeeingabetest(TRUE )FI .END PROC +schlueabkulieingabenrichtig;PROC bestandidbestimmenundalssachgebieteintragen: +#jf##systemdbon;putwert(fnrbestandname,bestand);search(dnrgesamtbestand,TRUE +);IF dbstatus=okTHEN sachgebiet:=intwert(fnrbestandid)ELSE sachgebiet:=maxint +FI ;#systemdboff;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,bestand) +ENDPROC bestandidbestimmenundalssachgebieteintragen;PROC +schlueabkulilistenvorbereiten:BOOL VAR b:=FALSE ; +bestandidbestimmenundalssachgebieteintragen;initobli(19);#A nzahlproS eite# +reinitparsing;setzeidentiwert("");objektlistestarten(dnrschluessel,"", +fnrschlschluessel,TRUE ,b);setzebestandende(b)END PROC +schlueabkulilistenvorbereiten;PROC schlueabkulibildschirmvorbereiten:LET +fnrausganf=2;standardkopfmaskeaktualisieren(schlueabkuliueberschrift); +initspalten;setzespaltenbreite(spalte1breite);setzespaltenbreite( +spalte2bildbreite);bildanf:=fnrausganf;setzebildanfangsposition(bildanf).END +PROC schlueabkulibildschirmvorbereiten;PROC schlueabkuliseitezeigen:blaettern +(PROC (INT CONST )abkuerzungzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop); +END PROC schlueabkuliseitezeigen;PROC abkuerzungzeigen(INT CONST dummy): +abkuerzungholen;abkuerzungaufbereiten;abkuerzungaufbildschirm.END PROC +abkuerzungzeigen;PROC abkuerzungaufbildschirm:INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsEND +REPEAT .END PROC abkuerzungaufbildschirm;PROC schlueabkulidruckvorbereiten: +druckvorbereiten;variablenfuerdrucksetzen;initspalten;setzespaltenbreite( +spalte1breite);setzespaltenbreite(spalte2druckbreite);initdruckkopf(zentriert +(schlueabkuliueberschrift,druckbreite)); +bestandidbestimmenundalssachgebieteintragen;lesenvorbereitendruck(PROC (INT +CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC multistopdruck). +variablenfuerdrucksetzen:spalte2druckbreite:=druckbreite-anzspaltentrenner- +spalte1breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen).END PROC +schlueabkulidruckvorbereiten;PROC schlueabkuliseitedrucken: +schlueabkuliueberschriftdrucken;seitedrucken(PROC (INT VAR )abkuerzungdrucken +,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopdruck);seitenwechsel.END +PROC schlueabkuliseitedrucken;PROC schlueabkuliueberschriftdrucken: +druckkopfschreiben;END PROC schlueabkuliueberschriftdrucken;PROC +abkuerzungdrucken(INT VAR zeilenzaehler):abkuerzungholen; +abkuerzungaufbereiten;zeilenzaehlerINCR ausgfeldlaenge;abkuerzungindruckdatei +.END PROC abkuerzungdrucken;PROC abkuerzungindruckdatei:druckzeileschreiben( +ausgfeld(1)).END PROC abkuerzungindruckdatei;PROC abkuerzungaufbereiten: +schreibeabkuerzunglangtext.schreibeabkuerzunglangtext:spaltenweise( +schluesselabk);spaltenweise(schluessellangtext);ausgfeld(1):=zeile.END PROC +abkuerzungaufbereiten;PROC abkuerzungholen:schluesselabk:=wert( +fnrschlschluessel);schluessellangtext:=wert(fnrschllangtext);END PROC +abkuerzungholen;END PACKET schluesselundabkuliste; + diff --git a/app/schulis/2.2.1/src/0.listen.schuelergruppen b/app/schulis/2.2.1/src/0.listen.schuelergruppen new file mode 100644 index 0000000..cbef1c3 --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.schuelergruppen @@ -0,0 +1,109 @@ +PACKET schuelergruppenlistenDEFINES schuelergruplispezielleteile:LET +AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT , +AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR +ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;LET schuelergruppeneingangsmaske= +"ms liste schuelergruppen",ausgfeldlaenge=1,anzahlderobjekteprobildschirm=17, +ueberschriftenzeilen=2,ausgkopflaenge=2,spaltentrenner=" ", +schuelergruppenanfpos=2,jgstspalte1breite=14,zugspalte2breite=9, +lehrerspalte3breite=15,stellvspalte4breite=15,strich="/",niltext="",blank=" " +,null=0,mnrauswahlnichtsinnvoll=56;LET textsj="Schuljahr",texthj= +"Schulhalbjahr";TEXT VAR schuelergruppenueberschrift:="",schuljahr,halbjahr, +jahrgangsstufe,altejahrgangsstufe:="",bearbeitungsschuljahr, +bearbeitungshalbjahr,zugtutor,klassenlehrer,stellvertreter, +auswahlnichtsinnvoll;TEXT CONST leerzeile:=bildbreite*blank,textueberschrift +:=("Jahrgangsstufe"+blank+"Zug/Tutor"+blank+"Klassenleiter"+3*blank+ +"Stellvertreter");INT VAR eingabestatus,bildanfang,spalte2druckbreite, +druckzeilenzahl;INT CONST aktuelleindexnr:=dnraktschuelergruppen;BOOL VAR +aktuelleshjgewaehlt;BOOL PROC multistop:BOOL VAR b;IF dbstatus=okTHEN b:=( +bearbeitungshalbjahr=wert(fnrsgrphj)AND bearbeitungsschuljahr=wert(fnrsgrpsj) +)ELSE b:=FALSE FI ;bEND PROC multistop;BOOL PROC multistopsim: +setzebestandende(FALSE );BOOL VAR b:=multistop;setzebestandende(NOT b);bEND +PROC multistopsim;PROC schuelergruplispezielleteile(INT CONST nr):SELECT nr +OF CASE 1:schuelergruppendialogvorbereitenCASE 2: +schuelergruppeneingabenrichtigCASE 3:schuelergruppenlistenvorbereitenCASE 4: +schuelergruppendruckvorbereitenCASE 5:schuelergruppenseitedruckenCASE 6: +schuelergruppenbildschirmvorbereitenCASE 7:schuelergruppenseitezeigen +ENDSELECT .END PROC schuelergruplispezielleteile;PROC +schuelergruppendialogvorbereiten:schuelergruppenueberschrift:=text( +vergleichsknoten);setzeanfangswerte(schuelergruppeneingangsmaske, +schuelergruppenanfpos)END PROC schuelergruppendialogvorbereiten;PROC +schuelergruppeneingabenrichtig:LET fnrausggeplanteshj=2,fnrausgaktuelleshj=3, +fnrausgdrucker=4,fnrausgbild=5;standardpruefe(5,fnrausgdrucker,fnrausgbild, +null,niltext,eingabestatus);IF eingabestatus=0THEN standardpruefe(5, +fnrausggeplanteshj,fnrausgaktuelleshj,null,niltext,eingabestatus);IF +eingabestatus=0THEN gewaehlteshalbjahrmerken;setzeeingabetest(TRUE ); +setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext)ELSE meldefehler; +setzeeingabetest(FALSE )FI ;ELSE meldefehler;setzeeingabetest(FALSE )FI . +meldefehler:meldungstext(mnrauswahlnichtsinnvoll,auswahlnichtsinnvoll); +standardmeldung(auswahlnichtsinnvoll,niltext).gewaehlteshalbjahrmerken: +aktuelleshjgewaehlt:=standardmaskenfeld(fnrausgaktuelleshj)<>niltext.END +PROC schuelergruppeneingabenrichtig;PROC schuelergruppenlistenvorbereiten: +BOOL VAR b;initspalten;setzespaltentrenner(spaltentrenner); +bearbeitungsschuljahr:=schulkenndatum(textsj);bearbeitungshalbjahr:= +schulkenndatum(texthj);IF NOT (aktuelleshjgewaehlt)THEN +geplanteshjundsjberechnen(bearbeitungshalbjahr,bearbeitungsschuljahr)FI ; +inittupel(dnraktschuelergruppen);setzeidentiwert("");initobli( +anzahlderobjekteprobildschirm);parsenooffields(6);putwert(fnrsgrpsj, +bearbeitungsschuljahr);putwert(fnrsgrphj,bearbeitungshalbjahr); +setzescanendewert("255");objektlistestarten(aktuelleindexnr, +bearbeitungsschuljahr,fnrsgrpjgst,TRUE ,b);setzebestandende(NOT multistopCOR +b);END PROC schuelergruppenlistenvorbereiten;PROC +schuelergruppenbildschirmvorbereiten:LET fnrausganf=2; +standardkopfmaskeaktualisieren(schuelergruppenueberschrift);bildanfang:= +fnrausganf;setzebildanfangsposition(bildanfang);INT VAR i;setzespaltenbreite( +bildbreite);spaltenweise(textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)IN +ausgabepos;erhoeheausgabeposumeins;spaltenweise(leerzeile);ausgfeld(1):=zeile +;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;setzebildanfangsposition(4) +;initspalten;setzespaltentrenner(spaltentrenner);setzespaltenbreite( +jgstspalte1breite);setzespaltenbreite(zugspalte2breite);setzespaltenbreite( +lehrerspalte3breite);setzespaltenbreite(stellvspalte4breite);END PROC +schuelergruppenbildschirmvorbereiten;PROC schuelergruppenseitezeigen: +blaettern(PROC (INT CONST )schuelergruppendatenzeigen,aktion,TRUE ,TRUE , +BOOL PROC multistop)END PROC schuelergruppenseitezeigen;PROC +schuelergruppendatenzeigen(INT CONST x):schuelergruppendatenholen; +schuelergruppendatenaufbereitenbild;schuelergruppendatenaufbildschirm;END +PROC schuelergruppendatenzeigen;PROC schuelergruppendatenholen:schuljahr:= +wert(fnrsgrpsj);halbjahr:=wert(fnrsgrphj);jahrgangsstufe:=wert(fnrsgrpjgst); +zugtutor:=wert(fnrsgrpkennung);klassenlehrer:=wert(fnrsgrplehrer); +stellvertreter:=wert(fnrsgrpstellvlehrer);END PROC schuelergruppendatenholen; +PROC schuelergruppendatenaufbereitenbild:IF length(jahrgangsstufe)=1THEN +spaltenweise(13*blank+jahrgangsstufe);ELSE spaltenweise(12*blank+ +jahrgangsstufe);FI ;spaltenweise(zugtutor);spaltenweise(klassenlehrer); +spaltenweise(stellvertreter);END PROC schuelergruppendatenaufbereitenbild; +PROC schuelergruppendatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos; +erhoeheausgabeposumeins;PER ;END PROC schuelergruppendatenaufbildschirm;PROC +schuelergruppendruckvorbereiten:setzebestandende(FALSE );druckvorbereiten; +variablenfuerdrucksetzen;TEXT VAR schjaufbereitet:=text(bearbeitungsschuljahr +,2)+strich+text(bearbeitungsschuljahr,2,3),halbjaufbereitet:= +bearbeitungshalbjahr+". Halbjahr";schuelergruppenueberschrift:= +"Liste der Schülergruppen im Schuljahr "+schjaufbereitet+blank+ +halbjaufbereitet;initdruckkopf(zentriert(schuelergruppenueberschrift, +druckbreite),zentriert(length(schuelergruppenueberschrift)*"-",druckbreite)); +initspalten;setzespaltenbreite(jgstspalte1breite);setzespaltenbreite( +zugspalte2breite);setzespaltenbreite(lehrerspalte3breite);setzespaltenbreite( +stellvspalte4breite);inittupel(dnraktschuelergruppen);initausgabekopfdruck; +putwert(fnrsgrpsj,bearbeitungsschuljahr);putwert(fnrsgrphj, +bearbeitungshalbjahr);lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT +VAR )scanforward,BOOL PROC multistopsim);.variablenfuerdrucksetzen: +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC +schuelergruppendruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck(1):= +textueberschrift;ausgkopfdruck(2):=leerzeileEND PROC initausgabekopfdruck; +PROC schuelergruppenseitedrucken:schuelergruppenueberschriftdrucken; +seitedrucken(PROC (INT VAR )schuelergruppendrucken,druckzeilenzahl, +ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END PROC +schuelergruppenseitedrucken;PROC schuelergruppenueberschriftdrucken:INT VAR i +;druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP druckzeileschreiben( +ausgkopfdruck(i))PER END PROC schuelergruppenueberschriftdrucken;PROC +schuelergruppendrucken(INT VAR zeilenzaehler):schuelergruppendatenholen;IF +altejahrgangsstufe<>jahrgangsstufeTHEN spaltenweise(" ");spaltenweise(" "); +spaltenweise(" ");spaltenweise(" ");ausgfeld(1):=zeile;zeilenzaehlerINCR +ausgfeldlaenge;schuelergruppenindruckdateiFI ;schuelergruppenaufbereitendruck +;zeilenzaehlerINCR ausgfeldlaenge;schuelergruppenindruckdatei.END PROC +schuelergruppendrucken;PROC schuelergruppenaufbereitendruck: +setzespaltentrenner(spaltentrenner);schuelergruppendatenaufbereitenbild; +ausgfeld(1):=zeile;altejahrgangsstufe:=jahrgangsstufe;END PROC +schuelergruppenaufbereitendruck;PROC schuelergruppenindruckdatei:INT VAR i; +FOR iFROM 1UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END +PROC schuelergruppenindruckdatei;END PACKET schuelergruppenlisten + diff --git a/app/schulis/2.2.1/src/0.listen.schulen b/app/schulis/2.2.1/src/0.listen.schulen new file mode 100644 index 0000000..c23ade2 --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.schulen @@ -0,0 +1,87 @@ +PACKET schulenlistenDEFINES schulenspezielleteile:LET niltext="",blank=" ", +mittestrich="-",ueberschriftenzeilen=1,#bestand="c05 schulen",#spalte1breite= +8,spalte2breite=8,spalte4breite=17,anzspaltentrenner=3,ausgkopflaenge=3, +ausgfeldlaenge=5,#maxdbwerte=100,##anzdbwerte=8,#AUSGFELD =ROW ausgfeldlaenge +TEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,schuleneingangsmaske= +"mu liste einfach eingang",schulenanfpos=2;#LET dnrschulen=120,fnrschkennung= +121,fnrschname=122,fnrschart=123,fnrschamtlnr=127,fnrschbundesland=128, +fnrschstrnr=124,fnrschplzort=125,fnrschtelnr=126;#INT CONST spalte3bildbreite +:=bildbreite-anzspaltentrenner-spalte1breite-spalte2breite-spalte4breite;INT +VAR spalte3druckbreite,spalte3breite,druckzeilenzahl,bildanf,eingabestatus; +TEXT VAR schulenueberschrift,schulkennung,schulart,amtlschulkennnr,schulname, +schulstrnr,schulnat,schulplz,schulort,schulland,schultelnr,anfbuchstabe, +neueranfbuchstabe;TEXT VAR druckstrich;TEXT CONST bildstrich:=bildbreite* +mittestrich;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL PROC multistop: +TRUE ENDPROC multistop;BOOL PROC multistopsim:setzebestandende(FALSE );TRUE +ENDPROC multistopsim;PROC schulenspezielleteile(INT CONST nr):SELECT nrOF +CASE 1:schulendialogvorbereitenCASE 2:schuleneingabenrichtigCASE 3: +schulenlistenvorbereitenCASE 4:schulendruckvorbereitenCASE 5: +schulenseitedruckenCASE 6:schulenbildschirmvorbereitenCASE 7: +schulenseitezeigenENDSELECT .END PROC schulenspezielleteile;PROC +schulendialogvorbereiten:schulenueberschrift:=text(vergleichsknoten); +setzeanfangswerte(schuleneingangsmaske,schulenanfpos).END PROC +schulendialogvorbereiten;PROC schuleneingabenrichtig:LET fnrausgdrucker=2, +fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,0,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext); +setzeeingabetest(TRUE )END IF .END PROC schuleneingabenrichtig;PROC +schulenlistenvorbereiten:BOOL VAR b;inittupel(dnrschulen);initobli(3); +reinitparsing;setzeidentiwert("");objektlistestarten(dnrschulen,"", +fnrschkennung,TRUE ,b);setzebestandende(b)END PROC schulenlistenvorbereiten; +PROC schulenbildschirmvorbereiten:LET fnrausganf=2; +standardkopfmaskeaktualisieren(schulenueberschrift);initspalten;spalte3breite +:=spalte3bildbreite;ausgfeld(5):=bildbreite*blank;setzespaltenbreiten; +initausgabekopf(bildstrich);bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO +ausgkopflaengeREPEAT ausgkopf(i)IN bildanf;bildanfINCR 1END REPEAT ; +setzebildanfangsposition(bildanf).END PROC schulenbildschirmvorbereiten;PROC +schulenseitezeigen:blaettern(PROC (INT CONST )schulezeigen,aktion,TRUE , +FALSE ,BOOL PROC multistop);END PROC schulenseitezeigen;PROC schulezeigen( +INT CONST dummy):schuleholen;schuleaufbereiten;schuleaufbildschirm.END PROC +schulezeigen;PROC schuleaufbildschirm:INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsEND +REPEAT .END PROC schuleaufbildschirm;PROC schulendruckvorbereiten: +anfbuchstabe:=niltext;druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf +(zentriert(schulenueberschrift,druckbreite));initspalten;spalte3breite:= +spalte3druckbreite;ausgfeld(5):=druckbreite*blank;setzespaltenbreiten; +initausgabekopf(druckstrich);inittupel(dnrschulen);setzebestandende(FALSE ); +lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL +PROC multistopsim).variablenfuerdrucksetzen:druckstrich:=druckbreite* +mittestrich;spalte3druckbreite:=druckbreite-anzspaltentrenner-spalte1breite- +spalte2breite-spalte4breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen +)-ausgkopflaenge.END PROC schulendruckvorbereiten;PROC schulenseitedrucken: +schulenueberschriftdrucken;seitedrucken(PROC (INT VAR )schuledrucken, +druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END +PROC schulenseitedrucken;PROC schulenueberschriftdrucken:druckkopfschreiben; +INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i +))END REPEAT .END PROC schulenueberschriftdrucken;PROC schuledrucken(INT VAR +zeilenzaehler):LET druckmeldung=101,markiert="#";schuleholen; +ggfmeldunganfbuchstabe;schuleaufbereiten;zeilenzaehlerINCR ausgfeldlaenge; +schuleindruckdatei.ggfmeldunganfbuchstabe:IF anfangsbuchstabegeaendertTHEN +meldunganfbuchstabeEND IF .anfangsbuchstabegeaendert:neueranfbuchstabe:= +schulkennungSUB 1;anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe: +standardmeldung(druckmeldung,neueranfbuchstabe+markiert);anfbuchstabe:= +neueranfbuchstabe.END PROC schuledrucken;PROC schuleindruckdatei:INT VAR i; +FOR iFROM 1UPTO ausgfeldlaengeREPEAT druckzeileschreiben(ausgfeld(i))END +REPEAT .END PROC schuleindruckdatei;PROC setzespaltenbreiten: +setzespaltenbreite(spalte1breite);setzespaltenbreite(spalte2breite); +setzespaltenbreite(spalte3breite);setzespaltenbreite(spalte4breite);END PROC +setzespaltenbreiten;PROC initausgabekopf(TEXT CONST strich):LET kennung= +"Kennung",art="Schulart",name="Name",amtlnr="amtl. Nr.",adresse="Adresse", +telnr="Telefon";spaltenweise(kennung);spaltenweise(art);spaltenweise(name); +spaltenweise(blank);ausgkopf(1):=zeile;spaltenweise(blank);spaltenweise( +amtlnr);spaltenweise(adresse);spaltenweise(telnr);ausgkopf(2):=zeile;ausgkopf +(3):=strich.END PROC initausgabekopf;PROC schuleholen:schulkennung:=wert( +fnrschkennung);schulname:=wert(fnrschname);schulart:=wert(fnrschart); +amtlschulkennnr:=wert(fnrschamtlnr);schulland:=wert(fnrschbundesland); +schulstrnr:=wert(fnrschstrnr);schulort:=wert(fnrschplzort);schultelnr:=wert( +fnrschtelnr).END PROC schuleholen;PROC schuleaufbereiten:LET deutsch="D"; +schreibekennungartname;schreibeamtlnrstrtelnr;schreibeortland. +schreibekennungartname:spaltenweise(schulkennung);spaltenweise(schulart); +spaltenweise(schulname);spaltenweise(blank);ausgfeld(1):=zeile. +schreibeamtlnrstrtelnr:spaltenweise(blank);spaltenweise(amtlschulkennnr); +spaltenweise(schulstrnr);spaltenweise(schultelnr);ausgfeld(2):=zeile. +schreibeortland:spaltenweise(blank);spaltenweise(blank);spaltenweise(schulort +);spaltenweise(blank);ausgfeld(3):=zeile;spaltenweise(blank);spaltenweise( +blank);spaltenweise(schulland);spaltenweise(blank);ausgfeld(4):=zeile.END +PROC schuleaufbereiten;END PACKET schulenlisten; + diff --git a/app/schulis/2.2.1/src/0.listen.steuerung b/app/schulis/2.2.1/src/0.listen.steuerung new file mode 100644 index 0000000..bafd51b --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.steuerung @@ -0,0 +1,67 @@ +PACKET listensteuerungDEFINES eingangsmaskezeigenundparameterlesen, +listedruckenoderzeigenggflweitereaktionlesen,weitereaktionlesen, +aufbildschirmblaettern,druckbearbeitung,setzeanfangswerte,setzeausgabedrucker +,ausgabedrucker,setzeeingabetest,setzebildanfangsposition,ausgabepos, +erhoeheausgabeposumeins,seitenzaehler,erhoeheseitenzaehlerumeins,aktion, +bildbreite,bildlaenge:LET namebildausgabemaske="mu liste bildausgabe", +datenexistierennicht=59,warteaufforderung=69,listewirdgedruckt=58, +zurnachprozedur=1,niltext="",blank=" ";INT VAR bildanfangsposition, +aktuelleposition,zeiger,richtung,seite;TEXT VAR nameauswahlmaske;BOOL VAR +eingabenrichtig,ausgdrucker;TEXT CONST leerzeilebild:=bildbreite*blank;PROC +eingangsmaskezeigenundparameterlesen(PROC (INT CONST )spezielleteile): +enablestop;dialogvorbereiten;dialogstarten.dialogvorbereiten:spezielleteile(1 +);standardstartproc(nameauswahlmaske).dialogstarten:infeld(aktuelleposition); +standardnproc.END PROC eingangsmaskezeigenundparameterlesen;PROC +listedruckenoderzeigenggflweitereaktionlesen(PROC (INT CONST )spezielleteile) +:eingabenueberpruefen;IF eingabenrichtigTHEN werteauswahlausundgibausELSE +wiederholeauswahlFI .eingabenueberpruefen:spezielleteile(2). +werteauswahlausundgibaus:meldewarten;vorbereitungenliste;IF bestandendeTHEN +meldekeinbestand;zurueckzumdialogELIF ausgdruckerTHEN druckbearbeitung( +zurnachprozedur,PROC spezielleteile)ELSE +bildschirmvorbereitenundersteseitezeigen(PROC spezielleteile)FI . +vorbereitungenliste:spezielleteile(3).meldewarten:standardmeldung( +warteaufforderung,niltext).meldekeinbestand:standardmeldung( +datenexistierennicht,niltext).wiederholeauswahl:zurueckzumdialog. +zurueckzumdialog:return(1).END PROC +listedruckenoderzeigenggflweitereaktionlesen;PROC druckbearbeitung(INT CONST +ruecksprung,PROC (INT CONST )spezielleteile):IF NOT (ruecksprung= +zurnachprozedur)THEN setzeausgabedrucker(TRUE )FI ;seite:=1; +ausgebenaufdrucker(PROC spezielleteile);zurueckzumdialog.zurueckzumdialog:IF +ruecksprung=zurnachprozedurTHEN return(ruecksprung)ELSE enter(ruecksprung)FI +.END PROC druckbearbeitung;PROC ausgebenaufdrucker(PROC (INT CONST ) +spezielleteile):setzemitseitennummern(TRUE );druckvorbereiten;druckeeineseite +;WHILE NOT bestandendeREP nimmnaechsteseite;druckeeineseitePER ; +meldelistewirdgedruckt;drucknachbereiten.druckvorbereiten:spezielleteile(4). +druckeeineseite:spezielleteile(5).nimmnaechsteseite:seiteINCR 1. +meldelistewirdgedruckt:standardmeldung(listewirdgedruckt,niltext).END PROC +ausgebenaufdrucker;PROC bildschirmvorbereitenundersteseitezeigen(PROC (INT +CONST )spezielleteile):standardstartproc(namebildausgabemaske);spezielleteile +(6);richtung:=#1;#3;seitezeigen(PROC spezielleteile);dialogstarten. +dialogstarten:weitereaktionlesen.END PROC +bildschirmvorbereitenundersteseitezeigen;PROC weitereaktionlesen:maskendialog +.maskendialog:aktuelleposition:=21;infeld(aktuelleposition);standardnproc. +END PROC weitereaktionlesen;PROC aufbildschirmblaettern(INT CONST was,PROC ( +INT CONST )spezielleteile):richtung:=was;standardkopfmaskeaktualisieren; +seitezeigen(PROC spezielleteile);zurueckzumdialog.zurueckzumdialog:return(1). +END PROC aufbildschirmblaettern;PROC setzeanfangswerte(TEXT CONST +eingangsmaske,INT CONST anfpos):nameauswahlmaske:=eingangsmaske; +aktuelleposition:=anfpos;END PROC setzeanfangswerte;PROC seitezeigen(PROC ( +INT CONST )spezielleteile):LET fnrausgende=20;aktuelleposition:= +bildanfangsposition;spezielleteile(7);ggfrestbildloeschen.ggfrestbildloeschen +:IF neuesbildangefangenTHEN restbildloeschenFI .neuesbildangefangen: +aktuelleposition>bildanfangsposition.restbildloeschen:FOR zeigerFROM +aktuellepositionUPTO fnrausgendeREP leerzeilebildIN zeigerPER .END PROC +seitezeigen;PROC setzeausgabedrucker(BOOL CONST b):ausgdrucker:=bEND PROC +setzeausgabedrucker;BOOL PROC ausgabedrucker:ausgdruckerEND PROC +ausgabedrucker;PROC setzeeingabetest(BOOL CONST b):eingabenrichtig:=bEND +PROC setzeeingabetest;PROC setzebildanfangsposition(INT CONST anfangsposition +):bildanfangsposition:=anfangspositionEND PROC setzebildanfangsposition;INT +PROC ausgabepos:aktuellepositionEND PROC ausgabepos;PROC +erhoeheausgabeposumeins:aktuellepositionINCR 1END PROC +erhoeheausgabeposumeins;INT PROC seitenzaehler:seiteEND PROC seitenzaehler; +PROC erhoeheseitenzaehlerumeins:seiteINCR 1END PROC +erhoeheseitenzaehlerumeins;INT PROC aktion:richtungEND PROC aktion;LET +bildzeilenbreite=78,bildseitenlaenge=23,bildkopflaenge=4;INT CONST bildbreite +:=bildzeilenbreite,bildlaenge:=bildseitenlaenge-bildkopflaenge;END PACKET +listensteuerung; + diff --git a/app/schulis/2.2.1/src/0.listen.werkzeuge b/app/schulis/2.2.1/src/0.listen.werkzeuge new file mode 100644 index 0000000..011db81 --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.werkzeuge @@ -0,0 +1,29 @@ +PACKET listenwerkzeugeDEFINES initspalten,setzespaltenbreite, +setzespaltentrenner,spaltenweise,zeile,geblockt,zentriert,zweistellig, +vergleichsdatum:LET maxanzspalten=20,null=0,blank=" ",niltext=""#,andenanfang +=1,ansende=2,vorwaerts=3,rueckwaerts=4,naechstenlesen=1;#;TEXT VAR +zwischenpuffer,spaltentrenner;INT VAR aktspalte,aktmaxanzspalten;ROW +maxanzspaltenINT VAR spaltenbreite;PROC initspalten:INT VAR i;FOR iFROM 1 +UPTO maxanzspaltenREP spaltenbreite(i):=nullPER ;aktmaxanzspalten:=null; +aktspalte:=1;zwischenpuffer:=niltext;spaltentrenner:=blank;END PROC +initspalten;PROC setzespaltenbreite(INT CONST breite):aktmaxanzspaltenINCR 1; +IF aktmaxanzspalten<=maxanzspaltenTHEN spaltenbreite(aktmaxanzspalten):= +breiteFI ;END PROC setzespaltenbreite;PROC setzespaltentrenner(TEXT CONST +trenner):spaltentrenner:=trennerEND PROC setzespaltentrenner;PROC +spaltenweise(TEXT CONST t):IF aktspalte>aktmaxanzspaltenTHEN aktspalte:=1; +zwischenpuffer:=niltextFI ;zwischenpuffer:=zwischenpuffer+text(t, +spaltenbreite(aktspalte));IF aktspalteniltextTHEN +statleseschleife(dnraktschuelergruppen,jgst,niltext,fnrsgrpjgst, +fnrsgrpkennung,PROC pruefesg)ELSE sek2:=FALSE ;letztejgst:=niltext; +statleseschleife(dnraktschuelergruppen,jgst,niltext,fnrsgrpjgst, +fnrsgrpkennung,PROC allesg)FI ;.setzerichtigeschulkenndaten:IF NOT aktuell +THEN IF schulhalbjahr=halbjahr1THEN schulhalbjahr:=halbjahr2ELSE schuljahr:= +subtext(schuljahr,3,4);schuljahrCAT text(int(schuljahr)+1);schulhalbjahr:= +halbjahr1FI ;FI ;putwert(fnrsgrpsj,schuljahr);putwert(fnrsgrphj,schulhalbjahr +);.END PROC holevergleichssg;BOOL PROC istzulaessigesg(TEXT CONST sg):pos( +aktuelleschuelergruppen,sg)>0END PROC istzulaessigesg;TEXT PROC sgeinerjgst: +aktuelleschuelergruppenEND PROC sgeinerjgst;PROC pruefesg(BOOL VAR schluss): +TEXT CONST sg:=jgstaufber(wert(fnrsgrpjgst))+wert(fnrsgrpkennung);IF dbstatus +=0CAND subtext(sg,1,2)=vergljgstTHEN neueaktuelleschuelergruppe(sg)ELSE +schluss:=TRUE FI .END PROC pruefesg;PROC allesg(BOOL VAR schluss):IF dbstatus +<>0OR wert(fnrsgrpsj)<>schuljahrOR wert(fnrsgrphj)<>schulhalbjahrTHEN schluss +:=TRUE ELSE TEXT CONST sg:=jgstaufber(wert(fnrsgrpjgst))+wert(fnrsgrpkennung) +;neueaktuelleschuelergruppe(sg)FI END PROC allesg;PROC +neueaktuelleschuelergruppe(TEXT CONST sg):IF aktuelleschuelergruppen=niltext +THEN anhaengenELSE trennen;anhaengenFI .anhaengen:aktuelleschuelergruppenCAT +sg;.trennen:aktuelleschuelergruppenCAT bestandtrenner.END PROC +neueaktuelleschuelergruppe;PROC initgruppenwechsel:INT VAR i;FOR iFROM 1UPTO +maxgwREP gw(i):=niltextPER .END PROC initgruppenwechsel;PROC gruppenwechsel( +TEXT CONST gwneu,INT CONST gwalt,INT CONST laenge,incr,INT VAR aktuellesfeld) +:IF gruppenwechselliegtvorTHEN gruppenwechselzeigenELSE leeresfeldFI ; +weiterzaehlen.gruppenwechselliegtvor:(schuelerzahl=1)COR (gw(gwalt)<>gwneu). +gruppenwechselzeigen:standardmaskenfeld(text(gwneu,laenge),aktuellesfeld);gw( +gwalt):=gwneu.leeresfeld:standardmaskenfeld(laenge*blank,aktuellesfeld). +weiterzaehlen:aktuellesfeldINCR incr.END PROC gruppenwechsel;PROC +eingangsbehandlunglistenweise:standardvproc(maske(vergleichsknoten))END PROC +eingangsbehandlunglistenweise;PROC startebildschirmblock(INT CONST best,sz): +nichtzuende:=TRUE ;bestand:=best;starten:=TRUE ;schuelerzahl:=sz.END PROC +startebildschirmblock;PROC bildschirmblock(PROC schuelerzeigen,BOOL PROC ( +INT CONST )pruefungspeziell,INT CONST was):INT VAR lv,anzahl;IF startenTHEN +erstenzeigen;neuerblock;erhoehezaehlerELSE neuerblockFI .erstenzeigen: +schuelerzeigen;changeindex.erhoehezaehler:schuelerzahlINCR 1.neuerblock: +anzahl:=schuelerzahl;starten:=FALSE ;IF nichtzuendeTHEN multisucc(bestand, +anzahl);FOR lvFROM 1UPTO anzahlREP schuelerlesen;nichtzuende:= +pruefungspeziell(was);IF nichtzuendeTHEN schuelerzeigenELSE LEAVE neuerblock +FI PER ;nichtzuende:=anzahl=schuelerzahlFI ;.schuelerlesen:stackentry(lv). +END PROC bildschirmblock;END PACKET listenweisegrundfunktionen; + diff --git a/app/schulis/2.2.1/src/0.listenweise klassen erf b/app/schulis/2.2.1/src/0.listenweise klassen erf new file mode 100644 index 0000000..9b3c02e --- /dev/null +++ b/app/schulis/2.2.1/src/0.listenweise klassen erf @@ -0,0 +1,215 @@ +PACKET listenweiseklassenerfDEFINES neueinfuegenklassen,entfernenklassen, +bearbeitungklassen,klassennichtspeichern,klassenspeichern:LET tofather=1, +tograndfather=2,niltext="",blank=" ",null=0,trenner="/",meldtrenner="#";LET +standardanfang=1,standardeinstieg=4;LET jgst5=5,jgst13=13,erstejgst="05";LET +erstesfeld=3,felderprozeile=4,klassenproseite=18;LET meldbestleer=59, +meldnichtspeichern=63,meldplausi=57,meldwertzulang=60,meldwarten=69, +meldspeicherung=132,meldspeicherfehler=131,meldfalscheauswahl=56, +meldfortschreibung=140,meldkeinelehrer=141,meldfalscherlehrer=142,meldschonda +=143,meldnichtleer=144,meldnichtda=134,meldloeschung=145;LET maxlaengekennung +=4,maxlaengeintegabez=4;LET pruefartalternative=5,pruefartgrenzen=3;LET +fnrjgst=4,fnrakt=3,fnrgepl=2,fnrfort2=5,fnrfortneu=6;LET keysj="Schuljahr", +keyshj="Schulhalbjahr";LET wertaktuell="aktuell",wertgeplant="geplant";LET +paraphentrenner=" ";LET vaaendern=1,vaneu=2,valoeschen=3;LET hj1="1",hj2="2"; +BOOL VAR nochwelcheda,akthalbjahr,fortschreibungzweiteshalbjahr, +fortschreibungneuesschuljahr,fortschreibung;INT VAR klassenzahl,aktuellesfeld +,pruefstatus,verarbeitungsart;ROW klassenproseiteTEXT VAR kennung;ROW +klassenproseiteTEXT VAR altedaten;TEXT VAR neuesschuljahr,neueshalbjahr, +vergleichsjgst,lehrerparaphen:=niltext,schuljahr:=niltext,halbjahr:=niltext; +PROC eingangsbildschirmpruefen(BOOL CONST neu):reinitparsing; +ankreuzfelderpruefen;IF eingangsbildschirmokTHEN jgstpruefen;IF +eingangsbildschirmokTHEN fortschreibungpruefenFI FI .ankreuzfelderpruefen: +standardpruefe(pruefartalternative,fnrgepl,fnrakt,null,niltext,pruefstatus). +jgstpruefen:akthalbjahr:=standardmaskenfeld(fnrakt)<>niltext;standardpruefe( +pruefartgrenzen,fnrjgst,jgst5,jgst13,niltext,pruefstatus);. +fortschreibungpruefen:vergleichsjgst:=jgstaufber(standardmaskenfeld(fnrjgst)) +;fortschreibungzweiteshalbjahr:=standardmaskenfeld(fnrfort2)<>niltext; +fortschreibungneuesschuljahr:=standardmaskenfeld(fnrfortneu)<>niltext; +fortschreibung:=(fortschreibungzweiteshalbjahrCOR +fortschreibungneuesschuljahr);IF (fortschreibungzweiteshalbjahrCAND +fortschreibungneuesschuljahr)THEN pruefstatus:=fnrfort2ELIF (fortschreibung +CAND akthalbjahr)THEN pruefstatus:=fnraktELIF (fortschreibungCAND (NOT neu)) +THEN pruefstatus:=meldfortschreibungELIF ((NOT akthalbjahr)CAND ( +vergleichsjgst=erstejgst))CAND fortschreibungneuesschuljahrTHEN pruefstatus:= +fnrjgstFI ;IF pruefstatus=meldfortschreibungTHEN standardmeldung(pruefstatus, +niltext);pruefstatus:=fnrjgstELIF pruefstatus<>nullTHEN standardmeldung( +meldfalscheauswahl,niltext)FI .eingangsbildschirmok:pruefstatus=0.END PROC +eingangsbildschirmpruefen;PROC neueinfuegenklassen:verarbeitungsart:=vaneu; +eingangsbehandlungEND PROC neueinfuegenklassen;PROC entfernenklassen: +verarbeitungsart:=valoeschen;eingangsbehandlungEND PROC entfernenklassen; +PROC bearbeitungklassen:verarbeitungsart:=vaaendern;eingangsbehandlungEND +PROC bearbeitungklassen;PROC eingangsbehandlung:BOOL CONST neueklassen:=( +verarbeitungsart=vaneu);eingangsbildschirmpruefen(neueklassen);IF +eingangsbildschirmokTHEN neuesschuljahrhalbjahrerrechnen; +initialisierungenvornehmen;blocklesenundausgeben;IF keinemehrdaTHEN +bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE +eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmok:pruefstatus=0. +initialisierungenvornehmen:bestandsetzen;plausipruefungvorbereiten; +standardstartproc(maske(vergleichsknoten)).bestandsetzen:infeld(fnrjgst);IF +verarbeitungsart=vaaendernTHEN pruefebestandELSE nochwelcheda:=trueFI . +pruefebestand:inittupel(dnraktschuelergruppen);klassengrunddateninpuffer; +search(dnraktschuelergruppen,FALSE );IF keineklassezudieserjgstTHEN +bestandleermelden;return(tofather);LEAVE eingangsbehandlungELSE nochwelcheda +:=trueFI .keineklassezudieserjgst:(dbstatus<>null)COR ((jgstaufber(wert( +fnrsgrpjgst))<>vergleichsjgst)COR (wert(fnrsgrpsj)<>neuesschuljahr)COR (wert( +fnrsgrphj)<>neueshalbjahr)).plausipruefungvorbereiten:standardmeldung( +meldwarten,niltext);.keinemehrda:NOT nochwelcheda.bestandleermelden: +standardmeldung(meldbestleer,niltext).eingangsmaskenfehler:infeld(pruefstatus +).END PROC eingangsbehandlung;PROC klassennichtspeichern:nichtspeichernmelden +;neuerblock.nichtspeichernmelden:standardmeldung(meldnichtspeichern,niltext); +pause(10).END PROC klassennichtspeichern;PROC klassenspeichern:SELECT +verarbeitungsartOF CASE vaaendern:aenderungenspeichernCASE vaneu: +neueklassenspeichernCASE valoeschen:klassenloeschenEND SELECT . +aenderungenspeichern:speicherungdurchfuehren(PROC (BOOL VAR ) +pruefeaenderungsplausi,false,true,false).neueklassenspeichern: +speicherungdurchfuehren(PROC (BOOL VAR )pruefeneuplausi,true,false,false). +klassenloeschen:speicherungdurchfuehren(PROC (BOOL VAR )pruefeloeschplausi, +false,false,true).END PROC klassenspeichern;PROC pruefeloeschplausi(BOOL VAR +dateninordnung):INT VAR satzindex:=erstesfeld,plausind;FOR plausindFROM 1 +UPTO klassenzahlREP pruefezeile;IF NOT dateninordnungTHEN fehlermeldung; +LEAVE pruefeloeschplausiFI ;satzindexINCR felderprozeilePER .pruefezeile:IF +standardmaskenfeld(satzindex)<>niltextTHEN dateninordnung:= +schuelergruppevorhandenFI .schuelergruppevorhanden:klassengrunddateninpuffer; +putwert(fnrsgrpkennung,standardmaskenfeld(satzindex));search( +dnraktschuelergruppen,TRUE );aktuellesfeld:=satzindex;(dbstatus=null). +fehlermeldung:IF (akthalbjahr)CAND (dbstatus=null)THEN TEXT VAR pruefsg:= +vergleichsjgst+standardmaskenfeld(satzindex);standardmeldung(meldnichtleer, +pruefsg+meldtrenner)ELSE standardmeldung(meldnichtda,standardmaskenfeld( +satzindex)+meldtrenner)FI .END PROC pruefeloeschplausi;PROC pruefeneuplausi( +BOOL VAR dateninordnung):BOOL VAR parapheninordnung;INT VAR satzindex:= +erstesfeld,plausind;IF lehrerparaphen=niltextTHEN holeallelehrerparaphenFI ; +FOR plausindFROM 1UPTO klassenzahlREP IF standardmaskenfeld(satzindex)<> +niltextTHEN IF length(standardmaskenfeld(satzindex))>maxlaengekennungTHEN +dateninordnung:=FALSE ;standardmeldung(meldwertzulang,meldtrenner); +aktuellesfeld:=satzindex;LEAVE pruefeneuplausiELIF length(standardmaskenfeld( +satzindex+3))>maxlaengeintegabezTHEN dateninordnung:=FALSE ;standardmeldung( +meldwertzulang,meldtrenner);aktuellesfeld:=satzindex+3;LEAVE pruefeneuplausi +ELSE parapheninordnung:=korrekteparaphe(satzindex+1)CAND korrekteparaphe( +satzindex+2);dateninordnung:=parapheninordnungCAND schuelergruppenochnichtda; +IF NOT dateninordnungTHEN fehlermeldung;LEAVE pruefeneuplausiFI FI FI ; +satzindexINCR felderprozeilePER .schuelergruppenochnichtda:TEXT VAR pruefsg:= +vergleichsjgst+standardmaskenfeld(satzindex);klassengrunddateninpuffer; +putwert(fnrsgrpkennung,standardmaskenfeld(satzindex));search( +dnraktschuelergruppen,TRUE );aktuellesfeld:=satzindex;(dbstatus<>null). +fehlermeldung:IF NOT parapheninordnungTHEN IF lehrerparaphen=paraphentrenner +THEN standardmeldung(meldkeinelehrer,niltext)ELSE standardmeldung( +meldfalscherlehrer,standardmaskenfeld(aktuellesfeld)+meldtrenner)FI ELSE +standardmeldung(meldschonda,pruefsg+meldtrenner)FI .END PROC pruefeneuplausi; +PROC pruefeaenderungsplausi(BOOL VAR dateninordnung):INT VAR satzindex:= +erstesfeld,plausind;IF lehrerparaphen=niltextTHEN holeallelehrerparaphenFI ; +FOR plausindFROM 1UPTO klassenzahlREP IF length(standardmaskenfeld(satzindex) +)>maxlaengekennungTHEN dateninordnung:=FALSE ;standardmeldung(meldwertzulang, +meldtrenner);aktuellesfeld:=satzindex;LEAVE pruefeaenderungsplausiELIF length +(standardmaskenfeld(satzindex+3))>maxlaengeintegabezTHEN dateninordnung:= +FALSE ;standardmeldung(meldwertzulang,meldtrenner);aktuellesfeld:=satzindex+3 +;LEAVE pruefeaenderungsplausiELSE dateninordnung:=korrekteparaphe(satzindex+1 +)CAND korrekteparaphe(satzindex+2);IF NOT dateninordnungTHEN fehlermeldung; +LEAVE pruefeaenderungsplausiFI ;FI ;satzindexINCR felderprozeilePER . +fehlermeldung:IF lehrerparaphen=paraphentrennerTHEN standardmeldung( +meldkeinelehrer,niltext)ELSE standardmeldung(meldfalscherlehrer, +standardmaskenfeld(aktuellesfeld)+meldtrenner)FI .END PROC +pruefeaenderungsplausi;PROC speicherungdurchfuehren(PROC (BOOL VAR )plausi, +BOOL CONST neu,aendern,loeschen):pruefeplausibilitaet;IF dateninordnungTHEN +speicherntransaktion;neuerblockELSE eingabefehler;return(tofather)FI ;. +pruefeplausibilitaet:BOOL VAR dateninordnung:=true;standardmeldung(meldplausi +,niltext);plausi(dateninordnung).speicherntransaktion:BOOL VAR +transaktionsfehler:=false;BOOL VAR aenderungsvermerkzusetzen:=FALSE ; +aendernschleife;IF aenderungsvermerkzusetzenTHEN IF akthalbjahrTHEN +aenderungsvermerksetzen(wertaktuell)ELSE aenderungsvermerksetzen(wertgeplant) +FI ELSE pause(10)FI .aendernschleife:INT VAR suind;INT VAR zahlderaenderungen +:=null;INT VAR satzindex:=erstesfeld;FOR suindFROM 1UPTO klassenzahlREP +behandleklassensatz;satzindexINCR felderprozeilePER .behandleklassensatz:IF +datenveraendertTHEN fuehreaenderungaus;aenderungsvermerkzusetzen:=TRUE ; +meldevollzugFI .datenveraendert:((NOT aendern)CAND (standardmaskenfeld( +satzindex)<>niltext))COR (aendernCAND (altedaten(suind)<>(standardmaskenfeld( +satzindex+1)+trenner+standardmaskenfeld(satzindex+2)+trenner+ +standardmaskenfeld(satzindex+3)))).fuehreaenderungaus:lesenvorbereiten;lesen; +zurueckschreiben.lesenvorbereiten:zahlderaenderungenINCR 1; +klassengrunddateninpuffer;putwert(fnrsgrpkennung,standardmaskenfeld(satzindex +)).lesen:IF NOT neuTHEN search(dnraktschuelergruppen,TRUE ); +transaktionsfehler:=(dbstatus<>null)FI .zurueckschreiben:IF NOT +transaktionsfehlerTHEN saveupdateposition(dnraktschuelergruppen);IF NOT +loeschenTHEN putwert(fnrsgrplehrer,standardmaskenfeld(satzindex+1));putwert( +fnrsgrpstellvlehrer,standardmaskenfeld(satzindex+2));bereiteintegabezauf; +putwert(fnrsgrpintegabez,standardmaskenfeld(satzindex+3));IF aendernTHEN +selupdate(dnraktschuelergruppen)ELSE insert(dnraktschuelergruppen);# +wuerfelwarten(vergleichsjgst,dr10.05.88standardmaskenfeld(satzindex))#FI +ELSE delete(dnraktschuelergruppen);#wuerfelwarten(vergleichsjgst,dr10.05.88 +standardmaskenfeld(satzindex))#FI FI .bereiteintegabezauf:IF +standardmaskenfeld(satzindex+3)=niltextCAND length(standardmaskenfeld( +satzindex))<=2THEN standardmaskenfeld(standardmaskenfeld(erstesfeld-1)+ +standardmaskenfeld(satzindex),satzindex+3)FI .meldevollzug:TEXT VAR +meldungstext;IF dbstatus=nullTHEN meldungstext:=vergleichsjgst+ +standardmaskenfeld(satzindex)+meldtrenner;IF NOT loeschenTHEN standardmeldung +(meldspeicherung,meldungstext)ELSE standardmeldung(meldloeschung,meldungstext +)FI ELSE meldungstext:=text(dbstatus)+meldtrenner;meldungstextCAT ( +vergleichsjgst+standardmaskenfeld(satzindex));meldungstextCAT meldtrenner; +standardmeldung(meldspeicherfehler,meldungstext);return(tofather);LEAVE +speicherungdurchfuehrenFI ;infeld(satzindex).eingabefehler:infeld( +aktuellesfeld).END PROC speicherungdurchfuehren;PROC neuerblock:enter( +tograndfather)END PROC neuerblock;PROC blocklesenundausgeben:SELECT +verarbeitungsartOF CASE vaaendern:aenderungsblocklesenCASE vaneu: +blocklesenneuCASE valoeschen:blocklesenloeschenEND SELECT .blocklesenneu: +neuerbildschirm.blocklesenloeschen:neuerbildschirm; +paraphenfelderundintegabezsperren.paraphenfelderundintegabezsperren:INT VAR +sperrfeld:=erstesfeld+1;INT VAR i;FOR iFROM 1UPTO klassenproseiteREP +feldschutz(sperrfeld);feldschutz(sperrfeld+1);feldschutz(sperrfeld+2); +sperrfeldINCR felderprozeilePER .END PROC blocklesenundausgeben;PROC +neuerbildschirm:vorbereiten;gewuenschteszeigen;nachbereiten.vorbereiten: +standardmaskenfeld(vergleichsjgst,erstesfeld-1);aktuellesfeld:=erstesfeld. +gewuenschteszeigen:IF fortschreibungTHEN TEXT VAR altejgst:=vergleichsjgst; +TEXT VAR altesschuljahr:=neuesschuljahr,alteshalbjahr:=neueshalbjahr; +klassenzahl:=null;IF fortschreibungneuesschuljahrTHEN vergleichsjgst:= +jgstaufber(text(int(altejgst)-1));FI ;neuesschuljahr:=schulkenndatum(keysj); +neueshalbjahr:=schulkenndatum(keyshj);klassengrunddateninpuffer; +statleseschleife(dnraktschuelergruppen,vergleichsjgst,niltext,fnrsgrpjgst, +fnrsgrpkennung,PROC zeigeklassendaten);vergleichsjgst:=altejgst; +neuesschuljahr:=altesschuljahr;neueshalbjahr:=alteshalbjahrFI .nachbereiten: +klassenzahl:=klassenproseite;infeld(standardanfang);standardfelderausgeben; +infeld(erstesfeld).END PROC neuerbildschirm;PROC aenderungsblocklesen: +vorbereiten;gewuenschteszeigen;nachbereiten.vorbereiten:standardmeldung( +meldwarten,niltext);klassenzahl:=null;standardmaskenfeld(vergleichsjgst, +erstesfeld-1);aktuellesfeld:=erstesfeld.gewuenschteszeigen: +klassengrunddateninpuffer;statleseschleife(dnraktschuelergruppen, +vergleichsjgst,niltext,fnrsgrpjgst,fnrsgrpkennung,PROC zeigeklassendaten). +nachbereiten:restlichezeilenloeschen;infeld(standardanfang); +standardfelderausgeben;infeld(standardeinstieg).restlichezeilenloeschen:INT +VAR zeilenzaehler;INT VAR zeilenfeld:=(klassenzahl*felderprozeile)+erstesfeld +;FOR zeilenzaehlerFROM klassenzahl+1UPTO klassenproseiteREP loeschezeilePER . +loeschezeile:INT VAR zeilenincr;FOR zeilenincrFROM 1UPTO felderprozeileREP +standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank,zeilenfeld); +feldschutz(zeilenfeld);zeilenfeldINCR 1PER ;.END PROC aenderungsblocklesen; +PROC zeigeklassendaten(BOOL VAR schluss):IF gehoertdazuTHEN klassenzahlINCR 1 +;kennungzeigen;paraphenzeigen;integabezzeigenFI .gehoertdazu:schluss:=( +jgstaufber(wert(fnrsgrpjgst))<>vergleichsjgst)COR klassenzahl=klassenproseite +;NOT schluss.kennungzeigen:TEXT CONST zug:=wert(fnrsgrpkennung);kennung( +klassenzahl):=zug;standardmaskenfeld(zug,aktuellesfeld);IF NOT fortschreibung +THEN feldschutz(aktuellesfeld);FI ;aktuellesfeldINCR 1.paraphenzeigen:TEXT +VAR paraphen:=wert(fnrsgrplehrer);TEXT CONST par:=wert(fnrsgrpstellvlehrer); +standardmaskenfeld(paraphen,aktuellesfeld);feldfrei(aktuellesfeld); +aktuellesfeldINCR 1;standardmaskenfeld(par,aktuellesfeld);feldfrei( +aktuellesfeld);aktuellesfeldINCR 1;paraphenCAT (trenner+par);altedaten( +klassenzahl):=paraphen+trenner+wert(fnrsgrpintegabez).integabezzeigen: +standardmaskenfeld(wert(fnrsgrpintegabez),aktuellesfeld);feldfrei( +aktuellesfeld);aktuellesfeldINCR 1.END PROC zeigeklassendaten;PROC +feldloeschen(INT CONST laenge):standardmaskenfeld(laenge*blank,aktuellesfeld) +END PROC feldloeschen;PROC holeallelehrerparaphen:lehrerparaphen:= +paraphentrenner;statleseschleife(dnrlehrer,niltext,niltext,fnrlparaphe, +fnrlfamname,PROC setzelehrparaphe)END PROC holeallelehrerparaphen;PROC +neuesschuljahrhalbjahrerrechnen:IF schuljahr=niltextTHEN schuljahr:= +schulkenndatum(keysj);halbjahr:=schulkenndatum(keyshj)FI ;IF akthalbjahrTHEN +neuesschuljahr:=schuljahr;neueshalbjahr:=halbjahrELIF halbjahr=hj1THEN +neuesschuljahr:=schuljahr;neueshalbjahr:=hj2ELSE ersteshalbjahrneuesschuljahr +FI .ersteshalbjahrneuesschuljahr:neuesschuljahr:=subtext(schuljahr,3,4); +neuesschuljahrCAT text(int(neuesschuljahr)+1,2);neueshalbjahr:=hj1.END PROC +neuesschuljahrhalbjahrerrechnen;PROC setzelehrparaphe(BOOL VAR b): +lehrerparaphenCAT paraphe(wert(fnrlparaphe))END PROC setzelehrparaphe;TEXT +PROC paraphe(TEXT CONST p):p+paraphentrennerEND PROC paraphe;BOOL PROC +korrekteparaphe(INT CONST ind):TEXT CONST par:=standardmaskenfeld(ind);INT +VAR paraphenpos:=pos(lehrerparaphen,paraphentrenner+paraphe(par)); +aktuellesfeld:=ind;(par=niltext)COR (paraphenpos>null)END PROC +korrekteparaphe;PROC klassengrunddateninpuffer:putwert(fnrsgrpsj, +neuesschuljahr);putwert(fnrsgrphj,neueshalbjahr);putwert(fnrsgrpjgst, +vergleichsjgst);END PROC klassengrunddateninpuffer;END PACKET +listenweiseklassenerf; + diff --git a/app/schulis/2.2.1/src/0.raumgruppen bearbeiten b/app/schulis/2.2.1/src/0.raumgruppen bearbeiten new file mode 100644 index 0000000..b61497b --- /dev/null +++ b/app/schulis/2.2.1/src/0.raumgruppen bearbeiten @@ -0,0 +1,54 @@ +PACKET erfraumgruppenDEFINES erfassungraumgruppen:LET maskenname= +"ms erf raumgruppen",fnrkennung=2,fnrletztesfeld=17,trenner=" = ",maxraeume= +15,laengeraumgruppe=4,laengeeinerraumangabe=4;TEXT VAR raeume:="";TEXT VAR +raum:="";INT VAR anzraeume;TEXT VAR gueltigeraeume:="";LET postrenner="�"; +LET meldnrungueltigerraum=55,meldnrraumgruppezulang=60;LET sachgebietraum= +"c02 raeume"PROC erfassungraumgruppen(INT CONST proznr):systemdboff; +reinitparsing;SELECT proznrOF CASE 1:setzeerfassungsparameterCASE 2: +zeigeraumgruppezurbearbeitungCASE 3:pruefeplausibilitaetCASE 4: +setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6: +raumgruppelesenCASE 7:raumgruppeaendernCASE 8:raumgruppeeinfuegenCASE 9: +raumgruppeloeschenEND SELECT END PROC erfassungraumgruppen;PROC +setzeerfassungsparameter:gueltigeraeume:="";setzeerfassungsparameter( +dnrraumgruppen,maskenname,fnrletztesfeld)END PROC setzeerfassungsparameter; +PROC zeigeraumgruppezurbearbeitung:setzeerfassungsfeld(wert(fnrrgraumgrp), +fnrkennung);raeume:=wert(fnrrgraeume);anzraeume:=(length(raeume))DIV +laengeeinerraumangabe;INT VAR i:=1;WHILE i<=anzraeumeREP raum:=subtext(raeume +,1,laengeeinerraumangabe);raeume:=subtext(raeume,laengeeinerraumangabe+1); +setzeerfassungsfeld(compress(raum),i+fnrkennung);iINCR 1PER ;WHILE i<= +maxraeumeREP setzeerfassungsfeld("",i+fnrkennung);iINCR 1PER ;END PROC +zeigeraumgruppezurbearbeitung;PROC pruefeplausibilitaet:LET leer="",null=0; +IF gueltigeraeume=""THEN holealleraeumeingueltigeraeumeFI ;INT VAR +fehlerstatus;pruefe(1,erfassungsmaske,PROC erfassungswert,fnrkennung,null, +null,leer,fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus +);LEAVE pruefeplausibilitaetELIF length(erfassungswert(fnrkennung))> +laengeraumgruppeTHEN meldeauffaellig(erfassungsmaske,meldnrraumgruppezulang); +setzefehlerstatus(fnrkennung);LEAVE pruefeplausibilitaetFI ;INT VAR i;FOR i +FROM 1UPTO maxraeumeREP INT VAR fnrraum:=i+fnrkennung;IF erfassungswert( +fnrraum)<>""THEN IF ungueltigeraumangabeTHEN setzefehlerstatus(fnrraum); +meldeauffaellig(erfassungsmaske,meldnrungueltigerraum);LEAVE +pruefeplausibilitaetFI ;FI ;PER .ungueltigeraumangabe:pos(gueltigeraeume, +suchwert)=0.suchwert:postrenner+compress(erfassungswert(fnrraum))+postrenner. +END PROC pruefeplausibilitaet;PROC holealleraeumeingueltigeraeume: +gueltigeraeume:=postrenner;statleseschleife(dnrschluessel,sachgebietraum,"", +fnrschlsachgebiet,fnrschlschluessel,PROC raumlesen);END PROC +holealleraeumeingueltigeraeume;PROC raumlesen(BOOL VAR b):IF dbstatus<>0COR +wert(fnrschlsachgebiet)>sachgebietraumTHEN b:=TRUE ELSE gueltigeraeumeCAT +wert(fnrschlschluessel)+postrennerFI END PROC raumlesen;PROC +setzewertefuerdbspeicherung:putwert(fnrrgraumgrp,erfassungswert(fnrkennung)); +INT VAR i;raeume:="";FOR iFROM fnrkennung+1UPTO fnrletztesfeldREP raum:= +erfassungswert(i);IF raum<>""THEN raeumeCAT text(raum,laengeeinerraumangabe) +FI PER ;putwert(fnrrgraeume,raeume)END PROC setzewertefuerdbspeicherung;PROC +setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR +identizeile;identizeile:=wert(fnrrgraumgrp)+trenner+wert(fnrrgraeume); +setzeidentiwert(identizeilemitschluesselanhang). +identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+wert( +fnrrgraumgrp).END PROC setzeidentiobjektfuerobjektliste;PROC raumgruppelesen: +putwert(fnrrgraumgrp,schluessel);search(dnrraumgruppen,TRUE );IF dbstatus=ok +THEN saveupdateposition(dnrraumgruppen)FI END PROC raumgruppelesen;PROC +raumgruppeaendern:restoreupdateposition(dnrraumgruppen);update(dnrraumgruppen +)END PROC raumgruppeaendern;PROC raumgruppeeinfuegen:insert(dnrraumgruppen) +END PROC raumgruppeeinfuegen;PROC raumgruppeloeschen:delete(dnrraumgruppen) +END PROC raumgruppeloeschen;TEXT PROC schluessel:erfassungswert(fnrkennung) +END PROC schluessel;END PACKET erfraumgruppen; + diff --git a/app/schulis/2.2.1/src/0.schulis schrifttyp b/app/schulis/2.2.1/src/0.schulis schrifttyp new file mode 100644 index 0000000..19f6bf8 --- /dev/null +++ b/app/schulis/2.2.1/src/0.schulis schrifttyp @@ -0,0 +1,9 @@ +PACKET schulisschrifttypDEFINES schrifttyp,anschreibenschrifttyp, +mitteilungschrifttyp,setzeschuliszeichensatz:TEXT VAR zeichensatz:="";PROC +setzeschuliszeichensatz(TEXT CONST font):zeichensatz:=fontEND PROC +setzeschuliszeichensatz;TEXT PROC schrifttyp:zeichensatzEND PROC schrifttyp; +TEXT PROC anschreibenschrifttyp:zeichensatzEND PROC anschreibenschrifttyp; +TEXT PROC mitteilungschrifttyp:zeichensatzEND PROC mitteilungschrifttyp;IF +fontexists(font(1))THEN zeichensatz:=font(1)ELSE zeichensatz:=""FI .END +PACKET schulisschrifttyp; + diff --git a/app/schulis/2.2.1/src/0.schulkenndaten bearbeiten b/app/schulis/2.2.1/src/0.schulkenndaten bearbeiten new file mode 100644 index 0000000..d82c587 --- /dev/null +++ b/app/schulis/2.2.1/src/0.schulkenndaten bearbeiten @@ -0,0 +1,109 @@ +PACKET schulkenndatenbearbeitenDEFINES schulkenndatenbearbeiten, +schulkenndatenspeichern:LET maske="ms erf schulkenndaten";LET sachgebiet= +"c02 schulkenndaten";LET schuljahr="Schuljahr",schulhalbjahr="Schulhalbjahr", +anfangschulhj="Anfang Schulhalbjahr",endeschulhj="Ende Schulhalbjahr", +schulname="Schulname",schulleiter="Schulleiter",schulort="Schulort", +schulstrasse="Schulstraße",schulrufnummer="Schulrufnummer";LET fnrschuljahr=2 +,fnrschulhalbjahr=3,fnranfangschulhj=4,fnrendeschulhj=5,fnrschulname=6, +fnrschulleiter=7,fnrschulort=8,fnrschulstrasse=9,fnrschulrufnummer=10;LET +melddatenwerdengespeichert=50,meldfehlendesdatum=52,melddatennichtspeichern= +63,meldkeinupdatemoeglich=73,meldungueltigesdatum=157,meldungueltigeangabe= +162;INT VAR ifnr;LET maxfelder=10;ROW maxfelderTEXT VAR alterwert;LET +laengeschuljahr=4;INT VAR erstesjahr,zweitesjahr;LET zwischenpunkt=".", +logbucheintrag="Anw. 10.3.1 Änderung an den Schulkenndaten";PROC +schulkenndatenbearbeiten:standardstartproc(maske);zeigeschulkenndaten;infeld( +fnrschuljahr);standardnproc.zeigeschulkenndaten:alterwert(fnrschuljahr):= +schulkenndatum(schuljahr);alterwert(fnrschulhalbjahr):=schulkenndatum( +schulhalbjahr);alterwert(fnranfangschulhj):=kurzdatum(schulkenndatum( +anfangschulhj));alterwert(fnrendeschulhj):=kurzdatum(schulkenndatum( +endeschulhj));alterwert(fnrschulname):=schulkenndatum(schulname);alterwert( +fnrschulleiter):=schulkenndatum(schulleiter);alterwert(fnrschulort):= +schulkenndatum(schulort);alterwert(fnrschulstrasse):=schulkenndatum( +schulstrasse);alterwert(fnrschulrufnummer):=schulkenndatum(schulrufnummer); +FOR ifnrFROM fnrschuljahrUPTO maxfelderREP standardmaskenfeld(alterwert(ifnr) +,ifnr)PER ;infeld(fnrschuljahr);standardfelderausgeben.END PROC +schulkenndatenbearbeiten;PROC schulkenndatenspeichern(BOOL CONST speichern): +IF NOT speichernTHEN standardmeldung(melddatennichtspeichern,"");pause(10); +return(2)ELSE INT VAR fehlerstatus:=0;dbstatus(0);pruefeplausibilitaet( +fehlerstatus);IF fehlerstatus=0THEN datenspeichern;logeintrag(logbucheintrag) +;IF dbstatus<>0THEN standardmeldung(meldkeinupdatemoeglich,"");return(1)ELSE +return(2)FI ELSE infeld(fehlerstatus);return(1)FI FI .datenspeichern: +standardmeldung(melddatenwerdengespeichert,"");IF standardmaskenfeld( +fnrschuljahr)<>alterwert(fnrschuljahr)THEN putwert(fnrschlsachgebiet, +sachgebiet);putwert(fnrschlschluessel,schuljahr);search(dnrschluessel,TRUE ); +putwert(fnrschllangtext,standardmaskenfeld(fnrschuljahr));IF dbstatus=0THEN +update(dnrschluessel);IF dbstatus<>0THEN infeld(fnrschuljahr);LEAVE +datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld( +fnrschulhalbjahr)<>alterwert(fnrschulhalbjahr)THEN putwert(fnrschlsachgebiet, +sachgebiet);putwert(fnrschlschluessel,schulhalbjahr);search(dnrschluessel, +TRUE );putwert(fnrschllangtext,standardmaskenfeld(fnrschulhalbjahr));IF +dbstatus=0THEN update(dnrschluessel);IF dbstatus<>0THEN infeld( +fnrschulhalbjahr);LEAVE datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF +standardmaskenfeld(fnranfangschulhj)<>alterwert(fnranfangschulhj)THEN putwert +(fnrschlsachgebiet,sachgebiet);putwert(fnrschlschluessel,anfangschulhj); +search(dnrschluessel,TRUE );putwert(fnrschllangtext,langdatum( +standardmaskenfeld(fnranfangschulhj)));IF dbstatus=0THEN update(dnrschluessel +);IF dbstatus<>0THEN infeld(fnranfangschulhj);LEAVE datenspeichernFI ELSE +insert(dnrschluessel)FI FI ;IF standardmaskenfeld(fnrendeschulhj)<>alterwert( +fnrendeschulhj)THEN putwert(fnrschlsachgebiet,sachgebiet);putwert( +fnrschlschluessel,endeschulhj);search(dnrschluessel,TRUE );putwert( +fnrschllangtext,langdatum(standardmaskenfeld(fnrendeschulhj)));IF dbstatus=0 +THEN update(dnrschluessel);IF dbstatus<>0THEN infeld(fnrendeschulhj);LEAVE +datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld( +fnrschulname)<>alterwert(fnrschulname)THEN putwert(fnrschlsachgebiet, +sachgebiet);putwert(fnrschlschluessel,schulname);search(dnrschluessel,TRUE ); +putwert(fnrschllangtext,standardmaskenfeld(fnrschulname));IF dbstatus=0THEN +update(dnrschluessel);IF dbstatus<>0THEN infeld(fnrschulname);LEAVE +datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld( +fnrschulleiter)<>alterwert(fnrschulleiter)THEN putwert(fnrschlsachgebiet, +sachgebiet);putwert(fnrschlschluessel,schulleiter);search(dnrschluessel,TRUE +);putwert(fnrschllangtext,standardmaskenfeld(fnrschulleiter));IF dbstatus=0 +THEN update(dnrschluessel);IF dbstatus<>0THEN infeld(fnrschulleiter);LEAVE +datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld( +fnrschulort)<>alterwert(fnrschulort)THEN putwert(fnrschlsachgebiet,sachgebiet +);putwert(fnrschlschluessel,schulort);search(dnrschluessel,TRUE );putwert( +fnrschllangtext,standardmaskenfeld(fnrschulort));IF dbstatus=0THEN update( +dnrschluessel);IF dbstatus<>0THEN infeld(fnrschulort);LEAVE datenspeichernFI +ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld(fnrschulstrasse)<> +alterwert(fnrschulstrasse)THEN putwert(fnrschlsachgebiet,sachgebiet);putwert( +fnrschlschluessel,schulstrasse);search(dnrschluessel,TRUE );putwert( +fnrschllangtext,standardmaskenfeld(fnrschulstrasse));IF dbstatus=0THEN update +(dnrschluessel);IF dbstatus<>0THEN infeld(fnrschulstrasse);LEAVE +datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld( +fnrschulrufnummer)<>alterwert(fnrschulrufnummer)THEN putwert( +fnrschlsachgebiet,sachgebiet);putwert(fnrschlschluessel,schulrufnummer); +search(dnrschluessel,TRUE );putwert(fnrschllangtext,standardmaskenfeld( +fnrschulrufnummer));IF dbstatus=0THEN update(dnrschluessel);IF dbstatus<>0 +THEN infeld(fnrschulrufnummer);LEAVE datenspeichernFI ELSE insert( +dnrschluessel)FI FI .END PROC schulkenndatenspeichern;PROC +pruefeplausibilitaet(INT VAR fstatus):TEXT VAR pruefwert;pruefwert:= +standardmaskenfeld(fnrschuljahr);IF length(pruefwert)<>laengeschuljahrTHEN +standardmeldung(meldungueltigeangabe,"");fstatus:=fnrschuljahr;LEAVE +pruefeplausibilitaetFI ;erstesjahr:=int(pruefwert);IF NOT lastconversionok +THEN standardmeldung(meldungueltigeangabe,"");fstatus:=fnrschuljahr;LEAVE +pruefeplausibilitaetELIF erstesjahr<0THEN standardmeldung( +meldungueltigeangabe,"");fstatus:=fnrschuljahr;LEAVE pruefeplausibilitaetFI ; +erstesjahr:=int(subtext(pruefwert,1,2));zweitesjahr:=int(subtext(pruefwert,3, +4));IF ((erstesjahr+1)MOD 100)<>zweitesjahrTHEN standardmeldung( +meldungueltigeangabe,"");fstatus:=fnrschuljahr;LEAVE pruefeplausibilitaetFI ; +IF standardmaskenfeld(fnrschulhalbjahr)<>"1"AND standardmaskenfeld( +fnrschulhalbjahr)<>"2"THEN standardmeldung(meldungueltigeangabe,"");fstatus:= +fnrschulhalbjahr;LEAVE pruefeplausibilitaetFI ;IF fehlerhaftesdatum( +standardmaskenfeld(fnranfangschulhj))THEN standardmeldung( +meldungueltigesdatum,"");fstatus:=fnranfangschulhj;LEAVE pruefeplausibilitaet +FI ;IF fehlerhaftesdatum(standardmaskenfeld(fnrendeschulhj))THEN +standardmeldung(meldungueltigesdatum,"");fstatus:=fnrendeschulhj;LEAVE +pruefeplausibilitaetFI ;IF subtext(standardmaskenfeld(fnrendeschulhj),5,6)<> +"00"AND NOT (datum(standardmaskenfeld(fnrendeschulhj))>datum( +standardmaskenfeld(fnranfangschulhj)))THEN standardmeldung( +meldungueltigesdatum,"");fstatus:=fnrendeschulhj;LEAVE pruefeplausibilitaet +FI ;IF standardmaskenfeld(fnrschulname)=""THEN standardmeldung( +meldfehlendesdatum,"");fstatus:=fnrschulname;LEAVE pruefeplausibilitaetFI . +END PROC pruefeplausibilitaet;BOOL PROC fehlerhaftesdatum(TEXT CONST +testdatum):datum(testdatum)=nildatumEND PROC fehlerhaftesdatum;TEXT PROC +kurzdatum(TEXT CONST langdatum):subtext(langdatum,1,2)+subtext(langdatum,4,5) ++subtext(langdatum,7,8)END PROC kurzdatum;TEXT PROC langdatum(TEXT CONST +kurzdatum):subtext(kurzdatum,1,2)+zwischenpunkt+subtext(kurzdatum,3,4)+ +zwischenpunkt+subtext(kurzdatum,5,6)END PROC langdatum;END PACKET +schulkenndatenbearbeiten + diff --git a/app/schulis/2.2.1/src/1.abgegangene aussortieren b/app/schulis/2.2.1/src/1.abgegangene aussortieren new file mode 100644 index 0000000..ac73783 --- /dev/null +++ b/app/schulis/2.2.1/src/1.abgegangene aussortieren @@ -0,0 +1,75 @@ +PACKET abgegangeneaussortierenDEFINES +abgegangeneaussortiereneingangsbehandlung,abgegangeneaussortieren:LET null=0, +fnrdatum=2,fnrankreuz1=3,fnrankreuz2=4,pruefartalternative=5,niltext="", +tofather=1,meldtrenner="#",namenstrenner=", ",meldfalschesdatum=157, +meldbearbeitung=153,meldspeicherfehler=131,meldende=158;LET falschertag="00", +keindatum="01.01.00";LET anzschlfelder=3;LET bestandabgegangene="abg", +bestandlaufsj="ls";LET jgstufe10=10;LET logtextbeginn1= +"Anw. 1.3.4 Abgemeldete bis ",logtextbeginn2="Anw. 1.3.4 Abgegangene bis ", +logtextende1=" aussortieren",logtextende2=" entfernen";ROW anzschlfelderTEXT +VAR key;TEXT VAR jgst,zugtutor;PROC abgegangeneaussortiereneingangsbehandlung +:reinitparsing;standardvproc(maske(vergleichsknoten)).END PROC +abgegangeneaussortiereneingangsbehandlung;PROC abgegangeneaussortieren: +pruefeplausibilitaet;IF allesokTHEN aussortierendurchfuehrenELSE +fehlerbehandlungFI .pruefeplausibilitaet:pruefedatum;IF allesokTHEN +pruefeankreuzfelderFI .allesok:INT VAR pruefstatus;pruefstatus=null. +pruefeankreuzfelder:standardpruefe(pruefartalternative,fnrankreuz1, +fnrankreuz2,null,niltext,pruefstatus);.pruefedatum:TEXT VAR stichtag:= +standardmaskenfeld(fnrdatum);IF (subtext(stichtag,1,2)=falschertag)COR (datum +(stichtag)=nildatum)THEN pruefstatus:=fnrdatum;standardmeldung( +meldfalschesdatum,niltext);ELSE pruefstatus:=nullFI .fehlerbehandlung:infeld( +pruefstatus);return(tofather).aussortierendurchfuehren:aussortieren(stichtag, +standardmaskenfeld(fnrankreuz1)<>niltext);return(tofather).END PROC +abgegangeneaussortieren;PROC aussortieren(TEXT CONST stichtag,BOOL CONST +uebertragen):TEXT VAR eintrag;IF uebertragenTHEN inbestandabgegangeneELSE +endgueltigloeschenFI .inbestandabgegangene:eintrag:=logtextbeginn1;eintrag +CAT datumskonversion(stichtag);eintragCAT logtextende1;logeintrag(eintrag); +leseschleife(ixsustatabgdat,bestandlaufsj,stichtag,PROC +abgegangeneuebertragen).endgueltigloeschen:eintrag:=logtextbeginn2;eintrag +CAT datumskonversion(stichtag);eintragCAT logtextende2;logeintrag(eintrag); +leseschleife(ixsustatabgdat,bestandabgegangene,stichtag,PROC +endgueltigloeschen).END PROC aussortieren;PROC leseschleife(INT CONST +sekbestandindex,TEXT CONST sustatus,TEXT CONST stichtag,PROC (BOOL VAR ) +aktion):erstenlesen;WHILE NOT schlussREP ausfuehrung;naechstenlesenPER ; +endemeldung.erstenlesen:BOOL VAR endegewuenscht:=FALSE ;putwert(fnrsustatuss, +sustatus);putwert(fnrsuabgdats,datumskonversion(stichtag));search( +sekbestandindex,FALSE );IF NOT gueltigesabgangsdatum(sustatus,stichtag)THEN +pred(sekbestandindex)FI ;statusueberpruefen.schluss:(dbstatus<>null)COR +endegewuenscht.ausfuehrung:bearbeitungmelden;aktion(endegewuenscht). +naechstenlesen:pred(sekbestandindex);statusueberpruefen.endemeldung:IF NOT +endegewuenschtTHEN standardmeldung(meldende,niltext)FI .statusueberpruefen: +IF gueltigesabgangsdatum(sustatus,stichtag)THEN lesenzumaendernELSE dbstatus( +notfound)FI .END PROC leseschleife;PROC abgegangeneuebertragen(BOOL VAR +schluss):delete(dnrschueler);IF dbstatus=okTHEN IF intwert(fnrsusgrpjgst)>= +jgstufe10THEN kurswahlserveraktualisieren(wert(fnrsusgrpjgst),"","")FI ; +putwert(fnrsustatuss,bestandabgegangene);insert(dnrschueler);IF dbstatus<>ok +THEN aktbestandzuruecksetzen;schlussundfehlermeldenFI ; +aktbestandzuruecksetzenELSE schlussundfehlermeldenFI .aktbestandzuruecksetzen +:putwert(fnrsustatuss,bestandlaufsj);.schlussundfehlermelden:schluss:=TRUE ; +fehlermelden.END PROC abgegangeneuebertragen;PROC endgueltigloeschen(BOOL +VAR schluss):#aenderunginstatraumvorbereiten(TRUE );dr11.05.88#IF NOT schluss +THEN #einenschuelerausstatraumentfernen;dr11.05.88#datenloeschen( +dnrhalbjahresdaten,schluss);IF NOT schlussTHEN diffdatenloeschen;delete( +dnrschueler);schluss:=dbstatus<>null;FI FI ;IF schlussTHEN # +einenschuelerinstatraumeinfuegen;dr11.05.88#fehlermeldenFI .diffdatenloeschen +:IF wert(fnrsudiffdatennrs)<>""THEN putwert(fnrdddiffdatennr,wert( +fnrsudiffdatennrs));search(dnrdiffdaten,TRUE );IF dbstatus=okTHEN delete( +dnrdiffdaten)FI FI .END PROC endgueltigloeschen;PROC datenloeschen(INT CONST +dateinummer,BOOL VAR schluss):inittupel(dateinummer);putwert(dateinummer+1, +key(1));putwert(dateinummer+2,key(2));putwert(dateinummer+3,datumskonversion( +key(3)));search(dateinummer,FALSE );WHILE dbstatus=okCAND gleicherschueler +REP delete(dateinummer);IF dbstatus<>okTHEN schluss:=TRUE ELSE succ( +dateinummer)FI PER .gleicherschueler:key(1)=wert(dateinummer+1)CAND key(2)= +wert(dateinummer+2)CAND key(3)=datumrekonversion(wert(dateinummer+3)).END +PROC datenloeschen;BOOL PROC gueltigesabgangsdatum(TEXT CONST bestand, +stichtag):dbstatus=okCAND wert(fnrsustatuss)=bestandCAND wert(fnrsuabgdats)<> +keindatumCAND datum(wert(fnrsuabgdats))<=datum(datumskonversion(stichtag)). +END PROC gueltigesabgangsdatum;PROC lesenzumaendern:key(1):=wert( +fnrsufamnames);key(2):=wert(fnrsurufnames);key(3):=datumrekonversion(wert( +fnrsugebdatums));jgst:=wert(fnrsusgrpjgst);zugtutor:=wert(fnrsusgrpzugtut) +END PROC lesenzumaendern;PROC bearbeitungmelden:standardmeldung( +meldbearbeitung,key(1)+namenstrenner+key(2)+meldtrenner+jgst+zugtutor+ +meldtrenner)END PROC bearbeitungmelden;PROC fehlermelden:standardmeldung( +meldspeicherfehler,text(dbstatus)+meldtrenner+key(1)+namenstrenner+key(2)+ +meldtrenner);END PROC fehlermelden;END PACKET abgegangeneaussortieren + diff --git a/app/schulis/2.2.1/src/1.anschr.anmeldebestaetigung fuer jgst 5 und 11 b/app/schulis/2.2.1/src/1.anschr.anmeldebestaetigung fuer jgst 5 und 11 new file mode 100644 index 0000000..608e8e4 --- /dev/null +++ b/app/schulis/2.2.1/src/1.anschr.anmeldebestaetigung fuer jgst 5 und 11 @@ -0,0 +1,58 @@ +PACKET anschranmeldebestaetigungfuerjgst5und11DEFINES anschreibenbesteingang, +anschreibenbestneustarten,sonderwertebestneu,multistopanmeld:LET swindexvollj +=511,swindexminderjmaennlweibl=512,vollj="v",minderjaehrig="m",maennl="m", +weibl="w",trennsymbol=" ",punkt=".";LET vordruckneu11= +"vordruck anmeldebestaetigung zur jgst 11";LET vordruckneu5= +"vordruck anmeldebestaetigung zur jgst 5";LET hellan="",hellaus=" ",maske= +"ms anschreiben best",jgstfeldnr=3,bestandfeldnr=2,namefeldnr=4,vornamefeldnr +=5,gebdatfeldnr=6,bildschirmfeldnr=7,druckerfeldnr=8;LET niltext="", +fehlermeldnr=56,wartemeldnr=69,datumfehler=157,vater=1;LET jgst05="05";INT +VAR eingabestatus;BOOL VAR anschreibenfuerjgst5;PROC anschreibenbesteingang( +TEXT CONST jgst):anschreibenfuerjgst5:=(jgst=jgst05);standardstartproc(maske) +;standardmaskenfeld(hellan+jgst+hellaus,jgstfeldnr);standardnprocEND PROC +anschreibenbesteingang;BOOL PROC sonderwertebestneu:IF NOT +anschreibenfuerjgst5THEN IF volljaehrig(wert(fnrsugebdatums))THEN +setzesonderwert(swindexvollj,vollj);setzesonderwert(swindexminderjmaennlweibl +,niltext)ELSE setzesonderwert(swindexvollj,minderjaehrig);IF wert( +fnrsugeschlechts)=weiblTHEN setzesonderwert(swindexminderjmaennlweibl,weibl) +ELSE setzesonderwert(swindexminderjmaennlweibl,maennl)FI FI FI ;IF +andereerzieheradresseCAND NOT volljaehrig(wert(fnrsugebdatums))#sf30.10.# +THEN leseerzieheradresse;uebertrageerzieheradresseFI ;adressat((wert( +fnrsuvornames)SUB 1)+punkt+trennsymbol+wert(fnrsufamnames));TRUE . +andereerzieheradresse:#intwert(fnradresskuerzel)<>0#wert(fnrsuplzorte)<>"". +leseerzieheradresse:#inittupel(dnradressen);putwert(dnradressen+1,wert( +fnradresskuerzel));search(dnradressen,TRUE )#.uebertrageerzieheradresse: +putwert(fnrsustrnrs,wert(fnrsustrnre));putwert(fnrsuplzorts,wert(fnrsuplzorte +)).END PROC sonderwertebestneu;PROC anschreibenbestneustarten:TEXT VAR +vordruckneu:="";lesemaskenwerte;IF NOT (auswahldruckeroderbildschirmok)THEN +meldedenfehler;infeld(bildschirmfeldnr);zurueckzumdialogELSE IF +schluesselmitdatumangegebenTHEN IF schuelerschluessel3okTHEN +startenausfuehrenELSE standardmeldung(datumfehler,niltext);infeld( +gebdatfeldnr);zurueckzumdialogFI ;ELSE IF (alleschuelergewaehltXOR +einschuelerohnedatumgewaehlt)THEN startenausfuehrenELSE meldedenfehler; +zurueckzumdialogFI ;FI ;FI .lesemaskenwerte:TEXT CONST schluessel1:= +standardmaskenfeld(namefeldnr);TEXT CONST schluessel2:=standardmaskenfeld( +vornamefeldnr);TEXT CONST schluessel3:=standardmaskenfeld(gebdatfeldnr);BOOL +CONST anschreibenzeigen:=standardmaskenfeld(bildschirmfeldnr)<>niltext;BOOL +CONST alle:=standardmaskenfeld(bestandfeldnr)<>niltext. +auswahldruckeroderbildschirmok:(standardmaskenfeld(bildschirmfeldnr)<>niltext +)XOR (standardmaskenfeld(druckerfeldnr)<>niltext).schluesselmitdatumangegeben +:NOT alleAND schluessel1<>niltextAND schluessel2<>niltextAND schluessel3<> +niltext.alleschuelergewaehlt:alleAND (schluessel1+schluessel2+schluessel3)= +niltext.einschuelerohnedatumgewaehlt:NOT alleAND schluessel1<>niltextAND +schluessel3=niltext.schuelerschluessel3ok:standardpruefe(6,6,0,0,niltext, +eingabestatus);IF NOT (eingabestatus=0)THEN FALSE ELSE TRUE FI . +meldedenfehler:standardmeldung(fehlermeldnr,niltext).zurueckzumdialog:return( +vater).startenausfuehren:standardmeldung(wartemeldnr,niltext); +initialisieredruckerfueranschreiben;inittupel(dnrschueler);parsenooffields(30 +);uebernimmnamen;IF anschreibenfuerjgst5THEN putwert(fnrsustatuss,"n05"); +vordruckneu:=vordruckneu5ELSE putwert(fnrsustatuss,"n11");vordruckneu:= +vordruckneu11FI ;anschreibenstart(ixsustatfamrufgeb,vordruckneu, +anschreibenzeigen,(schluessel1+schluessel2)<>"",BOOL PROC sonderwertebestneu, +BOOL PROC multistopanmeld).uebernimmnamen:putwert(fnrsufamnames,schluessel1); +putwert(fnrsurufnames,schluessel2);putwert(fnrsugebdatums,datumskonversion( +schluessel3)).END PROC anschreibenbestneustarten;BOOL PROC multistopanmeld: +BOOL VAR b;IF anschreibenfuerjgst5THEN b:=wert(fnrsustatuss)="n05"ELSE b:= +wert(fnrsustatuss)="n11"FI ;bENDPROC multistopanmeld;END PACKET +anschranmeldebestaetigungfuerjgst5und11; + diff --git a/app/schulis/2.2.1/src/1.anschr.mitteilungen neuangemeldete und abgemeldete b/app/schulis/2.2.1/src/1.anschr.mitteilungen neuangemeldete und abgemeldete new file mode 100644 index 0000000..3271256 --- /dev/null +++ b/app/schulis/2.2.1/src/1.anschr.mitteilungen neuangemeldete und abgemeldete @@ -0,0 +1,262 @@ +PACKET anschrmitteilungenneuangemeldeteundabgemeldeteDEFINES +mitteilungeingang,mitteilungende,mitteilungneuangstarten, +mitteilungabmeldungstarten,sonderwertemitteilungabmeldung, +sonderwertemitteilungneuangmithjd,sonderwertemitteilungneuangmitdiffd, +dummystop:LET laufenderbestand="ls";LET bestandfuerabgang="c02 abgang", +bestandfuerabschluss="c02 abschluss";LET swaktuelleshalbjahr=509, +sweintrittsdatum=512,swabgangsdatum=512,swschuelername=513,swgeburtsdatum=514 +,swabgangsgrund=515,swstrhausnr=516,swerreichterabschluss=516,swplzort=517, +swtelephonnr=518,swaktjgst=519,swklassenlehrer=520,#swbafoeg=521,dr05.03.88# +swkursanfang=530,swfelderunterschrnoteentlbuecher=591,swmatrixfeld=590;INT +VAR swkurse,eingabestatus;TEXT VAR aktuellejgst,tutorlehrer,abglangtext, +abslangtext;TEXT VAR aktuelleshalbjahr:="",aktuellesschuljahr:="", +schuljahranfang:="",schuljahrende:="";LET textschulhalbjahr="Schulhalbjahr", +textschuljahr="Schuljahr",textschuljahranfang="Anfang Schulhalbjahr", +textschuljahrende="Ende Schulhalbjahr";BOOL VAR hjdvorhanden,abmeldung:= +FALSE ,schuelergefunden;LET jgst09="09",jgst10="10";LET maske="ms mitteilung" +;LET namefeldnr=2,rufnamefeldnr=3,geburtsdatumfeldnr=4,bildschirmfeldnr=5, +druckerfeldnr=6;LET father=1;LET wartemeldnr=69,existiertnichtmeldnr=126, +falschesdatum=192,datumfehler=157,fehlermeldnr=56;TEXT VAR familienname, +rufname,geburtsdatum;BOOL VAR zeigen;BOOL VAR erstemitteilung:=TRUE ;LET +vordruckmithjd="vordruck mitteilung ueber eine anmeldung mit hjd", +vordruckmitdiffd="vordruck mitteilung ueber eine anmeldung mit diffd", +vordruckabmeldung="vordruck mitteilung ueber eine abmeldung";LET +maxanzahlbelegtekurse=15,anzahlkurskomponenten=4;ROW maxanzahlbelegtekurse +ROW anzahlkurskomponentenTEXT VAR kursdaten;LET lerngruppenindex=1, +fachlangtextindex=2,lehrerindex=3,fachschluesselindex=4;LET +indexdiffdatenbeschreibung=1,indexdiffdatenschluessel=2;INT VAR +anzahlderfaecher:=1,anzahlderbelegtenkurse:=0,anzahlderdiffdaten:=0;INT VAR +zaehler,zaehler1,zaehler2;TEXT VAR fachkuerzel;LET weiblich="w",maennlich="m" +,anredeweibl="Fr.",anredemaennl="Hr.",erstehalbj="1",auszufuellendesfeld= +"___________________________",trennsymbol=" ",punkt=".",niltext="",nildatum= +"01.01.00",textwahlpflichtfach="Wahlpflichtf. ";TEXT CONST +auszufuellendefelderunterschrnoteentlbuecher:="__________ ____ ________"; +TEXT CONST auszufuellendesfeldlehrer:="____________________________________ " +;TEXT CONST matrixfeld:="_______ "+auszufuellendesfeldlehrer+ +auszufuellendefelderunterschrnoteentlbuecher;LET maxanzahlderfaecher=100;ROW +maxanzahlderfaecherROW 2TEXT VAR faecherkartei;LET karteifachschluesselindex= +1,karteifachlangtext=2;LET anzstacktupel=25;PROC initialisierekursdaten:FOR +zaehler1FROM 1UPTO maxanzahlbelegtekurseREP FOR zaehler2FROM 1UPTO +anzahlkurskomponentenREP kursdaten(zaehler1)(zaehler2):=niltextPER PER END +PROC initialisierekursdaten;PROC holekursdaten:INT VAR i; +anzahlderbelegtenkurse:=length(wert(fnrhjdfach))DIV 2;FOR iFROM 1UPTO +anzahlderbelegtenkurseREP fachkuerzel:=subtext(wert(fnrhjdfach),i*2-1,i*2); +kursdaten(i)(fachschluesselindex):=compress(fachkuerzel);kursdaten(i)( +lerngruppenindex):=fachkuerzel+trennsymbol+subtext(wert(fnrhjdlerngrpkenn),i* +4-3,i*4);PER ;END PROC holekursdaten;PROC suchelangtextzufachschluessel(INT +VAR anzahlderschluessel):INT VAR i;FOR iFROM 1UPTO anzahlderschluesselREP +zaehler:=0;REP zaehlerINCR 1UNTIL zaehler>anzahlderfaecherCOR faecherkartei( +zaehler)(karteifachschluesselindex)=kursdaten(i)(fachschluesselindex)PER ;IF +faecherkartei(zaehler)(karteifachschluesselindex)=kursdaten(i)( +fachschluesselindex)THEN kursdaten(i)(fachlangtextindex):=faecherkartei( +zaehler)(karteifachlangtext);FI PER ;END PROC suchelangtextzufachschluessel; +PROC zuordnunglerngruppelehrer:INT VAR i;anzahlderbelegtenkurse:=length(wert( +fnrhjdfach))DIV 2;FOR iFROM 1UPTO anzahlderbelegtenkurseREP kursdaten(i)( +lehrerindex):=lehrerzukurs(subtext(wert(fnrhjdfach),i*2-1,i*2),i)PER ;END +PROC zuordnunglerngruppelehrer;TEXT PROC lehrerzukurs(TEXT CONST fachkuerzel, +INT CONST wievielte):INT VAR i:=wievielte;suchelerngruppe;IF dbstatus=okTHEN +suchelehrerELSE auszufuellendesfeldlehrerFI .suchelerngruppe:putwert(fnrlvsj, +wert(fnrhjdsj));putwert(fnrlvhj,wert(fnrhjdhj));putwert(fnrlvfachkennung, +fachkuerzel+compress(subtext(wert(fnrhjdlerngrpkenn),i*4-3,i*4)));putwert( +fnrlvjgst,wert(fnrhjdjgst));search(dnrlehrveranstaltungen,TRUE ).suchelehrer: +putwert(dnrlehrer+1,wert(fnrlvparaphe));search(dnrlehrer,TRUE );IF dbstatus<> +okTHEN auszufuellendesfeldlehrerELSE kompletteanredeFI .kompletteanrede:text( +anrede+lehrertitel+lehrerzusatz+trennsymbol+wert(fnrlfamname),length( +auszufuellendesfeldlehrer)).anrede:IF wert(fnrlgeschlecht)=weiblichTHEN +anredeweiblELIF wert(fnrlgeschlecht)=maennlichTHEN anredemaennlELSE niltext +FI .lehrertitel:IF wert(fnrlamtsbeztitel)=niltextTHEN niltextELSE trennsymbol ++wert(fnrlamtsbeztitel)FI .lehrerzusatz:IF wert(fnrlzusatz)=niltextTHEN +niltextELSE trennsymbol+wert(fnrlzusatz)FI .ENDPROC lehrerzukurs;PROC +sonderwertfueradressaten:adressat((wert(fnrsurufnames)SUB 1)+punkt+ +trennsymbol+wert(fnrsufamnames))END PROC sonderwertfueradressaten;PROC +sonderwerteallgschuelerdaten:IF wert(fnrsunamenszusatzs)<>niltextTHEN +setzesonderwert(swschuelername,wert(fnrsurufnames)+trennsymbol+wert( +fnrsunamenszusatzs)+trennsymbol+wert(fnrsufamnames))ELSE setzesonderwert( +swschuelername,wert(fnrsurufnames)+trennsymbol+wert(fnrsufamnames))FI ; +setzesonderwert(swgeburtsdatum,wert(fnrsugebdatums));END PROC +sonderwerteallgschuelerdaten;PROC +sonderwerteschuelerdatenfueranmeldebestaetigung:sonderwerteallgschuelerdaten; +setzesonderwert(swstrhausnr,wert(fnrsustrnrs));setzesonderwert(swplzort,wert( +fnrsuplzorts));setzesonderwert(swtelephonnr,wert(fnrsutelnrs));END PROC +sonderwerteschuelerdatenfueranmeldebestaetigung;PROC sonderwertfueraktjgst: +aktuellejgst:=wert(fnrsusgrpjgst)+wert(fnrsusgrpjgst+1);setzesonderwert( +swaktjgst,aktuellejgst);END PROC sonderwertfueraktjgst;PROC +sonderwertfuerklassenlehrer:sucheklassenlehrer;IF dbstatus=okTHEN IF wert( +fnrlgeschlecht)=weiblichTHEN tutorlehrer:=anredeweibl+trennsymbolELIF wert( +fnrlgeschlecht)=maennlichTHEN tutorlehrer:=anredemaennl+trennsymbolELSE +tutorlehrer:=niltextFI ;IF wert(fnrlzusatz)<>niltextTHEN tutorlehrer:= +tutorlehrer+wert(fnrlzusatz)+trennsymbolFI ;setzesonderwert(swklassenlehrer, +text(tutorlehrer+wert(fnrlfamname),37));FI .sucheklassenlehrer: +sucheschuelergruppe;suchelehrer.sucheschuelergruppe:putwert(fnrsgrpsj, +aktuellesschuljahr);putwert(fnrsgrphj,aktuelleshalbjahr);putwert(fnrsgrpjgst, +wert(fnrsusgrpjgst));putwert(fnrsgrpkennung,wert(fnrsusgrpzugtut));search( +dnraktschuelergruppen,TRUE ).suchelehrer:inittupel(dnrlehrer);IF dbstatus=ok +THEN putwert(fnrlparaphe,wert(fnrsgrplehrer));search(dnrlehrer,TRUE )FI .END +PROC sonderwertfuerklassenlehrer;PROC bildefaecherbestand: +initialisierefaecherkartei;vorbereitung;leseschleife. +initialisierefaecherkartei:FOR zaehler1FROM 1UPTO maxanzahlderfaecherREP FOR +zaehler2FROM 1UPTO karteifachlangtextREP faecherkartei(zaehler1)(zaehler2):= +niltextPER PER .vorbereitung:BOOL VAR wenigergelesen:=FALSE ;INT VAR anztupel +;inittupel(dnrfaecher);anztupel:=anzstacktupel;anzahlderfaecher:=0; +multisearchforward(dnrfaecher,anztupel);evtweniger.leseschleife:WHILE +anztupel>0CAND anzahlderfaecher<=maxanzahlderfaecherREP anzahlderfaecherINCR +1;anztupelDECR 1;multisucc;faecherkartei(anzahlderfaecher)(1):=wert( +dnrfaecher+1);faecherkartei(anzahlderfaecher)(2):=wert(dnrfaecher+2);IF +anztupel=0CAND NOT wenigergelesenTHEN anztupel:=anzstacktupel;multisucc( +dnrfaecher,anztupel);evtwenigerFI PER .evtweniger:IF anztupelniltextTHEN +anzahlderdiffdatenINCR 1;kursdaten(anzahlderdiffdaten)( +indexdiffdatenbeschreibung):=text(anzahlderbelegtenfremdsprachen)+ +". Fremdsprache:";anzahlderbelegtenfremdsprachenINCR 1;kursdaten( +anzahlderdiffdaten)(indexdiffdatenschluessel):=fachkuerzel;FI ; +wievieltespracheINCR 3UNTIL (fnrdd1fremdfach+wievieltesprache)>fnrdd4fremde +PER .ueberpruefeobreligionsteilnahme:IF wert(fnrddreliunter)<>niltextCAND ( +wert(fnrddreliunter+1)=nildatum)OR (wert(fnrddreliunter+1)<>nildatumAND wert( +fnrddreliunter+2)<>nildatum)THEN anzahlderdiffdatenINCR 1;kursdaten( +anzahlderdiffdaten)(indexdiffdatenbeschreibung):="Religion:";kursdaten( +anzahlderdiffdaten)(indexdiffdatenschluessel):=wert(fnrddreliunter)FI . +ueberpruefeobkunstodermusik:IF wert(fnrddkunstmusik)<>niltextTHEN +anzahlderdiffdatenINCR 1;kursdaten(anzahlderdiffdaten)( +indexdiffdatenbeschreibung):="Kunst/Musik:";kursdaten(anzahlderdiffdaten)( +indexdiffdatenschluessel):=wert(fnrddkunstmusik)FI .ermittlewp09:TEXT VAR txt +;IF erstehalbjahrTHEN txt:=textwahlpflichtfach+"09.1:";wps(fnrddfach091a, +anzahlderdiffdaten,txt);wps(fnrddfach091b,anzahlderdiffdaten,txt)ELSE txt:= +textwahlpflichtfach+"09.2:";wps(fnrddfach092a,anzahlderdiffdaten,txt);wps( +fnrddfach092b,anzahlderdiffdaten,txt)FI .ermittlewp10:IF erstehalbjahrTHEN +txt:=textwahlpflichtfach+"10.1:";wps(fnrddfach101a,anzahlderdiffdaten,txt); +wps(fnrddfach101b,anzahlderdiffdaten,txt);ELSE txt:=textwahlpflichtfach+ +"10.2:";wps(fnrddfach102a,anzahlderdiffdaten,txt);wps(fnrddfach102b, +anzahlderdiffdaten,txt)FI .erstehalbjahr:erstehalbj=sonderwert( +swaktuelleshalbjahr).ermittleags:INT VAR wievielteag:=0;REP fachkuerzel:=wert +(fnrddagthema1+wievielteag);IF fachkuerzel<>niltextTHEN anzahlderdiffdaten +INCR 1;kursdaten(anzahlderdiffdaten)(indexdiffdatenbeschreibung):="AG:"; +kursdaten(anzahlderdiffdaten)(indexdiffdatenschluessel):=fachkuerzel;FI ; +wievielteagINCR 3#2#UNTIL (fnrddagthema1+wievielteag)>fnrddagthema3PER . +sonderwertefuerdiffdaten:swkurse:=swkursanfang;FOR zaehler1FROM 1UPTO +anzahlderdiffdatenREP FOR zaehler2FROM 1UPTO indexdiffdatenschluesselREP +setzesonderwert(swkurse,kursdaten(zaehler1)(zaehler2));swkurseINCR 1PER PER . +END PROC sonderwertemitteilungneuangmitdiffd;PROC wps(INT CONST fnr,INT VAR +anzahlderdiffdaten,TEXT CONST txt):IF wert(fnr)<>niltextTHEN +anzahlderdiffdatenINCR 1;kursdaten(anzahlderdiffdaten)( +indexdiffdatenbeschreibung):=txt;kursdaten(anzahlderdiffdaten)( +indexdiffdatenschluessel):=wert(fnr)FI ENDPROC wps;BOOL PROC +sonderwertemitteilungabmeldung:initialisierekursdaten; +initialisieresonderwerte;sonderwertezumaufbaueinermatrix; +sonderwertfueradressaten;sonderwerteallgschuelerdaten; +abgangsdatumundabgangsgrund;sonderwertfueraktjgst; +sonderwertefuerkursebeimabgang;sonderwertfuerklassenlehrer; +sonderwertfuerabgangsgrundundabschluss;TRUE .abgangsdatumundabgangsgrund: +TEXT VAR abgdatum:=wert(fnrsuabgdats);IF abgdatum=nildatumTHEN abgdatum:="" +FI ;setzesonderwert(swabgangsdatum,abgdatum);TEXT VAR abgkuerzel:=wert( +fnrsuabggrund);TEXT VAR abskuerzel:=wert(fnrsuabschluss);. +sonderwertfuerabgangsgrundundabschluss:IF langtextgefunden( +bestandfuerabschluss,abskuerzel,abslangtext)THEN setzesonderwert( +swerreichterabschluss,abslangtext)ELSE setzesonderwert(swerreichterabschluss, +auszufuellendesfeld)FI ;IF langtextgefunden(bestandfuerabgang,abgkuerzel, +abglangtext)THEN setzesonderwert(swabgangsgrund,abglangtext)ELSE +setzesonderwert(swabgangsgrund,auszufuellendesfeld)FI . +sonderwertefuerkursebeimabgang:IF hjdvorhandenTHEN holekursdaten; +zuordnunglerngruppelehrer;swkurse:=swkursanfangELSE anzahlderbelegtenkurse:=0 +FI ;FOR zaehler1FROM 1UPTO anzahlderbelegtenkurseREP setzesonderwert(swkurse, +plusanhang(kursdaten(zaehler1)(fachschluesselindex),subtext(wert( +fnrhjdlerngrpkenn),zaehler1*4-3,zaehler1*4)));swkurseINCR 1;setzesonderwert( +swkurse,kursdaten(zaehler1)(lehrerindex));swkurseINCR 1PER . +sonderwertezumaufbaueinermatrix:setzesonderwert( +swfelderunterschrnoteentlbuecher,auszufuellendefelderunterschrnoteentlbuecher +);setzesonderwert(swmatrixfeld,matrixfeld).END PROC +sonderwertemitteilungabmeldung;TEXT PROC plusanhang(TEXT CONST t,t2):text(t,3 +)+text(t2,5)ENDPROC plusanhang;BOOL PROC langtextgefunden(TEXT CONST bestand, +kuerzel,TEXT VAR lang):systemdboff;putwert(fnrschlsachgebiet,bestand);putwert +(fnrschlschluessel,kuerzel);search(dnrschluessel,TRUE );lang:=wert( +fnrschllangtext);dbstatus=okENDPROC langtextgefunden;PROC lesemaskenwerte: +familienname:=standardmaskenfeld(namefeldnr);rufname:=standardmaskenfeld( +rufnamefeldnr);geburtsdatum:=standardmaskenfeld(geburtsdatumfeldnr);zeigen:= +standardmaskenfeld(bildschirmfeldnr)<>niltextEND PROC lesemaskenwerte;PROC +ermittledievorliegendendaten:standardmeldung(wartemeldnr,niltext);IF +aktuelleshalbjahr=""THEN aktuelleshalbjahr:=schulkenndatum(textschulhalbjahr) +;aktuellesschuljahr:=schulkenndatum(textschuljahr);FI ; +uebernimmschluesselwerte;search(ixsustatfamrufgeb,FALSE );schuelergefunden:=( +dbstatus=ok)CAND (wert(fnrsufamnames)=familienname)CAND (wert(fnrsurufnames)= +rufnameCOR rufname="")CAND (wert(fnrsugebdatums)=datumskonversion( +geburtsdatum)COR geburtsdatum="");IF schuelergefundenCAND abmeldungCAND +falschesabmelddatumTHEN schuelergefunden:=FALSE ;meldefalschesdatum; +zurueckzumdialogELSE weiterverarbeitungFI .falschesabmelddatum:IF +schuljahranfang=""THEN schuljahranfang:=schulkenndatum(textschuljahranfang); +schuljahrende:=schulkenndatum(textschuljahrende)FI ;NOT ((date(wert( +fnrsuabgdats))>=date(schuljahranfang))CAND (date(wert(fnrsuabgdats))<=date( +schuljahrende))).weiterverarbeitung:IF schuelergefundenTHEN +halbjahresdatenholen;ueberpruefeobkursdatenvorliegen;IF NOT hjdvorhandenTHEN +diffdatenholenFI ELSE meldeschuelerexistiertnicht;zurueckzumdialogFI . +halbjahresdatenholen:inittupel(dnrhalbjahresdaten);TEXT VAR tidhjddaten:=wert +(fnrsutidakthjd);readtid(dnrhalbjahresdaten,tidhjddaten).diffdatenholen: +inittupel(dnrdiffdaten);TEXT VAR tiddiffdaten:=wert(fnrsutiddiffdaten); +readtid(dnrdiffdaten,tiddiffdaten).meldeschuelerexistiertnicht: +standardmeldung(existiertnichtmeldnr,niltext).meldefalschesdatum: +standardmeldung(falschesdatum,niltext).ueberpruefeobkursdatenvorliegen: +hjdvorhanden:=dbstatus=okCAND wert(fnrhjdfach)<>"".zurueckzumdialog:return( +father).END PROC ermittledievorliegendendaten;PROC uebernimmschluesselwerte: +putwert(fnrsustatuss,laufenderbestand);putwert(fnrsufamnames,familienname); +putwert(fnrsurufnames,rufname);putwert(fnrsugebdatums,datumskonversion( +geburtsdatum))ENDPROC uebernimmschluesselwerte;PROC mitteilungneuangstarten: +reinitparsing;lesemaskenwerte;IF NOT (wahldruckeroderbildschirmok)THEN +meldedenfehler;zurueckzumdialogELSE IF (schluesselmitdatum)AND (NOT (datumok) +)THEN meldefehlerbeidatum;zurueckzumdialogELSE IF (schluesselmitdatumXOR +schluesselohnedatumok)THEN neuangemeldeteweiterELSE meldedenfehler; +zurueckzumdialogFI ;FI ;FI .neuangemeldeteweiter:abmeldung:=FALSE ; +ermittledievorliegendendaten;IF schuelergefundenTHEN +initialisieredruckerfuermitteilung;IF hjdvorhandenTHEN anschreibenstart( +ixsustatfamrufgeb,vordruckmithjd,zeigen,TRUE ,BOOL PROC +sonderwertemitteilungneuangmithjd,BOOL PROC dummystop)ELSE anschreibenstart( +ixsustatfamrufgeb,vordruckmitdiffd,zeigen,TRUE ,BOOL PROC +sonderwertemitteilungneuangmitdiffd,BOOL PROC dummystop)FI ;FI ;.END PROC +mitteilungneuangstarten;PROC meldedenfehler:standardmeldung(fehlermeldnr, +niltext)END PROC meldedenfehler;PROC zurueckzumdialog:return(father)END PROC +zurueckzumdialog;BOOL PROC wahldruckeroderbildschirmok:standardmaskenfeld( +bildschirmfeldnr)<>niltextXOR standardmaskenfeld(druckerfeldnr)<>niltextEND +PROC wahldruckeroderbildschirmok;BOOL PROC schluesselmitdatum:familienname<> +niltextAND rufname<>niltextAND geburtsdatum<>niltextEND PROC +schluesselmitdatum;BOOL PROC schluesselohnedatumok:familienname<>niltextAND +geburtsdatum=niltextEND PROC schluesselohnedatumok;BOOL PROC datumok: +standardpruefe(6,6,0,0,niltext,eingabestatus);IF NOT (eingabestatus=0)THEN +FALSE ELSE TRUE FI END PROC datumok;PROC meldefehlerbeidatum:standardmeldung( +datumfehler,niltext)END PROC meldefehlerbeidatum;PROC +mitteilungabmeldungstarten:reinitparsing;lesemaskenwerte;IF NOT ( +wahldruckeroderbildschirmok)THEN meldedenfehler;zurueckzumdialogELSE IF ( +schluesselmitdatum)AND (NOT (datumok))THEN meldefehlerbeidatum; +zurueckzumdialogELSE IF (schluesselmitdatumXOR schluesselohnedatumok)THEN +abgemeldeteweiterELSE meldedenfehler;zurueckzumdialogFI ;FI ;FI . +abgemeldeteweiter:abmeldung:=TRUE ;ermittledievorliegendendaten;IF +schuelergefundenTHEN initialisieredruckerfuermitteilung;anschreibenstart( +ixsustatfamrufgeb,vordruckabmeldung,zeigen,TRUE ,BOOL PROC +sonderwertemitteilungabmeldung,BOOL PROC dummystop)FI .END PROC +mitteilungabmeldungstarten;BOOL PROC dummystop:TRUE ENDPROC dummystop;END +PACKET anschrmitteilungenneuangemeldeteundabgemeldete; + diff --git a/app/schulis/2.2.1/src/1.anschr.nachpruefungsbescheinigung b/app/schulis/2.2.1/src/1.anschr.nachpruefungsbescheinigung new file mode 100644 index 0000000..27212bf --- /dev/null +++ b/app/schulis/2.2.1/src/1.anschr.nachpruefungsbescheinigung @@ -0,0 +1,150 @@ +PACKET anschrnachpruefungsbescheinigungDEFINES +nachpruefungsbescheinigungeingang,nachpruefungsbescheinigungende, +nachpruefungsbescheinigungstarten,sonderwertenachpruefungsbescheinigung, +multistopnachpruefbesch:INT VAR aktuellerindex;TEXT VAR schuelerschluessel1, +schuelerschluessel2,schuelerschluessel3,bestandsschluessel1, +bestandsschluessel2,aktuellesschuljahr,vorigesschuljahr;LET # +schluesselversetztmitpruefung="n"#schluesselnachpruefung="n";# +schluesselwiederholtmitpruefung="x",schluesselwiederholer="w";#LET vordruck= +"vordruck nachpruefungsbescheinigung";LET maske= +"ms auswahl schueler o. klasse";LET namefeldnr=2,vornamefeldnr=3, +geburtsdatumfeldnr=4,jgstfeldnr=5,zugtutorfeldnr=6,bildschirmfeldnr=7, +druckerfeldnr=8;LET niltext="",trennsymbol=" ",punkt=".",meldkennz="#", +fehlerhalbjnr=165,fehlermeldnr=56,#wartemeldnr=69,sortiervorgangwartemeldnr= +76,#dieauswahlderjgstistnichtzulaessignr=146,vater=1;LET minjgst=5,jgst11=11, +maxjgst=13;LET swschulhalbjahr=509,swzuname=511,swnamenszusaetze=512, +swvornamen=513,swgeschlecht=514,swgeburtsdatum=515,swzugang=516, +swjgstnachpruefung=517,swnachpruefungsfach=518,swparagraph=519,swbemerkung= +520;LET maxanzahlderfaecher=100,fachschluesselindex=1,fachlangtextindex=2; +ROW maxanzahlderfaecherROW fachlangtextindexTEXT VAR faecherkartei;INT VAR +anzahlderfaecher:=0;BOOL VAR eingang:=TRUE ,erstehalbjahr:=TRUE , +anschreibenzeigen;TEXT PROC langtextzufachschluessel(TEXT CONST schluessel): +INT VAR zaehler:=1;TEXT VAR langtext:="";WHILE zaehlerfaecherkartei(zaehler)(fachschluesselindex)REP zaehlerINCR 1PER ; +IF schluessel=faecherkartei(zaehler)(fachschluesselindex)THEN langtext:= +faecherkartei(zaehler)(fachlangtextindex)FI ;langtextEND PROC +langtextzufachschluessel;PROC bildefaecherbestand:LET anzstacktupel=25; +initialisierefaecherkartei;vorbereitung;leseschleife. +initialisierefaecherkartei:INT VAR zaehler1,zaehler2;FOR zaehler1FROM 1UPTO +maxanzahlderfaecherREP FOR zaehler2FROM 1UPTO fachlangtextindexREP +faecherkartei(zaehler1)(zaehler2):=niltextPER PER .vorbereitung:BOOL VAR +wenigergelesen:=FALSE ;INT VAR anztupel;inittupel(dnrfaecher);anztupel:= +anzstacktupel;anzahlderfaecher:=0;multisearchforward(dnrfaecher,anztupel); +evtweniger.leseschleife:WHILE anztupel>0CAND anzahlderfaecher<= +maxanzahlderfaecherREP anzahlderfaecherINCR 1;anztupelDECR 1;multisucc; +faecherkartei(anzahlderfaecher)(1):=wert(dnrfaecher+1);faecherkartei( +anzahlderfaecher)(2):=wert(dnrfaecher+2);IF anztupel=0CAND NOT wenigergelesen +THEN anztupel:=anzstacktupel;multisucc(dnrfaecher,anztupel);evtwenigerFI PER +.evtweniger:IF anztupel1CAND int(nachpruefergebnis)>=4) +COR (length(nachpruefergebnis)=1CAND int(nachpruefergebnis)<=4). +sonderwertfuerdiejahrgangsstufe:#IF wert(fnrsuartzugang)="x"THEN +setzesonderwert(swjgstnachpruefung,text(int(wert(fnrsujgst))-1))ELSE +setzesonderwert(swjgstnachpruefung,wert(fnrsujgst))FI #setzesonderwert( +swjgstnachpruefung,wert(fnrhjdjgst)).sonderwertparagraph:TEXT CONST +paragraphsek1:="Nr. 4 der Verordnung über die Abschlüsse und "+ +"die Versetzung in Sekundarstufe 1 (AVO - SI)",paragraphsek2:= +"Nr. 11 der Verordnung über den Bildungsgang"+ +" und die Abiturprüfung der gymnasialen Oberstufe";IF int(wert(fnrhjdjgst))< +jgst11THEN setzesonderwert(swparagraph,paragraphsek1)ELSE setzesonderwert( +swparagraph,paragraphsek2)FI .sonderwertfuerdasnachpruefungsfach:TEXT VAR +fachschluessel:="";#TEXT VAR nachpruefungsfach:="";#TEXT VAR langtext:=""; +fachschluessel:=wert(fnrhjdnachfach);langtext:=langtextzufachschluessel( +fachschluessel);setzesonderwert(swnachpruefungsfach,langtext). +sonderwertfuerbemerkung:sucheschluesselbemerkung; +suchelangtextzubemerkungundsetzesonderwert.sucheschluesselbemerkung:TEXT VAR +bemerkungsschluessel:="";bemerkungsschluessel:=wert(fnrhjdbemerk). +suchelangtextzubemerkungundsetzesonderwert:#INT VAR bestandsid:=0;systemdbon; +putwert(fnrsysbestand,"c02 bemerkungen");search(dnrsysbestaende,TRUE );IF +dbstatus=okTHEN bestandsid:=intwert(fnrsysbestandsid)FI ;systemdboff;#putwert +(fnrschlsachgebiet,"c02 bemerkungen");putwert(fnrschlschluessel, +bemerkungsschluessel);search(dnrschluessel,TRUE );IF dbstatus=okTHEN +setzesonderwert(swbemerkung,wert(fnrschllangtext))ELSE dbstatus(ok); +setzesonderwert(swbemerkung,niltext)FI .END PROC +sonderwertenachpruefungsbescheinigung;PROC nachpruefungsbescheinigungstarten: +IF erstehalbjahrTHEN lesemaskenwerte;IF maskenwerteinordnungTHEN IF +beibestandsauswahlauswahlzulaessigTHEN #bildebestand;IF status<>0AND NOT +einzelbearbeitungTHEN meldenichterstellbar;zurueckzumdialogELSE # +startenausfuehren#FI #ELSE meldeunzulaessigeschuelergruppenauswahl; +zurueckzumdialogFI ELSE meldedenfehler;zurueckzumdialogFI ELSE +meldefalscheshalbjahr;zurueckzumdialogFI .meldefalscheshalbjahr:LET +ersteshalbjahr="1";standardmeldung(fehlerhalbjnr,ersteshalbjahr+meldkennz). +lesemaskenwerte:schuelerschluessel1:=standardmaskenfeld(namefeldnr); +schuelerschluessel2:=standardmaskenfeld(vornamefeldnr);schuelerschluessel3:= +standardmaskenfeld(geburtsdatumfeldnr);bestandsschluessel1:= +standardmaskenfeld(jgstfeldnr);bestandsschluessel2:=standardmaskenfeld( +zugtutorfeldnr);anschreibenzeigen:=standardmaskenfeld(bildschirmfeldnr)<> +niltext.maskenwerteinordnung:IF NOT ((standardmaskenfeld(bildschirmfeldnr)<> +niltext)XOR (standardmaskenfeld(druckerfeldnr)<>niltext))THEN infeld( +bildschirmfeldnr);FALSE ELIF ((schuelerschluessel1<>niltextAND +bestandsschluessel1+bestandsschluessel2=niltextAND (schuelerschluessel2<> +niltextXOR (schuelerschluessel2=niltextAND schuelerschluessel3=niltext)))XOR +(schuelerschluessel1+schuelerschluessel2+schuelerschluessel3=niltextAND +bestandsschluessel1<>niltext)XOR (schuelerschluessel1+schuelerschluessel2+ +schuelerschluessel3+bestandsschluessel1+bestandsschluessel2=niltext))THEN +TRUE ELSE infeld(namefeldnr);FALSE FI .meldedenfehler:standardmeldung( +fehlermeldnr,niltext).zurueckzumdialog:return(vater). +meldeunzulaessigeschuelergruppenauswahl:standardmeldung( +dieauswahlderjgstistnichtzulaessignr,niltext). +beibestandsauswahlauswahlzulaessig:(bestandsschluessel1=niltext)OR ( +bestandsschluessel1<>niltextCAND int(bestandsschluessel1)<=maxjgstCAND int( +bestandsschluessel1)>=minjgst).#einzelbearbeitung:schuelerschluessel1<> +niltext.startenausfuehren:initialisieredruckerfueranschreiben; +anschreibenstart(endbestand,vordruck,dbmnachpruefungsbescheinigung, +schuelerschluessel1,schuelerschluessel2+schuelerschluessel3,anschreibenzeigen +,laengedbmnachpruefungsbescheinigung,BOOL PROC +sonderwertenachpruefungsbescheinigung);.END PROC +nachpruefungsbescheinigungstarten;#startenausfuehren: +initialisieredruckerfueranschreiben;dbstatus(ok);parsenooffields(44); +indexnummerbestimmen;uebernimmentsprechendedaten;anschreibenstart( +aktuellerindex,vordruck,anschreibenzeigen,(schuelerschluessel1+ +schuelerschluessel2)<>"",BOOL PROC sonderwertenachpruefungsbescheinigung, +BOOL PROC multistopnachpruefbesch).uebernimmentsprechendedaten:putwert( +fnrhjdsj,#aktuellesschuljahr#vorigesschuljahr);putintwert(fnrhjdhj,2);putwert +(fnrhjdfamnames,schuelerschluessel1);putwert(fnrhjdrufnames, +schuelerschluessel2);putwert(fnrhjdgebdats,datumskonversion( +schuelerschluessel3));putwert(fnrhjdjgst,bestandsschluessel1);putwert( +fnrhjdkennung,bestandsschluessel2);putwert(fnrhjdversetzung, +schluesselnachpruefung).indexnummerbestimmen:IF schuelerschluessel1<>niltext +THEN aktuellerindex:=#dnrhjd#ixhjdverfamsjhjrufgebELSE aktuellerindex:= +ixhjdversjhjjgstkennFI .END PROC nachpruefungsbescheinigungstarten;BOOL PROC +multistopnachpruefbesch:BOOL VAR b:=wert(fnrhjdsj)=#aktuellesschuljahr# +vorigesschuljahrCAND intwert(fnrhjdhj)=2CAND wert(fnrhjdversetzung)= +schluesselnachpruefung;IF bTHEN weitereueberpruefungFI ;b. +weitereueberpruefung:IF aktuellerindex=ixhjdverfamsjhjrufgebTHEN +ueberpruefenamenELSE IF bestandsschluessel1<>""THEN ueberpruefejgstFI FI . +ueberpruefenamen:b:=wert(fnrhjdfamnames)=schuelerschluessel1CAND ( +schuelerschluessel2=""COR wert(fnrhjdrufnames)=schuelerschluessel2)CAND ( +schuelerschluessel3=""COR wert(fnrhjdgebdats)=datumskonversion( +schuelerschluessel3)).ueberpruefejgst:b:=bestandsschluessel1=wert(fnrhjdjgst) +CAND (bestandsschluessel2=""COR bestandsschluessel2=wert(fnrhjdkennung)). +ENDPROC multistopnachpruefbesch;END PACKET anschrnachpruefungsbescheinigung; + diff --git a/app/schulis/2.2.1/src/1.anschr.nachpruefungszulassung b/app/schulis/2.2.1/src/1.anschr.nachpruefungszulassung new file mode 100644 index 0000000..871d9b6 --- /dev/null +++ b/app/schulis/2.2.1/src/1.anschr.nachpruefungszulassung @@ -0,0 +1,146 @@ +PACKET anschrnachpruefungszulassungDEFINES nachpruefungszulassungeingang, +nachpruefungszulassungende,nachpruefungszulassungstarten, +sonderwertenachpruefungszulassung,multistopnachpruefler:INT VAR +aktuellerindex;TEXT VAR schuelerschluessel1,schuelerschluessel2, +schuelerschluessel3,bestandsschluessel1,bestandsschluessel2, +aktuellesschuljahr;LET schluesselnachpruefung="n";LET vordruck= +"vordruck nachpruefungszulassung";LET maske="ms anschr schueler o. klasse"; +LET namefeldnr=2,vornamefeldnr=3,geburtsdatumfeldnr=4,jgstfeldnr=5, +zugtutorfeldnr=6,bildschirmfeldnr=7,druckerfeldnr=8;LET niltext="", +trennsymbol=" ",vollj="v",minderj="m",oder=" oder ",punkt=".",meldkennz="#", +fehlerhalbjnr=167,fehlermeldnr=56,#wartemeldnr=69,# +dieauswahlderjgstistnichtzulaessignr=146,# +anschreibenkannnichterstelltwerdennr=124,#vater=1;LET minjgst=5,jgst11=11, +maxjgst=13;LET swschulhalbjahr=509,swzuname=511,swnamenszusaetze=512, +swvornamen=513,swgeschlecht=514,swvollj=515,swstrhausnr=517,swplzort=518, +swnameerzieher=519,swnamenszusaetzeerzieher=520,swvornameerzieher=521, +swstrhausnrerzieher=522,swplzorterzieher=523,swparagraph=524, +swnachpruefungsfaecher=525,swbemerkung=526;LET maxanzahlderfaecher=100, +karteifachlangtext=2,fachschluesselindex=1,fachlangtextindex=2;ROW +maxanzahlderfaecherROW karteifachlangtextTEXT VAR faecherkartei;INT VAR +anzahlderfaecher:=0;BOOL VAR eingang:=TRUE ,zweitehalbjahr:=TRUE , +anschreibenzeigen;PROC bildefaecherbestand:LET anzstacktupel=25; +initialisierefaecherkartei;vorbereitung;leseschleife. +initialisierefaecherkartei:INT VAR zaehler1,zaehler2;FOR zaehler1FROM 1UPTO +maxanzahlderfaecherREP FOR zaehler2FROM 1UPTO karteifachlangtextREP +faecherkartei(zaehler1)(zaehler2):=niltextPER PER .vorbereitung:BOOL VAR +wenigergelesen:=FALSE ;INT VAR anztupel;inittupel(dnrfaecher);anztupel:= +anzstacktupel;anzahlderfaecher:=0;multisearchforward(dnrfaecher,anztupel); +evtweniger.leseschleife:WHILE anztupel>0CAND anzahlderfaecher<= +maxanzahlderfaecherREP anzahlderfaecherINCR 1;anztupelDECR 1;multisucc; +faecherkartei(anzahlderfaecher)(1):=wert(dnrfaecher+1);faecherkartei( +anzahlderfaecher)(2):=wert(dnrfaecher+2);IF anztupel=0CAND NOT wenigergelesen +THEN anztupel:=anzstacktupel;multisucc(dnrfaecher,anztupel);evtwenigerFI PER +.evtweniger:IF anztupelfaecherkartei(zaehler)(fachschluesselindex)REP zaehlerINCR 1PER ; +IF schluessel=faecherkartei(zaehler)(fachschluesselindex)THEN langtext:= +faecherkartei(zaehler)(fachlangtextindex)FI ;langtextEND PROC +langtextzufachschluessel;PROC nachpruefungszulassungeingang:standardvproc( +maske);IF eingangTHEN setzesonderwerteschulkenndaten; +feststellenobzweitehalbjahr;IF zweitehalbjahrTHEN bildefaecherbestand;FI ; +aendernderflaggeFI .feststellenobzweitehalbjahr:zweitehalbjahr:=int( +sonderwert(swschulhalbjahr))=2.aendernderflagge:eingang:=FALSE .END PROC +nachpruefungszulassungeingang;PROC nachpruefungszulassungende:eingang:=TRUE ; +enter(2)END PROC nachpruefungszulassungende;BOOL PROC +sonderwertenachpruefungszulassung:initialisieresonderwerte;sucheschueler; +sonderwertfuerdenadressaten;sonderwerteschuelerdaten;sonderwerteerzieherdaten +;sonderwertparagraph;sonderwertfuerdienachpruefungsfaecher; +sonderwertfuerbemerkung;TRUE .sucheschueler:inittupel(dnrschueler); +uebernehmeentsprdaten;search(dnrschueler,TRUE ).uebernehmeentsprdaten:putwert +(fnrsufamnames,wert(fnrhjdfamnames));putwert(fnrsurufnames,wert( +fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats)). +sonderwertfuerdenadressaten:adressat((wert(fnrsuvornames)SUB 1)+punkt+ +trennsymbol+wert(fnrsufamnames)).sonderwerteschuelerdaten:setzesonderwert( +swzuname,wert(fnrsufamnames));setzesonderwert(swnamenszusaetze,wert( +fnrsunamenszusatzs));setzesonderwert(swvornamen,wert(fnrsuvornames)); +setzesonderwert(swgeschlecht,wert(fnrsugeschlechts));setzesonderwert( +swstrhausnr,wert(fnrsustrnrs));setzesonderwert(swplzort,wert(fnrsuplzorts)); +IF volljaehrig(wert(fnrsugebdatums))THEN setzesonderwert(swvollj,vollj);ELSE +setzesonderwert(swvollj,minderj)FI .sonderwerteerzieherdaten:setzesonderwert( +swnameerzieher,wert(fnrsufamnamee));setzesonderwert(swnamenszusaetzeerzieher, +wert(fnrsunamenszusatze));setzesonderwert(swvornameerzieher,wert( +fnrsuvornamee));sucheerzieheradresse;setzesonderwert(swstrhausnrerzieher,wert +(fnrsustrnrs));setzesonderwert(swplzorterzieher,wert(fnrsuplzorts));. +sucheerzieheradresse:#IF wert(fnradresse)<>""THEN putwert(fnradrkuerzel,wert( +fnradresse));search(dnradressen,TRUE );IF dbstatus=okTHEN +uebernehmeerzieheradresseELSE dbstatus(ok)FI FI #IF wert(fnrsuplzorte)<>"" +THEN uebernehmeerzieheradresseFI .uebernehmeerzieheradresse:putwert( +fnrsustrnrs,wert(fnrsustrnre));putwert(fnrsuplzorts,wert(fnrsuplzorte)). +sonderwertparagraph:TEXT CONST paragraphsek1:= +"Nr. 4 der Verordnung über die Abschlüsse und "+ +"die Versetzung in Sekundarstufe 1 (AVO - SI)",paragraphsek2:= +"Nr. 11 der Verordnung über den Bildungsgang"+ +" und die Abiturprüfung der gymnasialen Oberstufe";IF int(wert(fnrhjdjgst))< +jgst11THEN setzesonderwert(swparagraph,paragraphsek1)ELSE setzesonderwert( +swparagraph,paragraphsek2)FI .sonderwertfuerdienachpruefungsfaecher:TEXT VAR +fachschluessel:="";TEXT VAR nachpruefungsfach:="";TEXT VAR langtext:=""; +bestimmungderfaecherindennachpruefungmoeglich;setzesonderwert( +swnachpruefungsfaecher,nachpruefungsfach). +bestimmungderfaecherindennachpruefungmoeglich:fachschluessel:=wert( +fnrhjdnachfach1);langtext:=langtextzufachschluessel(fachschluessel);IF +langtext<>niltextTHEN nachpruefungsfach:=langtext;fachschluessel:=wert( +fnrhjdnachfach2);langtext:=langtextzufachschluessel(fachschluessel);IF +langtext<>niltextTHEN nachpruefungsfach:=nachpruefungsfach+oder+langtext; +fachschluessel:=wert(fnrhjdnachfach3);langtext:=langtextzufachschluessel( +fachschluessel);IF langtext<>niltextTHEN nachpruefungsfach:=nachpruefungsfach ++oder+langtextFI FI FI .sonderwertfuerbemerkung:sucheschluesselbemerkung; +suchelangtextzubemerkungundsetzesonderwert.sucheschluesselbemerkung:TEXT VAR +bemerkungsschluessel:="";bemerkungsschluessel:=wert(fnrhjdbemnach). +suchelangtextzubemerkungundsetzesonderwert:putwert(fnrschlsachgebiet, +"c02 bemerkungen");putwert(fnrschlschluessel,bemerkungsschluessel);search( +dnrschluessel,TRUE );IF dbstatus=okTHEN setzesonderwert(swbemerkung,wert( +fnrschllangtext))ELSE dbstatus(ok);setzesonderwert(swbemerkung,niltext)FI . +END PROC sonderwertenachpruefungszulassung;PROC nachpruefungszulassungstarten +:IF zweitehalbjahrTHEN lesemaskenwerte;IF maskenwerteinordnungTHEN IF +beibestandsauswahlauswahlzulaessigTHEN startenausfuehrenELSE +meldeunzulaessigeschuelergruppenauswahl;zurueckzumdialogFI ELSE +meldedenfehler;zurueckzumdialogFI ELSE meldefalscheshalbjahr;zurueckzumdialog +FI .meldefalscheshalbjahr:LET zweiteshalbjahr="2";standardmeldung( +fehlerhalbjnr,zweiteshalbjahr+meldkennz).lesemaskenwerte:schuelerschluessel1 +:=standardmaskenfeld(namefeldnr);schuelerschluessel2:=standardmaskenfeld( +vornamefeldnr);schuelerschluessel3:=standardmaskenfeld(geburtsdatumfeldnr); +bestandsschluessel1:=standardmaskenfeld(jgstfeldnr);bestandsschluessel2:= +standardmaskenfeld(zugtutorfeldnr);anschreibenzeigen:=standardmaskenfeld( +bildschirmfeldnr)<>niltext.maskenwerteinordnung:IF NOT ((standardmaskenfeld( +bildschirmfeldnr)<>niltext)XOR (standardmaskenfeld(druckerfeldnr)<>niltext)) +THEN infeld(bildschirmfeldnr);FALSE ELIF ((schuelerschluessel1<>niltextAND +bestandsschluessel1+bestandsschluessel2=niltextAND (schuelerschluessel2<> +niltextXOR (schuelerschluessel2=niltextAND schuelerschluessel3=niltext)))XOR +(schuelerschluessel1+schuelerschluessel2+schuelerschluessel3=niltextAND +bestandsschluessel1<>niltext)XOR (schuelerschluessel1+schuelerschluessel2+ +schuelerschluessel3+bestandsschluessel1+bestandsschluessel2=niltext))THEN +TRUE ELSE infeld(namefeldnr);FALSE FI .meldedenfehler:standardmeldung( +fehlermeldnr,niltext).zurueckzumdialog:return(vater). +meldeunzulaessigeschuelergruppenauswahl:standardmeldung( +dieauswahlderjgstistnichtzulaessignr,niltext). +beibestandsauswahlauswahlzulaessig:(bestandsschluessel1=niltext)OR ( +bestandsschluessel1<>niltextCAND int(bestandsschluessel1)<=maxjgstCAND int( +bestandsschluessel1)>=minjgst).startenausfuehren: +initialisieredruckerfueranschreiben;dbstatus(ok);parsenooffields(30); +indexnummerbestimmen;uebernimmentsprechendedaten;anschreibenstart( +aktuellerindex,vordruck,anschreibenzeigen,(schuelerschluessel1+ +schuelerschluessel2)<>"",BOOL PROC sonderwertenachpruefungszulassung,BOOL +PROC multistopnachpruefler).uebernimmentsprechendedaten:aktuellesschuljahr:= +schulkenndatum("Schuljahr");putwert(fnrhjdsj,aktuellesschuljahr);putintwert( +fnrhjdhj,2);putwert(fnrhjdfamnames,schuelerschluessel1);putwert( +fnrhjdrufnames,schuelerschluessel2);putwert(fnrhjdgebdats,datumskonversion( +schuelerschluessel3));putwert(fnrhjdjgst,bestandsschluessel1);putwert( +fnrhjdkennung,bestandsschluessel2);putwert(fnrhjdversetzung, +schluesselnachpruefung).indexnummerbestimmen:IF schuelerschluessel1<>niltext +THEN aktuellerindex:=#dnrhalbjahresdaten#ixhjdverfamsjhjrufgebELSE +aktuellerindex:=ixhjdversjhjjgstkennFI .END PROC +nachpruefungszulassungstarten;BOOL PROC multistopnachpruefler:BOOL VAR b:= +wert(fnrhjdsj)=aktuellesschuljahrCAND intwert(fnrhjdhj)=2CAND wert( +fnrhjdversetzung)=schluesselnachpruefung;IF bTHEN weitereueberpruefungFI ;b. +weitereueberpruefung:IF aktuellerindex=ixhjdverfamsjhjrufgebTHEN +ueberpruefenamenELSE IF bestandsschluessel1<>""THEN ueberpruefejgstFI FI . +ueberpruefenamen:b:=wert(fnrhjdfamnames)=schuelerschluessel1CAND ( +schuelerschluessel2=""COR wert(fnrhjdrufnames)=schuelerschluessel2)CAND ( +schuelerschluessel3=""COR wert(fnrhjdgebdats)=datumskonversion( +schuelerschluessel3)).ueberpruefejgst:b:=int(bestandsschluessel1)=intwert( +fnrhjdjgst)CAND (bestandsschluessel2=""COR bestandsschluessel2=wert( +fnrhjdkennung)).ENDPROC multistopnachpruefler;END PACKET +anschrnachpruefungszulassung; + diff --git a/app/schulis/2.2.1/src/1.anschr.schulbescheinigung b/app/schulis/2.2.1/src/1.anschr.schulbescheinigung new file mode 100644 index 0000000..16686b2 --- /dev/null +++ b/app/schulis/2.2.1/src/1.anschr.schulbescheinigung @@ -0,0 +1,61 @@ +PACKET anschrschulbescheinigungDEFINES schulbescheinigungeingang, +schulbescheinigungstarten,sonderwerteschulbescheinigung, +multistopschulbescheinigung:TEXT VAR schuelerschluessel1,schuelerschluessel2, +schuelerschluessel3,bestandsschluessel1,bestandsschluessel2;BOOL VAR +anschreibenzeigen;INT VAR aktuellerindex,eingabestatus;LET vordruck= +"vordruck schulbescheinigung";LET trennsymbol=" ",punkt=".";LET maske= +"ms auswahl schueler o. klasse",namefeldnr=2,vornamefeldnr=3, +geburtsdatumfeldnr=4,jgstfeldnr=5,zugtutorfeldnr=6,bildschirmfeldnr=7, +druckerfeldnr=8,niltext="",fehlermeldnr=56,wartemeldnr=69,datumfehler=157, +vater=1;PROC schulbescheinigungeingang:standardvproc(maske)END PROC +schulbescheinigungeingang;BOOL PROC sonderwerteschulbescheinigung:adressat(( +wert(fnrsurufnames)SUB 1)+punkt+trennsymbol+wert(fnrsufamnames));TRUE END +PROC sonderwerteschulbescheinigung;PROC schulbescheinigungstarten: +lesemaskenwerte;IF NOT (auswahldruckeroderbildschirmok)THEN meldedenfehler; +infeld(bildschirmfeldnr);zurueckzumdialogELSE IF schluesselmitdatumangegeben +THEN IF schuelerschluessel3okTHEN indexnrbilden;startenausfuehrenELSE +standardmeldung(datumfehler,niltext);infeld(geburtsdatumfeldnr); +zurueckzumdialogFI ;ELSE IF (alleschuelergewaehltXOR schuelergruppegewaehlt +XOR einschuelerohnedatumgewaehlt)THEN indexnrbilden;startenausfuehrenELSE +meldedenfehler;zurueckzumdialogFI ;FI ;FI .lesemaskenwerte: +schuelerschluessel1:=standardmaskenfeld(namefeldnr);schuelerschluessel2:= +standardmaskenfeld(vornamefeldnr);schuelerschluessel3:=standardmaskenfeld( +geburtsdatumfeldnr);bestandsschluessel1:=standardmaskenfeld(jgstfeldnr); +bestandsschluessel2:=standardmaskenfeld(zugtutorfeldnr);anschreibenzeigen:= +standardmaskenfeld(bildschirmfeldnr)<>niltext.auswahldruckeroderbildschirmok: +(standardmaskenfeld(bildschirmfeldnr)<>niltext)XOR (standardmaskenfeld( +druckerfeldnr)<>niltext).schluesselmitdatumangegeben:((bestandsschluessel1+ +bestandsschluessel2)=niltextAND schuelerschluessel1<>niltextAND +schuelerschluessel2<>niltextAND schuelerschluessel3<>niltext). +alleschuelergewaehlt:(schuelerschluessel1+schuelerschluessel2+ +schuelerschluessel3+bestandsschluessel1+bestandsschluessel2)=niltext. +schuelergruppegewaehlt:bestandsschluessel1<>niltextAND (schuelerschluessel1+ +schuelerschluessel2+schuelerschluessel3=niltext).einschuelerohnedatumgewaehlt +:(bestandsschluessel1+bestandsschluessel2+schuelerschluessel3)=niltextAND +schuelerschluessel1<>niltext.schuelerschluessel3ok:standardpruefe(6,4,0,0, +niltext,eingabestatus);IF NOT (eingabestatus=0)THEN FALSE ELSE TRUE FI . +meldedenfehler:standardmeldung(fehlermeldnr,niltext).zurueckzumdialog:return( +vater).indexnrbilden:standardmeldung(wartemeldnr,niltext);IF +bestandsschluessel1<>niltextTHEN IF bestandsschluessel2<>niltextTHEN +aktuellerindex:=ixsustatjgstzugELSE aktuellerindex:=ixsustatjgstFI ELSE +aktuellerindex:=dnrschuelerFI .startenausfuehren: +initialisieredruckerfueranschreiben;#anschreibenstart(bestand,vordruck, +dbmschulbescheinigung,schuelerschluessel1,schuelerschluessel2+ +schuelerschluessel3,anschreibenzeigen,laengedbmschulbescheinigung,BOOL PROC +sonderwerteschulbescheinigung);#dbstatus(ok);inittupel(dnrschueler); +parsenooffields(19);uebernimmentsprechendedaten;anschreibenstart( +aktuellerindex,vordruck,anschreibenzeigen,(schuelerschluessel1+ +schuelerschluessel2)<>"",BOOL PROC sonderwerteschulbescheinigung,BOOL PROC +multistopschulbescheinigung).uebernimmentsprechendedaten:putwert( +fnrsufamnames,schuelerschluessel1);putwert(fnrsurufnames,schuelerschluessel2) +;putwert(fnrsugebdatums,datumskonversion(schuelerschluessel3));putwert( +fnrsusgrpjgst,bestandsschluessel1);putwert(fnrsusgrpzugtut, +bestandsschluessel2);putwert(fnrsustatuss,"ls").END PROC +schulbescheinigungstarten;BOOL PROC multistopschulbescheinigung:BOOL VAR b:= +FALSE ;IF wert(fnrsustatuss)="ls"THEN IF aktuellerindex<>dnrschuelerTHEN IF +aktuellerindex=ixsustatjgstTHEN b:=bestandsschluessel1=wert(fnrsusgrpjgst) +ELSE b:=(bestandsschluessel1=wert(fnrsusgrpjgst)CAND bestandsschluessel2=wert +(fnrsusgrpzugtut))FI ELSE b:=(schuelerschluessel1<>niltextCAND dbstatus=ok) +COR (schuelerschluessel1=niltextCAND TRUE )FI ;FI ;bENDPROC +multistopschulbescheinigung;END PACKET anschrschulbescheinigung; + diff --git a/app/schulis/2.2.1/src/1.anschr.wiederholer b/app/schulis/2.2.1/src/1.anschr.wiederholer new file mode 100644 index 0000000..8de4b25 --- /dev/null +++ b/app/schulis/2.2.1/src/1.anschr.wiederholer @@ -0,0 +1,91 @@ +PACKET anschrwiederholerDEFINES wiederholereingang,wiederholerstarten, +sonderwertewiederholer,multistopwiederholer:INT VAR aktuellerindex;TEXT VAR +schuelerschluessel1,schuelerschluessel2,schuelerschluessel3, +bestandsschluessel1,bestandsschluessel2,aktuellesschuljahr:="";LET vordruck= +"vordruck fuer wiederholer";LET swindexvolljminderj=511, +swindexminderjmaennlweibl=512,swindexnichterreichtejgst=513;LET jgst13=13, +weibl="w",maennl="m",minderj="m",vollj="v",niltext="",trennsymbol=" ",punkt= +".",schluesselwiederholer="w";LET maske="ms anschr schueler o. klasse";LET +namefeldnr=2,vornamefeldnr=3,geburtsdatumfeldnr=4,jgstfeldnr=5,zugtutorfeldnr +=6,bildschirmfeldnr=7,druckerfeldnr=8;LET fehlermeldnr=56,nurimzweitenhj=194, +#wartemeldnr=69,anschreibenkannnichterstelltwerdennr=124,# +dieauswahlderjgstistnichtzulaessignr=146,vater=1;LET minjgst=5,maxjgst=13; +PROC wiederholereingang:standardvproc(maske)END PROC wiederholereingang;BOOL +PROC sonderwertewiederholer:BOOL VAR erstellbar:=TRUE ;sucheschuelerdaten; +sonderwertfuervolljoderminderjundmaennlweibl;sonderwertfuernichterreichtejgst +;sonderwertfueradressaten;erstellbar#keitsangabe#.sucheschuelerdaten: +inittupel(dnrschueler);uebernimmschuelerdaten;search(dnrschueler,TRUE ). +uebernimmschuelerdaten:putwert(fnrsufamnames,wert(fnrhjdfamnames));putwert( +fnrsurufnames,wert(fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats +)).sonderwertfuervolljoderminderjundmaennlweibl:IF volljaehrig(wert( +fnrsugebdatums))THEN setzesonderwert(swindexvolljminderj,vollj); +setzesonderwert(swindexminderjmaennlweibl,niltext)ELSE setzesonderwert( +swindexvolljminderj,minderj);IF wert(fnrsugeschlechts)=weiblTHEN +setzesonderwert(swindexminderjmaennlweibl,weibl)ELSE setzesonderwert( +swindexminderjmaennlweibl,maennl)FI ;setzeerzieheradresseFI . +setzeerzieheradresse:#IF intwert(fnradresse)<>0THEN putwert(fnradrkuerzel, +wert(fnradresse));search(dnradressen,TRUE );IF dbstatus=okTHEN putwert( +fnrsustrnrs,wert(fnradrstrasse));putwert(fnrsuplzorts,wert(fnradrort))FI FI # +IF wert(fnrsuplzorte)<>""THEN putwert(fnrsustrnrs,wert(fnrsustrnre));putwert( +fnrsuplzorts,wert(fnrsuplzorts))FI .sonderwertfuernichterreichtejgst: +setzesonderwert(swindexnichterreichtejgst,text(intwert(fnrhjdjgst)+1)); +erstellbar:=NOT (intwert(fnrhjdjgst)=jgst13).sonderwertfueradressaten: +adressat((wert(fnrsurufnames)SUB 1)+punkt+trennsymbol+wert(fnrsufamnames));.# +erstellbarkeitsangabe:IF intwert(fnrzugang)=schluesselwiederholerTHEN +erstellbar:=wert(dbmindexversetzung,zweiteteilsegment)=schluesselwiederholer +AND erstellbarELSE erstellbar:=(dbwert(dbmindexversetzung,ersteteilsegment)= +schluesselwiederholer)AND erstellbarFI ;erstellbar.#END PROC +sonderwertewiederholer;PROC wiederholerstarten:IF zweiteshjTHEN weiterFI . +weiter:lesemaskenwerte;IF maskenwerteinordnungTHEN IF +beibestandsauswahlauswahlzulaessigTHEN #bestandbilden;IF status<>0THEN +meldenichterstellbar;zurueckzumdialogELSE #indexnummerbestimmen; +startenausfuehren#FI #ELSE meldeunzulaessigeschuelergruppenauswahl; +zurueckzumdialogFI ELSE meldedenfehler;zurueckzumdialogFI .zweiteshj:IF int( +schulkenndatum("Schulhalbjahr"))=1THEN standardmeldung(nurimzweitenhj,"2.#"); +zurueckzumdialog;FALSE ELSE TRUE FI .lesemaskenwerte:schuelerschluessel1:= +standardmaskenfeld(namefeldnr);schuelerschluessel2:=standardmaskenfeld( +vornamefeldnr);schuelerschluessel3:=standardmaskenfeld(geburtsdatumfeldnr); +bestandsschluessel1:=standardmaskenfeld(jgstfeldnr);bestandsschluessel2:= +standardmaskenfeld(zugtutorfeldnr);BOOL CONST anschreibenzeigen:= +standardmaskenfeld(bildschirmfeldnr)<>niltext.maskenwerteinordnung:IF NOT (( +standardmaskenfeld(bildschirmfeldnr)<>niltext)XOR (standardmaskenfeld( +druckerfeldnr)<>niltext))THEN infeld(bildschirmfeldnr);FALSE ELIF (( +schuelerschluessel1<>niltextAND bestandsschluessel1+bestandsschluessel2= +niltextAND (schuelerschluessel2<>niltextXOR (schuelerschluessel2=niltextAND +schuelerschluessel3=niltext)))XOR (schuelerschluessel1+schuelerschluessel2+ +schuelerschluessel3=niltextAND bestandsschluessel1<>niltext)XOR ( +schuelerschluessel1+schuelerschluessel2+schuelerschluessel3+ +bestandsschluessel1+bestandsschluessel2=niltext))THEN TRUE ELSE infeld( +namefeldnr);FALSE FI .meldedenfehler:standardmeldung(fehlermeldnr,niltext). +zurueckzumdialog:return(vater).#meldenichterstellbar:standardmeldung( +anschreibenkannnichterstelltwerdennr,niltext);.# +meldeunzulaessigeschuelergruppenauswahl:standardmeldung( +dieauswahlderjgstistnichtzulaessignr,niltext). +beibestandsauswahlauswahlzulaessig:(bestandsschluessel1=niltext)OR ( +bestandsschluessel1<>niltextCAND int(bestandsschluessel1)=minjgst).startenausfuehren: +initialisieredruckerfueranschreiben;dbstatus(ok);inittupel(dnrhalbjahresdaten +);parsenooffields(28);uebernimmentsprechendedaten;anschreibenstart( +aktuellerindex,vordruck,anschreibenzeigen,(schuelerschluessel1+ +schuelerschluessel2)<>"",BOOL PROC sonderwertewiederholer,BOOL PROC +multistopwiederholer).uebernimmentsprechendedaten:putwert(fnrhjdfamnames, +schuelerschluessel1);putwert(fnrhjdrufnames,schuelerschluessel2);putwert( +fnrhjdgebdats,datumskonversion(schuelerschluessel3));aktuellesschuljahr:= +schulkenndatum("Schuljahr");putwert(fnrhjdsj,aktuellesschuljahr);putintwert( +fnrhjdhj,2);putwert(fnrhjdjgst,bestandsschluessel1);putwert(fnrhjdkennung, +bestandsschluessel2);putwert(fnrhjdversetzung,schluesselwiederholer);. +indexnummerbestimmen:IF schuelerschluessel1<>niltextTHEN aktuellerindex:=# +dnrhalbjahresdaten#ixhjdverfamsjhjrufgebELSE aktuellerindex:= +ixhjdversjhjjgstkennFI .END PROC wiederholerstarten;BOOL PROC +multistopwiederholer:BOOL VAR b:=wert(fnrhjdsj)=aktuellesschuljahrCAND +intwert(fnrhjdhj)=2CAND wert(fnrhjdversetzung)=schluesselwiederholer;IF b +THEN weitereueberpruefungFI ;b.weitereueberpruefung:IF aktuellerindex= +ixhjdverfamsjhjrufgebTHEN ueberpruefenamenELSE IF bestandsschluessel1<>"" +THEN ueberpruefejgstFI FI .ueberpruefenamen:b:=wert(fnrhjdfamnames)= +schuelerschluessel1CAND (schuelerschluessel2=""COR wert(fnrhjdrufnames)= +schuelerschluessel2)CAND (schuelerschluessel3=""COR wert(fnrhjdgebdats)= +datumskonversion(schuelerschluessel3)).ueberpruefejgst:b:=int( +bestandsschluessel1)=intwert(fnrhjdjgst)CAND (bestandsschluessel2=""COR +bestandsschluessel2=wert(fnrhjdkennung)).ENDPROC multistopwiederholer;END +PACKET anschrwiederholer; + diff --git a/app/schulis/2.2.1/src/1.auskunft.betroffene b/app/schulis/2.2.1/src/1.auskunft.betroffene new file mode 100644 index 0000000..bfa245d --- /dev/null +++ b/app/schulis/2.2.1/src/1.auskunft.betroffene @@ -0,0 +1,259 @@ +PACKET auskbetroffenDEFINES auskbetroffeneingang,auskbetroffenstarten, +auskbetroffensonderwerte:TEXT VAR schuelerschluessel1,schuelerschluessel2, +schuelerschluessel3;LET swiort=511,swiwohntbei=512,swilangtextortsteil=513, +swilangtexterzber=514,swiorterzber=515,swilangtextstaatsan=516, +swilangtextsprache=517,swilangtextspaetaus=518,swilangtextgeschl=519, +swilangtextrelizug=520,swilangtextrelizeugnis=521,swiortletzteschule=522, +swilangtextschulform=523,swiaufbschuljeintrsek2=524,swilangtextzugang=525, +swilangtextabgang=526,swilangtextabschluss=527,swiortneueschule=528, +swilangtextfremdspr1=537,swiaufbhjafremdspr1=538,swiaufbhjefremdspr1=539, +swilangtextfremdspr2=540,swiaufbhjafremdspr2=541,swiaufbhjefremdspr2=542, +swilangtextfremdspr3=543,swiaufbhjafremdspr3=544,swiaufbhjefremdspr3=545, +swilangtextfremdspr4=546,swiaufbhjafremdspr4=547,swiaufbhjefremdspr4=548, +swilangtextreliunt=549,swilangtextkumu=550,swilangtextwpf191=551, +swilangtextwpf291=552,swilangtextwpf192=553,swilangtextwpf292=554, +swilangtextwpf1101=555,swilangtextwpf2101=556,swilangtextwpf1102=557, +swilangtextwpf2102=558,swilangtextag1=559,swiaufbhjaag1=560,swiaufbhjeag1=561 +,swilangtextag2=562,swiaufbhjaag2=563,swiaufbhjeag2=564,swilangtextag3=565, +swiaufbhjaag3=566,swiaufbhjeag3=567,swistrasseerz=568,switelerz=569, +swinameletzte=570,swistrasseletzte=571,swinameneue=572,swistrasseneue=573, +swischulform=582,swilangtextstatus=583;LET suffix1="c02 ortsteil",suffix2= +"c02 verwandtschaft",suffix3="c02 staaten",suffix4="c02 sprachen",suffix5= +"c02 relizugehoerigkeit",suffix6="c02 schulart",suffix7="c02 zugang",suffix8= +"c02 abgang",suffix9="c02 abschluss",suffix12="c02 blauer brief",suffix13= +"c02 bemerkungen",suffix14="c02 versetzung",namefeldnr=2,vornamefeldnr=3, +geburtsdatumfeldnr=4,niltext="",null=0,blank=" ",punkt=".",kla="(",klz=")", +fehlermeld1=56,fehlermeld2=157,wartemeldnr=69,vater=1,maske= +"ms auswahl schueler o. klasse mit bestand";TEXT VAR aktjgsthj;INT VAR +aktuellesschuljahr,aktuelleshalbjahr,jahr,halbjahr,eingabestatus;INT VAR +gewindex;BOOL CONST anschreibenzeigen:=FALSE ;PROC auskbetroffeneingang: +standardvproc(maske)END PROC auskbetroffeneingang;PROC auskbetroffenstarten: +lesemaskenwerte;IF schluesselmitdatumangegebenTHEN IF datumseingabekorrekt +THEN fortfahrenELSE meldungdatumnichtkorrekt;zurueckzumdialogFI ;ELSE IF +schlüsselohnedatumkorrektTHEN fortfahrenELSE meldungauswahlnichtsinnvoll; +zurueckzumdialogFI ;FI .schluesselmitdatumangegeben:schuelerschluessel1<> +niltextCAND schuelerschluessel2<>niltextCAND schuelerschluessel3<>niltext. +datumseingabekorrekt:standardpruefe(6,4,0,0,niltext,eingabestatus); +eingabestatus=0.schlüsselohnedatumkorrekt:schuelerschluessel3=niltextCAND +schuelerschluessel1<>niltext.fortfahren:setzemitseitennummern(TRUE );gewindex +:=dnrschueler;startenausfuehren.lesemaskenwerte:schuelerschluessel1:= +standardmaskenfeld(namefeldnr);schuelerschluessel2:=standardmaskenfeld( +vornamefeldnr);schuelerschluessel3:=standardmaskenfeld(geburtsdatumfeldnr). +meldungauswahlnichtsinnvoll:standardmeldung(fehlermeld1,niltext). +meldungdatumnichtkorrekt:standardmeldung(fehlermeld2,niltext). +zurueckzumdialog:return(vater).startenausfuehren:BOOL CONST einzelbearbeitung +:=TRUE ;reinitparsing;standardmeldung(wartemeldnr,niltext);#dr20.08.87# +aktjgsthj:=schulkenndatum("Schulhalbjahr");aktuelleshalbjahr:=int(aktjgsthj); +aktuellesschuljahr:=int(schulkenndatum("Schuljahr"));convertierehalbjahr; +setzesonderwerteschulkenndaten;setzewerte;zusammengesetztesanschreiben( +gewindex,anschreibenzeigen,einzelbearbeitung,BOOL PROC +auskbetroffensonderwerte,BOOL PROC multistopauskunft,TEXT PROC +druckdateiauskzusammenstellen).setzewerte:putwert(fnrsufamnames, +schuelerschluessel1);putwert(fnrsurufnames,schuelerschluessel2);putwert( +fnrsugebdatums,datumskonversion(schuelerschluessel3)).convertierehalbjahr:IF +aktuelleshalbjahr=1THEN jahr:=int(subtext(wert(2),1,2));halbjahr:=2ELSE jahr +:=int(subtext(wert(2),3,4));halbjahr:=1FI .END PROC auskbetroffenstarten; +BOOL PROC auskbetroffensonderwerte:LET nein="n",ja="j",langtextnein="nein", +langtextja="ja";initialisieresonderwerte;holediffdaten;adressat((wert( +fnrsurufnames)SUB 1)+punkt+blank+wert(fnrsufamnames));setzesonderwert(swiort, +wert(fnrsuplzorts));setzesonderwert(swiorterzber,wert(fnrsuplzorte)); +setzesonderwert(swistrasseerz,wert(fnrsustrnre));setzesonderwert(switelerz, +wert(fnrsutelnre));sucheadressezurschule(wert(fnrsuskennlschule)); +setzesonderwert(swiortletzteschule,wert(fnrschplzort));setzesonderwert( +swischulform,wert(fnrschart));setzesonderwert(swilangtextschulform,langtext( +suffix6,wert(fnrschart)));setzesonderwert(swinameletzte,wert(fnrschname)); +setzesonderwert(swistrasseletzte,wert(fnrschstrnr));sucheadressezurschule( +wert(fnrsuskennnschule));setzesonderwert(swiortneueschule,wert(fnrschplzort)) +;setzesonderwert(swinameneue,wert(fnrschname));setzesonderwert(swistrasseneue +,wert(fnrschstrnr));setzesonderwert(swiwohntbei,wohntbei);setzesonderwert( +swilangtextgeschl,langtextgeschl);setzesonderwert(swilangtextspaetaus, +langtextspaetaus);setzesonderwert(swilangtextrelizeugnis,langtextrelizeugnis) +;setzesonderwert(swilangtextstatus,langtextstatus);setzesonderwert( +swilangtextortsteil,langtext(suffix1,wert(fnrsuortsteils)));setzesonderwert( +swilangtexterzber,langtext(suffix2,wert(fnrsuverhes)));setzesonderwert( +swilangtextstaatsan,langtext(suffix3,wert(fnrsustaatsangs)));setzesonderwert( +swilangtextsprache,langtext(suffix4,wert(fnrsumuttersprache))); +setzesonderwert(swilangtextrelizug,langtext(suffix5,wert(fnrsureligionsz))); +setzesonderwert(swilangtextzugang,langtext(suffix7,wert(fnrsuartzugang))); +setzesonderwert(swilangtextabgang,langtext(suffix8,wert(fnrsuabggrund))); +setzesonderwert(swilangtextabschluss,langtext(suffix9,wert(fnrsuabschluss))); +setzesonderwert(swilangtextfremdspr1,langtextfach(wert(fnrdd1fremdfach))); +setzesonderwert(swilangtextfremdspr2,langtextfach(wert(fnrdd2fremdfach))); +setzesonderwert(swilangtextfremdspr3,langtextfach(wert(fnrdd3fremdfach))); +setzesonderwert(swilangtextfremdspr4,langtextfach(wert(fnrdd4fremdfach))); +setzesonderwert(swilangtextreliunt,langtextfach(wert(fnrddreliunter))); +setzesonderwert(swilangtextkumu,langtextfach(wert(fnrddkunstmusik))); +setzesonderwert(swilangtextwpf191,langtextfach(wert(fnrddfach091a))); +setzesonderwert(swilangtextwpf291,langtextfach(wert(fnrddfach091b))); +setzesonderwert(swilangtextwpf192,langtextfach(wert(fnrddfach092a))); +setzesonderwert(swilangtextwpf292,langtextfach(wert(fnrddfach092b))); +setzesonderwert(swilangtextwpf1101,langtextfach(wert(fnrddfach101a))); +setzesonderwert(swilangtextwpf2101,langtextfach(wert(fnrddfach101b))); +setzesonderwert(swilangtextwpf1102,langtextfach(wert(fnrddfach102a))); +setzesonderwert(swilangtextwpf2102,langtextfach(wert(fnrddfach102b))); +setzesonderwert(swilangtextag1,langtextfach(wert(fnrddagthema1))); +setzesonderwert(swilangtextag2,langtextfach(wert(fnrddagthema2))); +setzesonderwert(swilangtextag3,langtextfach(wert(fnrddagthema3))); +setzesonderwert(swiaufbschuljeintrsek2,aufbschuljahr(fnrsueintrittinsek)); +setzesonderwert(swiaufbhjafremdspr1,aufbhalbjahr(fnrdd1fremdb)); +setzesonderwert(swiaufbhjefremdspr1,aufbhalbjahr(fnrdd1fremde)); +setzesonderwert(swiaufbhjafremdspr2,aufbhalbjahr(fnrdd2fremdb)); +setzesonderwert(swiaufbhjefremdspr2,aufbhalbjahr(fnrdd2fremde)); +setzesonderwert(swiaufbhjafremdspr3,aufbhalbjahr(fnrdd3fremdb)); +setzesonderwert(swiaufbhjefremdspr3,aufbhalbjahr(fnrdd3fremde)); +setzesonderwert(swiaufbhjafremdspr4,aufbhalbjahr(fnrdd4fremdb)); +setzesonderwert(swiaufbhjefremdspr4,aufbhalbjahr(fnrdd4fremde)); +setzesonderwert(swiaufbhjaag1,aufbhalbjahr(fnrddagthema1b));setzesonderwert( +swiaufbhjeag1,aufbhalbjahr(fnrddagthema1e));setzesonderwert(swiaufbhjaag2, +aufbhalbjahr(fnrddagthema2b));setzesonderwert(swiaufbhjeag2,aufbhalbjahr( +fnrddagthema2e));setzesonderwert(swiaufbhjaag3,aufbhalbjahr(fnrddagthema3b)); +setzesonderwert(swiaufbhjeag3,aufbhalbjahr(fnrddagthema3e));TRUE . +holediffdaten:readtid(dnrdiffdaten,zugriff(fnrsutiddiffdaten)).langtextstatus +:IF wert(fnrsustatuss)="n05"THEN geklammert( +"Neuangemeldet zur Jahrgangsstufe 5")ELIF wert(fnrsustatuss)="n011"THEN +geklammert("Neuangemeldet zu jahrgangsstufe 11")ELIF wert(fnrsustatuss)="nso" +THEN geklammert("Neuangemeldet")ELIF wert(fnrsustatuss)="abg"THEN geklammert( +"Abgegangen")ELIF wert(fnrsustatuss)="ls"THEN geklammert( +"Laufendes Schuljahr")ELSE geklammert("Kein Eintrag")FI .wohntbei:IF wert( +fnrsuwohntbei)=niltextTHEN niltextELSE "bei: "+wert(fnrsuwohntbei)FI . +langtextgeschl:LET weiblich="w",langtextweibl="weiblich",langtextmaennl= +"männlich";IF wert(fnrsugeschlechts)=weiblichTHEN kla+langtextweibl+klzELSE +kla+langtextmaennl+klzFI .langtextspaetaus:IF wert(fnrsuspaetaus)=neinTHEN +langtextneinELIF wert(fnrsuspaetaus)=jaTHEN langtextjaELSE niltextFI . +langtextrelizeugnis:IF wert(fnrsureligionsz)=neinTHEN langtextneinELIF wert( +fnrsureligionsz)=jaTHEN langtextjaELSE niltextFI .END PROC +auskbetroffensonderwerte;PROC sucheadressezurschule(TEXT CONST schulk): +inittupel(dnrschulen);IF schulk<>""THEN putwert(fnrschkennung,schulk);search( +dnrschulen,TRUE );FI ENDPROC sucheadressezurschule;TEXT PROC langtextfach( +TEXT CONST kuerzel):inittupel(dnrfaecher);putwert(dnrfaecher+1,kuerzel); +search(dnrfaecher,TRUE );geklammert(wert(dnrfaecher+2))END PROC langtextfach; +TEXT PROC langtext(TEXT CONST bestand,bemerkungsschluessel):TEXT VAR +gefundenerlangtext:="";INT VAR bestandsid:=0;putwert(fnrschlsachgebiet, +bestand);putwert(fnrschlschluessel,bemerkungsschluessel);search(dnrschluessel +,TRUE );IF dbstatus=okTHEN gefundenerlangtext:=wert(fnrschllangtext)ELSE +dbstatus(ok);FI ;geklammert(gefundenerlangtext)END PROC langtext;TEXT PROC +geklammert(TEXT CONST zuklammern):IF zuklammern=niltextTHEN niltextELSE kla+ +zuklammern+klzFI ENDPROC geklammert;TEXT PROC aufbschuljahr(INT CONST dbindex +):LET trenner="/";IF wert(dbindex)=niltextOR wert(dbindex)="0"THEN niltext +ELSE subtext(wert(dbindex),1,2)+trenner+subtext(wert(dbindex),3,4)FI END +PROC aufbschuljahr;TEXT PROC aufbhalbjahr(INT CONST dbindex):LET trenner="."; +IF wert(dbindex)=niltextTHEN niltextELSE subtext(wert(dbindex),1,2)+trenner+ +subtext(wert(dbindex),3,3)FI END PROC aufbhalbjahr;TEXT PROC aufbhalbjahr( +INT CONST dbindex,ae):LET trenner=".";TEXT VAR hj:=subtext(wert(dbindex),(ae* +3)-2,ae*3);IF hj=niltextTHEN niltextELSE subtext(hj,1,2)+trenner+subtext(hj,3 +,3)FI END PROC aufbhalbjahr;TEXT PROC druckdateiauskzusammenstellen:LET +prevordruck="vordruck",postvordruck=" auskunft betroffene",vordruck1= +"vordruck1 auskunft betroffene",vordruck2="vordruck2 auskunft betroffene", +vordruck3="vordruck3 auskunft betroffene",vordruck4= +"vordruck4 auskunft betroffene",vordruck5="vordruck5 auskunft betroffene", +anzvordrucke=5,hilfsdatei1="hilfsdatei1",hilfsdatei2="hilfsdatei2", +hilfsdateikopf="hilfsdatei kopf",druckdatei="liste.1",manager= +"anschreiben server";INT VAR i,zeilenanz1,zeilenanz2,zeilenanzkopf,anzhj; +TEXT VAR zeile,schuljahr;INT VAR neuesschuljahr;FILE VAR f,g,kopfspeicher; +aktuellevordruckevommanagerholen;druckvorbereiten; +allgemeineschuelerdatenindiedruckdateischreiben; +halbjahresdatendesschuelersindiedruckdateischreiben; +letztehilfsdateiindruckdateibringen;drucknachbereitenohneausdrucken; +druckdatei.aktuellevordruckevommanagerholen:FOR iFROM 1UPTO anzvordruckeREP +forget(prevordruck+text(i)+postvordruck,quiet);fetch(prevordruck+text(i)+ +postvordruck,/manager)PER .allgemeineschuelerdatenindiedruckdateischreiben: +briefalternative(vordruck1,hilfsdatei1);f:=sequentialfile(input,hilfsdatei1); +#limit(75);##"unerklärliche"Z eilenumbrüche#maxlinelength(f,75);zeilenanz1:= +lines(f);FOR iFROM 1UPTO zeilenanz1REP getline(f,zeile);druckzeileschreiben( +zeile)PER ;seitenwechsel;forget(hilfsdatei1,quiet);briefalternative(vordruck2 +,hilfsdatei1);vordruck2merkenfuerfolgeseiten;briefalternative(vordruck3, +hilfsdatei1);f:=sequentialfile(output,hilfsdatei1);zeilenanz1:=lines(f). +halbjahresdatendesschuelersindiedruckdateischreiben:bestimme5teshjvor;lesehjd +;WHILE (dbstatus=ok)CAND gleicherschuelerREP initialisieresonderwerte; +alteanweisungsfolge;succ(dnrhalbjahresdaten);PER .bestimme5teshjvor:anzhj:=-5 +;bestimmeentsprechendesschuljahr.bestimmeentsprechendesschuljahr:IF anzhj<0 +THEN anzhj:=anzhj*-1;neuesschuljahr:=jahr-(anzhjDIV 2);IF (anzhjMOD 2)=0CAND +halbjahr=2THEN schuljahr:=text(neuesschuljahr)+text(neuesschuljahr+1);ELSE +schuljahr:=text(neuesschuljahr-1)+text(neuesschuljahr);FI ELSE neuesschuljahr +:=jahr+(anzhjDIV 2)+anzhjMOD 2;IF ((anzhjMOD 2)=1CAND halbjahr=2)COR ( +halbjahr=1)THEN schuljahr:=text(neuesschuljahr-1)+text(neuesschuljahr);ELSE +schuljahr:=text(neuesschuljahr)+text(neuesschuljahr+1);FI FI .lesehjd: +inittupel(dnrhalbjahresdaten);uebernehmenschuelerdaten;search( +dnrhalbjahresdaten,FALSE ).uebernehmenschuelerdaten:putwert(fnrhjdfamnames, +wert(fnrsufamnames));putwert(fnrhjdrufnames,wert(fnrsurufnames));putwert( +fnrhjdgebdats,wert(fnrsugebdatums));putwert(fnrhjdsj,schuljahr);putintwert( +fnrhjdhj,neueshalbjahr);.neueshalbjahr:IF aktuelleshalbjahr=1THEN 2ELSE 1FI . +gleicherschueler:wert(fnrhjdfamnames)=wert(fnrsufamnames)CAND wert( +fnrhjdrufnames)=wert(fnrsurufnames)CAND wert(fnrhjdgebdats)=wert( +fnrsugebdatums).alteanweisungsfolge:teil1hjdaufbereiten(vordruck4,hilfsdatei2 +);aufbereitetedatenunterbringen;teil2hjdaufbereiten(vordruck5,hilfsdatei2); +aufbereitetedatenunterbringen;.vordruck2merkenfuerfolgeseiten:copy( +hilfsdatei1,hilfsdateikopf);kopfspeicher:=sequentialfile(input,hilfsdateikopf +);zeilenanzkopf:=lines(kopfspeicher).aufbereitetedatenunterbringen:g:= +sequentialfile(input,hilfsdatei2);#limit(75);##"unerklärliche"Z eilenumbrüche +#maxlinelength(g,75);zeilenanz2:=lines(g);IF zeilenanz1+zeilenanz2> +drucklaengeTHEN hilfsdatei1indruckdateibringenundloeschen;seitenwechsel; +vordruckkopfnachhilfsdatei1;zeilenanz1:=zeilenanz2+zeilenanzkopf;ELSE +zeilenanz1:=zeilenanz1+zeilenanz2;FI ;hilfsdatei2nachhilfsdatei1undloeschen;. +hilfsdatei1indruckdateibringenundloeschen:input(f);FOR iFROM 1UPTO zeilenanz1 +REP getline(f,zeile);druckzeileschreiben(zeile);PER ;forget(hilfsdatei1,quiet +).vordruckkopfnachhilfsdatei1:f:=sequentialfile(output,hilfsdatei1);input( +kopfspeicher);FOR iFROM 1UPTO zeilenanzkopfREP getline(kopfspeicher,zeile); +putline(f,zeile)PER .hilfsdatei2nachhilfsdatei1undloeschen:FOR iFROM 1UPTO +zeilenanz2REP getline(g,zeile);putline(f,zeile)PER ;forget(hilfsdatei2,quiet) +.letztehilfsdateiindruckdateibringen:input(f);FOR iFROM 1UPTO zeilenanz1REP +getline(f,zeile);druckzeileschreiben(zeile)PER ;forget(hilfsdateikopf,quiet); +forget(hilfsdatei1,quiet).END PROC druckdateiauskzusammenstellen;PROC +teil1hjdaufbereiten(TEXT CONST vordruck,hilfsdatei):LET wiederholung= +" Wiederholung",zuwiederholen=" zu wiederholen",wirdwiederholt= +" wird wiederholt",swiaufbschuljahr=511,swiwarnung1=512,swibemnr1=513, +swilangtextbemnr1=514,swiwarnung2=515,swibemnr2=516,swilangtextbemnr2=517, +swiversetzung=518,swilangtextversetzung=519,swistartnachpruefungen=520, +swinotenachpruef=527,swistartzeugnisbemerk=528,swistartversaeumtverspaetet= +534,swilangtextbemerknachpruefung=537;INT VAR hilfsindex,i,swi;TEXT VAR wie; +wie:=wert(fnrhjdversetzung);setzesonderwert(swiaufbschuljahr,aufbschuljahr( +fnrhjdsj));setzesonderwert(swiwarnung1,wert(fnrhjdvermblau));setzesonderwert( +swibemnr1,wert(fnrhjdbemblau));setzesonderwert(swilangtextbemnr1,langtext( +suffix12,wert(fnrhjdbemblau)));setzesonderwert(swiwarnung2,wert( +fnrhjdvermnachwarn));setzesonderwert(swibemnr2,wert(fnrhjdbemnachwarn)); +setzesonderwert(swilangtextbemnr2,langtext(suffix13,wert(fnrhjdbemnachwarn))) +;setzesonderwert(swiversetzung,wert(fnrhjdversetzung));setzesonderwert( +swilangtextversetzung,langtext(suffix14,wert(fnrhjdversetzung))); +setzesonderwert(swilangtextbemerknachpruefung,langtext("Bemerkungen", +geklammert(wert(fnrhjdbemnach))));swi:=swistartnachpruefungen;FOR iFROM 1 +UPTO 3REP setzesonderwert(swi,wert(fnrhjdnachfach1+i-1));swiINCR 1; +setzesonderwert(swi,langtextfach(wert(fnrhjdnachfach1+i-1)));swiINCR 1; +hilfsindexINCR 1PER ;setzesonderwert(swi,wert(fnrhjdnachfach)); +setzesonderwert(swinotenachpruef,wert(fnrhjdnacherg));swi:= +swistartzeugnisbemerk;FOR iFROM 1UPTO 3REP setzesonderwert(swi,wert( +fnrhjdbemzeug1+i-1));swiINCR 1;setzesonderwert(swi,langtext(suffix13,wert( +fnrhjdbemzeug1+i-1)));swiINCR 1;hilfsindexINCR 1PER ;swi:= +swistartversaeumtverspaetet;FOR iFROM 1UPTO 3REP setzesonderwert(swi,wert( +fnrhjdversstdm+i-1));swiINCR 1;hilfsindexINCR 1PER ;briefalternative(vordruck +,hilfsdatei).END PROC teil1hjdaufbereiten;PROC teil2hjdaufbereiten(TEXT +CONST vordruck,hilfsdatei):LET swifach=538,swiart=539,swiklau=541,swiknr=542, +swiwarn=543,swinote=544,swibem=545;setzesonderwert(swifach,aufbereiteterwert( +fnrhjdfach,2));setzesonderwert(swiart,aufbereiteterwert(fnrhjdkursart,2)); +setzesonderwert(swiklau,aufbereiteterwert(fnrhjdklausurteiln,1)); +setzesonderwert(swiknr,aufbereiteterwert(fnrhjdlerngrpkenn,4)); +setzesonderwert(swiwarn,aufbereiteterwert(fnrhjdvermwarnung,1)); +setzesonderwert(swinote,aufbereiteterwert(fnrhjdnotepunkte,2)); +setzesonderwert(swibem,aufbereiteterwert(fnrhjdbemerk,3));fuellebemerkungen; +briefalternative(vordruck,hilfsdatei).fuellebemerkungen:LET kuerzelbreite=3; +INT VAR i,l:=length(wert(fnrhjdbemerk))DIV kuerzelbreite,von,bis;TEXT VAR +kuerzel;INT VAR swib:=546;FOR iFROM 1UPTO lREP von:=((i-1)*kuerzelbreite)+1; +bis:=i*kuerzelbreite;kuerzel:=subtext(wert(fnrhjdbemerk),von,bis); +setzesonderwert(swib,kuerzel);swibINCR 1;setzesonderwert(swib,langtext( +suffix13,kuerzel));swibINCR 1PER .END PROC teil2hjdaufbereiten;TEXT PROC +aufbereiteterwert(INT CONST fnr,kuerzelbreite):LET doppelpunkt=":",anzspalten +=13,spaltenbreitetab=4;INT VAR i,l:=length(wert(fnr))DIV kuerzelbreite,von, +bis,blankanz;TEXT VAR zeile:="",kuerzel;#IF l>nullTHEN #FOR iFROM 1UPTO #l# +anzspaltenREP von:=((i-1)*kuerzelbreite)+1;bis:=i*kuerzelbreite;kuerzel:= +subtext(wert(fnr),von,bis);zeile:=zeile+aufbkuerzelPER ;#ELSE zeile:= +anzspalten*(doppelpunkt+spaltenbreitetab*blank)FI ;#zeile.aufbkuerzel:IF +length(kuerzel)<>nullTHEN blankanz:=spaltenbreitetab-length(kuerzel); +doppelpunkt+preblankanz*blank+kuerzel+postblankanz*blankELSE doppelpunkt+ +spaltenbreitetab*blankFI .preblankanz:blankanzDIV 2.postblankanz:blankanz- +preblankanz.ENDPROC aufbereiteterwert;BOOL PROC multistopauskunft:( +schuelerschluessel1=wert(fnrsufamnames))CAND (schuelerschluessel2=wert( +fnrsurufnames)COR schuelerschluessel2="")CAND (schuelerschluessel3= +datumrekonversion(wert(fnrsugebdatums))COR schuelerschluessel3="")END PROC +multistopauskunft;TEXT PROC leerintintext(TEXT CONST t):IF t="0"THEN ""ELSE t +FI END PROC leerintintext;TEXT PROC kurz(TEXT CONST t):TEXT VAR txt:=niltext; +IF t<>niltextTHEN txt:=t+blankFI ;txtEND PROC kurz;END PACKET auskbetroffen; + diff --git a/app/schulis/2.2.1/src/1.erf.abmeldedaten b/app/schulis/2.2.1/src/1.erf.abmeldedaten new file mode 100644 index 0000000..9c5523b --- /dev/null +++ b/app/schulis/2.2.1/src/1.erf.abmeldedaten @@ -0,0 +1,142 @@ +PACKET erfabmeldedatenDEFINES suabmeldedatenbearbeiten, +suabmeldedatenspeichern,suausgesuchteabmeldedatenbearbeiten, +schuelerlistezeigen,pruefungschuelerab:LET maskennameeingang= +"ms schuelerangabe",maskenstammname="ms erf abmeldedaten",aktbestand="ls", +bestandschulen="Schulen",fnrname=2,fnrrufname=3,fnrgebdatum=4,fnrjgst=5, +fnrzug=6,fnrabdatum=7,fnrabgrund=8,fnrneueschule=9,fnrabschluss=10, +meldunglistenerstellung=7,meldungspeicherung=50,pruefemeldung=57, +meldungkeineaenderung=63,meldungletzter=67,meldungkeineliste=68, +meldunggibtsnicht=71,meldungspeicherungfehlerhaft=73,meldungfalschesdatum=157 +;LET leer="",oblitrenner="$";LET anzschluessel=3;#A nzahlderamP +rimärschlüselbeteiligtenF elder#BOOL VAR falschesdatum:=FALSE ;FILE VAR f; +ROW anzschluesselTEXT VAR schluessel;#24.03.87#TAG VAR maske;TEXT VAR +dateiname:="Schülerliste",schuelertid:="";TEXT VAR abdatumsicherung, +abgrundsicherung,abschlusssicherung;LET logtextbeginn= +"Anw. 1.3.1 Änderung """;PROC bearbeitunginitialisieren:forget(dateiname, +quiet).END PROC bearbeitunginitialisieren;PROC suabmeldedatenbearbeiten:BOOL +VAR sudatenexistieren;falschesdatum:=FALSE ;systemdboff;reinitparsing; +bearbeitunginitialisieren;schluessel(1):=standardmaskenfeld(fnrname); +schluessel(2):=standardmaskenfeld(fnrrufname);schluessel(3):= +datumrekonversion(standardmaskenfeld(fnrgebdatum));pruefeobsudatenexistieren( +sudatenexistieren);IF NOT falschesdatumTHEN IF sudatenexistierenTHEN +schluessel(1):=wert(fnrsufamnames);schluessel(2):=wert(fnrsurufnames); +schluessel(3):=datumrekonversion(wert(fnrsugebdatums));standardstartproc( +maskenstammname);bereiteaenderungvor;standardnproc;ELSE standardmeldung( +meldunggibtsnicht,"");return(1)FI ;ELSE return(1)FI .END PROC +suabmeldedatenbearbeiten;PROC bereiteaenderungvor:saveupdateposition( +dnrschueler);schuelertid:=gettid;holedbwerteinmaske;abdatumsicherung:=wert( +fnrsuabgdats);abgrundsicherung:=wert(fnrsuabggrund);abschlusssicherung:=wert( +fnrsuabschluss);infeld(fnrname);standardfelderausgeben;infeld(fnrabdatum). +END PROC bereiteaenderungvor;PROC holedbwerteinmaske:standardmaskenfeld(wert( +fnrsufamnames),fnrname);standardmaskenfeld(wert(fnrsurufnames),fnrrufname); +standardmaskenfeld(datumrekonversion(wert(fnrsugebdatums)),fnrgebdatum); +standardmaskenfeld(jgstaufber(wert(fnrsusgrpjgst)),fnrjgst); +standardmaskenfeld(wert(fnrsusgrpzugtut),fnrzug);standardmaskenfeld( +datumrekonversion(wert(fnrsuabgdats)),fnrabdatum);standardmaskenfeld(wert( +fnrsuabggrund),fnrabgrund);standardmaskenfeld(wert(fnrsuskennnschule), +fnrneueschule);standardmaskenfeld(wert(fnrsuabschluss),fnrabschluss)END PROC +holedbwerteinmaske;PROC pruefeobsudatenexistieren(BOOL VAR suexist):TEXT VAR +datenbankwerte,schluesselwerte;inittupel(dnrschueler);maskenwerteindatenbank; +IF NOT falschesdatumTHEN search(ixsustatfamrufgeb);IF dbstatus=okTHEN +datenbankwerte:=wert(fnrsurufnames)+datumrekonversion(wert(fnrsugebdatums)); +schluesselwerte:=schluessel(2)+schluessel(3);suexist:=(wert(fnrsufamnames)= +schluessel(1)CAND ((schluessel(2)=leerAND schluessel(3)=leer)OR (pos( +datenbankwerte,schluesselwerte)=1)))ELSE suexist:=FALSE FI FI .END PROC +pruefeobsudatenexistieren;PROC maskenwerteindatenbank:putwert(fnrsufamnames, +schluessel(1));putwert(fnrsurufnames,schluessel(2));disablestop;initmaske( +maske,maskennameeingang);putwert(fnrsugebdatums,datumskonversion(schluessel(3 +)));IF iserrorTHEN clearerror;standardmeldung(meldungfalschesdatum,"");infeld +(fnrgebdatum);falschesdatum:=TRUE ;enablestop;ELSE enablestop;putwert( +fnrsustatuss,aktbestand);FI ;END PROC maskenwerteindatenbank;PROC +suabmeldedatenspeichern(BOOL CONST zuspeichern):IF zuspeichernTHEN +bereitespeicherungvorELSE standardmeldung(meldungkeineaenderung,""); +vorbereitendernaechstendatenbehandlungFI .bereitespeicherungvor:INT VAR +fehlerstatus:=0;pruefeplausibilitaet(fehlerstatus);IF datenfehlerfreiTHEN +datenschreiben;vorbereitendernaechstendatenbehandlungELSE fehlerbehandeln; +return(1)FI .datenfehlerfrei:fehlerstatus=0.fehlerbehandeln:infeld( +fehlerstatus).datenschreiben:meldespeicherung;datenindatenbankspeichern. +meldespeicherung:standardmeldung(meldungspeicherung,""). +datenindatenbankspeichern:logeintragvornehmen;setzedbwerte; +abmeldedatenschreiben.logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn; +eintragCAT schluessel(1);eintragCAT ", ";eintragCAT schluessel(2);eintragCAT +", ";eintragCAT datumskonversion(schluessel(3));eintragCAT """";logeintrag( +eintrag).setzedbwerte:putwert(fnrsuabggrund,standardmaskenfeld(fnrabgrund)); +putwert(fnrsuskennnschule,standardmaskenfeld(fnrneueschule));putwert( +fnrsuabschluss,standardmaskenfeld(fnrabschluss));putwert(fnrsuabgdats, +datumskonversion(standardmaskenfeld(fnrabdatum)));.abmeldedatenschreiben:IF +abdatumsicherung<>wert(fnrsuabgdats)THEN restoreupdateposition(dnrschueler); +selupdate(dnrschueler);ELSE replace(dnrschueler,schuelertid)FI ;IF dbstatus<> +0THEN standardmeldung(meldungspeicherungfehlerhaft,"")#dr11.05.88ELIF +grundgeaendertTHEN grundinstatraumaendernELIF abschlussgeaendertTHEN +abschlussinstatraumaendern#FI .#drgrundgeaendert:11.05.88abgrundsicherung<> +wert(fnrsuabggrund).abschlussgeaendert:abschlusssicherung<>wert( +fnrsuabschluss).grundinstatraumaendern:kuerzelaendern(statnrabgrund, +abgrundsicherung,wert(fnrsuabggrund)).abschlussinstatraumaendern: +kuerzelaendern(statnrabschluss,abschlusssicherung,wert(fnrsuabschluss)).#END +PROC suabmeldedatenspeichern;PROC vorbereitendernaechstendatenbehandlung:IF +exists(dateiname)THEN holenaechstenschluesselauslisteELSE enter(2)FI . +holenaechstenschluesselausliste:BOOL VAR ok,kannbearbeitetwerden:=FALSE ; +holenaechstenmehrtlgschluesselausdatei(ok);WHILE okREP +pruefeobsudatenexistieren(ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:= +FALSE ELSE holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF +kannbearbeitetwerdenTHEN bereiteaenderungvor;return(1)ELSE +behandleendederthesaurusabarbeitungFI .behandleendederthesaurusabarbeitung: +standardmeldung(meldungletzter,"");enter(3).END PROC +vorbereitendernaechstendatenbehandlung;PROC schuelerlistezeigen:BOOL VAR +keineliste;schluessel(1):=standardmaskenfeld(fnrname);schluessel(2):= +standardmaskenfeld(fnrrufname);schluessel(3):=datumrekonversion( +standardmaskenfeld(fnrgebdatum));falschesdatum:=FALSE ;systemdboff; +parsenooffields(5);maskenwerteindatenbank;IF NOT falschesdatumTHEN +objektlistestarten(ixsustatfamrufgeb,schluessel(1),fnrsufamnames,TRUE , +keineliste);IF keinelisteTHEN reinitparsing;standardmeldung(meldungkeineliste +,"");return(1)ELSE standardmeldung(meldunglistenerstellung,""); +datensatzlistenausgabe(PROC (INT CONST )suerfassungschueler,TRUE ,BOOL PROC +pruefungschuelerab)FI ELSE return(1)FI END PROC schuelerlistezeigen;BOOL +PROC pruefungschuelerab:wert(fnrsustatuss)=aktbestandEND PROC +pruefungschuelerab;PROC suausgesuchteabmeldedatenbearbeiten:BOOL VAR ok, +kannbearbeitetwerden:=FALSE ;bearbeitunginitialisieren;objektlistebeenden( +dateiname,TRUE );reinitparsing;holeerstenmehrtlgschluesselausdatei(ok);WHILE +okREP pruefeobsudatenexistieren(ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok +:=FALSE ELSE holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF +kannbearbeitetwerdenTHEN standardstartproc(maskenstammname); +bereiteaenderungvor;standardnprocELSE enter(2)FI .END PROC +suausgesuchteabmeldedatenbearbeiten;PROC holeerstenmehrtlgschluesselausdatei( +BOOL VAR ok):IF NOT exists(dateiname)THEN ok:=FALSE ;LEAVE +holeerstenmehrtlgschluesselausdateiFI ;f:=sequentialfile(input,dateiname); +holenaechstenmehrtlgschluesselausdatei(ok);END PROC +holeerstenmehrtlgschluesselausdatei;PROC +holenaechstenmehrtlgschluesselausdatei(BOOL VAR ok):TEXT VAR thesaurustext:= +"";INT VAR schluesselbeginn:=0;INT VAR schluesseltrennung:=0;INT VAR i:=1, +anzschlfelder:=anzkey(dnrschueler);IF eof(f)THEN ok:=FALSE ; +loeschedieerstellteobjektlisteELSE getline(f,thesaurustext); +bestimmeschluesselausthesaurustext;ok:=TRUE FI . +bestimmeschluesselausthesaurustext:schluesselbeginn:=pos(thesaurustext, +oblitrenner);schluesseltrennung:=pos(thesaurustext,oblitrenner, +schluesselbeginn+1);FOR iFROM 1UPTO anzschlfelderREP IF schluesseltrennung>0 +THEN schluessel(i):=subtext(thesaurustext,schluesselbeginn+1, +schluesseltrennung-1);schluesselbeginn:=schluesseltrennung;schluesseltrennung +:=pos(thesaurustext,oblitrenner,schluesselbeginn+1);ELSE schluessel(i):= +subtext(thesaurustext,schluesselbeginn+1);FI ;PER ;schluessel(3):= +datumrekonversion(schluessel(3));.END PROC +holenaechstenmehrtlgschluesselausdatei;PROC loeschedieerstellteobjektliste: +forget(dateiname,quiet);END PROC loeschedieerstellteobjektliste;PROC +pruefeplausibilitaet(INT VAR fstatus):LET pruefartdatum=5,fmeldnichtimbestand +=55,bestandabgangsgrund="c02 abgang",bestandabschluss="c02 abschluss";fstatus +:=0;standardmeldung(pruefemeldung,"");IF standardmaskenfeld(fnrabgrund)<>leer +THEN IF NOT imschlbestand(standardmaskenfeld(fnrabgrund),bestandabgangsgrund) +THEN fstatus:=fnrabgrund;standardmeldung(fmeldnichtimbestand,"");LEAVE +pruefeplausibilitaetFI ;FI ;IF standardmaskenfeld(fnrneueschule)<>leerTHEN +IF NOT imbestand(standardmaskenfeld(fnrneueschule),bestandschulen)THEN +fstatus:=fnrneueschule;standardmeldung(fmeldnichtimbestand,"");LEAVE +pruefeplausibilitaetFI ;FI ;IF standardmaskenfeld(fnrabschluss)<>leerTHEN IF +NOT imschlbestand(standardmaskenfeld(fnrabschluss),bestandabschluss)THEN +fstatus:=fnrabschluss;standardmeldung(fmeldnichtimbestand,"");LEAVE +pruefeplausibilitaetFI ;FI ;IF standardmaskenfeld(fnrabdatum)<>leerTHEN +standardpruefe(pruefartdatum,fnrabdatum,0,0,"",fstatus);FI ;END PROC +pruefeplausibilitaet;#dr11.05.88PROC kuerzelaendern(INT CONST statnr,TEXT +CONST alterwert,neuerwert):kuerzelsummeeinsrunter(statnr,jgstaufber(wert( +fnrsusgrpjgst)),compress(wert(fnrsusgrpzugtut)),aktbestand,alterwert); +kuerzelsummeeinsrauf(statnr,jgstaufber(wert(fnrsusgrpjgst)),compress(wert( +fnrsusgrpzugtut)),aktbestand,neuerwert)END PROC kuerzelaendern;#END PACKET +erfabmeldedaten + diff --git a/app/schulis/2.2.1/src/1.erf.schuelerdaten b/app/schulis/2.2.1/src/1.erf.schuelerdaten new file mode 100644 index 0000000..fb86963 --- /dev/null +++ b/app/schulis/2.2.1/src/1.erf.schuelerdaten @@ -0,0 +1,605 @@ +PACKET erfschuelerdatenDEFINES sustartunderfassungsbildschirmaufbauen, +suvonerfassungsbildschirmeinlesen,suanmeldungbearbeiten,suanmeldungeinfuegen, +suanmeldungzeigen,suanmeldungloeschen,suanmeldungloeschenausfuehren, +suanmeldungspeichern,suschuelerbsblaettern,sudatenimbildschirmkopieren, +suausgesuchtezurbearbeitung,suanmeldungausgesuchteloeschen, +suzurueckzumanfangsbildschirm,suerfassungswert,suerfassungschueler, +pruefungschueler:LET maskenstammname="ms erf schuelerdaten",maskennameeingang +="ms schuelerangabe",maskennamebearbeitung="ms bearb schuelerdaten";LET +bestandneu5="n05",bestandneu11="n11",bestandneusonst="nso",bestandlaufschulj= +"ls",#bestandschuelergruppen="aktuelle Schülergruppen",#bestandschulen= +"Schulen",kuerzelzugangaktjgst="z";LET meldungloeschfrage=65,meldungloeschung +=83,meldungkeineloeschung=84,meldunggibtsschon=70,meldunggibtsnicht=71, +meldungletzter=67,meldungkeineliste=68,meldungspeicherung=80,meldungaenderung +=81,meldungkeineaenderung=82,meldunglistenerstellung=7, +meldungblaetterngehtnicht=72,meldungspeicherungfehlerhaft=73, +meldungloeschenfehlerhaft=74,meldungangabengenauer=129,meldungfalschesdatum= +157,meldungbittename=166,pruefemeldung=57;LET fmeldbittefuellen=52, +fmeldnichtimbestand=55,fmeldfalschesdatum=157,fmeldnumundbegrenzt=54, +fmeldbitteanderejgst=85,weiblich="w",maennlich="m",bestandstaaten= +"c02 staaten",bestandreligion="c02 relizugehoerigkeit",bestandzugang= +"c02 zugang";LET fbs1=1,fbs2=2,fbs3=3,fbs4=4,erstesfeldbeierfassungbs1=2, +erstesfeldbeierfassungbs2=2,erstesfeldbeierfassungbs3=3, +erstesfeldbeierfassungbs4=3,erstererfbildschirm=2,letztererfbildschirm=4;LET +fnrname=2,fnrnamenszus=3,fnrgebname=4,fnrvornamen=5,fnrrufname=6,fnrsustr=7, +fnrsutelefon=8,fnrsuplzort=9,fnrwohntbei=10,fnrortsteil=11,fnrgebdat=12, +fnrgeschlecht=13,fnrstaatsan=14,fnrreligion=15,fnrverwandt=16,fnrerzname=17, +fnrerznamenszus=18,fnrerzvornamen=19,fnrerzstr=20,fnrerztelefon=21, +fnrerzplzort=22,fnrloeschfeld=23,fnrgebort=3,fnrkreisland=4,fnrmuttersprache= +5,fnraussiedler=6,fnreinschulung=7,fnrschulkuerzel=8,fnrletzteklasse=9, +fnreintrittsdatum=10,fnreintrittjgst=11,fnrsek2=12,fnrjgst=13,fnrzug=14, +fnrzugang=15,fnrneuerzug=16,fnrvermerk1=17,fnrabdatum=23,fnrabgrund=24, +fnrneueschule=25,fnrabschluss=26,fnrreligionunterricht=3, +fnrreligionabmelddatum=4,fnrreligionanmelddatum=5,fnrfremdsprache=6, +fnrkunstmusik=18,fnrag=19,fnrwpsek1=28,fnrauswahlanfang=2,fnrauswahlende=5, +fnrneuan5=2,fnrneuan11=3,fnrneusonst=4,fnrneulaufschulj=5,fnrparamname=6, +fnrparamrufname=7,fnrparamgebdat=8,fnrparambearbname=2,fnrparambearbrufname=3 +,fnrparambearbgebdat=4,fnrerstesausgabefeld=2,fnrletztesausgabefeld=40, +fnrausgabename=2;LET zahldervermerke=6,maxlaengenamebeiaenderung=32, +maxlaengenamebeikeineaenderung=26;LET pruefartdatum=6,pruefartauswahl=5;LET +satzeinfuegen=1,#satzaendern=2,#satzloeschen=3,satzneueschluessel=4;LET +kennungerfassungsprogramm=1,kennungbearbeitungsprogramm=2, +kennungzeigeprogramm=3;LET leer="",leerzeichen=" ",oblitrenner="$", +kennzmeldungauffaellig="#";LET jgst05="05",jgst11="11",jgstufe5=5,jgstufe10= +10,jgstufe11=11,jgstufe13=13;LET bsanzahl=4,maxfelderzahl=100;LET +anzschluesselsu=3;LET aktschuljahr="Schuljahr",akthalbjahr="Schulhalbjahr"; +LET aendern=1,loeschen=2;BOOL VAR zurueckschreiben:=FALSE ;BOOL VAR +neuerschueler,neuenschuelereinfuegen,neuerschuelerersteintrag;BOOL VAR +zeigeprogramm:=FALSE ,mehrereloeschen:=FALSE ,feldschutzzumloeschengesetzt:= +FALSE ;FILE VAR f;INT VAR statussudatei:=0;INT VAR startpos;INT VAR +programmnummer;INT VAR bs,bsdraussen,fnrfehlerfeld;ROW bsanzahlROW +maxfelderzahlTEXT VAR erfassungsfeld;ROW bsanzahlTAG VAR maske;ROW bsanzahl +BOOL VAR maskegeholt;ROW anzschluesselsuTEXT VAR schluessel;ROW +anzschluesselsuTEXT VAR alterschluessel;TEXT VAR dateiname:="Schülerliste", +hjdtid:="",diffdatentid:="";#schultypsich:="",verskennzsich:="";#TEXT VAR +aktbestand,programmname,tupelsich;LET logtextbeginn1="Anw. 1.1.1 ", +logtextbeginn2="Anw. 1.2.2 ";BOOL PROC erfassungsprogramm:programmnummer= +kennungerfassungsprogrammEND PROC erfassungsprogramm;BOOL PROC +bearbeitungsprogramm:programmnummer=kennungbearbeitungsprogrammEND PROC +bearbeitungsprogramm;PROC sustartunderfassungsbildschirmaufbauen(INT CONST +progrnr):IF progrnr=kennungzeigeprogrammTHEN programmnummer:= +kennungbearbeitungsprogramm;zeigeprogramm:=TRUE ELSE programmnummer:=progrnr; +zeigeprogramm:=FALSE FI ;startprozedur;erfassungsbildschirmaufbauen; +suvonerfassungsbildschirmeinlesen.END PROC +sustartunderfassungsbildschirmaufbauen;PROC startprozedur:programmname:=text( +vergleichsknoten);reinitparsing;systemdboff;bildschirmeinitialisieren; +standardkopfmaskeausgeben(programmname);.END PROC startprozedur;PROC +bildschirmeinitialisieren:FOR bsFROM 1UPTO bsanzahlREP maskegeholt(bs):= +FALSE PER ;bs:=1;maskeholen(bs);bsdraussen:=0.END PROC +bildschirmeinitialisieren;PROC erfassungsbildschirmaufbauen:reinitparsing; +standardkopfmaskeaktualisieren(bstitel);erfassungsmaskeausgeben; +feldvorbelegungenbehandeln;felderausgeben.bstitel:IF bs>1THEN programmname+ +" ("+text(bs-1)+".Bildschirm)"ELSE programmnameFI .erfassungsmaskeausgeben: +IF bs<>bsdraussenTHEN zeigemaske;bsdraussen:=bsFI .zeigemaske:show(maske(bs)) +.felderausgeben:startpos:=fnrerstesausgabefeld;put(maske(bs),erfassungsfeld( +bs),startpos);IF zeigeprogrammCAND (bs<>fbs1)THEN feldschutzfuerallefelder; +startpos:=1ELSE startpos:=erstesfeldbeierfassung(bs)FI . +feldschutzfuerallefelder:INT VAR i;protect(maske(bs),1,FALSE );FOR iFROM +fnrerstesausgabefeldUPTO fnrletztesausgabefeldREP protect(maske(bs),i,TRUE ) +PER .END PROC erfassungsbildschirmaufbauen;PROC maskeholen(INT CONST maskennr +):initmaske(maske(maskennr),initmaskenname);maskegeholt(maskennr):=TRUE . +initmaskenname:IF erfassungsprogrammTHEN maskenstammname+text(maskennr)ELSE +maskennamefuerbearbeitungFI .maskennamefuerbearbeitung:SELECT maskennrOF +CASE 1:maskennameeingangCASE 2:maskenstammname+text(maskennr)CASE 3: +maskennamebearbeitung+text(maskennr)CASE 4:maskenstammname+text(maskennr) +OTHERWISE ""END SELECT .END PROC maskeholen;PROC feldvorbelegungenbehandeln: +SELECT bsOF CASE 1:bsfelderinitialisierenCASE 2:vorbelegungen2CASE 3: +vorbelegungen3CASE 4:vorbelegungen4END SELECT .vorbelegungen2: +vorbelegungneuerschueler2;loeschfeldverdecken.loeschfeldverdecken:LET +rahmenzeichen="=";erfassungsfeld(bs)(fnrloeschfeld):=rahmenzeichen. +vorbelegungen3:vorbelegungname3;vorbelegungzugang;vorbelegungeintrittjgst; +feldschutzfuerfelderbeineuanmeldungen;.vorbelegungen4:vorbelegungname4.END +PROC feldvorbelegungenbehandeln;PROC vorbelegungname3:TEXT VAR vor,zus,nach; +vor:=erfassungsfeld(fbs2)(fnrrufname)+leerzeichen;zus:=erfassungsfeld(fbs2)( +fnrnamenszus);IF zus<>leerTHEN zusCAT leerzeichenFI ;nach:=erfassungsfeld( +fbs2)(fnrname);erfassungsfeld(bs)(fnrausgabename):=text(vor+zus+nach, +laengefnrausgabename).laengefnrausgabename:length(maske(bs),fnrausgabename). +END PROC vorbelegungname3;PROC vorbelegungzugang:IF aktbestand<> +bestandlaufschuljTHEN erfassungsfeld(bs)(fnrzugang):=kuerzelzugangaktjgst; +protect(maske(bs),fnrzugang,TRUE )ELSE protect(maske(bs),fnrzugang,FALSE )FI +.END PROC vorbelegungzugang;PROC vorbelegungname4:erfassungsfeld(bs)( +fnrausgabename):=erfassungsfeld(fbs3)(fnrausgabename).END PROC +vorbelegungname4;PROC vorbelegungneuerschueler2:IF neuerschuelerersteintrag +THEN neuerschuelerersteintrag:=FALSE ;erfassungsfeld(fbs2)(fnrname):= +erfassungsfeld(fbs1)(fnrparamname);erfassungsfeld(fbs2)(fnrrufname):= +erfassungsfeld(fbs1)(fnrparamrufname);erfassungsfeld(fbs2)(fnrvornamen):= +erfassungsfeld(fbs1)(fnrparamrufname);erfassungsfeld(fbs2)(fnrgebdat):= +erfassungsfeld(fbs1)(fnrparamgebdat)FI .END PROC vorbelegungneuerschueler2; +PROC vorbelegungeintrittjgst:protect(maske(bs),fnrsek2,FALSE );protect(maske( +bs),fnreintrittjgst,FALSE );IF aktbestand=bestandneu5THEN erfassungsfeld(bs)( +fnreintrittjgst):=jgst05;protect(maske(bs),fnreintrittjgst,TRUE )ELIF +aktbestand=bestandneu11THEN erfassungsfeld(bs)(fnreintrittjgst):=jgst11; +protect(maske(bs),fnreintrittjgst,TRUE );IF neuerschuelerTHEN +eintrittinsek2vorbelegenFI FI .END PROC vorbelegungeintrittjgst;PROC +eintrittinsek2vorbelegen:TEXT VAR schuljahr:=schulkenndatum(aktschuljahr); +schuljahr:=subtext(schuljahr,3,4);schuljahr:=schuljahr+text(int(schuljahr)+1) +;erfassungsfeld(bs)(fnrsek2):=schuljahr;protect(maske(bs),fnrsek2,TRUE ).END +PROC eintrittinsek2vorbelegen;PROC feldschutzfuerfelderbeineuanmeldungen:IF +aktbestand=bestandlaufschuljTHEN protect(maske(bs),fnrzug,FALSE );IF +neuerschuelerTHEN protect(maske(bs),fnrjgst,FALSE )ELSE protect(maske(bs), +fnrjgst,TRUE )FI ELSE protect(maske(bs),fnrjgst,TRUE );protect(maske(bs), +fnrzug,TRUE )FI .END PROC feldschutzfuerfelderbeineuanmeldungen;PROC +suvonerfassungsbildschirmeinlesen:get(maske(bs),erfassungsfeld(bs),startpos); +loeschemeldung(maske(bs)).END PROC suvonerfassungsbildschirmeinlesen;PROC +suanmeldungbearbeiten:neuenschuelereinfuegen:=FALSE ;IF +sinnvolleauswahlgetroffenTHEN bearbeitungvorbereitungbeginnenELSE startpos:= +fnrfehlerfeld;return(1)FI .bearbeitungvorbereitungbeginnen:IF +namenangabenausreichendTHEN bearbeitungbeginnenELSE startpos:=fnrfehlerfeld; +return(1)FI .namenangabenausreichend:IF erfassungsprogrammTHEN +namenangabenausreichendbeierfassungELSE +namenangabenausreichendbeibearbeitungoderzeigenFI .bearbeitungbeginnen: +legeaktuellenbestandfest;BOOL VAR suexistiert:=FALSE ;schluesselbereitstellen +;pruefeobnameexistiert(suexistiert);IF suexistiertTHEN saveupdateposition( +dnrschueler);diffdatenlesen;schluessel(1):=wert(fnrsufamnames);schluessel(2) +:=wert(fnrsurufnames);schluessel(3):=datumrekonversion(wert(fnrsugebdatums)); +loeschedieerstellteobjektliste;zurueckschreiben:=TRUE ;# +schuelerausstatwuerfelentfernen;dr10.05.88#bereiteaenderungvor; +suvonerfassungsbildschirmeinlesenELSE meldeauffaellig(maske(bs), +meldunggibtsnicht);IF erfassungsprogrammTHEN startpos:=fnrparamnameELSE +startpos:=fnrparambearbnameFI ;return(1)FI .END PROC suanmeldungbearbeiten; +BOOL PROC sinnvolleauswahlgetroffen:fnrfehlerfeld:=0;IF erfassungsprogramm +THEN pruefe(pruefartauswahl,maske(bs),erfassungsfeld(fbs1),fnrauswahlanfang, +fnrauswahlende,0,leer,fnrfehlerfeld);IF fnrfehlerfeld=0THEN IF erfassungsfeld +(fbs1)(fnrparamgebdat)<>leerTHEN pruefe(pruefartdatum,maske(bs), +erfassungsfeld(fbs1),fnrparamgebdat,0,0,leer,fnrfehlerfeld);FI FI ; +fnrfehlerfeld=0ELSE IF erfassungsfeld(fbs1)(fnrparambearbgebdat)<>leerTHEN +pruefe(pruefartdatum,maske(bs),erfassungsfeld(fbs1),fnrparambearbgebdat,0,0, +leer,fnrfehlerfeld);FI ;fnrfehlerfeld=0FI .END PROC sinnvolleauswahlgetroffen +;TEXT PROC suerfassungswert(INT CONST feldnr):IF (feldnr>maxfelderzahl)OR ( +feldnr<1)THEN ""ELSE erfassungsfeld(bs)(feldnr)FI .END PROC suerfassungswert; +PROC schluesselbereitstellen:IF erfassungsprogrammTHEN schluessel(1):= +erfassungsfeld(fbs1)(fnrparamname);schluessel(2):=erfassungsfeld(fbs1)( +fnrparamrufname);schluessel(3):=erfassungsfeld(fbs1)(fnrparamgebdat)ELIF +bearbeitungsprogrammTHEN schluessel(1):=erfassungsfeld(fbs1)( +fnrparambearbname);schluessel(2):=erfassungsfeld(fbs1)(fnrparambearbrufname); +schluessel(3):=erfassungsfeld(fbs1)(fnrparambearbgebdat)FI ;alterschluessel(1 +):=schluessel(1);alterschluessel(2):=schluessel(2);alterschluessel(3):= +schluessel(3);END PROC schluesselbereitstellen;PROC pruefeobnameexistiert( +BOOL VAR suexist):TEXT VAR datenbankwerte,schluesselwerte;inittupel( +dnrschueler);putwert(fnrsufamnames,schluessel(1));putwert(fnrsurufnames, +schluessel(2));putwert(fnrsugebdatums,datumskonversion(schluessel(3))); +putwert(fnrsustatuss,aktbestand);IF neuenschuelereinfuegenTHEN search( +dnrschueler,FALSE )ELSE search(ixsustatfamrufgeb,FALSE );FI ;IF (NOT +neuenschuelereinfuegenCAND dbstatus=okCAND wert(fnrsustatuss)=aktbestand)OR ( +neuenschuelereinfuegenCAND dbstatus=ok)THEN datenbankwerte:=wert( +fnrsurufnames)+datumrekonversion(wert(fnrsugebdatums));schluesselwerte:= +schluessel(2)+schluessel(3);suexist:=(wert(fnrsufamnames)=schluessel(1)CAND ( +(schluessel(2)=leerAND schluessel(3)=leer)OR (pos(datenbankwerte, +schluesselwerte)=1)))ELSE suexist:=FALSE FI .END PROC pruefeobnameexistiert; +PROC bereiteaenderungvor:savetupel(dnrschueler,tupelsich);neuerschueler:= +FALSE ;holemaskenfallsnotwendig;fuelledbdateninfelder;bs:=erstererfbildschirm +;erfassungsbildschirmaufbauen.fuelledbdateninfelder:INT VAR bsn;FOR bsnFROM +erstererfbildschirmUPTO letztererfbildschirmREP holedbwerte(bsn)PER .END +PROC bereiteaenderungvor;PROC holemaskenfallsnotwendig:IF NOT (maskegeholt( +erstererfbildschirm))THEN FOR bsFROM erstererfbildschirmUPTO +letztererfbildschirmREP IF NOT maskegeholt(bs)THEN maskeholen(bs)FI ;PER FI . +END PROC holemaskenfallsnotwendig;PROC suanmeldungeinfuegen: +neuenschuelereinfuegen:=TRUE ;IF sinnvolleauswahlgetroffenTHEN +neueintragbeginnenELSE startpos:=fnrfehlerfeld;return(1)FI . +neueintragbeginnen:legeaktuellenbestandfest;BOOL VAR suexistiert:=FALSE ; +schluesselbereitstellen;pruefeobnameexistiert(suexistiert);IF suexistiert +THEN meldeauffaellig(maske(bs),meldunggibtsschon);return(1)ELSE +zurueckschreiben:=FALSE ;bereiteneueintragvor; +suvonerfassungsbildschirmeinlesenFI .bereiteneueintragvor:neuerschueler:= +TRUE ;neuerschuelerersteintrag:=TRUE ;holemaskenfallsnotwendig;bs:= +erstererfbildschirm;erfassungsbildschirmaufbauen.END PROC +suanmeldungeinfuegen;PROC legeaktuellenbestandfest:IF bearbeitungsprogramm +THEN aktbestand:=bestandlaufschuljELIF erfassungsfeld(fbs1)(fnrneuan5)<>leer +THEN aktbestand:=bestandneu5ELIF erfassungsfeld(fbs1)(fnrneuan11)<>leerTHEN +aktbestand:=bestandneu11ELIF erfassungsfeld(fbs1)(fnrneusonst)<>leerTHEN +aktbestand:=bestandneusonstELIF erfassungsfeld(fbs1)(fnrneulaufschulj)<>leer +THEN aktbestand:=bestandlaufschuljFI .END PROC legeaktuellenbestandfest;PROC +suanmeldungspeichern(BOOL CONST zuspeichern):BOOL VAR suexistiert;TEXT VAR +schuelertupel:="";IF NOT zuspeichernTHEN IF neuerschuelerTHEN +vorbereitendesnaechstenneuen;return(1)ELSE IF NOT zeigeprogrammTHEN melde( +maske(bs),meldungkeineaenderung,subtext(namefuermeldung,1, +maxlaengenamebeikeineaenderung)+kennzmeldungauffaellig)FI ; +vorbereitendernaechstenschluesselbehandlungFI ELSE speicherungstartenFI . +speicherungstarten:INT VAR fehlerstatus:=0; +pruefeobbeineuemschuelerschonvorhanden;IF datenfehlerfreiTHEN datenschreiben; +IF statussudatei<>0THEN melde(maske(bs),meldungspeicherungfehlerhaft,text( +statussudatei)+kennzmeldungauffaellig);#altenschuelerwiedereintragen;dr10. +05.88#return(1)ELIF neuerschuelerTHEN #schuelerinstatwuerfeleinfuegen;dr10. +05.88#vorbereitendesnaechstenneuen;return(1)ELSE # +schuelerinstatwuerfeleinfuegen;dr10.05.88# +vorbereitendernaechstenschluesselbehandlungFI ;ELSE fehlerbehandeln;return(1) +FI .pruefeobbeineuemschuelerschonvorhanden:IF falschesdatum(erfassungsfeld( +fbs2)(fnrgebdat))THEN fehlerstatus:=fnrgebdat;bs:=fbs2; +erfassungsbildschirmaufbauen;meldeauffaellig(maske(bs),meldungfalschesdatum); +ELSE schluessel(1):=erfassungsfeld(fbs2)(fnrname);schluessel(2):= +erfassungsfeld(fbs2)(fnrrufname);schluessel(3):=erfassungsfeld(fbs2)( +fnrgebdat);IF geaenderteschluesselfelderTHEN savetupel(dnrschueler, +schuelertupel);pruefeobnameexistiert(suexistiert);restoretupel(dnrschueler, +schuelertupel);IF suexistiertTHEN fehlerstatus:=fnrname;bs:=fbs2; +erfassungsbildschirmaufbauen;meldeauffaellig(maske(bs),meldunggibtsschon); +ELSE pruefeplausibilitaet(fehlerstatus);FI ELSE pruefeplausibilitaet( +fehlerstatus);FI FI .datenfehlerfrei:fehlerstatus=0.fehlerbehandeln:startpos +:=fehlerstatus.END PROC suanmeldungspeichern;PROC datenschreiben: +meldespeicherung;dbwertzuordnung;IF neuerschuelerTHEN logeintragvornehmen( +"Neueinfügen");neueneinfuegenELSE logeintragvornehmen("Änderung"); +bearbeitetenschreibenFI ;.meldespeicherung:IF neuerschuelerTHEN melde(maske( +bs),meldungspeicherung,namefuermeldung+kennzmeldungauffaellig)ELSE melde( +maske(bs),meldungaenderung,subtext(namefuermeldung,1, +maxlaengenamebeiaenderung)+kennzmeldungauffaellig)FI .dbwertzuordnung:INT +VAR bsn;IF neuerschuelerTHEN inittupel(dnrschueler)FI ;FOR bsnFROM +erstererfbildschirmUPTO letztererfbildschirmREP setzedbwerte(bsn)PER ;.END +PROC datenschreiben;TEXT PROC namefuermeldung:LET kennznametrenner=".";( +schluessel(2)SUB 1)+kennznametrenner+schluessel(1).END PROC namefuermeldung; +PROC logeintragvornehmen(TEXT CONST logergaenzung):TEXT VAR eintrag;IF +erfassungsprogrammTHEN eintrag:=logtextbeginn1ELSE eintrag:=logtextbeginn2FI +;eintragCAT logergaenzung;eintragCAT " """;eintragCAT schluessel(1);eintrag +CAT ", ";eintragCAT schluessel(2);eintragCAT ", ";eintragCAT datumskonversion +(schluessel(3));eintragCAT """";logeintrag(eintrag)END PROC +logeintragvornehmen;PROC neueneinfuegen:diffdatentid:="";putwert( +fnrdddiffdatennr,unique(dnrdiffdaten));insert(dnrdiffdaten);IF dbstatus=ok +THEN search(dnrdiffdaten,TRUE );IF dbstatus=okTHEN diffdatentid:=gettid;FI +ELSE fehlerprotokoll(dnrdiffdaten,satzeinfuegen);FI ;putwert( +fnrsudiffdatennrs,wert(fnrdddiffdatennr));putwert(fnrsustatuss,aktbestand); +putwert(fnrsutiddiffdaten,diffdatentid);insert(dnrschueler);statussudatei:= +dbstatus;evtlaenderungderkurswahldatenvollziehenEND PROC neueneinfuegen;PROC +bearbeitetenschreiben:TEXT VAR sj:=schulkenndatum(aktschuljahr),hj:= +schulkenndatum(akthalbjahr);putwert(fnrsustatuss,aktbestand); +restoreupdateposition(dnrschueler);#update(dnrschueler);dr10.05.88#selupdate( +dnrschueler);statussudatei:=dbstatus;replace(dnrdiffdaten,wert( +fnrsutiddiffdaten));IF statussudatei=okCAND aktbestand=bestandlaufschuljTHEN +neueklasseinhalbjahresdateneintragen(schluessel,sj,hj,wert(fnrsusgrpjgst), +wert(fnrsusgrpzugtut))FI ;IF statussudatei=okCAND geaenderteschluesselfelder +THEN hjddateiupdate(dnrhalbjahresdaten,satzneueschluessel); +evtlaenderungderkurswahldatenvollziehenFI END PROC bearbeitetenschreiben; +BOOL PROC geaenderteschluesselfelder:schluessel(1)<>alterschluessel(1)OR +schluessel(2)<>alterschluessel(2)OR schluessel(3)<>alterschluessel(3)END +PROC geaenderteschluesselfelder;PROC +vorbereitendernaechstenschluesselbehandlung:IF exists(dateiname)THEN +holenaechstenschluesselauslisteELSE zurueckschreiben:=FALSE ; +suzurueckzumanfangsbildschirm(2);FI .holenaechstenschluesselausliste:BOOL +VAR ok,kannbearbeitetwerden:=FALSE ;holenaechstenmehrtlgschluesselausdatei(ok +);WHILE okREP pruefeobnameexistiert(ok);IF okTHEN saveupdateposition( +dnrschueler);diffdatenlesen;kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE +holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerden +THEN zurueckschreiben:=TRUE ;IF mehrereloeschenTHEN bereiteloeschenvor;return +(1)ELSE #schuelerausstatwuerfelentfernen;dr10.05.88#bereiteaenderungvor; +return(1)FI ELSE zurueckschreiben:=FALSE ;behandleendederlistenabarbeitungFI +.behandleendederlistenabarbeitung:mehrereloeschen:=FALSE ;meldeauffaellig( +maske(bs),meldungletzter);suzurueckzumanfangsbildschirm(3).END PROC +vorbereitendernaechstenschluesselbehandlung;PROC sudatenimbildschirmkopieren: +INT VAR curspos:=startpos;IF bs=fbs2THEN IF curspos=fnrrufnameTHEN +erfassungsfeld(bs)(fnrrufname):=erfassungsfeld(bs)(fnrvornamen);put(maske(bs) +,erfassungsfeld(bs)(fnrrufname),fnrrufname)ELIF curspos=fnrerznameTHEN +erfassungsfeld(bs)(fnrerzname):=erfassungsfeld(bs)(fnrname);put(maske(bs), +erfassungsfeld(bs)(fnrerzname),fnrerzname);erfassungsfeld(bs)(fnrerznamenszus +):=erfassungsfeld(bs)(fnrnamenszus);put(maske(bs),erfassungsfeld(bs)( +fnrerznamenszus),fnrerznamenszus);INT VAR i;FOR iFROM 0UPTO fnrerzplzort- +fnrerzstrREP erfassungsfeld(bs)(fnrerzstr+i):=erfassungsfeld(bs)(fnrsustr+i); +put(maske(bs),erfassungsfeld(bs)(fnrerzstr+i),fnrerzstr+i)PER ;FI ;startpos:= +cursposFI ;return(1).END PROC sudatenimbildschirmkopieren;PROC +suanmeldungzeigen:BOOL VAR listeexistiertnicht;IF sinnvolleauswahlgetroffen +THEN listezeigenbeginnenELSE startpos:=fnrfehlerfeld;return(1)FI . +listezeigenbeginnen:schluesselbereitstellen;legeaktuellenbestandfest; +setzedbwerte(bs);meldeauffaellig(maske(bs),meldunglistenerstellung); +parsenooffields(5);putwert(fnrsustatuss,aktbestand);objektlistestarten( +ixsustatfamrufgeb,schluessel(1),fnrsufamnames,TRUE ,listeexistiertnicht);IF +listeexistiertnichtTHEN reinitparsing;meldeauffaellig(maske(bs), +meldungkeineliste);return(1)ELSE bsdraussen:=0;datensatzlistenausgabe(PROC ( +INT CONST )suerfassungschueler,TRUE ,BOOL PROC pruefungschueler)FI .END PROC +suanmeldungzeigen;PROC suerfassungschueler(INT CONST n):LET namenlaenge=63, +trenner=", ";TEXT VAR identizeile,schluesselanhang:="";INT VAR i;identizeile +:=wert(fnrsufamnames)+trenner+wert(fnrsurufnames);identizeile:=text( +identizeile,namenlaenge)+wert(fnrsugebdatums);schluesselkoppeln; +setzeidentiwert(identizeilemitschluesselanhang).schluesselkoppeln:FOR iFROM 1 +UPTO anzschluesselsuREP schluesselanhangCAT oblitrenner;schluesselanhangCAT +wert(dnrschueler+i);PER .identizeilemitschluesselanhang:identizeile+ +schluesselanhang.END PROC suerfassungschueler;BOOL PROC pruefungschueler:wert +(fnrsustatuss)=aktbestandEND PROC pruefungschueler;PROC +suausgesuchtezurbearbeitung:behandlungderausgesuchten(aendern)END PROC +suausgesuchtezurbearbeitung;PROC holeerstenmehrtlgschluesselausdatei(BOOL +VAR ok):IF NOT exists(dateiname)THEN ok:=FALSE ;LEAVE +holeerstenmehrtlgschluesselausdateiFI ;f:=sequentialfile(input,dateiname); +holenaechstenmehrtlgschluesselausdatei(ok);END PROC +holeerstenmehrtlgschluesselausdatei;PROC +holenaechstenmehrtlgschluesselausdatei(BOOL VAR ok):TEXT VAR thesaurustext:= +"";INT VAR schluesselbeginn:=0;INT VAR schluesseltrennung:=0;INT VAR i:=1;IF +eof(f)THEN ok:=FALSE ;loeschedieerstellteobjektlisteELSE getline(f, +thesaurustext);bestimmeschluesselausthesaurustext;ok:=TRUE FI . +bestimmeschluesselausthesaurustext:schluesselbeginn:=pos(thesaurustext, +oblitrenner);schluesseltrennung:=pos(thesaurustext,oblitrenner, +schluesselbeginn+1);FOR iFROM 1UPTO anzschluesselsuREP IF schluesseltrennung> +0THEN schluessel(i):=subtext(thesaurustext,schluesselbeginn+1, +schluesseltrennung-1);schluesselbeginn:=schluesseltrennung;schluesseltrennung +:=pos(thesaurustext,oblitrenner,schluesselbeginn+1);ELSE schluessel(i):= +subtext(thesaurustext,schluesselbeginn+1);FI ;PER ;schluessel(3):= +datumrekonversion(schluessel(3));.END PROC +holenaechstenmehrtlgschluesselausdatei;PROC loeschedieerstellteobjektliste: +forget(dateiname,quiet);END PROC loeschedieerstellteobjektliste;INT PROC +erstesfeldbeierfassung(INT CONST bildschirmnummer):IF bildschirmnummer=fbs1 +THEN erstesfeldbeierfassungbs1ELIF bildschirmnummer=fbs2THEN +erstesfeldbeierfassungbs2ELIF bildschirmnummer=fbs3THEN +erstesfeldbeierfassungbs3ELIF bildschirmnummer=fbs4THEN +erstesfeldbeierfassungbs4ELSE 1FI .END PROC erstesfeldbeierfassung;PROC +suschuelerbsblaettern(BOOL CONST vorwaerts):IF blaetternsinnlosTHEN +meldeauffaellig(maske(bs),meldungblaetterngehtnicht)ELSE +fuehreblaettervorgangdurch;FI ;return(1).blaetternsinnlos:(vorwaertsAND (bs= +letztererfbildschirm))OR (NOT vorwaertsAND (bs=erstererfbildschirm)). +fuehreblaettervorgangdurch:IF vorwaertsTHEN bsINCR 1ELSE bsDECR 1FI ; +erfassungsbildschirmaufbauen.END PROC suschuelerbsblaettern;PROC +bsfelderinitialisieren:INT VAR bsnr;FOR bsnrFROM 1UPTO bsanzahlREP init( +erfassungsfeld(bsnr))PER .END PROC bsfelderinitialisieren;PROC +vorbereitendesnaechstenneuen:bsfelderinitialisieren;bs:=erstererfbildschirm; +erfassungsbildschirmaufbauen.END PROC vorbereitendesnaechstenneuen;PROC +suzurueckzumanfangsbildschirm(INT CONST schritte):bs:=1;IF zurueckschreiben +THEN #schuelerinstatwuerfeleinfuegendr10.05.88#FI ;IF +feldschutzzumloeschengesetztTHEN feldschutzfuerallefelderaufheben; +feldschutzzumloeschengesetzt:=FALSE FI ;erfassungsbildschirmaufbauen;return( +schritte);.feldschutzfuerallefelderaufheben:INT VAR i;FOR iFROM +fnrerstesausgabefeldUPTO fnrloeschfeld-1REP protect(maske(erstererfbildschirm +),i,FALSE )PER ;protect(maske(erstererfbildschirm),fnrloeschfeld,TRUE ).END +PROC suzurueckzumanfangsbildschirm;PROC pruefeplausibilitaet(INT VAR fstatus) +:fstatus:=0;INT VAR fmeld;meldeauffaellig(maske(bs),pruefemeldung);pruefebs2; +IF fstatus<>0THEN fehlerausgabeELSE pruefebs3;IF fstatus<>0THEN fehlerausgabe +ELSE pruefebs4;IF fstatus<>0THEN fehlerausgabeFI FI FI .pruefebs2:IF +erfassungsfeld(fbs2)(fnrname)=leerTHEN fstatus:=fnrname;bs:=fbs2;fmeld:= +fmeldbittefuellen;LEAVE pruefebs2FI ;IF erfassungsfeld(fbs2)(fnrrufname)=leer +THEN fstatus:=fnrrufname;bs:=fbs2;fmeld:=fmeldbittefuellen;LEAVE pruefebs2FI +;IF erfassungsfeld(fbs2)(fnrgebdat)=leerTHEN fstatus:=fnrgebdat;bs:=fbs2; +fmeld:=fmeldbittefuellen;LEAVE pruefebs2ELSE IF falschesdatum(erfassungsfeld( +fbs2)(fnrgebdat))THEN fstatus:=fnrgebdat;bs:=fbs2;fmeld:=fmeldfalschesdatum; +LEAVE pruefebs2FI FI ;IF NOT ((erfassungsfeld(fbs2)(fnrgeschlecht)=weiblich) +OR (erfassungsfeld(fbs2)(fnrgeschlecht)=maennlich))THEN fstatus:= +fnrgeschlecht;bs:=fbs2;fmeld:=fmeldnichtimbestand;LEAVE pruefebs2FI ;IF +erfassungsfeld(fbs2)(fnrstaatsan)<>leerTHEN IF NOT imschlbestand( +erfassungsfeld(fbs2)(fnrstaatsan),bestandstaaten)THEN fstatus:=fnrstaatsan;bs +:=fbs2;fmeld:=fmeldnichtimbestand;LEAVE pruefebs2FI FI ;IF erfassungsfeld( +fbs2)(fnrreligion)<>leerTHEN IF NOT imschlbestand(erfassungsfeld(fbs2)( +fnrreligion),bestandreligion)THEN fstatus:=fnrreligion;bs:=fbs2;fmeld:= +fmeldnichtimbestand;LEAVE pruefebs2FI FI .pruefebs3:INT CONST eintrittsjgst:= +int(erfassungsfeld(fbs3)(fnreintrittjgst));IF erfassungsfeld(fbs3)( +fnreintrittsdatum)=leerTHEN fstatus:=fnreintrittsdatum;bs:=fbs3;fmeld:= +fmeldbittefuellen;LEAVE pruefebs3ELSE IF falschesdatum(erfassungsfeld(fbs3)( +fnreintrittsdatum))THEN fstatus:=fnreintrittsdatum;bs:=fbs3;fmeld:= +fmeldfalschesdatum;LEAVE pruefebs3FI FI ;IF aktbestand=bestandneusonstTHEN +IF erfassungsfeld(fbs3)(fnreintrittjgst)=leerTHEN fstatus:=fnreintrittjgst;bs +:=fbs3;fmeld:=fmeldbittefuellen;LEAVE pruefebs3FI ;IF eintrittsjgstjgstufe13THEN fstatus:=fnreintrittjgst;bs:=fbs3;fmeld:= +fmeldnumundbegrenzt;LEAVE pruefebs3FI ;IF eintrittsjgst=jgstufe5COR +eintrittsjgst=jgstufe11THEN fstatus:=fnreintrittjgst;bs:=fbs3;fmeld:= +fmeldbitteanderejgst;LEAVE pruefebs3FI FI ;IF erfassungsfeld(fbs3)( +fnrschulkuerzel)<>leerTHEN IF NOT imbestand(erfassungsfeld(fbs3)( +fnrschulkuerzel),bestandschulen)THEN fstatus:=fnrschulkuerzel;bs:=fbs3;fmeld +:=fmeldnichtimbestand;LEAVE pruefebs3FI FI ;IF aktbestand=bestandlaufschulj +THEN IF erfassungsfeld(fbs3)(fnrzugang)=leerTHEN fstatus:=fnrzugang;bs:=fbs3; +fmeld:=fmeldbittefuellen;LEAVE pruefebs3ELIF NOT imschlbestand(erfassungsfeld +(fbs3)(fnrzugang),bestandzugang)THEN fstatus:=fnrzugang;bs:=fbs3;fmeld:= +fmeldnichtimbestand;LEAVE pruefebs3FI ;FI ;IF bearbeitungsprogrammCAND +erfassungsfeld(fbs3)(fnrneueschule)<>leerTHEN IF NOT imbestand(erfassungsfeld +(fbs3)(fnrneueschule),bestandschulen)THEN fstatus:=fnrneueschule;bs:=fbs3; +fmeld:=fmeldnichtimbestand;LEAVE pruefebs3FI FI ;IF bearbeitungsprogrammCAND +erfassungsfeld(fbs3)(fnrabdatum)<>leerTHEN IF falschesdatum(erfassungsfeld( +fbs3)(fnrabdatum))THEN fstatus:=fnrabdatum;bs:=fbs3;fmeld:=fmeldfalschesdatum +;LEAVE pruefebs3FI FI ;IF aktbestand<>bestandlaufschuljTHEN LEAVE pruefebs3 +FI ;TEXT VAR jgst:=erfassungsfeld(fbs3)(fnrjgst);TEXT VAR zug:=erfassungsfeld +(fbs3)(fnrzug);IF jgst=leerTHEN fstatus:=fnrjgst;bs:=fbs3;fmeld:= +fmeldbittefuellen;LEAVE pruefebs3FI ;IF zug=leerTHEN fstatus:=fnrzug;bs:=fbs3 +;fmeld:=fmeldbittefuellen;LEAVE pruefebs3FI ;IF NOT imbestandschuelergruppen +THEN IF neuerschuelerTHEN fstatus:=fnrjgstELSE fstatus:=fnrzugFI ;bs:=fbs3; +fmeld:=fmeldnichtimbestand;LEAVE pruefebs3FI .pruefebs4:IF erfassungsfeld( +fbs4)(fnrreligionabmelddatum)<>leerTHEN IF falschesdatum(erfassungsfeld(fbs4) +(fnrreligionabmelddatum))THEN fstatus:=fnrreligionabmelddatum;bs:=fbs4;fmeld +:=fmeldfalschesdatum;LEAVE pruefebs4FI FI ;IF erfassungsfeld(fbs4)( +fnrreligionanmelddatum)<>leerTHEN IF falschesdatum(erfassungsfeld(fbs4)( +fnrreligionanmelddatum))THEN fstatus:=fnrreligionanmelddatum;bs:=fbs4;fmeld:= +fmeldfalschesdatum;LEAVE pruefebs4FI FI ;.fehlerausgabe: +erfassungsbildschirmaufbauen;meldeauffaellig(maske(bs),fmeld).END PROC +pruefeplausibilitaet;BOOL PROC imbestandschuelergruppen:TEXT VAR schuljahr:= +schulkenndatum(aktschuljahr),halbjahr:=schulkenndatum(akthalbjahr);INT VAR +dateinummer:=dnraktschuelergruppen;putwert(dateinummer+1,schuljahr);putwert( +dateinummer+2,halbjahr);putwert(dateinummer+3,erfassungsfeld(fbs3)(fnrjgst)); +putwert(dateinummer+4,erfassungsfeld(fbs3)(fnrzug));search(dateinummer,TRUE ) +;dbstatus=0END PROC imbestandschuelergruppen;BOOL PROC falschesdatum(TEXT +CONST pruefdatum):LET falschertag="00";datum(pruefdatum)=nildatumCOR subtext( +pruefdatum,1,2)=falschertag.END PROC falschesdatum;PROC setzedbwerte(INT +CONST bsnr):INT VAR lv,verm;SELECT bsnrOF CASE fbs1:setzedbwertevonbs1CASE +fbs2:setzedbwertevonbs2CASE fbs3:setzedbwertevonbs3CASE fbs4: +setzedbwertevonbs4END SELECT ;IF neuenschuelereinfuegenTHEN putwert( +fnrsutidakthjd,leer)ELSE putwert(fnrsutidakthjd,hjdtid)FI .setzedbwertevonbs1 +:IF NOT bearbeitungsprogrammTHEN putwert(fnrsufamnames,erfassungsfeld[bsnr][ +fnrparamname]);putwert(fnrsurufnames,erfassungsfeld[bsnr][fnrparamrufname]); +putwert(fnrsugebdatums,datumskonversion(erfassungsfeld[bsnr][fnrparamgebdat]) +);ELSE putwert(fnrsufamnames,erfassungsfeld[bsnr][fnrparambearbname]);putwert +(fnrsurufnames,erfassungsfeld[bsnr][fnrparambearbrufname]);putwert( +fnrsugebdatums,datumskonversion(erfassungsfeld[bsnr][fnrparambearbgebdat])); +FI .setzedbwertevonbs2:putwert(fnrsufamnames,erfassungsfeld[bsnr][fnrname]); +putwert(fnrsunamenszusatzs,erfassungsfeld[bsnr][fnrnamenszus]);putwert( +fnrsugebnames,erfassungsfeld[bsnr][fnrgebname]);putwert(fnrsuvornames, +erfassungsfeld[bsnr][fnrvornamen]);putwert(fnrsurufnames,erfassungsfeld[bsnr] +[fnrrufname]);putwert(fnrsustrnrs,erfassungsfeld[bsnr][fnrsustr]);putwert( +fnrsutelnrs,erfassungsfeld[bsnr][fnrsutelefon]);putwert(fnrsuplzorts, +erfassungsfeld[bsnr][fnrsuplzort]);putwert(fnrsuwohntbei,erfassungsfeld[bsnr] +[fnrwohntbei]);putwert(fnrsuortsteils,erfassungsfeld[bsnr][fnrortsteil]); +putwert(fnrsugebdatums,datumskonversion(erfassungsfeld[bsnr][fnrgebdat])); +putwert(fnrsugeschlechts,erfassungsfeld[bsnr][fnrgeschlecht]);putwert( +fnrsustaatsangs,erfassungsfeld[bsnr][fnrstaatsan]);putwert(fnrsureligionsz, +erfassungsfeld[bsnr][fnrreligion]);putwert(fnrsuverhes,erfassungsfeld[bsnr][ +fnrverwandt]);putwert(fnrsufamnamee,erfassungsfeld[bsnr][fnrerzname]);putwert +(fnrsunamenszusatze,erfassungsfeld[bsnr][fnrerznamenszus]);putwert( +fnrsuvornamee,erfassungsfeld[bsnr][fnrerzvornamen]);putwert(fnrsustrnre, +erfassungsfeld[bsnr][fnrerzstr]);putwert(fnrsutelnre,erfassungsfeld[bsnr][ +fnrerztelefon]);putwert(fnrsuplzorte,erfassungsfeld[bsnr][fnrerzplzort]);. +setzedbwertevonbs3:putwert(fnrsugeborts,erfassungsfeld[bsnr][fnrgebort]); +putwert(fnrsugebkreiss,erfassungsfeld[bsnr][fnrkreisland]);putwert( +fnrsumuttersprache,erfassungsfeld[bsnr][fnrmuttersprache]);putwert( +fnrsuspaetaus,erfassungsfeld[bsnr][fnraussiedler]);putwert(fnrsujahreinschul, +erfassungsfeld[bsnr][fnreinschulung]);putwert(fnrsuskennlschule, +erfassungsfeld[bsnr][fnrschulkuerzel]);putwert(fnrsuklasselschule, +erfassungsfeld[bsnr][fnrletzteklasse]);putwert(fnrsueintrittsdats, +datumskonversion(erfassungsfeld[bsnr][fnreintrittsdatum]));putwert( +fnrsujgsteintr,jgstaufber(erfassungsfeld[bsnr][fnreintrittjgst]));putwert( +fnrsueintrittinsek,erfassungsfeld[bsnr][fnrsek2]);putwert(fnrsusgrpjgst, +jgstaufber(erfassungsfeld[bsnr][fnrjgst]));putwert(fnrsusgrpzugtut, +erfassungsfeld[bsnr][fnrzug]);putwert(fnrsuartzugang,erfassungsfeld[bsnr][ +fnrzugang]);putwert(fnrsuneuerzugtut,erfassungsfeld[bsnr][fnrneuerzug]);FOR +vermFROM 0UPTO zahldervermerke-1REP putwert(fnrsuvermerk1+verm,erfassungsfeld +[bsnr][fnrvermerk1+verm])PER ;IF bearbeitungsprogrammTHEN putwert( +fnrsuabgdats,datumskonversion(erfassungsfeld[bsnr][fnrabdatum]));putwert( +fnrsuabggrund,erfassungsfeld[bsnr][fnrabgrund]);putwert(fnrsuskennnschule, +erfassungsfeld[bsnr][fnrneueschule]);putwert(fnrsuabschluss,erfassungsfeld[ +bsnr][fnrabschluss]);FI .setzedbwertevonbs4:putwert(fnrddreliunter, +erfassungsfeld[bsnr][fnrreligionunterricht]);putwert(fnrddreliunter+1, +datumskonversion(erfassungsfeld[bsnr][fnrreligionabmelddatum]));putwert( +fnrddreliunter+2,datumskonversion(erfassungsfeld[bsnr][fnrreligionanmelddatum +]));FOR lvFROM 0UPTO 11REP putwert(fnrdd1fremdfach+lv,erfassungsfeld[bsnr][ +fnrfremdsprache+lv]);PER ;putwert(fnrddkunstmusik,erfassungsfeld[bsnr][ +fnrkunstmusik]);FOR lvFROM 0UPTO 8REP putwert(fnrddagthema1+lv,erfassungsfeld +[bsnr][fnrag+lv]);PER ;FOR lvFROM 0UPTO 7REP putwert(fnrddfach091a+lv, +erfassungsfeld[bsnr][fnrwpsek1+lv]);PER .END PROC setzedbwerte;PROC +holedbwerte(INT CONST bsnr):INT VAR lv,verm;SELECT bsnrOF CASE fbs1: +holedbwertevonbs1CASE fbs2:holedbwertevonbs2CASE fbs3:holedbwertevonbs3CASE +fbs4:holedbwertevonbs4END SELECT ;hjdtid:=wert(fnrsutidakthjd);. +holedbwertevonbs1:IF NOT bearbeitungsprogrammTHEN erfassungsfeld[bsnr][ +fnrparamname]:=wert(fnrsufamnames);erfassungsfeld[bsnr][fnrparamrufname]:= +wert(fnrsurufnames);erfassungsfeld[bsnr][fnrparamgebdat]:=wert(fnrsugebdatums +);ELSE erfassungsfeld[bsnr][fnrparambearbname]:=wert(fnrsufamnames); +erfassungsfeld[bsnr][fnrparambearbrufname]:=wert(fnrsurufnames); +erfassungsfeld[bsnr][fnrparambearbgebdat]:=wert(fnrsugebdatums);FI . +holedbwertevonbs2:erfassungsfeld[bsnr][fnrname]:=wert(fnrsufamnames); +erfassungsfeld[bsnr][fnrnamenszus]:=wert(fnrsunamenszusatzs);erfassungsfeld[ +bsnr][fnrgebname]:=wert(fnrsugebnames);erfassungsfeld[bsnr][fnrvornamen]:= +wert(fnrsuvornames);erfassungsfeld[bsnr][fnrrufname]:=wert(fnrsurufnames); +erfassungsfeld[bsnr][fnrsustr]:=wert(fnrsustrnrs);erfassungsfeld[bsnr][ +fnrsutelefon]:=wert(fnrsutelnrs);erfassungsfeld[bsnr][fnrsuplzort]:=wert( +fnrsuplzorts);erfassungsfeld[bsnr][fnrwohntbei]:=wert(fnrsuwohntbei); +erfassungsfeld[bsnr][fnrortsteil]:=wert(fnrsuortsteils);erfassungsfeld[bsnr][ +fnrgebdat]:=datumrekonversion(wert(fnrsugebdatums));erfassungsfeld[bsnr][ +fnrgeschlecht]:=wert(fnrsugeschlechts);erfassungsfeld[bsnr][fnrstaatsan]:= +wert(fnrsustaatsangs);erfassungsfeld[bsnr][fnrreligion]:=wert(fnrsureligionsz +);erfassungsfeld[bsnr][fnrverwandt]:=wert(fnrsuverhes);erfassungsfeld[bsnr][ +fnrerzname]:=wert(fnrsufamnamee);erfassungsfeld[bsnr][fnrerznamenszus]:=wert( +fnrsunamenszusatze);erfassungsfeld[bsnr][fnrerzvornamen]:=wert(fnrsuvornamee) +;erfassungsfeld[bsnr][fnrerzstr]:=wert(fnrsustrnre);erfassungsfeld[bsnr][ +fnrerztelefon]:=wert(fnrsutelnre);erfassungsfeld[bsnr][fnrerzplzort]:=wert( +fnrsuplzorte);alteschluesselsichern.alteschluesselsichern:alterschluessel(1) +:=erfassungsfeld[bsnr][fnrname];alterschluessel(2):=erfassungsfeld[bsnr][ +fnrrufname];alterschluessel(3):=erfassungsfeld[bsnr][fnrgebdat];. +holedbwertevonbs3:TEXT VAR einjgst:=wert(fnrsujgsteintr),aktjgst:=wert( +fnrsusgrpjgst);erfassungsfeld[bsnr][fnrgebort]:=wert(fnrsugeborts); +erfassungsfeld[bsnr][fnrkreisland]:=wert(fnrsugebkreiss);erfassungsfeld[bsnr] +[fnrmuttersprache]:=wert(fnrsumuttersprache);erfassungsfeld[bsnr][ +fnraussiedler]:=wert(fnrsuspaetaus);erfassungsfeld[bsnr][fnreinschulung]:= +textnichtnull(wert(fnrsujahreinschul));erfassungsfeld[bsnr][fnrschulkuerzel] +:=wert(fnrsuskennlschule);erfassungsfeld[bsnr][fnrletzteklasse]:=wert( +fnrsuklasselschule);erfassungsfeld[bsnr][fnreintrittsdatum]:= +datumrekonversion(wert(fnrsueintrittsdats));erfassungsfeld[bsnr][ +fnreintrittjgst]:=jgstaufber(einjgst);erfassungsfeld[bsnr][fnrsek2]:= +textnichtnull(wert(fnrsueintrittinsek));erfassungsfeld[bsnr][fnrjgst]:= +jgstaufber(aktjgst);erfassungsfeld[bsnr][fnrzug]:=wert(fnrsusgrpzugtut); +erfassungsfeld[bsnr][fnrzugang]:=wert(fnrsuartzugang);erfassungsfeld[bsnr][ +fnrneuerzug]:=wert(fnrsuneuerzugtut);FOR vermFROM 0UPTO zahldervermerke-1REP +erfassungsfeld[bsnr][fnrvermerk1+verm]:=wert(fnrsuvermerk1+verm)PER ;IF +bearbeitungsprogrammTHEN erfassungsfeld[bsnr][fnrabdatum]:=datumrekonversion( +wert(fnrsuabgdats));erfassungsfeld[bsnr][fnrabgrund]:=wert(fnrsuabggrund); +erfassungsfeld[bsnr][fnrneueschule]:=wert(fnrsuskennnschule);erfassungsfeld[ +bsnr][fnrabschluss]:=wert(fnrsuabschluss);FI .holedbwertevonbs4: +erfassungsfeld[bsnr][fnrreligionunterricht]:=wert(fnrddreliunter); +erfassungsfeld[bsnr][fnrreligionabmelddatum]:=datumrekonversion(wert( +fnrddreliunter+1));erfassungsfeld[bsnr][fnrreligionanmelddatum]:= +datumrekonversion(wert(fnrddreliunter+2));FOR lvFROM 0UPTO 11REP +erfassungsfeld[bsnr][fnrfremdsprache+lv]:=wert(fnrdd1fremdfach+lv);PER ; +erfassungsfeld[bsnr][fnrkunstmusik]:=wert(fnrddkunstmusik);FOR lvFROM 0UPTO 8 +REP erfassungsfeld[bsnr][fnrag+lv]:=wert(fnrddagthema1+lv);PER ;FOR lvFROM 0 +UPTO 7REP erfassungsfeld[bsnr][fnrwpsek1+lv]:=wert(fnrddfach091a+lv);PER . +END PROC holedbwerte;PROC suanmeldungloeschen:IF sinnvolleauswahlgetroffen +THEN loeschenvorbereitungbeginnenELSE startpos:=fnrfehlerfeld;return(1)FI . +loeschenvorbereitungbeginnen:IF namenangabenausreichendTHEN loeschenbeginnen +ELSE startpos:=fnrfehlerfeld;return(1)FI .namenangabenausreichend:IF +erfassungsprogrammTHEN namenangabenausreichendbeierfassungELSE +namenangabenausreichendbeibearbeitungoderzeigenFI .loeschenbeginnen: +legeaktuellenbestandfest;BOOL VAR suexistiert:=FALSE ;schluesselbereitstellen +;pruefeobnameexistiert(suexistiert);IF suexistiertTHEN saveupdateposition( +dnrschueler);diffdatenlesen;schluessel(1):=wert(fnrsufamnames);schluessel(2) +:=wert(fnrsurufnames);schluessel(3):=datumrekonversion(wert(fnrsugebdatums)); +loeschedieerstellteobjektliste;zurueckschreiben:=FALSE ;bereiteloeschenvor; +suvonerfassungsbildschirmeinlesenELSE meldeauffaellig(maske(bs), +meldunggibtsnicht);IF erfassungsprogrammTHEN startpos:=fnrparamnameELSE +startpos:=fnrparambearbnameFI ;return(1)FI .END PROC suanmeldungloeschen; +PROC bereiteloeschenvor:bereiteaenderungvor; +feldschutzfuerallefelderausserloeschfeldsetzen;meldeauffaellig(maske(bs), +meldungloeschfrage);startpos:=fnrloeschfeldEND PROC bereiteloeschenvor;PROC +feldschutzfuerallefelderausserloeschfeldsetzen:INT VAR i;FOR iFROM +fnrerstesausgabefeldUPTO fnrloeschfeld-1REP protect(maske(bs),i,TRUE )PER ; +protect(maske(erstererfbildschirm),fnrloeschfeld,FALSE ); +feldschutzzumloeschengesetzt:=TRUE .END PROC +feldschutzfuerallefelderausserloeschfeldsetzen;PROC +suanmeldungloeschenausfuehren(BOOL CONST zuloeschen):IF zuloeschenTHEN melde( +maske(bs),meldungloeschung,namefuermeldung+kennzmeldungauffaellig); +logeintragvornehmen("Entfernen");schuelerloeschen;IF dbstatus<>0THEN melde( +maske(bs),meldungloeschenfehlerhaft,text(dbstatus)+kennzmeldungauffaellig);# +altenschuelerwiedereintragen;dr10.05.88#return(1)ELSE +vorbereitendernaechstenschluesselbehandlungFI ELSE melde(maske(bs), +meldungkeineloeschung,namefuermeldung+kennzmeldungauffaellig); +vorbereitendernaechstenschluesselbehandlungFI .schuelerloeschen: +hjddateiupdate(dnrhalbjahresdaten,satzloeschen);diffdatenloeschen;delete( +dnrschueler);evtlaenderungderkurswahldatenvollziehen.diffdatenloeschen:IF +wert(fnrsudiffdatennrs)<>""THEN putwert(fnrdddiffdatennr,wert( +fnrsudiffdatennrs));search(dnrdiffdaten,TRUE );IF dbstatus=okTHEN delete( +dnrdiffdaten)FI FI .END PROC suanmeldungloeschenausfuehren;PROC +suanmeldungausgesuchteloeschen:behandlungderausgesuchten(loeschen)END PROC +suanmeldungausgesuchteloeschen;PROC behandlungderausgesuchten(INT CONST +wasistzutun):BOOL VAR ok,kannbearbeitetwerden:=FALSE ; +loeschedieerstellteobjektliste;objektlistebeenden(dateiname,TRUE ); +reinitparsing;holeerstenmehrtlgschluesselausdatei(ok);WHILE okREP +pruefeobnameexistiert(ok);IF okTHEN saveupdateposition(dnrschueler); +diffdatenlesen;kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE +holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerden +THEN zurueckschreiben:=TRUE ;IF wasistzutun=aendernTHEN # +schuelerausstatwuerfelentfernen;dr10.05.88#bereiteaenderungvorELSE +bereiteloeschenvor;mehrereloeschen:=TRUE FI ; +suvonerfassungsbildschirmeinlesenELSE zurueckschreiben:=FALSE ; +suzurueckzumanfangsbildschirm(2)FI .END PROC behandlungderausgesuchten;BOOL +PROC namenangabenausreichendbeierfassung:IF erfassungsfeld(fbs1)(fnrparamname +)=leerTHEN meldeauffaellig(maske(bs),meldungbittename);fnrfehlerfeld:= +fnrparamname;FALSE ELIF erfassungsfeld(fbs1)(fnrparamrufname)=leerCAND +erfassungsfeld(fbs1)(fnrparamgebdat)<>leerTHEN meldeauffaellig(maske(bs), +meldungangabengenauer);fnrfehlerfeld:=fnrparamrufname;FALSE ELSE TRUE FI . +END PROC namenangabenausreichendbeierfassung;BOOL PROC +namenangabenausreichendbeibearbeitungoderzeigen:IF erfassungsfeld(fbs1)( +fnrparambearbname)=leerTHEN meldeauffaellig(maske(bs),meldungbittename); +fnrfehlerfeld:=fnrparambearbname;FALSE ELIF erfassungsfeld(fbs1)( +fnrparambearbrufname)=leerCAND erfassungsfeld(fbs1)(fnrparambearbgebdat)<> +leerTHEN meldeauffaellig(maske(bs),meldungangabengenauer);fnrfehlerfeld:= +fnrparambearbrufname;FALSE ELSE TRUE FI .END PROC +namenangabenausreichendbeibearbeitungoderzeigen;PROC hjddateiupdate(INT +CONST dateinummer,wasistzutun):LET stackgroesse=6;INT VAR anzahltupel:= +stackgroesse;inittupel(dateinummer);putwert(dateinummer+1,alterschluessel(1)) +;putwert(dateinummer+2,alterschluessel(2));putwert(dateinummer+3, +datumskonversion(alterschluessel(3)));multisearchforward(dateinummer, +anzahltupel);WHILE anzahltupel>0REP multisucc;IF gleicherschuelerTHEN SELECT +wasistzutunOF CASE satzloeschen:datenloeschenCASE satzneueschluessel: +schluesselfelderaendernENDSELECT ;anzahltupelDECR 1;IF anzahltupel=0THEN +nachlesenFI ;ELSE LEAVE hjddateiupdateFI PER .gleicherschueler: +alterschluessel(1)=wert(dateinummer+1)CAND alterschluessel(2)=wert( +dateinummer+2)CAND alterschluessel(3)=datumrekonversion(wert(dateinummer+3)). +datenloeschen:delete(dateinummer);fehlerprotokoll(dateinummer,satzloeschen). +schluesselfelderaendern:putwert(dateinummer+1,schluessel(1));putwert( +dateinummer+2,schluessel(2));putwert(dateinummer+3,datumskonversion( +schluessel(3)));#update(dateinummer);dr10.05.88#selupdate(dateinummer); +fehlerprotokoll(dateinummer,satzneueschluessel);putwert(dateinummer+1, +alterschluessel(1));putwert(dateinummer+2,alterschluessel(2));putwert( +dateinummer+3,datumskonversion(alterschluessel(3)));.nachlesen:anzahltupel:= +stackgroesse;multisucc(dateinummer,anzahltupel).END PROC hjddateiupdate;PROC +fehlerprotokoll(INT CONST dateinummer,wasausdrucken):TEXT CONST fehlerdatei:= +"Fehlerprotokoll";ROW 4TEXT VAR fehlerwobei:=ROW 4TEXT :( +"Einfügen in die Datei ","Ändern in der Datei ","Löschen in der Datei ", +"Ändern der Schlüsselfelder der Datei ");IF dbstatus<>okTHEN FILE VAR f:= +sequentialfile(output,fehlerdatei);putline(f, +"Fehlerprotokoll zur Bearbeitung des Schülers:");putline(f,schluessel(2)+ +leerzeichen+schluessel(1)+", geboren am "+datumskonversion(schluessel(3))); +putline(f,leer);putline(f,"Fehler beim "+fehlerwobei[wasausdrucken]+name( +dateinummer));print(fehlerdatei);forget(fehlerdatei,quiet);FI END PROC +fehlerprotokoll;PROC diffdatenlesen:readtid(dnrdiffdaten,wert( +fnrsutiddiffdaten))END PROC diffdatenlesen;PROC +evtlaenderungderkurswahldatenvollziehen:IF dbstatus=0THEN IF aktbestand= +bestandlaufschuljTHEN IF intwert(fnrsusgrpjgst)>=jgstufe10THEN +kurswahlserveraktualisieren(wert(fnrsusgrpjgst),"","")FI ELIF aktbestand= +bestandneu11THEN kurswahlserveraktualisieren(text(jgstufe10),"","")ELIF +aktbestand=bestandneusonstTHEN IF intwert(fnrsujgsteintr)>jgstufe10THEN +kurswahlserveraktualisieren(text(intwert(fnrsujgsteintr)-1),"","")FI FI ;FI +END PROC evtlaenderungderkurswahldatenvollziehen;END PACKET erfschuelerdaten + diff --git a/app/schulis/2.2.1/src/1.halbjahresdaten bearbeiten b/app/schulis/2.2.1/src/1.halbjahresdaten bearbeiten new file mode 100644 index 0000000..3427981 --- /dev/null +++ b/app/schulis/2.2.1/src/1.halbjahresdaten bearbeiten @@ -0,0 +1,679 @@ +PACKET halbjahresdatenbearbeitenDEFINES halbjahresdatenbearbeiten, +halbjahresdatenblaettern,halbjahresdatenspeichern, +listezuhalbjahresdatenzeigen, +halbjahresdatenausgewaehlterschuelerbearbeitenvorbereiten, +halbjahresdatendesschuelersnichtbearbeiten, +halbjahresdatendesschuelersbearbeiten,halbjahresdatenentfernenvorbereiten, +halbjahresdatenentfernen,halbjahresdatennichtentfernen,pruefunghjd, +hjderfassungswert:LET maskennamebearb1="ms bearb halbjahresdaten 1", +maskennamebearb2="ms bearb halbjahresdaten 2",maskennameeingang= +"ms bearb halbjahresdaten 0",fnrname=2,fnrrufname=3,fnrgebdatum=4, +fnrgewschuljahr=5,fnrgewhalbjahr=6,fnrgewjgst=7,fnrabgangbestand=8, +fnrausgabename=2,fnrausgaberufname=3,fnrausgabegebdatum=4,fnrausgabeaktjgst=5 +,fnrausgabeaktzug=6,fnrausgabeabgegangen=7,fnrausgabegewschj=8, +fnrausgabegewhj=9,fnrausgabegewjgst=10,fnrausgabegewzug=11,fnrblbriefwarn=12, +fnrblbriefbem=13,fnrblbriefnwarn=14,fnrblbriefnbem=15,fnrversetzung=16, +fnrnachpr1=17,fnrnachpr2=18,fnrnachpr3=19,fnrnachprbem=20,fnrnachprabgelegt= +21,fnrnachprnote=22,fnrzeugbem1=23,fnrzeugbem2=24,fnrzeugbem3=25, +fnrversaeumtmit=26,fnrversaeumtohne=27,fnrverspaetet=28,fnrfachanf=12, +fnrfachende=24,fnrkursartanf=25,fnrkursartende=37,fnrklausuranf=38, +fnrklausurende=50,fnrkursanf=51,fnrkursende=63,fnrnoteanf=64,fnrnoteende=76, +fnrbemanf=77,fnrbemende=89,fnrwarnunganf=90,fnrwarnungende=102, +schueleraktuell="ls",schuelerabgegangen="abg",schulhalbjahr="Schulhalbjahr", +schuljahr="Schuljahr",bestandblauerbrief="c02 blauer brief", +bestandbemerkungen="c02 bemerkungen",bestandzeugnisnoten="c02 zeugnisnoten", +bestandartlv="c02 art lehrveranstaltung",trenner="�",stdplausileiste= +"0000000000000",paramausgabe="#",anzschluesselsu=3,fmeldnichtimbestand=55, +meldungnureinesderfaechererl=147,meldungfachangabeunzulaessig=310, +meldungversetzungskzunzulaessig=136,meldungwirklichloeschen=65, +meldunggibtsnicht=71,meldunghjdgibtsnicht=168,meldungunerlaubterwert=34, +meldunglistenerstellung=7,meldungkeineliste=68,meldungletzter=67, +meldungspeicherung=50,meldungkeinespeicherung=63,meldungfalschesdatum=157,# +meldungkeinewiederholungsdaten=160,#meldunghalbjahrnichtrelevant=161, +meldungungueltigekursart=164,meldungfeldfuellen=170,meldungschuljahrangeben= +171,meldungjgstangeben=172,meldungfalschejgst=173,meldungfalschefunktion=72, +meldungnichtentfernt=62,meldungentfernt=61,meldungspeicherfehler=73, +meldungvornamepraez=129,meldunginakthjkeineaenderung=379,pruefemeldung=57, +dateiname="Schülerliste",oblitrenner="$",leer="",niltext="",punkt=".", +textabgegangen="abgegangen",schrittefuerobjektliste=2,anzmasken=3,eingang=1, +bearb1=2,bearb2=3,maxfeldbearb0=8,maxfeldbearb1=28,maxfeldbearb2=102, +saetzederliste=17,pruefartdatum=6;BOOL VAR maskebearb1nochnichtda:=TRUE , +maskebearb2nochnichtda:=TRUE ,maskeeingangnochnichtda:=TRUE ,falschesdatum:= +FALSE ;BOOL VAR schuljahrgefuellt,halbjahrgefuellt,jgstgefuellt, +halbjahresdatenschonvorhanden;FILE VAR f;INT VAR fehlerfeld:=0,ind,bs, +posgewhalbjahr,fnrfehler,fehlerstatus,fmeld:=0,lv:=0,feldnummer:=0;ROW +anzschluesselsuTEXT VAR schluessel;ROW anzmaskenROW maxfeldbearb2TEXT VAR +erfassungsfeld;ROW anzmaskenTAG VAR maske;TEXT VAR sicherunghjd:="", +schuelertid:="",hjdtid:="",vergleichszeile:="",hjdfachleiste:="",hjdartleiste +:="",hjdklausurleiste:="",hjdkennungenleiste:="",verglfachleiste:="", +verglartleiste:="",verglklausurleiste:="",verglkennungenleiste:="",leiste, +plausivar:="",plausileiste:="",pruefbestand:="",plausitxt,akthalbjahr:="", +aktschuljahr:="",gewhalbjahr:="",gewschuljahr:="",jgst,zug,vglgewhalbjahr:="" +,vglakthalbjahr:="",gewjgst:="",gewzug:="",aktbestand,spalteninhalte,versetzg +:=trenner+trenner+"v"+trenner+"n"+trenner+"s"+trenner+"f"+trenner+"w"+trenner +,faecher:=trenner+trenner,blbrief:=trenner+trenner,bemerk:=trenner+trenner, +noten:=trenner+trenner,artlv:=trenner+trenner;LET logtextbeginn="Anw. 1.2.3 " +;PROC halbjahresdatenentfernen:standardmeldung(meldungentfernt,niltext); +infeld(fnrname);inittupel(dnrhalbjahresdaten);schluesselfuerhjdsetzen( +dnrhalbjahresdaten,schluessel,gewschuljahr,gewhalbjahr,gewjgst); +logeintragvornehmen("Entfernen");delete(dnrhalbjahresdaten);IF +aktuellesschulhalbjahrinbearbeitungTHEN loeschehjdtidinsu;FI ;enter(2). +loeschehjdtidinsu:inittupel(dnrschueler);putwert(fnrsufamnames,schluessel(1)) +;putwert(fnrsurufnames,schluessel(2));putwert(fnrsugebdatums,schluessel(3)); +search(dnrschueler,TRUE );putwert(fnrsutidakthjd,"");update(dnrschueler).END +PROC halbjahresdatenentfernen;PROC halbjahresdatennichtentfernen: +standardmeldung(meldungnichtentfernt,niltext);infeld(fnrname);return(2)END +PROC halbjahresdatennichtentfernen;PROC halbjahresdatenentfernenvorbereiten: +BOOL VAR suexistiert:=FALSE ;IF maskeeingangnochnichtdaTHEN bs:=1;initmaske( +maske(bs),maskennameeingang);init(bs,maxfeldbearb0);maskeeingangnochnichtda:= +FALSE FI ;IF erfassungsfeld(bs)(fnrname)<>""CAND erfassungsfeld(bs)( +fnrgebdatum)<>""CAND erfassungsfeld(bs)(fnrrufname)=""THEN meldungausgeben( +meldungvornamepraez,fnrrufname);LEAVE halbjahresdatenentfernenvorbereitenFI ; +schluesselbereitstellen;IF NOT falschesdatumTHEN pruefeobnameexistiert( +suexistiert);IF suexistiertTHEN bs:=1;holedbwerte(bs);schluessel(1):= +erfassungsfeld(bs)(fnrname);schluessel(2):=erfassungsfeld(bs)(fnrrufname); +schluessel(3):=datumskonversion(erfassungsfeld(eingang)(fnrgebdatum)); +weiterepruefungELSE meldungausgeben(meldunggibtsnicht,fnrname)FI ELSE +meldungausgeben(meldungfalschesdatum,fnrgebdatum)FI .weiterepruefung:jgst:= +jgstaufber(wert(fnrsusgrpjgst));zug:=wert(fnrsusgrpzugtut);akthalbjahr:= +schulkenndatum(schulhalbjahr);erfassungsfeld(bs)(fnrgewschuljahr):= +standardmaskenfeld(fnrgewschuljahr);erfassungsfeld(bs)(fnrgewhalbjahr):= +standardmaskenfeld(fnrgewhalbjahr);IF int(standardmaskenfeld(fnrgewjgst))=0 +THEN erfassungsfeld(bs)(fnrgewjgst):=niltext;gewjgst:=standardmaskenfeld( +fnrgewjgst);ELSE erfassungsfeld(bs)(fnrgewjgst):=jgstaufber( +standardmaskenfeld(fnrgewjgst));gewjgst:=jgstaufber(standardmaskenfeld( +fnrgewjgst));FI ;gewschuljahr:=standardmaskenfeld(fnrgewschuljahr); +gewhalbjahr:=standardmaskenfeld(fnrgewhalbjahr);fnrfehler:=0; +pruefenobeintraegefuerhjdausreichend;IF fnrfehler=0THEN IF eingabenummerisch( +gewschuljahr)CAND korrekteschuljahreseingabe(gewschuljahr)THEN +weiterevorbereitungnachfehlerpruefungELSE meldungausgeben( +meldungunerlaubterwert,fnrgewschuljahr)FI ELSE meldungausgeben( +meldungfeldfuellen,fnrfehler)FI .pruefenobeintraegefuerhjdausreichend: +schuljahrgefuellt:=standardmaskenfeld(fnrgewschuljahr)<>leer;halbjahrgefuellt +:=standardmaskenfeld(fnrgewhalbjahr)<>leer;jgstgefuellt:=standardmaskenfeld( +fnrgewjgst)<>leer;IF allefelderleerOR nurhalbjahrgefuelltTHEN fnrfehler:= +fnrgewschuljahrELIF nurschuljahrgefuelltOR nurjgstgefuelltOR +nurschuljahrundjgstgefuelltTHEN fnrfehler:=fnrgewhalbjahrFI .allefelderleer:( +NOT schuljahrgefuellt)CAND (NOT halbjahrgefuellt)CAND (NOT jgstgefuellt). +nurhalbjahrgefuellt:(NOT schuljahrgefuellt)CAND (halbjahrgefuellt)CAND (NOT +jgstgefuellt).nurschuljahrgefuellt:(schuljahrgefuellt)CAND (NOT +halbjahrgefuellt)CAND (NOT jgstgefuellt).nurjgstgefuellt:(NOT +schuljahrgefuellt)CAND (NOT halbjahrgefuellt)CAND (jgstgefuellt). +nurschuljahrundjgstgefuellt:(schuljahrgefuellt)CAND (NOT halbjahrgefuellt) +CAND (jgstgefuellt).weiterevorbereitungnachfehlerpruefung: +halbjahresdatenschonvorhanden:=FALSE ;IF allefeldergefuelltTHEN +angabevonsjhjjgstELIF nurschuljahrundhalbjahrgefuelltTHEN angabevonsjhjELIF +nurhalbjahrundjgstgefuelltTHEN angabevonhjjgstFI ;gibmaskemitrowaus(eingang, +fnrname,fnrabgangbestand).allefeldergefuellt:(schuljahrgefuellt)CAND ( +halbjahrgefuellt)CAND (jgstgefuellt).nurschuljahrundhalbjahrgefuellt:( +schuljahrgefuellt)CAND (halbjahrgefuellt)CAND (NOT jgstgefuellt). +nurhalbjahrundjgstgefuellt:(NOT schuljahrgefuellt)CAND (halbjahrgefuellt) +CAND (jgstgefuellt).angabevonsjhjjgst:jgst:=jgstaufber(wert(fnrsusgrpjgst)); +vglgewhalbjahr:=gewjgst+punkt+gewhalbjahr;vglakthalbjahr:=jgst+punkt+ +akthalbjahr;schuelerhjdlesen(dnrhalbjahresdaten,TRUE );IF +halbjahresdatenschonvorhandenTHEN loeschedatensatzELSE meldunghjdgibtesnicht +FI .angabevonsjhj:schuelerhjdlesen(dnrhalbjahresdaten,FALSE );IF +halbjahresdatenschonvorhandenTHEN savetupel(dnrhalbjahresdaten,sicherunghjd); +saveupdateposition(dnrhalbjahresdaten);gewjgst:=jgstaufber(wert(fnrhjdjgst)); +erfassungsfeld(eingang)(fnrgewjgst):=gewjgst;erfassungsfeld(bearb1)( +fnrausgabegewjgst):=gewjgst;loeschedatensatzELSE meldungausgeben( +meldungjgstangeben,fnrgewjgst)FI .angabevonhjjgst:schuelerhjdlesen( +ixhjdfamrufgebjgsthj,TRUE );IF halbjahresdatenschonvorhandenTHEN savetupel( +dnrhalbjahresdaten,sicherunghjd);saveupdateposition(dnrhalbjahresdaten); +gewschuljahr:=wert(fnrhjdsj);erfassungsfeld(eingang)(fnrgewschuljahr):=gew +schuljahr;erfassungsfeld(bearb1)(fnrausgabegewschj):=gewschuljahr;IF +wiederholungvorhanden(dnrhalbjahresdaten,ixhjdfamrufgebjgsthj)THEN +meldungbitteschuljahrangebenELSE restoreupdateposition(dnrhalbjahresdaten); +loeschedatensatzFI ELSE meldungbitteschuljahrangebenFI . +meldungbitteschuljahrangeben:meldungausgeben(meldungschuljahrangeben, +fnrgewschuljahr).meldunghjdgibtesnicht:meldungausgeben(meldunghjdgibtsnicht, +fnrgewschuljahr).loeschedatensatz:standardmaskenfeld(wert(fnrsufamnames), +fnrname);standardmaskenfeld(wert(fnrsurufnames),fnrrufname); +standardmaskenfeld(datumrekonversion(wert(fnrsugebdatums)),fnrgebdatum); +standardmaskenfeld(gewschuljahr,fnrgewschuljahr);standardmaskenfeld( +gewhalbjahr,fnrgewhalbjahr);standardmaskenfeld(gewjgst,fnrgewjgst);IF +aktbestand=schueleraktuellTHEN standardmaskenfeld("",fnrabgangbestand);ELSE +standardmaskenfeld("x",fnrabgangbestand);FI ;infeld(fnrname); +standardfelderausgeben;meldungausgebeneinfach(meldungwirklichloeschen,fnrname +).END PROC halbjahresdatenentfernenvorbereiten;PROC halbjahresdatenblaettern( +BOOL CONST b):IF bTHEN IF bs=2THEN blaetteraufbearb2ELSE fehlermeldungFI +ELSE IF bs=3THEN blaetteraufbearb1ELSE fehlermeldungFI FI .fehlermeldung: +standardmeldung(meldungfalschefunktion,"");return(1).blaetteraufbearb2: +merkeinhaltbearb1;gibbearb2maskeaus;gibinhaltebearb2aus;.merkeinhaltbearb1: +merkemaskeninhalt(bearb1,fnrausgabegewjgst,fnrverspaetet).gibbearb2maskeaus: +IF maskebearb2nochnichtdaTHEN initmaske(maske(bearb2),maskennamebearb2);init( +bearb2,maxfeldbearb2);FI ;standardstartproc(maskennamebearb2). +gibinhaltebearb2aus:bs:=3;fuellehjddateninfelder;maskebearb2nochnichtda:= +FALSE ;infeld(fnrausgabename);standardfelderausgeben;infeld(fnrfachanf); +return(1).blaetteraufbearb1:merkeinhaltbearb2;gibbearb1maskeaus; +gibinhaltebearb1aus.merkeinhaltbearb2:merkemaskeninhalt(bearb2,fnrfachanf, +fnrwarnungende).gibbearb1maskeaus:standardstartproc(maskennamebearb1). +gibinhaltebearb1aus:bs:=2;fuellehjddateninfelder;infeld(fnrausgabename); +standardfelderausgeben;IF akthalbjahr=gewhalbjahrCAND aktschuljahr= +gewschuljahrTHEN infeld(fnrblbriefwarn)ELSE infeld(fnrausgabegewjgst);FI ; +return(1).END PROC halbjahresdatenblaettern;PROC gibmaskemitrowaus(INT CONST +maske,vonfeld,bisfeld):INT VAR lv;FOR lvFROM vonfeldUPTO bisfeldREP +standardmaskenfeld(erfassungsfeld(maske)(lv),lv);PER END PROC +gibmaskemitrowaus;PROC merkemaskeninhalt(INT CONST maske,vonfeld,bisfeld): +INT VAR lv;FOR lvFROM vonfeldUPTO bisfeldREP erfassungsfeld(maske)(lv):= +standardmaskenfeld(lv);PER END PROC merkemaskeninhalt;PROC +halbjahresdatenbearbeiten:BOOL VAR suexistiert:=FALSE ;reinitparsing;bs:= +eingang;IF maskeeingangnochnichtdaTHEN initmaske(maske(bs),maskennameeingang) +;init(bs,maxfeldbearb0);maskeeingangnochnichtda:=FALSE FI ;erfassungsfeld(bs) +(fnrname):=standardmaskenfeld(fnrname);erfassungsfeld(bs)(fnrrufname):= +standardmaskenfeld(fnrrufname);erfassungsfeld(bs)(fnrgebdatum):= +standardmaskenfeld(fnrgebdatum);IF erfassungsfeld(bs)(fnrname)<>""CAND +erfassungsfeld(bs)(fnrgebdatum)<>""CAND erfassungsfeld(bs)(fnrrufname)="" +THEN meldungausgeben(meldungvornamepraez,fnrrufname);LEAVE +halbjahresdatenbearbeitenFI ;schluesselbereitstellen;IF NOT falschesdatum +THEN pruefeobnameexistiert(suexistiert);IF suexistiertTHEN +loeschedieerstellteobjektliste;holedbwerte(bs);schluessel(1):=erfassungsfeld( +bs)(fnrname);schluessel(2):=erfassungsfeld(bs)(fnrrufname);schluessel(3):= +datumskonversion(erfassungsfeld(bs)(fnrgebdatum));jgst:=jgstaufber(wert( +fnrsusgrpjgst));zug:=wert(fnrsusgrpzugtut);akthalbjahr:=schulkenndatum( +schulhalbjahr);aktschuljahr:=schulkenndatum(schuljahr); +halbjahresdatendesschuelersbearbeiten;ELSE meldungausgeben(meldunggibtsnicht, +fnrname)FI ELSE return(1)FI .END PROC halbjahresdatenbearbeiten;PROC +halbjahresdatendesschuelersbearbeiten:maskebearb1nochnichtda:=TRUE ; +maskebearb2nochnichtda:=TRUE ;erfassungsfeld(bs)(fnrgewschuljahr):= +standardmaskenfeld(fnrgewschuljahr);erfassungsfeld(bs)(fnrgewhalbjahr):= +standardmaskenfeld(fnrgewhalbjahr);IF int(standardmaskenfeld(fnrgewjgst))=0 +THEN erfassungsfeld(bs)(fnrgewjgst):=niltext;gewjgst:=standardmaskenfeld( +fnrgewjgst);ELSE erfassungsfeld(bs)(fnrgewjgst):=jgstaufber( +standardmaskenfeld(fnrgewjgst));gewjgst:=erfassungsfeld(bs)(fnrgewjgst)FI ; +gewschuljahr:=standardmaskenfeld(fnrgewschuljahr);gewhalbjahr:= +standardmaskenfeld(fnrgewhalbjahr);infeld(fnrname);gibmaskemitrowaus(eingang, +fnrname,fnrgewjgst);standardfelderausgeben;IF akthalbjahr=gewhalbjahrCAND +aktschuljahr=gewschuljahrTHEN IF erfassungsfeld(bs)(fnrgewjgst)<>niltextCAND +jgst<>gewjgstTHEN meldungausgeben(meldungfalschejgst,fnrgewjgst);LEAVE +halbjahresdatendesschuelersbearbeitenFI ;FI ; +pruefenobeintraegefuerhjdausreichend;#dr16.07.87#IF fnrfehler=0THEN IF +eingabenummerisch(gewschuljahr)CAND korrekteschuljahreseingabe(gewschuljahr) +THEN initmaske(maske(bs),maskennamebearb1);init(bearb1,maxfeldbearb1); +erfassungsfeld(bearb1)(fnrausgabename):=schluessel(1);erfassungsfeld(bearb1)( +fnrausgaberufname):=schluessel(2);erfassungsfeld(bearb1)(fnrausgabegebdatum) +:=erfassungsfeld(eingang)(fnrgebdatum);erfassungsfeld(bearb1)( +fnrausgabeaktjgst):=jgst;erfassungsfeld(bearb1)(fnrausgabeaktzug):=zug;IF +aktbestand="ls"THEN erfassungsfeld(bearb1)(fnrausgabeabgegangen):= +" "ELSE erfassungsfeld(bearb1)(fnrausgabeabgegangen):="abgegangen" +FI ;erfassungsfeld(bearb1)(fnrausgabegewschj):=gewschuljahr;erfassungsfeld( +bearb1)(fnrausgabegewhj):=gewhalbjahr;erfassungsfeld(bearb1)( +fnrausgabegewjgst):=gewjgst;weiterevorbereitungnachfehlerpruefungELSE +meldungausgeben(meldungunerlaubterwert,fnrgewschuljahr)FI ELSE +meldungausgeben(meldungfeldfuellen,fnrfehler)FI . +pruefenobeintraegefuerhjdausreichend:fnrfehler:=0;schuljahrgefuellt:= +standardmaskenfeld(fnrgewschuljahr)<>leer;halbjahrgefuellt:= +standardmaskenfeld(fnrgewhalbjahr)<>leer;jgstgefuellt:=standardmaskenfeld( +fnrgewjgst)<>leer;IF allefelderleerOR nurhalbjahrgefuelltTHEN fnrfehler:= +fnrgewschuljahrELIF nurschuljahrgefuelltOR nurjgstgefuelltOR +nurschuljahrundjgstgefuelltTHEN fnrfehler:=fnrgewhalbjahrFI .allefelderleer:( +NOT schuljahrgefuellt)CAND (NOT halbjahrgefuellt)CAND (NOT jgstgefuellt). +nurhalbjahrgefuellt:(NOT schuljahrgefuellt)CAND (halbjahrgefuellt)CAND (NOT +jgstgefuellt).nurschuljahrgefuellt:(schuljahrgefuellt)CAND (NOT +halbjahrgefuellt)CAND (NOT jgstgefuellt).nurjgstgefuellt:(NOT +schuljahrgefuellt)CAND (NOT halbjahrgefuellt)CAND (jgstgefuellt). +nurschuljahrundjgstgefuellt:(schuljahrgefuellt)CAND (NOT halbjahrgefuellt) +CAND (jgstgefuellt).weiterevorbereitungnachfehlerpruefung: +halbjahresdatenschonvorhanden:=FALSE ;IF allefeldergefuelltTHEN +angabevonsjhjjgstELIF nurschuljahrundhalbjahrgefuelltTHEN angabevonsjhjELIF +nurhalbjahrundjgstgefuelltTHEN angabevonhjjgstFI ;gibmaskemitrowaus(bearb1, +fnrname,fnrabgangbestand).allefeldergefuellt:(schuljahrgefuellt)CAND ( +halbjahrgefuellt)CAND (jgstgefuellt).nurschuljahrundhalbjahrgefuellt:( +schuljahrgefuellt)CAND (halbjahrgefuellt)CAND (NOT jgstgefuellt). +nurhalbjahrundjgstgefuellt:(NOT schuljahrgefuellt)CAND (halbjahrgefuellt) +CAND (jgstgefuellt).angabevonsjhjjgst:IF halbjahrrelevantTHEN +schuelerhjdlesen(dnrhalbjahresdaten,TRUE );IF halbjahresdatenschonvorhanden +THEN savetupel(dnrhalbjahresdaten,sicherunghjd);saveupdateposition( +dnrhalbjahresdaten);IF passendejgstTHEN aenderungsvorbereitungELSE +meldungausgeben(meldungfalschejgst,fnrgewjgst);LEAVE +halbjahresdatendesschuelersbearbeitenFI ;ELSE aenderungsvorbereitungFI ;ELSE +meldungausgeben(meldunghalbjahrnichtrelevant,fnrgewjgst);LEAVE +halbjahresdatendesschuelersbearbeitenFI .passendejgst:int(gewjgst)=intwert( +fnrhjdjgst).angabevonsjhj:schuelerhjdlesen(dnrhalbjahresdaten,FALSE );IF +halbjahresdatenschonvorhandenTHEN savetupel(dnrhalbjahresdaten,sicherunghjd); +saveupdateposition(dnrhalbjahresdaten);gewjgst:=jgstaufber(wert(fnrhjdjgst)); +erfassungsfeld(eingang)(fnrgewjgst):=gewjgst;erfassungsfeld(bearb1)( +fnrausgabegewjgst):=gewjgst;infeld(fnrgewjgst);standardmaskenfeld(gewjgst, +fnrgewjgst);standardfelderausgeben;vglgewhalbjahr:=gewjgst+punkt+gewhalbjahr; +vglakthalbjahr:=jgst+punkt+akthalbjahr;aenderungsvorbereitungELIF akthalbjahr +=gewhalbjahrCAND aktschuljahr=gewschuljahrTHEN infeld(fnrgewjgst); +standardmaskenfeld(jgst,fnrgewjgst);standardfelderausgeben;erfassungsfeld( +bearb1)(fnrausgabegewjgst):=jgst;vglgewhalbjahr:=gewjgst+punkt+gewhalbjahr; +vglakthalbjahr:=jgst+punkt+akthalbjahr;aenderungsvorbereitungELSE +meldungausgeben(meldungjgstangeben,fnrgewjgst);LEAVE +halbjahresdatendesschuelersbearbeitenFI .angabevonhjjgst:IF halbjahrrelevant +THEN schuelerhjdlesen(ixhjdfamrufgebjgsthj,TRUE );IF +halbjahresdatenschonvorhandenTHEN savetupel(dnrhalbjahresdaten,sicherunghjd); +saveupdateposition(dnrhalbjahresdaten);gewschuljahr:=wert(fnrhjdsj); +erfassungsfeld(eingang)(fnrgewschuljahr):=gewschuljahr;erfassungsfeld(bearb1) +(fnrausgabegewschj):=gewschuljahr;IF wiederholungvorhanden(dnrhalbjahresdaten +,ixhjdfamrufgebjgsthj)THEN meldungbitteschuljahrangeben;LEAVE +halbjahresdatendesschuelersbearbeitenELSE infeld(fnrgewschuljahr); +standardmaskenfeld(gewschuljahr,fnrgewschuljahr);standardfelderausgeben; +aenderungsvorbereitungFI ELSE meldungbitteschuljahrangeben;LEAVE +halbjahresdatendesschuelersbearbeitenFI ELSE meldungausgeben( +meldunghalbjahrnichtrelevant,fnrgewjgst);LEAVE +halbjahresdatendesschuelersbearbeitenFI .meldungbitteschuljahrangeben: +meldungausgeben(meldungschuljahrangeben,fnrgewschuljahr). +aenderungsvorbereitung:standardstartproc(maskennamebearb1);bs:=bearb1;IF +maskebearb1nochnichtdaTHEN maskebearb1nochnichtda:=FALSE FI ; +bereiteaenderungvor.halbjahrrelevant:vglgewhalbjahr:=gewjgst+punkt+ +gewhalbjahr;vglakthalbjahr:=jgst+punkt+akthalbjahr;lieferehalbjahreszeile( +vergleichszeile,vglakthalbjahr);posgewhalbjahr:=pos(vergleichszeile, +vglgewhalbjahr);posgewhalbjahr>0.END PROC +halbjahresdatendesschuelersbearbeiten;PROC meldungausgeben(INT CONST welche, +fehlerfeld):standardmeldung(welche,niltext);infeld(fehlerfeld);return(1)END +PROC meldungausgeben;PROC meldungausgebeneinfach(INT CONST welche,fehlerfeld) +:standardmeldung(welche,niltext);infeld(fehlerfeld);standardnprocEND PROC +meldungausgebeneinfach;PROC schluesselbereitstellen:falschesdatum:=FALSE ; +fehlerfeld:=0;schluessel(1):=standardmaskenfeld(fnrname);schluessel(2):= +standardmaskenfeld(fnrrufname);schluessel(3):=datumrekonversion( +standardmaskenfeld(fnrgebdatum));IF standardmaskenfeld(fnrgebdatum)<>niltext +THEN pruefe(pruefartdatum,maske(bs),TEXT PROC (INT CONST )hjderfassungswert, +fnrgebdatum,0,0,niltext,fehlerfeld);IF fehlerfeld<>0THEN infeld(fehlerfeld); +falschesdatum:=TRUE ;FI FI ;IF NOT falschesdatumTHEN legeaktuellenbestandfest +FI .END PROC schluesselbereitstellen;PROC legeaktuellenbestandfest: +erfassungsfeld(bs)(fnrabgangbestand):=standardmaskenfeld(fnrabgangbestand); +IF standardmaskenfeld(fnrabgangbestand)=""THEN aktbestand:=schueleraktuell +ELSE aktbestand:=schuelerabgegangenFI END PROC legeaktuellenbestandfest;PROC +pruefeobnameexistiert(BOOL VAR suexist):TEXT VAR datenbankwerte, +schluesselwerte;inittupel(dnrschueler);maskenwerteindatenbank;IF NOT +falschesdatumTHEN search(ixsustatfamrufgeb,FALSE );IF dbstatus=okCAND wert( +fnrsustatuss)=aktbestandTHEN schuelertid:=gettid;hjdtid:=wert(fnrsutidakthjd) +;datenbankwerte:=wert(fnrsurufnames)+datumrekonversion(wert(fnrsugebdatums)); +schluesselwerte:=schluessel(2)+schluessel(3);suexist:=(wert(fnrsufamnames)= +schluessel(1)CAND ((schluessel(2)=leerAND schluessel(3)=leer)OR (pos( +datenbankwerte,schluesselwerte)=1)))ELSE suexist:=FALSE FI FI .END PROC +pruefeobnameexistiert;PROC maskenwerteindatenbank:putwert(fnrsufamnames, +schluessel(1));putwert(fnrsurufnames,schluessel(2));disablestop;putwert( +fnrsugebdatums,datumskonversion(schluessel(3)));IF iserrorTHEN clearerror; +standardmeldung(meldungfalschesdatum,"");infeld(fnrgebdatum);falschesdatum:= +TRUE ;ELSE putwert(fnrsustatuss,aktbestand);FI ;enablestopEND PROC +maskenwerteindatenbank;PROC bereiteaenderungvor:IF +halbjahresdatenschonvorhandenTHEN restoretupel(dnrhalbjahresdaten, +sicherunghjd);holedbwerte(bearb1);FI ;IF aktuelleshalbjahrTHEN IF NOT +halbjahresdatenschonvorhandenTHEN erfassungsfeld(bearb1)(fnrausgabegewzug):= +zug;FI ;fuellehjddateninfelder;infeld(fnrausgabename);standardfelderausgeben; +infeld(fnrblbriefwarn)ELSE IF NOT halbjahresdatenschonvorhandenTHEN +erfassungsfeld(bearb1)(fnrausgabegewzug):=gewzug;FI ;fuellehjddateninfelder; +infeld(fnrausgabename);standardfelderausgeben;infeld(fnrausgabegewjgst)FI ; +standardnproc.aktuelleshalbjahr:akthalbjahr=gewhalbjahrCAND aktschuljahr= +gewschuljahr.END PROC bereiteaenderungvor;BOOL PROC wiederholungvorhanden( +INT CONST dnr,index):ROW 5TEXT VAR feld;feld(1):=wert(dnr+1);feld(2):=wert( +dnr+2);feld(3):=wert(dnr+3);feld(4):=wert(dnr+5);feld(5):=wert(dnr+6);succ( +index);dbstatus=okCAND feld(1)=wert(dnr+1)CAND feld(2)=wert(dnr+2)CAND feld(3 +)=wert(dnr+3)CAND feld(4)=wert(dnr+5)CAND feld(5)=wert(dnr+6).END PROC +wiederholungvorhanden;PROC fuellehjddateninfelder:IF bs=2THEN +gibmaskemitrowaus(bearb1,fnrname,fnrverspaetet);ELSE gibmaskemitrowaus(bearb1 +,fnrname,fnrausgabegewzug);IF maskebearb2nochnichtdaTHEN fachfuellen; +artfuellen;klausurfuellen;kursfuellen;notefuellen;bemfuellen;warnungfuellen; +ELSE gibmaskemitrowaus(bearb2,fnrfachanf,fnrwarnungende)FI FI .fachfuellen: +hjdfachleiste:=wert(fnrhjdfach);FOR indFROM 0UPTO (fnrfachende-fnrfachanf) +REP standardmaskenfeld(wert(fnrhjdfach,(ind*2+1),2),(fnrfachanf+ind))PER . +artfuellen:hjdartleiste:=wert(fnrhjdkursart);FOR indFROM 0UPTO ( +fnrkursartende-fnrkursartanf)REP standardmaskenfeld(wert(fnrhjdkursart,(ind*2 ++1),2),(fnrkursartanf+ind))PER .klausurfuellen:hjdklausurleiste:=wert( +fnrhjdklausurteiln);FOR indFROM 0UPTO (fnrklausurende-fnrklausuranf)REP +standardmaskenfeld(wert(fnrhjdklausurteiln,(ind+1),1),(fnrklausuranf+ind)) +PER .kursfuellen:TEXT VAR klzeichen;hjdkennungenleiste:=wert( +fnrhjdlerngrpkenn);FOR indFROM 0UPTO (fnrkursende-fnrkursanf)REP +standardmaskenfeld(wert(fnrhjdlerngrpkenn,(4*ind+1),4),(fnrkursanf+ind))PER . +notefuellen:FOR indFROM 0UPTO (fnrnoteende-fnrnoteanf)REP standardmaskenfeld( +wert(fnrhjdnotepunkte,(2*ind+1),2),(fnrnoteanf+ind))PER .bemfuellen:FOR ind +FROM 0UPTO (fnrbemende-fnrbemanf)REP standardmaskenfeld(wert(fnrhjdbemerk,(3* +ind+1),3),(fnrbemanf+ind))PER .warnungfuellen:FOR indFROM 0UPTO ( +fnrwarnungende-fnrwarnunganf)REP standardmaskenfeld(wert(fnrhjdvermwarnung,( +ind+1),1),(fnrwarnunganf+ind))PER .END PROC fuellehjddateninfelder;PROC +loeschedieerstellteobjektliste:forget(dateiname,quiet);END PROC +loeschedieerstellteobjektliste;PROC schuelerhjdlesen(INT CONST index,BOOL +CONST jgstgesetzt):IF jgstgesetztTHEN IF aktuellesschulhalbjahrinbearbeitung +THEN IF hjdtid<>leerTHEN readtid(dnrhalbjahresdaten,hjdtid); +halbjahresdatenschonvorhanden:=dbstatus=0ELSE inittupel(dnrhalbjahresdaten); +halbjahresdatenschonvorhanden:=FALSE FI ELSE richtigsuchenundlesenFI ELSE +richtigsuchenundlesenFI ;IF halbjahresdatenschonvorhandenAND wert( +fnrhjdkennung)<>""THEN gewzug:=wert(fnrhjdkennung)ELSE gewzug:=""FI . +richtigsuchenundlesen:inittupel(dnrhalbjahresdaten);schluesselfuerhjdsetzen( +dnrhalbjahresdaten,schluessel,gewschuljahr,gewhalbjahr,gewjgst);search(index, +TRUE );halbjahresdatenschonvorhanden:=dbstatus=0.END PROC schuelerhjdlesen; +PROC halbjahresdatenspeichern(BOOL CONST speichern):INT VAR aktjg:=int(jgst); +IF speichernTHEN IF faecher=trenner+trennerTHEN holeaktdatenFI ;fehlerstatus +:=0;merkeinhaltdesaktuellenschirms;pruefeplausibilitaet(fehlerstatus);IF +datenfehlerfreiTHEN standardmeldung(meldungspeicherung,"");datenspeichern;# +eventuellinstatwuerfeleintragen;dr11.05.88# +ueberpruefobkurswahlbasisnochaktuell; +vorbereitendernaechstenschluesselbehandlung(2)ELSE return(1)FI ELSE +standardmeldung(meldungkeinespeicherung,""); +vorbereitendernaechstenschluesselbehandlung(2)FI . +ueberpruefobkurswahlbasisnochaktuell:IF NOT maskebearb2nochnichtdaTHEN IF +sek2jgstTHEN IF aktoderzukhjTHEN IF aenderunginkurswahldatenTHEN +loeschspezkurswahlbasisFI FI FI FI .sek2jgst:aktjg>9.aktoderzukhj:(int( +gewjgst)=aktjgCAND int(gewhalbjahr)>=int(akthalbjahr))COR int(gewjgst)>aktjg. +aenderunginkurswahldaten:hjdfachleiste<>verglfachleisteCOR hjdartleiste<> +verglartleisteCOR hjdklausurleiste<>verglklausurleisteCOR hjdkennungenleiste +<>verglkennungenleiste.loeschspezkurswahlbasis:kurswahlserveraktualisieren( +jgst,gewjgst,gewhalbjahr).holeaktdaten:holeblbrief;holebemerk;holenoten; +holefaecher;holeartlv.holeblbrief:inittupel(dnrschluessel);statleseschleife( +dnrschluessel,bestandblauerbrief,"",fnrschlsachgebiet,fnrschlschluessel,PROC +briefcat).holebemerk:inittupel(dnrschluessel);statleseschleife(dnrschluessel, +bestandbemerkungen,"",fnrschlsachgebiet,fnrschlschluessel,PROC bemerkcat). +holenoten:inittupel(dnrschluessel);statleseschleife(dnrschluessel, +bestandzeugnisnoten,"",fnrschlsachgebiet,fnrschlschluessel,PROC notencat). +holefaecher:inittupel(dnrfaecher);statleseschleife(dnrfaecher,"","",fnrffach, +fnrffachbez,PROC fachcat).holeartlv:inittupel(dnrschluessel);statleseschleife +(dnrschluessel,bestandartlv,"",fnrschlsachgebiet,fnrschlschluessel,PROC +artcat).merkeinhaltdesaktuellenschirms:IF bs=2THEN merkemaskeninhalt(bearb1, +fnrausgabegewjgst,fnrverspaetet)ELSE merkemaskeninhalt(bearb2,fnrfachanf, +fnrwarnungende);FI .datenfehlerfrei:fehlerstatus=0.datenspeichern:IF +halbjahresdatenschonvorhandenTHEN logeintragvornehmen("Änderung"); +datenaendernELSE logeintragvornehmen("Neueinfügen");schluesselsetzen( +dnrhalbjahresdaten);dateneinfuegenFI .datenaendern:dbwertesetzen; +restoreupdateposition(dnrhalbjahresdaten);selupdate(dnrhalbjahresdaten); +statusabfrage.dateneinfuegen:dbwertesetzen;insert(dnrhalbjahresdaten); +statusabfrage;IF dbstatus=ok#dr11.05.88#THEN hjdtid:=gettid; +eventuellneueshjdtideintragenFI .END PROC halbjahresdatenspeichern;PROC +logeintragvornehmen(TEXT CONST logergaenzung):TEXT VAR eintrag:=logtextbeginn +;eintragCAT logergaenzung;eintragCAT " """;eintragCAT schluessel(1);eintrag +CAT ", ";eintragCAT schluessel(2);eintragCAT ", ";eintragCAT schluessel(3); +eintragCAT """";logeintrag(eintrag)END PROC logeintragvornehmen;PROC fachcat( +BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE faecherCAT wert(fnrffach);faecher +CAT trennerFI END PROC fachcat;PROC artcat(BOOL VAR b):IF wert( +fnrschlsachgebiet)>bestandartlvCOR dbstatus<>0THEN b:=TRUE ELSE artlvCAT wert +(fnrschlschluessel);artlvCAT trennerFI END PROC artcat;PROC briefcat(BOOL +VAR b):IF wert(fnrschlsachgebiet)>bestandblauerbriefCOR dbstatus<>0THEN b:= +TRUE ELSE blbriefCAT wert(fnrschlschluessel);blbriefCAT trennerFI END PROC +briefcat;PROC bemerkcat(BOOL VAR b):IF wert(fnrschlsachgebiet)> +bestandbemerkungenCOR dbstatus<>0THEN b:=TRUE ELSE bemerkCAT wert( +fnrschlschluessel);bemerkCAT trennerFI END PROC bemerkcat;PROC notencat(BOOL +VAR b):IF wert(fnrschlsachgebiet)>bestandzeugnisnotenCOR dbstatus<>0THEN b:= +TRUE ELSE notenCAT wert(fnrschlschluessel);notenCAT trennerFI END PROC +notencat;PROC statusabfrage:IF dbstatus<>0THEN standardmeldung( +meldungspeicherfehler,text(dbstatus)+paramausgabe);pauseFI .END PROC +statusabfrage;PROC schluesselsetzen(INT CONST dateinummer): +schluesselfuerhjdsetzen(dateinummer,schluessel,gewschuljahr,gewhalbjahr, +gewjgst)END PROC schluesselsetzen;PROC dbwertesetzen:INT VAR lv;IF bs=2THEN +datenbearb1vombsholen;datenbearb2setzenELSE datenbearb1setzen; +datenbearb2vombsholenFI .datenbearb1vombsholen:FOR lvFROM fnrausgabegewjgst +UPTO fnrverspaetetREP erfassungsfeld(bearb1)(lv):=standardmaskenfeld(lv)PER ; +setzedbwerte(bearb1);setzekennung;.setzekennung:IF +aktuellesschulhalbjahrinbearbeitungTHEN putwert(fnrhjdkennung,compress(zug)) +FI .datenbearb2setzen:IF NOT maskebearb2nochnichtdaTHEN setzedbwerte(bearb2) +FI .datenbearb1setzen:setzedbwerte(bearb1).datenbearb2vombsholen:fachsetzen; +artsetzen;klausursetzen;kurssetzen;notesetzen;bemerksetzen;kurswarnungsetzen. +fachsetzen:spalteninhalte:="";FOR indFROM fnrfachanfUPTO fnrfachendeREP +plausivar:=standardmaskenfeld(ind);IF compress(plausivar)<>""THEN +spalteninhalteCAT text(plausivar,2)FI ;PER ;putwert(fnrhjdfach,spalteninhalte +).artsetzen:spalteninhalte:="";FOR indFROM fnrkursartanfUPTO fnrkursartende +REP IF (plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text( +standardmaskenfeld(ind),2)FI ;PER ;putwert(fnrhjdkursart,spalteninhalte). +klausursetzen:spalteninhalte:="";FOR indFROM fnrklausuranfUPTO fnrklausurende +REP IF (plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text( +standardmaskenfeld(ind),1)FI ;PER ;putwert(fnrhjdklausurteiln,spalteninhalte) +.kurssetzen:spalteninhalte:="";FOR indFROM fnrkursanfUPTO fnrkursendeREP IF ( +plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text( +standardmaskenfeld(ind),4)FI ;PER ;putwert(fnrhjdlerngrpkenn,spalteninhalte). +notesetzen:spalteninhalte:="";FOR indFROM fnrnoteanfUPTO fnrnoteendeREP IF ( +plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text( +standardmaskenfeld(ind),2)FI ;PER ;putwert(fnrhjdnotepunkte,spalteninhalte). +bemerksetzen:spalteninhalte:="";FOR indFROM fnrbemanfUPTO fnrbemendeREP IF ( +plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text( +standardmaskenfeld(ind),3)FI ;PER ;putwert(fnrhjdbemerk,spalteninhalte). +kurswarnungsetzen:spalteninhalte:="";FOR indFROM fnrwarnunganfUPTO +fnrwarnungendeREP IF (plausileisteSUB ((ind+1)MOD 13+1))="1"THEN +spalteninhalteCAT text(standardmaskenfeld(ind),1)FI ;PER ;putwert( +fnrhjdvermwarnung,spalteninhalte).END PROC dbwertesetzen;PROC +vorbereitendernaechstenschluesselbehandlung(INT CONST rueckschritte):IF +exists(dateiname)THEN holenaechstenschluesselauslisteELSE enter(2)FI . +holenaechstenschluesselausliste:BOOL VAR ok,kannbearbeitetwerden:=FALSE ; +holenaechstenmehrtlgschluesselausdatei(ok);WHILE okREP pruefeobnameexistiert( +ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE +holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerden +THEN bereiteeingangsmaskefuerausgewaehltenvor;return(rueckschritte)ELSE +behandleendederlistenabarbeitungFI .behandleendederlistenabarbeitung: +standardmeldung(meldungletzter,"");enter(rueckschritte+ +schrittefuerobjektliste).END PROC vorbereitendernaechstenschluesselbehandlung +;PROC bereiteeingangsmaskefuerausgewaehltenvor:standardstartproc( +maskennameeingang);bs:=eingang;IF maskeeingangnochnichtdaTHEN initmaske(maske +(bs),maskennameeingang);init(bs,maxfeldbearb0);maskeeingangnochnichtda:= +FALSE FI ;jgst:=wert(fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut);akthalbjahr:= +schulkenndatum(schulhalbjahr);fuellemaskenfeldereingang;gibmaskemitrowaus( +eingang,fnrname,fnrabgangbestand);infeld(fnrname);standardfelderausgeben; +setzefeldschutz;infeld(fnrgewschuljahr)END PROC +bereiteeingangsmaskefuerausgewaehltenvor;PROC pruefeplausibilitaet(INT VAR +fstatus):fmeld:=0;feldnummer:=0;pruefbestand:="";fstatus:=0;standardmeldung( +pruefemeldung,"");pruefeplausibilitaetbearb1;IF NOT maskebearb2nochnichtda +THEN pruefeplausibilitaetbearb2FI .fehlerbehandlungbearb1:IF bs=3THEN +standardstartproc(maskennamebearb1);bs:=2;fuellehjddateninfelder;infeld( +fnrausgabename);standardfelderausgeben;FI ;fehlerausgabespeziell;infeld( +fstatus);LEAVE pruefeplausibilitaet.fehlerausgabespeziell:IF fmeld= +meldungversetzungskzunzulaessigTHEN standardmeldung(fmeld,erfassungsfeld( +bearb1)(fnrversetzung)+paramausgabe);ELIF fmeld=meldungnureinesderfaechererl +THEN standardmeldung(fmeld,plausitxt+paramausgabe);ELIF fmeld= +meldunginakthjkeineaenderungTHEN standardmeldung(fmeld,erfassungsfeld(bearb1) +(fnrrufname)+" "+erfassungsfeld(bearb1)(fnrname)+paramausgabe+jgst+zug+ +paramausgabe)ELSE standardmeldung(fmeld,"")FI .fehlerbehandlungbearb2:IF bs=2 +THEN standardstartproc(maskennamebearb2);bs:=3;fuellehjddateninfelder;infeld( +fnrausgabename);standardfelderausgeben;FI ;fehlerausgabe;LEAVE +pruefeplausibilitaet.fehlerausgabe:infeld(fstatus);standardmeldung(fmeld,""). +pruefeplausibilitaetbearb1:IF erfassungsfeld(bearb1)(fnrausgabegewjgst)="" +THEN fstatus:=fnrausgabegewjgst;fmeld:=meldungjgstangeben; +fehlerbehandlungbearb1ELIF erfassungsfeld(bearb1)(fnrausgabegewzug)=""THEN +fstatus:=fnrausgabegewzug;fmeld:=meldungfeldfuellen;fehlerbehandlungbearb1 +ELIF erfassungsfeld(bearb1)(fnrausgabegewjgst)<>jgstCAND aktuellessjhjTHEN +fstatus:=fnrausgabegewjgst;fmeld:=meldunginakthjkeineaenderung; +fehlerbehandlungbearb1ELIF erfassungsfeld(bearb1)(fnrausgabegewzug)<>zugCAND +aktuellessjhjTHEN fstatus:=fnrausgabegewzug;fmeld:= +meldunginakthjkeineaenderung;fehlerbehandlungbearb1ELSE gewjgst:=jgstaufber( +erfassungsfeld(bearb1)(fnrausgabegewjgst));vglgewhalbjahr:=gewjgst+punkt+ +gewhalbjahr;vglakthalbjahr:=jgst+punkt+akthalbjahr;lieferehalbjahreszeile( +vergleichszeile,vglakthalbjahr);posgewhalbjahr:=pos(vergleichszeile, +vglgewhalbjahr);IF posgewhalbjahr<1THEN fstatus:=fnrausgabegewjgst;fmeld:= +meldunghalbjahrnichtrelevant;fehlerbehandlungbearb1FI ;FI ;IF pos(blbrief, +trenner+erfassungsfeld(bearb1)(fnrblbriefwarn)+trenner)<1THEN fstatus:= +fnrblbriefwarn;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;IF pos( +blbrief,trenner+erfassungsfeld(bearb1)(fnrblbriefnwarn)+trenner)<1THEN +fstatus:=fnrblbriefnwarn;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI +;IF pos(bemerk,trenner+erfassungsfeld(bearb1)(fnrblbriefbem)+trenner)<1THEN +fstatus:=fnrblbriefbem;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ; +IF pos(bemerk,trenner+erfassungsfeld(bearb1)(fnrblbriefnbem)+trenner)<1THEN +fstatus:=fnrblbriefnbem;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ; +IF pos(versetzg,trenner+erfassungsfeld(bearb1)(fnrversetzung)+trenner)<1THEN +fstatus:=fnrversetzung;fmeld:=meldungversetzungskzunzulaessig; +fehlerbehandlungbearb1FI ;IF pos(faecher,trenner+erfassungsfeld(bearb1)( +fnrnachpr1)+trenner)<1THEN fstatus:=fnrnachpr1;fmeld:= +meldungfachangabeunzulaessig;fehlerbehandlungbearb1FI ;IF pos(faecher,trenner ++erfassungsfeld(bearb1)(fnrnachpr2)+trenner)<1THEN fstatus:=fnrnachpr2;fmeld +:=meldungfachangabeunzulaessig;fehlerbehandlungbearb1FI ;IF pos(faecher, +trenner+erfassungsfeld(bearb1)(fnrnachpr3)+trenner)<1THEN fstatus:=fnrnachpr3 +;fmeld:=meldungfachangabeunzulaessig;fehlerbehandlungbearb1FI ;IF pos(bemerk, +trenner+erfassungsfeld(bearb1)(fnrnachprbem)+trenner)<1THEN fstatus:= +fnrnachprbem;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;plausitxt:= +"";plausitxtCAT trenner;plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr1); +plausitxtCAT trenner;plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr2); +plausitxtCAT trenner;plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr3); +plausitxtCAT trenner;IF pos(plausitxt,trenner+erfassungsfeld(bearb1)( +fnrnachprabgelegt)+trenner)<1THEN plausitxt:="";IF erfassungsfeld(bearb1)( +fnrnachpr1)<>""THEN plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr1);FI ;IF +erfassungsfeld(bearb1)(fnrnachpr2)<>""THEN plausitxtCAT ",";plausitxtCAT +erfassungsfeld(bearb1)(fnrnachpr2);FI ;IF erfassungsfeld(bearb1)(fnrnachpr3) +<>""THEN plausitxtCAT ",";plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr3);FI +;fstatus:=fnrnachprabgelegt;fmeld:=meldungnureinesderfaechererl; +fehlerbehandlungbearb1FI ;IF pos(noten,trenner+erfassungsfeld(bearb1)( +fnrnachprnote)+trenner)<1THEN fstatus:=fnrnachprnote;fmeld:= +fmeldnichtimbestand;fehlerbehandlungbearb1FI ;IF pos(bemerk,trenner+ +erfassungsfeld(bearb1)(fnrzeugbem1)+trenner)<1THEN fstatus:=fnrzeugbem1;fmeld +:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;IF pos(bemerk,trenner+ +erfassungsfeld(bearb1)(fnrzeugbem2)+trenner)<1THEN fstatus:=fnrzeugbem2;fmeld +:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;IF pos(bemerk,trenner+ +erfassungsfeld(bearb1)(fnrzeugbem3)+trenner)<1THEN fstatus:=fnrzeugbem3;fmeld +:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;plausitxt:=erfassungsfeld( +bearb1)(fnrversaeumtmit);IF plausitxt<>""CAND plausitxt<>"0"THEN IF int( +plausitxt)=0THEN fstatus:=fnrversaeumtmit;fmeld:=meldungunerlaubterwert; +fehlerbehandlungbearb1FI FI ;plausitxt:=erfassungsfeld(bearb1)( +fnrversaeumtohne);IF plausitxt<>""CAND plausitxt<>"0"THEN IF int(plausitxt)=0 +THEN fstatus:=fnrversaeumtohne;fmeld:=meldungunerlaubterwert; +fehlerbehandlungbearb1FI FI ;plausitxt:=erfassungsfeld(bearb1)(fnrverspaetet) +;IF plausitxt<>""CAND plausitxt<>"0"THEN IF int(plausitxt)=0THEN fstatus:= +fnrverspaetet;fmeld:=meldungunerlaubterwert;fehlerbehandlungbearb1FI FI . +aktuellessjhj:akthalbjahr=gewhalbjahrCAND aktschuljahr=gewschuljahr. +pruefeplausibilitaetbearb2:verglfachleiste:="";verglartleiste:=""; +verglklausurleiste:="";verglkennungenleiste:="";plausileiste:=stdplausileiste +;FOR lvFROM 0UPTO fnrfachende-fnrfachanfREP plausitxt:=erfassungsfeld(bearb2) +(fnrfachanf+lv);IF plausitxt<>""THEN replace(plausileiste,lv+1,"1"); +verglfachleisteCAT text(plausitxt,2);IF pos(faecher,trenner+plausitxt+trenner +)<1THEN fstatus:=fnrfachanf+lv;fmeld:=meldungfachangabeunzulaessig; +fehlerbehandlungbearb2FI FI PER ;FOR lvFROM 0UPTO fnrkursartende- +fnrkursartanfREP plausitxt:=erfassungsfeld(bearb2)(fnrkursartanf+lv);IF ( +plausileisteSUB (lv+1))="1"THEN verglartleisteCAT text(plausitxt,2)FI ;IF +plausitxt<>""THEN IF pos(artlv,trenner+plausitxt+trenner)<1THEN fstatus:= +fnrkursartanf+lv;fmeld:=meldungungueltigekursart;fehlerbehandlungbearb2FI ; +FI PER ;FOR lvFROM 0UPTO fnrkursende-fnrkursanfREP plausitxt:=erfassungsfeld( +bearb2)(fnrkursanf+lv);IF (plausileisteSUB (lv+1))="1"THEN +verglkennungenleisteCAT text(plausitxt,4)FI PER ;FOR lvFROM 0UPTO +fnrklausurende-fnrklausuranfREP plausitxt:=erfassungsfeld(bearb2)( +fnrklausuranf+lv);IF (plausileisteSUB (lv+1))="1"THEN verglklausurleisteCAT +text(plausitxt,1)FI PER ;FOR lvFROM 0UPTO fnrnoteende-fnrnoteanfREP plausitxt +:=erfassungsfeld(bearb2)(fnrnoteanf+lv);IF plausitxt<>""THEN IF pos(noten, +trenner+plausitxt+trenner)<1THEN fstatus:=fnrnoteanf+lv;fmeld:= +fmeldnichtimbestand;fehlerbehandlungbearb2FI FI ;PER ;FOR lvFROM 0UPTO +fnrbemende-fnrbemanfREP plausitxt:=erfassungsfeld(bearb2)(fnrbemanf+lv);IF +plausitxt<>""THEN IF pos(bemerk,trenner+plausitxt+trenner)<1THEN fstatus:= +fnrbemanf+lv;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb2FI FI ;PER ; +FOR lvFROM 0UPTO fnrwarnungende-fnrwarnunganfREP plausitxt:=erfassungsfeld( +bearb2)(fnrwarnunganf+lv);IF plausitxt<>""THEN IF pos(blbrief,trenner+ +plausitxt+trenner)<1THEN fstatus:=fnrwarnunganf+lv;fmeld:=fmeldnichtimbestand +;fehlerbehandlungbearb2FI FI ;PER .END PROC pruefeplausibilitaet;PROC +listezuhalbjahresdatenzeigen:BOOL VAR listeexistiertnicht;falschesdatum:= +FALSE ;bs:=eingang;IF maskeeingangnochnichtdaTHEN initmaske(maske(bs), +maskennameeingang);init(bs,maxfeldbearb0);maskeeingangnochnichtda:=FALSE FI ; +gewschuljahr:=standardmaskenfeld(fnrgewschuljahr);gewhalbjahr:= +standardmaskenfeld(fnrgewhalbjahr);IF int(standardmaskenfeld(fnrgewjgst))=0 +THEN gewjgst:=standardmaskenfeld(fnrgewjgst);ELSE gewjgst:=jgstaufber( +standardmaskenfeld(fnrgewjgst));FI ;schluesselbereitstellen;IF NOT +falschesdatumTHEN putwert(fnrsustatuss,aktbestand);standardmeldung( +meldunglistenerstellung,"");initobli(saetzederliste);parsenooffields(5); +objektlistestarten(ixsustatfamrufgeb,standardmaskenfeld(fnrname), +fnrsufamnames,TRUE ,listeexistiertnicht);IF listeexistiertnichtTHEN +reinitparsing;standardmeldung(meldungkeineliste,"");return(1)ELSE +datensatzlistenausgabe(PROC (INT CONST )suerfassungschueler,TRUE ,BOOL PROC +pruefunghjd);FI ELSE return(1)FI .END PROC listezuhalbjahresdatenzeigen;BOOL +PROC pruefunghjd:wert(fnrsustatuss)=aktbestandEND PROC pruefunghjd;PROC +halbjahresdatenausgewaehlterschuelerbearbeitenvorbereiten:BOOL VAR ok, +kannbearbeitetwerden:=FALSE ;loeschedieerstellteobjektliste; +objektlistebeenden(dateiname,TRUE );reinitparsing; +holeerstenmehrtlgschluesselausdatei(ok);WHILE okREP pruefeobnameexistiert(ok) +;IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE +holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerden +THEN bereiteeingangsmaskefuerausgewaehltenvor;standardnprocELSE +standardmeldung(meldungletzter,"");enter(2)FI .END PROC +halbjahresdatenausgewaehlterschuelerbearbeitenvorbereiten;PROC +fuellemaskenfeldereingang:INT VAR lv;holedbwerte(bs);erfassungsfeld(bs)( +fnrgewschuljahr):=gewschuljahr;erfassungsfeld(bs)(fnrgewhalbjahr):= +gewhalbjahr;erfassungsfeld(bs)(fnrgewjgst):=gewjgst;IF aktbestand= +schueleraktuellTHEN erfassungsfeld(bs)(fnrabgangbestand):=""ELSE +erfassungsfeld(bs)(fnrabgangbestand):="x"FI ;FOR lvFROM fnrnameUPTO +fnrabgangbestandREP standardmaskenfeld(erfassungsfeld(bs)(lv),lv)PER .END +PROC fuellemaskenfeldereingang;PROC setzefeldschutz:INT VAR i;FOR iFROM +fnrnameUPTO fnrabgangbestandREP feldschutz(i)PER ;feldfrei(fnrgewschuljahr); +feldfrei(fnrgewhalbjahr);feldfrei(fnrgewjgst);.END PROC setzefeldschutz;PROC +holeerstenmehrtlgschluesselausdatei(BOOL VAR ok):IF NOT exists(dateiname) +THEN ok:=FALSE ;LEAVE holeerstenmehrtlgschluesselausdateiFI ;f:= +sequentialfile(input,dateiname);holenaechstenmehrtlgschluesselausdatei(ok). +END PROC holeerstenmehrtlgschluesselausdatei;PROC +holenaechstenmehrtlgschluesselausdatei(BOOL VAR ok):TEXT VAR thesaurustext:= +"";INT VAR schluesselbeginn:=0;INT VAR schluesseltrennung:=0;INT VAR i:=1;IF +eof(f)THEN ok:=FALSE ;loeschedieerstellteobjektlisteELSE getline(f, +thesaurustext);bestimmeschluesselausthesaurustext;ok:=TRUE FI . +bestimmeschluesselausthesaurustext:schluesselbeginn:=pos(thesaurustext, +oblitrenner);schluesseltrennung:=pos(thesaurustext,oblitrenner, +schluesselbeginn+1);FOR iFROM 1UPTO anzschluesselsuREP IF schluesseltrennung> +0THEN schluessel(i):=subtext(thesaurustext,schluesselbeginn+1, +schluesseltrennung-1);schluesselbeginn:=schluesseltrennung;schluesseltrennung +:=pos(thesaurustext,oblitrenner,schluesselbeginn+1);ELSE schluessel(i):= +subtext(thesaurustext,schluesselbeginn+1);FI ;schluessel(3):= +datumrekonversion(schluessel(3));PER ;.END PROC +holenaechstenmehrtlgschluesselausdatei;PROC +halbjahresdatendesschuelersnichtbearbeiten: +vorbereitendernaechstenschluesselbehandlung(1)END PROC +halbjahresdatendesschuelersnichtbearbeiten;TEXT PROC hjderfassungswert(INT +CONST feldnr):IF (feldnr>maxfeldbearb2)OR (feldnr<1)THEN ""ELSE +erfassungsfeld(bs)(feldnr)FI .END PROC hjderfassungswert;PROC setzedbwerte( +INT CONST mnr):SELECT mnrOF CASE eingang:setzedbwerteeingangCASE bearb1: +setzedbwertebearb1CASE bearb2:setzedbwertebearb2END SELECT . +setzedbwerteeingang:putwert(fnrsufamnames,erfassungsfeld[mnr][fnrname]); +putwert(fnrsurufnames,erfassungsfeld[mnr][fnrrufname]);putwert(fnrsugebdatums +,datumskonversion(erfassungsfeld[mnr][fnrgebdatum]));.setzedbwertebearb1: +putwert(fnrhjdjgst,erfassungsfeld[mnr][fnrausgabegewjgst]);putwert( +fnrhjdkennung,erfassungsfeld[mnr][fnrausgabegewzug]);putwert(fnrhjdvermblau, +erfassungsfeld[mnr][fnrblbriefwarn]);putwert(fnrhjdbemblau,erfassungsfeld[mnr +][fnrblbriefbem]);putwert(fnrhjdvermnachwarn,erfassungsfeld[mnr][ +fnrblbriefnwarn]);putwert(fnrhjdbemnachwarn,erfassungsfeld[mnr][ +fnrblbriefnbem]);putwert(fnrhjdversetzung,erfassungsfeld[mnr][fnrversetzung]) +;putwert(fnrhjdnachfach1,erfassungsfeld[mnr][fnrnachpr1]);putwert( +fnrhjdnachfach2,erfassungsfeld[mnr][fnrnachpr2]);putwert(fnrhjdnachfach3, +erfassungsfeld[mnr][fnrnachpr3]);putwert(fnrhjdbemnach,erfassungsfeld[mnr][ +fnrnachprbem]);putwert(fnrhjdnachfach,erfassungsfeld[mnr][fnrnachprabgelegt]) +;putwert(fnrhjdnacherg,erfassungsfeld[mnr][fnrnachprnote]);putwert( +fnrhjdbemzeug1,erfassungsfeld[mnr][fnrzeugbem1]);putwert(fnrhjdbemzeug2, +erfassungsfeld[mnr][fnrzeugbem2]);putwert(fnrhjdbemzeug3,erfassungsfeld[mnr][ +fnrzeugbem3]);putwert(fnrhjdversstdm,erfassungsfeld[mnr][fnrversaeumtmit]); +putwert(fnrhjdversstdo,erfassungsfeld[mnr][fnrversaeumtohne]);putwert( +fnrhjdverspaet,erfassungsfeld[mnr][fnrverspaetet]);.setzedbwertebearb2: +setzedbwertfach;setzedbwertart;setzedbwertklausur;setzedbwertkurs; +setzedbwertnote;setzedbwertbem;setzedbwertwarnung.setzedbwertfach: +spalteninhalte:="";FOR indFROM fnrfachanfUPTO fnrfachendeREP spalteninhalte +CAT text(erfassungsfeld[mnr][ind],2)PER ;putwert(fnrhjdfach,spalteninhalte). +setzedbwertart:spalteninhalte:="";FOR indFROM fnrkursartanfUPTO +fnrkursartendeREP spalteninhalteCAT text(erfassungsfeld[mnr][ind],2)PER ; +putwert(fnrhjdkursart,spalteninhalte).setzedbwertklausur:spalteninhalte:=""; +FOR indFROM fnrklausuranfUPTO fnrklausurendeREP spalteninhalteCAT text( +erfassungsfeld[mnr][ind],1)PER ;putwert(fnrhjdklausurteiln,spalteninhalte). +setzedbwertkurs:spalteninhalte:="";FOR indFROM fnrkursanfUPTO fnrkursendeREP +spalteninhalteCAT text(erfassungsfeld[mnr][ind],4)PER ;putwert( +fnrhjdlerngrpkenn,spalteninhalte).setzedbwertnote:spalteninhalte:="";FOR ind +FROM fnrnoteanfUPTO fnrnoteendeREP spalteninhalteCAT text(erfassungsfeld[mnr] +[ind],2)PER ;putwert(fnrhjdnotepunkte,spalteninhalte).setzedbwertbem: +spalteninhalte:="";FOR indFROM fnrbemanfUPTO fnrbemendeREP spalteninhalteCAT +text(erfassungsfeld[mnr][ind],3)PER ;putwert(fnrhjdbemerk,spalteninhalte). +setzedbwertwarnung:spalteninhalte:="";FOR indFROM fnrwarnunganfUPTO +fnrwarnungendeREP spalteninhalteCAT text(erfassungsfeld[mnr][ind],1)PER ; +putwert(fnrhjdvermwarnung,spalteninhalte).END PROC setzedbwerte;PROC +holedbwerte(INT CONST mnr):SELECT mnrOF CASE eingang:holedbwerteeingangCASE +bearb1:holedbwertebearb1CASE bearb2:holedbwertebearb2END SELECT . +holedbwerteeingang:erfassungsfeld[mnr][fnrname]:=wert(fnrsufamnames); +erfassungsfeld[mnr][fnrrufname]:=wert(fnrsurufnames);erfassungsfeld[mnr][ +fnrgebdatum]:=datumrekonversion(wert(fnrsugebdatums));.holedbwertebearb1: +erfassungsfeld[mnr][fnrausgabegewjgst]:=jgstaufber(wert(fnrhjdjgst)); +erfassungsfeld[mnr][fnrausgabegewzug]:=wert(fnrhjdkennung);erfassungsfeld[mnr +][fnrblbriefwarn]:=wert(fnrhjdvermblau);erfassungsfeld[mnr][fnrblbriefbem]:= +wert(fnrhjdbemblau);erfassungsfeld[mnr][fnrblbriefnwarn]:=wert( +fnrhjdvermnachwarn);erfassungsfeld[mnr][fnrblbriefnbem]:=wert( +fnrhjdbemnachwarn);erfassungsfeld[mnr][fnrversetzung]:=wert(fnrhjdversetzung) +;erfassungsfeld[mnr][fnrnachpr1]:=wert(fnrhjdnachfach1);erfassungsfeld[mnr][ +fnrnachpr2]:=wert(fnrhjdnachfach2);erfassungsfeld[mnr][fnrnachpr3]:=wert( +fnrhjdnachfach3);erfassungsfeld[mnr][fnrnachprbem]:=wert(fnrhjdbemnach); +erfassungsfeld[mnr][fnrnachprabgelegt]:=wert(fnrhjdnachfach);erfassungsfeld[ +mnr][fnrnachprnote]:=wert(fnrhjdnacherg);erfassungsfeld[mnr][fnrzeugbem1]:= +wert(fnrhjdbemzeug1);erfassungsfeld[mnr][fnrzeugbem2]:=wert(fnrhjdbemzeug2); +erfassungsfeld[mnr][fnrzeugbem3]:=wert(fnrhjdbemzeug3);erfassungsfeld[mnr][ +fnrversaeumtmit]:=wert(fnrhjdversstdm);erfassungsfeld[mnr][fnrversaeumtohne] +:=wert(fnrhjdversstdo);erfassungsfeld[mnr][fnrverspaetet]:=wert( +fnrhjdverspaet).holedbwertebearb2:.END PROC holedbwerte;BOOL PROC +korrekteschuljahreseingabe(TEXT CONST eingabe):eingabe=niltextOR eingabe= +"9900"OR int(subtext(eingabe,1,2))=int(subtext(eingabe,3,4))-1END PROC +korrekteschuljahreseingabe;PROC eventuellneueshjdtideintragen:IF +aktuellesschulhalbjahrinbearbeitungTHEN neueshjdtideintragenFI . +neueshjdtideintragen:readtid(dnrschueler,schuelertid);putwert(fnrsutidakthjd, +hjdtid);replace(dnrschueler,schuelertid).END PROC +eventuellneueshjdtideintragen;#dr11.05.88PROC eventuellinstatwuerfeleintragen +:IF aktuellesschulhalbjahrinbearbeitungCAND versetzungseintrag<>wert( +fnrhjdversetzung)THEN kuerzelsummeeinsrunter(statnrversetzung,jgst,zug, +aktbestand,versetzungseintrag);kuerzelsummeeinsrauf(statnrversetzung,jgst,zug +,aktbestand,wert(fnrhjdversetzung));FI END PROC +eventuellinstatwuerfeleintragen;#BOOL PROC +aktuellesschulhalbjahrinbearbeitung:vglgewhalbjahr=vglakthalbjahrCAND +gewschuljahr=schulkenndatum(schuljahr)END PROC +aktuellesschulhalbjahrinbearbeitung;TEXT PROC ohnestrich(TEXT CONST txt): +TEXT VAR t:=txt;changeall(t,"_",niltext);tEND PROC ohnestrich;PROC init(INT +CONST bsnr,maxfeld):FOR lvFROM 1UPTO maxfeldREP erfassungsfeld(bsnr)(lv):="" +PER END PROC init;END PACKET halbjahresdatenbearbeiten; + diff --git a/app/schulis/2.2.1/src/1.hoeherstufen anw do.prog b/app/schulis/2.2.1/src/1.hoeherstufen anw do.prog new file mode 100644 index 0000000..d7dc1ea --- /dev/null +++ b/app/schulis/2.2.1/src/1.hoeherstufen anw do.prog @@ -0,0 +1,43 @@ +PACKET hoeherstufenanwdoprogDEFINES halbjahreswechselbearbeitung, +hochsetzeneingangsbehandlung,hochsetzenbearbeitung,hochsetzenprotokolldrucken +:#LET schuljahreswechsel="isp.hoeherstufen local.sj",halbjahreswechsel= +"isp.hoeherstufen local.hj";#LET niltext="",tofather=1,tograndfather=2, +maxjahr=100,minjahr="00";LET zumschuljahresende=1,zumhalbjahresende=0;LET +schluesselschuljahr="Schuljahr",schluesselhalbjahr="Schulhalbjahr", +schuljahresfeld=2,infofeld=3;LET meldende=110,melddruck=58,meldwarten=156; +LET protname="Fehlerprotokoll";LET rcodeprot=1001;DATASPACE VAR ds;INT VAR +kanal:=channel,rcode;TAG VAR aktuellemaske;TEXT VAR aktschuljahr,akthalbjahr, +kommendesschuljahr;LET logbucheintragsjwechsel="Anw. 1.5.1 Hochsetzen ", +logbucheintraghjwechsel="Anw. 1.5.2 Halbjahreswechsel ";TEXT VAR +logbuchtextanfang;PROC hochsetzeneingangsbehandlung:reinitparsing; +eingangsbildschirmzeigen;schuljahrzeigen;aufaktionwarten. +eingangsbildschirmzeigen:initmaske(aktuellemaske,maske(vergleichsknoten)); +standardstartproc(maske(vergleichsknoten)).schuljahrzeigen:schuljahrIN +schuljahresfeld.schuljahr:aktschuljahr:=schulkenndatum(schluesselschuljahr); +akthalbjahr:=schulkenndatum(schluesselhalbjahr);kommendesschuljahr:=subtext( +aktschuljahr,3,4);kommendesschuljahrCAT (jahrestext(int(kommendesschuljahr)+1 +));aktschuljahr.aufaktionwarten:infeld(infofeld);standardnproc.END PROC +hochsetzeneingangsbehandlung;PROC halbjahreswechselbearbeitung: +logbuchtextanfang:=logbucheintraghjwechsel;logeintrag(logbucheintraghjwechsel ++"gestartet");abschnittsendebearbeitung(zumhalbjahresende)END PROC +halbjahreswechselbearbeitung;PROC hochsetzenbearbeitung:logbuchtextanfang:= +logbucheintragsjwechsel;logeintrag(logbucheintragsjwechsel+"gestartet"); +abschnittsendebearbeitung(zumschuljahresende)END PROC hochsetzenbearbeitung; +PROC abschnittsendebearbeitung(INT CONST zeitpunkt):meldewarten; +fehlerbehandlungvorbereiten;verarbeitung;reinitparsing;fehlerauswertung. +meldewarten:standardmeldung(meldwarten,niltext).fehlerbehandlungvorbereiten: +forget(protname,quiet);disablestop.verarbeitung:kanal:=channel;#17.10.88dr# +putsndparam(1,text(kanal));break(quiet);IF zeitpunkt=zumschuljahresendeTHEN +doonserver("schuljahreswechsel",rcode)ELSE doonserver("halbjahreswechsel", +rcode)FI ;continue(kanal).fehlerauswertung:loeschemeldung(aktuellemaske);IF +rcode=rcodeprotTHEN ds:=getrcvds;copy(ds,protname);forget(ds);logeintrag( +logbuchtextanfang+"beendet mit Fehlern");zeigefehlerprotokollELSE logeintrag( +logbuchtextanfang+"beendet ohne Fehler");fertigmeldungFI . +zeigefehlerprotokoll:store(FALSE );clearerror;enablestop;editiere(protname). +fertigmeldung:IF NOT iserrorTHEN standardmeldung(meldende,niltext);FI ;return +(tofather).END PROC abschnittsendebearbeitung;PROC hochsetzenprotokolldrucken +:print(protname);forget(protname,quiet);reorganizescreen;standardmeldung( +melddruck,niltext);return(tograndfather)END PROC hochsetzenprotokolldrucken; +TEXT PROC jahrestext(INT CONST jahr):IF jahr=maxjahrTHEN minjahrELSE text( +jahr)FI END PROC jahrestext;END PACKET hoeherstufenanwdoprog + diff --git a/app/schulis/2.2.1/src/1.listen.abgem b/app/schulis/2.2.1/src/1.listen.abgem new file mode 100644 index 0000000..da5fb1b --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.abgem @@ -0,0 +1,115 @@ +PACKET abgemlistenDEFINES abgemlispezielleteile:LET niltext="",blank=" ", +mittestrich="-",null=0,ueberschriftenzeilen=1,spalte1breite=7,spalte3breite=8 +,spalte4breite=8,spalte5breite=7,anzspaltentrenner=4,ausgkopflaenge=3, +ausgfeldlaenge=2,AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW +ausgkopflaengeTEXT ,abgemlieingangsmaske="mu liste einfach eingang", +abgemlianfpos=2,mnrbearbeitetwirdjgst=106,#ixsustatabgdat=260,dnrschueler=2, +fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums=5,fnrsustatuss=6,fnrsusgrpjgst +=7,fnrsusgrpzugtut=8,fnrsunamenszusatzs=21,fnrsuabgdats=16,fnrsuabggrund=17, +fnrsuabschluss=18,#anfangsj="Anfang Schulhalbjahr",endesj= +"Ende Schulhalbjahr";INT CONST spalte2bildbreite:=bildbreite- +anzspaltentrenner-spalte1breite-spalte3breite-spalte4breite-spalte5breite; +INT VAR spalte2druckbreite,druckzeilenzahl,aktuelleindexnr,bildanf, +eingabestatus,breite;TEXT VAR abgemliueberschrift,bearbeitetwirdjgst, +schuljahr,jahr1,jahr2,schuelername,schuelerrufname,schuelernamenszus, +schuelerjgst,schuelerzug,schuelergebdat,schuelerabdat,schuelerabgrund, +schuelerabqual,jgst,neuejgst,startwert,klasse,neueklasse,anfangsdatum:="", +endedatum:="";TEXT VAR druckstrich;TEXT CONST bildstrich:=bildbreite* +mittestrich;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR +ersteraufbildschirm,klassegeaendert:=FALSE ;BOOL PROC multistop:BOOL VAR b:=( +date(wert(fnrsuabgdats))>=date(anfangsdatum))CAND (date(wert(fnrsuabgdats))<= +date(endedatum))CAND (wert(fnrsustatuss)="ls");bEND PROC multistop;BOOL PROC +multistopdruck:BOOL VAR b:=multistop;setzebestandende(NOT b);bENDPROC +multistopdruck;PROC abgemlispezielleteile(INT CONST nr):SELECT nrOF CASE 1: +abgemlidialogvorbereitenCASE 2:abgemlieingabenrichtigCASE 3: +abgemlilistenvorbereitenCASE 4:abgemlidruckvorbereitenCASE 5: +abgemliseitedruckenCASE 6:abgemlibildschirmvorbereitenCASE 7: +abgemliseitezeigenENDSELECT .END PROC abgemlispezielleteile;PROC +abgemlidialogvorbereiten:abgemliueberschrift:=text(vergleichsknoten); +setzeanfangswerte(abgemlieingangsmaske,abgemlianfpos)END PROC +abgemlidialogvorbereiten;PROC abgemlieingabenrichtig:LET fnrausgdrucker=2, +fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext); +setzeeingabetest(TRUE )FI .END PROC abgemlieingabenrichtig;PROC +abgemlilistenvorbereiten:BOOL VAR b:=FALSE ;LET schluessel="Schuljahr"; +aktuellesschuljahrermitteln;aktuelleindexnr:=ixsustatabgdat;startwert:="ls"; +inittupel(dnrschueler);initobli(8);parsenooffields(21);setzeidentiwert(""); +putwert(fnrsustatuss,startwert);putwert(fnrsuabgdats,anfangsdatum);# +objektlistestarten(aktuelleindexnr,"",3,TRUE ,b);#objektlistestarten( +aktuelleindexnr,"",fnrsuabgdats,TRUE ,b);setzebestandende(NOT multistopOR b). +aktuellesschuljahrermitteln:schuljahr:=schulkenndatum(schluessel);jahr1:= +subtext(schuljahr,1,2);jahr2:=subtext(schuljahr,3,4);anfangsdatum:= +schulkenndatum(anfangsj);endedatum:=schulkenndatum(endesj).END PROC +abgemlilistenvorbereiten;PROC abgemlibildschirmvorbereiten:LET fnrausganf=2; +standardkopfmaskeaktualisieren(abgemliueberschrift);breite:=bildbreite; +initspalten;setzespaltenbreiten(spalte2bildbreite);initausgabekopf(bildstrich +);bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT ausgkopf +(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext; +setzebildanfangsposition(bildanf).END PROC abgemlibildschirmvorbereiten;PROC +abgemliseitezeigen:ersteraufbildschirm:=TRUE ;setzescanendewert(endedatum); +setzescanstartwert(anfangsdatum);blaettern(PROC (INT CONST )schuelerzeigen, +aktion,TRUE ,TRUE ,BOOL PROC multistop);setzescanendewert("�"); +setzescanstartwert("�")END PROC abgemliseitezeigen;PROC schuelerzeigen(INT +CONST x):schuelerholen;IF ersteraufbildschirmTHEN klassegeaendert:=TRUE ; +ersteraufbildschirm:=FALSE FI ;schueleraufbereiten;schueleraufbildschirm.END +PROC schuelerzeigen;PROC schueleraufbildschirm:INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsEND +REPEAT .END PROC schueleraufbildschirm;PROC abgemlidruckvorbereiten:LET +uebteil1="Liste der im Schuljahr ",uebteil2=" abgemeldeten Schüler";TEXT VAR +ueberschrift;jgst:=niltext;klasse:=niltext;druckvorbereiten; +variablenfuerdrucksetzen;ueberschriftvorbereitendruck;initdruckkopf(zentriert +(ueberschrift,druckbreite));breite:=druckbreite;initspalten; +setzespaltenbreiten(spalte2druckbreite);initausgabekopf(druckstrich); +holemeldung;inittupel(dnrschueler);putwert(fnrsustatuss,startwert);putwert( +fnrsuabgdats,anfangsdatum);lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC , +INT VAR )scanforward,BOOL PROC multistopdruck).holemeldung:meldungstext( +mnrbearbeitetwirdjgst,bearbeitetwirdjgst).variablenfuerdrucksetzen: +druckstrich:=druckbreite*mittestrich;spalte2druckbreite:=druckbreite- +anzspaltentrenner-spalte1breite-spalte3breite-spalte4breite-spalte5breite; +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge. +ueberschriftvorbereitendruck:ueberschrift:=uebteil1+aufbereitetesschuljahr+ +uebteil2.aufbereitetesschuljahr:"19"+jahr1+"/"+jahr2.END PROC +abgemlidruckvorbereiten;PROC abgemliseitedrucken:abgemliueberschriftdrucken; +seitedrucken(PROC (INT VAR )schuelerdrucken,druckzeilenzahl,ausgfeldlaenge, +BOOL PROC multistopdruck);seitenwechsel.END PROC abgemliseitedrucken;PROC +abgemliueberschriftdrucken:druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO +ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC +abgemliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET +markiert="#";schuelerholen;IF zeilenzaehler=nullTHEN klassegeaendert:=TRUE +FI ;ggflmeldungjgst;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge; +schuelerindruckdatei.ggflmeldungjgst:IF jgstgeaendertTHEN zwischenmeldungFI . +jgstgeaendert:neuejgst:=schuelerjgst;jgst<>neuejgst.zwischenmeldung: +standardmeldung(bearbeitetwirdjgst,neuejgst+markiert);jgst:=neuejgst;END +PROC schuelerdrucken;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREPEAT druckzeileschreiben(ausgfeld(i))END REPEAT .END PROC +schuelerindruckdatei;PROC setzespaltenbreiten(INT CONST spalte2breite): +setzespaltenbreite(spalte1breite);setzespaltenbreite(spalte2breite); +setzespaltenbreite(spalte3breite);setzespaltenbreite(spalte4breite); +setzespaltenbreite(spalte5breite);END PROC setzespaltenbreiten;PROC +initausgabekopf(TEXT CONST strich):LET jgst="Jgst.",klasse=" Kl.",name= +"Familienname",rufname=" Rufname",geb="Geburts-",abg="Abgangs-",datum= +"datum",grund="Grund",qual=" Qual.";spaltenweise(jgst);spaltenweise(name); +spaltenweise(geb);spaltenweise(abg);spaltenweise(grund);ausgkopf(1):=zeile; +spaltenweise(klasse);spaltenweise(rufname);spaltenweise(datum);spaltenweise( +datum);spaltenweise(qual);ausgkopf(2):=zeile;ausgkopf(3):=strich;END PROC +initausgabekopf;PROC schuelerholen:schuelername:=wert(fnrsufamnames); +schuelerrufname:=wert(fnrsurufnames);schuelernamenszus:=wert( +fnrsunamenszusatzs);schuelerjgst:=wert(fnrsusgrpjgst);schuelerzug:=wert( +fnrsusgrpzugtut);schuelergebdat:=wert(fnrsugebdatums);schuelerabdat:=wert( +fnrsuabgdats);schuelerabgrund:=wert(fnrsuabggrund);schuelerabqual:=wert( +fnrsuabschluss);neueklasse:=schuelerjgst+schuelerzug;klassegeaendert:=klasse +<>neueklasse;klasse:=neueklasse.END PROC schuelerholen;PROC +schueleraufbereiten:LET minus="-";schreibenameabdaten;schreiberufname. +schreibenameabdaten:spaltenweise(aufbschuelerklasse);spaltenweise( +aufbschuelername);spaltenweise(schuelergebdat);spaltenweise(schuelerabdat); +spaltenweise(blank+aufbschuelerabgrund+blank+aufbschuelerabqual);ausgfeld(1) +:=zeile.schreiberufname:ausgfeld(2):=text(aufbrufname,breite). +aufbschuelerklasse:IF klassegeaendertTHEN schuelerjgst+blank+schuelerzugELSE +spalte1breite*blankFI .aufbschuelername:IF schuelernamenszus=niltextTHEN +schuelernameELSE schuelernamenszus+blank+schuelernameFI .aufbschuelerabqual: +IF schuelerabqual=niltextTHEN minusELSE schuelerabqualFI .aufbschuelerabgrund +:IF schuelerabgrund=niltextTHEN minusELSE schuelerabgrundFI .aufbrufname:( +spalte1breite+3)*blank+schuelerrufname.END PROC schueleraufbereiten;END +PACKET abgemlisten; + diff --git a/app/schulis/2.2.1/src/1.listen.adressen b/app/schulis/2.2.1/src/1.listen.adressen new file mode 100644 index 0000000..0a45d7b --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.adressen @@ -0,0 +1,186 @@ +PACKET adressenlistenDEFINES adrlispezielleteile:LET niltext="",blank=" ", +mittestrich="-",null=0,komma=",",altervolljaehrig=18,uebteil21="Jgst. ", +uebteil22="Klasse ",uebteil23="Tutorenkurs ",uebteil24="alphabetisch", +ueberschriftenzeilen=2,#bestand1="c12 schueler",bestand2= +"c11 akt schuelergruppen",praefix1="c12 jgst",praefix2="c12 sg",# +ausgfeldlaenge=9,AUSGFELD =ROW ausgfeldlaengeTEXT ,adrlieingangsmaske= +"ms liste adressen eingang",adrlianfpos=2,#dnrschueler=2,fnrsufamnames=3, +fnrsurufnames=4,fnrsustatuss=6,fnrsunamenszusatzs=21,fnrsugebnames=22, +fnrsugebdatums=5,fnrsusgrpjgst=7,fnrsusgrpzugtut=8,fnrsuwohntbei=23, +fnrsustrnrs=24,fnrsuplzorts=25,fnrsutelnrs=26,fnrsufamnamee=28,fnrsuvornamee= +29,fnrsunamenszusatzs=30,fnrsustrnre=31,fnrsuplzorte=32,fnrsutelnre=33, +ixsustatjgstzug=255,ixsustatjgst=261,ixstatfamrufgeb=254,stattnachfolgendemI +ndexixsustat=252,#mnrbearbeitetwerden=102,mnrbearbeitetwird=100, +mnrauswahlnichtsinnvoll=56,mnrlistewirdgedruckt=58;INT VAR aktuelleindexnr, +druckzeilenzahl,bildanf,vergldatum,ausgfeldzeile,eingabestatus,zaehler;TEXT +VAR adrliueberschrift,ueberschrift1,ueberschrift2,anfbuchstabe, +neueranfbuchstabe,startjahr,startzug,bearbeitetwerden,bearbeitetwird, +schuelername,schuelervorname,schuelernamenszusatz,schuelergebname,gebdat, +jahrgangsstufe,zug,adressename,adressestrasse,adresseort,adressetelnr, +erzbername,erzbervorname,erzbernamenszusatz,erzberstrasse,erzberort, +erzbertelnr;AUSGFELD VAR ausgfeld;ausgfeld(ausgfeldlaenge):=niltext;TEXT VAR +druckstrich;BOOL VAR einjahrgang,alle,sortalpha,neueklasse;BOOL PROC +multistop:BOOL VAR b:=FALSE ;IF wert(fnrsustatuss)="ls"THEN IF startjahr<> +niltextTHEN IF startzug=niltextTHEN b:=(wert(fnrsusgrpjgst)=startjahr)ELSE b +:=(wert(fnrsusgrpzugtut)=startzugAND wert(fnrsusgrpjgst)=startjahr)FI ELSE b +:=dbstatus=okFI ;FI ;bEND PROC multistop;BOOL PROC multistopsim:BOOL VAR b:= +multistop;setzebestandende(NOT b);bENDPROC multistopsim;PROC +adrlispezielleteile(INT CONST nr):SELECT nrOF CASE 1:adrlidialogvorbereiten +CASE 2:adrlieingabenrichtigCASE 3:adrlilistenvorbereitenCASE 4: +adrlidruckvorbereitenCASE 5:adrliseitedruckenCASE 6: +adrlibildschirmvorbereitenCASE 7:adrliseitezeigenENDSELECT .END PROC +adrlispezielleteile;PROC adrlidialogvorbereiten:adrliueberschrift:=text( +vergleichsknoten);setzeanfangswerte(adrlieingangsmaske,adrlianfpos).END PROC +adrlidialogvorbereiten;PROC adrlieingabenrichtig:LET fnrjgst=2,fnrzug=3, +fnralphasort=4,fnrklassensort=5,fnrausgdrucker=6,fnrausgbild=7;alle:=FALSE ; +einjahrgang:=FALSE ;sortalpha:=FALSE ;wohinausgabepruefen;IF +falschausgefuelltTHEN infeld(eingabestatus);setzeeingabetest(FALSE )ELSE +jahrgangsstufe:=standardmaskenfeld(fnrjgst);zug:=standardmaskenfeld(fnrzug); +wasausgabepruefenFI .wohinausgabepruefen:standardpruefe(5,fnrausgdrucker, +fnrausgbild,null,niltext,eingabestatus).wasausgabepruefen:IF jahrgangsstufe= +niltextTHEN IF zug=niltextTHEN wieausgabepruefen;IF falschausgefuelltTHEN +infeld(eingabestatus);setzeeingabetest(FALSE )ELSE alle:=TRUE ; +wertesetzenfuerweiterebearbeitungFI ELSE meldefehler;infeld(fnrzug); +setzeeingabetest(FALSE )FI ELSE standardpruefe(3,fnrjgst,5,13,niltext, +eingabestatus);IF falschausgefuelltTHEN infeld(eingabestatus); +setzeeingabetest(FALSE )ELSE jahrgangsstufe:=zweistellig(jahrgangsstufe); +einjahrgang:=(zug=niltext);IF einjahrgangTHEN wieausgabepruefen;IF +falschausgefuelltTHEN infeld(eingabestatus);setzeeingabetest(FALSE )ELSE +wertesetzenfuerweiterebearbeitungFI ELSE wertesetzenfuerweiterebearbeitung; +sortalpha:=TRUE FI ;FI ;FI .wieausgabepruefen:standardpruefe(5,fnralphasort, +fnrklassensort,null,niltext,eingabestatus).wertesetzenfuerweiterebearbeitung: +sortalpha:=standardmaskenfeld(fnrklassensort)=niltext;setzeausgabedrucker( +standardmaskenfeld(fnrausgbild)=niltext);setzeeingabetest(TRUE ). +falschausgefuellt:eingabestatus<>0.meldefehler:standardmeldung( +mnrauswahlnichtsinnvoll,niltext).END PROC adrlieingabenrichtig;PROC +adrlilistenvorbereiten:BOOL VAR b:=FALSE ;INT VAR staticfield:=dnrschueler+1; +vergldatum:=vergleichsdatum(altervolljaehrig);startjahr:=jahrgangsstufe; +startzug:=zug;IF sortalphaTHEN IF startjahr<>niltextTHEN IF startzug<>niltext +THEN aktuelleindexnr:=ixsustatjgstzugELSE aktuelleindexnr:=ixsustatjgstFI ; +ELSE staticfield:=fnrsustatuss;#?????#aktuelleindexnr:=ixsustatfamrufgeb# +aktuelleindexnr:=ixsustat#FI ;ELSE IF startjahr=""THEN staticfield:= +fnrsusgrpjgstELSE staticfield:=fnrsusgrpzugtutFI ;aktuelleindexnr:= +ixsustatjgstzugFI ;inittupel(dnrschueler);initobli(2);parsenooffields(34); +setzeidentiwert("");putwert(fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut, +startzug);putwert(fnrsustatuss,"ls");#objektlistestarten(aktuelleindexnr,"", +fnrsustatuss,TRUE ,b);#objektlistestarten(aktuelleindexnr,"",staticfield, +TRUE ,b);setzebestandende(NOT multistopCOR b)END PROC adrlilistenvorbereiten; +PROC adrlibildschirmvorbereiten:LET fnrausganf=2;ueberschriftvorbereitenbild; +standardkopfmaskeaktualisieren(ueberschrift1);bildanf:=fnrausganf;# +setzenderhilfsgroessenfuersblaettern(min(maxblocklaenge,bildblocklaenge), +bildsatzzahl);#setzebildanfangsposition(bildanf).END PROC +adrlibildschirmvorbereiten;PROC ueberschriftvorbereitenbild:LET aufein="", +aufaus=" ";ueberschrift1:=adrliueberschrift;IF NOT alleTHEN ueberschrift1:= +ueberschrift1+komma+blank;IF einjahrgangTHEN ueberschrift1:=ueberschrift1+ +uebteil21+aufein+jahrgangsstufe+aufausELSE IF int(jahrgangsstufe)<11THEN +ueberschrift1:=ueberschrift1+uebteil22ELSE ueberschrift1:=ueberschrift1+ +uebteil23FI ;ueberschrift1:=ueberschrift1+aufein+jahrgangsstufe+blank+zug+ +aufausFI FI ;END PROC ueberschriftvorbereitenbild;PROC adrliseitezeigen: +blaettern(PROC (INT CONST )adressdatenzeigen,aktion,TRUE ,aktuelleindexnr<> +dnrschueler,BOOL PROC multistop)END PROC adrliseitezeigen;PROC +adressdatenzeigen(INT CONST x):TEXT CONST leerzeile:=text(blank,bildbreite); +INT VAR i;adressdatenholen;adressdatenaufbereiten(bildbreite); +ggfleerzeilenfuellen;adressdatenaufbildschirm.ggfleerzeilenfuellen: +ausgfeldzeileINCR 1;FOR iFROM ausgfeldzeileUPTO ausgfeldlaenge-1REP ausgfeld( +i):=leerzeilePER .END PROC adressdatenzeigen;PROC adressdatenaufbildschirm: +INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos; +erhoeheausgabeposumeinsEND REPEAT .END PROC adressdatenaufbildschirm;PROC +adrlidruckvorbereiten:IF (alleOR einjahrgang)AND NOT sortalphaTHEN zaehler:= +null;neueklasse:=TRUE ELSE anfbuchstabe:=niltextFI ;druckvorbereiten; +variablenfuerdrucksetzen;holemeldungen;inittupel(dnrschueler);putwert( +fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut,startzug);putwert( +fnrsustatuss,"ls");lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR +)scanforward,BOOL PROC multistopsim);ueberschriftvorbereitendruck; +initdruckkopf(zentriert(ueberschrift1,druckbreite),zentriert(ueberschrift2, +druckbreite)).variablenfuerdrucksetzen:druckzeilenzahl:=drucklaenge( +ueberschriftenzeilen);druckstrich:=druckbreite*mittestrich.holemeldungen: +meldungstext(mnrbearbeitetwird,bearbeitetwird);meldungstext( +mnrbearbeitetwerden,bearbeitetwerden).END PROC adrlidruckvorbereiten;PROC +ueberschriftvorbereitendruck:jahrgangsstufe:=wert(fnrsusgrpjgst);zug:=wert( +fnrsusgrpzugtut);ueberschrift1:=compress(adrliueberschrift);#dr28.03.88#IF +alleTHEN IF sortalphaTHEN ueberschrift2:=uebteil24ELSE klassenueberschriftFI +ELSE IF einjahrgangTHEN IF sortalphaTHEN ueberschrift2:=uebteil21+ +jahrgangsstufe+komma+blank+uebteil24ELSE klassenueberschriftFI ELSE +klassenueberschriftFI FI .klassenueberschrift:IF int(jahrgangsstufe)<11THEN +ueberschrift2:=uebteil22ELSE ueberschrift2:=uebteil23FI ;ueberschrift2:= +ueberschrift2+jahrgangsstufe+blank+zug.END PROC ueberschriftvorbereitendruck; +PROC adrliseitedrucken:adrliueberschriftdrucken;IF (alleOR einjahrgang)AND +NOT sortalphaTHEN seitedrucken(PROC (INT VAR )adressdatendrucken, +druckzeilenzahl,ausgfeldlaenge,PROC bestandendesimulierenbeiklassenwechsel, +BOOL PROC multistopsim);IF neueklasseTHEN simuliertesendezuruecknehmen; +neuelistevorbereitenELSE seitenwechselFI ELSE seitedrucken(PROC (INT VAR ) +adressdatendrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim); +seitenwechselFI .simuliertesendezuruecknehmen:setzebestandende(FALSE ). +neuelistevorbereiten:meldelistewirdgedruckt;drucknachbereiten; +druckvorbereiten;zaehler:=null;ueberschriftvorbereitendruck;initdruckkopf( +zentriert(ueberschrift1,druckbreite),zentriert(ueberschrift2,druckbreite)). +meldelistewirdgedruckt:standardmeldung(mnrlistewirdgedruckt,"").END PROC +adrliseitedrucken;PROC adrliueberschriftdrucken:druckkopfschreiben.END PROC +adrliueberschriftdrucken;PROC adressdatendrucken(INT VAR zeilenzaehler):LET +markiert="#";adressdatenholen;ggfmeldung;zaehlerINCR 1;adressdatenaufbereiten +(druckbreite);zeilenzaehlerINCR ausgfeldzeile;adressdatenindruckdatei. +ggfmeldung:IF (alleOR einjahrgang)AND NOT sortalphaTHEN ggfmeldungklasseELSE +ggfmeldunganfbuchstabeEND IF .ggfmeldungklasse:IF zaehler=nullTHEN +standardmeldung(bearbeitetwird,jahrgangsstufe+blank+zug+markiert)FI . +ggfmeldunganfbuchstabe:IF anfangsbuchstabegeaendertTHEN meldunganfbuchstabe +END IF .anfangsbuchstabegeaendert:neueranfbuchstabe:=schuelernameSUB 1; +anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe:standardmeldung( +bearbeitetwerden,neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe. +END PROC adressdatendrucken;PROC adressdatenindruckdatei:INT VAR i;FOR iFROM +1UPTO ausgfeldzeileREP druckzeileschreiben(ausgfeld(i))PER .END PROC +adressdatenindruckdatei;PROC bestandendesimulierenbeiklassenwechsel:IF +bestandendeTHEN neueklasse:=FALSE ELSE nochklassezubearbeiten;IF neueklasse +THEN setzebestandende(TRUE )FI ;FI .nochklassezubearbeiten:neueklasse:=zug<> +wert(fnrsusgrpzugtut);IF alleTHEN neueklasse:=neueklasseOR (int( +jahrgangsstufe)<>int(wert(fnrsusgrpjgst)))FI .END PROC +bestandendesimulierenbeiklassenwechsel;PROC adressdatenholen:schuelername:= +wert(fnrsufamnames);schuelervorname:=wert(fnrsurufnames);schuelernamenszusatz +:=wert(fnrsunamenszusatzs);schuelergebname:=wert(fnrsugebnames);gebdat:=wert( +fnrsugebdatums);jahrgangsstufe:=wert(fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut +);adressename:=wert(fnrsuwohntbei);adressestrasse:=wert(fnrsustrnrs); +adresseort:=wert(fnrsuplzorts);adressetelnr:=wert(fnrsutelnrs);erzbername:= +wert(fnrsufamnamee);erzbervorname:=wert(fnrsuvornamee);erzbernamenszusatz:= +wert(fnrsunamenszusatze);erzberstrasse:=wert(fnrsustrnre);erzberort:=wert( +fnrsuplzorte);erzbertelnr:=wert(fnrsutelnre)END PROC adressdatenholen;PROC +adressdatenaufbereiten(INT CONST breite):LET prebreite=19,klassetelnrbreite= +21,deutsch="D",namevornametrenner=", ",gebnamepre=", geb. ",gebdatpre= +" Geb.Dat.: ",vollj="(Vollj.)",klassepre="Klasse: ",adressepre= +" Adresse : ",preleer=" ",adressnamepre="bei ", +telnrpre="Tel.: ",erzberpre=" Erz.Ber.: ";INT CONST breiteohnepre:= +breite-prebreite,ortgebdatbreite:=breiteohnepre-klassetelnrbreite; +schreibenamenszeile;schreibegebdatundggfklasse;schreibeschueleradresse; +schreibeggferzberadresse.schreibenamenszeile:ausgfeld(1):=text( +zusammengesetztername,breite).zusammengesetztername:subtext(schuelername+ +namevornametrenner+schuelervorname+blank+schuelernamenszusatz+gebname,1, +breite).gebname:IF schuelergebname=niltextTHEN niltextELSE gebnamepre+ +schuelergebnameEND IF .schreibegebdatundggfklasse:ausgfeld(2):=gebdatpre+ +gebdatundggfklasse.gebdatundggfklasse:IF alleOR einjahrgangTHEN text(gebdat+ +ggfvollj,ortgebdatbreite)+text(klassepre+klasse,klassetelnrbreite)ELSE text( +gebdat+ggfvollj,breiteohnepre)FI .klasse:jahrgangsstufe+blank+zug.ggfvollj: +IF volljaehrig(datum(gebdat))THEN volljELSE niltextEND IF . +schreibeschueleradresse:IF adressename=niltextTHEN ausgfeld(3):=text( +adressepre+adressestrasse,breite);ausgfeldzeile:=4ELSE ausgfeld(3):=text( +adressepre+adressnamepre+adressename,breite);ausgfeld(4):=text(preleer+ +adressestrasse,breite);ausgfeldzeile:=5FI ;ausgfeld(ausgfeldzeile):=preleer+ +ortundggftelefon.ortundggftelefon:IF adressetelnr=niltextTHEN text( +adresseggflandundort,breiteohnepre)ELSE text(adresseggflandundort, +ortgebdatbreite)+text(telnrpre+adressetelnr,klassetelnrbreite)FI . +adresseggflandundort:adresseort.schreibeggferzberadresse:IF erzbername= +niltextTHEN schreibeleerzeileELSE schreibeerzberadresseFI . +schreibeerzberadresse:schreibeerzbername;schreibeggferzberstrort. +schreibeerzbername:ausgfeldzeileINCR 1;ausgfeld(ausgfeldzeile):=text( +erzberpre+ggferzbernamenszusatz+erzbername+namevornametrenner+erzbervorname, +breite).ggferzbernamenszusatz:IF erzbernamenszusatz<>niltextTHEN +erzbernamenszusatz+blankELSE niltextFI .schreibeggferzberstrort:IF ( +erzberstrasse=niltext)AND (erzberort=niltext)THEN schreibeleerzeileELSE +schreibeerzberstrasse;schreibeerzberortundggftelnrFI .schreibeerzberstrasse: +ausgfeldzeileINCR 1;ausgfeld(ausgfeldzeile):=text(preleer+erzberstrasse, +breite).schreibeerzberortundggftelnr:ausgfeldzeileINCR 1;ausgfeld( +ausgfeldzeile):=preleer+erzberortundggftelefon.erzberortundggftelefon:IF +erzbertelnr=niltextTHEN text(erzberggflandundort,breiteohnepre)ELSE text( +erzberggflandundort,ortgebdatbreite)+text(telnrpre+erzbertelnr, +klassetelnrbreite)FI .erzberggflandundort:erzberort.schreibeleerzeile: +ausgfeldzeileINCR 1;ausgfeld(ausgfeldzeile):=text(blank,breite).END PROC +adressdatenaufbereiten;BOOL PROC volljaehrig(INT CONST geburtstag):geburtstag +<=vergldatumEND PROC volljaehrig;END PACKET adressenlisten; + diff --git a/app/schulis/2.2.1/src/1.listen.anherk b/app/schulis/2.2.1/src/1.listen.anherk new file mode 100644 index 0000000..fb9a34e --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.anherk @@ -0,0 +1,124 @@ +PACKET anherklistenDEFINES anherklispezielleteile:#LET dnrschueler=2, +fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums=5,fnrsustatuss=6, +fnrsuskennlschule=14,fnrsuklasselschule=15,fnrsunamenszusatzs=21,dnrschulen= +120,fnrschkennung=121,fnrschname=122,fnrschstrnr=124,fnrschplzort=125, +ixsustatschulkenn=253,#LET mnrbearbeitetwirdschule=103,mnrlistewirdgedruckt= +58;TEXT VAR bearbeitetwirdschule:="",listewirdgedruckt:="",startwert:="";LET +niltext="",blank=" ",mittestrich="-",null=0,komma=",",ueberschriftenzeilen=1, +spalte2breite=8,spalte3breite=27,anzspaltentrenner=2,spaltentrenner=":", +ausgkopflaenge=3,ausgfeldlaenge=1,AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF +=ROW ausgkopflaengeTEXT ,anherklieingangsmaske="ms liste anherk eingang", +anherklianfpos=2;INT VAR druckzeilenzahl,druckzeilenzahlseite1, +druckzeilenzahlfolgeseiten,spalte1breite,eingabestatus;TEXT VAR # +anherkliueberschrift,#schuelername,schuelerrufname,schuelernamenszus, +schuelergebdat,schulkuerzel,letzteklasse,vordruck,vordruckueberarbeitet;TEXT +VAR druckstrich;AUSGFELD VAR ausgfelddruck;AUSGKOPF VAR ausgkopfdruck;BOOL +VAR jgst5,neueherkschule;FILE VAR textanschr;PROC anherklispezielleteile(INT +CONST nr):SELECT nrOF CASE 1:anherklidialogvorbereitenCASE 2: +anherklieingabenrichtigCASE 3:anherklilistenvorbereitenCASE 4: +anherklidruckvorbereitenCASE 5:anherkliseitedruckenENDSELECT .END PROC +anherklispezielleteile;PROC anherklidialogvorbereiten:setzeanfangswerte( +anherklieingangsmaske,anherklianfpos).END PROC anherklidialogvorbereiten; +PROC anherklieingabenrichtig:LET fnrjgst5=2,fnrjgst11=3;standardpruefe(5, +fnrjgst5,fnrjgst11,null,niltext,eingabestatus);IF eingabestatus<>0THEN infeld +(eingabestatus);setzeeingabetest(FALSE )ELSE jgst5:=(standardmaskenfeld( +fnrjgst11)=niltext);setzeausgabedrucker(TRUE );setzeeingabetest(TRUE )FI . +END PROC anherklieingabenrichtig;PROC anherklilistenvorbereiten:BOOL VAR b:= +FALSE ;IF jgst5THEN startwert:="n05"ELSE startwert:="n11"FI ;meldungstext( +mnrbearbeitetwirdschule,bearbeitetwirdschule);meldungstext( +mnrlistewirdgedruckt,listewirdgedruckt);inittupel(dnrschueler); +parsenooffields(21);setzeidentiwert("");putwert(fnrsustatuss,startwert); +putwert(fnrsuskennlschule," ");objektlistestarten(ixsustatschulkenn,"",# +fnrsustatuss#dnrschueler+1,TRUE ,b);setzebestandende(b)END PROC +anherklilistenvorbereiten;PROC anherklidruckvorbereiten:LET vordr1= +"vordruck fuer anschreiben an herkunftsschulen fuer jgst 5",vordr2= +"vordruck fuer anschreiben an herkunftsschulen fuer jgst 11",vordrueberarb= +"vordruck ueberarbeitet",manager="anschreiben server";neueherkschule:=TRUE ; +druckvorbereiten;festenanschreibentextholen;variablenfuerdrucksetzen; +inittupel(dnrschueler);putwert(fnrsustatuss,startwert);putwert( +fnrsuskennlschule," ");lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT +VAR )scanforward,BOOL PROC multistopsim);initdruckkopf;initspalten; +initausgabekopfdruck.festenanschreibentextholen:IF jgst5THEN vordruck:=vordr1 +ELSE vordruck:=vordr2FI ;vordruckueberarbeitet:=vordrueberarb;forget(vordruck +,quiet);forget(vordruckueberarbeitet,quiet);fetch(vordruck,/manager); +briefalternative(vordruck,vordruckueberarbeitet).variablenfuerdrucksetzen: +druckstrich:=druckbreite*mittestrich;spalte1breite:=druckbreite- +anzspaltentrenner-spalte2breite-spalte3breite;druckzeilenzahlseite1:= +drucklaenge(ueberschriftenzeilen)-ausgkopflaenge;druckzeilenzahlfolgeseiten:= +drucklaenge-ausgkopflaenge.END PROC anherklidruckvorbereiten;PROC +initausgabekopfdruck:LET name="Name",geb="Geburts-",dat="datum",letzte= +"letzte:",klasse="Klasse:",bedingung="Bed. 2. Fremdsprache",erfuellt= +"erfüllt für";hilfsfeldervorbelegen;spaltenweise(niltext);spaltenweise(geb); +IF jgst5THEN spaltenweise(letzte)ELSE spaltenweise(letzte+bedingung)FI ; +ausgkopfdruck(1):=zeile;spaltenweise(name);spaltenweise(dat);IF jgst5THEN +spaltenweise(klasse)ELSE spaltenweise(klasse+erfuellt)FI ;ausgkopfdruck(2):= +zeile;ausgkopfdruck(3):=druckstrich.hilfsfeldervorbelegen:setzespaltentrenner +(spaltentrenner);setzespaltenbreite(spalte1breite);setzespaltenbreite( +spalte2breite);setzespaltenbreite(spalte3breite).END PROC +initausgabekopfdruck;BOOL PROC multistopsim:BOOL VAR b;IF jgst5THEN b:=wert( +fnrsustatuss)="n05"ELSE b:=wert(fnrsustatuss)="n11"FI ;setzebestandende(NOT b +);bENDPROC multistopsim;PROC anherkliseitedrucken:anherkliueberschriftdrucken +;seitedrucken(PROC (INT VAR )schuelerdatendrucken,druckzeilenzahl, +ausgfeldlaenge,PROC bestandendesimulierenbeischulwechsel,BOOL PROC +multistopsim);IF neueherkschuleTHEN simuliertesendezuruecknehmen; +neuelistevorbereitenELSE seitenwechselFI .simuliertesendezuruecknehmen: +setzebestandende(FALSE ).neuelistevorbereiten:meldelistewirdgedruckt; +drucknachbereiten;druckvorbereiten;initdruckkopf.meldelistewirdgedruckt: +standardmeldung(listewirdgedruckt,"").END PROC anherkliseitedrucken;PROC +anherkliueberschriftdrucken:LET anzleerzeilen=3,markiert="#";INT VAR i;IF +neueherkschuleTHEN zwischenmeldung;druckzeilenzahl:=druckzeilenzahlseite1; +druckkopfschreiben;anschreibenschreibenELSE druckzeilenzahl:= +druckzeilenzahlfolgeseitenFI ;FOR iFROM 1UPTO ausgkopflaengeREPEAT +druckzeileschreiben(ausgkopfdruck(i))END REPEAT .zwischenmeldung: +standardmeldung(bearbeitetwirdschule,wert(fnrsuskennlschule)+markiert). +anschreibenschreiben:#ROW 3TEXT VAR herkschuldaten,merker;##dbwertemerken;# +adresseherkschuleholen;adresseherkschuleschreiben;festentextschreiben; +unterschriftschreiben;#dbwertezurueckholen.#.#dbwertemerken:FOR iFROM 1UPTO 3 +REP merker(i):=dbwert(i)PER .#adresseherkschuleholen:putwert(fnrschkennung, +wert(fnrsuskennlschule));search(dnrschulen,TRUE );IF NOT gefundenTHEN +inittupel(dnrschulen)FI .gefunden:dbstatus=ok.adresseherkschuleschreiben:LET +an="An",zeilenzahladresse=7;ausgfelddruck(1):=text(an,druckbreite); +druckzeileschreiben(ausgfelddruck(1));drucke(text(wert(fnrschname), +druckbreite));drucke(text(wert(fnrschstrnr),druckbreite));drucke(text(wert( +fnrschplzort),druckbreite));#FOR iFROM 1UPTO 3REP ausgfelddruck(1):=text( +herkschuldaten(i),druckbreite);druckzeileschreiben(ausgfelddruck(1))PER ;# +FOR iFROM 1UPTO anzleerzeilenREP ausgfelddruck(1):=text(niltext,druckbreite); +druckzeileschreiben(ausgfelddruck(1))PER ;druckzeilenzahl:=druckzeilenzahl- +zeilenzahladresse.festentextschreiben:textanschr:=sequentialfile(input, +vordruckueberarbeitet);WHILE NOT eof(textanschr)REP getline(textanschr, +ausgfelddruck(1));druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1 +PER ;FOR iFROM 1UPTO anzleerzeilenREP ausgfelddruck(1):=text(niltext, +druckbreite);druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1PER . +unterschriftschreiben:LET schluessel="Schulleiter",klammer1="(",klammer2=")", +anzblank=5;TEXT VAR schulleiter;schulleiter:=schulkenndatum("Schulleiter"); +ausgfelddruck(1):=text(varanzblank*blank+klammer1+schulleiter+klammer2, +druckbreite);druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1; +ausgfelddruck(1):=text(anzblank*blank+schluessel,druckbreite); +druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1;FOR iFROM 1UPTO +anzleerzeilenREP ausgfelddruck(1):=text(niltext,druckbreite); +druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1PER .varanzblank: +anzblank-((length(schulleiter)+2-length(schluessel))DIV 2).# +dbwertezurueckholen:FOR iFROM 1UPTO 3REP dbwert(merker(i),i)PER .#END PROC +anherkliueberschriftdrucken;PROC drucke(TEXT CONST drucktext):ausgfelddruck(1 +):=drucktext;druckzeileschreiben(ausgfelddruck(1))ENDPROC drucke;PROC +schuelerdatendrucken(INT VAR zeilenzaehler):schuelerdatenholen; +schuelerdatenaufbereiten;zeilenzaehlerINCR ausgfeldlaenge; +schuelerdatenindruckdatei.END PROC schuelerdatendrucken;PROC +schuelerdatenholen:schuelername:=wert(fnrsufamnames);schuelerrufname:=wert( +fnrsurufnames);schuelernamenszus:=wert(fnrsunamenszusatzs);schuelergebdat:= +wert(fnrsugebdatums);schulkuerzel:=wert(fnrsuskennlschule);letzteklasse:=wert +(fnrsuklasselschule).END PROC schuelerdatenholen;PROC +schuelerdatenaufbereiten:LET restjgst5=" :",restjgst11=" : _________"; +schreibenamegebdatletzteklasse.schreibenamegebdatletzteklasse:spaltenweise( +schuelernameaufber);spaltenweise(schuelergebdat);IF jgst5THEN spaltenweise( +blank+letzteklasseaufber+restjgst5)ELSE spaltenweise(blank+letzteklasseaufber ++restjgst11)FI ;ausgfelddruck(1):=zeile.schuelernameaufber:schuelername+komma ++blank+schuelerrufname+blank+schuelernamenszus.letzteklasseaufber:IF +letzteklasse=niltextTHEN 3*blankELSE ((3-length(letzteklasse))*blank)+ +letzteklasseFI .END PROC schuelerdatenaufbereiten;PROC +schuelerdatenindruckdatei:druckzeileschreiben(ausgfelddruck(1)).END PROC +schuelerdatenindruckdatei;PROC bestandendesimulierenbeischulwechsel:IF +bestandendeTHEN neueherkschule:=FALSE ELSE neueherkschule:=schulkuerzel<>wert +(fnrsuskennlschule);IF neueherkschuleTHEN setzebestandende(TRUE )FI ;FI .END +PROC bestandendesimulierenbeischulwechsel;END PACKET anherklisten; + diff --git a/app/schulis/2.2.1/src/1.listen.gebu b/app/schulis/2.2.1/src/1.listen.gebu new file mode 100644 index 0000000..a025331 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.gebu @@ -0,0 +1,125 @@ +PACKET geburtslistenDEFINES gebulispezielleteile:LET niltext="",blank=" ", +mittestrich="-",null=0,komma=",",ueberschriftenzeilen=2,klas="Klasse",name= +"Name, Rufname",gebtag="Geburtstag",spalte1breite=7,spalte3breite=12, +anzspaltentrenner=2,ausgkopflaenge=2,ausgfeldlaenge=1,AUSGFELD =ROW +ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,gebulieingangsmaske= +"ms liste gebjahr eingang",gebulianfpos=2,mnrbearbeitetwird=100;INT CONST +spalte2bildbreite:=bildbreite-anzspaltentrenner-spalte1breite-spalte3breite; +INT VAR spalte2druckbreite,druckzeilenzahl,bildanf,eingabestatus, +aktuelleindexnr;TEXT VAR gebjahreingang,schuelername,schuelerrufname, +schuelernamenszus,schuelergebdat,klasse,alteklasse,druckstrich,bearbeitetwird +,startjahr,startgeschl;TEXT CONST bildstrich:=bildbreite*mittestrich; +AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR weibl,maennl, +ersteraufbildschirm,klassegeaendert:=FALSE ;#DBMASKE VAR sortiertnachgebjahr, +sortiertnachgebjahrgeschl,sortiertnachklassename;#BOOL PROC multistopstatus: +BOOL VAR b:=wert(fnrsustatuss)="ls";setzebestandende(NOT b);bENDPROC +multistopstatus;BOOL PROC multistopdrucken:BOOL VAR b:=multistopmitdbstatus( +FALSE );setzebestandende(NOT b);bENDPROC multistopdrucken;BOOL PROC +multistopmitdbstatusdrucken:BOOL VAR b:=multistopmitdbstatus(TRUE ); +setzebestandende(NOT b);bENDPROC multistopmitdbstatusdrucken;BOOL PROC +multistop:multistopmitdbstatus(FALSE )ENDPROC multistop;BOOL PROC +multistopmitdbstatus:multistopmitdbstatus(TRUE )ENDPROC multistopmitdbstatus; +BOOL PROC multistopmitdbstatus(BOOL CONST mitdbstatus):BOOL VAR b:=FALSE ;IF +wert(fnrsustatuss)="ls"THEN IF startgeschl<>""THEN IF wert(fnrsugeschlechts)= +startgeschlTHEN b:=(subtext(wert(fnrsugebdatums),7,8)=gebjahreingang)ELSE b:= +FALSE FI ELSE b:=(subtext(wert(fnrsugebdatums),7,8)=gebjahreingang);IF +mitdbstatusTHEN b:=bCAND (dbstatus=ok)FI FI ;FI ;bEND PROC +multistopmitdbstatus;PROC gebulispezielleteile(INT CONST nr):SELECT nrOF +CASE 1:gebulidialogvorbereitenCASE 2:gebulieingabenrichtigCASE 3: +gebulilistenvorbereitenCASE 4:gebulidruckvorbereitenCASE 5:gebuliseitedrucken +CASE 6:gebulibildschirmvorbereitenCASE 7:gebuliseitezeigenENDSELECT .END +PROC gebulispezielleteile;PROC gebulidialogvorbereiten:setzeanfangswerte( +gebulieingangsmaske,gebulianfpos)END PROC gebulidialogvorbereiten;PROC +gebulieingabenrichtig:LET fnrgebjahr=2,fnrmaennlich=3,fnrweiblich=4, +fnrausgdrucker=5,fnrausgbild=6;standardpruefe(2,fnrgebjahr,null,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE waspruefen;wohinpruefen;IF eingabestatus<>0THEN infeld( +eingabestatus);setzeeingabetest(FALSE )ELSE setzegeburtsjahr; +setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);setzeeingabetest +(TRUE )FI FI .waspruefen:weibl:=(standardmaskenfeld(fnrmaennlich)=niltext) +AND (standardmaskenfeld(fnrweiblich)<>niltext);maennl:=(standardmaskenfeld( +fnrweiblich)=niltext)AND (standardmaskenfeld(fnrmaennlich)<>niltext). +wohinpruefen:standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus).setzegeburtsjahr:gebjahreingang:=standardmaskenfeld(fnrgebjahr +);IF int(gebjahreingang)<10THEN gebjahreingang:=text(null)+text(int( +gebjahreingang))FI .END PROC gebulieingabenrichtig;PROC +gebulilistenvorbereiten:#bestanderstellen(PROC +bestandgeburtsjahrgaengeerstellen).#BOOL VAR b:=FALSE ;startjahr:="01.01."+ +gebjahreingang;setzescanendewert("01.01."+text(int(gebjahreingang)+1)); +setzescanstartwert(startjahr);IF weiblTHEN startgeschl:="w";ELIF maennlTHEN +startgeschl:="m";ELSE startgeschl:="";FI ;IF startgeschl=""THEN +aktuelleindexnr:=ixsustatgebELSE aktuelleindexnr:=ixsustatgeschlgeb;FI ; +inittupel(dnrschueler);initobli(14);parsenooffields(19);setzeidentiwert(""); +putdatumwert(fnrsugebdatums,startjahr);putwert(fnrsugeschlechts,startgeschl); +putwert(fnrsustatuss,"ls");dbstatus(ok);objektlistestarten(aktuelleindexnr,"" +,fnrsugebdatums,TRUE ,b);setzebestandende(NOT multistopmitdbstatus)END PROC +gebulilistenvorbereiten;PROC gebulibildschirmvorbereiten:LET fnrausganf=2, +gebuliueberschriftneu="Schülerliste Geburtsjahrgang 19";INT VAR i; +standardkopfmaskeaktualisieren(gebuliueberschriftneu+gebjahreingang); +initspalten;setzespaltenbreite(spalte1breite);setzespaltenbreite( +spalte2bildbreite);setzespaltenbreite(spalte3breite);initausgabekopf( +bildstrich);bildanf:=fnrausganf;FOR iFROM 1UPTO ausgkopflaengeREPEAT ausgkopf +(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext;# +setzenderhilfsgroessenfuersblaettern(min(bildblocklaenge,maxblocklaenge), +bildsatzzahl);#setzebildanfangsposition(bildanf).END PROC +gebulibildschirmvorbereiten;PROC gebuliseitezeigen:ersteraufbildschirm:=TRUE +;blaettern(PROC (INT CONST )schuelerzeigen,aktion,TRUE ,TRUE ,BOOL PROC +multistop).END PROC gebuliseitezeigen;PROC schuelerzeigen(INT CONST x): +schuelerholen1;schuelerholen2;IF ersteraufbildschirmTHEN klassegeaendert:= +TRUE ;ersteraufbildschirm:=FALSE FI ;schueleraufbereiten; +schueleraufbildschirm.END PROC schuelerzeigen;PROC schueleraufbildschirm:INT +VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos; +erhoeheausgabeposumeinsEND REPEAT .END PROC schueleraufbildschirm;PROC +gebulidruckvorbereiten:LET uebteil1="Liste der im Jahr 19",uebteil2= +" geborenen ",uebteil31="weiblichen ",uebteil32="männlichen ",uebteil4= +"Schüler";TEXT VAR ueberschrift;klasse:=niltext;druckvorbereiten; +variablenfuerdrucksetzen;ueberschriftvorbereitendruck;initdruckkopf( +ueberschrift);initspalten;setzespaltenbreite(spalte1breite); +setzespaltenbreite(spalte2druckbreite);setzespaltenbreite(spalte3breite); +initausgabekopf(druckstrich);holemeldungen;#putwert(dateinr(primdatid( +aktuelleindexnr))+1,"");putwert(fnrsugebdatums,"01.01."+gebjahreingang); +dbstatus(ok);#inittupel(dnrschueler);putwert(fnrsustatuss,"ls"); +aktuelleindexnr:=ixsustatjgstzug;BOOL VAR b;objektlistestarten( +aktuelleindexnr,"",fnrsusgrpzugtut,TRUE ,b);lesenvorbereitendruck(PROC (INT +CONST ,BOOL PROC ,INT VAR )scanforward,#BOOL PROC multistopmitdbstatusdrucken +#BOOL PROC multistopstatus).variablenfuerdrucksetzen:druckstrich:=druckbreite +*mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner-spalte1breite- +spalte3breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)- +ausgkopflaenge.ueberschriftvorbereitendruck:ueberschrift:=uebteil1+ +gebjahreingang+uebteil2;IF weiblTHEN ueberschrift:=ueberschrift+uebteil31 +ELSE IF maennlTHEN ueberschrift:=ueberschrift+uebteil32FI ;FI ;ueberschrift:= +ueberschrift+uebteil4.holemeldungen:meldungstext(mnrbearbeitetwird, +bearbeitetwird).END PROC gebulidruckvorbereiten;PROC gebuliseitedrucken: +gebuliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdrucken, +druckzeilenzahl,ausgfeldlaenge,#BOOL PROC multistopdrucken#BOOL PROC +multistopstatus);seitenwechsel.END PROC gebuliseitedrucken;PROC +gebuliueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO +ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC +gebuliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET +markiert="#";schuelerholen1;evtleave;schuelerholen2;ggflmeldungklasse;IF +zeilenzaehler=nullTHEN klassegeaendert:=TRUE FI ;IF klassegeaendertTHEN +leerzeileindruckdateiFI ;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge +;schuelerindruckdatei.evtleave:IF jahrstimmtnichtCOR geschlechtstimmtnicht +THEN LEAVE schuelerdruckenFI .jahrstimmtnicht:subtext(wert(fnrsugebdatums),7, +8)<>gebjahreingang.geschlechtstimmtnicht:startgeschl<>""CAND wert( +fnrsugeschlechts)<>startgeschl.ggflmeldungklasse:IF klassegeaendertTHEN +meldungklasseFI .meldungklasse:standardmeldung(bearbeitetwird,klasse+markiert +).leerzeileindruckdatei:ausgfeld(1):=text(blank,druckbreite); +druckzeileschreiben(ausgfeld(1));zeilenzaehlerINCR 1.END PROC schuelerdrucken +;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT +druckzeileschreiben(ausgfeld(i))END REPEAT .END PROC schuelerindruckdatei; +PROC initausgabekopf(TEXT CONST strich):spaltenweise(klas);spaltenweise(name) +;spaltenweise(gebtag);ausgkopf(1):=zeile;ausgkopf(2):=strich;END PROC +initausgabekopf;PROC schuelerholen1:schuelergebdat:=wert(fnrsugebdatums); +schuelername:=wert(fnrsufamnames);schuelerrufname:=wert(fnrsurufnames); +schuelernamenszus:=wert(fnrsunamenszusatzs);#alteklasse:=klasse;klasse:=wert( +fnrsusgrpjgst)+blank+wert(fnrsusgrpzugtut);klassegeaendert:=alteklasse<> +klasse.#END PROC schuelerholen1;PROC schuelerholen2:alteklasse:=klasse;klasse +:=wert(fnrsusgrpjgst)+blank+wert(fnrsusgrpzugtut);klassegeaendert:=alteklasse +<>klasse.END PROC schuelerholen2;PROC schueleraufbereiten: +schreibeklassenamegebdat.schreibeklassenamegebdat:IF klassegeaendertTHEN +spaltenweise(klasse)ELSE spaltenweise(blank)FI ;spaltenweise( +schuelernameaufber);spaltenweise(schuelergebdat);ausgfeld(1):=zeile. +schuelernameaufber:schuelername+komma+blank+schuelerrufname+blank+ +schuelernamenszus.END PROC schueleraufbereiten;END PACKET geburtslisten; + diff --git a/app/schulis/2.2.1/src/1.listen.gesamt b/app/schulis/2.2.1/src/1.listen.gesamt new file mode 100644 index 0000000..2ec7ee7 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.gesamt @@ -0,0 +1,106 @@ +PACKET gesamtlisteDEFINES geslispezielleteile:#LET dnrschueler=2, +ixsustatfamrufgeb=254,stattnachfolgendemI ndexixsustat=252,fnrsufamnames=3, +fnrsurufnames=4,fnrsustatuss=6,fnrsunamenszusatzs=21,fnrsugebdatums=5, +fnrsuabgdats=16,fnrsusgrpjgst=7,fnrsusgrpzugtut=8;#LET niltext="",nildatum= +"01.01.00",blank=" ",mittestrich="-",null=0,komma=",",kleina="a",stern="*", +ueberschriftenzeilen=1,altervolljaehrig=18,spalte2breite=10,spalte3breite=9, +anzspaltentrenner=2,spaltentrenner=":",ausgkopflaengebild=2, +ausgkopflaengedruck=6,ausgfeldlaenge=1,AUSGKOPFBILD =ROW ausgkopflaengebild +TEXT ,AUSGKOPFDRUCK =ROW ausgkopflaengedruckTEXT ,AUSGFELD =ROW +ausgfeldlaengeTEXT ,geslieingangsmaske="mu liste einfach eingang",geslianfpos +=2,nname="Name, Rufname",gebdat=" Geb.Dat.",klasse="Jgst./Kl.";INT CONST +spalte1bildbreite:=bildbreite-anzspaltentrenner-spalte2breite-spalte3breite; +INT VAR spalte1druckbreite,druckzeilenzahl,bildanf,vergldatum,eingabestatus; +TEXT VAR gesliueberschrift,schuelername,schuelerrufname,schuelernamenszus, +schuelergebdat,schuelerabdat,schuelernameaufber,gebdataufber,klasseaufber, +jahrgang,zug,anfbuchstabe,neueranfbuchstabe;TEXT VAR druckstrich;TEXT CONST +bildstrich:=bildbreite*mittestrich;AUSGFELD VAR ausgfeld;AUSGKOPFDRUCK VAR +ausgkopfdruck;AUSGKOPFBILD VAR ausgkopfbild;PROC geslispezielleteile(INT +CONST nr):SELECT nrOF CASE 1:geslidialogvorbereitenCASE 2: +geslieingabenrichtigCASE 3:geslilistenvorbereitenCASE 4:geslidruckvorbereiten +CASE 5:gesliseitedruckenCASE 6:geslibildschirmvorbereitenCASE 7: +gesliseitezeigenENDSELECT .END PROC geslispezielleteile;PROC +geslidialogvorbereiten:gesliueberschrift:=text(vergleichsknoten); +setzeanfangswerte(geslieingangsmaske,geslianfpos).END PROC +geslidialogvorbereiten;PROC geslieingabenrichtig:LET fnrausgdrucker=2, +fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext); +setzeeingabetest(TRUE )FI .END PROC geslieingabenrichtig;PROC +geslilistenvorbereiten:BOOL VAR b;setzespaltentrenner(spaltentrenner); +vergldatum:=vergleichsdatum(altervolljaehrig);inittupel(dnrschueler);initobli +(17);parsenooffields(21);setzeidentiwert("");putwert(fnrsustatuss,"ls"); +objektlistestarten(ixsustatfamrufgeb,"",fnrsufamnames,TRUE ,b); +setzebestandende(NOT multistopCOR b)END PROC geslilistenvorbereiten;BOOL +PROC multistop:wert(fnrsustatuss)="ls"ENDPROC multistop;BOOL PROC +multistopdruck:BOOL VAR b:=multistop;setzebestandende(NOT b);bENDPROC +multistopdruck;PROC geslibildschirmvorbereiten:LET fnrausganf=2; +standardkopfmaskeaktualisieren(gesliueberschrift);initspalten; +setzespaltenbreite(spalte1bildbreite);setzespaltenbreite(spalte2breite); +setzespaltenbreite(spalte3breite);initausgabekopfbild;bildanf:=fnrausganf; +INT VAR i;FOR iFROM 1UPTO ausgkopflaengebildREPEAT ausgkopfbild(i)IN bildanf; +bildanfINCR 1END REPEAT ;setzebildanfangsposition(bildanf).END PROC +geslibildschirmvorbereiten;PROC initausgabekopfbild:spaltenweise(nname); +spaltenweise(gebdat);spaltenweise(klasse);ausgkopfbild(1):=zeile;ausgkopfbild +(2):=bildstrich;END PROC initausgabekopfbild;PROC gesliseitezeigen:blaettern( +PROC (INT CONST )schuelerzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop)END +PROC gesliseitezeigen;BOOL PROC dummystop:#dbstatus<>ok#TRUE ENDPROC +dummystop;PROC schuelerzeigen(INT CONST x):schuelerholen;schueleraufbereiten; +schueleraufbildschirm;END PROC schuelerzeigen;PROC schueleraufbildschirm:INT +VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos; +erhoeheausgabeposumeinsEND REPEAT .END PROC schueleraufbildschirm;PROC +geslidruckvorbereiten:anfbuchstabe:=niltext;druckvorbereiten; +variablenfuerdrucksetzen;inittupel(dnrschueler);putwert(fnrsustatuss,"ls"); +lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL +PROC multistopdruck);initdruckkopf(zentriert(gesliueberschrift,druckbreite)); +initspalten;setzespaltenbreite(spalte1druckbreite);setzespaltenbreite( +spalte2breite);setzespaltenbreite(spalte3breite);initausgabekopfdruck. +variablenfuerdrucksetzen:druckstrich:=druckbreite*mittestrich; +spalte1druckbreite:=druckbreite-anzspaltentrenner-spalte2breite-spalte3breite +;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaengedruck.END +PROC geslidruckvorbereiten;PROC initausgabekopfdruck:LET kommentar1= +"Die abgemeldeten Schüler sind mit einem a vor Jgst./",kommentar2= +"Kl. markiert,",kommentar3="die volljährigen Schüler mit einem * vor dem ", +kommentar4="Geburtsdatum.";ausgkopfdruck(1):=text(kommentar1+kommentar2, +druckbreite);ausgkopfdruck(2):=text(kommentar3+kommentar4,druckbreite); +ausgkopfdruck(3):=text(niltext,druckbreite);ausgkopfdruck(4):=text(niltext, +druckbreite);spaltenweise(nname);spaltenweise(gebdat);spaltenweise(klasse); +ausgkopfdruck(5):=zeile;ausgkopfdruck(6):=druckstrich;END PROC +initausgabekopfdruck;PROC gesliseitedrucken:gesliueberschriftdrucken; +seitedrucken(PROC (INT VAR )schuelerdrucken,druckzeilenzahl,ausgfeldlaenge, +BOOL PROC multistopdruck);seitenwechsel.END PROC gesliseitedrucken;PROC +gesliueberschriftdrucken:druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO +ausgkopflaengedruckREPEAT druckzeileschreiben(ausgkopfdruck[i])END REPEAT . +END PROC gesliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler) +:LET bearbeitetwerden=102,markiert="#";schuelerholen;ggflmeldunganfbuchstabe; +schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge;schuelerindruckdatei. +ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN meldunganfbuchstabeFI . +anfbuchstabegeaendert:neueranfbuchstabe:=schuelernameSUB 1;anfbuchstabe<> +neueranfbuchstabe.meldunganfbuchstabe:standardmeldung(bearbeitetwerden, +neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC +schuelerdrucken;PROC schuelerindruckdatei:druckzeileschreiben(ausgfeld(1)). +END PROC schuelerindruckdatei;#PROC schuelerbestanderstellen(TEXT VAR aktbest +,DBMASKE VAR nameklassegebdat):setzemaske(nameklassegebdat, +"t c12 familienname/"+"t c12 rufname/"+"t c12 namenszusaetze(1)/"+ +"i c12 geburtsdatum/"+"i c12 abgangsdatum/"+"t c12 aktuelle schuelergruppe"); +aktbest:=bestand.END PROC schuelerbestanderstellen;#PROC schueleraufbereiten: +schuelervorbereiten;schreibenamegebdatklasse.schreibenamegebdatklasse: +ausgfeld(1):=zeile.END PROC schueleraufbereiten;PROC schuelervorbereiten: +schuelernamevorbereiten;gebdatvorbereiten;klassevorbereiten;zeilefuellen. +schuelernamevorbereiten:schuelernameaufber:=niltext;IF schuelernamenszus<> +niltextTHEN schuelernameaufber:=schuelernamenszus+blankFI ;schuelernameaufber +:=schuelernameaufber+schuelername+komma+blank+schuelerrufname. +gebdatvorbereiten:IF (schuelergebdat<>niltext)THEN IF volljaehrig(datum( +schuelergebdat))THEN gebdataufber:=sternELSE gebdataufber:=blankFI ; +gebdataufber:=gebdataufber+blank+schuelergebdatELSE gebdataufber:=niltextFI . +klassevorbereiten:IF (schuelerabdat<>nildatum)THEN klasseaufber:=kleinaELSE +klasseaufber:=blankFI ;klasseaufber:=klasseaufber+blank+jahrgang+blank+zug. +zeilefuellen:spaltenweise(schuelernameaufber);spaltenweise(gebdataufber); +spaltenweise(klasseaufber).END PROC schuelervorbereiten;BOOL PROC volljaehrig +(INT CONST geburtstag):geburtstag<=vergldatumEND PROC volljaehrig;PROC +schuelerholen:schuelername:=wert(fnrsufamnames);schuelerrufname:=wert( +fnrsurufnames);schuelernamenszus:=wert(fnrsunamenszusatzs);schuelergebdat:= +wert(fnrsugebdatums);schuelerabdat:=wert(fnrsuabgdats);jahrgang:=wert( +fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut);END PROC schuelerholen;END PACKET +gesamtliste; + diff --git a/app/schulis/2.2.1/src/1.listen.klassen b/app/schulis/2.2.1/src/1.listen.klassen new file mode 100644 index 0000000..7b4d39b --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.klassen @@ -0,0 +1,157 @@ +PACKET klassenlistenDEFINES klalispezielleteile:LET niltext="",blank=" ", +mittestrich="-",null=0,komma=",",stern="*",ueb1teil1="Klassenliste",ueb1teil2 +=" für Klasse ",ueb1teil3="Klassenlehrer: ",ueb2teil1="Tutorenkursliste", +ueb2teil21=" für Jahrgangsstufe ",ueb2teil22=" für den Kurs ",ueb2teil3= +"Tutor: ",ueb3="n der Jahrgangsstufe ",ueberschriftenzeilen=2, +spalte1druckbreite=3,spalte2bildbreite=7,anzspaltentrenner=1,ausgkopflaenge=2 +,ausgfeldlaenge=1,AUSGFELDDRUCK =ROW ausgfeldlaengeTEXT ,AUSGFELDBILD =ROW +ausgfeldlaengeTEXT ,AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ,AUSGKOPFBILD =ROW +ausgkopflaengeTEXT ,klalieingangsmaske="ms liste klassen eingang",klalianfpos +=2,nr="Nr.",name="Name, Rufname",sternvolljaehrig= +" ( * entspricht volljährig )",klasse="Klasse",altervolljaehrig=18, +mnrbearbeitetwird=100,mnrlistewirdgedruckt=58,mnrauswahlnichtsinnvoll=56;INT +CONST spalte1bildbreite:=bildbreite-anzspaltentrenner-spalte2bildbreite;INT +VAR spalte2druckbreite,druckzeilenzahlmax,druckzeilenzahl,bildanf,zaehler, +vergldatum,aktuelleindexnr,eingabestatus;TEXT VAR klaliueberschrift, +schuelername,schuelerrufname,schuelernamenszus,schuelergebdat, +schuelernameaufber,zaehleraufber,ueberschrift1,ueberschrift2,lehrer,jahrgang, +zug,startjgst,startzug,bearbeitetwird,listewirdgedruckt,auswahlnichtsinnvoll; +TEXT VAR druckstrich;TEXT CONST bildstrich:=bildbreite*mittestrich; +AUSGFELDDRUCK VAR ausgfelddruck;AUSGFELDBILD VAR ausgfeldbild;AUSGKOPFDRUCK +VAR ausgkopfdruck;AUSGKOPFBILD VAR ausgkopfbild;BOOL VAR einjahrgang,alle, +voll,neueklasse;BOOL PROC multistop:BOOL VAR b;IF startjgst<>""THEN IF +einjahrgangTHEN b:=wert(fnrsusgrpjgst)=startjgst;ELSE b:=wert(fnrsusgrpjgst)= +startjgstAND wert(fnrsusgrpzugtut)=startzug;FI ELSE b:=wert(fnrsustatuss)= +"ls";FI ;bEND PROC multistop;BOOL PROC multistopsim:BOOL VAR b:=multistop; +setzebestandende(NOT b);bENDPROC multistopsim;PROC klalispezielleteile(INT +CONST nr):SELECT nrOF CASE 1:klalidialogvorbereitenCASE 2: +klalieingabenrichtigCASE 3:klalilistenvorbereitenCASE 4:klalidruckvorbereiten +CASE 5:klaliseitedruckenCASE 6:klalibildschirmvorbereitenCASE 7: +klaliseitezeigenENDSELECT .END PROC klalispezielleteile;PROC +klalidialogvorbereiten:klaliueberschrift:=text(vergleichsknoten); +setzeanfangswerte(klalieingangsmaske,klalianfpos).END PROC +klalidialogvorbereiten;PROC klalieingabenrichtig:LET fnrjgst=2,fnrzug=3, +fnrvoll=4,fnrausgdrucker=5,fnrausgbild=6;alle:=FALSE ;einjahrgang:=FALSE ; +voll:=FALSE ;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE zug:=standardmaskenfeld(fnrzug);jahrgang:=standardmaskenfeld( +fnrjgst);IF standardmaskenfeld(fnrjgst)=niltextTHEN IF zug=niltextTHEN alle:= +TRUE ;voll:=(standardmaskenfeld(fnrvoll)<>niltext);setzeausgabedrucker( +standardmaskenfeld(fnrausgbild)=niltext);setzeeingabetest(TRUE )ELSE +meldefehler;infeld(fnrzug);setzeeingabetest(FALSE )FI ELSE standardpruefe(3, +fnrjgst,5,13,niltext,eingabestatus);IF eingabestatus<>0THEN infeld( +eingabestatus);setzeeingabetest(FALSE )ELSE jahrgang:=zweistellig( +standardmaskenfeld(fnrjgst));einjahrgang:=(zug=niltext);voll:=( +standardmaskenfeld(fnrvoll)<>niltext);setzeausgabedrucker(standardmaskenfeld( +fnrausgbild)=niltext);setzeeingabetest(TRUE )FI FI FI .meldefehler: +meldungstext(mnrauswahlnichtsinnvoll,auswahlnichtsinnvoll);standardmeldung( +auswahlnichtsinnvoll,niltext).END PROC klalieingabenrichtig;PROC +klalilistenvorbereiten:BOOL VAR b:=FALSE ;startjgst:=jahrgang;startzug:=zug; +neueklasse:=FALSE ;aktuelleindexnr:=ixsustatjgstzug;inittupel(dnrschueler); +initobli(17);parsenooffields(19);setzeidentiwert("");putwert(fnrsustatuss, +"ls");putwert(fnrsusgrpjgst,startjgst);putwert(fnrsusgrpzugtut,startzug); +vergldatum:=vergleichsdatum(altervolljaehrig);#objektlistestarten( +aktuelleindexnr,"",fnrsustatuss,TRUE ,b);#objektlistestarten(aktuelleindexnr, +"",staticfield,TRUE ,b);setzebestandende(NOT multistopCOR b).staticfield:IF +startjgst=niltextTHEN fnrsusgrpjgstELSE IF startzug=niltextTHEN +fnrsusgrpzugtutELSE dnrschueler+1FI FI .END PROC klalilistenvorbereiten;PROC +klalibildschirmvorbereiten:LET fnrausganf=2;ueberschriftvorbereitenbild; +standardkopfmaskeaktualisieren(ueberschrift1);initspalten;initausgabekopfbild +;bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT +ausgkopfbild(i)IN bildanf;bildanfINCR 1END REPEAT ;setzebildanfangsposition( +bildanf).END PROC klalibildschirmvorbereiten;PROC ueberschriftvorbereitenbild +:LET aufein="",aufaus=" ";IF alleTHEN ueberschrift1:=klaliueberschriftELSE +IF einjahrgangTHEN IF int(jahrgang)<11THEN ueberschrift1:=ueb1teil1ELSE +ueberschrift1:=ueb2teil1FI ;ueberschrift1:=ueberschrift1+ueb3+aufein+jahrgang ++aufausELSE IF int(jahrgang)<11THEN ueberschrift1:=ueb1teil1+ueb1teil2ELSE +ueberschrift1:=ueb2teil1+ueb2teil22FI ;ueberschrift1:=ueberschrift1+aufein+ +jahrgang+blank+wert(fnrsusgrpzugtut)+aufausFI FI ;END PROC +ueberschriftvorbereitenbild;PROC initausgabekopfbild:IF einjahrgangOR alle +THEN hilfsfeldervorbelegen;ausgkopfbild(1):=zeileELSE ausgkopfbild(1):=text( +name,bildbreite)FI ;ausgkopfbild(2):=bildstrich.hilfsfeldervorbelegen: +setzespaltenbreite(spalte1bildbreite);setzespaltenbreite(spalte2bildbreite); +IF vollTHEN spaltenweise(name+sternvolljaehrig)ELSE spaltenweise(name)FI ; +spaltenweise(klasse).END PROC initausgabekopfbild;PROC klaliseitezeigen: +blaettern(PROC (INT CONST )schuelerdatenzeigen,aktion,TRUE ,TRUE ,BOOL PROC +multistop)END PROC klaliseitezeigen;PROC schuelerdatenzeigen(INT CONST x): +schuelerdatenholen;schuelerdatenaufbereitenbild;schuelerdatenaufbildschirm. +END PROC schuelerdatenzeigen;PROC schuelerdatenaufbereitenbild: +schuelernameaufbereiten;IF alleOR einjahrgangTHEN schreibenamerufnameklasse +ELSE schreibenamerufnameFI .schreibenamerufnameklasse:spaltenweise( +schuelernameaufber);spaltenweise(jahrgang+blank+wert(fnrsusgrpzugtut)); +ausgfeldbild(1):=zeile.schreibenamerufname:ausgfeldbild(1):=text( +schuelernameaufber,bildbreite).END PROC schuelerdatenaufbereitenbild;PROC +schuelerdatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT +ausgfeldbild(i)IN ausgabepos;erhoeheausgabeposumeinsEND REPEAT .END PROC +schuelerdatenaufbildschirm;PROC klalidruckvorbereiten:zaehler:=null; +neueklasse:=TRUE ;druckvorbereiten;variablenfuerdrucksetzen;druckzeilenzahl:= +druckzeilenzahlmax;IF vollTHEN druckzeilenzahl:=druckzeilenzahl-2FI ; +holemeldung;inittupel(dnrschueler);putwert(fnrsusgrpjgst,startjgst);putwert( +fnrsusgrpzugtut,startzug);putwert(fnrsustatuss,"ls");lesenvorbereitendruck( +PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC multistopsim); +ueberschriftvorbereitendruck;initdruckkopf(ueberschrift1,ueberschrift2); +initspalten;initausgabekopfdruck.variablenfuerdrucksetzen:druckstrich:= +druckbreite*mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner- +spalte1druckbreite;druckzeilenzahlmax:=drucklaenge(ueberschriftenzeilen)- +ausgkopflaenge.holemeldung:meldungstext(mnrbearbeitetwird,bearbeitetwird). +END PROC klalidruckvorbereiten;PROC ueberschriftvorbereitendruck:IF int( +jahrgang)<11THEN ueberschrift1:=ueb1teil1+ueb1teil2+wert(fnrsusgrpjgst)+blank ++wert(fnrsusgrpzugtut);ueberschrift2:=ueb1teil3ELSE ueberschrift1:=ueb2teil1+ +ueb2teil21+jahrgang;ueberschrift2:=ueb2teil3FI ;klassenlehrer(lehrer,jahrgang +,wert(fnrsusgrpzugtut));ueberschrift2:=ueberschrift2+lehrer;END PROC +ueberschriftvorbereitendruck;PROC klassenlehrer(TEXT VAR lehrer,TEXT CONST +jahrgang,TEXT CONST zug):putwert(fnrsgrpsj,schulkenndatum("Schuljahr")); +putwert(fnrsgrphj,schulkenndatum("Schulhalbjahr"));putwert(fnrsgrpjgst, +jahrgang);putwert(fnrsgrpkennung,zug);search(dnraktschuelergruppen,TRUE );IF +dbstatus=okTHEN putwert(fnrlparaphe,wert(fnrsgrplehrer));search(dnrlehrer, +TRUE );IF dbstatus=okTHEN lehrer:=wert(fnrlfamname)ELSE lehrer:=""FI ;ELSE +lehrer:=""FI END PROC klassenlehrer;PROC initausgabekopfdruck: +hilfsfeldervorbelegen;ausgkopfdruck(1):=zeile;ausgkopfdruck(2):=druckstrich. +hilfsfeldervorbelegen:setzespaltenbreite(spalte1druckbreite); +setzespaltenbreite(spalte2druckbreite);spaltenweise(nr);spaltenweise(name). +END PROC initausgabekopfdruck;PROC klaliseitedrucken:LET kommentar= +"* Schüler ist am Tag der Listenerstellung volljährig"; +klaliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdatendrucken, +druckzeilenzahl,ausgfeldlaenge,PROC bestandendesimulierenbeiklassenwechsel, +BOOL PROC multistopsim);ggflkommentarzeile;IF neueklasseTHEN +simuliertesendezuruecknehmen;neuelistevorbereitenELSE seitenwechselFI . +ggflkommentarzeile:IF vollTHEN kommentarzeiledruckenFI .kommentarzeiledrucken +:ausgfelddruck(1):=text(niltext,druckbreite);druckzeileschreiben( +ausgfelddruck(1));ausgfelddruck(1):=text(kommentar,druckbreite); +druckzeileschreiben(ausgfelddruck(1)).simuliertesendezuruecknehmen: +setzebestandende(FALSE ).neuelistevorbereiten:meldelistewirdgedruckt; +drucknachbereiten;druckvorbereiten;zaehler:=null;schuelerdatenholen; +ueberschriftvorbereitendruck;initdruckkopf(ueberschrift1,ueberschrift2). +meldelistewirdgedruckt:meldungstext(mnrlistewirdgedruckt,listewirdgedruckt); +standardmeldung(listewirdgedruckt,niltext).END PROC klaliseitedrucken;PROC +klaliueberschriftdrucken:druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO +ausgkopflaengeREPEAT druckzeileschreiben(ausgkopfdruck(i))END REPEAT .END +PROC klaliueberschriftdrucken;PROC schuelerdatendrucken(INT VAR zeilenzaehler +):LET markiert="#";schuelerdatenholen;ggflmeldungklasse;zaehlerINCR 1; +schuelerdatenaufbereitendruck;zeilenzaehlerINCR ausgfeldlaenge; +schuelerdatenindruckdatei.ggflmeldungklasse:IF zaehler=nullTHEN +standardmeldung(bearbeitetwird,jahrgang+blank+zug+markiert)FI .END PROC +schuelerdatendrucken;PROC schuelerdatenaufbereitendruck:zaehleraufbereiten; +schuelernameaufbereiten;schreibenrnamerufname.zaehleraufbereiten:IF zaehler< +10THEN zaehleraufber:=blankELSE zaehleraufber:=niltextFI ;zaehleraufber:= +zaehleraufber+text(zaehler).schreibenrnamerufname:spaltenweise(zaehleraufber) +;spaltenweise(schuelernameaufber);ausgfelddruck(1):=zeile;END PROC +schuelerdatenaufbereitendruck;PROC schuelerdatenindruckdatei: +druckzeileschreiben(ausgfelddruck(1)).END PROC schuelerdatenindruckdatei; +PROC bestandendesimulierenbeiklassenwechsel:IF bestandendeTHEN neueklasse:= +FALSE ELSE nochklassezubearbeiten;IF neueklasseTHEN setzebestandende(TRUE ) +FI ;FI .nochklassezubearbeiten:neueklasse:=zug<>wert(fnrsusgrpzugtut);IF alle +THEN neueklasse:=neueklasseOR (int(jahrgang)<>int(wert(fnrsusgrpjgst)))FI . +END PROC bestandendesimulierenbeiklassenwechsel;PROC schuelernameaufbereiten: +schuelernameaufber:=niltext;IF schuelernamenszus<>niltextTHEN +schuelernameaufber:=schuelernamenszus+blankFI ;schuelernameaufber:= +schuelernameaufber+schuelername+komma+blank+schuelerrufname;IF vollCAND ( +schuelergebdat<>niltext)CAND volljaehrig(datum(schuelergebdat))THEN +schuelernameaufber:=schuelernameaufber+blank+sternFI ;END PROC +schuelernameaufbereiten;BOOL PROC volljaehrig(INT CONST geburtstag): +geburtstag<=vergldatumEND PROC volljaehrig;PROC schuelerdatenholen: +schuelername:=wert(fnrsufamnames);schuelerrufname:=wert(fnrsurufnames); +schuelernamenszus:=wert(fnrsunamenszusatzs);schuelergebdat:=wert( +fnrsugebdatums);jahrgang:=wert(fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut).END +PROC schuelerdatenholen;END PACKET klassenlisten; + diff --git a/app/schulis/2.2.1/src/1.listen.klassenbuch b/app/schulis/2.2.1/src/1.listen.klassenbuch new file mode 100644 index 0000000..e0c2386 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.klassenbuch @@ -0,0 +1,237 @@ +PACKET klassenbuchlistenDEFINES klabulispezielleteile:LET nildatumdb= +"01.01.00",niltext="",blank=" ",mittestrich="-",null=0,slspalte3breite=16, +slanzspaltentrenner=2,ausgkopflaenge=3,ausgfeldlaenge=3,maxanzproseite=50, +AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,SPEICHER +=ROW maxanzproseiteTEXT ,klabulieingangsmaske="ms liste klabuch eingang", +klabulianfpos=2,#dnrschueler=2,fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums +=5,fnrsustatuss=6,fnrsusgrpjgst=7,fnrsusgrpzugtut=8,fnrsugeschlechts=12, +fnrsunamenszusatzs=21,fnrsustrnrs=24,fnrsuplzorts=25,dbiplz=--,fnrsutelnrs=26 +,fnrsutidiffdaten=52,dnrdiffdaten=53,fnrddreliunter=67,fnrddreliunteranmeld= +69,fnrddreliunterabmeld=68,fnrddkunstmusik=70,fnrddfach091a=71,fnrddfach091b= +72,fnrddfach092a=73,fnrddfach092b=74,fnrddfach101a=75,fnrddfach101b=76, +fnrddfach102a=77,fnrddfach102b=78,fnrhjdfamnames=89,fnrhjdrufnames=90, +fnrhjdgebdats=91,fnrhjdhj=93,fnrhjdjgst=94,fnrhjdfach=113,fnrhjdkursart=114, +dnrfaecher=141,fnrffach=142,fnrffachbez=143,ixhjdfamrufgebjgsthj=276, +ixsustatjgstzug=255,#mnrlistewirdgedruckt=58,mnrbearbeitetwird=100, +mnrauswahlnichtsinnvoll=56;INT VAR slspalte1breite,slspalte2breite, +druckzeilenzahlgrund,druckzeilenzahl,druckzeilenzahlrest,zaehler,anzzaehler, +indexspeicher,eingabestatus,aktuelleindexnr;TEXT VAR vordruck, +vordruckueberarbsl,vordruckueberarbsr,klabuliueberschrift, +auswahlnichtsinnvoll,listewirdgedruckt,bearbeitetwird,startjahr,startzug, +schuelername,schuelerrufname,schuelernamenszus,jahrgang,zug,schuelerstrasse, +schuelerort,schuelertelefon,schuelergebdat,schuelergeschlecht,schuelerreliunt +,schuelersprachen,schuelermusfach,schuelerwpffach,schuelerkursfachbez, +schuelerkursartbez,zaehleraufber,lehrer,puffer1,puffer2,druckstrich;AUSGFELD +VAR ausgfeld;AUSGKOPF VAR slausgkopf,srausgkopf;SPEICHER VAR speicher;FILE +VAR f,g;BOOL VAR einjahrgang,alle,elementsek1,neueklasse:=FALSE ;BOOL PROC +multistopsim:BOOL VAR b:=FALSE ;IF wert(fnrsustatuss)="ls"THEN IF startjahr<> +""THEN b:=wert(fnrsusgrpjgst)=startjahr;IF bCAND startzug<>""THEN b:=wert( +fnrsusgrpzugtut)=startzugFI ELSE #b:=dbstatus=ok;#b:=wert(fnrsustatuss)="ls" +FI ;FI ;setzebestandende(NOT b);bEND PROC multistopsim;PROC +klabulispezielleteile(INT CONST nr):SELECT nrOF CASE 1: +klabulidialogvorbereiten;CASE 2:klabulieingabenrichtig;CASE 3: +klabulilistenvorbereiten;CASE 4:klabulidruckvorbereiten;CASE 5: +klabuliseitedrucken;ENDSELECT .END PROC klabulispezielleteile;PROC +klabulidialogvorbereiten:klabuliueberschrift:=text(vergleichsknoten); +setzeanfangswerte(klabulieingangsmaske,klabulianfpos).END PROC +klabulidialogvorbereiten;PROC klabulieingabenrichtig:LET fnrjgst=2,fnrzug=3; +alle:=FALSE ;einjahrgang:=FALSE ;reinitparsing;zug:=standardmaskenfeld(fnrzug +);jahrgang:=standardmaskenfeld(fnrjgst);IF standardmaskenfeld(fnrjgst)= +niltextTHEN IF zug=niltextTHEN alle:=TRUE ;setzeausgabedrucker(TRUE ); +setzeeingabetest(TRUE )ELSE meldefehler;infeld(fnrzug);setzeeingabetest( +FALSE )FI ELSE standardpruefe(3,fnrjgst,5,13,niltext,eingabestatus);IF +eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest(FALSE )ELSE +jahrgang:=zweistellig(standardmaskenfeld(fnrjgst));einjahrgang:=(zug=niltext) +;setzeausgabedrucker(TRUE );setzeeingabetest(TRUE )FI FI .meldefehler: +meldungstext(mnrauswahlnichtsinnvoll,auswahlnichtsinnvoll);standardmeldung( +auswahlnichtsinnvoll,niltext).END PROC klabulieingabenrichtig;PROC +klabulilistenvorbereiten:BOOL VAR b;startjahr:=jahrgang;startzug:=zug; +aktuelleindexnr:=ixsustatjgstzug;inittupel(dnrschueler);initobli(9); +setzeidentiwert("");putwert(fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut, +startzug);putwert(fnrsustatuss,"ls");#objektlistestarten(aktuelleindexnr,"", +fnrsusgrpjgst,TRUE ,b);#objektlistestarten(aktuelleindexnr,"",fnrsustatuss, +TRUE ,b);setzebestandende(NOT multistopsim)END PROC klabulilistenvorbereiten; +PROC klabulidruckvorbereiten:LET vordr="vordruck klassenbuchliste",manager= +"anschreiben server";setzemitseitennummern(FALSE );zaehler:=null;neueklasse:= +TRUE ;druckvorbereiten;variablenfuerdrucksetzen;holemeldungen;inittupel( +dnrschueler);putwert(fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut, +startzug);putwert(fnrsustatuss,"ls");lesenvorbereitendruck(PROC (INT CONST , +BOOL PROC ,INT VAR )scanforward,BOOL PROC multistopsim); +vordruckvommanagerholen;ueberschriftenvorbereiten;initspalten; +ausgabekoepfevorbereiten;ausgfeld(3):=druckstrich.holemeldungen:meldungstext( +mnrbearbeitetwird,bearbeitetwird).variablenfuerdrucksetzen:druckstrich:= +druckbreite*mittestrich;slspalte2breite:=(druckbreite-slanzspaltentrenner- +slspalte3breite)DIV 2;slspalte1breite:=druckbreite-slanzspaltentrenner- +slspalte2breite-slspalte3breite;druckzeilenzahlgrund:=drucklaenge- +ausgkopflaenge.vordruckvommanagerholen:vordruck:=vordr;forget(vordruck,quiet) +;fetch(vordruck,/manager).END PROC klabulidruckvorbereiten;PROC +ueberschriftenvorbereiten:LET swischuledatum=511,swiuebzeile=512, +vordrueberarbsl="vordruck ueberarbeitet sl",vordrueberarbsr= +"vordruck ueberarbeitet sr",beginnsek2=11,uebteil1sek1="Klasse: ", +uebteil1sek2="Tutorenkurs: ",ueb1teil2sek1=" Klassenlehrer: ",ueb1teil2sek2 +=" Tutor: ",ueb2teil2="Schuljahr ";jahrgangundzugholen;elementsek1bestimmen +;#puffer1:=wert();#setzesonderwerteschulkenndaten;#putwert(,puffer1);# +vordruckfuellenfuerueberschrift1;vordruckfuellenfuerueberschrift2; +verbleibendedruckzeilenzahlbestimmen.jahrgangundzugholen:jahrgang:=wert( +fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut).elementsek1bestimmen:elementsek1:= +FALSE ;IF int(jahrgang)int(wert( +fnrsusgrpjgst));IF neueklasseTHEN ausgabekopfsrvorbelegenFI ;neueklasse:= +neueklasseOR (zug<>wert(fnrsusgrpzugtut));ELSE neueklasse:=zug<>wert( +fnrsusgrpzugtut)FI .END PROC bestandendesimulierenbeiklassenwechsel;PROC +schuelerdatendrucken(INT VAR zeilenzaehler):LET markiert="#"; +schuelerdatenholen;ggflmeldungklasse;zaehlerINCR 1;anzzaehlerINCR 1; +schuelerdatenaufbereiten;zeilenzaehlerINCR ausgfeldlaenge; +schuelerdatenindruckdatei.ggflmeldungklasse:IF zaehler=nullTHEN +standardmeldung(bearbeitetwird,jahrgang+blank+zug+markiert)FI .END PROC +schuelerdatendrucken;PROC schuelerdatenholen:LET weiblich="w",maennlich="m", +junge="J",maedchen="M",anzsprachen=4,prosprache=3;INT VAR i,j;schuelername:= +wert(fnrsufamnames);schuelerrufname:=2*blank+wert(fnrsurufnames); +schuelernamenszus:=wert(fnrsunamenszusatzs);jahrgang:=wert(fnrsusgrpjgst);zug +:=wert(fnrsusgrpzugtut);schuelerstrasse:=wert(fnrsustrnrs);schuelerort:=wert( +fnrsuplzorts);schuelertelefon:=wert(fnrsutelnrs);schuelergebdat:=wert( +fnrsugebdatums);IF wert(fnrsugeschlechts)=weiblichTHEN schuelergeschlecht:= +maedchenELIF wert(fnrsugeschlechts)=maennlichTHEN schuelergeschlecht:=junge +ELSE schuelergeschlecht:=blankFI ;IF elementsek1THEN +diffdatenholenundaufbereitenELSE schuelerkursfachbez:=niltext; +schuelerkursartbez:=niltext;kursdatenholenundaufbereitenFI . +diffdatenholenundaufbereiten:INT VAR difstatus:=0;inittupel(dnrdiffdaten);IF +wert(fnrsutiddiffdaten)<>""THEN disablestop;readtid(dnrdiffdaten,wert( +fnrsutiddiffdaten));IF iserrorTHEN clearerror;difstatus:=1FI ;enablestopFI ; +IF difstatus=0THEN schuelersprachen:=niltext;sprachenaufbereiten; +schuelerreliunt:=wert(fnrddreliunter);schuelermusfach:=wert(fnrddkunstmusik); +schuelerwpffach:=niltext;IF jahrgang="09"THEN wpf9aufbereitenELIF jahrgang= +"10"THEN wpf10aufbereitenFI FI .sprachenaufbereiten:FOR iFROM 0UPTO +anzsprachen-1REP j:=(3*i)+55;puffer1:=wert(j);schuelersprachen:= +schuelersprachen+puffer1+(prosprache-length(puffer1))*blankPER . +wpf9aufbereiten:puffer1:=wert(fnrddfach091a);schuelerwpffach:=puffer1+(5- +length(puffer1))*blank;puffer1:=wert(fnrddfach091b);schuelerwpffach:= +schuelerwpffach+puffer1+(5-length(puffer1))*blank;puffer1:=wert(fnrddfach092a +);schuelerwpffach:=schuelerwpffach+puffer1+(5-length(puffer1))*blank;puffer1 +:=wert(fnrddfach092b);schuelerwpffach:=schuelerwpffach+puffer1+(5-length( +puffer1))*blank.wpf10aufbereiten:puffer1:=wert(fnrddfach101a);schuelerwpffach +:=puffer1+(5-length(puffer1))*blank;puffer1:=wert(fnrddfach101b); +schuelerwpffach:=schuelerwpffach+puffer1+(5-length(puffer1))*blank;puffer1:= +wert(fnrddfach102a);schuelerwpffach:=schuelerwpffach+puffer1+(5-length( +puffer1))*blank;puffer1:=wert(fnrddfach102b);schuelerwpffach:=schuelerwpffach ++puffer1+(5-length(puffer1))*blank.kursdatenholenundaufbereiten:putwert( +fnrhjdfamnames,schuelername);putwert(fnrhjdrufnames,compress(schuelerrufname) +);putwert(fnrhjdgebdats,schuelergebdat);putwert(fnrhjdjgst,jahrgang);putwert( +fnrhjdhj,schulkenndatum("Schulhalbjahr"));search(ixhjdfamrufgebjgsthj,TRUE ); +pause(5);IF dbstatus=okTHEN kursartzuweisenFI .#dr31.03.88kursartzuweisen: +TEXT VAR suchbegriff:="";FOR iFROM 1UPTO (length(wert(fnrhjdfach))DIV 2)REP +puffer1:=wert(fnrhjdkursart)SUB i;schuelerkursartbez:=schuelerkursartbez+ +puffer1+(2-length(puffer1))*blank;suchbegriff:=subtext(wert(fnrhjdfach),(2*i) +-1,2*i);suchbegriff:=compress(suchbegriff);putwert(fnrffach,suchbegriff); +search(dnrfaecher,TRUE );IF dbstatus=okTHEN puffer1:=wert(fnrffachbez); +schuelerkursfachbez:=schuelerkursfachbez+puffer1+(3-length(puffer1))*blank; +FI ;PER .#kursartzuweisen:TEXT VAR suchbegriff:="";FOR iFROM 1UPTO (length( +wert(fnrhjdfach))DIV 2)REP suchbegriff:=subtext(wert(fnrhjdfach),(2*i)-1,2*i) +;suchbegriff:=compress(suchbegriff);putwert(fnrffach,suchbegriff);search( +dnrfaecher,TRUE );IF dbstatus=okTHEN puffer1:=wert(fnrffach); +schuelerkursfachbez:=schuelerkursfachbez+text(puffer1,3);puffer1:=wert( +fnrhjdkursart)SUB i;schuelerkursartbez:=schuelerkursartbez+text(puffer1,3); +ELSE schuelerkursfachbez:=schuelerkursfachbez+(3*blank);schuelerkursartbez:= +schuelerkursartbez+(3*blank);FI ;PER .END PROC schuelerdatenholen;PROC +schuelerdatenaufbereiten:zaehleraufbereiten;schreibenrnamestrassetelnr; +schreiberufnameort;datenfuerrechteseitespeichern.schreibenrnamestrassetelnr: +spaltenweise(zaehleraufber+2*blank+schuelername);spaltenweise(schuelerstrasse +);spaltenweise(schuelertelefon);ausgfeld(1):=zeile.schreiberufnameort: +spaltenweise(4*blank+schuelerrufname+blank+schuelernamenszus);spaltenweise( +schuelerort);spaltenweise(blank);ausgfeld(2):=zeile. +datenfuerrechteseitespeichern:indexspeicherINCR 1;speicher(indexspeicher):= +zaehleraufber+2*blank+aufbgebdat+3*blank+schuelergeschlecht;IF elementsek1 +THEN speicher(indexspeicher):=speicher(indexspeicher)+6*blank+aufbreliunt+5* +blank+schuelersprachen+4*blank+aufbmusfach+6*blank+schuelerwpffach; +indexspeicherINCR 1ELSE speicher(indexspeicher):=speicher(indexspeicher)+3* +blank+schuelerkursfachbez;indexspeicherINCR 1;speicher(indexspeicher):=19* +blank+schuelerkursartbezFI .aufbgebdat:IF schuelergebdat=niltextTHEN 8*blank +ELSE schuelergebdatFI .aufbreliunt:IF schuelerreliunt=niltextOR (reliabmeld +AND NOT relianmeld)THEN 2*blankELSE schuelerreliuntFI .reliabmeld:wert( +fnrddabmeldedatreli)<>nildatumdb.relianmeld:wert(fnrddanmeldedatreli)<> +nildatumdb.aufbmusfach:IF schuelermusfach=niltextTHEN 2*blankELSE +schuelermusfachFI .END PROC schuelerdatenaufbereiten;PROC +schuelerdatenindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +druckzeileschreiben(ausgfeld(i))PER ;druckzeilenzahlrestDECR ausgfeldlaenge. +END PROC schuelerdatenindruckdatei;PROC leereschuelereintragen:INT VAR +leereschuelermoeglich,i;indexspeicherINCR 1;moeglicheschuelereintragen. +moeglicheschuelereintragen:leereschuelermoeglich:=druckzeilenzahlrestDIV +ausgfeldlaenge;FOR iFROM 1UPTO leereschuelermoeglichREP zaehlerINCR 1; +zaehleraufbereiten;ausgfeld(1):=text(zaehleraufber,druckbreite);ausgfeld(2):= +text(blank,druckbreite);schuelerdatenindruckdatei; +leerenschuelerfuerrechteseitespeichernPER . +leerenschuelerfuerrechteseitespeichern:anzzaehlerINCR 1;speicher( +indexspeicher):=text(zaehleraufber,druckbreite);indexspeicherINCR 2.END PROC +leereschuelereintragen;PROC rechteseitedrucken:INT VAR i,j;seitenwechsel; +klabulisrueberschriftdrucken;FOR iFROM 1UPTO anzzaehlerREP j:=2*i;ausgfeld(1) +:=speicher(j-1);ausgfeld(2):=speicher(j);schuelerdatenindruckdateiPER .END +PROC rechteseitedrucken;PROC klabulisrueberschriftdrucken:INT VAR i;input(g); +WHILE NOT eof(g)REP getline(g,ausgfeld(1));druckzeileschreiben(ausgfeld(1)); +PER ;druckzeileschreiben(druckstrich);FOR iFROM 1UPTO ausgkopflaengeREPEAT +druckzeileschreiben(srausgkopf(i))END REPEAT .END PROC +klabulisrueberschriftdrucken;PROC zaehleraufbereiten:LET zaehlerzweistellig= +10;IF zaehler0 +THEN infeld(eingabestatus);setzeeingabetest(FALSE )ELSE waspruefenFI . +waspruefen:sek1:=FALSE ;sek2:=FALSE ;fach1:="";fach2:="";fach3:=""; +reinitparsing;IF standardmaskenfeld(fnrjgst)=niltextTHEN standardpruefe(5, +fnrsek1,fnrsek2,null,niltext,eingabestatus);IF eingabestatus<>0THEN infeld( +eingabestatus);setzeeingabetest(FALSE )ELSE sek1:=standardmaskenfeld(fnrsek2) +=niltext;sek2:=NOT sek1;setzeausgabedrucker(standardmaskenfeld(fnrausgbild)= +niltext);setzeeingabetest(TRUE )FI ;ELSE IF (standardmaskenfeld(fnrsek1)= +niltext)AND (standardmaskenfeld(fnrsek2)=niltext)THEN standardpruefe(3, +fnrjgst,5,13,niltext,eingabestatus);IF eingabestatus<>0THEN infeld( +eingabestatus);setzeeingabetest(FALSE )ELSE jgst:=zweistellig( +standardmaskenfeld(fnrjgst));setzeausgabedrucker(standardmaskenfeld( +fnrausgbild)=niltext);setzeeingabetest(TRUE )FI ;ELSE meldefehler;infeld( +fnrsek1);setzeeingabetest(FALSE )FI ;FI .meldefehler:standardmeldung( +auswahlnichtsinnvoll,niltext).END PROC nachprlieingabenrichtig;PROC +nachprlilistenvorbereiten:BOOL VAR b;LET schluessel="Schuljahr"; +startwertjgstbestimmen;aktuellesschuljahrermitteln;inittupel( +dnrhalbjahresdaten);initobli(4);setzeidentiwert("");startwertesetzen; +objektlistestarten(ixhjdversjhjjgstkenn,"",fnrhjdjgst,TRUE ,b); +setzebestandende(NOT multistopnachprueflerCOR b).startwertjgstbestimmen: +aktuellesschuljahr:=schulkenndatum("Schuljahr");endewertjgst:=endeberechnung; +startwertjgst:=anfangsberechnung;.anfangsberechnung:IF sek1THEN "05"ELIF sek2 +THEN "11"ELSE jgstFI .endeberechnung:IF sek1THEN "11"ELIF sek2THEN "14"ELSE +text(int(jgst)+1)FI .startwertesetzen:putwert(fnrhjdversetzung, +schluesselnachpruefler);putwert(fnrhjdjgst,startwertjgst);putwert(fnrhjdsj, +aktuellesschuljahr);putintwert(fnrhjdhj,2).aktuellesschuljahrermitteln: +schuljahr:=schulkenndatum(schluessel);jahr1:=subtext(schuljahr,1,2);jahr2:= +subtext(schuljahr,3,4).END PROC nachprlilistenvorbereiten;PROC +nachprlibildschirmvorbereiten:LET fnrausganf=2;standardkopfmaskeaktualisieren +(nachprliueberschrift);breite:=bildbreite;initspalten;setzespaltentrenner( +spaltentrenner);setzespaltenbreiten(spalte2bildbreite);initausgabekopf( +bildstrich);bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaenge +REPEAT ausgkopf(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext; +setzebildanfangsposition(bildanf).END PROC nachprlibildschirmvorbereiten; +PROC nachprliseitezeigen:setzescanstartwert(startwertjgst);setzescanendewert( +endewertjgst);blaettern(PROC (INT CONST )schuelerzeigen,aktion,TRUE ,TRUE , +BOOL PROC multistopnachpruefler);setzescanstartwert("");setzescanendewert("�" +).#endewertjgstpluseinsbeigleichheit:IF startwertjgst=endewertjgstTHEN text( +int(endewertjgst)+1)ELSE endewertjgstFI .#END PROC nachprliseitezeigen;PROC +schuelerzeigen(INT CONST x):schuelerholen;IF ersteraufbildschirmTHEN +klassegeaendert:=TRUE ;ersteraufbildschirm:=FALSE FI ;schueleraufbereiten; +schueleraufbildschirm.END PROC schuelerzeigen;PROC schueleraufbildschirm:INT +VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos; +erhoeheausgabeposumeinsEND REPEAT .END PROC schueleraufbildschirm;PROC +nachprlidruckvorbereiten:LET uebteil11= +"Liste der zur Nachprüfung berechtigten Schüler, ",uebteil12="Sek.I", +uebteil13="Sek.II",uebteil14="Jgst. ",uebteil2="Schuljahr: ";TEXT VAR +ueberschrift1,ueberschrift2;ueberschriftvorbereitendruck;jgst:=niltext;klasse +:=niltext;druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf( +ueberschrift1,ueberschrift2);breite:=druckbreite;initspalten; +setzespaltentrenner(spaltentrenner);setzespaltenbreiten(spalte2druckbreite); +initausgabekopf(druckstrich);holemeldungen;setzewerte;lesenvorbereitendruck( +PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC +multistopnachprueflersim).holemeldungen:meldungstext(mnrbearbeitetwirdjgst, +bearbeitetwirdjgst).setzewerte:inittupel(dnrhalbjahresdaten);putwert( +fnrhjdversetzung,schluesselnachpruefler);putwert(fnrhjdjgst,startwertjgst); +putwert(fnrhjdsj,aktuellesschuljahr);putintwert(fnrhjdhj,2). +ueberschriftvorbereitendruck:ueberschrift1:=uebteil11;IF sek1THEN +ueberschrift1:=ueberschrift1+uebteil12ELSE IF sek2THEN ueberschrift1:= +ueberschrift1+uebteil13ELSE ueberschrift1:=ueberschrift1+uebteil14+jgstFI ; +FI ;ueberschrift2:=uebteil2+aufbereitetesschuljahr.aufbereitetesschuljahr: +"19"+jahr1+"/"+jahr2.variablenfuerdrucksetzen:druckstrich:=druckbreite* +mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner-spalte1breite- +spalte3breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)- +ausgkopflaenge.END PROC nachprlidruckvorbereiten;PROC nachprliseitedrucken: +nachprliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdrucken, +druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopnachprueflersim); +seitenwechsel.END PROC nachprliseitedrucken;PROC nachprliueberschriftdrucken: +druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT +druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC +nachprliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET +markiert="#";schuelerholen;IF zeilenzaehler=nullTHEN klassegeaendert:=TRUE +FI ;ggflmeldungjgst;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaengereal; +schuelerindruckdatei.ggflmeldungjgst:IF jgstgeaendertTHEN zwischenmeldungFI . +jgstgeaendert:neuejgst:=schuelerjgst;jgst<>neuejgst.zwischenmeldung: +standardmeldung(bearbeitetwirdjgst,neuejgst+markiert);jgst:=neuejgst;END +PROC schuelerdrucken;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengerealREPEAT druckzeileschreiben(ausgfeld(i))END REPEAT .END +PROC schuelerindruckdatei;PROC setzespaltenbreiten(INT CONST spalte2breite): +setzespaltenbreite(spalte1breite);setzespaltenbreite(spalte2breite); +setzespaltenbreite(spalte3breite);END PROC setzespaltenbreiten;PROC +initausgabekopf(TEXT CONST strich):LET jgst="Jgst.",zugtut="Zug/Tut",name= +"Familienname",rufname=" Rufname",rest1= +"Meldg. :Prüfer :Datum : : ",rest2= +" :Fach:Fach:Vors:Beis: Zeit:Raum:Note";spaltenweise(jgst);spaltenweise( +name);spaltenweise(rest1);ausgkopf(1):=zeile;spaltenweise(zugtut); +spaltenweise(rufname);spaltenweise(rest2);ausgkopf(2):=zeile;ausgkopf(3):= +strich;END PROC initausgabekopf;PROC schuelerholen:schuelername:=wert( +fnrhjdfamnames);schuelerrufname:=wert(fnrhjdrufnames);#schuelernamenszus:= +wert(fnrhjdzusatz);#schuelernamenszus:="";schuelerjgst:=wert(fnrhjdjgst); +schuelerzug:=wert(fnrhjdkennung);fach1:=wert(fnrhjdnachfach1);fach2:=wert( +fnrhjdnachfach2);fach3:=wert(fnrhjdnachfach3);fachlehrersuchen(fach1,paraphe1 +);fachlehrersuchen(fach2,paraphe2);fachlehrersuchen(fach3,paraphe3); +neueklasse:=schuelerjgst+schuelerzug;klassegeaendert:=klasse<>neueklasse; +klasse:=neueklasse.END PROC schuelerholen;PROC fachlehrersuchen(TEXT CONST +fach,TEXT VAR paraphe):putwert(fnrlvhj,wert(fnrhjdhj));putwert(fnrlvsj,wert( +fnrhjdsj));putwert(fnrlvjgst,wert(fnrhjdjgst));#putwert(fnrlvzug,wert( +fnrhjdkennung));#putwert(fnrlvfachkennung,fach+wert(fnrhjdkennung));search( +dnrlehrveranstaltungen,TRUE );IF dbstatus=okTHEN paraphe:=wert(fnrlvparaphe) +ELSE paraphe:=""FI END PROC fachlehrersuchen;PROC schueleraufbereiten:LET +zwizeile=" : : : : : : :";INT VAR posausgfeld; +posausgfeld:=null;schreibeklassenamefach1;schreiberufnamefach2;IF +ausgabedruckerTHEN schreibeggffach3ELSE schreibefach3FI ; +schreibezwischenzeile.schreibeklassenamefach1:spaltenweise(aufbschuelerklasse +);spaltenweise(aufbschuelername);spaltenweise(aufbfach1);posausgfeldINCR 1; +ausgfeld(posausgfeld):=zeile;posausgfeldINCR 1.schreiberufnamefach2: +spaltenweise(blank);spaltenweise(aufbrufname);spaltenweise(aufbfach2); +ausgfeld(posausgfeld):=zeile;posausgfeldINCR 1.schreibeggffach3:IF fach3<> +niltextTHEN schreibefach3FI ;ausgfeldlaengereal:=posausgfeld.schreibefach3: +spaltenweise(blank);spaltenweise(blank);spaltenweise(aufbfach3);ausgfeld( +posausgfeld):=zeile;posausgfeldINCR 1.schreibezwischenzeile:spaltenweise( +blank);spaltenweise(blank);spaltenweise(zwizeile);ausgfeld(posausgfeld):= +zeile.aufbschuelerklasse:IF klassegeaendertTHEN schuelerjgst+blank+ +schuelerzugELSE blankFI .aufbschuelername:IF schuelernamenszus=niltextTHEN +schuelernameELSE schuelernamenszus+blank+schuelernameFI .aufbfach1:aufbfach( +fach1,paraphe1).aufbrufname:2*blank+schuelerrufname.aufbfach2:aufbfach(fach2, +paraphe2).aufbfach3:aufbfach(fach3,paraphe3).END PROC schueleraufbereiten; +TEXT PROC aufbfach(TEXT CONST fach,paraphe):LET vorfach="__: ",nachfach= +":____:____:_______:____:____";vorfach+fach+(3-length(fach))*blank+ +spaltentrenner+paraphe+(4-length(paraphe))*blank+nachfach.END PROC aufbfach; +BOOL PROC elementsek1:sek1COR int(startwertjgst)<11ENDPROC elementsek1;BOOL +PROC multistopnachpruefler:BOOL VAR b;b:=nachprueflerundrichtigesdatumCAND +int(wert(fnrhjdjgst))>=int(startwertjgst)CAND int(wert(fnrhjdjgst))<#=#int( +endewertjgst);b.nachprueflerundrichtigesdatum:wert(fnrhjdversetzung)= +schluesselnachprueflerCAND wert(fnrhjdsj)=aktuellesschuljahrCAND wert( +fnrhjdhj)="2".ENDPROC multistopnachpruefler;BOOL PROC +multistopnachprueflersim:BOOL VAR b:=multistopnachpruefler;setzebestandende( +NOT b);bENDPROC multistopnachprueflersim;END PACKET nachprueflisten; + diff --git a/app/schulis/2.2.1/src/1.listen.neuan b/app/schulis/2.2.1/src/1.listen.neuan new file mode 100644 index 0000000..6fd7fc5 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.neuan @@ -0,0 +1,121 @@ +PACKET neuanlistenDEFINES neuanlispezielleteile:LET niltext="",blank=" ", +mittestrich="-",null=0,komma=",",ueberschriftenzeilen=2,nname="Name",schule= +"Schule",klasse="Klasse",spalte3breite=6,anzspaltentrenner=2,ausgkopflaenge=2 +,ausgfeldlaenge=2,AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW +ausgkopflaengeTEXT ,neuanlieingangsmaske="ms liste neuanmeld eingang", +neuanlianfpos=2,#fnrsustatuss=6,fnrsunamenszusatzs=21,fnrsuskennlschule=14, +fnrsuklasselschule=15,ixsustatschulkenn=253,ixsustatfamrufgeb=254dnrschueler= +2,dnrschulen=120,fnrschkennung=121,fnrschname=122,#mnrbearbeitetwerdenschulen +=101,mnrbearbeitetwerdenschueler=102;INT CONST spalte1bildbreite:=(bildbreite +-anzspaltentrenner-spalte3breite)DIV 2,spalte2bildbreite:=spalte1bildbreite;# +bildsatzzahl:=(bildlaenge-ausgkopflaenge)DIV ausgfeldlaenge,bildblocklaenge:= +(bildsatzzahl+1)DIV 2;#INT VAR spalte1druckbreite,spalte2druckbreite, +druckzeilenzahl,bildanf,eingabestatus,aktuelleindexnr;TEXT VAR schuljahr, +schuelername,schuelerrufname,schuelernamenszus,schuelerherkschule, +schuelerherkklasse,schuelernameaufber,jahrgang,#sortbest,#anfbuchstabe, +neueranfbuchstabe,startwert,bearbeitetwerdenschulen,bearbeitetwerdenschueler; +TEXT VAR druckstrich;TEXT CONST bildstrich:=bildbreite*mittestrich;AUSGFELD +VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR sortalpha,jgst5,jgst11;BOOL PROC +multistop:BOOL VAR b;IF jgst5THEN b:=wert(fnrsustatuss)="n05"ELIF jgst11THEN +b:=wert(fnrsustatuss)="n11"ELSE b:=wert(fnrsustatuss)="nso"FI ;bENDPROC +multistop;BOOL PROC multistopsim:BOOL VAR b:=multistop;setzebestandende(NOT b +);bENDPROC multistopsim;PROC neuanlispezielleteile(INT CONST nr):SELECT nrOF +CASE 1:neuanlidialogvorbereitenCASE 2:neuanlieingabenrichtigCASE 3: +neuanlilistenvorbereitenCASE 4:neuanlidruckvorbereitenCASE 5: +neuanliseitedruckenCASE 6:neuanlibildschirmvorbereitenCASE 7: +neuanliseitezeigenENDSELECT .END PROC neuanlispezielleteile;PROC +neuanlidialogvorbereiten:setzeanfangswerte(neuanlieingangsmaske,neuanlianfpos +)END PROC neuanlidialogvorbereiten;PROC neuanlieingabenrichtig:LET fnrjgst5=2 +,fnrjgst11=3,fnrjgstsonst=4,fnrsortalpha=5,fnrsortschule=6,fnrausgdrucker=7, +fnrausgbild=8;standardpruefe(5,fnrjgst5,fnrjgstsonst,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE standardpruefe(5,fnrsortalpha,fnrsortschule,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE jgst5:=standardmaskenfeld(fnrjgst5)<>niltext;jgst11:= +standardmaskenfeld(fnrjgst11)<>niltext;sortalpha:=standardmaskenfeld( +fnrsortschule)=niltext;#note("-->"+standardmaskenfeld(fnrsortschule)+"<--"); +noteline;#setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext); +setzeeingabetest(TRUE )FI FI FI .END PROC neuanlieingabenrichtig;PROC +neuanlilistenvorbereiten:LET fuenf="05",elf="11",sonst="sonst";BOOL VAR b:= +FALSE ;IF jgst5THEN jahrgang:=fuenf;startwert:="n05"ELSE IF jgst11THEN +jahrgang:=elf;startwert:="n11"ELSE jahrgang:=sonst;startwert:="nso"FI ;FI ; +IF sortalphaTHEN aktuelleindexnr:=ixsustatfamrufgebELSE aktuelleindexnr:= +ixsustatschulkennFI ;#note("Nr,: "+text(aktuelleindexnr));noteline;#inittupel +(dnrschueler);initobli(8);parsenooffields(21);setzeidentiwert("");putwert( +fnrsustatuss,startwert);#objektlistestarten(aktuelleindexnr,"",fnrsustatuss, +TRUE ,b);#objektlistestarten(aktuelleindexnr,"",staticfield,TRUE ,b); +setzebestandende(b).staticfield:IF sortalphaTHEN dnrschueler+1ELSE +fnrsuskennlschuleFI .END PROC neuanlilistenvorbereiten;PROC +neuanlibildschirmvorbereiten:LET fnrausganf=2,aufein="",aufaus=" ", +neuanliueberschriftneu1="Liste der Neuanmeldungen zur Jgst. ", +neuanliueberschriftneu2="Liste der sonstigen Neuanmeldungen"; +standardkopfmaskeaktualisieren(neueueberschrift);initspalten; +setzespaltenbreite(spalte1bildbreite);setzespaltenbreite(spalte2bildbreite); +setzespaltenbreite(spalte3breite);initausgabekopf(bildstrich);bildanf:= +fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT ausgkopf(i)IN +bildanf;bildanfINCR 1END REPEAT ;setzebildanfangsposition(bildanf). +neueueberschrift:IF (jgst5OR jgst11)THEN neuanliueberschriftneu1+aufein+ +jahrgang+aufausELSE neuanliueberschriftneu2FI .END PROC +neuanlibildschirmvorbereiten;PROC neuanliseitezeigen:blaettern(PROC (INT +CONST )schuelerzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop)END PROC +neuanliseitezeigen;PROC schuelerzeigen(INT CONST x):schuelerholen; +schueleraufbereiten;schueleraufbildschirmEND PROC schuelerzeigen;PROC +schueleraufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld +(i)IN ausgabepos;erhoeheausgabeposumeinsEND REPEAT .END PROC +schueleraufbildschirm;PROC neuanlidruckvorbereiten:LET schluessel="Schuljahr" +,uebteil1="Folgende Schüler wurden zum Schuljahr ",uebteil2=" für die", +uebteil31="Jahrgangsstufe ",uebteil32="sonstigen Jahrgangsstufen ",uebteil4= +" angemeldet:";TEXT VAR ueberschrift1,ueberschrift2;anfbuchstabe:=blank; +druckvorbereiten;variablenfuerdrucksetzen;ueberschriftvorbereitendruck; +initdruckkopf(ueberschrift1,ueberschrift2);initspalten;setzespaltenbreite( +spalte1druckbreite);setzespaltenbreite(spalte2druckbreite);setzespaltenbreite +(spalte3breite);initausgabekopf(druckstrich);holemeldungen;inittupel( +dnrschueler);putwert(fnrsustatuss,startwert);lesenvorbereitendruck(PROC (INT +CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC multistopsim). +variablenfuerdrucksetzen:druckstrich:=druckbreite*mittestrich; +spalte1druckbreite:=(druckbreite-anzspaltentrenner-spalte3breite)DIV 2; +spalte2druckbreite:=spalte1druckbreite;druckzeilenzahl:=drucklaenge( +ueberschriftenzeilen)-ausgkopflaenge.ueberschriftvorbereitendruck:schuljahr:= +schulkenndatum(schluessel);schuljahraufbereiten;ueberschrift1:=uebteil1+ +schuljahr+uebteil2;IF (jgst5OR jgst11)THEN ueberschrift2:=uebteil31+jahrgang+ +uebteil4ELSE ueberschrift2:=uebteil32+uebteil4FI .schuljahraufbereiten: +schuljahr:="19"+subtext(schuljahr,1,2)+"/"+subtext(schuljahr,3,4). +holemeldungen:meldungstext(mnrbearbeitetwerdenschulen,bearbeitetwerdenschulen +);meldungstext(mnrbearbeitetwerdenschueler,bearbeitetwerdenschueler).END +PROC neuanlidruckvorbereiten;PROC neuanliseitedrucken: +neuanliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdrucken, +druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END +PROC neuanliseitedrucken;PROC neuanliueberschriftdrucken:druckkopfschreiben; +INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i +))END REPEAT .END PROC neuanliueberschriftdrucken;PROC schuelerdrucken(INT +VAR zeilenzaehler):LET markiert="#";schuelerholen;ggflmeldunganfbuchstabe; +schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge;schuelerindruckdatei. +ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN zwischenmeldungFI . +anfbuchstabegeaendert:IF sortalphaTHEN neueranfbuchstabe:=schuelernameSUB 1 +ELSE neueranfbuchstabe:=schuelerherkschuleSUB 1FI ;anfbuchstabe<> +neueranfbuchstabe.zwischenmeldung:IF sortalphaTHEN standardmeldung( +bearbeitetwerdenschueler,neueranfbuchstabe+markiert)ELSE standardmeldung( +bearbeitetwerdenschulen,neueranfbuchstabe+markiert)FI ;anfbuchstabe:= +neueranfbuchstabe;END PROC schuelerdrucken;PROC schuelerindruckdatei:INT VAR +i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT druckzeileschreiben(ausgfeld(i))END +REPEAT .END PROC schuelerindruckdatei;PROC initausgabekopf(TEXT CONST strich) +:spaltenweise(nname);spaltenweise(schule);spaltenweise(klasse);ausgkopf(1):= +zeile;ausgkopf(2):=strich;END PROC initausgabekopf;PROC schuelerholen: +schuelername:=wert(3);schuelerrufname:=2*blank+wert(4);schuelernamenszus:= +wert(fnrsunamenszusatzs);sucheschule;schuelerherkklasse:=wert( +fnrsuklasselschule).sucheschule:putwert(fnrschkennung,wert(fnrsuskennlschule) +);search(dnrschulen,TRUE );IF dbstatus=okTHEN schuelerherkschule:=wert( +fnrschname)ELSE schuelerherkschule:=wert(fnrsuskennlschule)FI .END PROC +schuelerholen;PROC schueleraufbereiten:schuelernameaufbereiten; +schreibenameschuleklasse;schreiberufname.schreibenameschuleklasse: +spaltenweise(schuelernameaufber);spaltenweise(schuelerherkschule); +spaltenweise(schuelerherkklasse);ausgfeld(1):=zeile.schreiberufname: +spaltenweise(schuelerrufname);spaltenweise(blank);spaltenweise(blank); +ausgfeld(2):=zeile.END PROC schueleraufbereiten;PROC schuelernameaufbereiten: +schuelernameaufber:=niltext;IF schuelernamenszus<>niltextTHEN +schuelernameaufber:=schuelernamenszus+blankFI ;schuelernameaufber:= +schuelernameaufber+schuelername+komma;END PROC schuelernameaufbereiten;END +PACKET neuanlisten; + diff --git a/app/schulis/2.2.1/src/1.listen.prot versetzkonferenz b/app/schulis/2.2.1/src/1.listen.prot versetzkonferenz new file mode 100644 index 0000000..976d67c --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.prot versetzkonferenz @@ -0,0 +1,162 @@ +PACKET protversetzkonflistenDEFINES konfprolispezielleteile:LET +mnrbearbeitetwirdjgst=106,mnrbearbeitetwirdklasse=107,mnrbearbeitetwirdkurs= +108;TEXT VAR bearbeitetwirdjgst,bearbeitetwirdklasse,bearbeitetwirdkurs, +startjahr,startzug;INT VAR aktuelleindexnr;LET niltext="",nildatum="01.01.00" +,null=0,blank=" ",mittestrich="-",doppelpunkt=":",vordr1ueberarb= +"vordruck1 ueberarbeitet",vordr2ueberarb="vordruck2 ueberarbeitet", +vordr3ueberarb="vordruck3 ueberarbeitet",spalte2breite=52,anzspaltentrenner=1 +,ausgkopflaenge=3,ausgfeldlaenge=2,AUSGFELD =ROW ausgfeldlaengeTEXT , +AUSGKOPF =ROW ausgkopflaengeTEXT ,konfprolieingangsmaske= +"ms liste konfpro eingang",konfprolianfpos=2;INT VAR spalte1breite, +druckzeilenzahl,druckzeilenzahlrest,zeilenanz,schuelerzaehler,eingabestatus; +TEXT VAR konfproliueberschrift,zug,jahrgang,schuelername,schuelerrufname, +schuelernamenszus,schuelergebdat,zugangjgst,abmeldedat,schuelerjgst, +schuelerzug,vordruck,vordruckueberarbeitet,druckstrich;AUSGFELD VAR +ausgfelddruck;AUSGKOPF VAR ausgkopfdruck;BOOL VAR sek1,einjahrgang,alle, +neuesmerkmal;FILE VAR f;PROC konfprolispezielleteile(INT CONST nr):SELECT nr +OF CASE 1:konfprolidialogvorbereitenCASE 2:konfprolieingabenrichtigCASE 3: +konfprolilistenvorbereitenCASE 4:konfprolidruckvorbereitenCASE 5: +konfproliseitedruckenENDSELECT .END PROC konfprolispezielleteile;PROC +konfprolidialogvorbereiten:konfproliueberschrift:=text(vergleichsknoten); +setzeanfangswerte(konfprolieingangsmaske,konfprolianfpos).END PROC +konfprolidialogvorbereiten;PROC konfprolieingabenrichtig:LET fnrmskjgst=2, +fnrmskzug=3,auswahlnichtsinnvoll=56;sek1:=FALSE ;alle:=FALSE ;einjahrgang:= +FALSE ;jahrgang:="";zug:=compress(standardmaskenfeld(fnrmskzug));IF +standardmaskenfeld(fnrmskjgst)=niltextTHEN IF zug=niltextTHEN alle:=TRUE ; +sek1:=TRUE ;setzeausgabedrucker(TRUE );setzeeingabetest(TRUE )ELSE +meldefehler;infeld(fnrmskzug);setzeeingabetest(FALSE )FI ELSE standardpruefe( +3,fnrmskjgst,5,13,niltext,eingabestatus);IF eingabestatus<>0THEN infeld( +eingabestatus);setzeeingabetest(FALSE )ELSE jahrgang:=zweistellig( +standardmaskenfeld(fnrmskjgst));einjahrgang:=(zug=niltext);IF int(jahrgang)< +11THEN sek1:=TRUE FI ;setzeausgabedrucker(TRUE );setzeeingabetest(TRUE )FI +FI .meldefehler:standardmeldung(auswahlnichtsinnvoll,niltext).END PROC +konfprolieingabenrichtig;PROC konfprolilistenvorbereiten:BOOL VAR b:=FALSE ; +startjahr:=jahrgang;startzug:=zug;IF startjahr>"10"CAND startzug=niltextTHEN +aktuelleindexnr:=ixsustatjgstELSE aktuelleindexnr:=ixsustatjgstzugFI ; +dbstatus(ok);inittupel(dnrschueler);initobli(1);parsenooffields(19); +setzeidentiwert("");putwert(fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut, +startzug);putwert(fnrsustatuss,"ls");#objektlistestarten(aktuelleindexnr,"", +fnrsusgrpjgst,TRUE ,b);#objektlistestarten(aktuelleindexnr,"",staticfield, +TRUE ,b);setzebestandende(NOT multistopkonf).staticfield:IF aktuelleindexnr= +ixsustatjgstzugTHEN fnrsusgrpzugtutELSE dnrschueler+1FI .END PROC +konfprolilistenvorbereiten;PROC konfprolidruckvorbereiten:LET prevordruck= +"vordruck",postvordruck=" protokoll versetzkonf",vordr3= +"vordruck3 protokoll versetzkonf",anzvordrucke=3,manager="anschreiben server" +;INT VAR i;schuelerzaehler:=null;jahrgang:=wert(fnrsusgrpjgst);zug:=wert( +fnrsusgrpzugtut);aktuellevordruckevommanagerholen;neuesmerkmal:=TRUE ; +druckvorbereiten;variablenfuerdrucksetzen;vordruck3fuellen; +setzesonderwerteschulkenndaten;holemeldungen;putwert(dateinr(primdatid( +aktuelleindexnr))+1,"");putwert(fnrsusgrpjgst,startjahr);putwert( +fnrsusgrpzugtut,startzug);lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC , +INT VAR )scanforward,BOOL PROC multistopkonfsim);initspalten; +initausgabekopfdruck.holemeldungen:meldungstext(mnrbearbeitetwirdjgst, +bearbeitetwirdjgst);meldungstext(mnrbearbeitetwirdklasse,bearbeitetwirdklasse +);meldungstext(mnrbearbeitetwirdkurs,bearbeitetwirdkurs). +aktuellevordruckevommanagerholen:FOR iFROM 1UPTO anzvordruckeREP forget( +prevordruck+text(i)+postvordruck,quiet);fetch(prevordruck+text(i)+ +postvordruck,/manager);PER .variablenfuerdrucksetzen:druckstrich:=druckbreite +*mittestrich;spalte1breite:=druckbreite-anzspaltentrenner-spalte2breite. +vordruck3fuellen:vordruck:=vordr3;vordruckueberarbeitet:=vordr3ueberarb; +forget(vordruckueberarbeitet,quiet);briefalternative(vordruck, +vordruckueberarbeitet).END PROC konfprolidruckvorbereiten;PROC +initausgabekopfdruck:LET name=" :Familienname",rufname=" : Rufname", +rest1=" : :Erg. :Fächer:",rest2= +"Geb.dat.:Bem.:v/w/n :Nachpr:Gründe";hilfsfeldervorbelegen;spaltenweise(name) +;spaltenweise(rest1);ausgkopfdruck(1):=zeile;spaltenweise(rufname); +spaltenweise(rest2);ausgkopfdruck(2):=zeile;ausgkopfdruck(3):=druckstrich. +hilfsfeldervorbelegen:setzespaltentrenner(blank);setzespaltenbreite( +spalte1breite);setzespaltenbreite(spalte2breite).END PROC +initausgabekopfdruck;PROC konfproliseitedrucken:LET listewirdgedruckt=58; +konfproliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdatendrucken +,druckzeilenzahl,ausgfeldlaenge,PROC bestandendesimulierenbeimerkmalwechsel, +BOOL PROC multistopkonfsim);IF neuesmerkmalTHEN simuliertesendezuruecknehmen; +konfproliunterschriftdrucken;meldelistewirdgedruckt;drucknachbereiten; +schuelerzaehler:=null;neuelistevorbereitenELIF NOT bestandendeTHEN +seitenwechselFI .simuliertesendezuruecknehmen:setzebestandende(FALSE ). +meldelistewirdgedruckt:standardmeldung(listewirdgedruckt,niltext). +neuelistevorbereiten:druckvorbereiten.END PROC konfproliseitedrucken;PROC +konfproliueberschriftdrucken:LET vordr1="vordruck1 protokoll versetzkonf", +vordr2="vordruck2 protokoll versetzkonf",anzleerzeilen=2,markiert="#";INT +VAR i;TEXT VAR klassejgstaufber;IF neuesmerkmalTHEN +zwischenmeldungundvordruckefuellenFI ;vordruck1schreiben;IF neuesmerkmalTHEN +vordruck2schreibenFI ;leerzeilenschreiben;ausgabekopfschreiben. +zwischenmeldungundvordruckefuellen:LET swiklassebzwjgst=511, +swianwesendelehrer=512,klasse="Klasse ",kurs="Tutorenkurs ",jgst="Jgst. "; +klassejgstaufber:=jahrgang;IF (alleOR einjahrgang)AND NOT sek1THEN +standardmeldung(bearbeitetwirdjgst,klassejgstaufber+markiert); +klassejgstaufber:=jgst+klassejgstaufberELSE klassejgstaufber:= +klassejgstaufber+blank+zug;IF sek1THEN standardmeldung(bearbeitetwirdklasse, +klassejgstaufber+markiert);klassejgstaufber:=klasse+klassejgstaufberELSE +standardmeldung(bearbeitetwirdkurs,klassejgstaufber+markiert); +klassejgstaufber:=kurs+klassejgstaufberFI ;FI ;festesonderwertesetzen; +vordruck:=vordr1;vordruckueberarbeitet:=vordr1ueberarb;forget( +vordruckueberarbeitet,quiet);briefalternative(vordruck,vordruckueberarbeitet) +;vordruck:=vordr2;vordruckueberarbeitet:=vordr2ueberarb;forget( +vordruckueberarbeitet,quiet);briefalternative(vordruck,vordruckueberarbeitet) +.festesonderwertesetzen:setzesonderwert(swiklassebzwjgst,klassejgstaufber); +setzesonderwert(swianwesendelehrer,blank).vordruck2schreiben: +vordruckueberarbeitet:=vordr2ueberarb;f:=sequentialfile(input, +vordruckueberarbeitet);zeilenanz:=lines(f);FOR iFROM 1UPTO zeilenanzREP +getline(f,ausgfelddruck(1));druckzeileschreiben(ausgfelddruck(1));PER ; +druckzeilenzahlDECR zeilenanz.leerzeilenschreiben:FOR iFROM 1UPTO +anzleerzeilenREP druckzeileschreiben(blank)PER ;druckzeilenzahlDECR +anzleerzeilen.ausgabekopfschreiben:FOR iFROM 1UPTO ausgkopflaengeREP +druckzeileschreiben(ausgkopfdruck(i))PER ;druckzeilenzahlDECR ausgkopflaenge; +druckzeilenzahlrest:=druckzeilenzahl.END PROC konfproliueberschriftdrucken; +PROC konfproliunterschriftdrucken:INT VAR i;vordruck3holen;vordruck3schreiben +.vordruck3holen:vordruckueberarbeitet:=vordr3ueberarb;f:=sequentialfile(input +,vordruckueberarbeitet);zeilenanz:=lines(f).vordruck3schreiben:IF zeilenanz> +druckzeilenzahlrestTHEN seitenwechselmitneuemkopfFI ;FOR iFROM 1UPTO +zeilenanzREP getline(f,ausgfelddruck(1));druckzeileschreiben(ausgfelddruck(1) +);PER ;druckzeilenzahlrestDECR zeilenanz.seitenwechselmitneuemkopf: +seitenwechsel;vordruck1schreiben;druckzeilenzahlrest:=druckzeilenzahl; +vordruck3holen.END PROC konfproliunterschriftdrucken;PROC vordruck1schreiben: +INT VAR i;druckzeilenzahl:=drucklaenge;vordruckueberarbeitet:=vordr1ueberarb; +f:=sequentialfile(input,vordruckueberarbeitet);zeilenanz:=lines(f);FOR iFROM +1UPTO zeilenanzREP getline(f,ausgfelddruck(1));druckzeileschreiben( +ausgfelddruck(1));PER ;druckzeilenzahlDECR zeilenanz.END PROC +vordruck1schreiben;PROC schuelerdatendrucken(INT VAR zeilenzaehler): +schuelerdatenholen;schuelerdatenaufbereiten;zeilenzaehlerINCR ausgfeldlaenge; +schuelerdatenindruckdatei.END PROC schuelerdatendrucken;PROC +schuelerdatenholen:schuelername:=wert(fnrsufamnames);schuelerrufname:=wert( +fnrsurufnames);schuelernamenszus:=wert(fnrsunamenszusatzs);schuelergebdat:= +wert(fnrsugebdatums);zugangjgst:=wert(fnrsuartzugang);abmeldedat:=wert( +fnrsuabgdats);schuelerjgst:=wert(fnrsusgrpjgst);schuelerzug:=wert( +fnrsusgrpzugtut).END PROC schuelerdatenholen;PROC schuelerdatenaufbereiten: +LET unterstrich="_",bem1="w",bem2="x",abgemeldet="ab",gebdatlaenge=8, +zugangjgstlaenge=4,ausgleich1=3,ausgleich2=2,abgemlaenge1=4,abgemlaenge2=2, +rest1=": : :",rest2=":______:______:________________________"; +schuelerzaehlerINCR 1;schreibenamegebdatbemerkungen. +schreibenamegebdatbemerkungen:setzespaltentrenner(blank);spaltenweise( +schuelernameundnraufber);spaltenweise(schuelerbemteil1aufber);ausgfelddruck(1 +):=zeile;setzespaltentrenner(unterstrich);spaltenweise(schuelerrufnameaufber) +;spaltenweise(schuelerbemteil2aufber);ausgfelddruck(2):=zeile. +schuelernameundnraufber:IF schuelernamenszus=niltextTHEN nr+doppelpunkt+ +schuelernameELSE nr+doppelpunkt+schuelernamenszus+blank+schuelernameFI .nr:( +ausgleich1-length(text(schuelerzaehler)))*blank+text(schuelerzaehler). +schuelerbemteil1aufber:gebdatlaenge*blank+doppelpunkt+zugangjgstaufber+rest1. +zugangjgstaufber:IF (zugangjgst=bem1)OR (zugangjgst=bem2)THEN zugangjgst+( +zugangjgstlaenge-length(zugangjgst))*blankELSE zugangjgstlaenge*blankFI . +schuelerrufnameaufber:ausgleich1*unterstrich+doppelpunkt+ausgleich2* +unterstrich+schuelerrufname+anzunterstriche*unterstrich. +schuelerbemteil2aufber:schuelergebdat+doppelpunkt+abgemeldetaufber+rest2. +anzunterstriche:spalte1breite-ausgleich2-length(schuelerrufname). +abgemeldetaufber:IF abmeldedat=nildatumTHEN abgemlaenge1*unterstrichELSE +abgemeldet+abgemlaenge2*unterstrichFI .END PROC schuelerdatenaufbereiten; +PROC schuelerdatenindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +druckzeileschreiben(ausgfelddruck(i))PER ;druckzeilenzahlrestDECR +ausgfeldlaenge.END PROC schuelerdatenindruckdatei;PROC +bestandendesimulierenbeimerkmalwechsel:IF bestandendeTHEN neuesmerkmal:= +FALSE ;konfproliunterschriftdruckenELSE nochklassebzwjgstzubearbeiten;IF +neuesmerkmalTHEN setzebestandende(TRUE )FI ;FI .nochklassebzwjgstzubearbeiten +:jahrgang:=wert(fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut);neuesmerkmal:= +neuejgst;IF neuesmerkmalAND int(jahrgang)>10THEN sek1:=FALSE FI ;IF sek1THEN +neuesmerkmal:=neuesmerkmalOR neuerzugFI .neuejgst:schuelerjgst<>jahrgang. +neuerzug:schuelerzug<>zug.END PROC bestandendesimulierenbeimerkmalwechsel; +BOOL PROC multistopkonf:BOOL VAR b:=#TRUE ;#FALSE ;IF wert(fnrsustatuss)="ls" +THEN b:=TRUE ;IF startjahr<>""THEN IF startzug=niltextTHEN b:=(wert( +fnrsusgrpjgst)=startjahr)ELSE b:=(wert(fnrsusgrpzugtut)=startzugAND wert( +fnrsusgrpjgst)=startjahr)FI ;FI ;FI ;bEND PROC multistopkonf;BOOL PROC +multistopkonfsim:BOOL VAR b:=multistopkonf;setzebestandende(NOT b);bENDPROC +multistopkonfsim;END PACKET protversetzkonflisten; + diff --git a/app/schulis/2.2.1/src/1.listen.wiederholer b/app/schulis/2.2.1/src/1.listen.wiederholer new file mode 100644 index 0000000..e0541d2 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.wiederholer @@ -0,0 +1,160 @@ +PACKET versetzlistenDEFINES verslispezielleteile:LET schluesselwiederholer= +"w";INT CONST mnrbearbeitetwirdjgst:=106,nurimzweitenhj:=193;TEXT VAR +bearbeitetwirdjgst:="",aktuellesschuljahr:="",endewertjgst:="",startwertjgst +:="";LET niltext="",nildatum="01.01.00",blank=" ",mittestrich="-",null=0, +komma=",",ueberschriftenzeilen=2,spalte1breitesek1=5,spalte3breitesek1=32, +spalte1breitesek2=8,spalte3breitesek2=25,anzspaltentrenner=2,spaltentrenner= +":",ausgkopflaenge=3,ausgfeldlaenge=1,AUSGFELD =ROW ausgfeldlaengeTEXT , +AUSGKOPF =ROW ausgkopflaengeTEXT ,verslieingangsmaske= +"ms liste versetz nachpr eingang",verslianfpos=2;INT CONST +spalte2bildbreitesek1:=bildbreite-anzspaltentrenner-spalte1breitesek1- +spalte3breitesek1,spalte2bildbreitesek2:=bildbreite-anzspaltentrenner- +spalte1breitesek2-spalte3breitesek2;INT VAR spalte2druckbreite, +druckzeilenzahl,bildanf,eingabestatus,breite;TEXT VAR versliueberschrift, +jahr1,jahr2,schuelername,schuelerrufname,schuelernamenszus,schuelerjgst, +schuelerzug,schuelerabdat,ortsteil,erstesprache,religionsunt,kuodermu,jgst, +neuejgst,klasse,neueklasse;TEXT VAR druckstrich;TEXT CONST bildstrich:= +bildbreite*mittestrich;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR +sek1,sek2,ersteraufbildschirm,klassegeaendert:=FALSE ;PROC +verslispezielleteile(INT CONST nr):SELECT nrOF CASE 1:verslidialogvorbereiten +CASE 2:verslieingabenrichtigCASE 3:verslilistenvorbereitenCASE 4: +verslidruckvorbereitenCASE 5:versliseitedruckenCASE 6: +verslibildschirmvorbereitenCASE 7:versliseitezeigenENDSELECT .END PROC +verslispezielleteile;PROC verslidialogvorbereiten:versliueberschrift:=text( +vergleichsknoten);setzeanfangswerte(verslieingangsmaske,verslianfpos); +reinitparsingEND PROC verslidialogvorbereiten;PROC verslieingabenrichtig:LET +fnrsek1=2,fnrsek2=3,fnrjgst=4,fnrausgdrucker=5,fnrausgbild=6, +auswahlnichtsinnvoll=56;IF int(schulkenndatum("Schulhalbjahr"))=1THEN +standardmeldung(nurimzweitenhj,"2.#");setzeeingabetest(FALSE )ELSE +wohinpruefenFI .wohinpruefen:standardpruefe(5,fnrausgdrucker,fnrausgbild,null +,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus); +setzeeingabetest(FALSE )ELSE waspruefenFI .waspruefen:sek1:=FALSE ;sek2:= +FALSE ;jgst:="";IF standardmaskenfeld(fnrjgst)=niltextTHEN standardpruefe(5, +fnrsek1,fnrsek2,null,niltext,eingabestatus);IF eingabestatus<>0THEN infeld( +eingabestatus);setzeeingabetest(FALSE )ELSE sek1:=standardmaskenfeld(fnrsek2) +=niltext;sek2:=NOT sek1;setzeausgabedrucker(standardmaskenfeld(fnrausgbild)= +niltext);setzeeingabetest(TRUE )FI ;ELSE IF (standardmaskenfeld(fnrsek1)= +niltext)AND (standardmaskenfeld(fnrsek2)=niltext)THEN standardpruefe(3, +fnrjgst,5,13,niltext,eingabestatus);IF eingabestatus<>0THEN infeld( +eingabestatus);setzeeingabetest(FALSE )ELSE jgst:=zweistellig( +standardmaskenfeld(fnrjgst));setzeausgabedrucker(standardmaskenfeld( +fnrausgbild)=niltext);setzeeingabetest(TRUE )FI ;ELSE meldefehler;infeld( +fnrsek1);setzeeingabetest(FALSE )FI ;FI .meldefehler:standardmeldung( +auswahlnichtsinnvoll,niltext).END PROC verslieingabenrichtig;PROC +verslilistenvorbereiten:BOOL VAR b;LET schluessel="Schuljahr"; +aktuellesschuljahrermitteln;startwertjgstbestimmen;inittupel( +dnrhalbjahresdaten);initobli(16);setzeidentiwert("");startwertesetzen; +objektlistestarten(ixhjdversjhjjgstkenn,"",fnrhjdjgst,TRUE ,b); +setzebestandende(NOT multistopniverCOR b).aktuellesschuljahrermitteln: +aktuellesschuljahr:=schulkenndatum(schluessel);jahr1:=subtext( +aktuellesschuljahr,1,2);jahr2:=subtext(aktuellesschuljahr,3,4). +startwertjgstbestimmen:endewertjgst:=endeberechnung;startwertjgst:= +anfangsberechnung;.anfangsberechnung:IF sek1THEN "05"ELIF sek2THEN "11"ELSE +jgstFI .endeberechnung:IF sek1THEN "11"ELIF sek2THEN "14"ELSE text(int(jgst)+ +1)FI .startwertesetzen:putwert(fnrhjdversetzung,schluesselwiederholer); +putwert(fnrhjdjgst,startwertjgst);putwert(fnrhjdsj,aktuellesschuljahr); +putintwert(fnrhjdhj,2).END PROC verslilistenvorbereiten;BOOL PROC +multistopniver:BOOL VAR b;b:=wiederholerundrichtigesdatumCAND int(wert( +fnrhjdjgst))>=int(startwertjgst)CAND int(wert(fnrhjdjgst))<#=#int( +endewertjgst);b.wiederholerundrichtigesdatum:wert(fnrhjdversetzung)= +schluesselwiederholerCAND wert(fnrhjdsj)=aktuellesschuljahrCAND wert(fnrhjdhj +)="2".ENDPROC multistopniver;BOOL PROC multistopniversim:BOOL VAR b:= +multistopniver;setzebestandende(NOT b);bENDPROC multistopniversim;PROC +verslibildschirmvorbereiten:LET fnrausganf=2;standardkopfmaskeaktualisieren( +versliueberschrift);breite:=bildbreite;initspalten;setzespaltentrenner( +spaltentrenner);IF elementsek1THEN setzespaltenbreitensek1( +spalte2bildbreitesek1);initausgabekopfsek1(bildstrich)ELSE +setzespaltenbreitensek2(spalte2bildbreitesek2);initausgabekopfsek2(bildstrich +)FI ;bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT +ausgkopf(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext; +setzebildanfangsposition(bildanf).END PROC verslibildschirmvorbereiten;PROC +versliseitezeigen:setzescanstartwert(startwertjgst);setzescanendewert( +endewertjgstpluseinsbeigleichheit);blaettern(PROC (INT CONST )schuelerzeigen, +aktion,TRUE ,TRUE ,BOOL PROC multistopniver);setzescanstartwert(""); +setzescanendewert("�").endewertjgstpluseinsbeigleichheit:IF startwertjgst= +endewertjgstTHEN text(int(endewertjgst)+1)ELSE endewertjgstFI .END PROC +versliseitezeigen;PROC schuelerzeigen(INT CONST x):schuelerholen;IF +ersteraufbildschirmTHEN klassegeaendert:=TRUE ;ersteraufbildschirm:=FALSE FI +;schueleraufbereiten;schueleraufbildschirm.END PROC schuelerzeigen;PROC +schueleraufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld +(i)IN ausgabepos;erhoeheausgabeposumeinsEND REPEAT .END PROC +schueleraufbildschirm;PROC verslidruckvorbereiten:LET uebteil11= +"Liste der nicht versetzten Schüler, ",uebteil12="Sek.I",uebteil13="Sek.II", +uebteil14="Jgst. ",uebteil2="Schuljahr: ";TEXT VAR ueberschrift1, +ueberschrift2;ueberschriftvorbereitendruck;jgst:=niltext;klasse:=niltext; +druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(ueberschrift1, +ueberschrift2);breite:=druckbreite;initspalten;setzespaltentrenner( +spaltentrenner);IF elementsek1THEN setzespaltenbreitensek1(spalte2druckbreite +);initausgabekopfsek1(druckstrich)ELSE setzespaltenbreitensek2( +spalte2druckbreite);initausgabekopfsek2(druckstrich)FI ;holemeldungen; +setzewerte;lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR ) +scanforward,BOOL PROC multistopniversim).holemeldungen:meldungstext( +mnrbearbeitetwirdjgst,bearbeitetwirdjgst).setzewerte:inittupel( +dnrhalbjahresdaten);putwert(fnrhjdversetzung,schluesselwiederholer);putwert( +fnrhjdjgst,startwertjgst);putwert(fnrhjdsj,aktuellesschuljahr);putintwert( +fnrhjdhj,2).ueberschriftvorbereitendruck:ueberschrift1:=uebteil11;IF sek1 +THEN ueberschrift1:=ueberschrift1+uebteil12ELSE IF sek2THEN ueberschrift1:= +ueberschrift1+uebteil13ELSE ueberschrift1:=ueberschrift1+uebteil14+jgstFI ; +FI ;ueberschrift2:=uebteil2+aufbereitetesschuljahr.aufbereitetesschuljahr: +"19"+jahr1+"/"+jahr2.variablenfuerdrucksetzen:druckstrich:=druckbreite* +mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner;IF elementsek1 +THEN spalte2druckbreite:=spalte2druckbreite-spalte1breitesek1- +spalte3breitesek1ELSE spalte2druckbreite:=spalte2druckbreite- +spalte1breitesek2-spalte3breitesek2FI ;druckzeilenzahl:=drucklaenge( +ueberschriftenzeilen)-ausgkopflaenge.END PROC verslidruckvorbereiten;PROC +versliseitedrucken:versliueberschriftdrucken;seitedrucken(PROC (INT VAR ) +schuelerdrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopniversim); +seitenwechsel.END PROC versliseitedrucken;PROC versliueberschriftdrucken: +druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT +druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC +versliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET +markiert="#";schuelerholen;IF zeilenzaehler=nullTHEN klassegeaendert:=TRUE +FI ;ggflmeldungjgst;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge; +schuelerindruckdatei.ggflmeldungjgst:IF jgstgeaendertTHEN zwischenmeldungFI . +jgstgeaendert:neuejgst:=schuelerjgst;jgst<>neuejgst.zwischenmeldung: +standardmeldung(bearbeitetwirdjgst,neuejgst+markiert);jgst:=neuejgst;END +PROC schuelerdrucken;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREPEAT druckzeileschreiben(ausgfeld(i))END REPEAT .END PROC +schuelerindruckdatei;PROC setzespaltenbreitensek1(INT CONST spalte2breitesek1 +):setzespaltenbreite(spalte1breitesek1);setzespaltenbreite(spalte2breitesek1) +;setzespaltenbreite(spalte3breitesek1);END PROC setzespaltenbreitensek1;PROC +setzespaltenbreitensek2(INT CONST spalte2breitesek2):setzespaltenbreite( +spalte1breitesek2);setzespaltenbreite(spalte2breitesek2);setzespaltenbreite( +spalte3breitesek2);END PROC setzespaltenbreitensek2;PROC initausgabekopfsek1( +TEXT CONST strich):LET jgst="Jgst.",zug=" Zug",name="Name",rest1= +"Orts-:Rel.: L : KU : Klasse",rest2="teil :unt.: F : MU :Wunsch:neu"; +spaltenweise(jgst);spaltenweise(blank);spaltenweise(rest1);ausgkopf(1):=zeile +;spaltenweise(zug);spaltenweise(name);spaltenweise(rest2);ausgkopf(2):=zeile; +ausgkopf(3):=strich;END PROC initausgabekopfsek1;PROC initausgabekopfsek2( +TEXT CONST strich):LET jgst="Jgst.",tutor=" Tutor",name="Name",rest1= +"Abmeldung";spaltenweise(jgst);spaltenweise(blank);spaltenweise(blank); +ausgkopf(1):=zeile;spaltenweise(tutor);spaltenweise(name);spaltenweise(rest1) +;ausgkopf(2):=zeile;ausgkopf(3):=strich;END PROC initausgabekopfsek2;PROC +schuelerholen:sucheschueler;schuelername:=wert(fnrsufamnames);schuelerrufname +:=wert(fnrsurufnames);schuelernamenszus:=wert(fnrsunamenszusatzs); +schuelerjgst:=wert(fnrhjdjgst);schuelerzug:=wert(fnrhjdkennung);schuelerabdat +:=wert(fnrsuabgdats);IF elementsek1THEN ortsteil:=wert(fnrsuortsteils); +erstesprache:=wert(fnrdd1fremdfach);religionsunt:=wert(fnrddreliunter); +kuodermu:=wert(fnrddkunstmusik)FI ;neueklasse:=schuelerjgst+schuelerzug; +klassegeaendert:=klasse<>neueklasse;klasse:=neueklasse.sucheschueler: +uebernehmewerte;search(dnrschueler,TRUE );IF dbstatus=okTHEN readtid( +dnrdiffdaten,zugriff(fnrsutiddiffdaten))ELSE inittupel(dnrdiffdaten)FI . +uebernehmewerte:putwert(fnrsufamnames,wert(fnrhjdfamnames));putwert( +fnrsurufnames,wert(fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats +)).END PROC schuelerholen;PROC schueleraufbereiten:LET abgemsek1="abgem.", +abgemsek2="abgemeldet";schreibeklassenamerest.schreibeklassenamerest: +spaltenweise(aufbschuelerklasse);spaltenweise(aufbschuelername);spaltenweise( +aufbrest);ausgfeld(1):=zeile.aufbschuelerklasse:IF klassegeaendertTHEN +schuelerjgst+blank+schuelerzugELSE blankFI .aufbschuelername:IF +schuelernamenszus=niltextTHEN schuelername+komma+blank+schuelerrufnameELSE +schuelernamenszus+blank+schuelername+komma+blank+schuelerrufnameFI .aufbrest: +IF elementsek1THEN ganzerrestsek1ELSE abmeldungsek2FI .ganzerrestsek1:blank+ +text(ortsteil,3)+blank+spaltentrenner+blank+text(religionsunt,2)+blank+ +spaltentrenner+blank+text(erstesprache,1)+blank+spaltentrenner+blank+text( +kuodermu,2)+blank+spaltentrenner+abmeldungsek1.abmeldungsek1:IF ( +schuelerabdat=niltext)OR (schuelerabdat=nildatum)THEN text(blank,6)+ +spaltentrennerELSE abgemsek1+spaltentrenner+blank+mittestrichFI . +abmeldungsek2:IF (schuelerabdat=niltext)OR (schuelerabdat=nildatum)THEN blank +ELSE abgemsek2FI .END PROC schueleraufbereiten;BOOL PROC elementsek1:sek1COR +int(startwertjgst)<11ENDPROC elementsek1;END PACKET versetzlisten; + diff --git a/app/schulis/2.2.1/src/1.listenweise dif dat erf b/app/schulis/2.2.1/src/1.listenweise dif dat erf new file mode 100644 index 0000000..0ef8cfd --- /dev/null +++ b/app/schulis/2.2.1/src/1.listenweise dif dat erf @@ -0,0 +1,255 @@ +PACKET listenweisedifdaterfDEFINES bearbeitungdifdaterf, +difdaterfnichtspeichern,difdaterfspeichern:LET tofather=1,tograndfather=2, +maxsek1="10",niltext="",blank=" ",namenstrenner=", ",null=0,meldtrenner="#"; +LET maskennamepreallg="ms dif dat erf bearbeitung";LET jgst5=5,jgst13=13, +standardanfang=1;LET maxschueler=14,schuelerproseite=15;LET meldbestleer=59, +meldnichtspeichern=63,meldplausi=57,meldwarten=69,meldspeicherung=132, +meldspeicherfehler=131,meldnrfalschesdatum=157,meldnrfalscherschluessel=34; +LET pruefartalternative=5,pruefartgrenzen=3;LET fnrjgst=2,fnrtutor=3,fnrfs1=4 +,fnrag=12,fnrmaskentitel=3,fnrklasse=2;LET mnr1=1,mnr2=2,mnr3=3,mnr4=4,mnr5=5 +,titel09="09",titel10="10",ef1=4,fpz1=4,ef2=3,fpz3=2,fpz4=5;LET awfs1=1,awfs2 +=2,awfs3=3,awfs4=4,awreli=5,awkunst=6,awwp9=7,awwp10=8,awag=9, +auswertungsdistanz=3;LET maxag=3;LET allespruefen=1,einejgstpruefen=2, +eineklassepruefen=3;LET schuelerbestand="ls";LET logtextbeginn="Anw. 1.4.2 ", +logtextalleklassen="alle Klassen";LET logtext1=".Fremdsprache",logtext2= +"Teilnahme am Religionsunterricht",logtext3="Kunst/Musik",logtext4= +"Wahlpflichtfächer",logtext5="Arbeitsgemeinschaften";TEXT VAR logarttext; +BOOL VAR nochwelcheda,alleklassen,tutorenkurs,sek2,eineklasse, +nochweiterebestaende,einejgst;INT VAR fremdsprachenindex,wpindex,waspruefen, +erstesfeld,felderprozeile,standardeinstieg,laengename,laengeklasse, +schuelerzahl,aktuellesfeld,auswertungsnr;ROW schuelerproseiteTEXT VAR name; +ROW schuelerproseiteTEXT VAR rufname;ROW schuelerproseiteTEXT VAR gebdat;ROW +schuelerproseiteTEXT VAR altedaten;TEXT VAR vergleichsjgst,vergleichszug, +sicherungstupel;PROC bearbeitungdifdaterf:TEXT VAR jgst,zug;reinitparsing; +eingangsbildschirmpruefen;IF eingangsbildschirmokTHEN +initialisierungenvornehmen;naechsteportionlesen;IF keinemehrdaTHEN +bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE +eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmok:pruefstatus=0. +eingangsbildschirmpruefen:ankreuzfelderpruefen;IF eingangsbildschirmokTHEN +jgstzugpruefenFI .ankreuzfelderpruefen:INT VAR pruefstatus;standardpruefe( +pruefartalternative,fnrfs1,fnrag,null,niltext,pruefstatus);.jgstzugpruefen: +alleklassen:=FALSE ;IF standardmaskenfeld(fnrjgst)<>niltextTHEN +standardpruefe(pruefartgrenzen,fnrjgst,jgst5,jgst13,niltext,pruefstatus)ELIF +standardmaskenfeld(fnrtutor)<>niltextTHEN pruefstatus:=fnrtutorELSE +alleklassen:=TRUE FI .initialisierungenvornehmen:bestandundmaskesetzen; +bearbeitungsmaskevorbereiten;laengenfestlegen;IF sek2CAND NOT tutorenkurs +THEN startebildschirmblock(ixsustatjgst,maxschueler)ELSE +startebildschirmblock(ixsustatjgstzug,maxschueler)FI . +bearbeitungsmaskevorbereiten:standardstartproc(maskennamepreallg+text( +auswertungsmaskennr));IF maskentitel<>niltextTHEN standardmaskenfeld( +maskentitel,fnrmaskentitel)FI ;SELECT auswertungsmaskennrOF CASE mnr1: +erstesfeld:=ef1;felderprozeile:=fpz1CASE mnr2:erstesfeld:=ef2;felderprozeile +:=fpz1CASE mnr3:erstesfeld:=ef2;felderprozeile:=fpz3CASE mnr4:erstesfeld:=ef1 +;felderprozeile:=fpz4CASE mnr5:erstesfeld:=ef2;felderprozeile:=fpz1END +SELECT ;standardeinstieg:=erstesfeld+1.laengenfestlegen:laengeklasse:= +standardfeldlaenge(fnrklasse);laengename:=standardfeldlaenge(erstesfeld). +naechsteportionlesen:blocklesenundausgeben.keinemehrda:NOT nochwelcheda. +bestandleermelden:standardmeldung(meldbestleer,niltext).eingangsmaskenfehler: +#standardmeldung(meldfalscheauswahl,niltext);#infeld(pruefstatus). +bestandundmaskesetzen:standardmeldung(meldwarten,niltext);bestimmebestand; +setzestartkeys;pruefebestand;bestimmemaske.bestimmebestand:eineklasse:=FALSE +;einejgst:=FALSE ;jgst:=jgstaufber(standardmaskenfeld(fnrjgst));zug:= +standardmaskenfeld(fnrtutor);IF alleklassenTHEN alleklassensetzenELIF +nureineklasseTHEN setzeklasseELSE setzejgstFI .alleklassensetzen:waspruefen:= +allespruefen;sek2:=FALSE ;vergleichsjgst:=niltext;infeld(fnrjgst). +nureineklasse:tutorenkurs:=zug<>niltext;tutorenkurs.setzeklasse:eineklasse:= +TRUE ;waspruefen:=eineklassepruefen;vergleichsjgst:=jgst;vergleichszug:=zug; +sek2:=FALSE ;infeld(fnrtutor).setzejgst:sek2:=istsek2(jgst);einejgst:=TRUE ; +waspruefen:=einejgstpruefen;vergleichsjgst:=jgst;infeld(fnrjgst). +setzestartkeys:inittupel(dnrschueler);putwert(fnrsustatuss,schuelerbestand); +putwert(fnrsusgrpjgst,jgst);putwert(fnrsusgrpzugtut,zug);.pruefebestand: +search(ixsustatjgstzug,FALSE );IF dbstatus=nullCAND (pruefungspeziell( +waspruefen))THEN vergleichsjgst:=wert(fnrsusgrpjgst);vergleichszug:=wert( +fnrsusgrpzugtut);nochwelcheda:=TRUE ;IF alleklassenTHEN waspruefen:= +eineklassepruefenELIF NOT sek2CAND waspruefen=einejgstpruefenTHEN waspruefen +:=eineklassepruefenFI ELSE bestandleermelden;return(tofather);LEAVE +bearbeitungdifdaterfFI .bestimmemaske:setzeauswertungsnr;SELECT auswertungsnr +OF CASE awfs1,awfs2,awfs3,awfs4:auswertungfremdspracheCASE awreli: +auswertungreliCASE awkunst:auswertungkunstCASE awwp9:auswertungwp9CASE awwp10 +:auswertungwp10CASE awag:auswertungagEND SELECT .auswertungfremdsprache:INT +VAR auswertungsmaskennr:=mnr1;maskentitel:=text(auswertungsnr);logarttext:= +maskentitel;logarttextCAT logtext1.auswertungreli:auswertungsmaskennr:=mnr2; +logarttext:=logtext2.auswertungkunst:auswertungsmaskennr:=mnr3;logarttext:= +logtext3.auswertungwp9:auswertungsmaskennr:=mnr4;maskentitel:=titel09; +logarttext:=logtext4.auswertungwp10:auswertungsmaskennr:=mnr4;maskentitel:= +titel10;logarttext:=logtext4.auswertungag:auswertungsmaskennr:=mnr5; +logarttext:=logtext5.setzeauswertungsnr:INT VAR indauswertungsnr;TEXT VAR +maskentitel:=niltext;FOR indauswertungsnrFROM fnrfs1UPTO fnragREP IF +standardmaskenfeld(indauswertungsnr)<>niltextTHEN auswertungsnr:= +indauswertungsnr-auswertungsdistanz;LEAVE setzeauswertungsnrFI PER .END PROC +bearbeitungdifdaterf;PROC difdaterfnichtspeichern:nichtspeichernmelden; +startkeyssetzen;neuerblock.nichtspeichernmelden:standardmeldung( +meldnichtspeichern,niltext);pause(10).startkeyssetzen:restoretupel( +dnrschueler,sicherungstupel);changeindex.END PROC difdaterfnichtspeichern; +PROC difdaterfspeichern:BOOL VAR falschesdatum:=FALSE ;INT VAR lv; +pruefeplausibilitaet;IF dateninordnungTHEN speicherungdurchfuehren; +startkeyssetzen;neuerblockELSE eingabefehler;return(tofather);FI . +pruefeplausibilitaet:BOOL VAR dateninordnung:=TRUE ;standardmeldung( +meldplausi,niltext);aktuellesfeldvorbelegen;FOR suindFROM 1UPTO schuelerzahl +REP pruefezeile;IF NOT dateninordnungTHEN LEAVE pruefeplausibilitaetFI PER . +aktuellesfeldvorbelegen:SELECT auswertungsnrOF CASE awfs1,awfs2,awfs3,awfs4: +vorbelegungmitsprungCASE awreli:vorbelegungmitsprungCASE awkunst: +vorbelegungmitsprungCASE awwp9,awwp10:vorbelegungohnesprungCASE awag: +vorbelegungohnesprungEND SELECT .vorbelegungmitsprung:aktuellesfeld:= +erstesfeld+1-felderprozeile.vorbelegungohnesprung:aktuellesfeld:=erstesfeld. +pruefezeile:falschesdatum:=FALSE ;SELECT auswertungsnrOF CASE awfs1,awfs2, +awfs3,awfs4:ueberpruefefachmitsprungCASE awreli:ueberpruefefachmitsprungCASE +awkunst:ueberpruefefachmitsprungCASE awwp9,awwp10:ueberpruefefachinreiheCASE +awag:ueberpruefefachinreiheEND SELECT .ueberpruefefachmitsprung:aktuellesfeld +:=aktuellesfeld+felderprozeile;dateninordnung:=schluesselexistiert;IF +auswertungsnr=awreliTHEN disablestop;FOR lvFROM 1UPTO 2REP putwert( +fnrddreliunter+lv,datumskonversion(standardmaskenfeld(aktuellesfeld+lv)));IF +iserrorTHEN clearerror;falschesdatum:=TRUE ;dateninordnung:=FALSE ;enablestop +;LEAVE ueberpruefefachmitsprungFI ;PER ;enablestop;FI .ueberpruefefachinreihe +:INT VAR i;FOR iFROM 1UPTO felderprozeile-1REP aktuellesfeldINCR 1; +dateninordnung:=schluesselexistiert;IF NOT dateninordnungTHEN LEAVE +ueberpruefefachinreiheFI PER ;aktuellesfeldINCR 1.schluesselexistiert:TEXT +CONST schleintrag:=compress(subtext(standardmaskenfeld(aktuellesfeld),1,2));( +schleintrag=niltext)COR schluesselvorhanden(schleintrag). +speicherungdurchfuehren:logeintragvornehmen;aendernschleife;kurzwarten. +logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;eintragCAT logarttext; +eintragCAT " für ";IF alleklassenTHEN eintragCAT logtextalleklassenELSE +eintragCAT vergleichsjgst;eintragCAT vergleichszugFI ;logeintrag(eintrag). +kurzwarten:pause(10).aendernschleife:INT VAR suind;INT VAR zahlderaenderungen +:=null;INT VAR satzindex:=erstesfeld;FOR suindFROM 1UPTO schuelerzahlREP +behandleschuelersatz;satzindexINCR felderprozeilePER .behandleschuelersatz: +IF datenveraendertTHEN fuehreaenderungaus;meldevollzugFI .fuehreaenderungaus: +lesenvorbereiten;lesen;zurueckschreiben;.lesenvorbereiten:zahlderaenderungen +INCR 1;putwert(fnrsufamnames,name(suind));putwert(fnrsurufnames,rufname(suind +));putwert(fnrsugebdatums,gebdat(suind)).lesen:search(dnrschueler,TRUE );IF +dbstatus=okCAND wert(fnrsutiddiffdaten)<>niltextTHEN readtid(dnrdiffdaten, +wert(fnrsutiddiffdaten))ELSE dbstatus(notfound)FI .zurueckschreiben:IF +dbstatus=0THEN dbwertesetzen;aenderntransaktionFI .dbwertesetzen: +aktuellesfeld:=satzindex+1;SELECT auswertungsnrOF CASE awfs1,awfs2,awfs3, +awfs4:setzefremdsprachenCASE awreli:setzereliCASE awkunst:setzekunstCASE +awwp9,awwp10:setzewpCASE awag:setzeagEND SELECT .aenderntransaktion:replace( +dnrdiffdaten,wert(fnrsutiddiffdaten)).meldevollzug:TEXT VAR meldungstext;IF +dbstatus=0THEN meldungstext:=compress(standardmaskenfeld(satzindex))+ +meldtrenner;standardmeldung(meldspeicherung,meldungstext)ELSE meldungstext:= +text(dbstatus)+meldtrenner;meldungstextCAT compress(standardmaskenfeld( +satzindex));meldungstextCAT meldtrenner;standardmeldung(meldspeicherfehler, +meldungstext);return(tofather);LEAVE difdaterfspeichernFI ;infeld(satzindex+1 +).datenveraendert:altedaten(suind)<>jetzigedaten.jetzigedaten:INT VAR datind; +TEXT VAR datenindermaske:=niltext;FOR datindFROM 1UPTO felderprozeile-1REP +datenindermaskeCAT text(standardmaskenfeld(satzindex+datind), +standardfeldlaenge(satzindex+datind))PER ;datenindermaske.startkeyssetzen: +restoretupel(dnrschueler,sicherungstupel);changeindex.eingabefehler:IF +falschesdatumTHEN standardmeldung(meldnrfalschesdatum,niltext);infeld( +aktuellesfeld+lv)ELSE standardmeldung(meldnrfalscherschluessel,niltext); +infeld(aktuellesfeld)FI ;.END PROC difdaterfspeichern;BOOL PROC +schluesselvorhanden(TEXT CONST eingabe):putwert(fnrffach,eingabe);search( +dnrfaecher,TRUE );dbstatus=okEND PROC schluesselvorhanden;PROC neuerblock: +evtlnaechsterbestand;blocklesenundausgeben;IF nochwelchedaTHEN return( +tofather)ELSE enter(tograndfather)FI .evtlnaechsterbestand:IF schuelerzahl= +maxschuelerTHEN IF sek2CAND NOT tutorenkursTHEN succ(ixsustatjgst)ELSE succ( +ixsustatjgstzug);FI ;IF dbstatus<>0THEN nochwelcheda:=FALSE ; +nochweiterebestaende:=FALSE ;FI FI ;IF NOT pruefungspeziell(waspruefen)THEN +IF naechsterbestandTHEN changeindex;vergleichsjgst:=wert(fnrsusgrpjgst); +vergleichszug:=wert(fnrsusgrpzugtut);startebildschirmblock(ixsustatjgstzug, +maxschueler)ELSE nochwelcheda:=FALSE FI ELSE restoretupel(dnrschueler, +sicherungstupel);changeindexFI .END PROC neuerblock;PROC +blocklesenundausgeben:REP vorbereiten;gewuenschteszeigen;nachbereitenPER . +vorbereiten:IF NOT nochwelchedaTHEN LEAVE blocklesenundausgebenFI ; +standardmeldung(meldwarten,niltext);schuelerzahl:=null;aktuellesfeld:= +erstesfeld.nachbereiten:nochwelcheda:=(schuelerzahl>null);IF nochwelcheda +THEN savetupel(dnrschueler,sicherungstupel);restlichezeilenloeschen;infeld( +standardanfang);standardfelderausgeben;infeld(standardeinstieg);LEAVE +blocklesenundausgebenELIF naechsterbestandTHEN vergleichsjgst:=wert( +fnrsusgrpjgst);vergleichszug:=wert(fnrsusgrpzugtut);#???# +startebildschirmblock(ixsustatjgstzug,maxschueler);nochwelcheda:=TRUE ELSE +LEAVE blocklesenundausgebenFI ;.restlichezeilenloeschen:INT VAR zeilenzaehler +;INT VAR zeilenfeld:=(schuelerzahl*felderprozeile)+(erstesfeld-1);FOR +zeilenzaehlerFROM schuelerzahlUPTO maxschuelerREP loeschezeilePER . +loeschezeile:INT VAR zeilenincr;FOR zeilenincrFROM 1UPTO felderprozeileREP +zeilenfeldINCR 1;standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank, +zeilenfeld);feldschutz(zeilenfeld)PER ;.gewuenschteszeigen:SELECT +auswertungsnrOF CASE awfs1:zeigefremdsprache1CASE awfs2:zeigefremdsprache2 +CASE awfs3:zeigefremdsprache3CASE awfs4:zeigefremdsprache4CASE awreli: +zeigereliCASE awkunst:zeigekunstCASE awwp9:zeigewp9CASE awwp10:zeigewp10CASE +awag:zeigeagEND SELECT ;.zeigefremdsprache1:fremdsprachenindex:= +fnrdd1fremdfach;bildschirmblock(PROC fremdsprachezeigen,BOOL PROC (INT CONST +)pruefungspeziell,waspruefen).zeigefremdsprache2:fremdsprachenindex:= +fnrdd2fremdfach;bildschirmblock(PROC fremdsprachezeigen,BOOL PROC (INT CONST +)pruefungspeziell,waspruefen).zeigefremdsprache3:fremdsprachenindex:= +fnrdd3fremdfach;bildschirmblock(PROC fremdsprachezeigen,BOOL PROC (INT CONST +)pruefungspeziell,waspruefen).zeigefremdsprache4:fremdsprachenindex:= +fnrdd4fremdfach;bildschirmblock(PROC fremdsprachezeigen,BOOL PROC (INT CONST +)pruefungspeziell,waspruefen).zeigereli:bildschirmblock(PROC relizeigen,BOOL +PROC (INT CONST )pruefungspeziell,waspruefen).zeigekunst:bildschirmblock( +PROC kunstzeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen).zeigewp9: +wpindex:=fnrddfach091a;bildschirmblock(PROC wpzeigen,BOOL PROC (INT CONST ) +pruefungspeziell,waspruefen).zeigewp10:wpindex:=fnrddfach101a;bildschirmblock +(PROC wpzeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen).zeigeag: +bildschirmblock(PROC agzeigen,BOOL PROC (INT CONST )pruefungspeziell, +waspruefen).END PROC blocklesenundausgeben;PROC namezeigen:IF ersterTHEN +klassezeigenundrettenFI ;namenretten;standardmaskenfeld(text(schuelername+ +namenstrenner+schuelervorname,laengename),aktuellesfeld);readtid(dnrdiffdaten +,wert(fnrsutiddiffdaten));aktuellesfeldINCR 1.erster:schuelerzahl=null. +klassezeigenundretten:sek2:=istsek2(wert(fnrsusgrpjgst));IF sek2CAND (NOT +tutorenkurs)THEN sek2sonderbehandlungELSE normalbehandlungFI . +normalbehandlung:vergleichsjgst:=wert(fnrsusgrpjgst);vergleichszug:=wert( +fnrsusgrpzugtut);standardmaskenfeld(text(vergleichsjgst+vergleichszug, +laengeklasse),fnrklasse).sek2sonderbehandlung:vergleichsjgst:=wert( +fnrsusgrpjgst);standardmaskenfeld(text(vergleichsjgst,laengeklasse),fnrklasse +).namenretten:TEXT VAR schuelername,schuelervorname;schuelername:=wert( +fnrsufamnames);schuelervorname:=wert(fnrsurufnames);schuelerzahlINCR 1;name( +schuelerzahl):=schuelername;rufname(schuelerzahl):=schuelervorname;gebdat( +schuelerzahl):=wert(fnrsugebdatums).END PROC namezeigen;PROC +fremdsprachezeigen:namezeigen;gewaehltefremdsprachezeigen. +gewaehltefremdsprachezeigen:TEXT VAR was;INT VAR lv;altedaten(schuelerzahl):= +niltext;FOR lvFROM fremdsprachenindexUPTO fremdsprachenindex+2REP was:=wert( +lv);standardmaskenfeld(was,aktuellesfeld);altedaten(schuelerzahl)CAT text(was +,standardfeldlaenge(aktuellesfeld));feldfrei(aktuellesfeld);aktuellesfeld +INCR 1PER .END PROC fremdsprachezeigen;PROC setzefremdsprachen:TEXT VAR was; +INT VAR lv;FOR lvFROM fremdsprachenindexUPTO fremdsprachenindex+2REP was:= +standardmaskenfeld(aktuellesfeld);putwert(lv,was);aktuellesfeldINCR 1;PER . +END PROC setzefremdsprachen;PROC relizeigen:namezeigen;relidatenzeigen. +relidatenzeigen:INT VAR was:=fnrddreliunter,lv;TEXT VAR daten;altedaten( +schuelerzahl):=niltext;FOR lvFROM wasUPTO was+2REP IF lv=wasTHEN daten:=(wert +(lv));ELSE daten:=datumrekonversion(wert(lv))FI ;standardmaskenfeld(daten, +aktuellesfeld);altedaten(schuelerzahl)CAT text(daten,standardfeldlaenge( +aktuellesfeld));feldfrei(aktuellesfeld);aktuellesfeldINCR 1PER .END PROC +relizeigen;PROC setzereli:INT VAR was:=fnrddreliunter,lv;TEXT VAR daten;FOR +lvFROM wasUPTO was+2REP IF lv=wasTHEN daten:=standardmaskenfeld(aktuellesfeld +);ELSE daten:=datumskonversion(standardmaskenfeld(aktuellesfeld));FI ;putwert +(lv,daten);aktuellesfeldINCR 1PER END PROC setzereli;PROC kunstzeigen: +namezeigen;fachzeigen;merken.fachzeigen:TEXT VAR fach:=wert(fnrddkunstmusik); +standardmaskenfeld(fach,aktuellesfeld);feldfrei(aktuellesfeld);aktuellesfeld +INCR 1.merken:altedaten(schuelerzahl):=text(fach,2).END PROC kunstzeigen; +PROC setzekunst:putwert(fnrddkunstmusik,standardmaskenfeld(aktuellesfeld)); +END PROC setzekunst;PROC wpzeigen:namezeigen;zeigefaecher;merken.zeigefaecher +:INT VAR lv;TEXT VAR wpfaecher:=niltext,fach;FOR lvFROM wpindexUPTO wpindex+3 +REP fach:=wert(lv);standardmaskenfeld(fach,aktuellesfeld);feldfrei( +aktuellesfeld);aktuellesfeldINCR 1;wpfaecherCAT text(fach,2)PER .merken: +altedaten(schuelerzahl):=wpfaecher.END PROC wpzeigen;PROC setzewp:INT VAR lv; +TEXT VAR fach;FOR lvFROM wpindexUPTO wpindex+3REP fach:=standardmaskenfeld( +aktuellesfeld);putwert(lv,fach);aktuellesfeldINCR 1PER END PROC setzewp;PROC +agzeigen:namezeigen;agdatenzeigen.agdatenzeigen:INT VAR agind,woher:=0, +laengeag:=2;TEXT VAR ag:=niltext;altedaten(schuelerzahl):=niltext;FOR agind +FROM 0UPTO maxag-1REP ag:=text(wert(fnrddagthema1+woher),laengeag);agCAT text +(wert(fnrddagthema1b+woher),laengeag+1);agCAT text(wert(fnrddagthema1e+woher) +,laengeag+1);IF compress(ag)<>niltextTHEN standardmaskenfeld(ag,aktuellesfeld +);ELSE standardmaskenfeld(niltext,aktuellesfeld);FI ;altedaten(schuelerzahl) +CAT text(ag,standardfeldlaenge(aktuellesfeld));feldfrei(aktuellesfeld); +aktuellesfeldINCR 1;woherINCR 3PER .END PROC agzeigen;PROC setzeag:INT VAR +agind,wohin:=0;TEXT VAR ag:=niltext;FOR agindFROM 0UPTO maxag-1REP ag:= +standardmaskenfeld(aktuellesfeld);putwert(fnrddagthema1+wohin,subtext(ag,1,2) +);putwert(fnrddagthema1b+wohin,subtext(ag,3,5));putwert(fnrddagthema1e+wohin, +subtext(ag,6,8));wohinINCR 3;aktuellesfeldINCR 1;PER END PROC setzeag;PROC +feldloeschen(INT CONST laenge):standardmaskenfeld(laenge*blank,aktuellesfeld) +END PROC feldloeschen;BOOL PROC istsek2(TEXT CONST jgst):jgst>maxsek1END +PROC istsek2;BOOL PROC naechsterbestand:nochweiterebestaende:=(alleklassen +CAND pruefungspeziell(allespruefen))OR (einejgstCAND pruefungspeziell( +einejgstpruefen))OR (eineklasseCAND pruefungspeziell(eineklassepruefen)); +nochweiterebestaendeEND PROC naechsterbestand;BOOL PROC pruefungspeziell(INT +CONST wasistzutun):BOOL VAR b:=FALSE ;SELECT wasistzutunOF CASE allespruefen: +pruefungalleklassen(b)CASE einejgstpruefen:pruefungeinejgst(b)CASE +eineklassepruefen:pruefungeineklasse(b)END SELECT ;bEND PROC pruefungspeziell +;PROC pruefungalleklassen(BOOL VAR bool):bool:=wert(fnrsustatuss)= +schuelerbestandEND PROC pruefungalleklassen;PROC pruefungeinejgst(BOOL VAR +bool):bool:=(wert(fnrsustatuss)=schuelerbestandCAND wert(fnrsusgrpjgst)= +vergleichsjgst)END PROC pruefungeinejgst;PROC pruefungeineklasse(BOOL VAR +bool):bool:=(wert(fnrsustatuss)=schuelerbestandCAND wert(fnrsusgrpjgst)= +vergleichsjgstCAND wert(fnrsusgrpzugtut)=vergleichszug)END PROC +pruefungeineklasse;END PACKET listenweisedifdaterf + diff --git a/app/schulis/2.2.1/src/1.listenweise erg nachpr b/app/schulis/2.2.1/src/1.listenweise erg nachpr new file mode 100644 index 0000000..6b5a676 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listenweise erg nachpr @@ -0,0 +1,250 @@ +PACKET listenweiseergnachprDEFINES bearbeitungergnachpr, +ergnachprnichtspeichern,ergnachprspeichern:LET tofather=1,tograndfather=2, +jgst5=5,jgst13=13,niltext="",blank=" ",namenstrenner=", ",null=0,punkt=".", +meldtrenner="#";LET jgstufe10=10;LET einejgst=2,eineklasse=3;LET +geaendertersatz="x",kznachpruefung="n",dreizehnnachprsatz="N";LET +standardanfang=1,standardeinstieg=2,abstandzumnamen=2;LET maxschueler=15, +erstesfeld=5,felderprozeile=6,schuelerproseite=16;LET gwklasse=1;LET +bestandengrenzeeinstellig=4,bestandengrenzezweistellig="05",minnoteeinstellig +=1,maxnoteeinstellig=6,minnotezweistellig="00",maxnotezweistellig="15", +leernote="";LET meldbestleer=59,meldnichtspeichern=63,meldwarten=69, +meldspeicherung=132,meldspeicherfehler=131,meldfalschesfach=147, +meldungueltigenote=148,meldfalschesg=134,meldfehlendesfach=52, +meldtransaktionsfehler=138,meldplausi=57,meldfalscheauswahl=56, +meldzugtutorfehlt=52;LET pruefartgrenzen=3;LET fnrjgst=2,fnrtutor=3,fnrklasse +=2,fnrname=3,fnrbetr=4,fnrfach=5,fnrnote=6,fnrzug=7;LET schuljahrkey= +"Schuljahr",anfangschuljahrkey="Anfang Schulhalbjahr",halbjahr1="1",halbjahr2 +="2",bestandlaufsj="ls",bestandabgegangene="abg";LET allespruefen=1, +einejgstpruefen=2,eineklassepruefen=3;LET anzkenndaten=3,sek2min=11;LET +logtextbeginn="Anw. 1.4.9 Nachprüfungen für ",logtextalleklassen= +"alle Klassen";BOOL VAR nochwelcheda,alleklassen;INT VAR waspruefen, +laengeklasse,laengename,laengebetr,laengefach,laengenote,laengezugtutor, +bestandindex,schuelerzahl,aktuellesfeld;ROW schuelerproseiteTEXT VAR name; +ROW schuelerproseiteTEXT VAR rufname;ROW schuelerproseiteTEXT VAR gebdatum; +ROW schuelerproseiteBOOL VAR dreizehner;ROW schuelerproseiteTEXT VAR +altedaten;ROW schuelerproseiteTEXT VAR npfaecher;ROW anzkenndatenTEXT VAR key +;TEXT VAR startkey1,startkey2,aktschuljahr,schuljahr,schulhalbjahr,hjdtupel, +schuelertupel,sichtupel;PROC bearbeitungergnachpr:reinitparsing; +eingangsbildschirmpruefen;IF eingangsbildschirmokTHEN +initialisierungenvornehmen;naechsteportionlesen;IF keinemehrdaTHEN +bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE +eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmpruefen:INT VAR +pruefstatus:=null;startkey1:=niltext;startkey2:=niltext;alleklassen:=FALSE ; +IF standardmaskenfeld(fnrjgst)<>niltextTHEN standardpruefe(pruefartgrenzen, +fnrjgst,jgst5,jgst13,niltext,pruefstatus);IF pruefstatus=nullTHEN startkey1:= +jgstaufber(standardmaskenfeld(fnrjgst));startkey2:=standardmaskenfeld( +fnrtutor);IF standardmaskenfeld(fnrtutor)=niltextTHEN bestandindex:=einejgst +ELSE bestandindex:=eineklasseFI FI ELIF standardmaskenfeld(fnrtutor)<>niltext +THEN pruefstatus:=fnrtutorELSE alleklassen:=TRUE FI .eingangsbildschirmok: +pruefstatus=null.initialisierungenvornehmen:plausipruefungvorbereiten; +bestandsetzen;standardstartproc(maske(vergleichsknoten));laengenfestlegen;IF +waspruefen=einejgstpruefenAND sek2THEN startebildschirmblock( +ixhjdsjhjverjgstkenn,maxschueler);ELSE startebildschirmblock(ixhjdsjhjverjgst +,maxschueler);FI .sek2:int(startkey1)>=sek2min.bestandsetzen:bestimmebestand; +setzestartkeys;pruefebestand.bestimmebestand:aktschuljahr:=schulkenndatum( +schuljahrkey);schuljahr:=subtext(aktschuljahr,1,2);schuljahr:=text(int( +schuljahr)-1)+schuljahr;schulhalbjahr:=halbjahr2;IF alleklassenTHEN +alleklassensetzenELSE SELECT bestandindexOF CASE einejgst:bestandjgstCASE +eineklasse:bestandklasseEND SELECT FI ;.alleklassensetzen:waspruefen:= +allespruefen;infeld(fnrjgst).bestandjgst:waspruefen:=einejgstpruefen;infeld( +fnrjgst).bestandklasse:waspruefen:=eineklassepruefen;infeld(fnrtutor). +setzestartkeys:putwert(fnrhjdsj,schuljahr);putwert(fnrhjdhj,schulhalbjahr); +putwert(fnrhjdjgst,startkey1);putwert(fnrhjdkennung,startkey2);putwert( +fnrhjdversetzung,kznachpruefung).pruefebestand:search(ixhjdsjhjverjgstkenn, +FALSE );IF dbstatus<>nullOR (NOT pruefungspeziell(waspruefen))THEN +bestandleermelden;return(tofather);LEAVE bearbeitungergnachprELSE +nochwelcheda:=TRUE FI .laengenfestlegen:laengeklasse:=standardfeldlaenge( +fnrklasse);laengename:=standardfeldlaenge(fnrname);laengebetr:= +standardfeldlaenge(fnrbetr);laengefach:=standardfeldlaenge(fnrfach); +laengenote:=standardfeldlaenge(fnrnote);laengezugtutor:=standardfeldlaenge( +fnrzug).plausipruefungvorbereiten:standardmeldung(meldwarten,niltext);. +naechsteportionlesen:blocklesenundausgeben.keinemehrda:NOT nochwelcheda. +bestandleermelden:infeld(fnrjgst);standardmeldung(meldbestleer,niltext). +eingangsmaskenfehler:standardmeldung(meldfalscheauswahl,niltext);infeld( +pruefstatus).END PROC bearbeitungergnachpr;PROC ergnachprnichtspeichern: +nichtspeichernmelden;startkeyssetzen;neuerblock.nichtspeichernmelden: +standardmeldung(meldnichtspeichern,niltext);pause(10).startkeyssetzen: +restoretupel(dnrhalbjahresdaten,hjdtupel);changeindex.END PROC +ergnachprnichtspeichern;PROC ergnachprspeichern:BOOL VAR +halbjahresdateninzwischengeaendert,schuelerdateninzwischengeaendert;TEXT VAR +altejgst:="",alterzug:="",neuejgst:="";pruefeplausibilitaet;IF dateninordnung +THEN speicherungdurchfuehren;startkeyssetzen;neuerblockELSE eingabefehler; +return(tofather)FI .pruefeplausibilitaet:standardmeldung(meldplausi,niltext); +BOOL VAR dateninordnung:=TRUE ;INT VAR satzindex:=erstesfeld;INT VAR fehlernr +;TEXT VAR fehlertext:=niltext;FOR suindFROM 1UPTO schuelerzahlREP pruefezeile +;IF NOT dateninordnungTHEN LEAVE pruefeplausibilitaetFI ;satzindexINCR +felderprozeilePER .pruefezeile:dateninordnung:=allesfreiCOR allesrichtig. +allesrichtig:((noterichtig)CAND (schuelergrupperichtig))CAND (fachrichtig). +noterichtig:((NOT fehlendertutor)CAND (gueltigenote))CAND (NOT fehlendesfach) +.fehlendertutor:fehlernr:=meldzugtutorfehlt;aktuellesfeld:=satzindex+2; +sitzengebliebenCAND keintutor.sitzengeblieben:IF length(eingegebenenote)=1 +THEN int(eingegebenenote)>bestandengrenzeeinstelligELSE eingegebenenote< +bestandengrenzezweistelligFI .eingegebenenote:standardmaskenfeld(satzindex+1) +.gueltigenote:fehlernr:=meldungueltigenote;aktuellesfeld:=satzindex+1;TEXT +VAR pruefungsnote:=eingegebenenote;noteimbereich.noteimbereich:pruefungsnote= +leernoteOR (notenichtzukleinCAND notenichtzugross).notenichtzuklein:IF length +(pruefungsnote)=1THEN int(pruefungsnote)>=minnoteeinstelligELSE pruefungsnote +>=minnotezweistelligFI .notenichtzugross:IF length(pruefungsnote)=1THEN int( +pruefungsnote)<=maxnoteeinstelligELSE pruefungsnote<=maxnotezweistelligFI . +fehlendesfach:fehlernr:=meldfehlendesfach;aktuellesfeld:=satzindex;bestanden +CAND keinfach.bestanden:NOT sitzengeblieben.schuelergrupperichtig:fehlernr:= +meldfalschesg;aktuellesfeld:=satzindex+2;fehlertext:=standardmaskenfeld( +aktuellesfeld)+meldtrenner;keintutorCOR schuelergruppeimbestand. +schuelergruppeimbestand:#????#putwert(fnrsgrpsj,aktschuljahr);putwert( +fnrsgrphj,halbjahr1);putwert(fnrsgrpjgst,schuelergruppenschluessel);putwert( +fnrsgrpkennung,eingegebenertutor);search(dnraktschuelergruppen,TRUE ); +dbstatus=null.schuelergruppenschluessel:IF bestandenCAND NOT +dreizehnernachprueflingTHEN jahrgangsstufeeinshoeherELSE +bisherigejahrgangsstufeFI .bisherigejahrgangsstufe:subtext(altedaten(suind),1 +,2).jahrgangsstufeeinshoeher:jgstaufber(text(int(bisherigejahrgangsstufe)+1)) +.eingegebenertutor:standardmaskenfeld(satzindex+2).fachrichtig:fehlernr:= +meldfalschesfach;aktuellesfeld:=satzindex;fehlertext:=npfaecher(suind)+ +meldtrenner;keinfachCOR ausdemvorgegebenenbereich.ausdemvorgegebenenbereich: +pos(fehlertext,eingegebenesfach)>null.eingegebenesfach:standardmaskenfeld( +satzindex).allesfrei:(keintutorCAND keinfach)CAND keinenote.keintutor: +eingegebenertutor=niltextCOR eingegebenertutor="abg.".keinenote: +standardmaskenfeld(satzindex+1)=niltext.keinfach:eingegebenesfach=niltext. +speicherungdurchfuehren:logeintragvornehmen;aendernschleife;kurzwarten. +logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;IF alleklassenTHEN +eintragCAT logtextalleklassenELSE eintragCAT startkey1;eintragCAT startkey2 +FI ;logeintrag(eintrag).kurzwarten:pause(10).aendernschleife:INT VAR suind; +INT VAR zahlderaenderungen:=null;satzindex:=erstesfeld-abstandzumnamen;FOR +suindFROM 1UPTO schuelerzahlREP behandleschuelersatz;satzindexINCR +felderprozeilePER .behandleschuelersatz:IF datenveraendertTHEN +aenderungvorbereiten;IF zwischenzeitlichgeaendertTHEN transaktionsfehlerELSE +dateninpuffersetzen;schreibtransaktion;meldevollzugFI ;FI ;.datenveraendert: +subtext(altedaten(suind),laengeklasse+1)<>jetzigedaten.jetzigedaten:INT VAR +datenfeldanfang:=satzindex+abstandzumnamen;standardmaskenfeld(datenfeldanfang +)+standardmaskenfeld(datenfeldanfang+1)+standardmaskenfeld(datenfeldanfang+2) +.aenderungvorbereiten:lesenvorbereiten;lesen.lesenvorbereiten: +zahlderaenderungenINCR 1;key(1):=name(suind);key(2):=rufname(suind);key(3):= +datumrekonversion(gebdatum(suind));schluesselfuerhjddateisetzen. +schluesselfuerhjddateisetzen:schluesselfuerhjdsetzen(dnrhalbjahresdaten,key, +schuljahr,halbjahr2,"").lesen:search(dnrhalbjahresdaten,TRUE ); +halbjahresdateninzwischengeaendert:=(dbstatus<>ok);IF dbstatus=okTHEN +saveupdateposition(dnrhalbjahresdaten);savetupel(dnrhalbjahresdaten,sichtupel +);altejgst:=jgstaufber(wert(fnrhjdjgst));schluesselfuerschuelerdateisetzen; +search(dnrschueler,TRUE );schuelerdateninzwischengeaendert:=(dbstatus<>ok); +IF dbstatus=okTHEN alterzug:=wert(fnrsusgrpzugtut);saveupdateposition( +dnrschueler);savetupel(dnrschueler,schuelertupel)FI FI . +zwischenzeitlichgeaendert:halbjahresdateninzwischengeaendertOR +schuelerdateninzwischengeaendert.transaktionsfehler:standardmeldung( +meldtransaktionsfehler,niltext);return(tofather);infeld(satzindex+ +abstandzumnamen);LEAVE ergnachprspeichern.dateninpuffersetzen:IF jetzigedaten +=niltextTHEN noteundfachsetzen;schuelerdatenaendernELIF nichtbestandenTHEN +nichtbestandenneuELSE notenfachundneuerzugFI ;neuerzugtutorloeschen. +schuelerdatenaendern:putwert(fnrsustatuss,bestandlaufsj);IF +dreizehnernachprueflingTHEN putwert(fnrsusgrpjgst,text(jgst13));putwert( +fnrsuartzugang,dreizehnnachprsatz)ELSE neuejgst:=jgstaufber(text(int(altejgst +)+1));putwert(fnrsusgrpjgst,neuejgst);putwert(fnrsusgrpzugtut,wert( +fnrhjdkennung));putwert(fnrsuartzugang,kznachpruefung)FI .nichtbestanden: +datenfeldanfang:=satzindex+abstandzumnamen;IF length(standardmaskenfeld( +datenfeldanfang+1))=1THEN int(standardmaskenfeld(datenfeldanfang+1))> +bestandengrenzeeinstelligELSE standardmaskenfeld(datenfeldanfang+1)< +bestandengrenzezweistelligFI .notenfachundneuerzug:noteundfachsetzen;IF +dreizehnernachprueflingTHEN dreizehnerabmeldenELSE neuejgst:=jgstaufber(text( +int(altejgst)+1));putwert(fnrsusgrpjgst,neuejgst);putwert(fnrsuartzugang, +kznachpruefung);neuerzugsetzenFI .noteundfachsetzen:TEXT VAR fach:= +standardmaskenfeld(datenfeldanfang);TEXT VAR note:=standardmaskenfeld( +datenfeldanfang+1);putwert(fnrhjdnachfach,fach);putwert(fnrhjdnacherg,note). +dreizehnernachpruefling:dreizehner(suind).dreizehnerabmelden:putwert( +fnrsustatuss,bestandabgegangene);putwert(fnrsuabgdats,schulkenndatum( +anfangschuljahrkey)).neuerzugsetzen:TEXT VAR neuerzug;neuerzug:= +standardmaskenfeld(datenfeldanfang+2);IF neuerzug<>niltextTHEN IF neuerzug<> +alterzugTHEN putwert(fnrsusgrpzugtut,neuerzug);FI ELSE IF jgstaufber(wert( +fnrsusgrpjgst))=altejgstTHEN putwert(fnrsusgrpzugtut,wert(fnrhjdkennung))FI +FI ;zuginakthjdaendern.zuginakthjdaendern:savetupel(dnrhalbjahresdaten, +sichtupel);neueklasseinhalbjahresdateneintragen(key,aktschuljahr,halbjahr1, +neuejgst,neuerzug);IF dbstatus=okTHEN putwert(fnrsutidakthjd,gettid)FI ; +restoretupel(dnrhalbjahresdaten,sichtupel).nichtbestandenneu: +noteundfachsetzen;setzezugang;savetupel(dnrhalbjahresdaten,sichtupel); +setzejgstrunter;halbjahresdatenbearbeiten;restoretupel(dnrhalbjahresdaten, +sichtupel).setzezugang:putwert(fnrsuartzugang,geaendertersatz). +setzejgstrunter:neuejgst:=jgstaufber(text(int(altejgst)));neuerzug:= +standardmaskenfeld(datenfeldanfang+2);putwert(fnrsusgrpjgst,neuejgst);putwert +(fnrsusgrpzugtut,neuerzug);putwert(fnrsustatuss,bestandlaufsj);. +halbjahresdatenbearbeiten:IF NOT dreizehnernachprueflingTHEN +nachfolgendehjdsloeschen;FI .nachfolgendehjdsloeschen:halbjahresdatenloeschen +(PROC (INT CONST )succ,key,halbjahr2,int(neuejgst),FALSE );. +neuerzugtutorloeschen:putwert(fnrsuneuerzugtut,niltext).schreibtransaktion: +restoreupdateposition(dnrhalbjahresdaten);selupdate(dnrhalbjahresdaten);IF +dbstatus<>okTHEN restoretupel(dnrschueler,schuelertupel)ELSE +restoreupdateposition(dnrschueler);selupdate(dnrschueler);IF dbstatus<>ok +THEN restoretupel(dnrschueler,schuelertupel)ELSE IF int(neuejgst)=int( +altejgst)THEN evtlkurswahldatenfuerwiederholerbehandelnFI ;FI FI . +evtlkurswahldatenfuerwiederholerbehandeln:IF int(neuejgst)>=jgstufe10THEN +kurswahlserveraktualisieren(neuejgst,"","")FI ;IF (int(neuejgst)+1)>= +jgstufe10THEN kurswahlserveraktualisieren(text(int(neuejgst)+1),"","")FI . +meldevollzug:TEXT VAR meldungstext;IF dbstatus=0THEN meldungstext:=compress( +standardmaskenfeld(satzindex))+meldtrenner;standardmeldung(meldspeicherung, +meldungstext)ELSE meldungstext:=text(dbstatus)+meldtrenner;meldungstextCAT +compress(standardmaskenfeld(satzindex));meldungstextCAT meldtrenner; +standardmeldung(meldspeicherfehler,meldungstext);return(tofather);LEAVE +ergnachprspeichernFI ;infeld(satzindex+abstandzumnamen).startkeyssetzen: +restoretupel(dnrhalbjahresdaten,hjdtupel);changeindex.eingabefehler: +standardmeldung(fehlernr,fehlertext);infeld(aktuellesfeld).END PROC +ergnachprspeichern;PROC neuerblock:blocklesenundausgeben;IF nochwelchedaTHEN +return(tofather)ELSE enter(tograndfather)FI .END PROC neuerblock;PROC +blocklesenundausgeben:vorbereiten;initgruppenwechsel;gewuenschteszeigen; +nachbereiten.vorbereiten:IF NOT nochwelchedaTHEN LEAVE blocklesenundausgeben +FI ;standardmeldung(meldwarten,niltext);schuelerzahl:=null;aktuellesfeld:= +standardeinstieg.gewuenschteszeigen:bildschirmblock(PROC datenzeigen,BOOL +PROC (INT CONST )pruefungspeziell,waspruefen).nachbereiten:nochwelcheda:=( +schuelerzahl>null);IF nochwelchedaTHEN savetupel(dnrhalbjahresdaten,hjdtupel) +;restlichezeilenloeschen;infeld(standardanfang);standardfelderausgebenELSE +LEAVE blocklesenundausgebenFI ;infeld(erstesfeld).restlichezeilenloeschen: +INT VAR zeilenzaehler;INT VAR zeilenfeld:=(schuelerzahl*felderprozeile)+1; +FOR zeilenzaehlerFROM schuelerzahlUPTO schuelerproseite-1REP loeschezeilePER +.loeschezeile:INT VAR zeilenincr;FOR zeilenincrFROM 1UPTO felderprozeileREP +zeilenfeldINCR 1;standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank, +zeilenfeld);feldschutz(zeilenfeld)PER ;.END PROC blocklesenundausgeben;PROC +datenzeigen:TEXT VAR merkdaten:=niltext;zaehlen;zeigenundmerken.zaehlen: +schuelerzahlINCR 1.zeigenundmerken:altejgstzeigen;namezeigen;aktjgstzeigen; +fachzeigen;npfaechermerken;notezeigen;neuerzugtutorzeigen.altejgstzeigen:IF +dreizehnerzurnachpruefungTHEN aenderungsetzenELSE neusetzenFI ; +betreffendeszeigen.dreizehnerzurnachpruefung:intwert(fnrhjdjgst)=jgst13. +aenderungsetzen:BOOL VAR satzgeaendert:=TRUE ;.neusetzen:satzgeaendert:= +FALSE ;.betreffendeszeigen:TEXT VAR alteklasse:=jgstaufber(wert(fnrhjdjgst))+ +wert(fnrhjdkennung);dreizehner(schuelerzahl):=satzgeaendert; +standardmaskenfeld(text(alteklasse,laengeklasse),aktuellesfeld);merkdaten:= +text(alteklasse,laengeklasse);gruppenwechsel(alteklasse,gwklasse,laengeklasse +,1,aktuellesfeld);.namezeigen:namenretten;standardmaskenfeld(text( +schuelername+namenstrenner+schuelervorname,laengename),aktuellesfeld); +aktuellesfeldINCR 1.namenretten:TEXT VAR schuelername,schuelervorname; +schuelername:=wert(fnrhjdfamnames);schuelervorname:=wert(fnrhjdrufnames);name +(schuelerzahl):=schuelername;rufname(schuelerzahl):=schuelervorname;gebdatum( +schuelerzahl):=wert(fnrhjdgebdats).aktjgstzeigen:TEXT VAR aktklasse:=niltext; +schluesselfuerschuelerdateisetzen;search(dnrschueler,TRUE );IF dbstatus=ok +THEN aktklasse:=jgstaufber(wert(fnrsusgrpjgst))+wert(fnrsusgrpzugtut)FI ; +standardmaskenfeld(aktklasse,aktuellesfeld);aktuellesfeldINCR 1.fachzeigen: +TEXT VAR fach:=niltext,faecher:=niltext;fach:=wert(fnrhjdnachfach);merkdaten +CAT fach;standardmaskenfeld(fach,aktuellesfeld);feldfrei(aktuellesfeld); +aktuellesfeldINCR 1.npfaechermerken:INT VAR fachind;FOR fachindFROM +fnrhjdnachfach1UPTO fnrhjdnachfach1+2REP faecherCAT wert(fachind);faecherCAT +namenstrenner;PER ;npfaecher(schuelerzahl):=faecher.notezeigen:TEXT VAR note; +note:=wert(fnrhjdnacherg);merkdatenCAT note;standardmaskenfeld(note, +aktuellesfeld);feldfrei(aktuellesfeld);aktuellesfeldINCR 1. +neuerzugtutorzeigen:#????#TEXT VAR tutor;IF wert(fnrsustatuss)= +bestandabgegangeneTHEN tutor:=bestandabgegangene+punktELSE tutor:=niltext;# +wert(fnrsusgrpzugtut);15.07.87dr#FI ;merkdatenCAT tutor;standardmaskenfeld( +tutor,aktuellesfeld);altedaten(schuelerzahl):=merkdaten;feldfrei( +aktuellesfeld);aktuellesfeldINCR 1.END PROC datenzeigen;PROC +schluesselfuerschuelerdateisetzen:inittupel(dnrschueler);putwert( +fnrsufamnames,wert(fnrhjdfamnames));putwert(fnrsurufnames,wert(fnrhjdrufnames +));putwert(fnrsugebdatums,wert(fnrhjdgebdats));.END PROC +schluesselfuerschuelerdateisetzen;PROC feldloeschen(INT CONST laenge): +standardmaskenfeld(laenge*blank,aktuellesfeld)END PROC feldloeschen;BOOL +PROC pruefungspeziell(INT CONST wasistzutun):BOOL VAR b:=FALSE ;SELECT +wasistzutunOF CASE allespruefen:pruefungalleklassen(b)CASE einejgstpruefen: +pruefungeinejgst(b)CASE eineklassepruefen:pruefungeineklasse(b)END SELECT ;b +END PROC pruefungspeziell;PROC pruefungalleklassen(BOOL VAR bool):bool:=(wert +(fnrhjdsj)=schuljahrCAND wert(fnrhjdhj)=schulhalbjahrCAND wert( +fnrhjdversetzung)=kznachpruefung)END PROC pruefungalleklassen;PROC +pruefungeinejgst(BOOL VAR bool):bool:=(wert(fnrhjdsj)=schuljahrCAND wert( +fnrhjdhj)=schulhalbjahrCAND wert(fnrhjdversetzung)=kznachpruefungCAND +jgstaufber(wert(fnrhjdjgst))=startkey1)END PROC pruefungeinejgst;PROC +pruefungeineklasse(BOOL VAR bool):bool:=(wert(fnrhjdsj)=schuljahrCAND wert( +fnrhjdhj)=schulhalbjahrCAND wert(fnrhjdversetzung)=kznachpruefungCAND +jgstaufber(wert(fnrhjdjgst))=startkey1CAND wert(fnrhjdkennung)=startkey2)END +PROC pruefungeineklasse;END PACKET listenweiseergnachpr + diff --git a/app/schulis/2.2.1/src/1.listenweise erg vers konf b/app/schulis/2.2.1/src/1.listenweise erg vers konf new file mode 100644 index 0000000..83ce515 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listenweise erg vers konf @@ -0,0 +1,219 @@ +PACKET listenweiseergverskonfDEFINES bearbeitungergverskonf, +ergverskonfnichtspeichern,ergverskonfspeichern:LET tofather=1,tograndfather=2 +,jgst5=5,jgst13=13,leerejgst=" ",maxfach=3,niltext="",blank=" ", +namenstrenner=", ",unterstrich="_",null=0,leererzug=" ",meldtrenner="#"; +LET nachpruefling="n",versetzter="vs",wiederholer="wf";LET schuljahrkey= +"Schuljahr",schulhalbjahrkey="Schulhalbjahr";LET maxschueler=15,erstesfeld=2, +felderprozeile=4,schuelerproseite=16,laengefach=2;LET gwklasse=1;LET +meldbestleer=59,meldnichtspeichern=63,meldplausi=57,meldwarten=69, +meldspeicherung=132,meldspeicherfehler=131,meldfalscheauswahl=56, +meldtransaktionsfehler=138,meldfalscheeingabe1=136,meldfalscheeingabe2=137, +meldungueltigesfach=149;LET pruefartgrenzen=3;LET fnrjgst=2,fnrtutor=3, +fnrklasse=2,fnrname=3,fnrvers=4,fnrnachprfaecher=5;LET einejgst=2,eineklasse= +3;LET standardanfang=1,standardeinstieg=4;LET allespruefen=1,einejgstpruefen= +2,eineklassepruefen=3;LET anzkenndaten=3,sek2min=11,laufbestand="ls";LET +logtextbeginn="Anw. 1.4.4 Versetzungen für ",logtextalleklassen= +"alle Klassen";BOOL VAR nochwelcheda,alleklassen;INT VAR waspruefen:=0;INT +VAR laengeklasse,laengename,laengenachprfaecher,bestandindex,laengevers, +schuelerzahl,aktuellesfeld;ROW schuelerproseiteROW anzkenndatenTEXT VAR +kenndatum;ROW schuelerproseiteTEXT VAR altedaten;TEXT VAR schuelertid:="", +hjdtid:="";TEXT VAR versetzungszeichen:="";TEXT VAR startkey1,startkey2, +sicherungstupel,vergleichsjgst,zulaessigekuerzel,schuljahr,schulhalbjahr, +gueltigejgst,gueltigerzug;TEXT VAR fachkatalog:="";LET trenner="�";PROC +bearbeitungergverskonf:reinitparsing;eingangsbildschirmpruefen;IF +eingangsbildschirmokTHEN initialisierungenvornehmen;naechsteportionlesen;IF +keinemehrdaTHEN bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE +eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmpruefen:INT VAR +pruefstatus:=null;startkey1:=niltext;startkey2:=niltext;vergleichsjgst:= +niltext;alleklassen:=FALSE ;IF standardmaskenfeld(fnrjgst)<>niltextTHEN +standardpruefe(pruefartgrenzen,fnrjgst,jgst5,jgst13,niltext,pruefstatus);IF +pruefstatus=nullTHEN startkey1:=jgstaufber(standardmaskenfeld(fnrjgst)); +vergleichsjgst:=startkey1;startkey2:=standardmaskenfeld(fnrtutor);IF +standardmaskenfeld(fnrtutor)=niltextTHEN bestandindex:=einejgstELSE +bestandindex:=eineklasseFI FI ELIF standardmaskenfeld(fnrtutor)<>niltextTHEN +pruefstatus:=fnrtutorELSE alleklassen:=TRUE FI .eingangsbildschirmok: +pruefstatus=null.initialisierungenvornehmen:plausipruefungvorbereiten; +bestandsetzen;standardstartproc(maske(vergleichsknoten));laengenfestlegen;IF +waspruefen=einejgstpruefenCAND sek2THEN startebildschirmblock(ixsustatjgst, +maxschueler);ELSE startebildschirmblock(ixsustatjgstzug,maxschueler);FI .sek2 +:int(startkey1)>=sek2min.bestandsetzen:bestimmebestand;setzestartkeys; +pruefebestand.bestimmebestand:schuljahr:=schulkenndatum(schuljahrkey); +schulhalbjahr:=schulkenndatum(schulhalbjahrkey);IF alleklassenTHEN +alleklassensetzenELSE SELECT bestandindexOF CASE einejgst:bestandjgstCASE +eineklasse:bestandklasseEND SELECT FI ;.alleklassensetzen:waspruefen:= +allespruefen;infeld(fnrjgst).bestandjgst:waspruefen:=einejgstpruefen;infeld( +fnrjgst).bestandklasse:waspruefen:=eineklassepruefen;infeld(fnrtutor). +setzestartkeys:inittupel(dnrschueler);putwert(fnrsustatuss,laufbestand); +putwert(fnrsusgrpjgst,startkey1);putwert(fnrsusgrpzugtut,startkey2);. +pruefebestand:IF waspruefen=einejgstpruefenCAND sek2THEN search(ixsustatjgst, +FALSE )ELSE search(ixsustatjgstzug,FALSE )FI ;IF dbstatus<>nullCOR (NOT +pruefungspeziell(waspruefen))THEN bestandleermelden;return(tofather);LEAVE +bearbeitungergverskonfELSE nochwelcheda:=TRUE FI .laengenfestlegen: +laengeklasse:=standardfeldlaenge(fnrklasse);laengename:=standardfeldlaenge( +fnrname);laengevers:=standardfeldlaenge(fnrvers);laengenachprfaecher:= +standardfeldlaenge(fnrnachprfaecher).plausipruefungvorbereiten: +standardmeldung(meldwarten,niltext);zulaessigekuerzel:=nachpruefling+ +versetzter+wiederholer+blank.naechsteportionlesen:blocklesenundausgeben. +keinemehrda:NOT nochwelcheda.bestandleermelden:infeld(fnrjgst); +standardmeldung(meldbestleer,niltext).eingangsmaskenfehler:standardmeldung( +meldfalscheauswahl,niltext);infeld(pruefstatus).END PROC +bearbeitungergverskonf;PROC ergverskonfnichtspeichern:nichtspeichernmelden; +startkeyssetzen;neuerblock.nichtspeichernmelden:standardmeldung( +meldnichtspeichern,niltext);pause(10).startkeyssetzen:restoretupel( +dnrschueler,sicherungstupel);#dr02.05.88#changeindex.END PROC +ergverskonfnichtspeichern;PROC ergverskonfspeichern:BOOL VAR hjdgefunden:= +FALSE ;pruefeplausibilitaet;IF dateninordnungTHEN speicherungdurchfuehren; +startkeyssetzen;neuerblockELSE eingabefehler;return(tofather)FI . +pruefeplausibilitaet:standardmeldung(meldplausi,niltext);BOOL VAR +dateninordnung:=TRUE ,richtigesverskz,ungueltigefachangaben:=FALSE , +fachfehler:=FALSE ;INT VAR versfeld:=felderprozeile;FOR suindFROM 1UPTO +schuelerzahlREP pruefezeile;IF NOT dateninordnungTHEN LEAVE +pruefeplausibilitaetFI ;versfeldINCR felderprozeilePER .pruefezeile:TEXT VAR +gefundenesverskz:=standardmaskenfeld(versfeld);richtigesverskz:= +gefundenesverskz=niltextOR (pos(zulaessigekuerzel,gefundenesverskz)>null);IF +richtigesverskzTHEN pruefefachangabenzuverskz;IF ungueltigefachangabenTHEN +dateninordnung:=FALSE FI ELSE dateninordnung:=FALSE FI . +pruefefachangabenzuverskz:IF gefundenesverskz<>nachprueflingTHEN IF NOT +keineeingabenTHEN ungueltigefachangaben:=TRUE FI ELSE pruefefachangaben;IF +fachfehlerTHEN ungueltigefachangaben:=TRUE FI FI .pruefefachangaben:IF +fachkatalog=niltextTHEN holeaktuellenfachkatalogFI ;TEXT VAR fachangaben:= +standardmaskenfeld(versfeld+1);INT VAR lenfachang:=length(fachangaben);INT +VAR fachanzahl:=(lenfachang+1)DIV laengefach;INT VAR i;TEXT VAR fach;FOR i +FROM 0UPTO fachanzahl-1REP fach:=subtext(fachangaben,i*laengefach+1,i* +laengefach+laengefach);changeall(fach,unterstrich,niltext);fach:=compress( +fach);IF fach<>niltextCAND fachungueltig(fach)THEN fachfehler:=TRUE FI UNTIL +fachfehlerPER .keineeingaben:BOOL VAR b:=TRUE ;INT VAR lv;TEXT VAR t:= +standardmaskenfeld(versfeld+1);FOR lvFROM 1UPTO length(t)REP b:=(tSUB lv)= +unterstrichUNTIL NOT bPER ;b.speicherungdurchfuehren:vorbereiten; +logeintragvornehmen;aendernschleife;kurzwarten.logeintragvornehmen:TEXT VAR +eintrag:=logtextbeginn;IF alleklassenTHEN eintragCAT logtextalleklassenELSE +eintragCAT startkey1;eintragCAT startkey2FI ;logeintrag(eintrag).kurzwarten: +pause(10).vorbereiten:gueltigejgst:=vergleichsjgst;gueltigerzug:=startkey2;. +aendernschleife:INT VAR suind;INT VAR zahlderaenderungen:=null;INT VAR +satzindex:=felderprozeile-1;FOR suindFROM 1UPTO schuelerzahlREP +behandleschuelersatz;satzindexINCR felderprozeilePER .behandleschuelersatz: +IF vergleichsjgst=niltextTHEN gueltigejgstneubestimmenFI ;IF startkey2= +niltextTHEN gueltigenzugneubestimmenFI ;IF datenveraendertTHEN +fuehreaenderungaus;meldevollzugFI .gueltigejgstneubestimmen:TEXT VAR +pruefjgst:=subtext(standardmaskenfeld(satzindex-1),1,2);IF pruefjgst<> +leerejgstTHEN gueltigejgst:=pruefjgstFI ;.gueltigenzugneubestimmen:TEXT VAR +pruefzug:=subtext(standardmaskenfeld(satzindex-1),3,6);IF pruefzug<>leererzug +THEN gueltigerzug:=pruefzugFI .datenveraendert:altedaten(suind)<>( +standardmaskenfeld(satzindex+1)+standardmaskenfeld(satzindex+2)). +fuehreaenderungaus:lesenvorbereiten;lesen;hjdgefunden:=dbstatus=ok;IF +dbstatus=okTHEN saveupdateposition(dnrhalbjahresdaten);hjdtid:=gettid; +versetzungszeichen:=wert(fnrhjdversetzung);zurueckschreiben;ELSE +versetzungszeichen:=niltext;neuensatzankoppelnFI .lesenvorbereiten: +zahlderaenderungenINCR 1;schluesselfuerhjdsetzen(dnrhalbjahresdaten,kenndatum +[suind],schuljahr,schulhalbjahr,gueltigejgst);.lesen:search( +dnrhalbjahresdaten,TRUE );.zurueckschreiben:IF datenaenderungTHEN +transaktionsfehlerELSE schreibtransaktionFI .datenaenderung:( +versetzungsergebnis+nachpruefungsfaecher)<>altedaten(suind). +versetzungsergebnis:wert(fnrhjdversetzung).transaktionsfehler:standardmeldung +(meldtransaktionsfehler,niltext);return(tofather);infeld(suind*felderprozeile +);LEAVE ergverskonfspeichern.schreibtransaktion:setzedaten; +vorhandenensatzaendern.setzedaten:setzeverskz;setzefaecherdaten.setzeverskz: +putwert(fnrhjdversetzung,standardmaskenfeld(satzindex+1)).setzefaecherdaten: +INT VAR fachindanfang:=1,fachindende:=2;INT VAR fachind;TEXT VAR +eingegebenenpfaecher:=standardmaskenfeld(satzindex+2);TEXT VAR einzelfach; +FOR fachindFROM 0UPTO maxfach-1REP einzelfach:=subtext(eingegebenenpfaecher, +fachindanfang,fachindende);IF einzelfach<>laengefach*unterstrichTHEN +changeall(einzelfach,unterstrich,niltext);putwert(fnrhjdnachfach1+fachind, +compress(einzelfach))ELSE putwert(fnrhjdnachfach1+fachind,niltext)FI ; +fachindanfangINCR laengefach;fachindendeINCR laengefach;PER . +vorhandenensatzaendern:IF standardmaskenfeld(satzindex+1)<>versetzungszeichen +THEN restoreupdateposition(dnrhalbjahresdaten);#update(dnrhalbjahresdaten); +dr10.05.88#selupdate(dnrhalbjahresdaten)ELSE replace(dnrhalbjahresdaten, +hjdtid)FI .neuensatzankoppeln:setzedaten;putwert(fnrhjdkennung,compress( +gueltigerzug));insert(dnrhalbjahresdaten);hjdtid:=gettid;.meldevollzug:TEXT +VAR meldungstext;IF dbstatus=0THEN IF NOT hjdgefundenTHEN +neueshjdtidinschuelerdateieintragen(satzindex+1);FI ;#dr04.05.88hjdtid:= +gettid;neueshjdtidinschuelerdateieintragen(satzindex+1);##dr10.05.88 +eventuellinstatwuerfelaendern(satzindex+1);#meldungstext:=compress( +standardmaskenfeld(satzindex))+meldtrenner;standardmeldung(meldspeicherung, +meldungstext)ELSE meldungstext:=text(dbstatus)+meldtrenner;meldungstextCAT +compress(standardmaskenfeld(satzindex));meldungstextCAT meldtrenner; +standardmeldung(meldspeicherfehler,meldungstext);return(tofather);LEAVE +ergverskonfspeichernFI ;infeld(satzindex+1).startkeyssetzen:restoretupel( +dnrschueler,sicherungstupel);#dr02.05.88#changeindex.eingabefehler:IF NOT +richtigesverskzTHEN standardmeldung(meldfalscheeingabe1,standardmaskenfeld( +versfeld)+meldtrenner);infeld(versfeld)ELIF fachfehlerTHEN standardmeldung( +meldungueltigesfach,fach+meldtrenner);infeld(versfeld+1)ELSE standardmeldung( +meldfalscheeingabe2,niltext);infeld(versfeld+1)FI .END PROC +ergverskonfspeichern;PROC neuerblock:blocklesenundausgeben;IF nochwelcheda +THEN return(tofather)ELSE enter(tograndfather)FI .END PROC neuerblock;PROC +blocklesenundausgeben:parsenooffields(fnrhjdnachfach3-dnrhalbjahresdaten); +vorbereiten;initgruppenwechsel;gewuenschteszeigen;nachbereiten;reinitparsing. +vorbereiten:IF NOT nochwelchedaTHEN reinitparsing;LEAVE blocklesenundausgeben +FI ;standardmeldung(meldwarten,niltext);schuelerzahl:=null;aktuellesfeld:= +erstesfeld.gewuenschteszeigen:parsenooffields(12);#dr04.05.88#bildschirmblock +(PROC datenzeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen); +reinitparsing#dr04.05.88#.nachbereiten:nochwelcheda:=(schuelerzahl>null);IF +nochwelchedaTHEN savetupel(dnrschueler,sicherungstupel);#dr02.05.88# +restlichezeilenloeschen;infeld(standardanfang);standardfelderausgebenELSE +LEAVE blocklesenundausgebenFI ;infeld(standardeinstieg). +restlichezeilenloeschen:INT VAR zeilenzaehler;INT VAR zeilenfeld:=( +schuelerzahl*felderprozeile)+1;FOR zeilenzaehlerFROM schuelerzahlUPTO +maxschuelerREP loeschezeilePER .loeschezeile:INT VAR zeilenincr;FOR +zeilenincrFROM 1UPTO felderprozeileREP zeilenfeldINCR 1;standardmaskenfeld( +standardfeldlaenge(zeilenfeld)*blank,zeilenfeld);feldschutz(zeilenfeld)PER . +END PROC blocklesenundausgeben;PROC namezeigen:namenretten;standardmaskenfeld +(text(schuelername+namenstrenner+schuelervorname,laengename),aktuellesfeld); +aktuellesfeldINCR 1.namenretten:TEXT VAR schuelername,schuelervorname; +schuelername:=wert(fnrsufamnames);schuelervorname:=wert(fnrsurufnames); +kenndatum[schuelerzahl][1]:=schuelername;kenndatum[schuelerzahl][2]:= +schuelervorname;kenndatum[schuelerzahl][3]:=datumrekonversion(wert( +fnrsugebdatums));.END PROC namezeigen;PROC datenzeigen:BOOL VAR neuerstellen +:=FALSE ;zeigen;merken.zeigen:vorbereiten;alteklassezeigen;namezeigen; +halbjahresdatensuchen;versetzungsdatenzeigen.vorbereiten:schuelerzahlINCR 1; +TEXT VAR merkdaten:=niltext.alteklassezeigen:TEXT CONST alteklasse:= +jgstaufber(wert(fnrsusgrpjgst))+wert(fnrsusgrpzugtut);gruppenwechsel( +alteklasse,gwklasse,laengeklasse,1,aktuellesfeld).halbjahresdatensuchen: +inittupel(dnrhalbjahresdaten);#schluesselfuerhjdsetzen(dnrhalbjahresdaten, +kenndatum[schuelerzahl],schuljahr,schulhalbjahr,startkey1);search( +dnrhalbjahresdaten,TRUE );neuerstellen:=dbstatus<>ok##dr04.05.88#IF wert( +fnrsutidakthjd)<>niltext#neudr04.05.88#THEN disablestop;readtid( +dnrhalbjahresdaten,wert(fnrsutidakthjd));IF iserrorTHEN clearerror; +neuerstellen:=TRUE ELSE neuerstellen:=FALSE FI ;enablestopELSE neuerstellen:= +TRUE FI .versetzungsdatenzeigen:versetzunginmaske;feldfreigeben; +nachprfaecherinmaske;feldfreigeben.versetzunginmaske:TEXT VAR versetzungskz:= +niltext;IF NOT neuerstellenTHEN versetzungskz:=wert(fnrhjdversetzung);FI ; +merkdatenCAT versetzungskz;standardmaskenfeld(versetzungskz,aktuellesfeld). +nachprfaecherinmaske:TEXT VAR nachprfaecher:=niltext;IF NOT neuerstellenTHEN +nachprfaecher:=nachpruefungsfaecher;FI ;merkdatenCAT nachprfaecher; +standardmaskenfeld(nachprfaecher,aktuellesfeld).feldfreigeben:feldfrei( +aktuellesfeld);aktuellesfeldINCR 1.merken:altedaten(schuelerzahl):=merkdaten. +END PROC datenzeigen;TEXT PROC nachpruefungsfaecher:TEXT VAR nfaecher:= +niltext;INT VAR fachind;FOR fachindFROM 0UPTO maxfach-1REP IF wert( +fnrhjdnachfach1+fachind)=niltextTHEN nfaecherCAT (laengefach*unterstrich) +ELSE nfaecherCAT text(wert(fnrhjdnachfach1+fachind),laengefach);FI PER ; +nfaecherEND PROC nachpruefungsfaecher;PROC feldloeschen(INT CONST laenge): +standardmaskenfeld(laenge*blank,aktuellesfeld)END PROC feldloeschen;BOOL +PROC pruefungspeziell(INT CONST wasistzutun):BOOL VAR b:=FALSE ;SELECT +wasistzutunOF CASE allespruefen:pruefungalleklassen(b)CASE einejgstpruefen: +pruefungeinejgst(b)CASE eineklassepruefen:pruefungeineklasse(b)END SELECT ;b +END PROC pruefungspeziell;PROC pruefungalleklassen(BOOL VAR bool):bool:=(wert +(fnrsustatuss)=laufbestand)END PROC pruefungalleklassen;PROC pruefungeinejgst +(BOOL VAR bool):bool:=(wert(fnrsustatuss)=laufbestandCAND jgstaufber(wert( +fnrsusgrpjgst))=startkey1)END PROC pruefungeinejgst;PROC pruefungeineklasse( +BOOL VAR bool):bool:=(wert(fnrsustatuss)=laufbestandCAND jgstaufber(wert( +fnrsusgrpjgst))=startkey1CAND wert(fnrsusgrpzugtut)=startkey2)END PROC +pruefungeineklasse;PROC neueshjdtidinschuelerdateieintragen(INT CONST nr):IF +standardmaskenfeld(nr)<>versetzungszeichenTHEN inittupel(dnrschueler);putwert +(fnrsufamnames,wert(fnrhjdfamnames));putwert(fnrsurufnames,wert( +fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats));search( +dnrschueler,TRUE );IF dbstatus=okTHEN schuelertid:=gettid;putwert( +fnrsutidakthjd,hjdtid);replace(dnrschueler,schuelertid)FI FI END PROC +neueshjdtidinschuelerdateieintragen;BOOL PROC fachungueltig(TEXT CONST objekt +):pos(fachkatalog,trenner+objekt+trenner)=0END PROC fachungueltig;PROC +fachcat(BOOL VAR b):fachkatalogCAT wert(dnrfaecher+1)+trenner;END PROC +fachcat;PROC holeaktuellenfachkatalog:fachkatalog:=trenner;statleseschleife( +dnrfaecher,"","",dnrfaecher+1,dnrfaecher+1,PROC fachcat);END PROC +holeaktuellenfachkatalog;#dr10.05.88PROC eventuellinstatwuerfelaendern(INT +CONST nummer):IF standardmaskenfeld(nummer)<>versetzungszeichenTHEN +kuerzelsummeeinsrunter(statnrversetzung,jgstaufber(gueltigejgst),compress( +gueltigerzug),compress(laufbestand),compress(versetzungszeichen)); +kuerzelsummeeinsrauf(statnrversetzung,jgstaufber(gueltigejgst),compress( +gueltigerzug),compress(laufbestand),compress(standardmaskenfeld(nummer)));FI +END PROC eventuellinstatwuerfelaendern;#END PACKET listenweiseergverskonf + diff --git a/app/schulis/2.2.1/src/1.listenweise klassenbildung b/app/schulis/2.2.1/src/1.listenweise klassenbildung new file mode 100644 index 0000000..c563019 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listenweise klassenbildung @@ -0,0 +1,270 @@ +PACKET listenweiseklassenbildungDEFINES bearbeitungklassenbildung, +klassenbildungnichtspeichern,klassenbildungspeichern:LET meldbestleer=59, +meldnichtspeichern=63,meldwarten=69,meldspeicherung=132,meldspeicherfehler= +131,meldplausi=57,meldfalscheauswahl=56,meldexistiertnicht=134, +meldzuggewechselt=135,meldfalscheshj=78;LET meldtrenner="#",meldkznorm="+"; +LET fnrneuan5=2,fnrneuan11=3,fnrneuansonst=4,fnrjgst=5,fnrtutor=6, +fnrnurnichtvers=7,fnrgeplhj=8,fnrakthj=9;LET fnrherk=2,fnralteklasse=3, +fnrname=4,fnrneueklasse=5;LET tofather=1,tograndfather=2;LET niltext="",blank +=" ",namenstrenner=", ";LET pruefartalternative=5,pruefartgrenzen=3,jgst5=5, +jgst13=13,null=0,freigabeincr=2;LET schuljahrkey="Schuljahr",schulhalbjahrkey +="Schulhalbjahr",best5="n05",best11="n11",bestsonst="nso",bestlaufsj="ls"; +LET jgst05="05",jgst11="11",maxjgst="13",leerejgst=" ";LET kzwiederholer="w" +;LET standardanfang=1,standardeinstieg=6;LET ersteskommendeshj=1, +geplanteszweiteshj=2,aktuelleshj=3;LET maxschueler=15,erstesfeld=2, +felderprozeile=5,schuelerproseite=16,anzkenndaten=3;LET gwherk=1,gwalteklasse +=2,gwneuejgst=3;LET logtextbeginn="Anw. 1.4.1 Klassenbildung ",logtextneu5= +"Neu 5",logtextneu11="Neu 11",logtextneuso="Neu sonstige",logtextwiederhol= +", Wiederholer",logtextfuer="für ",logtextakthj="aktuelles Halbjahr ";BOOL +VAR nochwelcheda,klassenbehandlung,nurnichtversetzte,logakthalbjahr;LET +allespruefen=1,einejgstpruefen=2,eineklassepruefen=3, +einejgstwiederholerpruefen=4,eineklassewiederholerpruefen=5;INT VAR +waspruefen:=0;INT VAR laengeherk,laengealteklasse,laengename,laengeneueklasse +,bestandindex,halbjahresindex,indexbestand,schuelerzahl,aktuellesfeld, +wiederholerbestand;ROW schuelerproseiteROW anzkenndatenTEXT VAR kenndatum;# +ROW schuelerproseiteTEXT VAR name;ROW schuelerproseiteTEXT VAR rufname;ROW +schuelerproseiteTEXT VAR gebdat;##17.07.87dr#ROW schuelerproseiteTEXT VAR +zugtutor;TEXT VAR altejgst,neuejgst,benoetigtevergljgst,vergleichsjgst, +vergleichszug,sicherungstupel,klassenbildungsbestand,aktschuljahr, +aktschulhalbjahr;PROC bearbeitungklassenbildung:reinitparsing; +eingangsbildschirmpruefen;IF eingangsbildschirmokTHEN +initialisierungenvornehmen;naechsteportionlesen;IF keinemehrdaTHEN +bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE +eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmpruefen: +ankreuzfelderpruefen;IF eingangsbildschirmokTHEN jgstzugpruefen;IF +eingangsbildschirmokTHEN halbjahrmitankreuzungvergleichenFI FI . +ankreuzfelderpruefen:INT VAR pruefstatus;standardpruefe(pruefartalternative, +fnrneuan5,fnrjgst,null,niltext,pruefstatus);.jgstzugpruefen:IF +standardmaskenfeld(fnrjgst)<>niltextTHEN standardpruefe(pruefartgrenzen, +fnrjgst,jgst5,jgst13,niltext,pruefstatus)FI ;IF eingangsbildschirmokTHEN +nurnichtversetzte:=standardmaskenfeld(fnrnurnichtvers)<>niltext; +bestimmebestandindex;IF nurnichtversetzteCAND (bestandindexniltextTHEN LEAVE bestimmebestandindexFI +PER .halbjahrmitankreuzungvergleichen:aktschulhalbjahr:=schulkenndatum( +schulhalbjahrkey);aktschuljahr:=schulkenndatum(schuljahrkey);IF +aktschulhalbjahr="2"THEN IF standardmaskenfeld(fnrgeplhj)<>""THEN +standardmeldung(meldfalscheshj,aktschulhalbjahr+meldkznorm);pruefstatus:= +fnrgeplhjFI ELIF aktschulhalbjahr="1"THEN IF standardmaskenfeld(fnrgeplhj)="" +CAND standardmaskenfeld(fnrakthj)=""THEN standardmeldung(meldfalscheshj, +aktschulhalbjahr+meldkznorm);pruefstatus:=fnrgeplhjFI FI . +eingangsbildschirmok:pruefstatus=0.initialisierungenvornehmen: +bestandunddbmaskesetzen;halbjahrsetzen;nichtverspruefen; +plausipruefungvorbereiten;standardstartproc(maske(vergleichsknoten)); +laengenfestlegen;IF nurnichtversetzteTHEN startebildschirmblock( +wiederholerbestand,maxschueler)ELSE startebildschirmblock(indexbestand, +maxschueler)FI .bestandunddbmaskesetzen:standardmeldung(meldwarten,niltext); +klassenbehandlung:=FALSE ;SELECT bestandindexOF CASE fnrneuan5:neuan5setzen +CASE fnrneuan11:neuan11setzenCASE fnrneuansonst:neuansonstsetzenOTHERWISE +jgstoderzugsetzenEND SELECT ;pruefebestand.neuan5setzen:vergleichsjgst:= +jgst05;benoetigtevergljgst:=vergleichsjgst;klassenbildungsbestand:=best5; +indexbestand:=ixsustatschulkenn;waspruefen:=allespruefen;infeld(fnrneuan5). +neuan11setzen:vergleichsjgst:=jgst11;benoetigtevergljgst:=vergleichsjgst; +klassenbildungsbestand:=best11;indexbestand:=ixsustatschulkenn;waspruefen:= +allespruefen;infeld(fnrneuan11).neuansonstsetzen:vergleichsjgst:=niltext; +benoetigtevergljgst:=vergleichsjgst;klassenbildungsbestand:=bestsonst; +indexbestand:=ixsustatschulkenn;waspruefen:=allespruefen;infeld(fnrneuansonst +).jgstoderzugsetzen:TEXT CONST jgst:=jgstaufber(standardmaskenfeld(fnrjgst)); +vergleichsjgst:=jgst;klassenbildungsbestand:=bestlaufsj;IF eineklasseTHEN +setzeklasseELSE setzejgstFI ;IF NOT ((akthalbjahrCOR geplhalbjahr)COR +nurnichtversetzte)THEN neuejgst:=jgstaufber(text(int(altejgst)+1)); +benoetigtevergljgst:=neuejgstELSE neuejgst:=altejgst;benoetigtevergljgst:= +altejgstFI .eineklasse:TEXT CONST zug:=standardmaskenfeld(fnrtutor); +vergleichszug:=zug;klassenbehandlung:=zug<>niltext;klassenbehandlung. +setzeklasse:IF nurnichtversetzteTHEN wiederholerbestand:=ixhjdsjhjverjgstkenn +;waspruefen:=eineklassewiederholerpruefenELSE indexbestand:=ixsustatjgstzug; +waspruefen:=eineklassepruefen;FI ;altejgst:=jgst;infeld(fnrtutor).setzejgst: +IF nurnichtversetzteTHEN IF NOT klassenbehandlungTHEN #???index# +wiederholerbestand:=ixhjdsjhjverjgst;#wiederholer#ELSE wiederholerbestand:= +ixhjdsjhjverjgstkenn;FI ;waspruefen:=einejgstwiederholerpruefenELSE IF NOT +klassenbehandlungTHEN indexbestand:=ixsustatjgst;ELSE indexbestand:= +ixsustatjgstzug;FI ;waspruefen:=einejgstpruefen;FI ;altejgst:=jgst;infeld( +fnrjgst).pruefebestand:reinitparsing;IF nurnichtversetzteTHEN inittupel( +dnrhalbjahresdaten);schluesselfelderinhalbjahresdatenbelegen;search( +wiederholerbestand,FALSE );ELSE inittupel(dnrschueler); +schluesselfelderinschuelerbelegen;search(indexbestand,FALSE );FI ;IF +bestandnichtvorhandenTHEN bestandleermelden;return(tofather);LEAVE +bearbeitungklassenbildungELSE nochwelcheda:=TRUE FI . +schluesselfelderinhalbjahresdatenbelegen:putwert(fnrhjdversetzung, +kzwiederholer);putwert(fnrhjdsj,aktschuljahr);putwert(fnrhjdhj, +aktschulhalbjahr);putwert(fnrhjdjgst,vergleichsjgst);putwert(fnrhjdkennung, +vergleichszug);.schluesselfelderinschuelerbelegen:putwert(fnrsustatuss, +klassenbildungsbestand);IF indexbestand=ixsustatjgstzugOR indexbestand= +ixsustatjgstTHEN putwert(fnrsusgrpjgst,vergleichsjgst);putwert( +fnrsusgrpzugtut,vergleichszug)FI .bestandnichtvorhanden:dbstatus<>okOR (NOT +nurnichtversetzteCAND NOT pruefungspeziell(waspruefen))OR (nurnichtversetzte +CAND NOT pruefungspeziell(waspruefen)).halbjahrsetzen:logakthalbjahr:=FALSE ; +IF geplhalbjahrTHEN geplhalbjahrsetzenELIF akthalbjahrTHEN logakthalbjahr:= +TRUE ;akthalbjahrsetzenELSE ersteshalbjahrsetzenFI .geplhalbjahr:INT VAR +angekreuztesfeld;standardmaskenfeld(fnrgeplhj)<>niltext.geplhalbjahrsetzen: +IF akthalbjahrCOR neuanmeldungTHEN angekreuztesfeld:=fnrgeplhj;falscheauswahl +ELSE halbjahresindex:=geplanteszweiteshjFI .akthalbjahr:standardmaskenfeld( +fnrakthj)<>niltext.akthalbjahrsetzen:IF neuanmeldungTHEN angekreuztesfeld:= +fnrakthj;falscheauswahlELSE halbjahresindex:=aktuelleshjFI . +ersteshalbjahrsetzen:halbjahresindex:=ersteskommendeshj.neuanmeldung: +bestandindex<=fnrneuansonst.falscheauswahl:standardmeldung(meldfalscheauswahl +,niltext);infeld(angekreuztesfeld);return(tofather);LEAVE +bearbeitungklassenbildung.nichtverspruefen:IF (nurnichtversetzteCAND ( +halbjahresindex<>ersteskommendeshj))COR (((NOT nurnichtversetzte)CAND (jgst= +maxjgst))CAND (halbjahresindex=ersteskommendeshj))THEN angekreuztesfeld:= +fnrnurnichtvers;falscheauswahlELIF nurnichtversetzteTHEN halbjahresindex:= +ersteskommendeshjFI .plausipruefungvorbereiten:#holevergleichssg( +benoetigtevergljgst,(halbjahresindex=aktuelleshj)COR nurnichtversetzte)dr13. +11.87#holevergleichssg(benoetigtevergljgst,halbjahresindex=aktuelleshj). +laengenfestlegen:laengeherk:=standardfeldlaenge(fnrherk);laengealteklasse:= +standardfeldlaenge(fnralteklasse);laengename:=standardfeldlaenge(fnrname); +laengeneueklasse:=standardfeldlaenge(fnrneueklasse).naechsteportionlesen: +blocklesenundausgeben.keinemehrda:NOT nochwelcheda.bestandleermelden: +standardmeldung(meldbestleer,niltext).eingangsmaskenfehler:infeld(pruefstatus +).END PROC bearbeitungklassenbildung;PROC klassenbildungnichtspeichern: +nichtspeichernmelden;startkeyssetzen;neuerblock.nichtspeichernmelden: +standardmeldung(meldnichtspeichern,niltext);pause(10).startkeyssetzen: +restoretupel(dnrschueler,sicherungstupel);changeindex.END PROC +klassenbildungnichtspeichern;PROC klassenbildungspeichern: +bestimmeaenderungsart;pruefeplausibilitaet;IF dateninordnungTHEN +speicherungdurchfuehren;startkeyssetzen;neuerblockELSE eingabefehler;return( +tofather)FI .bestimmeaenderungsart:BOOL VAR normalfall:=NOT ((bestandindex> +fnrneuansonst)CAND (halbjahresindex=aktuelleshj));.pruefeplausibilitaet:BOOL +VAR dateninordnung:=TRUE ;INT VAR aktfeld:=1;TEXT VAR bezugsjgst:="", +gelesenejgst;standardmeldung(meldplausi,niltext);FOR suindFROM 1UPTO +schuelerzahlREP pruefezeile;IF NOT dateninordnungTHEN LEAVE +pruefeplausibilitaetFI ;PER .pruefezeile:TEXT VAR aktuellerzug;TEXT VAR +aktuelleschuelergruppe;aktfeldINCR felderprozeile;aktuellerzug:= +standardmaskenfeld(aktfeld);gelesenejgst:=standardmaskenfeld(aktfeld-1);IF +gelesenejgst<>leerejgstTHEN bezugsjgst:=gelesenejgst;FI ; +aktuelleschuelergruppe:=bezugsjgst+aktuellerzug;IF normalfallTHEN +dateninordnung:=(aktuellerzug=niltext)COR istzulaessigesg( +aktuelleschuelergruppe)ELSE dateninordnung:=istzulaessigesg( +aktuelleschuelergruppe)CAND (aktuellerzug<>niltext)FI . +speicherungdurchfuehren:vorbereiten;logeintragvornehmen;aendernschleife; +kurzwarten.logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;IF +klassenbildungsbestand=best5THEN eintragCAT logtextfuer;eintragCAT +logtextneu5ELIF klassenbildungsbestand=best11THEN eintragCAT logtextfuer; +eintragCAT logtextneu11ELIF klassenbildungsbestand=bestsonstTHEN eintragCAT +logtextfuer;eintragCAT logtextneusoELIF klassenbildungsbestand=bestlaufsj +THEN IF logakthalbjahrTHEN eintragCAT logtextakthjFI ;eintragCAT logtextfuer; +eintragCAT vergleichsjgst;eintragCAT vergleichszug;IF nurnichtversetzteTHEN +eintragCAT logtextwiederholFI ;FI ;logeintrag(eintrag).kurzwarten:pause(10). +vorbereiten:INT VAR aufsatzpunkt:=null;.aendernschleife:INT VAR suind;INT +VAR zahlderaenderungen:=null;FOR suindFROM 1UPTO schuelerzahlREP +behandleschuelersatzPER .behandleschuelersatz:IF datenveraendertTHEN +fuehreaenderungaus;meldevollzugELSE merkenalsaufsatzpunktFI .datenveraendert: +zugtutor(suind)<>standardmaskenfeld((suind*felderprozeile)+1). +merkenalsaufsatzpunkt:aufsatzpunkt:=suind.fuehreaenderungaus:lesenvorbereiten +;lesen;IF normalfallTHEN zurueckschreibenELSE aenderneinheitFI . +lesenvorbereiten:putwert(fnrsufamnames,kenndatum[suind][1]);putwert( +fnrsurufnames,kenndatum[suind][2]);putwert(fnrsugebdatums,datumskonversion( +kenndatum[suind][3]));zahlderaenderungenINCR 1;.lesen:search(dnrschueler, +TRUE ).zurueckschreiben:IF dbstatus=0THEN putwert(fnrsuneuerzugtut, +standardmaskenfeld((suind*felderprozeile)+1));replace(dnrschueler,gettid)FI . +aenderneinheit:TEXT VAR alterzug:=zugtutor(suind);TEXT VAR neuerzug:= +standardmaskenfeld((suind*felderprozeile)+1);TEXT VAR geliefertejgst:= +jgstaufber(wert(fnrsusgrpjgst));TEXT VAR gelieferterzug:=wert(fnrsusgrpzugtut +);IF dbstatus=0CAND geliefertejgst=altejgstCAND gelieferterzug=alterzugTHEN +TEXT VAR schuelertid:=gettid;aenderntransaktion;ELSE transaktionsfehlerFI . +aenderntransaktion:removeoutofindex(ixsustatjgstzug);# +aenderunginstatraumvorbereiten(FALSE );dr10.05.88 +einenschuelerausstatraumentfernen;#IF wert(fnrsutidakthjd)<>niltextTHEN +readtid(dnrhalbjahresdaten,wert(fnrsutidakthjd));putwert(fnrhjdkennung, +neuerzug);#update(dnrhalbjahresdaten);dr10.05.88#selupdate(dnrhalbjahresdaten +);putwert(fnrsutidakthjd,gettid)ELSE FI ;putwert(fnrsusgrpzugtut,neuerzug); +replace(dnrschueler,schuelertid);insertinindex(ixsustatjgstzug);#IF dbstatus +<>okTHEN putwert(fnrsusgrpzugtut,zugtutor[suind]);FI ; +einenschuelerinstatraumeinfuegen;dr10.05.88#.transaktionsfehler: +standardmeldung(meldzuggewechselt,niltext);return(tofather);infeld((suind* +felderprozeile)+1);LEAVE klassenbildungspeichern.meldevollzug:TEXT VAR +meldungstext;INT VAR satzindex:=(suind*felderprozeile)-1;IF dbstatus=0THEN +meldungstext:=compress(standardmaskenfeld(satzindex))+meldtrenner; +standardmeldung(meldspeicherung,meldungstext)ELSE meldungstext:=text(dbstatus +)+meldtrenner;meldungstextCAT compress(standardmaskenfeld(satzindex)); +meldungstextCAT meldtrenner;standardmeldung(meldspeicherfehler,meldungstext); +return(tofather);LEAVE klassenbildungspeichernFI ;infeld(satzindex+2). +startkeyssetzen:IF (NOT klassenbehandlung)OR normalfallTHEN aufsatzpunkt:= +schuelerzahlFI ;IF aufsatzpunkt>nullTHEN restoretupel(dnrschueler, +sicherungstupel);changeindexFI .eingabefehler:standardmeldung( +meldexistiertnicht,standardmaskenfeld(aktfeld)+meldtrenner);infeld(aktfeld). +END PROC klassenbildungspeichern;PROC neuerblock:blocklesenundausgeben;IF +nochwelchedaTHEN return(tofather)ELSE enter(tograndfather)FI .END PROC +neuerblock;PROC blocklesenundausgeben:vorbereiten;initgruppenwechsel;SELECT +bestandindexOF CASE fnrneuan5:neuan5lesenCASE fnrneuan11:neuan11lesenCASE +fnrneuansonst:neuansonstlesenOTHERWISE jgstoderzuglesenEND SELECT ; +nachbereiten.vorbereiten:IF NOT nochwelchedaTHEN LEAVE blocklesenundausgeben +FI ;standardmeldung(meldwarten,niltext);schuelerzahl:=null;aktuellesfeld:= +erstesfeld.neuan5lesen:bildschirmblock(PROC neuan5zeigen,BOOL PROC (INT +CONST )pruefungspeziell,waspruefen).neuan11lesen:bildschirmblock(PROC +neuan11zeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen). +neuansonstlesen:bildschirmblock(PROC neuansonstzeigen,BOOL PROC (INT CONST ) +pruefungspeziell,waspruefen).jgstoderzuglesen:bildschirmblock(PROC +jgstoderzugzeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen). +nachbereiten:nochwelcheda:=(schuelerzahl>null);IF nochwelchedaTHEN savetupel( +dnrschueler,sicherungstupel);restlichezeilenloeschen;infeld(standardanfang); +standardfelderausgebenFI ;infeld(standardeinstieg).restlichezeilenloeschen: +INT VAR zeilenzaehler;INT VAR zeilenfeld:=(schuelerzahl*felderprozeile)+1; +FOR zeilenzaehlerFROM schuelerzahlUPTO maxschuelerREP loeschezeilePER . +loeschezeile:INT VAR zeilenincr;FOR zeilenincrFROM 1UPTO felderprozeileREP +zeilenfeldINCR 1;standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank, +zeilenfeld)PER ;feldschutz(zeilenfeld).END PROC blocklesenundausgeben;PROC +neuanzeigen(TEXT CONST jgst):schuelerzahlINCR 1;herkunftsschulezeigen; +alteklassezeigen;namezeigen;neueklassezeigen;neuerzugtutorzeigen. +neueklassezeigen:gruppenwechsel(jgst,gwneuejgst,laengeneueklasse,1, +aktuellesfeld).END PROC neuanzeigen;PROC namezeigen:namenretten; +standardmaskenfeld(text(schuelername+namenstrenner+schuelervorname,laengename +),aktuellesfeld);INT VAR eingabefeld:=aktuellesfeld+freigabeincr; +standardmaskenfeld(niltext,eingabefeld);feldfrei(eingabefeld);aktuellesfeld +INCR 1.namenretten:TEXT VAR schuelername,schuelervorname;schuelername:=wert( +fnrsufamnames);schuelervorname:=wert(fnrsurufnames);kenndatum[schuelerzahl][1 +]:=schuelername;kenndatum[schuelerzahl][2]:=schuelervorname;kenndatum[ +schuelerzahl][3]:=datumrekonversion(wert(fnrsugebdatums));.END PROC +namezeigen;PROC herkunftsschulezeigen:gruppenwechsel(wert(fnrsuskennlschule), +gwherk,laengeherk,1,aktuellesfeld)END PROC herkunftsschulezeigen;PROC +alteklassezeigen:gruppenwechsel(wert(fnrsuklasselschule),gwalteklasse, +laengealteklasse,1,aktuellesfeld)END PROC alteklassezeigen;PROC neuan5zeigen: +neuanzeigen(jgst05)END PROC neuan5zeigen;PROC neuan11zeigen:neuanzeigen( +jgst11)END PROC neuan11zeigen;PROC neuansonstzeigen:schuelerzahlINCR 1; +herkunftsschulezeigen;alteklassezeigen;namezeigen;neueklassezeigen; +neuerzugtutorzeigen.neueklassezeigen:gruppenwechsel(jgstaufber(wert( +fnrsujgsteintr)),gwneuejgst,2,1,aktuellesfeld).END PROC neuansonstzeigen; +PROC neuerzugtutorzeigen:TEXT CONST neuerzugtutor:=wert(fnrsuneuerzugtut); +standardmaskenfeld(neuerzugtutor,aktuellesfeld);zugtutor(schuelerzahl):= +neuerzugtutor;aktuellesfeldINCR 1END PROC neuerzugtutorzeigen;PROC +jgstoderzugzeigen:schuelerzahlINCR 1;herkunftsschuleloeschen; +aktuelleklassezeigen;namezeigen;neueklassezeigen;zugtutorbehandeln. +herkunftsschuleloeschen:feldloeschen(laengeherk);aktuellesfeldINCR 1. +aktuelleklassezeigen:TEXT VAR aktjgst:=jgstaufber(wert(fnrsusgrpjgst));IF +halbjahresindex=aktuelleshjTHEN feldloeschen(laengealteklasse);aktuellesfeld +INCR 1ELSE gruppenwechsel(aktjgst+wert(fnrsusgrpzugtut),gwalteklasse, +laengealteklasse,1,aktuellesfeld)FI .neueklassezeigen:IF halbjahresindex= +ersteskommendeshjTHEN gruppenwechsel(neuejgst,gwneuejgst,2,1,aktuellesfeld) +ELSE gruppenwechsel(aktjgst,gwneuejgst,2,1,aktuellesfeld)FI . +zugtutorbehandeln:IF halbjahresindex<>aktuelleshjTHEN neuerzugtutorzeigen +ELSE TEXT CONST zugtutordesschuelers:=wert(fnrsusgrpzugtut);zugtutor( +schuelerzahl):=zugtutordesschuelers;standardmaskenfeld(zugtutordesschuelers, +aktuellesfeld);aktuellesfeldINCR 1FI .END PROC jgstoderzugzeigen;PROC +feldloeschen(INT CONST laenge):standardmaskenfeld(laenge*blank,aktuellesfeld) +END PROC feldloeschen;BOOL PROC pruefungspeziell(INT CONST wasistzutun):BOOL +VAR b:=FALSE ;SELECT wasistzutunOF CASE allespruefen:pruefungalleklassen(b) +CASE einejgstpruefen:pruefungeinejgst(b)CASE eineklassepruefen: +pruefungeineklasse(b)CASE einejgstwiederholerpruefen: +pruefungeinejgstwiederholer(b)CASE eineklassewiederholerpruefen: +pruefungeineklassewiederholer(b)END SELECT ;bEND PROC pruefungspeziell;PROC +pruefungalleklassen(BOOL VAR bool):bool:=(wert(fnrsustatuss)= +klassenbildungsbestand)END PROC pruefungalleklassen;PROC pruefungeinejgst( +BOOL VAR bool):bool:=(wert(fnrsustatuss)=bestlaufsjCAND jgstaufber(wert( +fnrsusgrpjgst))=vergleichsjgst)END PROC pruefungeinejgst;PROC +pruefungeineklasse(BOOL VAR bool):bool:=(wert(fnrsustatuss)=bestlaufsjCAND +jgstaufber(wert(fnrsusgrpjgst))=vergleichsjgstCAND wert(fnrsusgrpzugtut)= +vergleichszug)END PROC pruefungeineklasse;PROC pruefungeinejgstwiederholer( +BOOL VAR bool):inschuelerdateisuchen;bool:=(wert(fnrhjdversetzung)= +kzwiederholerCAND wert(fnrhjdsj)=aktschuljahrCAND wert(fnrhjdhj)= +aktschulhalbjahrCAND jgstaufber(wert(fnrhjdjgst))=vergleichsjgst)END PROC +pruefungeinejgstwiederholer;PROC pruefungeineklassewiederholer(BOOL VAR bool) +:inschuelerdateisuchen;bool:=(wert(fnrhjdversetzung)=kzwiederholerCAND wert( +fnrhjdsj)=aktschuljahrCAND wert(fnrhjdhj)=aktschulhalbjahrCAND jgstaufber( +wert(fnrhjdjgst))=vergleichsjgstCAND wert(fnrhjdkennung)=vergleichszug)END +PROC pruefungeineklassewiederholer;PROC inschuelerdateisuchen:inittupel( +dnrschueler);putwert(fnrsufamnames,wert(fnrhjdfamnames));putwert( +fnrsurufnames,wert(fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats +));putwert(fnrsustatuss,bestlaufsj);search(ixsustatfamrufgeb,TRUE );END PROC +inschuelerdateisuchen;END PACKET listenweiseklassenbildung + diff --git a/app/schulis/2.2.1/src/1.schuelerjgst aendern b/app/schulis/2.2.1/src/1.schuelerjgst aendern new file mode 100644 index 0000000..1a80c4f --- /dev/null +++ b/app/schulis/2.2.1/src/1.schuelerjgst aendern @@ -0,0 +1,161 @@ +PACKET schuelerjgstaendernDEFINES schuelerjgstbearbeiten, +schuelerjgstaenderungschuelerzeigen, +schuelerjgstaenderungfuerausgesuchteschuelerbearbeiten, +schuelerjgstaenderungspeichern,pruefungschuelerjgst:LET maskenname= +"ms schuelerjgst aendern",maskennameeingang="ms schuelerjgst aendern eingang" +,fnrname=2,fnrrufname=3,fnrgebdatum=4,fnrjgst=5,fnrhalbjahr=6,fnrzug=7, +fnrzugang=8,fnraktuellehjd=9,fnrneueshj1=10,fnrneuehjd1=11,fnrneueshj2=12, +fnrneuehjd2=13;LET schulhalbjahr="Schulhalbjahr";LET aktbestand="ls", +aktschuljahr="Schuljahr";LET meldunggibtsnicht=71,meldunglistenerstellung=7, +meldungkeineliste=68,meldungletzter=67,meldungspeicherung=50, +meldungkeinespeicherung=63,pruefemeldung=57;LET dateiname="Schülerliste"; +FILE VAR f;TEXT VAR schuelertupel:="",zugangsicherung:="",schuelertid:="", +hjdtid:="";TEXT VAR akthalbjahr,jgstalt,zugalt,jgst,zug,jgsttext;LET +gesamtanzahlhalbjahre=12,laengehalbjahreseintrag=4;LET jgst05="05",jgst13= +"13";LET jgstufe10=10;LET oblitrenner="$",leer="",punkt=".";LET +anzschlfeldersu=3;BOOL VAR falschesdatum:=FALSE ;INT CONST gesamtzeilenlaenge +:=gesamtanzahlhalbjahre*laengehalbjahreseintrag;ROW anzschlfeldersuTEXT VAR +schluessel;TAG VAR maske;TEXT VAR ausgabezeile:="",halbjahrkuerzel:="";LET +logtextbeginn="Anw. 1.2.4 Änderung";PROC schuelerjgstbearbeiten:BOOL VAR +suexistiert:=FALSE ;falschesdatum:=FALSE ;systemdboff;reinitparsing; +schluesselbereitstellen;pruefeobnameexistiert(suexistiert);IF NOT +falschesdatumTHEN IF suexistiertTHEN schluessel(1):=wert(fnrsufamnames); +schluessel(2):=wert(fnrsurufnames);schluessel(3):=datumrekonversion(wert( +fnrsugebdatums));loeschedieerstellteobjektliste;standardstartproc(maskenname) +;bereiteaenderungvor;infeld(fnrjgst);standardnprocELSE standardmeldung( +meldunggibtsnicht,"");return(1)FI ELSE return(1)FI .END PROC +schuelerjgstbearbeiten;PROC schluesselbereitstellen:schluessel(1):= +standardmaskenfeld(fnrname);schluessel(2):=standardmaskenfeld(fnrrufname); +schluessel(3):=datumrekonversion(standardmaskenfeld(fnrgebdatum));END PROC +schluesselbereitstellen;PROC pruefeobnameexistiert(BOOL VAR suexist):TEXT +VAR datenbankwerte,schluesselwerte;inittupel(dnrschueler); +maskenwerteindatenbank;IF NOT falschesdatumTHEN search(ixsustatfamrufgeb, +FALSE );IF dbstatus=okTHEN saveupdateposition(dnrschueler);datenbankwerte:= +wert(fnrsurufnames)+datumrekonversion(wert(fnrsugebdatums));schluesselwerte:= +schluessel(2)+schluessel(3);suexist:=(wert(fnrsufamnames)=schluessel(1)CAND ( +(schluessel(2)=leerAND schluessel(3)=leer)OR (pos(datenbankwerte, +schluesselwerte)=1)))ELSE suexist:=FALSE FI FI .END PROC +pruefeobnameexistiert;PROC bereiteaenderungvor:saveupdateposition(dnrschueler +);savetupel(dnrschueler,schuelertupel);schuelertid:=gettid;hjdtid:=wert( +fnrsutidakthjd);zugangsicherung:=wert(fnrsuartzugang);wertelesen; +fuelledbdateninfelder;fuellehjddateninfelder;infeld(1);standardfelderausgeben +;infeld(fnrjgst).wertelesen:akthalbjahr:=schulkenndatum(schulhalbjahr);. +fuelledbdateninfelder:jgstalt:=jgstaufber(wert(fnrsusgrpjgst));zugalt:= +compress(wert(fnrsusgrpzugtut));standardmaskenfeld(schluessel(1),fnrname); +standardmaskenfeld(schluessel(2),fnrrufname);standardmaskenfeld(schluessel(3) +,fnrgebdatum);standardmaskenfeld(akthalbjahr,fnrhalbjahr);standardmaskenfeld( +jgstalt,fnrjgst);standardmaskenfeld(zugalt,fnrzug);standardmaskenfeld(wert( +fnrsuartzugang),fnrzugang);.fuellehjddateninfelder:jgsttext:=jgstalt; +halbjahrkuerzel:=jgsttext+punkt+akthalbjahr;lieferehalbjahreszeile( +ausgabezeile,halbjahrkuerzel);standardmaskenfeld(ausgabezeile,fnraktuellehjd) +;IF jgstalt=jgst05THEN erhoehejgsttext(TRUE );halbjahrkuerzel:=jgsttext+punkt ++akthalbjahr;standardmaskenfeld(halbjahrkuerzel,fnrneueshj1); +lieferehalbjahreszeile(ausgabezeile,halbjahrkuerzel);standardmaskenfeld( +ausgabezeile,fnrneuehjd1);liefereleerzeileELIF jgstalt=jgst13THEN +erhoehejgsttext(FALSE );halbjahrkuerzel:=jgsttext+punkt+akthalbjahr; +standardmaskenfeld(halbjahrkuerzel,fnrneueshj1);lieferehalbjahreszeile( +ausgabezeile,halbjahrkuerzel);standardmaskenfeld(ausgabezeile,fnrneuehjd1); +liefereleerzeileELSE erhoehejgsttext(FALSE );halbjahrkuerzel:=jgsttext+punkt+ +akthalbjahr;standardmaskenfeld(halbjahrkuerzel,fnrneueshj1); +lieferehalbjahreszeile(ausgabezeile,halbjahrkuerzel);standardmaskenfeld( +ausgabezeile,fnrneuehjd1);jgsttext:=jgstalt;erhoehejgsttext(TRUE ); +halbjahrkuerzel:=jgsttext+punkt+akthalbjahr;standardmaskenfeld( +halbjahrkuerzel,fnrneueshj2);lieferehalbjahreszeile(ausgabezeile, +halbjahrkuerzel);standardmaskenfeld(ausgabezeile,fnrneuehjd2)FI . +liefereleerzeile:standardmaskenfeld(leereshj,fnrneueshj2);standardmaskenfeld( +leerezeile,fnrneuehjd2).leereshj:text(" ",laengehalbjahreseintrag).leerezeile +:text(" ",gesamtzeilenlaenge).END PROC bereiteaenderungvor;PROC +erhoehejgsttext(BOOL CONST erhoehen):INT VAR jgstint:=int(jgsttext);IF +erhoehenTHEN jgstintINCR 1ELSE jgstintDECR 1FI ;jgsttext:=jgstaufber(text( +jgstint))END PROC erhoehejgsttext;PROC loeschedieerstellteobjektliste:forget( +dateiname,quiet);END PROC loeschedieerstellteobjektliste;PROC +schuelerjgstaenderungschuelerzeigen:BOOL VAR listeexistiertnicht; +falschesdatum:=FALSE ;systemdboff;schluesselbereitstellen; +maskenwerteindatenbank;IF NOT falschesdatumTHEN standardmeldung( +meldunglistenerstellung,"");parsenooffields(5);objektlistestarten( +ixsustatfamrufgeb,schluessel(1),fnrsufamnames,TRUE ,listeexistiertnicht);IF +listeexistiertnichtTHEN reinitparsing;standardmeldung(meldungkeineliste,""); +return(1)ELSE datensatzlistenausgabe(PROC (INT CONST )suerfassungschueler, +TRUE ,BOOL PROC pruefungschuelerjgst)FI ELSE return(1)FI .END PROC +schuelerjgstaenderungschuelerzeigen;PROC maskenwerteindatenbank:putwert( +fnrsufamnames,schluessel(1));putwert(fnrsurufnames,schluessel(2));disablestop +;initmaske(maske,maskennameeingang);putwert(fnrsugebdatums,datumskonversion( +schluessel(3)));IF iserrorTHEN clearerror;meldeauffaellig(maske,157);infeld( +fnrgebdatum);falschesdatum:=TRUE ;enablestopELSE enablestop;putwert( +fnrsustatuss,aktbestand);FI END PROC maskenwerteindatenbank;BOOL PROC +pruefungschuelerjgst:wert(fnrsustatuss)=aktbestandEND PROC +pruefungschuelerjgst;PROC +schuelerjgstaenderungfuerausgesuchteschuelerbearbeiten:BOOL VAR ok, +kannbearbeitetwerden:=FALSE ;loeschedieerstellteobjektliste; +objektlistebeenden(dateiname,TRUE );reinitparsing; +holeerstenschluesselausdatei(ok);WHILE okREP pruefeobnameexistiert(ok);IF ok +THEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE +holenaechstenschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerdenTHEN +standardstartproc(maskenname);bereiteaenderungvor;infeld(fnrjgst); +standardnprocELSE enter(2)FI .END PROC +schuelerjgstaenderungfuerausgesuchteschuelerbearbeiten;PROC +holeerstenschluesselausdatei(BOOL VAR ok):IF NOT exists(dateiname)THEN ok:= +FALSE ;LEAVE holeerstenschluesselausdateiFI ;f:=sequentialfile(input, +dateiname);holenaechstenschluesselausdatei(ok);END PROC +holeerstenschluesselausdatei;PROC holenaechstenschluesselausdatei(BOOL VAR ok +):TEXT VAR thesaurustext:="";INT VAR schluesselbeginn,schluesseltrennung,i; +IF eof(f)THEN ok:=FALSE ;loeschedieerstellteobjektlisteELSE getline(f, +thesaurustext);bestimmeschluesselausthesaurustext;ok:=TRUE FI . +bestimmeschluesselausthesaurustext:schluesselbeginn:=pos(thesaurustext, +oblitrenner);schluesseltrennung:=pos(thesaurustext,oblitrenner, +schluesselbeginn+1);FOR iFROM 1UPTO anzschlfeldersuREP IF schluesseltrennung> +0THEN schluessel(i):=subtext(thesaurustext,schluesselbeginn+1, +schluesseltrennung-1);schluesselbeginn:=schluesseltrennung;schluesseltrennung +:=pos(thesaurustext,oblitrenner,schluesselbeginn+1);ELSE schluessel(i):= +subtext(thesaurustext,schluesselbeginn+1);FI ;schluessel(3):= +datumrekonversion(schluessel(3));PER ;.END PROC +holenaechstenschluesselausdatei;PROC schuelerjgstaenderungspeichern(BOOL +CONST speichern):IF speichernTHEN INT VAR fehlerstatus:=0; +pruefeplausibilitaet(fehlerstatus);IF datenfehlerfreiTHEN standardmeldung( +meldungspeicherung,"");datenspeichern; +vorbereitendernaechstenschluesselbehandlungELSE fehlerbehandeln;return(1)FI +ELSE standardmeldung(meldungkeinespeicherung,""); +vorbereitendernaechstenschluesselbehandlungFI .datenfehlerfrei:fehlerstatus=0 +.fehlerbehandeln:infeld(fehlerstatus).datenspeichern:logeintragvornehmen; +aenderungschreiben;halbjahresdatenloeschen(schluessel,jgstalt,jgst, +akthalbjahr).logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;eintragCAT +" """;eintragCAT schluessel(1);eintragCAT ", ";eintragCAT schluessel(2); +eintragCAT ", ";eintragCAT datumskonversion(schluessel(3));eintragCAT """"; +logeintrag(eintrag).aenderungschreiben:IF jgstoderzuggeaendertTHEN +dbfelderfuellen;aenderunginhjdeintragen;restoreupdateposition(dnrschueler); +selupdate(dnrschueler);IF dbstatus<>0THEN restoretupel(dnrschueler, +schuelertupel)ELSE IF jgst<>jgstaltTHEN IF int(jgst)>=jgstufe10THEN +kurswahlserveraktualisieren(jgst,"","")FI ;IF int(jgstalt)>=jgstufe10THEN +kurswahlserveraktualisieren(jgstalt,"","")FI ;FI ;FI ;ELSE dbfelderfuellen; +replace(dnrschueler,schuelertid);FI .dbfelderfuellen:putwert(fnrsusgrpjgst, +jgst);putwert(fnrsusgrpzugtut,zug);putwert(fnrsuartzugang,standardmaskenfeld( +fnrzugang));.jgstoderzuggeaendert:jgst<>jgstaltCOR zug<>zugalt. +aenderunginhjdeintragen:IF hjdtid<>leerTHEN putwert(fnrhjdjgst,jgst);putwert( +fnrhjdkennung,zug);selupdate(dnrhalbjahresdaten);IF dbstatus=okTHEN putwert( +fnrsutidakthjd,gettid)FI FI .END PROC schuelerjgstaenderungspeichern;PROC +vorbereitendernaechstenschluesselbehandlung:IF exists(dateiname)THEN +holenaechstenschluesselauslisteELSE enter(2)FI . +holenaechstenschluesselausliste:BOOL VAR ok,kannbearbeitetwerden:=FALSE ; +holenaechstenschluesselausdatei(ok);WHILE okREP pruefeobnameexistiert(ok);IF +okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE +holenaechstenschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerdenTHEN +bereiteaenderungvor;return(1)ELSE behandleendederlistenabarbeitungFI . +behandleendederlistenabarbeitung:standardmeldung(meldungletzter,"");enter(3). +END PROC vorbereitendernaechstenschluesselbehandlung;PROC +pruefeplausibilitaet(INT VAR fstatus):INT VAR fmeld;LET fmeldbittefuellen=52, +fmeldnichtimbestand=55,bestandzugang="c02 zugang";fstatus:=0;standardmeldung( +pruefemeldung,"");IF NOT imschlbestand(standardmaskenfeld(fnrzugang), +bestandzugang)THEN fstatus:=fnrzugang;fmeld:=fmeldnichtimbestand; +behandledenplausifehlerFI ;jgst:=jgstaufber(standardmaskenfeld(fnrjgst));zug +:=compress(standardmaskenfeld(fnrzug));IF jgst=leerTHEN fstatus:=fnrjgst; +fmeld:=fmeldbittefuellen;behandledenplausifehlerFI ;IF zug=leerTHEN fstatus:= +fnrzug;fmeld:=fmeldbittefuellen;behandledenplausifehlerFI ;IF NOT +imbestandschuelergruppenTHEN fstatus:=fnrjgst;fmeld:=fmeldnichtimbestand; +behandledenplausifehlerFI .imbestandschuelergruppen:TEXT VAR schuljahr:= +schulkenndatum(aktschuljahr),halbjahr:=schulkenndatum(schulhalbjahr);INT VAR +dateinummer:=dnraktschuelergruppen;putwert(dateinummer+1,schuljahr);putwert( +dateinummer+2,halbjahr);putwert(dateinummer+3,jgst);putwert(dateinummer+4,zug +);search(dateinummer,TRUE );dbstatus=0.behandledenplausifehler: +standardmeldung(fmeld,"");LEAVE pruefeplausibilitaet.END PROC +pruefeplausibilitaet;END PACKET schuelerjgstaendern + diff --git a/app/schulis/2.2.1/src/1.stat grundfunktionen b/app/schulis/2.2.1/src/1.stat grundfunktionen new file mode 100644 index 0000000..8ef332a --- /dev/null +++ b/app/schulis/2.2.1/src/1.stat grundfunktionen @@ -0,0 +1,70 @@ +PACKET statgrundfunktionenDEFINES statleseschleife,statauszaehlen,statinit, +statausgeben,statspalteausgeben,statzeilevertauschen,rechtstext,loeschespalte +:LET matrixanfang=6,zeilenlaenge=8,zeilensummentitel=93,spaltensummenbasis=12 +,matrixspaltenzahl=6,matrixzeilenzahl=11,laengezaehlfeld=5,laengewertefeld=8; +LET mv=100,nv=20,summentitel="Summe",maxfeld=100,niltext=" ";BOOL VAR +maskierung;INT VAR zeilenzahl,spaltenzahl;INT VAR aktuellestartzeile;INT VAR +aktuelleendzeile;INT VAR gesamtsumme:=0;ROW mvROW nvINT VAR statzaehler;ROW +mvINT VAR zeilenzeiger;INT PROC zaehler(INT CONST i,j):IF maskierungTHEN +statzaehler(zeilenzeiger(i))(j)ELSE statzaehler(i)(j)FI END PROC zaehler; +PROC statzeilevertauschen(INT CONST i,j):INT VAR k:=zeilenzeiger(j); +zeilenzeiger(j):=zeilenzeiger(i);zeilenzeiger(i):=k;maskierung:=TRUE END +PROC statzeilevertauschen;PROC statleseschleife(INT CONST indexnummer,TEXT +CONST startschluessel1,startschluessel2,INT CONST feldnr1,feldnr2,PROC (BOOL +VAR )stataktion):vorbereitungen;leseschleife.vorbereitungen:LET maxleseanzahl +=10;BOOL VAR vorzeitigesende:=FALSE ;#INT CONST maxblock:=maxfeldDIV +zahlderfelder;#INT VAR anzahltupel;#INT CONST maxanzahl:=(maxintDIV maxblock) +*maxblock#.leseschleife:putwert(feldnr1,startschluessel1);putwert(feldnr2, +startschluessel2);search(indexnummer);IF dbstatus=0THEN einleseschleifeFI . +einleseschleife:zaehlen;WHILE NOT schlussREP anzahltupel:=maxleseanzahl; +multisucc(indexnummer,anzahltupel);stackdurchlaufPER ;.stackdurchlauf:IF +anzahltupel=0THEN dbstatus(1)ELSE WHILE anzahltupel<>0REP lesen;zaehlen;IF +vorzeitigesendeTHEN dbstatus(1);anzahltupel:=0FI ;PER FI .schluss:dbstatus<>0 +.zaehlen:stataktion(vorzeitigesende).lesen:multisucc;anzahltupelDECR 1;.END +PROC statleseschleife;PROC statauszaehlen(INT CONST zeile,spalte):statzaehler +(zeile)(spalte)INCR 1;gesamtsummeINCR 1END PROC statauszaehlen;PROC +statauszaehlen(INT CONST zeile,spalte,anzahl):statzaehler(zeile)(spalte):= +anzahl;gesamtsummeINCR anzahlEND PROC statauszaehlen;PROC statinit(INT CONST +zeilen,spalten):#INT VAR i,j;#gesamtsumme:=0;spaltenzahl:=spalten; +aktuellestartzeile:=1;zeilenzahl:=0;maskierung:=FALSE ;statinit(zeilen)END +PROC statinit;PROC statinit(INT CONST zeilen):INT VAR i,j;FOR iFROM +zeilenzahl+1UPTO zeilenREP zeilenzeiger(i):=i;FOR jFROM 1UPTO spaltenzahlREP +statzaehler(i)(j):=0PER PER ;zeilenzahl:=zeilen;aktuelleendzeile:=min( +zeilenzahl,matrixzeilenzahl)END PROC statinit;PROC statausgeben(INT CONST +startzeile,startspalte):initialisieren;spaltenausgeben; +restlichespaltenloeschen;summenberechnen.initialisieren:INT VAR spalte; +aktuellestartzeile:=startzeile;BOOL VAR gesamtsummeausgeben:=TRUE ;INT CONST +endzeile:=min(zeilenzahl,startzeile+matrixzeilenzahl-1);aktuelleendzeile:= +endzeile;INT CONST endspalte:=min(spaltenzahl,startspalte+matrixspaltenzahl-1 +);INT VAR spaltennr:=1;.spaltenausgeben:FOR spalteFROM startspalteUPTO +endspalteREP statspalteausgeben(spalte,spaltennr);spaltennrINCR 1PER ;. +summenberechnen:IF zeilensummedarstellbarTHEN statzeilensummeELSE +gesamtsummeausgeben:=FALSE ;FI ;IF spaltensummedarstellbarTHEN +statspaltensumme(startspalte,endspalte);ELSE gesamtsummeausgeben:=FALSE ;FI ; +IF gesamtsummeausgebenTHEN statgesamtsummeFI .spaltensummedarstellbar:( +endzeile=zeilenzahl).zeilensummedarstellbar:(endspalte=spaltenzahl). +restlichespaltenloeschen:INT VAR i,basis:=matrixanfang+spaltennr-1;FOR iFROM +spaltennrUPTO matrixspaltenzahl+1REP loeschespalte(basis);basisINCR 1PER . +END PROC statausgeben;PROC loeschespalte(INT CONST basis):INT VAR feldnr:= +basis;WHILE feldnr<=maxfeldREP niltextIN feldnr;feldnrINCR zeilenlaengePER +END PROC loeschespalte;PROC statspalteausgeben(INT CONST spalte,spaltennr): +INT VAR i,basis:=matrixanfang+spaltennr-1;FOR iFROM aktuellestartzeileUPTO +aktuelleendzeileREP text(zaehler(i,spalte),laengezaehlfeld)IN basis;basis +INCR zeilenlaengePER ;WHILE basis<=maxfeldREP (niltextIN basis);basisINCR +zeilenlaengePER END PROC statspalteausgeben;PROC statzeilensumme:INT VAR i, +basis:=spaltensummenbasis;FOR iFROM aktuellestartzeileUPTO aktuelleendzeile +REP text(zeilensumme(i),laengezaehlfeld)IN basis;basisINCR zeilenlaengePER +END PROC statzeilensumme;PROC statgesamtsumme:INT VAR basis:= +zeilensummentitel+zeilenlaenge-1;text(gesamtsumme,laengezaehlfeld)IN basis +END PROC statgesamtsumme;PROC statspaltensumme(INT CONST startspalte, +endspalte):titel;einzelsummen.titel:rechtstext(summentitel,laengewertefeld) +IN zeilensummentitel.einzelsummen:INT VAR j,basis:=zeilensummentitel+1;FOR j +FROM startspalteUPTO endspalteREP text(spaltensumme(j),laengezaehlfeld)IN +basis;basisINCR 1;PER .END PROC statspaltensumme;INT PROC zeilensumme(INT +CONST zeilennr):INT VAR summe:=0;INT VAR j;FOR jFROM 1UPTO spaltenzahlREP +summeINCR zaehler(zeilennr,j)PER ;summeEND PROC zeilensumme;INT PROC +spaltensumme(INT CONST spaltennr):INT VAR summe:=0;INT VAR i;FOR iFROM 1UPTO +zeilenzahlREP summeINCR zaehler(i,spaltennr)PER ;summeEND PROC spaltensumme; +TEXT PROC rechtstext(TEXT CONST t,INT CONST laenge):((laenge-length(t))*" ")+ +tEND PROC rechtstext;END PACKET statgrundfunktionen + diff --git a/app/schulis/2.2.1/src/1.stat intern b/app/schulis/2.2.1/src/1.stat intern new file mode 100644 index 0000000..a94ef21 --- /dev/null +++ b/app/schulis/2.2.1/src/1.stat intern @@ -0,0 +1,337 @@ +PACKET statinternDEFINES statinternstart,statistiklistezeigen, +erstellestatistik,zeigefertigestatistik,statblaettern:LET matrix= +"ms stat matrix",obli="mu objektliste",ueberschriftenfeld=2,fortsetzungsfeld= +3,spaltentitel=4,wertebereichanfang=5,spaltenzahl=6,zeilenzahl=11, +zeilenlaenge=8,maxfeld=100,laengezaehlfeld=5,laengewertefeld=8;LET mv=100,nv= +20;ROW nvTEXT VAR spaltenwert;INT VAR maxspaltenwert;ROW mvTEXT VAR +zeilenwert;INT VAR maxzeilenwert;INT VAR zeileleer;LET anhangzeilen=2;LET +maxbestaende=8,maxauswertungen=17;LET titelergaenz1="alle Klassen ", +titelergaenz2="alle Tutorenkurse ";ROW maxbestaendeTEXT CONST bestandtitel1:= +ROW maxbestaendeTEXT :("der Jahrgangsstufe ","Jahrgangsstufen der Sek. 1", +"Jahrgangsstufen der Sek. 2","alle Jahrgangsstufen", +"Neuangemeldete zur Jgst. 5","Neuangemeldete zur Jgst. 11", +"Neuangemeldete zu einer anderen Jgst.","Abgegangene aller Jahrgangsstufen"); +LET allejgstsek1=2,allejgstsek2=3,allejgst=4,neuan5=5,neuan11=6,neuansonst=7, +abgegangene=8;ROW maxauswertungenTEXT CONST bestandtitel2:=ROW +maxauswertungenTEXT :("Geschlecht","Alter","Schultyp der Herkunftsschule", +"Art des Zugangs zur Jgst.","Versetzungsergebnis", +"Teilnahme Religionsunterricht","Sprachenfolge","Kunst/Musik", +"Ortsteil des Wohnortes","Staatsangehörigkeit","Muttersprache", +"Einschulungsjahr Grundschule","Herkunftsschule","Religionszugehörigkeit", +"Spätaussiedler","Abgangsgrund","Abschluß");LET geschlecht=1,alter=2,schultyp +=3,zugang=4,versetzung=5,teilnahmereli=6,fremdsprachen=7,kunst=8,ort=9,staat= +10,sprache=11,einschulung=12,herkunft=13,religion=14,aussiedler=15,abgang=16, +abschluss=17;LET fortsetzungstitel=" Forts.",leertitel="leer", +leertitelplatzhalter="�",sonsttitel="sonst",summentitel="Summe";LET +neuanmeld5="n05",neuanmeld11="n11",neuanmeldsonst="nso",archivbestand="abg", +gesamtbestand="ls";LET bestort="c02 ortsteil",beststaat="c02 staaten", +bestsprache="c02 sprachen",bestreligion="c02 relizugehoerigkeit",bestabgang= +"c02 abgang",bestabschluss="c02 abschluss",bestschulart="c02 schulart", +bestversetzung="c02 versetzung",bestzugang="c02 zugang",bestherkunft= +"Schulen";LET null="0",niltext="",blank=" ";LET allesek1= +" 05 06 07 08 09 10",allesek2=" 11 12 13";LET einenbestand= +2,einejgst=1,alleinsek1=4,alleinsek2=5;LET sjahr="Schuljahr",shj= +"Schulhalbjahr",trenner1=".",trenner2="/",trennpos1=2,trennpos2=3,stattext1= +"alle",stattext2="Werte",maxsek1=10,titeltrenner=", ",links=4,rechts=3,oben=2 +,unten=1,minjgst=5,maxjgst=13,abgkz="abg. ",maxkreuzzahl=1,basisohnebestand=1 +,laengespaltentitel=30,standardanfang=2;LET weiblich="w",maennlich="m",ja="j" +,nein="n";LET unzulaessigewahlnr=56,wartennr=69,fertignr=77,meldzuvielewerte= +87,nproc=1,standardabstand=2;LET maxoblizeile=18,listenauskunft=2018;LET +beginntag=1,endetag=2,beginnmonat=4,endemonat=5,beginnjahr=7;BOOL VAR +rechtsverschiebbar,variablezaehlung,neueintragnoetig,#20.01.88dr# +vergleichsstart,sprungvonunten,fehlerzuvielewerte;INT VAR xaktuell,yaktuell, +aktuellerbestand,statbestandnr,statjgst,statauswertungsnr,statbasisnr, +jahrdestagesdatums,monatdestagesdatums,tagdestagesdatums,waspruefen,#06.07.87 +dr#dateinummer,#01.02.88dr#schluesseldateinr,vglfeld,gewindex;#05.08.87dr# +TEXT VAR kuerzelbestand,gewbestand,#06.08.87dr#bestaendezeile,vergleichsjgst, +statgrundmaske,aktschuljahr,akthalbjahr,titelzeile;PROC statinternstart: +standardvproc(maske(vergleichsknoten));sprungvonunten:=FALSE END PROC +statinternstart;PROC statistiklistezeigen:IF eingangsbildschirmkorrektTHEN +standardstartproc(obli);auskunftstextergaenzen;fuellestatistikliste; +standardnprocELSE fehlerbehandlungFI .auskunftstextergaenzen:titelzeile:= +niltext;IF statbestandnr=einejgstTHEN titelzeile1ELSE einfachetitelzeileFI ; +ergaenzeauskunft(titelzeile+auskunftstextende,listenauskunft).titelzeile1:IF +insek1THEN titelzeileCAT titelergaenz1ELSE titelzeileCAT titelergaenz2FI ; +titelzeileCAT bestandtitel1(statbestandnr);titelzeileCAT aufberzweistellig( +text(statjgst)).insek1:statjgst<=maxsek1.einfachetitelzeile:titelzeileCAT +bestandtitel1(statbestandnr).fuellestatistikliste:INT VAR feldnr:= +standardabstand+1;FOR iFROM 1UPTO maxauswertungenREP standardmaskenfeld( +bestandtitel2(i),feldnr);feldnrINCR standardabstandPER ;feldnrDECR 1;FOR i +FROM maxauswertungen+1UPTO maxoblizeileREP feldschutz(feldnr);feldnrINCR +standardabstandPER .eingangsbildschirmkorrekt:IF sprungvonuntenTHEN TRUE +ELSE INT VAR i,kreuzzahl:=0;TEXT VAR ankreuzfeld;statbestandnr:= +standardanfang;FOR iFROM standardanfangUPTO maxbestaende+1REP ankreuzfeld:= +standardmaskenfeld(i);IF ankreuzfeld<>niltextTHEN IF (i=standardanfang)THEN +statjgst:=int(ankreuzfeld);IF (NOT lastconversionok)COR statjgstungueltig +THEN LEAVE eingangsbildschirmkorrektWITH FALSE FI FI ;kreuzzahlINCR 1; +statbestandnr:=iFI PER ;statbestandnrDECR 1;(kreuzzahl<=maxkreuzzahl)CAND ( +kreuzzahl>0)FI .statjgstungueltig:(statjgstmaxjgst). +fehlerbehandlung:standardmeldung(unzulaessigewahlnr,niltext);infeld( +statbestandnr+1);return(nproc).END PROC statistiklistezeigen;PROC +erstellestatistik:reinitparsing;IF listenwahlkorrektTHEN startestatistik( +statbestandnr,statjgst,statauswertungsnr);initialisiereblaettern; +zeigefertigestatistikELSE fehlerbehandlungFI .listenwahlkorrekt:INT VAR i, +kreuzzahl:=0;TEXT VAR ankreuzfeld;statauswertungsnr:=standardanfang;INT VAR +feldnr:=standardabstand;FOR iFROM 1UPTO maxauswertungenREP ankreuzfeld:= +standardmaskenfeld(feldnr);IF ankreuzfeld<>niltextTHEN kreuzzahlINCR 1; +statauswertungsnr:=iFI ;feldnrINCR standardabstandPER ;(kreuzzahl<= +maxkreuzzahl)CAND (kreuzzahl>0).initialisiereblaettern:sprungvonunten:=TRUE ; +IF NOT fehlerzuvielewerteTHEN standardmeldung(fertignr,niltext)FI ;xaktuell:= +1;yaktuell:=1.fehlerbehandlung:standardmeldung(unzulaessigewahlnr,niltext); +infeld(statauswertungsnr*standardabstand);return(nproc).END PROC +erstellestatistik;PROC zeigefertigestatistik:infeld(fortsetzungsfeld); +standardnprocEND PROC zeigefertigestatistik;PROC startestatistik(INT CONST +bestandnr,jgst,auswertungsnr):initialisiere;maskeausgeben;titelausgeben; +indexbestimmen;bestaendeausgeben;werteverarbeitung(auswertungsnr). +initialisiere:fehlerzuvielewerte:=FALSE ;statbasisnr:=basisohnebestand; +statgrundmaske:=niltext.maskeausgeben:standardstartproc(matrix); +standardmeldung(wartennr,niltext).titelausgeben:titelzeileCAT titeltrenner; +IF auswertungsnr=versetzungTHEN versetzungsergaenzungFI ;titelzeilenrest; +titelzeileausgeben.versetzungsergaenzung:liesschuljahr;lieshalbjahr; +titelzeilenzusatz.liesschuljahr:aktschuljahr:=schulkenndatum(sjahr). +lieshalbjahr:akthalbjahr:=schulkenndatum(shj).titelzeilenzusatz:titelzeile +CAT (subtext(aktschuljahr,1,trennpos1));titelzeileCAT trenner2;titelzeileCAT +(subtext(aktschuljahr,trennpos2));titelzeileCAT trenner1;titelzeileCAT +akthalbjahr;titelzeileCAT titeltrenner.titelzeilenrest:titelzeileCAT +bestandtitel2(auswertungsnr);.titelzeileausgeben:titelzeileIN +ueberschriftenfeld.indexbestimmen:SELECT bestandnrOF CASE allejgst,neuan5, +neuan11,neuansonst,abgegangene:gewindex:=ixsustatfamrufgebCASE allejgstsek1, +allejgstsek2,einejgst:gewindex:=ixsustatjgstEND SELECT ;indexvorbelegen. +indexvorbelegen:inittupel(dnrschueler);waspruefen:=einenbestand;gewbestand:= +gesamtbestand;SELECT bestandnrOF CASE einejgst:putwert(fnrsustatuss, +gesamtbestand);putwert(fnrsusgrpjgst,jgstkonv(jgst));waspruefen:=einejgst; +CASE allejgstsek1:putwert(fnrsustatuss,gesamtbestand);putwert(fnrsusgrpjgst, +"05");waspruefen:=alleinsek1;CASE allejgstsek2:putwert(fnrsustatuss, +gesamtbestand);putwert(fnrsusgrpjgst,"11");waspruefen:=alleinsek2;CASE +allejgst:putwert(fnrsustatuss,gesamtbestand);CASE neuan5:putwert(fnrsustatuss +,neuanmeld5);gewbestand:=neuanmeld5;CASE neuan11:putwert(fnrsustatuss, +neuanmeld11);gewbestand:=neuanmeld11;CASE neuansonst:putwert(fnrsustatuss, +neuanmeldsonst);gewbestand:=neuanmeldsonst;CASE abgegangene:putwert( +fnrsustatuss,archivbestand);gewbestand:=archivbestand;END SELECT . +bestaendeausgeben:SELECT bestandnrOF CASE einejgst:ermittleallekomponenten( +jgst)CASE allejgstsek1:ermittlebestaendezeile(allesek1)CASE allejgstsek2: +ermittlebestaendezeile(allesek2)CASE allejgst,neuansonst,abgegangene: +ermittlebestaendezeile(allesek1+allesek2)CASE neuan5:ermittlebestaendezeile( +praefix(allesek1))CASE neuan11:ermittlebestaendezeile(praefix(allesek2))END +SELECT ;bestaendezeileersterteilIN spaltentitel.bestaendezeileersterteil:IF +laengespaltentitellgPER ;maxspaltenwert:=iEND PROC +ermittlebestaendezeile;PROC ermittleallekomponenten(INT CONST jgst):INT VAR +dnrklassenbestand:=dnraktschuelergruppen;bestaendezeile:=niltext; +maxspaltenwert:=0;vergleichsjgst:=jgstkonv(jgst);vergleichsstart:=TRUE ; +inittupel(dnrklassenbestand);putwert(fnrsgrpsj,schulkenndatum(sjahr));putwert +(fnrsgrphj,schulkenndatum(shj));statleseschleife(dnrklassenbestand, +vergleichsjgst,niltext,dnrklassenbestand+3,dnrklassenbestand+4,PROC (BOOL +VAR )gibklasseaus);END PROC ermittleallekomponenten;PROC gibklasseaus(BOOL +VAR ende):INT CONST dnr:=dnraktschuelergruppen;TEXT CONST klassenjgst:= +jgstkonv(intwert(dnr+3));IF vergleichsstartTHEN IF vergleichsjgst<> +klassenjgstTHEN ende:=TRUE ELSE vergleichsjgst:=klassenjgst;vergleichsstart:= +FALSE FI ELSE IF vergleichsjgst<>klassenjgstTHEN ende:=TRUE FI FI ;IF NOT +endeTHEN TEXT CONST klassenkennung:=wert(dnr+4);maxspaltenwertINCR 1; +spaltenwert(maxspaltenwert):=compress(klassenkennung);bestaendezeileCAT +rechtstext(klassenkennung,laengezaehlfeld);FI END PROC gibklasseaus;PROC +felderparsen:IF dateinummer=dnrschuelerTHEN IF vglfeld<=fnrsujgsteintrTHEN +parsenooffields(fnrsujgsteintr-dnrschueler)ELSE parsenooffields(vglfeld- +dnrschueler)FI ELIF dateinummer=dnrhalbjahresdatenTHEN parsenooffields( +fnrhjdversetzung)ELIF dateinummer=dnrschulenTHEN parsenooffields( +fnrsuskennlschule)ELSE parsenooffields(fnrsutiddiffdaten-dnrschueler)FI END +PROC felderparsen;PROC statkonst(TEXT CONST wert1,wert2):#dr11.05.88#LET +konstwertezahl=2;felderparsen;setzewerte;gibwerteaus;startezaehlung. +setzewerte:variablezaehlung:=FALSE ;maxzeilenwert:=konstwertezahl+ +anhangzeilen;zeileleer:=konstwertezahl+1;zeilenwert(1):=wert1;zeilenwert(2):= +wert2;zeilenwert(zeileleer):=niltext.gibwerteaus:ausgabederzeilenwerte(1). +startezaehlung:statzaehlung(PROC registriereeinenschueler).END PROC statkonst +;PROC statschluessel(TEXT CONST bestand):statschluessel(bestand,PROC +registriereeinenschueler)END PROC statschluessel;PROC statschluessel(TEXT +CONST bestand,PROC zaehlmethode):systemdboff;setzewerte;gibwerteaus; +startezaehlung.setzewerte:kuerzelbestand:=bestand;variablezaehlung:=FALSE ; +maxzeilenwert:=0;inittupel(schluesseldateinr);IF schluesselbestandTHEN +statleseschleife(schluesseldateinr,bestand,niltext,schluesseldateinr+1, +schluesseldateinr+2,PROC (BOOL VAR )tragegefundenenzeilenwertein)ELSE +statleseschleife(schluesseldateinr,niltext,niltext,schluesseldateinr+1, +schluesseldateinr+2,PROC (BOOL VAR )tragegefundenenzeilenwertein)FI ; +maxzeilenwertINCR anhangzeilen;zeileleer:=maxzeilenwert-1;zeilenwert( +maxzeilenwert):=sonsttitel;zeilenwert(zeileleer):=niltext.schluesselbestand:( +bestandSUB 1)="c".gibwerteaus:ausgabederzeilenwerte(1).startezaehlung: +statzaehlung(PROC zaehlmethode).END PROC statschluessel;PROC +tragegefundenenzeilenwertein(BOOL VAR schluss):IF dbstatus=okTHEN IF +schluesseldateinr=dnrschluesselTHEN IF wert(fnrschlsachgebiet)=kuerzelbestand +THEN IF maxzeilenwert=mv-anhangzeilenTHEN fehlerzuvielewerte:=TRUE ; +standardmeldung(meldzuvielewerte,niltext)ELSE maxzeilenwertINCR 1;zeilenwert( +maxzeilenwert):=wert(fnrschlschluessel)FI ELSE schluss:=TRUE FI ELSE IF +maxzeilenwert=mv-anhangzeilenTHEN fehlerzuvielewerte:=TRUE ;standardmeldung( +meldzuvielewerte,niltext)ELSE maxzeilenwertINCR 1;zeilenwert(maxzeilenwert):= +wert(schluesseldateinr+1)FI FI ELSE schluss:=TRUE FI END PROC +tragegefundenenzeilenwertein;PROC statvariabel(PROC zaehlmethode):setzewerte; +gibwerteaus;startezaehlung.setzewerte:variablezaehlung:=TRUE ;maxzeilenwert:= +0.gibwerteaus:stattext1IN wertebereichanfang;stattext2IN (wertebereichanfang+ +zeilenlaenge).startezaehlung:statzaehlung(PROC zaehlmethode).END PROC +statvariabel;PROC statzaehlung(PROC zaehlmethode):LET stackgroesse=15;INT +VAR anzahl;vorbereitung;zaehlschleife;IF variablezaehlungTHEN umsortierenFI ; +ausgabe.vorbereitung:reinitparsing;neueintragnoetig:=FALSE ;statinit( +maxzeilenwert,maxspaltenwert).zaehlschleife:anzahl:=stackgroesse; +multisearchforward(gewindex,anzahl);WHILE anzahl>0REP felderparsen;multisucc; +IF pruefungbestand(waspruefen)THEN IF dateinummer=dnrdiffdaten#dr11.05.88# +THEN diffdatenlesenELIF dateinummer=dnrhalbjahresdatenTHEN hjddatenlesenELIF +dateinummer=dnrschulenTHEN schuldatenlesenFI ;zaehlmethode; +gegebenenfallsneuenzeilenwertausgeben;anzahlDECR 1; +wennstackabgearbeitetnachlesenELSE LEAVE zaehlschleifeFI ;PER .diffdatenlesen +:inittupel(dnrdiffdaten);IF wert(fnrsutiddiffdaten)<>niltextTHEN readtid( +dnrdiffdaten,wert(fnrsutiddiffdaten))FI .hjddatenlesen:inittupel( +dnrhalbjahresdaten);IF wert(fnrsutidakthjd)<>niltextTHEN readtid( +dnrhalbjahresdaten,wert(fnrsutidakthjd));FI .schuldatenlesen:inittupel( +dnrschulen);IF wert(fnrsuskennlschule)<>niltextTHEN putwert(fnrschkennung, +wert(fnrsuskennlschule));search(dnrschulen,TRUE )FI . +gegebenenfallsneuenzeilenwertausgeben:IF variablezaehlungCAND +neueintragnoetigTHEN ausgabederzeilenwerte(1)FI . +wennstackabgearbeitetnachlesen:IF anzahl=0THEN anzahl:=stackgroesse;multisucc +(gewindex,anzahl);FI .umsortieren:quicksort(1,maxzeilenwert).ausgabe: +zwischentitel(0);ausgabederzeilenwerte(1);statausgeben(1,1).END PROC +statzaehlung;PROC ausgabederzeilenwerte(INT CONST startzeile): +sovielzeilenwiemoeglich;uebrigezeilenloeschen.sovielzeilenwiemoeglich:INT +VAR i,endwert:=min(maxzeilenwert,startzeile+zeilenzahl-1);INT VAR basis:= +wertebereichanfang;TEXT VAR ausgabewert:="";FOR iFROM startzeileUPTO endwert +REP IF variablezaehlungTHEN ausgabewert:=zeilenwert(i);IF ausgabewert= +leertitelplatzhalterTHEN ausgabewert:=leertitelFI ELIF i=zeileleerTHEN +ausgabewert:=leertitelELIF i=maxzeilenwertTHEN ausgabewert:=sonsttitelELSE +ausgabewert:=zeilenwert(i)FI ;rechtstext(ausgabewert,laengewertefeld)IN basis +;basisINCR zeilenlaengePER .uebrigezeilenloeschen:TEXT CONST loeschwert:= +rechtstext(niltext,laengewertefeld);WHILE basisspaltenzahlTHEN basis:=((bestandnr-spaltenzahl)*laengezaehlfeld)+1; +text(subtext(bestaendezeile,basis),laengespaltentitel)IN spaltentitel; +aktuellespalte:=spaltenzahl;loeschespalte(wertebereichanfang+aktuellespalte); +spaltenneuausgeben(bestandnr-spaltenzahl)FI ;infeld(wertebereichanfang+ +aktuellespalte);INT VAR x,y;getcursor(x,y);cursor(x+laengezaehlfeld-1,y-2). +END PROC zwischentitel;PROC statblaettern(INT CONST richtung):SELECT richtung +OF CASE links:nachlinksblaetternCASE rechts:nachrechtsblaetternCASE unten: +nachuntenblaetternCASE oben:nachobenblaetternEND SELECT ;return(nproc). +nachlinksblaettern:blaettern(xaktuell,yaktuell,0,-spaltenzahl). +nachrechtsblaettern:blaettern(xaktuell,yaktuell,0,spaltenzahl). +nachuntenblaettern:blaettern(xaktuell,yaktuell,zeilenzahl,0). +nachobenblaettern:blaettern(xaktuell,yaktuell,-zeilenzahl,0).END PROC +statblaettern;PROC blaettern(INT VAR x,y,INT CONST xincr,yincr):IF zulaessig +THEN meldefortsetzung;fuehreausFI .zulaessig:INT CONST xneu:=x+xincr;INT +CONST yneu:=y+yincr;((xneu>0)CAND (xneu<=maxzeilenwert))CAND ((yneu>0)CAND ( +yneu<=maxspaltenwert)).meldefortsetzung:IF (xneu=1)CAND (yneu=1)THEN +rechtstext(niltext,laengewertefeld)IN fortsetzungsfeldELSE fortsetzungstitel +IN fortsetzungsfeldFI .fuehreaus:x:=xneu;y:=yneu;IF xincr=0THEN +spaltentitelneuELSE zeilentitelneuFI ;statausgeben(xneu,yneu).spaltentitelneu +:ausgabederspaltenwerte(yneu).zeilentitelneu:ausgabederzeilenwerte(xneu).END +PROC blaettern;PROC registriereeinenschueler:tragevariablenwertein(wert( +vglfeld))END PROC registriereeinenschueler;PROC zaehlmethodealter:TEXT CONST +suchwert:=jgstkonv(lebensalter(wert(fnrsugebdatums)));tragevariablenwertein( +suchwert)END PROC zaehlmethodealter;PROC zaehlmethodereli:TEXT VAR suchwert:= +"";suchwert:=wert(fnrddreliunter);IF NOT leerTHEN IF abgemeldetTHEN suchwert +:=abgkz+suchwertFI FI ;eintragen.leer:suchwert=niltext.abgemeldet:datum( +datumrekonversion(wert(fnrddabmeldedatreli)))<>nildatum.eintragen: +tragevariablenwertein(suchwert).END PROC zaehlmethodereli;PROC +zaehlmethodefremdsprachen:TEXT VAR suchwert:=text(wert(fnrdd1fremdfach),2)+ +text(wert(fnrdd2fremdfach),2)+text(wert(fnrdd3fremdfach),2)+text(wert( +fnrdd4fremdfach),2);IF suchwert=zeilenlaenge*blankTHEN suchwert:=niltextFI ; +tragevariablenwertein(suchwert)END PROC zaehlmethodefremdsprachen;PROC +tragevariablenwertein(TEXT CONST suchwert):INT VAR lva:=0,zeilennr:=0;BOOL +VAR gefunden:=TRUE ;TEXT VAR gefundenerwert:=niltext;sucheaktuellenbestand; +suchegefundenenwert;IF NOT gefundenAND variablezaehlungTHEN IF maxzeilenwert= +mvTHEN fehlerzuvielewerte:=TRUE ;standardmeldung(meldzuvielewerte,niltext) +ELSE neueintragnoetig:=TRUE ;zeilennrINCR 1;maxzeilenwert:=zeilennr; +zeilenwert(zeilennr):=gefundenerwert;statinit(maxzeilenwert);registrierenFI +ELSE neueintragnoetig:=FALSE ;registrierenFI .sucheaktuellenbestand:SELECT +statbestandnrOF CASE einejgst:bestimmeaktuellenbestandCASE allejgstsek2: +aktuellerbestand:=int(wert(fnrsusgrpjgst))-10CASE allejgst,allejgstsek1, +abgegangene:aktuellerbestand:=int(wert(fnrsusgrpjgst))-4CASE neuansonst: +aktuellerbestand:=int(wert(fnrsujgsteintr))-4CASE neuan5,neuan11: +aktuellerbestand:=1END SELECT ;.bestimmeaktuellenbestand:FOR lvaFROM 1UPTO +maxspaltenwertREP IF compress(wert(fnrsusgrpzugtut))=compress(spaltenwert(lva +))THEN aktuellerbestand:=lva;LEAVE bestimmeaktuellenbestandFI PER . +suchegefundenenwert:IF suchwert=niltextTHEN IF variablezaehlungTHEN +gefundenerwert:=leertitelplatzhalter;zeilennr:=gefundenezeile(gefundenerwert, +maxzeilenwert,gefunden)ELSE zeilennr:=zeileleerFI ELSE gefundenerwert:= +suchwert;zeilennr:=gefundenezeile(gefundenerwert,maxzeilenwert,gefunden)FI . +registrieren:statauszaehlen(zeilennr,aktuellerbestand).END PROC +tragevariablenwertein;INT PROC gefundenezeile(TEXT CONST vergleichswert,INT +CONST oberegrenze,BOOL VAR gefunden):INT VAR i;FOR iFROM 1UPTO oberegrenze +REP IF vergleichswert=zeilenwert(i)THEN gefunden:=TRUE ;LEAVE gefundenezeile +WITH iFI PER ;gefunden:=FALSE ;maxzeilenwertEND PROC gefundenezeile;PROC +holetagesdatum:TEXT CONST tagesdatum:=date;jahrdestagesdatums:=int(subtext( +tagesdatum,beginnjahr));monatdestagesdatums:=int(subtext(tagesdatum, +beginnmonat,endemonat));tagdestagesdatums:=int(subtext(tagesdatum,beginntag, +endetag));END PROC holetagesdatum;INT PROC lebensalter(TEXT CONST +geburtsdatum):INT VAR grundalter:=jahrdestagesdatums-int(subtext(geburtsdatum +,beginnjahr));IF spaeterermonatgeborenCOR (gleichermonatgeborenCAND +spaeterertaggeboren)THEN einsjuengerFI ;grundalter.einsjuenger:grundalter +DECR 1.spaeterermonatgeboren:INT CONST geburtsmonat:=int(subtext(geburtsdatum +,beginnmonat,endemonat));geburtsmonat>monatdestagesdatums. +gleichermonatgeboren:geburtsmonat=monatdestagesdatums.spaeterertaggeboren:int +(subtext(geburtsdatum,beginntag,endetag))>tagdestagesdatums.END PROC +lebensalter;TEXT PROC aufberzweistellig(TEXT CONST jgst):IF length(jgst)=1 +THEN null+jgstELSE jgstFI END PROC aufberzweistellig;TEXT PROC praefix(TEXT +CONST t):subtext(t,1,laengezaehlfeld)END PROC praefix;PROC quicksort(INT +CONST anfang,ende):IF anfang= +pivotREP bereichsendeDECR 1PER .vertauscheamrand:vertauscheinzeilenwert( +bereichsanfang,bereichsende).fuegepivotein:INT CONST pivotstelle:= +bereichsende;vertauscheinzeilenwert(anfang,pivotstelle).END PROC quicksort; +PROC vertauscheinzeilenwert(INT CONST i,j):TEXT VAR hilfselement:=zeilenwert( +i);zeilenwert(i):=zeilenwert(j);zeilenwert(j):=hilfselement; +statzeilevertauschen(i,j)END PROC vertauscheinzeilenwert;TEXT PROC jgstkonv( +INT CONST jgst):TEXT CONST tjgst:=text(jgst);IF jgstmaxsek1)END PROC +pruefungsek2;END PACKET statintern; + diff --git a/app/schulis/2.2.1/src/2.AUSWERTUNGEN KURSWAHL.files b/app/schulis/2.2.1/src/2.AUSWERTUNGEN KURSWAHL.files new file mode 100644 index 0000000..e5bd001 --- /dev/null +++ b/app/schulis/2.2.1/src/2.AUSWERTUNGEN KURSWAHL.files @@ -0,0 +1,7 @@ +2.kurswahl schnittstelle +2.likw schuelerwahl sek2 +2.likw kurskombinationen sek2 +2.likw wahl und kursdaten sek2 +2.kw anschr kurslisten sek2 +2.stand der kursbildung analysieren + diff --git a/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL 2.files b/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL 2.files new file mode 100644 index 0000000..8e00897 --- /dev/null +++ b/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL 2.files @@ -0,0 +1,5 @@ +2.kurswahl schnittstelle +2.kurszuordnung und umwahl fuer einzelne schueler sek2 +2.kursdaten exportieren +2.kursdaten importieren + diff --git a/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL.files b/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL.files new file mode 100644 index 0000000..2f7ea21 --- /dev/null +++ b/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL.files @@ -0,0 +1,8 @@ +0.kurswahlbasis bereinigen +2.kurswahl schnittstelle +2.erf wahldaten +2.kurse auf planbloecke legen +2.schueler zu kursen zuordnen +2.konsistenzpruefung in kursdaten +2.halbjahreswechsel fuer kursdaten + diff --git a/app/schulis/2.2.1/src/2.erf wahldaten b/app/schulis/2.2.1/src/2.erf wahldaten new file mode 100644 index 0000000..79ab36c --- /dev/null +++ b/app/schulis/2.2.1/src/2.erf wahldaten @@ -0,0 +1,395 @@ +PACKET erfwahldatenDEFINES wahldatenveraendern,wahldatenspeichern, +wahldatenbeenden,wahldatenuebernehmen,wahldatenschuelerlisten, +wahldatenlisteblaettern,wahldatenlistenachbereiten:LET eingangsmaske= +"ms wahldaten eingang",textzumeingangsknoten="Wahldaten bearbeiten", +fnreingbetrjgst=2,fnreingbetrhj=3,fnreingsuderjgst=4,fnreingneuangzurjgst=5, +fnreingfamiliennamesu=6,fnreingrufnamesu=7,fnreinggeburtsdatumsu=8, +fnreingkurse=9,fnreinguebernausjgst=10,fnreinguebernaushj=11, +fnreingcursorruhepos=12;LET jgst10="10",jgst11="11",jgst12="12",jgst13="13", +hj1="1",hj2="2";LET logtext1="Anw. 2.1.1 Wahl ",logtext2="übernehmen ", +logtext3=" nach ",logtext4=" für akt. ",text1=" """,text2=""" ",komma=", ", +punkt=".";TEXT VAR logmeldung;TEXT VAR betrjgst,betrhj,jgstfuersu, +jgstfuerneuang,aktjgst,schuelermenge,gewsj,sufamname,surufname,sugebdatum, +kurswahlgewünscht,uebernausjgst,uebernaushj;LET bearbeitungsmaske= +"ms wahldaten",fnrmeldungsfeld=1,fnrschuljahr=2,fnrschueler=3, +fnrerstesfachart=4,fnrersteeingabe=5,letztefeldnummer=195, +offsetnächsteeingabe=2,textfaecherwahl="Fächerwahl",textkurswahl="Kurswahl", +titelanfang=" eingeben für jetzige Jgst. ",titelmitte=" in ",trennerfuerjgst= +".",trennerfuerschuljahr="/";LET längedesfaches=2,längederart=2, +längederkennung=4,längefachmitkennung=6,längeeinesplbl=3,maxfächeroderkurse= +96,maximalewahlen=13;TEXT VAR aktuellerschueler,alleabiturklausurkürzel;LET +ankreuzung="x";TEXT VAR allefächeroderkursangebote;INT VAR +längefachoderkursangebot;LET längefachangebot=4,posfachimfachangebot=3, +längekursangebot=10,poskennungimkursangebot=3,endposkennungimkursangebot=6, +posartimkursangebot=9;LET listenmaske="mu objektliste",fnrerstesankreuzfeld=2 +,felderprolisteneintrag=2,listeneintraegeproseite=18;LET andenanfang=1, +ansende=2,vorwaerts=3,rueckwaerts=4,dummyschueler="",sunamenstrenner=", ", +sulaengeohnedatum=60,datumstrenner=".",maxankreuzungen=1000,ankreuzungliste= +"x",keineankreuzung="",boolvektordatei="Boolvektor";BOUND ROW maxankreuzungen +BOOL VAR boolvektor;LET meldungfalschejgst=404,meldungfalscheshj=405, +meldungfalschejgstfuersu=404,meldungfalschejgstfuerneuang=404, +meldungmindestenseinejgst=409,meldungjgstsaufeinanderfolgend=410, +meldungjgstzurueckliegend=411,meldunghjzurueckliegend=412, +meldungnurzweiteshjmoeglich=413,meldungfeldleerlassen=390,meldungfamnamefehlt +=166,meldungrufnamefehlt=129,meldungsperrengescheitert=425, +meldungkeinenschülerangeben=414,meldungübernahmeinsichselbst=415, +meldungfrageuebernehmen=300,meldungdatenfehlen=68,meldunguebernehmen=301, +meldunginbearbeitung=352,meldungdatenuebernommen=302,meldungplausi=57, +meldunglistewirderstellt=7,meldungblaetternnichtmöglich=72, +meldungkurswahlserverfehlt=416,meldungsugruppeleer=423,meldungkeinangebot=417 +,meldungangebotzugross=418,meldungzuvielewahlen=421,meldungfalscheskürzel=55, +meldunginkonsistenz=419,meldungdoppelbelegung=420,meldungspeicherung=50, +meldungspeicherfehler=73;LET kuerzelfuerneuang="N",kuerzelfuersuderjgst="O", +kuerzelfuerallesu="",kennungnursuname="N",kennungnurwahldatenzumsu="K", +kennungalleszumsu="A",längeeinerwahl=15,posklausurineinerwahl=1, +posartineinerwahl=2,leereart=" ",posfachineinerwahl=4,poskennungineinerwahl= +6,leerekennung=" ",posplbl1ineinerwahl=10,leererplbl=" ", +leerekennungundplbl=" ",kennungnurplanblöcke="P",poszweiterplbl=4, +keinplbl="",zusperrenderkwdatenraum="Kurswahl-2 ";LET dbtrenner="�", +textschulhalbjahr="Schulhalbjahr",textschuljahr="Schuljahr", +bestandabiturklausur="c02 abitur klausur";LET blank=" ",niltext="";TEXT VAR +zugrundeliegendeshj:=niltext,zugrundeliegendessj:=niltext, +zugrundeliegendejgst:=niltext;BOOL VAR übernahmeingang:=FALSE , +bearbeitennachliste:=FALSE ,bearbeitungingang:=FALSE ;INT VAR aktuellezeile, +erstezeile,letztezeile;LET pufferdatenraum="temporärdatei";ROW maximalewahlen +TEXT VAR plbl1,plbl2;ROW maximalewahlenINT VAR fnrzurwahl;TEXT VAR eintrag; +FILE VAR f;BOOL VAR keineplanblöcke;INT VAR ptrfachoderkursangebot,zähler, +rücksprungweite:=1;PROC wahldatenveraendern:INT VAR fehlerstatus,fnr,i;BOOL +VAR sperregesetzt;IF NOT bearbeitennachlisteTHEN fehlerstatus:= +angabenpruefungdereingangsmaske(2);IF fehlerstatus<>0THEN infeld(fehlerstatus +);return(1);LEAVE wahldatenveraendernFI ;FI ;holeallerelevantendaten; +bearbeitungingang:=TRUE ;setzeueberschriftindenmaskekopf; +bleibendeangabenindiemaskefüllen;gefuelltebearbeitungsmaskeausgeben; +standardnproc.holeallerelevantendaten:IF NOT bearbeitennachlisteTHEN +kurswahlinitialisieren(aktjgst,betrjgst,betrhj,schuelermenge,gewsj); +kurswahlbasisholen(fehlerstatus);IF fehlerstatus<>0THEN infeld( +fnreingbetrjgst);wahldatenbeenden;standardmeldung(meldungkurswahlserverfehlt, +niltext);LEAVE wahldatenveraendernFI ;IF letzterschuelermaxfächeroderkurseTHEN infeld(fnreingbetrjgst); +wahldatenbeenden;standardmeldung(meldungangebotzugross,niltext);LEAVE +wahldatenveraendernFI ;alleabiturklausurkürzel:=ankreuzung;first( +dnrschluessel);statleseschleife(dnrschluessel,bestandabiturklausur,"", +fnrschlsachgebiet,fnrschlschluessel,PROC (BOOL VAR )sammlekürzel);IF +bearbeitennachlisteTHEN aktuellezeile:=erstezeile-1ELSE aktuellezeileDECR 1 +FI ;naechsterindex(aktuellezeile);IF aktuellezeile=0THEN infeld( +fnreingbetrjgst);wahldatenbeenden;LEAVE wahldatenveraendernFI ; +kurswahlsperresetzen(zusperrenderkwdatenraum,sperregesetzt);IF NOT +sperregesetztTHEN infeld(fnreingbetrjgst);wahldatenbeenden;standardmeldung( +meldungsperrengescheitert,niltext);LEAVE wahldatenveraendernFI ;. +setzeueberschriftindenmaskekopf:TEXT VAR t;IF kurswahlgewünscht<>niltextTHEN +t:=textkurswahlELSE t:=textfaecherwahlFI ;tCAT titelanfang;tCAT aktjgst;tCAT +titelmitte;tCAT betrjgst;tCAT trennerfuerjgst;tCAT betrhj;standardstartproc( +bearbeitungsmaske);standardkopfmaskeaktualisieren(t). +bleibendeangabenindiemaskefüllen:standardmaskenfeld(text(gewsj,2)+ +trennerfuerschuljahr+subtext(gewsj,3),fnrschuljahr);fnr:=fnrerstesfachart; +FOR iFROM 1UPTO length(allefächeroderkursangebote)DIV +längefachoderkursangebotREP eintrag:=subtext(allefächeroderkursangebote,1+(i- +1)*längefachoderkursangebot,i*längefachoderkursangebot);IF kurswahlgewünscht= +niltextTHEN eintrag:=subtext(eintrag,posfachimfachangebot)+blank+text(text( +eintrag,längederart),längederkennung)ELSE eintrag:=text(eintrag, +längedesfaches)+blank+subtext(eintrag,poskennungimkursangebot, +endposkennungimkursangebot)FI ;standardmaskenfeld(eintrag,fnr);fnrINCR +offsetnächsteeingabePER ;fnrINCR 1;WHILE fnr<=letztefeldnummerREP feldschutz( +fnr);fnrINCR offsetnächsteeingabePER .END PROC wahldatenveraendern;PROC +wahldatenspeichern(BOOL CONST speichern):INT VAR i,j,fnr,fehlerstatus;TEXT +VAR wahldaten,p1,p2,fname,rname,gebdat;IF speichernTHEN +evtlaktuelleplanblöckeholen;pruefeplausibilitaet;speicherungdurchfuehren; +logbucheintragausfuehrenFI ;naechsterindex(aktuellezeile);IF aktuellezeile<>0 +THEN gefuelltebearbeitungsmaskeausgeben;return(1)ELSE wahldatenbeendenFI . +logbucheintragausfuehren:logmeldung:=betrjgst;logmeldungCAT punkt;logmeldung +CAT betrhj;logmeldungCAT text1;logmeldungCAT fname;logmeldungCAT komma; +logmeldungCAT rname;logmeldungCAT komma;logmeldungCAT gebdat;logmeldungCAT +text2;logbucheintragvornehmen(logmeldung);.evtlaktuelleplanblöckeholen:IF +kurswahlgewünscht<>niltextTHEN kurswahl1holen(fehlerstatus);keineplanblöcke:= +fehlerstatus<>0FI .pruefeplausibilitaet:standardmeldung(meldungplausi,niltext +);wahldaten:=niltext;zähler:=0;fnr:=fnrersteeingabe;FOR iFROM 1UPTO length( +allefächeroderkursangebote)DIV längefachoderkursangebotREP IF +standardmaskenfeld(fnr)<>niltextTHEN zählerINCR 1;IF zähler>maximalewahlen +THEN standardmeldung(meldungzuvielewahlen,niltext);infeld(fnr);return(1); +LEAVE wahldatenspeichernFI ;IF length(standardmaskenfeld(fnr))>1COR pos( +alleabiturklausurkürzel,standardmaskenfeld(fnr))=0THEN standardmeldung( +meldungfalscheskürzel,niltext);infeld(fnr);return(1);LEAVE wahldatenspeichern +FI ;IF standardmaskenfeld(fnr)=ankreuzungTHEN wahldatenCAT blankELSE +wahldatenCAT standardmaskenfeld(fnr)FI ;ptrfachoderkursangebot:=(i-1)* +längefachoderkursangebot;IF kurswahlgewünscht=niltextTHEN wahldatenCAT +subtext(allefächeroderkursangebote,ptrfachoderkursangebot+1, +ptrfachoderkursangebot+längefachoderkursangebot);wahldatenCAT +leerekennungundplbl;ELSE wahldatenCAT subtext(allefächeroderkursangebote, +ptrfachoderkursangebot+posartimkursangebot,ptrfachoderkursangebot+ +längekursangebot);p1:=subtext(allefächeroderkursangebote, +ptrfachoderkursangebot+1,ptrfachoderkursangebot+längefachmitkennung); +wahldatenCAT p1;IF keineplanblöckeTHEN wahldatenCAT leererplbl;wahldatenCAT +leererplblELSE p1:=kursdaten(p1,kennungnurplanblöcke);IF p1=keinplblTHEN p1:= +leererplbl;p2:=leererplblELSE p2:=subtext(p1,poszweiterplbl);p1:=subtext(p1,1 +,längeeinesplbl)FI ;FOR jFROM 1UPTO zähler-1REP IF (p1<>leererplblCAND (p1= +plbl1[j]COR p1=plbl2[j]))COR (p2<>leererplblCAND (p2=plbl2[j]COR p2=plbl1[j]) +)THEN standardmeldung(meldungdoppelbelegung,standardmaskenfeld(fnrzurwahl[j]) ++"#");infeld(fnr);return(1);LEAVE wahldatenspeichernFI ;PER ;plbl1[zähler]:= +p1;plbl2[zähler]:=p2;wahldatenCAT p1;wahldatenCAT p2;fnrzurwahl[zähler]:=fnr- +1;FI FI FI ;fnrINCR offsetnächsteeingabePER .speicherungdurchfuehren: +standardmeldung(meldungspeicherung,niltext);i:=pos(aktuellerschueler, +dbtrenner);j:=pos(aktuellerschueler,dbtrenner,i+1);fname:=text( +aktuellerschueler,i-1);rname:=subtext(aktuellerschueler,i+1,j-1);gebdat:= +subtext(aktuellerschueler,j+1);schuelerwahleintragen(fname,rname,gebdat, +wahldaten);.END PROC wahldatenspeichern;PROC wahldatenbeenden:INT VAR +fehlerstatus:=0,i;rücksprungweite:=1;IF übernahmeingangTHEN forget( +pufferdatenraum,quiet);FOR iFROM fnreingbetrjgstUPTO fnreinguebernaushjREP +feldfrei(i)PER ;feldschutz(fnreingcursorruhepos);infeld(fnreingbetrjgst);IF +NOT bearbeitungingangTHEN kurswahlsperrebeenden(zusperrenderkwdatenraum); +rücksprungweiteINCR 1FI ;übernahmeingang:=FALSE ELSE IF bearbeitennachliste +COR bearbeitungingangTHEN fülleeingangsmaskeFI FI ;IF bearbeitennachliste +THEN forget(boolvektordatei,quiet);bearbeitennachliste:=FALSE ; +rücksprungweiteINCR 1FI ;IF bearbeitungingangTHEN kurswahl2sichern( +fehlerstatus);IF fehlerstatus<>0THEN standardmeldung(meldungspeicherfehler, +niltext);infeld(fnreingbetrjgst)FI ;kurswahlsperrebeenden( +zusperrenderkwdatenraum);bearbeitungingang:=FALSE ;rücksprungweiteINCR 1FI ; +return(rücksprungweite).fülleeingangsmaske:standardstartproc(eingangsmaske); +standardkopfmaskeaktualisieren(textzumeingangsknoten);standardmaskenfeld( +betrjgst,fnreingbetrjgst);standardmaskenfeld(betrhj,fnreingbetrhj); +standardmaskenfeld(jgstfuersu,fnreingsuderjgst);standardmaskenfeld( +jgstfuerneuang,fnreingneuangzurjgst);standardmaskenfeld(sufamname, +fnreingfamiliennamesu);standardmaskenfeld(surufname,fnreingrufnamesu); +standardmaskenfeld(sugebdatum,fnreinggeburtsdatumsu);standardmaskenfeld( +kurswahlgewünscht,fnreingkurse);standardmaskenfeld(uebernausjgst, +fnreinguebernausjgst);standardmaskenfeld(uebernaushj,fnreinguebernaushj); +standardmaskenfeld(niltext,fnreingcursorruhepos);.END PROC wahldatenbeenden; +PROC wahldatenuebernehmen(BOOL CONST hauptaktion):INT VAR i,j1,j2,j3,j4, +fehlerstatus;TEXT VAR zeile,wahlen,t;BOOL VAR sperregesetzt;IF NOT +hauptaktionTHEN fehlerstatus:=angabenpruefungdereingangsmaske(1);IF +fehlerstatus<>0THEN infeld(fehlerstatus);return(1);LEAVE wahldatenuebernehmen +FI ;kurswahlinitialisieren(aktjgst,uebernausjgst,uebernaushj,schuelermenge, +gewsj);kurswahlbasisholen(fehlerstatus);IF fehlerstatus<>0THEN +standardmeldung(meldungkurswahlserverfehlt,niltext);infeld(fnreingbetrjgst); +return(1);LEAVE wahldatenuebernehmenFI ;IF letzterschueler0THEN standardmeldung( +meldungkurswahlserverfehlt,niltext);infeld(fnreingbetrjgst);forget( +pufferdatenraum,quiet);return(1);LEAVE wahldatenuebernehmenFI ; +kurswahlsperresetzen(zusperrenderkwdatenraum,sperregesetzt);IF NOT +sperregesetztTHEN standardmeldung(meldungsperrengescheitert,niltext);infeld( +fnreingbetrjgst);forget(pufferdatenraum,quiet);return(1);LEAVE +wahldatenuebernehmenFI ;übernahmeingang:=TRUE ;standardmeldung( +meldungfrageuebernehmen,niltext);FOR iFROM fnreingbetrjgstUPTO +fnreinguebernaushjREP feldschutz(i)PER ;feldfrei(fnreingcursorruhepos);infeld +(fnreingcursorruhepos);standardnproc;ELSE standardmeldung(meldunguebernehmen, +niltext);bearbeitungingang:=TRUE ;f:=sequentialfile(input,pufferdatenraum); +WHILE NOT eof(f)REP getline(f,zeile);j1:=pos(zeile,dbtrenner);j2:=pos(zeile, +dbtrenner,j1+1);j3:=pos(zeile,dbtrenner,j2+1);j4:=pos(zeile,dbtrenner,j3+1); +standardmeldung(meldunginbearbeitung,subtext(zeile,j1+1,j2-1)+"#");IF +kurswahlgewünscht=niltextTHEN t:=text(zeile,j1-1);wahlen:=niltext;FOR iFROM 1 +UPTO length(t)DIV längeeinerwahlREP wahlenCAT subtext(t,(i-1)*längeeinerwahl+ +1,(i-1)*längeeinerwahl+poskennungineinerwahl-1);wahlenCAT leerekennungundplbl +PER ELSE wahlen:=text(zeile,j1-1)FI ;schuelerwahleintragen(subtext(zeile,j1+1 +,j2-1),subtext(zeile,j2+1,j3-1),subtext(zeile,j3+1,j4-1),wahlen);PER ; +standardmeldung(meldungdatenuebernommen,niltext);logmeldung:=logtext2; +logmeldungCAT uebernausjgst;logmeldungCAT punkt;logmeldungCAT uebernaushj; +logmeldungCAT logtext3;logmeldungCAT betrjgst;logmeldungCAT punkt;logmeldung +CAT betrhj;logmeldungCAT logtext4;logmeldungCAT aktjgst; +logbucheintragvornehmen(logmeldung);wahldatenbeendenFI END PROC +wahldatenuebernehmen;PROC wahldatenschuelerlisten:INT VAR i,fehlerstatus; +fehlerstatus:=angabenpruefungdereingangsmaske(2);IF fehlerstatus<>0THEN +infeld(fehlerstatus);return(1);LEAVE wahldatenschuelerlistenFI ; +standardmeldung(meldunglistewirderstellt,niltext);kurswahlinitialisieren( +aktjgst,betrjgst,betrhj,schuelermenge,gewsj);kurswahlbasisholen(fehlerstatus) +;IF fehlerstatus<>0THEN standardmeldung(meldungkurswahlserverfehlt,niltext); +infeld(fnreingbetrjgst);return(1);LEAVE wahldatenschuelerlistenFI ;IF +letzterschueler +letztezeileTHEN standardmeldung(meldungblaetternnichtmöglich,"")ELSE +aktuellezeile:=max(1,letztezeile-listeneintraegeproseite+1); +listezeigenabzeile(aktuellezeile)FI CASE vorwaerts:IF aktuellezeile+ +listeneintraegeproseite>letztezeileTHEN standardmeldung( +meldungblaetternnichtmöglich,"")ELSE aktuellezeileINCR +listeneintraegeproseite;listezeigenabzeile(aktuellezeile)FI CASE rueckwaerts: +IF aktuellezeile=erstezeileTHEN standardmeldung(meldungblaetternnichtmöglich, +"")ELSE aktuellezeileDECR listeneintraegeproseite;aktuellezeile:=max( +aktuellezeile,erstezeile);listezeigenabzeile(aktuellezeile)FI END SELECT ; +return(1)END PROC wahldatenlisteblaettern;PROC wahldatenlistenachbereiten: +INT VAR i,fnr;infeld(fnrerstesankreuzfeld);standardnproc;fnr:= +fnrerstesankreuzfeld;FOR iFROM aktuellezeileUPTO min(aktuellezeile+ +listeneintraegeproseite,letztezeile)REP boolvektor(i):=standardmaskenfeld(fnr +)<>niltext;fnrINCR felderprolisteneintragPER END PROC +wahldatenlistenachbereiten;PROC ermittlelistenstartundende:INT VAR index,j1, +j2;TEXT VAR t;letztezeile:=min(maxankreuzungen,letzterschueler);erstezeile:= +min(ersterschueler,letztezeile);aktuellezeile:=erstergewuenschterschueler. +erstergewuenschterschueler:index:=erstezeile;IF sufamname<>niltextTHEN t:= +wahldatenzumindex(index,kennungnursuname);j1:=pos(t,dbtrenner);WHILE +sufamname>text(t,j1-1)CAND indexsubtext(t,j1+1,j2-1)CAND indexniltextTHEN WHILE sufamname=text(t,j1 +-1)CAND surufname=subtext(t,j1+1,j2-1)CAND text(sugebdatum,2)+datumstrenner+ +subtext(sugebdatum,3,4)+datumstrenner+subtext(sugebdatum,5)<>subtext(t,j2+1) +CAND index +letztezeileTHEN index:=0FI END PROC naechsterindex;PROC sammlefächerangebot( +BOOL VAR b):IF intwert(fnrfangsj)>int(zugrundeliegendessj)COR intwert( +fnrfanghj)>int(zugrundeliegendeshj)COR intwert(fnrfangjgst)>int( +zugrundeliegendejgst)COR dbstatus<>0THEN b:=TRUE ELIF intwert(fnrfangjgst)= +int(zugrundeliegendejgst)THEN allefächeroderkursangeboteCAT text(wert( +fnrfangart),längederart);allefächeroderkursangeboteCAT text(wert(fnrfangfach) +,längedesfaches);FI END PROC sammlefächerangebot;PROC sammlekürzel(BOOL VAR b +):IF wert(fnrschlsachgebiet)<>bestandabiturklausurCOR dbstatus<>0THEN b:= +TRUE ELSE alleabiturklausurkürzelCAT wert(fnrschlschluessel)FI ;END PROC +sammlekürzel;PROC gefuelltebearbeitungsmaskeausgeben:TEXT VAR wahldaten, +klausurleiste,suchtext;INT VAR i,anfposaktuellewahl,position,fnr;BOOL VAR +warnung:=FALSE ;wahldaten:=wahldatenzumindex(aktuellezeile,kennungnursuname); +aktuellerschueler:=wahldaten;changeall(wahldaten,dbtrenner,sunamenstrenner); +standardmaskenfeld(text(wahldaten,standardfeldlaenge(fnrschueler)), +fnrschueler);wahldaten:=wahldatenzumindex(aktuellezeile, +kennungnurwahldatenzumsu);klausurleiste:=(length(allefächeroderkursangebote) +DIV längefachoderkursangebot)*dbtrenner;FOR iFROM 1UPTO length(wahldaten)DIV +längeeinerwahlREP anfposaktuellewahl:=(i-1)*längeeinerwahl;IF +kurswahlgewünscht=niltextTHEN IF subtext(wahldaten,anfposaktuellewahl+ +poskennungineinerwahl,anfposaktuellewahl+posplbl1ineinerwahl-1)<>leerekennung +THEN warnung:=TRUE FI ;IF subtext(wahldaten,anfposaktuellewahl+ +posartineinerwahl,anfposaktuellewahl+posfachineinerwahl-1)=leereartTHEN +warnung:=TRUE ELSE suchtext:=subtext(wahldaten,anfposaktuellewahl+ +posartineinerwahl,anfposaktuellewahl+poskennungineinerwahl-1);position:=pos( +allefächeroderkursangebote,suchtext);WHILE position<>0CAND positionMOD +längefachoderkursangebot<>1REP position:=pos(allefächeroderkursangebote, +suchtext,position+1);PER ;IF position=0THEN warnung:=TRUE ELSE position:= +positionDIV längefachoderkursangebot+1;IF (klausurleisteSUB position)<> +dbtrennerTHEN warnung:=TRUE ELSE IF (wahldatenSUB (anfposaktuellewahl+ +posklausurineinerwahl))=blankTHEN change(klausurleiste,position,position, +ankreuzung)ELSE change(klausurleiste,position,position,wahldatenSUB ( +anfposaktuellewahl+posklausurineinerwahl))FI FI ;FI FI ELSE IF subtext( +wahldaten,anfposaktuellewahl+posartineinerwahl,anfposaktuellewahl+ +posfachineinerwahl-1)=leereartTHEN warnung:=TRUE FI ;suchtext:=subtext( +wahldaten,anfposaktuellewahl+posfachineinerwahl,anfposaktuellewahl+ +posplbl1ineinerwahl-1);position:=pos(allefächeroderkursangebote,suchtext); +WHILE position<>0CAND positionMOD längefachoderkursangebot<>1REP position:= +pos(allefächeroderkursangebote,suchtext,position+1);PER ;IF position=0THEN +warnung:=TRUE ELSE position:=positionDIV längefachoderkursangebot+1;IF ( +klausurleisteSUB position)<>dbtrennerTHEN warnung:=TRUE ELSE IF (wahldaten +SUB (anfposaktuellewahl+posklausurineinerwahl))=blankTHEN change( +klausurleiste,position,position,ankreuzung)ELSE change(klausurleiste,position +,position,wahldatenSUB (anfposaktuellewahl+posklausurineinerwahl))FI FI FI +FI ;PER ;fnr:=fnrersteeingabe;FOR iFROM 1UPTO length(klausurleiste)REP IF ( +klausurleisteSUB i)=dbtrennerTHEN standardmaskenfeld(niltext,fnr)ELSE +standardmaskenfeld(klausurleisteSUB i,fnr)FI ;fnrINCR offsetnächsteeingabe +PER ;IF warnungTHEN standardmeldung(meldunginkonsistenz,niltext);infeld( +fnrschuljahr)ELSE infeld(fnrmeldungsfeld)FI ;standardfelderausgeben;infeld( +fnrersteeingabe)END PROC gefuelltebearbeitungsmaskeausgeben;INT PROC +angabenpruefungdereingangsmaske(INT CONST aktion):INT VAR fehlerstatus; +betrjgst:=standardmaskenfeld(fnreingbetrjgst);betrhj:=standardmaskenfeld( +fnreingbetrhj);IF betrjgst<>jgst11AND betrjgst<>jgst12AND betrjgst<>jgst13 +THEN standardmeldung(meldungfalschejgst,niltext);LEAVE +angabenpruefungdereingangsmaskeWITH fnreingbetrjgstFI ;IF betrhj<>hj1AND +betrhj<>hj2THEN standardmeldung(meldungfalscheshj,niltext);LEAVE +angabenpruefungdereingangsmaskeWITH fnreingbetrhjFI ;jgstfuersu:= +standardmaskenfeld(fnreingsuderjgst);IF jgstfuersu<>niltextCAND jgstfuersu<> +jgst10CAND jgstfuersu<>jgst11CAND jgstfuersu<>jgst12CAND jgstfuersu<>jgst13 +THEN standardmeldung(meldungfalschejgstfuersu,niltext);LEAVE +angabenpruefungdereingangsmaskeWITH fnreingsuderjgstFI ;jgstfuerneuang:= +standardmaskenfeld(fnreingneuangzurjgst);IF jgstfuerneuang<>niltextCAND +jgstfuerneuang<>jgst11CAND jgstfuerneuang<>jgst12CAND jgstfuerneuang<>jgst13 +THEN standardmeldung(meldungfalschejgstfuerneuang,niltext);LEAVE +angabenpruefungdereingangsmaskeWITH fnreingneuangzurjgstFI ;IF jgstfuersu= +niltextCAND jgstfuerneuang=niltextTHEN standardmeldung( +meldungmindestenseinejgst,niltext);LEAVE angabenpruefungdereingangsmaskeWITH +fnreingsuderjgstFI ;IF jgstfuersu<>niltextCAND jgstfuerneuang<>niltextCAND +int(jgstfuersu)+1<>int(jgstfuerneuang)THEN standardmeldung( +meldungjgstsaufeinanderfolgend,niltext);LEAVE angabenpruefungdereingangsmaske +WITH fnreingsuderjgstFI ;zugrundeliegendeshj:=schulkenndatum( +textschulhalbjahr);zugrundeliegendessj:=schulkenndatum(textschuljahr);IF +jgstfuerneuang<>niltextTHEN IF jgstfuerneuang>betrjgstTHEN standardmeldung( +meldungjgstzurueckliegend,niltext);LEAVE angabenpruefungdereingangsmaskeWITH +fnreingbetrjgstFI ;aktjgst:=text(int(jgstfuerneuang)-1);IF jgstfuersu<> +niltextTHEN schuelermenge:=kuerzelfuerallesuELSE schuelermenge:= +kuerzelfuerneuangFI ELSE IF jgstfuersu>betrjgstTHEN standardmeldung( +meldungjgstzurueckliegend,niltext);LEAVE angabenpruefungdereingangsmaskeWITH +fnreingbetrjgstFI ;IF betrjgst=jgstfuersuCAND betrhjniltextTHEN LEAVE angabenpruefungdereingangsmaske +WITH fnreingsuderjgstELSE LEAVE angabenpruefungdereingangsmaskeWITH +fnreingneuangzurjgstFI FI ;kurswahlgewünscht:=standardmaskenfeld(fnreingkurse +);sufamname:=standardmaskenfeld(fnreingfamiliennamesu);surufname:= +standardmaskenfeld(fnreingrufnamesu);sugebdatum:=standardmaskenfeld( +fnreinggeburtsdatumsu);uebernausjgst:=standardmaskenfeld(fnreinguebernausjgst +);uebernaushj:=standardmaskenfeld(fnreinguebernaushj);IF aktion=2THEN IF +sufamname=niltextCAND (surufname<>niltextOR sugebdatum<>niltext)THEN +standardmeldung(meldungfamnamefehlt,niltext);LEAVE +angabenpruefungdereingangsmaskeWITH fnreingfamiliennamesuFI ;IF surufname= +niltextCAND sugebdatum<>niltextTHEN standardmeldung(meldungrufnamefehlt, +niltext);LEAVE angabenpruefungdereingangsmaskeWITH fnreingrufnamesuFI ;IF +sugebdatum<>niltextTHEN standardpruefe(6,fnreinggeburtsdatumsu,0,0,"", +fehlerstatus);IF fehlerstatus<>0THEN LEAVE angabenpruefungdereingangsmaske +WITH fehlerstatusFI FI ;IF uebernausjgst<>niltextTHEN standardmeldung( +meldungfeldleerlassen,niltext);LEAVE angabenpruefungdereingangsmaskeWITH +fnreinguebernausjgstFI ;IF uebernaushj<>niltextTHEN standardmeldung( +meldungfeldleerlassen,niltext);LEAVE angabenpruefungdereingangsmaskeWITH +fnreinguebernaushjFI ELSE IF length(sufamname)+length(surufname)+length( +sugebdatum)>0THEN standardmeldung(meldungkeinenschülerangeben,niltext);IF +sufamname<>niltextTHEN LEAVE angabenpruefungdereingangsmaskeWITH +fnreingfamiliennamesuELIF surufname<>niltextTHEN LEAVE +angabenpruefungdereingangsmaskeWITH fnreingrufnamesuELSE LEAVE +angabenpruefungdereingangsmaskeWITH fnreinggeburtsdatumsuFI ;FI ;IF +uebernausjgst<>jgst11AND uebernausjgst<>jgst12AND uebernausjgst<>jgst13THEN +standardmeldung(meldungfalschejgst,niltext);LEAVE +angabenpruefungdereingangsmaskeWITH fnreinguebernausjgstFI ;IF uebernaushj<> +hj1AND uebernaushj<>hj2THEN standardmeldung(meldungfalscheshj,niltext);LEAVE +angabenpruefungdereingangsmaskeWITH fnreinguebernaushjFI ;IF uebernausjgst= +betrjgstCAND uebernaushj=betrhjTHEN standardmeldung( +meldungübernahmeinsichselbst,niltext);LEAVE angabenpruefungdereingangsmaske +WITH fnreinguebernausjgstFI ;IF jgstfuerneuang<>niltextTHEN IF jgstfuerneuang +>uebernausjgstTHEN standardmeldung(meldungjgstzurueckliegend,niltext);LEAVE +angabenpruefungdereingangsmaskeWITH fnreinguebernausjgstFI ;ELSE IF +jgstfuersu>uebernausjgstTHEN standardmeldung(meldungjgstzurueckliegend, +niltext);LEAVE angabenpruefungdereingangsmaskeWITH fnreinguebernausjgstFI ; +IF uebernausjgst=jgstfuersuCAND uebernaushj0THEN erase(zeile, +kurswahlserver)ELSE IF subtext(zeile,1,5)<>vergleichshjTHEN vergleichshj:= +subtext(zeile,1,5);vergleichsjgst:="";line(prot);standardmeldung( +meldnrinbearbeitung,(vergleichshjSUB 5)+". "+subtext(vergleichshj,1,2)+ +schraegstrich+subtext(vergleichshj,3,4)+kennzhell)FI ;IF vergleichshj<= +aktuelleshjTHEN meldeloeschung(zeile,TRUE );erase(subtext(zeile, +beginndateiname),kurswahlserver)ELIF pos(zeile,kurswahl2praefix)>0THEN erase( +subtext(zeile,beginndateiname),kurswahlserver)ELSE meldeloeschung(zeile, +FALSE )FI FI .kopfinausgabedateischreiben:putline(prot,schulkenndatum( +schulname));putline(prot,text(schulkenndatum(schulort),65)+date);line(prot); +putline(prot,ueberschrift);putline(prot,length(ueberschrift)*strich);line( +prot);auszeile:=untertitel1;auszeileCAT subtext(aktsj,1,2);auszeileCAT +schraegstrich;auszeileCAT subtext(aktsj,3,4);auszeileCAT " , ";auszeileCAT +akthj;auszeileCAT halbjahr;putline(prot,auszeile);auszeile:=untertitel2; +auszeileCAT subtext(geplsj,1,2);auszeileCAT schraegstrich;auszeileCAT subtext +(geplsj,3,4);auszeileCAT " , ";auszeileCAT geplhj;auszeileCAT halbjahr; +putline(prot,auszeile);line(prot);putline(prot,protokollanfang)END PROC +halbjahreswechselfuerkursdatenstarten;PROC meldeloeschung(TEXT CONST +ausdatname,BOOL CONST loeschen):IF vergleichsjgst<>jgstinausdatnameTHEN +vergleichsjgst:=jgstinausdatname;TEXT VAR auszeile:="Jgst. ";auszeileCAT +vergleichsjgst;auszeileCAT " in ";auszeileCAT subtext(vergleichshj,1,2); +auszeileCAT "/";auszeileCAT subtext(vergleichshj,3,4);auszeileCAT " "; +auszeileCAT (vergleichshjSUB 5);auszeileCAT ". Halbjahr ";IF loeschenTHEN +auszeileCAT "wurden gelöscht"ELSE auszeileCAT "existieren"FI ;putline(prot, +auszeile)FI .jgstinausdatname:subtext(ausdatname,beginnjgstsort, +beginnjgstsort+1).END PROC meldeloeschung;PROC +halbjahreswechselfuerkursdatendrucken(BOOL CONST drucken):IF druckenTHEN +print(protname)FI ;forget(protname,quiet);enter(2)END PROC +halbjahreswechselfuerkursdatendrucken;END PACKET +halbjahreswechselfuerkursdaten + diff --git a/app/schulis/2.2.1/src/2.konsistenzpruefung in kursdaten b/app/schulis/2.2.1/src/2.konsistenzpruefung in kursdaten new file mode 100644 index 0000000..c027414 --- /dev/null +++ b/app/schulis/2.2.1/src/2.konsistenzpruefung in kursdaten @@ -0,0 +1,75 @@ +PACKET konsistenzpruefunginkursdatenDEFINES +konsistenzpruefunginkursdatenstarten, +konsistenzpruefunginkursdatenprotokolldrucken:LET meldnrblankomeldung=343; +LET protname="Protokoll zur Konsistenzprüfung";FILE VAR prot;LET schuljahr= +"Schuljahr",schulhalbjahr="Schulhalbjahr",schulname="Schulname",schulort= +"Schulort";LET ueberschrift="Konsistenzprüfung in Kursdaten",untertitel1= +"Kursdaten zum Schuljahr ",texthalbjahr=". Halbjahr",untertitel2= +"Prüfung am ",beginnderfehlerliste=" festgestellte Inkonsistenzen:";LET +strich="-",schraegstrich="/",blank=" ",kennzhell="#";TEXT VAR aktsj:="",akthj +:="",gewsj:="",gewhj:="",bearbschuljahr;INT VAR ihalbjahr;LET maxhalbjahre=7; +LET ersteshj="1";INT VAR jgst,gewjgst,jgstinkrement,startjgst;LET jgst10=10, +jgst11=11,jgst13=13;TEXT VAR auszeile;TEXT VAR gueltigekurse,alleplanbloecke, +allekursedesplanblocks,planblock,kurs;LET kennungkurse="K";LET +laengeplanblock=3,laengekurs=6,laengekursangaben=10;INT VAR posplanblock, +poskurs;BOOL VAR keinfehleraufgetreten;PROC +konsistenzpruefunginkursdatenstarten:IF aktsj=""THEN aktsj:=schulkenndatum( +schuljahr);akthj:=schulkenndatum(schulhalbjahr)FI ;gewsj:=aktsj;gewhj:=akthj; +protokollvorbereiten;ausgabekopfaufbereiten;pruefunginkursdatendurchfuehren; +zeigedatei(protname,"").protokollvorbereiten:forget(protname,quiet);prot:= +sequentialfile(output,protname).ausgabekopfaufbereiten:putline(prot, +schulkenndatum(schulname));putline(prot,schulkenndatum(schulort));line(prot,2 +);putline(prot,20*blank+ueberschrift);putline(prot,20*blank+length( +ueberschrift)*strich);line(prot);auszeile:=untertitel1;auszeileCAT +aufberschuljahr;auszeileCAT ", ";auszeileCAT akthj;auszeileCAT texthalbjahr; +putline(prot,auszeile);auszeile:=untertitel2;auszeileCAT date;auszeileCAT +blank;auszeileCAT timeofday;putline(prot,auszeile);line(prot,2).END PROC +konsistenzpruefunginkursdatenstarten;PROC pruefunginkursdatendurchfuehren:IF +akthj=ersteshjTHEN startjgst:=jgst11ELSE startjgst:=jgst10FI ;FOR jgstFROM +startjgstUPTO jgst13REP kurswahlserveraktualisieren(text(jgst),"","")#spr16. +01.91#PER ;jgstinkrement:=0;FOR ihalbjahrFROM 1UPTO maxhalbjahreREP +gewhalbjahrbearbeiten;halbjahrerhoehenPER .halbjahrerhoehen: +geplanteshjundsjberechnen(gewhj,gewsj);IF gewhj=ersteshjTHEN jgstinkrement +INCR 1FI .gewhalbjahrbearbeiten:FOR jgstFROM startjgstUPTO jgst13REP gewjgst +:=jgst+jgstinkrement;IF gewjgst<=13THEN kurswahlinitialisieren(text(jgst), +text(gewjgst),gewhj,"",bearbschuljahr);IF istkurswahlbasisvorhandenTHEN +bearbeiteFI ;FI ;PER .bearbeite:kontrollmeldungausgeben; +datenmeldunginprotokollausgeben;fehlerschalterinitialisieren;IF +aktuellesodergeplanteshalbjahrTHEN INT VAR fehlerstatus;kurswahlbasisholen( +fehlerstatus);pruefeplanblockschemamitkursen;kurswahl1sichern(fehlerstatus) +FI ;fehlerschalterauswerten.aktuellesodergeplanteshalbjahr:ihalbjahr=1COR +ihalbjahr=2.kontrollmeldungausgeben:auszeile:="Daten zu Jgst. ";auszeileCAT +text(gewjgst);auszeileCAT ".";auszeileCAT gewhj;auszeileCAT " in ";auszeile +CAT aufberschuljahr;auszeileCAT " werden geprüft.";auszeileCAT kennzhell; +standardmeldung(meldnrblankomeldung,auszeile).datenmeldunginprotokollausgeben +:auszeile:="Wahldaten für Schüler der Jgst. ";auszeileCAT text(jgst);auszeile +CAT ": Schuljahr ";auszeileCAT aufberschuljahr;auszeileCAT " Jgst. ";auszeile +CAT text(gewjgst);auszeileCAT ".";auszeileCAT gewhj;putline(prot,auszeile). +fehlerschalterinitialisieren:keinfehleraufgetreten:=TRUE . +fehlerschalterauswerten:IF keinfehleraufgetretenTHEN putline(prot, +beginnderfehlerliste+" keine")FI ;line(prot,2).pruefeplanblockschemamitkursen +:gueltigekurse:=allekurse;alleplanbloecke:=alleplanblockbezeichner; +posplanblock:=1;WHILE posplanblock0REP IF findposMOD laenge=1THEN LEAVE suchposWITH findposELSE +findpos:=pos(quelle,suchtext,findpos+1);FI PER ;findposEND PROC suchpos;END +PACKET konsistenzpruefunginkursdaten + diff --git a/app/schulis/2.2.1/src/2.kursdaten exportieren b/app/schulis/2.2.1/src/2.kursdaten exportieren new file mode 100644 index 0000000..e93c54d --- /dev/null +++ b/app/schulis/2.2.1/src/2.kursdaten exportieren @@ -0,0 +1,226 @@ +PACKET kursdatenueberschnittstelleexportierenDEFINES +kursdatenschnittstelleexportanfang, +kursdatenschnittstelleexportaufbereitenoderabfrage, +kursdatenschnittstelleexportaufbereiten,kursdatenschnittstelleexportzeigen, +kursdatenschnittstelleexportzeigenverlassen, +kursdatenschnittstelleexportloeschenabfrage, +kursdatenschnittstelleexportloeschen,kursdatenschnittstelleexportarchiv, +kursdatenschnittstelleexportabfrage, +kursdatenschnittstelleexportloescheundreturn, +kursdatenschnittstelleexportdrucken,kursdatenschnittstelleexportabbruch:LET +eingangsmaske="ms kurswahldaten exportieren",schuljahr="Schuljahr",halbjahr= +"Schulhalbjahr",filemodus="file ibm",listenname= +"Liste der Dateien auf der Diskette:",trenner="�",dos="DOS",einganggewjgst=2, +einganggewhj=3,eingangaktjgst=4,eingangaktneue=5,eingangmitkursen=6, +eingangdateiname=7,anzeingangsfelder=7,kurslaenge=15,kznurneue="N",kzohneneue +="O",kzalle="A",kzname="N",kzkurse="K",suffixfa=".FA",suffixwk=".WK",suffixbr +=".BR",suffixzi=".ZI",suffixzieintrag=" ",leerekennung=" " +,meldungkeineschueler=423,meldungbearbwird=352,meldungwarten=69, +meldungdrucken=58,meldungpraezisieren=129,meldungfeldfuellen=52, +meldungfalschejgst=404,meldungfalscheshj=405,meldungserverfehler=416, +meldungandereauswahl=318,meldungdatengeloescht=431,meldungnamefalsch=323, +meldungrausreichen=343,meldungdisksichern=347,meldungdiskinit=348, +meldungnameloeschen=349,meldungaufdiskschr=350,meldungnameunbek=351;ROW +anzeingangsfelderTEXT VAR eingangrow:=ROW anzeingangsfelderTEXT :("","","","" +,"","","schulis");INT VAR i,j;TEXT VAR t,t1,t2;INT VAR pos1,pos2,letztepos, +fstat,ruecksprung,aktfeld;TEXT VAR aktdateiname:="schulis",gewjgst,gewhj, +aktjgst,aktneue,gewsj,aktsj:="0000",akthj,schuelergruppe,aktsuffix:=suffixfa, +fahj,fasj,kweintrag,kurseintrag,dateieintrag;THESAURUS VAR thes;BOOL VAR +archivfehler;FILE VAR dsfa,dswk,dsbr,dszi,g;PROC +kursdatenschnittstelleexportanfang:standardstartproc(eingangsmaske); +gibeingangaus;standardfelderausgeben;infeld(letztepos);standardnproc. +gibeingangaus:infeld(1);FOR iFROM 1UPTO anzeingangsfelderREP +standardmaskenfeld(eingangrow(i),i);IF eingangrow(i)<>""THEN letztepos:=iFI +PER .END PROC kursdatenschnittstelleexportanfang;PROC +kursdatenschnittstelleexportaufbereitenoderabfrage: +pruefeingabeundbelegvariablen;IF fstat=0THEN abfrageloeschenFI . +abfrageloeschen:beginlist;REP getlistentry(t1,t2);IF pos(t1,suffixfa)>0THEN +infeld(eingangdateiname);ruecksprung:=2;standardmeldung(meldungnameloeschen, +t1+" (-WK,-BR,-ZI)#"+text(t2,8)+"#");standardnproc;LEAVE +kursdatenschnittstelleexportaufbereitenoderabfrageFI UNTIL t1=""PER ; +ruecksprung:=1;kursdatenschnittstelleexportaufbereiten.END PROC +kursdatenschnittstelleexportaufbereitenoderabfrage;PROC +kursdatenschnittstelleexportaufbereiten:kurswahlinitialisieren(aktjgst, +gewjgst,gewhj,schuelergruppe,gewsj);kurswahlbasisholen(fstat);IF fstat<>0 +THEN meldungausgeben(meldungserverfehler,einganggewjgst,1);ELIF +letzterschueler""THEN erstelledateimitkennungELSE +erstelledateiohnekennungFI .erstelledateimitkennung:FOR iFROM ersterschueler +UPTO letzterschuelerREP kweintrag:=wahldatenzumindex(i,kzname);pos1:=pos( +kweintrag,trenner)-1;pos2:=pos(kweintrag,trenner,pos1+2)-1;dateieintrag:=text +(kweintrag,pos1);dateieintrag:=text(dateieintrag,30);dateieintragCAT text( +subtext(kweintrag,pos1+2,pos2),15);dateieintragCAT subtext(kweintrag,pos2+2); +kweintrag:=wahldatenzumindex(i,kzkurse);pos1:=1;FOR jFROM 1UPTO length( +kweintrag)DIV kurslaengeREP kurseintrag:=subtext(kweintrag,pos1,pos1+ +kurslaenge-1);dateieintragCAT subtext(kurseintrag,4,5);dateieintragCAT +subtext(kurseintrag,2,3);dateieintragCAT (kurseintragSUB 1);dateieintragCAT +subtext(kurseintrag,6,7);pos1INCR kurslaenge;PER ;put(dswk,dateieintrag);line +(dswk);PER .erstelledateiohnekennung:FOR iFROM ersterschuelerUPTO +letzterschuelerREP kweintrag:=wahldatenzumindex(i,kzname);pos1:=pos(kweintrag +,trenner)-1;pos2:=pos(kweintrag,trenner,pos1+2)-1;dateieintrag:=text( +kweintrag,pos1);dateieintrag:=text(dateieintrag,30);dateieintragCAT text( +subtext(kweintrag,pos1+2,pos2),15);dateieintragCAT subtext(kweintrag,pos2+2); +kweintrag:=wahldatenzumindex(i,kzkurse);pos1:=1;FOR jFROM 1UPTO length( +kweintrag)DIV kurslaengeREP kurseintrag:=subtext(kweintrag,pos1,pos1+ +kurslaenge-1);dateieintragCAT subtext(kurseintrag,4,5);dateieintragCAT +subtext(kurseintrag,2,3);dateieintragCAT (kurseintragSUB 1);dateieintragCAT +leerekennung;pos1INCR kurslaenge;PER ;put(dswk,dateieintrag);line(dswk);PER . +bereitebrdateiauf:forget(aktdateiname+suffixbr,quiet);dsbr:=sequentialfile( +output,aktdateiname+suffixbr).bereitezidateiauf:forget(aktdateiname+suffixzi, +quiet);standardmeldung(meldungbearbwird,aktdateiname+suffixzi+"#");dszi:= +sequentialfile(output,aktdateiname+suffixzi);dateieintrag:=gewsj;dateieintrag +CAT gewjgst;dateieintragCAT gewhj;dateieintragCAT date;dateieintragCAT +"schulis ";dateieintragCAT suffixzieintrag;put(dszi,dateieintrag).END PROC +kursdatenschnittstelleexportaufbereiten;PROC faecherangebotindateischreiben( +BOOL VAR b):INT VAR wstd;IF wert(fnrfangsj)=fasjCAND wert(fnrfanghj)=fahj +CAND wert(fnrfangjgst)=gewjgstCAND dbstatus=okTHEN wstd:=intwert( +fnrfangwochenstd);IF wstd>9THEN wstd:=9FI ;put(dsfa,text(wert(fnrfangfach),2) ++text(wert(fnrfangart),2)+text(wert(fnrfanganzlv),2)+text(wstd));line(dsfa) +ELSE dbstatus(1);b:=FALSE FI .END PROC faecherangebotindateischreiben;PROC +kursdatenschnittstelleexportzeigen:aktdateiname:=standardmaskenfeld( +eingangdateiname);IF aktdateiname=""THEN fehlermeldungfeldfuellenELIF exists( +aktdateiname+suffixfa)THEN zeigdateiELSE fehlermeldungdateifehltFI .END PROC +kursdatenschnittstelleexportzeigen;PROC zeigdatei:zeigedatei(aktdateiname+ +aktsuffix,"vr").END PROC zeigdatei;PROC +kursdatenschnittstelleexportzeigenverlassen:IF aktsuffix=suffixziTHEN +aktsuffix:=suffixfa;enter(2)ELSE IF aktsuffix=suffixfaTHEN aktsuffix:= +suffixwkELIF aktsuffix=suffixwkTHEN aktsuffix:=suffixziFI ;enter(1)FI .END +PROC kursdatenschnittstelleexportzeigenverlassen;PROC +kursdatenschnittstelleexportloeschenabfrage:aktdateiname:=standardmaskenfeld( +eingangdateiname);IF aktdateiname=""THEN fehlermeldungfeldfuellenELIF exists( +aktdateiname+suffixfa)THEN beginlist;t1:=" ";REP getlistentry(t1,t2);IF t1= +aktdateiname+suffixfaTHEN standardmeldung(meldungnameloeschen,t1+ +" (-WK,-BR,-ZI)#"+text(t2,8)+"#");standardnproc;LEAVE +kursdatenschnittstelleexportloeschenabfrageFI ;UNTIL t1=""PER ELSE +fehlermeldungdateifehltFI .END PROC +kursdatenschnittstelleexportloeschenabfrage;PROC +kursdatenschnittstelleexportloeschen:forget(aktdateiname+suffixfa,quiet); +forget(aktdateiname+suffixwk,quiet);forget(aktdateiname+suffixbr,quiet); +forget(aktdateiname+suffixzi,quiet);standardmeldung(meldungdatengeloescht,"") +;return(2).END PROC kursdatenschnittstelleexportloeschen;PROC +kursdatenschnittstelleexportdrucken:aktdateiname:=standardmaskenfeld( +eingangdateiname);IF aktdateiname=""THEN fehlermeldungfeldfuellenELIF exists( +aktdateiname+suffixfa)THEN druckalledateienELSE fehlermeldungdateifehltFI . +druckalledateien:standardmeldung(meldungdrucken,"");print(aktdateiname+ +suffixfa);print(aktdateiname+suffixwk);print(aktdateiname+suffixzi);return(1) +.END PROC kursdatenschnittstelleexportdrucken;PROC +pruefeingabeundbelegvariablen:fstat:=0;eingangrow(einganggewjgst):= +standardmaskenfeld(einganggewjgst);eingangrow(einganggewhj):= +standardmaskenfeld(einganggewhj);eingangrow(eingangaktjgst):= +standardmaskenfeld(eingangaktjgst);eingangrow(eingangaktneue):= +standardmaskenfeld(eingangaktneue);eingangrow(eingangmitkursen):= +standardmaskenfeld(eingangmitkursen);IF aktsj="0000"THEN aktsj:= +schulkenndatum(schuljahr);akthj:=schulkenndatum(halbjahr)FI ;gewjgst:= +eingangrow(einganggewjgst);gewhj:=eingangrow(einganggewhj);aktjgst:= +eingangrow(eingangaktjgst);aktneue:=eingangrow(eingangaktneue);prueffeld2; +prueffeld3;prueffeld4und5;prueffeld4;prueffeld5;IF fstat=0THEN pruefdateiname +FI .prueffeld2:i:=int(gewjgst);IF gewjgst=""THEN meldungausgeben( +meldungfeldfuellen,einganggewjgst,1);LEAVE pruefeingabeundbelegvariablenELIF +i<11COR i>14THEN meldungausgeben(meldungfalschejgst,einganggewjgst,1);LEAVE +pruefeingabeundbelegvariablenFI .prueffeld3:i:=int(gewhj);IF gewhj=""THEN +meldungausgeben(meldungfeldfuellen,einganggewhj,1);LEAVE +pruefeingabeundbelegvariablenELIF i<1COR i>2THEN meldungausgeben( +meldungfalscheshj,einganggewhj,1);LEAVE pruefeingabeundbelegvariablenFI . +prueffeld4und5:IF aktjgst=""CAND aktneue=""THEN meldungausgeben( +meldungpraezisieren,eingangaktjgst,1);LEAVE pruefeingabeundbelegvariablen +ELIF aktjgst=""CAND aktneue<>""THEN schuelergruppe:=kznurneueELIF aktjgst<>"" +CAND aktneue=""THEN schuelergruppe:=kzohneneueELSE schuelergruppe:=kzalleFI . +prueffeld4:i:=int(aktjgst);IF i<10COR i>14THEN meldungausgeben( +meldungfalschejgst,einganggewjgst,1);LEAVE pruefeingabeundbelegvariablenELIF +i>int(gewjgst)THEN meldungausgeben(meldungandereauswahl,einganggewjgst,1); +LEAVE pruefeingabeundbelegvariablenELIF i=int(gewjgst)THEN IF gewhj="1"CAND +akthj="2"THEN meldungausgeben(meldungandereauswahl,einganggewhj,1);LEAVE +pruefeingabeundbelegvariablenFI FI .prueffeld5:i:=int(aktneue);IF aktneue<>"" +CAND aktjgst<>""THEN IF i-1<>int(aktjgst)THEN meldungausgeben( +meldungandereauswahl,eingangaktneue,1)FI ELIF aktneue<>""CAND aktjgst=""THEN +IF i<11COR i>14THEN meldungausgeben(meldungfalschejgst,eingangaktneue,1)ELIF +i+1>int(gewjgst)THEN meldungausgeben(meldungandereauswahl,eingangaktneue,1) +ELIF i-1=int(gewjgst)THEN IF gewhj="1"CAND akthj="2"THEN meldungausgeben( +meldungandereauswahl,einganggewhj,1)FI FI FI .pruefdateiname:aktdateiname:= +standardmaskenfeld(eingangdateiname);IF aktdateiname=""THEN +fehlermeldungfeldfuellenELIF falschercode(aktdateiname)THEN +fehlermeldungnamefalsch(TRUE )FI .END PROC pruefeingabeundbelegvariablen; +BOOL PROC falschercode(TEXT CONST t):INT VAR zeichencode;FOR iFROM 1UPTO +LENGTH t-3REP zeichencode:=code(tSUB i);IF NOT ((zeichencode>=48AND +zeichencode<=57)OR (zeichencode>=65AND zeichencode<=90)OR (zeichencode>=97 +AND zeichencode<=122))THEN LEAVE falschercodeWITH TRUE FI PER ;FALSE END +PROC falschercode;PROC meldungausgeben(INT CONST meldung,gewfeld, +gewruecksprung):fstat:=1;standardmeldung(meldung,"");infeld(gewfeld);return( +gewruecksprung)END PROC meldungausgeben;PROC archivanmelden:aktfeld:=infeld; +archivfehler:=FALSE ;commanddialogue(FALSE );aktdateiname:=standardmaskenfeld +(eingangdateiname);IF aktdateiname=""THEN fehlermeldungfeldfuellenELIF exists +(aktdateiname+suffixfa)THEN meldearchivanELSE fehlermeldungdateifehltFI . +meldearchivan:disablestop;reserve(filemodus,/dos);IF iserrorTHEN archivfehler +:=TRUE ;abbruchnachfehler(1);ELSE enablestopFI .END PROC archivanmelden;PROC +kursdatenschnittstelleexportarchiv(INT CONST wahl):aktfeld:=infeld;SELECT +wahlOF CASE 1:archivinitialisierenCASE 2:archivanmelden;IF archivfehlerTHEN +LEAVE kursdatenschnittstelleexportarchivFI ;archivlistenCASE 3: +archivbeschreibenCASE 4:archivueberschreibenEND SELECT ;infeld(aktfeld). +archivinitialisieren:standardmeldung(meldungwarten,"");disablestop;clear(/dos +);IF iserrorTHEN abbruchnachfehler(2);ELSE enablestop;loeschemeldung;release( +/dos);return(2)FI .archivlisten:standardmeldung(meldungwarten,"");disablestop +;g:=sequentialfile(output,listenname);thes:=ALL /dos;IF iserrorTHEN +abbruchnachfehler(1);ELSE thesaurusaufbereiten;enablestop;zeigedatei( +listenname,"vr");release(/dos)FI .thesaurusaufbereiten:t:=" ";i:=0;REP get( +thes,t,i);putline(g,t)UNTIL t=""PER .archivbeschreiben:standardmeldung( +meldungwarten,"");disablestop;IF exists(aktdateiname+suffixfa,/dos)THEN IF +iserrorTHEN abbruchnachfehler(2);LEAVE kursdatenschnittstelleexportarchiv +ELSE abfragedateiueberschreibenFI ELSE save(aktdateiname+suffixfa,/dos);IF +iserrorTHEN abbruchnachfehler(2);LEAVE kursdatenschnittstelleexportarchiv +ELSE save(aktdateiname+suffixwk,/dos);save(aktdateiname+suffixbr,/dos);save( +aktdateiname+suffixzi,/dos)FI ;enablestop;commanddialogue(TRUE ); +loeschemeldung;release(/dos);return(2)FI .abfragedateiueberschreiben: +standardmeldung(meldungaufdiskschr,aktdateiname+".FA (-WK,-BR,-ZI)#"); +standardnproc.archivueberschreiben:standardmeldung(meldungwarten,""); +disablestop;commanddialogue(FALSE );erase(aktdateiname+suffixfa,/dos);erase( +aktdateiname+suffixwk,/dos);erase(aktdateiname+suffixbr,/dos);erase( +aktdateiname+suffixzi,/dos);IF iserrorTHEN abbruchnachfehler(3);LEAVE +kursdatenschnittstelleexportarchivFI ;save(aktdateiname+suffixfa,/dos);IF +iserrorTHEN abbruchnachfehler(3);LEAVE kursdatenschnittstelleexportarchiv +ELSE save(aktdateiname+suffixwk,/dos);save(aktdateiname+suffixbr,/dos);save( +aktdateiname+suffixzi,/dos)FI ;enablestop;commanddialogue(TRUE ); +loeschemeldung;release(/dos);return(3).END PROC +kursdatenschnittstelleexportarchiv;PROC abbruchnachfehler(INT CONST schritte) +:standardmeldung(meldungrausreichen,"Fehler: "+errormessage+" !#");clearerror +;return(schritte);infeld(aktfeld);release(/dos);commanddialogue(TRUE ); +enablestopEND PROC abbruchnachfehler;PROC kursdatenschnittstelleexportabbruch +(INT CONST schritte):return(schritte);infeld(aktfeld);release(/dos); +commanddialogue(TRUE );enablestopEND PROC kursdatenschnittstelleexportabbruch +;PROC kursdatenschnittstelleexportabfrage(INT CONST wahl):SELECT wahlOF CASE +1:archivanmelden;IF archivfehlerTHEN LEAVE +kursdatenschnittstelleexportabfrageFI ;standardmeldung(meldungdisksichern, +aktdateiname+".FA (-WK,-BR,-ZI)#")CASE 2:archivanmelden;IF archivfehlerTHEN +LEAVE kursdatenschnittstelleexportabfrageFI ;standardmeldung(meldungdiskinit, +"")CASE 3:fragevorbereiten;standardmeldung(meldungnameloeschen,aktdateiname+ +".FA (-WK,-BR,-ZI)#"+text(t2,8)+"#")END SELECT ;standardnproc. +fragevorbereiten:aktdateiname:=standardmaskenfeld(eingangdateiname);IF +aktdateiname=""THEN fehlermeldungnamefalsch(FALSE )ELIF falschercode( +aktdateiname)THEN fehlermeldungnamefalsch(TRUE )FI ;IF exists(aktdateiname+ +suffixfa)THEN beginlist;REP getlistentry(t1,t2);UNTIL t1=aktdateiname+ +suffixfaCOR t1=""PER ;ELSE fehlermeldungdateifehlt;LEAVE +kursdatenschnittstelleexportabfrageFI .END PROC +kursdatenschnittstelleexportabfrage;PROC fehlermeldungdateifehlt:fstat:=1; +standardmeldung(meldungnameunbek,aktdateiname+".FA (-WK,-BR,-ZI)#");infeld( +eingangdateiname);return(1).END PROC fehlermeldungdateifehlt;PROC +fehlermeldungfeldfuellen:meldungausgeben(meldungpraezisieren,eingangdateiname +,1).END PROC fehlermeldungfeldfuellen;PROC fehlermeldungnamefalsch(BOOL +CONST mitfalschemzeichen):IF mitfalschemzeichenTHEN fstat:=1;standardmeldung( +meldungnamefalsch,subtext(aktdateiname,i,i)+"#"+aktdateiname+"#");infeld( +eingangdateiname);return(1)ELSE meldungausgeben(meldungnamefalsch, +eingangdateiname,1)FI END PROC fehlermeldungnamefalsch;PROC +kursdatenschnittstelleexportloescheundreturn(BOOL CONST b):IF bTHEN forget( +listenname,quiet);FI ;loeschemeldung;return(2)END PROC +kursdatenschnittstelleexportloescheundreturn;PROC loeschemeldung:aktfeld:= +infeld;infeld(1);standardfelderausgeben;infeld(aktfeld)END PROC +loeschemeldung;END PACKET kursdatenueberschnittstelleexportieren + diff --git a/app/schulis/2.2.1/src/2.kursdaten importieren b/app/schulis/2.2.1/src/2.kursdaten importieren new file mode 100644 index 0000000..20dd27e --- /dev/null +++ b/app/schulis/2.2.1/src/2.kursdaten importieren @@ -0,0 +1,199 @@ +PACKET kursdatenueberschnittstelleimportierenDEFINES +kursdatenschnittstelleimportanfang, +kursdatenschnittstelleimportaufbereitenfrage, +kursdatenschnittstelleimportaufbereiten, +kursdatenschnittstelleimportloescheundreturn, +kursdatenschnittstelleimportarchiv:LET eingangsmaske= +"ms kurswahldaten importieren",schuljahr="Schuljahr",halbjahr="Schulhalbjahr" +,kuwa2sperre="Kurswahl-2 ",filemodus="file ibm",listenname= +"Liste der Dateien auf der Diskette:",protname="Protokoll zur Übernahme", +schulname="Schulname",schulort="Schulort",leerzeile=" ",ueberschrift1= +"Protokoll zur Übernahme von Kurswahldaten aus Standardschnittstelle der", +ueberschrift2a="Jgst. ",ueberschrift2b=" für das Halbjahr ",ueberschrift2c= +" (Schuljahr ",unterschrift= +"-----------------------------------------------------------------------", +fehlerfall1="Fehler, Schüler nicht in akt. Jgst. : ",fehlerfall2= +"Warnung, neuer Kurs : ",fehlerfall3a= +"Fehler, Planblock nicht übernommen : ",fehlerfall3b= +" Nicht übernommene Daten : ",fehlerfall3c= +" ",fehlerfall4a= +"Fehler, unbekannter Kurs : ",fehlerfall4b= +" in Kurswahl von : ",trenner="�",dos="DOS", +eingangdateiname=2,kurslaengebr=6,kurslaengewk=7,kursendebr=5,kursendewk=6, +kzart="A",kzalle="A",kzplbl="P",kzstd="S",suffixfa=".FA",suffixwk=".WK", +suffixbr=".BR",suffixzi=".ZI",meldungkeineschueler=423,meldunggewhjunzul=405, +meldunggewsjunzul=127,meldunggewjgstunzul=404,meldungparallelanw=425, +meldungbearbwird=352,meldungwarten=69,meldungpraezisieren=129, +meldungserverfehler=416,meldungdatenuebernehmen=433,meldungdatenirrelevant= +432,meldungnamefalsch=323,meldungrausreichen=343,meldungnameunbek=351;INT +VAR i;TEXT VAR t;INT VAR fstat,aktfeld,ermwstd,kurspos,aktpos,aktzeile;TEXT +VAR aktdateiname:="schulis",gewjgst,gewhj,aktjgst,geplsj,geplhj,gewsj,aktsj:= +"0000",akthj,neuewahldaten,aktfake,dateieintrag,aktkurs,neuekurse:=trenner, +fach,kennung,behandeltekurse:=trenner,weitererblock;BOOL VAR archivfehler:= +FALSE ,sperreok:=TRUE ,aktodergeplhj:=FALSE ;THESAURUS VAR thes;FILE VAR dsfa +,dswk,dsbr,dszi,prot,g;PROC kursdatenschnittstelleimportanfang: +standardstartproc(eingangsmaske);infeld(2);standardmaskenfeld(aktdateiname, +eingangdateiname);standardfelderausgeben;standardnproc.END PROC +kursdatenschnittstelleimportanfang;PROC +kursdatenschnittstelleimportaufbereitenfrage:standardmeldung(meldungwarten,"" +);fstat:=0;pruefdateiname;holedateivomarchiv;holedatenfuerabfrage. +holedatenfuerabfrage:toline(dszi,1);readrecord(dszi,dateieintrag);gewsj:=text +(dateieintrag,4);i:=int(gewsj);IF NOT lastconversionokTHEN +fehlermeldungsjunzulaessigFI ;gewhj:=dateieintragSUB 7;IF gewhj<>"1"CAND +gewhj<>"2"THEN fehlermeldunggewhjunzulaessigFI ;gewjgst:=subtext(dateieintrag +,5,6);IF gewjgst<>"10"CAND gewjgst<>"11"CAND gewjgst<>"12"CAND gewjgst<>"13" +THEN fehlermeldunggewjgstunzulaessigFI ;IF aktsj="0000"THEN aktsj:= +schulkenndatum(schuljahr);akthj:=schulkenndatum(halbjahr);geplhj:=akthj; +geplsj:=aktsj;geplanteshjundsjberechnen(geplhj,geplsj)FI ;IF gewsj=aktsjCAND +gewhj=akthjTHEN aktodergeplhj:=TRUE ;aktjgst:=gewjgstELIF gewsj=aktsjCAND +gewhj0THEN meldungausgeben(meldungserverfehler,eingangdateiname, +1);LEAVE kursdatenschnittstelleimportaufbereitenELIF letzterschueler< +ersterschuelerTHEN meldungausgeben(meldungkeineschueler,eingangdateiname,1); +LEAVE kursdatenschnittstelleimportaufbereitenFI ;kurswahlsperresetzen( +kuwa2sperre,sperreok);IF NOT sperreokTHEN meldungausgeben(meldungparallelanw, +eingangdateiname,1);LEAVE kursdatenschnittstelleimportaufbereitenFI ; +neuekurse:=trenner;behandeltekurse:=trenner;bereiteprotokollvor; +uebernehmebrdatei;uebernehmewkdatei;loeschemeldung;kurswahlsperrebeenden( +kuwa2sperre);kurswahlbasissichern;zeigedatei(protname,"vr"). +kurswahlbasissichern:kurswahl0sichern(fstat);kurswahl1sichern(fstat); +kurswahl2sichern(fstat);IF fstat<>0THEN meldungausgeben(meldungserverfehler, +eingangdateiname,1);LEAVE kursdatenschnittstelleimportaufbereitenFI . +bereiteprotokollvor:forget(protname,quiet);prot:=sequentialfile(output, +protname);putline(prot,schulkenndatum(schulname));putline(prot,text( +schulkenndatum(schulort),65)+date);putline(prot,leerzeile);putline(prot, +ueberschrift1);putline(prot,ueberschrift2a+aktjgst+ueberschrift2b+gewjgst+"." ++gewhj+ueberschrift2c+text(gewsj,2)+"/"+subtext(gewsj,3)+"):");putline(prot, +unterschrift);putline(prot,leerzeile).uebernehmebrdatei:bereitek1dateivor; +toline(dsbr,1);col(dsbr,1);WHILE NOT eof(dsbr)REP readrecord(dsbr, +dateieintrag);IF compress(dateieintrag)<>""THEN pruefplanblockundkurse(text( +dateieintrag,3),subtext(dateieintrag,4))FI ;down(dsbr);col(dsbr,1)PER . +bereitek1dateivor:planbloeckeinitialisieren;FOR iFROM 1UPTO 22REP +planblockloeschen(text(i))PER .uebernehmewkdatei:toline(dswk,1);col(dswk,1); +WHILE NOT eof(dswk)REP readrecord(dswk,dateieintrag);pruefschueler(compress( +text(dateieintrag,30)),compress(subtext(dateieintrag,31,45)),subtext( +dateieintrag,46,53),subtext(dateieintrag,54));down(dswk);col(dswk,1)PER .END +PROC kursdatenschnittstelleimportaufbereiten;PROC pruefplanblockundkurse( +TEXT CONST block,kurse):INT VAR blockbez:=int(text(block,2)),laengekurse:= +length(kurse);standardmeldung(meldungbearbwird,"Planblock "+text(block,2)+"#" +);IF blockbez>0CAND blockbez<23THEN tragblockein;tragkurseeinELSE +fehlermeldungblockfalschFI .fehlermeldungblockfalsch:putline(prot, +fehlerfall3a+text(block,2));putline(prot,fehlerfall3b+text(kurse,42));IF +laengekurse>42THEN putline(prot,fehlerfall3c+subtext(kurse,43))FI . +tragblockein:planblockeintragen(text(block,2),text(int(blockSUB 3))). +tragkurseein:kurspos:=1;WHILE kurspos""THEN ermittlewstd;tragkursein; +planbloeckezumkurseintragenmitevtlblockeintrag(aktfake,text(block,2), +weitererblock);behandeltekurseCAT aktfake+trennerELSE +evtlplanbloeckeaktualisierenFI ;kursposINCR kurslaengebrPER .ermittlewstd:IF +pos(neuekurse,trenner+aktfake+trenner)=0THEN aktzeile:=lineno(dsbr);ermwstd:= +int(blockSUB 3);toline(dsbr,aktzeile+1);col(dsbr,1);WHILE NOT eof(dsbr)REP +downety(dsbr,aktkurs);aktpos:=col(dsbr);IF NOT eof(dsbr)CAND ((aktpos-3)MOD 6 +)=1THEN readrecord(dsbr,t);ermwstdINCR int(tSUB 3);weitererblock:=text(t,2); +down(dsbr);col(dsbr,1);neuekurseCAT aktfake+trenner;toline(dsbr,aktzeile); +LEAVE ermittlewstdELSE col(dsbr,aktpos+1)FI ;PER ;neuekurseCAT aktfake+ +trenner;toline(dsbr,aktzeile)FI .evtlplanbloeckeaktualisieren:IF pos( +behandeltekurse,trenner+aktfake+trenner)=0CAND compress(aktfake)<>""THEN +aktzeile:=lineno(dsbr);toline(dsbr,aktzeile+1);col(dsbr,1);WHILE NOT eof(dsbr +)REP downety(dsbr,aktkurs);aktpos:=col(dsbr);IF NOT eof(dsbr)CAND ((aktpos-3) +MOD 6)=1THEN readrecord(dsbr,t);weitererblock:=text(t,2);behandeltekurseCAT +aktfake+trenner;toline(dsbr,aktzeile); +planbloeckezumkurseintragenmitevtlblockeintrag(aktfake,text(block,2), +weitererblock);LEAVE evtlplanbloeckeaktualisierenELSE col(dsbr,aktpos+1)FI ; +PER ;weitererblock:="";planbloeckezumkurseintragenmitevtlblockeintrag(aktfake +,text(block,2),weitererblock);behandeltekurseCAT aktfake+trenner;toline(dsbr, +aktzeile)FI .tragkursein:IF aktodergeplhjTHEN putline(prot,fehlerfall2+text( +aktkurs,2)+" "+text(subtext(aktkurs,5),4)+", Art "+subtext(aktkurs,3,4))FI ; +kurseintragen(text(aktkurs,2),text(subtext(aktkurs,5),4),text(ermwstd), +subtext(aktkurs,3,4)).END PROC pruefplanblockundkurse;PROC +planbloeckezumkurseintragenmitevtlblockeintrag(TEXT CONST kurs,block1,block2) +:TEXT VAR t:=planblockdaten(block1,kzstd);IF dbstatus=1THEN +planblockeintragen(block1,"0")FI ;t:=planblockdaten(block2,kzstd);IF dbstatus +=1THEN planblockeintragen(block2,"0")FI ;planbloeckezumkurseintragen(kurs, +block1,block2)END PROC planbloeckezumkurseintragenmitevtlblockeintrag;PROC +pruefschueler(TEXT CONST famname,rufname,gebdatum,wahldaten):standardmeldung( +meldungbearbwird,famname+", "+rufname+"#");t:=wahldatenzumschueler(famname, +rufname,gebdatum,kzart);IF dbstatus=1THEN fehlermeldungunbekschuelerELSE +tragwahldateneinFI .fehlermeldungunbekschueler:putline(prot,fehlerfall1+text( +famname+", "+rufname+", "+gebdatum,40)).tragwahldatenein: +schuelerwahleintragen(famname,rufname,gebdatum,aufbereitetewahldaten(famname, +rufname,gebdatum,wahldaten)).END PROC pruefschueler;TEXT PROC +aufbereitetewahldaten(TEXT CONST famname,rufname,gebdatum,altewahldaten):INT +VAR wahllaenge:=length(altewahldaten);TEXT VAR planbloecke;kurspos:=1; +neuewahldaten:="";WHILE kurspos=48AND zeichencode<=57)OR (zeichencode>=65AND +zeichencode<=90)OR (zeichencode>=97AND zeichencode<=122))THEN LEAVE +falschercodeWITH TRUE FI PER ;FALSE END PROC falschercode;PROC +meldungausgeben(INT CONST meldung,gewfeld,gewruecksprung):fstat:=1; +standardmeldung(meldung,"");infeld(gewfeld);return(gewruecksprung)END PROC +meldungausgeben;PROC archivanmelden:aktfeld:=infeld;archivfehler:=FALSE ; +commanddialogue(FALSE );disablestop;reserve(filemodus,/dos);IF iserrorTHEN +archivfehler:=TRUE ;abbruchnachfehler(1);ELSE enablestopFI .END PROC +archivanmelden;PROC kursdatenschnittstelleimportarchiv:aktfeld:=infeld; +archivanmelden;IF archivfehlerTHEN LEAVE kursdatenschnittstelleimportarchiv +FI ;archivlisten;infeld(aktfeld).archivlisten:standardmeldung(meldungwarten, +"");disablestop;g:=sequentialfile(output,listenname);thes:=ALL /dos;IF +iserrorTHEN abbruchnachfehler(1);ELSE thesaurusaufbereiten;enablestop; +zeigedatei(listenname,"vr");release(/dos)FI .thesaurusaufbereiten:t:=" ";i:=0 +;REP get(thes,t,i);putline(g,t)UNTIL t=""PER .END PROC +kursdatenschnittstelleimportarchiv;PROC abbruchnachfehler(INT CONST schritte) +:standardmeldung(meldungrausreichen,"Fehler: "+errormessage+" !#");clearerror +;return(schritte);infeld(aktfeld);release(/dos);commanddialogue(TRUE ); +enablestopEND PROC abbruchnachfehler;PROC fehlermeldungdateifehlt:fstat:=1; +standardmeldung(meldungnameunbek,aktdateiname+".FA (-WK,-BR,-ZI)#");infeld( +eingangdateiname);return(1).END PROC fehlermeldungdateifehlt;PROC +fehlermeldungfeldfuellen:meldungausgeben(meldungpraezisieren,eingangdateiname +,1).END PROC fehlermeldungfeldfuellen;PROC fehlermeldungnamefalsch(BOOL +CONST mitfalschemzeichen):IF mitfalschemzeichenTHEN fstat:=1;standardmeldung( +meldungnamefalsch,subtext(aktdateiname,i,i)+"#"+aktdateiname+"#");infeld( +eingangdateiname);return(1)ELSE meldungausgeben(meldungnamefalsch, +eingangdateiname,1)FI END PROC fehlermeldungnamefalsch;PROC +kursdatenschnittstelleimportloescheundreturn:forget(listenname,quiet);forget( +protname,quiet);loeschemeldung;return(3)END PROC +kursdatenschnittstelleimportloescheundreturn;PROC loeschemeldung:aktfeld:= +infeld;infeld(1);standardfelderausgeben;infeld(aktfeld)END PROC +loeschemeldung;END PACKET kursdatenueberschnittstelleimportieren + diff --git a/app/schulis/2.2.1/src/2.kurse auf planbloecke legen b/app/schulis/2.2.1/src/2.kurse auf planbloecke legen new file mode 100644 index 0000000..f23d29c --- /dev/null +++ b/app/schulis/2.2.1/src/2.kurse auf planbloecke legen @@ -0,0 +1,449 @@ +PACKET kurseaufplanbloeckelegenDEFINES kurseaufbloeckestarten, +kurseaufbloeckeinitialisieren,kurseaufbloeckeschemaspeichern, +kurseaufbloeckeschemavorblaettern,kurseaufbloeckeschemaentfernenfrage, +kurseaufbloeckeschemaentfernen,kurseaufbloeckeschemauebernehmenfrage, +kurseaufbloeckeschemauebernehmen,kurseaufbloeckebearbeiten, +kurseaufbloeckeinformationenaufbereiten,kurseaufbloeckerechtehaelftezeigen, +kurseaufbloeckeaenderungenspeichern,kurseaufbloeckeschemaeinteilen, +kurseaufbloecketeilblockabspalten,kurseaufbloecketeilblockentfernen, +kurseaufbloeckeschemanichtweiteraendern,kurseaufbloeckezurueckzumbeginn:LET +maskeeingang="ms kurse auf planbloecke eingang",maskebearb= +"ms kurse auf planbloecke";LET fnrgewjgst=2,fnrhalbjahr=3,fnraktjgst=4, +fnrneuanjgst=5,fnrherkunftjgst=6,fnrherkunfthj=7,fnrmitkursen=8;LET fnrfach=2 +,fnrart=3,fnrwochenstunden=4,fnranzahlschueler=5,fnranzahlkurse=6, +fnrschuelerprokurs=7,fnrausgabefach=8,fnrersterkurs=9,fnrletzterblock=44, +fnrersteblockangabe=45,fnrerstewstd=46,fnrletztewstd=167;LET felderprozeile= +11,felderprokurs=3;LET meldnrspeichern=50,meldnrkeinezahl=53, +meldnrdatenwerdengeprueft=57,meldnrloeschen=61,meldnrnichtloeschen=62, +meldnrnichtspeichern=63,meldnrloeschfrage=65,meldnrbittewarten=69, +meldnrblaetternunmoeglich=72,meldnrbitteangabeergaenzen=129, +meldnrangabenichtsinnvoll=162,meldnruebernehmenfrage=300,meldnruebernehmen= +301,meldnrnichtuebernehmen=303,meldnrfeldleerlassen=390, +meldnrfachartkombinationungueltig=393,meldnrfalschejgstfolge=410, +meldnrfalschebezugsjgst=411,meldnruebernahmeingleicheshj=415, +meldnrkurswahlfehler=416,meldnrdateninbearbeitung=425,meldnrschemagibtsnicht= +426,meldnrschemagibtsschon=427,meldnrblocknichtteilbar=428, +meldnrteilblockentfernen=429,meldnrstundensummmestimmtnicht=430;LET +feldanzmaskeeingang=8;ROW feldanzmaskeeingangTEXT VAR feldbs1;INT VAR +letztecursorfnr:=fnrgewjgst,letztecursorfnrbs2,pruefstatus;INT VAR ifnr;LET +maxblock=22;LET maxtabzeilen=66;LET TABZEILE =STRUCT (TEXT blockbez,TEXT wstd +,INT frei,INT gesamt,TEXT kurse);ROW maxtabzeilenTABZEILE VAR blockzeile;INT +VAR izeile,iblock,erstergezeigterblock,letztergezeigterblock,letzterblock:=1; +BOOL VAR rechtetabellenhaelftezeigen:=FALSE ;INT VAR ikurs;LET maxkurse=7; +TEXT VAR allekursedesblocks,kursbez;INT VAR poskurs;LET laengekurs=6, +laengeallekursangaben=10,laengefach=2,laengeart=2,laengefachartstd=5,incrwstd +=4;LET KURSTAB =STRUCT (TEXT kursname,TEXT blocknr1,TEXT blocknr2);ROW +maxfachkursKURSTAB VAR kurstab;INT VAR ifachkurs;LET maxfachkurs=12;TEXT VAR +angabenzueinemkurs,gefundenerkurs,gefundeneplanbloecke,gefundenerblock1, +gefundenerblock2;INT VAR blockwstd1,blockwstd2;LET jgst10=10,jgst11=11,jgst13 +=13,hj1=1,hj2=2;TEXT VAR aktjgst,gewjgst,gewhalbjahr,neuanjgst,kopiejgst, +kopiehalbjahr,gewschuljahr,aktuelleshalbjahr,fangsj,fanghj;TEXT VAR blocknr, +pruefblockbez;LET posblockkennung=3;LET kennungteilblockb="b";LET kennungwstd +="S",kennungkurse="K",kennungplanbloecke="P";TEXT VAR alleplanblockbez;LET +planblocklaenge=3,laengeblocknr=2;INT VAR posplanblock;TEXT VAR +allekursedesgewhj,allekursedesherkunfthj;TEXT VAR fachartkombinationen:="", +fach,fachart;INT VAR wochenstundenzahl,anzahlschuelermitfachart, +anzahlschuelerprokurs,anzahlkursezufachart;BOOL VAR wstdfelderschutz:=FALSE , +planbloeckemitkursenuebernehmen,kurswahlsperreok;LET kurswahl1="Kurswahl-1 "; +TEXT VAR gewschueler;LET nuraktuelleschueler="O",nurneuangemeldete="N";LET +zeilenprobildschirm=12;INT VAR kurswahlstatus;TEXT VAR ueberschrift;LET +titel1="Kurse blocken für jetzige ",titel2=" in ";LET schulhalbjahr= +"Schulhalbjahr",schuljahr="Schuljahr";initfelderdeseingangsbildschirms;PROC +kurseaufbloeckestarten:standardstartproc(maskeeingang); +wertedeseingangsbildschirmsholen;infeld(fnrgewjgst);standardfelderausgeben; +infeld(letztecursorfnr);standardnprocEND PROC kurseaufbloeckestarten;PROC +kurseaufbloeckeinitialisieren:eingangsbehandlung(1);IF eingangsmaskenfehler +THEN infeld(pruefstatus);return(1)ELSE wertedeseingangsbildschirmsmerken; +kurswahlinitialisieren(aktjgst,gewjgst,gewhalbjahr,gewschueler,gewschuljahr); +kurswahlbasisholen(kurswahlstatus);IF kurswahlstatus<>0THEN +kurswahlfehlerbehandeln;return(1)ELIF alleplanblockbezeichner<>""THEN +standardmeldung(meldnrschemagibtsschon,"");infeld(fnrgewjgst);return(1)ELSE +kurswahlsperresetzen(kurswahl1,kurswahlsperreok);IF NOT kurswahlsperreokTHEN +standardmeldung(meldnrdateninbearbeitung,"");return(1)ELSE wstdfelderschutz:= +FALSE ;blockschemazeigen(1);infeld(fnrerstewstd);standardnprocFI FI FI .END +PROC kurseaufbloeckeinitialisieren;PROC kurswahlfehlerbehandeln: +standardmeldung(meldnrkurswahlfehler,"");pause(10)END PROC +kurswahlfehlerbehandeln;PROC kurseaufbloeckezurueckzumbeginn(INT CONST stufen +):kurswahlsperrebeenden(kurswahl1);enter(stufen)END PROC +kurseaufbloeckezurueckzumbeginn;PROC blockschemazeigen(INT CONST art): +standardstartproc(maskebearb);ueberschriftaufbereiten; +standardkopfmaskeaktualisieren(ueberschrift);eingabefeldersperren(fnrfach, +fnrart);zusatzfelderinitialisieren;IF art=1THEN blockschemainitialisieren +ELSE blockschemafuellenFI ;rechtetabellenhaelftezeigen:=FALSE ; +blockschemaausgebenab(1);infeld(fnrfach);standardfelderausgeben. +ueberschriftaufbereiten:IF art=1THEN ueberschrift:=titel1;ueberschriftCAT +aktjgst;ueberschriftCAT titel2;ELIF art=2THEN ueberschrift:=text( +vergleichsknoten);ueberschriftCAT " für ";ELIF art=3THEN IF +planbloeckemitkursenuebernehmenTHEN ueberschrift:=text(vergleichsknoten)ELSE +ueberschrift:="Blockschema ohne Kurse übernehmen"FI ;ueberschriftCAT +" für "FI ;ueberschriftCAT gewjgst;ueberschriftCAT ".";ueberschriftCAT +gewhalbjahr;ueberschriftCAT " ";ueberschriftCAT subtext(gewschuljahr,1,2); +ueberschriftCAT "/";ueberschriftCAT subtext(gewschuljahr,3,4). +zusatzfelderinitialisieren:FOR ifnrFROM fnrfachUPTO fnrersteblockangabe-1REP +standardmaskenfeld("",ifnr)PER .blockschemainitialisieren:FOR iblockFROM 1 +UPTO maxtabzeilenREP IF iblock>maxblockTHEN blockzeile(iblock).blockbez:="" +ELSE blockzeile(iblock).blockbez:=textzweistellig(iblock)+" "FI ;blockzeile( +iblock).wstd:="0";blockzeile(iblock).frei:=0;blockzeile(iblock).gesamt:=0; +blockzeile(iblock).kurse:=""PER ;letzterblock:=maxblock.END PROC +blockschemazeigen;PROC blockschemafuellen:alleplanblockbez:= +alleplanblockbezeichner;iblock:=0;posplanblock:=1;WHILE posplanblock0THEN standardmeldung( +meldnrkeinezahl,"");blockschemaausgebenab(pruefstatus);infeld( +fnrersteblockangabe);standardfelderausgeben;infeld(fnrerstewstd);return(1) +ELSE standardmeldung(meldnrspeichern,"");wochenstundenspeichern; +kurswahl1sichern(kurswahlstatus);kurswahlsperrebeenden(kurswahl1);enter(2)FI +ELSE standardmeldung(meldnrnichtspeichern,"");kurswahlsperrebeenden(kurswahl1 +);enter(2)FI .allewochenstundenangabenpruefen:INT VAR testint;iblock:=1; +WHILE iblock<=letzterblockAND pruefstatus=0REP testint:=int(blockzeile(iblock +).wstd);IF NOT lastconversionokTHEN pruefstatus:=iblockFI ;iblockINCR 1PER . +wochenstundenspeichern:FOR iblockFROM 1UPTO letzterblockREP +planblockeintragen(blockzeile(iblock).blockbez,blockzeile(iblock).wstd)PER . +END PROC kurseaufbloeckeschemaspeichern;PROC eingetragenewochenstundenmerken: +ifnr:=fnrerstewstd;iblock:=erstergezeigterblock;FOR izeileFROM 1UPTO +zeilenprobildschirmREP blockzeile(iblock).wstd:=standardmaskenfeld(ifnr);ifnr +INCR felderprozeile;iblockINCR 1UNTIL iblock>letzterblockPER END PROC +eingetragenewochenstundenmerken;PROC kurseaufbloeckeschemavorblaettern(BOOL +CONST vorwaerts):letztecursorfnrbs2:=infeld;IF letztecursorfnrbs2>= +fnrerstewstdTHEN letztecursorfnrbs2:=fnrerstewstdFI ;IF vorwaertsTHEN IF +letztergezeigterblock=letzterblockTHEN standardmeldung( +meldnrblaetternunmoeglich,"")ELSE eingetragenewochenstundenmerken; +blockschemaausgebenab(letztergezeigterblock+1);infeld(fnrersteblockangabe); +standardfelderausgeben;infeld(letztecursorfnrbs2)FI ELSE IF +erstergezeigterblock=1THEN standardmeldung(meldnrblaetternunmoeglich,"")ELSE +eingetragenewochenstundenmerken;IF erstergezeigterblock>zeilenprobildschirm +THEN blockschemaausgebenab(erstergezeigterblock-zeilenprobildschirm)ELSE +blockschemaausgebenab(1)FI ;infeld(fnrersteblockangabe); +standardfelderausgeben;infeld(letztecursorfnrbs2)FI FI ;return(1)END PROC +kurseaufbloeckeschemavorblaettern;PROC kurseaufbloeckeschemaentfernenfrage: +eingangsbehandlung(2);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return( +1)ELSE wertedeseingangsbildschirmsmerken;kurswahlinitialisieren(aktjgst, +gewjgst,gewhalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen( +kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1) +ELIF alleplanblockbezeichner<>""THEN kurswahlsperresetzen(kurswahl1, +kurswahlsperreok);IF NOT kurswahlsperreokTHEN standardmeldung( +meldnrdateninbearbeitung,"");return(1)ELSE wstdfelderschutz:=TRUE ; +blockschemazeigen(2);standardmeldung(meldnrloeschfrage,"");feldfrei(fnrfach); +infeld(fnrfach);standardnprocFI ELSE standardmeldung(meldnrschemagibtsnicht, +"");infeld(fnrgewjgst);return(1)FI FI .END PROC +kurseaufbloeckeschemaentfernenfrage;PROC kurseaufbloeckeschemaentfernen(BOOL +CONST entfernen):IF entfernenTHEN standardmeldung(meldnrloeschen,""); +planbloeckeinitialisierenELSE standardmeldung(meldnrnichtloeschen,"")FI ; +kurswahlsperrebeenden(kurswahl1);enter(2)END PROC +kurseaufbloeckeschemaentfernen;PROC kurseaufbloeckeschemauebernehmenfrage: +eingangsbehandlung(3);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return( +1)ELSE wertedeseingangsbildschirmsmerken;kurswahlinitialisieren(aktjgst, +gewjgst,gewhalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen( +kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1) +ELIF alleplanblockbezeichner<>""THEN standardmeldung(meldnrschemagibtsschon, +"");infeld(fnrgewjgst);return(1)ELSE IF planbloeckemitkursenuebernehmenTHEN +allekursedesgewhj:=allekurseFI ;TEXT VAR gewschuljahrsave:=gewschuljahr; +kopiejgst:=standardmaskenfeld(fnrherkunftjgst);kopiehalbjahr:= +standardmaskenfeld(fnrherkunfthj);kurswahlinitialisieren(aktjgst,kopiejgst, +kopiehalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen(kurswahlstatus); +IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)ELIF +alleplanblockbezeichner<>""THEN wstdfelderschutz:=TRUE ;gewschuljahr:= +gewschuljahrsave;blockschemazeigen(3);standardmeldung(meldnruebernehmenfrage, +"");feldfrei(fnrfach);infeld(fnrfach);standardnprocELSE standardmeldung( +meldnrschemagibtsnicht,"");infeld(fnrherkunftjgst);return(1)FI FI FI END +PROC kurseaufbloeckeschemauebernehmenfrage;PROC +kurseaufbloeckeschemauebernehmen(BOOL CONST uebernehmen):IF uebernehmenTHEN +standardmeldung(meldnruebernehmen,"");IF planbloeckemitkursenuebernehmenCAND +allekursedesgewhj=""THEN allekursedesherkunfthj:=allekurseFI ; +kurswahlinitialisieren(aktjgst,gewjgst,gewhalbjahr,gewschueler,gewschuljahr); +kurswahlbasisholen(kurswahlstatus);kurswahlsperresetzen(kurswahl1, +kurswahlsperreok);IF NOT kurswahlsperreokTHEN standardmeldung( +meldnrdateninbearbeitung,"");return(1)ELSE +evtlkurseundplanblockschemauebernahmedurchfuehren;kurswahl0sichern( +kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln; +kurswahlsperrebeenden(kurswahl1);return(1)ELSE kurswahl1sichern( +kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln; +kurswahlsperrebeenden(kurswahl1);return(1)ELSE kurswahlsperrebeenden( +kurswahl1);enter(2)FI FI FI ELSE standardmeldung(meldnrnichtuebernehmen,""); +enter(2)FI .allekursealskursedesgewhjeintragen:poskurs:=1;WHILE poskurs<= +length(allekursedesherkunfthj)REP kurseintragen(kursfach,kurskennung,kurswstd +,kursart);poskursINCR laengeallekursangabenPER .kursfach:subtext( +allekursedesherkunfthj,poskurs,poskurs+1).kurskennung:compress(subtext( +allekursedesherkunfthj,poskurs+2,poskurs+5)).kurswstd:subtext( +allekursedesherkunfthj,poskurs+6,poskurs+7).kursart:subtext( +allekursedesherkunfthj,poskurs+8,poskurs+9). +evtlkurseundplanblockschemauebernahmedurchfuehren:IF +planbloeckemitkursenuebernehmenCAND allekursedesgewhj=""THEN +allekursealskursedesgewhjeintragen;allekursedesgewhj:=allekursedesherkunfthj +FI ;FOR iblockFROM 1UPTO letzterblockREP planblockeintragen(blockzeile(iblock +).blockbez,blockzeile(iblock).wstd);IF planbloeckemitkursenuebernehmenTHEN +allekursedesblocks:=blockzeile(iblock).kurse;poskurs:=1;WHILE poskurs<=length +(allekursedesblocks)REP kursbez:=subtext(allekursedesblocks,poskurs,poskurs+ +laengekurs-1);IF suchpos(allekursedesgewhj,kursbez,laengeallekursangaben)>0 +THEN kurszumplanblockeintragen(compress(kursbez),blockzeile(iblock).blockbez) +FI ;poskursINCR laengekursPER ;FI PER .END PROC +kurseaufbloeckeschemauebernehmen;PROC kurseaufbloeckebearbeiten: +eingangsbehandlung(2);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return( +1)ELSE wertedeseingangsbildschirmsmerken;kurswahlinitialisieren(aktjgst, +gewjgst,gewhalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen( +kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1) +ELIF alleplanblockbezeichner<>""THEN kurswahlsperresetzen(kurswahl1, +kurswahlsperreok);IF NOT kurswahlsperreokTHEN standardmeldung( +meldnrdateninbearbeitung,"");return(1)ELSE wstdfelderschutz:=TRUE ; +blockschemazeigen(2);feldfrei(fnrfach);feldfrei(fnrart);infeld(fnrfach); +standardnprocFI ELSE standardmeldung(meldnrschemagibtsnicht,"");infeld( +fnrgewjgst);return(1)FI FI END PROC kurseaufbloeckebearbeiten;PROC +kurseaufbloeckeinformationenaufbereiten:fach:=text(standardmaskenfeld(fnrfach +),laengefach);fachart:=text(standardmaskenfeld(fnrart),laengeart);IF +gueltigefachartkombination(fach,fachart,wochenstundenzahl)THEN kurswahl2holen +(kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1) +ELSE informationenwirklichaufbereiten;standardnprocFI ELSE standardmeldung( +meldnrfachartkombinationungueltig,"");return(1)FI . +informationenwirklichaufbereiten:feldschutzfuerinfosetzen;standardmaskenfeld( +fach,fnrausgabefach);anzahlschuelermitfachart:=anzahlschuelermitwahl(fach,"", +fachart,"");standardmaskenfeld(text(anzahlschuelermitfachart), +fnranzahlschueler);standardmaskenfeld(text(wochenstundenzahl), +fnrwochenstunden);kursezufachundartbestimmen;standardmaskenfeld(text( +anzahlkursezufachart),fnranzahlkurse);IF anzahlkursezufachart>0THEN +anzahlschuelerprokurs:=anzahlschuelermitfachartDIV anzahlkursezufachart; +standardmaskenfeld(text(anzahlschuelerprokurs),fnrschuelerprokurs)ELSE +standardmaskenfeld(" ",fnrschuelerprokurs)FI ;iblock:=0;posplanblock:=1; +WHILE posplanblock"" +THEN standardmaskenfeld(compress(gefundenerkurs),ifnr);standardmaskenfeld( +compress(gefundenerblock1),ifnr+1);standardmaskenfeld(compress( +gefundenerblock2),ifnr+2);anzahlkursezufachartINCR 1ELSE standardmaskenfeld( +"",ifnr);standardmaskenfeld("",ifnr+1);standardmaskenfeld("",ifnr+2)FI ; +kurstab(ifachkurs).kursname:=standardmaskenfeld(ifnr);kurstab(ifachkurs). +blocknr1:=standardmaskenfeld(ifnr+1);kurstab(ifachkurs).blocknr2:= +standardmaskenfeld(ifnr+2);ifnrINCR felderprokursPER . +suchegewuenschtenkursinkursendeshj:gefundenerkurs:="";WHILE poskurs<=length( +allekursedesgewhj)REP angabenzueinemkurs:=subtext(allekursedesgewhj,poskurs, +poskurs+laengeallekursangaben-1);IF subtext(angabenzueinemkurs,1,2)=fachCAND +subtext(angabenzueinemkurs,9,10)=fachartTHEN gefundenerkurs:=subtext( +angabenzueinemkurs,1,6);gefundeneplanbloecke:=kursdaten(gefundenerkurs, +kennungplanbloecke);gefundenerblock1:=subtext(gefundeneplanbloecke,1,3); +gefundenerblock2:=subtext(gefundeneplanbloecke,4,6);gefundenerkurs:=subtext( +gefundenerkurs,3)FI ;poskursINCR laengeallekursangabenUNTIL gefundenerkurs<> +""PER .END PROC kurseaufbloeckeinformationenaufbereiten;BOOL PROC +gueltigefachartkombination(TEXT CONST prueffach,pruefart,INT VAR +auswochenstundenzahl):INT VAR postreffer;IF fachartkombinationen=""THEN +standardmeldung(meldnrbittewarten,"");holeallefachartkombinationenFI ; +postreffer:=suchpos(fachartkombinationen,prueffach+pruefart,laengefachartstd) +;IF postreffer=0THEN FALSE ELSE auswochenstundenzahl:=int( +fachartkombinationenSUB (postreffer+incrwstd));TRUE FI . +holeallefachartkombinationen:TEXT VAR aktuellesschuljahr:=schulkenndatum( +schuljahr);inittupel(dnrfaecherangebot);fanghj:=aktuelleshalbjahr;fangsj:= +aktuellesschuljahr;IF NOT (gewhalbjahr=aktuelleshalbjahrAND gewschuljahr= +aktuellesschuljahr)THEN geplanteshjundsjberechnen(fanghj,fangsj)FI ;putwert( +fnrfangsj,fangsj);putwert(fnrfanghj,fanghj);putwert(fnrfangjgst,gewjgst); +search(dnrfaecherangebot,FALSE );statleseschleife(dnrfaecherangebot,fangsj, +fanghj,fnrfangsj,fnrfanghj,PROC fanglesen)END PROC gueltigefachartkombination +;PROC fanglesen(BOOL VAR b):IF dbstatus=0AND wert(fnrfangsj)=fangsjAND wert( +fnrfanghj)=fanghjAND wert(fnrfangjgst)=gewjgstTHEN fachartkombinationenCAT +text(wert(fnrfangfach),laengefach);fachartkombinationenCAT text(wert( +fnrfangart),laengeart);fachartkombinationenCAT text(wert(fnrfangwochenstd),1) +ELSE b:=TRUE FI END PROC fanglesen;PROC kurseaufbloeckerechtehaelftezeigen( +BOOL CONST rechts):rechtetabellenhaelftezeigen:=rechts;letztecursorfnrbs2:= +infeld;blockschemaausgebenab(erstergezeigterblock);infeld(fnrersteblockangabe +);standardfelderausgeben;infeld(letztecursorfnrbs2);return(1)END PROC +kurseaufbloeckerechtehaelftezeigen;PROC kurseaufbloeckeaenderungenspeichern( +BOOL CONST speichern):IF speichernTHEN kurszuordnungenpruefen;IF pruefstatus> +0THEN infeld(pruefstatus);return(1)ELSE kurszuordnungenspeichern; +kurswahl0sichern(kurswahlstatus);IF kurswahlstatus<>0THEN +kurswahlfehlerbehandeln;return(1)ELSE kurswahl1sichern(kurswahlstatus);IF +kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)ELSE +zurueckzumbearbeitungsanfangFI FI ;FI ;ELSE standardmeldung( +meldnrnichtspeichern,"");zurueckzumbearbeitungsanfangFI . +kurszuordnungenpruefen:standardmeldung(meldnrdatenwerdengeprueft,""); +pruefstatus:=0;ifnr:=fnrersterkurs;WHILE ifnr""OR standardmaskenfeld(ifnr+ +2)<>"")THEN pruefstatus:=ifnr;standardmeldung(meldnrbitteangabeergaenzen,""); +LEAVE kurszuordnungenpruefenFI ;pruefblockbez:=standardmaskenfeld(ifnr+1);IF +ungueltigepruefblockbezTHEN pruefstatus:=ifnr+1;standardmeldung( +meldnrangabenichtsinnvoll,"");LEAVE kurszuordnungenpruefenFI ;pruefblockbez:= +standardmaskenfeld(ifnr+2);IF ungueltigepruefblockbezTHEN pruefstatus:=ifnr+2 +;standardmeldung(meldnrangabenichtsinnvoll,"");LEAVE kurszuordnungenpruefen +FI ;ifnrINCR felderprokursPER .ungueltigepruefblockbez:pruefblockbez<>""AND ( +suchpos(alleplanblockbez,pruefblockbez,planblocklaenge)=0COR length(compress( +pruefblockbez))""THEN WHILE ifnrpruef> +fnrersterkursREP ifnrpruefDECR felderprokurs;IF kursbez=compress( +standardmaskenfeld(ifnrpruef))THEN LEAVE kursbezdoppeltangegebenWITH TRUE FI +;PER ;FI ;FALSE .kurszuordnungenspeichern:TEXT VAR kompkursbez; +standardmeldung(meldnrspeichern,"");ifnr:=fnrersterkurs;ifachkurs:=1;WHILE +ifnr""THEN IF kurstab(ifachkurs).kursname=""THEN kursneuaufnehmen +ELSE kursevtlueberschreibenFI ELSE IF kurstab(ifachkurs).kursname<>""THEN +kursentfernenFI FI ;ifachkursINCR 1;ifnrINCR felderprokursPER . +kursevtlueberschreiben:IF kompkursbez=kurstab(ifachkurs).kursnameTHEN kursbez +:=standardmaskenfeld(fnrausgabefach);kursbezCAT kompkursbez; +planbloeckezumkurseintragen(kursbez,standardmaskenfeld(ifnr+1), +standardmaskenfeld(ifnr+2))ELSE kursentfernen;kursneuaufnehmenFI . +kursneuaufnehmen:kursbez:=standardmaskenfeld(fnrausgabefach);kursbezCAT +kompkursbez;kurseintragen(standardmaskenfeld(fnrausgabefach),kompkursbez, +standardmaskenfeld(fnrwochenstunden),standardmaskenfeld(fnrart)); +planbloeckezumkurseintragen(kursbez,standardmaskenfeld(ifnr+1), +standardmaskenfeld(ifnr+2)).kursentfernen:kursbez:=standardmaskenfeld( +fnrausgabefach);kursbezCAT kurstab(ifachkurs).kursname;kursloeschen(fach, +kurstab(ifachkurs).kursname).zurueckzumbearbeitungsanfang:wstdfelderschutz:= +TRUE ;IF speichernTHEN blockschemaneufuellen;blockschemaausgebenab(1)FI ; +eingabefeldersperren(fnrersterkurs,fnrletzterblock);feldfrei(fnrfach); +feldfrei(fnrart);FOR ifnrFROM fnrwochenstundenUPTO fnrletzterblockREP +standardmaskenfeld("",ifnr)PER ;infeld(fnrfach);return(2). +blockschemaneufuellen:iblock:=0;posplanblock:=1;WHILE posplanblock" "THEN standardmeldung(meldnrblocknichtteilbar,"")ELIF +text(blocknr,2)=naechsteblocknummerTHEN standardmeldung( +meldnrblocknichtteilbar,"")ELIF standardmaskenfeld(ifnr)<"0"OR +standardmaskenfeld(ifnr)>blockzeile(iblock).wstdTHEN standardmeldung( +meldnrangabenichtsinnvoll,"")ELSE teilblockabspaltendurchfuehrenFI ;return(1) +.naechsteblocknummer:IF iblock=letzterblockTHEN ""ELSE text(blockzeile(iblock ++1).blockbez,2)FI .teilblockabspaltendurchfuehren:blockwstd1:=int( +standardmaskenfeld(ifnr));blockwstd2:=int(blockzeile(iblock).wstd)-blockwstd1 +;planblockteilen(text(blocknr,2),text(blockwstd1),text(blockwstd2)); +kurswahl1sichern(kurswahlstatus);IF kurswahlstatus<>0THEN +kurswahlfehlerbehandelnELSE erstergezeigterblock:=iblock;blockschemafuellen; +blockschemaausgebenab(erstergezeigterblock);infeld(fnrersteblockangabe); +standardfelderausgeben;infeld(fnrerstewstd)FI END PROC +kurseaufbloecketeilblockabspalten;PROC iblockbestimmen:iblock:= +erstergezeigterblock+incrblock.incrblock:(ifnr-fnrerstewstd)DIV +felderprozeileEND PROC iblockbestimmen;PROC kurseaufbloecketeilblockentfernen +:ifnr:=infeld;blocknr:=standardmaskenfeld(ifnr-1);IF (blocknrSUB +posblockkennung)<>" "THEN standardmeldung(meldnrteilblockentfernen,"")ELSE +iblockbestimmen;IF teilbloeckevorhandenTHEN IF teilblockkurseidentischTHEN +allekursedesblocks:=blockzeile(iblock+1).kurse;planblockloeschen(blockzeile( +iblock+1).blockbez);planblockloeschen(blockzeile(iblock+2).blockbez); +allekurseinblocknreintragen;kurswahl1sichern(kurswahlstatus);IF +kurswahlstatus<>0THEN kurswahlfehlerbehandelnELSE blockschemafuellen; +blockschemaausgebenab(erstergezeigterblock);infeld(fnrersteblockangabe); +standardfelderausgeben;infeld(fnrerstewstd)FI ELSE standardmeldung( +meldnrteilblockentfernen,"")FI ELSE standardmeldung(meldnrteilblockentfernen, +"")FI FI ;return(1).teilbloeckevorhanden:text(blocknr,laengeblocknr)= +naechsteblocknummer.naechsteblocknummer:IF iblock=letzterblockTHEN ""ELSE +text(blockzeile(iblock+1).blockbez,laengeblocknr)FI .teilblockkurseidentisch: +blockzeile(iblock+1).kurse=blockzeile(iblock+2).kurse. +allekurseinblocknreintragen:poskurs:=1;WHILE poskurs<=length( +allekursedesblocks)REP kursbez:=subtext(allekursedesblocks,poskurs,poskurs+ +laengekurs-1);kurszumplanblockeintragen(kursbez,blocknr);poskursINCR +laengekursPER .END PROC kurseaufbloecketeilblockentfernen;PROC +kurseaufbloeckeschemanichtweiteraendern:INT VAR meldnrfehler; +eingetragenewochenstundenmerken;pruefstatus:=0; +allewochenstundenangabenpruefen;IF pruefstatus<>0THEN standardmeldung( +meldnrfehler,"");blockschemaausgebenab(pruefstatus);infeld( +fnrersteblockangabe);standardfelderausgeben;infeld(fnrerstewstd);return(1) +ELSE standardmeldung(meldnrspeichern,"");wochenstundenspeichern; +kurswahl1sichern(kurswahlstatus);feldfrei(fnrfach);feldfrei(fnrart); +wstdfelderschutz:=TRUE ;eingabefeldersperren(fnrerstewstd,fnrletztewstd, +felderprozeile);infeld(fnrfach);return(2)FI .allewochenstundenangabenpruefen: +INT VAR testint;iblock:=1;WHILE iblock<=letzterblockAND pruefstatus=0REP +testint:=int(blockzeile(iblock).wstd);IF NOT lastconversionokTHEN pruefstatus +:=iblock;meldnrfehler:=meldnrkeinezahlELIF ((blockzeile(iblock).blockbez)SUB +posblockkennung)=kennungteilblockbTHEN IF int(blockzeile(iblock-2).wstd)<>int +(blockzeile(iblock-1).wstd)+int(blockzeile(iblock).wstd)THEN pruefstatus:= +iblock-2;meldnrfehler:=meldnrstundensummmestimmtnichtFI FI ;iblockINCR 1PER . +wochenstundenspeichern:FOR iblockFROM 1UPTO letzterblockREP +planblockeintragen(blockzeile(iblock).blockbez,blockzeile(iblock).wstd)PER . +END PROC kurseaufbloeckeschemanichtweiteraendern;PROC eingangsbehandlung(INT +CONST art):pruefstatus:=0;aktjgst:=standardmaskenfeld(fnraktjgst);gewhalbjahr +:=standardmaskenfeld(fnrhalbjahr);gewjgst:=standardmaskenfeld(fnrgewjgst); +neuanjgst:=standardmaskenfeld(fnrneuanjgst);kopiehalbjahr:=standardmaskenfeld +(fnrherkunfthj);kopiejgst:=standardmaskenfeld(fnrherkunftjgst); +aktuelleshalbjahr:=schulkenndatum(schulhalbjahr);allgemeinefelderpruefen;IF +pruefstatus=0THEN IF art=1OR art=2THEN bearbeitungfelderpruefenELIF art=3 +THEN uebernahmefelderpruefen;planbloeckemitkursenuebernehmen:= +standardmaskenfeld(fnrmitkursen)<>""FI FI .allgemeinefelderpruefen: +standardpruefe(3,fnrgewjgst,jgst11,jgst13,"",pruefstatus);IF pruefstatus>0 +THEN LEAVE allgemeinefelderpruefenFI ;standardpruefe(3,fnrhalbjahr,hj1,hj2,"" +,pruefstatus);IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;IF +aktjgst<>""THEN IF int(aktuelleshalbjahr)=hj2THEN standardpruefe(3,fnraktjgst +,jgst10,jgst13,"",pruefstatus)ELSE standardpruefe(3,fnraktjgst,jgst11,jgst13, +"",pruefstatus)FI ;IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;FI ; +IF neuanjgst<>""THEN standardpruefe(3,fnrneuanjgst,jgst11,jgst13,"", +pruefstatus);IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;FI ;IF +aktjgst<>""THEN IF neuanjgst<>""THEN IF int(neuanjgst)<>int(aktjgst)+1THEN +standardmeldung(meldnrfalschejgstfolge,"");pruefstatus:=fnraktjgst;LEAVE +allgemeinefelderpruefenFI ;gewschueler:=""ELSE gewschueler:= +nuraktuelleschuelerFI ELIF neuanjgst=""THEN standardmeldung( +meldnrbitteangabeergaenzen,"");pruefstatus:=fnraktjgst;LEAVE +allgemeinefelderpruefenELSE gewschueler:=nurneuangemeldete;aktjgst:=text(int( +neuanjgst)-1)FI ;IF aktjgst>gewjgstCOR (aktjgst=gewjgstAND aktuelleshalbjahr> +gewhalbjahr)THEN standardmeldung(meldnrfalschebezugsjgst,"");pruefstatus:= +fnrgewjgst;LEAVE allgemeinefelderpruefenFI .bearbeitungfelderpruefen:IF +standardmaskenfeld(fnrherkunftjgst)<>""THEN standardmeldung( +meldnrfeldleerlassen,"");pruefstatus:=fnrherkunftjgst;LEAVE +bearbeitungfelderpruefenFI ;IF standardmaskenfeld(fnrherkunfthj)<>""THEN +standardmeldung(meldnrfeldleerlassen,"");pruefstatus:=fnrherkunfthj;LEAVE +bearbeitungfelderpruefenFI ;IF standardmaskenfeld(fnrmitkursen)<>""THEN +standardmeldung(meldnrfeldleerlassen,"");pruefstatus:=fnrmitkursen;LEAVE +bearbeitungfelderpruefenFI .uebernahmefelderpruefen:standardpruefe(3, +fnrherkunftjgst,jgst11,jgst13,"",pruefstatus);IF pruefstatus>0THEN LEAVE +uebernahmefelderpruefenFI ;standardpruefe(3,fnrherkunfthj,hj1,hj2,"", +pruefstatus);IF pruefstatus>0THEN LEAVE uebernahmefelderpruefenFI ;IF gewjgst +=kopiejgstCAND gewhalbjahr=kopiehalbjahrTHEN pruefstatus:=fnrgewjgst; +standardmeldung(meldnruebernahmeingleicheshj,"");LEAVE +uebernahmefelderpruefenFI ;END PROC eingangsbehandlung;BOOL PROC +eingangsmaskenfehler:pruefstatus<>0END PROC eingangsmaskenfehler;INT PROC +suchpos(TEXT CONST quelle,suchtext,INT CONST laenge):INT VAR findpos:=pos( +quelle,suchtext);WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE suchpos +WITH findposELSE findpos:=pos(quelle,suchtext,findpos+1);FI PER ;findposEND +PROC suchpos;PROC eingabefeldersperren(INT CONST von,bis): +eingabefeldersperren(von,bis,1)END PROC eingabefeldersperren;PROC +eingabefeldersperren(INT CONST von,bis,abstand):INT VAR ifnr:=von;WHILE ifnr +<=bisREP feldschutz(ifnr);ifnrINCR abstandPER END PROC eingabefeldersperren; +PROC eingabefelderoeffnen(INT CONST von,bis):eingabefelderoeffnen(von,bis,1) +END PROC eingabefelderoeffnen;PROC eingabefelderoeffnen(INT CONST von,bis, +abstand):INT VAR ifnr:=von;WHILE ifnr<=bisREP feldfrei(ifnr);ifnrINCR abstand +PER END PROC eingabefelderoeffnen;PROC initfelderdeseingangsbildschirms:INT +VAR i;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1(i):=""PER END PROC +initfelderdeseingangsbildschirms;PROC wertedeseingangsbildschirmsmerken:INT +VAR i;letztecursorfnr:=infeld;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1( +i):=standardmaskenfeld(i)PER END PROC wertedeseingangsbildschirmsmerken;PROC +wertedeseingangsbildschirmsholen:INT VAR i;FOR iFROM 1UPTO +feldanzmaskeeingangREP standardmaskenfeld(feldbs1(i),i)PER END PROC +wertedeseingangsbildschirmsholen;TEXT PROC textzweistellig(INT CONST i):IF i< +10THEN "0"+text(i)ELSE text(i)FI END PROC textzweistellig;END PACKET +kurseaufplanbloeckelegen + diff --git a/app/schulis/2.2.1/src/2.kurswahl schnittstelle b/app/schulis/2.2.1/src/2.kurswahl schnittstelle new file mode 100644 index 0000000..2b29d36 --- /dev/null +++ b/app/schulis/2.2.1/src/2.kurswahl schnittstelle @@ -0,0 +1,664 @@ +PACKET kurswahlschnittstelle240791DEFINES kurswahlinitialisieren, +kurswahlbasisholen,erweitertekurswahlbasisholen,istkurswahlbasisvorhanden, +kurswahldatenvorhanden,kurswahl0holen,kurswahl1holen,kurswahl2holen, +kurswahl0sichern,kurswahl1sichern,kurswahl2sichern,kurswahlsperresetzen, +kurswahlsperrebeenden,kurseintragen,kursloeschen,planblockeintragen, +planblockteilen,planblockloeschen,planbloeckezumkurseintragen, +planbloeckeinitialisieren,kurszumplanblockeintragen,schuelerwahleintragen, +schuelerwahlaendern,ersterschueler,letzterschueler,wahldatenzumindex, +wahldatenzumschueler,weiterewahldatenzumschueler,kursdaten,allekurse, +alleplanblockbezeichner,planblockdaten,anzahlschuelermitwahl,schuelermitwahl, +anzahlfreierschuelerimplanblock,schuelerinplanblock,schuelerundklausur:LET +namezwischendatei="Hj-Daten",meldungneuebasis=377;LET maxkuwa1zeilen=66, +laengekurseintrag=15,laengeblockwstd=4,laengeblock=3,laengekurs=6,laengefach= +2,laengekennung=4,laengeart=2,laengewstd=2,laengeklausur=1,server= +"kurswahl server",kennungtplbl1="a",kennungtplbl2="b",leereplanbloecke= +" ",leererblock=" ",leerekennung=" ",leereart=" ",stat1="ls",stat2 +="n11",stat3="nso",kzschueler="�S�",kzneue="�N�",kzohneneue="O",kznurneue="N" +,kzname="N",kzkurse="K",kzart="A",kzstd="S",kzplanbl="P",kzfake="FK",dbsj= +"Schuljahr",dbhj="Schulhalbjahr",trenner="�",trenner2="$",kurswahl0= +"Kurswahl-0 ",kurswahl1="Kurswahl-1 ",kurswahl2="Kurswahl-2 ",praefixsperre= +"Sperre ";FILE VAR kuwa0,kuwa1,kuwa2,kuwa3,kuwahilf;TEXT VAR schuljahr:= +"0000",halbjahr:="0",aktschuljahr:="0000",akthalbjahr:="0",jgst:="",hjdtid, +fa1,ke1,fa2,ke2,ws,kl,ar,eintrag,status,datei,sj,hj;INT VAR bearbschueler, +erster:=1,letzter:=0,namenpos,aktjg;BOOL VAR hjzukuenftig,hjaktgepl, +kuwa2eintrag:=TRUE ,plblvorhanden:=FALSE ,faartschoneingetragen:=FALSE , +fakeschoneingetragen:=FALSE ,eintragloeschen:=FALSE ;TEXT VAR hjd1,hjd2,hjd3, +hjd4,hjd5,hjd6,hjd7;TASK VAR takuser;PROC kurswahlinitialisieren(TEXT CONST +aktjgst,gewjgst,gewhj,schueler,TEXT VAR bersj):INT VAR j;aktjg:=int(aktjgst); +IF schueler=kzohneneueTHEN bearbschueler:=1ELIF schueler=kznurneueTHEN +bearbschueler:=2ELSE bearbschueler:=3FI ;sj:=schulkenndatum(dbsj);hj:= +schulkenndatum(dbhj);IF gewjgst=aktjgstTHEN schuljahr:=sjELSE j:=int(gewjgst) +-int(aktjgst);schuljahr:=konvsjteil(text(sj,2),j)+konvsjteil(subtext(sj,3),j) +FI ;bersj:=schuljahr;halbjahr:=gewhj;jgst:=gewjgst;IF hj="1"CAND int(gewjgst) +>int(aktjgst)THEN hjzukuenftig:=TRUE ELIF hj="2"CAND int(gewjgst+gewhj)>(int( +aktjgst)+1)*10+1THEN hjzukuenftig:=TRUE ELSE hjzukuenftig:=FALSE FI ; +hjaktgepl:=NOT hjzukuenftigEND PROC kurswahlinitialisieren;BOOL PROC +istkurswahlbasisvorhanden:dbstatus(1);IF halbjahrnichtgesetztTHEN FALSE ELIF +NOT existstask(server)THEN FALSE ELSE takuser:=task(server);datei:= +datenraumname(kurswahl1);dbstatus(0);exists(datei,takuser)FI END PROC +istkurswahlbasisvorhanden;PROC kurswahlbasisholen(INT VAR fehlerstatus):INT +VAR j;IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT existstask(server) +THEN fehlerstatus:=2ELSE takuser:=task(server);commanddialogue(FALSE ); +fehlerstatus:=0;datei:=datenraumname(kurswahl0);IF exists(datei,takuser)THEN +holkuwa0dateiundkoppleanELSE erstellekuwa0dateiFI ;datei:=datenraumname( +kurswahl1);IF exists(datei,takuser)THEN plblvorhanden:=TRUE ; +holkuwa1dateiundkoppleanELSE plblvorhanden:=FALSE ;erstellekuwa1dateiFI ; +datei:=datenraumname(kurswahl2);IF exists(datei,takuser)THEN +holkuwa2dateiundkoppleanELSE erstellekuwa2dateiFI ;commanddialogue(TRUE )FI . +holkuwa0dateiundkopplean:fetch(datei,takuser);kuwa0:=sequentialfile(modify, +old(datei)).erstellekuwa0datei:IF hjzukuenftigTHEN kuwa0:=sequentialfile( +modify,datei);insertrecord(kuwa0)ELSE datei:=datenraumname(kurswahl0);forget( +datei,quiet);kursdatenholen;IF lines(kuwa0)=0THEN insertrecord(kuwa0)FI FI ; +save(datei,takuser).holkuwa1dateiundkopplean:fetch(datei,takuser);kuwa1:= +sequentialfile(modify,old(datei)).erstellekuwa1datei:kuwa1:=sequentialfile( +modify,datei);FOR jFROM 1UPTO maxkuwa1zeilenREP insertrecord(kuwa1)PER ;save( +datei,takuser).holkuwa2dateiundkopplean:fetch(datei,takuser);kuwa2:= +sequentialfile(modify,old(datei));ermittleersterletzter.erstellekuwa2datei: +kuwa2eintrag:=TRUE ;kurswahleinerjgstaufbereiten(jgst,halbjahr,schuljahr, +kuwa2);save(datei,takuser).END PROC kurswahlbasisholen;PROC +ermittleersterletzter:IF bearbschueler<>2THEN erster:=1ELSE erster:= +zeilennrzumschuelerbestand(FALSE )FI ;IF bearbschueler<>1THEN letzter:=lines( +kuwa2)ELSE letzter:=zeilennrzumschuelerbestand(TRUE )FI END PROC +ermittleersterletzter;PROC erweitertekurswahlbasisholen(TEXT CONST gewjgst, +gewhj,INT VAR fehlerstatus):TEXT VAR erwschuljahr;INT VAR j;IF +halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT existstask(server)THEN +fehlerstatus:=2ELSE takuser:=task(server);commanddialogue(FALSE );IF int( +gewjgst)=aktjgTHEN erwschuljahr:=sjELSE j:=int(gewjgst)-aktjg;erwschuljahr:= +konvsjteil(text(sj,2),j)+konvsjteil(subtext(sj,3),j);FI ;fehlerstatus:=0; +datei:=kurswahl2+gewjgst+" "+gewhj+"."+erwschuljahr;IF exists(datei,takuser) +THEN holkuwa3dateiundkoppleanELSE erstellekuwa3dateiFI ;commanddialogue(TRUE +)FI .holkuwa3dateiundkopplean:fetch(datei,takuser);kuwa3:=sequentialfile( +modify,old(datei)).erstellekuwa3datei:plblvorhanden:=FALSE ;kuwa2eintrag:= +FALSE ;kurswahleinerjgstaufbereiten(gewjgst,gewhj,erwschuljahr,kuwa3).END +PROC erweitertekurswahlbasisholen;PROC kurswahl0holen(INT VAR fehlerstatus): +IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT existstask(server)THEN +fehlerstatus:=2ELSE takuser:=task(server);datei:=datenraumname(kurswahl0);IF +exists(datei,takuser)THEN commanddialogue(FALSE );fetch(datei,takuser); +commanddialogue(TRUE );kuwa0:=sequentialfile(modify,old(datei));fehlerstatus +:=0ELSE fehlerstatus:=3FI ;FI .END PROC kurswahl0holen;PROC kurswahl1holen( +INT VAR fehlerstatus):IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT +existstask(server)THEN fehlerstatus:=2ELSE takuser:=task(server);datei:= +datenraumname(kurswahl1);IF exists(datei,takuser)THEN commanddialogue(FALSE ) +;fetch(datei,takuser);commanddialogue(TRUE );kuwa1:=sequentialfile(modify,old +(datei));fehlerstatus:=0ELSE fehlerstatus:=3FI ;FI .END PROC kurswahl1holen; +PROC kurswahl2holen(INT VAR fehlerstatus):IF halbjahrnichtgesetztTHEN +fehlerstatus:=1ELIF NOT existstask(server)THEN fehlerstatus:=2ELSE takuser:= +task(server);datei:=datenraumname(kurswahl2);IF exists(datei,takuser)THEN +commanddialogue(FALSE );fetch(datei,takuser);commanddialogue(TRUE );kuwa2:= +sequentialfile(modify,old(datei));ermittleersterletzter;fehlerstatus:=0ELSE +fehlerstatus:=3FI ;FI END PROC kurswahl2holen;PROC kurswahl0sichern(INT VAR +fehlerstatus):kurswahl02sichern(kurswahl0,fehlerstatus)END PROC +kurswahl0sichern;PROC kurswahl1sichern(INT VAR fehlerstatus): +kurswahldatenraumsichern(kurswahl1,fehlerstatus)END PROC kurswahl1sichern; +PROC kurswahl2sichern(INT VAR fehlerstatus):kurswahl02sichern(kurswahl2, +fehlerstatus)END PROC kurswahl2sichern;PROC kurswahl02sichern(TEXT CONST +welchen,INT VAR fehlerstatus):INT VAR aktfeld:=infeld;datei:=datenraumname( +welchen);IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT existstask( +server)THEN fehlerstatus:=2ELIF NOT exists(datei)THEN fehlerstatus:=4ELSE +takuser:=task(server);IF exists(datei,takuser)THEN commanddialogue(FALSE ); +save(datei,takuser);commanddialogue(TRUE );fehlerstatus:=0ELSE +standardmeldung(meldungneuebasis,"");forget(datei,quiet);IF welchen=kurswahl2 +THEN bereitek2datenraumaufELSE bereitek0datenraumaufFI ;commanddialogue( +FALSE );save(datei,takuser);commanddialogue(TRUE );fehlerstatus:=0;infeld(1); +standardfelderausgeben;infeld(aktfeld)FI FI .bereitek0datenraumauf:IF +hjzukuenftigTHEN kuwa0:=sequentialfile(modify,datei);insertrecord(kuwa0)ELSE +kursdatenholen;IF lines(kuwa0)=0THEN insertrecord(kuwa0)FI FI . +bereitek2datenraumauf:kuwa2eintrag:=TRUE ;kurswahleinerjgstaufbereiten(jgst, +halbjahr,schuljahr,kuwa2).END PROC kurswahl02sichern;PROC +kurswahldatenraumsichern(TEXT CONST welchen,INT VAR fehlerstatus):datei:= +datenraumname(welchen);IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT +existstask(server)THEN fehlerstatus:=2ELIF NOT exists(datei)THEN fehlerstatus +:=4ELSE takuser:=task(server);commanddialogue(FALSE );save(datei,takuser); +commanddialogue(TRUE );fehlerstatus:=0FI END PROC kurswahldatenraumsichern; +BOOL PROC kurswahldatenvorhanden:INT VAR i;dbstatus(1);IF +halbjahrnichtgesetztTHEN FALSE ELSE datei:=datenraumname(kurswahl2);IF exists +(datei)THEN ueberpruefwahldatenvorhandenELSE FALSE FI FI . +ueberpruefwahldatenvorhanden:dbstatus(0);toline(kuwa2,erster);col(kuwa2,1); +FOR iFROM ersterUPTO letzterREP readrecord(kuwa2,eintrag);IF (eintragSUB 1)<> +trennerTHEN LEAVE ueberpruefwahldatenvorhandenWITH TRUE FI ;down(kuwa2);PER ; +FALSE .END PROC kurswahldatenvorhanden;PROC kurswahlsperresetzen(TEXT CONST +was,BOOL VAR ok):IF halbjahrnichtgesetztTHEN ok:=FALSE ELIF NOT existstask( +server)THEN ok:=FALSE ELSE takuser:=task(server);datei:= +gesperrterdatenraumname(was);IF exists(datei,takuser)THEN ok:=FALSE ELSE +commanddialogue(FALSE );forget(datei,quiet);copy(datenraumname(was),datei); +save(datei,takuser);forget(datei,quiet);commanddialogue(TRUE );ok:=TRUE FI ; +FI END PROC kurswahlsperresetzen;PROC kurswahlsperrebeenden(TEXT CONST was): +IF NOT halbjahrnichtgesetztAND existstask(server)THEN takuser:=task(server); +datei:=gesperrterdatenraumname(was);commanddialogue(FALSE );erase(datei, +takuser);commanddialogue(TRUE );FI END PROC kurswahlsperrebeenden;PROC +kurseintragen(TEXT CONST fach,kennung,wstd,art):dbstatus(1);IF +halbjahrnichtgesetztTHEN LEAVE kurseintragenELIF fach=""COR kennung=""COR +wstd=""COR art=""THEN LEAVE kurseintragenFI ;fa1:=text(fach,laengefach);ke1:= +text(kennung,laengekennung);ws:=text(wstd,laengewstd);ar:=text(art,laengeart) +;IF kurseingetragen(fa1+ke1)THEN LEAVE kurseintragenFI ;toline(kuwa0,lines( +kuwa0));insertrecord(kuwa0);writerecord(kuwa0,fa1+ke1+ws+ar);IF hjaktgepl +THEN tragindbeinELSE dbstatus(0)FI .tragindbein:inittupel( +dnrlehrveranstaltungen);putwert(fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr); +putwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,fa1+compress(ke1)); +putintwert(fnrlvwochenstd,int(wstd));putwert(fnrlvart,compress(art));insert( +dnrlehrveranstaltungen).END PROC kurseintragen;PROC kursloeschen(TEXT CONST +fach,kennung):IF halbjahrnichtgesetztTHEN dbstatus(1);LEAVE kursloeschenFI ; +fa1:=text(fach,laengefach);ke1:=text(kennung,laengekennung);IF +kurseingetragen(fa1+ke1)THEN IF hjaktgeplTHEN aenderindbFI ;deleterecord( +kuwa0);aenderkursinkuwa1(fa1+ke1,"")ELSE dbstatus(1)FI .aenderindb:inittupel( +dnrlehrveranstaltungen);putwert(fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr); +putwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,fa1+compress(ke1));search( +dnrlehrveranstaltungen,TRUE );IF dbstatus=0THEN delete(dnrlehrveranstaltungen +)ELSE dbstatus(1);LEAVE kursloeschenFI .END PROC kursloeschen;PROC +planblockeintragen(TEXT CONST anwblockbez,stunden):TEXT VAR blockbez:= +formbezeichner(anwblockbez),blocknr:=text(blockbez,2),teilkennung:=blockbez +SUB 3;INT VAR j:=int(blocknr)*3-2;dbstatus(1);IF halbjahrnichtgesetztTHEN +LEAVE planblockeintragenELIF j>0CAND j<=maxkuwa1zeilenTHEN IF teilkennung= +kennungtplbl1THEN jINCR 1ELIF teilkennung=kennungtplbl2THEN jINCR 2ELIF +teilkennung<>""CAND teilkennung<>" "THEN LEAVE planblockeintragenFI ;toline( +kuwa1,j);readrecord(kuwa1,eintrag);IF eintrag=""THEN writerecord(kuwa1,text( +blockbez,3)+text(stunden,1))ELSE writerecord(kuwa1,text(eintrag,3)+text( +stunden,1)+subtext(eintrag,5))FI ;dbstatus(0)FI END PROC planblockeintragen; +PROC planblockteilen(TEXT CONST blocknr,wstd1,wstd2):INT VAR j:=int(blocknr)* +3-2;dbstatus(1);IF halbjahrnichtgesetztCOR (compress(blocknrSUB 3))<>""THEN +LEAVE planblockteilenFI ;IF j>0CAND j<=maxkuwa1zeilenTHEN toline(kuwa1,j+1); +readrecord(kuwa1,eintrag);IF eintrag=""THEN up(kuwa1);readrecord(kuwa1, +eintrag);IF eintrag<>""THEN teileplanblockFI FI ;FI .teileplanblock:dbstatus( +0);writerecord(kuwa1,text(eintrag,4));down(kuwa1);writerecord(kuwa1,text( +eintrag,2)+kennungtplbl1+wstd1+subtext(eintrag,5));down(kuwa1);writerecord( +kuwa1,text(eintrag,2)+kennungtplbl2+wstd2+subtext(eintrag,5)).END PROC +planblockteilen;PROC planblockloeschen(TEXT CONST anwblockbez):TEXT VAR +blockbez:=formbezeichner(anwblockbez),blocknr:=text(blockbez,2),teilkennung:= +blockbezSUB 3;INT VAR j:=int(blocknr)*3-2;BOOL VAR pruefteilbloecke:=FALSE ; +dbstatus(1);IF halbjahrnichtgesetztTHEN LEAVE planblockloeschenFI ;IF +teilkennung=kennungtplbl1THEN jINCR 1ELIF teilkennung=kennungtplbl2THEN j +INCR 2ELSE pruefteilbloecke:=TRUE FI ;IF j>0CAND j<=maxkuwa1zeilenTHEN toline +(kuwa1,j);IF pruefteilbloeckeTHEN down(kuwa1,2);readrecord(kuwa1,eintrag);IF +eintrag<>""THEN LEAVE planblockloeschenELSE up(kuwa1);readrecord(kuwa1, +eintrag);IF eintrag<>""THEN LEAVE planblockloeschenELSE up(kuwa1)FI ;FI ;FI ; +writerecord(kuwa1,"");dbstatus(0)FI .END PROC planblockloeschen;PROC +planbloeckeinitialisieren:TEXT VAR datei:=datenraumname(kurswahl1);INT VAR j; +IF halbjahrnichtgesetztCOR NOT existstask(server)THEN dbstatus(1)ELSE takuser +:=task(server);erstellekuwa1dateiFI .erstellekuwa1datei:forget(datei,quiet); +kuwa1:=sequentialfile(modify,datei);FOR jFROM 1UPTO maxkuwa1zeilenREP +insertrecord(kuwa1)PER ;dbstatus(0);commanddialogue(FALSE );save(datei, +takuser);commanddialogue(TRUE ).END PROC planbloeckeinitialisieren;PROC +planbloeckezumkurseintragen(TEXT CONST anwkurs,anwblockbez1,anwblockbez2): +TEXT VAR kurs:=text(anwkurs,laengekurs),blockbez1:=formbezeichner( +anwblockbez1),blockbez2:=formbezeichner(anwblockbez2);dbstatus(1);IF +halbjahrnichtgesetztTHEN LEAVE planbloeckezumkurseintragenFI ;IF blockbez1<> +""COR blockbez2<>""THEN IF NOT kurseingetragen(kurs)THEN LEAVE +planbloeckezumkurseintragenFI FI ;IF compress(blockbez1)<>""THEN IF NOT +blockeingetragen(blockbez1)THEN LEAVE planbloeckezumkurseintragenFI ;FI ;IF +compress(blockbez2)<>""THEN IF NOT blockeingetragen(blockbez2)THEN LEAVE +planbloeckezumkurseintragenFI ;FI ;loescheplanbloeckezukurs(kurs);IF +blockeingetragen(blockbez1)THEN tragkurseinFI ;IF blockeingetragen(blockbez2) +THEN tragkurseinFI ;dbstatus(0).tragkursein:readrecord(kuwa1,eintrag);eintrag +CAT kurs;writerecord(kuwa1,eintrag).END PROC planbloeckezumkurseintragen; +PROC loescheplanbloeckezukurs(TEXT CONST kurs):TEXT VAR bloecke:=planbloecke( +kurs);IF bloecke<>leereplanbloeckeTHEN aenderkursinkuwa1(kurs,"")FI .END +PROC loescheplanbloeckezukurs;INT PROC planblockzeilennr(TEXT CONST +anwblockbez):TEXT VAR blockbez:=formbezeichner(anwblockbez);IF +blockeingetragen(blockbez)THEN lineno(kuwa1)ELSE 0FI END PROC +planblockzeilennr;PROC schuelerwahleintragen(TEXT CONST famname,rufname, +gebdatum,wahl):TEXT VAR schueler:=trenner+famname+trenner+rufname+trenner+ +gebdatum,wahldaten:=wahl;dbstatus(1);IF halbjahrnichtgesetztCOR length( +wahldaten)MOD laengekurseintrag<>0THEN LEAVE schuelerwahleintragenFI ;IF +schuelereingetragen(schueler,kuwa2)THEN readrecord(kuwa2,eintrag);hjd1:= +wahldaten;hjdateneintragen(famname,rufname,gebdatum,1);IF dbstatus=0THEN +schreibeintragFI ;FI .schreibeintrag:writerecord(kuwa2,wahldaten+subtext( +eintrag,pos(eintrag,trenner))).END PROC schuelerwahleintragen;PROC +schuelerwahleintragen(TEXT CONST famname,rufname,gebdatum,fach,kennung,art, +klausur):TEXT VAR schueler:=trenner+famname+trenner+rufname+trenner+gebdatum, +kurse;INT VAR aktpos;dbstatus(1);IF halbjahrnichtgesetztTHEN LEAVE +schuelerwahleintragenFI ;fa1:=text(fach,laengefach);ke1:=text(kennung, +laengekennung);ar:=text(art,laengeart);kl:=text(klausur,laengeklausur);IF +schuelereingetragen(schueler,kuwa2)THEN readrecord(kuwa2,eintrag);hjd1:=fa1; +hjd2:=ke1;hjd3:=ar;hjd4:=kl;hjdateneintragen(famname,rufname,gebdatum,2);IF +dbstatus=0THEN schreibeintragFI FI .schreibeintrag:pruefanzkurse;IF ke1= +leerekennungTHEN tragfachwahleinELSE tragkurswahleinFI .pruefanzkurse:aktpos +:=pos(eintrag,trenner);kurse:=text(eintrag,aktpos-1);IF length(kurse)=195 +THEN LEAVE schuelerwahleintragenFI .tragfachwahlein:IF nichteingetragen( +eintrag,ar+fa1,2,aktpos)THEN IF ke1<>leerekennungTHEN writerecord(kuwa2,kl+ar ++fa1+ke1+planbloecke(fa1+ke1)+eintrag)ELSE writerecord(kuwa2,kl+ar+fa1+ke1+ +leereplanbloecke+eintrag)FI ;FI .tragkurswahlein:IF nichteingetragen(eintrag, +fa1+ke1,4,aktpos)THEN writerecord(kuwa2,kl+ar+fa1+ke1+planbloecke(fa1+ke1)+ +eintrag)FI .END PROC schuelerwahleintragen;PROC schuelerwahlaendern(TEXT +CONST famname,rufname,gebdatum,fachalt,kennungalt,artalt,fachneu,kennungneu, +artneu,klausur):TEXT VAR schueler:=trenner+famname+trenner+rufname+trenner+ +gebdatum,neuereintrag,aralt,compke,compart;INT VAR aktpos,kurspos;dbstatus(1) +;IF halbjahrnichtgesetztTHEN LEAVE schuelerwahlaendernFI ; +faartschoneingetragen:=FALSE ;fakeschoneingetragen:=FALSE ;fa1:=text(fachalt, +laengefach);ke1:=text(kennungalt,laengekennung);aralt:=text(artalt,laengeart) +;fa2:=text(fachneu,laengefach);ke2:=text(kennungneu,laengekennung);ar:=text( +artneu,laengeart);kl:=text(klausur,laengeklausur);IF schuelereingetragen( +schueler,kuwa2)THEN pruefundtragein;hjd1:=fa1;hjd2:=ke1;hjd3:=fa2;hjd4:=ke2; +hjd5:=ar;hjd6:=kl;hjd7:=aralt;hjdateneintragen(famname,rufname,gebdatum,3); +IF dbstatus=0THEN aendereintragFI FI .pruefundtragein:readrecord(kuwa2, +eintrag);IF fachalt=""THEN LEAVE schuelerwahlaendernFI ;IF kennungalt<>"" +THEN IF nichteingetragen(eintrag,fa1+ke1,4,aktpos)THEN LEAVE +schuelerwahlaendernFI ELIF artalt=""THEN LEAVE schuelerwahlaendernELIF +nichteingetragen(eintrag,aralt+fa1,2,aktpos)THEN LEAVE schuelerwahlaendernFI +;IF fachneu=""THEN eintragloeschen:=TRUE ;eintrag:=text(eintrag,aktpos-1)+ +subtext(eintrag,aktpos+laengekurseintrag)ELSE eintragloeschen:=FALSE ;compke +:=compress(kennungneu);compart:=compress(artneu);IF compke=""CAND compart="" +THEN LEAVE schuelerwahlaendernELIF compke<>""THEN IF NOT nichteingetragen( +eintrag,fa2+ke2,4,kurspos)THEN fakeschoneingetragen:=TRUE FI ELIF compart<>"" +THEN IF NOT nichteingetragen(eintrag,ar+fa2,2,kurspos)THEN +faartschoneingetragen:=TRUE FI FI ;loeschundtrageinFI .aendereintrag: +writerecord(kuwa2,eintrag).loeschundtragein:neuereintrag:=kl;neuereintragCAT +ar;neuereintragCAT fa2;neuereintragCAT ke2;IF (fa1+ke1)<>(fa2+ke2)THEN +neuereintragCAT planbloecke(fa2+ke2)ELSE neuereintragCAT subtext(eintrag, +aktpos+9,aktpos+14)FI ;IF faartschoneingetragenCOR fakeschoneingetragenTHEN +ueberschreibneuenkursmitneuenwertenELSE substituieraltenkursmitneuemkursFI . +substituieraltenkursmitneuemkurs:eintrag:=text(eintrag,aktpos-1)+neuereintrag ++subtext(eintrag,aktpos+laengekurseintrag). +ueberschreibneuenkursmitneuenwerten:eintrag:=text(eintrag,kurspos-1)+ +neuereintrag+subtext(eintrag,kurspos+laengekurseintrag);IF aktpos<>kurspos +THEN eintrag:=text(eintrag,aktpos-1)+subtext(eintrag,aktpos+laengekurseintrag +)FI .END PROC schuelerwahlaendern;PROC hjdateneintragen(TEXT CONST famname, +rufname,gebdatum,INT CONST aktion):INT VAR iii,iiii;TEXT VAR wahlteil, +tutoreintrag;TEXT VAR t1,t2,t3,t4;SELECT aktionOF CASE 1: +hjdatenersetzenoderanlegenCASE 2:hjdatenergaenzenoderanlegenCASE 3: +hjdatensubstituierenEND SELECT .hjdatenersetzenoderanlegen:suchhjdaten( +famname,rufname,gebdatum);IF dbstatus<>0THEN IF schuelerindbTHEN +erstellhjdatensatz;IF schuljahr=aktsjCAND halbjahr=akthjCAND dbstatus=0THEN +schreibtidinsudatenFI FI ELSE aenderehjdatensatzFI .aenderehjdatensatz: +tragwahldatenein;putwert(fnrhjdfach,t1);putwert(fnrhjdkursart,t3);putwert( +fnrhjdlerngrpkenn,t2);putwert(fnrhjdklausurteiln,t4);update( +dnrhalbjahresdaten).erstellhjdatensatz:inittupel(dnrhalbjahresdaten);putwert( +fnrhjdfamnames,famname);putwert(fnrhjdrufnames,rufname);putwert(fnrhjdgebdats +,gebdatum);putwert(fnrhjdjgst,jgst);putwert(fnrhjdsj,schuljahr);putwert( +fnrhjdhj,halbjahr);tragwahldatenein;IF schuljahr=aktsjCAND halbjahr=akthj +THEN putwert(fnrhjdkennung,tutoreintrag)FI ;putwert(fnrhjdfach,t1);putwert( +fnrhjdkursart,t3);putwert(fnrhjdlerngrpkenn,t2);putwert(fnrhjdklausurteiln,t4 +);insert(dnrhalbjahresdaten);IF dbstatus<>0THEN LEAVE hjdateneintragenELSE +hjdtid:=gettidFI .schuelerindb:parsenooffields(7);inittupel(dnrschueler); +putwert(fnrsufamnames,famname);putwert(fnrsurufnames,rufname);putwert( +fnrsugebdatums,gebdatum);search(dnrschueler,TRUE );IF schuljahr=aktsjCAND +halbjahr=akthjCAND dbstatus=0THEN tutoreintrag:=wert(fnrsusgrpzugtut)FI ; +reinitparsing;dbstatus=0.tragwahldatenein:t1:="";t2:="";t3:="";t4:="";FOR iii +FROM 1UPTO length(hjd1)DIV 15REP wahlteil:=subtext(hjd1,(iii-1)*15+1,iii*15); +t1CAT subtext(wahlteil,4,5);t2CAT subtext(wahlteil,6,9);t3CAT subtext( +wahlteil,2,3);t4CAT (wahlteilSUB 1)PER .schreibtidinsudaten:inittupel( +dnrschueler);putwert(fnrsufamnames,famname);putwert(fnrsurufnames,rufname); +putwert(fnrsugebdatums,gebdatum);search(dnrschueler,TRUE );IF dbstatus=0THEN +putwert(fnrsutidakthjd,hjdtid);selupdate(dnrschueler)FI . +hjdatenergaenzenoderanlegen:suchhjdaten(famname,rufname,gebdatum);IF dbstatus +<>0THEN IF schuelerindbTHEN generierhjdatensatz;IF schuljahr=aktsjCAND +halbjahr=akthjCAND dbstatus=0THEN schreibtidinsudatenFI FI ELSE +ergaenzehjdatensatzFI .ergaenzehjdatensatz:t1:=wert(fnrhjdfach);IF length(t1) +=26THEN dbstatus(1);LEAVE hjdateneintragenELSE t3:=wert(fnrhjdkursart);t2:= +wert(fnrhjdlerngrpkenn);t4:=wert(fnrhjdklausurteiln)FI ;t1CAT hjd1;t2CAT hjd2 +;t3CAT hjd3;t4CAT hjd4;putwert(fnrhjdfach,t1);putwert(fnrhjdkursart,t3); +putwert(fnrhjdlerngrpkenn,t2);putwert(fnrhjdklausurteiln,t4);update( +dnrhalbjahresdaten);IF dbstatus<>0THEN LEAVE hjdateneintragenFI . +generierhjdatensatz:inittupel(dnrhalbjahresdaten);putwert(fnrhjdfamnames, +famname);putwert(fnrhjdrufnames,rufname);putwert(fnrhjdgebdats,gebdatum); +putwert(fnrhjdjgst,jgst);IF schuljahr=aktsjCAND halbjahr=akthjTHEN putwert( +fnrhjdkennung,tutoreintrag)FI ;putwert(fnrhjdsj,schuljahr);putwert(fnrhjdhj, +halbjahr);putwert(fnrhjdfach,hjd1);putwert(fnrhjdkursart,hjd3);putwert( +fnrhjdlerngrpkenn,hjd2);putwert(fnrhjdklausurteiln,hjd4);insert( +dnrhalbjahresdaten);IF dbstatus<>0THEN LEAVE hjdateneintragenFI ;hjdtid:= +gettid.hjdatensubstituieren:suchhjdaten(famname,rufname,gebdatum);IF dbstatus +<>0THEN dbstatus(1);LEAVE hjdateneintragenELSE substituierehjdatensatzFI . +substituierehjdatensatz:t2:=wert(fnrhjdkursart);t3:=wert(fnrhjdlerngrpkenn); +t4:=wert(fnrhjdklausurteiln);setzeuebergebenewerte;schreibgeaendertensatz. +schreibgeaendertensatz:putwert(fnrhjdfach,t1);putwert(fnrhjdkursart,t2); +putwert(fnrhjdlerngrpkenn,t3);putwert(fnrhjdklausurteiln,t4);update( +dnrhalbjahresdaten).setzeuebergebenewerte:t1:=wert(fnrhjdfach); +suchrichtigefachposition;IF eintragloeschenTHEN alteneintragloeschenELIF +faartschoneingetragenCOR fakeschoneingetragenTHEN eintragaktualisieren;IF iii +<>iiiiTHEN alteneintragloeschenFI ELSE alteneintragueberschreibenFI . +eintragaktualisieren:suchschonvorhandeneneintrag;IF faartschoneingetragen +THEN t3:=text(t3,iiii*2-2)+hjd4+subtext(t3,iiii*2+3)ELSE t2:=text(t2,iiii-1)+ +hjd5+subtext(t2,iiii+2)FI ;t4:=text(t4,(iiii+1)DIV 2-1)+hjd6+subtext(t4,(iiii ++1)DIV 2+1).alteneintragloeschen:t1:=text(t1,iii-1)+subtext(t1,iii+2);t2:= +text(t2,iii-1)+subtext(t2,iii+2);t3:=text(t3,iii*2-2)+subtext(t3,iii*2+3);t4 +:=text(t4,(iii+1)DIV 2-1)+subtext(t4,(iii+1)DIV 2+1). +alteneintragueberschreiben:IF hjd1<>hjd3THEN t1:=text(t1,iii-1)+hjd3+subtext( +t1,iii+2)FI ;IF hjd2<>hjd4THEN t3:=text(t3,iii*2-2)+hjd4+subtext(t3,iii*2+3) +FI ;IF hjd5<>hjd7THEN t2:=text(t2,iii-1)+hjd5+subtext(t2,iii+2)FI ;t4:=text( +t4,(iii+1)DIV 2-1)+hjd6+subtext(t4,(iii+1)DIV 2+1).suchrichtigefachposition: +iii:=1;WHILE iii<>0REP iii:=pos(t1,hjd1,iii);IF iii=0THEN dbstatus(1);LEAVE +hjdateneintragenELSE pruefzugehoerigewerteFI ;iiiINCR 1PER ;dbstatus(1); +LEAVE hjdateneintragen.pruefzugehoerigewerte:IF (iiiMOD 2)=1THEN IF compress( +hjd2)<>""THEN pruefkennungELIF compress(hjd7)<>""THEN pruefartFI FI . +pruefkennung:IF subtext(t3,iii*2-1,iii*2+2)=hjd2THEN LEAVE +suchrichtigefachpositionFI .pruefart:IF subtext(t2,iii,iii+1)=hjd7THEN LEAVE +suchrichtigefachpositionFI .suchschonvorhandeneneintrag:iiii:=1;WHILE iiii<>0 +REP iiii:=pos(t1,hjd3,iiii);IF iiii=0THEN dbstatus(1);LEAVE hjdateneintragen +ELSE pruefweiterewerteFI ;iiiiINCR 1PER ;dbstatus(1);LEAVE hjdateneintragen. +pruefweiterewerte:IF (iiiiMOD 2)=1THEN IF faartschoneingetragenTHEN IF +subtext(t2,iiii,iiii+1)=hjd5THEN LEAVE suchschonvorhandeneneintragFI ELIF +fakeschoneingetragenTHEN IF subtext(t3,iiii*2-1,iiii*2+2)=hjd4THEN LEAVE +suchschonvorhandeneneintragFI FI FI .END PROC hjdateneintragen;TEXT PROC +aktsj:IF aktschuljahr="0000"THEN aktschuljahr:=schulkenndatum("Schuljahr"); +FI ;aktschuljahrEND PROC aktsj;TEXT PROC akthj:IF akthalbjahr="0"THEN +akthalbjahr:=schulkenndatum("Schulhalbjahr");FI ;akthalbjahrEND PROC akthj; +PROC suchhjdaten(TEXT CONST famname,rufname,gebdatum):inittupel( +dnrhalbjahresdaten);putwert(fnrhjdfamnames,famname);putwert(fnrhjdrufnames, +rufname);putwert(fnrhjdgebdats,gebdatum);putwert(fnrhjdsj,schuljahr);putwert( +fnrhjdhj,halbjahr);search(dnrhalbjahresdaten,TRUE )END PROC suchhjdaten;INT +PROC ersterschueler:ersterEND PROC ersterschueler;INT PROC letzterschueler: +letzterEND PROC letzterschueler;TEXT PROC wahldatenzumindex(INT CONST +zeilennr,TEXT CONST kennung):INT VAR trennerpos;dbstatus(1);IF +halbjahrnichtgesetztTHEN LEAVE wahldatenzumindexWITH ""ELIF zeilennrletzterTHEN LEAVE wahldatenzumindexWITH ""FI ;toline(kuwa2, +zeilennr);col(kuwa2,1);readrecord(kuwa2,eintrag);IF kennung=kznameCOR kennung +=kzkurseCOR kennung=kzartTHEN dbstatus(0);trennerpos:=pos(eintrag,trenner); +IF kennung=kznameTHEN subtext(eintrag,trennerpos+1,length(eintrag)-3)ELIF +kennung=kzkurseTHEN text(eintrag,trennerpos-1)ELSE eintragFI ELSE ""FI END +PROC wahldatenzumindex;TEXT PROC wahldatenzumschueler(TEXT CONST famname, +rufname,gebdatum,kennung):TEXT VAR schueler:=trenner+famname+trenner+rufname+ +trenner+gebdatum;dbstatus(1);IF halbjahrnichtgesetztTHEN LEAVE +wahldatenzumschuelerWITH ""FI ;IF schuelereingetragen(schueler,kuwa2)THEN +readrecord(kuwa2,eintrag);IF kennung="F"COR kennung="A"COR kennung="FA"COR +kennung="FAk"COR kennung="FK"COR kennung="FKk"COR kennung="FKAk"COR kennung= +"FP"THEN dbstatus(0);alledaten(eintrag,kennung)ELSE ""FI ELSE ""FI END PROC +wahldatenzumschueler;TEXT PROC weiterewahldatenzumschueler(TEXT CONST famname +,rufname,gebdatum,kennung):TEXT VAR schueler:=trenner+famname+trenner+rufname ++trenner+gebdatum;dbstatus(1);IF halbjahrnichtgesetztTHEN LEAVE +weiterewahldatenzumschuelerWITH ""FI ;IF schuelereingetragen(schueler,kuwa3) +THEN readrecord(kuwa3,eintrag);IF kennung="F"COR kennung="A"COR kennung="FA" +COR kennung="FAk"COR kennung="FK"COR kennung="FKk"COR kennung="FKAk"THEN +dbstatus(0);alledaten(eintrag,kennung)ELSE ""FI ELSE ""FI END PROC +weiterewahldatenzumschueler;TEXT PROC kursdaten(TEXT CONST anwkurs,kennung): +TEXT VAR ausgabe:="",kurs:=text(anwkurs,laengekurs);dbstatus(1);IF +halbjahrnichtgesetztTHEN LEAVE kursdatenWITH ""FI ;IF kurseingetragen(kurs) +THEN readrecord(kuwa0,eintrag);IF kennung=kzartTHEN ausgabe:=subtext(eintrag, +9);dbstatus(0)ELIF kennung=kzstdTHEN ausgabe:=subtext(eintrag,7,8);dbstatus(0 +)ELIF kennung=kzplanblTHEN ausgabe:=planbloecke(kurs);dbstatus(0)FI FI ; +ausgabeEND PROC kursdaten;TEXT PROC allekurse:TEXT VAR ausgabe:="";IF +halbjahrnichtgesetztTHEN dbstatus(1);LEAVE allekurseWITH ""ELSE dbstatus(0) +FI ;col(kuwa0,1);toline(kuwa0,1);WHILE NOT eof(kuwa0)REP readrecord(kuwa0, +eintrag);IF eintrag<>""THEN ausgabeCAT eintragFI ;down(kuwa0)PER ;ausgabeEND +PROC allekurse;TEXT PROC alleplanblockbezeichner:TEXT VAR ausgabe:="";IF +halbjahrnichtgesetztTHEN dbstatus(1);LEAVE alleplanblockbezeichnerWITH "" +ELSE dbstatus(0)FI ;col(kuwa1,1);toline(kuwa1,1);WHILE NOT eof(kuwa1)REP +readrecord(kuwa1,eintrag);IF eintrag<>""THEN ausgabeCAT text(eintrag, +laengeblock)FI ;down(kuwa1)PER ;ausgabeEND PROC alleplanblockbezeichner;TEXT +PROC planblockdaten(TEXT CONST anwblockbez,kennung):TEXT VAR blockbez:= +formbezeichner(anwblockbez);IF halbjahrnichtgesetztCOR NOT blockeingetragen( +blockbez)THEN dbstatus(1);LEAVE planblockdatenWITH ""FI ;readrecord(kuwa1, +eintrag);IF kennung=kzstdTHEN dbstatus(0);eintragSUB 4ELIF kennung=kzkurse +THEN dbstatus(0);subtext(eintrag,5)ELSE ""FI END PROC planblockdaten;PROC +kurszumplanblockeintragen(TEXT CONST anwkurs,anwblockbez):TEXT VAR blockbez:= +formbezeichner(anwblockbez);TEXT CONST kurs:=text(anwkurs,laengekurs);IF +halbjahrnichtgesetztCOR NOT blockeingetragen(blockbez)THEN dbstatus(1);LEAVE +kurszumplanblockeintragenFI ;readrecord(kuwa1,eintrag);IF length(eintrag)> +laengeblockwstdTHEN IF wertnichteingetragen(subtext(eintrag,laengeblockwstd+1 +),kurs,1)THEN eintragCAT text(kurs,laengekurs);writerecord(kuwa1,eintrag)FI +ELSE eintragCAT text(kurs,laengekurs);writerecord(kuwa1,eintrag)FI ;dbstatus( +0)END PROC kurszumplanblockeintragen;INT PROC anzahlschuelermitwahl(TEXT +CONST fach,kennung,art,klausur):IF halbjahrnichtgesetztTHEN dbstatus(1); +LEAVE anzahlschuelermitwahlWITH 0FI ;fa1:=text(fach,laengefach);ke1:=text( +kennung,laengekennung);ar:=text(art,laengeart);dbstatus(0);IF fach=""THEN +dbstatus(1);-1ELIF kennung=""CAND art=""CAND klausur=""THEN anzahlschueler( +fa1,"",4)ELIF kennung=""CAND art=""THEN anzahlschueler(fa1,klausur,4)ELIF +kennung<>""CAND art=""CAND klausur=""THEN anzahlschueler(fa1+ke1,"",4)ELIF +kennung<>""CAND art=""THEN anzahlschueler(fa1+ke1,klausur,4)ELIF kennung="" +CAND art<>""CAND klausur=""THEN anzahlschueler(ar+fa1,"",2)ELIF kennung="" +CAND art<>""THEN anzahlschueler(klausur+ar+fa1,"",1)ELIF klausur=""THEN +anzahlschueler(ar+fa1+ke1,"",2)ELSE anzahlschueler(klausur+ar+fa1+ke1,"",1) +FI END PROC anzahlschuelermitwahl;INT PROC anzahlschuelermitwahl(TEXT CONST +fach,kennung,art,klausur,fach2,kennung2,art2,klausur2):TEXT VAR p1,p3,p4,p6, +ar1,ar2;INT VAR p2,p5;fa1:=text(fach,laengefach);fa2:=text(fach2,laengefach); +ke1:=text(kennung,laengekennung);ke2:=text(kennung2,laengekennung);ar1:=text( +art,laengeart);ar2:=text(art2,laengeart);IF halbjahrnichtgesetztCOR (fa1=fa2 +CAND kennung=kennung2CAND art=art2)THEN dbstatus(1);LEAVE +anzahlschuelermitwahlWITH 0FI ;pruefwahl.pruefwahl:dbstatus(0);IF fach="" +THEN dbstatus(1);LEAVE anzahlschuelermitwahlWITH -1ELIF kennung=""CAND art="" +CAND klausur=""THEN p1:=fa1;p2:=4;p3:=""ELIF kennung=""CAND art=""THEN p1:= +fa1;p2:=4;p3:=klausurELIF kennung<>""CAND art=""CAND klausur=""THEN p1:=fa1+ +ke1;p2:=4;p3:=""ELIF kennung<>""CAND art=""THEN p1:=fa1+ke1;p2:=4;p3:=klausur +ELIF kennung=""CAND art<>""CAND klausur=""THEN p1:=ar1+fa1;p2:=2;p3:="";ELIF +kennung=""CAND art<>""THEN p1:=klausur+ar1+fa1;p2:=1;p3:=""ELIF klausur="" +THEN p1:=ar1+fa1+ke1;p2:=2;p3:=""ELSE p1:=klausur+ar1+fa1+ke1;p2:=1;p3:=""FI +;IF fach2=""THEN LEAVE anzahlschuelermitwahlWITH anzahlschueler(p1,p3,p2) +ELIF kennung2=""CAND art2=""CAND klausur2=""THEN p4:=fa2;p5:=4;p6:=""ELIF +kennung2=""CAND art2=""THEN p4:=fa2;p5:=4;p6:=klausur2ELIF kennung2<>""CAND +art2=""CAND klausur2=""THEN p4:=fa2+ke2;p5:=4;p6:=""ELIF kennung2<>""CAND +art2=""THEN p4:=fa2+ke2;p5:=4;p6:=klausur2ELIF kennung2=""CAND art2<>""CAND +klausur2=""THEN p4:=ar2+fa2;p5:=2;p6:="";ELIF kennung2=""CAND art2<>""THEN p4 +:=klausur2+ar2+fa2;p5:=1;p6:=""ELIF klausur2=""THEN p4:=ar2+fa2+ke2;p5:=2;p6 +:=""ELSE p4:=klausur2+ar2+fa2+ke2;p5:=1;p6:=""FI ;anzahlschueler(p1,p3,p4,p6, +p2,p5)END PROC anzahlschuelermitwahl;TEXT PROC schuelermitwahl(TEXT CONST +fach,kennung,art,klausur):IF halbjahrnichtgesetztTHEN dbstatus(1);LEAVE +schuelermitwahlWITH ""FI ;fa1:=text(fach,laengefach);ke1:=text(kennung, +laengekennung);ar:=text(art,laengeart);pruefwahl.pruefwahl:dbstatus(0);IF +fach=""THEN dbstatus(1);""ELIF kennung=""CAND art=""CAND klausur=""THEN +schueler(fa1,"",4)ELIF kennung=""CAND art=""THEN schueler(fa1,klausur,4)ELIF +kennung<>""CAND art=""CAND klausur=""THEN schueler(fa1+ke1,"",4)ELIF kennung +<>""CAND art=""THEN schueler(fa1+ke1,klausur,4)ELIF kennung=""CAND art<>"" +CAND klausur=""THEN schueler(ar+fa1,"",2)ELIF kennung=""CAND art<>""THEN +schueler(klausur+ar+fa1,"",1)ELIF klausur=""THEN schueler(ar+fa1+ke1,"",2) +ELSE schueler(klausur+ar+fa1+ke1,"",1)FI END PROC schuelermitwahl;INT PROC +anzahlfreierschuelerimplanblock(TEXT CONST blocknr,teilkennung,fach,kennung, +art,klausur):TEXT VAR block:=text(blocknr,2)+text(teilkennung,1);INT VAR j:= +int(blocknr)*3-2,anzspezschueler:=letzterschueler-ersterschueler+1, +anzbelschueler:=0;IF halbjahrnichtgesetztCOR j<1COR j>maxkuwa1zeilenTHEN +dbstatus(1);LEAVE anzahlfreierschuelerimplanblockWITH -1FI ;IF fach=""THEN +anzspezschueler:=letzterschueler-ersterschueler+1ELSE anzspezschueler:= +anzahlschuelermitwahl(fach,kennung,art,klausur)FI ;fa1:=text(fach,laengefach) +;ke1:=text(kennung,laengekennung);ar:=text(art,laengeart);pruefwahl.pruefwahl +:dbstatus(0);IF fach=""THEN anzbelschueler:=anzahlschueler("","",block,1) +ELIF kennung=""CAND art=""CAND klausur=""THEN anzbelschueler:=anzahlschueler( +fa1,"",block,4)ELIF kennung=""CAND art=""THEN anzbelschueler:=anzahlschueler( +fa1,klausur,block,4)ELIF kennung<>""CAND art=""CAND klausur=""THEN +anzbelschueler:=anzahlschueler(fa1+ke1,"",block,4)ELIF kennung<>""CAND art="" +THEN anzbelschueler:=anzahlschueler(fa1+ke1,klausur,block,4)ELIF kennung="" +CAND art<>""CAND klausur=""THEN anzbelschueler:=anzahlschueler(ar+fa1,"", +block,2)ELIF kennung=""CAND art<>""THEN anzbelschueler:=anzahlschueler( +klausur+ar+fa1,"",block,1)ELIF klausur=""THEN anzbelschueler:=anzahlschueler( +ar+fa1+ke1,"",block,2)ELSE anzbelschueler:=anzahlschueler(klausur+ar+fa1+ke1, +"",block,1)FI ;anzspezschueler-anzbelschuelerEND PROC +anzahlfreierschuelerimplanblock;BOOL PROC schuelerinplanblock(TEXT CONST +famname,rufname,gebdatum,blockbez):TEXT VAR schueler:=trenner+famname+trenner ++rufname+trenner+gebdatum,block:=text(blockbez,laengeblock),schuelerkurse:="" +,aktkurs,plblkurse:=planblockdaten(block,kzkurse);INT VAR kurspos;IF +planblockeingetragenCAND schuelereingetragen(schueler,kuwa2)CAND NOT +halbjahrnichtgesetztTHEN dbstatus(0);schuelerkurse:=wahldatenzumschueler( +famname,rufname,gebdatum,kzfake);IF plblkurse=""THEN FALSE ELSE +betrachtealleschuelerkurseFI ELSE dbstatus(1);TRUE FI .planblockeingetragen: +dbstatus=0.betrachtealleschuelerkurse:kurspos:=1;WHILE kurspos0 +REP aktpos:=pos(quelle,teilmuster,suchab);IF aktposMOD laengekurs=1THEN +LEAVE kursnichteingetragenWITH FALSE ELSE suchab:=aktpos+1FI PER ;TRUE END +PROC kursnichteingetragen;TEXT PROC schuelerundklausur(TEXT CONST fach, +kennung,art):IF halbjahrnichtgesetztTHEN dbstatus(1);LEAVE schuelerundklausur +WITH ""FI ;fa1:=text(fach,laengefach);ke1:=text(kennung,laengekennung);ar:= +text(art,laengeart);pruefwahl.pruefwahl:dbstatus(0);IF fach=""THEN dbstatus(1 +);""ELIF kennung=""CAND art=""THEN klausurschueler(fa1,4)ELIF kennung<>"" +CAND art=""THEN klausurschueler(fa1+ke1,4)ELIF kennung=""CAND art<>""THEN +klausurschueler(ar+fa1,2)ELSE klausurschueler(ar+fa1+ke1,2)FI END PROC +schuelerundklausur;TEXT PROC klausurschueler(TEXT CONST suchtext,INT CONST +findpos):INT VAR aktpos;TEXT VAR namen:="";col(kuwa2,1);toline(kuwa2,erster); +WHILE lineno(kuwa2)<=letzterREP downety(kuwa2,suchtext);aktpos:=col(kuwa2); +IF lineno(kuwa2)>letzterTHEN LEAVE klausurschuelerWITH namenELIF aktposMOD +laengekurseintrag=findposTHEN readrecord(kuwa2,eintrag);namenpos:=pos(eintrag +,trenner);IF aktposletzterTHEN +LEAVE schuelerWITH namenELIF aktposMOD laengekurseintrag=findposTHEN +readrecord(kuwa2,eintrag);namenpos:=pos(eintrag,trenner);IF aktposletzterTHEN LEAVE anzahlschuelerWITH anzELIF aktpos +MOD laengekurseintrag=findposTHEN readrecord(kuwa2,eintrag);namenpos:=pos( +eintrag,trenner);IF aktpos +letzterTHEN LEAVE anzahlschuelerWITH anzELIF aktposMOD laengekurseintrag= +findposTHEN readrecord(kuwa2,eintrag);namenpos:=pos(eintrag,trenner);IF +aktposletzterTHEN LEAVE +anzahlschuelerWITH anzELIF aktposMOD laengekurseintrag=findposTHEN readrecord +(kuwa2,eintrag);namenpos:=pos(eintrag,trenner);IF aktpos0THEN dbstatus(1)ELSE aktpos:=1;WHILE +aktpos0THEN quelle +:=text(urquelle,trennerpos-1)ELSE quelle:=urquelleFI ;WHILE pos(quelle,muster +,suchab)<>0REP aktpos:=pos(quelle,muster,suchab);IF aktposMOD +laengekurseintrag=riposTHEN findpos:=aktpos-ripos+1;LEAVE nichteingetragen +WITH FALSE ELSE suchab:=aktpos+1FI PER ;findpos:=0;TRUE END PROC +nichteingetragen;BOOL PROC nichteingetragen(TEXT CONST urquelle,muster,INT +CONST ripos):INT VAR trennerpos:=pos(urquelle,trenner);TEXT VAR quelle, +teilmuster;IF trennerpos>0THEN quelle:=text(urquelle,trennerpos-1)ELSE quelle +:=urquelleFI ;IF length(muster)<4THEN wertnichteingetragen(quelle,muster, +ripos)ELSE teilmuster:=text(muster,3);IF wertnichteingetragen(quelle, +teilmuster,ripos)THEN teilmuster:=subtext(muster,4);wertnichteingetragen( +quelle,teilmuster,ripos)ELSE FALSE FI FI END PROC nichteingetragen;BOOL PROC +wertnichteingetragen(TEXT CONST quelle,teilmuster,INT CONST ripos):INT VAR +suchab:=1,aktpos;WHILE pos(quelle,teilmuster,suchab)<>0REP aktpos:=pos(quelle +,teilmuster,suchab);IF aktposMOD laengekurseintrag=riposTHEN LEAVE +wertnichteingetragenWITH FALSE ELSE suchab:=aktpos+1FI PER ;TRUE END PROC +wertnichteingetragen;TEXT PROC planbloecke(TEXT CONST kurs):TEXT VAR blockbez +:="",zeile;INT VAR aktsp;col(kuwa1,1);toline(kuwa1,1);WHILE NOT eof(kuwa1) +REP downety(kuwa1,kurs);IF NOT eof(kuwa1)THEN aktsp:=col(kuwa1);IF aktspMOD +laengekurs=5THEN readrecord(kuwa1,zeile);blockbezCAT text(zeile,laengeblock) +FI ;col(kuwa1,aktsp+1)FI ;PER ;text(blockbez,6)END PROC planbloecke;PROC +aenderkursinkuwa1(TEXT CONST kurs,kursneu):INT VAR aktsp;col(kuwa1,1);toline( +kuwa1,1);WHILE NOT eof(kuwa1)REP downety(kuwa1,kurs);IF NOT eof(kuwa1)THEN +aktsp:=col(kuwa1);IF aktspMOD laengekurs=5THEN readrecord(kuwa1,eintrag); +writerecord(kuwa1,text(eintrag,aktsp-1)+kursneu+subtext(eintrag,aktsp+6))FI ; +col(kuwa1,aktsp+1)FI ;PER END PROC aenderkursinkuwa1;BOOL PROC +schuelereingetragen(TEXT CONST schueler,FILE VAR file):col(file,1);toline( +file,1);downety(file,schueler);IF NOT eof(file)THEN col(file,1);TRUE ELSE +FALSE FI END PROC schuelereingetragen;PROC planbloeckezukurseintragen(TEXT +CONST kurs,planbloecke):INT VAR aktpos;col(kuwa2,1);toline(kuwa2,1);WHILE +NOT eof(kuwa2)REP downety(kuwa2,kurs);IF NOT eof(kuwa2)THEN aktpos:=col(kuwa2 +);IF aktposMOD laengekurseintrag=4THEN korrigiereintragFI ;col(kuwa2,aktpos+ +11)FI PER .korrigiereintrag:readrecord(kuwa2,eintrag);writerecord(kuwa2,text( +eintrag,aktpos+5)+planbloecke+subtext(eintrag,aktpos+12)).END PROC +planbloeckezukurseintragen;BOOL PROC kurseingetragen(TEXT CONST anwkurs): +TEXT VAR kurs:=text(anwkurs,laengekurs);indateieingetragen(kuwa0,kurs)END +PROC kurseingetragen;BOOL PROC blockeingetragen(TEXT CONST planblock): +indateieingetragen(kuwa1,planblock)END PROC blockeingetragen;BOOL PROC +indateieingetragen(FILE VAR dat,TEXT CONST suchtext):IF compress(suchtext)="" +THEN LEAVE indateieingetragenWITH FALSE FI ;toline(dat,1);col(dat,1);downety( +dat,suchtext);WHILE NOT eof(dat)REP IF col(dat)=1THEN LEAVE +indateieingetragenWITH TRUE ELSE col(dat,col(dat)+1)FI ;downety(dat,suchtext) +PER ;FALSE END PROC indateieingetragen;TEXT PROC konvsjteil(TEXT CONST jahr, +INT CONST jgstdiff):INT VAR kjahr:=int(jahr)+jgstdiff;IF kjahr>99THEN subtext +(text(kjahr),2)ELSE text(kjahr)FI END PROC konvsjteil;PROC kursdatenholen: +kuwa0:=sequentialfile(output,datei);inittupel(dnrlehrveranstaltungen);putwert +(fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr);putwert(fnrlvjgst,jgst); +statleseschleife(dnrlehrveranstaltungen,schuljahr,halbjahr,fnrlvsj,fnrlvhj, +PROC kursdatenaktodergepl);modify(kuwa0).END PROC kursdatenholen;PROC +kursdatenaktodergepl(BOOL VAR b):IF wert(fnrlvsj)<>schuljahrCOR wert(fnrlvhj) +<>halbjahrCOR wert(fnrlvjgst)<>jgstCOR dbstatus<>0THEN b:=TRUE ELSE putline( +kuwa0,text(wert(fnrlvfachkennung),laengekurs)+text(wert(fnrlvwochenstd), +laengewstd)+text(wert(fnrlvart),laengeart))FI .END PROC kursdatenaktodergepl; +PROC kurswahleinerjgstaufbereiten(TEXT CONST jgst,halbjahr,schuljahr,FILE +VAR kuwadatei):datei:=kurswahl2+jgst+" "+halbjahr+"."+schuljahr;forget(datei, +quiet);IF kuwa2eintragTHEN kuwa2:=sequentialfile(output,datei)ELSE kuwa3:= +sequentialfile(output,datei)FI ;eintrag:=trenner;holhalbjahresdaten; +holalleschueler;forget(namezwischendatei,quiet);IF kuwa2eintragTHEN modify( +kuwa2)ELSE modify(kuwa3)FI .holhalbjahresdaten:inittupel(dnrhalbjahresdaten); +changeindex;putwert(fnrhjdsj,schuljahr);putwert(fnrhjdhj,halbjahr);putwert( +fnrhjdjgst,jgst);forget(namezwischendatei,quiet);kuwahilf:=sequentialfile( +output,namezwischendatei);statleseschleife(ixhjdsjhjjgstkenn,schuljahr, +halbjahr,fnrhjdsj,fnrhjdhj,PROC zwischenspeichern);.holalleschueler:modify( +kuwahilf);IF bearbschueler<>2THEN erster:=1FI ;inittupel(dnrschueler); +parsenooffields(5);changeindex;status:=stat1;statleseschleife(ixsustatjgst, +status,text(aktjg),fnrsustatuss,fnrsusgrpjgst,PROC schuelerholen);IF aktjg=10 +THEN status:=stat2ELSE status:=stat3FI ;IF kuwa2eintragTHEN IF bearbschueler= +1THEN letzter:=lines(kuwa2)ELIF bearbschueler=2THEN erster:=lines(kuwa2)+1FI +FI ;IF aktjg<>13THEN inittupel(dnrschueler);putintwert(fnrsujgsteintr,aktjg+1 +);statleseschleife(ixsustatjgst,status,"",fnrsustatuss,fnrsusgrpjgst,PROC +neueschuelerholen);FI ;IF kuwa2eintragTHEN IF bearbschueler<>1THEN letzter:= +lines(kuwa2)FI ;IF erster=letzterTHEN letzterDECR 1FI FI ;reinitparsing.END +PROC kurswahleinerjgstaufbereiten;PROC zwischenspeichern(BOOL VAR b):IF wert( +fnrhjdsj)<>schuljahrCOR wert(fnrhjdhj)<>halbjahrCOR wert(fnrhjdjgst)<>jgst +COR dbstatus<>0THEN b:=TRUE ELSE tragwerteeinFI .tragwerteein:bereitedatenauf +(wert(fnrhjdfach),wert(fnrhjdkursart),wert(fnrhjdlerngrpkenn),wert( +fnrhjdklausurteiln));putline(kuwahilf,eintrag).END PROC zwischenspeichern; +PROC bereitedatenauf(TEXT CONST faecher,arten,kennungen,klausuren):INT VAR i, +j,l;TEXT VAR t,fach;l:=length(faecher)DIV laengefach;eintrag:="";FOR iFROM 1 +UPTO lREP holklausur;holart;holfach;holkennungPER ;eintragCAT trenner;eintrag +CAT wert(fnrhjdfamnames);eintragCAT trenner;eintragCAT wert(fnrhjdrufnames); +eintragCAT trenner;eintragCAT wert(fnrhjdgebdats).holklausur:t:=subtext( +klausuren,i,i);IF t<>""THEN eintragCAT tELSE eintragCAT " "FI .holart:j:=i* +laengeart-1;t:=subtext(arten,j,j+1);IF t<>""THEN eintragCAT tELSE eintragCAT +leereartFI .holfach:t:=subtext(faecher,j,j+1);IF t<>""THEN eintragCAT t;fach +:=tELSE eintragCAT " "FI .holkennung:j:=i*laengekennung-3;t:=subtext( +kennungen,j,j+3);IF t<>""THEN eintragCAT t;IF plblvorhandenTHEN +holplanbloeckeELSE eintragCAT leereplanbloeckeFI ELSE eintragCAT leerekennung ++leereplanbloeckeFI .holplanbloecke:eintragCAT planbloecke(fach+t).END PROC +bereitedatenauf;PROC schuelerholen(BOOL VAR b):IF wert(fnrsustatuss)<>status +COR intwert(fnrsusgrpjgst)<>aktjgCOR dbstatus<>0THEN dbstatus(1);b:=TRUE +ELSE schuelerdatenerstellen(kzschueler)FI .END PROC schuelerholen;PROC +neueschuelerholen(BOOL VAR b):IF wert(fnrsustatuss)<>statusCOR dbstatus<>0 +THEN dbstatus(1);b:=TRUE ELIF intwert(fnrsujgsteintr)=aktjg+1THEN +schuelerdatenerstellen(kzneue)FI .END PROC neueschuelerholen;PROC +schuelerdatenerstellen(TEXT CONST schuelerkennung):TEXT VAR famname,rufname, +gebdatum,eintragkuwahilf;famname:=wert(fnrsufamnames);rufname:=wert( +fnrsurufnames);gebdatum:=wert(fnrsugebdatums);eintragkuwahilf:=trenner+ +famname+trenner+rufname+trenner+gebdatum;IF keinehjdatenTHEN +schreibleereintragELSE suchinkuwahilfFI .keinehjdaten:eintrag=trenner. +suchinkuwahilf:col(kuwahilf,1);toline(kuwahilf,1);downety(kuwahilf, +eintragkuwahilf);IF eof(kuwahilf)THEN schreibleereintragELSE col(kuwahilf,1); +readrecord(kuwahilf,eintragkuwahilf);eintragkuwahilfCAT schuelerkennung;IF +kuwa2eintragTHEN putline(kuwa2,eintragkuwahilf)ELSE putline(kuwa3, +eintragkuwahilf)FI ;FI .schreibleereintrag:eintragkuwahilfCAT schuelerkennung +;IF kuwa2eintragTHEN putline(kuwa2,eintragkuwahilf)ELSE putline(kuwa3, +eintragkuwahilf)FI .END PROC schuelerdatenerstellen;BOOL PROC +halbjahrnichtgesetzt:schuljahr="0000"END PROC halbjahrnichtgesetzt;TEXT PROC +gesperrterdatenraumname(TEXT CONST namepraefix):praefixsperre+datenraumname( +namepraefix)END PROC gesperrterdatenraumname;TEXT PROC datenraumname(TEXT +CONST namepraefix):TEXT VAR name:=namepraefix;nameCAT jgst;nameCAT " ";name +CAT halbjahr;nameCAT ".";nameCAT schuljahr;nameEND PROC datenraumname;TEXT +PROC formbezeichner(TEXT CONST bezeichner):TEXT VAR bez:="",erg:="";INT VAR +ibez:=int(bezeichner);IF bezeichner=""THEN LEAVE formbezeichnerWITH +bezeichnerFI ;IF NOT (lastconversionok)THEN erg:=bezeichnerSUB 3;IF NOT (erg= +kennungtplbl1COR erg=kennungtplbl2)THEN LEAVE formbezeichnerWITH ""FI ELSE +erg:=" "FI ;IF ibez<10THEN bezCAT "0";bezCAT text(ibez)ELSE bezCAT text(ibez) +FI ;bezCAT erg;bezEND PROC formbezeichner;END PACKET +kurswahlschnittstelle240791; + diff --git a/app/schulis/2.2.1/src/2.kurszuordnung und umwahl fuer einzelne schueler sek2 b/app/schulis/2.2.1/src/2.kurszuordnung und umwahl fuer einzelne schueler sek2 new file mode 100644 index 0000000..2c44f7d --- /dev/null +++ b/app/schulis/2.2.1/src/2.kurszuordnung und umwahl fuer einzelne schueler sek2 @@ -0,0 +1,420 @@ +PACKET kurszuordnungundumwahlfuereinzelneschuelersek2DEFINES +kurszuordnungundumwahlsek2anfang,kurszuordnungundumwahlbearbeiten, +kurszuordnungundumwahlspeichern,kurszuordnungundumwahlkurselisten, +kurszuordnungundumwahlkopieren,kurszuordnungundumwahlrechtehaelfte, +kurszuordnungundumwahllinkehaelfte,kurszuordnungundumwahlvorwaerts, +kurszuordnungundumwahlrueckwaerts,kurszuordnungundumwahlbeenden, +kurszuordnungundumwahllistezeigen,kurszuordnungundumwahllisteblaettern, +kurszuordnungundumwahllistebearbeiten,kurszuordnungundumwahllistebeenden:LET +artbestand="c02 art lehrveranstaltung",abiklbestand="c02 abitur klausur", +kuwa2sperre="Kurswahl-2 ",eingangsmaske= +"ms kurszuordnung und umwahl sek2 eingang",bearbmaske= +"ms kurszuordnung und umwahl sek2 bearb",listenmaske="mu objektliste", +schuljahr="Schuljahr",halbjahr="Schulhalbjahr",laengefake=6,laengefakeartkl=9 +,laengevname=15,laengeplbleinesbs=36,laengekurseeinesbs=42,laengefamname=30, +laengegebdat=8,laengename=53,einganggewjgst=2,einganggewhj=3,eingangaktjgst=4 +,eingangaktneue=5,eingangfamname=6,eingangrufname=7,eingangdatum=8,bearbname= +2,bearbfaecher=3,bearbkurse=42,meldungwarten=69,meldungpraezisieren=129, +meldungpruefen=329,meldungspeichern=50,meldungnspeichern=63, +meldungfeldfuellen=52,meldungfalschejgst=404,meldungfalscheshj=405, +meldungandereauswahl=318,meldunglistezeigen=7,meldungkeineschueler=423, +meldungserverfehler=416,meldungkeinblaettern=72,meldungfalschesfach=310, +meldungfalscheart=311,meldungunbeklv=360,meldungblockschnitt=424, +meldungspfehler=419,meldungparallelanw=425,meldungfalscheartzk=434, +meldungunbekannt=126,trenner="�",leerespraefix=" ",leererblock=" ", +leerebloecke=" ",ausgzeichen="#",namenstrenner=", ",kzdoppeltbelegt= +" * ",kzfaecher="F",kznurneue="N",kzname="N",kzohneneue="O",kzkurse="K", +kzalle="A",kzart="A",kzstd="S",kzplbl="P",kzfaplbl="FP",kzfakeartkl="FKAk", +logtext1="Anw. 2.3.1 Umwahl ",text1=" """,text2=""" ",punkt=".",komma=", ", +ersteslistenfeld=2,erstesfachfeld=3,ersteskursfeld=42,anzbearbeingfelder=13, +anzlistenfelder=18,anzbearbzeilen=12,anzfeldereingang=8;TEXT VAR gewsj,aktsj +:="0000",akthj,gewjgst,gewhj,aktjgst,aktneue,aktwahl,aktname,aktvname, +aktgebdatum,aktfaecher,aktartkl,aktkurse,aktschueler,schuelergruppe, +schuelerliste,aktblock,alleplanbloecke:="",faecherbloecke,wahldaten,fach,art, +klausur,kennung,fehlerblock,allearten:=trenner,allefaecher:=trenner,block12, +block1,block2,alleklausurbez:="",praefix,kurse,pruefbloecke:=trenner, +logmeldung;INT VAR i,j,letztepos:=2,fstat:=0,aktlistennr,fachfeld:= +erstesfachfeld,artfeld:=16,klfeld:=17,kursfeld:=ersteskursfeld,aktplblindex:= +1,anfpos,aktbsseite:=1,letztesfeld,listenpos:=1,aktindex,ersterindex:= +ersterschueler;ROW anzbearbeingfelderROW 4TEXT VAR bearbrow;ROW +anzfeldereingangTEXT VAR eingangrow;ROW anzlistenfelderTEXT VAR aktliste; +BOOL VAR listenbearbeitung:=FALSE ,rechtsscrollen:=FALSE ,sperreok, +kopierfunktion:=FALSE ,scrollen:=FALSE ;WINDOW VAR w;initroweingang; +initrowbearb;PROC initroweingang:FOR iFROM 2UPTO anzfeldereingangREP +eingangrow(i):=""PER ;END PROC initroweingang;PROC initrowbearb:INT VAR i; +FOR iFROM 1UPTO anzbearbeingfelderREP bearbrow(i):=ROW 4TEXT :("","","","") +PER ;END PROC initrowbearb;PROC kurszuordnungundumwahlsek2anfang:aktplblindex +:=1;standardstartproc(eingangsmaske);gibeingangaus;infeld(1); +standardfelderausgeben;infeld(letztepos);standardnproc.gibeingangaus:FOR i +FROM 2UPTO anzfeldereingangREP standardmaskenfeld(eingangrow(i),i);IF +eingangrow(i)<>""THEN letztepos:=iFI PER .END PROC +kurszuordnungundumwahlsek2anfang;PROC kurszuordnungundumwahlbearbeiten: +listenbearbeitung:=FALSE ;kopierfunktion:=FALSE ;schuelerliste:=""; +standardmeldung(meldungwarten,"");merkeeingang;aktname:=eingangrow( +eingangfamname);aktvname:=eingangrow(eingangrufname);aktgebdatum:=konvdatum( +eingangrow(eingangdatum));prueffeld2bis5;IF fstat<>0THEN LEAVE +kurszuordnungundumwahlbearbeitenFI ;kurswahlinitialisieren(aktjgst,gewjgst, +gewhj,schuelergruppe,gewsj);kurswahlbasisholen(fstat);IF fstat<>0THEN +meldungausgeben(meldungserverfehler,einganggewjgst,1);LEAVE +kurszuordnungundumwahlbearbeitenELIF letzterschueler0THEN meldungausgeben(meldungunbekannt,eingangfamname,1); +kurswahlsperrebeenden(kuwa2sperre);LEAVE kurszuordnungundumwahlbearbeitenFI . +END PROC kurszuordnungundumwahlbearbeiten;PROC schuelerbearbeiten:INT VAR +kurspos,rowindex:=1;aktschueler:=aktname+namenstrenner+aktvname+namenstrenner ++aktgebdatum;initrowbearb;ermittlefaecherartklkurse;standardmaskenfeld(text( +aktschueler,laengename),bearbname);zeigplanblockkurszuordnung. +ermittlefaecherartklkurse:fachfeld:=erstesfachfeld;artfeld:=16;klfeld:=17; +kursfeld:=ersteskursfeld;kurspos:=1;aktfaecher:="";aktartkl:="";aktkurse:=""; +rowindex:=1;aktwahl:=wahldatenzumschueler(aktname,aktvname,aktgebdatum, +kzfakeartkl);IF dbstatus=1COR aktwahl=""THEN aktwahl:="";initrowbearb;FOR j +FROM 1UPTO anzbearbeingfelderREP standardmaskenfeld("",fachfeld); +standardmaskenfeld("",artfeld);standardmaskenfeld("",klfeld); +standardmaskenfeld("",kursfeld);fachfeldINCR 1;artfeldINCR 2;klfeldINCR 2; +kursfeldINCR 1;PER ;ELSE gibwahlausFI .gibwahlaus:WHILE kursposlaengeplbleinesbs; +zeigbearbdaten(aktplblindex).END PROC schuelerbearbeiten;PROC zeigbearbdaten( +INT CONST planblocknr):INT VAR blockpos:=planblocknr*3-2;pruefbloecke:= +trenner;faecherbloecke:=wahldatenzumschueler(aktname,aktvname,aktgebdatum, +kzfaplbl);rechtsscrollen:=FALSE ;FOR iFROM 1UPTO anzbearbzeilenREP aktblock:= +subtext(alleplanbloecke,blockpos,blockpos+2);IF aktblock=""THEN scrollen:= +FALSE ;standardmaskenfeld("",i*4+51);standardmaskenfeld("",i*4+52); +standardmaskenfeld("",i*4+53);standardmaskenfeld("",i*4+54)ELSE +standardmaskenfeld(konvplanblock(aktblock),i*4+51);standardmaskenfeld( +planblockdaten(aktblock,kzstd),i*4+52);standardmaskenfeld("",i*4+53); +ermittlemoeglichekurse;blockposINCR 3;FI ;PER ; +kurszuordnungundumwahlkopierenvorbereiten;infeld(erstesfachfeld).END PROC +zeigbearbdaten;PROC ermittlemoeglichekurse:TEXT VAR kurse:=planblockdaten( +aktblock,kzkurse),ausgabekurse;INT VAR kurspos:=1,berhilfe:=aktbsseite* +laengekurseeinesbs;IF length(kurse)>berhilfeTHEN rechtsscrollen:=TRUE ;FI ; +kurse:=subtext(kurse,berhilfe-laengekurseeinesbs+1,berhilfe);konvkurse; +standardmaskenfeld(ausgabekurse,i*4+54).konvkurse:ausgabekurse:="";kurspos:=1 +;WHILE kursposlength(schuelerliste)THEN kurswahlsperrebeenden(kuwa2sperre);enter(3)ELSE +kopierfunktion:=FALSE ;IF naechsterschuelerTHEN infeld(1);schuelerbearbeiten; +return(1)ELSE kurswahlsperrebeenden(kuwa2sperre);enter(3)FI FI ;ELSE +kurswahlsperrebeenden(kuwa2sperre);enter(2)FI .pruefundspeicheraenderungen: +standardmeldung(meldungpruefen,"");fachfeld:=erstesfachfeld;artfeld:=16; +klfeld:=17;kursfeld:=ersteskursfeld;aenderung:=FALSE ;wahldaten:="";FOR i +FROM 1UPTO anzbearbeingfelderREP infeld(fachfeld);fach:=standardmaskenfeld( +fachfeld);art:=standardmaskenfeld(artfeld);klausur:=standardmaskenfeld(klfeld +);kennung:=standardmaskenfeld(kursfeld);block12:=kursdaten(text(fach,2)+ +kennung,kzplbl);IF fach<>bearbrow(i)(1)COR art<>bearbrow(i)(2)COR klausur<> +bearbrow(i)(3)COR kennung<>bearbrow(i)(4)THEN aenderung:=TRUE FI ;IF fach<>"" +THEN IF art=""CAND kennung=""THEN meldungfeldfuellenausgebenELSE prueffachFI +ELIF art<>""COR kennung<>""THEN meldungfeldfachfuellenausgeben;LEAVE +kurszuordnungundumwahlspeichernFI ;IF art<>""THEN pruefartFI ;IF kennung<>"" +THEN pruefkennung;pruefartzumkurs;IF block12<>leerebloeckeTHEN +pruefkursueberschneidungFI FI ;IF fach<>""THEN wahldatenCAT text(klausur,1); +wahldatenCAT text(art,2);wahldatenCAT text(fach,2);wahldatenCAT text(kennung, +4);wahldatenCAT text(block12,6)FI ;fachfeldINCR 1;artfeldINCR 2;klfeldINCR 2; +kursfeldINCR 1PER ;IF aenderungTHEN standardmeldung(meldungspeichern,""); +schuelerwahleintragen(aktname,aktvname,aktgebdatum,wahldaten);IF dbstatus<>0 +THEN meldungausgeben(meldungspfehler,bearbfaecher,1);LEAVE +kurszuordnungundumwahlspeichernELSE logbucheintragvornehmen;kurswahl2sichern( +fstat)FI FI .prueffach:IF allefaecher=trennerTHEN holepruefdatenFI ;IF pos( +allefaecher,trenner+fach+trenner)=0THEN meldungausgeben(meldungfalschesfach, +fachfeld,1);LEAVE kurszuordnungundumwahlspeichernFI .pruefart:IF pos( +allearten,trenner+art+trenner)=0THEN meldungausgeben(meldungfalscheart, +artfeld,1);LEAVE kurszuordnungundumwahlspeichernFI .pruefkennung:std:= +compress(kursdaten(text(fach,2)+text(kennung,4),kzart));IF dbstatus<>0THEN +standardmeldung(meldungunbeklv,text(fach,2)+kennung+ausgzeichen);infeld( +kursfeld);return(1);LEAVE kurszuordnungundumwahlspeichernFI .pruefartzumkurs: +IF art<>""CAND std<>artCAND std<>""THEN meldungfalscheartausgeben;LEAVE +kurszuordnungundumwahlspeichernFI .pruefkursueberschneidung:TEXT VAR kuform; +block1:=text(block12,3);block2:=subtext(block12,4);FOR jFROM 1UPTO i-1REP fa +:=standardmaskenfeld(erstesfachfeld+j-1);ke:=standardmaskenfeld( +ersteskursfeld+j-1);kuform:=text(text(fa,2)+ke,laengefake);IF fa<>""CAND ke<> +""THEN IF kuform<>text(text(fach,2)+kennung,laengefake)THEN IF +planblockschnitt(kuform)THEN meldungblockschnittausgeben;LEAVE +kurszuordnungundumwahlspeichernFI FI FI PER ;FOR jFROM i+1UPTO +anzbearbeingfelderREP fa:=standardmaskenfeld(erstesfachfeld+j-1);ke:= +standardmaskenfeld(ersteskursfeld+j-1);kuform:=text(text(fa,2)+ke,laengefake) +;IF fa<>""CAND ke<>""THEN IF kuform<>text(text(fach,2)+kennung,laengefake) +THEN IF planblockschnitt(kuform)THEN meldungblockschnittausgeben;LEAVE +kurszuordnungundumwahlspeichernFI FI FI PER .meldungfeldfuellenausgeben: +meldungausgeben(meldungfeldfuellen,artfeld,1).meldungfeldfachfuellenausgeben: +meldungausgeben(meldungfeldfuellen,fachfeld,1).meldungfalscheartausgeben: +standardmeldung(meldungfalscheartzk,text(fach,2)+kennung+ausgzeichen+std+ +ausgzeichen);infeld(artfeld);return(1).meldungblockschnittausgeben: +standardmeldung(meldungblockschnitt,compress(fehlerblock)+ausgzeichen);infeld +(kursfeld);return(1).END PROC kurszuordnungundumwahlspeichern;BOOL PROC +naechsterschueler:aktindex:=int(subtext(schuelerliste,listenpos,listenpos+2)) +;belegeglobalevariablen(aktindex);listenposINCR 4;aktname<>""END PROC +naechsterschueler;BOOL PROC planblockschnitt(TEXT CONST andererkurs):TEXT +VAR bl1,bl2,bl12;IF compress(andererkurs)=""THEN LEAVE planblockschnittWITH +FALSE ELIF block1=leererblockCAND block2=leererblockTHEN LEAVE +planblockschnittWITH FALSE FI ;bl12:=kursdaten(andererkurs,kzplbl);IF +dbstatus=1THEN LEAVE planblockschnittWITH FALSE FI ;IF bl12=leerebloeckeTHEN +LEAVE planblockschnittWITH FALSE FI ;IF block1<>leererblockTHEN bl1:=text( +bl12,3);IF block1ganzerblockCOR bl1ganzerblockTHEN block1:=text(block1,2);bl1 +:=text(bl12,2);ELSE bl1:=text(bl12,3)FI ;IF block1=bl1COR block1=bl2THEN +fehlerblock:=block1;LEAVE planblockschnittWITH TRUE FI ;FI ;IF block2<> +leererblockTHEN bl2:=subtext(bl12,4);IF block2ganzerblockCOR bl2ganzerblock +THEN block2:=text(block2,2);bl2:=subtext(bl12,4,5)ELSE bl2:=subtext(bl12,4) +FI ;IF block2=bl1COR block2=bl2THEN fehlerblock:=block2;LEAVE +planblockschnittWITH TRUE FI ;FI ;FALSE .block1ganzerblock:(block1SUB 3)=" ". +bl1ganzerblock:(bl1SUB 3)=" ".block2ganzerblock:(block2SUB 3)=" ". +bl2ganzerblock:(bl2SUB 3)=" ".END PROC planblockschnitt;PROC holepruefdaten: +allefaecher:=trenner;allearten:=trenner;inittupel(dnrfaecher); +statleseschleife(dnrfaecher,"","",fnrffach,fnrffach,PROC sammleallefaecher); +inittupel(dnrschluessel);statleseschleife(dnrschluessel,artbestand,"", +fnrschlsachgebiet,fnrschlschluessel,PROC sammleallearten)END PROC +holepruefdaten;PROC sammleallefaecher(BOOL VAR b):allefaecherCAT wert( +fnrffach);allefaecherCAT trennerEND PROC sammleallefaecher;PROC +sammleallearten(BOOL VAR b):IF wert(fnrschlsachgebiet)>artbestandCOR dbstatus +<>0THEN b:=TRUE ELSE alleartenCAT wert(fnrschlschluessel);alleartenCAT +trenner;alleartenCAT text(wert(fnrschlschluessel),2);alleartenCAT trennerFI +END PROC sammleallearten;PROC kurszuordnungundumwahlkurselisten:TEXT VAR +kursliste,liste,ausgabeart;INT VAR aktfeld;kursliste:="";aktfeld:=infeld;w:= +startwindow(20,23,77,1);liste:="";standardmeldung(meldunglistezeigen,"");#IF +menuedraussen08.02.91THEN reorganizescreenFI ;#fuelleliste;infeld(1); +standardfelderausgeben;open(w);auskunfterteilung(liste,w,FALSE ); +reorganizescreen;setlasteditvalues;infeld(aktfeld);return(1).fuelleliste: +holklausurkuerzel;listeCAT "Zusammensetzung der Kurse";listeCAT +auskunftstextende;listeCAT " ";listeCAT auskunftstextende;listeCAT +"Fach Art Kurs Schüler Klausur";listeCAT auskunftstextende;listeCAT +" ges. ";FOR iFROM 1UPTO 6REP IF (alleklausurbezSUB i)<>"" +THEN listeCAT text((alleklausurbezSUB i),5)FI PER ;listeCAT auskunftstextende +;listeallerkurse.holklausurkuerzel:IF alleklausurbez=""THEN statleseschleife( +dnrschluessel,abiklbestand,"",fnrschlsachgebiet,fnrschlschluessel,PROC +sammlealleabikl)FI .listeallerkurse:belegefachart;betrachtekurse;anfpos:=1; +praefix:=text(fach,5)+text(ausgabeart,4);WHILE anfpos""THEN praefix:=leerespraefixFI ;kennung:= +subtext(kursliste,anfpos,anfpos+3);listeCAT text(kennung,6);listeCAT text( +anzahlschuelermitwahl(fach,kennung,"",""),3);listeCAT " ";FOR iFROM 1UPTO 6 +REP IF (alleklausurbezSUB i)<>""THEN listeCAT text(anzahlschuelermitwahl(fach +,kennung,ausgabeart,(alleklausurbezSUB i)),5)FI PER ;listeCAT +auskunftstextende;anfposINCR 4PER ;listeCAT auskunftstextende.betrachtekurse: +anfpos:=1;kursliste:="";kurse:=allekurse;WHILE anfpos<>0REP anfpos:=pos(kurse +,fach,anfpos);IF anfposMOD 10=1THEN IF subtext(kurse,anfpos,anfpos+1)=text( +fach,2)CAND subtext(kurse,anfpos+8,anfpos+9)=text(art,2)THEN kurslisteCAT +subtext(kurse,anfpos+2,anfpos+5)FI FI ;IF anfpos<>0THEN anfposINCR 1FI PER ; +IF kursliste=""THEN ausgabeart:="";ermittleallekursezumfachELSE ausgabeart:= +artFI .ermittleallekursezumfach:anfpos:=1;kursliste:="";WHILE anfpos<>0REP +anfpos:=pos(kurse,fach,anfpos);IF anfposMOD 10=1THEN IF subtext(kurse,anfpos, +anfpos+1)=fachTHEN kurslisteCAT subtext(kurse,anfpos+2,anfpos+5)FI FI ;IF +anfpos<>0THEN anfposINCR 1FI PER .belegefachart:aktfeld:=infeld;IF aktfeld>2 +CAND aktfeld<16THEN fach:=standardmaskenfeld(aktfeld);art:=standardmaskenfeld +(((aktfeld-2)*2-1)+15)ELIF aktfeld>15CAND aktfeld<42THEN fach:= +standardmaskenfeld(aktfeldDIV 2-5);IF aktfeldMOD 2=0THEN art:= +standardmaskenfeld(aktfeld)ELSE art:=standardmaskenfeld(aktfeld-1)FI ELSE +fach:=standardmaskenfeld(aktfeld-39);art:=standardmaskenfeld((aktfeld-39)*2+ +10)FI ;art:=compress(art).END PROC kurszuordnungundumwahlkurselisten;PROC +kurszuordnungundumwahllistebeenden:kurswahlsperrebeenden(kuwa2sperre);enter(2 +)END PROC kurszuordnungundumwahllistebeenden;PROC sammlealleabikl(BOOL VAR b) +:IF wert(fnrschlsachgebiet)>abiklbestandCOR dbstatus<>0THEN b:=TRUE ELSE +alleklausurbezCAT wert(fnrschlschluessel)FI END PROC sammlealleabikl;PROC +kurszuordnungundumwahlkopierenvorbereiten:TEXT VAR fa,ke,f,k,aktplbl;INT VAR +z;TEXT VAR var:="",neuerkurseintrag:="";IF pruefbloecke=trennerTHEN +ermittlegezeigtebloecke;FI ;FOR jFROM 1UPTO anzbearbeingfelderREP fa:= +standardmaskenfeld(bearbfaecher+j-1);ke:=standardmaskenfeld(bearbkurse+j-1); +IF altedatenleerundneuedatenTHEN neuedateneintragenELIF +altedatenundneuedatenleerTHEN altedatenloeschenELIF altedatenundneuedaten +THEN altedatenloeschenundneuedateneintragenFI ;bearbrow(j)(1):=fa;bearbrow(j) +(4):=kePER ;standardfelderausgeben.altedatenleerundneuedaten:bearbrow(j)(4)= +""CAND fa<>""CAND ke<>"".altedatenundneuedatenleer:bearbrow(j)(1)<>""CAND +bearbrow(j)(4)<>""CAND ke="".altedatenundneuedaten:bearbrow(j)(1)<>""CAND +bearbrow(j)(4)<>""CAND fa<>""CAND ke<>"".ermittlegezeigtebloecke:aktplbl:= +subtext(alleplanbloecke,aktplblindex*3-2,(aktplblindex+anzbearbzeilen-1)*3); +pruefbloecke:=trenner;FOR jFROM 1UPTO length(aktplbl)DIV 3REP pruefbloecke +CAT subtext(aktplbl,j*3-2,j*3);pruefbloeckeCAT trennerPER .neuedateneintragen +:faecherbloecke:=kursdaten(text(fa,2)+ke,kzplbl);IF faecherbloecke= +leerebloeckeTHEN LEAVE neuedateneintragenFI ;aktplbl:=text(faecherbloecke,3); +IF aktplbl<>leererblockTHEN i:=pos(pruefbloecke,trenner+aktplbl+trenner);IF i +>0THEN i:=iDIV 4+1;tragneuenkurseinFI FI ;aktplbl:=subtext(faecherbloecke,4); +IF aktplbl<>leererblockTHEN i:=pos(pruefbloecke,trenner+aktplbl+trenner);IF i +>0THEN i:=iDIV 4+1;tragneuenkurseinFI FI .tragneuenkursein:IF +standardmaskenfeld(i*4+53)<>""CAND standardmaskenfeld(i*4+53)<>text(fa,2)+ +text(ke,4)THEN standardmaskenfeld(kzdoppeltbelegt,i*4+53)ELSE +standardmaskenfeld(text(fa,2)+text(ke,4),i*4+53)FI .altedatenloeschen: +loescheintrag.altedatenloeschenundneuedateneintragen:IF bearbrow(j)(1)<>fa +COR bearbrow(j)(4)<>keTHEN loescheintragFI ;neuedateneintragen.loescheintrag: +faecherbloecke:=kursdaten(text(bearbrow(j)(1),2)+bearbrow(j)(4),kzplbl);IF +faecherbloecke=leerebloeckeTHEN LEAVE loescheintragFI ;aktplbl:=text( +faecherbloecke,3);IF aktplbl<>leererblockTHEN i:=pos(pruefbloecke,trenner+ +aktplbl+trenner);IF i>0THEN i:=iDIV 4+1;IF standardmaskenfeld(i*4+53)= +kzdoppeltbelegtTHEN traganderenkurseinELSE standardmaskenfeld("",i*4+53)FI +FI FI ;aktplbl:=subtext(faecherbloecke,4);IF aktplbl<>leererblockTHEN i:=pos( +pruefbloecke,trenner+aktplbl+trenner);IF i>0THEN i:=iDIV 4+1;IF +standardmaskenfeld(i*4+53)=kzdoppeltbelegtTHEN traganderenkurseinELSE +standardmaskenfeld("",i*4+53)FI FI FI .traganderenkursein:neuerkurseintrag:= +"";FOR zFROM 1UPTO j-1REP f:=standardmaskenfeld(bearbfaecher+z-1);IF f<>"" +THEN k:=standardmaskenfeld(bearbkurse+z-1);IF k<>""THEN var:=text(f,2)+k;var +:=kursdaten(var,kzplbl);IF text(var,3)=aktplblCOR subtext(var,4)=aktplblTHEN +IF neuerkurseintrag=""THEN neuerkurseintrag:=text(f,2)+text(k,4)ELSE +standardmaskenfeld(kzdoppeltbelegt,i*4+53);LEAVE traganderenkurseinFI FI FI +FI PER ;FOR zFROM j+1UPTO anzbearbeingfelderREP f:=standardmaskenfeld( +bearbfaecher+z-1);IF f<>""THEN k:=standardmaskenfeld(bearbkurse+z-1);IF k<>"" +THEN var:=text(f,2)+k;var:=kursdaten(var,kzplbl);IF text(var,3)=aktplblCOR +subtext(var,4)=aktplblTHEN IF neuerkurseintrag=""THEN neuerkurseintrag:=text( +f,2)+text(k,4)ELSE standardmaskenfeld(kzdoppeltbelegt,i*4+53);LEAVE +traganderenkurseinFI FI FI FI PER ;IF neuerkurseintrag=""THEN +standardmaskenfeld("",i*4+53)ELSE tragkursausehemdoppelbeleinFI . +tragkursausehemdoppelbelein:standardmaskenfeld(neuerkurseintrag,i*4+53).END +PROC kurszuordnungundumwahlkopierenvorbereiten;PROC +kurszuordnungundumwahlkopieren:kopierfunktion:=TRUE ; +kurszuordnungundumwahlkopierenvorbereiten;kopierfunktion:=FALSE ;return(1) +END PROC kurszuordnungundumwahlkopieren;PROC +kurszuordnungundumwahlrechtehaelfte:INT VAR blockpos:=aktplblindex*3-2, +aktfeld:=infeld;IF rechtsscrollenTHEN aktbsseiteINCR 1; +zeigweiteremoeglichekurseELSE letztesfeld:=infeld;meldungausgeben( +meldungkeinblaettern,letztesfeld,1)FI .zeigweiteremoeglichekurse:FOR iFROM 1 +UPTO anzbearbzeilenREP aktblock:=subtext(alleplanbloecke,blockpos,blockpos+2) +;IF aktblock=""THEN standardmaskenfeld("",i*4+54)ELSE ermittlemoeglichekurse; +blockposINCR 3;FI ;PER ;infeld(1);standardfelderausgeben;infeld(aktfeld); +return(1).END PROC kurszuordnungundumwahlrechtehaelfte;PROC +kurszuordnungundumwahllinkehaelfte:INT VAR blockpos:=aktplblindex*3-2,aktfeld +:=infeld;IF aktbsseite<>1THEN rechtsscrollen:=TRUE ;aktbsseiteDECR 1; +zeigweiteremoeglichekurseELSE letztesfeld:=infeld;meldungausgeben( +meldungkeinblaettern,letztesfeld,1)FI .zeigweiteremoeglichekurse:FOR iFROM 1 +UPTO anzbearbzeilenREP aktblock:=subtext(alleplanbloecke,blockpos,blockpos+2) +;IF aktblock=""THEN standardmaskenfeld("",i*4+54)ELSE ermittlemoeglichekurse; +blockposINCR 3;FI ;PER ;infeld(1);standardfelderausgeben;infeld(aktfeld); +return(1).END PROC kurszuordnungundumwahllinkehaelfte;PROC +kurszuordnungundumwahlvorwaerts:INT VAR aktfeld:=infeld;IF scrollenTHEN +aktplblindexINCR anzbearbzeilen;zeigbearbdaten(aktplblindex);infeld(aktfeld); +return(1)ELSE letztesfeld:=infeld;meldungausgeben(meldungkeinblaettern, +letztesfeld,1)FI END PROC kurszuordnungundumwahlvorwaerts;PROC +kurszuordnungundumwahlrueckwaerts:INT VAR aktfeld:=infeld;IF aktplblindex>1 +THEN scrollen:=TRUE ;aktplblindexDECR anzbearbzeilen;zeigbearbdaten( +aktplblindex);infeld(aktfeld);return(1)ELSE letztesfeld:=infeld; +meldungausgeben(meldungkeinblaettern,letztesfeld,1)FI END PROC +kurszuordnungundumwahlrueckwaerts;PROC kurszuordnungundumwahlbeenden: +kurswahlsperrebeenden(kuwa2sperre);IF listenbearbeitungTHEN enter(3)ELSE +enter(2)FI END PROC kurszuordnungundumwahlbeenden;BOOL PROC datumkorrekt: +standardpruefe(6,eingangdatum,1,1,"",fstat);fstat=0END PROC datumkorrekt; +PROC prueffeld2bis5:fstat:=0;IF aktsj="0000"THEN aktsj:=schulkenndatum( +schuljahr);akthj:=schulkenndatum(halbjahr)FI ;gewjgst:=eingangrow( +einganggewjgst);gewhj:=eingangrow(einganggewhj);aktjgst:=eingangrow( +eingangaktjgst);aktneue:=eingangrow(eingangaktneue);prueffeld2;prueffeld3; +prueffeld4und5;prueffeld4;IF fstat=1THEN LEAVE prueffeld2bis5FI ;prueffeld5. +prueffeld2:i:=int(gewjgst);IF gewjgst=""THEN meldungausgeben( +meldungfeldfuellen,einganggewjgst,1);LEAVE prueffeld2bis5ELIF i<11COR i>14 +THEN meldungausgeben(meldungfalschejgst,einganggewjgst,1);LEAVE +prueffeld2bis5FI .prueffeld3:i:=int(gewhj);IF gewhj=""THEN meldungausgeben( +meldungfeldfuellen,einganggewhj,1);LEAVE prueffeld2bis5ELIF i<1COR i>2THEN +meldungausgeben(meldungfalscheshj,einganggewhj,1);LEAVE prueffeld2bis5FI . +prueffeld4und5:IF aktjgst=""CAND aktneue=""THEN meldungausgeben( +meldungpraezisieren,eingangaktjgst,1);LEAVE prueffeld2bis5ELIF aktjgst="" +CAND aktneue<>""THEN schuelergruppe:=kznurneueELIF aktjgst<>""CAND aktneue="" +THEN schuelergruppe:=kzohneneueELSE schuelergruppe:=kzalleFI .prueffeld4:i:= +int(aktjgst);IF i<10COR i>14THEN meldungausgeben(meldungfalschejgst, +einganggewjgst,1)ELIF i>int(gewjgst)THEN meldungausgeben(meldungandereauswahl +,einganggewjgst,1)ELIF i=int(gewjgst)THEN IF gewhj="1"CAND akthj="2"THEN +meldungausgeben(meldungandereauswahl,einganggewhj,1)FI FI .prueffeld5:i:=int( +aktneue);IF aktneue<>""CAND aktjgst<>""THEN IF i-1<>int(aktjgst)THEN +meldungausgeben(meldungandereauswahl,eingangaktneue,1)FI ELIF aktneue<>"" +CAND aktjgst=""THEN IF i<11COR i>14THEN meldungausgeben(meldungfalschejgst, +eingangaktneue,1)ELIF i+1>int(gewjgst)THEN meldungausgeben( +meldungandereauswahl,eingangaktneue,1)ELIF i-1=int(gewjgst)THEN IF gewhj="1" +CAND akthj="2"THEN meldungausgeben(meldungandereauswahl,einganggewhj,1)FI FI +FI .END PROC prueffeld2bis5;PROC kurszuordnungundumwahllistezeigen: +standardmeldung(meldungwarten,"");merkeeingang;prueffeld2bis5;IF fstat<>0 +THEN LEAVE kurszuordnungundumwahllistezeigenELSE standardmeldung( +meldunglistezeigen,"");kurswahlinitialisieren(aktjgst,gewjgst,gewhj, +schuelergruppe,gewsj);kurswahlbasisholen(fstat);IF fstat<>0THEN +meldungausgeben(meldungserverfehler,einganggewjgst,1);LEAVE +kurszuordnungundumwahllistezeigenELIF letzterschueler0THEN +standardmaskenfeld("x",i*2);aktliste(i):="x"ELSE standardmaskenfeld("",i*2); +aktliste(i):=""FI PER ;infeld(1);standardfelderausgeben;infeld( +ersteslistenfeld).END PROC zeigliste;PROC suchindices:TEXT VAR aktname; +aktname:=eingangrow(eingangfamname);IF aktname=""THEN ersterindex:= +ersterschuelerELSE vergleichnamenFI .vergleichnamen:aktname:=text(aktname, +laengefamname);aktnameCAT trenner;aktnameCAT text(eingangrow(eingangrufname), +laengevname);aktnameCAT trenner;aktnameCAT text(eingangrow(eingangdatum), +laengegebdat);aktnameCAT trenner;FOR iFROM ersterschuelerUPTO letzterschueler +REP IF wahldatenzumindex(i,kzname)>=aktnameTHEN ersterindex:=i;LEAVE +suchindicesFI PER ;ersterindex:=letzterschueler.END PROC suchindices;PROC +kurszuordnungundumwahllisteblaettern(INT CONST aktion):INT VAR +ersterschuelerletzterbs,aktfeld:=infeld;IF aktion=1THEN IF aktlistennr<> +ersterschuelerTHEN analysierekennzeichnungen;ersterindex:=ersterschueler; +zeigliste(ersterindex);return(1)ELSE fehlermeldungaktionnichtmöglichFI ELIF +aktion=2THEN ersterschuelerletzterbs:=letzterschueler-anzlistenfelder+1;IF +aktlistennrersterschuelerletzterbs +THEN analysierekennzeichnungen;zeigliste(ersterschuelerletzterbs);return(1) +ELIF aktlistennr=ersterschuelerletzterbsTHEN fehlermeldungaktionnichtmöglich +FI ELIF aktion=3THEN IF aktlistennr>=letzterschueler-anzlistenfelder+1THEN +fehlermeldungaktionnichtmöglichELSE analysierekennzeichnungen;zeigliste( +aktlistennr+anzlistenfelder);return(1)FI ELIF aktion=4THEN IF aktlistennr= +ersterindexTHEN fehlermeldungaktionnichtmöglichELSE analysierekennzeichnungen +;IF (aktlistennr-anzlistenfelder+1)aktliste(i)THEN +schuelerlisteCAT text(aktlistennr+i-1,3);schuelerlisteCAT trennerFI PER .END +PROC analysierekennzeichnungen;PROC kurszuordnungundumwahllistebearbeiten: +listenpos:=1;listenbearbeitung:=TRUE ;kopierfunktion:=FALSE ; +analysierekennzeichnungen;IF schuelerliste=trennerTHEN kurswahlsperrebeenden( +kuwa2sperre);enter(2);LEAVE kurszuordnungundumwahllistebearbeitenELSE +schuelerliste:=subtext(schuelerliste,2)FI ;standardstartproc(bearbmaske); +standardkopfmaskeaktualisieren("Kurszuordnung für jetzige Jgst. "+aktjgst+ +" in "+gewjgst+"."+gewhj);aktbsseite:=1;aktplblindex:=1;aktindex:=int(subtext +(schuelerliste,listenpos,listenpos+2));belegeglobalevariablen(aktindex); +schuelerbearbeiten;standardnproc;listenposINCR 4.END PROC +kurszuordnungundumwahllistebearbeiten;PROC belegeglobalevariablen(INT CONST +index):TEXT VAR iddaten:=wahldatenzumindex(index,kzname);INT VAR trenner1pos +:=pos(iddaten,trenner),trenner2pos:=pos(iddaten,trenner,trenner1pos+1);IF +dbstatus=0THEN aktname:=text(iddaten,trenner1pos-1);aktvname:=subtext(iddaten +,trenner1pos+1,trenner2pos-1);aktgebdatum:=subtext(iddaten,trenner2pos+1); +ELSE aktname:="";aktvname:="";aktgebdatum:=""FI ;eingangrow(eingangfamname):= +aktname;eingangrow(eingangrufname):=aktvname;eingangrow(eingangdatum):= +datumrekonversion(aktgebdatum)END PROC belegeglobalevariablen;PROC +meldungausgeben(INT CONST meldung,gewfeld,gewruecksprung):fstat:=1; +standardmeldung(meldung,"");infeld(gewfeld);return(gewruecksprung)END PROC +meldungausgeben;PROC merkeeingang:FOR iFROM 2UPTO anzfeldereingangREP +eingangrow(i):=standardmaskenfeld(i)PER END PROC merkeeingang;PROC +logbucheintragvornehmen:logmeldung:=logtext1;logmeldungCAT gewjgst;logmeldung +CAT punkt;logmeldungCAT gewhj;logmeldungCAT text1;logmeldungCAT aktname; +logmeldungCAT komma;logmeldungCAT aktvname;logmeldungCAT komma;logmeldungCAT +aktgebdatum;logmeldungCAT text2;logeintrag(logmeldung)END PROC +logbucheintragvornehmen;END PACKET +kurszuordnungundumwahlfuereinzelneschuelersek2 + diff --git a/app/schulis/2.2.1/src/2.kw anschr kurslisten sek2 b/app/schulis/2.2.1/src/2.kw anschr kurslisten sek2 new file mode 100644 index 0000000..2f79a1b --- /dev/null +++ b/app/schulis/2.2.1/src/2.kw anschr kurslisten sek2 @@ -0,0 +1,90 @@ +PACKET kwanschrkurslistensek2DEFINES kursliauskunfteingang, +kursliauskunftstarten,kursliauskunftsonderwerte,kursliauskunftscanbedingung, +kursliauskunftdruckdateibauen:LET swkurs=520,swanrede=521,swlehrer=522, +swklausur=523,swname=524,swvorname=525,swgebdat=526,maske= +"ms anschr kwkursli sek2 eingang",fnrjgst=2,fnrfach=3,fnrkennung=4,fnrakthj=5 +,fnrgeplhj=6,fnrausgbs=7,fnrausgdr=8,niltext="",blank=" ",null=0,satztrenner= +"$",feldtrenner="�",mnrbittewarten=69,mnrbittepraeziser=129,mnrkeinekwdatenda +=406,mnrjgstfalsch=404;INT VAR mnrallgemein;TEXT CONST dateimitvordruck1:= +"vordruck1 kursli kopfueb",dateimitvordruck2:="vordruck2 kursli zeile";INT +VAR index,status,dbstatusgemerkt,fehler,zeilenzahl,zusatzzeilen, +zeilenhilfszahl,anzahlsaetze,satzanfpos,feldpos1,feldpos2;TEXT VAR hj, +fuerkwsj,jgst,fachkennung,fach,kennung,kwdaten,kurs,anredetext,lehrer;BOOL +VAR bestfach,bildschirmausgabe,akthjgewaehlt,hilfsdateida;PROC +kursliauskunfteingang:standardvproc(maske)END PROC kursliauskunfteingang; +PROC kursliauskunftstarten:bestfach:=FALSE ;standardpruefe(5,fnrausgbs, +fnrausgdr,null,niltext,status);IF status<>0THEN infeld(status);return(1)ELSE +standardpruefe(5,fnrakthj,fnrgeplhj,null,niltext,status);IF status<>0THEN +infeld(status);return(1)ELSE bildschirmausgabe:=standardmaskenfeld(fnrausgdr) +=niltext;akthjgewaehlt:=standardmaskenfeld(fnrgeplhj)=niltext;jgst:= +standardmaskenfeld(fnrjgst);fach:=standardmaskenfeld(fnrfach);kennung:= +standardmaskenfeld(fnrkennung);IF weiterepruefungenokTHEN startenausfuehren +ELSE standardmeldung(mnrallgemein,niltext);return(1)FI ;FI ;FI ;. +weiterepruefungenok:standardpruefe(2,fnrjgst,null,null,niltext,status);IF +status<>0THEN infeld(fnrjgst);mnrallgemein:=mnrjgstfalsch;LEAVE +weiterepruefungenokWITH FALSE FI ;IF int(jgst)<11COR int(jgst)>13THEN infeld( +fnrjgst);mnrallgemein:=mnrjgstfalsch;LEAVE weiterepruefungenokWITH FALSE FI ; +IF (fach=niltextAND kennung<>niltext)THEN infeld(fnrfach);mnrallgemein:= +mnrbittepraeziser;LEAVE weiterepruefungenokWITH FALSE FI ;IF (fach<>niltext +AND kennung=niltext)THEN infeld(fnrkennung);mnrallgemein:=mnrbittepraeziser; +LEAVE weiterepruefungenokWITH FALSE FI ;IF NOT kwdatenraumokTHEN infeld( +fnrjgst);mnrallgemein:=mnrkeinekwdatenda;LEAVE weiterepruefungenokWITH FALSE +FI ;inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,fuerkwsj);putwert( +fnrlvhj,hj);putwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,text(fach,2)+ +kennung);IF fach<>niltextAND kennung<>niltextTHEN bestfach:=TRUE ;search( +dnrlehrveranstaltungen,TRUE );IF dbstatus<>0THEN mnrallgemein:= +mnrkeinekwdatenda;LEAVE weiterepruefungenokWITH FALSE FI ;ELSE search( +dnrlehrveranstaltungen,FALSE );IF dbstatus<>0COR wert(fnrlvjgst)<>jgstCOR +wert(fnrlvhj)<>hjCOR wert(fnrlvsj)<>fuerkwsjTHEN mnrallgemein:= +mnrkeinekwdatenda;LEAVE weiterepruefungenokWITH FALSE FI ;FI ;kurs:=text(fach +,2)+kennung;TRUE .kwdatenraumok:hj:=schulkenndatum("Schulhalbjahr");IF +akthjgewaehltTHEN kurswahlinitialisieren(jgst,jgst,hj,niltext,fuerkwsj)ELSE +IF hj="1"THEN hj:="2"ELSE hj:="1";jgst:=text(int(jgst)+1);FI ; +kurswahlinitialisieren(jgst,jgst,hj,niltext,fuerkwsj)FI ;kurswahlbasisholen( +fehler);fehler=0.startenausfuehren:setzesonderwerteschulkenndaten;IF bestfach +THEN index:=ixlvsjhjkennELSE index:=dnrlehrveranstaltungenFI ;standardmeldung +(mnrbittewarten,niltext);zusammengesetztesanschreiben(index,bildschirmausgabe +,FALSE ,BOOL PROC kursliauskunftsonderwerte,BOOL PROC +kursliauskunftscanbedingung,TEXT PROC kursliauskunftdruckdateibauen)END PROC +kursliauskunftstarten;BOOL PROC kursliauskunftscanbedingung:BOOL VAR ok;IF +bestfachTHEN ok:=dbstatus=0AND jgst=wert(fnrlvjgst)AND kurs=wert( +fnrlvfachkennung)ELSE ok:=dbstatus=0AND jgst=wert(fnrlvjgst)FI ;okEND PROC +kursliauskunftscanbedingung;BOOL PROC kursliauskunftsonderwerte:BOOL VAR +schuelerda:=FALSE ;initialisieresonderwerte;fachkennung:=wert( +fnrlvfachkennung);adressat(fachkennung);fach:=subtext(fachkennung,1,2); +kennung:=subtext(fachkennung,3,6);dbstatusgemerkt:=dbstatus;kwdaten:= +schuelerundklausur(fach,kennung,niltext);IF length(kwdaten)<>0THEN schuelerda +:=TRUE ;setzesonderwert(swkurs,wert(fnrlvjgst)+blank+fach+blank+kennung); +inittupel(dnrlehrer);putwert(fnrlparaphe,wert(fnrlvparaphe));search(dnrlehrer +,TRUE );IF dbstatus=0THEN lehrer:=wert(fnrlamtsbeztitel);lehrerCAT blank; +lehrerCAT wert(fnrlzusatz);lehrerCAT blank;lehrerCAT wert(fnrlfamname);IF +wert(fnrlgeschlecht)="m"THEN anredetext:="Herr "ELSE anredetext:="Frau "FI ; +FI ;setzesonderwert(swanrede,anredetext);setzesonderwert(swlehrer,lehrer); +dbstatus(dbstatusgemerkt);FI ;dbstatus=0AND schuelerdaEND PROC +kursliauskunftsonderwerte;TEXT PROC kursliauskunftdruckdateibauen:LET +druckdatei="liste.1",hilfsdatei="hilfsdatei";vordruckeholen; +setzemitseitennummern(TRUE );setzeanzahlderzeichenprozeile(78); +druckvorbereiten;zeilenzahl:=0;zusatzzeilen:=0;briefalternative( +dateimitvordruck1,hilfsdatei);hilfsdateiindruckdatei(hilfsdatei);hilfsdateida +:=FALSE ;satzanfpos:=pos(kwdaten,satztrenner);WHILE satzanfpos<>0AND +satzanfpos=drucklaengeTHEN seitenwechsel;zeilenzahl:=0;FI ;FOR iFROM 1 +UPTO zeilenhilfszahlREP getline(f,zeile);druckzeileschreiben(zeile)PER ; +forget(hilfsdatei,quiet);zeilenzahlINCR zeilenhilfszahlEND PROC +hilfsdateiindruckdatei;END PACKET kwanschrkurslistensek2; + diff --git a/app/schulis/2.2.1/src/2.likw kurskombinationen sek2 b/app/schulis/2.2.1/src/2.likw kurskombinationen sek2 new file mode 100644 index 0000000..35caa9d --- /dev/null +++ b/app/schulis/2.2.1/src/2.likw kurskombinationen sek2 @@ -0,0 +1,166 @@ +PACKET likwkurskombinatilonensek2DEFINES kurskombinationmaskebearbeiten, +kurskombinationggferstellen,kurskombinationzeigen,kurskombinationendrucken: +LET maske="ms kurskombination auszaehlen sek2 eingang",fnr2fuerjgst=2, +fnr3fuerhj=3,fnr4jgstls=4,fnr5jgstneu=5,fnr6kurswahl=6,fnr7bestart=7, +fnr8klausur=8,fnr9bs=9,fnr10dr=10,mnrjgstfalsch=404,mnrjgstfehlt=172, +mnrhjfalsch=405,mnrkeinekwdatenda=406,mnrkeinedbdatenda=407, +mnrbearbeitetwerden=352,mnrlistewirdgedruckt=58,mnrbittewarten=69, +mnrlistewirdaufbereitet=190;INT VAR mnrallgemein;TEXT VAR mnrzusatz;TEXT +CONST mark:="#";LET niltext="",punkt=".",querstrich="/",blank=" ", +blankklammer=" )",doppelpunkt=":",null=0,neuangemeldete="N",allederjgst="", +ohneneuang="O";BOOL VAR bildschirmausgabe,kurswahlen,lsundneue,nurneue,nurls, +bestimmtekursart;TEXT VAR dbsj,dbhj,dbjgst,fuerkwsj,fuerhj,fuerjgst,jgstls, +jgstneu,hilfsstring,kursart,klausur,kennung,fachart,lvart,fachkennung1, +fachkennung2,fachart1,fachart2,kursart1,kursart2;LET maxkurse=200,maxspalten= +13;TEXT CONST ueberschrift3:="-------:"+13*"----+";TEXT VAR ueberschrift1, +ueberschrift2,zeile;LET ausgfeldlaenge=1,AUSGFELD =ROW ausgfeldlaengeTEXT , +AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ; +AUSGKOPFDRUCK VAR ausgkopfdruck;LET ausgkopflaenge=2,ueberschriftenzeilen=2; +TEXT CONST kopfueb1teil1:="Wahlergebnis für Jgst. ",kopfueb1teil2:= +" im Schuljahr ",kopfueb1teil3:=" (Art/Klausur: ",kopfueb2teil1:= +"Schüler der jetzigen Jgst. ",kopfueb2teil2:=" und der ",kopfueb2teil3:= +"Neuangemeldeten zur Jgst. ";TEXT VAR textueb1:="",textueb2:="";INT VAR +status,dbstatusmerker,zaehler,x,y,z,anzangebote,anztabellen,anzspaltenschluss +,anfang,ende,zeilenzaehler,druckzeilenzahl;LET datenraum="datenraum";LET +ZEILE =STRUCT (TEXT angebot,ROW maxkurseINT anzahl);BOUND ROW maxkurseZEILE +VAR zeilespalte;ROW maxspaltenINT VAR summen;PROC +kurskombinationmaskebearbeiten:standardvproc(maske);END PROC +kurskombinationmaskebearbeiten;PROC kurskombinationggferstellen:lsundneue:= +FALSE ;nurls:=FALSE ;nurneue:=FALSE ;standardmeldung(mnrbittewarten,niltext); +standardpruefe(5,fnr9bs,fnr10dr,null,niltext,status);IF status<>0THEN infeld( +status);return(1)ELSE fuerjgst:=standardmaskenfeld(fnr2fuerjgst);fuerhj:= +standardmaskenfeld(fnr3fuerhj);jgstls:=standardmaskenfeld(fnr4jgstls);jgstneu +:=standardmaskenfeld(fnr5jgstneu);IF NOT eingabenzujgstundhjkorrektTHEN +standardmeldung(mnrallgemein,niltext);return(1);ELSE kursart:= +standardmaskenfeld(fnr7bestart);klausur:=standardmaskenfeld(fnr8klausur); +bestimmtekursart:=kursart<>niltext;kurswahlen:=standardmaskenfeld( +fnr6kurswahl)<>niltext;bildschirmausgabe:=standardmaskenfeld(fnr10dr)=niltext +;IF NOT datenraumfürgewaehltessjdaTHEN standardmeldung(mnrkeinekwdatenda, +niltext);return(1);ELSE IF angebotelvsoderfaecherimrowTHEN +druckdateifuellenundausgebenELSE standardmeldung(mnrkeinedbdatenda,mnrzusatz+ +mark);return(1)FI ;FI ;FI ;FI ;.eingabenzujgstundhjkorrekt:dbhj:= +schulkenndatum("Schulhalbjahr");dbsj:=schulkenndatum("Schuljahr");INT VAR +jgst;standardpruefe(2,fnr2fuerjgst,null,null,niltext,status);IF status<>0 +THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2fuerjgst);LEAVE +eingabenzujgstundhjkorrektWITH FALSE FI ;jgst:=int(fuerjgst);IF jgst<11COR +jgst>13THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2fuerjgst);LEAVE +eingabenzujgstundhjkorrektWITH FALSE FI ;IF fuerhj<>"1"AND fuerhj<>"2"THEN +mnrallgemein:=mnrhjfalsch;infeld(fnr3fuerhj);LEAVE eingabenzujgstundhjkorrekt +WITH FALSE FI ;IF jgstls=niltextAND jgstneu=niltextTHEN mnrallgemein:= +mnrjgstfehlt;infeld(fnr4jgstls);LEAVE eingabenzujgstundhjkorrektWITH FALSE +FI ;jgst:=int(jgstls);IF jgstls<>niltextTHEN standardpruefe(2,fnr4jgstls,null +,null,niltext,status);IF status<>0COR (jgst<10COR jgst>13)THEN mnrallgemein:= +mnrjgstfalsch;infeld(fnr4jgstls);LEAVE eingabenzujgstundhjkorrektWITH FALSE +FI ;FI ;jgst:=int(jgstneu);IF jgstneu<>niltextTHEN standardpruefe(2, +fnr5jgstneu,null,null,niltext,status);IF status<>0COR (jgst<11COR jgst>13) +THEN mnrallgemein:=mnrhjfalsch;infeld(fnr5jgstneu);LEAVE +eingabenzujgstundhjkorrektWITH FALSE FI ;FI ;IF jgstls<>niltextAND jgstneu<> +niltextTHEN IF int(jgstls)+1=int(jgstneu)AND jgstneu<=fuerjgstTHEN lsundneue +:=TRUE ELSE mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE +eingabenzujgstundhjkorrektWITH FALSE FI ;ELIF jgstls=niltextTHEN IF jgstneu> +fuerjgstTHEN mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE +eingabenzujgstundhjkorrektWITH FALSE ELSE nurneue:=TRUE FI ;ELSE IF jgstls> +fuerjgstTHEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2fuerjgst);LEAVE +eingabenzujgstundhjkorrektWITH FALSE ELIF (jgstls="10"AND dbhj="1")COR ( +jgstls=fuerjgstAND fuerhj0;angebotedaEND PROC angebotelvsoderfaecherimrow; +PROC angebotlvmerken(BOOL VAR ende):IF status<>0COR wert(fnrlvjgst)<>dbjgst +THEN ende:=TRUE ;ELSE lvart:=wert(fnrlvart);IF (NOT bestimmtekursart)COR +lvart=kursartTHEN anzangeboteINCR 1;zeilespalte(anzangebote).angebot:=text( +wert(fnrlvfachkennung),6)+lvart;FI ;FI ;END PROC angebotlvmerken;PROC +angebotfangmerken(BOOL VAR ende):IF status<>0COR wert(fnrfangjgst)<>dbjgst +THEN ende:=TRUE ;ELSE fachart:=wert(fnrfangart);IF (NOT bestimmtekursart)COR +fachart=kursartTHEN anzangeboteINCR 1;zeilespalte(anzangebote).angebot:=text( +wert(fnrfangfach),2)+fachart;FI ;FI ;END PROC angebotfangmerken;PROC +druckdateifuellenundausgeben:zeilenzaehler:=0;standardmeldung( +mnrlistewirdaufbereitet,niltext);wahldatenauskwdatenrauminrowablegen; +anztabellen:=anzangeboteDIV maxspalten;anzspaltenschluss:=anzangeboteMOD +maxspalten;ueberschriftenimdruckkopfbauen;variablenfuerdrucksetzen; +druckvorbereiten;initdruckkopf(textueb1,textueb2);FOR zFROM 1UPTO anztabellen +REP ende:=z*maxspalten;anfang:=ende-(maxspalten-1); +tabellevonbisspalteausgeben(maxspalten);IF z0THEN IF anztabellen<>0THEN anfang:=ende+1; +seitenwechselELSE anfang:=1FI ;ende:=anzangebote;tabellevonbisspalteausgeben( +anzspaltenschluss);FI ;IF bildschirmausgabeTHEN kurskombinationzeigenELSE +kurskombinationendrucken(FALSE )FI ;.variablenfuerdrucksetzen:druckzeilenzahl +:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge. +ueberschriftenimdruckkopfbauen:textueb1:=kopfueb1teil1;textueb1CAT fuerjgst; +textueb1CAT punkt;textueb1CAT fuerhj;textueb1CAT kopfueb1teil2;textueb1CAT +subtext(fuerkwsj,1,2)+querstrich;textueb1CAT subtext(fuerkwsj,3,4);IF +bestimmtekursartOR klausur<>niltextTHEN textueb1CAT kopfueb1teil3;textueb1 +CAT kursart+querstrich;textueb1CAT klausur+blankklammer;FI ;IF NOT (fuerhj= +dbhjAND fuerjgst=jgstls)THEN geplanteshjundsjberechnen(dbhj,dbsj);FI ;IF +nurneueTHEN textueb2:=kopfueb2teil3;textueb2CAT jgstneu;ELSE textueb2:= +kopfueb2teil1;textueb2CAT jgstls;IF lsundneueTHEN textueb2CAT kopfueb2teil2; +textueb2CAT kopfueb2teil3;textueb2CAT jgstneu;FI ;FI ;END PROC +druckdateifuellenundausgeben;PROC wahldatenauskwdatenrauminrowablegen:FOR x +FROM 1UPTO anzangeboteREP y:=1;IF kurswahlenTHEN WHILE y<=xREP +kombiationenlvsmerken(x,y);yINCR 1;PER ;ELSE WHILE y<=xREP +kombinationenfaechermerken(x,y);yINCR 1;PER ;FI ;PER ;END PROC +wahldatenauskwdatenrauminrowablegen;PROC kombiationenlvsmerken(INT CONST zeil +,spal):fachkennung1:=zeilespalte(zeil).angebot;fachkennung2:=zeilespalte(spal +).angebot;IF NOT bestimmtekursartTHEN kursart1:=subtext(fachkennung1,7,7); +kursart2:=subtext(fachkennung2,7,7);ELSE kursart1:=kursart;kursart2:=kursart +FI ;dbstatusmerker:=dbstatus;zeilespalte(zeil).anzahl(spal):= +anzahlschuelermitwahl(subtext(fachkennung1,1,2),subtext(fachkennung1,3,6), +kursart1,klausur,subtext(fachkennung2,1,2),subtext(fachkennung2,3,6),kursart2 +,klausur);dbstatus(dbstatusmerker);END PROC kombiationenlvsmerken;PROC +kombinationenfaechermerken(INT CONST zeil,spal):fachart1:=zeilespalte(zeil). +angebot;fachart2:=zeilespalte(spal).angebot;IF bestimmtekursartTHEN kursart1 +:=kursart;kursart2:=kursart;ELSE kursart1:=subtext(fachart1,3,3);kursart2:= +subtext(fachart2,3,3);FI ;kennung:=niltext;dbstatusmerker:=dbstatus; +zeilespalte(zeil).anzahl(spal):=anzahlschuelermitwahl(subtext(fachart1,1,2), +kennung,kursart1,klausur,subtext(fachart2,1,2),kennung,kursart2,klausur); +dbstatus(dbstatusmerker);END PROC kombinationenfaechermerken;PROC +tabellevonbisspalteausgeben(INT CONST spaltenzahl):INT VAR s,kombinationen; +FOR sFROM 1UPTO maxspaltenREP summen(s):=0PER ;zeilenzaehler:=0;ueberschrift1 +:=" :";ueberschrift2:=" :";FOR zaehlerFROM anfangUPTO endeREP +ueberschrift1CAT text(zeilespalte(zaehler).angebot,2)+" :";IF NOT kurswahlen +THEN ueberschrift2CAT subtext(zeilespalte(zaehler).angebot,3,3)+" :";ELSE +ueberschrift2CAT subtext(zeilespalte(zaehler).angebot,3,6)+":";FI ;PER ; +druckkopfschreiben;setzemitseitennummern(TRUE );druckzeileschreiben( +ueberschrift1);druckzeileschreiben(ueberschrift2);druckzeileschreiben( +ueberschrift3);zeilenzaehlerINCR 12;FOR zaehlerFROM 1UPTO anzangeboteREP s:=1 +;hilfsstring:=zeilespalte(zaehler).angebot;zeile:=text(hilfsstring,2)+blank; +IF kurswahlenTHEN zeileCAT subtext(hilfsstring,3,6)+doppelpunkt;ELSE zeile +CAT subtext(hilfsstring,3,3)+3*blank+doppelpunktFI ;FOR xFROM anfangUPTO ende +REP IF x0 +THEN infeld(status);setzeeingabetest(FALSE )ELSE fuerjgst:=standardmaskenfeld +(fnr2fuerjgst);fuerhj:=standardmaskenfeld(fnr3fuerhj);jgstls:= +standardmaskenfeld(fnr4jgstls);jgstneu:=standardmaskenfeld(fnr5jgstneu);IF +NOT eingabenzujgstundhjkorrektTHEN standardmeldung(mnrallgemein,niltext); +setzeeingabetest(FALSE )ELSE kurswahlen:=standardmaskenfeld(fnr6kurswahl)<> +niltext;bildschirmausgabe:=standardmaskenfeld(fnr8dr)=niltext;IF NOT ( +datenraumfürgewaehltessjda)THEN standardmeldung(mnrkeinekwdatenda,niltext); +setzeeingabetest(FALSE )ELSE IF keineklausurkuerzelvorhandenTHEN +standardmeldung(mnrkeinekuerzelda,niltext);setzeeingabetest(FALSE )ELSE +setzeeingabetest(TRUE );setzeausgabedrucker(NOT bildschirmausgabe)FI ;FI ;FI +;FI ;.keineklausurkuerzelvorhanden:BOOL VAR nix:=TRUE ;klausurkuerzel:= +niltext;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,klausurbestand); +search(dnrschluessel,FALSE );anzkuerzel:=0;IF dbstatus<>0COR wert( +fnrschlsachgebiet)<>klausurbestandTHEN LEAVE keineklausurkuerzelvorhanden +WITH nixELSE FOR xFROM 1UPTO maxkuerzelREP IF wert(fnrschlsachgebiet)= +klausurbestandTHEN klausurkuerzelCAT wert(fnrschlschluessel);anzkuerzelINCR 1 +;succ(dnrschluessel)FI ;PER ;FI ;nix:=anzkuerzel=0;nix. +eingabenzujgstundhjkorrekt:dbhj:=schulkenndatum("Schulhalbjahr");dbsj:= +schulkenndatum("Schuljahr");INT VAR jgst;standardpruefe(2,fnr2fuerjgst,null, +null,niltext,status);IF status<>0THEN mnrallgemein:=mnrjgstfalsch;infeld( +fnr2fuerjgst);LEAVE eingabenzujgstundhjkorrektWITH FALSE FI ;jgst:=int( +fuerjgst);IF jgst<11COR jgst>13THEN mnrallgemein:=mnrjgstfalsch;infeld( +fnr2fuerjgst);LEAVE eingabenzujgstundhjkorrektWITH FALSE FI ;IF fuerhj<>"1" +AND fuerhj<>"2"THEN mnrallgemein:=mnrhjfalsch;infeld(fnr3fuerhj);LEAVE +eingabenzujgstundhjkorrektWITH FALSE FI ;IF jgstls=niltextAND jgstneu=niltext +THEN mnrallgemein:=mnrjgstfehlt;infeld(fnr4jgstls);LEAVE +eingabenzujgstundhjkorrektWITH FALSE FI ;jgst:=int(jgstls);IF jgstls<>niltext +THEN standardpruefe(2,fnr4jgstls,null,null,niltext,status);IF status<>0COR ( +jgst<10COR jgst>13)THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE +eingabenzujgstundhjkorrektWITH FALSE FI ;FI ;jgst:=int(jgstneu);IF jgstneu<> +niltextTHEN standardpruefe(2,fnr5jgstneu,null,null,niltext,status);IF status +<>0COR (jgst<11COR jgst>13)THEN mnrallgemein:=mnrhjfalsch;infeld(fnr5jgstneu) +;LEAVE eingabenzujgstundhjkorrektWITH FALSE FI ;FI ;IF jgstls<>niltextAND +jgstneu<>niltextTHEN IF int(jgstls)+1=int(jgstneu)AND jgstneu<=fuerjgstTHEN +lsundneue:=TRUE ELSE mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE +eingabenzujgstundhjkorrektWITH FALSE FI ;ELIF jgstls=niltextTHEN IF jgstneu> +fuerjgstTHEN mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE +eingabenzujgstundhjkorrektWITH FALSE ELSE nurneue:=TRUE FI ;ELSE IF jgstls> +fuerjgstTHEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2fuerjgst);LEAVE +eingabenzujgstundhjkorrektWITH FALSE ELIF (jgstls="10"AND dbhj="1")COR ( +jgstls=fuerjgstAND fuerhjint(jgstneu)-1THEN mnrallgemein:=mnrjgstfalsch;infeld( +fnr2jgstls);LEAVE plausisspezokWITH FALSE FI ;FI ;IF NOT kurswahldatenraumda +THEN infeld(fnr2jgstls);LEAVE plausisspezokWITH FALSE FI ;FI ;TRUE . +bestschuelerkorrekt:IF rufname=niltextTHEN IF gebdat=niltextTHEN IF +famnameeindeutigTHEN rufname:=wert(fnrsurufnames);gebdat:=wert(fnrsugebdatums +);LEAVE bestschuelerkorrektWITH TRUE ELSE LEAVE bestschuelerkorrektWITH +FALSE ;FI ;ELSE egmaskefeldnr:=fnr5rufname;mnrallgemein:= +mnrangabenpraezisieren;LEAVE bestschuelerkorrektWITH FALSE ;FI ;ELSE IF +gebdat<>niltextTHEN hilfstext:=subtext(gebdat,1,2);hilfstextCAT punkt; +hilfstextCAT subtext(gebdat,3,4);hilfstextCAT punkt;hilfstextCAT subtext( +gebdat,5,6);gebdat:=hilfstext;IF kompletterschluesselokTHEN LEAVE +bestschuelerkorrektWITH TRUE ELSE LEAVE bestschuelerkorrektWITH FALSE FI ; +ELSE IF famnameundrufnameeindeutigTHEN gebdat:=wert(fnrsugebdatums);LEAVE +bestschuelerkorrektWITH TRUE ELSE LEAVE bestschuelerkorrektWITH FALSE ;FI ; +FI ;FI ;TRUE END PROC wahlundkursdatenggfstarten;BOOL PROC famnameeindeutig: +inittupel(dnrschueler);putwert(fnrsufamnames,famname);putwert(fnrsurufnames, +rufname);putwert(fnrsugebdatums,gebdat);putwert(fnrsustatuss,"ls");search( +dnrschueler,FALSE );IF wert(fnrsufamnames)<>famnameTHEN egmaskefeldnr:= +fnr4famname;mnrallgemein:=mnrdatenexistierennicht;LEAVE famnameeindeutigWITH +FALSE ;ELSE succ(dnrschueler);IF wert(fnrsufamnames)=famnameTHEN +egmaskefeldnr:=fnr5rufname;mnrallgemein:=mnrangabenpraezisieren;LEAVE +famnameeindeutigWITH FALSE ;ELSE pred(dnrschueler)FI ;FI ;TRUE END PROC +famnameeindeutig;BOOL PROC famnameundrufnameeindeutig:inittupel(dnrschueler); +putwert(fnrsufamnames,famname);putwert(fnrsurufnames,rufname);putwert( +fnrsugebdatums,gebdat);putwert(fnrsustatuss,"ls");search(dnrschueler,FALSE ); +IF wert(fnrsufamnames)<>famnameCOR wert(fnrsurufnames)<>rufnameTHEN +egmaskefeldnr:=fnr4famname;mnrallgemein:=mnrdatenexistierennicht;LEAVE +famnameundrufnameeindeutigWITH FALSE ELSE succ(dnrschueler);IF wert( +fnrsufamnames)=famnameAND wert(fnrsurufnames)=rufnameTHEN egmaskefeldnr:= +fnr6gebdat;mnrallgemein:=mnrangabenpraezisieren;LEAVE +famnameundrufnameeindeutigWITH FALSE ELSE pred(dnrschueler)FI ;FI ;TRUE END +PROC famnameundrufnameeindeutig;BOOL PROC kompletterschluesselok:BOOL VAR +insek2:=TRUE ;standardpruefe(6,fnr6gebdat,null,null,niltext,status);IF status +<>0THEN egmaskefeldnr:=fnr6gebdat;mnrallgemein:=mnrungueltigesdatum;LEAVE +kompletterschluesselokWITH FALSE ;FI ;hilfstext:=subtext(gebdat,1,2); +hilfstextCAT punkt;hilfstextCAT subtext(gebdat,3,4);hilfstextCAT punkt; +hilfstextCAT subtext(gebdat,5,6);gebdat:=hilfstext;inittupel(dnrschueler); +putwert(fnrsufamnames,famname);putwert(fnrsurufnames,rufname);putwert( +fnrsugebdatums,gebdat);putwert(fnrsustatuss,"ls");search(dnrschueler,TRUE ); +IF dbstatus<>0COR intwert(fnrsusgrpjgst)<11THEN egmaskefeldnr:=fnr4famname; +mnrallgemein:=mnrschuelernichtimentsprbestand;insek2:=FALSE FI ;insek2END +PROC kompletterschluesselok;PROC starten:aktschueler:=erster;IF +bildschirmausgabeTHEN listeaufbereiten;bearbeitungingang:=TRUE ;rename( +"liste.1","Wahl- und Kursdaten");zeigedatei("Wahl- und Kursdaten","vr");ELSE +IF ankreuzlisteTHEN WHILE aktschueler<>0REP +listeaufbereitendruckenundloeschenodermeldung;naechsterindex(aktschueler); +PER ;ankreuzliste:=FALSE ;bearbeitungingang:=FALSE ;forget(boolvektordatei, +quiet);standardstartproc(eingangsmaske);egmaskenfelderleerenzurueckundmeldung +(2);ELSE FOR aktschuelerFROM ersterUPTO letzterREP +listeaufbereitendruckenundloeschenodermeldung;PER ; +egmaskenfelderleerenzurueckundmeldung(1);FI ;FI ;END PROC starten;PROC +listeaufbereitendruckenundloeschenodermeldung:IF NOT schuelervorhandenTHEN +meldungELSE listemitdatenzumschueleraufbereiten;standardmeldung( +mnrdruckausgabefuerwirdgedruckt,famname+"#");listedrucken;listeloeschen;FI ; +END PROC listeaufbereitendruckenundloeschenodermeldung;PROC +wahlundkursdatennaechsteliste(BOOL CONST drucken):IF druckenTHEN listedrucken +FI ;listeloeschen;IF ankreuzlisteTHEN naechsterindex(aktschueler);IF +aktschueler=0THEN forget(boolvektordatei,quiet);ankreuzliste:=FALSE ; +standardstartproc(eingangsmaske);egmaskenfelderleerenzurueckundmeldung(3); +ELSE listeaufbereiten;rename("liste.1","Wahl- und Kursdaten");return(1)FI ; +ELSE IF aktschueler=letzterTHEN egmaskenfelderleerenzurueckundmeldung(2); +ELSE aktschuelerINCR 1;listeaufbereiten;rename("liste.1", +"Wahl- und Kursdaten");return(1);FI ;FI ;END PROC +wahlundkursdatennaechsteliste;PROC listeaufbereiten:IF NOT schuelervorhanden +THEN listeleeraufbereitenELSE listemitdatenzumschueleraufbereiten;FI ;END +PROC listeaufbereiten;PROC meldung:mnrzusatz:="Halbjahresdaten"; +standardmeldung(mnrkeinedatendain,mnrzusatz+"#");END PROC meldung;PROC +schuelerdatenauskwdatenraumholen(INT CONST index):hilfstext:= +wahldatenzumindex(index,kennungnursuname);pos1:=pos(hilfstext,trenner);pos2:= +pos(hilfstext,trenner,pos1+1);famname:=subtext(hilfstext,1,pos1-1);rufname:= +subtext(hilfstext,pos1+1,pos2-1);gebdat:=subtext(hilfstext,pos2+1,length( +hilfstext));END PROC schuelerdatenauskwdatenraumholen;PROC +listeleeraufbereiten:dateioeffnenunddruckkopfschreiben;putline(ausgabedatei, +"Keine Halbjahres-Daten vorhanden für: "+rufname+blank+famname)END PROC +listeleeraufbereiten;PROC dateioeffnenunddruckkopfschreiben:ausgabedatei:= +sequentialfile(output,"liste.1");druckvorbereiten;ueb2:=famname;ueb2CAT blank +;ueb2CAT rufname;ueb2CAT ", geboren am ";ueb2CAT gebdat;initdruckkopf(ueb1, +ueb2);druckkopfschreiben;END PROC dateioeffnenunddruckkopfschreiben;PROC +rowinitialisieren:FOR ixfaecherFROM 1UPTO maxanzfaecherREP FOR ixschulhjFROM +1UPTO maxanzschulhjREP faecherschulhj(ixfaecher)(ixschulhj):=niltextPER ;PER +;END PROC rowinitialisieren;PROC listemitdatenzumschueleraufbereiten: +faecherstringok:=FALSE ;rowinitialisieren;dateioeffnenunddruckkopfschreiben; +uebsj:=5*blank+doppblank;uebjgst:="Fach "+doppblank;ixfaecher:=1;ixschulhj:=0 +;faecherstring:=wert(fnrhjdfach);WHILE dbstatus=0AND wert(fnrhjdfamnames)= +famnameAND wert(fnrhjdrufnames)=rufnameAND wert(fnrhjdgebdats)=gebdatREP +shjueberschriftenmerken;IF compress(faecherstring)=niltextTHEN succ( +dnrhalbjahresdaten);faecherstring:=wert(fnrhjdfach);ELSE +faecherstringaufbereitenundweiterewertelesen;IF faecherstring=faecherTHEN +FOR zaehlerFROM 1UPTO anzfaecherREP datenproshjprofachmerken(zaehler);PER ; +ELSE pos1:=1;zaehler:=1;WHILE pos10AND pos2MOD 2=0REP +pos2:=pos(faecherstring,fach,pos2+1);PER ;IF pos2=0THEN anzfaecherINCR 1; +ixfaecher:=anzfaecher;faecherstringCAT fach;ELSE ixfaecher:=(pos2+1)DIV 2FI ; +datenproshjprofachmerken(ixfaecher);pos1INCR 2;PER ;FI ;succ( +dnrhalbjahresdaten);FI ;PER ;ausgabederrowmatrixindatei;. +shjueberschriftenmerken:ixschulhjINCR 1;hilfstext:=wert(fnrhjdsj);uebsjCAT +subtext(hilfstext,1,2);uebsjCAT "/";uebsjCAT subtext(hilfstext,3,4);uebsjCAT +doppblank;hilfstext:=text(wert(fnrhjdjgst),2);hilfstextCAT punkt;hilfstext +CAT wert(fnrhjdhj);uebjgstCAT hilfstext;uebjgstCAT blank+doppblank;. +faecherstringaufbereitenundweiterewertelesen:IF NOT faecherstringokTHEN +zaehler:=1;pos1:=1;WHILE zaehler0AND pos1MOD 2=0REP pos1:=pos(faecherstring,subtext(faecherstring,zaehler, +zaehler+1),pos1+1)PER ;IF pos1=0THEN zaehlerINCR 2;ELSE IF pos1MOD 2=1THEN +change(faecherstring,pos1,pos1+1,niltext);FI ;FI ;PER ;anzfaecher:=length( +faecherstring)DIV 2;faecherstringok:=TRUE ;FI ;faecher:=wert(fnrhjdfach); +kennungen:=wert(fnrhjdlerngrpkenn);klausuren:=wert(fnrhjdklausurteiln); +kursarten:=wert(fnrhjdkursart);punkte:=wert(fnrhjdnotepunkte);IF punkte= +niltextTHEN punkte:=length(faecher)*blankFI ;.ausgabederrowmatrixindatei: +zeile1:=uebsj;druckzeileschreiben(zeile1);zeile1:=uebjgst;druckzeileschreiben +(zeile1);zeile1:="-----+"+(10*"------+");druckzeileschreiben(zeile1);INT VAR +i;i:=1;FOR pos1FROM 1UPTO anzfaecherREP zeile1:=subtext(faecherstring,i,i+1); +zeile1CAT blanksdopp;zeile2:=2*blank+blanksdopp;FOR zaehlerFROM 1UPTO +ixschulhjREP IF faecherschulhj(pos1)(zaehler)=niltextTHEN zeile1CAT 3*blank+ +blanksdopp;zeile2CAT 3*blank+blanksdopp;ELSE zeile1CAT subtext(faecherschulhj +(pos1)(zaehler),1,6);zeile1CAT dopp;zeile2CAT subtext(faecherschulhj(pos1)( +zaehler),7,12);zeile2CAT dopp;FI ;PER ;iINCR 2;druckzeileschreiben(zeile1); +druckzeileschreiben(zeile2);PER ;END PROC listemitdatenzumschueleraufbereiten +;PROC datenproshjprofachmerken(INT CONST rowindex):IF faecherschulhj(rowindex +)(ixschulhj)<>niltextTHEN faecherschulhj(rowindex)(ixschulhj):=platzhalter +ELSE faecherschulhj(rowindex)(ixschulhj):=subtext(kennungen,1,4)+blank+ +subtext(klausuren,1,1)+subtext(punkte,1,2)+blank+blank+subtext(kursarten,1,2) +;FI ;kennungen:=subtext(kennungen,5,length(kennungen));klausuren:=subtext( +klausuren,2,length(klausuren));punkte:=subtext(punkte,3,length(punkte)); +kursarten:=subtext(kursarten,3,length(kursarten));END PROC +datenproshjprofachmerken;PROC egmaskenfelderleerenzurueckundmeldung(INT +CONST stufe):FOR zaehlerFROM 2UPTO 8REP standardmaskenfeld(niltext,zaehler); +PER ;return(stufe);standardmeldung(mnralledruckausgabenerstellt,niltext);END +PROC egmaskenfelderleerenzurueckundmeldung;PROC listedrucken:IF exists( +"Wahl- und Kursdaten")THEN print("Wahl- und Kursdaten")ELSE print("liste.1"); +FI ;END PROC listedrucken;PROC listeloeschen:forget("Wahl- und Kursdaten", +quiet);forget("liste.1",quiet)END PROC listeloeschen;PROC +wahlundkursdatenblaettern(INT CONST richtung):SELECT richtungOF CASE 1: +andenanfangCASE 2:eineseitevorCASE 3:eineseitezurueckCASE 4:andasende +ENDSELECT ;return(1).andenanfang:aktuellezeile:=erster;listezeigenabzeile( +aktuellezeile);.andasende:aktuellezeile:=max(1,letzter- +listeneintraegeproseite+1);listezeigenabzeile(aktuellezeile);.eineseitevor: +IF aktuellezeile+listeneintraegeproseite>letzterTHEN standardmeldung( +meldungblaetternnichtmöglich,"")ELSE aktuellezeileINCR +listeneintraegeproseite;listezeigenabzeile(aktuellezeile)FI ;. +eineseitezurueck:IF aktuellezeile=ersterTHEN standardmeldung( +meldungblaetternnichtmöglich,"")ELSE aktuellezeileDECR +listeneintraegeproseite;aktuellezeile:=max(aktuellezeile,erster); +listezeigenabzeile(aktuellezeile)FI ;END PROC wahlundkursdatenblaettern;PROC +wahldatenlistenseiteaktualisieren:INT VAR i,fnr;standardnproc;fnr:= +fnrerstesankreuzfeld;FOR iFROM aktuellezeileUPTO min(aktuellezeile+ +listeneintraegeproseite,letzter)REP boolvektor(i):=standardmaskenfeld(fnr)<> +niltext;fnrINCR felderprolisteneintragPER END PROC +wahldatenlistenseiteaktualisieren;PROC listezeigenabzeile(INT CONST zeile): +INT VAR i,j1,j2,fnr;TEXT VAR t,t1;fnr:=fnrerstesankreuzfeld;FOR iFROM zeile +UPTO zeile+listeneintraegeproseiteREP IF i<=letzterTHEN t:=wahldatenzumindex( +i,kennungnursuname);feldfrei(fnr);IF boolvektor(i)THEN standardmaskenfeld( +ankreuzung,fnr);ELSE standardmaskenfeld(keineankreuzung,fnr);FI ; +bereiteschuelerzeileauf;standardmaskenfeld(t1,fnr+1);ELSE standardmaskenfeld( +niltext,fnr);feldschutz(fnr);standardmaskenfeld(dummyschueler,fnr+1)FI ;fnr +INCR felderprolisteneintrag;PER ;infeld(fnrerstesankreuzfeld); +standardfelderausgeben;.bereiteschuelerzeileauf:j1:=pos(t,trenner);j2:=pos(t, +trenner,j1+1);t1:=text(t,j1-1);t1CAT sunamenstrenner;t1CAT subtext(t,j1+1,j2- +1);t1:=text(t1,sulaengeohnedatum);t1CAT " ";t1CAT subtext(t,j2+1).END PROC +listezeigenabzeile;PROC naechsterindex(INT VAR index):indexINCR 1;WHILE index +<=letzterCAND NOT boolvektor(index)REP indexINCR 1PER ;IF index>letzterTHEN +index:=0FI END PROC naechsterindex;PROC wahlundkursdatenabschluss:INT VAR +ruecksprungweite:=1;IF ankreuzlisteTHEN forget(boolvektordatei,quiet); +ankreuzliste:=FALSE ;ruecksprungweiteINCR 1FI ;IF bearbeitungingangTHEN +bearbeitungingang:=FALSE ;ruecksprungweiteINCR 1FI ;listeloeschen;enter( +ruecksprungweite);END PROC wahlundkursdatenabschluss;BOOL PROC +plausisallgemok:standardmeldung(mnrbittewarten,niltext);ankreuzliste:=FALSE ; +bestschueler:=FALSE ;lsundneue:=FALSE ;nurneue:=FALSE ;nurls:=FALSE ; +standardpruefe(5,fnr7bs,fnr8dr,null,niltext,status);IF status<>0THEN infeld( +fnr7bs);mnrallgemein:=mnrauswahlnichtsinnvoll;LEAVE plausisallgemokWITH +FALSE FI ;bildschirmausgabe:=standardmaskenfeld(fnr8dr)=niltext;jgstls:= +standardmaskenfeld(fnr2jgstls);jgstneu:=standardmaskenfeld(fnr3jgstneu); +famname:=standardmaskenfeld(fnr4famname);rufname:=standardmaskenfeld( +fnr5rufname);gebdat:=standardmaskenfeld(fnr6gebdat);IF famname<>niltextCOR +rufname<>niltextCOR gebdat<>niltextTHEN bestschueler:=TRUE ;IF jgstls<> +niltextCOR jgstneu<>niltextTHEN infeld(fnr4famname);mnrallgemein:= +mnrjgstoderbestschueler;LEAVE plausisallgemokWITH FALSE FI ;ELSE IF jgstls= +niltextAND jgstneu=niltextTHEN infeld(fnr2jgstls);mnrallgemein:=mnrjgstfehlt; +LEAVE plausisallgemokWITH FALSE ;FI ;IF jgstls<>niltextTHEN standardpruefe(2, +fnr2jgstls,null,null,niltext,status);IF status<>0COR (int(jgstls)<10COR int( +jgstls)>13)THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2jgstls);LEAVE +plausisallgemokWITH FALSE ;FI ;FI ;IF jgstneu<>niltextTHEN standardpruefe(2, +fnr3jgstneu,null,null,niltext,status);IF status<>0COR (int(jgstneu)<11COR int +(jgstneu)>13)THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr3jgstneu);LEAVE +plausisallgemokWITH FALSE ;FI ;FI ;IF jgstls=niltextTHEN nurneue:=TRUE ELIF +jgstneu=niltextTHEN nurls:=TRUE ELSE lsundneue:=TRUE FI ;FI ;TRUE END PROC +plausisallgemok;BOOL PROC schuelervorhanden:IF NOT bestschuelerTHEN +schuelerdatenauskwdatenraumholen(aktschueler);FI ;inittupel( +dnrhalbjahresdaten);putwert(fnrhjdfamnames,famname);putwert(fnrhjdrufnames, +rufname);putwert(fnrhjdgebdats,gebdat);putwert(fnrhjdsj,niltext);putwert( +fnrhjdhj,niltext);search(dnrhalbjahresdaten,FALSE );dbstatus=0AND wert( +fnrhjdfamnames)=famnameAND wert(fnrhjdrufnames)=rufnameAND wert(fnrhjdgebdats +)=gebdatEND PROC schuelervorhanden;BOOL PROC kurswahldatenraumda:INT VAR +fehler;sj:=schulkenndatum("Schuljahr");hj:=schulkenndatum("Schulhalbjahr"); +IF nurlsTHEN kurswahlinitialisieren(jgstls,jgstls,hj,ohneneuang,kwsj);ELIF +nurneueTHEN jgstls:=text(int(jgstneu)-1);kurswahlinitialisieren(jgstls,jgstls +,hj,neuang,kwsj);ELSE kurswahlinitialisieren(jgstls,jgstls,hj,mitneuang,kwsj) +FI ;kurswahlbasisholen(fehler);IF fehler<>0THEN mnrallgemein:= +mnrkeinekwdatenda;infeld(fnr2jgstls);ELSE erster:=ersterschueler;letzter:= +letzterschuelerFI ;fehler=0END PROC kurswahldatenraumda;END PACKET +likwwahlundkursdatensek2 + diff --git a/app/schulis/2.2.1/src/2.schueler zu kursen zuordnen b/app/schulis/2.2.1/src/2.schueler zu kursen zuordnen new file mode 100644 index 0000000..32187e4 --- /dev/null +++ b/app/schulis/2.2.1/src/2.schueler zu kursen zuordnen @@ -0,0 +1,384 @@ +PACKET schuelerzukursenzuordnenDEFINES schuelerkursenzuordnenabbruch, +schuelerkursenzuordnenanfang,schuelerkursenzuordnenpruefuebernahme, +schuelerkursenzuordnenuebernahme,schuelerkursenzuordnenpruefung, +schuelerkursenzuordnenspeichern,schuelerkursenzuordnenkopieren, +schuelerkursenzuordnenlisten:LET server="kurswahl server",kuwa2sperre= +"Kurswahl-2 ",anzschuelerbs=15,laengefakeartkl=9,laengekurs=6,laengedseintrag +=15,az="#",trenner1="$",trenner2="�",maskeeingang= +"ms schueler zu kursen zuordnen eingang",maskebearb= +"ms schueler zu kursen zuordnen bearb",stdzeigbloecke= +"1 2 3 4 5 6 7 8 9 10 11 ",leerewahldaten=" ", +leereweiterewahldaten=" ",kzname="N",kzkurse="K",kznurneue="N",kzohneneue= +"O",kzalle="A",kennungplanbl="P",kennungfapl="FP",kennungfaartkl="FAk", +kennungfakeartkl="FKAk",kennungfake="FK",kennungkeinkurs=" - ", +kennungkeinfach=" * ",meldungbearbwird=352,meldungfeldleeren=390, +meldungunbeklv=360,meldungfeldfuellen=52,meldungschonkurs=424, +meldungbittewarten=69,meldungfalscherwert=55,meldungspeicherfehler=364, +meldungjgstfalsch=404,meldungjgstfehlt=172,meldunghjfalsch=405,meldungpruefen +=329,meldungspeichern=50,meldungnspeichern=63,meldungandereauswahl=318, +meldungunzulauswahl=56,meldungserverfehler=376,meldunglistezeigen=7, +meldungparallelanw=425,meldungkeinedaten=68,meldungkeinekopfunktion=318, +logtext1="Anw. 2.2.2 ",logtext2=" für akt. ",text1="Kurszuordnung ",text2= +"Kurse übernehmen ",text3=" nach ",punkt=".",felderstername=7, +felderstekennung=9,feldletztekennung=65,anzfeldereingang=36;INT VAR i,j,z; +INT VAR letztepos:=2,ijgst,ihj,fstat,aktpos:=1,aktfeld,pos1,pos2,blockpos, +suchab,jgst1,jgst2,findpos,feld,blpos,kopzeile,aktzeile,anfpos,anzkurse, +anzsch,endpos,anzschueler,fapos,saktpos,ssuchab;TEXT VAR aktjgst,akthj:="", +gewjgst,gewhj,zusjgst,zushj,gewsj,alleplblbez,alleschueler1:="",alleschueler2 +:="",wahl,neuewahldaten,weiterewahldaten,wahldaten,alleschueler:="", +zeigbloecke,fach:="",art:="",kennungdesschuelers,name,kennungjetzt, +kennungvorher,planbloecke,aktfeldinh,t,nname,vname,gdat,ausgabe:="",block, +vorz,blockbez,aktkennung,liste:="",kurse,kurs,kennung,kursliste,fakennung, +fawahl,sname,logmeldung,klkz,klwahl;ROW anzfeldereingangTEXT VAR eingangrow; +ROW anzschuelerbsROW 4TEXT VAR schueler;BOOL VAR zusspaltezeigen:=FALSE , +belegungpruefen:=FALSE ,sperreok,speicherungsfehler:=FALSE ,bewertung, +klausurkz:=FALSE ;WINDOW VAR w;PROC schuelerkursenzuordnenpruefuebernahme:IF +menuedraussenTHEN reorganizescreenFI END PROC +schuelerkursenzuordnenpruefuebernahme;PROC schuelerkursenzuordnenuebernahme( +BOOL CONST uebernehmen):merkeeingangbs;IF uebernehmenTHEN standardmeldung( +meldungbittewarten,"");aktpos:=1;gewjgst:=eingangrow(2);gewhj:=eingangrow(3); +ijgst:=int(gewjgst);ihj:=int(gewhj);zusjgst:=eingangrow(35);zushj:=eingangrow +(36);IF akthj=""THEN akthj:=schulkenndatum("Schulhalbjahr")FI ;prueffeld2und3 +;prueffeld4;prueffeld5;prueffeld634;prueffeld3536;datenholen; +betrachtealleschueler;logmeldung:=text2;logmeldungCAT zusjgst;logmeldungCAT +punkt;logmeldungCAT zushj;logmeldungCAT text3;logmeldungCAT gewjgst; +logmeldungCAT punkt;logmeldungCAT gewhj;logbucheintragvornehmen(logmeldung); +kurswahlsperrebeenden(kuwa2sperre)FI ;enter(2).prueffeld2und3:IF gewjgst="" +THEN fehlermeldungausgeben(2,meldungjgstfehlt,1);LEAVE +schuelerkursenzuordnenuebernahmeELIF gewhj=""THEN fehlermeldungausgeben(2, +meldunghjfalsch,1);LEAVE schuelerkursenzuordnenuebernahmeELIF jgstfalsch( +gewjgst,"11")THEN fehlermeldungausgeben(2,meldungjgstfalsch,1);LEAVE +schuelerkursenzuordnenuebernahmeELIF ihj<1COR ihj>2THEN fehlermeldungausgeben +(3,meldunghjfalsch,1);LEAVE schuelerkursenzuordnenuebernahmeFI .prueffeld4: +aktfeldinh:=eingangrow(4);IF aktfeldinh=""THEN IF eingangrow(5)=""THEN +fehlermeldungausgeben(4,meldungandereauswahl,1);LEAVE +schuelerkursenzuordnenuebernahmeELSE LEAVE prueffeld4FI ELIF jgstfalsch( +gewjgst,aktfeldinh)THEN fehlermeldungausgeben(4,meldungunzulauswahl,1);LEAVE +schuelerkursenzuordnenuebernahmeELIF int(aktfeldinh)=ijgstTHEN pruefhjELIF +aktfeldinh="10"CAND akthj="1"THEN fehlermeldungausgeben(4, +meldungandereauswahl,1);LEAVE schuelerkursenzuordnenuebernahmeFI .pruefhj:IF +gewhj="1"CAND akthj="2"THEN fehlermeldungausgeben(3,meldungandereauswahl,1); +LEAVE schuelerkursenzuordnenuebernahmeFI .prueffeld5:aktfeldinh:=eingangrow(5 +);IF aktfeldinh=""THEN LEAVE prueffeld5ELIF aktfeldinh<>""CAND eingangrow(4) +<>""THEN IF int(aktfeldinh)<>int(eingangrow(4))+1THEN fehlermeldungausgeben(5 +,meldungunzulauswahl,1);LEAVE schuelerkursenzuordnenuebernahmeFI ELIF int( +aktfeldinh)>ijgstTHEN fehlermeldungausgeben(5,meldungunzulauswahl,1);LEAVE +schuelerkursenzuordnenuebernahmeFI .prueffeld634:FOR iFROM 6UPTO 34REP IF +standardmaskenfeld(i)<>""THEN fehlermeldungausgeben(i,meldungfeldleeren,1); +LEAVE schuelerkursenzuordnenuebernahmeFI PER .prueffeld3536:zusjgst:= +eingangrow(35);zushj:=eingangrow(36);IF zusjgst=""THEN fehlermeldungausgeben( +35,meldungjgstfehlt,1);LEAVE schuelerkursenzuordnenuebernahmeELIF zushj="" +THEN fehlermeldungausgeben(36,meldunghjfalsch,1);LEAVE +schuelerkursenzuordnenuebernahmeELIF zusjgst=gewjgstCAND zushj=gewhjTHEN +fehlermeldungausgeben(35,meldungandereauswahl,1);LEAVE +schuelerkursenzuordnenuebernahmeELIF jgstfalsch(zusjgst,"11")THEN +fehlermeldungausgeben(35,meldungjgstfalsch,1);LEAVE +schuelerkursenzuordnenuebernahmeELIF zushj<>"1"CAND zushj<>"2"THEN +fehlermeldungausgeben(36,meldunghjfalsch,1);LEAVE +schuelerkursenzuordnenuebernahmeFI .datenholen:IF NOT exists(/server)THEN +fehlermeldungausgeben(letztepos,meldungserverfehler,1);LEAVE +schuelerkursenzuordnenuebernahmeFI ;IF eingangrow(4)=""THEN t:=kznurneue; +aktjgst:=text(int(eingangrow(5))-1)ELIF eingangrow(5)=""THEN t:=kzohneneue; +aktjgst:=eingangrow(4)ELSE t:=kzalle;aktjgst:=eingangrow(4)FI ; +kurswahlinitialisieren(aktjgst,gewjgst,gewhj,t,gewsj);kurswahlbasisholen( +fstat);erweitertekurswahlbasisholen(zusjgst,zushj,fstat);kurswahlsperresetzen +(kuwa2sperre,sperreok);IF NOT sperreokTHEN fehlermeldungausgeben(infeld, +meldungparallelanw,1);LEAVE schuelerkursenzuordnenuebernahmeFI . +betrachtealleschueler:FOR iFROM ersterschuelerUPTO letzterschuelerREP +wahldaten:=wahldatenzumindex(i,kzkurse);name:=wahldatenzumindex(i,kzname); +pos1:=pos(name,trenner2,1)-1;pos2:=pos(name,trenner2,pos1+2)-1;nname:=subtext +(name,1,pos1);vname:=subtext(name,pos1+2,pos2);gdat:=subtext(name,pos2+2,pos2 ++9);standardmeldung(meldungbearbwird,vname+" "+nname+az);weiterewahldaten:= +weiterewahldatenzumschueler(nname,vname,gdat,kennungfakeartkl); +betrachtekennungen;kurswahl2sichern(fstat)PER .betrachtekennungen:pos1:=1; +neuewahldaten:="";WHILE pos1kennungvorherTHEN planbloecke:=kursdaten(fach+kennungvorher, +kennungplanbl);IF dbstatus=0THEN neuewahldatenCAT text(wahl,1);neuewahldaten +CAT art;neuewahldatenCAT fach;neuewahldatenCAT kennungvorher;neuewahldaten +CAT planbloeckeELSE neuewahldatenCAT wahlFI ELSE neuewahldatenCAT wahlFI ; +pos1INCR laengedseintragPER ;IF wahldaten<>neuewahldatenTHEN +schuelerwahleintragen(nname,vname,gdat,neuewahldaten)FI .END PROC +schuelerkursenzuordnenuebernahme;PROC schuelerkursenzuordnenanfang: +standardstartproc(maskeeingang);gibeingangaus;standardfelderausgeben;infeld( +letztepos);standardnproc.gibeingangaus:FOR iFROM 2UPTO anzfeldereingangREP +standardmaskenfeld(eingangrow(i),i);IF eingangrow(i)<>""THEN letztepos:=iFI +PER .END PROC schuelerkursenzuordnenanfang;PROC +schuelerkursenzuordnenpruefung:standardmeldung(meldungbittewarten,""); +merkeeingangbs;aktpos:=1;gewjgst:=eingangrow(2);gewhj:=eingangrow(3);ijgst:= +int(gewjgst);ihj:=int(gewhj);IF akthj=""THEN akthj:=schulkenndatum( +"Schulhalbjahr")FI ;prueffeld2und3;prueffeld4;prueffeld5;prueffeld6und7; +prueffeld8bis13;prueffeld3536;datenholen;betrachtebelegung; +planblockbezpruefen;schueleraufzeigen.betrachtebelegung:FOR iFROM 14UPTO 23 +REP IF eingangrow(i)<>""THEN planblockvorzpruefen;planblockbez15bis23pruefen; +belegungpruefen:=TRUE ;LEAVE betrachtebelegungFI ;PER ;belegungpruefen:= +FALSE .prueffeld2und3:IF gewjgst=""THEN fehlermeldungausgeben(2, +meldungjgstfehlt,1);LEAVE schuelerkursenzuordnenpruefungELIF gewhj=""THEN +fehlermeldungausgeben(2,meldunghjfalsch,1);LEAVE +schuelerkursenzuordnenpruefungELIF jgstfalsch(gewjgst,"11")THEN +fehlermeldungausgeben(2,meldungjgstfalsch,1);LEAVE +schuelerkursenzuordnenpruefungELIF ihj<1COR ihj>2THEN fehlermeldungausgeben(3 +,meldunghjfalsch,1);LEAVE schuelerkursenzuordnenpruefungFI .prueffeld4: +aktfeldinh:=eingangrow(4);IF aktfeldinh=""THEN IF eingangrow(5)=""THEN +fehlermeldungausgeben(4,meldungandereauswahl,1);LEAVE +schuelerkursenzuordnenpruefungELSE LEAVE prueffeld4FI ELIF jgstfalsch(gewjgst +,aktfeldinh)THEN fehlermeldungausgeben(4,meldungunzulauswahl,1);LEAVE +schuelerkursenzuordnenpruefungELIF int(aktfeldinh)=ijgstTHEN pruefhjELIF +aktfeldinh="10"CAND akthj="1"THEN fehlermeldungausgeben(4, +meldungandereauswahl,1);LEAVE schuelerkursenzuordnenpruefungFI .pruefhj:IF +gewhj="1"CAND akthj="2"THEN fehlermeldungausgeben(3,meldungandereauswahl,1); +LEAVE schuelerkursenzuordnenpruefungFI .prueffeld5:aktfeldinh:=eingangrow(5); +IF aktfeldinh=""THEN LEAVE prueffeld5ELIF aktfeldinh<>""CAND eingangrow(4)<> +""THEN IF int(aktfeldinh)<>int(eingangrow(4))+1THEN fehlermeldungausgeben(5, +meldungunzulauswahl,1);LEAVE schuelerkursenzuordnenpruefungFI ELIF int( +aktfeldinh)>ijgstTHEN fehlermeldungausgeben(5,meldungunzulauswahl,1);LEAVE +schuelerkursenzuordnenpruefungFI .prueffeld6und7:zusjgst:=eingangrow(6);zushj +:=eingangrow(7);IF zusjgst=""CAND zushj<>""THEN fehlermeldungausgeben(6, +meldungjgstfehlt,1);LEAVE schuelerkursenzuordnenpruefungELIF zushj=""CAND +zusjgst<>""THEN fehlermeldungausgeben(7,meldunghjfalsch,1);LEAVE +schuelerkursenzuordnenpruefungELIF zushj=""CAND zusjgst=""THEN +zusspaltezeigen:=FALSE ELIF zusjgst=gewjgstCAND zushj=gewhjTHEN +fehlermeldungausgeben(6,meldungandereauswahl,1);LEAVE +schuelerkursenzuordnenpruefungELIF jgstfalsch(gewjgst,"11")THEN +fehlermeldungausgeben(6,meldungjgstfalsch,1);LEAVE +schuelerkursenzuordnenpruefungELIF ihj<1COR ihj>2THEN fehlermeldungausgeben(7 +,meldunghjfalsch,1);LEAVE schuelerkursenzuordnenpruefungELIF jgstfalsch( +gewjgst,zusjgst)THEN fehlermeldungausgeben(6,meldungandereauswahl,1);LEAVE +schuelerkursenzuordnenpruefungELSE zusspaltezeigen:=TRUE FI .prueffeld8bis13: +klkz:=compress(eingangrow(10));klausurkz:=klkz<>"";FOR iFROM 8UPTO 13REP IF +eingangrow(i)<>""THEN LEAVE prueffeld8bis13FI PER ;fehlermeldungausgeben(8, +meldungfeldfuellen,1);LEAVE schuelerkursenzuordnenpruefung.prueffeld3536:IF +eingangrow(35)<>""COR eingangrow(36)<>""THEN fehlermeldungausgeben(35, +meldungandereauswahl,1);LEAVE schuelerkursenzuordnenpruefungFI . +planblockvorzpruefen:IF planblockvorzfalsch(14)COR planblockvorzfalsch(16) +COR planblockvorzfalsch(18)COR planblockvorzfalsch(20)COR planblockvorzfalsch +(22)THEN kurswahlsperrebeenden(kuwa2sperre);LEAVE +schuelerkursenzuordnenpruefungFI .datenholen:IF NOT exists(/server)THEN +fehlermeldungausgeben(letztepos,meldungserverfehler,1);LEAVE +schuelerkursenzuordnenpruefungFI ;IF eingangrow(4)=""THEN t:=kznurneue; +aktjgst:=text(int(eingangrow(5))-1)ELIF eingangrow(5)=""THEN t:=kzohneneue; +aktjgst:=eingangrow(4)ELSE t:=kzalle;aktjgst:=eingangrow(4)FI ; +kurswahlinitialisieren(aktjgst,gewjgst,gewhj,t,gewsj);kurswahlbasisholen( +fstat);IF zusspaltezeigenTHEN erweitertekurswahlbasisholen(zusjgst,zushj, +fstat);FI ;kurswahlsperresetzen(kuwa2sperre,sperreok);IF sperreokTHEN +alleplblbez:=alleplanblockbezeichnerELSE fehlermeldungausgeben(infeld, +meldungparallelanw,1);LEAVE schuelerkursenzuordnenpruefungFI . +planblockbez15bis23pruefen:IF planblockbezfalsch(eingangrow(15))THEN +fehlermeldungausgeben(15,meldungfalscherwert,1);kurswahlsperrebeenden( +kuwa2sperre);LEAVE schuelerkursenzuordnenpruefungELIF planblockbezfalsch( +eingangrow(17))THEN fehlermeldungausgeben(17,meldungfalscherwert,1); +kurswahlsperrebeenden(kuwa2sperre);LEAVE schuelerkursenzuordnenpruefungELIF +planblockbezfalsch(eingangrow(19))THEN fehlermeldungausgeben(19, +meldungfalscherwert,1);kurswahlsperrebeenden(kuwa2sperre);LEAVE +schuelerkursenzuordnenpruefungELIF planblockbezfalsch(eingangrow(21))THEN +fehlermeldungausgeben(21,meldungfalscherwert,1);kurswahlsperrebeenden( +kuwa2sperre);LEAVE schuelerkursenzuordnenpruefungELIF planblockbezfalsch( +eingangrow(23))THEN fehlermeldungausgeben(23,meldungfalscherwert,1); +kurswahlsperrebeenden(kuwa2sperre);LEAVE schuelerkursenzuordnenpruefungFI . +planblockbezpruefen:zeigbloecke:="";FOR iFROM 24UPTO 34REP IF +planblockbezfalsch(eingangrow(i))THEN fehlermeldungausgeben(i, +meldungfalscherwert,1);kurswahlsperrebeenden(kuwa2sperre);LEAVE +schuelerkursenzuordnenpruefungFI ;IF eingangrow(i)<>""THEN zeigbloeckeCAT +konvblock(eingangrow(i))FI ;PER .END PROC schuelerkursenzuordnenpruefung; +BOOL PROC planblockbezfalsch(TEXT CONST anwblock):suchab:=1;IF anwblock="" +THEN FALSE ELSE block:=text(anwblock,3);WHILE pos(alleplblbez,block,suchab)<> +0REP j:=pos(alleplblbez,block,suchab);IF jMOD 3=1THEN LEAVE +planblockbezfalschWITH FALSE ELSE suchab:=j+1FI PER ;TRUE FI END PROC +planblockbezfalsch;BOOL PROC planblockvorzfalsch(INT CONST feld):t:=( +eingangrow(feld)SUB 1);IF t<>""THEN IF eingangrow(feld+1)=""THEN +fehlermeldungausgeben(feld+1,meldungfeldfuellen,1);TRUE ELIF NOT (t="-"COR t= +"+")THEN fehlermeldungausgeben(feld,meldungfalscherwert,1);TRUE ELSE FALSE +FI ELIF eingangrow(feld+1)<>""THEN fehlermeldungausgeben(feld, +meldungfeldfuellen,1);TRUE ELSE FALSE FI END PROC planblockvorzfalsch;PROC +fehlermeldungausgeben(INT CONST feld,meldung,ruecksprung):infeld(feld); +standardmeldung(meldung,"");return(ruecksprung)END PROC fehlermeldungausgeben +;BOOL PROC jgstfalsch(TEXT CONST jgst,abjgst):jgst1:=int(jgst);jgst2:=int( +abjgst);jgst113END PROC jgstfalsch;PROC initbspuffer:FOR i +FROM 1UPTO anzschuelerbsREP schueler(i)(1):="";schueler(i)(2):="";schueler(i) +(3):="";schueler(i)(4):=""PER END PROC initbspuffer;PROC schueleraufzeigen: +fach:=text(eingangrow(8),2);art:=text(eingangrow(9),2);holschueler;IF +alleschueler=""THEN meldungkeineschueler;kurswahlsperrebeenden(kuwa2sperre) +ELSE zeigbearbschirm;standardnprocFI .zeigbearbschirm:standardstartproc( +maskebearb);standardkopfmaskeaktualisieren("Kurszuordnung für jetzige Jgst. " ++aktjgst+" in "+gewjgst+"."+gewhj);ausgabe:=fach;ausgabeCAT art;ausgabeCAT +text(eingangrow(10),1);IF eingangrow(11)<>""THEN ausgabeCAT "+";ausgabeCAT +text(eingangrow(11),2);ausgabeCAT text(eingangrow(12),2);ausgabeCAT text( +eingangrow(13),1);ELSE ausgabeCAT " "FI ;standardmaskenfeld(ausgabe,2); +ausgabe:=" ";ausgabeCAT text(eingangrow(14),1);ausgabeCAT konvblock( +eingangrow(15));ausgabeCAT text(eingangrow(16),1);ausgabeCAT konvblock( +eingangrow(17));ausgabeCAT text(eingangrow(18),1);ausgabeCAT konvblock( +eingangrow(19));ausgabeCAT text(eingangrow(20),1);ausgabeCAT konvblock( +eingangrow(21));ausgabeCAT text(eingangrow(22),1);ausgabeCAT konvblock( +eingangrow(23));standardmaskenfeld(ausgabe,3);IF zusspaltezeigenTHEN +standardmaskenfeld(eingangrow(6)+"."+eingangrow(7),4);ELSE standardmaskenfeld +(" ",4);FI ;standardmaskenfeld(fach,5);IF zeigbloecke=""THEN zeigbloecke:= +stdzeigbloecke;standardmaskenfeld(stdzeigbloecke,6)ELSE standardmaskenfeld( +text(zeigbloecke,33),6)FI ;zeigschueler.meldungkeineschueler: +fehlermeldungausgeben(14,meldungkeinedaten,1).holschueler:alleschueler:=""; +alleschueler1:=schuelermitwahl(fach,"",art,eingangrow(10));IF eingangrow(11) +<>""THEN alleschueler2:=schuelermitwahl(eingangrow(11),"",eingangrow(12), +eingangrow(13));schuelervergleichELSE alleschueler2:="";IF belegungpruefen +THEN pruefbelegungallerschuelerELSE alleschueler:=alleschueler1;anzschueler:= +anzahlschuelermitwahl(fach,"",art,eingangrow(10))FI ;FI . +pruefbelegungallerschueler:saktpos:=1;ssuchab:=2;alleschueler:="";anzschueler +:=0;WHILE saktpos<>0REP saktpos:=pos(alleschueler1,trenner1,ssuchab);IF +saktpos<>0THEN sname:=subtext(alleschueler1,ssuchab,saktpos-1);IF +richtigebelegung(sname)THEN alleschuelerCAT trenner1+sname;anzschuelerINCR 1 +FI ;ssuchab:=saktpos+1FI PER ;sname:=subtext(alleschueler1,ssuchab);IF +richtigebelegung(sname)THEN alleschuelerCAT trenner1+sname;anzschuelerINCR 1 +FI .END PROC schueleraufzeigen;PROC zeigschueler:aktfeld:=felderstername; +initbspuffer;FOR iFROM 1UPTO anzschuelerbsREP wahldaten:="";weiterewahldaten +:="";kennungdesschuelers:="";standardmaskenfeld(schuelername,aktfeld); +standardmaskenfeld(text(wahldaten,22),aktfeld+3);standardmaskenfeld( +weiterewahldaten,aktfeld+1);IF kennungdesschuelers=leereweiterewahldatenTHEN +standardmaskenfeld("",aktfeld+2)ELSE standardmaskenfeld(kennungdesschuelers, +aktfeld+2)FI ;aktfeldINCR 4PER ;infeld(1);standardfelderausgeben;infeld(9). +END PROC zeigschueler;TEXT PROC schuelername:findpos:=pos(alleschueler, +trenner1,aktpos+1);IF findpos>0THEN name:=subtext(alleschueler,aktpos+2, +findpos-1);aktpos:=findposELIF aktpos=length(alleschueler)THEN name:=""ELSE +name:=subtext(alleschueler,aktpos+2);aktpos:=length(alleschueler)FI ; +bereitenameauf(name)END PROC schuelername;TEXT PROC bereitenameauf(TEXT +CONST name):ausgabe:=name;change(ausgabe,trenner2,", ");ausgabe:=text(ausgabe +,pos(ausgabe,trenner2)-1);wahldatenaufbereiten(name);text(ausgabe,23)END +PROC bereitenameauf;PROC wahldatenaufbereiten(TEXT CONST name):TEXT VAR +zblock;IF name=""THEN wahldaten:=leerewahldaten;weiterewahldaten:= +leereweiterewahldatenELSE pos1:=pos(name,trenner2,1)-1;pos2:=pos(name, +trenner2,pos1+2)-1;nname:=subtext(name,1,pos1);vname:=subtext(name,pos1+2, +pos2);gdat:=subtext(name,pos2+2,pos2+9);kennungdesschuelers:=kennungvonfach( +FALSE );IF kennungdesschuelers=kennungkeinfachCOR kennungdesschuelers= +kennungkeinkursTHEN kennungdesschuelers:=""FI ;schueler(i)(1):=nname;schueler +(i)(2):=vname;schueler(i)(3):=gdat;schueler(i)(4):=kennungdesschuelers; +ermittlewahldaten;ermittleweiterewahldatenFI .ermittlewahldaten:wahl:= +wahldatenzumschueler(nname,vname,gdat,kennungfake);blockpos:=1;WHILE blockpos +0REP aktpos:=pos(quelle, +teilmuster,suchab);IF aktposMOD laengekurs=1THEN LEAVE kurseingetragenWITH +TRUE ELSE suchab:=aktpos+1FI PER ;FALSE END PROC kurseingetragen;PROC +schuelervergleich:saktpos:=1;ssuchab:=2;anzschueler:=0;WHILE saktpos<>0REP +saktpos:=pos(alleschueler1,trenner1,ssuchab);IF saktpos<>0THEN sname:=subtext +(alleschueler1,ssuchab,saktpos-1);IF pos(alleschueler2,sname)>0THEN IF +belegungpruefenTHEN IF richtigebelegung(sname)THEN alleschuelerCAT trenner1+ +sname;anzschuelerINCR 1FI ELSE alleschuelerCAT trenner1+sname;anzschueler +INCR 1FI FI ;ssuchab:=saktpos+1FI PER ;sname:=subtext(alleschueler1,ssuchab); +IF pos(alleschueler2,sname)>0THEN IF belegungpruefenTHEN IF richtigebelegung( +sname)THEN alleschuelerCAT trenner1+sname;anzschuelerINCR 1FI ELSE +alleschuelerCAT trenner1+sname;anzschuelerINCR 1FI FI .END PROC +schuelervergleich;BOOL PROC richtigebelegung(TEXT CONST name):bewertung:= +TRUE ;pos1:=pos(name,trenner2,2)-1;pos2:=pos(name,trenner2,pos1+2)-1;nname:= +subtext(name,2,pos1);vname:=subtext(name,pos1+2,pos2);gdat:=subtext(name,pos2 ++2,pos2+9);feld:=12;FOR iFROM 1UPTO 5REP feldINCR 2;vorz:=eingangrow(feld); +IF vorz<>""THEN blockbez:=eingangrow(feld+1);block:=konvblock(blockbez);IF +vorz="-"THEN bewertung:=NOT schuelerinplanblock(nname,vname,gdat,block)ELSE +bewertung:=schuelerinplanblock(nname,vname,gdat,block)FI ;IF NOT bewertung +THEN LEAVE richtigebelegungWITH FALSE FI FI ;PER ;bewertungEND PROC +richtigebelegung;PROC schuelerkursenzuordnenspeichern(BOOL CONST speichern): +speicherungsfehler:=FALSE ;IF speichernTHEN pruefkennungen;speicherkennungen; +logmeldung:=text1;logmeldungCAT gewjgst;logmeldungCAT punkt;logmeldungCAT +gewhj;logbucheintragvornehmen(logmeldung);kurswahl2sichern(i);ELSE +standardmeldung(meldungnspeichern," ")FI ;naechsterbildschirm.pruefkennungen: +standardmeldung(meldungpruefen," ");j:=felderstekennung;FOR iFROM 1UPTO +anzschuelerbsREP kennung:=standardmaskenfeld(j);infeld(j);IF kennung<>""THEN +IF schueler(i)(1)=""THEN fehlermeldungkeinschuelerFI ;planbloecke:=compress( +kursdaten(fach+kennung,kennungplanbl));IF dbstatus<>0THEN +fehlermeldungunbekkennungELIF planbloecke<>""CAND kennung<>schueler(i)(4) +THEN pruefplanbloeckeFI FI ;jINCR 4PER .pruefplanbloecke:prueferstenblock;IF +length(planbloecke)>3THEN pruefzweitenblockFI .prueferstenblock:IF +schuelerinplanblock(schueler(i)(1),schueler(i)(2),schueler(i)(3),text( +planbloecke,3))THEN fehlermeldungschonkursblock1FI .pruefzweitenblock:IF +schuelerinplanblock(schueler(i)(1),schueler(i)(2),schueler(i)(3),subtext( +planbloecke,4))THEN fehlermeldungschonkursblock2FI . +fehlermeldungschonkursblock1:infeld((i-1)*4+9);standardmeldung( +meldungschonkurs,text(planbloecke,3)+az);return(1);LEAVE +schuelerkursenzuordnenspeichern.fehlermeldungschonkursblock2:infeld((i-1)*4+9 +);standardmeldung(meldungschonkurs,subtext(planbloecke,4)+az);return(1); +LEAVE schuelerkursenzuordnenspeichern.fehlermeldungkeinschueler: +fehlermeldungausgeben((i-1)*4+9,meldungfeldleeren,1);LEAVE +schuelerkursenzuordnenspeichern.fehlermeldungunbekkennung:infeld((i-1)*4+9); +standardmeldung(meldungunbeklv,fach+kennung+az);return(1);LEAVE +schuelerkursenzuordnenspeichern.speicherkennungen:standardmeldung( +meldungspeichern," ");j:=felderstekennung;FOR iFROM 1UPTO anzschuelerbsREP +kennung:=standardmaskenfeld(j);infeld(j);IF kennung<>schueler(i)(4)THEN IF +NOT klausurkzTHEN ermittleklkennzFI ;schuelerwahlaendern(schueler(i)(1), +schueler(i)(2),schueler(i)(3),fach,schueler(i)(4),art,fach,kennung,art,klkz); +IF dbstatus<>0THEN speicherungsfehler:=TRUE FI ;FI ;jINCR 4PER ;IF +speicherungsfehlerTHEN kurswahlserveraktualisieren(aktjgst,gewjgst,gewhj)FI . +naechsterbildschirm:kurswahl0holen(fstat);kurswahl1holen(fstat);IF aktpos< +length(alleschueler)CAND NOT speicherungsfehlerTHEN zeigschueler;return(1); +IF speicherungsfehlerTHEN standardmeldung(meldungspeicherfehler,"");FI ELSE +kurswahlsperrebeenden(kuwa2sperre);enter(2);IF speicherungsfehlerTHEN +standardmeldung(meldungspeicherfehler,"");infeld(letztepos)FI FI .END PROC +schuelerkursenzuordnenspeichern;PROC ermittleklkennz:klwahl:= +wahldatenzumschueler(schueler(i)(1),schueler(i)(2),schueler(i)(3), +kennungfaartkl);z:=1;WHILE z""REP +standardmaskenfeld(aktkennung,aktzeile);aktzeileINCR 4PER ;infeld(kopzeile+4) +;standardfelderausgeben;infeld(kopzeile+4);FI ;return(1).fehlermeldungkeinkop +:standardmeldung(meldungkeinekopfunktion,"").END PROC +schuelerkursenzuordnenkopieren;PROC schuelerkursenzuordnenlisten:kursliste:= +"";aktfeld:=infeld;w:=startwindow(35,23,77,1);liste:="";standardmeldung( +meldunglistezeigen,"");IF menuedraussenTHEN reorganizescreenFI ;fuelleliste; +infeld(1);standardfelderausgeben;open(w);auskunfterteilung(liste,w,FALSE ); +reorganizescreen;setlasteditvalues;infeld(aktfeld);return(1).fuelleliste: +listeCAT "Anzahl Schüler wie ausgewählt";listeCAT auskunftstextende;listeCAT +text(anzschueler);listeCAT auskunftstextende;listeCAT " ";listeCAT +auskunftstextende;listeCAT "Fach gewählt Kurszahl/-größe";listeCAT +auskunftstextende;listeCAT fach;listeCAT " ";listeCAT art;listeCAT " "; +listeCAT gewaehlteschueler;listeCAT " ";listeCAT anzahlkurse;listeCAT +kursgroesse;listeCAT auskunftstextende;listeCAT " ";listeCAT +auskunftstextende;listeCAT "Kurse Planblock Schüler";listeCAT +auskunftstextende;listeallerkurse.listeallerkurse:anfpos:=1;WHILE anfpos< +length(kursliste)REP listeCAT fach+" ";kennung:=subtext(kursliste,anfpos, +anfpos+3);listeCAT kennung;listeCAT " ";kurs:=kursdaten(fach+kennung, +kennungplanbl);IF kurs=""THEN listeCAT " "ELSE listeCAT text(int( +text(kurs,3)),2);listeCAT " ";listeCAT text(int(subtext(kurs,4)),2);liste +CAT " ";FI ;listeCAT text(anzahlschuelermitwahl(fach,kennung,"","")); +listeCAT auskunftstextende;anfposINCR 4PER .gewaehlteschueler:anzsch:= +anzahlschuelermitwahl(fach,"",art,"");text(text(anzsch),6).kursgroesse:text( +anzschDIV anzkurse).anzahlkurse:kurse:=allekurse;suchanfang;suchende;IF +anfpos=0THEN "0 "ELSE kurse:=subtext(kurse,anfpos,endpos); +betrachtekurse;text(text(anzkurse),10)FI .betrachtekurse:anzkurse:=0;anfpos:= +1;kursliste:="";WHILE anfpos0REP IF (anfposMOD 10)=1CAND subtext(kurse, +anfpos+8,anfpos+9)=artTHEN LEAVE suchanfangELSE anfpos:=pos(kurse,fach,anfpos ++1)FI ;PER .suchende:findpos:=pos(kurse,fach,anfpos+1);IF anfpos<>0THEN +endpos:=anfpos+9;WHILE findpos<>0REP IF (findposMOD 10)=1CAND subtext(kurse, +findpos+8,findpos+9)=artTHEN endpos:=findpos+9FI ;findpos:=pos(kurse,fach, +findpos+1)PER ;ELSE endpos:=0FI .END PROC schuelerkursenzuordnenlisten;TEXT +PROC konvblock(TEXT CONST blockbez):INT VAR block;IF blockbez<>""THEN block:= +int(text(blockbez,2));IF block<10THEN "0"+text(block)+text(blockbezSUB 3,1) +ELSE text(block)+text(blockbezSUB 3,1)FI ELSE " "FI END PROC konvblock; +PROC initrow:FOR iFROM 2UPTO anzfeldereingangREP eingangrow(i):=""PER END +PROC initrow;PROC merkeeingangbs:FOR iFROM 2UPTO anzfeldereingangREP +eingangrow(i):=standardmaskenfeld(i)PER .END PROC merkeeingangbs;PROC +logbucheintragvornehmen(TEXT CONST escfunktion):logeintrag(logtext1+ +escfunktion+logtext2+aktjgst)END PROC logbucheintragvornehmen;initrow;END +PACKET schuelerzukursenzuordnen; + diff --git a/app/schulis/2.2.1/src/2.stand der kursbildung analysieren b/app/schulis/2.2.1/src/2.stand der kursbildung analysieren new file mode 100644 index 0000000..f199978 --- /dev/null +++ b/app/schulis/2.2.1/src/2.stand der kursbildung analysieren @@ -0,0 +1,132 @@ +PACKET standderkursbildunganalysierenDEFINES +standderkursbildunganalysierenvorbereiten, +standderkursbildunganalysierenstarten,standderkursbildunganalysierendrucken: +LET maskeeingang="ms stand der kursbildung analysieren";LET fnrgewjgst=2, +fnrhalbjahr=3,fnraktjgst=4,fnrneuanjgst=5,fnralleschueler=6;FILE VAR prot; +LET protname="Zuordnung von Schülern zu Kursen";LET schulhalbjahr= +"Schulhalbjahr",schulname="Schulname",schulort="Schulort";LET jgst10=10, +jgst11=11,jgst13=13,hj1=1,hj2=2;LET meldnrdatenwerdengeprueft=57, +meldnrbittewarten=69,meldnrbearbeitetwird=102,meldnrbitteangabeergaenzen=129, +meldnrfalschejgstfolge=410,meldnrfalschebezugsjgst=411,meldnrkurswahlfehler= +416;LET feldanzmaskeeingang=6;ROW feldanzmaskeeingangTEXT VAR feldbs1;INT +VAR letztecursorfnr:=fnrgewjgst,pruefstatus,kurswahlstatus;TEXT VAR +aktuelleshalbjahr:="",aktjgst,gewjgst,gewhalbjahr,neuanjgst,gewschuljahr; +BOOL VAR alleschueler,fehlerinschuelerwahl;TEXT VAR gewschueler;LET +nuraktuelleschueler="O",nurneuangemeldete="N";INT VAR ischueler;TEXT VAR +wahldaten,schuelername,anfangsbuchstabe,kurs,gueltigekurse;INT VAR ikurs;LET +maxkurse=13;ROW maxkurseSTRUCT (TEXT eintrag,TEXT pb1,TEXT pb2)VAR +kurshinweis;TEXT VAR planbloecke,belegtebloecke,pbnr,pbkennung,pruefblock; +LET pbkennunga="a",pbkennungb="b",pbleer=" ";INT VAR poskurs;LET laengekurs +=6,laengeschuelerkurs=15,laengekursangaben=10,laengeplanblock=3;LET trenner= +"�",schraegstrich="/",doppelpunkt=":",kennzhell="#";LET kennungname="N", +kennungkurse="K",kennungplanblock="P";TEXT VAR auszeile,fachzeile,kurszeile, +fehlerzeile;LET ueberschrift="Zuordnung von Schülern zu Kursen",untertitel1= +"Jgst. ",erklaerung1="(Fehlende Zuordnungen sind mit ""_"" hervorgehoben,", +erklaerung2="Überschneidungen in Planblöcken mit ""*"",",erklaerung3= +"ungültige Kursbezeichnungen mit ""$"" markiert.)",blank=" ",zeilenbeginn= +" ",leereintrag=" :",ungueltigerkurs="$$$$:",fehlenderkurs="____:", +gleichzeitigerkurs="****:";initfelderdeseingangsbildschirms;PROC +standderkursbildunganalysierenvorbereiten:standardstartproc(maskeeingang); +wertedeseingangsbildschirmsholen;infeld(fnrgewjgst);standardfelderausgeben; +infeld(letztecursorfnr);standardnprocEND PROC +standderkursbildunganalysierenvorbereiten;PROC +standderkursbildunganalysierenstarten:eingangsbehandlung;IF pruefstatus>0 +THEN infeld(pruefstatus);return(1)ELSE wertedeseingangsbildschirmsmerken; +standardmeldung(meldnrbittewarten,"");kurswahlinitialisieren(aktjgst,gewjgst, +gewhalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen(kurswahlstatus);IF +kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)ELSE +protokollvorbereiten;kurszuordnungenanalysieren;zeigedatei(protname,"")FI FI +.protokollvorbereiten:forget(protname,quiet);prot:=sequentialfile(output, +protname);putline(prot,schulkenndatum(schulname));auszeile:=text( +schulkenndatum(schulort),60);auszeileCAT date;putline(prot,auszeile);line( +prot,2);putline(prot,20*blank+ueberschrift);auszeile:=22*blank;auszeileCAT +untertitel1;auszeileCAT aktjgst;auszeileCAT " für ";auszeileCAT gewjgst; +auszeileCAT ".";auszeileCAT gewhalbjahr;auszeileCAT blank;auszeileCAT +aufberschuljahr;putline(prot,auszeile);line(prot,2);auszeile:=erklaerung1; +putline(prot,auszeile);auszeile:=erklaerung2;putline(prot,auszeile);auszeile +:=erklaerung3;putline(prot,auszeile).END PROC +standderkursbildunganalysierenstarten;PROC kurswahlfehlerbehandeln: +standardmeldung(meldnrkurswahlfehler,"");pause(10)END PROC +kurswahlfehlerbehandeln;TEXT PROC aufberschuljahr:TEXT VAR aufbersj:=subtext( +gewschuljahr,1,2);aufbersjCAT schraegstrich;aufbersjCAT subtext(gewschuljahr, +3,4);aufbersjEND PROC aufberschuljahr;PROC kurszuordnungenanalysieren: +gueltigekurse:=allekurse;anfangsbuchstabe:="";FOR ischuelerFROM +ersterschuelerUPTO letzterschuelerREP schuelerwahluntersuchenPER . +schuelerwahluntersuchen:fachzeile:=zeilenbeginn;kurszeile:=zeilenbeginn; +wahldaten:=wahldatenzumindex(ischueler,kennungkurse);schuelername:= +wahldatenzumindex(ischueler,kennungname);IF (schuelernameSUB 1)<> +anfangsbuchstabeTHEN anfangsbuchstabe:=schuelernameSUB 1;standardmeldung( +meldnrbearbeitetwird,anfangsbuchstabe+kennzhell)FI ;fehlerinschuelerwahl:= +FALSE ;belegtebloecke:="";poskurs:=1;FOR ikursFROM 1UPTO maxkurseREP kurs:= +subtext(wahldaten,poskurs+3,poskurs+laengekurs+2);IF kurs<>""THEN +facheintragen;kurseintragen;kurshinweiseintragenELSE leereintraegeergaenzen +FI ;poskursINCR laengeschuelerkursPER ;fehlerzeilezusammenstellen;IF +fehlerinschuelerwahlCOR alleschuelerTHEN line(prot);changeall(schuelername, +trenner,", ");putline(prot,schuelername);putline(prot,fachzeile);putline(prot +,kurszeile);putline(prot,fehlerzeile)FI .facheintragen:fachzeileCAT subtext( +kurs,1,2);fachzeileCAT " :".kurseintragen:IF subtext(kurs,3,6)<>" "THEN +kurszeileCAT subtext(kurs,3,6)ELSE kurszeileCAT subtext(wahldaten,poskurs+1, +poskurs+2);kurszeileCAT " "FI ;kurszeileCAT doppelpunkt.kurshinweiseintragen +:IF subtext(kurs,3,6)=" "THEN kurshinweis(ikurs).eintrag:=fehlenderkurs +ELIF suchpos(gueltigekurse,kurs,laengekursangaben)=0THEN kurshinweis(ikurs). +eintrag:=ungueltigerkursELSE kurshinweis(ikurs).eintrag:="";planbloecke:= +kursdaten(kurs,kennungplanblock);kurshinweis(ikurs).pb1:=subtext(planbloecke, +1,3);kurshinweis(ikurs).pb2:=subtext(planbloecke,4,6);belegtenblockeintragen( +kurshinweis(ikurs).pb1);belegtenblockeintragen(kurshinweis(ikurs).pb2)FI . +fehlerzeilezusammenstellen:fehlerzeile:=zeilenbeginn;FOR ikursFROM 1UPTO +maxkurseREP IF kurshinweis(ikurs).eintrag=""THEN doppelbelegungpruefen; +fehlerzeileCAT kurshinweis(ikurs).eintrag;ELIF kurshinweis(ikurs).eintrag= +leereintragTHEN fehlerzeileCAT leereintragELSE fehlerzeileCAT kurshinweis( +ikurs).eintrag;fehlerinschuelerwahl:=TRUE FI PER .leereintraegeergaenzen: +fachzeileCAT leereintrag;kurszeileCAT leereintrag;kurshinweis(ikurs).eintrag +:=leereintrag.doppelbelegungpruefen:pruefblock:=kurshinweis(ikurs).pb1;IF +schnittliegtvorTHEN kurshinweis(ikurs).eintrag:=gleichzeitigerkurs; +fehlerinschuelerwahl:=TRUE ELSE pruefblock:=kurshinweis(ikurs).pb2;IF +schnittliegtvorTHEN kurshinweis(ikurs).eintrag:=gleichzeitigerkurs; +fehlerinschuelerwahl:=TRUE ELSE kurshinweis(ikurs).eintrag:=leereintragFI FI +.schnittliegtvor:IF pruefblock=pbleerTHEN FALSE ELSE pos(belegtebloecke, +pruefblock,suchpos(belegtebloecke,pruefblock,laengeplanblock)+1)>0FI .END +PROC kurszuordnungenanalysieren;PROC belegtenblockeintragen(TEXT VAR +belegterpb):IF belegterpb<>pbleerTHEN pbnr:=subtext(belegterpb,1,2);pbkennung +:=belegterpbSUB laengeplanblock;belegtebloeckeCAT pbnr;belegtebloeckeCAT +pbkennung;IF pbkennung=blankTHEN belegtebloeckeCAT pbnr;belegtebloeckeCAT +pbkennunga;belegtebloeckeCAT pbnr;belegtebloeckeCAT pbkennungb;ELSE +belegtebloeckeCAT pbnr;belegtebloeckeCAT blankFI ;FI END PROC +belegtenblockeintragen;PROC standderkursbildunganalysierendrucken(BOOL CONST +drucken):IF druckenTHEN print(protname)FI ;forget(protname,quiet);enter(2) +END PROC standderkursbildunganalysierendrucken;PROC eingangsbehandlung: +pruefstatus:=0;standardmeldung(meldnrdatenwerdengeprueft,"");aktjgst:= +standardmaskenfeld(fnraktjgst);gewhalbjahr:=standardmaskenfeld(fnrhalbjahr); +gewjgst:=standardmaskenfeld(fnrgewjgst);neuanjgst:=standardmaskenfeld( +fnrneuanjgst);alleschueler:=standardmaskenfeld(fnralleschueler)<>"";IF +aktuelleshalbjahr=""THEN aktuelleshalbjahr:=schulkenndatum(schulhalbjahr)FI ; +allgemeinefelderpruefen.allgemeinefelderpruefen:standardpruefe(3,fnrgewjgst, +jgst11,jgst13,"",pruefstatus);IF pruefstatus>0THEN LEAVE +allgemeinefelderpruefenFI ;standardpruefe(3,fnrhalbjahr,hj1,hj2,"", +pruefstatus);IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;IF aktjgst +<>""THEN IF int(aktuelleshalbjahr)=hj2THEN standardpruefe(3,fnraktjgst,jgst10 +,jgst13,"",pruefstatus)ELSE standardpruefe(3,fnraktjgst,jgst11,jgst13,"", +pruefstatus)FI ;IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;FI ;IF +neuanjgst<>""THEN standardpruefe(3,fnrneuanjgst,jgst11,jgst13,"",pruefstatus) +;IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;FI ;IF aktjgst<>"" +THEN IF neuanjgst<>""THEN IF int(neuanjgst)<>int(aktjgst)+1THEN +standardmeldung(meldnrfalschejgstfolge,"");pruefstatus:=fnraktjgst;LEAVE +allgemeinefelderpruefenFI ;gewschueler:=""ELSE gewschueler:= +nuraktuelleschuelerFI ELIF neuanjgst=""THEN standardmeldung( +meldnrbitteangabeergaenzen,"");pruefstatus:=fnraktjgst;LEAVE +allgemeinefelderpruefenELSE gewschueler:=nurneuangemeldete;aktjgst:=text(int( +neuanjgst)-1)FI ;IF aktjgst>gewjgstCOR (aktjgst=gewjgstAND aktuelleshalbjahr> +gewhalbjahr)THEN standardmeldung(meldnrfalschebezugsjgst,"");pruefstatus:= +fnrgewjgst;LEAVE allgemeinefelderpruefenFI .END PROC eingangsbehandlung;INT +PROC suchpos(TEXT CONST quelle,suchtext,INT CONST laenge):INT VAR findpos:= +pos(quelle,suchtext);WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE +suchposWITH findposELSE findpos:=pos(quelle,suchtext,findpos+1);FI PER ; +findposEND PROC suchpos;PROC initfelderdeseingangsbildschirms:INT VAR i;FOR i +FROM 1UPTO feldanzmaskeeingangREP feldbs1(i):=""PER END PROC +initfelderdeseingangsbildschirms;PROC wertedeseingangsbildschirmsmerken:INT +VAR i;letztecursorfnr:=infeld;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1( +i):=standardmaskenfeld(i)PER END PROC wertedeseingangsbildschirmsmerken;PROC +wertedeseingangsbildschirmsholen:INT VAR i;FOR iFROM 1UPTO +feldanzmaskeeingangREP standardmaskenfeld(feldbs1(i),i)PER END PROC +wertedeseingangsbildschirmsholen;END PACKET standderkursbildunganalysieren + diff --git a/app/schulis/2.2.1/src/3.anschr.betroffene lehrer b/app/schulis/2.2.1/src/3.anschr.betroffene lehrer new file mode 100644 index 0000000..453a590 --- /dev/null +++ b/app/schulis/2.2.1/src/3.anschr.betroffene lehrer @@ -0,0 +1,174 @@ +PACKET auskunftlehrerDEFINES lehrerauskunfteingang,lehrerauskunftstarten, +lehrerauskunftsonderwerte:LET anrede=511,nameaufbereitet=513;INT VAR x,index +:=dnrlehrer,aktuellesfach,aktuelleart,aktuelleartlehrbefaehigunglangtext;LET +schulj=526,halbj=527,ermaessgrund1langtext=550,ermaessgrund2langtext=551, +ermaessgrund3langtext=552,ermaessgrund4langtext=553;INT VAR +aktswklassenlehrer:=580,aktswstellvertreter:=581;LET ganztage=520,ganzgew=521 +,vormtage=522,vormgew=523,nachtage=524,nachgew=525;LET swdatum=520,swzeit=521 +,swart=522,swlv=523;LET maske="ms auskunft lehrer eingang",paraphenfeldnr=2, +trenner="/",niltext="",blank=" ",strich=" --- ",mnrbittewarten=69, +mnrkeinegueltigeparaphe=344;TEXT CONST dateimitvordruck1:= +"vordruck1 auskunft lehrer",dateimitvordruck2:="vordruck2 auskunft lehrer", +dateimitvordruck3:="vordruck3 auskunft lehrer",dateimitvordruck4:= +"vordruck4 auskunft lehrer",dateimitvordruck5:="vordruck5 auskunft lehrer", +dateimitvordruck6:="vordruck6 auskunft lehrer",dateimitvordruck7:= +"vordruck7 auskunft lehrer",bestandnameartlehrbefaehigung:= +"c02 art lehrbefaehigung",bestandnamepersoenlermaessigung:= +"c02 persoenl ermaess";TEXT VAR angegebeneparaphe:="",aktuelleshalbjahr, +aktuellesschuljahr,geplanteshalbjahr,geplantesschuljahr,schuljahr:="", +halbjahr:="";INT VAR zeilenzahl,zeilenhilfszahl,zusatzzeilen;BOOL PROC +paraphevorhanden:putwert(fnrlparaphe,angegebeneparaphe);search(dnrlehrer, +TRUE );IF dbstatus=0THEN TRUE ELSE FALSE FI END PROC paraphevorhanden;PROC +lehrerauskunfteingang:standardvproc(maske)END PROC lehrerauskunfteingang; +PROC lehrerauskunftstarten:angegebeneparaphe:=standardmaskenfeld( +paraphenfeldnr);IF angegebeneparaphe<>niltextTHEN startenausfuehrenELSE +meldeeingabefehler;zurueckzumdialogFI ;.meldeeingabefehler:standardmeldung( +mnrkeinegueltigeparaphe,niltext).zurueckzumdialog:return(1).startenausfuehren +:IF NOT (paraphevorhanden)THEN meldeeingabefehler;zurueckzumdialogELSE BOOL +CONST bildschirmausgabe:=FALSE ,einzelbearbeitung:=TRUE ;aktuelleshalbjahr:= +schulkenndatum("Schulhalbjahr");aktuellesschuljahr:=schulkenndatum( +"Schuljahr");geplanteshalbjahr:=aktuelleshalbjahr;geplantesschuljahr:= +aktuellesschuljahr;geplanteshjundsjberechnen(geplanteshalbjahr, +geplantesschuljahr);setzesonderwerteschulkenndaten;setzewerte;standardmeldung +(mnrbittewarten,niltext);zusammengesetztesanschreiben(index,bildschirmausgabe +,einzelbearbeitung,BOOL PROC lehrerauskunftsonderwerte,BOOL PROC +scanbedingung,TEXT PROC druckdateibauen);FI ;.setzewerte:putwert(fnrlparaphe, +angegebeneparaphe)END PROC lehrerauskunftstarten;BOOL PROC scanbedingung:IF +dbstatus=0THEN TRUE ELSE FALSE FI END PROC scanbedingung;BOOL PROC +lehrerauskunftsonderwerte:LET sechs=6;ROW sechsTEXT VAR artlehrbefaehigung; +initialisieresonderwerte;adressat(angegebeneparaphe);TEXT VAR anredetext:= +"Frau";IF wert(fnrlgeschlecht)="m"THEN anredetext:="Herrn"FI ;setzesonderwert +(anrede,anredetext);setzesonderwert(nameaufbereitet,wert(fnrlrufname)+" "+ +wert(fnrlzusatz)+" "+wert(fnrlfamname));TEXT VAR grund1,grund2,grund3,grund4; +grund1:=wert(fnrlermgrund1);grund2:=wert(fnrlermgrund2);grund3:=wert( +fnrlermgrund3);grund4:=wert(fnrlermgrund4);inittupel(dnrlehrbefaehigungen); +putwert(fnrlbparaphe,angegebeneparaphe);search(ixlbpar,FALSE );aktuellesfach +:=514;aktuelleart:=515;aktuelleartlehrbefaehigunglangtext:=554;FOR xFROM 1 +UPTO sechsREP IF dbstatus=0AND wert(fnrlbparaphe)=angegebeneparapheTHEN +setzesonderwert(aktuellesfach,wert(fnrlbfach));artlehrbefaehigung(x):=wert( +fnrlbart);setzesonderwert(aktuelleart,artlehrbefaehigung(x));ELSE +setzesonderwert(aktuellesfach,niltext);artlehrbefaehigung(x):=niltext; +setzesonderwert(aktuelleart,niltext);FI ;succ(ixlbpar);aktuellesfachINCR 2; +aktuelleartINCR 2PER ;inittupel(dnrschluessel);putwert(fnrschlsachgebiet, +bestandnamepersoenlermaessigung);putwert(fnrschlschluessel,grund1);search( +dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert(ermaessgrund1langtext, +wert(fnrschllangtext))ELSE setzesonderwert(ermaessgrund1langtext,blank)FI ; +putwert(fnrschlschluessel,grund2);search(dnrschluessel,TRUE );IF dbstatus=0 +THEN setzesonderwert(ermaessgrund2langtext,wert(fnrschllangtext));ELSE +setzesonderwert(ermaessgrund2langtext,blank);FI ;putwert(fnrschlschluessel, +grund3);search(dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert( +ermaessgrund3langtext,wert(fnrschllangtext))ELSE setzesonderwert( +ermaessgrund3langtext,blank)FI ;putwert(fnrschlschluessel,grund4);search( +dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert(ermaessgrund4langtext, +wert(fnrschllangtext))ELSE setzesonderwert(ermaessgrund4langtext,blank)FI ; +putwert(fnrschlsachgebiet,bestandnameartlehrbefaehigung);FOR xFROM 1UPTO 6 +REP putwert(fnrschlschluessel,artlehrbefaehigung(x));search(dnrschluessel, +TRUE );IF dbstatus=0THEN setzesonderwert(aktuelleartlehrbefaehigunglangtext, +wert(fnrschllangtext))ELSE setzesonderwert(aktuelleartlehrbefaehigunglangtext +,blank)FI ;aktuelleartlehrbefaehigunglangtextINCR 1PER ;TRUE END PROC +lehrerauskunftsonderwerte;TEXT PROC druckdateibauen:LET druckdatei="liste.1", +hilfsdatei="hilfsdatei";TEXT VAR zeile;INT VAR i;BOOL VAR mitdatendesgeplhjs +:=FALSE ;BOOL VAR weiteresaetzeda:=FALSE ;vordruckeholen; +setzemitseitennummern(TRUE );druckvorbereiten;zeilenzahl:=0;zusatzzeilen:=0; +briefalternative(dateimitvordruck1,hilfsdatei);hilfsdateiindruckdatei( +hilfsdatei);zusatzzeilen:=5;sonderwertsjundhjsetzen(aktuellesschuljahr, +aktuelleshalbjahr);ggfvordruck21malundvordruck3xmalindruckdatei( +mitdatendesgeplhjs);mitdatendesgeplhjs:=TRUE ;sonderwertsjundhjsetzen( +geplantesschuljahr,geplanteshalbjahr); +ggfvordruck21malundvordruck3xmalindruckdatei(mitdatendesgeplhjs);zusatzzeilen +:=4;vordruck4indruckdatei(aktuellesschuljahr,aktuelleshalbjahr); +vordruck4indruckdatei(geplantesschuljahr,geplanteshalbjahr);zusatzzeilen:=14; +vordruck5indruckdatei(aktuellesschuljahr,aktuelleshalbjahr); +vordruck5indruckdatei(geplantesschuljahr,geplanteshalbjahr);zusatzzeilen:=4; +ggf1malvordruck6undxmalvordruck7indruckdatei;drucknachbereitenohneausdrucken; +vordruckeloeschen;druckdatei.vordruckeholen:fetch(dateimitvordruck1,/ +"anschreiben server");fetch(dateimitvordruck2,/"anschreiben server");fetch( +dateimitvordruck3,/"anschreiben server");fetch(dateimitvordruck4,/ +"anschreiben server");fetch(dateimitvordruck5,/"anschreiben server");fetch( +dateimitvordruck6,/"anschreiben server");fetch(dateimitvordruck7,/ +"anschreiben server");.vordruckeloeschen:forget(dateimitvordruck1,quiet); +forget(dateimitvordruck2,quiet);forget(dateimitvordruck3,quiet);forget( +dateimitvordruck4,quiet);forget(dateimitvordruck5,quiet);forget( +dateimitvordruck6,quiet);forget(dateimitvordruck7,quiet);. +ggf1malvordruck6undxmalvordruck7indruckdatei:inittupel(dnrvertretungen); +putwert(fnrvparaphe,angegebeneparaphe);search(ixvpar,FALSE );IF dbstatus=0 +AND wert(fnrvparaphe)=angegebeneparapheTHEN swvertretungenfuellen; +briefalternative(dateimitvordruck6,hilfsdatei);hilfsdateiindruckdatei( +hilfsdatei);weiteresaetzeda:=FALSE ;succ(ixvpar);zusatzzeilen:=1;WHILE +dbstatus=0AND wert(fnrvparaphe)=angegebeneparapheREP weiteresaetzeda:=TRUE ; +swvertretungenfuellen;briefalternative(dateimitvordruck7,hilfsdatei);succ( +ixvpar);PER ;IF weiteresaetzedaTHEN hilfsdateiindruckdatei(hilfsdatei)FI ;FI +;END PROC druckdateibauen;PROC swvertretungenfuellen:TEXT VAR datum, +datumaufber,lehrveranstg,lvaufber,zeitaufber;INT VAR zeit,tag,std; +initialisieresonderwerte;datum:=wert(fnrvdatum);zeit:=intwert(fnrvtagstd); +lehrveranstg:=wert(fnrvveranstaltung);datumaufber:=subtext(datum,1,2)+"."; +datumaufberCAT subtext(datum,4,5)+".";datumaufberCAT subtext(datum,7,8);tag:= +(zeit-1)DIV 12;std:=zeitMOD 12;IF tag=0THEN zeitaufber:="Mo "ELIF tag=1THEN +zeitaufber:="Di "ELIF zeit=2THEN zeitaufber:="Mi "ELIF zeit=3THEN zeitaufber +:="Do "ELIF zeit=4THEN zeitaufber:="Fr "ELIF zeit=5THEN zeitaufber:="Sa "FI ; +zeitaufberCAT text(std,2);lvaufber:=subtext(lehrveranstg,1,2)+blank;lvaufber +CAT subtext(lehrveranstg,3,4)+blank;lvaufberCAT subtext(lehrveranstg,5,8); +setzesonderwert(swdatum,datumaufber);setzesonderwert(swzeit,zeitaufber); +setzesonderwert(swart,wert(fnrvanrechnung));setzesonderwert(swlv,lvaufber); +END PROC swvertretungenfuellen;PROC hilfsdateiindruckdatei(TEXT CONST +hilfsdatei):FILE VAR f;INT VAR i;TEXT VAR zeile;f:=sequentialfile(input, +hilfsdatei);zeilenhilfszahl:=lines(f);IF zeilenzahl+zeilenhilfszahl+ +zusatzzeilen>=drucklaengeTHEN seitenwechsel;zeilenzahl:=0;FI ;FOR iFROM 1 +UPTO zeilenhilfszahlREP getline(f,zeile);druckzeileschreiben(zeile)PER ; +forget(hilfsdatei,quiet);zeilenzahlINCR zeilenhilfszahlEND PROC +hilfsdateiindruckdatei;PROC sonderwertsjundhjsetzen(TEXT VAR sj,hj): +setzesonderwert(schulj,subtext(sj,1,2)+trenner+subtext(sj,3,4)); +setzesonderwert(halbj,hj);END PROC sonderwertsjundhjsetzen;PROC +ggfvordruck21malundvordruck3xmalindruckdatei(BOOL VAR geplhj):LET aktjgst=528 +,aktfach=529,aktkurs=530,aktwochstd=531,hilfsdatei="hilfsdatei";TEXT VAR fach +,jgst:=blank,kennung;IF geplhjTHEN halbjahr:=geplanteshalbjahr;schuljahr:= +geplantesschuljahr;ELSE halbjahr:=aktuelleshalbjahr;schuljahr:= +aktuellesschuljahr;FI ;inittupel(dnrlehrveranstaltungen);putwert(fnrlvparaphe +,angegebeneparaphe);putwert(fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr); +search(ixlvsjhjpar,FALSE );IF dbstatus=0AND (wert(fnrlvparaphe)= +angegebeneparaphe)AND (wert(fnrlvhj)=halbjahr)AND (wert(fnrlvsj)=schuljahr) +THEN briefalternative(dateimitvordruck2,hilfsdatei); +sonderwertesetzenundinhilfsdateischreiben;hilfsdateiindruckdatei(hilfsdatei); +FI ;.sonderwertesetzenundinhilfsdateischreiben:WHILE dbstatus=0AND (wert( +fnrlvparaphe)=angegebeneparaphe)AND (wert(fnrlvhj)=halbjahr)AND (wert(fnrlvsj +)=schuljahr)REP fach:=subtext(wert(fnrlvfachkennung),1,2);setzesonderwert( +aktfach,fach);kennung:=subtext(wert(fnrlvfachkennung),3,6);setzesonderwert( +aktkurs,kennung);jgstCAT wert(fnrlvjgst);IF length(jgst)>2THEN +setzesonderwert(aktjgst,subtext(jgst,2,3));ELSE setzesonderwert(aktjgst,jgst) +;FI ;jgst:=blank;setzesonderwert(aktwochstd,wert(fnrlvwochenstd)); +briefalternative(dateimitvordruck3,hilfsdatei);succ(ixlvsjhjpar);PER ;END +PROC ggfvordruck21malundvordruck3xmalindruckdatei;PROC vordruck4indruckdatei( +TEXT VAR sj,hj):LET hilfsdatei="hilfsdatei";TEXT VAR aufberwert:=niltext; +BOOL VAR hilfsdateiangelegt:=FALSE ;TEXT VAR ueberschrift:="Schuljahr "; +initialisieresonderwerte;aktswklassenlehrer:=580;aktswstellvertreter:=581; +ueberschriftCAT subtext(sj,1,2)+"/"+subtext(sj,3,4);ueberschriftCAT ", "+hj+ +". Halbjahr";setzesonderwert(schulj,ueberschrift);inittupel( +dnraktschuelergruppen);putwert(fnrsgrpsj,sj);putwert(fnrsgrphj,hj);search( +dnraktschuelergruppen,FALSE );WHILE dbstatus=0AND wert(fnrsgrphj)=hjREP IF +wert(fnrsgrplehrer)=angegebeneparapheAND aktswklassenlehrer<590THEN +aufberwert:=wert(fnrsgrpjgst);aufberwertCAT wert(fnrsgrpkennung); +setzesonderwert(aktswklassenlehrer,aufberwert);aktswklassenlehrerINCR 2; +hilfsdateiangelegt:=TRUE ;ELSE IF wert(fnrsgrpstellvlehrer)=angegebeneparaphe +AND aktswstellvertreter<591THEN aufberwert:=wert(fnrsgrpjgst);aufberwertCAT +wert(fnrsgrpkennung);setzesonderwert(aktswstellvertreter,aufberwert); +aktswstellvertreterINCR 2;hilfsdateiangelegt:=TRUE ;FI ;FI ;succ( +dnraktschuelergruppen)PER ;IF hilfsdateiangelegtTHEN briefalternative( +dateimitvordruck4,hilfsdatei);hilfsdateiindruckdatei(hilfsdatei);FI ;END +PROC vordruck4indruckdatei;PROC vordruck5indruckdatei(TEXT VAR sj,hj):LET +hilfsdatei="hilfsdatei";TEXT VAR zeitwuensche,ueberschrift:="Schuljahr "; +initialisieresonderwerte;INT VAR aktswzeitwunsch:=531,position:=1,i; +ueberschriftCAT subtext(sj,1,2)+"/"+subtext(sj,3,4);ueberschriftCAT ", "+hj+ +". Halbjahr";setzesonderwert(schulj,ueberschrift);inittupel(dnrzeitwuensche); +putwert(fnrzwsj,sj);putwert(fnrzwhj,hj);putwert(fnrzwbezug,"P");putwert( +fnrzwbezugsobjekt,angegebeneparaphe);search(dnrzeitwuensche,TRUE );IF +dbstatus=0THEN zeitwuensche:=wert(fnrzwunbestimmtewuensche);setzesonderwert( +ganztage,zeitwuenscheSUB 1);setzesonderwert(ganzgew,zeitwuenscheSUB 3); +setzesonderwert(vormtage,zeitwuenscheSUB 4);setzesonderwert(vormgew, +zeitwuenscheSUB 6);setzesonderwert(nachtage,zeitwuenscheSUB 7); +setzesonderwert(nachgew,zeitwuenscheSUB 9);zeitwuensche:=wert( +fnrzwbestimmtewuensche);FOR iFROM 1UPTO 66REP setzesonderwert(aktswzeitwunsch +,subtext(zeitwuensche,position,position+1));aktswzeitwunschINCR 1;position +INCR 2PER ;briefalternative(dateimitvordruck5,hilfsdatei); +hilfsdateiindruckdatei(hilfsdatei);FI ;END PROC vordruck5indruckdatei;END +PACKET auskunftlehrer; + diff --git a/app/schulis/2.2.1/src/3.erf lehrer b/app/schulis/2.2.1/src/3.erf lehrer new file mode 100644 index 0000000..47846ee --- /dev/null +++ b/app/schulis/2.2.1/src/3.erf lehrer @@ -0,0 +1,134 @@ +PACKET erflehrerDEFINES erfassunglehrer:LET trenner=" = ",komma=", ",leer="", +trennerfuerimbestand="�",dateinameschluessel="Schlüssel",dateinamefaecher= +"Fächer",null=0;LET maskenname="ms erf lehrer",fnrletztesfeld=32,fnrparaphe=2 +,fnrfamilienname=3,fnrrufname=4,fnrnamenszusatz=5,fnramtsbezeichnung=6, +fnrgeschlecht=7,fnrstrasseundnummer=8,fnrplzundort=9,fnrtelefon=10, +fnrlehrbeffach=11,fnrlehrbefart=12,fnrpflichtstunden=23,fnrermaessigung=24, +fnrermaessigungsgrund=25,fnrsprechzeiten=32,anzlehrbefprolehrer=6, +anzermprolehrer=4;LET untergrenze=0,obergrenze=99,paraphenlaenge=4, +bestandermgrund="c02 persoenl ermaess",bestandartlehrbef= +"c02 art lehrbefaehigung",meldungparaphezulang=178,meldungzugeschlecht=55, +meldungzumbestand=55,meldungzusollstunden=175,meldungzulehrbeffach=177, +meldungzufachdoppelt=176;ROW anzlehrbefprolehrerSTRUCT (TEXT fach,art)VAR +altelehrbefaehigungen;TEXT VAR alteparaphe;INT VAR sollstunden;PROC +erfassunglehrer(INT CONST proznr):reinitparsing;SELECT proznrOF CASE 1: +setzeerfassungsparameterCASE 2:zeigelehrerzurbearbeitungCASE 3: +pruefeplausibilitaetCASE 4:setzewertefuerdbspeicherungCASE 5: +setzeidentiobjektfuerobjektlisteCASE 6:lehrerlesenCASE 7:lehreraendernCASE 8: +lehrereinfuegenCASE 9:lehrerloeschenEND SELECT END PROC erfassunglehrer;PROC +setzeerfassungsparameter:systemdboff;setzeerfassungsparameter(dnrlehrer, +maskenname,fnrletztesfeld).END PROC setzeerfassungsparameter;PROC +zeigelehrerzurbearbeitung:INT VAR i;alteparaphe:=wert(fnrlparaphe); +setzeerfassungsfeld(wert(fnrlparaphe),fnrparaphe);setzeerfassungsfeld(wert( +fnrlfamname),fnrfamilienname);setzeerfassungsfeld(wert(fnrlrufname), +fnrrufname);setzeerfassungsfeld(wert(fnrlzusatz),fnrnamenszusatz); +setzeerfassungsfeld(wert(fnrlamtsbeztitel),fnramtsbezeichnung); +setzeerfassungsfeld(wert(fnrlgeschlecht),fnrgeschlecht);setzeerfassungsfeld( +wert(fnrlpflichtstd),fnrpflichtstunden);FOR iFROM 0UPTO anzermprolehrer-1REP +setzeerfassungsfeld(wert(fnrlerm1+2*i),fnrermaessigung+2*i); +setzeerfassungsfeld(wert(fnrlermgrund1+2*i),fnrermaessigungsgrund+2*i)PER ; +FOR iFROM 0UPTO 5REP setzeerfassungsfeld(altelehrbefaehigungen(i+1).fach, +fnrlehrbeffach+2*i);setzeerfassungsfeld(altelehrbefaehigungen(i+1).art, +fnrlehrbefart+2*i)PER ;setzeerfassungsfeld(wert(fnrlsprechzeit), +fnrsprechzeiten);setzeerfassungsfeld(wert(fnrlstrnr),fnrstrasseundnummer); +setzeerfassungsfeld(wert(fnrlplzort),fnrplzundort);setzeerfassungsfeld(wert( +fnrltelnr),fnrtelefon)END PROC zeigelehrerzurbearbeitung;PROC +pruefeplausibilitaet:INT VAR i,j,fehlerstatus;pruefe(1,erfassungsmaske,PROC +erfassungswert,fnrparaphe,null,null,leer,fehlerstatus);IF fehlerstatus<>0 +THEN setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;IF length( +erfassungswert(fnrparaphe))>paraphenlaengeTHEN meldeauffaellig( +erfassungsmaske,meldungparaphezulang);setzefehlerstatus(fnrparaphe);LEAVE +pruefeplausibilitaetFI ;pruefe(1,erfassungsmaske,PROC erfassungswert, +fnrfamilienname,null,null,leer,fehlerstatus);IF fehlerstatus<>0THEN +setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;IF +erfassungswert(fnrgeschlecht)<>"m"AND erfassungswert(fnrgeschlecht)<>"w"THEN +meldeauffaellig(erfassungsmaske,meldungzugeschlecht);setzefehlerstatus( +fnrgeschlecht);LEAVE pruefeplausibilitaetFI ;FOR iFROM 0UPTO +anzlehrbefprolehrer-1REP IF erfassungswert(fnrlehrbefart+2*i)<>""THEN IF +erfassungswert(fnrlehrbeffach+2*i)=""THEN meldeauffaellig(erfassungsmaske, +meldungzulehrbeffach);setzefehlerstatus(fnrlehrbeffach+2*i);LEAVE +pruefeplausibilitaetFI ;IF NOT imbestand(bestandartlehrbef+ +trennerfuerimbestand+erfassungswert(fnrlehrbefart+2*i),dateinameschluessel) +THEN meldeauffaellig(erfassungsmaske,meldungzumbestand);setzefehlerstatus( +fnrlehrbefart+2*i);LEAVE pruefeplausibilitaetFI FI ;IF erfassungswert( +fnrlehrbeffach+2*i)<>""THEN FOR jFROM i+1UPTO anzlehrbefprolehrer-1REP IF +erfassungswert(fnrlehrbeffach+2*i)=erfassungswert(fnrlehrbeffach+2*j)THEN +meldeauffaellig(erfassungsmaske,meldungzufachdoppelt);setzefehlerstatus( +fnrlehrbeffach+2*i);LEAVE pruefeplausibilitaetFI PER ;IF NOT imbestand( +erfassungswert(fnrlehrbeffach+2*i),dateinamefaecher)THEN meldeauffaellig( +erfassungsmaske,meldungzumbestand);setzefehlerstatus(fnrlehrbeffach+2*i); +LEAVE pruefeplausibilitaetFI FI PER ;IF erfassungswert(fnrpflichtstunden)<>"" +THEN pruefe(2,erfassungsmaske,PROC erfassungswert,fnrpflichtstunden,null,null +,leer,fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus); +LEAVE pruefeplausibilitaetFI ;pruefe(3,erfassungsmaske,PROC erfassungswert, +fnrpflichtstunden,untergrenze,obergrenze,leer,fehlerstatus);IF fehlerstatus<> +0THEN setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;FI ; +sollstunden:=int(erfassungswert(fnrpflichtstunden));FOR iFROM 0UPTO +anzermprolehrer-1REP IF erfassungswert(fnrermaessigung+2*i)<>""THEN pruefe(2, +erfassungsmaske,PROC erfassungswert,fnrermaessigung+2*i,null,null,leer, +fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);LEAVE +pruefeplausibilitaetFI ;pruefe(3,erfassungsmaske,PROC erfassungswert, +fnrermaessigung+2*i,untergrenze,obergrenze,leer,fehlerstatus);IF fehlerstatus +<>0THEN setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;FI ; +sollstunden:=sollstunden-int(erfassungswert(fnrermaessigung+2*i));IF +sollstunden<0THEN meldeauffaellig(erfassungsmaske,meldungzusollstunden); +setzefehlerstatus(fnrermaessigung+2*i);LEAVE pruefeplausibilitaetFI ;IF +erfassungswert(fnrermaessigungsgrund+2*i)<>""THEN IF NOT imbestand( +bestandermgrund+trennerfuerimbestand+erfassungswert(fnrermaessigungsgrund+2*i +),dateinameschluessel)THEN meldeauffaellig(erfassungsmaske,meldungzumbestand) +;setzefehlerstatus(fnrermaessigungsgrund+2*i);LEAVE pruefeplausibilitaetFI +FI PER END PROC pruefeplausibilitaet;PROC setzewertefuerdbspeicherung:INT +VAR i;putwert(fnrlparaphe,erfassungswert(fnrparaphe));putwert(fnrlfamname, +erfassungswert(fnrfamilienname));putwert(fnrlrufname,erfassungswert( +fnrrufname));putwert(fnrlzusatz,erfassungswert(fnrnamenszusatz));putwert( +fnrlamtsbeztitel,erfassungswert(fnramtsbezeichnung));putwert(fnrlgeschlecht, +erfassungswert(fnrgeschlecht));putintwert(fnrlsollstd,sollstunden);putwert( +fnrlpflichtstd,erfassungswert(fnrpflichtstunden));FOR iFROM 0UPTO +anzermprolehrer-1REP putwert(fnrlerm1+2*i,erfassungswert(fnrermaessigung+2*i) +);putwert(fnrlermgrund1+2*i,erfassungswert(fnrermaessigungsgrund+2*i))PER ; +putwert(fnrlsprechzeit,erfassungswert(fnrsprechzeiten));putwert(fnrlstrnr, +erfassungswert(fnrstrasseundnummer));putwert(fnrlplzort,erfassungswert( +fnrplzundort));putwert(fnrltelnr,erfassungswert(fnrtelefon))END PROC +setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET +trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert(fnrlparaphe)+ +trenner+wert(fnrlfamname)+komma+wert(fnrlrufname);setzeidentiwert( +identizeilemitschluesselanhang).identizeilemitschluesselanhang:identizeile+ +trennsymbolfuerobli+wert(fnrlparaphe).END PROC +setzeidentiobjektfuerobjektliste;PROC lehrerlesen:INT VAR i,j;putwert( +fnrlparaphe,schluessel);search(dnrlehrer,TRUE );IF dbstatus=okTHEN +saveupdateposition(dnrlehrer);putwert(fnrlbparaphe,schluessel);putwert( +fnrlbfach,leer);search(ixlbpar);i:=0;WHILE dbstatus=okCAND i< +anzlehrbefprolehrerCAND wert(fnrlbparaphe)=schluesselREP i:=i+1; +altelehrbefaehigungen(i).fach:=wert(fnrlbfach);altelehrbefaehigungen(i).art:= +wert(fnrlbart);succ(ixlbpar);PER ;FOR jFROM i+1UPTO anzlehrbefprolehrerREP +altelehrbefaehigungen(j).fach:="";altelehrbefaehigungen(j).art:=""PER ; +dbstatus(ok)FI END PROC lehrerlesen;PROC lehreraendern:INT VAR i; +restoreupdateposition(dnrlehrer);update(dnrlehrer);logbucheintrag("Änderung") +;FOR iFROM 0UPTO anzlehrbefprolehrer-1REP IF alteparaphe<>schluesselCOR +erfassungswert(fnrlehrbeffach+2*i)<>altelehrbefaehigungen(i+1).fachCOR +erfassungswert(fnrlehrbefart+2*i)<>altelehrbefaehigungen(i+1).artTHEN IF +altelehrbefaehigungen(i+1).fach=leerCAND erfassungswert(fnrlehrbeffach+2*i)<> +leerTHEN putwert(fnrlbfach,erfassungswert(fnrlehrbeffach+2*i));putwert( +fnrlbart,erfassungswert(fnrlehrbefart+2*i));putwert(fnrlbparaphe,schluessel); +insert(dnrlehrbefaehigungen)ELSE putwert(fnrlbfach,altelehrbefaehigungen(i+1) +.fach);putwert(fnrlbparaphe,alteparaphe);putwert(fnrlbart, +altelehrbefaehigungen(i+1).art);IF erfassungswert(fnrlehrbeffach+2*i)=leer +THEN delete(dnrlehrbefaehigungen)ELSE search(dnrlehrbefaehigungen,TRUE );IF +dbstatus=okTHEN putwert(fnrlbfach,erfassungswert(fnrlehrbeffach+2*i));putwert +(fnrlbart,erfassungswert(fnrlehrbefart+2*i));putwert(fnrlbparaphe,schluessel) +;update(dnrlehrbefaehigungen)FI FI FI ;dbstatus(ok)FI PER END PROC +lehreraendern;PROC lehrereinfuegen:INT VAR i;insert(dnrlehrer);logbucheintrag +("Neueinfügen");FOR iFROM 0UPTO anzlehrbefprolehrer-1REP IF erfassungswert( +fnrlehrbeffach+2*i)<>""THEN putwert(fnrlbfach,erfassungswert(fnrlehrbeffach+2 +*i));putwert(fnrlbart,erfassungswert(fnrlehrbefart+2*i));putwert(fnrlbparaphe +,schluessel);insert(dnrlehrbefaehigungen)FI PER END PROC lehrereinfuegen; +PROC lehrerloeschen:delete(dnrlehrer);logbucheintrag("Entfernen");putwert( +fnrlbparaphe,schluessel);putwert(fnrlbfach,leer);search(ixlbpar);WHILE +dbstatus=okCAND wert(fnrlbparaphe)=schluesselREP delete(dnrlehrbefaehigungen) +;succ(ixlbpar);PER ;dbstatus(ok)END PROC lehrerloeschen;PROC logbucheintrag( +TEXT CONST logergaenzung):TEXT VAR eintrag:="Anw. 3.1.1 ";eintragCAT +logergaenzung;eintragCAT " """;eintragCAT schluessel;eintragCAT """ """; +eintragCAT wert(fnrlfamname);eintragCAT """";logeintrag(eintrag)END PROC +logbucheintrag;TEXT PROC schluessel:erfassungswert(fnrparaphe)END PROC +schluessel;END PACKET erflehrer + diff --git a/app/schulis/2.2.1/src/3.listen.lehrbef faecherweise b/app/schulis/2.2.1/src/3.listen.lehrbef faecherweise new file mode 100644 index 0000000..d9c03b3 --- /dev/null +++ b/app/schulis/2.2.1/src/3.listen.lehrbef faecherweise @@ -0,0 +1,104 @@ +PACKET lehrbefaehigungenfaecherweiselisteDEFINES +faecherwlehrbeflispezielleteile:LET lehrbefaehigungeingangsmaske= +"ms liste lehrbefaehigungen faecherweise eingang", +anzahlderobjekteprobildschirm=17,ausgfeldlaenge=1,lehrbefaehigunganfpos=2, +spaltenbreite1fach=12,spaltenbreite2art=6,spaltenbreite3paraphe=4, +spaltentrenner=" ",wochenstdanfpos=2,ueberschriftenzeilen=2,ausgkopflaenge=2, +strich="-",blank=" ",null=0,niltext="",mnrauswahlnichtsinnvoll=56, +mnrbearbeitetwerden=352;TEXT CONST spaltentext:=("Fach"+9*blank+"Art"+3*blank ++"Lehrer"),spaltenstrich:=length(spaltentext)*strich;TEXT VAR +lehrbefaehigungueberschriftbs:="Liste der Lehrbefähigungen", +lehrbefaehigungueberschriftdr:="Liste der Lehrbefähigungen",alteparahpe:="", +paraphe:="",alteart:="",art:="",altesfach:="",fach:="",teiltextmeldung:= +"Fächer mit den Anfangsbuchstaben:",anfbuchstabe:="",neueranfbuchstabe:=""; +INT VAR eingabestatus,bildanfang,druckzeilenzahl;LET AUSGFELD =ROW +ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW +ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf; +AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC multistop:TRUE END PROC multistop; +PROC faecherwlehrbeflispezielleteile(INT CONST nr):SELECT nrOF CASE 1: +faecherwlehrbefaehigungdialogvorbereitenCASE 2: +faecherwlehrbefaehigungeingabenrichtigCASE 3: +faecherwlehrbefaehigunglistenvorbereitenCASE 4: +faecherwlehrbefaehigungdruckvorbereitenCASE 5: +faecherwlehrbefaehigungseitedruckenCASE 6: +faecherwlehrbefaehigungbildschirmvorbereitenCASE 7: +faecherwlehrbefaehigungseitezeigenENDSELECT .END PROC +faecherwlehrbeflispezielleteile;PROC faecherwlehrbefaehigungdialogvorbereiten +:lehrbefaehigungueberschriftbs:=text(vergleichsknoten);setzeanfangswerte( +lehrbefaehigungeingangsmaske,lehrbefaehigunganfpos)END PROC +faecherwlehrbefaehigungdialogvorbereiten;PROC +faecherwlehrbefaehigungeingabenrichtig:LET fnrausgdrucker=2,fnrausgbild=3; +standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF +eingabestatus=0THEN setzeeingabetest(TRUE );setzeausgabedrucker( +standardmaskenfeld(fnrausgbild)=niltext);ELSE meldefehler;setzeeingabetest( +FALSE )FI ;.meldefehler:standardmeldung(mnrauswahlnichtsinnvoll,niltext).END +PROC faecherwlehrbefaehigungeingabenrichtig;PROC +faecherwlehrbefaehigunglistenvorbereiten:BOOL VAR b;initspalten; +setzespaltentrenner(spaltentrenner);inittupel(dnrlehrbefaehigungen); +setzeidentiwert("");initobli(anzahlderobjekteprobildschirm); +objektlistestarten(ixlbart,"",0,TRUE ,b);setzebestandende(b);END PROC +faecherwlehrbefaehigunglistenvorbereiten;PROC +faecherwlehrbefaehigungbildschirmvorbereiten:LET fnrausganf=2; +standardkopfmaskeaktualisieren(lehrbefaehigungueberschriftbs);bildanfang:= +fnrausganf;setzebildanfangsposition(bildanfang);setzespaltenbreite(bildbreite +);spaltenweise(spaltentext);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos; +erhoeheausgabeposumeins;spaltenweise(spaltenstrich);ausgfeld(1):=zeile; +ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;setzebildanfangsposition(4); +spaltenbreitensetzenEND PROC faecherwlehrbefaehigungbildschirmvorbereiten; +PROC faecherwlehrbefaehigungseitezeigen:altesfach:=niltext;alteart:=niltext; +blaettern(PROC (INT CONST )lehrbefdatenfachweisezeigen,aktion,TRUE ,FALSE , +BOOL PROC multistop)END PROC faecherwlehrbefaehigungseitezeigen;PROC +lehrbefdatenfachweisezeigen(INT CONST x): +datenausdateilehrbefaehigungenfachweiseholen; +datenausdateilehrbefaehigungenfachweiseaufbereitenbild; +datenfachweiseaufbildschirmausgebenEND PROC lehrbefdatenfachweisezeigen;PROC +datenausdateilehrbefaehigungenfachweiseholen:fach:=wert(fnrlbfach);art:=wert( +fnrlbart);paraphe:=wert(fnrlbparaphe)END PROC +datenausdateilehrbefaehigungenfachweiseholen;PROC +datenausdateilehrbefaehigungenfachweiseaufbereitenbild:IF fach<>altesfach +THEN spaltenweise(fach);spaltenweise(art)ELSE spaltenweise(blank);IF art<> +alteartTHEN spaltenweise(art)ELSE spaltenweise(blank)FI ;FI ;spaltenweise( +paraphe);alteparahpe:=paraphe;altesfach:=fach;alteart:=art;END PROC +datenausdateilehrbefaehigungenfachweiseaufbereitenbild;PROC +datenfachweiseaufbildschirmausgeben:INT VAR i;FOR iFROM 1UPTO ausgfeldlaenge +REP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ; +END PROC datenfachweiseaufbildschirmausgeben;PROC +faecherwlehrbefaehigungdruckvorbereiten:setzebestandende(FALSE );anfbuchstabe +:=" ";druckvorbereiten;variablenfuerdrucksetzen;lehrbefaehigungueberschriftdr +CAT " fachweise";initdruckkopf(zentriert(lehrbefaehigungueberschriftdr, +druckbreite),zentriert(length(lehrbefaehigungueberschriftdr)*"-",druckbreite) +);spaltenbreitensetzen;initausgabekopfdruck;inittupel(dnrlehrbefaehigungen); +lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL +PROC multistop);.variablenfuerdrucksetzen:druckzeilenzahl:=drucklaenge( +ueberschriftenzeilen)-ausgkopflaenge.END PROC +faecherwlehrbefaehigungdruckvorbereiten;PROC initausgabekopfdruck: +ausgkopfdruck(1):=spaltentext;ausgkopfdruck(2):=spaltenstrichEND PROC +initausgabekopfdruck;PROC faecherwlehrbefaehigungseitedrucken: +lehrbefaehigungueberschriftdrucken;altesfach:=niltext;alteart:=niltext; +seitedrucken(PROC (INT VAR )lehrbefaehigungdrucken,druckzeilenzahl, +ausgfeldlaenge,BOOL PROC multistop);seitenwechselEND PROC +faecherwlehrbefaehigungseitedrucken;PROC lehrbefaehigungueberschriftdrucken: +INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP +druckzeileschreiben(ausgkopfdruck(i))PER END PROC +lehrbefaehigungueberschriftdrucken;PROC lehrbefaehigungdrucken(INT VAR +zeilenzaehler):LET markiert="#";datenausdateilehrbefaehigungenfachweiseholen; +ggflmeldunganfbuchstabe;IF fach<>altesfachTHEN spaltenweise(blank); +spaltenweise(blank);spaltenweise(blank);ausgfeld(1):=zeile;zeilenzaehlerINCR +ausgfeldlaenge;lehrerstundendatenindruckdateiFI ; +lehrerstundendatenaufbereitendruck;zeilenzaehlerINCR ausgfeldlaenge; +lehrerstundendatenindruckdatei.ggflmeldunganfbuchstabe:IF +anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert: +neueranfbuchstabe:=fachSUB 1;anfbuchstabe<>neueranfbuchstabe. +meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,teiltextmeldung+ +neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC +lehrbefaehigungdrucken;PROC lehrerstundendatenaufbereitendruck: +setzespaltentrenner(spaltentrenner); +datenausdateilehrbefaehigungenfachweiseaufbereitenbild;ausgfeld(1):=zeile; +END PROC lehrerstundendatenaufbereitendruck;PROC +lehrerstundendatenindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +druckzeileschreiben(ausgfeld(1))PER END PROC lehrerstundendatenindruckdatei; +PROC spaltenbreitensetzen:initspalten;setzespaltenbreite(spaltenbreite1fach); +setzespaltenbreite(spaltenbreite2art);setzespaltenbreite( +spaltenbreite3paraphe);END PROC spaltenbreitensetzen;END PACKET +lehrbefaehigungenfaecherweiseliste; + diff --git a/app/schulis/2.2.1/src/3.listen.lehrbef lehrerweise b/app/schulis/2.2.1/src/3.listen.lehrbef lehrerweise new file mode 100644 index 0000000..1c3e172 --- /dev/null +++ b/app/schulis/2.2.1/src/3.listen.lehrbef lehrerweise @@ -0,0 +1,100 @@ +PACKET lehrbefaehigungenlehrerweiselisteDEFINES +lehrerwlehrbeflidruckenoderzeigen:LET datenraum="datenraum",ausgkopflaenge=2, +ueberschriftenzeilen=2,anzahlparapheninlehrbef=300,neunfelder=9,niltext="", +blank=" ",null=0,strich="-",mnrbearbeitetwerden=352,mnrlistewirdgedruckt=58, +mnrauswahlnichtsinnvoll=56,mnrlistewirdaufbereiet=190;INT VAR zeilenzaehler, +druckzeilenzahl,anzahlparindateilehrbef,anzahlparindateilehrer,x,y, +eingabestatus;BOUND ROW anzahlparapheninlehrbefROW neunfelderTEXT VAR +datenauszweidateien;FILE VAR ausgabedatei;TEXT CONST ausgabedateiname:= +"Liste der Lehrbefähigungen",teiltextmeldung:= +"Lehrerparaphen mit den Anfangsbuchstaben:",spaltentext:= +"Lehrer Soll. Pfl. Lehrbefähigung Fach/Art",tasten:="vr",spaltenstrich:=60* +strich;TEXT VAR neueranfbuchstabe:="",anfbuchstabe:="",ueberschrift:= +"Liste der Lehrbefähigungen aller Lehrer",paraphe:="",aufbereitetezeile:=""; +BOOL VAR ausgabedrucker:=FALSE ;LET AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ; +AUSGKOPFDRUCK VAR ausgkopfdruck;PROC lehrerwlehrbeflidruckenoderzeigen(INT +CONST nr):anzahlparindateilehrer:=int(records(dnrlehrer));SELECT nrOF CASE 1: +druckenoderbildschirmausgabeCASE 2:druckennachbildschirmausgabe;return(2); +forget(ausgabedateiname,quiet)CASE 3:rowimdatenraumloeschen;enter(2);forget( +ausgabedateiname,quiet)ENDSELECT .END PROC lehrerwlehrbeflidruckenoderzeigen; +PROC rowimdatenraumloeschen:forget(datenraum,quiet)END PROC +rowimdatenraumloeschen;PROC druckennachbildschirmausgabe: +lehrerwlehrbefdruckenEND PROC druckennachbildschirmausgabe;PROC +druckenoderbildschirmausgabe:LET fnrausgdrucker=2,fnrausgbild=3;IF +eingabenrichtigTHEN standardmeldung(mnrlistewirdaufbereiet,niltext); +datenauszweidateienholenundimrowablegen;ausgabedrucker:=(standardmaskenfeld( +fnrausgbild)=niltext);IF ausgabedruckerTHEN lehrerwlehrbefdrucken;return(1); +ELSE ausgabedatei:=sequentialfile(output,"Liste der Lehrbefähigungen"); +lehrerwlehrbefaufbildschirmzeigenFI ;ELSE meldefehler;return(1)FI ;. +eingabenrichtig:standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus);IF eingabestatus=0THEN TRUE ELSE FALSE FI .meldefehler: +standardmeldung(mnrauswahlnichtsinnvoll,niltext)END PROC +druckenoderbildschirmausgabe;PROC lehrerwlehrbefaufbildschirmzeigen: +datenausrowinshowdateischreiben;dateiaufbildschirmausgeben;END PROC +lehrerwlehrbefaufbildschirmzeigen;PROC lehrerwlehrbefdrucken: +druckdateimitrowdatenfuellendruckenundloeschen;rowimdatenraumloeschenEND +PROC lehrerwlehrbefdrucken;PROC +druckdateimitrowdatenfuellendruckenundloeschen:TEXT VAR zeile;INT VAR +zeilenanz:=1,x:=1;druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf( +ueberschrift);initausgabekopfdruck;druckkopfschreiben; +spaltenueberschriftdrucken;setzemitseitennummern(TRUE );x:=1;zeilenzaehler:=1 +;WHILE zeilenanz<=anzahlparindateilehrbefREP zeileaufbereiten; +ggfmeldunganfbuchstabe;neueranfbuchstabe:=anfbuchstabe;IF zeilenzaehler> +druckzeilenzahlTHEN seitenwechsel;spaltenueberschriftdrucken;zeilenzaehler:=0 +;FI ;druckzeileschreiben(zeile);xINCR 1;zeilenanzINCR 1;zeilenzaehlerINCR 1; +PER ;standardmeldung(mnrlistewirdgedruckt,niltext);drucknachbereiten;. +ggfmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN meldunganfbuchstabeFI . +anfbuchstabegeaendert:anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe: +LET markiert="#";standardmeldung(mnrbearbeitetwerden,teiltextmeldung+ +neueranfbuchstabe+markiert);.variablenfuerdrucksetzen:druckzeilenzahl:= +drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.zeileaufbereiten:y:=1;zeile +:=text(datenauszweidateien(x)(y),8);FOR yFROM 8UPTO neunfelderREP zeileCAT +text(datenauszweidateien(x)(y),6)PER ;FOR yFROM 2UPTO 7REP zeileCAT text( +datenauszweidateien(x)(y),7)PER ;anfbuchstabe:=(datenauszweidateien(x)(1)) +SUB 1;END PROC druckdateimitrowdatenfuellendruckenundloeschen;PROC +initausgabekopfdruck:ausgkopfdruck(1):=spaltentext;ausgkopfdruck(2):= +spaltenstrichEND PROC initausgabekopfdruck;PROC spaltenueberschriftdrucken: +INT VAR l;FOR lFROM 1UPTO ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck +(l))PER END PROC spaltenueberschriftdrucken;PROC +datenausrowinshowdateischreiben:putline(ausgabedatei,blank);putline( +ausgabedatei,spaltentext);putline(ausgabedatei,spaltenstrich);putline( +ausgabedatei,blank);FOR xFROM 1UPTO anzahlparindateilehrbefREP +zeileaufbereiten;aufbereitetezeileindateischreibenPER .zeileaufbereiten:y:=1; +aufbereitetezeile:=text(datenauszweidateien(x)(y),8);FOR yFROM 8UPTO +neunfelderREP aufbereitetezeileCAT text(datenauszweidateien(x)(y),6)PER ;FOR +yFROM 2UPTO 7REP aufbereitetezeileCAT text(datenauszweidateien(x)(y),7)PER ;. +aufbereitetezeileindateischreiben:putline(ausgabedatei,aufbereitetezeile); +aufbereitetezeile:=niltextEND PROC datenausrowinshowdateischreiben;PROC +dateiaufbildschirmausgeben:zeigedatei(ausgabedateiname,tasten);END PROC +dateiaufbildschirmausgeben;PROC datenauszweidateienholenundimrowablegen: +datenauszweidateien:=new(datenraum);lehrerdatenrowinitialisieren;inittupel( +ixlbpar);x:=0;y:=1;statleseschleife(ixlbpar,"","",fnrlbparaphe,fnrlbfach, +PROC holedatenausdateilehrbefaehigungeninsrow);anzahlparindateilehrbef:=x; +inittupel(dnrlehrer);x:=1;y:=1;statleseschleife(dnrlehrer,"","",fnrlparaphe, +fnrlfamname,PROC holedatenausdateilehrerinsrow);.lehrerdatenrowinitialisieren +:FOR xFROM 1UPTO anzahlparindateilehrerREP FOR yFROM 1UPTO neunfelderREP +datenauszweidateien(x)(y):=niltext;PER ;PER END PROC +datenauszweidateienholenundimrowablegen;PROC +holedatenausdateilehrbefaehigungeninsrow(BOOL VAR b):IF dbstatus<>0THEN b:= +TRUE ELSE IF paraphe<>wert(fnrlbparaphe)THEN xINCR 1;y:=1;paraphe:=wert( +fnrlbparaphe);datenauszweidateien(x)(y):=paraphe;FI ;yINCR 1; +datenauszweidateien(x)(y):=text(wert(fnrlbfach),2)+"/"+wert(fnrlbart);FI ; +END PROC holedatenausdateilehrbefaehigungeninsrow;PROC +holedatenausdateilehrerinsrow(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE IF +wert(fnrlparaphe)=datenauszweidateien(x)(1)THEN datenauszweidateien(x)(8):= +wert(fnrlsollstd);datenauszweidateien(x)(9):=wert(fnrlpflichtstd);xINCR 1;FI +;FI ;END PROC holedatenausdateilehrerinsrow;PROC statleseschleife(INT CONST +indexnummer,TEXT CONST startschluessel1,startschluessel2,INT CONST feldnr1, +feldnr2,PROC (BOOL VAR )stataktion):vorbereitungen;leseschleife. +vorbereitungen:LET maxleseanzahl=10;BOOL VAR vorzeitigesende:=FALSE ;#INT +CONST maxblock:=maxfeldDIV zahlderfelder;#INT VAR anzahltupel;#INT CONST +maxanzahl:=(maxintDIV maxblock)*maxblock#.leseschleife:putwert(feldnr1, +startschluessel1);putwert(feldnr2,startschluessel2);search(indexnummer);IF +dbstatus=0THEN einleseschleifeFI .einleseschleife:zaehlen;WHILE NOT schluss +REP anzahltupel:=maxleseanzahl;multisucc(indexnummer,anzahltupel); +stackdurchlaufPER ;.stackdurchlauf:IF anzahltupel=0THEN dbstatus(1)ELSE +WHILE anzahltupel<>0REP lesen;zaehlen;IF vorzeitigesendeTHEN dbstatus(1); +anzahltupel:=0FI ;PER FI .schluss:dbstatus<>0.zaehlen:stataktion( +vorzeitigesende).lesen:multisucc;anzahltupelDECR 1;.END PROC statleseschleife +;END PACKET lehrbefaehigungenlehrerweiseliste; + diff --git a/app/schulis/2.2.1/src/3.listen.paraphen b/app/schulis/2.2.1/src/3.listen.paraphen new file mode 100644 index 0000000..d45d2c7 --- /dev/null +++ b/app/schulis/2.2.1/src/3.listen.paraphen @@ -0,0 +1,81 @@ +PACKET lehrerparaphenlistenDEFINES parlispezielleteile:LET parlieingangsmaske +="ms liste lehrerparaphen eingang",spaltentrenner=" ",parlianfpos=2, +spalte1breite=7,niltext="",blank=" ",komma=",",null=0,ueberschriftenzeilen=2, +mnrauswahlnichtsinnvoll=56,mnrbearbeitetwerden=352,ausgkopflaenge=2, +ausgfeldlaenge=1,anzahlderobjekteprobildschirm=19;TEXT VAR parliueberschrift +:="Liste der Lehrerparaphen",lehrername,rufname,namenszusatz,amtsbez,anrede, +geschlecht,paraphe,anfbuchstabe,neueranfbuchstabe:="",lehrernameaufbereitet, +auswahlnichtsinnvoll,teiltextmeldung:= +"die Paraphe mit dem Anfangsbuchstaben:";INT VAR aktuelleindexnr, +eingabestatus,lesestart,bildanfang,spalte2druckbreite,druckzeilenzahl;INT +CONST indexlehrername:=ixlfamruf,spalte2bildbreite:=bildbreite-spalte1breite- +1;BOOL VAR sortierungnachparaphen;LET AUSGFELD =ROW ausgfeldlaengeTEXT , +AUSGKOPF =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf +;BOOL PROC multistop:TRUE END PROC multistop;PROC parlispezielleteile(INT +CONST nr):SELECT nrOF CASE 1:parlidialogvorbereitenCASE 2: +parlieingabenrichtigCASE 3:parlilistenvorbereitenCASE 4:parlidruckvorbereiten +CASE 5:parliseitedruckenCASE 6:parlibildschirmvorbereitenCASE 7: +parliseitezeigenENDSELECT .END PROC parlispezielleteile;PROC +parlidialogvorbereiten:parliueberschrift:=text(vergleichsknoten); +setzeanfangswerte(parlieingangsmaske,parlianfpos)END PROC +parlidialogvorbereiten;PROC parlieingabenrichtig:LET fnrsortparaphen=2, +fnrsortlehrernamen=3,fnrausgdrucker=4,fnrausgbild=5;standardpruefe(5, +fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus=0 +THEN standardpruefe(5,fnrsortparaphen,fnrsortlehrernamen,null,niltext, +eingabestatus);IF eingabestatus=0THEN sortierartmerken;setzeeingabetest(TRUE +);setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);ELSE +meldefehler;setzeeingabetest(FALSE )FI ;ELSE meldefehler;setzeeingabetest( +FALSE )FI .sortierartmerken:sortierungnachparaphen:=standardmaskenfeld( +fnrsortparaphen)<>niltext.meldefehler:meldungstext(mnrauswahlnichtsinnvoll, +auswahlnichtsinnvoll);standardmeldung(auswahlnichtsinnvoll,niltext).END PROC +parlieingabenrichtig;PROC parlilistenvorbereiten:BOOL VAR b;initspalten; +setzespaltentrenner(spaltentrenner);IF sortierungnachparaphenTHEN +aktuelleindexnr:=dnrlehrer;lesestart:=fnrlparapheELSE aktuelleindexnr:= +indexlehrername;lesestart:=0;FI ;inittupel(dnrlehrer);setzeidentiwert(""); +initobli(anzahlderobjekteprobildschirm);parsenooffields(6);objektlistestarten +(aktuelleindexnr,"",lesestart,TRUE ,b);setzebestandende(NOT multistopCOR b); +END PROC parlilistenvorbereiten;PROC parlibildschirmvorbereiten:LET +fnrausganf=2;standardkopfmaskeaktualisieren(parliueberschrift);bildanfang:= +fnrausganf;setzebildanfangsposition(bildanfang);setzespaltenbreite( +spalte1breite);setzespaltenbreite(spalte2bildbreite);END PROC +parlibildschirmvorbereiten;PROC parliseitezeigen:blaettern(PROC (INT CONST ) +lehrerdatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END PROC +parliseitezeigen;PROC lehrerdatenzeigen(INT CONST x):lehrerdatenholen; +lehrerdatenaufbereitenbild;lehrerdatenaufbildschirm.END PROC +lehrerdatenzeigen;PROC lehrerdatenholen:paraphe:=wert(fnrlparaphe);lehrername +:=wert(fnrlfamname);rufname:=wert(fnrlrufname);namenszusatz:=wert(fnrlzusatz) +;amtsbez:=wert(fnrlamtsbeztitel);geschlecht:=wert(fnrlgeschlecht);IF +geschlecht="w"XOR geschlecht="W"THEN anrede:="Fr. "ELSE anrede:="Hr. "FI ; +lehrernameaufbereitet:=(lehrername+komma+blank+anrede+amtsbezeichnung+rufname ++blank+namenszusatz);.amtsbezeichnung:IF amtsbez<>niltextTHEN amtsbez+blank +ELSE ""FI .END PROC lehrerdatenholen;PROC lehrerdatenaufbereitenbild: +spaltenweise(paraphe);spaltenweise(lehrernameaufbereitet);END PROC +lehrerdatenaufbereitenbild;PROC lehrerdatenaufbildschirm:INT VAR i;FOR iFROM +1UPTO ausgfeldlaengeREP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos; +erhoeheausgabeposumeins;PER ;END PROC lehrerdatenaufbildschirm;PROC +parlidruckvorbereiten:setzebestandende(FALSE );anfbuchstabe:=" "; +druckvorbereiten;variablenfuerdrucksetzen;spalte2druckbreite:=druckbreite-( +spalte1breite+1);initdruckkopf(zentriert(parliueberschrift,druckbreite), +zentriert(length(parliueberschrift)*"-",druckbreite));initspalten; +setzespaltenbreite(spalte1breite);setzespaltenbreite(spalte2druckbreite); +inittupel(dnrlehrer);lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT +VAR )scanforward,BOOL PROC multistop);.variablenfuerdrucksetzen: +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC +parlidruckvorbereiten;PROC parliseitedrucken:parliueberschriftdrucken; +seitedrucken(PROC (INT VAR )lehrerdrucken,druckzeilenzahl,ausgfeldlaenge, +BOOL PROC multistop);seitenwechsel.END PROC parliseitedrucken;PROC +parliueberschriftdrucken:druckkopfschreiben.END PROC parliueberschriftdrucken +;PROC lehrerdrucken(INT VAR zeilenzaehler):LET markiert="#";lehrerdatenholen; +ggflmeldunganfbuchstabe;lehreraufbereitendruck;zeilenzaehlerINCR +ausgfeldlaenge;lehrerindruckdatei.ggflmeldunganfbuchstabe:IF +anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:IF +sortierungnachparaphenTHEN neueranfbuchstabe:=lehrernameSUB 1;ELSE +neueranfbuchstabe:=parapheSUB 1;FI ;anfbuchstabe<>neueranfbuchstabe. +meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,teiltextmeldung+ +neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC +lehrerdrucken;PROC lehreraufbereitendruck:spaltenweise(paraphe);spaltenweise( +lehrernameaufbereitet);ausgfeld(1):=zeile;END PROC lehreraufbereitendruck; +PROC lehrerindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +druckzeileschreiben(ausgfeld(1))PER .END PROC lehrerindruckdatei;END PACKET +lehrerparaphenlisten; + diff --git a/app/schulis/2.2.1/src/3.listen.sprechzeiten b/app/schulis/2.2.1/src/3.listen.sprechzeiten new file mode 100644 index 0000000..7f33cb7 --- /dev/null +++ b/app/schulis/2.2.1/src/3.listen.sprechzeiten @@ -0,0 +1,99 @@ +PACKET lehrersprechzeitenlisteDEFINES sprechzeitlispezielleteile:LET +sprechzeingangsmaske="ms liste lehrerparaphen eingang", +anzahlderobjekteprobildschirm=17,ausgfeldlaenge=1,spalte1breite=46, +spalte2breite=25,spaltentrenner=": ",sprechzanfpos=2,ueberschriftenzeilen=2, +strich="-",niltext="",blank=" ",komma=",",null=0,ausgkopflaenge=2, +mittelstrich="-",teilueb1="Lehrer",teilueb2="Sprechzeiten", +mnrauswahlnichtsinnvoll=56,mnrbearbeitetwerden=352;TEXT VAR +sprechzueberschrift:="Liste der Lehrersprechzeiten",paraphe,lehrername, +lehrernameaufbereitet,lehrernameaufbereitetmitparaphe,rufname,namenszusatz, +amtsbez,geschlecht,sprechzeit,druckstrich,textueberschrift,teiltextmeldung:= +"die Lehrer mit den Anfangsbuchstaben:",anfbuchstabe,neueranfbuchstabe:="", +auswahlnichtsinnvoll;INT VAR aktuelleindexnr,eingabestatus,lesestart, +bildanfang,druckzeilenzahl;INT CONST indexlehrername:=ixlfamruf, +maxspaltenlaengepara:=5;BOOL VAR sortierungnachparaphen;LET AUSGFELD =ROW +ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW +ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf; +AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC multistop:TRUE END PROC multistop; +PROC sprechzeitlispezielleteile(INT CONST nr):SELECT nrOF CASE 1: +sprechzdialogvorbereitenCASE 2:sprechzeingabenrichtigCASE 3: +sprechzlistenvorbereitenCASE 4:sprechzdruckvorbereitenCASE 5: +sprechzseitedruckenCASE 6:sprechzbildschirmvorbereitenCASE 7: +sprechzseitezeigenENDSELECT .END PROC sprechzeitlispezielleteile;PROC +sprechzdialogvorbereiten:sprechzueberschrift:=text(vergleichsknoten); +setzeanfangswerte(sprechzeingangsmaske,sprechzanfpos)END PROC +sprechzdialogvorbereiten;PROC sprechzeingabenrichtig:LET fnrsortparaphen=2, +fnrsortlehrernamen=3,fnrausgdrucker=4,fnrausgbild=5;standardpruefe(5, +fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus=0 +THEN standardpruefe(5,fnrsortparaphen,fnrsortlehrernamen,null,niltext, +eingabestatus);IF eingabestatus=0THEN sortierartmerken;setzeeingabetest(TRUE +);setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);ELSE +meldefehler;setzeeingabetest(FALSE )FI ;ELSE meldefehler;setzeeingabetest( +FALSE )FI .sortierartmerken:sortierungnachparaphen:=standardmaskenfeld( +fnrsortparaphen)<>niltext.meldefehler:meldungstext(mnrauswahlnichtsinnvoll, +auswahlnichtsinnvoll);standardmeldung(auswahlnichtsinnvoll,niltext).END PROC +sprechzeingabenrichtig;PROC sprechzlistenvorbereiten:BOOL VAR b;initspalten; +setzespaltentrenner(spaltentrenner);IF sortierungnachparaphenTHEN +aktuelleindexnr:=dnrlehrer;lesestart:=fnrlparapheELSE aktuelleindexnr:= +indexlehrername;lesestart:=0;FI ;inittupel(dnrlehrer);setzeidentiwert(""); +initobli(anzahlderobjekteprobildschirm);parsenooffields(17); +objektlistestarten(aktuelleindexnr,"",lesestart,TRUE ,b);setzebestandende(b); +END PROC sprechzlistenvorbereiten;PROC sprechzbildschirmvorbereiten:LET +fnrausganf=2;standardkopfmaskeaktualisieren(sprechzueberschrift);bildanfang:= +fnrausganf;setzebildanfangsposition(bildanfang);INT VAR i;setzespaltenbreite( +bildbreite);textueberschrift:=teilueb1+((spalte1breite+1)-(length(teilueb1))) +*blank+teilueb2;spaltenweise(textueberschrift);ausgfeld(1):=zeile;ausgfeld(1) +IN ausgabepos;erhoeheausgabeposumeins;spaltenweise(bildbreite*strich); +ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins; +setzebildanfangsposition(4);initspalten;setzespaltenbreite(spalte1breite); +setzespaltenbreite(spalte2breite);END PROC sprechzbildschirmvorbereiten;PROC +sprechzseitezeigen:blaettern(PROC (INT CONST )lehrerdatenzeigen,aktion,TRUE , +FALSE ,BOOL PROC multistop)END PROC sprechzseitezeigen;PROC lehrerdatenzeigen +(INT CONST x):lehrerdatenholen;lehrerdatenaufbereitenbild; +lehrerdatenaufbildschirm.END PROC lehrerdatenzeigen;PROC lehrerdatenholen: +paraphe:=wert(fnrlparaphe);lehrername:=wert(fnrlfamname);rufname:=wert( +fnrlrufname);namenszusatz:=wert(fnrlzusatz);amtsbez:=wert(fnrlamtsbeztitel); +geschlecht:=wert(fnrlgeschlecht);sprechzeit:=wert(fnrlsprechzeit);IF +geschlecht="w"XOR geschlecht="W"THEN geschlecht:="Fr. "ELSE geschlecht:= +"Hr. "FI ;lehrernameaufbereitet:=(lehrername+komma+blank+geschlecht+ +amtsbezeichnung+rufname+blank+namenszusatz);IF sortierungnachparaphenTHEN +lehrernameaufbereitetmitparaphe:=paraphe+(maxspaltenlaengepara-length(paraphe +))*blank+lehrernameaufbereitetFI .amtsbezeichnung:IF amtsbez<>niltextTHEN +amtsbez+blankELSE ""FI .END PROC lehrerdatenholen;PROC +lehrerdatenaufbereitenbild:IF sortierungnachparaphenTHEN spaltenweise( +lehrernameaufbereitetmitparaphe)ELSE spaltenweise(lehrernameaufbereitet)FI ; +spaltenweise(sprechzeit);END PROC lehrerdatenaufbereitenbild;PROC +lehrerdatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP ausgfeld +(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;END PROC +lehrerdatenaufbildschirm;PROC sprechzdruckvorbereiten:setzebestandende(FALSE +);anfbuchstabe:=" ";druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf( +zentriert(sprechzueberschrift,druckbreite),zentriert(length( +sprechzueberschrift)*"-",druckbreite));initspalten;setzespaltenbreite( +spalte1breite);setzespaltenbreite(spalte2breite);inittupel(dnrlehrer); +initausgabekopfdruck;lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT +VAR )scanforward,BOOL PROC multistop);.variablenfuerdrucksetzen: +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC +sprechzdruckvorbereiten;PROC initausgabekopfdruck:druckstrich:=(spalte1breite +*mittelstrich)+(spaltentrennerSUB 1)+(spalte2breite+1)*mittelstrich; +textueberschrift:=teilueb1+(spalte1breite-(length(teilueb1)))*blank+ +spaltentrenner+teilueb2;ausgkopfdruck(1):=textueberschrift;ausgkopfdruck(2):= +druckstrich;END PROC initausgabekopfdruck;PROC sprechzseitedrucken: +sprechzueberschriftdrucken;seitedrucken(PROC (INT VAR )lehrerdrucken, +druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistop);seitenwechsel.END PROC +sprechzseitedrucken;PROC sprechzueberschriftdrucken:INT VAR i; +druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP druckzeileschreiben( +ausgkopfdruck(i))PER END PROC sprechzueberschriftdrucken;PROC lehrerdrucken( +INT VAR zeilenzaehler):LET markiert="#";lehrerdatenholen; +ggflmeldunganfbuchstabe;lehreraufbereitendruck;zeilenzaehlerINCR +ausgfeldlaenge;lehrerindruckdatei.ggflmeldunganfbuchstabe:IF +anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:IF +sortierungnachparaphenTHEN neueranfbuchstabe:=lehrernameSUB 1;ELSE +neueranfbuchstabe:=parapheSUB 1;FI ;anfbuchstabe<>neueranfbuchstabe. +meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,teiltextmeldung+ +neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC +lehrerdrucken;PROC lehreraufbereitendruck:setzespaltentrenner(spaltentrenner) +;lehrerdatenaufbereitenbild;ausgfeld(1):=zeile;END PROC +lehreraufbereitendruck;PROC lehrerindruckdatei:INT VAR i;FOR iFROM 1UPTO +ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END PROC +lehrerindruckdatei;END PACKET lehrersprechzeitenliste; + diff --git a/app/schulis/2.2.1/src/3.listen.wochenstunden b/app/schulis/2.2.1/src/3.listen.wochenstunden new file mode 100644 index 0000000..a8cd29c --- /dev/null +++ b/app/schulis/2.2.1/src/3.listen.wochenstunden @@ -0,0 +1,114 @@ +PACKET wochenstundenlisteDEFINES wochenstdlispezielleteile:LET +wochenstdeingangsmaske="ms liste lehrerparaphen eingang", +anzahlderobjekteprobildschirm=17,ausgfeldlaenge=1,spalte1breite=5, +spalte2breite=30,spalte3breite=4,spalte4breite=31,spaltentrenner=" ", +wochenstdanfpos=2,ueberschriftenzeilen=2,niltext="",blank=" ",komma=",",null= +0,ausgkopflaenge=2,mittelstrich="-",mnrauswahlnichtsinnvoll=56, +mnrbearbeitetwerden=352;TEXT CONST blanknull:=" 0/",unterstreichung:= +bildbreite*mittelstrich,textueberschrift:=("Lehrer"+31*blank+ +"Soll Pfl. Ermäßigung/Grund");TEXT VAR wochenstdueberschrift:= +"Liste der Wochenstunden und Ermäßigungen",schraegstrich:="/",paraphe, +lehrername,rufname,namenszusatz,amtsbez,geschlecht,sollstdn,pflichtstdn, +ermaessigung1,ermaessigung2,ermaessigung3,ermaessigung4,ermgrund1,ermgrund2, +ermgrund3,ermgrund4,lehrernameaufbereitet,bearbeitetwerden,anfbuchstabe, +neueranfbuchstabe:="",auswahlnichtsinnvoll,teiltextmeldung:= +"die Paraphe mit dem Anfangsbuchstaben:";INT VAR aktuelleindexnr, +eingabestatus,lesestart,bildanfang,druckzeilenzahl;INT CONST indexlehrername +:=ixlfamruf;BOOL VAR sortierungnachparaphen;LET AUSGFELD =ROW ausgfeldlaenge +TEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW ausgkopflaenge +TEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;AUSGKOPFDRUCK VAR +ausgkopfdruck;BOOL PROC multistop:TRUE END PROC multistop;PROC +wochenstdlispezielleteile(INT CONST nr):SELECT nrOF CASE 1: +wochenstddialogvorbereitenCASE 2:wochenstdeingabenrichtigCASE 3: +wochenstdlistenvorbereitenCASE 4:wochenstddruckvorbereitenCASE 5: +wochenstdseitedruckenCASE 6:wochenstdbildschirmvorbereitenCASE 7: +wochenstdseitezeigenENDSELECT .END PROC wochenstdlispezielleteile;PROC +wochenstddialogvorbereiten:wochenstdueberschrift:=text(vergleichsknoten); +setzeanfangswerte(wochenstdeingangsmaske,wochenstdanfpos)END PROC +wochenstddialogvorbereiten;PROC wochenstdeingabenrichtig:LET fnrsortparaphen= +2,fnrsortlehrernamen=3,fnrausgdrucker=4,fnrausgbild=5;standardpruefe(5, +fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus=0 +THEN standardpruefe(5,fnrsortparaphen,fnrsortlehrernamen,null,niltext, +eingabestatus);IF eingabestatus=0THEN sortierartmerken;setzeeingabetest(TRUE +);setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);ELSE +meldefehler;setzeeingabetest(FALSE )FI ;ELSE meldefehler;setzeeingabetest( +FALSE )FI .sortierartmerken:sortierungnachparaphen:=standardmaskenfeld( +fnrsortparaphen)<>niltext;.meldefehler:standardmeldung( +mnrauswahlnichtsinnvoll,niltext).END PROC wochenstdeingabenrichtig;PROC +wochenstdlistenvorbereiten:BOOL VAR b;initspalten;setzespaltentrenner( +spaltentrenner);IF sortierungnachparaphenTHEN aktuelleindexnr:=dnrlehrer; +lesestart:=fnrlparapheELSE aktuelleindexnr:=indexlehrername;lesestart:=0;FI ; +inittupel(dnrlehrer);setzeidentiwert("");initobli( +anzahlderobjekteprobildschirm);parsenooffields(16);objektlistestarten( +aktuelleindexnr,"",lesestart,TRUE ,b);setzebestandende(b);END PROC +wochenstdlistenvorbereiten;PROC wochenstdbildschirmvorbereiten:LET fnrausganf +=2;standardkopfmaskeaktualisieren(wochenstdueberschrift);bildanfang:= +fnrausganf;setzebildanfangsposition(bildanfang);INT VAR i;setzespaltenbreite( +bildbreite);spaltenweise(textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)IN +ausgabepos;erhoeheausgabeposumeins;spaltenweise(unterstreichung);ausgfeld(1) +:=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins; +setzebildanfangsposition(4);initspalten;setzespaltenbreite(spalte1breite); +setzespaltenbreite(spalte2breite);setzespaltenbreite(spalte3breite); +setzespaltenbreite(spalte3breite);setzespaltenbreite(spalte4breite);END PROC +wochenstdbildschirmvorbereiten;PROC wochenstdseitezeigen:blaettern(PROC (INT +CONST )stundendatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END PROC +wochenstdseitezeigen;PROC stundendatenzeigen(INT CONST x):stundendatenholen; +stundendatenaufbereitenbild;stundendatenaufbildschirm.END PROC +stundendatenzeigen;PROC stundendatenaufbereitenbild:TEXT VAR ermaessigungen:= +niltext;spaltenweise(paraphe);spaltenweise(lehrernameaufbereitet); +spaltenweise(2*blank+sollstdn);spaltenweise(2*blank+pflichtstdn);IF +ermaessigung1=blanknullTHEN ermaessigung1:=3*blankELSE ermaessigungen:=2* +blank+ermaessigung1+ermgrund1FI ;IF ermaessigung2=blanknullTHEN ermaessigung2 +:=3*blankELSE ermaessigungenCAT 3*blank+ermaessigung2+ermgrund2FI ;IF +ermaessigung3=blanknullTHEN ermaessigung3:=3*blankELSE ermaessigungenCAT 3* +blank+ermaessigung3+ermgrund3FI ;IF ermaessigung4=blanknullTHEN ermaessigung4 +:=blankELSE ermaessigungenCAT 3*blank+ermaessigung4+ermgrund4FI ;spaltenweise +(ermaessigungen);END PROC stundendatenaufbereitenbild;PROC +stundendatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;END +PROC stundendatenaufbildschirm;PROC wochenstddruckvorbereiten: +setzebestandende(FALSE );anfbuchstabe:=" ";druckvorbereiten; +variablenfuerdrucksetzen;initdruckkopf(zentriert(wochenstdueberschrift, +druckbreite),zentriert(length(wochenstdueberschrift)*"-",druckbreite)); +initspalten;setzespaltenbreite(spalte1breite);setzespaltenbreite( +spalte2breite);setzespaltenbreite(spalte3breite);setzespaltenbreite( +spalte3breite);setzespaltenbreite(spalte4breite);holemeldung;inittupel( +dnrlehrer);initausgabekopfdruck;lesenvorbereitendruck(PROC (INT CONST ,BOOL +PROC ,INT VAR )scanforward,BOOL PROC multistop);.holemeldung:meldungstext( +mnrbearbeitetwerden,bearbeitetwerden).variablenfuerdrucksetzen: +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC +wochenstddruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck(1):= +textueberschrift;ausgkopfdruck(2):=unterstreichungEND PROC +initausgabekopfdruck;PROC wochenstdseitedrucken:wochenstdueberschriftdrucken; +seitedrucken(PROC (INT VAR )wochenstdndrucken,druckzeilenzahl,ausgfeldlaenge, +BOOL PROC multistop);seitenwechsel.END PROC wochenstdseitedrucken;PROC +wochenstdueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO +ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck(i))PER END PROC +wochenstdueberschriftdrucken;PROC wochenstdndrucken(INT VAR zeilenzaehler): +LET markiert="#";stundendatenholen;ggflmeldunganfbuchstabe; +lehrerstundendatenaufbereitendruck;zeilenzaehlerINCR ausgfeldlaenge; +lehrerstundendatenindruckdatei.ggflmeldunganfbuchstabe:IF +anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:IF +sortierungnachparaphenTHEN neueranfbuchstabe:=lehrernameSUB 1;ELSE +neueranfbuchstabe:=parapheSUB 1;FI ;anfbuchstabe<>neueranfbuchstabe. +meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,teiltextmeldung+ +neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC +wochenstdndrucken;PROC lehrerstundendatenaufbereitendruck:setzespaltentrenner +(spaltentrenner);stundendatenaufbereitenbild;ausgfeld(1):=zeile;END PROC +lehrerstundendatenaufbereitendruck;PROC lehrerstundendatenindruckdatei:INT +VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER +END PROC lehrerstundendatenindruckdatei;PROC stundendatenholen:paraphe:=wert( +fnrlparaphe);lehrername:=wert(fnrlfamname);rufname:=wert(fnrlrufname); +namenszusatz:=wert(fnrlzusatz);amtsbez:=wert(fnrlamtsbeztitel);geschlecht:= +wert(fnrlgeschlecht);sollstdn:=text(intwert(fnrlsollstd),2);pflichtstdn:=text +(intwert(fnrlpflichtstd),2);ermaessigung1:=text(intwert(fnrlerm1),2)+ +schraegstrich;ermgrund1:=text(wert(fnrlermgrund1),2);ermaessigung2:=text( +intwert(fnrlerm2),2)+schraegstrich;ermgrund2:=text(wert(fnrlermgrund2),2); +ermaessigung3:=text(intwert(fnrlerm3),2)+schraegstrich;ermgrund3:=text(wert( +fnrlermgrund3),2);ermaessigung4:=text(intwert(fnrlerm4),2)+schraegstrich; +ermgrund4:=text(wert(fnrlermgrund4),2);IF geschlecht="w"XOR geschlecht="W" +THEN geschlecht:="Fr. "ELSE geschlecht:="Hr. "FI ;lehrernameaufbereitet:=( +lehrername+komma+blank+geschlecht+amtsbezeichnung+rufname+blank+namenszusatz) +;.amtsbezeichnung:IF amtsbez<>niltextTHEN amtsbez+blankELSE ""FI .END PROC +stundendatenholen;END PACKET wochenstundenliste; + diff --git a/app/schulis/2.2.1/src/3.listenweise lehrer erf b/app/schulis/2.2.1/src/3.listenweise lehrer erf new file mode 100644 index 0000000..9715e4d --- /dev/null +++ b/app/schulis/2.2.1/src/3.listenweise lehrer erf @@ -0,0 +1,95 @@ +PACKET listenweiselehrererfDEFINES bearbeitunglehrer,lehrerspeichern:LET +tofather=1,tograndfather=2,niltext="",blank=" ",trennerfuerimbestand="�", +dateinameschluessel="Schlüssel",null=0;LET maskeerm="ms lehrer erm bearb", +maskespr="ms lehrer spr bearb",lehrerproseite=18,felderprozeileerm=11, +felderprozeilespr=3,fnrparapheeingangsmaske=2,fnrersteparaphe=2,fnrersteerm=5 +,fnrersterermgrund=6,fnrerstespr=4,anzermprolehrer=4;LET untergrenze=0, +obergrenze=99,bestandermgrund="c02 persoenl ermaess",meldungbestleer=59, +meldungnichtspeichern=63,meldungplausi=57,meldungwarten=69,meldungspeicherung +=132,meldungspeicherfehler=179,meldungzumbestand=55,meldungzusollstunden=175, +hell="#";ROW lehrerproseiteSTRUCT (TEXT paraphe,sprechzeiten,pflichtstunden, +sollstunden,ROW anzermprolehrerTEXT erm,grund)VAR altelehrer;BOOL VAR +bearbeitungdererm,nochwelcheda;INT VAR lehrerzahl,felderprozeile, +fnrerstesbearbeitungsfeld;TEXT VAR paraphe,bearbeitungsmaske;LET +logbucheintragerm="Anw. 3.1.2 Änderungen der Stundenermäßigung", +logbucheintragspr="Anw. 3.1.3 Änderungen der Sprechzeiten";PROC neuerblock: +IF lehrerzahl=lehrerproseiteTHEN succ(dnrlehrer);nochwelcheda:=dbstatus=null; +putwert(fnrlparaphe,paraphe);changeindex;FI ;blocklesenundausgeben;IF +nochwelchedaTHEN return(tofather)ELSE enter(tograndfather)FI END PROC +neuerblock;PROC blocklesenundausgeben:IF nochwelchedaTHEN standardmeldung( +meldungwarten,niltext);lehrerzahl:=null;bildschirmblock(PROC zeilezeigen, +BOOL PROC (INT CONST )leerepruefung,null);nochwelcheda:=(lehrerzahl>null);IF +nochwelchedaTHEN paraphe:=wert(fnrlparaphe);restlichefelderloeschen;infeld(1) +;standardfelderausgeben;infeld(fnrerstesbearbeitungsfeld);FI FI . +restlichefelderloeschen:INT VAR zeilenfeld;FOR zeilenfeldFROM fnrersteparaphe ++lehrerzahl*felderprozeileUPTO lehrerproseite*felderprozeile+1REP +standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank,zeilenfeld); +feldschutz(zeilenfeld)PER .END PROC blocklesenundausgeben;PROC zeilezeigen: +INT VAR i,aktuellesfeld;aktuellesfeld:=fnrersteparaphe+felderprozeile* +lehrerzahl;lehrerzahlINCR 1;altelehrer(lehrerzahl).paraphe:=wert(fnrlparaphe) +;standardmaskenfeld(wert(fnrlparaphe),aktuellesfeld);aktuellesfeldINCR 1; +standardmaskenfeld(wert(fnrlfamname),aktuellesfeld);aktuellesfeldINCR 1;IF +bearbeitungderermTHEN altelehrer(lehrerzahl).pflichtstunden:=wert( +fnrlpflichtstd);standardmaskenfeld(wert(fnrlpflichtstd),aktuellesfeld); +aktuellesfeldINCR 1;FOR iFROM 1UPTO anzermprolehrerREP altelehrer(lehrerzahl) +.erm(i):=wert(fnrlerm1+2*(i-1));standardmaskenfeld(wert(fnrlerm1+2*(i-1)), +aktuellesfeld);aktuellesfeldINCR 1;altelehrer(lehrerzahl).grund(i):=wert( +fnrlermgrund1+2*(i-1));standardmaskenfeld(wert(fnrlermgrund1+2*(i-1)), +aktuellesfeld);aktuellesfeldINCR 1;PER ELSE altelehrer(lehrerzahl). +sprechzeiten:=wert(fnrlsprechzeit);standardmaskenfeld(wert(fnrlsprechzeit), +aktuellesfeld);aktuellesfeldINCR 1;FI END PROC zeilezeigen;BOOL PROC +leerepruefung(INT CONST dummy):TRUE END PROC leerepruefung;PROC +bearbeitunglehrer(INT CONST programm):reinitparsing; +initialisierungenvornehmen;pruefeobimbestand;IF dbstatus<>nullTHEN +standardmeldung(meldungbestleer,niltext);return(tofather);LEAVE +bearbeitunglehrerFI ;nochwelcheda:=TRUE ;standardstartproc(bearbeitungsmaske) +;startebildschirmblock(dnrlehrer,lehrerproseite-1);blocklesenundausgeben; +standardnproc.initialisierungenvornehmen:bearbeitungdererm:=programm=1;IF +bearbeitungderermTHEN bearbeitungsmaske:=maskeerm;felderprozeile:= +felderprozeileerm;fnrerstesbearbeitungsfeld:=fnrersteerm;ELSE +bearbeitungsmaske:=maskespr;felderprozeile:=felderprozeilespr; +fnrerstesbearbeitungsfeld:=fnrerstespr;FI ;standardmeldung(meldungwarten, +niltext).pruefeobimbestand:inittupel(dnrlehrer);putwert(fnrlparaphe, +standardmaskenfeld(fnrparapheeingangsmaske));search(dnrlehrer,FALSE ).END +PROC bearbeitunglehrer;PROC lehrerspeichern(BOOL CONST speichern):INT VAR +fehlerstatus:=0,i,j,sollstunden;BOOL VAR lehrerdatengeaendert;INT VAR aktfnr; +IF speichernTHEN pruefeplausibilitaet;IF fehlerstatus<>0THEN infeld( +fehlerstatus);return(tofather);LEAVE lehrerspeichernELSE +speicherungdurchführenFI ELSE standardmeldung(meldungnichtspeichern,niltext) +FI ;putwert(fnrlparaphe,paraphe);changeindex;neuerblock;.pruefeplausibilitaet +:IF bearbeitungderermTHEN standardmeldung(meldungplausi,niltext);FOR jFROM 1 +UPTO lehrerzahlREP pruefeeinezeilePER FI .pruefeeinezeile:sollstunden:=int( +altelehrer(j).pflichtstunden);FOR iFROM 0UPTO anzermprolehrer-1REP aktfnr:= +fnrersteerm+(j-1)*felderprozeile+2*i;IF standardmaskenfeld(aktfnr)<>""THEN +standardpruefe(2,aktfnr,null,null,niltext,fehlerstatus);IF fehlerstatus<>0 +THEN LEAVE pruefeplausibilitaetFI ;standardpruefe(3,aktfnr,untergrenze, +obergrenze,niltext,fehlerstatus);IF fehlerstatus<>0THEN LEAVE +pruefeplausibilitaetFI ;FI ;sollstunden:=sollstunden-int(standardmaskenfeld( +aktfnr));IF sollstunden<0THEN standardmeldung(meldungzusollstunden,niltext); +fehlerstatus:=aktfnr;LEAVE pruefeplausibilitaetELSE altelehrer(j).sollstunden +:=text(sollstunden)FI ;aktfnr:=fnrersterermgrund+(j-1)*felderprozeile+2*i;IF +standardmaskenfeld(aktfnr)<>""THEN IF NOT imbestand(bestandermgrund+ +trennerfuerimbestand+standardmaskenfeld(aktfnr),dateinameschluessel)THEN +standardmeldung(meldungzumbestand,niltext);fehlerstatus:=aktfnr;LEAVE +pruefeplausibilitaetFI FI PER .speicherungdurchführen:IF bearbeitungdererm +THEN logeintrag(logbucheintragerm)ELSE logeintrag(logbucheintragspr)FI ;FOR j +FROM 0UPTO lehrerzahl-1REP IF lehrerdatenwurdengeaendertTHEN putwert( +fnrlparaphe,altelehrer(j+1).paraphe);search(dnrlehrer,true); +speicherfehlerabfangen;IF bearbeitungderermTHEN FOR iFROM 0UPTO +anzermprolehrer-1REP putwert(fnrlerm1+2*i,standardmaskenfeld(fnrersteerm+j* +felderprozeile+2*i));putwert(fnrlermgrund1+2*i,standardmaskenfeld( +fnrersterermgrund+j*felderprozeile+2*i));PER ;putwert(fnrlsollstd,altelehrer( +j+1).sollstunden)ELSE putwert(fnrlsprechzeit,standardmaskenfeld(fnrerstespr+j +*felderprozeile));FI ;update(dnrlehrer);speicherfehlerabfangen; +standardmeldung(meldungspeicherung,altelehrer(j+1).paraphe+hell)FI PER . +lehrerdatenwurdengeaendert:lehrerdatengeaendert:=FALSE ;IF bearbeitungdererm +THEN i:=0;WHILE NOT lehrerdatengeaendertCAND i +altelehrer(j+1).erm(i+1)COR standardmaskenfeld(fnrersterermgrund+j* +felderprozeile+2*i)<>altelehrer(j+1).grund(i+1);iINCR 1PER ELSE +lehrerdatengeaendert:=standardmaskenfeld(fnrerstespr+j*felderprozeile)<> +altelehrer(j+1).sprechzeitenFI ;lehrerdatengeaendert.speicherfehlerabfangen: +IF dbstatus<>nullTHEN standardmeldung(meldungspeicherfehler,altelehrer(j+1). +paraphe+hell);return(tofather);LEAVE lehrerspeichernFI .END PROC +lehrerspeichern;END PACKET listenweiselehrererf + diff --git a/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 2.files b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 2.files new file mode 100644 index 0000000..f1e4883 --- /dev/null +++ b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 2.files @@ -0,0 +1,5 @@ +4.stundenplan schnittstelle +4.einhaltung zeitwuensche pruefen +4.daten für intega aufbereiten + + diff --git a/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 3.files b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 3.files new file mode 100644 index 0000000..34b3d36 --- /dev/null +++ b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 3.files @@ -0,0 +1,6 @@ +4.stundenplan schnittstelle +4.aufsichten erstellen +4.vertretungen organisieren +4.stdpluebersichten +4.einzelstdpl.sek2 + diff --git a/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN.files b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN.files new file mode 100644 index 0000000..fe85e58 --- /dev/null +++ b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN.files @@ -0,0 +1,11 @@ +4.stundenplan schnittstelle +4.einzelstdpl.raeume +4.einzelstdpl.lehrer +4.einzelstdpl.sek1 +4.stand der stundenplanung analysieren +4.springstunden lehrer analysieren +4.springstunden schueler analysieren +4.raumwuensche pruefen +4.teilstdpl fach lehrer + + diff --git a/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 2.files b/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 2.files new file mode 100644 index 0000000..afefca2 --- /dev/null +++ b/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 2.files @@ -0,0 +1,6 @@ +0.listenweise grundfunktionen +0.kurswahlbasis bereinigen +4.faecherangebot planen +4.lehrveranstaltungen benennen +4.uv und kopplungen bearbeiten + diff --git a/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 3.files b/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 3.files new file mode 100644 index 0000000..230eb9a --- /dev/null +++ b/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 3.files @@ -0,0 +1,7 @@ +0.listenweise grundfunktionen +4.zeitwuensche bearbeiten +4.vertretungsdaten bearbeiten + + + + diff --git a/app/schulis/2.2.1/src/4.ERFASSUNGEN STUNDENPLAN.files b/app/schulis/2.2.1/src/4.ERFASSUNGEN STUNDENPLAN.files new file mode 100644 index 0000000..7ca8dae --- /dev/null +++ b/app/schulis/2.2.1/src/4.ERFASSUNGEN STUNDENPLAN.files @@ -0,0 +1,11 @@ +4.stundenplan schnittstelle +4.stundenplan raumweise erfassen +4.stundenplan im dialog erstellen +4.daten für schulis aufbereiten +4.halbjahreswechsel zum stundenplan +4.konsistenzpruefung +4.stundenplan nach zeiten erfassen +4.stundenplan nach lv erfassen +4.stundenplan akt halbj uebernehmen + + diff --git a/app/schulis/2.2.1/src/4.anschr.unterrichtsvertlg fuer lehrer b/app/schulis/2.2.1/src/4.anschr.unterrichtsvertlg fuer lehrer new file mode 100644 index 0000000..9c695d8 --- /dev/null +++ b/app/schulis/2.2.1/src/4.anschr.unterrichtsvertlg fuer lehrer @@ -0,0 +1,137 @@ +PACKET anschrunterrichtsvertlgfuerlehrerDEFINES +unterrichtsvertlgfuerlehrereingang,unterrichtsvertlgfuerlehrerstarten, +unterrichtsvertlgfuerlehrersonderwerte,unterrichtsvertlgfuerlehrermultistop, +unterrichtsvertlgfuerlehrerdruckdateibauen:LET maske= +"ms unterrichtsverteilung fuer lehrer drucken",fnrparaphe=2,fnrzeitwuensche=3 +,fnraktsj=4,fnrbsausgabe=5,fnrdrausgabe=6,mnrbittewarten=69, +mnrkeinegueltigeparaphe=344,mnrlistewirdaufbereitet=190,trenner="/",blank=" " +,niltext="";TEXT CONST v1datlehrer:="vordruck1 unterrichtsvertlg fuer lehrer" +,v2datlehrveranstgn:="vordruck2 unterrichtsvertlg fuer lehrer", +v3dataktschuelergr:="vordruck4 auskunft lehrer",v4datzeitwuensche:= +"vordruck5 auskunft lehrer",bestandnamepersoenlermaessigung:= +"c02 persoenl ermaess";LET swsj=520,swhj=521,swanrede=522, +swermaessgrund1langtext=530,swermaessgrund2langtext=531, +swermaessgrund3langtext=532,swermaessgrund4langtext=533,swfach=534,swkennung= +535,swwstd=536,swdummy=526,ganztage=520,ganzgew=521,vormtage=522,vormgew=523, +nachtage=524,nachgew=525;BOOL VAR bildschirmausgabe,mitzeitwuenschen, +einzelbearbeitung,aktsj;TEXT VAR angegebeneparaphe:="",aktparaphe,halbjahr, +schuljahr,wochstdn,fachkennung;INT VAR gemerkterdbstatus,status,sollstdn, +differenz,summewochstdn:=0,zeilenhilfszahl,zeilenzahl,zusatzzeilen, +swaktklassenleiter,swaktstellvertreter;BOOL PROC paraphevorhanden:putwert( +fnrlparaphe,angegebeneparaphe);search(dnrlehrer,TRUE );IF dbstatus=0THEN +TRUE ELSE FALSE FI END PROC paraphevorhanden;PROC +unterrichtsvertlgfuerlehrereingang:standardvproc(maske)END PROC +unterrichtsvertlgfuerlehrereingang;PROC unterrichtsvertlgfuerlehrerstarten: +standardpruefe(5,fnrbsausgabe,fnrdrausgabe,0,"",status);IF status<>0THEN +infeld(status);return(1);ELSE angegebeneparaphe:=standardmaskenfeld( +fnrparaphe);IF angegebeneparaphe=niltextCOR paraphevorhandenTHEN +bildschirmausgabe:=standardmaskenfeld(fnrbsausgabe)<>niltext; +einzelbearbeitung:=standardmaskenfeld(fnrparaphe)<>niltext;mitzeitwuenschen:= +standardmaskenfeld(fnrzeitwuensche)<>niltext;aktsj:=standardmaskenfeld( +fnraktsj)<>niltext;aktparaphe:=angegebeneparaphe;startenausfuehrenELSE +standardmeldung(mnrkeinegueltigeparaphe,niltext);return(1)FI ;FI . +startenausfuehren:halbjahr:=schulkenndatum("Schulhalbjahr");schuljahr:= +schulkenndatum("Schuljahr");IF NOT (aktsj)THEN geplanteshjundsjberechnen( +halbjahr,schuljahr);FI ;setzesonderwerteschulkenndaten;setzewerte; +standardmeldung(mnrbittewarten,niltext);zusammengesetztesanschreiben( +dnrlehrer,bildschirmausgabe,einzelbearbeitung,BOOL PROC +unterrichtsvertlgfuerlehrersonderwerte,BOOL PROC +unterrichtsvertlgfuerlehrermultistop,TEXT PROC +unterrichtsvertlgfuerlehrerdruckdateibauen).setzewerte:putwert(fnrlparaphe, +aktparaphe)END PROC unterrichtsvertlgfuerlehrerstarten;BOOL PROC +unterrichtsvertlgfuerlehrermultistop:BOOL VAR ok;IF einzelbearbeitungTHEN ok +:=angegebeneparaphe=wert(fnrlparaphe)AND dbstatus=0ELSE ok:=dbstatus=0FI ;ok +END PROC unterrichtsvertlgfuerlehrermultistop;BOOL PROC +unterrichtsvertlgfuerlehrersonderwerte:TEXT VAR grund1,grund2,grund3,grund4; +initialisieresonderwerte;aktparaphe:=wert(fnrlparaphe);adressat(aktparaphe); +gemerkterdbstatus:=dbstatus;setzesonderwert(swsj,subtext(schuljahr,1,2)+ +trenner+subtext(schuljahr,3,4));setzesonderwert(swhj,halbjahr);TEXT VAR +anredetext;IF wert(fnrlgeschlecht)="m"THEN anredetext:="Herrn"ELSE anredetext +:="Frau";FI ;setzesonderwert(swanrede,anredetext);grund1:=wert(fnrlermgrund1) +;grund2:=wert(fnrlermgrund2);grund3:=wert(fnrlermgrund3);grund4:=wert( +fnrlermgrund4);sollstdn:=intwert(fnrlsollstd);inittupel(dnrschluessel); +putwert(fnrschlsachgebiet,bestandnamepersoenlermaessigung);putwert( +fnrschlschluessel,grund1);search(dnrschluessel,TRUE );IF dbstatus=0THEN +setzesonderwert(swermaessgrund1langtext,wert(fnrschllangtext))ELSE +setzesonderwert(swermaessgrund1langtext,blank)FI ;putwert(fnrschlschluessel, +grund2);search(dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert( +swermaessgrund2langtext,wert(fnrschllangtext));ELSE setzesonderwert( +swermaessgrund2langtext,blank);FI ;putwert(fnrschlschluessel,grund3);search( +dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert( +swermaessgrund3langtext,wert(fnrschllangtext))ELSE setzesonderwert( +swermaessgrund3langtext,blank)FI ;putwert(fnrschlschluessel,grund4);search( +dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert( +swermaessgrund4langtext,wert(fnrschllangtext))ELSE setzesonderwert( +swermaessgrund4langtext,blank)FI ;inittupel(dnrlehrveranstaltungen);putwert( +fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr);putwert(fnrlvparaphe,aktparaphe) +;search(ixlvsjhjpar,TRUE );IF dbstatus=0THEN fachkennung:=wert( +fnrlvfachkennung);wochstdn:=wert(fnrlvwochenstd);setzesonderwert(swfach, +subtext(fachkennung,1,2));setzesonderwert(swkennung,subtext(fachkennung,3,6)) +;setzesonderwert(swwstd,wochstdn);summewochstdn:=int(wochstdn);ELSE +setzesonderwert(swfach,blank);setzesonderwert(swkennung,blank); +setzesonderwert(swwstd,blank);summewochstdn:=0;FI ;dbstatus(gemerkterdbstatus +);TRUE END PROC unterrichtsvertlgfuerlehrersonderwerte;TEXT PROC +unterrichtsvertlgfuerlehrerdruckdateibauen:LET druckdatei="liste.1", +hilfsdatei="hilfsdatei";TEXT VAR zeile;zeilenzahl:=0;zusatzzeilen:=0; +vordruckeholen;setzemitseitennummern(TRUE );druckvorbereiten;standardmeldung( +mnrlistewirdaufbereitet,niltext);briefalternative(v1datlehrer,hilfsdatei); +hilfsdateiindruckdatei(hilfsdatei);vordruck2ggfxmalindruckdatei;zeile:=blank; +druckzeileschreiben(zeile);zeilenzahlINCR 1;zeile:=42*blank+"Wstd. Summe: "+ +text(summewochstdn,2);druckzeileschreiben(zeile);zeilenzahlINCR 1;IF sollstdn +<>summewochstdnTHEN differenz:=sollstdn-summewochstdn;IF differenz<0THEN +zeile:=43*blank+"Mehrarbeit: "+text(-differenz,2)+" Std.";ELSE zeile:=24* +blank+"Sollstunden unterschritten um: "+text(differenz,2)+" Std.";FI ; +druckzeileschreiben(zeile);zeilenzahlINCR 1;FI ;zeilenzahl:=5; +vordruck3ggfindruckdatei;IF mitzeitwuenschenTHEN zeilenzahl:=17; +vordruck4ggfindruckdatei;FI ;drucknachbereitenohneausdrucken; +vordruckeloeschen;druckdatei.vordruckeholen:fetch(v1datlehrer,/ +"anschreiben server");fetch(v2datlehrveranstgn,/"anschreiben server");fetch( +v3dataktschuelergr,/"anschreiben server");fetch(v4datzeitwuensche,/ +"anschreiben server");.vordruckeloeschen:forget(v1datlehrer,quiet);forget( +v2datlehrveranstgn,quiet);forget(v3dataktschuelergr,quiet);forget( +v4datzeitwuensche,quiet);END PROC unterrichtsvertlgfuerlehrerdruckdateibauen; +PROC vordruck2ggfxmalindruckdatei:TEXT VAR hilfsdatei:="hilfsdatei";BOOL VAR +hilfsdateida:=FALSE ;succ(ixlvsjhjpar);WHILE dbstatus=0AND wert(fnrlvparaphe) +=aktparapheREP fachkennung:=wert(fnrlvfachkennung);wochstdn:=subtext(wert( +fnrlvwochenstd),1,2);setzesonderwert(swfach,subtext(fachkennung,1,2)); +setzesonderwert(swkennung,subtext(fachkennung,3,6));setzesonderwert(swwstd, +wochstdn);summewochstdnINCR int(wochstdn);briefalternative(v2datlehrveranstgn +,hilfsdatei);succ(ixlvsjhjpar);hilfsdateida:=TRUE ;PER ;IF hilfsdateidaTHEN +hilfsdateiindruckdatei(hilfsdatei)FI ;END PROC vordruck2ggfxmalindruckdatei; +PROC vordruck3ggfindruckdatei:LET hilfsdatei="hilfsdatei";TEXT VAR aufberwert +:=niltext;BOOL VAR hilfsdateiangelegt:=FALSE ;setzesonderwert(swdummy,blank); +swaktklassenleiter:=580;swaktstellvertreter:=581;gemerkterdbstatus:=dbstatus; +inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,schuljahr);putwert( +fnrsgrphj,halbjahr);search(dnraktschuelergruppen,FALSE );WHILE dbstatus=0AND +wert(fnrsgrphj)=halbjahrREP IF wert(fnrsgrplehrer)=aktparapheAND +swaktklassenleiter<590THEN aufberwert:=wert(fnrsgrpjgst);aufberwertCAT wert( +fnrsgrpkennung);setzesonderwert(swaktklassenleiter,aufberwert); +swaktklassenleiterINCR 2;hilfsdateiangelegt:=TRUE ;ELSE IF wert( +fnrsgrpstellvlehrer)=aktparapheAND swaktstellvertreter<591THEN aufberwert:= +wert(fnrsgrpjgst);aufberwertCAT wert(fnrsgrpkennung);setzesonderwert( +swaktstellvertreter,aufberwert);swaktstellvertreterINCR 2;hilfsdateiangelegt +:=TRUE ;FI ;FI ;succ(dnraktschuelergruppen)PER ;IF hilfsdateiangelegtTHEN +briefalternative(v3dataktschuelergr,hilfsdatei);hilfsdateiindruckdatei( +hilfsdatei);FI ;dbstatus(gemerkterdbstatus)END PROC vordruck3ggfindruckdatei; +PROC vordruck4ggfindruckdatei:gemerkterdbstatus:=dbstatus;LET hilfsdatei= +"hilfsdatei";TEXT VAR zeitwuensche;initialisieresonderwerte;INT VAR +aktswzeitwunsch:=531,position:=1,i;setzesonderwert(swdummy,blank);inittupel( +dnrzeitwuensche);putwert(fnrzwsj,schuljahr);putwert(fnrzwhj,halbjahr);putwert +(fnrzwbezug,"P");putwert(fnrzwbezugsobjekt,aktparaphe);search(dnrzeitwuensche +,TRUE );IF dbstatus=0THEN zeitwuensche:=wert(fnrzwunbestimmtewuensche); +setzesonderwert(ganztage,zeitwuenscheSUB 1);setzesonderwert(ganzgew, +zeitwuenscheSUB 3);setzesonderwert(vormtage,zeitwuenscheSUB 4); +setzesonderwert(vormgew,zeitwuenscheSUB 6);setzesonderwert(nachtage, +zeitwuenscheSUB 7);setzesonderwert(nachgew,zeitwuenscheSUB 9);zeitwuensche:= +wert(fnrzwbestimmtewuensche);FOR iFROM 1UPTO 66REP setzesonderwert( +aktswzeitwunsch,subtext(zeitwuensche,position,position+1));aktswzeitwunsch +INCR 1;positionINCR 2PER ;briefalternative(v4datzeitwuensche,hilfsdatei); +hilfsdateiindruckdatei(hilfsdatei);FI ;dbstatus(gemerkterdbstatus)END PROC +vordruck4ggfindruckdatei;PROC hilfsdateiindruckdatei(TEXT CONST hilfsdatei): +FILE VAR f;INT VAR i;TEXT VAR zeile;f:=sequentialfile(input,hilfsdatei); +zeilenhilfszahl:=lines(f);IF zeilenzahl+zeilenhilfszahl+zusatzzeilen>= +drucklaengeTHEN seitenwechsel;zeilenzahl:=0;FI ;FOR iFROM 1UPTO +zeilenhilfszahlREP getline(f,zeile);druckzeileschreiben(zeile)PER ;forget( +hilfsdatei,quiet);zeilenzahlINCR zeilenhilfszahlEND PROC +hilfsdateiindruckdatei;END PACKET anschrunterrichtsvertlgfuerlehrer + diff --git a/app/schulis/2.2.1/src/4.anschr.vertretungen b/app/schulis/2.2.1/src/4.anschr.vertretungen new file mode 100644 index 0000000..d806e14 --- /dev/null +++ b/app/schulis/2.2.1/src/4.anschr.vertretungen @@ -0,0 +1,149 @@ +PACKET anschrvertretungenDEFINES vertretungeneingang,vertretungenstarten, +vertretungensonderwerte,vertretungendruckdateibauen,vertretungenscanbedingung +,vertretungslistedrucken:LET swnameaufbereitet=550,swdatum=520,swzeit=521, +swstd=521,swart=522,swlv=523,swlangtext=523;LET maske= +"ms vertretungen eingang",fnrparaphe=2,fnrvonzeit=3,fnrbiszeit=4,fnrbsausgabe +=5,fnrdrausgabe=6,niltext="",blank=" ",strich="-----",kreuz="+",klammerauf= +"(",klammerzu=")",maxvertretungsarten=16,sonstigkuerzel="qq", +mnrauswahlnichtsinnvoll=56,mnrbittewarten=69,mnrlistewirderstellt=7, +mnrnichtimbestand=55;LET druckdatei="liste.1";TEXT CONST sonstiges:= +"Sonstiges",dateimitformularkopf:="vordruck1 vertretungen", +dateimitvertretungsdaten:="vordruck2 vertretungen";REAL VAR obergrenze, +untergrenze,aktzeit;INT VAR index:=dnrlehrer,status,zeilenzahl, +zeilenhilfszahl,zusatzzeilen,zaehler;TEXT VAR angegebeneparaphe:="", +aktparaphe,letzteparaphe,datum,hilfstext,bestand:="c02 anrechnung vertret", +vertretungsarten;ROW maxvertretungsartenTEXT VAR vertretungen;BOOL VAR +bildschirmausgabe,einzelbearbeitung,zeituntergrenze,zeitobergrenze,dateiende, +ersteraufruf;PROC vertretungslistedrucken(BOOL CONST drucken):IF druckenTHEN +print(druckdatei);FI ;forget(druckdatei,quiet);IF einzelbearbeitungTHEN +forget(dateimitformularkopf,quiet);forget(dateimitvertretungsdaten,quiet); +enter(2)ELIF dateiendeTHEN forget(dateimitformularkopf,quiet);forget( +dateimitvertretungsdaten,quiet);enter(2)ELSE enter(1)FI ;END PROC +vertretungslistedrucken;PROC vertretungeneingang:ersteraufruf:=TRUE ; +standardvproc(maske)END PROC vertretungeneingang;PROC vertretungenstarten: +TEXT VAR vonzeit,biszeit;IF NOT ersteraufrufTHEN putwert(fnrvparaphe, +aktparaphe);zusammengesetztesanschreiben(ixvpar,bildschirmausgabe, +einzelbearbeitung,BOOL PROC vertretungensonderwerte,BOOL PROC +vertretungenscanbedingung,TEXT PROC vertretungendruckdateibauen);ELSE last( +ixvpar);letzteparaphe:=wert(fnrvparaphe);standardpruefe(5,fnrbsausgabe, +fnrdrausgabe,0,"",status);IF status<>0THEN infeld(status);return(1);ELSE +standardmeldung(mnrbittewarten,niltext);vonzeit:=standardmaskenfeld( +fnrvonzeit);biszeit:=standardmaskenfeld(fnrbiszeit);zeituntergrenze:=vonzeit +<>niltext;zeitobergrenze:=biszeit<>niltext;IF datumspruefungenkorrektTHEN +angegebeneparaphe:=standardmaskenfeld(fnrparaphe);IF +angabenindateivertretungenvorhandenTHEN ersteraufruf:=FALSE ; +parametersetzenundstartenELSE standardmeldung(mnrnichtimbestand,niltext); +return(1)FI ;ELSE return(1)FI ;FI ;FI ;.parametersetzenundstarten:dateiende:= +FALSE ;datum:=wert(fnrvdatum);vertretungsartenausbestandholen; +bildschirmausgabe:=standardmaskenfeld(fnrdrausgabe)=niltext; +setzesonderwerteschulkenndaten;vordruckeholen;standardmeldung( +mnrlistewirderstellt,niltext);putwert(fnrvparaphe,aktparaphe);disablestop; +zusammengesetztesanschreiben(ixvpar,bildschirmausgabe,einzelbearbeitung,BOOL +PROC vertretungensonderwerte,BOOL PROC vertretungenscanbedingung,TEXT PROC +vertretungendruckdateibauen);IF iserrorTHEN clearerrorFI ;enablestop. +vordruckeholen:forget(dateimitformularkopf,quiet);forget( +dateimitvertretungsdaten,quiet);fetch(dateimitformularkopf,/ +"anschreiben server");fetch(dateimitvertretungsdaten,/"anschreiben server");. +datumspruefungenkorrekt:IF zeituntergrenzeTHEN standardpruefe(6,fnrvonzeit,0, +0,"",status);IF status<>0THEN infeld(status);LEAVE datumspruefungenkorrekt +WITH FALSE ELSE datum:=subtext(vonzeit,5,6);datumCAT subtext(vonzeit,3,4); +datumCAT subtext(vonzeit,1,2);untergrenze:=real(datum);FI ;FI ;IF +zeitobergrenzeTHEN standardpruefe(6,fnrbiszeit,0,0,"",status);IF status<>0 +THEN infeld(status);LEAVE datumspruefungenkorrektWITH FALSE ELSE datum:= +subtext(biszeit,5,6);datumCAT subtext(biszeit,3,4);datumCAT subtext(biszeit,1 +,2);obergrenze:=real(datum);FI ;FI ;IF zeituntergrenzeAND zeitobergrenzeTHEN +IF untergrenze>obergrenzeTHEN infeld(fnrvonzeit);standardmeldung( +mnrauswahlnichtsinnvoll,niltext);LEAVE datumspruefungenkorrektWITH FALSE FI ; +FI ;TRUE .vertretungsartenausbestandholen:vertretungsarten:=niltext;inittupel +(dnrschluessel);putwert(fnrschlsachgebiet,bestand);search(dnrschluessel); +WHILE wert(fnrschlsachgebiet)=bestandREP vertretungsartenCAT text(wert( +fnrschlschluessel),2);succ(dnrschluessel);PER ;. +angabenindateivertretungenvorhanden:BOOL VAR ok:=FALSE ;einzelbearbeitung:= +angegebeneparaphe<>niltext;inittupel(dnrvertretungen);IF einzelbearbeitung +THEN putwert(fnrvparaphe,angegebeneparaphe);search(ixvpar,TRUE )ELSE search( +ixvpar,FALSE )FI ;IF dbstatus<>0THEN ok:=FALSE ELSE aktparaphe:=wert( +fnrvparaphe);IF einzelbearbeitungTHEN WHILE dbstatus=0AND angegebeneparaphe= +aktparapheAND obergrenzeokAND NOT untergrenzeokREP succ(ixvpar);aktparaphe:= +wert(fnrvparaphe);PER ;ok:=dbstatus=0AND obergrenzeokAND untergrenzeokAND +angegebeneparaphe=aktparapheELSE WHILE dbstatus=0AND (NOT obergrenzeokCOR +NOT untergrenzeok)REP succ(ixvpar);PER ;aktparaphe:=wert(fnrvparaphe);ok:= +dbstatus=0AND obergrenzeokAND untergrenzeokFI ;FI ;okEND PROC +vertretungenstarten;BOOL PROC obergrenzeok:BOOL VAR b:=TRUE ;IF +zeitobergrenzeTHEN datum:=wert(fnrvdatum);hilfstext:=subtext(datum,7,8); +hilfstextCAT subtext(datum,4,5);hilfstextCAT subtext(datum,1,2);aktzeit:=real +(hilfstext);b:=aktzeit<=obergrenze;FI ;bEND PROC obergrenzeok;BOOL PROC +untergrenzeok:BOOL VAR b:=TRUE ;IF zeituntergrenzeTHEN datum:=wert(fnrvdatum) +;hilfstext:=subtext(datum,7,8);hilfstextCAT subtext(datum,4,5);hilfstextCAT +subtext(datum,1,2);aktzeit:=real(hilfstext);b:=aktzeit>=untergrenze;FI ;bEND +PROC untergrenzeok;BOOL PROC vertretungenscanbedingung:BOOL VAR b;IF +einzelbearbeitungTHEN b:=aktparaphe=angegebeneparapheAND dbstatus=0ELSE b:= +dbstatus=0AND NOT dateiendeFI ;bEND PROC vertretungenscanbedingung;BOOL PROC +vertretungensonderwerte:TEXT VAR hilfsstring1:=niltext,hilfsstring2;INT VAR +dbstatussave;initialisieresonderwerte;adressat(aktparaphe);dbstatussave:= +dbstatus;inittupel(dnrlehrer);putwert(fnrlparaphe,aktparaphe);search( +dnrlehrer,TRUE );IF wert(fnrlgeschlecht)="m"THEN hilfsstring1:="Herrn "ELSE +hilfsstring1:="Frau ";FI ;hilfsstring2:=wert(fnrlamtsbeztitel);IF +hilfsstring2<>niltextTHEN hilfsstring1CAT hilfsstring2+blank;FI ;hilfsstring2 +:=wert(fnrlzusatz);IF hilfsstring2<>niltextTHEN hilfsstring1CAT hilfsstring2+ +blank;FI ;hilfsstring1CAT wert(fnrlfamname);setzesonderwert(swnameaufbereitet +,hilfsstring1);dbstatus(0);TRUE END PROC vertretungensonderwerte;TEXT PROC +vertretungendruckdateibauen:LET druckdatei="liste.1",hilfsdatei="hilfsdatei"; +TEXT VAR zeile;INT VAR i;BOOL VAR einsatzda:=FALSE ;setzemitseitennummern( +TRUE );druckvorbereiten;zeilenzahl:=0;zusatzzeilen:=0;briefalternative( +dateimitformularkopf,hilfsdatei);hilfsdateiindruckdatei(hilfsdatei);FOR +zaehlerFROM 1UPTO maxvertretungsartenREP vertretungen(zaehler):=niltextPER ; +vordruck2xmalinhilfsdatei;hilfsdateiindruckdatei(hilfsdatei);IF zeilenzahl+3> +drucklaengeTHEN seitenwechsel;zeilenzahl:=0FI ;zeile:=blank; +druckzeileschreiben(zeile);druckzeileschreiben(zeile);zeile:= +"Summe Stunden Art";druckzeileschreiben(zeile);zeile:=3*strich+kreuz+7* +strich;druckzeileschreiben(zeile);zeilenzahlINCR 4;setzesonderwert(swdatum, +niltext);imrowgemerktedatenübervordruck2indruckdatei; +drucknachbereitenohneausdrucken;druckdateiEND PROC +vertretungendruckdateibauen;PROC vordruck2xmalinhilfsdatei:LET hilfsdatei= +"hilfsdatei";INT VAR savedbstatus;savedbstatus:=dbstatus;inittupel( +dnrvertretungen);statleseschleife(ixvpar,"",aktparaphe,fnrvparaphe, +fnrvparaphe,PROC saetzezurparapheinvordruck);dbstatus(savedbstatus);IF NOT +einzelbearbeitungTHEN search(ixvpar,FALSE );WHILE dbstatus=0AND (NOT +obergrenzeokCOR NOT untergrenzeokCOR aktparaphe=wert(fnrvparaphe))REP succ( +ixvpar);PER ;dateiende:=letzteparaphe=aktparapheOR dbstatus<>0;aktparaphe:= +wert(fnrvparaphe);FI ;END PROC vordruck2xmalinhilfsdatei;PROC +saetzezurparapheinvordruck(BOOL VAR b):LET hilfsdatei="hilfsdatei";b:=FALSE ; +IF NOT obergrenzeokCOR wert(fnrvparaphe)<>aktparapheCOR dbstatus=3THEN b:= +TRUE ;ELSE IF untergrenzeokTHEN swvertretungenfuellen;briefalternative( +dateimitvertretungsdaten,hilfsdatei);FI ;FI ;END PROC +saetzezurparapheinvordruck;PROC swvertretungenfuellen:TEXT VAR zeitaufber, +artvertr,lehrveranstg,lvaufber;INT VAR zeit,std,tag,position;zeit:=intwert( +fnrvtagstd);lehrveranstg:=wert(fnrvveranstaltung);artvertr:=text(wert( +fnrvanrechnung),2);datum:=wert(fnrvdatum);position:=pos(vertretungsarten, +artvertr);IF position=0THEN vertretungen(16)CAT sonstigkuerzelELSE WHILE ( +positionMOD 2)=0AND position<>0AND position<32REP position:=pos( +vertretungsarten,artvertr,position+1);PER ;IF position=0OR (positionMOD 2)=0 +THEN vertretungen(16)CAT sonstigkuerzelELSE vertretungen(position)CAT +artvertrFI ;FI ;tag:=(zeit-1)DIV 12;std:=zeitMOD 12;IF tag=0THEN zeitaufber:= +"Mo "ELIF tag=1THEN zeitaufber:="Di "ELIF tag=2THEN zeitaufber:="Mi "ELIF tag +=3THEN zeitaufber:="Do "ELIF tag=4THEN zeitaufber:="Fr "ELIF tag=5THEN +zeitaufber:="Sa "FI ;zeitaufberCAT text(std,2);lvaufber:=subtext(lehrveranstg +,1,2)+blank;lvaufberCAT subtext(lehrveranstg,3,4)+blank;lvaufberCAT subtext( +lehrveranstg,5,8);setzesonderwert(swdatum,datum);setzesonderwert(swzeit, +zeitaufber);setzesonderwert(swart,artvertr);setzesonderwert(swlv,lvaufber); +END PROC swvertretungenfuellen;PROC +imrowgemerktedatenübervordruck2indruckdatei:BOOL VAR angabeda:=FALSE ;TEXT +VAR hilfsdatei:="hilfsdatei",kuerzel,langtext;INT VAR savedbstatus; +savedbstatus:=dbstatus;inittupel(dnrschluessel);putwert(fnrschlsachgebiet, +bestand);zaehler:=1;WHILE zaehler<=maxvertretungsartenREP kuerzel:=text( +vertretungen(zaehler),2);IF kuerzel<>" "THEN IF kuerzel=sonstigkuerzelTHEN +kuerzel:=" ";langtext:=sonstigesELSE putwert(fnrschlschluessel,compress( +kuerzel));search(dnrschluessel,TRUE );langtext:=wert(fnrschllangtext);FI ; +setzesonderwert(swstd,text(length(vertretungen(zaehler))DIV 2,2)); +setzesonderwert(swart,kuerzel);setzesonderwert(swlangtext,klammerauf+langtext ++klammerzu);briefalternative(dateimitvertretungsdaten,hilfsdatei);angabeda:= +TRUE ;FI ;zaehlerINCR 1;PER ;dbstatus(savedbstatus);IF angabedaTHEN +hilfsdateiindruckdatei(hilfsdatei)FI ;END PROC +imrowgemerktedatenübervordruck2indruckdatei;PROC hilfsdateiindruckdatei(TEXT +CONST hilfsdatei):FILE VAR f;INT VAR i;TEXT VAR zeile;f:=sequentialfile(input +,hilfsdatei);zeilenhilfszahl:=lines(f);IF zeilenzahl+zeilenhilfszahl+ +zusatzzeilen>=drucklaengeTHEN seitenwechsel;zeilenzahl:=0;FI ;FOR iFROM 1 +UPTO zeilenhilfszahlREP getline(f,zeile);druckzeileschreiben(zeile)PER ; +forget(hilfsdatei,quiet);zeilenzahlINCR zeilenhilfszahlEND PROC +hilfsdateiindruckdatei;END PACKET anschrvertretungen; + diff --git a/app/schulis/2.2.1/src/4.aufsichten erstellen b/app/schulis/2.2.1/src/4.aufsichten erstellen new file mode 100644 index 0000000..06022bf --- /dev/null +++ b/app/schulis/2.2.1/src/4.aufsichten erstellen @@ -0,0 +1,194 @@ +PACKET aufsichtenerstellenDEFINES aufsichtsplandatenbearbeiten, +aufsichtsplandatenspeichern,aufsichtsplanlehrerlistezeigen:LET feldeingtag=2, +feldeingnr=3,feldeingakthj=4,feldbearbtag=2,feldbearbnr=3,feldbearbname=4, +feldbearbort1=5,feldbearbpar1=6,letztesbearbfeld=38,leerereintrag=" ", +bestandorte="c02 aufsichtsorte",trenner="�",schuljahr="Schuljahr",halbjahr= +"Schulhalbjahr",ausgparam="#",bearbmaske="ms aufsichtsplan erstellen bearb", +kennungparaphe="P",kennunglv="L",kennungraum="R",laengetagbeschr=17, +laengeparaphe=4,laengeaufsort=4,laengeraumminus=3,maxanzorte=17, +meldungserverfehler=376,meldungbearbwird=352,meldungkeinstdplan=366, +meldungkeinesugruppen=334,meldungzuvielesugruppen=356,meldungkeinelv=326, +meldungzuvielelv=358,meldungbasisinkon=378,meldunglisteerstellen=7, +meldungfalschertag=385,meldungfalschepar=142,meldungwarten=69, +meldungzuvieleorte=398,meldungkeinelehrer=337,meldungkeineorte=399, +meldungkeinedaten=59,meldungschonaufs=401,meldungspeichern=50, +meldungfalscherwert=54,meldungnichtsp=63,meldungspfehler=364,meldungplausi=57 +;ROW maxanzorteTEXT VAR datenausplan;TEXT VAR alletage:= +"�01�1� 1�MO�mo�Mo�02�2� 2�DI�di�Di�"+"03�3� 3�MI�mi�Mi�04�4� 4�DO�do�Do�"+ +"05�5� 5�FR�fr�Fr�06�6� 6�SA�sa�Sa��";TEXT VAR tag:="",nr:="",komprpar:="", +lehrerliste:="",orteliste:="",aufslehrerliste:="",schhj,schj,hjsjanhang:="", +eintragtag,eintragnr,eintragname;INT VAR i,j,fstat,stdvor,stdnach,rowindex:=1 +,anzaufsorte:=0,hjkennalt:=-1,hjkennneu:=0,anzaufs:=0;BOOL VAR +aenderungsfehler:=FALSE ,stundenplannichtda:=TRUE ,zuvieleorte:=FALSE ; +WINDOW VAR w:=startwindow(27,23,77,1);TEXT VAR liste,aktpar,lvvor,lvnach, +raumvor,raumnach,paraphenvorstd:="",paraphennachstd:="",lvvorstd:="", +lvnachstd:="",raeumevorstd:="",raeumenachstd:="";PROC +aufsichtsplandatenbearbeiten:standardmeldung(meldungwarten," "); +pruefeingabedaten;holedaten;aufsichtsplandatenzeigen.pruefeingabedaten: +prueftag;pruefnr.prueftag:tag:=standardmaskenfeld(feldeingtag);i:=pos( +alletage,trenner+tag+trenner);IF i=0THEN return(1);infeld(feldeingtag); +standardmeldung(meldungfalschertag,"");LEAVE aufsichtsplandatenbearbeiten +ELSE IF tag=""THEN tag:="1"ELSE tag:=text(iDIV laengetagbeschr+1)FI FI . +pruefnr:nr:=standardmaskenfeld(feldeingnr);IF nr=""THEN nr:="01"ELSE i:=int( +nr);IF i<1COR i>15THEN return(1);infeld(feldeingnr);standardmeldung( +meldungfalscherwert,"");LEAVE aufsichtsplandatenbearbeitenELSE nr:="0"+text(i +);nr:=subtext(nr,length(nr)-1);FI ;FI .holedaten:IF akthj<>""THEN hjkennneu:= +0ELSE hjkennneu:=1FI ;IF hjkennneu<>hjkennaltTHEN hjkennalt:=hjkennneu;schj:= +schulkenndatum(schuljahr);schhj:=schulkenndatum(halbjahr);IF hjkennneu=1THEN +geplanteshjundsjberechnen(schhj,schj)FI ;stundenplanhalbjahrsetzen(schhj,schj +);hjsjanhang:=schhj+". "+text(schj,2)+"/"+subtext(schj,3);FI ;IF records( +dnraufsichtszeiten)=0.0THEN fehlermeldungkeineaufszeitenFI ;IF orteliste="" +THEN holeorteFI ;holestartzeit;holeparaphenzurstartzeit.akthj: +standardmaskenfeld(feldeingakthj).fehlermeldungkeineaufszeiten:return(1); +infeld(feldeingnr);standardmeldung(meldungkeinedaten,"");LEAVE +aufsichtsplandatenbearbeiten.holeorte:IF records(dnrschluessel)=0.0THEN +fehlermeldungkeineorteELSE zuvieleorte:=FALSE ;inittupel(dnrschluessel); +statleseschleife(dnrschluessel,bestandorte,"",dnrschluessel+1,dnrschluessel+2 +,PROC erstelleorteliste);IF orteliste=""THEN fehlermeldungkeineorteELIF +anzaufsorte>maxanzorteTHEN orteliste:=text(orteliste,maxanzorte*laengeaufsort +);anzaufsorte:=maxanzorte;zuvieleorte:=TRUE FI FI .fehlermeldungkeineorte: +return(1);infeld(feldeingtag);standardmeldung(meldungkeineorte,"");LEAVE +aufsichtsplandatenbearbeiten.holestartzeit:inittupel(dnraufsichtszeiten); +putwert(fnrazsj,schj);putwert(fnrazhj,schhj);putwert(fnrazaufsichtszeit,tag+ +nr);search(dnraufsichtszeiten,TRUE );IF dbstatus<>0THEN +fehlermeldungkeineaufszeitenELSE eintragtag:=tagesangabe(tag);eintragnr:=text +(int(nr),2);eintragname:=wert(fnrazbezeichnung);stdvor:=intwert( +fnraztagstdvor);stdnach:=intwert(fnraztagstdnach)FI .holeparaphenzurstartzeit +:IF records(dnraufsichtsplan)=0.0THEN LEAVE holeparaphenzurstartzeitELSE +inittupel(dnraufsichtsplan);aufslehrerliste:="";putwert(fnrapaufsichtszeit, +tag+nr);statleseschleife(dnraufsichtsplan,schj,schhj,fnrapsj,fnraphj,PROC +parderaufsicht)FI .END PROC aufsichtsplandatenbearbeiten;PROC +aufsichtsplandatenzeigen:standardstartproc(bearbmaske); +standardkopfmaskeaktualisieren("Aufsichtsplan erstellen für "+hjsjanhang); +fuellemaske;standardnprocEND PROC aufsichtsplandatenzeigen;PROC fuellemaske: +INT VAR aktpos,aktfeld;TEXT VAR ort,paraphe;infeld(1);standardmaskenfeld( +eintragtag,feldbearbtag);standardmaskenfeld(eintragnr,feldbearbnr); +standardmaskenfeld(eintragname,feldbearbname);gibaufsorteaus; +standardfelderausgeben;infeld(feldbearbpar1);liste:="";aenderungsfehler:= +FALSE ;IF zuvieleorteTHEN standardmeldung(meldungzuvieleorte,"");zuvieleorte +:=FALSE FI .gibaufsorteaus:aktpos:=1;rowindex:=1;aktfeld:=feldbearbort1; +WHILE aktpos0THEN subtext(aufslehrerliste,aktpos+7,pos(aufslehrerliste,trenner, +aktpos+7)-1)ELSE ""FI END PROC holeaufsicht;PROC aufsichtsplandatenspeichern( +BOOL CONST speichern):TEXT VAR zeit,eintragort,eintragpar,weiterereintragpar; +INT VAR aktfeld:=5,feld;aenderungsfehler:=FALSE ;IF speichernTHEN +aenderungenspeichernELSE standardmeldung(meldungnichtsp,"")FI ;IF +aenderungsfehlerTHEN fehlermeldungspfehlerFI ;naechstezeit. +aenderungenspeichern:standardmeldung(meldungplausi,"");aenderungsfehler:= +FALSE ;aktfeld:=5;FOR iFROM 1UPTO anzaufsorteREP eintragpar:= +standardmaskenfeld(aktfeld+1);IF eintragpar<>""THEN IF NOT +bezeichnungzulaessig("P",eintragpar)THEN fehlermeldungfalscheparapheELIF +eintragpar<>datenausplan(i)THEN pruefanderebseintraegeFI FI ;aktfeldINCR 2 +PER ;standardmeldung(meldungspeichern,"");aktfeld:=5;FOR iFROM 1UPTO +anzaufsorteREP eintragort:=standardmaskenfeld(aktfeld);eintragpar:= +standardmaskenfeld(aktfeld+1);IF datenausplan(i)<>eintragparTHEN +speicheraenderungenFI ;aktfeldINCR 2PER .pruefanderebseintraege:feld:=6;FOR j +FROM 1UPTO anzaufsorteREP IF feld<>aktfeld+1THEN weiterereintragpar:= +standardmaskenfeld(feld);IF eintragpar=weiterereintragparTHEN +fehlermeldungparaphedoppeltFI ;FI ;feldINCR 2PER .fehlermeldungparaphedoppelt +:standardmeldung(meldungschonaufs,eintragpar+ausgparam+standardmaskenfeld( +feld-1)+ausgparam);infeld(aktfeld+1);return(1);LEAVE +aufsichtsplandatenspeichern.fehlermeldungfalscheparaphe:standardmeldung( +meldungfalschepar,eintragpar+ausgparam);infeld(aktfeld+1);return(1);LEAVE +aufsichtsplandatenspeichern.fehlermeldungspfehler:standardmeldung( +meldungspfehler,"");infeld(feldbearbpar1);return(1);LEAVE +aufsichtsplandatenspeichern.speicheraenderungen:IF datenausplan(i)=""CAND +eintragpar<>""THEN insertsatzELIF datenausplan(i)<>""CAND eintragpar=""THEN +deletesatzELSE updatesatzFI .insertsatz:inittupel(dnraufsichtsplan);putwert( +fnrapsj,schj);putwert(fnraphj,schhj);putwert(fnrapaufsichtszeit,tag+nr); +putwert(fnrapaufsichtsort,compress(eintragort));putwert(fnrapparaphe, +eintragpar);insert(dnraufsichtsplan);IF dbstatus<>okTHEN aenderungsfehler:= +TRUE FI .updatesatz:inittupel(dnraufsichtsplan);putwert(fnrapsj,schj);putwert +(fnraphj,schhj);putwert(fnrapaufsichtszeit,tag+nr);putwert(fnrapaufsichtsort, +compress(eintragort));putwert(fnrapparaphe,datenausplan(i));search( +dnraufsichtsplan,TRUE );IF dbstatus=okTHEN putwert(fnrapparaphe,eintragpar); +update(dnraufsichtsplan);IF dbstatus<>okTHEN aenderungsfehler:=TRUE FI ELSE +aenderungsfehler:=TRUE FI .deletesatz:inittupel(dnraufsichtsplan);putwert( +fnrapsj,schj);putwert(fnraphj,schhj);putwert(fnrapaufsichtszeit,tag+nr); +putwert(fnrapaufsichtsort,compress(eintragort));putwert(fnrapparaphe, +datenausplan(i));search(dnraufsichtsplan,TRUE );IF dbstatus=okTHEN delete( +dnraufsichtsplan);IF dbstatus<>okTHEN aenderungsfehler:=TRUE FI ELSE +aenderungsfehler:=TRUE FI .naechstezeit:succ(dnraufsichtszeiten);IF wert( +fnrazsj)<>schjCOR wert(fnrazhj)<>schhjCOR dbstatus<>0THEN verlasseanwendung +ELSE zeit:=wert(fnrazaufsichtszeit);tag:=text(zeit,1);nr:=subtext(zeit,2); +eintragtag:=tagesangabe(tag);eintragnr:=text(int(nr),2);eintragname:=wert( +fnrazbezeichnung);stdvor:=intwert(fnraztagstdvor);stdnach:=intwert( +fnraztagstdnach);inittupel(dnraufsichtsplan);aufslehrerliste:="";putwert( +fnrapaufsichtszeit,zeit);statleseschleife(dnraufsichtsplan,schj,schhj,fnrapsj +,fnraphj,PROC parderaufsicht);fuellemaske;return(1)FI .verlasseanwendung: +enter(2).END PROC aufsichtsplandatenspeichern;PROC +aufsichtsplanlehrerlistezeigen:INT VAR parpos,anfpos,aktfeld:=infeld; +standardmeldung(meldunglisteerstellen,"");IF liste=""THEN IF lehrerliste="" +THEN holelehrerFI ;IF stundenplannichtdaTHEN +stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN +meldungausgeben(fstat);return(1);LEAVE aufsichtsplanlehrerlistezeigenELSE +stundenplannichtda:=FALSE FI ;FI ;IF stdvor<>0THEN paraphenvorstd:= +datenderzeit(stdvor,kennungparaphe);lvvorstd:=datenderzeit(stdvor,kennunglv); +raeumevorstd:=datenderzeit(stdvor,kennungraum)ELSE paraphenvorstd:=""; +lvvorstd:="";raeumevorstd:="";FI ;IF stdnach<>0THEN paraphennachstd:= +datenderzeit(stdnach,kennungparaphe);lvnachstd:=datenderzeit(stdnach, +kennunglv);raeumenachstd:=datenderzeit(stdnach,kennungraum)ELSE +paraphennachstd:="";lvnachstd:="";raeumenachstd:=""FI ;fuelleliste;FI ;IF +menuedraussenTHEN reorganizescreenFI ;infeld(1);standardfelderausgeben;open(w +);auskunfterteilung(liste,w,FALSE );reorganizescreen;setlasteditvalues;infeld +(aktfeld);return(1).fuelleliste:listeCAT "Aufsicht möglich durch:";listeCAT +auskunftstextende;listeCAT "Paraphe Anz. Unterr. vorher Unterr. nachher"; +listeCAT auskunftstextende;FOR iFROM 1UPTO length(lehrerliste)DIV +laengeparapheREP lvvor:="";lvnach:="";raumvor:="";raumnach:="";aktpar:= +subtext(lehrerliste,(i-1)*laengeparaphe+1,i*laengeparaphe);parpos:=suchpos( +paraphenvorstd,aktpar,laengeparaphe);IF parpos>0THEN anfpos:=(parpos-1)*2; +lvvor:=subtext(lvvorstd,anfpos+1,anfpos+8);raumvor:=subtext(raeumevorstd, +parpos,parpos+laengeraumminus)FI ;parpos:=suchpos(paraphennachstd,aktpar, +laengeparaphe);IF parpos>0THEN anfpos:=(parpos-1)*2;lvnach:=subtext(lvnachstd +,anfpos+1,anfpos+8);raumnach:=subtext(raeumenachstd,parpos,parpos+ +laengeraumminus)FI ;IF lvvor<>""COR lvnach<>""THEN schreiblisteneintragFI ; +PER ;listeCAT "*";listeCAT auskunftstextende.holelehrer:IF records(dnrlehrer) +=0.0THEN fehlermeldungkeinelehrerELSE inittupel(dnrlehrer);statleseschleife( +dnrlehrer,"","",fnrlparaphe,fnrlfamname,PROC erstellelehrerliste)FI . +fehlermeldungkeinelehrer:return(1);infeld(feldeingtag);standardmeldung( +meldungkeinelehrer,"");LEAVE aufsichtsplanlehrerlistezeigen.END PROC +aufsichtsplanlehrerlistezeigen;PROC schreiblisteneintrag:standardmeldung( +meldungbearbwird,aktpar+ausgparam);listeCAT text(aktpar,8);komprpar:=compress +(aktpar);listeCAT text(aufsichtenderparaphe,2);IF lvvor=""THEN listeCAT +" ";ELSE listeCAT " ";listeCAT text(lvvor,2);listeCAT " "; +listeCAT subtext(lvvor,3,4);listeCAT " ";listeCAT subtext(lvvor,5);listeCAT +"/";listeCAT raumvorFI ;IF lvnach=""THEN listeCAT " ";ELSE +listeCAT " ";listeCAT text(lvnach,2);listeCAT " ";listeCAT subtext(lvnach,3,4 +);listeCAT " ";listeCAT subtext(lvnach,5);listeCAT "/";listeCAT raumnachFI ; +listeCAT auskunftstextende.END PROC schreiblisteneintrag;INT PROC +aufsichtenderparaphe:inittupel(dnraufsichtsplan);anzaufs:=0;statleseschleife( +ixappar,komprpar,"",fnrapparaphe,fnrapsj,PROC anzaufsichtenzaehlen);anzaufs +END PROC aufsichtenderparaphe;PROC anzaufsichtenzaehlen(BOOL VAR b):IF +dbstatus<>okCOR wert(fnrapparaphe)>komprparTHEN dbstatus(1);b:=TRUE ELIF wert +(fnrapsj)=schjCAND wert(fnraphj)=schhjTHEN anzaufsINCR 1FI END PROC +anzaufsichtenzaehlen;INT PROC suchpos(TEXT CONST quelle,muster,INT CONST +musterlaenge):INT VAR suchab:=1,aktpos;IF quelle<>""THEN WHILE pos(quelle, +muster,suchab)>0REP aktpos:=pos(quelle,muster,suchab);IF aktposMOD +musterlaenge=1THEN LEAVE suchposWITH aktposELSE suchab:=aktpos+1FI ;PER ;FI ; +0END PROC suchpos;PROC erstellelehrerliste(BOOL VAR b):IF dbstatus<>0THEN b:= +TRUE ELSE lehrerlisteCAT text(wert(fnrlparaphe),laengeparaphe)FI END PROC +erstellelehrerliste;PROC erstelleorteliste(BOOL VAR b):IF wert(dnrschluessel+ +1)>bestandorteCOR dbstatus<>0THEN b:=TRUE ELSE ortelisteCAT text(wert( +dnrschluessel+2),laengeaufsort);anzaufsorteINCR 1FI END PROC +erstelleorteliste;PROC parderaufsicht(BOOL VAR b):IF wert(fnrapsj)<>schjCOR +wert(fnraphj)<>schhjCOR wert(fnrapaufsichtszeit)<>tag+nrCOR dbstatus<>0THEN +dbstatus(1);b:=TRUE ELSE aufslehrerlisteCAT trenner;aufslehrerlisteCAT +trenner;aufslehrerlisteCAT text(wert(fnrapaufsichtsort),laengeaufsort); +aufslehrerlisteCAT trenner;aufslehrerlisteCAT wert(fnrapparaphe); +aufslehrerlisteCAT trennerFI END PROC parderaufsicht;TEXT PROC tagesangabe( +TEXT CONST tag):IF tag="1"THEN "Mo"ELIF tag="2"THEN "Di"ELIF tag="3"THEN "Mi" +ELIF tag="4"THEN "Do"ELIF tag="5"THEN "Fr"ELSE "Sa"FI END PROC tagesangabe; +PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN standardmeldung( +meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(meldungkeinstdplan, +"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5 +THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN +standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung( +meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,""); +FI END PROC meldungausgeben;END PACKET aufsichtenerstellen + diff --git "a/app/schulis/2.2.1/src/4.daten f\303\274r intega aufbereiten" "b/app/schulis/2.2.1/src/4.daten f\303\274r intega aufbereiten" new file mode 100644 index 0000000..008e89e --- /dev/null +++ "b/app/schulis/2.2.1/src/4.daten f\303\274r intega aufbereiten" @@ -0,0 +1,462 @@ +PACKET datenfuerintegaaufbereitenDEFINES integastdvproc,integaarchiv, +integaabfrage,integaaufbereitenoderabfrage,integaentfernen,integaposhalt, +integaloescheundreturn,integadatenzeigen,integadatendrucken, +schulisintegatransfer:LET raumkenndaten="c02 raeume",schulkenndaten= +"c02 schulkenndaten",schulhj="Schulhalbjahr",schulj="Schuljahr",schulname= +"Schulname",schulort="Schulort",schulstr="Schulstraße",eingmaske= +"ms eing integaeingabedatei",fldakthj=2,fldfix1=3,fldfix2=4,fldinteganame=5, +meldg0=69,meldg1=340,meldg2=323,meldg3=324,meldg4=331,meldg5=332,meldg6=333, +meldg7=334,meldg8=335,meldg9=336,meldg10=337,meldg11=338,meldg13=343,meldg14= +345,meldg15=346,meldg16=347,meldg17=348,meldg18=349,meldg19=350,meldg20=351, +meldg21=381,meldg22=56,meldg23=58,meldungbearbwird=352,meldungserverfehler= +376,meldungkeinstdplan=366,meldungkeinesugruppen=334,meldungzuvielesugruppen= +356,meldungkeinelv=326,meldungzuvielelv=358,meldungbasisinkon=378, +meldungstdplauswvorber=384,zeilenende="",erstestde=1,maxstden=66,vormstden=6, +nachmstden=6,stdenprotag=12,vorm=6,nachm=5,unttage=6,eumelgrenzemaxzeilen= +4000,ausgparam="#",trenner="�";LET filemodus="file ibm",leererunbestwunsch= +" ",dateikennung=".DP",dos="DOS",kennpar="P",kennsugrup="S",kennraum= +"R",kennkoppl="K",kennfach="F",listenname= +"Liste der Dateien auf der Diskette:";DATASPACE VAR dszeitw,dslverf,dskverf; +FILE VAR f,g,z,k,l;INT VAR p,i,j,h,fstat,zz:=0,ruecksprung:=1,maxvs:=0,maxns +:=0,vs:=vormstden,ns:=nachmstden,nulltestd:=0,vm:=vorm,objvm,nm:=nachm,objnm, +ut:=unttage,objut,jahrende;TEXT VAR sgrdaten:="",sgridaten:="",klgr:=trenner, +klgrdaten:="",rgrdaten:=trenner,letztepar:="",par:="",objektverf:="", +lehrerdaten,bearbkopplungen,kartenart,zeitwuensche:=trenner, +schulverfuegbarkeit:="",dateiname:="SCHULIS.DP",schuldaten:="",zeile:="", +aktschj:="0",aktschhj:="0",geplschj:="0",geplschhj:="0",schj,schhj,record:="" +,t1:="",t2:="",zeitdaten:="";BOOL VAR datenfehler,fehler,mindeinraum, +archivfehler,falschesugrupgefunden:=FALSE ,abbruchwegen4000zeilen:=FALSE ; +THESAURUS VAR thes;TEXT VAR t:="",leererbestwunsch:= +" "+ +" ",bestwunsch, +unbestwunsch;PROC integaposhalt(INT CONST rueck):infeld(fldakthj);return( +rueck)END PROC integaposhalt;PROC loeschemeldung:INT VAR ankreuzung:=1;FOR i +FROM fldakthjUPTO fldfix2REP IF standardmaskenfeld(i)<>""THEN ankreuzung:= +ankreuzung*(2*i-1)FI PER ;standardstartproc(eingmaske);infeld(fldakthj);FOR i +FROM fldakthjUPTO fldfix2REP IF ankreuzungMOD (2*i-1)=0THEN +standardmaskenfeld("x",i)FI PER ;standardmaskenfeld(text(dateiname,pos( +dateiname,".")-1),fldinteganame);standardfelderausgeben;infeld(fldakthj);END +PROC loeschemeldung;PROC archivanmelden:archivfehler:=FALSE ;commanddialogue( +FALSE );disablestop;dateiname:=standardmaskenfeld(fldinteganame)+".DP";IF +standardmaskenfeld(fldinteganame)=""THEN fehlermeldungnamefalschELIF +falschercode(dateiname)THEN fehlermeldungnamefalschFI ;reserve(filemodus,/dos +);IF iserrorTHEN archivfehler:=TRUE ;abbruchnachfehler(1);LEAVE +archivanmeldenFI ;enablestop.fehlermeldungnamefalsch:archivfehler:=TRUE ; +return(ruecksprung);infeld(fldinteganame);standardmeldung(meldg2,subtext( +dateiname,i,i)+"#"+dateiname+"#");LEAVE archivanmelden.END PROC +archivanmelden;PROC integaarchiv(INT CONST wahl):SELECT wahlOF CASE 1: +archivinitialisierenCASE 2:archivanmelden;IF archivfehlerTHEN LEAVE +integaarchivFI ;archivlistenCASE 3:archivbeschreibenCASE 4: +archivueberschreibenEND SELECT .archivinitialisieren:standardmeldung(meldg0, +" ");disablestop;clear(/dos);IF iserrorTHEN abbruchnachfehler(2);LEAVE +integaarchivFI ;enablestop;loeschemeldung;return(2).archivlisten: +standardmeldung(meldg0," ");disablestop;g:=sequentialfile(output,listenname); +thes:=ALL /dos;IF iserrorTHEN abbruchnachfehler(1);LEAVE integaarchivFI ; +thesaurusaufbereiten;enablestop;zeigedatei(listenname,"vr"). +thesaurusaufbereiten:t:=" ";i:=0;REP get(thes,t,i);putline(g,t)UNTIL t=""PER +.archivbeschreiben:standardmeldung(meldg0," ");disablestop;IF exists( +dateiname,/dos)THEN IF iserrorTHEN abbruchnachfehler(2);LEAVE integaarchiv +ELSE abfragedateiueberschreibenFI ELSE save(dateiname,/dos);IF iserrorTHEN +abbruchnachfehler(2);LEAVE integaarchivFI ;enablestop;commanddialogue(TRUE ); +loeschemeldung;return(2);FI .abfragedateiueberschreiben:infeld(1); +standardmeldung(meldg19,dateiname+"#");standardnproc.archivueberschreiben: +standardmeldung(meldg0," ");disablestop;commanddialogue(FALSE );erase( +dateiname,/dos);IF iserrorTHEN abbruchnachfehler(3);LEAVE integaarchivFI ; +save(dateiname,/dos);IF iserrorTHEN abbruchnachfehler(3);LEAVE integaarchiv +FI ;enablestop;commanddialogue(TRUE );loeschemeldung;return(3).END PROC +integaarchiv;PROC integaloescheundreturn(BOOL CONST b):IF bTHEN forget( +listenname,quiet);FI ;loeschemeldung;return(2)END PROC integaloescheundreturn +;PROC abbruchnachfehler(INT CONST schritte):standardmeldung(meldg13, +"Fehler: "+errormessage+" !#");clearerror;infeld(fldakthj);return(schritte); +release(/dos);commanddialogue(TRUE );enablestopEND PROC abbruchnachfehler; +PROC integaabfrage(INT CONST wahl):SELECT wahlOF CASE 1:archivanmelden;IF +archivfehlerTHEN LEAVE integaabfrageFI ;standardmeldung(meldg16,"")CASE 2: +archivanmelden;IF archivfehlerTHEN LEAVE integaabfrageFI ;standardmeldung( +meldg17,"")CASE 3:fragevorbereiten;standardmeldung(meldg18,dateiname+"#"+text +(t2,8)+"#")END SELECT ;infeld(1);standardnproc.fragevorbereiten:dateiname:= +standardmaskenfeld(fldinteganame)+".DP";IF standardmaskenfeld(fldinteganame)= +""THEN fehlermeldungnamefalschELIF falschercode(dateiname)THEN +fehlermeldungnamefalschFI ;IF exists(dateiname)THEN beginlist;REP +getlistentry(t1,t2);UNTIL t1=dateinameCOR t1=""PER ;ELSE return(1);infeld( +fldinteganame);standardmeldung(meldg20,dateiname+"#");LEAVE integaabfrageFI . +fehlermeldungnamefalsch:return(1);infeld(fldinteganame);standardmeldung( +meldg2,subtext(dateiname,i,i)+"#"+dateiname+"#");LEAVE integaabfrage.END +PROC integaabfrage;PROC integadatenzeigen:standardmeldung(meldg0," "); +dateiname:=standardmaskenfeld(fldinteganame)+".DP";IF standardmaskenfeld( +fldinteganame)=""THEN fehlermeldungnamefalschELIF falschercode(dateiname) +THEN fehlermeldungnamefalschFI ;IF exists(dateiname)THEN zeigedatenELSE +return(1);infeld(fldinteganame);standardmeldung(meldg20,dateiname+"#");LEAVE +integadatenzeigenFI .fehlermeldungnamefalsch:return(1);infeld(fldinteganame); +standardmeldung(meldg2,subtext(dateiname,i,i)+"#"+dateiname+"#");LEAVE +integadatenzeigen.zeigedaten:zeigedatei(dateiname,"vr").END PROC +integadatenzeigen;PROC integadatendrucken:dateiname:=standardmaskenfeld( +fldinteganame)+".DP";IF exists(dateiname)THEN standardmeldung(meldg23,""); +print(dateiname)ELSE infeld(fldinteganame);standardmeldung(meldg20,dateiname+ +"#");FI ;return(1).END PROC integadatendrucken;PROC integaentfernen:infeld( +fldinteganame);dateiname:=standardmaskenfeld(fldinteganame)+".DP";forget( +dateiname,quiet);infeld(fldakthj);return(2);END PROC integaentfernen;PROC +integastdvproc:standardstartproc(eingmaske);standardmaskenfeld("SCHULIS", +fldinteganame);standardfelderausgeben;infeld(fldakthj);standardnprocEND PROC +integastdvproc;PROC integaaufbereitenoderabfrage:beginlist;REP getlistentry( +t1,t2);IF pos(t1,dateikennung)>0THEN standardmeldung(meldg18,t1+"#"+text(t2,8 +)+"#");infeld(fldinteganame);standardnproc;ruecksprung:=2;LEAVE +integaaufbereitenoderabfrageFI ;UNTIL t1=""PER ;ruecksprung:=1; +schulisintegatransferEND PROC integaaufbereitenoderabfrage;PROC +schulisintegatransfer:falschesugrupgefunden:=FALSE ;standardmeldung(meldg0, +" ");forget(t1,quiet);init;pruefeeingmaske;stelledateinamefest; +stellehalbjahrfest;pruefobintegabezda;holestundenplandaten;melde("A"); +schreibeschulname;stellezeitvarfest;berechneschulverfuegbarkeit;melde("BA"); +schreibefragenkatalog;melde("BB");schreibegewichtungen;melde("BC"); +schreibezeitraster1;melde("BD");schreibezeitraster2;pruefdateigroesse; +holeallezeitwuensche;melde("C");schreibelehrerdaten;pruefdateigroesse;melde( +"D und F");schreibeklassen;pruefdateigroesse;melde("G");schreiberaumgruppen; +pruefdateigroesse;melde("H");schreibeuvdaten;pruefdateigroesse;melde("I"); +schreibeschulverfgbkt;pruefdateigroesse;melde("J");schreibelehrerverfgbkt; +pruefdateigroesse;melde("K");schreiberaumverfgbkt;pruefdateigroesse;melde("L" +);schreibeklassenverfgbkt;pruefdateigroesse;melde("M");schreibefachverfgbkt; +pruefdateigroesse;melde("N");schreibevorbelegungen;pruefdateigroesse; +gibfertigmeldungaus.pruefdateigroesse:IF zz>eumelgrenzemaxzeilenTHEN +standardmeldung(meldg14,"");return(ruecksprung);LEAVE schulisintegatransfer +FI .init:dszeitw:=nilspace;dslverf:=nilspace;dskverf:=nilspace;z:= +sequentialfile(modify,dszeitw);l:=sequentialfile(modify,dslverf);k:= +sequentialfile(modify,dskverf);insertrecord(z);insertrecord(l);insertrecord(k +);zz:=0.pruefeeingmaske:IF standardmaskenfeld(fldfix1)<>""CAND +standardmaskenfeld(fldfix2)<>""THEN return(ruecksprung);standardmeldung( +meldg22,"");infeld(fldfix1);LEAVE schulisintegatransferFI ;dateiname:= +standardmaskenfeld(fldinteganame)+".DP";IF standardmaskenfeld(fldinteganame)= +""THEN i:=0;fehlermeldungnamefalschELIF falschercode(dateiname)THEN +fehlermeldungnamefalschFI .fehlermeldungnamefalsch:return(ruecksprung);infeld +(fldinteganame);standardmeldung(meldg2,subtext(dateiname,i,i)+"#"+dateiname+ +"#");LEAVE schulisintegatransfer.pruefobintegabezda:sgridaten:="";letztepar:= +"";inittupel(dnraktschuelergruppen);datenfehler:=FALSE ;dbleer( +dnraktschuelergruppen);IF fehlerTHEN fehlerkeineschuelergruppenFI ; +statleseschleife(dnraktschuelergruppen,schj,schhj,dnraktschuelergruppen+1, +dnraktschuelergruppen+2,PROC sgridatenholen);IF datenfehlerTHEN +fehlermeldungintegaELSE sgridatenCAT trennerFI .fehlerkeineschuelergruppen: +return(ruecksprung);standardmeldung(meldg7,"");LEAVE schulisintegatransfer. +fehlermeldungintega:return(ruecksprung);standardmeldung(meldg4,"");LEAVE +schulisintegatransfer.stelledateinamefest:f:=sequentialfile(output,dateiname) +.stellehalbjahrfest:holeschuldaten;aktschhj:=holedatum(schuldaten,trenner+ +schulhj+trenner);aktschj:=holedatum(schuldaten,trenner+schulj+trenner);IF +aktschhj="1"THEN geplschhj:="2";geplschj:=aktschjELSE geplschhj:="1";geplschj +:=subtext(aktschj,3);jahrende:=int(geplschj)+1;geplschjCAT subtext("0"+text( +jahrende),LENGTH ("0"+text(jahrende))-1)FI ;IF standardmaskenfeld(fldakthj)<> +""THEN schj:=aktschj;schhj:=aktschhjELSE schj:=geplschj;schhj:=geplschhjFI . +holeschuldaten:dbleer(dnrschluessel);IF fehlerTHEN fehlerkeineschuldatenFI ; +schuldaten:=trenner;inittupel(dnrschluessel);statleseschleife(dnrschluessel, +schulkenndaten,"",dnrschluessel+1,dnrschluessel+2,PROC schulkennung). +fehlerkeineschuldaten:return(ruecksprung);standardmeldung(meldg8,"");LEAVE +schulisintegatransfer.holestundenplandaten:standardmeldung( +meldungstdplauswvorber,"");stundenplanhalbjahrsetzen(schhj,schj); +stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN +meldungausgeben(fstat);return(ruecksprung);LEAVE schulisintegatransferFI . +stellezeitvarfest:holezeitdaten;IF zeitdaten=trennerTHEN LEAVE +stellezeitvarfestELSE stelleunttagefestFI .holezeitdaten:zeitdaten:=trenner; +dbleer(dnrzeitraster);IF fehlerTHEN fehlerkeinezeitdatenFI ;inittupel( +dnrzeitraster);statleseschleife(dnrzeitraster,schj,schhj,dnrzeitraster+1, +dnrzeitraster+2,PROC zeitrasterdaten).fehlerkeinezeitdaten:return(ruecksprung +);standardmeldung(meldg9,"");LEAVE schulisintegatransfer.stelleunttagefest: +INT VAR akttagv:=0,akttagn:=0;vm:=0;nm:=0;ut:=0;FOR iFROM 1UPTO unttageREP vs +:=0;ns:=0;nulltestd:=(i-1)*stdenprotag;IF pos(zeitdaten,trenner+text( +nulltestd+1)+trenner)>0THEN utINCR 1;stellestdenfestELSE LEAVE +stelleunttagefestFI PER .stellestdenfest:FOR jFROM 1UPTO stdenprotagREP IF +pos(zeitdaten,trenner+text(nulltestd+j)+trenner)>0THEN holedrittesdatum( +zeitdaten,trenner+text(nulltestd+j)+trenner);zaehlevunstden;IF akttagv<>i +CAND t1="v"THEN vmINCR 1;akttagv:=iFI ;IF akttagn<>iCAND t1="n"THEN nmINCR 1; +akttagn:=iFI ;ELSE LEAVE stellestdenfestFI ;PER ;IF maxvs0THEN holedrittesdatum(zeitdaten,trenner+text((i-1)* +stdenprotag+j)+trenner);IF t1="x"THEN schulverfuegbarkeitCAT "1"ELSE +schulverfuegbarkeitCAT " "FI ELSE schulverfuegbarkeitCAT " "FI PER PER ; +schulverfuegbarkeit:=text(schulverfuegbarkeit,maxstden).schreibeschulverfgbkt +:putlinezz(f," "+schulverfuegbarkeit+"I"+zeilenende).schreibefragenkatalog +:vs:=maxvs;ns:=maxns;zeile:="";zeileCAT "FRAGEN ";zeileCAT " N N N 0";IF vs +<10THEN zeileCAT " "+text(vs)ELSE zeileCAT text(vs)FI ;zeileCAT +" 0 312 3100 0 ";zeileCAT text(ut);zeileCAT +"253146 BA";zeileCAT zeilenende;putlinezz(f,zeile +).schreibegewichtungen:zeile:="";zeileCAT "GEWICHT ";zeileCAT +" 2 2 2 2 2 2 2 2 2 2 2 0";zeileCAT " "; +zeileCAT "BB";zeileCAT zeilenende;putlinezz(f,zeile).schreibezeitraster1:IF +zeitdaten=""THEN LEAVE schreibezeitraster1FI ;zeile:="";zeileCAT "RASTERR"; +zeileCAT " 1 1";IF vs<10THEN zeileCAT " "+text(vs)ELSE zeileCAT text(vs)FI ; +zeileCAT " ";zeile +CAT "BC";zeileCAT zeilenende;putlinezz(f,zeile);zeile:="";zeileCAT "RASTERR"; +zeileCAT " 2 1";IF vs<11THEN zeileCAT " "+text(vs-1)ELSE zeileCAT text(vs-1) +FI ;zeileCAT " "; +zeileCAT "BC";zeileCAT zeilenende;putlinezz(f,zeile);zeile:="";zeileCAT +"RASTERB";IF vs<6THEN zeileCAT " 2 1 3 ";ELIF vs<8THEN zeile +CAT " 2 1 3 5 ";ELIF vs<10THEN zeileCAT +" 2 1 3 5 7 ";ELIF vs<12THEN zeileCAT " 2 1 3 5 7 9 " +;ELSE zeileCAT " 2 1 3 5 7 911 ";FI ;zeileCAT +" ";zeileCAT "BC";zeileCAT zeilenende; +putlinezz(f,zeile).schreibezeitraster2:IF zeitdaten=""THEN LEAVE +schreibezeitraster2FI ;FOR iFROM 1UPTO 12REP hole2daten(zeitdaten,trenner+ +text(i)+trenner);IF t1<>""COR t1<>" "THEN IF i<10THEN +zeitrasterzeilenerstellen(" "+text(i),t1,t2);ELSE zeitrasterzeilenerstellen( +text(i),t1,t2);FI ;FI ;PER .holeallezeitwuensche:dbleer(dnrzeitwuensche);IF +NOT fehlerTHEN inittupel(dnrzeitwuensche);statleseschleife(dnrzeitwuensche, +schj,schhj,dnrzeitwuensche+1,dnrzeitwuensche+2,PROC zeitw)FI . +schreibelehrerdaten:inittupel(dnrlehrer);fehler:=FALSE ;dbleer(dnrlehrer);IF +fehlerTHEN fehlerkeinelehrerFI ;fehler:=FALSE ;statleseschleife(dnrlehrer,"", +"",dnrlehrer+1,dnrlehrer+2,PROC lehrer);IF fehlerTHEN return(ruecksprung); +standardmeldung(meldg3,"");LEAVE schulisintegatransferFI .fehlerkeinelehrer: +return(ruecksprung);standardmeldung(meldg10,"");LEAVE schulisintegatransfer. +schreibeklassen:sgrdaten:="";klgrdaten:="";inittupel(dnraktschuelergruppen); +statleseschleife(dnraktschuelergruppen,schj,schhj,dnraktschuelergruppen+1, +dnraktschuelergruppen+2,PROC sgrdatenholen);dbleer(dnrklassengruppen);IF NOT +fehlerTHEN inittupel(dnrklassengruppen);statleseschleife(dnrklassengruppen,"" +,"",dnrklassengruppen+1,dnrklassengruppen+2,PROC klgrdatenholen);FI ;IF +sgrdaten<>""THEN schreibeklstELSE fehlermeldungaktschgrfehlenFI ;IF klgrdaten +<>""THEN schreibeklgrFI .fehlermeldungaktschgrfehlen:return(ruecksprung); +standardmeldung(meldg5,"");LEAVE schulisintegatransfer.schreibeklst:p:=1; +WHILE pos(sgrdaten,trenner,p+1)>0REP spput(subtext(sgrdaten,p+1,pos(sgrdaten, +trenner,p+1)-1));p:=pos(sgrdaten,trenner,p+1)PER ;spput(subtext(sgrdaten,p+1) +).schreibeklgr:p:=1;WHILE pos(klgrdaten,trenner,p+1)>0REP spiput(subtext( +klgrdaten,p+1,pos(klgrdaten,trenner,p+1)-1));IF falschesugrupgefundenTHEN +fehlerunbekanntesugrupgefundenFI ;putlinezz(f,text(t1,64)+" "+text(ut)+text( +vm)+text(nm)+" F"+zeilenende);p:=pos(klgrdaten,trenner,p+1)PER ;spiput( +subtext(klgrdaten,p+1));IF falschesugrupgefundenTHEN +fehlerunbekanntesugrupgefundenFI ;putlinezz(f,text(t1,64)+" "+text(ut)+text( +vm)+text(nm)+" F"+zeilenende).schreiberaumgruppen:schreibergrkarten; +schreiberkarten.schreibergrkarten:dbleer(dnrraumgruppen);IF NOT fehlerTHEN +zeile:="";inittupel(dnrraumgruppen);statleseschleife(dnrraumgruppen,"","", +dnrraumgruppen+1,dnrraumgruppen+2,PROC raumgr)FI .schreiberkarten:mindeinraum +:=FALSE ;fehler:=FALSE ;zeile:="";inittupel(dnrschluessel);statleseschleife( +dnrschluessel,raumkenndaten,"",dnrschluessel+1,dnrschluessel+2,PROC raum);IF +NOT mindeinraumTHEN return(ruecksprung);standardmeldung(meldg6,"");LEAVE +schulisintegatransferELIF zeile<>""THEN erstellrestraeumeFI . +erstellrestraeume:putlinezz(f,"REST"+text(zeile,64)+" G"+zeilenende);IF +length(zeile)>64THEN zeile:=subtext(zeile,65);h:=length(zeile)DIV 64;FOR i +FROM 1UPTO hREP schreibekartePER ;IF length(zeile)MOD 64>0THEN +schreibrestkarteFI FI .schreibekarte:putlinezz(f," "+subtext(zeile,(i-1)* +64+1,i*64)+" G"+zeilenende).schreibrestkarte:putlinezz(f," "+text(subtext +(zeile,h*64+1),64)+" G"+zeilenende).schreibeuvdaten:dbleer( +dnrlehrveranstaltungen);IF fehlerTHEN fehlerkeineuvFI ;inittupel( +dnrlehrveranstaltungen);statleseschleife(dnrlehrveranstaltungen,schj,schhj, +dnrlehrveranstaltungen+1,dnrlehrveranstaltungen+2,PROC lvschreiben);IF +falschesugrupgefundenTHEN fehlerunbekanntesugrupgefundenFI .fehlerkeineuv: +return(ruecksprung);standardmeldung(meldg11,"");LEAVE schulisintegatransfer. +fehlerunbekanntesugrupgefunden:return(ruecksprung);standardmeldung(meldg21, +par+ausgparam+letztepar+ausgparam);LEAVE schulisintegatransfer. +schreibelehrerverfgbkt:toline(l,1);col(l,1);WHILE NOT eof(l)REP readrecord(l, +record);putlinezz(f,record);down(l)PER .schreiberaumverfgbkt:dbleer( +dnrzeitwuensche);IF NOT fehlerTHEN schreibverfkarten(trenner+kennraum+trenner +)FI .schreibeklassenverfgbkt:toline(k,1);col(k,1);WHILE NOT eof(k)REP +readrecord(k,record);putlinezz(f,record);down(k)PER .schreibefachverfgbkt: +dbleer(dnrzeitwuensche);IF NOT fehlerTHEN schreibverfkarten(trenner+kennfach+ +trenner)FI .schreibevorbelegungen:IF standardmaskenfeld(fldfix2)<>""THEN +dbleer(dnrzeitwuensche);IF NOT fehlerTHEN schreibverfkarten(trenner+kennkoppl ++trenner)FI ELIF standardmaskenfeld(fldfix1)<>""THEN kartenart:="N"; +uebertragdatendesstundenplansFI .gibfertigmeldungaus:forget(dszeitw);forget( +dslverf);forget(dskverf);standardmeldung(meldg15,dateiname+"#"+text(zz)+"#"); +return(ruecksprung).END PROC schulisintegatransfer;PROC +uebertragdatendesstundenplans:TEXT VAR kopplungenderzeit:="",aktkopplung;INT +VAR aktpos;bearbkopplungen:="";FOR iFROM erstestdeUPTO maxstdenREP +standardmeldung(meldungbearbwird,integatagstd(i)+ausgparam);kopplungenderzeit +:=datenderzeit(i,kennkoppl);aktpos:=1;WHILE aktposeumelgrenzemaxzeilenTHEN standardmeldung(meldg14,""); +return(ruecksprung);LEAVE uebertragdatendesstundenplansFI .END PROC +uebertragdatendesstundenplans;PROC schreibvorbelegung(TEXT CONST kopplung, +allezeiten):INT VAR suchpos:=1,aktpos:=0;TEXT VAR kartenanfang:=text(kopplung +,8),karte:="";kartenanfangCAT " ";WHILE pos(allezeiten,"1",suchpos)<>0REP +aktpos:=pos(allezeiten,"1",suchpos);IF aktpos>0THEN karteCAT integatagstd( +aktpos);suchpos:=aktpos+1FI ;IF length(karte)=40THEN schreibkarte; +kartenanfang:=" ";karte:=""FI PER ;IF length(karte)<>40THEN +schreibkarteFI .schreibkarte:objektverf:=kartenanfang+text(karte,61)+ +kartenart+zeilenende;putlinezz(f,objektverf).END PROC schreibvorbelegung; +BOOL PROC nichtbearbeitet(TEXT CONST kopplung):INT VAR aktpos,suchab:=1; +WHILE pos(bearbkopplungen,kopplung,suchab)<>0REP aktpos:=pos(bearbkopplungen, +kopplung,suchab);IF aktposMOD 8=1THEN LEAVE nichtbearbeitetWITH FALSE ELSE +suchab:=aktpos+1FI ;PER ;bearbkopplungenCAT kopplung;TRUE END PROC +nichtbearbeitet;PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN +standardmeldung(meldungserverfehler,"");ELIF fstat=3THEN standardmeldung( +meldungkeinstdplan,"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen +,"");ELIF fstat=5THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6 +THEN standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung( +meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,""); +FI END PROC meldungausgeben;PROC schreibverfkarten(TEXT CONST kennung):TEXT +VAR objekt:="";toline(z,1);col(z,1);REP col(z,col(z)+1);downety(z,kennung) +UNTIL eof(z)COR (col(z)=142)PER ;IF kennung=trenner+kennraum+trennerTHEN +kartenart:="K"ELIF kennung=trenner+kennfach+trennerTHEN kartenart:="M"ELSE +kartenart:="N"FI ;IF NOT eof(z)CAND (kartenart<>"N")THEN REP readrecord(z, +record);IF pos(record,kennung)<>142THEN LEAVE schreibverfkartenFI ;bestwunsch +:=subtext(record,10,141);objekt:=holedatum(record,kennung); +uebertragbestwunschinverfkarte(objektverf);objektverf:=text(objekt,4)+ +objektverf+kartenart+zeilenende;putlinezz(f,objektverf);down(z)PER ELIF NOT +eof(z)THEN REP readrecord(z,record);IF pos(record,kennung)<>142THEN LEAVE +schreibverfkartenFI ;bestwunsch:=subtext(record,10,141);IF bestwunsch<> +leererbestwunschTHEN objekt:=holedatum(record,kennung); +uebertragbestwunschinvorbelegung(objekt)FI ;down(z)PER FI .END PROC +schreibverfkarten;PROC uebertragbestwunschinvorbelegung(TEXT CONST kopplung): +INT VAR suchpos:=1,aktpos:=0;TEXT VAR kartenanfang:=text(kopplung,8),karte:= +"";kartenanfangCAT " ";WHILE pos(bestwunsch,"+3",suchpos)<>0REP aktpos:=pos( +bestwunsch,"+3",suchpos);IF aktpos>0THEN karteCAT integatagstd((aktpos+1)DIV +2);suchpos:=aktpos+1FI ;IF length(karte)=40THEN schreibkarte;kartenanfang:= +" ";karte:=""FI PER ;IF karte<>""THEN schreibkarteFI .schreibkarte: +objektverf:=kartenanfang+text(karte,61)+kartenart+zeilenende;putlinezz(f, +objektverf).END PROC uebertragbestwunschinvorbelegung;TEXT PROC integatagstd( +INT CONST intzeit):TEXT VAR std:="";INT VAR stdnr:=intzeit;std:=text((stdnr-1 +)MOD 12+1,2);SELECT (stdnr-1)DIV 12OF CASE 0:"MO"+stdCASE 1:"DI"+stdCASE 2: +"MI"+stdCASE 3:"DO"+stdCASE 4:"FR"+stdCASE 5:"SA"+stdOTHERWISE " "END +SELECT END PROC integatagstd;BOOL PROC falschercode(TEXT CONST t):INT VAR +zeichencode;FOR iFROM 1UPTO LENGTH t-3REP zeichencode:=code(tSUB i);IF NOT (( +zeichencode>=48AND zeichencode<=57)OR (zeichencode>=65AND zeichencode<=90)OR +(zeichencode>=97AND zeichencode<=122))THEN LEAVE falschercodeWITH TRUE FI +PER ;FALSE END PROC falschercode;PROC zeitrasterzeilenerstellen(TEXT CONST +std,zeitanfang,zeitende):zeile:="";zeileCAT "ZEIT ";zeileCAT std;zeileCAT +subtext(zeitanfang,LENGTH zeitanfang-3)+subtext(zeitende,LENGTH zeitende-3); +zeileCAT " ";zeile:=text( +zeile,70);zeileCAT "BB";zeileCAT zeilenende;putlinezz(f,zeile)END PROC +zeitrasterzeilenerstellen;PROC schulkennung(BOOL VAR b):IF wert(dnrschluessel ++1)>schulkenndatenCOR dbstatus<>0THEN b:=TRUE ELSE schuldatenCAT wert( +dnrschluessel+2)+trenner;schuldatenCAT wert(dnrschluessel+3)+trenner;FI END +PROC schulkennung;PROC zeitrasterdaten(BOOL VAR b):IF wert(dnrzeitraster+1)<> +schjCOR wert(dnrzeitraster+2)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE +zeitdatenCAT wert(dnrzeitraster+3)+trenner;zeitdatenCAT " "+wert( +dnrzeitraster+5)+trenner;zeitdatenCAT " "+wert(dnrzeitraster+6)+trenner; +zeitdatenCAT wert(dnrzeitraster+4)+trenner;FI END PROC zeitrasterdaten;PROC +raumgr(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE schreibkarte;schreibraeume +FI .schreibkarte:t2:=wert(dnrraumgruppen+2);putlinezz(f,text(wert( +dnrraumgruppen+1),4)+text(t2,maxstden)+"G"+zeilenende).schreibraeume:FOR i +FROM 1UPTO (LENGTH t2)DIV 4REP rgrdatenCAT compress(subtext(t2,i*4-3,i*4))+ +trennerPER .END PROC raumgr;PROC raum(BOOL VAR b):IF wert(dnrschluessel+1)> +raumkenndatenCOR dbstatus<>0THEN b:=TRUE ELSE mindeinraum:=TRUE ;IF pos( +rgrdaten,trenner+wert(dnrschluessel+2)+trenner)<1THEN schreibrestraeumeFI ; +FI .schreibrestraeume:zeileCAT text(wert(dnrschluessel+2),4).END PROC raum; +PROC lvschreiben(BOOL VAR b):IF wert(dnrlehrveranstaltungen+1)<>schjCOR wert( +dnrlehrveranstaltungen+2)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE schreibkarte +FI .schreibkarte:zeile:="";zeileCAT text(wert(dnrlehrveranstaltungen+5),8)+ +text(wert(dnrlehrveranstaltungen+4),2)+" "+text(wert(dnrlehrveranstaltungen+ +6),4)+subtext(" "+wert(dnrlehrveranstaltungen+7),length(" "+wert( +dnrlehrveranstaltungen+7))-1)+" ";FOR iFROM 8UPTO 11REP IF wert( +dnrlehrveranstaltungen+i)=""CAND i=8THEN pruefrestlklgrELIF wert( +dnrlehrveranstaltungen+i)=""CAND i<>8THEN zeileCAT " "ELIF +istschuelergruppeTHEN zeileCAT text(substituiere,4)ELIF istklassengruppeTHEN +zeileCAT text(wert(dnrlehrveranstaltungen+i),4)ELIF istklassenstufeTHEN zeile +CAT text(formatjgst(wert(dnrlehrveranstaltungen+i)),4)ELSE +falschesugrupgefunden:=TRUE ;par:=formatjgst(wert(dnrlehrveranstaltungen+3))+ +wert(dnrlehrveranstaltungen+4);letztepar:=wert(dnrlehrveranstaltungen+i);b:= +TRUE ;LEAVE lvschreibenFI PER ;zeileCAT " "+text(wert( +dnrlehrveranstaltungen+12),4)+text(wert(dnrlehrveranstaltungen+13),4)+ +" "+"H"+zeilenende;putlinezz(f,zeile).pruefrestlklgr:IF wert( +dnrlehrveranstaltungen+9)=""CAND wert(dnrlehrveranstaltungen+10)=""CAND wert( +dnrlehrveranstaltungen+11)=""THEN zeileCAT text(formatjgst(wert( +dnrlehrveranstaltungen+3)),4)ELSE zeileCAT " "FI .istschuelergruppe:pos( +sgridaten,trenner+formatjgst(wert(dnrlehrveranstaltungen+3))+text(wert( +dnrlehrveranstaltungen+i),4)+trenner)>0.istklassengruppe:pos(klgr,trenner+ +wert(dnrlehrveranstaltungen+i)+trenner)>0.istklassenstufe:intwert( +dnrlehrveranstaltungen+i)>4CAND intwert(dnrlehrveranstaltungen+i)<14. +substituiere:subst(text(jgst+wert(dnrlehrveranstaltungen+i),6)).jgst: +formatjgst(wert(dnrlehrveranstaltungen+3)).END PROC lvschreiben;TEXT PROC +holedatum(TEXT VAR variable,TEXT CONST suchwort):IF pos(variable,suchwort)>0 +THEN subtext(variable,nachsuchwort,endezeichen)ELSE ""FI .nachsuchwort:pos( +variable,suchwort)+LENGTH suchwort.endezeichen:pos(variable,trenner, +nachsuchwort)-1.END PROC holedatum;PROC hole2daten(TEXT VAR variable,TEXT +CONST suchwort):IF pos(variable,suchwort)>0THEN t1:=subtext(variable, +nachsuchwort,endezeichen);t2:=subtext(variable,endezeichen+2, +naechstesendezeichen-1);ELSE t1:="";t2:=""FI .nachsuchwort:pos(variable, +suchwort)+LENGTH suchwort.endezeichen:pos(variable,trenner,nachsuchwort)-1. +naechstesendezeichen:pos(variable,trenner,endezeichen+2).END PROC hole2daten; +PROC holedrittesdatum(TEXT VAR variable,TEXT CONST suchwort):INT VAR p:=pos( +variable,suchwort),i;FOR iFROM 1UPTO 3REP p:=pos(variable,trenner,p+1);PER ; +t1:=subtext(variable,p+1,pos(variable,trenner,p+1)-1)END PROC +holedrittesdatum;PROC spput(TEXT CONST t):TEXT VAR hohlstd:="0 ", +weiterekarten:="",zeile:="",alleschgr,aktschgr;BOOL VAR jgstausgabe:=TRUE ; +INT VAR anzschgrprozeile:=0;zeile:=text(t,4);alleschgr:=subtext(t,5); +weiterekarten:="";FOR iFROM 1UPTO (length(t)-4)DIV 4REP objut:=ut;objvm:=vm; +objnm:=nm;aktschgr:=subtext(alleschgr,(i-1)*4+1,i*4);suchezeitwunsch; +schreibeintragPER ;IF anzschgrprozeileMOD 15<>0THEN eintragausgebenFI ; +schreibschgrmitunbestwunsch.suchezeitwunsch:suchezeitw(trenner+kennsugrup+ +trenner+aktschgr+trenner);IF unbestwunsch<>""CAND unbestwunsch<> +leererunbestwunschTHEN uebertragunbestwunschinkarte;IF objut<>utCOR objvm<>vm +COR objnm<>nmTHEN weiterekartenCAT " ";weiterekartenCAT aktschgr; +weiterekartenCAT hohlstd;weiterekartenCAT text(objut);weiterekartenCAT text( +objvm);weiterekartenCAT text(objnm)FI FI ;IF bestwunsch<>""CAND bestwunsch<> +leererbestwunschTHEN uebertragbestwunschinverfkarte(objektverf);objektverf:= +aktschgr+objektverf+"L"+zeilenende;putds(k,objektverf)FI .schreibeintrag:IF +keinwunschgefundenTHEN zeileCAT aktschgr;anzschgrprozeileINCR 1;IF +anzschgrprozeile=15THEN putlinezz(f,zeile+hohlstd+text(ut)+text(vm)+text(nm)+ +" D"+zeilenende);anzschgrprozeile:=0;jgstausgabe:=FALSE ;zeile:=" "FI FI . +keinwunschgefunden:bestwunsch=""COR (objut=utCAND objvm=vmCAND objnm=nm). +eintragausgeben:putlinezz(f,text(zeile,64)+hohlstd+text(ut)+text(vm)+text(nm) ++" D"+zeilenende);jgstausgabe:=FALSE .schreibschgrmitunbestwunsch:IF +weiterekarten<>""THEN FOR jFROM 1UPTO length(weiterekarten)DIV 13REP aktschgr +:=subtext(weiterekarten,(j-1)*13+1,j*13);IF jgstausgabeTHEN putlinezz(f,zeile ++subtext(aktschgr,5,8)+ +" "+subtext(aktschgr,9 +)+" D"+zeilenende);jgstausgabe:=FALSE ELSE putlinezz(f,text(aktschgr,8)+ +" "+subtext(aktschgr,9 +)+" D"+zeilenende)FI ;PER ;FI .END PROC spput;PROC spiput(TEXT CONST t):t1:= +text(t,4);FOR iFROM 1UPTO ((LENGTH t)-4)DIV 6REP IF subtext(t,i*6+1,i*6+4)= +" "THEN t1CAT subtext(t,i*6-1,i*6+2)ELSE t1CAT subst(subtext(t,i*6-1,i*6+4 +));IF falschesugrupgefundenTHEN par:=text(t,4);LEAVE spiputFI ;FI ;PER .END +PROC spiput;TEXT PROC subst(TEXT CONST t):IF pos(sgridaten,trenner+t+trenner) +>0THEN subtext(sgridaten,pos(sgridaten,trenner+t+trenner)+8,pos(sgridaten, +trenner+t+trenner)+11)ELSE letztepar:=t;falschesugrupgefunden:=TRUE ;""FI +END PROC subst;PROC lehrer(BOOL VAR b):lehrerdaten:="";objut:=ut;objvm:=vm; +objnm:=nm;IF dbstatus<>0THEN b:=TRUE ELSE lehrerdatenCAT text(wert(dnrlehrer+ +2),20);par:=wert(dnrlehrer+1);lehrerdatenCAT text(wert(dnrlehrer+1),4)+ +" ";lehrerdatenCAT subtext(" "+wert(dnrlehrer+7),length(" "+wert( +dnrlehrer+7))-1);suchezeitw(trenner+kennpar+trenner+par+trenner);IF +bestwunsch<>""CAND bestwunsch<>leererbestwunschTHEN schreibverfuegkarteFI ; +schreiblehrerkarteFI .schreibverfuegkarte:uebertragbestwunschinverfkarte( +objektverf);objektverf:=text(par,4)+objektverf+"J"+zeilenende;putds(l, +objektverf).schreiblehrerkarte:IF unbestwunsch<>""CAND unbestwunsch<> +leererunbestwunschTHEN uebertragunbestwunschinkarteFI ;putlinezz(f, +lehrerdaten+" "+text(objut)+text(objvm)+text(objnm)+ +" C"+zeilenende).END PROC lehrer;PROC suchezeitw( +TEXT CONST kennung):toline(z,1);col(z,1);downety(z,kennung);IF eof(z)THEN +bestwunsch:="";unbestwunsch:=""ELSE readrecord(z,record);unbestwunsch:=text( +record,9);bestwunsch:=subtext(record,10,141)FI ;END PROC suchezeitw;PROC +zeitw(BOOL VAR b):IF wert(dnrzeitwuensche+1)<>schjCOR wert(dnrzeitwuensche+2) +<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE zeitwuensche:="";zeitwuenscheCAT wert +(dnrzeitwuensche+6);zeitwuenscheCAT wert(dnrzeitwuensche+5);zeitwuenscheCAT +trenner;zeitwuenscheCAT wert(dnrzeitwuensche+3);zeitwuenscheCAT trenner;IF +wert(dnrzeitwuensche+3)=kennsugrupTHEN zeitwuenscheCAT holedatum(sgridaten, +trenner+text(wert(dnrzeitwuensche+4),6)+trenner);ELSE zeitwuenscheCAT wert( +dnrzeitwuensche+4);FI ;zeitwuenscheCAT trenner;putds(z,zeitwuensche)FI END +PROC zeitw;PROC uebertragbestwunschinverfkarte(TEXT VAR verf):INT VAR suchpos +:=1,aktpos:=0;verf:=schulverfuegbarkeit;WHILE pos(bestwunsch,"-3",suchpos)<>0 +REP aktpos:=pos(bestwunsch,"-3",suchpos);IF aktpos>0THEN replace(verf,(aktpos ++1)DIV 2,"1");suchpos:=aktpos+1FI PER END PROC uebertragbestwunschinverfkarte +;PROC uebertragunbestwunschinkarte:INT VAR tageswunsch:=0;IF (unbestwunsch +SUB 3)="3"THEN tageswunsch:=int(unbestwunschSUB 1);objutDECR tageswunsch; +objvmDECR tageswunsch;objnmDECR tageswunsch-1FI ;IF (unbestwunschSUB 6)="3" +THEN objvmDECR int(unbestwunschSUB 4)FI ;IF (unbestwunschSUB 9)="3"THEN objnm +DECR int(unbestwunschSUB 7)FI ;END PROC uebertragunbestwunschinkarte;PROC +sgrdatenholen(BOOL VAR b):IF wert(dnraktschuelergruppen+1)<>schjCOR wert( +dnraktschuelergruppen+2)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE IF wert( +dnraktschuelergruppen+3)<>letzteparTHEN zeile:=formatjgst(wert( +dnraktschuelergruppen+3));sgrdatenCAT trenner+text(zeile,4);letztepar:=wert( +dnraktschuelergruppen+3)FI ;sgrdatenCAT text(wert(dnraktschuelergruppen+7),4) +FI ;END PROC sgrdatenholen;PROC klgrdatenholen(BOOL VAR b):IF dbstatus<>0 +THEN b:=TRUE ELSE klgrdatenCAT trenner+text(wert(dnrklassengruppen+1),4);klgr +CAT wert(dnrklassengruppen+1)+trenner;klgrdatenCAT wert(dnrklassengruppen+2) +FI END PROC klgrdatenholen;PROC sgridatenholen(BOOL VAR b):IF wert( +dnraktschuelergruppen+1)<>schjCOR wert(dnraktschuelergruppen+2)<>schhjCOR +dbstatus<>0THEN b:=TRUE ELSE sgridatenCAT trenner+jgstaufber(wert( +dnraktschuelergruppen+3));sgridatenCAT text(wert(dnraktschuelergruppen+4),4)+ +trenner;sgridatenCAT text(wert(dnraktschuelergruppen+7),4);IF wert( +dnraktschuelergruppen+7)=""THEN datenfehler:=TRUE FI FI ;END PROC +sgridatenholen;PROC putds(FILE VAR file,TEXT CONST t):writerecord(file,t); +down(file);insertrecord(file)END PROC putds;PROC dbleer(INT CONST dateinr): +fehler:=FALSE ;IF records(dateinr)<1.0THEN fehler:=TRUE FI END PROC dbleer; +PROC melde(TEXT CONST meldungsergaenzung):standardmeldung(meldg1, +meldungsergaenzung+"#")END PROC melde;PROC putlinezz(FILE VAR f,TEXT CONST t) +:putline(f,t);IF zz>2999THEN abbruchwegen4000zeilen:=TRUE ELSE zzINCR 1FI +END PROC putlinezz;TEXT PROC formatjgst(TEXT CONST jgst):IF int(jgst)=0THEN +LEAVE formatjgstWITH "00"ELIF int(jgst)<10THEN LEAVE formatjgstWITH +jgstaufber(jgst)FI ;jgstEND PROC formatjgst;END PACKET +datenfuerintegaaufbereiten; + diff --git "a/app/schulis/2.2.1/src/4.daten f\303\274r schulis aufbereiten" "b/app/schulis/2.2.1/src/4.daten f\303\274r schulis aufbereiten" new file mode 100644 index 0000000..89c96ea --- /dev/null +++ "b/app/schulis/2.2.1/src/4.daten f\303\274r schulis aufbereiten" @@ -0,0 +1,184 @@ +PACKET integastundenplanuebernehmenDEFINES integastundenplanarchivlisten, +integastundenplanstdvproc,integastundenplanuebernehmen, +integastundenplandatenschreiben:LET integadatei="SCHULIS.PUN",filemodus= +"file ibm",dos="DOS",anzstdenprotag=12,schulname="Schulname",schulort= +"Schulort",schuljahr="Schuljahr",halbjahr="Schulhalbjahr",maskeeingang= +"ms stdplan von intega uebernehmen",listenname= +"Liste der Dateien auf der Diskette:",protokollname= +"Stundenplan von INTEGA übernehmen",leerzeile=" ",ueberschrift= +" Fehlerprotokoll zur Übernahme des Stundenplans ",unterstrich= +" ------------------------------------------------------------------", +fehler1kopf="1. Kopplung existiert in schulis nicht für:",fehler2kopf= +"2. Lehrveranstaltung kann nicht identifiziert werden für:",fehler3kopf1= +"3. Kopplung und Paraphe passen in schulis auf Lehrveranstaltung, aber", +fehler3kopf2=" Fach stimmt nicht überein für:",fehler4kopf= +"4. In INTEGA wurden Zeiten verplant, die in schulis gesperrt sind für:", +fehlerspalten1= +" Kopplung Fach Lehrer Klassengruppen Zeit Raum", +fehlerspalten2=" schulis INTEGA ",fehlerspalten3= +" Lehrver. Kopplung Fach Lehrer Klassengruppen Zeit Raum", +spalten3fueller=" ", +keinfehler=" Kein Fehler dieser Art aufgetreten!",tab1= +" +--------+--------+----+------+-----------------------+-----+----+",tab2= +" +--------+----+------+-----------------------+-----+----+", +feldakthj=2,laengelvkopp=8,laengeindex=4,laengezeitraum=6,beginnkopp=1, +endekopp=8,beginnfach=9,endefach=12,beginnlvfach=3,endelvfach=4,beginnpar=13, +endepar=16,beginnklgr=19,endeklgr=42,beginnbelegg=43,fachergaenzung=" ", +leereraumangabe=" ",leerelv=" ",pseudoraum="PSEU",ausgabeparam="#", +frageraum="????",kennungkopplung="K",kennungparaphe="P",kennungzulzeit="ZZ", +kennungmo="Mo ",kennungdi="Di ",kennungmi="Mi ",kennungdo="Do ",kennungfr= +"Fr ",kennungsa="Sa ",meldungserverfehler=376,meldungkeinstdplan=366, +meldungkeinesugruppen=334,meldungzuvielesugruppen=356,meldungkeinelv=326, +meldungzuvielelv=358,meldungstdplanveraltet=377,meldungbasisinkon=378, +meldwarten=69,melddatenaufber=357,melduebern=374,meldueberschr=372, +meldaenderungenunvollstaendig=364,meldprotokollaufbereiten=373, +meldstandderuebern=375,meldarchivfehler=343;FILE VAR g,protokoll, +integastdplandatei;THESAURUS VAR thes;TEXT VAR gewsj,gewhj,t,integaeintrag,lv +,leistekoppexistnicht,leistelvnichtident,leistelvfalschesfach,leisteunzzeit, +integakopplung,integafach,integaparaphe,integabelegg,zeitraumeintrag, +zeitderlv,raumderlv,stdplaneintrag;INT VAR fstat,i,posanf,posende, +intzeitderlv;BOOL VAR archivfehler:=FALSE ,transferfehler:=FALSE ,eintragok; +PROC archivanmelden(INT CONST ruecksprung):archivfehler:=FALSE ; +commanddialogue(FALSE );disablestop;reserve(filemodus,/dos);IF iserrorTHEN +archivfehler:=TRUE ;abbruchnachfehler(ruecksprung);LEAVE archivanmeldenFI ; +enablestopEND PROC archivanmelden;PROC integastundenplanarchivlisten: +standardmeldung(meldwarten," ");archivanmelden(1);IF archivfehlerTHEN LEAVE +integastundenplanarchivlistenFI ;disablestop;forget(listenname,quiet);thes:= +ALL (/dos);IF iserrorTHEN archivfehler:=TRUE ;abbruchnachfehler(1);ELSE +release(/dos);thesaurusaufbereiten;enablestop;zeigedatei(listenname,"vr")FI . +thesaurusaufbereiten:g:=sequentialfile(output,listenname);t:=" ";i:=0;REP get +(thes,t,i);putline(g,t)UNTIL t=""PER .END PROC integastundenplanarchivlisten; +PROC integastundenplanstdvproc:standardstartproc(maskeeingang);IF +transferfehlerTHEN standardmeldung(meldaenderungenunvollstaendig,"")FI ; +transferfehler:=FALSE ;infeld(2);standardnprocEND PROC +integastundenplanstdvproc;PROC integastundenplanuebernehmen:standardmeldung( +meldwarten,"");gewsj:=schulkenndatum(schuljahr);gewhj:=schulkenndatum( +halbjahr);IF standardmaskenfeld(feldakthj)=""THEN geplanteshjundsjberechnen( +gewhj,gewsj)FI ;stundenplanhalbjahrsetzen(gewhj,gewsj);standardmeldung( +melddatenaufber,"");stundenplanbasisundstundenplanholen(fstat);IF fstat<>0 +CAND fstat<>8THEN standardmeldung(melduebern,"")ELSE standardmeldung( +meldueberschr,"")FI ;standardnproc.END PROC integastundenplanuebernehmen; +PROC integastundenplandatenschreiben:TEXT VAR alteerstellungszeit:="";IF +fstat<>0CAND fstat<>8THEN standardmeldung(meldwarten,""); +stundenplanbasisundstundenplanerstellen(fstat);IF fstat<>0THEN return(2); +meldungausgeben(fstat);LEAVE integastundenplandatenschreibenELSE +stundenplanbasissichern(fstat);stundenplansichern(fstat);IF fstat<>0THEN +return(2);meldungausgeben(fstat);LEAVE integastundenplandatenschreibenFI ;FI +;FI ;alteerstellungszeit:=erstellungszeitderdatenraeume;stundenplanloeschen( +fstat);stundenplanerstellen(alteerstellungszeit,fstat);datenvonarchivholen(2) +;IF archivfehlerTHEN LEAVE integastundenplandatenschreibenFI ; +dateninstdplanschreibenEND PROC integastundenplandatenschreiben;PROC +datenvonarchivholen(INT CONST ruecksprung):standardmeldung(meldwarten," "); +archivanmelden(ruecksprung);IF archivfehlerTHEN LEAVE datenvonarchivholenFI ; +disablestop;fetch(integadatei,/dos);IF iserrorTHEN archivfehler:=TRUE ; +abbruchnachfehler(ruecksprung);ELSE release(/dos);enablestop;commanddialogue( +TRUE );FI END PROC datenvonarchivholen;PROC dateninstdplanschreiben:INT VAR +zeilennr:=0;TEXT VAR anzzeilen;BOOL VAR lvnichtvermerkt:=TRUE ; +fehlerprotvorbereiten;datenraumankoppeln;WHILE NOT eof(integastdplandatei) +REP zeilennrINCR 1;getline(integastdplandatei,integaeintrag);standardmeldung( +meldstandderuebern,anzzeilen+ausgabeparam+text(zeilennr)+ausgabeparam); +stundenplaneintraegevornehmenPER ;IF leisteunzzeit<>""COR +leistekoppexistnicht<>""COR leistelvnichtident<>""COR leistelvfalschesfach<> +""THEN sicherstdplan;standardmeldung(meldprotokollaufbereiten," ");forget( +protokollname,quiet);protokoll:=sequentialfile(output,protokollname); +fuelleprotokoll;infeld(1);standardfelderausgeben;infeld(2);zeigedatei( +protokollname,"vr")ELSE sicherstdplan;infeld(1);standardfelderausgeben;infeld +(2);return(2)FI .sicherstdplan:stundenplanreorganisierenundsichern(fstat);IF +fstat<>0THEN transferfehler:=TRUE FI .fehlerprotvorbereiten:leisteunzzeit:="" +;leistekoppexistnicht:="";leistelvnichtident:="";leistelvfalschesfach:="". +datenraumankoppeln:integastdplandatei:=sequentialfile(input,integadatei); +anzzeilen:=text(lines(integastdplandatei)).stundenplaneintraegevornehmen: +integakopplung:=text(integaeintrag,laengelvkopp);integafach:=subtext( +integaeintrag,beginnfach,endefach);integaparaphe:=subtext(integaeintrag, +beginnpar,endepar);integabelegg:=subtext(integaeintrag,beginnbelegg);t:= +allelvmit(kennungkopplung,integakopplung);IF t=""THEN leistekoppexistnicht +CAT text(zeilennr,laengeindex)ELSE IF lvmitgleicherparaphe(t)THEN pruefefach +ELSE leistelvnichtidentCAT text(zeilennr,laengeindex)FI FI .pruefefach:IF +integafach<>subtext(lv,beginnlvfach,endelvfach)+fachergaenzungTHEN +leistelvfalschesfachCAT text(zeilennr,laengeindex);leistelvfalschesfachCAT +text(lv,laengelvkopp)ELSE tragstundeneinundpruefezeitenFI . +tragstundeneinundpruefezeiten:stdplaneintrag:=lv+integakopplung+integaparaphe +;posanf:=1;posende:=length(integabelegg);lvnichtvermerkt:=TRUE ;WHILE posanf< +posendeREP zeitraumeintrag:=subtext(integabelegg,posanf,posanf+laengezeitraum +-1);zeitderlv:=text(zeitraumeintrag,2);intzeitderlv:=int(zeitderlv);raumderlv +:=compress(subtext(zeitraumeintrag,3));IF raumderlv=""COR raumderlv= +pseudoraumCOR raumderlv=frageraumTHEN raumderlv:=leereraumangabeFI ;IF NOT +bezeichnungzulaessig(kennungzulzeit,zeitderlv)THEN IF lvnichtvermerktTHEN +leisteunzzeitCAT text(zeilennr,laengeindex);leisteunzzeitCAT text(lv, +laengelvkopp);lvnichtvermerkt:=FALSE FI ELSE planeintragvornehmen( +intzeitderlv,lv,raumderlv,eintragok);IF NOT eintragokTHEN transferfehler:= +TRUE FI ;FI ;posanfINCR laengezeitraumPER .fuelleprotokoll:putline(protokoll, +schulkenndatum(schulname));putline(protokoll,text(schulkenndatum(schulort),65 +)+date);putline(protokoll,leerzeile);putline(protokoll,ueberschrift+gewhj+ +". "+text(gewsj,2)+"/"+subtext(gewsj,3)+" von INTEGA");putline(protokoll, +unterstrich);putline(protokoll,leerzeile);putline(protokoll,fehler1kopf); +putline(protokoll,leerzeile);IF leistekoppexistnicht=""THEN putline(protokoll +,keinfehler)ELSE putline(protokoll,fehlerspalten1);putline(protokoll,tab2); +gibfalschekopplungenausFI ;putline(protokoll,leerzeile);putline(protokoll, +fehler2kopf);putline(protokoll,leerzeile);IF leistelvnichtident=""THEN +putline(protokoll,keinfehler)ELSE putline(protokoll,fehlerspalten1);putline( +protokoll,tab2);gibfalschelvausFI ;putline(protokoll,leerzeile);putline( +protokoll,fehler3kopf1);putline(protokoll,fehler3kopf2);putline(protokoll, +leerzeile);IF leistelvnichtident=""THEN putline(protokoll,keinfehler)ELSE +putline(protokoll,fehlerspalten2);putline(protokoll,fehlerspalten3);putline( +protokoll,tab1);gibnichtidentlvausFI ;putline(protokoll,leerzeile);putline( +protokoll,fehler4kopf);putline(protokoll,leerzeile);IF leisteunzzeit=""THEN +putline(protokoll,keinfehler)ELSE putline(protokoll,fehlerspalten3);putline( +protokoll,tab1);gibfalschezeitenausFI .gibfalschezeitenaus:gibleisteaus( +leisteunzzeit,FALSE ,FALSE ).gibfalschekopplungenaus:gibleisteaus( +leistekoppexistnicht,TRUE ,TRUE ).gibfalschelvaus:gibleisteaus( +leistelvnichtident,TRUE ,TRUE ).gibnichtidentlvaus:gibleisteaus( +leistelvfalschesfach,FALSE ,TRUE ).END PROC dateninstdplanschreiben;PROC +gibleisteaus(TEXT CONST leiste,BOOL CONST ohnelv,allezeiten):INT VAR +posanfleiste,posendeleiste,posanflv,posanfbelegg,posendebelegg;BOOL VAR +erstezeilederlv:=TRUE ;posanfleiste:=1;posendeleiste:=length(leiste);modify( +integastdplandatei);WHILE posanfleistehjkennalt.pruefeeingangsmaske:standardpruefe(5,2,6,0,"",fstat);IF +fstat<>0THEN infeld(fstat);return(1);LEAVE zeitwuenschepruefenausfuehrenELIF +standardmaskenfeld(fldlehrer)<>""THEN fall:=fldlehrer;anhang:=anhangl;kenn:= +kennzlehrerELIF standardmaskenfeld(fldsugrup)<>""THEN fall:=fldsugrup;anhang +:=anhangs;kenn:=kennzsugrupELIF standardmaskenfeld(fldraeume)<>""THEN fall:= +fldraeume;anhang:=anhangr;kenn:=kennzraeume;pruefefaecherELIF +standardmaskenfeld(fldfaecher)<>""THEN fall:=fldfaecher;anhang:=anhangf;kenn +:=kennzfaecher;IF faecherkatalog=trennerTHEN holallefaecherFI ;ELIF +standardmaskenfeld(fldkopplungen)<>""THEN fall:=fldkopplungen;anhang:=anhangk +;kenn:=kennzkopplFI .holallefaecher:inittupel(dnrfaecher);statleseschleife( +dnrfaecher,"","",fnrffach,fnrffach,PROC faecher).pruefefaecher:IF records( +dnrfaecher)=0.0THEN fehlerkeinefaecherFI .pruefehalbjahr:schj:=schulkenndatum +(schuljahr);schhj:=schulkenndatum(schulhalbjahr);IF standardmaskenfeld( +fldakthalbj)=""THEN geplanteshjundsjberechnen(schhj,schj);hjkennneu:=1ELSE +hjkennneu:=0FI .holestundenplan:standardmeldung(meldungstdplauswvorber,""); +stundenplanhalbjahrsetzen(schhj,schj);stundenplanbasisundstundenplanholen( +fstat);IF fstat<>0CAND fstat<>8THEN meldungausgeben(fstat);return(1);LEAVE +zeitwuenschepruefenausfuehrenFI .erstellezeitraster:plan:="";IF records( +dnrzeitraster)=0.0THEN fehlerzeitrasternichtvollstdELSE inittupel( +dnrzeitraster);statleseschleife(dnrzeitraster,schj,schhj,fnrzrsj,fnrzrhj, +PROC zeitrasterdaten)FI ;IF length(plan)schjCOR wert(fnrzwhj)<>schhj +COR wert(fnrzwbezug)<>kennCOR dbstatus<>0THEN b:=TRUE ELSE IF +keinezeitwuenscheTHEN keinezeitwuensche:=FALSE FI ;bereiteobjektauf(wert( +fnrzwbezugsobjekt))FI END PROC zeitwuenschelisten;PROC bereiteobjektauf(TEXT +CONST objekt):TEXT VAR bestwunsch,unbestwunsch;INT VAR suchpos:=1,freietage, +freievorm,freienachm,wnerf,wanz;TEXT VAR wunsch:="";standardmeldung( +meldungbearbwird,objekt+ausgabeparam);IF kenn=kennzfaecherTHEN IF pos( +faecherkatalog,trenner+objekt+trenner)=0THEN fehlereintragELSE listeneintrag +FI ELIF bezeichnungzulaessig(kenn,objekt)THEN listeneintragELSE fehlereintrag +FI .fehlereintrag:putline(datei,objekt+": (ungültige Bezeichnung)");putline +(datei,leerzeile).listeneintrag:moobjeintrag:=moeintrag;diobjeintrag:= +dieintrag;miobjeintrag:=mieintrag;doobjeintrag:=doeintrag;frobjeintrag:= +freintrag;saobjeintrag:=saeintrag;uebertragwuensche;putline(datei,objekt+":") +;putline(datei,leerzeile);putline(datei,"Wünsche zu festen Zeiten:");putline( +datei,"(nicht erfüllte sind mit * markiert)");putline(datei, +" 1 2 3 4 5 6 7 8 9 10 11 12");putline(datei, +moobjeintrag+text(bestwzeile,48));putline(datei,diobjeintrag+subtext( +bestwzeile,49,96));putline(datei,miobjeintrag+subtext(bestwzeile,97,144)); +putline(datei,doobjeintrag+subtext(bestwzeile,145,192));putline(datei, +frobjeintrag+subtext(bestwzeile,193,240));putline(datei,saobjeintrag+subtext( +bestwzeile,241));putline(datei,leerzeile);putline(datei, +" im Plan allgemeine Wünsche:");putline(datei, +" frei Anzahl/Gewicht nicht erfüllt");putline(datei, +"ganze Tage "+unbestwtage);putline(datei,"zusätzl. Vorm. "+unbestwvorm) +;putline(datei,"zusätzl. Nachm. "+unbestwnachm);putline(datei,leerzeile); +putline(datei,leerzeile).uebertragwuensche:bestwunsch:=wert( +fnrzwbestimmtewuensche);unbestwunsch:=wert(fnrzwunbestimmtewuensche); +bestwzeile:=bestwurzeile;unbestwtage:=" _ _ _ _ "; +unbestwvorm:=" _ _ _ _ ";unbestwnachm:= +" _ _ _ _ ";tragbestwuenscheein;tragunbestwuenscheein. +tragbestwuenscheein:suchpos:=1;WHILE suchpos<>0REP suchpos:=pos(bestwunsch, +minus,suchpos);IF suchpos<>0THEN wunsch:=subtext(bestwunsch,suchpos,suchpos+1 +);zaehlebestwunsch(1,wunsch,TRUE );IF unterricht(objekt,suchposDIV 2+1)THEN +wunschCAT ausgnerf;zaehlebestwunsch(1,wunsch,FALSE )FI ;replace(bestwzeile, +suchpos*2-1,wunsch);suchposINCR 1FI ;PER ;suchpos:=1;WHILE suchpos<>0REP +suchpos:=pos(bestwunsch,plus,suchpos);IF suchpos<>0THEN wunsch:=subtext( +bestwunsch,suchpos,suchpos+1);zaehlebestwunsch(1,wunsch,TRUE );IF NOT ( +unterricht(objekt,suchposDIV 2+1))THEN wunschCAT ausgnerf;zaehlebestwunsch(1, +wunsch,FALSE )FI ;replace(bestwzeile,suchpos*2-1,wunsch);suchposINCR 1FI ; +PER .tragunbestwuenscheein:anztage:=0;anzvorm:=0;anznachm:=0; +ermittleunbestwdaten(objekt);freietage:=anzunterrichtstage-anztage;freievorm +:=anzvormittage-freietage-anzvorm;freienachm:=anznachmittage-freietage- +anznachm;replace(unbestwtage,ausgfreipos,text(freietage));replace(unbestwvorm +,ausgfreipos,text(freievorm));replace(unbestwnachm,ausgfreipos,text( +freienachm));IF unbestwunsch<>leererunbestwunschTHEN wunsch:=unbestwunschSUB +posanzut;IF wunsch<>" "THEN replace(unbestwtage,ausganzpos,wunsch)FI ;wanz:= +int(wunsch);IF freietage" "THEN replace(unbestwtage,ausggewpos,wunsch)FI ;zaehleunbestwunsch( +2,wanz,wnerf,wunsch);wunsch:=unbestwunschSUB posanzvm;IF wunsch<>" "THEN +replace(unbestwvorm,ausganzpos,wunsch)FI ;wanz:=int(wunsch);IF freievorm" "THEN replace( +unbestwvorm,ausggewpos,wunsch)FI ;zaehleunbestwunsch(3,wanz,wnerf,wunsch); +wunsch:=unbestwunschSUB posanznm;IF wunsch<>" "THEN replace(unbestwnachm, +ausganzpos,wunsch)FI ;wanz:=int(wunsch);IF freienachm" "THEN replace(unbestwnachm, +ausggewpos,wunsch)FI ;zaehleunbestwunsch(4,wanz,wnerf,wunsch);FI .END PROC +bereiteobjektauf;PROC ermittleunbestwdaten(TEXT CONST objekt):BOOL VAR +tagnichtgezaehlt:=TRUE ;INT VAR incr:=0,anz,zeitstd;anz:= +anzunterrichtsstunden;FOR iFROM 1UPTO anzunterrichtstage-1REP +tagnichtgezaehlt:=TRUE ;suchevormunterricht;suchenachmunterricht;incrINCR +anzunterrichtsstundenPER ;anz:=anzsamstagstunden;tagnichtgezaehlt:=TRUE ; +suchevormunterricht;suchenachmunterricht.suchevormunterricht:FOR jFROM 1UPTO +anzREP zeitstd:=incr+j;IF (planSUB zeitstd)=kennungvormTHEN IF unterricht( +objekt,incr+j)THEN anzvormINCR 1;anztageINCR 1;tagnichtgezaehlt:=FALSE ; +LEAVE suchevormunterrichtFI ;ELIF (planSUB zeitstd)=kennungnachmTHEN LEAVE +suchevormunterrichtFI ;PER .suchenachmunterricht:FOR jFROM anzDOWNTO 1REP +zeitstd:=incr+j;IF (planSUB zeitstd)=kennungnachmTHEN IF unterricht(objekt, +incr+j)THEN anznachmINCR 1;IF tagnichtgezaehltTHEN anztageINCR 1;LEAVE +suchenachmunterrichtFI ;FI ;ELIF (planSUB zeitstd)=kennungvormTHEN LEAVE +suchenachmunterrichtFI ;PER .END PROC ermittleunbestwdaten;PROC +zaehlebestwunsch(INT CONST rowindex,TEXT CONST wunsch,BOOL CONST erfuellt): +INT VAR gew;IF wunsch="-3"THEN gew:=1ELIF wunsch="-2"THEN gew:=2ELIF wunsch= +"-1"THEN gew:=3ELIF wunsch="+1"THEN gew:=4ELIF wunsch="+2"THEN gew:=5ELIF +wunsch="+3"THEN gew:=6FI ;IF erfuelltTHEN anzwuenschegesamt(rowindex)(gew) +INCR 1ELSE anznerfwuensche(rowindex)(gew)INCR 1FI END PROC zaehlebestwunsch; +PROC zaehleunbestwunsch(INT CONST rowindex,wanz,wnerf,TEXT CONST wunsch):INT +VAR gewicht;SELECT int(wunsch)OF CASE 3:gewicht:=1CASE 2:gewicht:=2OTHERWISE +gewicht:=3END SELECT ;anzwuenschegesamt(rowindex)(gewicht)INCR wanz;IF wnerf +<>0THEN anznerfwuensche(rowindex)(gewicht)INCR wnerfFI END PROC +zaehleunbestwunsch;BOOL PROC unterricht(TEXT CONST objekt,INT CONST zeit): +TEXT VAR lv,ra,par,daten;INT VAR spos,findpos;IF fall=fldsugrupCOR fall= +fldlehrerCOR fall=fldraeumeTHEN objektunterrichtELSE objektindatenderzeitFI . +objektunterricht:planeintraglesen(zeit,kenn,objekt,lv,ra,par);lv<>"". +objektindatenderzeit:IF fall=fldfaecherTHEN daten:=datenderzeit(zeit,kennzlv) +;findpos:=3ELSE daten:=datenderzeit(zeit,kenn);findpos:=1FI ;IF daten=""THEN +FALSE ELSE suchindatenFI .suchindaten:spos:=1;WHILE spos<>0REP spos:=pos( +daten,objekt,spos);IF spos<>0THEN IF (sposMOD 8)=findposTHEN LEAVE unterricht +WITH TRUE FI ;sposINCR 1FI ;PER ;FALSE .END PROC unterricht;PROC +zeitrasterdaten(BOOL VAR b):IF wert(fnrzrsj)<>schjCOR wert(fnrzrhj)<>schhj +COR dbstatus<>0THEN b:=TRUE ELSE planCAT wert(fnrzrkennungteil);FI END PROC +zeitrasterdaten;PROC faecher(BOOL VAR b):faecherkatalogCAT wert(fnrffach)+ +trennerEND PROC faecher;PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN +standardmeldung(meldungserverfehler,"");ELIF fstat=3THEN standardmeldung( +meldungkeinstdplan,"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen +,"");ELIF fstat=5THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6 +THEN standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung( +meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,""); +FI END PROC meldungausgeben;END PACKET einhaltungzeitwuenschepruefen + diff --git a/app/schulis/2.2.1/src/4.einzelstdpl.lehrer b/app/schulis/2.2.1/src/4.einzelstdpl.lehrer new file mode 100644 index 0000000..39067e3 --- /dev/null +++ b/app/schulis/2.2.1/src/4.einzelstdpl.lehrer @@ -0,0 +1,113 @@ +PACKET einzelstdpllehrerDEFINES einzelstdpllehrereingang, +einzelstdpllehrerstarten,einzelstdpllehrersonderwerte, +einzelstdpllehrermultistop,einzelstdpllehrerdruckdateibauen:LET swanrede=511, +swlehrername=512,swschuljahr=514,swhalbjahr=515,swtagesstunde=520, +swklassenleitungen=540,swstellvleitungen=541,swaufsichtszeit=542, +swaufsichtsort=543,dateimitvordruck1="vordruck1 einzelstdpl lehrer", +dateimitvordruck2="vordruck2 einzelstdpl raeume",dateimitvordruck3= +"vordruck2 einzelstdpl lehrer",dateimitvordruck4= +"vordruck3 einzelstdpl lehrer";TASK VAR vordruckserver;LET +maxzeichenimvordruck=79;TEXT VAR hj,sj,paraphe:="",anrede,klassenleitung:="", +stellvleitung:="",l:="",r:="",p:="",geplantezeiten;LET maske= +"ms einzelstdpl lehrer eingang",fnr2paraphe=2,fnr3akthj=3,fnr4ausgabebs=4, +fnr5ausgabedr=5,blank=" ",null=0,niltext="", +meldnrkeinestundenplandatenvorhanden=366,meldnrungueltigeparaphe=344, +meldnrkeinelehrerdaten=337,meldnrauswahlunsinnig=56,meldnrbittewarten=69;INT +CONST swzweitezeile:=6,erstestd:=1,letztestd:=12,maxwochstdn:=66,maxwochtage +:=6;BOOL VAR anschreibenaufbszeigen:=TRUE ,einzelanschreiben:=TRUE , +aktuelleshjgewaehlt:=TRUE ;INT VAR eingabestatus,x,meldnr;PROC +einzelstdpllehrereingang:standardvproc(maske)END PROC +einzelstdpllehrereingang;PROC einzelstdpllehrerstarten:vordruckserver:=/ +"anschreiben server";IF maskenwerteokTHEN IF stundenplanokTHEN +startenausfuehrenELSE meldnr:=meldnrkeinestundenplandatenvorhanden; +meldedenfehler;zurueckzumdialog;FI ;ELSE meldedenfehler;zurueckzumdialogFI ;. +meldedenfehler:standardmeldung(meldnr,niltext).zurueckzumdialog:return(1). +startenausfuehren:forget(dateimitvordruck1,quiet);forget(dateimitvordruck2, +quiet);forget(dateimitvordruck3,quiet);forget(dateimitvordruck4,quiet);fetch( +dateimitvordruck1,vordruckserver);fetch(dateimitvordruck2,vordruckserver); +fetch(dateimitvordruck3,vordruckserver);fetch(dateimitvordruck4, +vordruckserver);inittupel(dnrlehrer);putwert(fnrlparaphe,paraphe); +standardmeldung(meldnrbittewarten,niltext);zusammengesetztesanschreiben( +dnrlehrer,anschreibenaufbszeigen,einzelanschreiben,BOOL PROC +einzelstdpllehrersonderwerte,BOOL PROC einzelstdpllehrermultistop,TEXT PROC +einzelstdpllehrerdruckdateibauen);END PROC einzelstdpllehrerstarten;BOOL +PROC stundenplanok:sj:=schulkenndatum("Schuljahr");hj:=schulkenndatum( +"Schulhalbjahr");IF NOT (aktuelleshjgewaehlt)THEN geplanteshjundsjberechnen( +hj,sj)FI ;stundenplanhalbjahrsetzen(hj,sj); +stundenplanbasisundstundenplanholen(eingabestatus);eingabestatus=0OR +eingabestatus=8END PROC stundenplanok;BOOL PROC maskenwerteok:BOOL VAR ok:= +FALSE ;standardpruefe(5,fnr4ausgabebs,fnr5ausgabedr,null,niltext, +eingabestatus);IF eingabestatus<>0THEN meldnr:=meldnrauswahlunsinnig;infeld( +fnr4ausgabebs);ok:=FALSE ELSE anschreibenaufbszeigen:=standardmaskenfeld( +fnr5ausgabedr)=niltext;einzelanschreiben:=standardmaskenfeld(fnr2paraphe)<> +niltext;aktuelleshjgewaehlt:=standardmaskenfeld(fnr3akthj)<>niltext;IF +einzelanschreibenTHEN IF gueltigeparapheTHEN paraphe:=wert(fnrlparaphe);ok:= +TRUE ELSE meldnr:=meldnrungueltigeparaphe;infeld(fnr2paraphe);ok:=FALSE FI ; +ELSE IF dateilehrerleerTHEN meldnr:=meldnrkeinelehrerdaten;infeld(fnr3akthj); +ok:=FALSE ELSE ok:=TRUE FI ;FI ;FI ;okEND PROC maskenwerteok;BOOL PROC +gueltigeparaphe:inittupel(dnrlehrer);putwert(fnrlparaphe,standardmaskenfeld( +fnr2paraphe));search(dnrlehrer,TRUE );dbstatus=0END PROC gueltigeparaphe; +BOOL PROC dateilehrerleer:inittupel(dnrlehrer);search(dnrlehrer);dbstatus<>0 +END PROC dateilehrerleer;BOOL PROC einzelstdpllehrersonderwerte:INT VAR +gemerkterdbstatus;paraphe:=wert(fnrlparaphe);initialisieresonderwerte;IF wert +(fnrlgeschlecht)="m"THEN anrede:="Herrn"ELSE anrede:="Frau"FI ;adressat(wert( +fnrlfamname));setzesonderwert(swschuljahr,subtext(sj,1,2)+"/"+subtext(sj,3,4) +);setzesonderwert(swhalbjahr,hj);setzesonderwert(swanrede,anrede); +setzesonderwert(swlehrername,wert(fnrlfamname));gemerkterdbstatus:=dbstatus; +inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,sj);putwert(fnrsgrphj,hj); +search(dnraktschuelergruppen);klassenleitung:=niltext;stellvleitung:=niltext; +WHILE (dbstatus=0AND wert(fnrsgrphj)=hj)REP IF wert(fnrsgrplehrer)=wert( +fnrlparaphe)THEN klassenleitungCAT (wert(fnrsgrpjgst)+wert(fnrsgrpkennung)+ +blank)FI ;IF wert(fnrsgrpstellvlehrer)=wert(fnrlparaphe)THEN stellvleitung +CAT (wert(fnrsgrpjgst)+wert(fnrsgrpkennung)+blank)FI ;succ( +dnraktschuelergruppen);PER ;setzesonderwert(swklassenleitungen,klassenleitung +);setzesonderwert(swstellvleitungen,stellvleitung);dbstatus(gemerkterdbstatus +);TRUE END PROC einzelstdpllehrersonderwerte;BOOL PROC +einzelstdpllehrermultistop:BOOL VAR b;IF einzelanschreibenTHEN b:=wert( +fnrlparaphe)=parapheELSE b:=dbstatus=0FI ;bENDPROC einzelstdpllehrermultistop +;TEXT PROC einzelstdpllehrerdruckdateibauen:INT VAR dbstatusintern;LET +stddruckdatei="liste.1",hilfsdatei="hilfsdatei";FILE VAR f;TEXT VAR zeile:="" +,druckdatei:="Lehrer-Einzelplan";TEXT CONST teil1:="---+",teil2:= +"-----------+",teil3:="-----------: ",teil4:="-------------------", +normaletrennlinie:=teil1+5*teil2+teil3,abschlusslinie:=4*teil4+blank; +setzemitseitennummern(TRUE );druckvorbereiten;setzeanzahlderzeichenprozeile( +maxzeichenimvordruck);briefalternative(dateimitvordruck1,hilfsdatei); +zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet); +geplantezeiten:=allezeitenvon("P",paraphe);FOR xFROM erstestdUPTO letztestd +REP datendeszweitenvordrucksindruckdateiPER ;briefalternative( +dateimitvordruck3,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei); +forget(hilfsdatei,quiet);inittupel(dnraufsichtsplan);putwert(fnrapsj,sj); +putwert(fnraphj,hj);putwert(fnrapparaphe,paraphe);search(ixappar,TRUE ); +WHILE dbstatus=0AND wert(fnrapsj)=sjAND wert(fnraphj)=hjAND wert(fnrapparaphe +)=parapheREP setzesonderwert(swaufsichtsort,wert(fnrapaufsichtsort)); +dbstatusintern:=dbstatus;inittupel(dnraufsichtszeiten);putwert(fnrazsj,sj); +putwert(fnrazhj,hj);putwert(fnrapaufsichtszeit,wert(fnrapaufsichtszeit)); +search(dnraufsichtszeiten,TRUE );IF dbstatus=0THEN setzesonderwert( +swaufsichtszeit,wert(fnrazbezeichnung))ELSE setzesonderwert(swaufsichtszeit, +blank)FI ;briefalternative(dateimitvordruck4,hilfsdatei); +zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet); +dbstatus(dbstatusintern);succ(ixappar);PER ;drucknachbereitenohneausdrucken; +rename(stddruckdatei,druckdatei);f:=sequentialfile(modify,druckdatei);toline( +f,1);input(f);druckdatei.datendeszweitenvordrucksindruckdatei:setzesonderwert +(swtagesstunde,text(x,2)); +planeintraegeprowochenstdenlesenundsonderwertesetzen(x);briefalternative( +dateimitvordruck2,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei); +IF x<>letztestdTHEN zeile:=normaletrennlinieELSE zeile:=abschlusslinieFI ; +druckzeileschreiben(zeile);forget(hilfsdatei,quiet);END PROC +einzelstdpllehrerdruckdateibauen;PROC zeilenweisehilfsdateiindruckdatei(TEXT +CONST hilfsdatei):INT VAR i;TEXT VAR zeile:="";FILE VAR f;f:=sequentialfile( +input,hilfsdatei);FOR iFROM 1UPTO lines(f)REP getline(f,zeile); +druckzeileschreiben(zeile)PER ;END PROC zeilenweisehilfsdateiindruckdatei; +PROC planeintraegeprowochenstdenlesenundsonderwertesetzen(INT CONST std):INT +VAR i,wochenstd:=std,sonderwert:=521;TEXT VAR ausgabe;FOR iFROM 1UPTO +maxwochtageREP IF (geplantezeitenSUB wochenstd)="1"THEN planeintraglesen( +wochenstd,"P",paraphe,l,r,p);IF wochenstd<=maxwochstdnTHEN ausgabe:=subtext(l +,1,2);ausgabeCAT blank;ausgabeCAT subtext(l,3,4);ausgabeCAT blank;ausgabeCAT +subtext(l,5,8);setzesonderwert(sonderwert,ausgabe);setzesonderwert(sonderwert ++swzweitezeile,r);ELSE setzesonderwert(sonderwert,blank);setzesonderwert( +sonderwert+swzweitezeile,blank);FI ;ELSE setzesonderwert(sonderwert,blank); +setzesonderwert(sonderwert+swzweitezeile,blank);FI ;ausgabe:=niltext; +sonderwertINCR 1;wochenstdINCR letztestd;PER ;END PROC +planeintraegeprowochenstdenlesenundsonderwertesetzen;END PACKET +einzelstdpllehrer + diff --git a/app/schulis/2.2.1/src/4.einzelstdpl.raeume b/app/schulis/2.2.1/src/4.einzelstdpl.raeume new file mode 100644 index 0000000..aeb0db5 --- /dev/null +++ b/app/schulis/2.2.1/src/4.einzelstdpl.raeume @@ -0,0 +1,86 @@ +PACKET einzelstdplraeumeDEFINES einzelstdplraeumeeingang, +einzelstdplraeumestarten,einzelstdplraeumesonderwerte, +einzelstdplraeumemultistop,einzelstdplraeumedruckdateibauen:LET maske= +"ms einzelstdpl raeume eingang",fnr2raum=2,fnr3akthj=3,fnr4ausgabebs=4, +fnr5ausgabedr=5,blank=" ",null=0,niltext="", +fehlermeldnrkeinestundenplandatenvorhanden=366,fehlermeldnrungueltigerraum= +359,fehlermeldnrauswahlunsinnig=56,fehlermeldnrbestandraeumeleer=365, +meldnrbittewarten=69,swraum=511,swschuljahr=512,swhalbjahr=513,swraumlangtext +=514,swtagesstunde=520,maxzeichenimvordruck=79;TASK VAR vordruckserver;TEXT +CONST dateimitvordruck1:="vordruck1 einzelstdpl raeume",dateimitvordruck2:= +"vordruck2 einzelstdpl raeume",bestandnameraeume:="c02 raeume",strich:="-", +kreuz:="+",abschlusslinie:=76*strich+blank,normaletrennlinie:=3*strich+kreuz+ +5*(11*strich+kreuz)+11*strich+": ";TEXT VAR hj,sj,raum:="",l:="",r:="",p:=""; +BOOL VAR anschreibenaufbszeigen:=TRUE ,einzelanschreiben:=TRUE , +aktuelleshjgewaehlt:=TRUE ;INT VAR eingabestatus,i,x,fehlermeldnr;INT CONST +aktuellerindex:=dnrschluessel,maxwochstdn:=66,erstestd:=1,letztestd:=12;PROC +einzelstdplraeumeeingang:standardvproc(maske)END PROC +einzelstdplraeumeeingang;PROC einzelstdplraeumestarten:IF maskenwerteokTHEN +IF stundenplanokTHEN startenausfuehrenELSE fehlermeldnr:= +fehlermeldnrkeinestundenplandatenvorhanden;meldedenfehler;zurueckzumdialog; +FI ;ELSE meldedenfehler;zurueckzumdialogFI ;.meldedenfehler:standardmeldung( +fehlermeldnr,niltext).zurueckzumdialog:return(1).startenausfuehren: +vordruckserver:=/"anschreiben server";forget(dateimitvordruck1,quiet);forget( +dateimitvordruck2,quiet);fetch(dateimitvordruck1,vordruckserver);fetch( +dateimitvordruck2,vordruckserver);inittupel(dnrschluessel);putwert( +fnrschlsachgebiet,bestandnameraeume);putwert(fnrschlschluessel,raum); +standardmeldung(meldnrbittewarten,niltext);zusammengesetztesanschreiben( +aktuellerindex,anschreibenaufbszeigen,einzelanschreiben,BOOL PROC +einzelstdplraeumesonderwerte,BOOL PROC einzelstdplraeumemultistop,TEXT PROC +einzelstdplraeumedruckdateibauen);END PROC einzelstdplraeumestarten;BOOL +PROC stundenplanok:stundenplanhalbjahrsetzen(hj,sj); +stundenplanbasisundstundenplanholen(eingabestatus);eingabestatus=0OR +eingabestatus=8END PROC stundenplanok;BOOL PROC maskenwerteok:BOOL VAR ok; +standardpruefe(5,fnr4ausgabebs,fnr5ausgabedr,null,niltext,eingabestatus);IF +eingabestatus<>0THEN fehlermeldnr:=fehlermeldnrauswahlunsinnig;infeld( +fnr4ausgabebs);ok:=FALSE ELSE anschreibenaufbszeigen:=standardmaskenfeld( +fnr5ausgabedr)=niltext;einzelanschreiben:=standardmaskenfeld(fnr2raum)<> +niltext;aktuelleshjgewaehlt:=standardmaskenfeld(fnr3akthj)<>niltext;sj:= +schulkenndatum("Schuljahr");hj:=schulkenndatum("Schulhalbjahr");IF NOT ( +aktuelleshjgewaehlt)THEN geplanteshjundsjberechnen(hj,sj)FI ;IF +einzelanschreibenTHEN IF gueltigerraumTHEN ok:=TRUE ELSE fehlermeldnr:= +fehlermeldnrungueltigerraum;ok:=FALSE FI ;ELSE IF schluesselbestandleerTHEN +fehlermeldnr:=fehlermeldnrbestandraeumeleer;infeld(fnr2raum);ok:=FALSE ELSE +raum:=wert(fnrschlschluessel);ok:=TRUE FI ;FI ;FI ;okEND PROC maskenwerteok; +BOOL PROC gueltigerraum:raum:=standardmaskenfeld(fnr2raum);inittupel( +dnrschluessel);putwert(fnrschlsachgebiet,bestandnameraeume);putwert( +fnrschlschluessel,raum);search(dnrschluessel,TRUE );dbstatus=0END PROC +gueltigerraum;BOOL PROC schluesselbestandleer:inittupel(dnrschluessel); +putwert(fnrschlsachgebiet,bestandnameraeume);search(dnrschluessel);raum:=wert +(fnrschlschluessel);dbstatus<>0COR wert(fnrschlsachgebiet)<>bestandnameraeume +END PROC schluesselbestandleer;BOOL PROC einzelstdplraeumesonderwerte: +initialisieresonderwerte;adressat(raum);setzesonderwert(swschuljahr,subtext( +sj,1,2)+"/"+subtext(sj,3,4));setzesonderwert(swhalbjahr,hj);setzesonderwert( +swraum,wert(fnrschlschluessel));setzesonderwert(swraumlangtext,wert( +fnrschllangtext));TRUE END PROC einzelstdplraeumesonderwerte;BOOL PROC +einzelstdplraeumemultistop:BOOL VAR b;IF einzelanschreibenTHEN b:=wert( +fnrschlschluessel)=raumELSE b:=wert(fnrschlsachgebiet)=bestandnameraeumeFI ;b +ENDPROC einzelstdplraeumemultistop;TEXT PROC einzelstdplraeumedruckdateibauen +:LET stddruckdatei="liste.1",hilfsdatei="hilfsdatei";FILE VAR f;TEXT VAR +zeile:="",druckdatei:="Raumplan";forget(druckdatei,quiet);druckvorbereiten; +setzeanzahlderzeichenprozeile(maxzeichenimvordruck);raum:=wert( +fnrschlschluessel);datendeserstenvordrucksindruckdatei;FOR xFROM erstestd +UPTO letztestdREP datendeszweitenvordrucksindruckdateiPER ;rename( +stddruckdatei,druckdatei);f:=sequentialfile(modify,druckdatei);toline(f,1); +input(f);druckdatei.datendeserstenvordrucksindruckdatei:briefalternative( +dateimitvordruck1,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei); +forget(hilfsdatei,quiet);.datendeszweitenvordrucksindruckdatei: +setzesonderwert(swtagesstunde,text(x,2)); +planeintraegeprowochenstdenlesenundsonderwertesetzen(x);briefalternative( +dateimitvordruck2,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei); +IF x<>letztestdTHEN zeile:=normaletrennlinieELSE zeile:=abschlusslinieFI ; +druckzeileschreiben(zeile);forget(hilfsdatei,quiet);END PROC +einzelstdplraeumedruckdateibauen;PROC zeilenweisehilfsdateiindruckdatei(TEXT +CONST hilfsdatei):TEXT VAR zeile:=niltext;FILE VAR f;f:=sequentialfile(input, +hilfsdatei);FOR iFROM 1UPTO lines(f)REP getline(f,zeile);druckzeileschreiben( +zeile)PER ;END PROC zeilenweisehilfsdateiindruckdatei;PROC +planeintraegeprowochenstdenlesenundsonderwertesetzen(INT CONST std):INT VAR +wochenstd:=std,sonderwert:=521;TEXT VAR ausgabe;WHILE wochenstd<=maxwochstdn +REP planeintraglesen(wochenstd,"R",raum,l,r,p);IF r<>""THEN ausgabe:=subtext( +l,1,2);ausgabeCAT blank;ausgabeCAT subtext(l,3,4);ausgabeCAT blank;ausgabe +CAT subtext(l,5,8);setzesonderwert(sonderwert,ausgabe);setzesonderwert( +sonderwert+6,p);ELSE setzesonderwert(sonderwert,blank);setzesonderwert( +sonderwert+6,blank);FI ;ausgabe:=niltext;sonderwertINCR 1;wochenstdINCR 12; +PER ;END PROC planeintraegeprowochenstdenlesenundsonderwertesetzen;END +PACKET einzelstdplraeume; + diff --git a/app/schulis/2.2.1/src/4.einzelstdpl.sek1 b/app/schulis/2.2.1/src/4.einzelstdpl.sek1 new file mode 100644 index 0000000..1f72cd0 --- /dev/null +++ b/app/schulis/2.2.1/src/4.einzelstdpl.sek1 @@ -0,0 +1,233 @@ +PACKET einzelstdplsek1DEFINES einzelstdplsek1eingang,einzelstdplsek1starten, +einzelstdplsek1sonderwerte,einzelstdplsek1multistop, +einzelstdplsek1druckdateibauen:LET laengelv=8,geplantestd="1", +maxlvgnproschuelergr=100,maxwochstdn=66,swschuelergruppe=511,swschuljahr=512, +swhalbjahr=513,swklassenleiter=514,swstellvertreter=516,swtagesstunde=520, +sw4fach=518,sw4kopplung=519,sw4fachlangtext=520,sw4erllehrer=521,sw6kopplung= +530,sw7lv=540,maske="ms einzelstdpl sek1 eingang",fnr2jgst=2,fnr3kennung=3, +fnr4ohneerlaeuterung=4,fnr5akthj=5,fnr6ausgabebs=6,fnr7ausgabedr=7,blank=" ", +vierblanks=" ",null=0,niltext="",meldnrauswahlunsinnig=56, +meldnrbittewarten=69,meldnrkeinestundenplandatenvorhanden=366, +meldnrkeineentsprechendenschuelerda=127,meldnrungueltigeklassengr=320, +meldnrungueltigejgst=146,maxzeichenimvordruck=79;TASK VAR vordruckserver; +TEXT CONST dateimitvordruck1:="vordruck1 einzelstdpl sek1",dateimitvordruck2 +:="vordruck2 einzelstdpl sek1",dateimitvordruck3:= +"vordruck3 einzelstdpl sek1",dateimitvordruck4:="vordruck4 einzelstdpl sek1", +dateimitvordruck5:="vordruck5 einzelstdpl sek1",dateimitvordruck6:= +"vordruck6 einzelstdpl sek1",dateimitvordruck7:="vordruck7 einzelstdpl sek1", +strich:="-",kreuz:="+",abschlusslinie:=76*strich+blank,normaletrennlinie:=3* +strich+kreuz+5*(11*strich+kreuz)+11*strich+": ";TEXT VAR kopplg:="",hj,sj, +sjaufber,jgst:="",kennung:="",stdplanrede,uebfolgeseiten,l:="",r:="",p:="", +lvgnproschuelgr,lv,paraphezurlv,string,schuelergr,kopplungsbez,hilfstext, +lehrer:="";BOUND ROW maxlvgnproschuelergrTEXT VAR zeitenzulv;BOUND ROW +maxwochstdnTEXT VAR kopplungen;BOOL VAR gesamtesek1:=FALSE ,bestjgst:=FALSE , +bestschuelergruppe:=FALSE ,korrektewahl:=FALSE ,anschreibenaufbszeigen:=TRUE +,miterlaeuterung:=TRUE ,einzelanschreiben:=TRUE ,aktuelleshjgewaehlt:=TRUE ; +INT VAR anzzeilen,eingabestatus,i,x,y,z:=0,anzlvgnprokopplg, +anzlvgnproschuelergr,meldnr;INT CONST aktuellerindex:=dnraktschuelergruppen, +erstestd:=1,letztestd:=12,sek1max:=10,sek1min:=5,maxwochtage:=6;PROC +einzelstdplsek1eingang:standardvproc(maske)END PROC einzelstdplsek1eingang; +PROC einzelstdplsek1starten:IF maskenwerteokTHEN IF stundenplanokTHEN +startenausfuehrenELSE meldnr:=meldnrkeinestundenplandatenvorhanden; +meldedenfehler;zurueckzumdialog;FI ;ELSE meldedenfehler;zurueckzumdialogFI ;. +meldedenfehler:standardmeldung(meldnr,niltext).zurueckzumdialog:return(1). +startenausfuehren:vordruckserver:=/"anschreiben server";forget( +dateimitvordruck1,quiet);forget(dateimitvordruck2,quiet);fetch( +dateimitvordruck1,vordruckserver);fetch(dateimitvordruck2,vordruckserver); +forget("datenraum1",quiet);forget("datenraum2",quiet);IF miterlaeuterungTHEN +forget(dateimitvordruck3,quiet);forget(dateimitvordruck4,quiet);forget( +dateimitvordruck5,quiet);forget(dateimitvordruck6,quiet);forget( +dateimitvordruck7,quiet);fetch(dateimitvordruck3,vordruckserver);fetch( +dateimitvordruck4,vordruckserver);fetch(dateimitvordruck5,vordruckserver); +fetch(dateimitvordruck6,vordruckserver);fetch(dateimitvordruck7, +vordruckserver);FI ;setzesonderwerteschulkenndaten;standardmeldung( +meldnrbittewarten,niltext);zusammengesetztesanschreiben(aktuellerindex, +anschreibenaufbszeigen,einzelanschreiben,BOOL PROC einzelstdplsek1sonderwerte +,BOOL PROC einzelstdplsek1multistop,TEXT PROC einzelstdplsek1druckdateibauen) +;END PROC einzelstdplsek1starten;BOOL PROC maskenwerteok:BOOL VAR ok:=FALSE ; +standardpruefe(5,fnr6ausgabebs,fnr7ausgabedr,null,niltext,eingabestatus);IF +eingabestatus<>0THEN meldnr:=meldnrauswahlunsinnig;infeld(fnr6ausgabebs); +ELSE sortierungsetzen;aktuelleshjgewaehlt:=standardmaskenfeld(fnr5akthj)<> +niltext;sj:=schulkenndatum("Schuljahr");hj:=schulkenndatum("Schulhalbjahr"); +IF NOT (aktuelleshjgewaehlt)THEN geplanteshjundsjberechnen(hj,sj)FI ;sjaufber +:=subtext(sj,1,2)+"/"+subtext(sj,3,4);anschreibenaufbszeigen:= +standardmaskenfeld(fnr7ausgabedr)=niltext;miterlaeuterung:=standardmaskenfeld +(fnr4ohneerlaeuterung)=niltext;korrektewahl:=FALSE ;inittupel( +dnraktschuelergruppen);putwert(fnrsgrpsj,sj);putwert(fnrsgrphj,hj);IF +gesamtesek1THEN IF gueltigesek1THEN einzelanschreiben:=FALSE ;ok:=TRUE ELSE +meldnr:=meldnrkeineentsprechendenschuelerda;infeld(fnr2jgst)FI ;ELIF bestjgst +THEN IF gueltigejgstTHEN einzelanschreiben:=FALSE ;ok:=TRUE ELSE meldnr:= +meldnrungueltigejgst;infeld(fnr2jgst)FI ;ELIF bestschuelergruppeTHEN IF +gueltigeschuelergrTHEN einzelanschreiben:=TRUE ;ok:=TRUE ELSE meldnr:= +meldnrungueltigeklassengr;infeld(fnr2jgst)FI ;ELSE meldnr:= +meldnrauswahlunsinnig;infeld(fnr2jgst);FI ;FI ;ok.sortierungsetzen:IF ( +standardmaskenfeld(fnr2jgst)=niltextAND standardmaskenfeld(fnr3kennung)= +niltext)THEN gesamtesek1:=TRUE ;ELSE IF (standardmaskenfeld(fnr2jgst)<> +niltextAND standardmaskenfeld(fnr3kennung)<>niltext)THEN bestschuelergruppe:= +TRUE ELSE IF standardmaskenfeld(fnr3kennung)=niltextTHEN bestjgst:=TRUE FI ; +FI ;FI END PROC maskenwerteok;BOOL PROC stundenplanok: +stundenplanhalbjahrsetzen(hj,sj);stundenplanbasisundstundenplanholen( +eingabestatus);eingabestatus=0OR eingabestatus=8END PROC stundenplanok;BOOL +PROC gueltigesek1:search(dnraktschuelergruppen);IF (sek1min<=int(wert( +fnrsgrpjgst))AND sek1max>=int(wert(fnrsgrpjgst))AND dbstatus=0)THEN IF length +(wert(fnrsgrpjgst))=1THEN jgst:="0"+wert(fnrsgrpjgst);ELSE jgst:=wert( +fnrsgrpjgst)FI ;kennung:=wert(fnrsgrpkennung);korrektewahl:=TRUE FI ; +korrektewahlEND PROC gueltigesek1;BOOL PROC gueltigejgst:IF length( +standardmaskenfeld(fnr2jgst))=1THEN jgst:="0"+standardmaskenfeld(fnr2jgst) +ELSE jgst:=standardmaskenfeld(fnr2jgst)FI ;IF int(jgst)<=sek1maxAND int(jgst) +>=sek1minTHEN putwert(fnrsgrpjgst,jgst);search(dnraktschuelergruppen);IF +dbstatus=0THEN kennung:=wert(fnrsgrpkennung);korrektewahl:=TRUE FI ;FI ; +korrektewahlEND PROC gueltigejgst;BOOL PROC gueltigeschuelergr:IF length( +standardmaskenfeld(fnr2jgst))=1THEN jgst:="0"+standardmaskenfeld(fnr2jgst) +ELSE jgst:=standardmaskenfeld(fnr2jgst)FI ;kennung:=standardmaskenfeld( +fnr3kennung);IF int(jgst)<=sek1maxAND int(jgst)>=sek1minTHEN putwert( +fnrsgrpjgst,jgst);putwert(fnrsgrpkennung,kennung);search( +dnraktschuelergruppen,TRUE );IF dbstatus=0THEN korrektewahl:=TRUE FI ;FI ; +korrektewahlEND PROC gueltigeschuelergr;BOOL PROC einzelstdplsek1multistop: +BOOL VAR b;IF bestschuelergruppeTHEN b:=intwert(fnrsgrpsj)=int(sj)AND intwert +(fnrsgrphj)=int(hj)AND intwert(fnrsgrpjgst)=int(jgst)AND wert(fnrsgrpkennung) +=kennungAND dbstatus=okELIF bestjgstTHEN b:=intwert(fnrsgrpsj)=int(sj)AND +intwert(fnrsgrphj)=int(hj)AND intwert(fnrsgrpjgst)=int(jgst)AND dbstatus=ok +ELSE b:=intwert(fnrsgrpsj)=int(sj)AND intwert(fnrsgrphj)=int(hj)AND intwert( +fnrsgrpjgst)<=sek1maxAND intwert(fnrsgrpjgst)>=sek1minAND dbstatus=okFI ;b +ENDPROC einzelstdplsek1multistop;BOOL PROC einzelstdplsek1sonderwerte:INT +VAR gemerkterdbstatus;initialisieresonderwerte;setzesonderwert(swschuljahr, +sjaufber);setzesonderwert(swhalbjahr,hj);IF length(wert(fnrsgrpjgst))=1THEN +jgst:="0"+wert(fnrsgrpjgst);ELSE jgst:=wert(fnrsgrpjgst)FI ;kennung:=wert( +fnrsgrpkennung);schuelergr:=jgst+kennung;setzesonderwert(swschuelergruppe, +jgst+kennung);adressat(schuelergr);gemerkterdbstatus:=dbstatus;inittupel( +dnrlehrer);putwert(fnrlparaphe,wert(fnrsgrplehrer));search(dnrlehrer,TRUE ); +IF dbstatus=0THEN IF wert(fnrlgeschlecht)="m"THEN lehrer:="Hr. "ELSE lehrer:= +"Fr. "FI ;hilfstext:=wert(fnrlamtsbeztitel);IF hilfstext<>niltextTHEN lehrer +CAT hilfstext;lehrerCAT blank;FI ;hilfstext:=wert(fnrlzusatz);IF hilfstext<> +niltextTHEN lehrerCAT hilfstext;lehrerCAT blank;FI ;lehrerCAT wert( +fnrlfamname);setzesonderwert(swklassenleiter,lehrer);FI ;inittupel(dnrlehrer) +;putwert(fnrlparaphe,wert(fnrsgrpstellvlehrer));search(dnrlehrer,TRUE );IF +dbstatus=0THEN IF wert(fnrlgeschlecht)="m"THEN lehrer:="Hr. "ELSE lehrer:= +"Fr. "FI ;hilfstext:=wert(fnrlamtsbeztitel);IF hilfstext<>niltextTHEN lehrer +CAT hilfstext;lehrerCAT blank;FI ;hilfstext:=wert(fnrlzusatz);IF hilfstext<> +niltextTHEN lehrerCAT hilfstext;lehrerCAT blank;FI ;lehrerCAT wert( +fnrlfamname);setzesonderwert(swstellvertreter,lehrer);FI ;dbstatus( +gemerkterdbstatus);TRUE END PROC einzelstdplsek1sonderwerte;TEXT PROC +einzelstdplsek1druckdateibauen:LET stddruckdatei="liste.1",druckdatei= +"Stundenplan",hilfsdatei="hilfsdatei";FILE VAR f;IF miterlaeuterungTHEN +kopplungsmerkrowinitialisieren;setzemitseitennummern(TRUE )FI ;forget( +druckdatei,quiet);druckvorbereiten;setzeanzahlderzeichenprozeile( +maxzeichenimvordruck);uebfolgeseiten:="Stundenplan für Klasse "+schuelergr+ +"(Schuljahr "+sjaufber+", "+hj+". Halbjahr)";anzzeilen:=1;briefalternative( +dateimitvordruck1,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei); +forget(hilfsdatei,quiet);proschuelergruppeallelvgnmitzeitenind2ablegen;FOR x +FROM erstestdUPTO letztestdREP +datendeszweitenvordrucksindruckdateiundggfkopplgmerken(x)PER ;IF +miterlaeuterungTHEN briefalternative(dateimitvordruck3,hilfsdatei); +zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);FOR x +FROM 1UPTO anzlvgnproschuelergrREP datendesviertenvordrucksindruckdatei;PER ; +IF anzzeilen+8>=drucklaengeTHEN seitenwechsel;druckzeileschreiben( +uebfolgeseiten);druckzeileschreiben(blank);anzzeilen:=3FI ;briefalternative( +dateimitvordruck5,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei); +forget(hilfsdatei,quiet);FOR xFROM 1UPTO maxwochstdnREP +datendessechstenundsiebtenvordrucksindruckdatei(x);PER ;FI ; +drucknachbereitenohneausdrucken;rename(stddruckdatei,druckdatei);f:= +sequentialfile(modify,druckdatei);toline(f,1);input(f);druckdatei. +kopplungsmerkrowinitialisieren:forget("datenraum1",quiet);kopplungen:=new( +"datenraum1");FOR xFROM 1UPTO maxwochstdnREP kopplungen(x):=niltext;PER . +proschuelergruppeallelvgnmitzeitenind2ablegen:lvgnproschuelgr:= +lvderschuelergruppe(schuelergr);anzlvgnproschuelergr:=(length(lvgnproschuelgr +))DIV laengelv;forget("datenraum2",quiet);zeitenzulv:=new("datenraum2");INT +VAR position:=0;FOR xFROM 1UPTO anzlvgnproschuelergrREP lv:=subtext( +lvgnproschuelgr,position+1,position+laengelv);string:=allezeitenvon("L",lv); +stringCAT lv;zeitenzulv(x):=string;positionINCR laengelv;PER ;FOR xFROM +anzlvgnproschuelergr+1UPTO maxlvgnproschuelergrREP zeitenzulv(x):=niltext; +PER ;.datendesviertenvordrucksindruckdatei:TEXT VAR fach:=subtext(zeitenzulv( +x),maxwochstdn+3,maxwochstdn+4);fachCAT blank;setzesonderwert(sw4fach,fach); +IF length(zeitenzulv(x))>maxwochstdn+laengelvTHEN kopplg:=subtext(zeitenzulv( +x),maxwochstdn+laengelv+1,maxwochstdn+2*laengelv);setzesonderwert(sw4kopplung +,"("+kopplg+")");ELSE setzesonderwert(sw4kopplung,10*blank)FI ;inittupel( +dnrfaecher);putwert(fnrffach,compress(fach));search(dnrfaecher,TRUE );IF +dbstatus=okTHEN setzesonderwert(sw4fachlangtext,wert(fnrffachbez))ELSE +setzesonderwert(sw4fachlangtext,blank)FI ;paraphezurlv:=datenzurlv("P", +subtext(zeitenzulv(x),maxwochstdn+1,maxwochstdn+laengelv));inittupel( +dnrlehrer);putwert(fnrlparaphe,compress(paraphezurlv));search(dnrlehrer,TRUE +);IF dbstatus=okTHEN IF wert(fnrlgeschlecht)="w"THEN lehrer:="Fr. "ELSE +lehrer:="Hr. "FI ;hilfstext:=wert(fnrlamtsbeztitel);IF hilfstext<>niltext +THEN lehrerCAT hilfstext;lehrerCAT blank;FI ;hilfstext:=wert(fnrlzusatz);IF +hilfstext<>niltextTHEN lehrerCAT hilfstext;lehrerCAT blank;FI ;lehrerCAT wert +(fnrlfamname);setzesonderwert(sw4erllehrer,lehrer);ELSE setzesonderwert( +sw4erllehrer,blank);FI ;briefalternative(dateimitvordruck4,hilfsdatei); +zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);END +PROC einzelstdplsek1druckdateibauen;PROC zeilenweisehilfsdateiindruckdatei( +TEXT CONST hilfsdatei):TEXT VAR zeile:=niltext;FILE VAR f;f:=sequentialfile( +input,hilfsdatei);FOR iFROM 1UPTO lines(f)REP getline(f,zeile);anzzeilenINCR +1;IF anzzeilenletztestdTHEN zeile:=normaletrennlinieELSE zeile:= +abschlusslinieFI ;druckzeileschreiben(zeile);anzzeilenINCR 1;forget( +hilfsdatei,quiet);END PROC +datendeszweitenvordrucksindruckdateiundggfkopplgmerken;PROC +datendessechstenundsiebtenvordrucksindruckdatei(INT CONST d1index):LET +hilfsdatei="hilfsdatei";FILE VAR f;INT VAR y,z,index:=d1index;TEXT VAR tagstd +,zeiten,altekopplg,fach,allelvsderkopplg;INT CONST maxauszugebendezeiten:=8; +INT VAR anzzeitenprokopplg,poslv,sonderwert;IF kopplungen(index)<>niltext +THEN altekopplg:=kopplungen(index);setzesonderwert(sw6kopplung,altekopplg); +zeiten:=text(index,2);FOR zFROM index+1UPTO maxwochstdnREP IF kopplungen(z)= +altekopplgTHEN zeitenCAT text(z,2);kopplungen(z):=niltext;FI ;PER ; +anzzeitenprokopplg:=length(zeiten)DIV 2;poslv:=1;sonderwert:=sw6kopplung+1; +FOR zFROM 1UPTO 8REP IF anzzeitenprokopplg>=zTHEN tagstd:=subtext(zeiten, +poslv,poslv+1);setzesonderwert(sonderwert,tagstunde(int(tagstd),TRUE ));ELSE +setzesonderwert(sonderwert,blank)FI ;poslvINCR 2;sonderwertINCR 1PER ; +briefalternative(dateimitvordruck6,hilfsdatei); +zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet); +allelvsderkopplg:=allelvmit("K",altekopplg);anzlvgnprokopplg:=(length( +allelvsderkopplg)DIV laengelv);poslv:=1;TEXT VAR lvderkopplg;BOOL VAR +lvmind1malgeplant;FOR yFROM 1UPTO anzlvgnprokopplgREP lvmind1malgeplant:= +FALSE ;lvderkopplg:=subtext(allelvsderkopplg,poslv,poslv+7);IF pos( +lvgnproschuelgr,lvderkopplg)<>0THEN +fuerallezeitenderlvplaneintraegelesenundsonderwertesetzen;FI ;IF +lvmind1malgeplantTHEN briefalternative(dateimitvordruck7,hilfsdatei); +zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);FI ; +poslvINCR laengelv;PER ;TEXT VAR leerzeile:=blank;druckzeileschreiben( +leerzeile);FI ;.fuerallezeitenderlvplaneintraegelesenundsonderwertesetzen: +TEXT VAR l,r,p;INT VAR zeit,poszeit;sonderwert:=sw7lv;fach:=subtext( +lvderkopplg,3,4);setzesonderwert(sonderwert,fach);poszeit:=1;FOR zFROM 1UPTO +maxauszugebendezeitenREP sonderwertINCR 1;IF anzzeitenprokopplg>=zTHEN zeit:= +int(subtext(zeiten,poszeit,poszeit+1));IF lvgeplant(zeit,lvderkopplg)THEN +planeintraglesen(zeit,"L",lvderkopplg,l,r,p);IF r=vierblanksTHEN +setzesonderwert(sonderwert,"x");ELSE setzesonderwert(sonderwert,r);FI ; +lvmind1malgeplant:=TRUE ;FI ;ELSE setzesonderwert(sonderwert,blank);FI ; +poszeitINCR 2PER END PROC datendessechstenundsiebtenvordrucksindruckdatei; +PROC stdplanprowochstdlesenundswsetzen(INT CONST std):INT VAR x,sonderwert:= +521;INT VAR wochenstd:=std;FOR iFROM 1UPTO maxwochtageREP IF wochenstd<= +maxwochstdnTHEN string:="";FOR xFROM 1UPTO anzlvgnproschuelergrREP IF ( +zeitenzulv(x)SUB wochenstd)=geplantestdTHEN stringCAT (subtext(zeitenzulv(x), +maxwochstdn+1,maxwochstdn+laengelv));FI ;PER ;IF length(string)<=laengelv +THEN planeintraglesen(wochenstd,"L",string,l,r,p);setzesonderwert(sonderwert, +subtext(l,3,4)+" "+r)ELSE planeintraglesen(wochenstd,"L",subtext(string,1,8), +l,r,p);setzesonderwert(sonderwert,"*"+datenzurlv("K",l))FI ;wochenstdINCR +letztestd;sonderwertINCR 1;ELSE setzesonderwert(sonderwert,blank)FI ;PER ; +END PROC stdplanprowochstdlesenundswsetzen;PROC +stdplanprowochstdlesenswsetzenunddatenprokopplgmerken(INT CONST stunde):INT +VAR x,pos,posstring,sonderwert:=521;INT VAR wochenstd:=stunde;TEXT VAR +lvposimrow;FOR iFROM 1UPTO maxwochtageREP IF wochenstd<=maxwochstdnTHEN +string:="";lvposimrow:=niltext;FOR xFROM 1UPTO anzlvgnproschuelergrREP IF ( +zeitenzulv(x)SUB wochenstd)=geplantestdTHEN stringCAT (subtext(zeitenzulv(x), +maxwochstdn+1,maxwochstdn+laengelv));lvposimrowCAT text(x,3);FI ;PER ;IF +length(lvposimrow)=3THEN planeintraglesen(wochenstd,"L",string,l,r,p); +setzesonderwert(sonderwert,subtext(l,3,4)+" "+r);ELIF length(lvposimrow)>3 +THEN kopplungsbez:=datenzurlv("K",subtext(string,1,laengelv));setzesonderwert +(sonderwert,"*"+kopplungsbez);kopplungen(wochenstd):=kopplungsbez;pos:=1; +posstring:=1;FOR yFROM 1UPTO (length(lvposimrow)DIV 3)REP IF length( +zeitenzulv(int(subtext(lvposimrow,pos,pos+2))))=maxwochstdn+laengelvTHEN +zeitenzulv(int(subtext(lvposimrow,pos,pos+2)))CAT kopplungsbezFI ;posINCR 3; +posstringINCR 8PER ;ELSE setzesonderwert(sonderwert,blank);FI ;wochenstdINCR +letztestd;sonderwertINCR 1;ELSE setzesonderwert(sonderwert,blank)FI ;PER ; +END PROC stdplanprowochstdlesenswsetzenunddatenprokopplgmerken;END PACKET +einzelstdplsek1; + diff --git a/app/schulis/2.2.1/src/4.einzelstdpl.sek2 b/app/schulis/2.2.1/src/4.einzelstdpl.sek2 new file mode 100644 index 0000000..17bc9bd --- /dev/null +++ b/app/schulis/2.2.1/src/4.einzelstdpl.sek2 @@ -0,0 +1,197 @@ +PACKET einzelstdplsek2DEFINES einzelstdplsek2eingang,einzelstdplsek2starten, +einzelstdplsek2sonderwerte,einzelstdplsek2multistop, +einzelstdplsek2druckdateibauen:LET swrufname=511,swfamname=512,swgebdat=513, +swschuljahr=514,swhalbjahr=515,swtutorkurs=516,swtagesstunde=520,swmozeile1= +521,swsazeile1=526,swlv=540,swlehrername=541,maske= +"ms einzelstdpl sek2 eingang",fnr2jgst=2,fnr3famname=3,fnr4rufname=4, +fnr5gebdat=5,fnr6ausgbs=6,fnr7ausgdr=7,meldnrauswahlunsinnig=56, +meldnrdatenexistierennicht=59,meldnrbittewarten=69, +meldnrschuelernichtimentsprbestand=126,meldnrpraezisieren=129, +meldnrungueltigesdatum=157,meldnrjgstoderschueler=318, +meldnrkeinestundenplandatenvorhanden=366,meldnrfalschejgstangabe=404, +maxwochstdn=66,maxanzfaecher=100;INT CONST maxwochtage:=6,erstestd:=1, +letztestd:=12;LET blank=" ",null=0,niltext="",punkt=".",maxzeichenimvordruck= +79;TASK VAR vordruckserver;TEXT CONST dateimitueberschrift:= +"vordruck1 einzelstdpl sek2",dateimitstdplzeilen:= +"vordruck2 einzelstdpl raeume",dateimiterlauterungen:= +"vordruck2 einzelstdpl sek2",strich:="-",kreuz:="+",abschlusslinie:=76*strich ++blank,normaletrennlinie:=3*strich+kreuz+5*(11*strich+kreuz)+11*strich+": ", +lvnichtimbestand:="nicht in Datei 'Lehrveranstaltungen' enthalten ", +paraphenichtimbestand:=" nicht in Datei 'Lehrer' enthalten ";TEXT VAR hj,sj, +sjaufber,uebfolgeseiten,famname,rufname,gebdat,jgst,tutorkurs,tutorkursalt, +hilfsstring,tupelwerthjd,kennungen,faecher,paraphe,anrede,titel,zusatz,name, +hilfstext,lv,zeile1,zeile2,l:="",r:="",p:="";ROW maxanzfaecherTEXT VAR +lehrveranstaltungen;BOOL VAR gesamtesek2,bestjgst,einzelschueler, +bildschirmausgabe;INT VAR aktuellerindex,gemerkterdbstatus,anzzeilen, +eingabestatus,i,x,y,z,feldnr,meldnr,zaehler,anzfaecher;PROC +einzelstdplsek2eingang:standardvproc(maske)END PROC einzelstdplsek2eingang; +PROC einzelstdplsek2starten:sj:=schulkenndatum("Schuljahr");hj:= +schulkenndatum("Schulhalbjahr");IF maskenwerteokTHEN IF stundenplanokTHEN +startenausfuehrenELSE meldnr:=meldnrkeinestundenplandatenvorhanden; +meldefehlerundzurueckzumdialog;FI ;ELSE meldefehlerundzurueckzumdialog;FI ;. +startenausfuehren:sjaufber:=subtext(sj,1,2)+"/";sjaufberCAT subtext(sj,3,4); +vordruckserver:=/"anschreiben server";forget(dateimitueberschrift,quiet); +forget(dateimitstdplzeilen,quiet);forget(dateimiterlauterungen,quiet);fetch( +dateimitueberschrift,vordruckserver);fetch(dateimitstdplzeilen,vordruckserver +);fetch(dateimiterlauterungen,vordruckserver);setzesonderwerteschulkenndaten; +standardmeldung(meldnrbittewarten,niltext);inittupel(dnrhalbjahresdaten); +putwert(fnrhjdsj,sj);putwert(fnrhjdhj,hj);putwert(fnrhjdfamnames,famname); +putwert(fnrhjdrufnames,rufname);putwert(fnrhjdgebdats,gebdat);IF +einzelschuelerTHEN aktuellerindex:=dnrhalbjahresdaten;ELSE aktuellerindex:= +ixhjdsjhjjgstkenn;putwert(fnrhjdjgst,jgst);FI ;tutorkursalt:=niltext; +zusammengesetztesanschreiben(aktuellerindex,bildschirmausgabe,einzelschueler, +BOOL PROC einzelstdplsek2sonderwerte,BOOL PROC einzelstdplsek2multistop,TEXT +PROC einzelstdplsek2druckdateibauen);END PROC einzelstdplsek2starten;PROC +meldefehlerundzurueckzumdialog:standardmeldung(meldnr,niltext);return(1)END +PROC meldefehlerundzurueckzumdialog;BOOL PROC maskenwerteok:BOOL VAR ok:= +FALSE ,gesamtesek2:=FALSE ;bestjgst:=FALSE ;einzelschueler:=FALSE ; +standardpruefe(5,fnr6ausgbs,fnr7ausgdr,null,niltext,eingabestatus);IF +eingabestatus<>0THEN meldnr:=meldnrauswahlunsinnig;infeld(fnr6ausgbs);ELSE +bildschirmausgabe:=standardmaskenfeld(fnr7ausgdr)=niltext;jgst:= +standardmaskenfeld(fnr2jgst);famname:=standardmaskenfeld(fnr3famname);rufname +:=standardmaskenfeld(fnr4rufname);gebdat:=standardmaskenfeld(fnr5gebdat);IF +jgst=niltextTHEN IF famname=niltextCAND rufname=niltextCAND gebdat=niltext +THEN gesamtesek2:=TRUE ;jgst:="11";ok:=TRUE ELSE IF einzelschuelerkorrekt +THEN einzelschueler:=TRUE ;ok:=TRUE ELSE infeld(feldnr)FI ;FI ;ELSE +standardpruefe(2,fnr2jgst,null,null,niltext,eingabestatus);IF eingabestatus<> +0COR int(jgst)<11COR int(jgst)>13THEN meldnr:=meldnrfalschejgstangabe;infeld( +fnr2jgst);ELSE IF famname<>niltextCOR rufname<>niltextCOR gebdat<>niltext +THEN meldnr:=meldnrjgstoderschueler;infeld(fnr2jgst)ELSE bestjgst:=TRUE ;ok:= +TRUE FI ;FI ;FI ;FI ;okEND PROC maskenwerteok;BOOL PROC stundenplanok: +stundenplanhalbjahrsetzen(hj,sj);stundenplanbasisundstundenplanholen( +eingabestatus);eingabestatus=0OR eingabestatus=8END PROC stundenplanok;BOOL +PROC einzelschuelerkorrekt:IF famname=niltextTHEN feldnr:=fnr3famname;meldnr +:=meldnrpraezisieren;LEAVE einzelschuelerkorrektWITH FALSE ;FI ;IF rufname= +niltextTHEN IF gebdat=niltextTHEN IF famnameeindeutigTHEN rufname:=wert( +fnrsurufnames);gebdat:=wert(fnrsugebdatums);LEAVE einzelschuelerkorrektWITH +TRUE ELSE LEAVE einzelschuelerkorrektWITH FALSE ;FI ;ELSE feldnr:=fnr4rufname +;meldnr:=meldnrpraezisieren;LEAVE einzelschuelerkorrektWITH FALSE ;FI ;ELSE +IF gebdat<>niltextTHEN IF kompletterschluesselokundhjddaTHEN LEAVE +einzelschuelerkorrektWITH TRUE ELSE LEAVE einzelschuelerkorrektWITH FALSE FI +;ELSE IF famnameundrufnameeindeutigTHEN gebdat:=wert(fnrsugebdatums);LEAVE +einzelschuelerkorrektWITH TRUE ELSE LEAVE einzelschuelerkorrektWITH FALSE FI +;FI ;FI ;TRUE END PROC einzelschuelerkorrekt;BOOL PROC famnameeindeutig: +inittupel(dnrschueler);putwert(fnrsufamnames,famname);putwert(fnrsustatuss, +"ls");search(dnrschueler,FALSE );IF wert(fnrsufamnames)<>famnameTHEN feldnr:= +fnr3famname;meldnr:=meldnrdatenexistierennicht;LEAVE famnameeindeutigWITH +FALSE ;ELSE succ(dnrschueler);IF wert(fnrsufamnames)=famnameTHEN feldnr:= +fnr4rufname;meldnr:=meldnrpraezisieren;LEAVE famnameeindeutigWITH FALSE ; +ELSE pred(dnrschueler);FI ;FI ;TRUE END PROC famnameeindeutig;BOOL PROC +famnameundrufnameeindeutig:inittupel(dnrschueler);putwert(fnrsufamnames, +famname);putwert(fnrsurufnames,rufname);putwert(fnrsustatuss,"ls");search( +dnrschueler,FALSE );IF wert(fnrsufamnames)<>famnameCOR wert(fnrsurufnames)<> +rufnameTHEN feldnr:=fnr3famname;meldnr:=meldnrdatenexistierennicht;LEAVE +famnameundrufnameeindeutigWITH FALSE ELSE succ(dnrschueler);IF wert( +fnrsufamnames)=famnameAND wert(fnrsurufnames)=rufnameTHEN feldnr:=fnr5gebdat; +meldnr:=meldnrpraezisieren;LEAVE famnameundrufnameeindeutigWITH FALSE ELSE +pred(dnrschueler);FI ;FI ;TRUE END PROC famnameundrufnameeindeutig;BOOL PROC +kompletterschluesselokundhjdda:standardpruefe(6,fnr5gebdat,null,null,niltext, +eingabestatus);IF eingabestatus<>0THEN feldnr:=fnr5gebdat;meldnr:= +meldnrungueltigesdatum;LEAVE kompletterschluesselokundhjddaWITH FALSE ;FI ; +hilfstext:=subtext(gebdat,1,2);hilfstextCAT punkt;hilfstextCAT subtext(gebdat +,3,4);hilfstextCAT punkt;hilfstextCAT subtext(gebdat,5,6);gebdat:=hilfstext; +inittupel(dnrhalbjahresdaten);putwert(fnrhjdfamnames,famname);putwert( +fnrhjdrufnames,rufname);putwert(fnrhjdgebdats,gebdat);putwert(fnrhjdsj,sj); +putwert(fnrhjdhj,hj);search(dnrhalbjahresdaten,TRUE );IF dbstatus<>0THEN +feldnr:=fnr3famname;meldnr:=meldnrschuelernichtimentsprbestand;LEAVE +kompletterschluesselokundhjddaWITH FALSE ;FI ;TRUE END PROC +kompletterschluesselokundhjdda;BOOL PROC einzelstdplsek2multistop:BOOL VAR b; +IF einzelschuelerTHEN b:=wert(fnrhjdfamnames)=famnameAND wert(fnrhjdrufnames) +=rufnameAND intwert(fnrhjdjgst)>10AND schulhalbjahrkorrektAND dbstatus=ok +ELIF bestjgstTHEN b:=wert(fnrhjdjgst)=jgstAND schulhalbjahrkorrektAND +dbstatus=okELSE b:=schulhalbjahrkorrektAND dbstatus=okFI ;bENDPROC +einzelstdplsek2multistop;BOOL PROC schulhalbjahrkorrekt:intwert(fnrhjdsj)=int +(sj)AND intwert(fnrhjdhj)=int(hj)END PROC schulhalbjahrkorrekt;BOOL PROC +einzelstdplsek2sonderwerte:initialisieresonderwerte;setzesonderwert( +swschuljahr,sjaufber);setzesonderwert(swhalbjahr,hj);famname:=wert( +fnrhjdfamnames);rufname:=wert(fnrhjdrufnames);gebdat:=wert(fnrhjdgebdats); +jgst:=wert(fnrhjdjgst);adressat(famname);setzesonderwert(swrufname,rufname); +setzesonderwert(swfamname,famname);setzesonderwert(swgebdat,gebdat);tutorkurs +:=wert(fnrhjdkennung);IF tutorkurs=niltextTHEN gemerkterdbstatus:=dbstatus; +inittupel(dnrschueler);putwert(fnrsufamnames,famname);putwert(fnrsurufnames, +rufname);putwert(fnrsugebdatums,gebdat);search(dnrschueler,TRUE );IF dbstatus +=0THEN tutorkurs:=wert(fnrsusgrpzugtut);FI ;dbstatus(gemerkterdbstatus);FI ; +gemerkterdbstatus:=dbstatus;inittupel(dnrlehrer);IF tutorkurs<>tutorkursalt +THEN inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,sj);putwert(fnrsgrphj +,hj);putwert(fnrsgrpjgst,jgst);putwert(fnrsgrpkennung,tutorkurs);search( +dnrlehrveranstaltungen,TRUE );paraphe:=wert(fnrsgrplehrer);IF dbstatus<>0COR +paraphe=niltextTHEN hilfsstring:=jgst+blank+tutorkurs;setzesonderwert( +swtutorkurs,hilfsstring);ELSE hilfsstring:=jgst+blank;hilfsstringCAT paraphe; +putwert(fnrlparaphe,paraphe);search(dnrlehrer,TRUE );IF wert(fnrlgeschlecht)= +"m"THEN hilfsstringCAT " Hr. "ELSE hilfsstringCAT " Fr. "FI ;hilfsstringCAT +wert(fnrlamtsbeztitel);hilfsstringCAT blank+wert(fnrlzusatz);hilfsstringCAT +blank+wert(fnrlfamname);setzesonderwert(swtutorkurs,hilfsstring);FI ; +tutorkursalt:=tutorkurs;ELSE setzesonderwert(swtutorkurs,hilfsstring);FI ; +dbstatus(gemerkterdbstatus);TRUE END PROC einzelstdplsek2sonderwerte;TEXT +PROC einzelstdplsek2druckdateibauen:LET stddruckdatei="liste.1",druckdatei= +"Stundenplan",hilfsdatei="hilfsdatei";FILE VAR f;forget(druckdatei,quiet); +setzemitseitennummern(TRUE );druckvorbereiten;setzeanzahlderzeichenprozeile( +maxzeichenimvordruck);jgst:=wert(fnrhjdjgst);faecher:=wert(fnrhjdfach); +kennungen:=wert(fnrhjdlerngrpkenn);lehrveranstaltungenimrowmerken; +uebfolgeseiten:="Erläuterungen zum Stundenplan: "+rufname+blank+famname+" ("+ +sjaufber+","+hj+") ";anzzeilen:=1;briefalternative(dateimitueberschrift, +hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei, +quiet);FOR xFROM erstestdUPTO letztestdREP vordruckzweiindruckdatei(x)PER ; +ueberschriftenfuererlaeuterungenindruckdatei;FOR zaehlerFROM 1UPTO anzfaecher +REP IF anzzeilen>drucklaengeTHEN seitenwechsel;druckzeileschreiben( +uebfolgeseiten);druckzeileschreiben(blank);spaltenueberschriftenindruckdatei; +anzzeilenINCR 4;FI ;vordruckdreiindruckdatei(zaehler)PER ; +drucknachbereitenohneausdrucken;rename(stddruckdatei,druckdatei);f:= +sequentialfile(modify,druckdatei);toline(f,1);input(f);druckdatei. +lehrveranstaltungenimrowmerken:FOR iFROM 1UPTO maxanzfaecherREP +lehrveranstaltungen(i):=niltextPER ;anzfaecher:=length(faecher)DIV 2;FOR i +FROM 1UPTO anzfaecherREP lehrveranstaltungen(i):=jgst+subtext(faecher,1,2)+ +subtext(kennungen,1,4);faecher:=subtext(faecher,3,length(faecher));kennungen +:=subtext(kennungen,5,length(kennungen));PER ;. +ueberschriftenfuererlaeuterungenindruckdatei:IF anzzeilen+6>drucklaengeTHEN +seitenwechsel;druckzeileschreiben(uebfolgeseiten);druckzeileschreiben(blank); +anzzeilen:=3;FI ;zeile1:=blank;druckzeileschreiben(zeile1);zeile1:= +"Erläuterungen: ";druckzeileschreiben(zeile1);zeile1:=blank; +druckzeileschreiben(zeile1);spaltenueberschriftenindruckdatei;anzzeilenINCR 6 +;END PROC einzelstdplsek2druckdateibauen;PROC +spaltenueberschriftenindruckdatei:zeile1:="Lehrveranstaltung : Lehrer "; +druckzeileschreiben(zeile1);zeile1:="------------------:"+56*"-"+blank; +druckzeileschreiben(zeile1);END PROC spaltenueberschriftenindruckdatei;PROC +zeilenweisehilfsdateiindruckdatei(TEXT CONST hilfsdatei):TEXT VAR zeile:= +niltext;FILE VAR f;f:=sequentialfile(input,hilfsdatei);FOR iFROM 1UPTO lines( +f)REP getline(f,zeile);anzzeilenINCR 1;IF anzzeilenletztestdTHEN zeile:=normaletrennlinieELSE zeile:= +abschlusslinieFI ;druckzeileschreiben(zeile);anzzeilenINCR 1;forget( +hilfsdatei,quiet);END PROC vordruckzweiindruckdatei;PROC +vordruckdreiindruckdatei(INT CONST index):LET hilfsdatei="hilfsdatei";TEXT +VAR zeile:=niltext;FILE VAR f;hilfstext:=lehrveranstaltungen(index);lv:= +subtext(hilfstext,1,2)+blank;lvCAT subtext(hilfstext,3,4)+blank;lvCAT subtext +(hilfstext,5,8);setzesonderwert(swlv,lv);gemerkterdbstatus:=dbstatus; +inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,sj);putwert(fnrlvhj,hj); +putwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,compress(subtext(hilfstext,3 +,8)));search(dnrlehrveranstaltungen,TRUE );IF dbstatus<>0THEN setzesonderwert +(swlehrername,lvnichtimbestand);ELSE inittupel(dnrlehrer);putwert(fnrlparaphe +,wert(fnrlvparaphe));search(dnrlehrer,TRUE );IF dbstatus<>0THEN +setzesonderwert(swlehrername,"Paraphe "+wert(fnrlvparaphe)+ +paraphenichtimbestand)ELSE anredetitelusfzusammensetzten;setzesonderwert( +swlehrername,anrede+titel+name)FI ;FI ;dbstatus(gemerkterdbstatus); +briefalternative(dateimiterlauterungen,hilfsdatei); +zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);. +anredetitelusfzusammensetzten:IF wert(fnrlgeschlecht)="w"THEN anrede:="Fr. " +ELSE anrede:="Hr. "FI ;titel:=wert(fnrlamtsbeztitel);zusatz:=wert(fnrlzusatz) +;name:=blank+wert(fnrlfamname);IF length(titel)>0THEN titelCAT blank;titel +CAT zusatzELSE titel:=zusatzFI ;END PROC vordruckdreiindruckdatei;PROC +stdplanprowochstdlesenundswsetzen(INT CONST std):INT VAR sonderwert;INT VAR +wochenstd:=std;FOR sonderwertFROM swmozeile1UPTO swsazeile1REP zaehler:=1;IF +wochenstd<=maxwochstdnTHEN WHILE zaehler<=anzfaecherAND NOT lvgeplant( +wochenstd,lehrveranstaltungen(zaehler))REP zaehlerINCR 1;PER ;IF zaehler> +anzfaecherTHEN setzesonderwert(sonderwert,niltext);setzesonderwert(sonderwert ++6,niltext);ELSE lv:=lehrveranstaltungen(zaehler);planeintraglesen(wochenstd, +"L",lv,l,r,p);zeile1:=subtext(lv,1,2)+blank;zeile1CAT subtext(lv,3,8);zeile2 +:=text(r,10);setzesonderwert(sonderwert,zeile1);setzesonderwert(sonderwert+6, +zeile2);FI ;wochenstdINCR letztestd;ELSE zeile2:=niltext;setzesonderwert( +sonderwert,zeile2);setzesonderwert(sonderwert+6,zeile2);FI ;PER ;END PROC +stdplanprowochstdlesenundswsetzen;END PACKET einzelstdplsek2; + diff --git a/app/schulis/2.2.1/src/4.faecherangebot drucken b/app/schulis/2.2.1/src/4.faecherangebot drucken new file mode 100644 index 0000000..f38c047 --- /dev/null +++ b/app/schulis/2.2.1/src/4.faecherangebot drucken @@ -0,0 +1,110 @@ +PACKET druckefaecherangebotDEFINES faecherangebotspezielleteile:LET AUSGFELD +=ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,ausgfeldlaenge=1, +ausgkopflaenge=2,sj="Schuljahr",hj="Schulhalbjahr",ueberschrzeilen=1, +ausgabeparam="#",jg="Jgst.",fc="Fach",ar="Art",ws="Wstd.",an= +"Anz. Lehrveranst.",eingmaske="ms liste faecherangebot",meldungbearb=352, +meldungpraez=129,fldgeplshj=2,fldaktshj=3,fldsortjgst=4,fldsortfach=5, +fldaufdr=6,fldaufbs=7,zeilenanzahl=17,jgstbezbreite=5,fachbezbreite=4, +artbezbreite=3,wstdbezbreite=5,anzbezbreite=17;AUSGFELD VAR ausgfeld; +AUSGKOPF VAR ausgkopf;INT VAR i,status,index,druckzeilenzahl;TEXT VAR +geplschj,geplschhj,aktschj,aktschhj,schj,schhj:="0";TEXT VAR meldungaltejgst +:="",meldungaltesfach:="",altejgst:="",altesfach:="",jgst,fach,art,wstd,anzlv +,druckstrich,faecherangebotueberschrift;BOOL VAR erstezeile;BOOL PROC +multistop:IF dbstatus=okTHEN LEAVE multistopWITH wert(fnrfanghj)=schhjCAND +wert(fnrfangsj)=schjFI ;FALSE END PROC multistop;BOOL PROC multistopsim:IF +dbstatus=okTHEN IF wert(fnrfanghj)=schhjCAND wert(fnrfangsj)=schjTHEN LEAVE +multistopsimWITH TRUE ELSE setzebestandende(TRUE );LEAVE multistopsimWITH +FALSE FI ELSE setzebestandende(TRUE )FI ;FALSE END PROC multistopsim;PROC +holeakthj:holakthj;holaktj;bergeplhjuj.holakthj:aktschhj:=schulkenndatum(hj). +holaktj:aktschj:=schulkenndatum(sj).bergeplhjuj:geplschhj:=aktschhj;geplschj +:=aktschj;geplanteshjundsjberechnen(geplschhj,geplschj).END PROC holeakthj; +PROC faecherangebotspezielleteile(INT CONST anwahl):SELECT anwahlOF CASE 1: +faecherangebotdialogvorbereitenCASE 2:faecherangebotrichtigCASE 3: +faecherangebotlistenvorbereitenCASE 4:faecherangebotdruckvorbereitenCASE 5: +faecherangebotseitedruckenCASE 6:faecherangebotbsvorbereitenCASE 7: +faecherangebotseitezeigenEND SELECT .END PROC faecherangebotspezielleteile; +PROC faecherangebotdialogvorbereiten:holeakthj;faecherangebotueberschrift:= +text(vergleichsknoten);setzeanfangswerte(eingmaske,fldgeplshj)END PROC +faecherangebotdialogvorbereiten;PROC faecherangebotrichtig:IF ( +standardmaskenfeld(fldgeplshj)=""CAND standardmaskenfeld(fldaktshj)="")COR ( +standardmaskenfeld(fldsortjgst)=""CAND standardmaskenfeld(fldsortfach)="") +COR (standardmaskenfeld(fldaufdr)=""CAND standardmaskenfeld(fldaufbs)="") +THEN standardmeldung(meldungpraez,"");setzeeingabetest(FALSE );infeld( +fldgeplshj);LEAVE faecherangebotrichtigFI ;standardpruefe(5,fldgeplshj, +fldaktshj,0,"",status);IF status<>0THEN infeld(status);setzeeingabetest( +FALSE )ELSE standardpruefe(5,fldsortjgst,fldsortfach,0,"",status);IF status<> +0THEN infeld(status);setzeeingabetest(FALSE )ELSE standardpruefe(5,fldaufdr, +fldaufbs,0,"",status);IF status<>0THEN infeld(status);setzeeingabetest(FALSE +)ELSE IF standardmaskenfeld(fldgeplshj)<>""THEN schj:=geplschj;schhj:= +geplschhjELSE schj:=aktschj;schhj:=aktschhjFI ;IF standardmaskenfeld( +fldsortjgst)<>""THEN index:=dnrfaecherangebot;setzescanendewert("255")ELSE +index:=ixfangsjhjfach;setzescanendewert("�")FI ;setzeausgabedrucker( +standardmaskenfeld(fldaufdr)<>"");setzeeingabetest(TRUE );FI ;FI ;FI END +PROC faecherangebotrichtig;PROC faecherangebotlistenvorbereiten:BOOL VAR b; +inittupel(dnrfaecherangebot);initobli(zeilenanzahl);reinitparsing; +setzeidentiwert("");setzewerte;objektlistestarten(index,schj,staticfield, +TRUE ,b);setzebestandende(NOT multistopCOR b).setzewerte:putwert(fnrfangsj, +schj);putwert(fnrfanghj,schhj).staticfield:IF index=dnrfaecherangebotTHEN +fnrfangjgstELSE fnrfangfachFI .END PROC faecherangebotlistenvorbereiten;PROC +faecherangebotbsvorbereiten:standardkopfmaskeaktualisieren( +faecherangebotueberschrift+" für "+schhj+". "+text(schj,2)+"/"+subtext(schj,3 +));initspalten;setzespaltentrenner(" ");setzespaltenbreiten; +initausgabekopf(bildbreite*"-");ausgkopf(1)IN 2;ausgkopf(2)IN 3; +setzebildanfangsposition(4).END PROC faecherangebotbsvorbereiten;PROC +setzespaltenbreiten:setzespaltenbreite(jgstbezbreite);setzespaltenbreite( +fachbezbreite);setzespaltenbreite(artbezbreite);setzespaltenbreite( +wstdbezbreite);setzespaltenbreite(anzbezbreite);END PROC setzespaltenbreiten; +PROC faecherangebotseitezeigen:altejgst:="";blaettern(PROC (INT CONST ) +faecherangebotzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop);END PROC +faecherangebotseitezeigen;PROC faecherangebotzeigen(INT CONST procparameter): +faecherangebotholen;faecherangebotaufbereiten;faecherangebotaufbs;END PROC +faecherangebotzeigen;PROC faecherangebotholen:jgst:=text(intwert(fnrfangjgst) +,2);fach:=wert(fnrfangfach);art:=wert(fnrfangart);wstd:=text(intwert( +fnrfangwochenstd),2);anzlv:=text(intwert(fnrfanganzlv),2);IF NOT multistop +THEN setzebestandende(TRUE )FI .END PROC faecherangebotholen;PROC +faecherangebotaufbereiten:IF jgst<>altejgstTHEN spaltenweise(jgst);altejgst:= +jgstELSE spaltenweise(" ")FI ;spaltenweise(fach);spaltenweise(art); +spaltenweise(wstd);spaltenweise(anzlv);ausgfeld(1):=zeile.END PROC +faecherangebotaufbereiten;PROC faecherangebotaufbs:ausgfeld(1)IN ausgabepos; +erhoeheausgabeposumeinsEND PROC faecherangebotaufbs;PROC initausgabekopf( +TEXT CONST t):spaltenweise(jg);spaltenweise(fc);spaltenweise(ar);spaltenweise +(ws);spaltenweise(an);ausgkopf(1):=zeile;ausgkopf(2):=t;END PROC +initausgabekopf;PROC faecherangebotdruckvorbereiten:druckvorbereiten; +variablensetzen;initdruckkopf(zentriert(faecherangebotueberschrift+" für "+ +schhj+". "+text(schj,2)+"/"+subtext(schj,3),druckbreite));initspalten; +setzespaltentrenner(" ");setzespaltenbreiten;initausgabekopf( +druckbreite*"-");inittupel(index);setzebestandende(FALSE );setzewerte; +lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL +PROC multistopsim).variablensetzen:druckstrich:=druckbreite*"-"; +druckzeilenzahl:=drucklaenge(ueberschrzeilen)-ausgkopflaenge.setzewerte: +putwert(fnrfangsj,schj);putwert(fnrfanghj,schhj).END PROC +faecherangebotdruckvorbereiten;PROC faecherangebotseitedrucken:altejgst:=""; +altesfach:="";erstezeile:=TRUE ;faecherangebotueberschriftdrucken; +seitedrucken(PROC (INT VAR )faecherangebotdrucken,druckzeilenzahl, +ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel;END PROC +faecherangebotseitedrucken;PROC faecherangebotueberschriftdrucken: +druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP druckzeileschreiben( +ausgkopf(i))PER .END PROC faecherangebotueberschriftdrucken;PROC +faecherangebotdrucken(INT VAR zz):faecherangebotholen;IF index= +dnrfaecherangebotTHEN IF meldungaltejgst<>jgstTHEN meldungaltejgst:=jgst; +standardmeldung(meldungbearb,"Jgst. "+jgst+ausgabeparam)FI ;ELSE IF +meldungaltesfach<>fachTHEN meldungaltesfach:=fach;standardmeldung( +meldungbearb,"Fach "+fach+ausgabeparam)FI ;FI ; +faecherangebotaufbereitenmitleerzeile(zz);faecherangebotindruckdatei(zz);IF +zz>=druckzeilenzahl-1THEN zzINCR ausgfeldlaengeFI .END PROC +faecherangebotdrucken;PROC faecherangebotaufbereitenmitleerzeile(INT VAR zz): +IF index=dnrfaecherangebotTHEN IF jgst<>altejgstTHEN gibleerzeileaus; +spaltenweise(jgst)ELSE spaltenweise(" ")FI ELSE IF fach<>altesfachTHEN +gibleerzeileaus;altejgst:=""FI ;IF jgst<>altejgstTHEN spaltenweise(jgst)ELSE +spaltenweise(" ")FI FI ;spaltenweise(fach);spaltenweise(art);spaltenweise( +wstd);spaltenweise(anzlv);ausgfeld(1):=zeile.gibleerzeileaus:IF NOT +erstezeileTHEN spaltenweise(" ");spaltenweise(" ");spaltenweise(" "); +spaltenweise(" ");spaltenweise(" ");ausgfeld(1):=zeile; +faecherangebotindruckdatei(zz)FI .END PROC +faecherangebotaufbereitenmitleerzeile;PROC faecherangebotindruckdatei(INT +VAR zz):zzINCR ausgfeldlaenge;IF jgst<>altejgstTHEN altejgst:=jgstFI ;IF fach +<>altesfachCAND index=ixfangsjhjfachTHEN altesfach:=fachFI ;IF erstezeile +THEN erstezeile:=FALSE FI ;FOR iFROM 1UPTO ausgfeldlaengeREP +druckzeileschreiben(ausgfeld(i))PER END PROC faecherangebotindruckdatei;END +PACKET druckefaecherangebot + diff --git a/app/schulis/2.2.1/src/4.faecherangebot planen b/app/schulis/2.2.1/src/4.faecherangebot planen new file mode 100644 index 0000000..91d301d --- /dev/null +++ b/app/schulis/2.2.1/src/4.faecherangebot planen @@ -0,0 +1,369 @@ +PACKET planefaecherangebotDEFINES fachangpruefuebern,fachangpruefbearb, +fachangmodbldsch,fachangstdvproc,fachanguebern,fachangspeichern:LET sj= +"Schuljahr",hj="Schulhalbjahr",art="c02 art lehrveranstaltung",eingmaske= +"ms erf faecherangebot",bearbmaske="ms bearb faecherangebot", +kennzeichnunggeplant="geplant",maxzahl=99,minzahl=0,bearbzl=19,jgstfeldnr=10, +meldg0=56,meldg1=300,meldg3=302,meldg4=303,meldg5=304,meldg6=305,meldg7=306, +meldg8=307,meldg9=308,meldg11=310,meldg12=311,meldg10=318,meldg13=315,meldg14 +=312,meldg15=313,meldg16=314,meldg17=69,meldg18=57,meldg19=50,trenner="�"; +ROW 10TEXT VAR eingbldsch;ROW bearbzlINT VAR dbsatzbsnr;ROW bearbzlSTRUCT ( +TEXT fach,TEXT art,TEXT wstd,TEXT anz)VAR bearbbldsch;ROW bearbzlSTRUCT ( +TEXT fach,TEXT art,TEXT wstd,TEXT anz,)VAR dbinh;INT VAR i,j,k,letztepos:=2, +status,zeignr:=1,z1dbnr:=1,nzaehler:=0,ersteeinfuegezeile:=1,bszeiger:=1, +dbzeiger:=1,letztejgst:=1,anzbssaetze,anzdbsaetze,letztebearbzeile:=0;TEXT +VAR fa:="",ar:="",ws:="",an:="",tupel:="",fachkatalog,artkatalog, +maskenkopferg:="";INT VAR aktzeile:=0;TEXT VAR aktschhj:="0",aktschj:="0", +geplschhj:="0",geplschj:="0";BOOL VAR okay:=TRUE ,rueck,istfehler,neu:=FALSE +,dbfa2,bldfa2,f2:=FALSE ,f3:=FALSE ,f6:=FALSE ,modifsatzgeprueft:=FALSE , +keinescn:=TRUE ,saetzeunveraendert;PROC holeaktdaten:statleseschleife( +dnrfaecher,"","",fnrffach,fnrffach,PROC fachcat);statleseschleife( +dnrschluessel,art,"",fnrschlsachgebiet,fnrschlschluessel,PROC artcat)END +PROC holeaktdaten;PROC holeakthj:aktschhj:=schulkenndatum(hj);aktschj:= +schulkenndatum(sj);geplschhj:=aktschhj;geplschj:=aktschj; +geplanteshjundsjberechnen(geplschhj,geplschj);maskenkopferg:=text( +vergleichsknoten)+" "+geplschhj+". "+text(geplschj,2)+"/"+subtext(geplschj,3) +END PROC holeakthj;PROC initrows:fachkatalog:=trenner;artkatalog:=trenner; +FOR iFROM 1UPTO 10REP eingbldsch(i):=""PER ;FOR iFROM 1UPTO bearbzlREP +bearbbldsch(i).fach:="";bearbbldsch(i).art:="";bearbbldsch(i).wstd:=""; +bearbbldsch(i).anz:="";dbsatzbsnr(i):=0;dbinh(i).fach:="";dbinh(i).art:=""; +dbinh(i).wstd:="";dbinh(i).anz:="";PER ;END PROC initrows;PROC +fachangpruefuebern:merkeeingsch;f2:=FALSE ;f3:=FALSE ;f6:=FALSE ;okay:=TRUE ; +fall1;fall2;fall3;fall6;fall9;IF okayTHEN merkeeingsch;standardmeldung(meldg1 +,"");standardnprocELSE IF NOT rueckTHEN fachangzurueckmitmeldg(meldg0,1, +letztepos,"")FI FI .fall1:IF eingbldsch(2)=""CAND eingbldsch(3)=""CAND +eingbldsch(6)=""THEN fachangzurueckmitmeldg(meldg0,1,0,"");LEAVE +fachangpruefuebernFI .fall2:IF eingbldsch(2)<>""THEN f2:=TRUE ;prueferestFI . +prueferest:FOR iFROM 3UPTO 10REP IF eingbldsch(i)<>""THEN okay:=FALSE ; +letztepos:=2;FI PER .fall3:IF eingbldsch(3)<>""CAND okayTHEN f3:=TRUE ; +pruefandereFI .pruefandere:IF eingbldsch(2)<>""THEN okay:=FALSE FI ;FOR i +FROM 6UPTO 10REP IF eingbldsch(i)<>""THEN okay:=FALSE FI PER ;IF NOT okay +THEN fachangzurueckmitmeldg(meldg0,1,0,"");LEAVE fachangpruefuebernFI ;IF +eingbldsch(4)=""CAND okayTHEN fachangzurueckmitmeldg(meldg5,1,4,"");LEAVE +fachangpruefuebernFI ;IF eingbldsch(5)=""CAND okayTHEN fachangzurueckmitmeldg +(meldg5,1,5,"");LEAVE fachangpruefuebernFI ;pruefjgst(4);IF NOT okayTHEN +LEAVE fachangpruefuebernFI ;pruefjgst(5);IF NOT okayTHEN LEAVE +fachangpruefuebernFI .fall6:IF eingbldsch(6)<>""CAND okayTHEN f6:=TRUE ; +pruefnochFI .pruefnoch:FOR iFROM 2UPTO 5REP IF eingbldsch(i)<>""THEN okay:= +FALSE FI PER ;FOR iFROM 9UPTO 10REP IF eingbldsch(i)<>""THEN okay:=FALSE FI +PER ;IF NOT okayTHEN fachangzurueckmitmeldg(meldg0,1,0,"");LEAVE +fachangpruefuebernFI ;IF eingbldsch(7)=""CAND okayTHEN fachangzurueckmitmeldg +(meldg5,1,7,"");LEAVE fachangpruefuebernFI ;IF eingbldsch(8)=""CAND okayTHEN +fachangzurueckmitmeldg(meldg5,1,8,"");LEAVE fachangpruefuebernFI ;pruefjgst(7 +);IF NOT okayTHEN LEAVE fachangpruefuebernFI ;pruefjgst(8);IF NOT okayTHEN +LEAVE fachangpruefuebernFI ;IF eingbldsch(7)=eingbldsch(8)THEN +fachangzurueckmitmeldg(meldg0,1,7,"");LEAVE fachangpruefuebernFI .fall9:IF +eingbldsch(9)<>""COR eingbldsch(10)<>""CAND okayTHEN IF NOT rueckTHEN +fachangzurueckmitmeldg(meldg10,1,letztepos,"")FI ;LEAVE fachangpruefuebernFI +.END PROC fachangpruefuebern;PROC fachangpruefbearb:standardmeldung(meldg17, +" ");merkeeingsch;okay:=TRUE ;FOR iFROM 2UPTO 8REP IF eingbldsch(i)<>""THEN +fachangzurueckmitmeldg(meldg10,1,i,"");LEAVE fachangpruefbearbFI ;PER ;IF +eingbldsch(9)=""CAND okayTHEN fachangzurueckmitmeldg(meldg0,1,i,"");LEAVE +fachangpruefbearbFI ;IF eingbldsch(10)=""THEN fachangzurueckmitmeldg(meldg5,1 +,10,"");LEAVE fachangpruefbearbELSE pruefjgst(10);FI ;IF okayCAND eingbldsch( +10)<>""THEN erfasstefelderausgeben(zeignr);standardnprocELSE IF NOT rueck +THEN fachangzurueckmitmeldg(meldg0,1,0,"")FI FI .END PROC fachangpruefbearb; +PROC pruefjgst(INT CONST eingbldschindex):rueck:=FALSE ;IF compress( +eingbldsch(eingbldschindex))="0"COR eingbldsch(eingbldschindex)="00"THEN +LEAVE pruefjgstELIF int(eingbldsch(eingbldschindex))>4CAND int(eingbldsch( +eingbldschindex))<14THEN LEAVE pruefjgstELSE fachangzurueckmitmeldg(meldg6,1, +0,"");okay:=FALSE ;rueck:=TRUE ;infeld(eingbldschindex);FI END PROC pruefjgst +;PROC pruefdbfd(TEXT CONST objekt,katalog):IF pos(katalog,trenner+objekt+ +trenner)<1THEN istfehler:=TRUE ;IF katalog=fachkatalogTHEN +fachangzurueckmitmeldg(meldg11,0,i*4-1,"")ELSE fachangzurueckmitmeldg(meldg12 +,0,i*4,"")FI FI .END PROC pruefdbfd;PROC prueftypfd(INT CONST feld): +standardpruefe(3,feld,minzahl,maxzahl,"",status);IF status>0THEN istfehler:= +TRUE ;infeld(feld)FI END PROC prueftypfd;PROC fachangstdvproc:gibeingschaus; +standardnproc.END PROC fachangstdvproc;PROC gibeingschaus:zeignr:=1; +standardstartproc(eingmaske);gibeingbldschaus;infeld(2); +standardfelderausgeben;infeld(letztepos).gibeingbldschaus:FOR iFROM 1UPTO 10 +REP standardmaskenfeld(eingbldsch(i),i);IF eingbldsch(i)<>""THEN letztepos:=i +FI PER .END PROC gibeingschaus;PROC erfasstefelderausgeben(INT CONST znr): +ersteeinfuegezeile:=1;keinescn:=TRUE ;IF aktschhj="0"THEN holeakthjFI ;z1dbnr +:=znr;anzdbsaetze:=0;j:=1;IF znr=1THEN loeschedbinh;standardstartproc( +bearbmaske);standardkopfmaskeaktualisieren(maskenkopferg);standardmaskenfeld( +eingbldsch(jgstfeldnr),2);ELSE loeschefelder;FI ;putwert(fnrfangsj,geplschj); +putwert(fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch(jgstfeldnr +)));putintwert(fnrfanglfdnr,znr);search(dnrfaecherangebot,FALSE );IF dbstatus +<>okTHEN gibleerenbildschirmELIF wert(fnrfangsj)=geplschjCAND intwert( +fnrfanglfdnr)=znrCAND intwert(fnrfangjgst)=int(eingbldsch(jgstfeldnr))CAND +wert(fnrfanghj)=geplschhjTHEN z1dbnr:=intwert(fnrfanglfdnr);k:=1; +startebildschirmblock(dnrfaecherangebot,bearbzl-1);bildschirmblock(PROC +gibbearbzeileaus,BOOL PROC (INT CONST )pruefung,i);neu:=FALSE ;ELSE +gibleerenbildschirmFI ;infeld(2);standardfelderausgeben;infeld(k*4-1). +gibleerenbildschirm:infeld(2);standardfelderausgeben;infeld(3);IF znr=1THEN +neu:=TRUE ;FI ;LEAVE erfasstefelderausgeben.loeschedbinh:FOR iFROM 1UPTO +bearbzlREP dbsatzbsnr(i):=0;dbinh(i).fach:="";dbinh(i).art:="";dbinh(i).wstd +:="";dbinh(i).anz:="";PER .loeschefelder:FOR iFROM 1UPTO bearbzlREP dbinh(i). +fach:="";dbinh(i).art:="";dbinh(i).wstd:="";dbinh(i).anz:="";PER ; +standardstartproc(bearbmaske);standardkopfmaskeaktualisieren(maskenkopferg); +standardmaskenfeld(eingbldsch(jgstfeldnr),2).END PROC erfasstefelderausgeben; +PROC gibbearbzeileaus:merkdbwerte;standardmaskenfeld(fa,k*4-1); +standardmaskenfeld(ar,k*4);standardmaskenfeld(ws,k*4+1);standardmaskenfeld(an +,k*4+2);IF kartCOR dbstatus<>0 +THEN b:=TRUE ELSE artkatalogCAT wert(fnrschlschluessel)+trennerFI END PROC +artcat;PROC merkebearbsch:anzbssaetze:=0;FOR iFROM 1UPTO letztebearbzeileREP +bearbbldsch(i).fach:=standardmaskenfeld((i-1)*4+3);bearbbldsch(i).art:= +standardmaskenfeld((i-1)*4+4);bearbbldsch(i).wstd:=standardmaskenfeld((i-1)*4 ++5);bearbbldsch(i).anz:=standardmaskenfeld((i-1)*4+6);IF compress(bearbbldsch +(i).fach)<>""THEN anzbssaetzeINCR 1FI PER ;IF letztebearbzeile0THEN infeld(feld)FI ;IF ruecksprung>0THEN return(ruecksprung)FI END PROC +fachangzurueckmitmeldg;PROC fachanguebern(BOOL CONST b):IF bTHEN IF aktschhj= +"0"THEN holeakthjFI ;letztejgst:=1;IF f2THEN uebernaktkompELIF f3THEN +uebernaktpartELIF f6THEN ueberngeplpartFI ;aenderungsvermerksetzen( +kennzeichnunggeplant)ELSE standardmeldung(meldg4,"");infeld(2);return(2)FI +END PROC fachanguebern;PROC uebernaktkomp:putwert(fnrfangsj,aktschj);putwert( +fnrfanghj,aktschhj);putintwert(fnrfangjgst,0);putintwert(fnrfanglfdnr,1); +search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN +meldungdatennichtuebernommenELIF wert(fnrfangsj)<>aktschjCAND wert(fnrfanghj) +<>aktschhjTHEN meldungdatennichtuebernommenELSE savetupel(dnrfaecherangebot, +tupel);loeschevorhandenesaetze(2);restoretupel(dnrfaecherangebot,tupel); +schreibtupelFI ;korrtupelindbpuffer;succ(dnrfaecherangebot);WHILE dbstatus=ok +CAND wert(fnrfanghj)=aktschhjCAND wert(fnrfangsj)=aktschjREP schreibtupel; +korrtupelindbpuffer;succ(dnrfaecherangebot);PER ;meldungdatenuebernommen. +meldungdatenuebernommen:return(2);standardmeldung(meldg3,"");LEAVE +uebernaktkomp.meldungdatennichtuebernommen:return(2);standardmeldung(meldg13, +"");LEAVE uebernaktkomp.schreibtupel:putwert(fnrfangsj,geplschj);putwert( +fnrfanghj,geplschhj);putintwert(fnrfangjgst,intwert(fnrfangjgst));putintwert( +fnrfanglfdnr,intwert(fnrfanglfdnr));putwert(fnrfangfach,wert(fnrfangfach)); +putwert(fnrfangart,wert(fnrfangart));putintwert(fnrfangwochenstd,intwert( +fnrfangwochenstd));putintwert(fnrfanganzlv,intwert(fnrfanganzlv));IF intwert( +fnrfangjgst)<>letztejgstTHEN standardmeldung(meldg14,text(intwert(fnrfangjgst +))+"#");letztejgst:=intwert(fnrfangjgst);FI ;insert(dnrfaecherangebot). +korrtupelindbpuffer:putwert(fnrfangsj,aktschj);putwert(fnrfanghj,aktschhj). +END PROC uebernaktkomp;PROC uebernaktpart:putwert(fnrfangsj,aktschj);putwert( +fnrfanghj,aktschhj);putintwert(fnrfangjgst,int(eingbldsch(4)));putintwert( +fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN +meldungdatennichtuebernommenELIF intwert(fnrfangjgst)=int(eingbldsch(4))CAND +wert(fnrfanghj)=aktschhjCAND wert(fnrfangsj)=aktschjTHEN savetupel( +dnrfaecherangebot,tupel);loeschevorhandenesaetze(5);restoretupel( +dnrfaecherangebot,tupel);standardmeldung(meldg14,eingbldsch(5)+"#"); +schreibtupelELSE meldungdatennichtuebernommenFI ;korrtupelindbpuffer;succ( +dnrfaecherangebot);WHILE dbstatus=okCAND intwert(fnrfangjgst)=int(eingbldsch( +4))CAND wert(fnrfanghj)=aktschhjCAND wert(fnrfangsj)=aktschjREP schreibtupel; +korrtupelindbpuffer;succ(dnrfaecherangebot);PER ;meldungdatenuebernommen. +meldungdatenuebernommen:return(2);standardmeldung(meldg3,"");LEAVE +uebernaktpart.meldungdatennichtuebernommen:return(2);standardmeldung(meldg13, +"");LEAVE uebernaktpart.schreibtupel:putwert(fnrfangsj,geplschj);putwert( +fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch(5)));putintwert( +fnrfanglfdnr,intwert(fnrfanglfdnr));putwert(fnrfangfach,wert(fnrfangfach)); +putwert(fnrfangart,wert(fnrfangart));putintwert(fnrfangwochenstd,intwert( +fnrfangwochenstd));putintwert(fnrfanganzlv,intwert(fnrfanganzlv));insert( +dnrfaecherangebot).korrtupelindbpuffer:putwert(fnrfangsj,aktschj);putwert( +fnrfanghj,aktschhj);putintwert(fnrfangjgst,int(eingbldsch(4))).END PROC +uebernaktpart;PROC ueberngeplpart:putwert(fnrfangsj,geplschj);putwert( +fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch(7)));putintwert( +fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN +meldungdatennichtuebernommenELIF wert(fnrfangsj)<>geplschjCAND intwert( +fnrfangjgst)<>int(eingbldsch(7))CAND wert(fnrfanghj)<>geplschhjTHEN +meldungdatennichtuebernommenELSE savetupel(dnrfaecherangebot,tupel); +loeschevorhandenesaetze(8);restoretupel(dnrfaecherangebot,tupel); +standardmeldung(meldg14,eingbldsch(8)+"#");schreibtupelFI ; +korrtupelindbpuffer;succ(dnrfaecherangebot);WHILE dbstatus=okCAND intwert( +fnrfangjgst)=int(eingbldsch(7))CAND wert(fnrfanghj)=geplschhjCAND wert( +fnrfangsj)=geplschjREP schreibtupel;korrtupelindbpuffer;succ( +dnrfaecherangebot);PER ;meldungdatenuebernommen.meldungdatenuebernommen: +return(2);standardmeldung(meldg3,"");LEAVE ueberngeplpart. +meldungdatennichtuebernommen:return(2);standardmeldung(meldg13,"");LEAVE +ueberngeplpart.schreibtupel:putwert(fnrfangsj,geplschj);putwert(fnrfanghj, +geplschhj);putintwert(fnrfangjgst,int(eingbldsch(8)));putintwert(fnrfanglfdnr +,intwert(fnrfanglfdnr));putwert(fnrfangfach,wert(fnrfangfach));putwert( +fnrfangart,wert(fnrfangart));putintwert(fnrfangwochenstd,intwert( +fnrfangwochenstd));putintwert(fnrfanganzlv,intwert(fnrfanganzlv));insert( +dnrfaecherangebot).korrtupelindbpuffer:putintwert(fnrfangjgst,int(eingbldsch( +7))).END PROC ueberngeplpart;PROC loeschevorhandenesaetze(INT CONST feld): +inittupel(dnrfaecherangebot);IF feld=2THEN putwert(fnrfangsj,geplschj); +putwert(fnrfanghj,geplschhj);putintwert(fnrfangjgst,0);putintwert( +fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN +letztejgst:=1;LEAVE loeschevorhandenesaetzeELIF wert(fnrfangsj)=geplschjCAND +wert(fnrfanghj)=geplschhjTHEN standardmeldung(meldg15,text(intwert( +fnrfangjgst))+"#");letztejgst:=intwert(fnrfangjgst);WHILE wert(fnrfanghj)= +geplschhjCAND dbstatus=okCAND wert(fnrfangsj)=geplschjREP IF intwert( +fnrfangjgst)<>letztejgstTHEN standardmeldung(meldg15,text(intwert(fnrfangjgst +))+"#");letztejgst:=intwert(fnrfangjgst);FI ;delete(dnrfaecherangebot);succ( +dnrfaecherangebot)PER ;FI ELSE putwert(fnrfangsj,geplschj);putwert(fnrfanghj, +geplschhj);putintwert(fnrfangjgst,int(eingbldsch(feld)));putintwert( +fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN +letztejgst:=1;LEAVE loeschevorhandenesaetzeELIF intwert(fnrfangjgst)=int( +eingbldsch(feld))CAND wert(fnrfangsj)=geplschjCAND wert(fnrfanghj)=geplschhj +THEN standardmeldung(meldg15,eingbldsch(feld)+"#");WHILE intwert(fnrfangjgst) +=int(eingbldsch(feld))CAND wert(fnrfanghj)=geplschhjCAND wert(fnrfangsj)= +geplschjCAND dbstatus=0REP delete(dnrfaecherangebot);succ(dnrfaecherangebot) +PER ;ELSE letztejgst:=1;LEAVE loeschevorhandenesaetzeFI FI ;END PROC +loeschevorhandenesaetze;PROC fachangspeichern(BOOL CONST speichern): +stelleletztebearbzeilefest;merkebearbsch;bestimmenzaehler;IF speichernTHEN +standardmeldung(meldg18," ");fachleerurest;IF fachkatalog=trennerTHEN +holeaktdatenFI ;speicherdaten;IF NOT saetzeunveraendertTHEN +aenderungsvermerksetzen(kennzeichnunggeplant);FI ;standardmeldung(meldg7,""); +FI ;naechsterbildschirm;nzaehler:=0;.fachleerurest:FOR iFROM 1UPTO bearbzl +REP IF bearbbldsch(i).fach=""CAND (bearbbldsch(i).art<>""COR bearbbldsch(i). +wstd<>""COR bearbbldsch(i).anz<>"")THEN fachangzurueckmitmeldg(meldg8,1,(i*4- +1),"");LEAVE fachangspeichernFI PER .speicherdaten:pruefefachartkombination; +standardmeldung(meldg19," ");IF NOT neuCAND nzaehler>0CAND anzdbsaetze< +anzbssaetze+nzaehlerCAND letztebearbzeile>0THEN korrigieredbsaetzerueckwFI ; +behandlebildschirmsaetze;IF NOT neuCAND anzbssaetze0THEN korrigieredbsaetzevorwFI .bestimmenzaehler:FOR iFROM +anzdbsaetzeDOWNTO 1REP IF dbsatzbsnr(i)""THEN IF neuTHEN pruefesatz; +pruefefachart(i,1);IF bldfa2THEN fachangzurueckmitmeldg(meldg9,1,i*4-1,""); +LEAVE fachangspeichernFI ;ELIF NOT neuCAND neuersatzTHEN pruefesatz; +pruefefachart(i,3);IF bldfa2THEN fachangzurueckmitmeldg(meldg9,1,i*4-1,""); +LEAVE fachangspeichernELIF dbfa2THEN pruefobvorhergeaendert;FI ;ELIF +geaendertersatzTHEN pruefesatz;IF fachartgeaendertCOR (nzaehler>0CAND i> +ersteeinfuegezeile)THEN pruefefachart(i,3);FI ;modifsatzgeprueft:=TRUE ;IF +bldfa2THEN fachangzurueckmitmeldg(meldg9,1,i*4-1,"");LEAVE fachangspeichern +ELIF dbfa2THEN pruefobvorhergeaendert;FI ;IF geaenderteraltersatzTHEN +dbzeigerINCR 1FI ELIF unveraendertersatzTHEN ueberpruefesonderfall;dbzeiger +INCR 1FI ;ELSE pruefobgeloeschtersatzFI PER .ueberpruefesonderfall:IF +nzaehler>0CAND i>ersteeinfuegezeileTHEN pruefefachart(i,3);modifsatzgeprueft +:=TRUE ;IF bldfa2THEN fachangzurueckmitmeldg(meldg9,1,i*4-1,"");LEAVE +fachangspeichernELIF dbfa2THEN pruefobvorhergeaendert;FI ;FI . +pruefobgeloeschtersatz:FOR kFROM i+1UPTO bearbzlREP IF bearbbldsch(k).fach<> +""THEN IF bearbbldsch(k).fach=dbinh(k).fachCAND bearbbldsch(k).art=dbinh(k). +artCAND bearbbldsch(k).wstd=dbinh(k).wstdCAND bearbbldsch(k).anz=dbinh(k).anz +THEN dbzeigerINCR 1;LEAVE pruefobgeloeschtersatzFI FI PER . +geaenderteraltersatz:FOR kFROM i+1UPTO bearbzlREP IF bearbbldsch(k).fach<>"" +CAND dbzeiger""COR standardmaskenfeld +((i-1)*4+4)<>""THEN letztebearbzeile:=i;LEAVE stelleletztebearbzeilefestFI +PER .neuersatz:i+z1dbnr-1>=z1dbnr+anzdbsaetze-nzaehlerCAND (bearbbldsch(i). +fach<>dbinh(dbzeiger).fachCAND bearbbldsch(i).art<>dbinh(dbzeiger).artCAND +bearbbldsch(i).wstd<>dbinh(dbzeiger).wstdCAND bearbbldsch(i).anz<>dbinh( +dbzeiger).anz).geaendertersatz:bearbbldsch(i).fach<>dbinh(dbzeiger).fachCOR +bearbbldsch(i).art<>dbinh(dbzeiger).artCOR bearbbldsch(i).wstd<>dbinh( +dbzeiger).wstdCOR bearbbldsch(i).anz<>dbinh(dbzeiger).anz.fachartgeaendert: +bearbbldsch(i).fach<>dbinh(dbzeiger).fachCOR bearbbldsch(i).art<>dbinh( +dbzeiger).art.unveraendertersatz:bearbbldsch(i).fach=dbinh(dbzeiger).fachCOR +bearbbldsch(i).art=dbinh(dbzeiger).artCOR bearbbldsch(i).wstd=dbinh(dbzeiger) +.wstdCOR bearbbldsch(i).anz=dbinh(dbzeiger).anz.behandlebildschirmsaetze: +dbzeiger:=1;FOR bszeigerFROM 1UPTO letztebearbzeileREP infeld((bszeiger-1)*4+ +3);IF compress(bearbbldsch(bszeiger).fach)<>""THEN IF NOT satzgeaendert( +dbzeiger,bszeiger)THEN dbzeigerINCR 1ELIF dbinh(dbzeiger).fach<>""CAND +dbsatzbsnr(dbzeiger)"" +CAND anzdbsaetze>anzbssaetze+nzaehlerTHEN FOR iFROM 1UPTO zuloeschendesaetze +REP loeschesatz;dbzeigerINCR 1PER FI ;dbzeiger:=1;bszeiger:=1. +zuloeschendesaetze:anzdbsaetze-anzbssaetze-nzaehler.schreibesatz:IF +saetzeunveraendertTHEN saetzeunveraendert:=FALSE FI ;putwert(fnrfangsj, +geplschj);putwert(fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch( +jgstfeldnr)));putintwert(fnrfanglfdnr,z1dbnr+dbzeiger-1);dbzeigerINCR 1; +putwert(fnrfangfach,bearbbldsch(bszeiger).fach);putwert(fnrfangart, +bearbbldsch(bszeiger).art);putintwert(fnrfangwochenstd,int(bearbbldsch( +bszeiger).wstd));putintwert(fnrfanganzlv,int(bearbbldsch(bszeiger).anz)); +insert(dnrfaecherangebot);neu:=FALSE .aenderesatz:IF saetzeunveraendertTHEN +saetzeunveraendert:=FALSE FI ;putwert(fnrfangsj,geplschj);putwert(fnrfanghj, +geplschhj);putintwert(fnrfangjgst,int(eingbldsch(jgstfeldnr)));putintwert( +fnrfanglfdnr,dbzeiger+z1dbnr-1);search(dnrfaecherangebot,TRUE );putwert( +fnrfangfach,bearbbldsch(bszeiger).fach);putwert(fnrfangart,bearbbldsch( +bszeiger).art);putintwert(fnrfangwochenstd,int(bearbbldsch(bszeiger).wstd)); +putintwert(fnrfanganzlv,int(bearbbldsch(bszeiger).anz));update( +dnrfaecherangebot).loeschesatz:IF saetzeunveraendertTHEN saetzeunveraendert:= +FALSE FI ;putwert(fnrfangsj,geplschj);putwert(fnrfanghj,geplschhj);putintwert +(fnrfangjgst,int(eingbldsch(jgstfeldnr)));putintwert(fnrfanglfdnr,dbzeiger+ +z1dbnr-1);search(dnrfaecherangebot,TRUE );IF dbstatus<>okTHEN errorstop( +"Systemfehler, zu löschenden Satz nicht gefunden !")FI ;delete( +dnrfaecherangebot).korrigieredbsaetzevorw:IF saetzeunveraendertTHEN +saetzeunveraendert:=FALSE FI ;suchedbsatz(geplschj,geplschhj,int(eingbldsch( +jgstfeldnr)),bearbbldsch(letztebearbzeile).fach,bearbbldsch(letztebearbzeile) +.art,bearbbldsch(letztebearbzeile).wstd,bearbbldsch(letztebearbzeile).anz); +REP succ(dnrfaecherangebot);IF dbstatus=okCAND intwert(fnrfangjgst)=int( +eingbldsch(jgstfeldnr))CAND wert(fnrfanghj)=geplschhjCAND wert(fnrfangsj)= +geplschjTHEN putintwert(fnrfanglfdnr,intwert(fnrfanglfdnr)-zuloeschendesaetze +);update(dnrfaecherangebot);ELSE LEAVE korrigieredbsaetzevorwFI UNTIL intwert +(fnrfangjgst)<>int(eingbldsch(jgstfeldnr))PER .korrigieredbsaetzerueckw:IF +saetzeunveraendertTHEN saetzeunveraendert:=FALSE FI ;putwert(fnrfangsj, +geplschj);putwert(fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch( +jgstfeldnr)));putintwert(fnrfanglfdnr,maxint);search(dnrfaecherangebot,FALSE +);REP pred(dnrfaecherangebot);IF intwert(fnrfangjgst)=int(eingbldsch( +jgstfeldnr))CAND wert(fnrfanghj)=geplschhjCAND nichtbssatzCAND wert(fnrfangsj +)=geplschjTHEN putintwert(fnrfanglfdnr,intwert(fnrfanglfdnr)+anzbssaetze- +anzdbsaetze+nzaehler);update(dnrfaecherangebot);ELSE LEAVE +korrigieredbsaetzerueckwFI PER .nichtbssatz:intwert(fnrfanglfdnr)>z1dbnr+ +anzdbsaetze-1-nzaehler.naechsterbildschirm:j:=1;IF speichernTHEN IF +anzbssaetze=bearbzlCOR anzdbsaetze=bearbzlCOR nzaehler>0THEN zeignrINCR +anzbssaetze;erfasstefelderausgeben(zeignr);return(1);ELSE zeignr:=1;enter(2); +FI ELSE IF anzdbsaetzez1dbnr+anzdbsaetze-1-nzaehlerTHEN fachangzurueckmitmeldg(meldg9 +,1,i*4-1,"");LEAVE fachangspeichernFI .pruefesatz:pruefdbfd(bearbbldsch(i). +fach,fachkatalog);raus;pruefdbfd(bearbbldsch(i).art,artkatalog);raus;IF +bearbbldsch(i).wstd<>""THEN prueftypfd(i*4+1);raus;FI ;IF bearbbldsch(i).anz +<>""THEN prueftypfd(i*4+2);rausFI .raus:IF istfehlerTHEN return(1);LEAVE +fachangspeichernFI .END PROC fachangspeichern;PROC suchedbsatz(TEXT CONST +supsj,supshj,INT CONST supjgst,TEXT CONST fach,art,wstd,anz):putwert( +fnrfangsj,supsj);putwert(fnrfanghj,supshj);putintwert(fnrfangjgst,supjgst); +putintwert(fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF NOT (dbstatus= +okCAND wert(fnrfanghj)=supshjCAND intwert(fnrfangjgst)=supjgstCAND wert( +fnrfangsj)=supsjCAND wert(fnrfangfach)=fachCAND wert(fnrfangart)=artCAND +intwert(fnrfangwochenstd)=int(wstd)CAND intwert(fnrfanganzlv)=int(anz))THEN +REP succ(dnrfaecherangebot);IF dbstatus=okCAND wert(fnrfanghj)=supshjCAND +intwert(fnrfangjgst)=supjgstCAND wert(fnrfangsj)=supsjCAND wert(fnrfangfach)= +fachCAND wert(fnrfangart)=artCAND intwert(fnrfangwochenstd)=int(wstd)CAND +intwert(fnrfanganzlv)=int(anz)THEN LEAVE suchedbsatzFI UNTIL dbstatus<>okPER +FI .END PROC suchedbsatz;PROC pruefefachart(INT CONST i,p):IF neuTHEN +pruefbldschELSE pruefbldsch;pruefdbFI .pruefbldsch:bldfa2:=FALSE ;FOR jFROM 1 +UPTO i-1REP IF jz1dbnr+i-1THEN dbfa2:=TRUE ;LEAVE pruefefachartELIF +nzaehler>0CAND i>ersteeinfuegezeileTHEN dbfa2:=TRUE ;LEAVE pruefefachartFI +FI ELSE REP pruefnachfolger;UNTIL nachfolgerfalschPER FI .nachfolgerfalsch: +dbstatus<>okCOR wert(fnrfangfach)<>bearbbldsch(i).fachCOR wert(fnrfangsj)<> +geplschjCOR wert(fnrfanghj)<>geplschhjCOR intwert(fnrfangjgst)>int(eingbldsch +(jgstfeldnr)).pruefnachfolger:succ(ixfangsjhjfach);IF dbstatus=okCAND wert( +fnrfanghj)=geplschhjCAND intwert(fnrfangjgst)=int(eingbldsch(jgstfeldnr)) +CAND wert(fnrfangfach)=bearbbldsch(i).fachCAND wert(fnrfangart)=bearbbldsch(i +).artCAND wert(fnrfangsj)=geplschjTHEN IF p=1THEN dbfa2:=TRUE ;LEAVE +pruefefachartELIF p=3THEN IF intwert(fnrfanglfdnr)<>z1dbnr+i-1THEN dbfa2:= +TRUE ;LEAVE pruefefachartELIF nzaehler>0CAND i>ersteeinfuegezeileTHEN dbfa2:= +TRUE ;LEAVE pruefefachartFI FI FI .END PROC pruefefachart;BOOL PROC +satzgeaendert(INT CONST dbnr,bsnr):NOT (dbinh(dbnr).fach=bearbbldsch(bsnr). +fachCAND dbinh(dbnr).art=bearbbldsch(bsnr).artCAND dbinh(dbnr).wstd= +bearbbldsch(bsnr).wstdCAND dbinh(dbnr).anz=bearbbldsch(bsnr).anz)END PROC +satzgeaendert;PROC fachangmodbldsch(INT CONST iproc):SELECT iprocOF CASE 1: +zeileneinfuegenCASE 2:zeileloeschenEND SELECT .zeileneinfuegen:aktzeile:= +bearbfeldzuzeile(infeld);IF keinescnTHEN ersteeinfuegezeile:=aktzeile; +keinescn:=FALSE FI ;IF aktzeile=bearbzlTHEN fachangzurueckmitmeldg(meldg16,1, +infeld," ");LEAVE zeileneinfuegenFI ;infeld((aktzeile+1)*4-1);FOR iFROM +bearbzl-1DOWNTO aktzeile+1REP standardmaskenfeld(standardmaskenfeld(i*4-1),(i ++1)*4-1);standardmaskenfeld(standardmaskenfeld(i*4),(i+1)*4); +standardmaskenfeld(standardmaskenfeld(i*4+1),(i+1)*4+1);standardmaskenfeld( +standardmaskenfeld(i*4+2),(i+1)*4+2);PER ;standardmaskenfeld("",(aktzeile+1)* +4-1);standardmaskenfeld("",(aktzeile+1)*4);standardmaskenfeld("",(aktzeile+1) +*4+1);standardmaskenfeld("",(aktzeile+1)*4+2);infeld((aktzeile+1)*4-1); +standardfelderausgeben;FOR iFROM 1UPTO anzdbsaetzeREP IF dbsatzbsnr(i)> +aktzeileTHEN dbsatzbsnr(i)INCR 1;FI PER ;return(1).zeileloeschen:loeschzeile( +bearbfeldzuzeile(infeld)).END PROC fachangmodbldsch;INT PROC bearbfeldzuzeile +(INT CONST feldnr):(feldnr+1)DIV 4END PROC bearbfeldzuzeile;PROC loeschzeile( +INT CONST zeilennr):INT VAR z:=zeilennr*4;infeld(z-1);standardmaskenfeld("",z +-1);standardmaskenfeld("",z);standardmaskenfeld("",z+1);standardmaskenfeld("" +,z+2);standardfelderausgeben;infeld(z-1);return(1)END PROC loeschzeile; +initrows;END PACKET planefaecherangebot; + diff --git a/app/schulis/2.2.1/src/4.halbjahreswechsel zum stundenplan b/app/schulis/2.2.1/src/4.halbjahreswechsel zum stundenplan new file mode 100644 index 0000000..5955533 --- /dev/null +++ b/app/schulis/2.2.1/src/4.halbjahreswechsel zum stundenplan @@ -0,0 +1,120 @@ +PACKET halbjahreswechselzumstundenplanDEFINES +halbjahreswechselzumstundenplanvorbereiten, +halbjahreswechselzumstundenplanstarten,halbjahreswechselzumstundenplandrucken +:LET maske="ms halbjahreswechsel zum stundenplan";INT VAR fnraktsj:=2, +fnrakthj:=3,fnrgeplsj:=4,fnrgeplhj:=5,fnrauskunft:=6;LET +meldnrhalbjahreswechsellaeuft=156,meldnrinbearbeitung=352;FILE VAR prot;LET +protname="Protokoll zum Halbjahreswechsel";LET schuljahr="Schuljahr", +schulhalbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort";LET +aenderungsvermerk="c02 aenderungsvermerk",wertaktuell="aktuell",wertgeplant= +"geplant";LET erstessj=1,letztessj=9900,naechstessj=101,ersteshj=1,letzteshj= +2;TEXT CONST meldtextanfang:="Daten für ",meldtextexist:=" existieren.", +meldtextexistnicht:=" existierten nicht.",meldtextgeloescht:= +" wurden gelöscht.",ueberschrift:= +"Schulhalbjahreswechsel in Daten der Unterrichtsorganisation",untertitel1:= +"Wechsel von Schuljahr ",untertitel2:=" zum Schuljahr ",halbjahr:= +". Halbjahr",namestundenplan:="Stundenplan";LET strich="-",schraegstrich="/", +doppelpunkt=":",kennzhell="#";LET laengedatname=30;TEXT VAR aktsj:="",akthj:= +"",geplsj,geplhj;INT VAR bearbsj,bearbhj,gelesensj,gelesenhj,intaktsj, +intakthj,intgeplsj,intgeplhj;INT VAR dateinummer;TEXT VAR auszeile,dateiname; +LET logbucheintraghjwechsel= +"Anw. 4.7.1 Halbjahreswechsel z. Unterrichtsorg. ";PROC +halbjahreswechselzumstundenplanvorbereiten:standardstartproc(maske);IF aktsj= +""THEN aktsj:=schulkenndatum(schuljahr);akthj:=schulkenndatum(schulhalbjahr) +FI ;geplsj:=aktsj;geplhj:=akthj;geplanteshjundsjberechnen(geplhj,geplsj); +standardmaskenfeld(aktsj,fnraktsj);standardmaskenfeld(akthj,fnrakthj); +standardmaskenfeld(geplsj,fnrgeplsj);standardmaskenfeld(geplhj,fnrgeplhj); +infeld(fnraktsj);standardfelderausgeben;infeld(fnrauskunft);standardnprocEND +PROC halbjahreswechselzumstundenplanvorbereiten;PROC +halbjahreswechselzumstundenplanstarten:standardmeldung( +meldnrhalbjahreswechsellaeuft,"");logeintrag(logbucheintraghjwechsel+ +"gestartet");protokollvorbereiten;ausgabekopfaufbereiten; +halbjahreswechselvorbereiten;wechselfuerbestand(dnraktschuelergruppen); +wechselfuerbestand(dnrzeitraster);wechselfuerbestand(dnraufsichtszeiten); +wechselfuerbestand(dnrzeitwuensche);wechselfuerbestand(dnrfaecherangebot); +wechselfuerbestand(dnrlehrveranstaltungen);wechselfuerbestandstundenplan; +wechselfuerbestand(dnraufsichtsplan);logeintrag(logbucheintraghjwechsel+ +"beendet");aenderungsvermerkfuerstundenplansetzen;zeigedatei(protname,""). +protokollvorbereiten:forget(protname,quiet);prot:=sequentialfile(output, +protname).ausgabekopfaufbereiten:putline(prot,schulkenndatum(schulname)); +putline(prot,text(schulkenndatum(schulort),65)+date);line(prot);putline(prot, +ueberschrift);putline(prot,length(ueberschrift)*strich);line(prot);auszeile:= +untertitel1;auszeileCAT subtext(aktsj,1,2);auszeileCAT schraegstrich;auszeile +CAT subtext(aktsj,3,4);auszeileCAT " , ";auszeileCAT akthj;auszeileCAT +halbjahr;putline(prot,auszeile);auszeile:=untertitel2;auszeileCAT subtext( +geplsj,1,2);auszeileCAT schraegstrich;auszeileCAT subtext(geplsj,3,4); +auszeileCAT " , ";auszeileCAT geplhj;auszeileCAT halbjahr;putline(prot, +auszeile);line(prot).halbjahreswechselvorbereiten:intaktsj:=int(aktsj); +intakthj:=int(akthj);intgeplsj:=int(geplsj);intgeplhj:=int(geplhj); +dateinummer:=0.aenderungsvermerkfuerstundenplansetzen:inittupel(dnrschluessel +);putwert(fnrschlsachgebiet,aenderungsvermerk);putwert(fnrschlschluessel, +wertaktuell);search(dnrschluessel,TRUE );IF dbstatus=0THEN delete( +dnrschluessel);FI ;putwert(fnrschlsachgebiet,aenderungsvermerk);putwert( +fnrschlschluessel,wertgeplant);search(dnrschluessel,TRUE );IF dbstatus=0THEN +putwert(fnrschlschluessel,wertaktuell);update(dnrschluessel);FI .END PROC +halbjahreswechselzumstundenplanstarten;PROC wechselfuerbestand(INT CONST +dateinr):standardmeldung(meldnrinbearbeitung,name(dateinr)+kennzhell); +dateinamefuerausgabevorbereiten;erstensatzlesen;WHILE +geleseneshalbjahrkleineraktuelleshalbjahrREP IF wechselliegtvorTHEN +zeilezuhalbjahrausgeben(meldtextgeloescht,gelesensj,gelesenhj)FI ; +satzloeschen;satzlesenPER ;IF geleseneshalbjahrgleichaktuelleshalbjahrTHEN +zeilezuhalbjahrausgeben(meldtextgeloescht,gelesensj,gelesenhj);REP +satzloeschen;satzlesenUNTIL NOT geleseneshalbjahrgleichaktuelleshalbjahrPER +ELSE zeilezuhalbjahrausgeben(meldtextexistnicht,intaktsj,intakthj)FI ;IF +geleseneshalbjahrgleichgeplanteshalbjahrTHEN zeilezuhalbjahrausgeben( +meldtextexist,intgeplsj,intgeplhj)ELSE zeilezuhalbjahrausgeben( +meldtextexistnicht,intgeplsj,intgeplhj)FI ;bearbsj:=gelesensj;bearbhj:= +gelesenhj;WHILE nochsaetzedaREP IF wechselliegtvorTHEN +zeilezuhalbjahrausgeben(meldtextexist,gelesensj,gelesenhj)FI ; +naechsteshalbjahrsuchenPER .dateinamefuerausgabevorbereiten:line(prot); +dateinummerINCR 1;dateiname:=text(dateinummer);dateinameCAT ". ";dateiname +CAT name(dateinr);dateinameCAT doppelpunkt;dateiname:=text(dateiname, +laengedatname).geleseneshalbjahrkleineraktuelleshalbjahr:dbstatus=0AND (( +gelesensjgelesensjOR bearbhj<>gelesenhjTHEN bearbsj:= +gelesensj;bearbhj:=gelesenhj;TRUE ELSE FALSE FI .END PROC wechselfuerbestand; +PROC wechselfuerbestandstundenplan:INT VAR fstatusstuplan;standardmeldung( +meldnrinbearbeitung,namestundenplan+kennzhell); +dateinamefuerausgabevorbereiten;gelesensj:=erstessj;WHILE gelesensj<= +letztessjREP FOR gelesenhjFROM ersteshjUPTO letzteshjREP +stundenplanhalbjahrsetzen(text(gelesenhj),gelesensjaufbereitet);IF +geleseneshalbjahrkleineraktuelleshalbjahrTHEN IF stundenplandatenvorhanden +THEN stundenplanbasisundstundenplanloeschen(fstatusstuplan); +zeilezuhalbjahrausgeben(meldtextgeloescht,gelesensj,gelesenhj)FI ELIF +geleseneshalbjahrgleichaktuelleshalbjahrTHEN IF stundenplandatenvorhanden +THEN stundenplanbasisundstundenplanloeschen(fstatusstuplan); +zeilezuhalbjahrausgeben(meldtextgeloescht,gelesensj,gelesenhj)ELSE +zeilezuhalbjahrausgeben(meldtextexistnicht,gelesensj,gelesenhj)FI ELIF +geleseneshalbjahrgleichgeplanteshalbjahrTHEN IF stundenplandatenvorhanden +THEN zeilezuhalbjahrausgeben(meldtextexist,gelesensj,gelesenhj)ELSE +zeilezuhalbjahrausgeben(meldtextexistnicht,gelesensj,gelesenhj)FI ELSE IF +stundenplandatenvorhandenTHEN zeilezuhalbjahrausgeben(meldtextexist,gelesensj +,gelesenhj)FI FI PER ;gelesensj:=gelesensj+naechstessjPER . +geleseneshalbjahrkleineraktuelleshalbjahr:(gelesensj0THEN infeld(fnrfehler);return(1)ELSE +pruefungstartenFI .pruefungstarten:IF aktsj=""THEN aktsj:=schulkenndatum( +schuljahr);akthj:=schulkenndatum(schulhalbjahr)FI ;gewsj:=aktsj;gewhj:=akthj; +IF standardmaskenfeld(fnrgeplhj)<>""THEN geplanteshjundsjberechnen(gewhj, +gewsj);FI ;protokollvorbereiten;ausgabekopfaufbereiten; +pruefungklassengruppendurchfuehren;pruefungraumgruppendurchfuehren; +pruefunglehrveranstaltungendurchfuehren; +pruefunglehrerstundenzahlendurchfuehren;pruefungzeitwuenschedurchfuehren; +pruefungstundenplandurchfuehren;pruefungaufsichtsplandurchfuehren; +ausgabefussaufbereiten;zeigedatei(protname,"").protokollvorbereiten:forget( +fehlerzeilendatei,quiet);fetch(fehlerzeilendatei,/anschreibenserver);fehldat +:=sequentialfile(modify,fehlerzeilendatei);forget(protname,quiet);prot:= +sequentialfile(output,protname);ifehler:=0.ausgabekopfaufbereiten:putline( +prot,schulkenndatum(schulname));putline(prot,schulkenndatum(schulort));line( +prot);putline(prot,20*blank+ueberschrift);putline(prot,20*blank+length( +ueberschrift)*strich);line(prot);auszeile:=untertitel1;auszeileCAT subtext( +gewsj,1,2);auszeileCAT schraegstrich;auszeileCAT subtext(gewsj,3,4);auszeile +CAT ", ";auszeileCAT gewhj;auszeileCAT texthalbjahr;putline(prot,auszeile); +auszeile:=untertitel2;auszeileCAT date;auszeileCAT blank;auszeileCAT +timeofday;putline(prot,auszeile);line(prot);line(prot);putline(prot, +anfangstext);line(prot).ausgabefussaufbereiten:line(prot);IF ifehler=0THEN +putline(prot,20*blank+"keine")ELSE putline(prot,20*blank+20*strich)FI .END +PROC konsistenzpruefungstarten;PROC pruefungklassengruppendurchfuehren: +standardmeldung(meldnrinbearbeitung,name(dnrklassengruppen)+kennzhell); +holegueltigeschuelergruppen;gueltigeklassengruppen:=""; +fehlerhafteklassengruppen:="";inittupel(dnrklassengruppen);statleseschleife( +dnrklassengruppen,"","",fnrkgklassengrp,fnrkgklassengrp,PROC +klassengruppelesenundpruefen)END PROC pruefungklassengruppendurchfuehren; +PROC holegueltigeschuelergruppen:gueltigeschuelergruppen:="";inittupel( +dnraktschuelergruppen);statleseschleife(dnraktschuelergruppen,gewsj,gewhj, +fnrsgrpsj,fnrsgrphj,PROC schuelergruppelesen)END PROC +holegueltigeschuelergruppen;PROC schuelergruppelesen(BOOL VAR b):IF dbstatus +<>0OR wert(fnrsgrpsj)<>gewsjOR wert(fnrsgrphj)<>gewhjTHEN b:=TRUE ELSE +gueltigeschuelergruppenCAT jgstzweistellig(intwert(fnrsgrpjgst)); +gueltigeschuelergruppenCAT text(wert(fnrsgrpkennung),laengekennung)FI END +PROC schuelergruppelesen;PROC klassengruppelesenundpruefen(BOOL VAR b):TEXT +VAR sugruppe,sugruppen;INT VAR possugruppe,laengesugruppen;IF dbstatus<>0 +THEN b:=TRUE ELSE klassengruppe:=wert(fnrkgklassengrp);gueltigeklassengruppen +CAT text(klassengruppe,laengeklassengruppe);sugruppen:=wert(fnrkgschuelergrp) +;laengesugruppen:=length(sugruppen);possugruppe:=1;WHILE possugruppe< +laengesugruppenREP sugruppe:=subtext(sugruppen,possugruppe,possugruppe+ +laengesugruppe-1);IF suchpos(gueltigeschuelergruppen,sugruppe,laengesugruppe) +=0AND sugruppeistnichtjgstTHEN fehlerprotokollieren(1,klassengruppe+awtrenner ++sugruppe+awtrenner);fehlerhafteklassengruppenCAT text(klassengruppe, +laengeklassengruppe)FI ;possugruppeINCR laengesugruppePER ;FI . +sugruppeistnichtjgst:subtext(sugruppe,3,6)<>" ".END PROC +klassengruppelesenundpruefen;PROC pruefungraumgruppendurchfuehren: +standardmeldung(meldnrinbearbeitung,name(dnrraumgruppen)+kennzhell); +holegueltigeraeume;gueltigeraumgruppen:="";fehlerhafteraumgruppen:=""; +inittupel(dnrraumgruppen);statleseschleife(dnrraumgruppen,"","",fnrrgraumgrp, +fnrrgraumgrp,PROC raumgruppelesenundpruefen)END PROC +pruefungraumgruppendurchfuehren;PROC holegueltigeraeume:gueltigeraeume:=""; +inittupel(dnrschluessel);statleseschleife(dnrschluessel,sachgebietraum,"", +fnrschlsachgebiet,fnrschlschluessel,PROC raumlesen);END PROC +holegueltigeraeume;PROC raumlesen(BOOL VAR b):IF dbstatus<>0COR wert( +fnrschlsachgebiet)>sachgebietraumTHEN b:=TRUE ELSE gueltigeraeumeCAT text( +wert(fnrschlschluessel),laengeraum)FI END PROC raumlesen;PROC +raumgruppelesenundpruefen(BOOL VAR b):TEXT VAR alleraeume;INT VAR +laengeraeume;IF dbstatus<>0THEN b:=TRUE ELSE raumgruppe:=wert(fnrrgraumgrp); +gueltigeraumgruppenCAT text(raumgruppe,laengeraum);alleraeume:=wert( +fnrrgraeume);laengeraeume:=length(alleraeume);posraum:=1;WHILE posraum< +laengeraeumeREP raum:=subtext(alleraeume,posraum,posraum+laengeraum-1);IF +suchpos(gueltigeraeume,raum,laengeraum)=0THEN fehlerprotokollieren(2, +raumgruppe+awtrenner+raum+awtrenner);fehlerhafteraumgruppenCAT text( +raumgruppe,laengeraum)FI ;posraumINCR laengeraumPER ;FI .END PROC +raumgruppelesenundpruefen;PROC pruefunglehrveranstaltungendurchfuehren: +standardmeldung(meldnrinbearbeitung,name(dnrlehrveranstaltungen)+kennzhell); +holegueltigeparaphen;holegueltigefaecher;gueltigelv:="";fehlerhaftelv:=""; +gueltigekopplungen:="";inittupel(dnrlehrveranstaltungen);statleseschleife( +dnrlehrveranstaltungen,gewsj,gewhj,fnrlvsj,fnrlvhj,PROC lvlesenundpruefen) +END PROC pruefunglehrveranstaltungendurchfuehren;PROC holegueltigeparaphen: +gueltigeparaphen:="";ilehrer:=0;inittupel(dnrlehrer);statleseschleife( +dnrlehrer,"","",fnrlparaphe,fnrlparaphe,PROC paraphelesen);END PROC +holegueltigeparaphen;PROC paraphelesen(BOOL VAR b):IF dbstatus<>0THEN b:= +TRUE ELSE gueltigeparaphenCAT text(wert(fnrlparaphe),laengeparaphe);ilehrer +INCR 1;lehrersollstd(ilehrer):=intwert(fnrlsollstd);lehreriststd(ilehrer):=0 +FI END PROC paraphelesen;PROC holegueltigefaecher:gueltigefaecher:=""; +inittupel(dnrfaecher);statleseschleife(dnrfaecher,"","",fnrffach,fnrffach, +PROC fachlesen);END PROC holegueltigefaecher;PROC fachlesen(BOOL VAR b):IF +dbstatus<>0THEN b:=TRUE ELSE gueltigefaecherCAT text(wert(fnrffach), +laengefach)FI END PROC fachlesen;PROC lvlesenundpruefen(BOOL VAR b):IF +dbstatus<>0OR wert(fnrlvhj)<>gewhjOR wert(fnrlvsj)<>gewsjTHEN b:=TRUE ELSE +lvdatenpruefenFI .lvdatenpruefen:jgst:=jgstzweistellig(intwert(fnrlvjgst)); +paraphe:=text(wert(fnrlvparaphe),laengeparaphe);fach:=subtext(wert( +fnrlvfachkennung),1,2);lv:=jgst+wert(fnrlvfachkennung);gueltigelvCAT text(lv, +laengelv);gueltigekopplungenCAT text(wert(fnrlvkopplung),laengekopplung);IF +suchpos(gueltigefaecher,fach,laengefach)=0THEN fehlerprotokollieren(3,lv+ +awtrenner+fach+awtrenner);fehlerhaftelvCAT text(lv,laengelv)FI ;posparaphe:= +suchpos(gueltigeparaphen,paraphe,laengeparaphe);IF posparaphe=0THEN +fehlerprotokollieren(4,lv+awtrenner+paraphe+awtrenner);fehlerhaftelvCAT text( +lv,laengelv)ELSE lehrerstundenaufsummierenFI ;INT VAR fnrklgrp;FOR fnrklgrp +FROM fnrlvklgrp1UPTO fnrlvklgrp4REP klassengruppe:=wert(fnrklgrp);IF +klassengruppe<>""THEN IF suchpos(gueltigeschuelergruppen,jgst+klassengruppe, +laengesugruppe)=0THEN IF intwert(fnrlvjgst)>0THEN IF jgst<>klassengruppeTHEN +pruefeobgueltigeklassengruppeFI ELIF klassengruppeistkeinejgstTHEN +pruefeobgueltigeklassengruppeFI FI ;FI ;PER ;INT VAR fnrraumgrp;FOR +fnrraumgrpFROM fnrlvraumgrp1UPTO fnrlvraumgrp2REP raum:=wert(fnrraumgrp);IF +raum<>""THEN raum:=text(raum,laengeraum);IF suchpos(gueltigeraeume,raum, +laengeraum)=0THEN IF suchpos(gueltigeraumgruppen,raum,laengeraum)=0THEN +fehlerprotokollieren(7,lv+awtrenner+raum+awtrenner)ELIF suchpos( +fehlerhafteraumgruppen,raum,laengeraum)>0THEN fehlerprotokollieren(8,lv+ +awtrenner+raum+awtrenner)FI FI ;FI ;PER ;.klassengruppeistkeinejgst: +jgstaufber(klassengruppe)jgst13. +pruefeobgueltigeklassengruppe:IF suchpos(gueltigeklassengruppen,klassengruppe +,laengeklassengruppe)=0THEN fehlerprotokollieren(5,lv+awtrenner+klassengruppe ++awtrenner)ELIF suchpos(fehlerhafteklassengruppen,klassengruppe, +laengeklassengruppe)>0THEN fehlerprotokollieren(6,lv+awtrenner+klassengruppe+ +awtrenner)FI .lehrerstundenaufsummieren:ilehrer:=((posparaphe-1)DIV +laengeparaphe)+1;lehreriststd(ilehrer):=lehreriststd(ilehrer)+intwert( +fnrlvwochenstd).END PROC lvlesenundpruefen;PROC +pruefunglehrerstundenzahlendurchfuehren:standardmeldung(meldnrinbearbeitung, +name(dnrlehrer)+kennzhell);ilehrer:=1;posparaphe:=1;WHILE posparaphelehrersollstd(ilehrer)THEN +fehlerprotokollieren(9,subtext(gueltigeparaphen,posparaphe,posparaphe+ +laengeparaphe-1)+awtrenner);FI ;ilehrerINCR 1;posparapheINCR laengeparaphe +PER .END PROC pruefunglehrerstundenzahlendurchfuehren;PROC +pruefungzeitwuenschedurchfuehren:standardmeldung(meldnrinbearbeitung,name( +dnrzeitwuensche)+kennzhell);inittupel(dnrzeitwuensche);statleseschleife( +dnrzeitwuensche,gewsj,gewhj,fnrzwsj,fnrzwhj,PROC zeitwuenschelesenundpruefen) +END PROC pruefungzeitwuenschedurchfuehren;PROC zeitwuenschelesenundpruefen( +BOOL VAR b):IF dbstatus<>0OR wert(fnrzwhj)<>gewhjOR wert(fnrzwsj)<>gewsjTHEN +b:=TRUE ELSE zeitwunschpruefenFI .zeitwunschpruefen:INT VAR bezuglaenge:=0; +TEXT VAR bezug,bezugsobjekt,bezugtext,bezugmenge;bezug:=wert(fnrzwbezug);IF +bezug=bezugfachTHEN bezuglaenge:=laengefach;bezugtext:=bezugtextfach; +bezugmenge:=gueltigefaecherELIF bezug=bezugsugruppeTHEN bezuglaenge:= +laengesugruppe;bezugtext:=bezugtextsugruppe;bezugmenge:= +gueltigeschuelergruppenELIF bezug=bezugparapheTHEN bezuglaenge:=laengeparaphe +;bezugtext:=bezugtextparaphe;bezugmenge:=gueltigeparaphenELIF bezug=bezugraum +THEN bezuglaenge:=laengeraum;bezugtext:=bezugtextraum;bezugmenge:= +gueltigeraeumeELIF bezug=bezugkopplungTHEN bezuglaenge:=laengekopplung; +bezugtext:=bezugtextkopplung;bezugmenge:=gueltigekopplungenELSE LEAVE +zeitwunschpruefenFI ;bezugsobjekt:=text(wert(fnrzwbezugsobjekt),bezuglaenge); +IF suchpos(bezugmenge,bezugsobjekt,bezuglaenge)=0THEN delete(dnrzeitwuensche) +;fehlerprotokollieren(10,bezugsobjekt+awtrenner+bezugtext+awtrenner)FI END +PROC zeitwuenschelesenundpruefen;PROC pruefungstundenplandurchfuehren:INT +VAR fstatusstuplan;BOOL VAR ok;stundenplanhalbjahrsetzen(gewhj,gewsj); +standardmeldung(meldnrstundenplanwirdaufbereitet,""); +stundenplanbasisundstundenplanholen(fstatusstuplan);IF fstatusstuplan=8THEN +standardmeldung(meldnrbasisalt,"")FI ;IF fstatusstuplan=0OR fstatusstuplan=8 +THEN pruefestundenplan;stundenplanreorganisierenundsichern(fstatusstuplan) +ELSE stundenplanfehlerbehandelnFI .stundenplanfehlerbehandeln:putline(prot, +"*** Der Stundenplan wurde nicht geprüft. ***").pruefestundenplan:TEXT VAR +lvderzeit,paraphenderzeit,kopplungenderzeit,raeumederzeit;holezeitraster; +standardmeldung(meldnrinbearbeitung,"Stundenplan"+kennzhell);FOR izeitFROM +erstestundeUPTO letztestundeREP lvderzeit:=datenderzeit(izeit,kennunglv);IF +lvderzeit<>""THEN pruefeallelvderzeitFI PER .pruefeallelvderzeit:IF ( +zeitrasterleisteSUB izeit)=kennzzeitrastersperrungTHEN poslv:=1;WHILE poslv< +length(lvderzeit)REP lv:=subtext(lvderzeit,poslv,poslv+laengelv-1); +planeintragloeschen(izeit,lv,ok);fehlerprotokollieren(18,tagstunde(izeit, +TRUE )+awtrenner+lv+awtrenner);poslvINCR laengelvPER ELSE +weiterepruefungenzulvFI .weiterepruefungenzulv:paraphenderzeit:=datenderzeit( +izeit,kennungparaphe);kopplungenderzeit:=datenderzeit(izeit,kennungkopplung); +raeumederzeit:=datenderzeit(izeit,kennungraum);poslv:=1;WHILE poslv0 +THEN fehlerprotokollieren(12,paramlvzeit)ELSE inhaltspruefungzueintragFI ; +poslvINCR laengelvPER .inhaltspruefungzueintrag:posparaphe:=((poslv-1)DIV 2)+ +1;paraphe:=subtext(paraphenderzeit,posparaphe,posparaphe+laengeparaphe-1); +neueparaphe:=datenzurlv(kennungparaphe,lv);IF neueparaphe<>parapheTHEN IF +suchpos(paraphenderzeit,neueparaphe,laengeparaphe)>0THEN fehlerprotokollieren +(14,paramparaphenwechsel)ELSE fehlerprotokollieren(13,paramparaphenwechsel); +posraum:=posparaphe;raum:=subtext(raeumederzeit,posraum,posraum+laengeraum-1) +;IF raum<>leerraumTHEN IF suchpos(gueltigeraeume,raum,laengeraum)=0THEN raum +:=leerraum;fehlerprotokollieren(15,paramlvzeit)FI ;FI ;planeintragvornehmen( +izeit,lv,raum,ok);FI ELSE posraum:=posparaphe;raum:=subtext(raeumederzeit, +posraum,posraum+laengeraum-1);IF raum<>leerraumTHEN IF suchpos(gueltigeraeume +,raum,laengeraum)=0THEN raum:=leerraum;fehlerprotokollieren(15,paramlvzeit); +planeintragvornehmen(izeit,lv,raum,ok);FI ;FI ;kopplung:=subtext( +kopplungenderzeit,poslv,poslv+laengekopplung-1);neuekopplung:=datenzurlv( +kennungkopplung,lv);IF neuekopplung<>kopplungTHEN fehlerprotokollieren(16, +paramkopplungswechsel);planeintragvornehmen(izeit,lv,raum,ok);kopplung:= +neuekopplungFI ;FI ;IF schuelergruppenschnittbeizeit(izeit,kennungkopplung, +kopplung,"")THEN fehlerprotokollieren(17,paramlvzeit)FI .END PROC +pruefungstundenplandurchfuehren;TEXT PROC paramlvzeit:TEXT VAR param:=lv; +paramCAT awtrenner;paramCAT tagstunde(izeit,TRUE );paramCAT awtrenner;param +END PROC paramlvzeit;TEXT PROC paramparaphenwechsel:TEXT VAR param:= +paramlvzeit;paramCAT paraphe;paramCAT awtrenner;paramCAT neueparaphe;param +CAT awtrenner;paramEND PROC paramparaphenwechsel;TEXT PROC +paramkopplungswechsel:TEXT VAR param:=paramlvzeit;paramCAT kopplung;paramCAT +awtrenner;paramCAT neuekopplung;paramCAT awtrenner;paramEND PROC +paramkopplungswechsel;PROC holezeitraster:zeitrasterleiste:=letztestunde* +blank;inittupel(dnrzeitraster);statleseschleife(dnrzeitraster,gewsj,gewhj, +fnrzrsj,fnrzrhj,PROC erstellezeitrasterleiste);END PROC holezeitraster;PROC +erstellezeitrasterleiste(BOOL VAR b):IF wert(fnrzrsj)<>gewsjCOR wert(fnrzrhj) +<>gewhjCOR dbstatus<>0THEN b:=TRUE ELSE IF wert(fnrzrkennungteil)= +kennzzeitrastersperrungTHEN replace(zeitrasterleiste,intwert(fnrzrtagstunde), +kennzzeitrastersperrung)FI FI END PROC erstellezeitrasterleiste;PROC +pruefungaufsichtsplandurchfuehren:standardmeldung(meldnrinbearbeitung,name( +dnraufsichtsplan)+kennzhell);holegueltigeaufsichtsorte; +holegueltigeaufsichtszeiten;inittupel(dnraufsichtsplan);statleseschleife( +dnraufsichtsplan,gewsj,gewhj,fnrapsj,fnraphj,PROC aufsichtenlesenundpruefen) +END PROC pruefungaufsichtsplandurchfuehren;PROC holegueltigeaufsichtsorte: +gueltigeaufsichtsorte:="";inittupel(dnrschluessel);statleseschleife( +dnrschluessel,sachgebietaufsichtsorte,"",fnrschlsachgebiet,fnrschlschluessel, +PROC aufsichtsortlesen);END PROC holegueltigeaufsichtsorte;PROC +aufsichtsortlesen(BOOL VAR b):IF dbstatus<>0COR wert(fnrschlsachgebiet)> +sachgebietaufsichtsorteTHEN b:=TRUE ELSE gueltigeaufsichtsorteCAT text(wert( +fnrschlschluessel),laengeorte)FI END PROC aufsichtsortlesen;PROC +holegueltigeaufsichtszeiten:gueltigeaufsichtszeiten:="";inittupel( +dnraufsichtszeiten);statleseschleife(dnraufsichtszeiten,gewsj,gewhj,fnrazsj, +fnrazhj,PROC aufsichtszeitlesen)END PROC holegueltigeaufsichtszeiten;PROC +aufsichtszeitlesen(BOOL VAR b):IF dbstatus<>0OR wert(fnrazsj)<>gewsjOR wert( +fnrazhj)<>gewhjTHEN b:=TRUE ELSE gueltigeaufsichtszeitenCAT text(wert( +fnrazaufsichtszeit),laengeaufsichtszeit)FI END PROC aufsichtszeitlesen;PROC +aufsichtenlesenundpruefen(BOOL VAR b):IF dbstatus<>0OR wert(fnraphj)<>gewhj +OR wert(fnrapsj)<>gewsjTHEN b:=TRUE ELSE aufsichtsplandatenpruefenFI . +aufsichtsplandatenpruefen:aufsichtszeit:=text(wert(fnrapaufsichtszeit), +laengeaufsichtszeit);IF suchpos(gueltigeaufsichtszeiten,aufsichtszeit, +laengeaufsichtszeit)=0THEN delete(dnraufsichtsplan);fehlerprotokollieren(19, +aufsichtszeit+awtrenner)ELSE ort:=text(wert(fnrapaufsichtsort),laengeorte); +IF suchpos(gueltigeaufsichtsorte,ort,laengeorte)=0THEN fehlerprotokollieren( +20,aufsichtszeit+awtrenner+ort+awtrenner)FI ;paraphe:=text(wert(fnrapparaphe) +,laengeparaphe);IF suchpos(gueltigeparaphen,paraphe,laengeparaphe)=0THEN +fehlerprotokollieren(21,aufsichtszeit+awtrenner+ort+awtrenner)FI ;FI END +PROC aufsichtenlesenundpruefen;PROC konsistenzpruefungprotokolldrucken(BOOL +CONST drucken):IF druckenTHEN print(protname)FI ;forget(protname,quiet);enter +(2)END PROC konsistenzpruefungprotokolldrucken;PROC fehlerprotokollieren(INT +CONST fallnr,TEXT CONST aktwerte):TEXT VAR aktuellerwert;INT VAR awpos, +awendepos,epos;LET maxfehler=100;IF ifehler>maxfehlerTHEN LEAVE +fehlerprotokollierenELIF ifehler=maxfehlerTHEN putline(prot, +"keine weitere Fehlerprotokollierung");ifehlerINCR 1;LEAVE +fehlerprotokollierenFI ;suchfall:=fall;suchfallCAT text(fallnr);suchfallCAT +doppelpunkt;toline(fehldat,1);col(fehldat,1);WHILE NOT eof(fehldat)REP +downety(fehldat,suchfall);readrecord(fehldat,zeile);IF pos(zeile,suchfall)=1 +THEN down(fehldat);behandlefallELSE col(fehldat,col(fehldat)+1)FI PER . +behandlefall:ifehlerINCR 1;auszeile:=text(ifehler);auszeileCAT ") ";INT VAR +praefixlaenge:=length(auszeile);awpos:=1;WHILE NOT eof(fehldat)REP readrecord +(fehldat,zeile);IF pos(zeile,fall)>0THEN line(prot);LEAVE behandlefallFI ; +ersetzeevtlersatzzeichendurchaktuellewerte;auszeileCAT zeile;putline(prot, +auszeile);down(fehldat);auszeile:=praefixlaenge*blankPER . +ersetzeevtlersatzzeichendurchaktuellewerte:epos:=pos(zeile,ersatzzeichen); +WHILE epos>0REP awendepos:=pos(aktwerte,awtrenner,awpos);aktuellerwert:= +subtext(aktwerte,awpos,awendepos-1);awpos:=awendepos+1;change(zeile, +ersatzzeichen,aktuellerwert);epos:=pos(zeile,ersatzzeichen,epos+length( +aktuellerwert));PER .END PROC fehlerprotokollieren;INT PROC suchpos(TEXT +CONST quelle,suchtext,INT CONST laenge):INT VAR findpos:=pos(quelle,suchtext) +;WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE suchposWITH findposELSE +findpos:=pos(quelle,suchtext,findpos+1);FI PER ;findposEND PROC suchpos;TEXT +PROC jgstzweistellig(INT CONST intjgst):IF intjgst=0THEN "00"ELIF intjgst>4 +AND intjgst<10THEN "0"+text(intjgst)ELSE text(intjgst)FI END PROC +jgstzweistellig;END PACKET konsistenzpruefung + diff --git a/app/schulis/2.2.1/src/4.lehrveranstaltungen benennen b/app/schulis/2.2.1/src/4.lehrveranstaltungen benennen new file mode 100644 index 0000000..7965000 --- /dev/null +++ b/app/schulis/2.2.1/src/4.lehrveranstaltungen benennen @@ -0,0 +1,480 @@ +PACKET lehrveranstaltungenbenennenDEFINES lehrveranstaltungenbenennenstart, +lehrveranstaltungenuebernehmenstart,lehrveranstaltungenuebernehmen, +bearbeitunglehrveranstaltungen,lehrveranstaltungenzeileeinfuegen, +lehrveranstaltungenspeichern:LET maskeeingang= +"ms lehrveranstalt benennen eingang";LET maskebearb= +"ms lehrveranstalt benennen";LET fnrbearbeiten=2,fnrbearbaktsj=3, +fnrbearbgeplsj=4,fnrbearbjgst=5,fnrbearbfach=6,fnrfachanguebernehmen=7, +fnrfachangaktsj=8,fnrfachanggeplsj=9,fnrfachangjgst=10,fnrlehrveruebernehmen= +11,fnrlehrverjgst=12;LET feldanzmaskeeingang=12;ROW feldanzmaskeeingangTEXT +VAR feldbs1;LET felderprozeile=9;LET ersteseingabefeld=3;LET +erstestabellenfeld=2;LET incrfuerkennung=1,incrfuerlvart=2, +incrfuerklassengranfang=3,incrfuerklassengrende=6,incrfuerwstd=7;LET +meldnrdatenspeichern=50,meldnrungueltigeauswahl=56,meldnrkennungzulang=60, +meldnrdatennichtspeichern=63,meldnrbittewarten=69,meldnrbitteangabegenauer= +129,meldnrungueltigeuebernahmejgst=146,meldnrfragedatenuebernehmen=300, +meldnrdatenwerdenuebernommen=301,meldnrdatenwurdenuebernommen=302, +meldnrdatenwurdennichtuebernommen=303,meldnrkeinfachzuanderenangaben=307, +meldnrungueltigesfach=310,meldnrungueltigeart=311, +meldnrletztezeilenichteinfuegen=314,meldnrkeinfaecherangebot=315, +meldnruebernehmenderjgst=316,meldnrlehrveranstaltungloeschen=317, +meldnrfalschetastezuankreuz=318,meldnrfalscheausfuellung=319, +meldnrungueltigeklassengruppe=320,meldnrkeinelehrveranstaltungen=321, +meldnrlehrveranstaltunggibtsschon=322,meldnrfehlerhaftejgst=305;LET kennzhell +="#";LET textschulj="Schuljahr",texthalbj="Schulhalbjahr",ersteshalbjahr="1", +zweiteshalbjahr="2";LET wertaktuell="aktuell",wertgeplant="geplant";LET +artbestand="c02 art lehrveranstaltung";BOOL VAR aktuelleshalbjahrzubearbeiten +;TEXT VAR gewschulj,gewhalbj,aktschulj:="",akthalbj:="";INT VAR gewjgst, +startjgst,endejgst;TEXT VAR vgljgst:="",vglfach:="";INT VAR +jgstdesletztensatzes:=0;LET fachlaenge=2;LET kennunglaenge=4;INT VAR zugriff; +BOOL VAR eingangsmaskenfehler:=FALSE ;INT VAR pruefstatus:=0,letztecursorfnr +:=fnrbearbeiten;INT VAR aktzeile;INT VAR ifnr,ijgst;LET trenner="�";TEXT VAR +geprueftefaecher,gueltigeschuelergruppen:="",gueltigeklassengruppen:="", +gueltigelvart:="";TEXT VAR pruefklasse;INT VAR pruefjgst,pruefbez;TEXT VAR +sugruppen,sugruppejgst;INT VAR possugruppe,laengesugruppen;LET +laengeeinersugruppe=6;LET blankzeichen=" ",trennstrich="/", +textueberschriftanfang="Lehrveranstaltungen benennen für Halbjahr ";TEXT VAR +ueberschrift;LET jgst0=0,jgst5=5,jgst10=10,jgst13=13;BOOL VAR gueltigejgst; +BOOL VAR bearbeitungallerjgst;BOOL VAR leerenbszeigen;LET lvdateiname= +"LV-Datei";FILE VAR lvdatei;TEXT VAR lvdateizeile;TEXT VAR nfschulj,nfhalbj, +nfjgst,nffachkennung;INT VAR izeile,anzahlgezeigtezeilen, +anzahleingegebenezeilen;LET zeilenanzahl=18;ROW zeilenanzahlSTRUCT (TEXT jgst +,TEXT fach,TEXT kennung,TEXT kopplung,TEXT art,TEXT klasse1,TEXT klasse2, +TEXT klasse3,TEXT klasse4,TEXT wstd)VAR bszeile; +initfelderdeseingangsbildschirms;initbszeilepuffer;PROC +lehrveranstaltungenbenennenstart:standardstartproc(maskeeingang); +wertedeseingangsbildschirmsholen;infeld(fnrbearbeiten);standardfelderausgeben +;infeld(letztecursorfnr);standardnprocEND PROC +lehrveranstaltungenbenennenstart;PROC lehrveranstaltungenuebernehmenstart: +BOOL VAR ausgangsdatenfehlen:=FALSE ;eingangsbehandlung(1);IF +eingangsmaskenfehlerTHEN infeld(pruefstatus);return(1)ELSE +wertedeseingangsbildschirmsmerken;schulhalbjahrbestimmen;IF jgstangabeleer +THEN startjgst:=jgst0;endejgst:=jgst13ELSE startjgst:=int(vgljgst);endejgst:= +startjgstFI ;IF standardmaskenfeld(fnrfachanguebernehmen)<>""THEN +pruefendesfaecherangebots;IF ausgangsdatenfehlenTHEN standardmeldung( +meldnrkeinfaecherangebot,"");return(1)ELSE standardmeldung( +meldnrfragedatenuebernehmen,"");eingabefeldersperren(fnrfachanguebernehmen); +standardnprocFI ELSE pruefenderlehrveranstaltungen;IF ausgangsdatenfehlen +THEN standardmeldung(meldnrkeinelehrveranstaltungen,"");return(1)ELIF +gewhalbj=ersteshalbjahrAND startjgst=jgst13THEN standardmeldung( +meldnrungueltigeuebernahmejgst,"");infeld(fnrlehrverjgst);return(1)ELSE +standardmeldung(meldnrfragedatenuebernehmen,"");eingabefeldersperren( +fnrlehrveruebernehmen);standardnprocFI FI FI .pruefendesfaecherangebots: +ausgangsdatenfehlen:=FALSE ;putwert(fnrfangsj,gewschulj);putwert(fnrfanghj, +gewhalbj);putintwert(fnrfangjgst,startjgst);putintwert(fnrfanglfdnr,0);search +(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN ausgangsdatenfehlen:=TRUE +ELIF wert(fnrfanghj)<>gewhalbjCOR wert(fnrfangsj)<>gewschuljCOR intwert( +fnrfangjgst)>endejgstTHEN ausgangsdatenfehlen:=TRUE FI . +pruefenderlehrveranstaltungen:ausgangsdatenfehlen:=FALSE ;putwert(fnrlvsj, +aktschulj);putwert(fnrlvhj,akthalbj);putintwert(fnrlvjgst,startjgst);putwert( +fnrlvfachkennung,"");search(dnrlehrveranstaltungen,FALSE );IF dbstatus<>ok +THEN ausgangsdatenfehlen:=TRUE ELIF wert(fnrlvhj)<>akthalbjCOR wert(fnrlvsj) +<>aktschuljCOR intwert(fnrlvjgst)>endejgstTHEN ausgangsdatenfehlen:=TRUE FI . +END PROC lehrveranstaltungenuebernehmenstart;PROC eingabefeldersperren(INT +CONST fnrfreiesfeld):FOR ifnrFROM fnrbearbeitenUPTO feldanzmaskeeingangREP +IF ifnr<>fnrfreiesfeldTHEN feldschutz(ifnr)FI PER ;infeld(fnrfreiesfeld)END +PROC eingabefeldersperren;PROC eingabefelderfreigeben:FOR ifnrFROM +fnrbearbeitenUPTO feldanzmaskeeingangREP feldfrei(ifnr)PER END PROC +eingabefelderfreigeben;PROC lehrveranstaltungenuebernehmen(BOOL CONST +uebernehmen):INT VAR letztejgst:=-1;IF uebernehmenTHEN standardmeldung( +meldnrdatenwerdenuebernommen,"");IF standardmaskenfeld(fnrfachanguebernehmen) +<>""THEN evtlvorhandenelehrveranstaltungenloeschen; +neuelvausfaecherangebotschreibenELSE neuelvauslehrveranstaltungenschreibenFI +;evtlkurswahldatenbeimuebernehmenaktualisieren;IF +aktuelleshalbjahrzubearbeitenTHEN aenderungsvermerksetzen(wertaktuell)ELSE +aenderungsvermerksetzen(wertgeplant)FI ;standardmeldung( +meldnrdatenwurdenuebernommen,"")ELSE standardmeldung( +meldnrdatenwurdennichtuebernommen,"")FI ;eingabefelderfreigeben;return(2). +evtlkurswahldatenbeimuebernehmenaktualisieren:IF +aktuelleshalbjahrzubearbeitenOR gewhalbj=zweiteshalbjahrTHEN FOR gewjgstFROM +startjgstUPTO endejgstREP IF gewjgst>jgst10THEN kurswahlserverlvaktualisieren +(text(gewjgst),text(gewjgst),gewhalbj)FI ;PER ;ELSE FOR gewjgstFROM startjgst +UPTO endejgstREP IF gewjgst>=jgst10THEN kurswahlserverlvaktualisieren(text( +gewjgst),text(gewjgst+1),gewhalbj)FI ;PER ;FI . +evtlvorhandenelehrveranstaltungenloeschen: +sucheerstelehrveranstaltungzugewhalbj;WHILE lehrveranstaltungzuloeschenREP +meldungzumloeschenbeijgstwechsel;loeschevorhandenelehrveranstaltung; +suchenaechstelehrveranstaltungzugewhalbjPER . +sucheerstelehrveranstaltungzugewhalbj:putwert(fnrlvsj,gewschulj);putwert( +fnrlvhj,gewhalbj);putintwert(fnrlvjgst,startjgst);putwert(fnrlvfachkennung,"" +);search(dnrlehrveranstaltungen,FALSE );letztejgst:=-1;. +lehrveranstaltungzuloeschen:dbstatus=okCAND wert(fnrlvsj)=gewschuljCAND wert( +fnrlvhj)=gewhalbjCAND intwert(fnrlvjgst)<=endejgst. +loeschevorhandenelehrveranstaltung:delete(dnrlehrveranstaltungen). +meldungzumloeschenbeijgstwechsel:IF intwert(fnrlvjgst)<>letztejgstTHEN +letztejgst:=intwert(fnrlvjgst);standardmeldung( +meldnrlehrveranstaltungloeschen,text(letztejgst)+kennzhell)FI . +suchenaechstelehrveranstaltungzugewhalbj:succ(dnrlehrveranstaltungen). +neuelvausfaecherangebotschreiben:letztejgst:=-1;REP +lehrveranstaltungenzufaecherangebotschreiben; +suchenaechstesfaecherangebotzugewhalbjUNTIL faecherangebotabgehandeltPER . +lehrveranstaltungenzufaecherangebotschreiben:INT VAR satzanzahl:=intwert( +fnrfanganzlv);INT VAR isatz; +setzefestewerteausfaecherangebotfuerlehrveranstaltung; +meldungzuruebernahmebeijgstwechsel;FOR isatzFROM 1UPTO satzanzahlREP +setzevarwerteausfaecherangebotfuerlehrveranstaltung;insert( +dnrlehrveranstaltungen)PER .meldungzuruebernahmebeijgstwechsel:IF intwert( +fnrlvjgst)<>letztejgstTHEN letztejgst:=intwert(fnrlvjgst);standardmeldung( +meldnruebernehmenderjgst,text(letztejgst)+kennzhell)FI . +setzefestewerteausfaecherangebotfuerlehrveranstaltung:putwert(fnrlvsj, +gewschulj);putwert(fnrlvhj,gewhalbj);putintwert(fnrlvjgst,intwert(fnrfangjgst +));putwert(fnrlvparaphe,"");putwert(fnrlvart,wert(fnrfangart));putintwert( +fnrlvwochenstd,intwert(fnrfangwochenstd));putwert(fnrlvklgrp1,"");putwert( +fnrlvklgrp2,"");putwert(fnrlvklgrp3,"");putwert(fnrlvklgrp4,"");putwert( +fnrlvraumgrp1,"");putwert(fnrlvraumgrp2,"");. +setzevarwerteausfaecherangebotfuerlehrveranstaltung:TEXT VAR lvkennung:=text( +wert(fnrfangart),2)+textzweistellig(isatz);putwert(fnrlvfachkennung,text(wert +(fnrfangfach),fachlaenge)+lvkennung);putwert(fnrlvkopplung,textzweistellig( +intwert(fnrfangjgst))+textzweistellig(intwert(fnrfanglfdnr))+lvkennung);. +suchenaechstesfaecherangebotzugewhalbj:succ(dnrfaecherangebot). +faecherangebotabgehandelt:NOT (dbstatus=okCAND intwert(fnrfangjgst)<=endejgst +CAND wert(fnrfangsj)=gewschuljCAND wert(fnrfanghj)=gewhalbj). +neuelvauslehrveranstaltungenschreiben:lvsaetzezuaktuellenjgstindateischreiben +;evtlvorhandenelehrveranstaltungenloeschenvorbereiten; +evtlvorhandenelehrveranstaltungenloeschen; +lvsaetzeausdateizugeplantenjgstschreiben. +lvsaetzezuaktuellenjgstindateischreiben:forget(lvdateiname,quiet);lvdatei:= +sequentialfile(output,lvdateiname);standardmeldung(meldnrbittewarten,""); +holegueltigelehrveranstaltungen. +evtlvorhandenelehrveranstaltungenloeschenvorbereiten:IF gewhalbj= +ersteshalbjahrAND NOT jgstangabeleerTHEN IF startjgst>=jgst5THEN startjgst +INCR 1;endejgstINCR 1FI FI .lvsaetzeausdateizugeplantenjgstschreiben: +letztejgst:=-1;lvdatei:=sequentialfile(input,lvdateiname);WHILE NOT eof( +lvdatei)REP getline(lvdatei,lvdateizeile);restoretupel(dnrlehrveranstaltungen +,lvdateizeile);putwert(fnrlvhj,gewhalbj);IF gewhalbj=ersteshalbjahrTHEN +putwert(fnrlvsj,gewschulj);ijgst:=intwert(fnrlvjgst);IF ijgst>0THEN +putintwert(fnrlvjgst,ijgst+1);TEXT VAR bearbkopplung:=wert(fnrlvkopplung);IF +int(subtext(bearbkopplung,1,2))=ijgstTHEN putwert(fnrlvkopplung, +textzweistellig(ijgst+1)+subtext(bearbkopplung,3))FI ;FI ;FI ;IF intwert( +fnrlvjgst)>jgst13THEN LEAVE lvsaetzeausdateizugeplantenjgstschreibenELSE +meldungzuruebernahmebeijgstwechsel;insert(dnrlehrveranstaltungen)FI PER END +PROC lehrveranstaltungenuebernehmen;PROC holegueltigelehrveranstaltungen: +inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,aktschulj);putwert(fnrlvhj, +akthalbj);putintwert(fnrlvjgst,startjgst);search(dnrlehrveranstaltungen, +FALSE );statleseschleife(dnrlehrveranstaltungen,aktschulj,akthalbj,fnrlvsj, +fnrlvhj,PROC lehrveranstaltungindateieinlesen)END PROC +holegueltigelehrveranstaltungen;PROC lehrveranstaltungindateieinlesen(BOOL +VAR b):IF dbstatus<>0OR wert(fnrlvsj)<>aktschuljOR wert(fnrlvhj)<>akthalbjOR +intwert(fnrlvjgst)>endejgstTHEN b:=TRUE ELSE savetupel(dnrlehrveranstaltungen +,lvdateizeile);putline(lvdatei,lvdateizeile)FI END PROC +lehrveranstaltungindateieinlesen;PROC bearbeitunglehrveranstaltungen: +eingangsbehandlung(2);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return( +1)ELSE wertedeseingangsbildschirmsmerken;schulhalbjahrbestimmen; +zugriffauflehrveranstaltungenbestimmen;erstensatzlesen;IF +keinelehrveranstaltungengespeichertCAND bearbeitungallerjgstTHEN +standardmeldung(meldnrkeinelehrveranstaltungen,"");return(1)ELSE +standardstartproc(maskebearb);ueberschriftzeilezusammensetzen; +standardkopfmaskeaktualisieren(ueberschrift);bsfuellen;infeld( +ersteseingabefeld);standardnprocFI ;FI . +zugriffauflehrveranstaltungenbestimmen:IF fachangabeleerTHEN zugriff:= +ixlvsjhjkoppELIF jgstangabeleerTHEN zugriff:=ixlvsjhjkennELSE zugriff:= +dnrlehrveranstaltungenFI .erstensatzlesen:putwert(fnrlvsj,gewschulj);putwert( +fnrlvhj,gewhalbj);putintwert(fnrlvjgst,int(vgljgst));IF zugriff=ixlvsjhjkopp +THEN putwert(fnrlvkopplung,textzweistellig(int(vgljgst)))ELSE putwert( +fnrlvfachkennung,vglfach)FI ;jgstdesletztensatzes:=int(vgljgst);search( +zugriff,FALSE );leerenbszeigen:=NOT (dbstatus=okCAND wert(fnrlvhj)=gewhalbj +CAND wert(fnrlvsj)=gewschuljCAND (jgstangabeleerCOR intwert(fnrlvjgst)=int( +vgljgst))CAND (fachangabeleerCOR compress(subtext(wert(fnrlvfachkennung),1, +fachlaenge))=vglfach)).keinelehrveranstaltungengespeichert:dbstatus<>0. +ueberschriftzeilezusammensetzen:ueberschrift:=textueberschriftanfang; +ueberschriftCAT gewhalbj;ueberschriftCAT blankzeichen;ueberschriftCAT subtext +(gewschulj,1,2);ueberschriftCAT trennstrich;ueberschriftCAT subtext(gewschulj +,3,4).END PROC bearbeitunglehrveranstaltungen;BOOL PROC fachangabeleer: +vglfach=""END PROC fachangabeleer;BOOL PROC jgstangabeleer:vgljgst=""END +PROC jgstangabeleer;PROC bsfuellen:izeile:=0;IF NOT leerenbszeigenTHEN +startebildschirmblock(zugriff,zeilenanzahl-1);bildschirmblock(PROC satzmerken +,BOOL PROC (INT CONST )satzzubehandeln,0);IF dbstatus=0THEN succ(zugriff);IF +dbstatus<>0THEN inittupel(dnrlehrveranstaltungen)FI ELSE inittupel( +dnrlehrveranstaltungen)FI ;merkesatzalsnachfolgerELSE nffachkennung:=""FI ; +evtlleerzeilenhinzufuegen;werteausbszeileinstandardfeldersetzen;infeld( +erstestabellenfeld);standardfelderausgeben;.evtlleerzeilenhinzufuegen: +anzahlgezeigtezeilen:=izeile;WHILE izeile +int(vgljgst)THEN LEAVE satzzubehandelnWITH FALSE FI ;IF NOT fachangabeleer +CAND compress(subtext(wert(fnrlvfachkennung),1,fachlaenge))<>vglfachTHEN +LEAVE satzzubehandelnWITH FALSE FI ;TRUE .END PROC satzzubehandeln;PROC +satzmerken:izeileINCR 1;bszeile(izeile).jgst:=wert(fnrlvjgst); +jgstdesletztensatzes:=intwert(fnrlvjgst);bszeile(izeile).fach:=compress( +subtext(wert(fnrlvfachkennung),1,2));bszeile(izeile).kennung:=subtext(wert( +fnrlvfachkennung),3);bszeile(izeile).kopplung:=wert(fnrlvkopplung);bszeile( +izeile).art:=wert(fnrlvart);bszeile(izeile).klasse1:=wert(fnrlvklgrp1); +bszeile(izeile).klasse2:=wert(fnrlvklgrp2);bszeile(izeile).klasse3:=wert( +fnrlvklgrp3);bszeile(izeile).klasse4:=wert(fnrlvklgrp4);bszeile(izeile).wstd +:=wert(fnrlvwochenstd);.END PROC satzmerken;PROC lehrveranstaltungenspeichern +(BOOL CONST speichern):IF speichernTHEN plausipruefung;ELSE pruefstatus:=0FI +;IF pruefstatus<>0THEN infeld(pruefstatus);return(1)ELSE datenspeichern( +speichern);IF nachfolgesatzvorhandenTHEN holewertedesnachfolgersatzes;search( +dnrlehrveranstaltungen,TRUE );IF dbstatus<>0THEN search( +dnrlehrveranstaltungen,FALSE )FI ;izeile:=0;IF satzzubehandeln(izeile)THEN +changeindex;leerenbszeigen:=FALSE ;setzejgstfuerneuenbildschirm; +naechstenbildschirmzeigenELSE enter(2)FI ELIF letzteeingabezeilegefuelltTHEN +leerenbszeigen:=TRUE ;naechstenbildschirmzeigenELSE enter(2)FI ;FI . +nachfolgesatzvorhanden:nffachkennung<>"".letzteeingabezeilegefuellt: +standardmaskenfeld((zeilenanzahl-1)*felderprozeile+ersteseingabefeld)<>"". +holewertedesnachfolgersatzes:putwert(fnrlvsj,nfschulj);putwert(fnrlvhj, +nfhalbj);putwert(fnrlvjgst,nfjgst);putwert(fnrlvfachkennung,nffachkennung). +naechstenbildschirmzeigen:bsfuellen;infeld(ersteseingabefeld);return(1). +setzejgstfuerneuenbildschirm:izeile:=zeilenanzahl;WHILE +keinbezugaufletztensatzREP izeileDECR 1PER ;jgstdesletztensatzes:=int(bszeile +(izeile).jgst);.keinbezugaufletztensatz:bszeile(izeile).fach="".END PROC +lehrveranstaltungenspeichern;PROC datenspeichern(BOOL CONST speichern):IF +speichernTHEN standardmeldung(meldnrdatenspeichern,""); +datenspeicherungdurchfuehren;ELSE standardmeldung(meldnrdatennichtspeichern, +"");FI ;END PROC datenspeichern;PROC datenspeicherungdurchfuehren:BOOL VAR +aenderungsvermerkzusetzen:=FALSE ;FOR izeileFROM 1UPTO zeilenanzahlREP +holevergleichswerte;IF lvzeileloeschenTHEN aenderungszeileanzeigen; +aenderungsvermerkzusetzen:=TRUE ;altelvloeschenELIF lvzeileeinfuegenTHEN +aenderungszeileanzeigen;aenderungsvermerkzusetzen:=TRUE ;neuelveinfuegenELIF +lvzeileueberschreibenTHEN aenderungszeileanzeigen;aenderungsvermerkzusetzen:= +TRUE ;altelvupdateFI PER ;IF aenderungsvermerkzusetzenTHEN IF +aktuelleshalbjahrzubearbeitenTHEN aenderungsvermerksetzen(wertaktuell)ELSE +aenderungsvermerksetzen(wertgeplant)FI FI .holevergleichswerte:INT VAR +prueffnr:=fachfnrin(izeile);TEXT VAR prueffach:=standardmaskenfeld(prueffnr); +TEXT VAR altesfach:=bszeile(izeile).fach.lvzeileloeschen:prueffach=""CAND +altesfach<>"".altelvloeschen:setzealtesuchwerteindbpuffer;search( +dnrlehrveranstaltungen,TRUE );IF dbstatus=0THEN delete(dnrlehrveranstaltungen +);evtlkurswahldatenbeimbearbeitenaktualisierenFI .lvzeileeinfuegen:prueffach +<>""CAND altesfach="".neuelveinfuegen:setzeneuewerteindbpuffer; +setzenichtsichtbarewerteindbpuffer;insert(dnrlehrveranstaltungen); +evtlkurswahldatenbeimbearbeitenaktualisieren.lvzeileueberschreiben:NOT ( +standardmaskenfeld(prueffnr)=bszeile(izeile).fachCAND standardmaskenfeld( +prueffnr+1)=bszeile(izeile).kennungCAND standardmaskenfeld(prueffnr+2)= +bszeile(izeile).artCAND standardmaskenfeld(prueffnr+3)=bszeile(izeile). +klasse1CAND standardmaskenfeld(prueffnr+4)=bszeile(izeile).klasse2CAND +standardmaskenfeld(prueffnr+5)=bszeile(izeile).klasse3CAND standardmaskenfeld +(prueffnr+6)=bszeile(izeile).klasse4CAND standardmaskenfeld(prueffnr+7)= +bszeile(izeile).wstd).altelvupdate:setzealtesuchwerteindbpuffer;search( +dnrlehrveranstaltungen,TRUE );setzeneuewerteindbpuffer;IF standardmaskenfeld( +prueffnr)<>bszeile(izeile).fachCOR compress(standardmaskenfeld(prueffnr+1))<> +bszeile(izeile).kennungTHEN setzenichtsichtbarewerteindbpufferFI ;update( +dnrlehrveranstaltungen);evtlkurswahldatenbeimbearbeitenaktualisieren. +setzealtesuchwerteindbpuffer:putwert(fnrlvsj,gewschulj);putwert(fnrlvhj, +gewhalbj);putwert(fnrlvjgst,bszeile(izeile).jgst);putwert(fnrlvfachkennung, +text(altesfach,fachlaenge)+bszeile(izeile).kennung).setzeneuewerteindbpuffer: +putwert(fnrlvsj,gewschulj);putwert(fnrlvhj,gewhalbj);putwert(fnrlvjgst, +bszeile(izeile).jgst);putwert(fnrlvfachkennung,neuekennung);putwert(fnrlvart, +standardmaskenfeld(prueffnr+2));putwert(fnrlvklgrp1,standardmaskenfeld( +prueffnr+3));putwert(fnrlvklgrp2,standardmaskenfeld(prueffnr+4));putwert( +fnrlvklgrp3,standardmaskenfeld(prueffnr+5));putwert(fnrlvklgrp4, +standardmaskenfeld(prueffnr+6));putwert(fnrlvwochenstd,standardmaskenfeld( +prueffnr+7)).setzenichtsichtbarewerteindbpuffer:putwert(fnrlvkopplung, +neuekopplung);putwert(fnrlvparaphe,"");putwert(fnrlvraumgrp1,"");putwert( +fnrlvraumgrp2,"").neuekennung:text(prueffach,fachlaenge)+compress( +standardmaskenfeld(prueffnr+1)).neuekopplung:textzweistellig(int(bszeile( +izeile).jgst))+neuekennung.END PROC datenspeicherungdurchfuehren;PROC +evtlkurswahldatenbeimbearbeitenaktualisieren:IF intwert(fnrlvjgst)>jgst10 +THEN IF aktuelleshalbjahrzubearbeitenOR gewhalbj=zweiteshalbjahrTHEN +kurswahlserverlvaktualisieren(wert(fnrlvjgst),wert(fnrlvjgst),gewhalbj)ELSE +kurswahlserverlvaktualisieren(text(intwert(fnrlvjgst)-1),wert(fnrlvjgst), +gewhalbj)FI FI END PROC evtlkurswahldatenbeimbearbeitenaktualisieren;PROC +aenderungszeileanzeigen:infeld((izeile-1)*felderprozeile+ersteseingabefeld) +END PROC aenderungszeileanzeigen;PROC lehrveranstaltungenzeileeinfuegen(BOOL +CONST zeilerein):INT VAR erstefnr;IF zeilereinTHEN zeileeinfuegenELSE +zeileloeschenFI ;return(1).zeileeinfuegen:aktzeile:=bearbeitungszeilezufeld( +infeld);IF aktzeile=zeilenanzahlTHEN standardmeldung( +meldnrletztezeilenichteinfuegen,"");LEAVE zeileeinfuegenFI ;IF bszeile( +zeilenanzahl).fach<>""THEN merkeverdraengtensatzalsnachfolgesatz; +anzahlgezeigtezeilen:=zeilenanzahlFI ;FOR izeileFROM zeilenanzahl-1DOWNTO +aktzeile+1REP zeileiminternenpufferverschieben; +wertederzeileaufdembildschirmverschiebenPER ;izeile:=aktzeile+1; +leerzeileschreiben;jgstineingefuegterzeilevermerken;neuezeilenausgeben. +merkeverdraengtensatzalsnachfolgesatz:nfschulj:=gewschulj;nfhalbj:=gewhalbj; +nfjgst:=bszeile(zeilenanzahl).jgst;nffachkennung:=text(bszeile(zeilenanzahl). +fach,fachlaenge)+bszeile(zeilenanzahl).kennung. +zeileiminternenpufferverschieben:bszeile(izeile+1).jgst:=bszeile(izeile).jgst +;bszeile(izeile+1).fach:=bszeile(izeile).fach;bszeile(izeile+1).kennung:= +bszeile(izeile).kennung;bszeile(izeile+1).kopplung:=bszeile(izeile).kopplung; +bszeile(izeile+1).art:=bszeile(izeile).art;bszeile(izeile+1).klasse1:=bszeile +(izeile).klasse1;bszeile(izeile+1).klasse2:=bszeile(izeile).klasse2;bszeile( +izeile+1).klasse3:=bszeile(izeile).klasse3;bszeile(izeile+1).klasse4:=bszeile +(izeile).klasse4;bszeile(izeile+1).wstd:=bszeile(izeile).wstd;. +wertederzeileaufdembildschirmverschieben:FOR ifnrFROM erstesfeldderzeileUPTO +letztesfeldderzeileREP standardmaskenfeld(standardmaskenfeld(ifnr),ifnr+ +felderprozeile)PER .erstesfeldderzeile:(izeile-1)*felderprozeile+ +erstestabellenfeld.letztesfeldderzeile:erstesfeldderzeile+felderprozeile-1. +jgstineingefuegterzeilevermerken:bszeile(izeile).jgst:=bszeile(aktzeile).jgst +;bszeile(izeile).fach:="";bszeile(izeile).kennung:="";bszeile(izeile). +kopplung:="";bszeile(izeile).art:="";bszeile(izeile).klasse1:="";bszeile( +izeile).klasse2:="";bszeile(izeile).klasse3:="";bszeile(izeile).klasse4:=""; +bszeile(izeile).wstd:="";standardmaskenfeld(textzweistellig(int(bszeile( +izeile).jgst)),erstefnr);.zeileloeschen:izeile:=bearbeitungszeilezufeld( +infeld);leerzeileschreiben;neuezeilenausgeben.leerzeileschreiben:erstefnr:= +erstesfeldderzeile;standardmaskenfeld(" ",erstefnr);FOR ifnrFROM erstefnr+1 +UPTO letztesfeldderzeileREP standardmaskenfeld("",ifnr)PER . +neuezeilenausgeben:infeld(erstefnr);standardfelderausgeben;infeld(erstefnr+1) +.END PROC lehrveranstaltungenzeileeinfuegen;INT PROC bearbeitungszeilezufeld( +INT CONST feldnr):((feldnr-erstestabellenfeld)DIV felderprozeile)+1END PROC +bearbeitungszeilezufeld;PROC eingangsbehandlung(INT CONST plausiart):LET +uebernehmen=1,bearbeiten=2;BOOL VAR ok;reinitparsing;eingangsmaskenfehler:= +FALSE ;ankreuzfelderpruefen;IF mehralseineauswahlangekreuztTHEN +standardmeldung(meldnrungueltigeauswahl,"");pruefstatus:=fnrbearbeiten; +eingangsmaskenfehler:=TRUE ;LEAVE eingangsbehandlungFI ;IF +uebernehmenpruefungTHEN IF ankreuz1THEN ankreuzfehler(fnrbearbeiten);LEAVE +eingangsbehandlungFI ELIF bearbeitenpruefungTHEN IF ankreuz2THEN +ankreuzfehler(fnrfachanguebernehmen);LEAVE eingangsbehandlungELIF ankreuz3 +THEN ankreuzfehler(fnrlehrveruebernehmen);LEAVE eingangsbehandlungFI FI ;IF +bearbeitenpruefungTHEN standardpruefe(5,fnrbearbaktsj,fnrbearbgeplsj,0,"", +pruefstatus);IF pruefstatus<>0THEN eingangsmaskenfehler:=TRUE ;LEAVE +eingangsbehandlungELSE jgstpruefung(fnrbearbjgst,ok);IF NOT okTHEN jgstfehler +(fnrbearbjgst);LEAVE eingangsbehandlungFI ;vgljgst:=standardmaskenfeld( +fnrbearbjgst);vglfach:=compress(standardmaskenfeld(fnrbearbfach))FI ELIF +ankreuz2THEN standardpruefe(5,fnrfachangaktsj,fnrfachanggeplsj,0,"", +pruefstatus);IF pruefstatus<>0THEN eingangsmaskenfehler:=TRUE ;LEAVE +eingangsbehandlungELSE jgstpruefung(fnrfachangjgst,ok);IF NOT okTHEN +jgstfehler(fnrfachangjgst);LEAVE eingangsbehandlungELSE vgljgst:= +standardmaskenfeld(fnrfachangjgst)FI ;FI ELSE jgstpruefung(fnrlehrverjgst,ok) +;IF NOT okTHEN jgstfehler(fnrlehrverjgst);LEAVE eingangsbehandlungELSE +vgljgst:=standardmaskenfeld(fnrlehrverjgst)FI ;FI ;IF ankreuz1THEN FOR ifnr +FROM fnrfachanguebernehmenUPTO fnrlehrverjgstREP IF standardmaskenfeld(ifnr) +<>""THEN eintragfehler(ifnr);LEAVE eingangsbehandlungFI PER ELIF ankreuz2 +THEN FOR ifnrFROM fnrbearbeitenUPTO fnrbearbfachREP IF standardmaskenfeld( +ifnr)<>""THEN eintragfehler(ifnr);LEAVE eingangsbehandlungFI PER ;IF +standardmaskenfeld(fnrlehrverjgst)<>""THEN eintragfehler(fnrlehrverjgst); +LEAVE eingangsbehandlungFI ELSE FOR ifnrFROM fnrbearbeitenUPTO fnrfachangjgst +REP IF standardmaskenfeld(ifnr)<>""THEN eintragfehler(ifnr);LEAVE +eingangsbehandlungFI PER FI .ankreuzfelderpruefen:INT VAR summe:=0;IF +ankreuz1THEN summeINCR 1FI ;IF ankreuz2THEN summeINCR 1FI ;IF ankreuz3THEN +summeINCR 1FI .mehralseineauswahlangekreuzt:summe<>1.ankreuz1: +standardmaskenfeld(fnrbearbeiten)<>"".ankreuz2:standardmaskenfeld( +fnrfachanguebernehmen)<>"".ankreuz3:standardmaskenfeld(fnrlehrveruebernehmen) +<>"".uebernehmenpruefung:plausiart=uebernehmen.bearbeitenpruefung:plausiart= +bearbeiten.END PROC eingangsbehandlung;PROC ankreuzfehler(INT CONST +fehlerfeld):pruefstatus:=fehlerfeld;eingangsmaskenfehler:=TRUE ; +standardmeldung(meldnrfalschetastezuankreuz,"").END PROC ankreuzfehler;PROC +jgstpruefung(INT CONST fnrpruefjgst,BOOL VAR ok):IF standardmaskenfeld( +fnrpruefjgst)=""THEN bearbeitungallerjgst:=TRUE ;ok:=TRUE ;ELSE +bearbeitungallerjgst:=FALSE ;gewjgst:=int(standardmaskenfeld(fnrpruefjgst)); +ok:=lastconversionokCAND (gewjgst=jgst0OR (gewjgst>=jgst5AND gewjgst<=jgst13) +)FI END PROC jgstpruefung;PROC jgstfehler(INT CONST fehlerfeld):pruefstatus:= +fehlerfeld;eingangsmaskenfehler:=TRUE ;standardmeldung(meldnrfehlerhaftejgst, +"").END PROC jgstfehler;PROC eintragfehler(INT CONST fehlerfeld):pruefstatus +:=fehlerfeld;eingangsmaskenfehler:=TRUE ;standardmeldung( +meldnrfalscheausfuellung,"").END PROC eintragfehler;PROC plausipruefung: +pruefstatus:=0;facheintraegepruefen;IF eingabefehlerTHEN LEAVE plausipruefung +FI ;datenkonsistenzpruefen;IF eingabefehlerTHEN LEAVE plausipruefungFI . +eingabefehler:pruefstatus<>0.END PROC plausipruefung;PROC +facheintraegepruefen:anzahleingegebenezeilen:=0;geprueftefaecher:=trenner;IF +gueltigeschuelergruppen=""THEN holegueltigeschuelergruppenFI ;IF +gueltigeklassengruppen=""THEN holegueltigeklassengruppenFI ;IF gueltigelvart= +""THEN holegueltigelvartenFI ;FOR izeileFROM 1UPTO zeilenanzahlREP IF +fachfehlerTHEN LEAVE facheintraegepruefenFI PER .fachfehler:INT VAR prueffnr +:=fachfnrin(izeile);TEXT VAR prueffach:=standardmaskenfeld(prueffnr);IF +prueffachleerTHEN IF eintraginfolgefelderderzeileTHEN pruefstatus:=prueffnr; +standardmeldung(meldnrkeinfachzuanderenangaben,"");TRUE ELSE FALSE FI ELIF +prueffachungueltigTHEN pruefstatus:=prueffnr;standardmeldung( +meldnrungueltigesfach,"");TRUE ELIF length(standardmaskenfeld(prueffnr+ +incrfuerkennung))>kennunglaengeTHEN pruefstatus:=prueffnr+incrfuerkennung; +standardmeldung(meldnrkennungzulang,"");TRUE ELIF compress(standardmaskenfeld +(prueffnr+incrfuerkennung))=""THEN pruefstatus:=prueffnr+incrfuerkennung; +standardmeldung(meldnrbitteangabegenauer,"");TRUE ELIF lvartungueltigTHEN +TRUE ELIF klassengruppenungueltigTHEN TRUE ELIF wochenstundenungueltigTHEN +pruefstatus:=prueffnr+incrfuerwstd;TRUE ELSE anzahleingegebenezeilenINCR 1; +FALSE FI .prueffachleer:prueffach="".eintraginfolgefelderderzeile: +standardmaskenfeld(prueffnr+1)<>""COR standardmaskenfeld(prueffnr+2)<>""COR +standardmaskenfeld(prueffnr+3)<>""COR standardmaskenfeld(prueffnr+4)<>""COR +standardmaskenfeld(prueffnr+5)<>""COR standardmaskenfeld(prueffnr+6)<>""COR +standardmaskenfeld(prueffnr+7)<>"".prueffachungueltig:IF +fachkuerzelschongeprueftTHEN FALSE ELIF fachimfachbestandTHEN +geprueftefaecherCAT prueffach;geprueftefaecherCAT trenner;FALSE ELSE TRUE FI +.fachkuerzelschongeprueft:pos(geprueftefaecher,trenner+prueffach+trenner)>0. +fachimfachbestand:putwert(fnrffach,prueffach);search(dnrfaecher,TRUE ); +dbstatus=0.lvartungueltig:IF pos(gueltigelvart,trenner+standardmaskenfeld( +prueffnr+incrfuerlvart)+trenner)=0THEN standardmeldung(meldnrungueltigeart,"" +);pruefstatus:=prueffnr+incrfuerlvart;TRUE ELSE FALSE FI . +klassengruppenungueltig:pruefjgst:=int(bszeile(izeile).jgst);FOR ifnrFROM +prueffnr+incrfuerklassengranfangUPTO prueffnr+incrfuerklassengrendeREP +pruefklasse:=standardmaskenfeld(ifnr);IF klassengruppeungueltigTHEN +standardmeldung(meldnrungueltigeklassengruppe,"");pruefstatus:=ifnr;LEAVE +klassengruppenungueltigWITH TRUE FI PER ;FALSE .klassengruppeungueltig:IF +pruefklasse=""THEN FALSE ELIF pruefklasseistschuelergruppeTHEN FALSE ELIF +pruefklasseistklassengruppeTHEN FALSE ELIF pruefklasseistgueltigejgstTHEN +FALSE ELSE TRUE FI .pruefklasseistschuelergruppe:pos(gueltigeschuelergruppen, +trenner+bszeile(izeile).jgst+pruefklasse+trenner)>0. +pruefklasseistklassengruppe:IF pos(gueltigeklassengruppen,trenner+pruefklasse ++trenner)=0THEN FALSE ELIF pruefjgst=jgst0THEN TRUE ELSE putwert( +fnrkgklassengrp,pruefklasse);search(dnrklassengruppen,TRUE );IF dbstatus<>0 +THEN FALSE ELSE sugruppen:=wert(fnrkgschuelergrp);laengesugruppen:=length( +sugruppen);possugruppe:=1;WHILE possugruppepruefjgst +THEN LEAVE pruefklasseistklassengruppeWITH FALSE FI ;possugruppeINCR +laengeeinersugruppePER ;TRUE FI FI .pruefklasseistgueltigejgst:gueltigejgst:= +FALSE ;pruefbez:=int(pruefklasse);IF lastconversionokTHEN IF pruefbez>=jgst5 +CAND pruefbez<=jgst13THEN IF pruefjgst=jgst0OR pruefjgst=pruefbezTHEN +gueltigejgst:=TRUE FI FI FI ;gueltigejgst.wochenstundenungueltig: +standardpruefe(1,prueffnr+incrfuerwstd,0,0,"",pruefstatus);IF pruefstatus=0 +THEN standardpruefe(2,prueffnr+incrfuerwstd,0,0,"",pruefstatus);pruefstatus<> +0ELSE TRUE FI .END PROC facheintraegepruefen;INT PROC fachfnrin(INT CONST +zeilennr):(zeilennr-1)*felderprozeile+ersteseingabefeldEND PROC fachfnrin; +PROC datenkonsistenzpruefen:FOR izeileFROM 1UPTO zeilenanzahlREP IF +zeileungueltigTHEN pruefstatus:=prueffnr;standardmeldung( +meldnrlehrveranstaltunggibtsschon,"");LEAVE datenkonsistenzpruefenFI PER . +zeileungueltig:IF leerzeileTHEN FALSE ELIF +zeileistimschluesselunveraendertgebliebenTHEN FALSE ELSE +ergebnisderpruefungzeileschongespeichertFI .leerzeile:INT VAR prueffnr:= +fachfnrin(izeile);TEXT VAR prueffach:=standardmaskenfeld(prueffnr);prueffach= +"".zeileistimschluesselunveraendertgeblieben:standardmaskenfeld(prueffnr)= +bszeile(izeile).fachCAND compress(standardmaskenfeld(prueffnr+1))=bszeile( +izeile).kennung.ergebnisderpruefungzeileschongespeichert: +neuewerteindbpuffersetzen;search(dnrlehrveranstaltungen,TRUE );dbstatus=0. +neuewerteindbpuffersetzen:putwert(fnrlvsj,gewschulj);putwert(fnrlvhj,gewhalbj +);putwert(fnrlvjgst,bszeile(izeile).jgst);putwert(fnrlvfachkennung,text( +prueffach,fachlaenge)+compress(standardmaskenfeld(prueffnr+1))).END PROC +datenkonsistenzpruefen;PROC schulhalbjahrbestimmen:IF akthalbj=""THEN +akthalbj:=schulkenndatum(texthalbj);aktschulj:=schulkenndatum(textschulj)FI ; +IF standardmaskenfeld(fnrlehrveruebernehmen)<>""THEN +aktuelleshalbjahrzubearbeiten:=FALSE ELSE aktuelleshalbjahrzubearbeiten:= +standardmaskenfeld(fnrbearbaktsj)<>""OR standardmaskenfeld(fnrfachangaktsj)<> +""FI ;gewhalbj:=akthalbj;gewschulj:=aktschulj;IF NOT +aktuelleshalbjahrzubearbeitenTHEN geplanteshjundsjberechnen(gewhalbj, +gewschulj)FI END PROC schulhalbjahrbestimmen;PROC holegueltigeschuelergruppen +:gueltigeschuelergruppen:=trenner;inittupel(dnraktschuelergruppen); +statleseschleife(dnraktschuelergruppen,gewschulj,gewhalbj,fnrsgrpsj,fnrsgrphj +,PROC schuelergruppelesen)END PROC holegueltigeschuelergruppen;PROC +schuelergruppelesen(BOOL VAR b):IF dbstatus<>0OR wert(fnrsgrpsj)<>gewschulj +OR wert(fnrsgrphj)<>gewhalbjTHEN b:=TRUE ELSE gueltigeschuelergruppenCAT wert +(fnrsgrpjgst);gueltigeschuelergruppenCAT wert(fnrsgrpkennung); +gueltigeschuelergruppenCAT trennerFI END PROC schuelergruppelesen;PROC +holegueltigeklassengruppen:gueltigeklassengruppen:=trenner;inittupel( +dnrklassengruppen);statleseschleife(dnrklassengruppen,"","",fnrkgklassengrp, +fnrkgklassengrp,PROC klassengruppelesen)END PROC holegueltigeklassengruppen; +PROC klassengruppelesen(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE +gueltigeklassengruppenCAT wert(fnrkgklassengrp);gueltigeklassengruppenCAT +trennerFI END PROC klassengruppelesen;PROC holegueltigelvarten:gueltigelvart +:=trenner;inittupel(dnrschluessel);statleseschleife(dnrschluessel,artbestand, +"",fnrschlsachgebiet,fnrschlschluessel,PROC holelvart)END PROC +holegueltigelvarten;PROC holelvart(BOOL VAR b):IF wert(fnrschlsachgebiet)> +artbestandCOR dbstatus<>0THEN b:=TRUE ELSE gueltigelvartCAT wert( +fnrschlschluessel);gueltigelvartCAT trennerFI END PROC holelvart;TEXT PROC +textzweistellig(INT CONST i):IF i<10THEN "0"+text(i)ELSE text(i)FI END PROC +textzweistellig;PROC initfelderdeseingangsbildschirms:INT VAR i;FOR iFROM 1 +UPTO feldanzmaskeeingangREP feldbs1(i):=""PER END PROC +initfelderdeseingangsbildschirms;PROC wertedeseingangsbildschirmsmerken:INT +VAR i;letztecursorfnr:=infeld;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1( +i):=standardmaskenfeld(i)PER END PROC wertedeseingangsbildschirmsmerken;PROC +wertedeseingangsbildschirmsholen:INT VAR i;FOR iFROM 1UPTO +feldanzmaskeeingangREP standardmaskenfeld(feldbs1(i),i)PER END PROC +wertedeseingangsbildschirmsholen;PROC initbszeilepuffer:FOR izeileFROM 1UPTO +zeilenanzahlREP bszeile(izeile).jgst:="";bszeile(izeile).fach:="";bszeile( +izeile).kennung:="";bszeile(izeile).art:="";bszeile(izeile).klasse1:=""; +bszeile(izeile).klasse2:="";bszeile(izeile).klasse3:="";bszeile(izeile). +klasse4:="";bszeile(izeile).wstd:="";PER END PROC initbszeilepuffer;END +PACKET lehrveranstaltungenbenennen + diff --git a/app/schulis/2.2.1/src/4.liste ausgewaehlter kopplungen drucken b/app/schulis/2.2.1/src/4.liste ausgewaehlter kopplungen drucken new file mode 100644 index 0000000..3b86dd8 --- /dev/null +++ b/app/schulis/2.2.1/src/4.liste ausgewaehlter kopplungen drucken @@ -0,0 +1,72 @@ +PACKET listeausgewaehlterkopplungendruckenDEFINES +listekopplungenmitanzlverstellen,listekopplungenmitanzlvdrucken:LET feldanzlv +=2,feldakthj=3,anzkopfzeilen=9,anzzeilen=45,ausgparam="#",leerzeile=" ", +meldungbearbwird=352,meldunglistedrucken=58,meldunglisteaufbereiten=7, +meldungwarten=69,meldungkeinedaten=68,meldungfalscherwert=54,meldungkeinelv= +326,dateiname="Liste der Kopplungen",zwdateiname="zwischenspeicherung", +praefix=" ",ueberschrift="Liste aller Kopplungen",kopfzeile= +"Kopplung Anzahl gekoppelter Lehrveranstaltungen",stdkopf= +" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 >14", +unterstrich= +"----------+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---", +spaltentrenner=": : : : : : : : : : : : : : : " +,spaltentrenner1= +": x : : : : : : : : : : : : : : ", +spaltentrennerl= +": : : : : : : : : : : : : : : x ",schuljahr= +"Schuljahr",halbjahr="Schulhalbjahr",schulname="Schulname",schulort= +"Schulort";TEXT VAR schj,schhj,aktkopplung:="",postfix:="",anzseiten, +ueberschriftanhang,anzahllv:="",neuerkopf:="";INT VAR i,j,anzlv,anwanzlv, +spaltenindex,anzs;BOOL VAR erstekopplung:=TRUE ;FILE VAR datei,zwdatei;PROC +listekopplungenmitanzlverstellen:standardmeldung(meldungwarten,"");schj:= +schulkenndatum(schuljahr);schhj:=schulkenndatum(halbjahr);IF +standardmaskenfeld(feldakthj)=""THEN geplanteshjundsjberechnen(schhj,schj)FI +;anzahllv:=standardmaskenfeld(feldanzlv);IF anzahllv<>""THEN anwanzlv:=int( +anzahllv);IF lastconversionokTHEN IF anwanzlv<1COR anwanzlv>99THEN +fehlermeldungfalscherwertFI ELSE fehlermeldungfalscherwertFI ; +ueberschriftanhang:=" ab "+text(anwanzlv)+" Lehrveranstaltungen";ELSE +anwanzlv:=1;ueberschriftanhang:=""FI ;spaltenindex:=anwanzlv-1;inittupel( +dnrlehrveranstaltungen);IF records(dnrlehrveranstaltungen)=0.0THEN +standardmeldung(meldungkeinelv,"");return(1)ELSE bereiteprotokollvor;dbstatus +(0);erstekopplung:=TRUE ;aktkopplung:="";anzlv:=1;statleseschleife( +ixlvsjhjkopp,schj,schhj,fnrlvsj,fnrlvhj,PROC holekopplungen);IF lines(datei)= +anzkopfzeilenTHEN standardmeldung(meldungkeinedaten,"");return(1);ELSE +zeigedatei(dateiname,"vr")FI FI .fehlermeldungfalscherwert:standardmeldung( +meldungfalscherwert,"");return(1);LEAVE listekopplungenmitanzlverstellen. +bereiteprotokollvor:standardmeldung(meldunglisteaufbereiten,"");forget( +dateiname,quiet);datei:=sequentialfile(output,dateiname);forget(zwdateiname, +quiet);zwdatei:=sequentialfile(output,zwdateiname);schreibkopf(datei).END +PROC listekopplungenmitanzlverstellen;PROC schreibkopf(FILE VAR dat):INT VAR +k;putline(dat,schulkenndatum(schulname));putline(dat,text(schulkenndatum( +schulort),65)+date);putline(dat,leerzeile);putline(dat,ueberschrift+ +ueberschriftanhang);putline(dat,"Schuljahr 19"+text(schj,2)+"/"+subtext(schj +,3)+" "+schhj+". Halbjahr");putline(dat,leerzeile);putline(dat,kopfzeile); +IF anwanzlv=1THEN putline(dat,stdkopf)ELSE neuerkopf:=praefix;FOR kFROM 1 +UPTO 14REP neuerkopfCAT text(anwanzlv-1+k,4)PER ;neuerkopfCAT " >"+text( +anwanzlv+13);putline(dat,neuerkopf)FI ;putline(dat,unterstrich).END PROC +schreibkopf;PROC schreibfuss(INT CONST nr):putline(zwdatei,leerzeile);putline +(zwdatei,leerzeile);putline(zwdatei,text(nr,70)+"/"+anzseiten);putline( +zwdatei,"#page#")END PROC schreibfuss;PROC holekopplungen(BOOL VAR b):IF wert +(fnrlvsj)<>schjCOR wert(fnrlvhj)<>schhjCOR dbstatus<>0THEN dbstatus(1);b:= +TRUE ELIF aktkopplung<>wert(fnrlvkopplung)THEN gibeintragaus;aktkopplung:= +wert(fnrlvkopplung);standardmeldung(meldungbearbwird,aktkopplung+ausgparam); +anzlv:=1ELSE anzlvINCR 1FI .gibeintragaus:IF erstekopplungTHEN erstekopplung +:=FALSE ELIF anzlv=anwanzlvTHEN putline(datei,text(aktkopplung,10)+ +spaltentrenner1)ELIF anzlv>anwanzlv+13THEN putline(datei,text(aktkopplung,10) ++spaltentrennerl)ELIF anzlv>anwanzlvCAND anzlv0THEN anzsINCR 1FI ;anzseiten:=text(anzs,2).giballeseitenaus: +toline(datei,anzkopfzeilen+1);FOR iFROM 1UPTO volleseitenREP schreibkopf( +zwdatei);FOR jFROM 1UPTO anzzeilenREP readrecord(datei,zeile);down(datei); +putline(zwdatei,zeile)PER ;schreibfuss(i)PER ;IF restzeilen<>0THEN +schreibkopf(zwdatei);FOR iFROM 1UPTO restzeilenREP readrecord(datei,zeile); +down(datei);putline(zwdatei,zeile)PER ;FOR iFROM restzeilen+1UPTO anzzeilen +REP putline(zwdatei,leerzeile)PER ;schreibfuss(anzs)FI ;print(zwdateiname); +enter(2).END PROC listekopplungenmitanzlvdrucken;END PACKET +listeausgewaehlterkopplungendrucken; + diff --git a/app/schulis/2.2.1/src/4.listen.aufsichtsplan b/app/schulis/2.2.1/src/4.listen.aufsichtsplan new file mode 100644 index 0000000..ba9c597 --- /dev/null +++ b/app/schulis/2.2.1/src/4.listen.aufsichtsplan @@ -0,0 +1,78 @@ +PACKET aufsichtsplandruckenDEFINES aufsichtsplanmaskebearbeiten, +aufsichtsplanggferstellen,aufsichtsplanzeigen,aufsichtsplandrucken:LET maske= +"ms aufsichtsplan drucken eingang",mnrlistewirderstellt=7, +mnrlistewirdgedruckt=58,mnrbittewarten=69,mnrlistewirdaufbereitet=190, +mnrkeinedatenimbestand=68,blank=" ",sixblanks=" ";INT CONST fnr2aktsj:=2 +,fnr3ausgbs:=3,fnr4ausgdr:=4;INT VAR druckzeilenzahl;TEXT VAR +gesamtueberschrift,ueberschrift2,halbjahr,schuljahr,sjhjaufber,altertag;TEXT +CONST ueberschrift1:="Aufsicht Aufsichtsorte ",ueberschrift3:=7*"----------" ++blank,aufsichtsorte:="c02 aufsichtsorte";FILE VAR showdatei,druckdatei;LET +niltext="",maxaufsichtszeiten=90,maxorteprozeile=10;ROW maxaufsichtszeiten +TEXT VAR zeiten;ROW maxorteprozeileTEXT VAR ortejezeile;BOOL VAR keinedatenda +;INT VAR status,zaehler,anzahlzeiten,anzahlorte;BOOL VAR bildschirmausgabe; +PROC aufsichtsplanmaskebearbeiten:standardvproc(maske);END PROC +aufsichtsplanmaskebearbeiten;PROC aufsichtsplanggferstellen:standardpruefe(5, +fnr3ausgbs,fnr4ausgdr,0,niltext,status);IF status<>0THEN infeld(status); +return(1)ELSE bildschirmausgabe:=standardmaskenfeld(fnr4ausgdr)=niltext; +standardmeldung(mnrbittewarten,niltext);ggfdatenmerkenundshowdateierstellen; +IF keinedatendaTHEN standardmeldung(mnrkeinedatenimbestand,niltext);return(1) +ELSE IF bildschirmausgabeTHEN aufsichtsplanzeigenELSE aufsichtsplandrucken(0) +FI ;FI ;FI ;.ggfdatenmerkenundshowdateierstellen:halbjahr:=schulkenndatum( +"Schulhalbjahr");schuljahr:=schulkenndatum("Schuljahr");IF standardmaskenfeld +(fnr2aktsj)=niltextTHEN geplanteshjundsjberechnen(halbjahr,schuljahr)FI ; +sjhjaufber:=subtext(schuljahr,1,2)+"/";sjhjaufberCAT subtext(schuljahr,3,4)+ +" ";sjhjaufberCAT halbjahr;zaehler:=0;keinedatenda:=FALSE ;inittupel( +dnraufsichtszeiten);exactmatch(FALSE );statleseschleife(dnraufsichtszeiten, +schuljahr,halbjahr,fnrazsj,fnrazhj,PROC aufsichtszeitenmerken);keinedatenda:= +anzahlzeiten=0;IF NOT keinedatendaTHEN ggfdiezehnerstenortelesenFI ;. +ggfdiezehnerstenortelesen:zaehler:=0;anzahlorte:=0;inittupel(dnrschluessel); +putwert(fnrschlsachgebiet,aufsichtsorte);search(dnrschluessel,FALSE );IF +dbstatus<>0OR wert(fnrschlsachgebiet)<>aufsichtsorteTHEN keinedatenda:=TRUE ; +ELSE maximalzehnortemerkenundueberschriftenbasteln;standardmeldung( +mnrlistewirderstellt,niltext);TEXT CONST namedershowdatei:="Aufsichtsplan : " ++sjhjaufber+". Halbj.";forget(namedershowdatei,quiet);showdatei:= +sequentialfile(output,namedershowdatei);inittupel(dnraufsichtsplan);putwert( +fnrapsj,schuljahr);putwert(fnraphj,halbjahr); +prozeitproorteintraegeausaufsichtsplaninshowdatei;IF anzahlorte= +maxorteprozeileTHEN WHILE wert(fnrschlsachgebiet)=aufsichtsorteAND dbstatus<> +3REP anzahlorte:=0;zaehler:=0;maximalzehnortemerkenundueberschriftenbasteln; +prozeitproorteintraegeausaufsichtsplaninshowdatei;PER FI ;FI ;END PROC +aufsichtsplanggferstellen;PROC maximalzehnortemerkenundueberschriftenbasteln: +ueberschrift2:="Tag Nr. ";WHILE dbstatus<>3AND wert(fnrschlsachgebiet)= +aufsichtsorteAND zaehler0OR wert(fnrazhj)<>halbjahrTHEN b:=TRUE ;ELSE +zaehlerINCR 1;zeiten(zaehler):=wert(fnrazaufsichtszeit);FI ;anzahlzeiten:= +zaehlerEND PROC aufsichtszeitenmerken;PROC +prozeitproorteintraegeausaufsichtsplaninshowdatei:INT VAR hilfszaehler;TEXT +VAR hilfstext,tag,aufsichtsnr,zeile;putline(showdatei,ueberschrift1);putline( +showdatei,ueberschrift2);putline(showdatei,ueberschrift3);altertag:="";FOR +zaehlerFROM 1UPTO anzahlzeitenREP hilfstext:=zeiten(zaehler);putwert( +fnrapaufsichtszeit,hilfstext);IF length(hilfstext)=2THEN aufsichtsnr:=" "; +aufsichtsnrCAT subtext(hilfstext,2,2);ELSE aufsichtsnr:=subtext(hilfstext,2,3 +);FI ;tagnummeraufbereiten;FOR hilfszaehlerFROM 1UPTO anzahlorteREP putwert( +fnrapaufsichtsort,ortejezeile(hilfszaehler));search(dnraufsichtsplan,TRUE ); +IF dbstatus=0THEN hilfstextCAT text(wert(fnrapparaphe),6);ELSE hilfstextCAT +sixblanksFI ;PER ;zeile:=hilfstext;hilfstext:=sixblanks;putline(showdatei, +zeile);PER ;putline(showdatei,blank);.tagnummeraufbereiten:tag:=text( +hilfstext,1);IF tag="1"THEN tag:="Mo "ELIF tag="2"THEN tag:="Di "ELIF tag="3" +THEN tag:="Mi "ELIF tag="4"THEN tag:="Do "ELIF tag="5"THEN tag:="Fr "ELIF tag +="6"THEN tag:="Sa "FI ;IF tag=altertagTHEN hilfstext:=3*blankELSE hilfstext:= +tag;FI ;hilfstextCAT aufsichtsnr+". ";altertag:=tagEND PROC +prozeitproorteintraegeausaufsichtsplaninshowdatei;PROC aufsichtsplanzeigen: +zeigedatei("Aufsichtsplan : "+sjhjaufber+". Halbj.","a");END PROC +aufsichtsplanzeigen;PROC aufsichtsplandrucken(INT CONST ruecksprungregel): +INT VAR zeilenzaehler:=1;TEXT VAR zeile;gesamtueberschrift:= +"Aufsichtsplan für Schuljahr ";gesamtueberschriftCAT sjhjaufber; +gesamtueberschriftCAT ". Halbjahr";druckdatei:=sequentialfile(output, +"liste.1");input(showdatei);druckvorbereiten;druckzeilenzahl:=drucklaenge(2); +initdruckkopf(gesamtueberschrift,blank);druckkopfschreiben; +setzemitseitennummern(TRUE );WHILE NOT eof(showdatei)REP getline(showdatei, +zeile);druckzeileschreiben(zeile);zeilenzaehlerINCR 1;IF zeilenzaehler> +druckzeilenzahlTHEN seitenwechsel;zeilenzaehler:=1FI ;PER ;drucknachbereiten; +IF ruecksprungregel=0THEN return(1)ELSE return(2)FI ;standardmeldung( +mnrlistewirdgedruckt,niltext);END PROC aufsichtsplandrucken;END PACKET +aufsichtsplandrucken; + diff --git a/app/schulis/2.2.1/src/4.listen.unterrichtsverteilung b/app/schulis/2.2.1/src/4.listen.unterrichtsverteilung new file mode 100644 index 0000000..39eaee2 --- /dev/null +++ b/app/schulis/2.2.1/src/4.listen.unterrichtsverteilung @@ -0,0 +1,252 @@ +PACKET unterrichtsverteilunglistenDEFINES unterrichtsverteilungspezielleteile +:LET AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT , +AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR +ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;LET maskeunterrichtsverteilung= +"ms liste unterrichtsverteilung eingang",ausgfeldlaenge=1, +anzahlderobjekteprobildschirm=17,ueberschriftenzeilen=2,ausgkopflaenge=2, +spaltentrenner=" ",zweierspaltenbreite=2,viererspaltenbreite=4, +fuenferspaltenbreite=5,achterspaltenbreite=8,neunerspaltenbreite=9, +zehnerspaltenbreite=10,unterrichtsverteilunganfpos=2,niltext="",blank=" ", +null=0,strich="-",mnrfachfalsch=305,mnrjgstfalsch=305,mnrbearbeitetwerden=352 +,mnrparapheungueltig=344,mnrauswahlnichtsinnvoll=56;TEXT VAR +neueranfbuchstabe,teiltextmeldung,unterrichtsverteilungueberschrift:="", +schuljahr,halbjahr,altejahrgangsstufe:="",alteparaphe:="",altekopplung:="", +altesfach,gewaehltejgst,gewaehlteparaphe,gewaehltesfach,bearbeitungsschuljahr +,bearbeitungshalbjahr,jahrgangsstufe:="",fach,kennung,kopplung,paraphe, +wochenstdn,klassengruppe1,klassengruppe2,klassengruppe3,klassengruppe4, +raumgruppe1,raumgruppe2,anfbuchstabe,auswahlnichtsinnvoll;TEXT CONST +unterstreichung:=bildbreite*"-",leerzeile:=bildbreite*blank,textueb1:= +"Jgst. ",textueb2:="Fach Kenng. ",textueb3:="Paraphe ",textueb4:="Kopplung " +,textueb5:="Wstd. Klassengruppen Räume ";TEXT VAR textueberschrift +:="";INT VAR eingabestatus,bildanfang,spalte2druckbreite,druckzeilenzahl, +aktuelleindexnr:=dnrlehrveranstaltungen,feldnr,jgsthilfsvar;INT CONST +groesstejgst:=13,kleinstejgst:=5;BOOL VAR geplanteshjgewaehlt,erstezeile:= +FALSE ,sortjgstalle,sortjgstbest,sortparaphenalle,sortparaphebest, +sortkopplungen,sortfaecher,sortbestfach;BOOL PROC multistop:BOOL VAR b;IF +dbstatus=okTHEN IF sortjgstalleXOR sortparaphenalleXOR sortkopplungenXOR +sortfaecherTHEN b:=bearbeitungshalbjahr=wert(fnrlvhj)ELIF sortjgstbestTHEN b +:=gewaehltejgst=wert(fnrlvjgst)AND bearbeitungshalbjahr=wert(fnrlvhj)ELIF +sortparaphebestTHEN b:=gewaehlteparaphe=wert(fnrlvparaphe)AND +bearbeitungshalbjahr=wert(fnrlvhj)ELIF sortbestfachTHEN b:=text( +gewaehltesfach,2)=text(wert(fnrlvfachkennung),2)AND bearbeitungshalbjahr=wert +(fnrlvhj)FI ;ELSE b:=FALSE FI ;bEND PROC multistop;BOOL PROC multistopsim: +setzebestandende(FALSE );BOOL VAR b:=multistop;setzebestandende(NOT b);bEND +PROC multistopsim;PROC unterrichtsverteilungspezielleteile(INT CONST nr): +SELECT nrOF CASE 1:unterrichtsverteilungdialogvorbereitenCASE 2: +unterrichtsverteilungeingabenrichtigCASE 3: +unterrichtsverteilunglistenvorbereitenCASE 4: +unterrichtsverteilungdruckvorbereitenCASE 5:unterrichtsverteilungseitedrucken +CASE 6:unterrichtsverteilungbildschirmvorbereitenCASE 7: +unterrichtsverteilungseitezeigenENDSELECT .END PROC +unterrichtsverteilungspezielleteile;PROC +unterrichtsverteilungdialogvorbereiten:unterrichtsverteilungueberschrift:= +text(vergleichsknoten);setzeanfangswerte(maskeunterrichtsverteilung, +unterrichtsverteilunganfpos)END PROC unterrichtsverteilungdialogvorbereiten; +PROC unterrichtsverteilungeingabenrichtig:LET fnrlehrveranstgn=2, +fnrlehrveranstgnjgst=3,fnrkopplungen=4,fnrparaphen=5,fnrbestparaphe=6, +fnrfaecher=7,fnrfach=8,fnraktuelleshj=9,fnrausgbild=10,fnrausgdrucker=11; +sortjgstalle:=FALSE ;sortjgstbest:=FALSE ;sortparaphenalle:=FALSE ; +sortparaphebest:=FALSE ;sortkopplungen:=FALSE ;sortfaecher:=FALSE ; +sortbestfach:=FALSE ;IF ausgabemediumkorrektgewaehltTHEN setzeausgabedrucker( +standardmaskenfeld(fnrausgbild)=niltext);geplanteshjgewaehlt:= +standardmaskenfeld(fnraktuelleshj)=niltext; +sortierartpruefenundmerkenbzwfehlermeldungausgeben;ELSE +meldefehlerauswahldruckerbildschirm;setzeeingabetest(FALSE )FI . +ausgabemediumkorrektgewaehlt:standardpruefe(5,fnrausgbild,fnrausgdrucker,null +,niltext,eingabestatus);eingabestatus=0. +sortierartpruefenundmerkenbzwfehlermeldungausgeben:IF (standardmaskenfeld( +fnrkopplungen)=niltextAND standardmaskenfeld(fnrparaphen)=niltextAND +standardmaskenfeld(fnrbestparaphe)=niltextAND standardmaskenfeld(fnrfaecher)= +niltextAND standardmaskenfeld(fnrfach)=niltext)THEN IF standardmaskenfeld( +fnrlehrveranstgn)=niltextTHEN meldefehler;setzeeingabetest(FALSE )ELSE +sortierungnachlehrveranstaltungenweiterpruefenFI ;ELSE IF NOT ( +standardmaskenfeld(fnrlehrveranstgn)=niltextAND standardmaskenfeld( +fnrlehrveranstgnjgst)=niltext)THEN meldefehler;setzeeingabetest(FALSE )ELSE +sortierungnachkopplungenparaphenoderfaechernpruefenFI ;FI . +sortierungnachlehrveranstaltungenweiterpruefen:IF standardmaskenfeld( +fnrlehrveranstgnjgst)=niltextTHEN sortjgstalle:=TRUE ;setzeeingabetest(TRUE ) +ELSE IF jgstkorrektTHEN sortjgstbest:=TRUE ;setzeeingabetest(TRUE )ELSE +meldefehlerjgst;setzeeingabetest(FALSE )FI ;FI ;. +sortierungnachkopplungenparaphenoderfaechernpruefen:IF standardmaskenfeld( +fnrkopplungen)<>niltextTHEN IF standardmaskenfeld(fnrparaphen)=niltextAND +standardmaskenfeld(fnrbestparaphe)=niltextAND standardmaskenfeld(fnrfaecher)= +niltextAND standardmaskenfeld(fnrfach)=niltextTHEN sortkopplungen:=TRUE ; +setzeeingabetest(TRUE )ELSE meldefehler;setzeeingabetest(FALSE )FI ;ELSE IF +standardmaskenfeld(fnrparaphen)<>niltextTHEN IF standardmaskenfeld(fnrfaecher +)=niltextAND standardmaskenfeld(fnrfach)=niltextTHEN +weiterepruefungzursortierungparaphenELSE meldefehler;setzeeingabetest(FALSE ) +FI ;ELSE IF standardmaskenfeld(fnrfaecher)<>niltextTHEN IF standardmaskenfeld +(fnrparaphen)=niltextAND standardmaskenfeld(fnrbestparaphe)=niltextTHEN +weiterepruefungzursortierungfaecherELSE meldefehler;setzeeingabetest(FALSE ) +FI ;FI ;FI ;FI ;.weiterepruefungzursortierungparaphen:IF standardmaskenfeld( +fnrbestparaphe)=niltextTHEN sortparaphenalle:=TRUE ;setzeeingabetest(TRUE ) +ELSE gewaehlteparaphe:=standardmaskenfeld(fnrbestparaphe);IF paraphekorrekt +THEN sortparaphebest:=TRUE ;setzeeingabetest(TRUE )FI ;FI ;. +weiterepruefungzursortierungfaecher:IF standardmaskenfeld(fnrfach)=niltext +THEN sortfaecher:=TRUE ;setzeeingabetest(TRUE )ELSE gewaehltesfach:= +standardmaskenfeld(fnrfach);IF fachkorrektTHEN sortbestfach:=TRUE ; +setzeeingabetest(TRUE )FI ;FI ;.meldefehlerauswahldruckerbildschirm:infeld( +fnrausgbild);standardmeldung(mnrauswahlnichtsinnvoll,niltext).meldefehler: +meldungstext(mnrauswahlnichtsinnvoll,auswahlnichtsinnvoll);standardmeldung( +auswahlnichtsinnvoll,niltext).jgstkorrekt:gewaehltejgst:=standardmaskenfeld( +fnrlehrveranstgnjgst);jgsthilfsvar:=int(gewaehltejgst);IF NOT +lastconversionokTHEN LEAVE jgstkorrektWITH FALSE FI ;IF jgsthilfsvar<10THEN +gewaehltejgst:=text(jgsthilfsvar);FI ;jgsthilfsvar<=groesstejgstAND +jgsthilfsvar>=kleinstejgst.paraphekorrekt:inittupel(dnrlehrer);putwert( +fnrlparaphe,gewaehlteparaphe);search(dnrlehrer,TRUE );dbstatus=ok.fachkorrekt +:inittupel(dnrfaecher);putwert(fnrffach,gewaehltesfach);search(dnrfaecher, +TRUE );dbstatus=ok.fehlerfalscheparaphe:standardmeldung(mnrparapheungueltig, +niltext);infeld(fnrbestparaphe);.meldefehlerjgst:standardmeldung( +mnrjgstfalsch,niltext);infeld(fnrlehrveranstgnjgst);.END PROC +unterrichtsverteilungeingabenrichtig;PROC +unterrichtsverteilunglistenvorbereiten:BOOL VAR b;initspalten; +setzespaltentrenner(spaltentrenner);bearbeitungshalbjahr:=schulkenndatum( +"Schulhalbjahr");bearbeitungsschuljahr:=schulkenndatum("Schuljahr");IF +geplanteshjgewaehltTHEN geplanteshjundsjberechnen(bearbeitungshalbjahr, +bearbeitungsschuljahr);FI ;inittupel(dnrlehrveranstaltungen);setzeidentiwert( +"");initobli(anzahlderobjekteprobildschirm);putwert(fnrlvsj, +bearbeitungsschuljahr);putwert(fnrlvhj,bearbeitungshalbjahr);IF sortjgstalle +XOR sortjgstbestTHEN sortierungnachprimärindexvorbereitenELIF sortkopplungen +THEN sortierungnachsekindexlvkopplungvorbereitenELIF sortfaecherOR +sortbestfachTHEN sortierungnachsekindexlvfachvorbereitenELSE +sortierungnachsekindexlvparaphevorbereitenFI ;objektlistestarten( +aktuelleindexnr,bearbeitungsschuljahr,feldnr,TRUE ,b);setzebestandende(NOT +multistopCOR b);.sortierungnachprimärindexvorbereiten:setzescanstartwert(""); +setzescanendewert("�");textueberschrift:=(textueb1+textueb2+textueb4+2*blank+ +textueb3+blank+textueb5);aktuelleindexnr:=dnrlehrveranstaltungen;IF +sortjgstbestTHEN putwert(fnrlvjgst,gewaehltejgst);feldnr:=fnrlvfachkennung; +ELSE feldnr:=fnrlvjgst;setzescanendewert("255");FI ;. +sortierungnachsekindexlvkopplungvorbereiten:textueberschrift:=(textueb4+ +textueb1+textueb2+2*blank+textueb3+2*blank+textueb5);aktuelleindexnr:= +ixlvsjhjkopp;feldnr:=fnrlvkopplung;. +sortierungnachsekindexlvparaphevorbereiten:textueberschrift:=(textueb3+ +textueb1+textueb2+textueb4+2*blank+textueb5);aktuelleindexnr:=ixlvsjhjpar;IF +sortparaphebestTHEN putwert(fnrlvparaphe,gewaehlteparaphe);feldnr:= +fnrlvfachkennung;ELSE feldnr:=fnrlvparapheFI ;. +sortierungnachsekindexlvfachvorbereiten:textueberschrift:=(textueb2+textueb1+ +textueb4+textueb3+2*blank+textueb5);aktuelleindexnr:=ixlvsjhjkenn;IF +sortbestfachTHEN feldnr:=fnrlvfachkennung;putwert(fnrlvfachkennung, +gewaehltesfach);setzescanstartwert(gewaehltesfach);setzescanendewert(text( +gewaehltesfach,2)+code(255));ELSE feldnr:=fnrlvfachkennung;FI ;END PROC +unterrichtsverteilunglistenvorbereiten;PROC +unterrichtsverteilungbildschirmvorbereiten:LET fnrausganf=2; +unterrichtsverteilungueberschrift:="Unterrichtsverteilung im Schuljahr "+( +text(bearbeitungsschuljahr,2)+"/"+text(bearbeitungsschuljahr,2,3)+", "+ +bearbeitungshalbjahr+". Halbjahr");standardkopfmaskeaktualisieren( +unterrichtsverteilungueberschrift);bildanfang:=fnrausganf; +setzebildanfangsposition(bildanfang);INT VAR i;setzespaltenbreite(bildbreite) +;spaltenweise(textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos; +erhoeheausgabeposumeins;spaltenweise(length(textueberschrift)*strich); +ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins; +setzebildanfangsposition(4);spaltendefinierenEND PROC +unterrichtsverteilungbildschirmvorbereiten;PROC +unterrichtsverteilungseitezeigen:altejahrgangsstufe:=niltext;alteparaphe:= +niltext;altekopplung:=niltext;altesfach:=niltext;blaettern(PROC (INT CONST ) +unterrichtsverteilungzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop)END PROC +unterrichtsverteilungseitezeigen;PROC unterrichtsverteilungzeigen(INT CONST x +):unterrichtsverteilungholen;unterrichtsverteilungaufbereitenbild; +unterrichtsverteilungaufbildschirm;END PROC unterrichtsverteilungzeigen;PROC +unterrichtsverteilungaufbereitenbild:IF sortkopplungenTHEN kopplungausgeben; +spaltenweise(jahrgangsstufe);spaltenweise(fach);spaltenweise(kennung); +spaltenweise(blank);spaltenweise(paraphe);ELIF sortjgstalleXOR sortjgstbest +THEN jahrgangsstufeausgeben;spaltenweise(fach);spaltenweise(kennung); +spaltenweise(kopplung);spaltenweise(paraphe);ELIF sortparaphenalleXOR +sortparaphebestTHEN parapheausgeben;spaltenweise(blank);spaltenweise( +jahrgangsstufe);spaltenweise(fach);spaltenweise(kennung);spaltenweise( +kopplung);ELIF sortfaecherXOR sortbestfachTHEN fachausgeben;spaltenweise( +kennung);spaltenweise(jahrgangsstufe);spaltenweise(kopplung);spaltenweise( +paraphe);FI ;spaltenweise(wochenstdn);spaltenweise(blank);spaltenweise( +klassengruppe1);spaltenweise(klassengruppe2);spaltenweise(klassengruppe3); +spaltenweise(klassengruppe4);spaltenweise(raumgruppe1);spaltenweise( +raumgruppe2);.jahrgangsstufeausgeben:IF altejahrgangsstufe<>jahrgangsstufe +THEN spaltenweise(jahrgangsstufe);altejahrgangsstufe:=jahrgangsstufe;ELSE +spaltenweise(blank)FI ;.parapheausgeben:IF alteparaphe<>parapheTHEN +spaltenweise(paraphe);alteparaphe:=parapheELSE spaltenweise(blank)FI ;. +fachausgeben:IF altesfach<>fachTHEN spaltenweise(fach);altesfach:=fachELSE +spaltenweise(blank)FI ;.kopplungausgeben:IF altekopplung<>kopplungTHEN +spaltenweise(kopplung);altekopplung:=kopplung;ELSE spaltenweise(blank)FI ; +END PROC unterrichtsverteilungaufbereitenbild;PROC +unterrichtsverteilungaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaenge +REP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ; +END PROC unterrichtsverteilungaufbildschirm;PROC +unterrichtsverteilungdruckvorbereiten:setzebestandende(FALSE );anfbuchstabe:= +" ";druckvorbereiten;variablenfuerdrucksetzen; +unterrichtsverteilungueberschrift:="Unterrichtsverteilung im Schuljahr "+( +text(bearbeitungsschuljahr,2)+"/"+text(bearbeitungsschuljahr,2,3)+", "+ +bearbeitungshalbjahr+". Halbjahr");initdruckkopf(zentriert( +unterrichtsverteilungueberschrift,druckbreite),zentriert(length( +unterrichtsverteilungueberschrift)*strich,druckbreite));spaltendefinieren; +initausgabekopfdruck;inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj, +bearbeitungsschuljahr);putwert(fnrlvhj,bearbeitungshalbjahr);IF sortjgstbest +THEN putwert(fnrlvjgst,gewaehltejgst);ELIF sortparaphebestTHEN putwert( +fnrlvparaphe,gewaehlteparaphe);ELIF sortbestfachTHEN putwert(fnrlvfachkennung +,gewaehltesfach);FI ;lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT +VAR )scanforward,BOOL PROC multistopsim);.variablenfuerdrucksetzen: +druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC +unterrichtsverteilungdruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck +(1):=textueberschrift;ausgkopfdruck(2):=unterstreichungEND PROC +initausgabekopfdruck;PROC unterrichtsverteilungseitedrucken: +unterrichtsverteilungueberschriftdrucken;altejahrgangsstufe:=niltext; +alteparaphe:=niltext;altekopplung:=niltext;altesfach:=niltext;erstezeile:= +TRUE ;seitedrucken(PROC (INT VAR )unterrichtsverteilungdrucken, +druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END +PROC unterrichtsverteilungseitedrucken;PROC +unterrichtsverteilungueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR i +FROM 1UPTO ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck(i))PER END +PROC unterrichtsverteilungueberschriftdrucken;PROC +unterrichtsverteilungdrucken(INT VAR zeilenzaehler):LET markiert="#"; +unterrichtsverteilungholen;ggflmeldunganfbuchstabe;IF NOT (erstezeile)AND (( +sortjgstalleAND altejahrgangsstufe<>jahrgangsstufe)XOR (sortkopplungenAND +altekopplung<>kopplung)XOR (sortparaphenalleAND alteparaphe<>paraphe)XOR ( +sortfaecherAND altesfach<>fach))THEN leerzeileindruckdateiFI ; +unterrichtsverteilungaufbereitendruck;zeilenzaehlerINCR ausgfeldlaenge; +unterrichtsverteilungindruckdatei;erstezeile:=FALSE .leerzeileindruckdatei: +ausgfeld(1):=text(blank,druckbreite);druckzeileschreiben(ausgfeld(1)); +zeilenzaehlerINCR ausgfeldlaenge;.ggflmeldunganfbuchstabe:IF +anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:IF +sortjgstalleXOR sortjgstbestTHEN neueranfbuchstabe:=jahrgangsstufeSUB 1; +teiltextmeldung:="Jgst "ELIF sortparaphenalleXOR sortparaphebestTHEN +neueranfbuchstabe:=parapheSUB 1;teiltextmeldung:= +"Paraphen mit Anfangsbuchstaben: "ELIF sortkopplungenTHEN neueranfbuchstabe:= +kopplungSUB 1;teiltextmeldung:="Kopplungen mit Anfangsbuchstaben: "ELIF +sortfaecherXOR sortbestfachTHEN neueranfbuchstabe:=fach;teiltextmeldung:= +"Fach: "FI ;anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe: +standardmeldung(mnrbearbeitetwerden,teiltextmeldung+neueranfbuchstabe+ +markiert);anfbuchstabe:=neueranfbuchstabe.END PROC +unterrichtsverteilungdrucken;PROC unterrichtsverteilungaufbereitendruck: +unterrichtsverteilungaufbereitenbild;ausgfeld(1):=zeile;END PROC +unterrichtsverteilungaufbereitendruck;PROC unterrichtsverteilungindruckdatei: +INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1)) +PER END PROC unterrichtsverteilungindruckdatei;PROC spaltendefinieren: +initspalten;setzespaltentrenner(spaltentrenner);IF sortkopplungenTHEN +setzespaltenbreite(neunerspaltenbreite);setzespaltenbreite( +fuenferspaltenbreite);setzespaltenbreite(zweierspaltenbreite); +setzespaltenbreite(achterspaltenbreite);setzespaltenbreite( +zweierspaltenbreite);setzespaltenbreite(achterspaltenbreite);ELIF +sortjgstalleXOR sortjgstbestTHEN setzespaltenbreite(fuenferspaltenbreite); +setzespaltenbreite(zweierspaltenbreite);setzespaltenbreite( +neunerspaltenbreite);setzespaltenbreite(zehnerspaltenbreite); +setzespaltenbreite(achterspaltenbreite);ELIF sortparaphenalleXOR +sortparaphebestTHEN setzespaltenbreite(viererspaltenbreite); +setzespaltenbreite(zweierspaltenbreite);setzespaltenbreite( +fuenferspaltenbreite);setzespaltenbreite(zweierspaltenbreite); +setzespaltenbreite(neunerspaltenbreite);setzespaltenbreite( +zehnerspaltenbreite);ELIF sortfaecherXOR sortbestfachTHEN setzespaltenbreite( +viererspaltenbreite);setzespaltenbreite(achterspaltenbreite); +setzespaltenbreite(viererspaltenbreite);setzespaltenbreite( +neunerspaltenbreite);setzespaltenbreite(neunerspaltenbreite);FI ; +setzespaltenbreite(viererspaltenbreite);setzespaltenbreite( +zweierspaltenbreite);setzespaltenbreite(viererspaltenbreite); +setzespaltenbreite(viererspaltenbreite);setzespaltenbreite( +viererspaltenbreite);setzespaltenbreite(fuenferspaltenbreite); +setzespaltenbreite(viererspaltenbreite);setzespaltenbreite( +viererspaltenbreite);END PROC spaltendefinieren;PROC +unterrichtsverteilungholen:TEXT VAR fachkennung;halbjahr:=wert(fnrlvhj); +jahrgangsstufe:=text(intwert(fnrlvjgst),2);fachkennung:=wert(fnrlvfachkennung +);fach:=text(fachkennung,2);kennung:=subtext(fachkennung,3,6);kopplung:=wert( +fnrlvkopplung);paraphe:=wert(fnrlvparaphe);wochenstdn:=text(intwert( +fnrlvwochenstd),2);klassengruppe1:=wert(fnrlvklgrp1);klassengruppe2:=wert( +fnrlvklgrp2);klassengruppe3:=wert(fnrlvklgrp3);klassengruppe4:=wert( +fnrlvklgrp4);raumgruppe1:=wert(fnrlvraumgrp1);raumgruppe2:=wert(fnrlvraumgrp2 +);END PROC unterrichtsverteilungholen;END PACKET unterrichtsverteilunglisten + diff --git a/app/schulis/2.2.1/src/4.raumwuensche pruefen b/app/schulis/2.2.1/src/4.raumwuensche pruefen new file mode 100644 index 0000000..109eace --- /dev/null +++ b/app/schulis/2.2.1/src/4.raumwuensche pruefen @@ -0,0 +1,117 @@ +PACKET raumwuenschepruefenDEFINES raumwuenschepruefenstarten, +raumwuenschepruefenlistedrucken:INT VAR fnrakthj:=2,fnrausgabebildschirm:=3, +fnrausgabedrucker:=4;LET meldnrlistewirdgedruckt=58,meldnrkeinelv=326, +meldnrkeinesugruppen=334,meldnrinbearbeitung=352,meldnrzuvielesugruppen=356, +meldnrstundenplanwirdaufbereitet=357,meldnrzuvielelv=358, +meldnrstundenplanserverfehlt=376,meldnrbasisalt=377,meldnrbasisinkons=378; +LET protname="Einhaltung der Raumwünsche";FILE VAR prot;LET raumgruppendatei= +"Datei mit Raumgruppen";FILE VAR datraumgruppen;LET schuljahr="Schuljahr", +schulhalbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort";LET +ueberschrift="Einhaltung der Raumwünsche, Stundenplan ",texthalbjahr= +". Halbjahr",kopfzeile1="Lehrver- Zeit belegter Anmerkungen",kopfzeile2= +"anstaltung Raum";LET meldkeinwunschraumfrei= +"kein Wunsch- oder Ersatzraum frei",meldwunschraumfrei=" frei", +meldkeinwunschangegeben="Raum fehlt, kein Raumwunsch angegeben";LET +fallkeinwunschraumfrei=1,fallwunschraumfrei=2,fallkeinwunschangegeben=3;LET +laengeschulname=61;LET strich="-",schraegstrich="/",blank=" ",vierblanks= +" ",leerraum=" ",kennzhell="#",editorzusatztasten="vr";LET laengeraum=4 +,laengelv=8;LET kennunglv="L",kennungraum="R",kennungwunschraum="RW", +kennungersatzraum="RE";LET erstestunde=1,letztestunde=66,zeitbelegt="1";LET +posraeumeinrgzeile=5;TEXT VAR aktsj:="",akthj:="",gewsj,gewhj;TEXT VAR +auszeile;TEXT VAR jgst,lv,letztelv,raum,freierwunschraum,wunschraeumederlv, +raeumederzeit,raumgruppenzeile,zeitenderlv;INT VAR izeit;INT VAR posraum;INT +VAR fstatusstuplan;PROC raumwuenschepruefenstarten:INT VAR fnrfehler:=0; +standardpruefe(5,fnrausgabebildschirm,fnrausgabedrucker,0,"",fnrfehler);IF +fnrfehler<>0THEN infeld(fnrfehler);return(1)ELSE +schulhalbjahrbestimmenundstundenplanholen;IF fstatusstuplan<>0THEN +stundenplanfehlerbehandeln;return(1)ELSE pruefungraumwuenschedurchfuehren;IF +listedirektdruckenTHEN standardmeldung(meldnrlistewirdgedruckt,"");print( +protname);forget(protname,quiet);return(1)ELSE zeigedatei(protname, +editorzusatztasten)FI ;FI FI .listedirektdrucken:standardmaskenfeld( +fnrausgabedrucker)<>"".schulhalbjahrbestimmenundstundenplanholen:IF aktsj="" +THEN aktsj:=schulkenndatum(schuljahr);akthj:=schulkenndatum(schulhalbjahr)FI +;gewsj:=aktsj;gewhj:=akthj;IF standardmaskenfeld(fnrakthj)=""THEN +geplanteshjundsjberechnen(gewhj,gewsj);FI ;stundenplanhalbjahrsetzen(gewhj, +gewsj);standardmeldung(meldnrstundenplanwirdaufbereitet,""); +stundenplanbasisundstundenplanholen(fstatusstuplan);IF fstatusstuplan=0THEN +stundenplanreorganisierenundsichern(fstatusstuplan)ELIF fstatusstuplan=8THEN +standardmeldung(meldnrbasisalt,"");stundenplanreorganisierenundsichern( +fstatusstuplan)FI .stundenplanfehlerbehandeln:IF fstatusstuplan=2THEN +standardmeldung(meldnrstundenplanserverfehlt,"")ELIF fstatusstuplan=4THEN +standardmeldung(meldnrkeinesugruppen,"")ELIF fstatusstuplan=5THEN +standardmeldung(meldnrzuvielesugruppen,"")ELIF fstatusstuplan=6THEN +standardmeldung(meldnrkeinelv,"")ELIF fstatusstuplan=7THEN standardmeldung( +meldnrzuvielelv,"")ELIF fstatusstuplan=8THEN standardmeldung(meldnrbasisalt, +"")ELIF fstatusstuplan=9THEN standardmeldung(meldnrbasisinkons,"")FI . +pruefungraumwuenschedurchfuehren:protokollvorbereiten;ausgabekopfaufbereiten; +raumgruppeninraumgruppendateiauslesen;letztelv:="";inittupel( +dnrlehrveranstaltungen);putwert(fnrlvsj,gewsj);putwert(fnrlvhj,gewhj); +statleseschleife(dnrlehrveranstaltungen,gewsj,gewhj,fnrlvsj,fnrlvhj,PROC +raeumeeinerlvpruefen);ausgabefussaufbereiten.protokollvorbereiten:forget( +protname,quiet);prot:=sequentialfile(output,protname).ausgabekopfaufbereiten: +auszeile:=text(schulkenndatum(schulname),laengeschulname);auszeileCAT date; +putline(prot,auszeile);putline(prot,schulkenndatum(schulort));line(prot); +auszeile:=ueberschrift;auszeileCAT subtext(gewsj,1,2);auszeileCAT +schraegstrich;auszeileCAT subtext(gewsj,3,4);auszeileCAT ", ";auszeileCAT +gewhj;auszeileCAT texthalbjahr;putline(prot,auszeile);putline(prot,length( +auszeile)*strich);line(prot);putline(prot,kopfzeile1);putline(prot,kopfzeile2 +);putline(prot,65*strich).ausgabefussaufbereiten:line(prot);putline(prot,20* +blank+20*strich).raumgruppeninraumgruppendateiauslesen:IF NOT exists( +raumgruppendatei)THEN datraumgruppen:=sequentialfile(output,raumgruppendatei) +;inittupel(dnrraumgruppen);statleseschleife(dnrraumgruppen,"","",fnrrgraumgrp +,fnrrgraeume,PROC raumgruppeindateischreiben)FI .END PROC +raumwuenschepruefenstarten;PROC raumgruppeindateischreiben(BOOL VAR b):IF +dbstatus=0THEN putline(datraumgruppen,text(wert(fnrrgraumgrp),laengeraum)+ +wert(fnrrgraeume))ELSE b:=TRUE FI END PROC raumgruppeindateischreiben;PROC +raeumeeinerlvpruefen(BOOL VAR b):IF dbstatus<>0OR wert(fnrlvsj)<>gewsjOR wert +(fnrlvhj)<>gewhjTHEN b:=TRUE ELSE pruefeallelveintraegeFI . +pruefeallelveintraege:jgst:=jgstzweistellig(intwert(fnrlvjgst));lv:=text(jgst ++wert(fnrlvfachkennung),laengelv);standardmeldung(meldnrinbearbeitung,lv+ +kennzhell);wunschraeumezulvbestimmen;zeitenderlv:=allezeitenvon(kennunglv,lv) +;FOR izeitFROM erstestundeUPTO letztestundeREP IF (zeitenderlvSUB izeit)= +zeitbelegtTHEN prueferaumeintragFI PER .wunschraeumezulvbestimmen: +wunschraeumederlv:="";raum:=datenzurlv(kennungwunschraum,lv);IF raum<>""THEN +IF bezeichnungzulaessig(kennungraum,raum)THEN wunschraeumederlvCAT raumELSE +wunschraeumederlvCAT raeumederraumgruppeFI ;FI ;raum:=datenzurlv( +kennungersatzraum,lv);IF raum<>""THEN IF bezeichnungzulaessig(kennungraum, +raum)THEN wunschraeumederlvCAT raumELSE wunschraeumederlvCAT +raeumederraumgruppeFI ;FI .prueferaumeintrag:TEXT VAR suchpara,suchlv; +planeintraglesen(izeit,kennunglv,lv,suchlv,raum,suchpara);raeumederzeit:= +datenderzeit(izeit,kennungraum);IF wunschraeumederlv<>""THEN +erstenfreienwunschraumbestimmen;IF freierwunschraum=""THEN IF +belegterraumistkeinwunschraumTHEN inlisteschreiben(fallkeinwunschraumfrei)FI +ELIF freierwunschraumistbesseralsbelegterTHEN inlisteschreiben( +fallwunschraumfrei)FI ELIF raum=leerraumTHEN inlisteschreiben( +fallkeinwunschangegeben)FI .erstenfreienwunschraumbestimmen:freierwunschraum +:="";posraum:=1;WHILE posraumlvTHEN line(prot);letztelv:=lvFI ;putline(prot,auszeile)END PROC +inlisteschreiben;PROC raumwuenschepruefenlistedrucken(BOOL CONST drucken):IF +druckenTHEN print(protname)FI ;forget(protname,quiet);enter(2)END PROC +raumwuenschepruefenlistedrucken;INT PROC suchpos(TEXT CONST quelle,suchtext, +INT CONST laenge):INT VAR findpos:=pos(quelle,suchtext);WHILE findpos>0REP +IF findposMOD laenge=1THEN LEAVE suchposWITH findposELSE findpos:=pos(quelle, +suchtext,findpos+1);FI PER ;findposEND PROC suchpos;TEXT PROC jgstzweistellig +(INT CONST intjgst):IF intjgst=0THEN "00"ELIF intjgst>4AND intjgst<10THEN "0" ++text(intjgst)ELSE text(intjgst)FI END PROC jgstzweistellig;END PACKET +raumwuenschepruefen; + diff --git a/app/schulis/2.2.1/src/4.springstunden lehrer analysieren b/app/schulis/2.2.1/src/4.springstunden lehrer analysieren new file mode 100644 index 0000000..bd205d2 --- /dev/null +++ b/app/schulis/2.2.1/src/4.springstunden lehrer analysieren @@ -0,0 +1,122 @@ +PACKET springstundenlehrerDEFINES springstundenlehrerausfuehren:LET fnrakthj= +2,fnrohneminiplan=3,minitagestr="!",minivornachmtr=" ",miniunterricht="*", +minisprstd="o",minifrei=".",ausgabeparam="#",leerzeile=" ",laengeparbez=9, +tageprowoche=6,stdprotag=12,letztestunde=66,meldungbearbwird=352, +meldungwarten=69,meldungkeinelehrer=337,meldungkeinzeitraster=336, +meldungserverfehler=376,meldungkeinstdplan=366,meldungkeinesugruppen=334, +meldungzuvielesugruppen=356,meldungkeinelv=326,meldungzuvielelv=358, +meldungbasisinkon=378,meldungstdplauswvorber=384,kennungpar="P",kennunggesp= +"x",kennungvorm="v",kennungnachm="n",dateiname="Liste der Springstunden", +ueberschrift="Springstunden der Lehrer für das Schulhalbjahr ",unterstrich= +"-------------------------------------------------------",legende1= +"In den Mini-Stundenplänen bedeuten:",legende2= +""" Unterricht für den Lehrer",legende3=""" Springstunde für den Lehrer", +legende4=""" andere Zeiten ohne Unterricht",legende5= +" ""x"" gesperrte Zeiten aufgrund des Zeitrasters",legende6= +""" Trennzeichen Vor- und Nachmittag",legende7= +""" Trennzeichen Unterrichtstage",legende8="Zeitraster der Schule:",legende9 +="Mo Di Mi Do Fr Sa", +ausgabewstd=" Wstd. ",vorgabetage=" 0 Tage (0 v/ 0 n) ",vorgabesprstd1= +" Springstd. (",vorgabesprstd2=" x1/ ",vorgabesprstd3=" x2/ ",vorgabesprstd4= +" xgr.)",posunttage=2,posvormtage=10,posnachmtage=15,schuljahr="Schuljahr", +halbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort";TEXT VAR +paraphe,schj,schhj,ausgabetage,ausgabesprstd,miniplan:="",iminiplan, +ausgminiplan,tagesplan,zeile,vormnachmwechsel:="",relzeit,zeichen;INT VAR i,j +,wstd,stdverschiebung,erstepos,letztepos,anzunttage,anzvormtage,anznachmtage, +anzsprstd,anzsprstd1,anzsprstd2,anzsprstdx,sprstdlaenge,indextagesanf,mittag, +fstat;TEXT VAR kvn,kzt,kaktvn;BOOL VAR miniplanausgabe:=FALSE , +erstenichtvormstd:=TRUE ,keinmittag:=TRUE ;FILE VAR datei;PROC +springstundenlehrerausfuehren:standardmeldung(meldungwarten,""); +miniplanausgabe:=FALSE ;schj:=schulkenndatum(schuljahr);schhj:=schulkenndatum +(halbjahr);IF standardmaskenfeld(fnrakthj)=""THEN geplanteshjundsjberechnen( +schhj,schj)FI ;IF standardmaskenfeld(fnrohneminiplan)=""THEN miniplanausgabe +:=TRUE ;FI ;erstelleminiplan;stundenplanhalbjahrsetzen(schhj,schj); +standardmeldung(meldungstdplauswvorber,""); +stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN +meldungausgeben(fstat);return(1);LEAVE springstundenlehrerausfuehrenFI ; +inittupel(dnrlehrer);IF records(dnrlehrer)=0.0THEN standardmeldung( +meldungkeinelehrer,"");return(1);LEAVE springstundenlehrerausfuehrenELSE +bereiteprotokollvor;statleseschleife(dnrlehrer,"","",dnrlehrer+1,dnrlehrer+2, +PROC lehrer)FI ;zeigedatei(dateiname,"vr").bereiteprotokollvor:forget( +dateiname,quiet);datei:=sequentialfile(output,dateiname);putline(datei, +schulkenndatum(schulname));putline(datei,text(schulkenndatum(schulort),65)+ +date);putline(datei,leerzeile);putline(datei,ueberschrift+schhj+". "+text( +schj,2)+"/"+subtext(schj,3));putline(datei,unterstrich);putline(datei, +leerzeile);IF miniplanausgabeTHEN putline(datei,legende1);putline(datei, +" """+miniunterricht+legende2);putline(datei," """+minisprstd+legende3) +;putline(datei," """+minifrei+legende4);putline(datei,legende5);putline( +datei," """+minivornachmtr+legende6);putline(datei," """+minitagestr+ +legende7);putline(datei,leerzeile);putline(datei,legende8);putline(datei, +legende9);bereiteplanauf(miniplan);putline(datei,ausgminiplan);putline(datei, +leerzeile)FI .erstelleminiplan:miniplan:="";vormnachmwechsel:="";IF records( +dnrzeitraster)=0.0THEN standardmeldung(meldungkeinzeitraster,"");return(1); +LEAVE springstundenlehrerausfuehrenFI ;erstenichtvormstd:=TRUE ;inittupel( +dnrzeitraster);statleseschleife(dnrzeitraster,schj,schhj,dnrzeitraster+1, +dnrzeitraster+2,PROC zeitrasterdaten);IF length(miniplan)0THEN b:=TRUE ELSE paraphe:=wert(fnrlparaphe) +;standardmeldung(meldungbearbwird,paraphe+ausgabeparam);wstd:= +anzahlverplstden(paraphe);zeile:=text(paraphe,laengeparbez);zeileCAT text( +wstd,2);zeileCAT ausgabewstd;untersuchetage;zeileCAT ausgabetage; +untersuchesprstden;zeileCAT ausgabesprstd;putline(datei,zeile);IF +miniplanausgabeTHEN bereiteplanauf(iminiplan);changeall(ausgminiplan, +kennungvorm,minifrei);changeall(ausgminiplan,kennungnachm,minifrei);putline( +datei,ausgminiplan)FI ;line(datei)FI .untersuchetage:ausgabetage:=vorgabetage +;IF anzunttage<>0THEN replace(ausgabetage,posunttage,text(anzunttage))FI ;IF +anzvormtage<>0THEN replace(ausgabetage,posvormtage,text(anzvormtage))FI ;IF +anznachmtage<>0THEN replace(ausgabetage,posnachmtage,text(anznachmtage))FI . +untersuchesprstden:anzsprstd:=0;anzsprstd1:=0;anzsprstd2:=0;anzsprstdx:=0; +FOR iFROM 1UPTO tageprowocheREP erstepos:=0;letztepos:=0;indextagesanf:=(i-1) +*stdprotag;tagesplan:=subtext(iminiplan,indextagesanf+1,i*stdprotag); +ermittlerandundsprstdenPER .ermittlerandundsprstden:erstepos:=pos(tagesplan, +miniunterricht);IF erstepos<>0THEN ermittleletztestd;ermittlevormnachmwechsel +;ermittlespringstdFI .ermittleletztestd:FOR jFROM stdprotagDOWNTO 1REP IF ( +tagesplanSUB j)=miniunterrichtTHEN letztepos:=j;LEAVE ermittleletztestdFI +PER .ermittlevormnachmwechsel:mittag:=0;FOR jFROM 12DOWNTO 1REP IF (miniplan +SUB indextagesanf+j)=kennungvormTHEN mittag:=j;LEAVE ermittlevormnachmwechsel +FI PER .ermittlespringstd:keinmittag:=TRUE ;FOR jFROM letzteposDOWNTO +ersteposREP IF (tagesplanSUB j)=kennungvormCOR (tagesplanSUB j)=kennungnachm +COR (tagesplanSUB j)=kennunggespTHEN anzsprstdINCR 1;sprstdlaengeINCR 1;IF +miniplanausgabeTHEN replace(iminiplan,indextagesanf+j,minisprstd);FI ;IF j= +mittag+1COR j=mittagTHEN IF keinmittagTHEN anzsprstdINCR 1;sprstdlaengeINCR 1 +;keinmittag:=FALSE FI FI ELSE IF sprstdlaenge=1THEN anzsprstd1INCR 1ELIF +sprstdlaenge=2THEN anzsprstd2INCR 1ELIF sprstdlaenge>2THEN anzsprstdxINCR 1 +FI ;sprstdlaenge:=0;FI PER ;IF keinmittagCAND erstepos<=mittagCAND letztepos> +mittagTHEN anzsprstdINCR 1;anzsprstd1INCR 1FI ;ausgabesprstd:=text(anzsprstd, +2)+vorgabesprstd1+text(anzsprstd1,2)+vorgabesprstd2+text(anzsprstd2,2)+ +vorgabesprstd3+text(anzsprstdx,2)+vorgabesprstd4.END PROC lehrer;PROC +bereiteplanauf(TEXT CONST plan):ausgminiplan:=plan;stdverschiebung:=0;FOR i +FROM 1UPTO length(vormnachmwechsel)DIV 3REP relzeit:=vormnachmwechselSUB i*3- +2;relzeitCAT (vormnachmwechselSUB i*3-1);zeichen:=vormnachmwechselSUB i*3; +insertchar(ausgminiplan,zeichen,int(relzeit)+stdverschiebung);stdverschiebung +INCR 1PER ;END PROC bereiteplanauf;PROC zeitrasterdaten(BOOL VAR b):IF wert( +fnrzrsj)<>schjCOR wert(fnrzrhj)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE kvn:= +wert(fnrzrkennungteil);kzt:=text(wert(fnrzrtagstunde),2);miniplanCAT kvn;IF +kvn<>kennungvormTHEN IF erstenichtvormstdTHEN kaktvn:=kzt;erstenichtvormstd:= +FALSE FI ELSE erstenichtvormstd:=TRUE FI ;IF int(kzt)MOD stdprotag=1CAND kzt +<>"1 "THEN IF kaktvn<>""THEN vormnachmwechselCAT kaktvn;vormnachmwechselCAT +minivornachmtr;kaktvn:=""FI ;vormnachmwechselCAT kzt;vormnachmwechselCAT +minitagestrFI ;IF kzt=text(letztestunde)THEN IF kaktvn<>""THEN +vormnachmwechselCAT kaktvn;vormnachmwechselCAT minivornachmtr;kaktvn:=""FI +FI FI END PROC zeitrasterdaten;INT PROC anzahlverplstden(TEXT CONST paraphe): +TEXT VAR stundenplan:=allezeitenvon(kennungpar,paraphe),unttage:=tageprowoche +*"0",vormtage:=tageprowoche*"0",nachmtage:=tageprowoche*"0";INT VAR einspos:= +1,anzeinsen:=0,wochentag;iminiplan:=miniplan;anzunttage:=0;anzvormtage:=0; +anznachmtage:=0;WHILE einspos<>0REP einspos:=pos(stundenplan,"1",einspos);IF +einspos<>0THEN anzeinsenINCR 1;replace(iminiplan,einspos,miniunterricht); +wochentag:=(einspos-1)DIV stdprotag+1;IF (unttageSUB wochentag)="0"THEN +replace(unttage,wochentag,"1");anzunttageINCR 1FI ;IF (vormtageSUB wochentag) +="0"CAND vormittagsunterrichtTHEN replace(vormtage,wochentag,"1");anzvormtage +INCR 1FI ;IF (nachmtageSUB wochentag)="0"CAND nachmittagsunterrichtTHEN +replace(nachmtage,wochentag,"1");anznachmtageINCR 1FI ;einsposINCR 1FI PER ; +anzeinsen.vormittagsunterricht:(miniplanSUB einspos)=kennungvorm. +nachmittagsunterricht:(miniplanSUB einspos)=kennungnachm.END PROC +anzahlverplstden;PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN +standardmeldung(meldungserverfehler,"");ELIF fstat=3THEN standardmeldung( +meldungkeinstdplan,"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen +,"");ELIF fstat=5THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6 +THEN standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung( +meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,""); +FI END PROC meldungausgeben;END PACKET springstundenlehrer; + diff --git a/app/schulis/2.2.1/src/4.springstunden schueler analysieren b/app/schulis/2.2.1/src/4.springstunden schueler analysieren new file mode 100644 index 0000000..39a9bfc --- /dev/null +++ b/app/schulis/2.2.1/src/4.springstunden schueler analysieren @@ -0,0 +1,137 @@ +PACKET springstundenschuelerDEFINES springstundenschuelerausfuehren:LET +fnrakthj=3,fnrohneminiplan=4,minitagestr="!",minivornachmtr=" ", +miniunterricht="*",minisprstd="o",minifrei=".",ausgabeparam="#",leerzeile=" " +,laengelv=8,laengeschgrbez=9,tageprowoche=6,stdprotag=12,letztestunde=66, +meldungbearbwird=352,meldungwarten=69,meldungkeineschueler=332, +meldungkeinzeitraster=336,meldungserverfehler=376,meldungkeinstdplan=366, +meldungkeinesugruppen=334,meldungzuvielesugruppen=356,meldungkeinelv=326, +meldungzuvielelv=358,meldungbasisinkon=378,meldungstdplauswvorber=384, +kennunglv="L",kennunggesp="x",kennungvorm="v",kennungnachm="n",dateiname= +"Liste der Springstunden",ueberschrift= +"Springstunden der Schülergruppen Sek.1 für das Schulhalbjahr ",unterstrich= +"---------------------------------------------------------------------", +legende1="In den Mini-Stundenplänen bedeuten:",legende2= +""" Unterricht für die Schülergruppe",legende3= +""" Springstunde für die Schülergruppe",legende4= +""" andere Zeiten ohne Unterricht",legende5= +" ""x"" gesperrte Zeiten aufgrund des Zeitrasters",legende6= +""" Trennzeichen Vor- und Nachmittag",legende7= +""" Trennzeichen Unterrichtstage",legende8="Zeitraster der Schule:",legende9 +="Mo Di Mi Do Fr Sa", +ausgabewstd=" Wstd. ",vorgabetage=" 0 Tage (0 v/ 0 n) ",vorgabesprstd1= +" Springstd. (",vorgabesprstd2=" x1/ ",vorgabesprstd3=" x2/ ",vorgabesprstd4= +" xgr.)",posunttage=2,posvormtage=10,posnachmtage=15,schuljahr="Schuljahr", +halbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort";TEXT VAR +schgrbez,schj,schhj,ausgabetage,ausgabesprstd,miniplan:="",iminiplan, +ausgminiplan,tagesplan,zeile,vormnachmwechsel:="",relzeit,zeichen;TEXT VAR +kvn,kzt,kaktvn;INT VAR i,j,wstd,stdverschiebung,erstepos,letztepos,mittag, +anzunttage,anzvormtage,anznachmtage,anzsprstd,anzsprstd1,anzsprstd2, +anzsprstdx,sprstdlaenge,indextagesanf,fstat;BOOL VAR miniplanausgabe:=FALSE , +erstenichtvormstd:=TRUE ,keinmittag:=TRUE ,keinschueler:=TRUE ;FILE VAR datei +;PROC springstundenschuelerausfuehren:standardmeldung(meldungwarten,""); +miniplanausgabe:=FALSE ;schj:=schulkenndatum(schuljahr);schhj:=schulkenndatum +(halbjahr);IF standardmaskenfeld(fnrakthj)=""THEN geplanteshjundsjberechnen( +schhj,schj)FI ;IF standardmaskenfeld(fnrohneminiplan)=""THEN miniplanausgabe +:=TRUE ;FI ;erstelleminiplan;stundenplanhalbjahrsetzen(schhj,schj); +standardmeldung(meldungstdplauswvorber,""); +stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN +meldungausgeben(fstat);return(1);LEAVE springstundenschuelerausfuehrenFI ; +inittupel(dnraktschuelergruppen);IF records(dnraktschuelergruppen)=0.0THEN +standardmeldung(meldungkeineschueler,"");return(1);LEAVE +springstundenschuelerausfuehrenELSE bereiteprotokollvor;keinschueler:=TRUE ; +statleseschleife(dnraktschuelergruppen,schj,schhj,fnrsgrpsj,fnrsgrphj,PROC +schueler);IF keinschuelerTHEN standardmeldung(meldungkeineschueler,"");return +(1);LEAVE springstundenschuelerausfuehrenFI FI ;zeigedatei(dateiname,"vr"). +bereiteprotokollvor:forget(dateiname,quiet);datei:=sequentialfile(output, +dateiname);putline(datei,schulkenndatum(schulname));putline(datei,text( +schulkenndatum(schulort),65)+date);putline(datei,leerzeile);putline(datei, +ueberschrift+schhj+". "+text(schj,2)+"/"+subtext(schj,3));putline(datei, +unterstrich);putline(datei,leerzeile);IF miniplanausgabeTHEN putline(datei, +legende1);putline(datei," """+miniunterricht+legende2);putline(datei, +" """+minisprstd+legende3);putline(datei," """+minifrei+legende4); +putline(datei,legende5);putline(datei," """+minivornachmtr+legende6); +putline(datei," """+minitagestr+legende7);putline(datei,leerzeile);putline +(datei,legende8);putline(datei,legende9);bereiteplanauf(miniplan);putline( +datei,ausgminiplan);putline(datei,leerzeile)FI .erstelleminiplan:miniplan:="" +;vormnachmwechsel:="";IF records(dnrzeitraster)=0.0THEN standardmeldung( +meldungkeinzeitraster,"");return(1);LEAVE springstundenschuelerausfuehrenFI ; +erstenichtvormstd:=TRUE ;inittupel(dnrzeitraster);statleseschleife( +dnrzeitraster,schj,schhj,dnrzeitraster+1,dnrzeitraster+2,PROC zeitrasterdaten +);IF length(miniplan)schjCOR wert(fnrsgrphj)<>schhjCOR intwert(fnrsgrpjgst)>10COR dbstatus<>0 +THEN b:=TRUE ELSE schgrbez:=jgstaufber(wert(fnrsgrpjgst))+wert(fnrsgrpkennung +);standardmeldung(meldungbearbwird,schgrbez+ausgabeparam);wstd:= +anzahlverplstden(schgrbez);zeile:=text(schgrbez,laengeschgrbez);zeileCAT text +(wstd,2);zeileCAT ausgabewstd;untersuchetage;zeileCAT ausgabetage; +untersuchesprstden;zeileCAT ausgabesprstd;putline(datei,zeile);IF +miniplanausgabeTHEN bereiteplanauf(iminiplan);changeall(ausgminiplan, +kennungvorm,minifrei);changeall(ausgminiplan,kennungnachm,minifrei);putline( +datei,ausgminiplan)FI ;line(datei);IF keinschuelerTHEN keinschueler:=FALSE +FI FI .untersuchetage:ausgabetage:=vorgabetage;IF anzunttage<>0THEN replace( +ausgabetage,posunttage,text(anzunttage))FI ;IF anzvormtage<>0THEN replace( +ausgabetage,posvormtage,text(anzvormtage))FI ;IF anznachmtage<>0THEN replace( +ausgabetage,posnachmtage,text(anznachmtage))FI .untersuchesprstden:anzsprstd +:=0;anzsprstd1:=0;anzsprstd2:=0;anzsprstdx:=0;FOR iFROM 1UPTO tageprowoche +REP erstepos:=0;letztepos:=0;indextagesanf:=(i-1)*stdprotag;tagesplan:= +subtext(iminiplan,indextagesanf+1,i*stdprotag);ermittlerandundsprstdenPER . +ermittlerandundsprstden:erstepos:=pos(tagesplan,miniunterricht);IF erstepos<> +0THEN ermittleletztestd;ermittlevormnachmwechsel;ermittlespringstdFI . +ermittleletztestd:FOR jFROM stdprotagDOWNTO 1REP IF (tagesplanSUB j)= +miniunterrichtTHEN letztepos:=j;LEAVE ermittleletztestdFI PER . +ermittlevormnachmwechsel:mittag:=0;FOR jFROM 12DOWNTO 1REP IF (miniplanSUB +indextagesanf+j)=kennungvormTHEN mittag:=j;LEAVE ermittlevormnachmwechselFI +PER .ermittlespringstd:keinmittag:=TRUE ;FOR jFROM letzteposDOWNTO erstepos +REP IF (tagesplanSUB j)=kennungvormCOR (tagesplanSUB j)=kennungnachmCOR ( +tagesplanSUB j)=kennunggespTHEN anzsprstdINCR 1;sprstdlaengeINCR 1;IF +miniplanausgabeTHEN replace(iminiplan,indextagesanf+j,minisprstd);FI ;IF j= +mittag+1COR j=mittagTHEN IF keinmittagTHEN anzsprstdINCR 1;sprstdlaengeINCR 1 +;keinmittag:=FALSE ;FI FI ELSE IF sprstdlaenge=1THEN anzsprstd1INCR 1ELIF +sprstdlaenge=2THEN anzsprstd2INCR 1ELIF sprstdlaenge>2THEN anzsprstdxINCR 1 +FI ;sprstdlaenge:=0;FI PER ;IF keinmittagCAND erstepos<=mittagCAND letztepos> +mittagTHEN anzsprstdINCR 1;anzsprstd1INCR 1FI ;ausgabesprstd:=text(anzsprstd, +2)+vorgabesprstd1+text(anzsprstd1,2)+vorgabesprstd2+text(anzsprstd2,2)+ +vorgabesprstd3+text(anzsprstdx,2)+vorgabesprstd4.END PROC schueler;PROC +bereiteplanauf(TEXT CONST plan):ausgminiplan:=plan;stdverschiebung:=0;FOR i +FROM 1UPTO length(vormnachmwechsel)DIV 3REP relzeit:=vormnachmwechselSUB i*3- +2;relzeitCAT (vormnachmwechselSUB i*3-1);zeichen:=vormnachmwechselSUB i*3; +insertchar(ausgminiplan,zeichen,int(relzeit)+stdverschiebung);stdverschiebung +INCR 1PER ;END PROC bereiteplanauf;PROC zeitrasterdaten(BOOL VAR b):IF wert( +fnrzrsj)<>schjCOR wert(fnrzrhj)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE kvn:= +wert(fnrzrkennungteil);kzt:=text(wert(fnrzrtagstunde),2);miniplanCAT kvn;IF +kvn<>kennungvormTHEN IF erstenichtvormstdTHEN kaktvn:=kzt;erstenichtvormstd:= +FALSE FI ELSE erstenichtvormstd:=TRUE FI ;IF int(kzt)MOD stdprotag=1CAND kzt +<>"1 "THEN IF kaktvn<>""THEN vormnachmwechselCAT kaktvn;vormnachmwechselCAT +minivornachmtr;kaktvn:=""FI ;vormnachmwechselCAT kzt;vormnachmwechselCAT +minitagestrFI #IF kzt=text(letztestunde)THEN IF kaktvn<>""THEN +vormnachmwechselCAT kaktvn;vormnachmwechselCAT minivornachmtr;kaktvn:=""FI +FI #FI END PROC zeitrasterdaten;INT PROC anzahlverplstden(TEXT CONST schgr): +TEXT VAR stundenplan:=erstelleallezeiten(schgr),unttage:=tageprowoche*"0", +vormtage:=tageprowoche*"0",nachmtage:=tageprowoche*"0";INT VAR einspos:=1, +anzeinsen:=0,wochentag;iminiplan:=miniplan;anzunttage:=0;anzvormtage:=0; +anznachmtage:=0;WHILE einspos<>0REP einspos:=pos(stundenplan,"1",einspos);IF +einspos<>0THEN anzeinsenINCR 1;replace(iminiplan,einspos,miniunterricht); +wochentag:=(einspos-1)DIV stdprotag+1;IF (unttageSUB wochentag)="0"THEN +replace(unttage,wochentag,"1");anzunttageINCR 1FI ;IF (vormtageSUB wochentag) +="0"CAND vormittagsunterrichtTHEN replace(vormtage,wochentag,"1");anzvormtage +INCR 1FI ;IF (nachmtageSUB wochentag)="0"CAND nachmittagsunterrichtTHEN +replace(nachmtage,wochentag,"1");anznachmtageINCR 1FI ;einsposINCR 1FI PER ; +anzeinsen.vormittagsunterricht:(miniplanSUB einspos)=kennungvorm. +nachmittagsunterricht:(miniplanSUB einspos)=kennungnachm.END PROC +anzahlverplstden;TEXT PROC erstelleallezeiten(TEXT CONST schgruppe):TEXT VAR +allelv:=lvderschuelergruppe(schgruppe),allezeiten,aktzeiten:="",aktlv;INT +VAR i,einspos:=1;aktlv:=text(allelv,laengelv);allezeiten:=allezeitenvon( +kennunglv,aktlv);FOR iFROM 2UPTO length(allelv)DIV laengelvREP aktlv:=subtext +(allelv,(i-1)*laengelv+1,i*laengelv);aktzeiten:=allezeitenvon(kennunglv,aktlv +);einspos:=1;WHILE einspos<>0REP einspos:=pos(aktzeiten,"1",einspos);IF +einspos<>0THEN IF (allezeitenSUB einspos)="0"THEN replace(allezeiten,einspos, +"1");FI ;einsposINCR 1FI ;PER ;PER ;allezeitenEND PROC erstelleallezeiten; +PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN standardmeldung( +meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(meldungkeinstdplan, +"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5 +THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN +standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung( +meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,""); +FI END PROC meldungausgeben;END PACKET springstundenschueler; + diff --git a/app/schulis/2.2.1/src/4.stand der stundenplanung analysieren b/app/schulis/2.2.1/src/4.stand der stundenplanung analysieren new file mode 100644 index 0000000..c505d27 --- /dev/null +++ b/app/schulis/2.2.1/src/4.stand der stundenplanung analysieren @@ -0,0 +1,98 @@ +PACKET standderstundenplanunganalysierenDEFINES +stundenplanstandanalyseausfuehren:LET feldakthj=2,dateiname="Fehlerprotokoll" +,schulname="Schulname",schulort="Schulort",schuljahr="Schuljahr",halbjahr= +"Schulhalbjahr",kennunglv="L",kennungkopplg="K",ausgpar="#",anzkopfzeilen=10, +laengelv=8,laengekopplg=8,laengefachkenn=6,leererraum=" ",leerzeile=" ", +ueberschrift1="Fehlerprotokoll zum Stand der Stundenplanung",unterstrich1= +"-----------------------------------------------------",ausgkopp=" " +,ausgkopplv=" ",ueberschrift2= +"Kopplung Lehrveranst. Wstd. Anmerkung",ueberschrift3= +" soll/ist",unterstrich2= +"---------+------------+-----------+--------------------------------------", +keinefehler="Keine Fehler aufgetreten (alle Kopplungen korrekt verplant)!", +zuvielverpl=" Std. zuviel verplant",raumfehlt="Raum fehlt für ",zuverplanen= +" Std. noch zu verplanen",keinekopplg="Kopplung nicht erhalten (", +meldungserverfehler=376,meldungkeinstdplan=366,meldungkeinesugruppen=334, +meldungzuvielesugruppen=356,meldungkeinelv=326,meldungzuvielelv=358, +meldungbasisinkon=378,meldungwarten=69,meldungstdplauswvorber=384, +meldungkeinehjdaten=382,meldungbearbeitetwird=352;FILE VAR datei;TEXT VAR +aktkopplg:="",aktlv:="",sj,hj,ausgzeile,ausgpostfix;BOOL VAR +kopplungausgegeben:=FALSE ,lvausgegeben:=FALSE ;INT VAR maxwstd:=0,verplstden +:=0,aktwstd:=0,anzverplstden:=0,fstat:=0,anzleereraumzuw:=0,jgstderlv;PROC +meldungausgeben(INT VAR fstat):IF fstat=2THEN standardmeldung( +meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(meldungkeinstdplan, +"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5 +THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN +standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung( +meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,""); +FI ;return(1)END PROC meldungausgeben;PROC stundenplanstandanalyseausfuehren: +standardmeldung(meldungwarten,"");bestimmehalbjahr;bereiteprotokollvor; +setzepufferwerte;holeunduntersuchekopplungen;IF lines(datei)=anzkopfzeilen +THEN putline(datei,keinefehler)FI ;zeigedatei(dateiname,"vr"). +bereiteprotokollvor:forget(dateiname,quiet);datei:=sequentialfile(output, +dateiname);putline(datei,schulkenndatum(schulname));putline(datei,text( +schulkenndatum(schulort),65)+date);putline(datei,leerzeile);putline(datei, +ueberschrift1+" "+hj+". "+text(sj,2)+"/"+subtext(sj,3));putline(datei, +unterstrich1);putline(datei,leerzeile);putline(datei,ueberschrift2);putline( +datei,ueberschrift3);putline(datei,unterstrich2);putline(datei,leerzeile). +bestimmehalbjahr:sj:=schulkenndatum(schuljahr);hj:=schulkenndatum(halbjahr); +IF standardmaskenfeld(feldakthj)=""THEN geplanteshjundsjberechnen(hj,sj);FI . +setzepufferwerte:inittupel(dnrlehrveranstaltungen). +holeunduntersuchekopplungen:IF keinehjdatenTHEN fehlermeldungkeinelvFI ; +standardmeldung(meldungstdplauswvorber,"");stundenplanhalbjahrsetzen(hj,sj); +stundenplanbasisundstundenplanholen(fstat);IF fstat=0COR fstat=8THEN +statleseschleife(ixlvsjhjkopp,sj,hj,fnrlvsj,fnrlvhj,PROC +kopplungenuntersuchen)ELSE meldungausgeben(fstat);LEAVE +stundenplanstandanalyseausfuehren;FI .keinehjdaten:records( +dnrlehrveranstaltungen)=0.0.fehlermeldungkeinelv:standardmeldung( +meldungkeinehjdaten,"");return(1).END PROC stundenplanstandanalyseausfuehren; +PROC kopplungenuntersuchen(BOOL VAR b):IF wert(fnrlvsj)<>sjCOR wert(fnrlvhj) +<>hjCOR dbstatus<>0THEN b:=TRUE ELSE IF aktkopplg<>wert(fnrlvkopplung)THEN +IF nichterstersatzCAND mehrerelvTHEN ueberpruefeinhaltungderkopplungFI ; +aktkopplg:=wert(fnrlvkopplung);standardmeldung(meldungbearbeitetwird, +aktkopplg+ausgpar);maxwstd:=0;IF kopplungausgegebenTHEN putline(datei, +leerzeile)FI ;kopplungausgegeben:=FALSE ;FI ;lvausgegeben:=FALSE ;jgstderlv:= +intwert(fnrlvjgst);IF jgstderlv=0THEN aktlv:="00"+text(wert(fnrlvfachkennung) +,laengefachkenn)ELSE aktlv:=jgstaufber(wert(fnrlvjgst))+text(wert( +fnrlvfachkennung),laengefachkenn)FI ;aktwstd:=intwert(fnrlvwochenstd);IF +maxwstd"".mehrerelv:length(allelvmit(kennungkopplg, +aktkopplg))>laengelv.ueberpruefanzstdenundleereraumangabe:anzleereraumzuw:=0; +verplstden:=anzahlverplstden(kennunglv,aktlv);IF verplstdenaktwstdTHEN fehlerzuvielstdenFI ;IF +anzleereraumzuw>0THEN ausgzeile:="";ausgpostfix:=raumfehlt+text( +anzleereraumzuw)+" Std.";IF kopplungausgegebenTHEN IF lvausgegebenTHEN +ausgzeileCAT ausgkopplv;lvausgegeben:=TRUE ELSE ausgzeileCAT ausgkopp; +ausgzeileCAT aktlv;ausgzeileCAT text(aktwstd,8);ausgzeileCAT text(verplstden, +5);ausgzeileCAT " ";FI ;ELSE ausgzeileCAT text(aktkopplg,laengekopplg+2); +ausgzeileCAT aktlv;ausgzeileCAT text(aktwstd,8);ausgzeileCAT text(verplstden, +5);ausgzeileCAT " ";kopplungausgegeben:=TRUE ;lvausgegeben:=TRUE FI ; +ausgzeileCAT ausgpostfix;putline(datei,ausgzeile)FI .fehlerzuwenigstden: +ausgzeile:="";ausgpostfix:=aktlv;ausgpostfixCAT text(aktwstd,8);ausgpostfix +CAT text(verplstden,5);ausgpostfixCAT " ";ausgpostfixCAT text(aktwstd- +verplstden);ausgpostfixCAT zuverplanen;IF kopplungausgegebenTHEN ausgzeile:= +ausgkopp;ELSE ausgzeile:=text(aktkopplg,laengekopplg+2);kopplungausgegeben:= +TRUE FI ;ausgzeileCAT ausgpostfix;putline(datei,ausgzeile);lvausgegeben:= +TRUE .fehlerzuvielstden:ausgzeile:="";ausgpostfix:=aktlv;ausgpostfixCAT text( +aktwstd,8);ausgpostfixCAT text(verplstden,5);ausgpostfixCAT " "; +ausgpostfixCAT text(verplstden-aktwstd);ausgpostfixCAT zuvielverpl;IF +kopplungausgegebenTHEN ausgzeile:=ausgkopp;ELSE ausgzeile:=text(aktkopplg, +laengekopplg+2);kopplungausgegeben:=TRUE FI ;ausgzeileCAT ausgpostfix;putline +(datei,ausgzeile);lvausgegeben:=TRUE .ueberpruefeinhaltungderkopplung: +anzverplstden:=anzahlverplstden(kennungkopplg,aktkopplg);IF anzverplstden> +maxwstdTHEN ausgpostfix:=keinekopplg;ausgpostfixCAT text(anzverplstden); +ausgpostfixCAT " Wstd.)";IF kopplungausgegebenTHEN IF lvausgegebenTHEN +ausgzeile:=ausgkopplv;ELSE ausgzeile:=ausgkopp;ausgzeileCAT aktlv;ausgzeile +CAT text(aktwstd,8);ausgzeileCAT text(verplstden,5);ausgzeileCAT " "; +lvausgegeben:=TRUE FI ;ELSE ausgzeile:=text(aktkopplg,laengekopplg+2); +ausgzeileCAT aktlv;ausgzeileCAT text(aktwstd,8);ausgzeileCAT text(verplstden, +5);kopplungausgegeben:=TRUE FI ;ausgzeileCAT ausgpostfix;putline(datei, +ausgzeile)FI .END PROC kopplungenuntersuchen;INT PROC anzahlverplstden(TEXT +CONST kennung,kennungstext):TEXT VAR stundenplan:=allezeitenvon(kennung, +kennungstext),plv,praum,ppar;INT VAR einspos:=1,anzeinsen:=0;WHILE einspos<>0 +REP einspos:=pos(stundenplan,"1",einspos);IF einspos<>0THEN anzeinsenINCR 1; +IF kennung=kennunglvTHEN ueberpruefleererraumFI ;einsposINCR 1FI PER ; +anzeinsen.ueberpruefleererraum:planeintraglesen(einspos,kennunglv, +kennungstext,plv,praum,ppar);IF praum=leererraumTHEN anzleereraumzuwINCR 1FI +.END PROC anzahlverplstden;END PACKET standderstundenplanunganalysieren; + diff --git a/app/schulis/2.2.1/src/4.stdpluebersichten b/app/schulis/2.2.1/src/4.stdpluebersichten new file mode 100644 index 0000000..2c760c7 --- /dev/null +++ b/app/schulis/2.2.1/src/4.stdpluebersichten @@ -0,0 +1,425 @@ +PACKET stdpluebersichtenDEFINES merkeartderstdpluebersichtundzeigemaske, +stdpluebersichterstellenunddruckenggfvorherzeigen, +stdpluebersichtdruckenundggfnaechsteerstellen:INT VAR +ausgewaehlteuebersichtsart;LET artlehrer=1,artraeume=2,artsek1=3,artsek2=4, +artzeiten=5,maskennamefuerlehrer="ms stdpluebersicht fuer lehrer", +maskennamefuerraeume="ms stdpluebersicht fuer raeume",maskennamefuersek1= +"ms stdpluebersicht fuer sek1",maskennamefuersek2= +"ms stdpluebersicht fuer sek2",maskennamefuerzeiten= +"ms stdpluebersicht fuer zeiten";TEXT VAR sj,hj,kennung,vonobjekt,bisobjekt, +sek1kennungvon,sek1kennungbis,ueberschrift1,ueberschrift2,tag, +listeallerobjekte:="";INT VAR laengederlistenobjekte,ptraktobjekt,sek1jgstvon +,sek1jgstbis,varspbreite,anzahlspalten,vonstd,bisstd,anzahltage;BOOL VAR +nurdrucken,zweizeilig;LET fnr2geplsj=2,fnr3aktsj=3,fnr4einzeilig=4, +fnr5zweizeilig=5,fnr6vonobjekt=6,fnr7bisobjekt=7,fnr8vonstd=8,fnr9bisstd=9, +fnr10spaltenproseite=10,fnr11tageproseite=11,fnr12bildschirm=12,fnr13drucker= +13,fnrz4vonstd=4,fnrz5bisstd=5,fnrz6anzspalten=6,fnrz7bildschirm=7, +fnrz8drucker=8;LET erstestd=1,letztestdmofr=12,letztestdsa=6,maxanzstdn=66, +letztertag=6,erstertag=1,allewochentagsbezeichnungen= +"MODIMIDOFRSAMoDiMiDoFrSamodimidofrsa";LET konstspbreite=6, +konstkopplungsbreite=8,maxanzspalten1bis4=9,maxanzspalten5=5,maxanzspalten=9, +minanzspalten=1,spaltenbreite8=8,spaltenbreite10=10,spaltenbreite12=12, +spaltenbreite27=27,druckdatei="liste.1",textstdpluebersicht= +"Stundenplanübersicht für ",textlehrer="Lehrer",textraeume="Räume",textsek1= +"Klassen der Sek. 1",textsek2="Jgst. ",textzeiten="Zeiten", +textanfangfuerschulhalbjahr="Schuljahr 19",trennerfuerschuljahr="/", +textmittefuerschulhalbjahr=", ",textendefuerschulhalbjahr=". Halbjahr", +ueberschriftenzahl=2,spaltentrenner=":",trennstrichzeichen="-", +spaltentrennerimstrich="+",textzeiterstespalte="Zeit :",leereerstespalte= +" :",textmontag="Mo",textdienstag="Di",textmittwoch="Mi",textdonnerstag= +"Do",textfreitag="Fr",textsamstag="Sa",textkeintag=" ",trennstrichfuerlv="/" +,ueberschriftspalte2beiart4="Kopplung:",ueberschriftspalte3beiart4= +" Lehrveranstaltungen",ueberschriftbeiart5="Lv /R /P /Kopplg. ", +endeposjgstinlv=2,anfposfachinlv=3,endeposfachinlv=4,anfposkennunginlv=5, +laengeeinerlv=8,laengeeinerkopplung=8,laengeeinerparaphe=4,laengeeinesraumes= +4,laengeeinersgrp=6,laengeeinerjgst=2,zeilebeianfangneueseite=2, +maxtabzahljedruckdatei=10;LET meldnrlistewirdaufgebaut=7, +meldnrbittezahlangeben=53,meldnrzahlausserhalbdergrenzen=54, +meldnrungueltigeeingabe=55,meldnrauswahlnichtsinnvoll=56,meldnrplausi=57, +meldnrlistewirdausgedruckt=58,meldnrbittewarten=69,meldnrinbearbeitung=352, +meldnrkeinegueltigejgst=146,meldnrungueltigeparaphe=344, +meldnrkeinelehrerdatenda=337,meldnrfalscheraumangabe=359, +meldnrkeineraumdatenda=365,meldnrkeinestdpldatenda=366,meldnrfalschetagesbez= +385,meldnrfalschestundenfolge=386,meldnralphabetischefolge=380, +meldnrkeinehjdatenda=382,meldnrmaxzeichenueberschritten=383, +meldnrstdpldatenwerdenaufbereitet=384;INT VAR fehlermeldnr:= +meldnrauswahlnichtsinnvoll,status,aktdnr;BOOL VAR druckenfertig;LET niltext= +"",blank=" ",null=0,bestandraeume="c02 raeume";LET letztejgstsek1=10,jgst11= +"11",jgst12="12",jgst13="13";PROC merkeartderstdpluebersichtundzeigemaske( +INT CONST art):ausgewaehlteuebersichtsart:=art;SELECT artOF CASE artlehrer: +laengederlistenobjekte:=laengeeinerparaphe;kennung:="P";varspbreite:= +spaltenbreite10;standardvproc(maskennamefuerlehrer)CASE artraeume: +laengederlistenobjekte:=laengeeinesraumes;kennung:="R";varspbreite:= +spaltenbreite10;standardvproc(maskennamefuerraeume)CASE artsek1: +laengederlistenobjekte:=laengeeinersgrp;kennung:="S";varspbreite:= +spaltenbreite8;standardvproc(maskennamefuersek1)CASE artsek2: +laengederlistenobjekte:=laengeeinerjgst;kennung:="L";varspbreite:= +spaltenbreite12;standardvproc(maskennamefuersek2)CASE artzeiten:varspbreite:= +spaltenbreite27;standardvproc(maskennamefuerzeiten)END SELECT ;END PROC +merkeartderstdpluebersichtundzeigemaske;PROC +stdpluebersichtdruckenundggfnaechsteerstellen(BOOL CONST drucken):FILE VAR f; +IF druckenTHEN standardmeldung(meldnrlistewirdausgedruckt,niltext);f:= +sequentialfile(output,druckdatei);drucknachbereiten;ELSE TEXT VAR dateiname:= +niltext;INT VAR index:=0;THESAURUS VAR t:=allLIKE "liste.*";get(t,dateiname, +index);WHILE dateiname<>niltextREP forget(dateiname,quiet);get(t,dateiname, +index)PER ;FI ;IF druckenfertigTHEN enter(2)ELSE IF +ausgewaehlteuebersichtsart=artzeitenTHEN bereitetabellefuerzeitenaufELSE +bereitetabelleninderdruckdateiaufFI ;return(1)FI ;END PROC +stdpluebersichtdruckenundggfnaechsteerstellen;PROC +stdpluebersichterstellenunddruckenggfvorherzeigen:standardmeldung( +meldnrplausi,niltext);IF NOT (maskenwerteok)THEN return(1)ELSE IF NOT ( +druckwerteok)THEN fehlermeldnr:=meldnrmaxzeichenueberschritten; +standardmeldung(fehlermeldnr,niltext);return(1)ELSE IF NOT (datenvorhanden) +THEN standardmeldung(fehlermeldnr,niltext);return(1)ELSE IF nurdruckenTHEN +standardmeldung(meldnrbittewarten,niltext)ELSE standardmeldung( +meldnrlistewirdaufgebaut,niltext)FI ;ueberschrift2:= +textanfangfuerschulhalbjahr;ueberschrift2CAT text(sj,2);ueberschrift2CAT +trennerfuerschuljahr;ueberschrift2CAT subtext(sj,3);ueberschrift2CAT +textmittefuerschulhalbjahr;ueberschrift2CAT hj;ueberschrift2CAT +textendefuerschulhalbjahr;initdruckkopf(ueberschrift1,ueberschrift2); +setzemitseitennummern(TRUE );druckenfertig:=FALSE ;ptraktobjekt:=1;IF +ausgewaehlteuebersichtsart=artzeitenTHEN bereitetabellefuerzeitenaufELSE +bereitetabelleninderdruckdateiaufFI ;IF nurdruckenTHEN drucknachbereiten; +WHILE NOT druckenfertigREP IF ausgewaehlteuebersichtsart=artzeitenTHEN +bereitetabellefuerzeitenaufELSE bereitetabelleninderdruckdateiaufFI ; +drucknachbereiten;PER ;enter(1)ELSE zeigedatei(druckdatei,"vr");FI ;FI ;FI ; +FI ;END PROC stdpluebersichterstellenunddruckenggfvorherzeigen;BOOL PROC +maskenwerteok:standardpruefe(5,fnr2geplsj,fnr3aktsj,null,niltext,status);IF +status<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE FI ;sj:= +schulkenndatum("Schuljahr");hj:=schulkenndatum("Schulhalbjahr");IF +standardmaskenfeld(fnr3aktsj)=niltextTHEN geplanteshjundsjberechnen(hj,sj)FI +;stundenplanhalbjahrsetzen(hj,sj);IF ausgewaehlteuebersichtsart<>artzeiten +THEN IF NOT (druckerbildschirmok(fnr12bildschirm,fnr13drucker))THEN LEAVE +maskenwerteokWITH FALSE FI ;standardpruefe(5,fnr4einzeilig,fnr5zweizeilig, +null,niltext,status);IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH +FALSE FI ;zweizeilig:=standardmaskenfeld(fnr4einzeilig)=niltext;IF NOT ( +spaltenanzahlok(fnr10spaltenproseite))THEN LEAVE maskenwerteokWITH FALSE FI ; +IF (standardmaskenfeld(fnr11tageproseite))=niltextTHEN anzahltage:=letztertag ++1ELSE standardpruefe(2,fnr11tageproseite,null,null,niltext,status);IF status +=0THEN standardpruefe(3,fnr11tageproseite,erstertag,letztertag,niltext,status +);IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE ELSE +anzahltage:=int(standardmaskenfeld(fnr11tageproseite));FI ;ELSE infeld(status +);LEAVE maskenwerteokWITH FALSE FI ;FI ;IF standardmaskenfeld(fnr8vonstd)= +niltextTHEN vonstd:=erstestdELSE standardpruefe(2,fnr8vonstd,null,null, +niltext,status);IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH +FALSE FI ;standardpruefe(3,fnr8vonstd,erstestd,letztestdmofr,niltext,status); +IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE FI ;vonstd:=int +(standardmaskenfeld(fnr8vonstd))FI ;IF standardmaskenfeld(fnr9bisstd)=niltext +THEN bisstd:=letztestdmofrELSE standardpruefe(2,fnr9bisstd,null,null,niltext, +status);IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE FI ; +standardpruefe(3,fnr9bisstd,erstestd,letztestdmofr,niltext,status);IF status +<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE FI ;bisstd:=int( +standardmaskenfeld(fnr9bisstd))FI ;IF vonstd>bisstdTHEN infeld(fnr9bisstd); +fehlermeldnr:=meldnrauswahlnichtsinnvoll;standardmeldung(fehlermeldnr,niltext +);LEAVE maskenwerteokWITH FALSE ;FI ;vonobjekt:=standardmaskenfeld( +fnr6vonobjekt);bisobjekt:=standardmaskenfeld(fnr7bisobjekt);ELSE IF NOT ( +druckerbildschirmok(fnrz7bildschirm,fnrz8drucker))THEN LEAVE maskenwerteok +WITH FALSE ELSE IF NOT anfangsundendzeitokTHEN standardmeldung(fehlermeldnr, +niltext);LEAVE maskenwerteokWITH FALSE FI ;IF NOT (spaltenanzahlok( +fnrz6anzspalten))THEN LEAVE maskenwerteokWITH FALSE FI ;FI ;FI ;TRUE . +anfangsundendzeitok:TEXT VAR hilfstext;INT VAR tag;hilfstext:= +standardmaskenfeld(fnrz4vonstd);IF hilfstext=niltextTHEN vonstd:=erstestd +ELSE tag:=pos(allewochentagsbezeichnungen,text(hilfstext,2));IF tag=0THEN +fehlermeldnr:=meldnrfalschetagesbez;infeld(fnrz4vonstd);LEAVE +anfangsundendzeitokWITH FALSE FI ;tag:=(tagMOD 12)DIV 2;vonstd:=int(subtext( +hilfstext,3));IF NOT lastconversionokTHEN fehlermeldnr:= +meldnrbittezahlangeben;infeld(fnrz4vonstd);LEAVE anfangsundendzeitokWITH +FALSE FI ;IF vonstdletztestdmofr) +COR (tag=letztertag-1AND vonstd>letztestdsa)THEN fehlermeldnr:= +meldnrzahlausserhalbdergrenzen;infeld(fnrz4vonstd);LEAVE anfangsundendzeitok +WITH FALSE FI ;vonstd:=vonstd+(tag*letztestdmofr);FI ;hilfstext:= +standardmaskenfeld(fnrz5bisstd);IF hilfstext=niltextTHEN bisstd:=maxanzstdn +ELSE tag:=pos(allewochentagsbezeichnungen,text(hilfstext,2));IF tag=0THEN +fehlermeldnr:=meldnrfalschetagesbez;infeld(fnrz5bisstd);LEAVE +anfangsundendzeitokWITH FALSE FI ;tag:=(tagMOD 12)DIV 2;bisstd:=int(subtext( +hilfstext,3));IF NOT lastconversionokTHEN fehlermeldnr:= +meldnrbittezahlangeben;infeld(fnrz5bisstd);LEAVE anfangsundendzeitokWITH +FALSE FI ;IF bisstdletztestdmofr) +COR (tag=letztertag-1AND bisstd>letztestdsa)THEN fehlermeldnr:= +meldnrzahlausserhalbdergrenzen;infeld(fnrz4vonstd);LEAVE anfangsundendzeitok +WITH FALSE FI ;bisstd:=bisstd+(tag*letztestdmofr);FI ;IF vonstd>bisstdTHEN +fehlermeldnr:=meldnrfalschestundenfolge;infeld(fnrz4vonstd);LEAVE +anfangsundendzeitokWITH FALSE FI ;TRUE END PROC maskenwerteok;BOOL PROC +druckerbildschirmok(INT CONST fnrbs,fnrdr):BOOL VAR richtig:=FALSE ; +standardpruefe(5,fnrbs,fnrdr,null,niltext,status);IF status<>0THEN infeld( +status);ELSE richtig:=TRUE ;nurdrucken:=standardmaskenfeld(fnrbs)=niltext;FI +;richtigEND PROC druckerbildschirmok;BOOL PROC spaltenanzahlok(INT CONST +fnrspaltenanz):BOOL VAR richtig:=FALSE ;INT VAR spaltenmax,spaltenstandard; +IF ausgewaehlteuebersichtsart=artzeitenTHEN spaltenstandard:=2;spaltenmax:= +maxanzspalten5;ELIF ausgewaehlteuebersichtsart=artsek2THEN spaltenstandard:=4 +;spaltenmax:=maxanzspalten1bis4ELSE spaltenstandard:=5;spaltenmax:= +maxanzspalten1bis4FI ;IF standardmaskenfeld(fnrspaltenanz)=niltextTHEN +anzahlspalten:=spaltenstandard;richtig:=TRUE ELSE standardpruefe(2, +fnrspaltenanz,null,null,niltext,status);IF status<>0THEN infeld(status);ELSE +standardpruefe(3,fnrspaltenanz,minanzspalten,spaltenmax,niltext,status);IF +status<>0THEN infeld(status)ELSE anzahlspalten:=int(standardmaskenfeld( +fnrspaltenanz));richtig:=TRUE FI ;FI ;FI ;richtigEND PROC spaltenanzahlok; +BOOL PROC druckwerteok:BOOL VAR richtig;IF ausgewaehlteuebersichtsart=artsek2 +THEN richtig:=konstspbreite+1+konstkopplungsbreite+1+(varspbreite+1)* +anzahlspalten<=druckbreiteELSE richtig:=konstspbreite+1+(varspbreite+1)* +anzahlspalten<=druckbreiteFI ;IF NOT richtigTHEN IF +ausgewaehlteuebersichtsart=artzeitenTHEN infeld(fnrz6anzspalten)ELSE infeld( +fnr10spaltenproseite)FI ;FI ;richtigEND PROC druckwerteok;BOOL PROC +datenvorhanden:BOOL VAR richtig:=FALSE ;stundenplanbasisundstundenplanholen( +status);IF status<>0AND status<>8THEN fehlermeldnr:=meldnrkeinestdpldatenda; +infeld(fnr2geplsj);ELSE SELECT ausgewaehlteuebersichtsartOF CASE artlehrer: +aktdnr:=dnrlehrer;IF (datenpruefungok(fnrlparaphe,fnrlfamname))THEN richtig:= +TRUE ;ueberschrift1:=textstdpluebersicht;ueberschrift1CAT textlehrer;FI ; +CASE artraeume:aktdnr:=dnrschluessel;IF (datenpruefungok(fnrschlsachgebiet, +fnrschlschluessel))THEN richtig:=TRUE ;ueberschrift1:=textstdpluebersicht; +ueberschrift1CAT textraeume;FI ;CASE artsek1:aktdnr:=dnraktschuelergruppen; +IF (datenpruefungok(fnrsgrpsj,fnrsgrphj))THEN richtig:=TRUE ;ueberschrift1:= +textstdpluebersicht;ueberschrift1CAT textsek1;FI ;CASE artsek2:IF jgstokTHEN +richtig:=TRUE ;ueberschrift1:=textstdpluebersicht;ueberschrift1CAT textsek2; +FI ;CASE artzeiten:richtig:=TRUE ;ueberschrift1:=textstdpluebersicht; +ueberschrift1CAT textzeiten;END SELECT ;FI ;richtig.jgstok:IF vonobjekt= +niltextTHEN vonobjekt:=jgst11FI ;IF bisobjekt=niltextTHEN bisobjekt:=jgst13 +FI ;IF vonobjekt<>jgst11AND vonobjekt<>jgst12AND vonobjekt<>jgst13THEN +fehlermeldnr:=meldnrkeinegueltigejgst;infeld(fnr6vonobjekt);LEAVE jgstokWITH +FALSE FI ;IF bisobjekt<>jgst11AND bisobjekt<>jgst12AND bisobjekt<>jgst13THEN +fehlermeldnr:=meldnrkeinegueltigejgst;infeld(fnr7bisobjekt);LEAVE jgstokWITH +FALSE FI ;IF int(bisobjekt)bisobjektTHEN +listeallerobjekteCAT bisobjektFI ;TRUE END PROC datenvorhanden;BOOL PROC +datenpruefungok(INT CONST erstesfeld,zweitesfeld):TEXT VAR ersterparameter, +zweiterparameter;inittupel(aktdnr);listeallerobjekte:=niltext;IF +ausgewaehlteuebersichtsart=artlehrerTHEN IF records(aktdnr)=0.0THEN +fehlermeldnr:=meldnrkeinelehrerdatenda;infeld(fnr6vonobjekt);LEAVE +datenpruefungokWITH FALSE ;FI ;IF vonobjekt<>niltextTHEN putwert(fnrlparaphe, +vonobjekt);search(aktdnr,TRUE );IF dbstatus<>0THEN fehlermeldnr:= +meldnrungueltigeparaphe;infeld(fnr6vonobjekt);LEAVE datenpruefungokWITH +FALSE ;FI ;FI ;IF bisobjekt<>niltextTHEN putwert(fnrlparaphe,bisobjekt); +search(aktdnr,TRUE );IF dbstatus<>0THEN fehlermeldnr:=meldnrungueltigeparaphe +;infeld(fnr7bisobjekt);LEAVE datenpruefungokWITH FALSE ;FI ;FI ; +ersterparameter:=vonobjekt;zweiterparameter:=niltext;inittupel(aktdnr);ELIF +ausgewaehlteuebersichtsart=artraeumeTHEN ersterparameter:=bestandraeume; +zweiterparameter:=vonobjekt;putwert(fnrschlsachgebiet,ersterparameter); +putwert(fnrschlschluessel,zweiterparameter);search(dnrschluessel,FALSE );IF +dbstatus<>0OR wert(fnrschlsachgebiet)<>bestandraeumeTHEN IF vonobjekt=niltext +THEN fehlermeldnr:=meldnrkeineraumdatenda;ELSE fehlermeldnr:= +meldnrfalscheraumangabe;FI ;infeld(fnr6vonobjekt);LEAVE datenpruefungokWITH +FALSE FI ;IF vonobjekt<>niltextTHEN search(dnrschluessel,TRUE );IF dbstatus<> +0THEN fehlermeldnr:=meldnrfalscheraumangabe;infeld(fnr6vonobjekt);LEAVE +datenpruefungokWITH FALSE FI ;FI ;IF bisobjekt<>niltextTHEN putwert( +fnrschlschluessel,bisobjekt);search(dnrschluessel,TRUE );IF dbstatus<>0THEN +fehlermeldnr:=meldnrfalscheraumangabe;infeld(fnr7bisobjekt);LEAVE +datenpruefungokWITH FALSE FI ;FI ;inittupel(aktdnr);ELSE ersterparameter:=sj; +zweiterparameter:=hj;putwert(fnrsgrpsj,ersterparameter);putwert(fnrsgrphj, +zweiterparameter);search(dnrschluessel,FALSE );IF dbstatus<>0OR wert( +fnrsgrphj)<>hjTHEN infeld(fnr6vonobjekt);fehlermeldnr:=meldnrkeinehjdatenda; +LEAVE datenpruefungokWITH FALSE FI ;IF vonobjekt<>niltextTHEN sek1kennungvon +:=subtext(vonobjekt,3,6);sek1jgstvon:=int(subtext(vonobjekt,1,2));IF NOT ( +lastconversionok)THEN infeld(fnr6vonobjekt);fehlermeldnr:= +meldnrkeinegueltigejgst;LEAVE datenpruefungokWITH FALSE FI ;FI ;IF bisobjekt +<>niltextTHEN sek1kennungbis:=subtext(bisobjekt,3,6);sek1jgstbis:=int(subtext +(bisobjekt,1,2));IF NOT lastconversionokCOR sek1jgstvon<5COR sek1jgstvon>11 +COR sek1jgstbis<5COR sek1jgstbis>11THEN infeld(fnr7bisobjekt);fehlermeldnr:= +meldnrkeinegueltigejgst;LEAVE datenpruefungokWITH FALSE ELSE putintwert( +fnrsgrpjgst,sek1jgstvon);putwert(fnrsgrpkennung,sek1kennungvon);IF +sek1jgstvon>sek1jgstbisTHEN infeld(fnr6vonobjekt);fehlermeldnr:= +meldnrzahlausserhalbdergrenzen;LEAVE datenpruefungokWITH FALSE FI ;IF +sek1jgstvon=sek1jgstbisTHEN IF sek1kennungvon>sek1kennungbisTHEN infeld( +fnr6vonobjekt);fehlermeldnr:=meldnralphabetischefolge;LEAVE datenpruefungok +WITH FALSE FI ;FI ;IF sek1jgstbis<>10THEN bisobjekt:="0"+text(sek1jgstbis)+ +sek1kennungbis;FI ;IF sek1jgstvon<>10THEN vonobjekt:="0"+text(sek1jgstvon)+ +sek1kennungvon;FI ;FI ;FI ;FI ;IF vonanfangbisendeTHEN statleseschleife( +aktdnr,ersterparameter,zweiterparameter,erstesfeld,zweitesfeld,PROC dateiende +);ELIF vonanfangbiswertTHEN IF NOT bezeichnungzulaessig(kennung,bisobjekt) +THEN infeld(fnr7bisobjekt);fehlermeldnr:=meldnrungueltigeeingabe; +standardmeldung(fehlermeldnr,niltext);LEAVE datenpruefungokWITH FALSE ELSE +statleseschleife(aktdnr,ersterparameter,zweiterparameter,erstesfeld, +zweitesfeld,PROC endewert);FI ;ELIF vonwertbisendeTHEN IF NOT +bezeichnungzulaessig(kennung,vonobjekt)THEN infeld(fnr6vonobjekt); +fehlermeldnr:=meldnrungueltigeeingabe;standardmeldung(fehlermeldnr,niltext); +LEAVE datenpruefungokWITH FALSE ELSE statleseschleife(aktdnr,ersterparameter, +zweiterparameter,erstesfeld,zweitesfeld,PROC dateiende);FI ;ELIF +vonwertbiswertTHEN IF NOT bezeichnungzulaessig(kennung,vonobjekt)THEN infeld( +fnr6vonobjekt);fehlermeldnr:=meldnrungueltigeeingabe;standardmeldung( +fehlermeldnr,niltext);LEAVE datenpruefungokWITH FALSE ELSE IF NOT +bezeichnungzulaessig(kennung,bisobjekt)THEN infeld(fnr7bisobjekt); +fehlermeldnr:=meldnrungueltigeeingabe;standardmeldung(fehlermeldnr,niltext); +LEAVE datenpruefungokWITH FALSE ELSE IF vonobjekt>bisobjektTHEN infeld( +fnr7bisobjekt);fehlermeldnr:=meldnralphabetischefolge;standardmeldung( +fehlermeldnr,niltext);LEAVE datenpruefungokWITH FALSE ELSE statleseschleife( +aktdnr,ersterparameter,zweiterparameter,erstesfeld,zweitesfeld,PROC endewert) +;FI ;FI ;FI ;ELSE statleseschleife(aktdnr,ersterparameter,zweiterparameter, +erstesfeld,zweitesfeld,PROC endewert);FI ;TRUE .vonanfangbisende:vonobjekt= +niltextAND bisobjekt=niltext.vonanfangbiswert:vonobjekt=niltextAND bisobjekt +<>niltext.vonwertbisende:vonobjekt<>niltextAND bisobjekt=niltext. +vonwertbiswert:vonobjekt<>niltextAND bisobjekt<>niltextEND PROC +datenpruefungok;PROC endewert(BOOL VAR letzter):IF ausgewaehlteuebersichtsart +=artlehrerTHEN IF dbstatus=0AND wert(fnrlparaphe)<=bisobjektTHEN +listeallerobjekteCAT text(wert(fnrlparaphe),laengederlistenobjekte)ELSE +letzter:=TRUE ;FI ;ELIF ausgewaehlteuebersichtsart=artraeumeTHEN IF dbstatus= +0AND wert(fnrschlsachgebiet)=bestandraeumeAND bisobjekt>=wert( +fnrschlschluessel)THEN listeallerobjekteCAT text(wert(fnrschlschluessel), +laengederlistenobjekte)ELSE letzter:=TRUE ;FI ;ELSE IF dbstatus=0AND wert( +fnrsgrpsj)=sjAND wert(fnrsgrphj)=hjAND (sek1jgstbis>intwert(fnrsgrpjgst)OR ( +sek1jgstbis=intwert(fnrsgrpjgst)AND sek1kennungbis>=wert(fnrsgrpkennung))) +THEN listeallerobjekteCAT text(wert(fnrsgrpjgst),2);listeallerobjekteCAT text +(wert(fnrsgrpkennung),4);ELSE letzter:=TRUE ;FI ;FI ;END PROC endewert;PROC +dateiende(BOOL VAR ende):IF ausgewaehlteuebersichtsart=artlehrerTHEN IF +dbstatus=0THEN listeallerobjekteCAT text(wert(fnrlparaphe), +laengederlistenobjekte)ELSE ende:=TRUE FI ;ELIF ausgewaehlteuebersichtsart= +artraeumeTHEN IF dbstatus=0AND wert(fnrschlsachgebiet)=bestandraeumeTHEN +listeallerobjekteCAT text(wert(fnrschlschluessel),laengederlistenobjekte); +ELSE ende:=TRUE FI ;ELSE IF dbstatus=0AND wert(fnrsgrpsj)=sjAND wert( +fnrsgrphj)=hjAND letztejgstsek1>=intwert(fnrsgrpjgst)THEN listeallerobjekte +CAT text(wert(fnrsgrpjgst),2);listeallerobjekteCAT text(wert(fnrsgrpkennung), +4);ELSE ende:=TRUE ;FI ;FI ;END PROC dateiende;PROC drucketrennstrich:TEXT +VAR t:=konstspbreite*trennstrichzeichen;tCAT spaltentrennerimstrich;IF +ausgewaehlteuebersichtsart=artsek2THEN tCAT konstkopplungsbreite* +trennstrichzeichen;tCAT spaltentrennerimstrich;FI ;tCAT anzahlspalten*( +varspbreite*trennstrichzeichen+spaltentrennerimstrich);druckzeileschreiben(t) +END PROC drucketrennstrich;PROC druckespaltenueberschriften(ROW maxanzspalten +TEXT CONST spaltenueberschrift):TEXT VAR t:=textzeiterstespalte;INT VAR i;IF +ausgewaehlteuebersichtsart=artsek2THEN tCAT spaltenueberschrift[1];tCAT +spaltenueberschrift[2]ELSE FOR iFROM 1UPTO anzahlspaltenREP tCAT text( +spaltenueberschrift[i],varspbreite);tCAT spaltentrennerPER FI ;tCAT blank; +druckzeileschreiben(t)END PROC druckespaltenueberschriften;PROC +bereitetabelleninderdruckdateiauf:TEXT VAR jgstbez,lvsderjgst,aktlv,aktkopplg +,lvsprozeit,kopplgnprozeit,kopplgundlvs;INT VAR ptraktlv;INT VAR position, +anfpos,endpos;INT VAR zeilenzaehler,aktstd,spaltenzaehler,stundenzaehler, +tagzaehler,tabellenzaehler;TEXT VAR t,t1,lv,rm,par;BOOL VAR +erstezeilederstunde,stundenochnichtfertig;ROW maxanzspaltenTEXT VAR +spaltenueberschrift,zusatzangabe;druckvorbereiten;FOR tabellenzaehlerFROM 1 +UPTO maxtabzahljedruckdateiREP bestimmespaltenueberschriften;IF +ausgewaehlteuebersichtsart<>artsek2THEN standardmeldung(meldnrinbearbeitung, +spaltenueberschrift(1)+"#");FI ;zeilenzaehler:=zeilebeianfangneueseite; +druckkopfschreiben;druckespaltenueberschriften(spaltenueberschrift); +drucketrennstrich;FOR tagzaehlerFROM erstertagUPTO letztertagREP IF +tagzaehler=letztertagTHEN aktstd:=min(bisstd,letztestdsa)ELSE aktstd:=bisstd +FI ;FOR stundenzaehlerFROM vonstdUPTO aktstdREP bereitezeileneinerstundeauf +PER ;IF zeilenzaehler>zeilebeianfangneueseiteTHEN drucketrennstrich; +zeilenzaehlerINCR 1;evtlseitenumbruchwgueberlaenge;FI ; +evtlseitenumbruchwgtageszahljeseite;PER ;IF zeilenzaehler> +zeilebeianfangneueseiteTHEN seitenwechsel;zeilenzaehler:= +zeilebeianfangneueseite;FI ;PER ;druckenfertig:=ptraktobjekt>length( +listeallerobjekte).bestimmespaltenueberschriften:IF +ausgewaehlteuebersichtsart=artsek2THEN IF ptraktobjekt>length( +listeallerobjekte)THEN druckenfertig:=TRUE ;LEAVE +bereitetabelleninderdruckdateiaufFI ;jgstbez:=subtext(listeallerobjekte, +ptraktobjekt,ptraktobjekt+laengederlistenobjekte-1);lvsderjgst:= +lvderschuelergruppe(jgstbez);spaltenueberschrift[1]:= +ueberschriftspalte2beiart4;spaltenueberschrift[2]:=ueberschriftspalte3beiart4 +;initdruckkopf(ueberschrift1+blank+jgstbez,ueberschrift2);ptraktobjektINCR +laengederlistenobjekte;ELSE spaltenzaehler:=0;WHILE (spaltenzaehler< +anzahlspalten)AND (ptraktobjekt<=length(listeallerobjekte))REP spaltenzaehler +INCR 1;spaltenueberschrift[spaltenzaehler]:=subtext(listeallerobjekte, +ptraktobjekt,ptraktobjekt+laengederlistenobjekte-1);ptraktobjektINCR +laengederlistenobjekte;PER ;IF spaltenzaehler=0THEN druckenfertig:=TRUE ; +LEAVE bereitetabelleninderdruckdateiaufFI ;anzahlspalten:=spaltenzaehlerFI . +bereitezeileneinerstundeauf:erstezeilederstunde:=TRUE ;stundenochnichtfertig +:=TRUE ;WHILE stundenochnichtfertigREP IF erstezeilederstundeTHEN IF +stundenzaehler=vonstdTHEN SELECT tagzaehlerOF CASE 1:t:=textmontag;CASE 2:t:= +textdienstag;CASE 3:t:=textmittwoch;CASE 4:t:=textdonnerstag;CASE 5:t:= +textfreitag;CASE 6:t:=textsamstag;END SELECT ;tag:=t;ELSE t:=textkeintagFI ;t +CAT blank;tCAT text(stundenzaehler,2);tCAT blank;tCAT spaltentrenner;ELSE t:= +leereerstespalte;FI ;IF ausgewaehlteuebersichtsart=artsek2THEN IF +erstezeilederstundeTHEN anfpos:=1;endpos:=8;lvsprozeit:=datenderzeit(( +tagzaehler-1)*letztestdmofr+stundenzaehler,"L");kopplgnprozeit:=datenderzeit( +(tagzaehler-1)*letztestdmofr+stundenzaehler,"K");position:=0;WHILE endpos<= +length(lvsderjgst)AND positionMOD 8<>1REP aktlv:=subtext(lvsderjgst,anfpos, +endpos);position:=pos(lvsprozeit,aktlv);anfposINCR 8;endposINCR 8PER ;IF +position<>0THEN aktkopplg:=subtext(kopplgnprozeit,position,position+7); +kopplgundlvs:=aktkopplg;anfpos:=1;endpos:=8;position:=pos(kopplgnprozeit, +aktkopplg);WHILE endpos<=length(kopplgnprozeit)AND position<>0REP IF position +MOD 8=1THEN aktlv:=subtext(lvsprozeit,position,position+7);IF pos( +kopplgundlvs,aktlv)=0THEN kopplgundlvsCAT aktlvFI ;anfposINCR 8;endposINCR 8; +FI ;position:=pos(kopplgnprozeit,aktkopplg,position+1);PER ;ELSE kopplgundlvs +:=niltextFI ;tCAT text(text(kopplgundlvs,laengeeinerkopplung), +konstkopplungsbreite);ptraktlv:=laengeeinerkopplung+1;ELSE tCAT +konstkopplungsbreite*blankFI ;tCAT spaltentrenner;standardmeldung( +meldnrinbearbeitung,"Jahrgangsstufe: "+jgstbez+" Wochentag: "+tag+"#");FI ; +aktstd:=(tagzaehler-1)*letztestdmofr+stundenzaehler;FOR spaltenzaehlerFROM 1 +UPTO anzahlspaltenREP IF ausgewaehlteuebersichtsart=artsek2THEN IF ptraktlv<= +length(kopplgundlvs)THEN lv:=subtext(kopplgundlvs,ptraktlv,ptraktlv+ +laengeeinerlv-1);ptraktlvINCR laengeeinerlv;planeintraglesen(aktstd,kennung, +lv,lv,rm,par);rm:=8*blank+rm;t1:=subtext(lv,anfposfachinlv,endeposfachinlv); +t1CAT blank;t1CAT subtext(lv,anfposkennunginlv);t1CAT trennstrichfuerlv;t1 +CAT par;ELSE t1:=niltext;par:=niltext;rm:=niltext;FI ;ELSE planeintraglesen( +aktstd,kennung,spaltenueberschrift[spaltenzaehler],lv,rm,par);IF lv=niltext +THEN t1:=niltextELSE IF ausgewaehlteuebersichtsart=artsek1THEN IF length(lv)> +laengeeinerlvTHEN lv:=text(lv,laengeeinerlv);t1:=datenzurlv("K",lv);rm:= +niltext;ELSE t1:=blank;t1CAT subtext(lv,anfposfachinlv,endeposfachinlv);t1 +CAT blank;t1CAT par;FI ;rm:=4*blank+rmELSE t1:=text(lv,endeposjgstinlv);t1 +CAT blank;t1CAT subtext(lv,anfposfachinlv,endeposfachinlv);t1CAT blank;t1CAT +subtext(lv,anfposkennunginlv);FI ;FI ;FI ;tCAT text(t1,varspbreite);tCAT +spaltentrenner;IF zweizeiligTHEN IF ausgewaehlteuebersichtsart=artraeumeTHEN +zusatzangabe[spaltenzaehler]:=parELSE zusatzangabe[spaltenzaehler]:=rmFI ; +zusatzangabe[spaltenzaehler]:=text(zusatzangabe[spaltenzaehler],varspbreite); +FI ;PER ;druckzeileschreiben(t);zeilenzaehlerINCR 1;IF zeilenzaehler= +drucklaenge(ueberschriftenzahl)THEN seitenwechsel;zeilenzaehler:= +zeilebeianfangneueseite;IF zweizeiligCOR tagzaehlerzeilebeianfangneueseiteTHEN seitenwechsel;zeilenzaehler:= +zeilebeianfangneueseite;IF tagzaehler +zeilebeianfangneueseiteTHEN drucketrennstrich;zeilenzaehlerINCR 1;IF +zeilenzaehler=drucklaenge(ueberschriftenzahl)THEN seitenwechsel;zeilenzaehler +:=zeilebeianfangneueseite;IF stundenzaehlerlength(listeallerobjekte)THEN tCAT konstkopplungsbreite* +blank;tCAT trennstrichfuerlv;tCAT 4*blank;tCAT trennstrichfuerlv;tCAT 4*blank +;tCAT trennstrichfuerlv;tCAT konstkopplungsbreite*blank;tCAT spaltentrenner; +ELSE tCAT subtext(listeallerobjekte,ptraktobjekt,ptraktobjekt+laengeeinerlv-1 +);tCAT trennstrichfuerlv;ptraktobjektINCR laengeeinerlv;tCAT subtext( +stringraeume,ptraktraum,ptraktraum+laengeeinesraumes-1);tCAT +trennstrichfuerlv;ptraktraumINCR laengeeinesraumes;tCAT subtext( +stringparaphen,ptraktparaphe,ptraktparaphe+laengeeinerparaphe-1);tCAT +trennstrichfuerlv;ptraktparapheINCR laengeeinerparaphe;tCAT subtext( +stringkopplungen,ptraktkopplung,ptraktkopplung+laengeeinerkopplung-1);tCAT +spaltentrenner;ptraktkopplungINCR laengeeinerkopplung;FI ;PER ; +druckzeileschreiben(t);zeilenzaehlerINCR 1;evtlseitenumbruchwgueberlaenge; +PER .evtlseitenumbruchwgueberlaenge:IF zeilenzaehler=drucklaenge( +ueberschriftenzahl)THEN seitenwechsel;zeilenzaehler:=zeilebeianfangneueseite; +IF stundenzaehlerniltextTHEN druckkopfschreiben +;druckespaltenueberschriften(spaltenueberschrift);drucketrennstrich;FI ;FI ;. +END PROC bereitetabellefuerzeitenauf;END PACKET stdpluebersichten; + diff --git a/app/schulis/2.2.1/src/4.stundenplan akt halbj uebernehmen b/app/schulis/2.2.1/src/4.stundenplan akt halbj uebernehmen new file mode 100644 index 0000000..0d29a46 --- /dev/null +++ b/app/schulis/2.2.1/src/4.stundenplan akt halbj uebernehmen @@ -0,0 +1,141 @@ +PACKET stundenplanakthalbjuebernehmenDEFINES stundenplanuebernehmenpruefen, +stundenplanuebernehmen:LET feldjgst1=2,feldjgst2=3,maxanzfehler=500,laengelv= +8,schuljahr="Schuljahr",halbjahr="Schulhalbjahr",schulname="Schulname", +schulort="Schulort",kennungraum="R",kennungparaphe="P",kennunglv="L",allejgst +="00050607080910111213",leererraum=" ",ausgabeparam="#",erstestd=1, +letztestd=66,dateiname="Protokoll zur Stundenplan-Übernahme",zwdatei= +"Zwischenspeicherung",lvungueltig="Lehrveranstaltung nicht geplant", +raumungueltig1="Raumbezeichnung ",raumungueltig2=" ungültig",ohneraum= +" (Übernahme ohne Raum)",schnittschueler="Zeitüberschneidung Schüler durch ", +schnittlehrer="Zeitüberschneidung Lehrer durch",schnittraum= +"Zeitüberschneidung Raum ",leerzeile=" ",ueberschrift1= +"Stundenplan für Jgst. ",ueberschrift2=" übernehmen von ",ueberschrift3= +" nach ",meldungwirklichuebern=300,meldungfalschejgst=305,meldungabbruch=400, +meldungbearbwird=352,meldungplausi=57,meldungwarten=69,meldungkeinesugruppen= +334,meldungzuvielesugruppen=356,meldungkeinelv=326,meldungserverfehler=376, +meldungbasisinkon=378,meldungjgst13=402,meldungzuvielelv=358;TEXT VAR aktsj, +akthj,geplsj,geplhj,jgst1,jgst2,allelvderzeit,alleraeumederzeit,eintrag, +aktzubearbjgst,geplzubearbjgst;INT VAR i,j,fstat,jg1,jg2,jgstpos,anzbearbjgst +,zz:=0;BOOL VAR geplstundenplanneu:=FALSE ,jgstumzusetzen:=FALSE , +erstereintrag:=TRUE ;FILE VAR datei,z;PROC stundenplanreorganisiertverlassen: +stundenplanreorganisierenundsichern(fstat);IF fstat<>0THEN return(2); +meldungausgeben(fstat)FI END PROC stundenplanreorganisiertverlassen;PROC +stundenplanuebernehmenpruefen:standardmeldung(meldungwarten," "); +holestartdaten;jgst1:=standardmaskenfeld(feldjgst1);jgst2:=standardmaskenfeld +(feldjgst2);pruefeingaben;gibmeldunguebernahmeaus;standardnproc. +holestartdaten:aktsj:=schulkenndatum(schuljahr);akthj:=schulkenndatum( +halbjahr);geplsj:=aktsj;geplhj:=akthj;geplanteshjundsjberechnen(geplhj,geplsj +).pruefeingaben:standardmeldung(meldungplausi,"");IF jgstrichtig(jgst1,jg1,1) +THEN IF NOT jgstrichtig(jgst2,jg2,2)THEN infeld(feldjgst2); +fehlermeldungfalschejgstFI ELSE infeld(feldjgst1);fehlermeldungfalschejgstFI +;IF jgst1=jgst2THEN aktzubearbjgst:=jgst1;ELSE aktzubearbjgst:=subtext( +allejgst,pos(allejgst,jgst1),pos(allejgst,jgst2)+1)FI ;anzbearbjgst:=length( +aktzubearbjgst)DIV 2;IF geplhj="2"THEN geplzubearbjgst:=aktzubearbjgstELIF +jgst1="13"THEN infeld(feldjgst1);fehlermeldungfalscherwertELIF jgst2="13" +THEN infeld(feldjgst2);fehlermeldungfalscherwertELSE jgstumzusetzen:=TRUE ; +berechnegeplzubearbjgstFI .fehlermeldungfalschejgst:standardmeldung( +meldungfalschejgst,"");return(1);LEAVE stundenplanuebernehmenpruefen. +fehlermeldungfalscherwert:standardmeldung(meldungjgst13,"");return(1);LEAVE +stundenplanuebernehmenpruefen.gibmeldunguebernahmeaus:standardmeldung( +meldungwirklichuebern,"").END PROC stundenplanuebernehmenpruefen;PROC +berechnegeplzubearbjgst:TEXT VAR jg;jgstpos:=1;geplzubearbjgst:="";FOR iFROM +1UPTO anzbearbjgstREP jg:=subtext(aktzubearbjgst,jgstpos,jgstpos+1);IF jg= +"00"THEN geplzubearbjgstCAT "00"ELSE geplzubearbjgstCAT jgstaufber(text(int( +jg)+1))FI ;jgstposINCR 2PER END PROC berechnegeplzubearbjgst;BOOL PROC +jgstrichtig(TEXT VAR jgst,INT VAR jg,INT CONST pruefung):IF jgst<>""THEN jg:= +int(jgst);IF jg=0CAND lastconversionokTHEN jgst:="00";TRUE ELIF +lastconversionokTHEN IF jg>4CAND jg<14THEN jgst:=jgstaufber(jgst);TRUE ELSE +FALSE FI ELSE FALSE FI ELIF pruefung=1THEN jgst:="05";jg:=5;TRUE ELIF +pruefung=2THEN jgst:=jgst1;jg:=jg1;TRUE ELSE FALSE FI .END PROC jgstrichtig; +PROC stundenplanuebernehmen(BOOL CONST uebernahme):TEXT VAR ueberschrift:=""; +IF uebernahmeTHEN standardmeldung(meldungbearbwird,"Stundenplan "+akthj+". "+ +text(aktsj,2)+"/"+subtext(aktsj,3)+ausgabeparam);stundenplanhalbjahrsetzen( +akthj,aktsj);stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat +<>8THEN meldungausgeben(fstat);return(2);LEAVE stundenplanuebernehmenFI ; +forget(dateiname,quiet);datei:=sequentialfile(output,dateiname);ueberschrift +:=ueberschrift1+jgst1;IF jgst1<>jgst2THEN ueberschriftCAT " bis "+jgst2FI ; +ueberschriftCAT ueberschrift2;ueberschriftCAT akthj+". ";ueberschriftCAT text +(aktsj,2)+"/";ueberschriftCAT subtext(aktsj,3);ueberschriftCAT ueberschrift3; +ueberschriftCAT geplhj+". ";ueberschriftCAT text(geplsj,2)+"/";ueberschrift +CAT subtext(geplsj,3);putline(datei,schulkenndatum(schulname));putline(datei, +text(schulkenndatum(schulort),65)+date);putline(datei,leerzeile);putline( +datei,ueberschrift);putline(datei,length(ueberschrift)*"-");holalleeintraege; +fstat:=0;loeschealleeintraege;IF fstat<>0CAND fstat<>8THEN meldungausgeben( +fstat);return(2);LEAVE stundenplanuebernehmenFI ;uebertragalleeintraege; +stundenplanreorganisiertverlassen;IF zz>maxanzfehlerTHEN standardmeldung( +meldungabbruch,text(zz)+ausgabeparam)ELIF zz=0THEN +eintragkeineuebernahmefehlerFI ;IF fstat=0THEN zeigedatei(dateiname,"vr");FI +ELSE return(2)FI .eintragkeineuebernahmefehler:putline(datei,leerzeile); +putline(datei,"Bei der Übernahme traten keine Fehler auf!").END PROC +stundenplanuebernehmen;PROC loeschealleeintraege:INT VAR jgstpos:=1; +geplstundenplanneu:=FALSE ;stundenplanhalbjahrsetzen(geplhj,geplsj); +standardmeldung(meldungbearbwird,"Stundenplan "+geplhj+". "+text(geplsj,2)+ +"/"+subtext(geplsj,3)+ausgabeparam);stundenplanbasisundstundenplanholen(fstat +);IF fstat<>0CAND fstat<>8THEN stundenplanbasisundstundenplanerstellen(fstat) +;IF fstat<>0THEN LEAVE loeschealleeintraegeELSE geplstundenplanneu:=TRUE ; +stundenplanbasissichern(fstat);stundenplansichern(fstat);IF fstat<>0THEN +meldungausgeben(fstat);return(2);LEAVE loeschealleeintraegeFI FI FI ;IF +geplstundenplanneuTHEN LEAVE loeschealleeintraegeFI ;FOR iFROM erstestdUPTO +letztestdREP standardmeldung(meldungbearbwird,tagstunde(i,FALSE )+ +" (Einträge löschen)"+ausgabeparam);allelvderzeit:=datenderzeit(i,kennunglv); +jgstpos:=1;FOR jFROM 1UPTO anzbearbjgstREP loeschelv(subtext(geplzubearbjgst, +jgstpos,jgstpos+1));jgstposINCR 2PER PER .END PROC loeschealleeintraege;PROC +loeschelv(TEXT CONST jgst):INT VAR suchab:=1,aktpos;BOOL VAR spok:=TRUE ; +WHILE pos(allelvderzeit,jgst,suchab)>0REP aktpos:=pos(allelvderzeit,jgst, +suchab);IF aktposMOD laengelv=1THEN planeintragloeschen(i,subtext( +allelvderzeit,aktpos,aktpos+7),spok)FI ;suchab:=aktpos+7PER .END PROC +loeschelv;PROC holalleeintraege:forget(zwdatei,quiet);z:=sequentialfile( +output,zwdatei);FOR iFROM erstestdUPTO letztestdREP standardmeldung( +meldungbearbwird,tagstunde(i,FALSE )+" (Einträge holen)"+ausgabeparam); +allelvderzeit:=datenderzeit(i,kennunglv);alleraeumederzeit:=datenderzeit(i, +kennungraum);jgstpos:=1;eintrag:="";FOR jFROM 1UPTO anzbearbjgstREP holelv( +subtext(aktzubearbjgst,jgstpos,jgstpos+1));jgstposINCR 2PER ;putline(z, +eintrag)PER .END PROC holalleeintraege;PROC holelv(TEXT CONST jgst):INT VAR +suchab:=1,aktpos,ii;TEXT VAR lveintrag;WHILE pos(allelvderzeit,jgst,suchab)>0 +REP aktpos:=pos(allelvderzeit,jgst,suchab);IF aktposMOD laengelv=1THEN ii:=( +aktpos+1)DIV 2;IF jgstumzusetzenTHEN lveintrag:=lv;IF text(lveintrag,2)<>"00" +THEN eintragCAT jgstaufber(text(int(text(lveintrag,2))+1));eintragCAT subtext +(lveintrag,3);ELSE eintragCAT lvFI ;eintragCAT raumELSE eintragCAT lv+raumFI +FI ;suchab:=aktpos+7PER .lv:subtext(allelvderzeit,aktpos,aktpos+7).raum: +subtext(alleraeumederzeit,ii,ii+3).END PROC holelv;PROC +uebertragalleeintraege:zz:=0;modify(z);toline(z,1);col(z,1);FOR iFROM +erstestdUPTO letztestdREP standardmeldung(meldungbearbwird,tagstunde(i,FALSE +)+" (Einträge übernehmen)"+ausgabeparam);readrecord(z,eintrag);IF eintrag<>"" +THEN erstereintrag:=TRUE ;schreibeintraegeFI ;down(z);IF zz>maxanzfehlerTHEN +putline(datei,leerzeile);putline(datei, +"Abbruch, da bei der Übernahme zuviele Fehler auftraten!");LEAVE +uebertragalleeintraegeFI PER END PROC uebertragalleeintraege;PROC +schreibeintraege:TEXT VAR lv,raum,t1,t2;INT VAR lvpos:=1;BOOL VAR ohnefehler; +WHILE lvposlv +CAND t2<>"".pruefraumundschnitt:IF raum<>leererraumTHEN IF NOT +bezeichnungzulaessig(kennungraum,raum)THEN IF erstereintragTHEN putline(datei +,leerzeile);erstereintrag:=FALSE FI ;putline(datei,jgfake(lv)+": "+tagstunde( +i,TRUE )+". : "+raumungueltig1+raum+raumungueltig2+ohneraum);zzINCR 1;raum:= +leererraumELIF raumunterrichtTHEN IF erstereintragTHEN putline(datei, +leerzeile);erstereintrag:=FALSE FI ;putline(datei,jgfake(lv)+": "+tagstunde(i +,TRUE )+". : "+schnittraum+raum+ohneraum);zzINCR 1;raum:=leererraumFI FI . +raumunterricht:t1:=geplantelvfuer(i,kennungraum,raum);t1<>lvCAND t1<>"".END +PROC schreibeintraege;TEXT PROC jgfake(TEXT CONST lv):text(lv,2)+" "+subtext( +lv,3,4)+" "+subtext(lv,5)END PROC jgfake;PROC meldungausgeben(INT VAR fstat): +IF fstat=2THEN standardmeldung(meldungserverfehler,"");ELIF fstat=4THEN +standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5THEN standardmeldung( +meldungzuvielesugruppen,"")ELIF fstat=6THEN standardmeldung(meldungkeinelv,"" +)ELIF fstat=7THEN standardmeldung(meldungzuvielelv,"")ELIF fstat=9THEN +standardmeldung(meldungbasisinkon,"");ELSE LEAVE meldungausgebenFI END PROC +meldungausgeben;END PACKET stundenplanakthalbjuebernehmen; + diff --git a/app/schulis/2.2.1/src/4.stundenplan im dialog erstellen b/app/schulis/2.2.1/src/4.stundenplan im dialog erstellen new file mode 100644 index 0000000..634545c --- /dev/null +++ b/app/schulis/2.2.1/src/4.stundenplan im dialog erstellen @@ -0,0 +1,382 @@ +PACKET stundenplanimdialogerstellenundaendernDEFINES stupidstart, +stupidbearbeitendesstundenplans,stupidspeicherndieserzeitenfuerkopplung, +stupidspeichernderraeumeundzeitenderlv,stupidkopierenderraumangabe, +stupidnichtaendernweitermitkopplung, +stupidnichtaendernweitermitnaechsterkopplung,stupidstoerendelvlisten, +stupidraumbelegunglisten,stupidlistedrucken:LET maskeeingang= +"ms erf stuplan im dialog 0";LET maskebearb1="ms erf stuplan im dialog 1"; +LET maskebearb2="ms erf stuplan im dialog 2";LET fnrkopplungbs0=2, +fnrakthalbjahr=3,fnrmitzeitwuenschen=4,fnrkopplungbs1=2,fnrwstdmaxbs1=3, +felderbistabbeginn=2,fnrersteseingabefeldbs1=4,felderproeintragbs1=2, +fnrletztesfeldbs1=135,fnrlehrveranstaltbs2=2,fnrwstdbs2=3,fnrparaphebs2=4, +fnrklassengruppenbeginn=5,fnrraumwunsch=9,felderbistabbeginnbs2=10, +fnrersterraumbs2=12,fnrletztesfeldbs2=142,felderproeintragbs2=2;INT VAR +fnrersteseingabefeldbs2;INT VAR ifnr;LET meldnrbittewarten=69, +meldnrdatenwurdengespeichert=302,meldnrdatenwurdennichtgespeichert=303, +meldnrungueltigekopplung=325,meldnrkeinelv=326,meldnrkeinesugruppen=334, +meldnrzuvielesugruppen=356,meldnrdatenaufbereitet=357,meldnrzuvielelv=358, +meldnrungueltigerraum=359,meldnrzuordnungwegensperrungunmoegl=368, +meldnrzuvielezuordnungen=369,meldnrraumschonbelegt=370, +meldnrstundenplanserverfehlt=376,meldnrbasisalt=377,meldnrbasisinkons=378, +meldnrkeinestoerendenlv=371;FILE VAR ausgabeliste;LET liste1= +"störende Lehrveranstaltungen",liste2="Raumbelegungen";TEXT VAR zeigdatei; +LET raumgruppendatei="Datei mit Raumgruppen";FILE VAR datraumgruppen;LET +wunschraumdatei="Datei mit Raumwünschen";FILE VAR datraumwunsch;LET +zwdateiname="Datei mit Zeitwünschen";FILE VAR zwdatei;LET laengelv=8, +laengefachkenn=6,laengekopplung=8,laengeparaphe=4,laengeraum=4,laengewstd=2, +laengesugruppe=6,laengeklagruppe=4,laengenfaktor=2;LET erstestd=1,letztestd= +66;LET kennzlehrergesperrt="L",kennzzeitgesperrt="X",kennzraumgesperrt="R", +kennzschuelergesperrt="S",kennzzeitrastersperrung="x",kennzlehrerwunsch="l", +kennzraumevtlgesperrt="r",kennzverplant="x",kennzkeinfreierwunschraum="x", +kennzraumungeprueft="-";LET kennungkopplung="K",kennungparaphe="P",kennunglv= +"L",kennungraum="R",kennungwunschraum="RW",kennungersatzraum="RE";LET +stundeverplant="1",stundefrei="0",stundefehlerhaft="$";LET textschulj= +"Schuljahr",texthalbj="Schulhalbjahr";LET raumkenndaten="c02 raeume";LET +posraeumeinrgzeile=5;LET raumplatzhalter=" ",lehrerplatzhalter=" ", +blankzeichen=" ",trennstrich="/",vorschlagzeichen="*",textueberschriftanhang= +" für Halbjahr ",textueberschriftbs2="Raumzuordnung in Kopplung ";LET zwbezug +="P";LET minusdrei="-3";INT VAR fstatusstuplan;INT VAR i;INT VAR +maxwochenstunden;TEXT VAR aktschulj:="",akthalbj:="",gewschulj,gewhalbj, +behandeltesschulj:="",behandelteshalbj:="";TEXT VAR kopplung,ankreuzung, +eintrag,lv,paraphe,raum,raumhinweis,raumzeile,raumgruppenzeile,zwdateizeile, +raumbelegliste,raumsetzliste,alleraeume:="",paraphenmitzeitwuenschen:="", +sugruppen;INT VAR anzahlraeume,posraum;INT VAR wstdderlv;TEXT VAR +kopplungszeiten,schuelerschnittzeiten,zeitrasterleiste:="", +halbjderzeitrasterleiste:="",zeitwunschleiste,halbjderzeitwuensche:="", +lvliste,paraphenliste;INT VAR ilv,anzahllv;TEXT VAR suchlv,suchraum, +suchparaphe;TEXT VAR ueberschrift,ueberschriftbs1:="";BOOL VAR +mitzeitwuenschen,meldungzufehlergezeigt;TEXT VAR wertfeld2:="",wertfeld3:="", +wertfeld4:="";PROC stupidstart:standardstartproc(maskeeingang); +wertedeseingangsbildschirmsholen;infeld(fnrkopplungbs0); +standardfelderausgeben;infeld(fnrkopplungbs0);standardnprocEND PROC +stupidstart;PROC stupidbearbeitendesstundenplans: +schulhalbjahrbestimmenundstundenplanholen;IF fstatusstuplan<>0THEN +stundenplanfehlerbehandeln;return(1)ELSE suchekopplung;IF +keinegueltigekopplungTHEN standardmeldung(meldnrungueltigekopplung,"");return +(1)ELSE wertedeseingangsbildschirmsmerken;standardstartproc(maskebearb1); +kopplungzeigen;standardnprocFI FI .schulhalbjahrbestimmenundstundenplanholen: +IF akthalbj=""THEN akthalbj:=schulkenndatum(texthalbj);aktschulj:= +schulkenndatum(textschulj);FI ;gewhalbj:=akthalbj;gewschulj:=aktschulj;IF +standardmaskenfeld(fnrakthalbjahr)=""THEN geplanteshjundsjberechnen(gewhalbj, +gewschulj)FI ;mitzeitwuenschen:=standardmaskenfeld(fnrmitzeitwuenschen)<>""; +IF mitzeitwuenschenTHEN IF paraphenmitzeitwuenschen=""COR gewhalbj<> +halbjderzeitwuenscheTHEN halbjderzeitwuensche:=gewhalbj;standardmeldung( +meldnrbittewarten,"");dateimitzeitwuenschenzusammenstellenFI FI ;IF NOT ( +gewhalbj=behandelteshalbjAND gewschulj=behandeltesschulj)THEN +behandelteshalbj:=gewhalbj;behandeltesschulj:=gewschulj; +stundenplanhalbjahrsetzen(gewhalbj,gewschulj);standardmeldung( +meldnrdatenaufbereitet,"");stundenplanbasisundstundenplanholen(fstatusstuplan +);IF fstatusstuplan=0THEN stundenplanreorganisierenundsichern(fstatusstuplan) +ELIF fstatusstuplan=8THEN standardmeldung(meldnrbasisalt,""); +stundenplanreorganisierenundsichern(fstatusstuplan)ELSE +stundenplanbasisundstundenplanerstellen(fstatusstuplan);IF fstatusstuplan=0 +THEN stundenplanbasissichern(fstatusstuplan);stundenplansichern( +fstatusstuplan)FI FI FI .stundenplanfehlerbehandeln:IF fstatusstuplan=2THEN +standardmeldung(meldnrstundenplanserverfehlt,"")ELIF fstatusstuplan=4THEN +standardmeldung(meldnrkeinesugruppen,"")ELIF fstatusstuplan=5THEN +standardmeldung(meldnrzuvielesugruppen,"")ELIF fstatusstuplan=6THEN +standardmeldung(meldnrkeinelv,"")ELIF fstatusstuplan=7THEN standardmeldung( +meldnrzuvielelv,"")ELIF fstatusstuplan=8THEN standardmeldung(meldnrbasisalt, +"")ELIF fstatusstuplan=9THEN standardmeldung(meldnrbasisinkons,"")FI . +suchekopplung:kopplung:=standardmaskenfeld(fnrkopplungbs0);putwert(fnrlvsj, +gewschulj);putwert(fnrlvhj,gewhalbj);putwert(fnrlvkopplung,kopplung);search( +ixlvsjhjkopp,FALSE ).END PROC stupidbearbeitendesstundenplans;BOOL PROC +keinegueltigekopplung:dbstatus<>0OR wert(fnrlvhj)<>gewhalbjOR wert(fnrlvsj)<> +gewschuljEND PROC keinegueltigekopplung;PROC +dateimitzeitwuenschenzusammenstellen:forget(zwdateiname,quiet);zwdatei:= +sequentialfile(output,zwdateiname);paraphenmitzeitwuenschen:="";inittupel( +dnrzeitwuensche);putwert(fnrzwbezug,zwbezug);statleseschleife(dnrzeitwuensche +,gewschulj,gewhalbj,fnrzwsj,fnrzwhj,PROC zeitwunschlesen)END PROC +dateimitzeitwuenschenzusammenstellen;PROC zeitwunschlesen(BOOL VAR b):IF +dbstatus<>0OR wert(fnrzwsj)<>gewschuljOR wert(fnrzwhj)<>gewhalbjOR wert( +fnrzwbezug)>zwbezugTHEN b:=TRUE ELSE paraphenmitzeitwuenschenCAT text(wert( +fnrzwbezugsobjekt),laengeparaphe);zwdateizeile:=wert(fnrzwbestimmtewuensche); +putline(zwdatei,zwdateizeile)FI END PROC zeitwunschlesen;PROC kopplungzeigen: +ueberschriftzeilezusammensetzen;standardkopfmaskeaktualisieren(ueberschrift); +standardmeldung(meldnrbittewarten,"");datenbestimmenundausgeben;infeld( +fnrersteseingabefeldbs1).ueberschriftzeilezusammensetzen:IF ueberschriftbs1= +""THEN ueberschriftbs1:=text(vergleichsknoten)FI ;ueberschrift:= +ueberschriftbs1;ueberschriftCAT textueberschriftanhang;ueberschriftCAT +gewhalbj;ueberschriftCAT blankzeichen;ueberschriftCAT subtext(gewschulj,1,2); +ueberschriftCAT trennstrich;ueberschriftCAT subtext(gewschulj,3,4). +datenbestimmenundausgeben:kopplung:=wert(fnrlvkopplung); +maxwochenstundenbestimmen;zeitrasterleistefestlegen;kopplungszeitenfestlegen; +lvlisteholen;paraphenlisteundwunschraumlisteholen;schuelerschnittzeitenholen; +zeitwunschleistefestlegen;standardmaskenfeld(kopplung,fnrkopplungbs1); +standardmaskenfeld(text(maxwochenstunden),fnrwstdmaxbs1); +meldungzufehlergezeigt:=FALSE ;FOR iFROM erstestdUPTO letztestdREP +fuelleeintrag;standardmaskenfeld(ankreuzung,i*felderproeintragbs1+ +felderbistabbeginn);standardmaskenfeld(text(eintrag,3),i*felderproeintragbs1+ +felderbistabbeginn+1);PER ;IF meldungzufehlergezeigtTHEN infeld(2)ELSE infeld +(1)FI ;standardfelderausgeben.maxwochenstundenbestimmen:maxwochenstunden:=0; +putwert(fnrlvkopplung,kopplung);putintwert(fnrlvjgst,0);statleseschleife( +ixlvsjhjkopp,gewschulj,gewhalbj,fnrlvsj,fnrlvhj,PROC maxwochenstdberechnen). +fuelleeintrag:IF (kopplungszeitenSUB i)=stundeverplantTHEN ankreuzung:= +kennzverplantELSE ankreuzung:=""FI ;eintrag:="";IF (zeitrasterleisteSUB i)= +kennzzeitrastersperrungTHEN eintragCAT kennzzeitgesperrtELSE +weiterepruefungenzueintragFI .weiterepruefungenzueintrag:IF +istlehrerzurzeitverplantTHEN eintragCAT kennzlehrergesperrtELSE IF +mitzeitwuenschenCAND (zeitwunschleisteSUB i)=stundeverplantTHEN eintragCAT +kennzlehrerwunschFI FI ;IF (schuelerschnittzeitenSUB i)=stundeverplantTHEN +eintragCAT kennzschuelergesperrtELIF (schuelerschnittzeitenSUB i)= +stundefehlerhaftCAND NOT meldungzufehlergezeigtTHEN standardmeldung( +meldnrbasisinkons,"");meldungzufehlergezeigt:=TRUE FI ;IF eintrag= +kennzlehrergesperrt+kennzschuelergesperrtTHEN eintragCAT kennzraumungeprueft +ELSE raumhinweis:="";prueferaumbelegung;eintragCAT raumhinweisFI . +kopplungszeitenfestlegen:kopplungszeiten:=allezeitenvon(kennungkopplung, +kopplung).lvlisteholen:lvliste:=allelvmit(kennungkopplung,kopplung);anzahllv +:=length(lvliste)DIV laengelv.schuelerschnittzeitenholen: +schuelerschnittzeiten:=schuelergruppenschnittallezeiten(kennungkopplung, +kopplung).paraphenlisteundwunschraumlisteholen:paraphenliste:=""; +raumgruppeninraumgruppendateiauslesen;forget(wunschraumdatei,quiet); +datraumwunsch:=sequentialfile(output,wunschraumdatei);INT VAR lvpos:=1,iraum; +FOR ilvFROM 1UPTO anzahllvREP lv:=subtext(lvliste,lvpos,lvpos+laengelv-1); +paraphenlisteCAT datenzurlv(kennungparaphe,lv);raumzeile:="";raum:=datenzurlv +(kennungwunschraum,lv);IF bezeichnungzulaessig(kennungraum,compress(raum)) +THEN raumzeileCAT raumELSE raumzeileCAT raeumederraumgruppeFI ;raum:= +datenzurlv(kennungersatzraum,lv);IF bezeichnungzulaessig(kennungraum,compress +(raum))THEN raumzeileCAT raumELSE raumzeileCAT raeumederraumgruppeFI ;putline +(datraumwunsch,raumzeile);lvpos:=lvpos+laengelvPER . +raumgruppeninraumgruppendateiauslesen:IF NOT exists(raumgruppendatei)THEN +datraumgruppen:=sequentialfile(output,raumgruppendatei);inittupel( +dnrraumgruppen);statleseschleife(dnrraumgruppen,"","",fnrrgraumgrp, +fnrrgraeume,PROC raumgruppeindateischreiben)FI .raeumederraumgruppe: +datraumgruppen:=sequentialfile(modify,raumgruppendatei);toline(datraumgruppen +,1);col(datraumgruppen,1);WHILE NOT eof(datraumgruppen)REP downety( +datraumgruppen,raum);IF col(datraumgruppen)=1CAND NOT eof(datraumgruppen) +THEN readrecord(datraumgruppen,raumgruppenzeile);LEAVE raeumederraumgruppe +WITH subtext(raumgruppenzeile,posraeumeinrgzeile)ELSE col(datraumgruppen,col( +datraumgruppen)+1)FI ;PER ;"".prueferaumbelegung:BOOL VAR vorlaeufiggesetzt; +raumbelegliste:=datenderzeit(i,kennungraum);IF raumbelegliste<>""THEN +raumsetzliste:="";datraumwunsch:=sequentialfile(input,wunschraumdatei);ilv:=0 +;WHILE NOT eof(datraumwunsch)REP getline(datraumwunsch,raumzeile);ilv:=ilv+1; +IF raumzeile<>""THEN anzahlraeume:=length(raumzeile)DIV laengeraum; +vorlaeufiggesetzt:=FALSE ;posraum:=1;FOR iraumFROM 1UPTO anzahlraeumeREP raum +:=subtext(raumzeile,posraum,posraum+laengeraum-1);prueferaum;posraum:=posraum ++laengeraumUNTIL vorlaeufiggesetztPER ;IF NOT vorlaeufiggesetztTHEN +raumhinweis:=kennzraumevtlgesperrtFI ;FI ;PER ;FI .prueferaum:IF suchpos( +raumbelegliste,raum,laengeraum)>0THEN lv:=subtext(lvliste,(ilv-1)*laengelv+1, +ilv*laengelv);planeintraglesen(i,kennungraum,raum,suchlv,suchraum,suchparaphe +);IF suchlv<>lvTHEN IF iraum=anzahlraeumeTHEN raumhinweis:=kennzraumgesperrt; +LEAVE prueferaumbelegungFI ELSE vorlaeufiggesetzt:=TRUE FI ELSE IF suchpos( +raumsetzliste,raum,laengeraum)=0THEN raumsetzliste:=raum;vorlaeufiggesetzt:= +TRUE FI FI .zeitwunschleistefestlegen:IF mitzeitwuenschenTHEN zwdatei:= +sequentialfile(modify,zwdateiname);zeitwunschleiste:=letztestd*stundefrei; +INT VAR fundpos,posparaphe:=1;WHILE posparaphe0THEN zeitwuenschezerlegenFI ;posparapheINCR laengeparaphe;PER ;FI . +zeitwuenschezerlegen:INT VAR izeile:=(fundpos+3)DIV laengeparaphe;toline( +zwdatei,izeile);readrecord(zwdatei,zwdateizeile);fundpos:=pos(zwdateizeile, +minusdrei,1);WHILE fundpos>0REP fundposINCR 1;replace(zeitwunschleiste, +fundposDIV 2,stundeverplant);fundpos:=pos(zwdateizeile,minusdrei,fundpos)PER +.END PROC kopplungzeigen;PROC raumgruppeindateischreiben(BOOL VAR b):IF +dbstatus=0THEN putline(datraumgruppen,text(wert(fnrrgraumgrp),laengeraum)+ +wert(fnrrgraeume))ELSE b:=TRUE FI END PROC raumgruppeindateischreiben;PROC +maxwochenstdberechnen(BOOL VAR b):IF dbstatus=0CAND wert(fnrlvkopplung)= +kopplungCAND wert(fnrlvsj)=gewschuljCAND wert(fnrlvhj)=gewhalbjTHEN +maxwochenstunden:=max(intwert(fnrlvwochenstd),maxwochenstunden)ELSE b:=TRUE +FI END PROC maxwochenstdberechnen;PROC zeitrasterleistefestlegen:IF gewhalbj +<>halbjderzeitrasterleisteOR zeitrasterleiste=""THEN zeitrasterleiste:= +letztestd*blankzeichen;inittupel(dnrzeitraster);statleseschleife( +dnrzeitraster,gewschulj,gewhalbj,fnrzrsj,fnrzrhj,PROC +erstellezeitrasterleiste);halbjderzeitrasterleiste:=gewhalbj;FI END PROC +zeitrasterleistefestlegen;PROC erstellezeitrasterleiste(BOOL VAR b):IF wert( +fnrzrsj)<>gewschuljCOR wert(fnrzrhj)<>gewhalbjCOR dbstatus<>0THEN b:=TRUE +ELSE IF wert(fnrzrkennungteil)=kennzzeitrastersperrungTHEN replace( +zeitrasterleiste,intwert(fnrzrtagstunde),kennzzeitrastersperrung)FI FI END +PROC erstellezeitrasterleiste;BOOL PROC istlehrerzurzeitverplant:TEXT VAR +kopplungenderzeit:="";TEXT VAR lehrerderzeit:=datenderzeit(i,kennungparaphe); +IF lehrerderzeit=""COR paraphenliste=lehrerplatzhalterTHEN LEAVE +istlehrerzurzeitverplantWITH FALSE FI ;INT VAR posparaphe:=1;INT VAR +poslehrer,poskopplung;WHILE posparaphe<=length(paraphenliste)REP paraphe:= +subtext(paraphenliste,posparaphe,posparaphe+laengeparaphe-1);IF paraphe<> +lehrerplatzhalterTHEN poslehrer:=suchpos(lehrerderzeit,paraphe,laengeparaphe) +;IF poslehrer>0THEN IF kopplungenderzeit=""THEN kopplungenderzeit:= +datenderzeit(i,kennungkopplung)FI ;poskopplung:=(poslehrer-1)*laengenfaktor+1 +;IF subtext(kopplungenderzeit,poskopplung,poskopplung+laengekopplung-1)<>text +(kopplung,laengekopplung)THEN LEAVE istlehrerzurzeitverplantWITH TRUE FI FI ; +FI ;posparaphe:=posparaphe+laengeparaphePER ;FALSE END PROC +istlehrerzurzeitverplant;PROC stupidstoerendelvlisten:TEXT VAR prueflv, +pruefkopplung,pruefparaphe,lvderzeit,kopplungenderzeit,paraphenderzeit, +vglkopplung,auszeile;INT VAR feldnr:=infeld;IF +sperrungderzeitdurchlehreroderschuelerTHEN erstelledateimitstoerendenlv; +zeigedatei(zeigdatei,"");ELSE standardmeldung(meldnrkeinestoerendenlv,""); +return(1)FI .sperrungderzeitdurchlehreroderschueler:pos(standardmaskenfeld( +feldnr+1),kennzlehrergesperrt)>0OR pos(standardmaskenfeld(feldnr+1), +kennzschuelergesperrt)>0.erstelledateimitstoerendenlv:i:=(feldnr- +felderbistabbeginn)DIV felderproeintragbs1;zeigdatei:=liste1;forget(zeigdatei +,quiet);ausgabeliste:=sequentialfile(output,zeigdatei);auszeile:="Kopplung "; +auszeileCAT kopplung;auszeileCAT " am ";auszeileCAT tagstunde(i,FALSE ); +auszeileCAT ".Stunde verhindert durch:";putline(ausgabeliste,auszeile);line( +ausgabeliste);auszeile:="Lehrveranst. (Kopplung) Lehrer Klassengruppen"; +putline(ausgabeliste,auszeile);lvderzeit:=datenderzeit(i,kennunglv); +kopplungenderzeit:=datenderzeit(i,kennungkopplung);paraphenderzeit:= +datenderzeit(i,kennungparaphe);INT VAR poslv:=1,poskopplung:=1,posparaphe:=1; +vglkopplung:=text(kopplung,laengekopplung);WHILE poslv<=length(lvderzeit)REP +pruefkopplung:=subtext(kopplungenderzeit,poskopplung,poskopplung+ +laengekopplung-1);IF pruefkopplung<>vglkopplungTHEN pruefparaphe:=subtext( +paraphenderzeit,posparaphe,posparaphe+laengeparaphe-1);prueflv:=subtext( +lvderzeit,poslv,poslv+laengelv-1);IF suchpos(paraphenliste,pruefparaphe, +laengeparaphe)>0CAND pruefparaphe<>lehrerplatzhalterTHEN vermerkelvELIF +gemeinsameschuelergruppen(kennungkopplung,kopplung,kennunglv,prueflv)THEN +vermerkelvFI ;FI ;poskopplung:=poskopplung+laengekopplung;poslv:=poslv+ +laengelv;posparaphe:=posparaphe+laengeparaphe;PER .vermerkelv:auszeile:= +subtext(prueflv,1,2);auszeileCAT blankzeichen;auszeileCAT subtext(prueflv,3,4 +);auszeileCAT blankzeichen;auszeileCAT subtext(prueflv,5);auszeileCAT " "; +auszeileCAT pruefkopplung;auszeileCAT " ";auszeileCAT pruefparaphe;auszeile +CAT " ";sugruppen:=beteiligteschuelergruppen(kennunglv,prueflv);INT VAR +possu:=1;WHILE possu<=length(sugruppen)REP auszeileCAT subtext(sugruppen, +possu,possu+laengesugruppe-1);auszeileCAT blankzeichen;possu:=possu+ +laengesugruppePER ;putline(ausgabeliste,auszeile).END PROC +stupidstoerendelvlisten;PROC stupidraumbelegunglisten:TEXT VAR auszeile;INT +VAR feldnr:=infeld;erstelledateimitraumbelegung;zeigedatei(zeigdatei,""). +erstelledateimitraumbelegung:i:=(feldnr-felderbistabbeginnbs2)DIV +felderproeintragbs2;zeigdatei:=liste2;forget(zeigdatei,quiet);ausgabeliste:= +sequentialfile(output,zeigdatei);auszeile:= +"Raumbelegung für Lehrveranstaltung ";auszeileCAT subtext(lv,1,2);auszeile +CAT blankzeichen;auszeileCAT subtext(lv,3,4);auszeileCAT blankzeichen; +auszeileCAT subtext(lv,5);auszeileCAT " am ";auszeileCAT tagstunde(i,FALSE ); +auszeileCAT ".Stunde:";putline(ausgabeliste,auszeile);line(ausgabeliste); +putline(ausgabeliste,"freie Räume:");line(ausgabeliste);IF alleraeume=""THEN +alleraeumeholenFI ;posraum:=1;WHILE posraum<=length(alleraeume)REP raum:= +subtext(alleraeume,posraum,posraum+laengeraum-1);planeintraglesen(i, +kennungraum,raum,suchlv,suchraum,suchparaphe);IF suchraum=""THEN putline( +ausgabeliste,raum)FI ;posraum:=posraum+laengeraumPER ;line(ausgabeliste);line +(ausgabeliste);putline(ausgabeliste,"Belegung der Wunsch- und Ersatzräume:"); +datraumwunsch:=sequentialfile(modify,wunschraumdatei);toline(datraumwunsch, +ilv);readrecord(datraumwunsch,raumzeile);posraum:=1;WHILE posraum<=length( +raumzeile)REP raum:=subtext(raumzeile,posraum,posraum+laengeraum-1); +planeintraglesen(i,kennungraum,raum,suchlv,suchraum,suchparaphe);IF suchraum +<>""THEN auszeile:=raum;auszeileCAT " : ";auszeileCAT subtext(suchlv,1,2); +auszeileCAT blankzeichen;auszeileCAT subtext(suchlv,3,4);auszeileCAT +blankzeichen;auszeileCAT subtext(suchlv,5);putline(ausgabeliste,auszeile);FI +;posraum:=posraum+laengeraumPER .alleraeumeholen:inittupel(dnrschluessel); +statleseschleife(dnrschluessel,raumkenndaten,"",fnrschlsachgebiet, +fnrschlschluessel,PROC raeumeholen).END PROC stupidraumbelegunglisten;PROC +raeumeholen(BOOL VAR b):IF wert(fnrschlsachgebiet)>raumkenndatenCOR dbstatus +<>0THEN b:=TRUE ELSE alleraeumeCAT text(wert(fnrschlschluessel),laengeraum) +FI END PROC raeumeholen;PROC stupidspeicherndieserzeitenfuerkopplung:BOOL +VAR plausifehler:=FALSE ;INT VAR anzahlankreuzungen:=0;ifnr:= +fnrersteseingabefeldbs1;REP IF standardmaskenfeld(ifnr)<>""THEN IF zeitbelegt +OR lehrerbelegtOR schuelerbelegtTHEN plausifehler:=TRUE ;standardmeldung( +meldnrzuordnungwegensperrungunmoegl,"");infeld(ifnr)FI ;anzahlankreuzungen +INCR 1FI ;ifnrINCR felderproeintragbs1UNTIL (ifnr>fnrletztesfeldbs1)OR +plausifehlerPER ;IF plausifehlerTHEN return(1)ELIF anzahlankreuzungen> +maxwochenstundenTHEN standardmeldung(meldnrzuvielezuordnungen,"");return(1) +ELSE speichernderkopplung;standardmeldung(meldnrdatenwurdengespeichert,""); +stundenplansichern(fstatusstuplan);IF anzahlankreuzungen=0THEN +stupidnichtaendernweitermitnaechsterkopplungELSE standardstartproc( +maskebearb2);erstelvzurkopplungnocheinmallesen;ilv:=1;lvzeigen;standardnproc +FI FI .zeitbelegt:pos(standardmaskenfeld(ifnr+1),kennzzeitgesperrt)>0. +lehrerbelegt:pos(standardmaskenfeld(ifnr+1),kennzlehrergesperrt)>0. +schuelerbelegt:pos(standardmaskenfeld(ifnr+1),kennzschuelergesperrt)>0. +erstelvzurkopplungnocheinmallesen:putwert(fnrlvsj,gewschulj);putwert(fnrlvhj, +gewhalbj);putwert(fnrlvkopplung,kopplung);search(ixlvsjhjkopp,FALSE ). +speichernderkopplung:INT VAR poslv;ifnr:=fnrersteseingabefeldbs1;FOR iFROM +erstestdUPTO letztestdREP ankreuzung:=standardmaskenfeld(ifnr);IF ( +kopplungszeitenSUB i)=stundeverplantTHEN IF ankreuzung=""THEN +kopplungentfernenELSE kopplungueberschreibenFI ELSE IF ankreuzung<>""THEN +kopplungschreibenFI ;FI ;ifnr:=ifnr+felderproeintragbs1PER .kopplungschreiben +:BOOL VAR ok;poslv:=1;WHILE poslv<=length(lvliste)REP lv:=subtext(lvliste, +poslv,poslv+laengelv-1);planeintragvornehmen(i,lv,raumplatzhalter,ok);poslv:= +poslv+laengelvPER ;replace(kopplungszeiten,i,stundeverplant). +kopplungentfernen:poslv:=1;WHILE poslv<=length(lvliste)REP lv:=subtext( +lvliste,poslv,poslv+laengelv-1);planeintragloeschen(i,lv,ok);poslv:=poslv+ +laengelvPER ;replace(kopplungszeiten,i,stundefrei).kopplungueberschreiben: +poslv:=1;WHILE poslv<=length(lvliste)REP lv:=subtext(lvliste,poslv,poslv+ +laengelv-1);planeintraglesen(i,kennunglv,lv,suchlv,suchraum,suchparaphe); +suchraum:=compress(suchraum);IF suchraum=""THEN suchraum:=raumplatzhalterFI ; +planeintragvornehmen(i,lv,suchraum,ok);poslv:=poslv+laengelvPER .END PROC +stupidspeicherndieserzeitenfuerkopplung;PROC lvzeigen: +ueberschriftzeilezusammensetzen;standardkopfmaskeaktualisieren(ueberschrift); +datenbestimmenundausgeben.ueberschriftzeilezusammensetzen:ueberschrift:= +textueberschriftbs2;ueberschriftCAT kopplung;ueberschriftCAT +textueberschriftanhang;ueberschriftCAT gewhalbj;ueberschriftCAT blankzeichen; +ueberschriftCAT subtext(gewschulj,1,2);ueberschriftCAT trennstrich; +ueberschriftCAT subtext(gewschulj,3,4).datenbestimmenundausgeben: +werteauslvsatzholen;ifnr:=felderbistabbeginnbs2;fnrersteseingabefeldbs2:=0; +FOR iFROM erstestdUPTO letztestdREP IF (kopplungszeitenSUB i)=stundeverplant +THEN planeintraglesen(i,kennunglv,text(lv,laengelv),suchlv,suchraum, +suchparaphe);IF compress(suchraum)<>""THEN standardmaskenfeld(blankzeichen, +ifnr+1);standardmaskenfeld(compress(suchraum),ifnr+2)ELSE standardmaskenfeld( +vorschlagzeichen,ifnr+1);standardmaskenfeld(compress(wunschraumvorschlag), +ifnr+2)FI ;IF fnrersteseingabefeldbs2=0THEN fnrersteseingabefeldbs2:=ifnr+2 +FI ELSE standardmaskenfeld(blankzeichen,ifnr+1);standardmaskenfeld( +raumplatzhalter,ifnr+2);feldschutz(ifnr+2)FI ;ifnr:=ifnr+felderproeintragbs2 +PER ;infeld(1);standardfelderausgeben;infeld(fnrersteseingabefeldbs2). +werteauslvsatzholen:lv:=jgstzweistellig(intwert(fnrlvjgst))+text(wert( +fnrlvfachkennung),laengefachkenn);wstdderlv:=intwert(fnrlvwochenstd);paraphe +:=wert(fnrlvparaphe);standardmaskenfeld(text(lv,laengelv), +fnrlehrveranstaltbs2);standardmaskenfeld(text(wstdderlv,laengewstd), +fnrwstdbs2);standardmaskenfeld(text(paraphe,laengeparaphe),fnrparaphebs2); +standardmaskenfeld(text(wert(fnrlvklgrp1),laengeklagruppe), +fnrklassengruppenbeginn);standardmaskenfeld(text(wert(fnrlvklgrp2), +laengeklagruppe),fnrklassengruppenbeginn+1);standardmaskenfeld(text(wert( +fnrlvklgrp3),laengeklagruppe),fnrklassengruppenbeginn+2);standardmaskenfeld( +text(wert(fnrlvklgrp4),laengeklagruppe),fnrklassengruppenbeginn+3); +standardmaskenfeld(text(wert(fnrlvraumgrp1),laengeraum),fnrraumwunsch); +standardmaskenfeld(text(wert(fnrlvraumgrp2),laengeraum),fnrraumwunsch+1). +wunschraumvorschlag:datraumwunsch:=sequentialfile(modify,wunschraumdatei); +toline(datraumwunsch,ilv);readrecord(datraumwunsch,raumzeile);raumbelegliste +:=datenderzeit(i,kennungraum);posraum:=1;WHILE posraum<=length(raumzeile)REP +raum:=subtext(raumzeile,posraum,posraum+laengeraum-1);IF suchpos( +raumbelegliste,raum,laengeraum)=0THEN LEAVE wunschraumvorschlagWITH raumFI ; +posraum:=posraum+laengeraumPER ;kennzkeinfreierwunschraum.END PROC lvzeigen; +PROC stupidspeichernderraeumeundzeitenderlv(BOOL CONST speichern):BOOL VAR +plausifehler,ok;IF speichernTHEN plausifehler:=FALSE ; +plausipruefungfuerraeumezulv;IF plausifehlerTHEN return(1)ELSE +raeumezulvspeichern;standardmeldung(meldnrdatenwurdengespeichert,""); +stundenplansichern(fstatusstuplan);naechstelvzurbearbeitungFI ELSE +standardmeldung(meldnrdatenwurdennichtgespeichert,""); +naechstelvzurbearbeitungFI .plausipruefungfuerraeumezulv:INT VAR +anzahlankreuzungen:=0;ifnr:=fnrersterraumbs2;FOR iFROM erstestdUPTO letztestd +REP IF (kopplungszeitenSUB i)=stundeverplantTHEN raum:=compress( +standardmaskenfeld(ifnr));IF raum<>""THEN anzahlankreuzungen:= +anzahlankreuzungen+1;IF raum<>kennzkeinfreierwunschraumTHEN IF NOT +bezeichnungzulaessig(kennungraum,raum)THEN standardmeldung( +meldnrungueltigerraum,"");infeld(ifnr);plausifehler:=TRUE ELIF +raumdurchanderelvbelegtTHEN standardmeldung(meldnrraumschonbelegt,"");infeld( +ifnr);plausifehler:=TRUE FI FI FI FI ;ifnr:=ifnr+felderproeintragbs2UNTIL +plausifehlerPER ;IF NOT plausifehlerTHEN IF anzahlankreuzungen>wstdderlvTHEN +standardmeldung(meldnrzuvielezuordnungen,"");infeld(fnrersteseingabefeldbs2); +plausifehler:=TRUE FI FI .raumdurchanderelvbelegt:planeintraglesen(i, +kennungraum,raum,suchlv,suchraum,suchparaphe);compress(suchraum)<>""AND +suchlv<>lv.raeumezulvspeichern:ifnr:=fnrersterraumbs2;FOR iFROM erstestdUPTO +letztestdREP IF (kopplungszeitenSUB i)=stundeverplantTHEN raum:=compress( +standardmaskenfeld(ifnr));IF raum=""THEN planeintragloeschen(i,lv,ok);ELSE +IF raum=kennzkeinfreierwunschraumTHEN raum:=raumplatzhalterFI ; +planeintragvornehmen(i,lv,raum,ok);FI FI ;ifnr:=ifnr+felderproeintragbs2PER . +naechstelvzurbearbeitung:succ(ixlvsjhjkopp);IF dbstatus=0THEN IF +weiterelvzukopplungvorhandenTHEN ilv:=ilv+1;lvzeigen;return(1)ELSE +standardstartproc(maskebearb1);kopplungzeigen;return(2)FI ELSE enter(3)FI . +weiterelvzukopplungvorhanden:wert(fnrlvkopplung)=kopplungAND wert(fnrlvhj)= +gewhalbjAND wert(fnrlvsj)=gewschulj.END PROC +stupidspeichernderraeumeundzeitenderlv;PROC stupidkopierenderraumangabe:INT +VAR feldnr:=infeld;ifnr:=feldnr;WHILE ifnrraumplatzhalterTHEN +standardmaskenfeld(standardmaskenfeld(feldnr),ifnr)FI PER ;return(1)END PROC +stupidkopierenderraumangabe;PROC stupidnichtaendernweitermitkopplung:putwert( +fnrlvkopplung,kopplung+blankzeichen);search(ixlvsjhjkopp,FALSE );IF +keinegueltigekopplungTHEN enter(3)ELSE standardstartproc(maskebearb1); +kopplungzeigen;return(2)FI END PROC stupidnichtaendernweitermitkopplung;PROC +stupidnichtaendernweitermitnaechsterkopplung:putwert(fnrlvkopplung,kopplung+ +blankzeichen);search(ixlvsjhjkopp,FALSE );IF keinegueltigekopplungTHEN enter( +2)ELSE kopplungzeigen;return(1)FI END PROC +stupidnichtaendernweitermitnaechsterkopplung;PROC stupidlistedrucken(BOOL +CONST drucken):IF druckenTHEN print(zeigdatei)FI ;forget(zeigdatei,quiet); +return(2)END PROC stupidlistedrucken;INT PROC suchpos(TEXT CONST quelle, +suchtext,INT CONST laenge):INT VAR findpos:=pos(quelle,suchtext);WHILE +findpos>0REP IF findposMOD laenge=1THEN LEAVE suchposWITH findposELSE findpos +:=pos(quelle,suchtext,findpos+1);FI PER ;findposEND PROC suchpos;TEXT PROC +jgstzweistellig(INT CONST intjgst):IF intjgst=0THEN "00"ELIF intjgst>4AND +intjgst<10THEN "0"+text(intjgst)ELSE text(intjgst)FI END PROC jgstzweistellig +;PROC wertedeseingangsbildschirmsmerken:wertfeld2:=standardmaskenfeld( +fnrkopplungbs0);wertfeld3:=standardmaskenfeld(fnrakthalbjahr);wertfeld4:= +standardmaskenfeld(fnrmitzeitwuenschen)END PROC +wertedeseingangsbildschirmsmerken;PROC wertedeseingangsbildschirmsholen: +standardmaskenfeld(wertfeld2,fnrkopplungbs0);standardmaskenfeld(wertfeld3, +fnrakthalbjahr);standardmaskenfeld(wertfeld4,fnrmitzeitwuenschen)END PROC +wertedeseingangsbildschirmsholen;END PACKET +stundenplanimdialogerstellenundaendern + diff --git a/app/schulis/2.2.1/src/4.stundenplan nach lv erfassen b/app/schulis/2.2.1/src/4.stundenplan nach lv erfassen new file mode 100644 index 0000000..376fbac --- /dev/null +++ b/app/schulis/2.2.1/src/4.stundenplan nach lv erfassen @@ -0,0 +1,133 @@ +PACKET stundenplannachlverfassenDEFINES stundenplannachlvspeichern, +stundenplannachlvreorganisiertverlassen,stundenplannachlvkopieren, +stundenplannachlvzeigen:LET stdplmaske="ms stdplan nach lv bearb", +feldeingjgst=2,feldeingfach=3,feldeingkenn=4,feldeingakthj=5,laengelv=8, +lvmitleeremraum="x",leererraum=" ",leererlehrer=" ",schuljahr= +"Schuljahr",halbjahr="Schulhalbjahr",kennungwstd="W",kennungraum="R", +kennungparaphe="P",kennunglv="L",kennungzulzeit="ZZ",ausgabeparam="#", +maxstunden=66,meldungplausi=57,meldungfeldfuellen=52,meldungfalschejgst=305, +meldungzuvielewstd=369,meldungjgstergaenzen=304,meldungfalschesfach=310, +meldungkeinestartlv=68,meldungspeichern=50,meldungwarten=69, +meldungdatenaufbereitet=357,meldungkeinesugruppen=334,meldungzuvielesugruppen +=356,meldunglehrerbesetzt=361,meldungraumbesetzt=370,meldungsugrupbesetzt=362 +,meldungzeitgesperrt=363,meldungkeinelv=326,meldungaenderungsfehler=364, +meldunguvfehler=403,meldungserverfehler=376,meldungbasisinkon=378, +meldunganderewahl=318,meldungfalscherraum=359,meldungzuvielelv=358;ROW +maxstundenTEXT VAR lvausstdpl;ROW maxstundenTEXT VAR lvvombs;TEXT VAR schhj, +schj,aktfachkenn,aktlv,eintraglv,lveintrag,raumeintrag,pareintrag,hjsjanhang +:="";INT VAR i,fstat,hjkennalt:=-1,aktjgst,uvokfeld:=2,wstdderlv,hjkennneu:=0 +;BOOL VAR spok:=TRUE ,uvok:=TRUE ,aenderungsfehler:=FALSE ;PROC +stundenplannachlvkopieren:INT VAR aktfeld:=infeld;TEXT VAR feldinhalt:="";IF +aktfeld=67THEN fehlermeldunganwunzulELSE kopierenFI ;return(1).kopieren: +feldinhalt:=standardmaskenfeld(aktfeld);standardmaskenfeld(feldinhalt,aktfeld ++1);standardfelderausgeben;infeld(aktfeld).fehlermeldunganwunzul: +standardmeldung(meldunganderewahl,"").END PROC stundenplannachlvkopieren; +PROC stundenplannachlvreorganisiertverlassen: +stundenplanreorganisierenundsichern(fstat);IF fstat<>0THEN return(1); +meldungausgeben(fstat)ELSE enter(2)FI END PROC +stundenplannachlvreorganisiertverlassen;PROC stundenplannachlvzeigen:INT VAR +jgst:=0;TEXT VAR jg:="",fach:="",kennung:="";standardmeldung(meldungwarten, +" ");jg:=standardmaskenfeld(feldeingjgst);fach:=standardmaskenfeld( +feldeingfach);kennung:=standardmaskenfeld(feldeingkenn);pruefeeingabe; +maskeundinitialisierung;holstartlv;stundenplannachlvausgeben.pruefeeingabe: +IF jg<>""THEN jgst:=int(jg);IF lastconversionokTHEN pruefjgstELSE +fehlermeldungfalschejgstFI ;FI ;prueffach;pruefkennung.pruefjgst:IF jgst<>0 +THEN IF jgst<5COR jgst>13THEN fehlermeldungfalschejgstFI FI . +fehlermeldungfalschejgst:standardmeldung(meldungfalschejgst,"");infeld( +feldeingjgst);return(1);LEAVE stundenplannachlvzeigen.prueffach:IF fach<>"" +THEN IF jg=""THEN standardmeldung(meldungjgstergaenzen,"");infeld( +feldeingjgst);return(1);LEAVE stundenplannachlvzeigenELSE fach:=compress(fach +);inittupel(dnrfaecher);putwert(fnrffach,fach);search(dnrfaecher,TRUE );IF +dbstatus<>okTHEN fehlermeldungfalschesfachFI FI FI .fehlermeldungfalschesfach +:standardmeldung(meldungfalschesfach,"");infeld(feldeingfach);return(1); +LEAVE stundenplannachlvzeigen.pruefkennung:IF kennung<>""THEN IF jg=""THEN +standardmeldung(meldungfeldfuellen,"");infeld(feldeingjgst);return(1);LEAVE +stundenplannachlvzeigenFI ;IF fach=""THEN standardmeldung(meldungfeldfuellen, +"");infeld(feldeingfach);return(1);LEAVE stundenplannachlvzeigenFI ;FI . +maskeundinitialisierung:aktlv:="";aktjgst:=0;aktfachkenn:="";IF akthj<>"" +THEN hjkennneu:=0ELSE hjkennneu:=1FI ;IF hjkennneu<>hjkennaltTHEN hjkennalt:= +hjkennneu;schj:=schulkenndatum(schuljahr);schhj:=schulkenndatum(halbjahr);IF +hjkennneu=1THEN geplanteshjundsjberechnen(schhj,schj)FI ; +stundenplanhalbjahrsetzen(schhj,schj);hjsjanhang:=schhj+". "+text(schj,2)+"/" ++subtext(schj,3);holestdplanFI .akthj:standardmaskenfeld(feldeingakthj). +holestdplan:standardmeldung(meldungdatenaufbereitet,""); +stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN +stundenplanbasisundstundenplanerstellen(fstat);IF fstat<>0THEN return(1); +meldungausgeben(fstat);LEAVE stundenplannachlvzeigenELSE +stundenplanbasissichern(fstat);stundenplansichern(fstat);IF fstat<>0THEN +return(1);meldungausgeben(fstat);LEAVE stundenplannachlvzeigenFI FI ELIF +fstat=8THEN meldungausgeben(fstat)FI .holstartlv:fach:=text(fach+" ",2); +inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj +);putintwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,fach+kennung);search( +dnrlehrveranstaltungen,FALSE );IF dbstatus>2THEN fehlermeldungkeinestartlv +ELSE aktjgst:=intwert(fnrlvjgst);aktfachkenn:=wert(fnrlvfachkennung);aktlv:= +text(jgstaufbereiten(aktjgst)+aktfachkenn,laengelv)FI . +fehlermeldungkeinestartlv:standardmeldung(meldungkeinestartlv,"");infeld( +feldeingjgst);return(1);LEAVE stundenplannachlvzeigen.END PROC +stundenplannachlvzeigen;PROC stundenplannachlvausgeben:standardstartproc( +stdplmaske);fuellemaske;IF NOT uvokTHEN infeld(uvokfeld);standardmeldung( +meldunguvfehler," ")FI ;standardnproc.END PROC stundenplannachlvausgeben; +PROC fuellemaske:standardkopfmaskeaktualisieren("Stundenplan "+hjsjanhang+ +" für Lehrveranstaltung "+aktlv+"");uvok:=TRUE ;raumeintrag:="";lveintrag:= +"";pareintrag:="";wstdderlv:=int(datenzurlv(kennungwstd,aktlv));FOR iFROM 1 +UPTO maxstundenREP planeintraglesen(i,kennunglv,aktlv,lveintrag,raumeintrag, +pareintrag);IF raumeintrag<>""THEN IF raumeintrag=leererraumTHEN raumeintrag +:=lvmitleeremraumELSE raumeintrag:=compress(raumeintrag)FI ;lvausstdpl(i):= +raumeintrag;standardmaskenfeld(raumeintrag,i+1);IF pareintrag=leererlehrer +THEN IF uvokTHEN uvok:=FALSE ;uvokfeld:=i+1;eintraglv:=lveintragFI FI ELSE +lvausstdpl(i):="";standardmaskenfeld("",i+1);FI PER ;infeld(1); +standardfelderausgeben;infeld(2).END PROC fuellemaske;PROC meldungausgeben( +INT VAR fstat):IF fstat=2THEN standardmeldung(meldungserverfehler,"");ELIF +fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5THEN +standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN standardmeldung( +meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(meldungzuvielelv,"")ELIF +fstat=9THEN standardmeldung(meldungbasisinkon,"");ELSE LEAVE meldungausgeben +FI END PROC meldungausgeben;PROC stundenplannachlvspeichern(BOOL CONST +speichern):TEXT VAR raumeintrag,t:="",lv:="";INT VAR bisherigejgst:=0,anzwstd +;IF speichernTHEN aenderungenvornehmen;FI ;naechstersatz;return(1). +naechstersatz:succ(dnrlehrveranstaltungen);IF dbstatus>2COR wert(fnrlvsj)<> +schjCOR wert(fnrlvhj)<>schhjTHEN stundenplannachlvreorganisiertverlassen; +LEAVE stundenplannachlvspeichernELIF intwert(fnrlvjgst)<>bisherigejgstTHEN +stundenplanreorganisierenundsichern(fstat);bisherigejgst:=intwert(fnrlvjgst) +FI ;aktjgst:=intwert(fnrlvjgst);aktfachkenn:=wert(fnrlvfachkennung);aktlv:= +text(jgstaufbereiten(aktjgst)+aktfachkenn,laengelv);fuellemaske;IF NOT uvok +THEN infeld(uvokfeld);standardmeldung(meldunguvfehler,eintraglv+ausgabeparam) +FI .aenderungenvornehmen:standardmeldung(meldungplausi," ");plausipruefung; +standardmeldung(meldungspeichern," ");aenderungsfehler:=FALSE ;speicherung; +IF aenderungsfehlerTHEN standardmeldung(meldungaenderungsfehler,"");return(1) +;LEAVE stundenplannachlvspeichernELSE stundenplansichern(fstat)FI ;IF fstat<> +0THEN meldungausgeben(fstat);return(1);LEAVE stundenplannachlvspeichernFI . +plausipruefung:anzwstd:=0;FOR iFROM 1UPTO maxstundenREP infeld(i+1); +raumeintrag:=standardmaskenfeld(i+1);IF raumeintrag<>""THEN pruefezeit;IF +raumeintrag<>lvmitleeremraumTHEN prueferaum;lvvombs(i):=raumeintragELSE +lvvombs(i):=leererraumFI ;schnittraeume;schnittlehrer;schnittsugruppen; +wstdzahlok;anzwstdINCR 1;ELSE lvvombs(i):=""FI ;PER .pruefezeit:IF NOT +bezeichnungzulaessig(kennungzulzeit,text(i))THEN standardmeldung( +meldungzeitgesperrt,tagstunde(i,TRUE )+" Std."+ausgabeparam);return(1);LEAVE +stundenplannachlvspeichernFI .prueferaum:IF NOT bezeichnungzulaessig( +kennungraum,raumeintrag)THEN standardmeldung(meldungfalscherraum,"");return(1 +);LEAVE stundenplannachlvspeichernFI .schnittraeume:IF raumunterrichtTHEN +standardmeldung(meldungraumbesetzt,"");return(1);LEAVE +stundenplannachlvspeichernFI .raumunterricht:lv:=geplantelvfuer(i,kennungraum +,raumeintrag);lv<>aktlvCAND lv<>"".schnittlehrer:t:=datenzurlv(kennungparaphe +,aktlv);IF t<>leererlehrerTHEN IF lehrerunterrichtTHEN standardmeldung( +meldunglehrerbesetzt,t+ausgabeparam);return(1);LEAVE +stundenplannachlvspeichernFI FI .lehrerunterricht:lv:=geplantelvfuer(i, +kennungparaphe,t);lv<>aktlvCAND lv<>"".schnittsugruppen:IF +sugruppenichtunterrichtsfreiTHEN standardmeldung(meldungsugrupbesetzt,lv+ +ausgabeparam);return(1);LEAVE stundenplannachlvspeichernFI . +sugruppenichtunterrichtsfrei:schuelergruppenschnittbeizeit(i,kennunglv,aktlv, +"",lv,t).wstdzahlok:IF anzwstd=wstdderlvTHEN standardmeldung( +meldungzuvielewstd,"");return(1);LEAVE stundenplannachlvspeichernFI . +speicherung:FOR iFROM 1UPTO maxstundenREP IF lvausstdpl(i)<>""COR lvvombs(i) +<>""THEN infeld(i+1);IF loeschenTHEN planeintragentfernenELSE +planeintragschreibenFI ;FI ;PER .loeschen:lvausstdpl(i)<>""CAND lvvombs(i)="" +.planeintragentfernen:planeintragloeschen(i,aktlv,spok);IF NOT spokTHEN +aenderungsfehler:=TRUE FI .planeintragschreiben:IF lvausstdpl(i)<>""THEN +planeintragloeschen(i,aktlv,spok);IF spokTHEN planeintragvornehmen(i,aktlv, +lvvombs(i),spok);FI ;ELSE planeintragvornehmen(i,aktlv,lvvombs(i),spok);FI ; +IF NOT spokTHEN aenderungsfehler:=TRUE FI .END PROC +stundenplannachlvspeichern;TEXT PROC jgstaufbereiten(INT CONST jgst):TEXT +VAR lv:="0";lvCAT text(jgst);subtext(lv,length(lv)-1)END PROC jgstaufbereiten +;END PACKET stundenplannachlverfassen; + diff --git a/app/schulis/2.2.1/src/4.stundenplan nach zeiten erfassen b/app/schulis/2.2.1/src/4.stundenplan nach zeiten erfassen new file mode 100644 index 0000000..51a812d --- /dev/null +++ b/app/schulis/2.2.1/src/4.stundenplan nach zeiten erfassen @@ -0,0 +1,157 @@ +PACKET stundenplannachzeitenerfassenDEFINES stundenplannachzeitenspeichern, +stundenplannachzeitenzurueckzummenue,stdnraustagstd, +stundenplannachzeitenzeigen:LET stdplmaske="ms stdplan nach zeit bearb", +feldeingtag=2,feldeingstd=3,feldeingakt=4,laengelv=8,laengeraum=4,trenner="�" +,schuljahr="Schuljahr",halbjahr="Schulhalbjahr",kennungraum="R", +kennungparaphe="P",kennunglv="L",kennungzulzeit="ZZ",leerelv=" ", +leererraum=" ",leererlehrer=" ",ausgabeparam="#",maxeintraege=60, +erstestunde=1,letztestunde=66,stdprotag=12,meldungzeitgesperrt=363, +meldungnichtspeichern=63,meldungraumangloeschen=396,meldungraumbesetzt=370, +meldungplausi=57,meldungnur60lv=394,meldungspeichern=50,meldungwarten=69, +meldungdatenaufbereitet=357,meldungfalschertag=385,meldungfalschestd=54, +meldungfalscherraum=359,meldungkeinesugruppen=334,meldungzuvielesugruppen=356 +,meldungnichtlv=360,meldunglehrerbesetzt=361,meldungsugrupbesetzt=362, +meldungkeinelv=326,meldungaenderungsfehler=364,meldunguvfehler=403,# +meldungstdplanveraltet=377,#meldungserverfehler=376,meldungbasisinkon=378, +meldungzuvielelv=358;ROW maxeintraegeTEXT VAR eintragausstdpl;TEXT VAR +maskeneintragtag:="",maskeneintragstd:="",gewhj,gewsj,allelv,alleraeume, +alleparaphen,uvoklv,lveintrag,raumeintrag,hjsjanhang:="",altereintrag:=""; +TEXT VAR alletage:="��01�02�03�04�05�06�1�2�3�4�5�6�MO�DI�MI�DO�FR�SA�"+ +"�mo�di�mi�do�fr�sa�Mo�Di�Mi�Do�Fr�Sa�"+ +"� 1� 2� 3� 4� 5� 6�1 �2 �3 �4 �5 �6 �",allestden:= +"��01�02�03�04�05�06�07�08�09�10�11�12�13� 1� 2� 3�"+ +"� 4� 5� 6� 7� 8� 9�1 �2 �3 �4 �5 �6 �7 �8 �9 �"+"1�2�3�4�5�6�7�8�9�";INT +VAR i,fstat,abstd:=0,uvokfeld,hjkennalt:=-1,hjkennneu:=0,letztebearbstd:=66; +BOOL VAR spok:=TRUE ,uvok:=TRUE ,anzlvok:=TRUE ,stdplzeilegeloescht:=FALSE , +aenderungsfehler:=FALSE ;INT PROC stdnraustagstd(TEXT CONST tag,std):INT VAR +itag:=int(tag),istd;IF lastconversionokTHEN IF itag=0COR itag=1THEN itag:=1 +FI ELSE IF tag="MO"COR tag="mo"COR tag="Mo"COR tag=""THEN itag:=1ELIF tag= +"DI"COR tag="di"COR tag="Di"THEN itag:=2ELIF tag="MI"COR tag="mi"COR tag="Mi" +THEN itag:=3ELIF tag="DO"COR tag="do"COR tag="Do"THEN itag:=4ELIF tag="FR" +COR tag="fr"COR tag="Fr"THEN itag:=5ELSE itag:=6FI FI ;IF std=""THEN istd:=1 +ELSE istd:=int(std)FI ;(itag-1)*stdprotag+istdEND PROC stdnraustagstd;PROC +stundenplannachzeitenreorganisiertverlassen: +stundenplanreorganisierenundsichern(fstat);IF fstat<>0THEN return(1); +meldungausgeben(fstat)ELSE enter(2)FI END PROC +stundenplannachzeitenreorganisiertverlassen;PROC stundenplannachzeitenzeigen: +standardmeldung(meldungwarten," ");maskeneintragtag:=standardmaskenfeld( +feldeingtag);maskeneintragstd:=standardmaskenfeld(feldeingstd);abstd:= +stdnraustagstd(maskeneintragtag,maskeneintragstd);prueftag;pruefstd;IF akthj +<>""THEN hjkennneu:=0ELSE hjkennneu:=1FI ;IF hjkennneu<>hjkennaltTHEN +hjkennalt:=hjkennneu;gewsj:=schulkenndatum(schuljahr);gewhj:=schulkenndatum( +halbjahr);IF hjkennneu=1THEN geplanteshjundsjberechnen(gewhj,gewsj)FI ; +stundenplanhalbjahrsetzen(gewhj,gewsj);ermittleletztestunde;hjsjanhang:=" "+ +gewhj+". "+text(gewsj,2)+"/"+subtext(gewsj,3)+", Raum ";holestdplanFI ; +pruefzeitzulaessig;stundenplannachzeitenausgeben.akthj:standardmaskenfeld( +feldeingakt).holestdplan:standardmeldung(meldungdatenaufbereitet,""); +stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN +stundenplanbasisundstundenplanerstellen(fstat);IF fstat<>0THEN return(1); +meldungausgeben(fstat);LEAVE stundenplannachzeitenzeigenELSE +stundenplanbasissichern(fstat);stundenplansichern(fstat);IF fstat<>0THEN +return(1);meldungausgeben(fstat);LEAVE stundenplannachzeitenzeigenFI FI ELIF +fstat=8THEN meldungausgeben(fstat)FI .prueftag:IF pos(alletage,trenner+ +maskeneintragtag+trenner)=0THEN return(1);infeld(feldeingtag);standardmeldung +(meldungfalschertag,"");LEAVE stundenplannachzeitenzeigenFI .pruefstd:IF pos( +allestden,trenner+maskeneintragstd+trenner)=0THEN return(1);infeld( +feldeingstd);standardmeldung(meldungfalschestd,"");LEAVE +stundenplannachzeitenzeigenELIF abstdDIV stdprotag=6THEN IF abstd-60>6THEN +return(1);infeld(feldeingstd);standardmeldung(meldungfalschestd,"");LEAVE +stundenplannachzeitenzeigenFI ;FI .pruefzeitzulaessig:IF NOT +bezeichnungzulaessig(kennungzulzeit,text(abstd))THEN return(1);infeld( +feldeingtag);standardmeldung(meldungzeitgesperrt,tagstunde(abstd,FALSE )+"."+ +ausgabeparam);LEAVE stundenplannachzeitenzeigenFI .ermittleletztestunde:FOR i +FROM letztestundeDOWNTO erstestundeREP IF bezeichnungzulaessig(kennungzulzeit +,text(i))THEN letztebearbstd:=i;LEAVE ermittleletztestundeFI PER .END PROC +stundenplannachzeitenzeigen;PROC stundenplannachzeitenausgeben: +standardstartproc(stdplmaske);fuellemaske;IF NOT anzlvokTHEN standardmeldung( +meldungnur60lv,tagstunde(abstd,TRUE )+ausgabeparam)ELIF NOT uvokTHEN infeld( +uvokfeld);standardmeldung(meldunguvfehler," ");FI ;standardnproc.END PROC +stundenplannachzeitenausgeben;PROC fuellemaske:TEXT VAR lvimstdplan, +raumimstdplan,parimstdplan;INT VAR poslv,posraum,index;stdplzeilegeloescht:= +FALSE ;allelv:=datenderzeit(abstd,kennunglv);alleraeume:=datenderzeit(abstd, +kennungraum);alleparaphen:=datenderzeit(abstd,kennungparaphe); +standardkopfmaskeaktualisieren("Stundenplan für "+tagstunde(abstd,FALSE )+ +". Stunde");uvok:=TRUE ;anzlvok:=TRUE ;uvokfeld:=2;poslv:=1;posraum:=1;IF +length(allelv)>maxeintraege*laengelvTHEN allelv:=text(allelv,maxeintraege* +laengelv);alleraeume:=text(alleraeume,maxeintraege*laengeraum);anzlvok:= +FALSE FI ;FOR iFROM 1UPTO maxeintraegeREP index:=i*2;IF poslv""THEN +planeintragvornehmen(abstd,text(eintragausstdpl(i),laengelv),subtext( +eintragausstdpl(i),laengelv+1),spok)ELSE LEAVE alteeintraegeschreibenFI PER . +loescheinhaltaktstundenplanzeile:stdplzeilegeloescht:=TRUE ;t1:=datenderzeit( +abstd,kennunglv);pos:=1;WHILE pos0THEN meldungausgeben(fstat);return(1) +;LEAVE stundenplannachzeitenspeichernFI ;FI .plausipruefungundspeicherung: +loescheinhaltaktstundenplanzeile;FOR iFROM 1UPTO maxeintraegeREP infeld(i*2); +altereintrag:=eintragausstdpl(i);lveintrag:=standardmaskenfeld(i*2);IF ( +lveintragSUB 1)=" "THEN lveintrag:=jgstaufber(text(lveintrag,2))+subtext( +lveintrag,3)FI ;lveintrag:=text(lveintrag,laengelv);raumeintrag:=text( +standardmaskenfeld(i*2+1),laengeraum);IF lveintrag+raumeintrag<>leerelv+ +leererraumTHEN infeld(i*2);pruefelvleerundraum;pruefelvgueltig; +prueferaumgueltig;pruefelehrerfrei;prueferaumfrei;pruefesugruppenfrei; +planeintragschreibenFI ;PER .pruefelvleerundraum:IF lveintrag=leerelvCAND +raumeintrag<>leererraumTHEN standardmeldung(meldungraumangloeschen,"");return +(1);LEAVE stundenplannachzeitenspeichernFI .pruefelvgueltig:IF NOT +bezeichnungzulaessig(kennunglv,lveintrag)THEN standardmeldung(meldungnichtlv, +lveintrag+ausgabeparam);return(1);LEAVE stundenplannachzeitenspeichernFI . +prueferaumgueltig:IF raumeintrag<>leererraumTHEN IF NOT bezeichnungzulaessig( +kennungraum,raumeintrag)THEN standardmeldung(meldungfalscherraum,"");infeld(i +*2+1);return(1);LEAVE stundenplannachzeitenspeichernFI FI .pruefelehrerfrei: +par:=datenzurlv(kennungparaphe,lveintrag);IF par<>leererlehrerTHEN IF +lehrerunterrichtTHEN standardmeldung(meldunglehrerbesetzt,par+ausgabeparam); +return(1);LEAVE stundenplannachzeitenspeichernFI FI .lehrerunterricht:lv:= +geplantelvfuer(abstd,kennungparaphe,par);lv<>lveintragCAND lv<>"". +prueferaumfrei:IF raumeintrag<>leererraumTHEN IF inraumunterrichtTHEN +standardmeldung(meldungraumbesetzt,"");infeld(i*2+1);return(1);LEAVE +stundenplannachzeitenspeichernFI FI .inraumunterricht:t1:=geplantelvfuer( +abstd,kennungraum,raumeintrag);t1<>lveintragCAND t1<>"".pruefesugruppenfrei: +IF sugruppenichtunterrichtsfreiTHEN standardmeldung(meldungsugrupbesetzt,t1+ +ausgabeparam);return(1);LEAVE stundenplannachzeitenspeichernFI . +sugruppenichtunterrichtsfrei:schuelergruppenschnittbeizeit(abstd,kennunglv, +lveintrag,text(altereintrag,8),t1,t2).planeintragschreiben: +planeintragvornehmen(abstd,lveintrag,raumeintrag,spok);IF NOT spokTHEN +aenderungsfehler:=TRUE FI .END PROC stundenplannachzeitenspeichern;PROC +stundenplannachzeitenzurueckzummenue:INT VAR pos;TEXT VAR t1;standardmeldung( +meldungnichtspeichern,"");IF stdplzeilegeloeschtTHEN alteeintraegeschreiben +FI ;stundenplanreorganisierenundsichern(fstat);enter(2). +alteeintraegeschreiben:loescheinhaltaktstundenplanzeile;FOR iFROM 1UPTO +maxeintraegeREP IF eintragausstdpl(i)<>""THEN planeintragvornehmen(abstd,text +(eintragausstdpl(i),laengelv),subtext(eintragausstdpl(i),laengelv+1),spok) +ELSE LEAVE alteeintraegeschreibenFI PER .loescheinhaltaktstundenplanzeile:t1 +:=datenderzeit(abstd,kennunglv);pos:=1;WHILE pos0THEN return(1); +meldungausgeben(fstat)ELSE enter(2)FI END PROC +stundenplanraumweisereorganisiertverlassen;PROC stundenplanraumweisezeigen: +maskeundinitialisierung;IF maskeneintragraum<>""THEN IF raumfalsch( +maskeneintragraum)THEN standardmeldung(meldungfalscherraum,"");return(1)ELSE +restraumleiste:=text(raumleiste,pos(raumleiste,maskeneintragraum)+laengeraum- +1);anzraeume:=length(restraumleiste)DIV laengeraum; +stundenplanraumweiseausgeben(letzterraum);FI ;ELSE restraumleiste:=raumleiste +;anzraeume:=length(restraumleiste)DIV laengeraum;IF anzraeume>=1THEN +stundenplanraumweiseausgeben(letzterraum)ELSE standardmeldung( +meldungkeineraeume,"");return(1)FI ;FI .letzterraum:subtext(restraumleiste,( +anzraeume-1)*laengeraum+1).maskeundinitialisierung:standardmeldung( +meldungwarten," ");IF akthj<>""THEN hjkennneu:=0ELSE hjkennneu:=1FI ; +merkeraum;IF hjkennneu<>hjkennaltTHEN hjkennalt:=hjkennneu;gewsj:= +schulkenndatum(schuljahr);gewhj:=schulkenndatum(halbjahr);IF hjkennneu=1THEN +geplanteshjundsjberechnen(gewhj,gewsj)FI ;stundenplanhalbjahrsetzen(gewhj, +gewsj);hjsjanhang:=" "+gewhj+". "+text(gewsj,2)+"/"+subtext(gewsj,3)+ +", Raum ";holestdplanFI ;IF plausiraeume=trenner+trennerTHEN holeplausiraeume +FI .akthj:standardmaskenfeld(feldeingakt).merkeraum:maskeneintragraum:= +standardmaskenfeld(feldeingraum).holestdplan:standardmeldung( +meldungdatenaufbereitet,"");stundenplanbasisundstundenplanholen(fstat);IF +fstat<>0CAND fstat<>8THEN stundenplanbasisundstundenplanerstellen(fstat);IF +fstat<>0THEN return(1);meldungausgeben(fstat);LEAVE +stundenplanraumweisezeigenELSE stundenplanbasissichern(fstat); +stundenplansichern(fstat);IF fstat<>0THEN return(1);meldungausgeben(fstat); +LEAVE stundenplanraumweisezeigenFI FI ELIF fstat=8THEN meldungausgeben(fstat) +FI .holeplausiraeume:inittupel(dnrschluessel);statleseschleife(dnrschluessel, +raumkenndaten,"",dnrschluessel+1,dnrschluessel+2,PROC raeumeholen).END PROC +stundenplanraumweisezeigen;PROC stundenplanraumweiseausgeben(TEXT CONST raum) +:standardstartproc(stdplmaske);fuellemaske(raum);IF NOT uvokTHEN infeld( +uvokfeld);standardmeldung(meldunguvfehler," ")FI ;standardnproc.END PROC +stundenplanraumweiseausgeben;PROC fuellemaske(TEXT CONST raum):TEXT VAR +paraphelvnulleintrag:="";standardkopfmaskeaktualisieren("Stundenplan für"+ +hjsjanhang+raum);maskeneintragraum:=compress(raum);uvok:=TRUE ;uvokfeld:=2; +FOR iFROM 1UPTO maxstundenREP planeintraglesen(i,kennungraum,raum, +stdpleintraglvident,stdpleintraglvraum,stdpleintraglvpar);IF +stdpleintraglvident<>""THEN lvausstdpl(i):=stdpleintraglvident; +standardmaskenfeld(stdpleintraglvident,i+1);IF stdpleintraglvpar=leererlehrer +THEN IF uvokTHEN uvok:=FALSE ;uvokfeld:=i+1FI ELSE pruefeparaphestdplanlvnull +FI ELSE lvausstdpl(i):="";standardmaskenfeld("",i+1);FI PER ;infeld(1); +standardfelderausgeben;infeld(2).pruefeparaphestdplanlvnull: +paraphelvnulleintrag:=datenzurlv(kennungparaphe,stdpleintraglvident);IF +stdpleintraglvpar<>paraphelvnulleintragTHEN planeintragvornehmen(i, +stdpleintraglvident,paraphelvnulleintrag,spok)FI .END PROC fuellemaske;BOOL +PROC raumfalsch(TEXT CONST raum):pos(plausiraeume,trenner+raum+trenner)=0END +PROC raumfalsch;PROC raeumeholen(BOOL VAR b):IF wert(dnrschluessel+1)> +raumkenndatenCOR dbstatus<>0THEN b:=TRUE ELSE plausiraeumeCAT wert( +dnrschluessel+2);plausiraeumeCAT trenner;raumleiste:=text(wert(dnrschluessel+ +2),laengeraum)+raumleisteFI END PROC raeumeholen;PROC meldungausgeben(INT +VAR fstat):IF fstat=2THEN standardmeldung(meldungserverfehler,"");ELIF fstat= +4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5THEN +standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN standardmeldung( +meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(meldungzuvielelv,"")ELIF +fstat=8THEN standardmeldung(meldungstdplanveraltet,"");ELIF fstat=9THEN +standardmeldung(meldungbasisinkon,"");ELSE LEAVE meldungausgebenFI END PROC +meldungausgeben;PROC stundenplanraumweisespeichern(BOOL CONST speichern): +TEXT VAR t:="",lv:="";INT VAR posrestraumleiste;IF anzraeume=1THEN IF +speichernTHEN aenderungenvornehmen;FI ; +stundenplanraumweisereorganisiertverlassenELSE IF speichernTHEN +aenderungenvornehmen;FI ;anzraeumeDECR 1;IF anzraeumeMOD 10=0THEN +stundenplanreorganisierenundsichern(fstat)FI ;naechsterraum;return(1)FI . +naechsterraum:posrestraumleiste:=(anzraeume-1)*laengeraum+1;fuellemaske( +subtext(restraumleiste,posrestraumleiste,posrestraumleiste+laengeraum-1));IF +NOT uvokTHEN infeld(uvokfeld);standardmeldung(meldunguvfehler," ")FI . +aenderungenvornehmen:standardmeldung(meldungplausi," ");plausipruefung; +standardmeldung(meldungspeichern," ");aenderungsfehler:=FALSE ;speicherung; +IF aenderungsfehlerTHEN standardmeldung(meldungaenderungsfehler,"");return(1) +;LEAVE stundenplanraumweisespeichernELSE IF anzraeumeMOD 20=0THEN +stundenplanraumweisereorganisiertverlassenELSE stundenplansichern(fstat)FI ; +IF fstat<>0THEN meldungausgeben(fstat);return(1);LEAVE +stundenplanraumweisespeichernFI ;FI .plausipruefung:FOR iFROM 1UPTO +maxstundenREP aktbspos:=i+1;infeld(aktbspos);stdpleintraglv:=text( +standardmaskenfeld(aktbspos),laengelv);stdpleintragjgst:=text(stdpleintraglv, +laengejgst);IF keinejgstmitfuehrendernullTHEN IF stdpleintragjgst="0 "COR +stdpleintragjgst=" 0"THEN stdpleintraglv:="00"+subtext(stdpleintraglv, +laengejgst+1)ELSE stdpleintraglv:=jgstaufber(stdpleintragjgst)+subtext( +stdpleintraglv,laengejgst+1);IF NOT lastconversionokTHEN standardmeldung( +meldungnichtlv,standardmaskenfeld(aktbspos)+ausgabeparam);return(1);LEAVE +stundenplanraumweisespeichernFI ;FI ;FI ;IF compress(stdpleintraglv)<>""THEN +lvvombs(i):=stdpleintraglv;pruefezeit;pruefelvundpar;pruefesugruppenfreiELSE +lvvombs(i):="";FI ;PER .speicherung:FOR iFROM 1UPTO maxstundenREP IF +lvausstdpl(i)<>""COR lvvombs(i)<>""THEN aktbspos:=i+1;infeld(aktbspos);IF +loeschenTHEN planeintragentfernenELSE planeintragschreibenFI ;FI ;PER . +keinejgstmitfuehrendernull:keinejgstCAND keinleerereintrag.keinejgst:pos( +alleklst,trenner+stdpleintragjgst+trenner)=0.keinleerereintrag:compress( +stdpleintraglv)<>"".pruefelvundpar:t:=datenzurlv(kennungparaphe, +stdpleintraglv);IF t=ungueltigeparTHEN standardmeldung(meldungnichtlv, +standardmaskenfeld(aktbspos)+ausgabeparam);return(1);LEAVE +stundenplanraumweisespeichernELIF t<>leererlehrerTHEN IF lehrerunterricht +THEN standardmeldung(meldunglehrerbesetzt,t+ausgabeparam);return(1);LEAVE +stundenplanraumweisespeichernFI FI .lehrerunterricht:lv:=geplantelvfuer(i, +kennungparaphe,t);lv<>stdpleintraglvCAND lv<>"".pruefesugruppenfrei:IF +sugruppenichtunterrichtsfreiTHEN standardmeldung(meldungsugrupbesetzt,lv+ +ausgabeparam);return(1);LEAVE stundenplanraumweisespeichernFI . +sugruppenichtunterrichtsfrei:schuelergruppenschnittbeizeit(i,kennunglv, +stdpleintraglv,lvausstdpl(i),lv,t).pruefezeit:t:=text(i);IF NOT +bezeichnungzulaessig(kennungzulzeit,t)THEN standardmeldung( +meldungzeitgesperrt,tagstunde(i,TRUE )+" Std."+ausgabeparam);return(1);LEAVE +stundenplanraumweisespeichernFI .loeschen:lvausstdpl(i)<>""CAND lvvombs(i)="" +.planeintragentfernen:planeintragloeschen(i,lvausstdpl(i),spok);IF NOT spok +THEN aenderungsfehler:=TRUE FI .planeintragschreiben:IF lvausstdpl(i)<>"" +THEN planeintragloeschen(i,lvausstdpl(i),spok);IF spokTHEN +planeintragvornehmen(i,lvvombs(i),maskeneintragraum,spok);FI ;ELSE +planeintragvornehmen(i,lvvombs(i),maskeneintragraum,spok);FI ;IF NOT spok +THEN aenderungsfehler:=TRUE FI .END PROC stundenplanraumweisespeichern;END +PACKET stundenplanraumweiseerfassen; + diff --git a/app/schulis/2.2.1/src/4.stundenplan schnittstelle b/app/schulis/2.2.1/src/4.stundenplan schnittstelle new file mode 100644 index 0000000..bc036af --- /dev/null +++ b/app/schulis/2.2.1/src/4.stundenplan schnittstelle @@ -0,0 +1,692 @@ +PACKET stundenplanschnittstelleDEFINES tagstunde,stundenplanhalbjahrsetzen, +stundenplanbasisundstundenplanerstellen,stundenplanerstellen, +stundenplanbasisundstundenplanholen,stundenplanbasissichern, +stundenplansichern,stundenplandatenvorhanden, +stundenplanbasisundstundenplanloeschen,stundenplanloeschen, +stundenplanreorganisierenundsichern,bezeichnungzulaessig,datenzurlv, +beteiligteschuelergruppen,schuelergruppenschnittbeizeit, +schuelergruppenschnittallezeiten,gemeinsameschuelergruppen, +lvderschuelergruppe,allelvmit,lvgeplant,geplantelvfuer,allezeitenvon, +datenderzeit,planeintraglesen,planeintragvornehmen,planeintragloeschen, +erstellungszeitderdatenraeume:LET maxdatenraumeintraege=4000, +maxlehrveranstaltungen=2500,erstestunde=1,letztestunde=66,stdprotag=12, +samstagstd=6,schultage=6,stuplanverwalter="stundenplan server",sgnull= +"Stundenplan-0 ",sgeins="Stundenplan-1 ",lvnull="Stundenplan-2 ",lveins= +"Stundenplan-3 ",stuplan="Stundenplan-4 ",aenderungakt="aktuell", +aenderunggepl="geplant",maxsugruppen=30,laengelv=8,laengekopplung=8, +laengeparaphe=4,laengeraum=4,laengezeit=2,laengejgst=2,laengefachkennung=6, +laengesugruppe=6,laengeklagruppe=4,laengewochenstd=2,laengestuplaneintrag=24, +stuplanposjgst=1,stuplanposkopplung=9,stuplanposparaphe=17,stuplanposraum=21, +erstellzeittag=1,erstellzeitmonat=4,erstellzeitjahr=7,erstellzeitstdmin=10, +beginnlvjgst=1,beginnlvbez=1,beginnlvkopplung=9,beginnlvparaphe=17, +beginnlvwochenstd=21,beginnlvraumgr1=23,beginnlvraumgr2=27;INT CONST +endelvbez:=beginnlvbez+laengelv-1,endelvkopplung:=beginnlvkopplung+ +laengekopplung-1,endelvparaphe:=beginnlvparaphe+laengeparaphe-1, +endelvwochenstd:=beginnlvwochenstd+laengewochenstd-1,endelvraumgr1:= +beginnlvraumgr1+laengeraum-1,endelvraumgr2:=beginnlvraumgr2+laengeraum-1;LET +leistenlaenge=8,bits=16,jgstnull=0,jgstfuenf=5,jgstdreizehn=13,anzklst=9, +trenner="�",klstjgst="�05�5�06�6�07�7�08�8�09�9�10�11�12�13�", +zeitrastersperre="x",dbraeume="c02 raeume",dbaenderung= +"c02 aenderungsvermerk",dbaenderungakt="aktuell",dbaenderunggepl="geplant", +halbj="Schulhalbjahr",fehlerzeichen="$",blank=" ",punkt=".",null="0",eins="1" +,leereraumangabe=" ",kennunglv="L",kennungkopplung="K",kennungparaphe="P", +kennungraum="R",kennungzeit="ZA",kennungzugelassenezeit="ZZ",kennungsugruppe= +"S",kennungwochenstd="W",kennungwunschraum="RW",kennungersatzraum="RE";LET +kennungmo="Mo ",kennungdi="Di ",kennungmi="Mi ",kennungdo="Do ",kennungfr= +"Fr ",kennungsa="Sa ",kennungmontag="Montag ",kennungdienstag="Dienstag ", +kennungmittwoch="Mittwoch ",kennungdonnerstag="Donnerstag ",kennungfreitag= +"Freitag ",kennungsamstag="Samstag ";TYPE BITLEISTE =ROW leistenlaengeINT ; +BITLEISTE VAR sugrupurleiste,sugrupleiste;BOUND ROW maxlehrveranstaltungen +BITLEISTE VAR lvbitleisten;BOUND ROW maxdatenraumeintraegeBITLEISTE VAR +sgbitleisten;ROW maxsugruppenBITLEISTE VAR sugruppenstack;DATASPACE VAR dslv, +dssugrup,dsstdpl;FILE VAR lvdatei,sugrupdatei,stuplandatei;TEXT VAR gewschulj +:="",gewhalbj:="",halbjplausizeit:="",dateieintrag,ergebnis,dserstellungszeit +,behandeltesugruppen:=trenner,letztedbzeit,lvzeile,sugruppeneinerklgr:="", +plausiparaphen:=trenner,plausizeiten:="",plausiklgr:=trenner,plausiraeume:= +trenner;INT VAR i,j,k,zz,anzbitleisten:=0,lowbit,anzsugrup,anzsugrupundklgr, +anzlv,lvjgstnullanfang,lvjgstnullende,lvsugrupjgstanfang,lvsugrupjgstende, +letzteposstuplanzeile,letzterzugrifflv0:=1;BOOL VAR klgreintrag;TEXT PROC +tagstunde(INT CONST anwstdnr,BOOL CONST mitkurzform):INT VAR stdnr:= +konvertierezeit(anwstdnr);TEXT VAR std;IF stdnr +letztestundeTHEN ""ELSE std:=text((stdnr-1)MOD stdprotag+1);IF mitkurzform +THEN SELECT (stdnr-1)DIV stdprotagOF CASE 0:kennungmo+stdCASE 1:kennungdi+std +CASE 2:kennungmi+stdCASE 3:kennungdo+stdCASE 4:kennungfr+stdCASE 5:kennungsa+ +stdOTHERWISE ""END SELECT ELSE SELECT (stdnr-1)DIV stdprotagOF CASE 0: +kennungmontag+stdCASE 1:kennungdienstag+stdCASE 2:kennungmittwoch+stdCASE 3: +kennungdonnerstag+stdCASE 4:kennungfreitag+stdCASE 5:kennungsamstag+std +OTHERWISE ""END SELECT FI FI END PROC tagstunde;PROC +stundenplanhalbjahrsetzen(TEXT CONST anwhalbj,anwschulj):gewschulj:=anwschulj +;gewhalbj:=anwhalbj;plausizeiten:=""END PROC stundenplanhalbjahrsetzen;PROC +stundenplanbasisundstundenplanerstellen(INT VAR fehlerstatus):IF gewschulj="" +THEN fehlerstatus:=1ELSE hilfsdatenerstellen(fehlerstatus);IF fehlerstatus=0 +THEN schreibeerstellungszeitFI ;FI .END PROC +stundenplanbasisundstundenplanerstellen;PROC stundenplanerstellen(TEXT CONST +zeit,INT VAR fehlerstatus):commanddialogue(FALSE );IF gewschulj=""THEN +fehlerstatus:=1;forget(stuplandatenraum)ELSE forget(stuplandatenraum);# +dsstdpl:=new(stuplandatenraum);forget(dsstdpl);#commanddialogue(TRUE ); +stuplandatei:=sequentialfile(modify,stuplandatenraum);FOR iFROM erstestunde +UPTO letztestunde+1REP insertrecord(stuplandatei)PER ;schreibzeitinstdpl; +fehlerstatus:=0FI .schreibzeitinstdpl:toline(stuplandatei,letztestunde+1); +writerecord(stuplandatei,zeit).END PROC stundenplanerstellen;PROC +stundenplanbasissichern(INT VAR fehlerstatus):TASK VAR server;disablestop; +server:=task(stuplanverwalter);IF iserrorTHEN clearerror;fehlerstatus:=2; +ELIF gewschulj=""THEN fehlerstatus:=1;ELIF NOT exists(lvnulldatenraum)COR +NOT exists(lveinsdatenraum)COR NOT exists(sgnulldatenraum)COR NOT exists( +sgeinsdatenraum)THEN fehlerstatus:=3ELSE commanddialogue(FALSE );save( +lvnulldatenraum,server);save(lveinsdatenraum,server);save(sgnulldatenraum, +server);save(sgeinsdatenraum,server);commanddialogue(TRUE );fehlerstatus:=0 +FI ;enablestopEND PROC stundenplanbasissichern;PROC stundenplansichern(INT +VAR fehlerstatus):TASK VAR server;disablestop;server:=task(stuplanverwalter); +IF iserrorTHEN clearerror;fehlerstatus:=2;ELIF gewschulj=""THEN fehlerstatus +:=1ELIF NOT exists(stuplandatenraum)THEN fehlerstatus:=3ELSE commanddialogue( +FALSE );save(stuplandatenraum,server);commanddialogue(TRUE );fehlerstatus:=0; +FI ;enablestopEND PROC stundenplansichern;PROC +stundenplanbasisundstundenplanholen(INT VAR fehlerstatus):TASK VAR server; +disablestop;server:=task(stuplanverwalter);IF iserrorTHEN clearerror; +fehlerstatus:=2;ELIF gewschulj=""THEN fehlerstatus:=1ELIF NOT exists( +lvnulldatenraum,server)COR NOT exists(lveinsdatenraum,server)COR NOT exists( +sgnulldatenraum,server)COR NOT exists(sgeinsdatenraum,server)COR NOT exists( +stuplandatenraum,server)THEN fehlerstatus:=3;ELSE commanddialogue(FALSE ); +fetch(stuplandatenraum,server);fetch(lvnulldatenraum,server);fetch( +lveinsdatenraum,server);fetch(sgnulldatenraum,server);fetch(sgeinsdatenraum, +server);datenraeumeankoppeln;commanddialogue(TRUE );IF +stundenplanbasisaktuell(fehlerstatus)THEN anzsugrupundklgr:=lines(sugrupdatei +)-anzklst;anzsugrup:=anzsugrupundklgr-int(records(dnrklassengruppen));anzlv:= +lines(lvdatei);fehlerstatus:=0;ELSE IF fehlerstatus=9THEN +aenderungsvermerkderdbsetzen;FI ;stundenplanbasiserstellen(fehlerstatus);IF +fehlerstatus=0THEN stundenplanbasissichern(fehlerstatus);IF fehlerstatus=0 +THEN stundenplansichern(fehlerstatus);fehlerstatus:=8FI FI FI FI ;enablestop. +aenderungsvermerkderdbsetzen:IF gewhalbj=schulkenndatum(halbj)THEN +aenderungsvermerksetzen(aenderungakt)ELSE aenderungsvermerksetzen( +aenderunggepl)FI .END PROC stundenplanbasisundstundenplanholen;BOOL PROC +stundenplandatenvorhanden:TASK VAR server;IF NOT existstask(stuplanverwalter) +THEN FALSE ELIF gewschulj=""THEN FALSE ELSE server:=task(stuplanverwalter); +exists(lvnulldatenraum,server)COR exists(lveinsdatenraum,server)COR exists( +sgnulldatenraum,server)COR exists(sgeinsdatenraum,server)COR exists( +stuplandatenraum,server)FI END PROC stundenplandatenvorhanden;PROC +stundenplanbasisundstundenplanloeschen(INT VAR fehlerstatus):TASK VAR server; +IF NOT existstask(stuplanverwalter)THEN fehlerstatus:=2ELIF gewschulj=""THEN +fehlerstatus:=1;ELSE server:=task(stuplanverwalter);commanddialogue(FALSE ); +erase(stuplandatenraum,server);erase(lvnulldatenraum,server);erase( +lveinsdatenraum,server);erase(sgnulldatenraum,server);erase(sgeinsdatenraum, +server);commanddialogue(TRUE );fehlerstatus:=0;FI END PROC +stundenplanbasisundstundenplanloeschen;PROC stundenplanloeschen(INT VAR +fehlerstatus):IF gewschulj=""THEN fehlerstatus:=1ELIF NOT exists( +stuplandatenraum)THEN fehlerstatus:=3;ELSE forget(stuplandatenraum,quiet); +fehlerstatus:=0FI END PROC stundenplanloeschen;PROC +stundenplanreorganisierenundsichern(INT VAR fehlerstatus):INT VAR kanal;IF +gewschulj=""THEN fehlerstatus:=1ELIF NOT exists(stuplandatenraum)THEN +fehlerstatus:=3ELSE kanal:=channel(myself);break(quiet);reorganize( +stuplandatenraum);continue(kanal);modify(stuplandatei);stundenplansichern( +fehlerstatus)FI END PROC stundenplanreorganisierenundsichern;TEXT PROC +erstellungszeitderdatenraeume:IF exists(stuplandatenraum)THEN toline( +stuplandatei,letztestunde+1);readrecord(stuplandatei,dserstellungszeit); +dserstellungszeitELSE fehlerzeichenFI END PROC erstellungszeitderdatenraeume; +BOOL PROC bezeichnungzulaessig(TEXT CONST kennung,kennungstext):TEXT VAR +sicherung;INT VAR zeit,alterdbstatus;IF kennung=kennunglvTHEN lv0eintrag(text +(kennungstext,laengelv))<>""ELIF kennung=kennungkopplungTHEN kopplunginlv0( +text(kennungstext,laengekopplung))ELIF kennung=kennungparapheTHEN IF +plausiparaphen=trennerTHEN alterdbstatus:=dbstatus;savetupel(dnrlehrer, +sicherung);statleseschleife(dnrlehrer,"","",fnrlparaphe,fnrlparaphe,PROC +paraphencat);restoretupel(dnrlehrer,sicherung);dbstatus(alterdbstatus)FI ;pos +(plausiparaphen,trenner+text(kennungstext,laengeparaphe)+trenner)>0ELIF +kennung=kennungsugruppeTHEN sg0eintrag(text(kennungstext,laengesugruppe)) +ELIF kennung=kennungraumTHEN IF plausiraeume=trennerTHEN alterdbstatus:= +dbstatus;savetupel(dnrschluessel,sicherung);statleseschleife(dnrschluessel, +dbraeume,"",fnrschlsachgebiet,fnrschlschluessel,PROC raumcat);restoretupel( +dnrschluessel,sicherung);dbstatus(alterdbstatus)FI ;pos(plausiraeume,trenner+ +text(kennungstext,laengeraum)+trenner)>0ELIF kennung=kennungzeitTHEN IF real( +kennungstext)<1000.0THEN konvertierezeit(int(kennungstext))<>0ELSE FALSE FI +ELIF kennung=kennungzugelassenezeitTHEN IF real(kennungstext)>1000.0THEN +LEAVE bezeichnungzulaessigWITH FALSE FI ;IF plausizeiten=""COR gewhalbj<> +halbjplausizeitTHEN halbjplausizeit:=gewhalbj;plausizeiten:=letztestunde*"0"; +inittupel(dnrzeitraster);alterdbstatus:=dbstatus;savetupel(dnrzeitraster, +sicherung);statleseschleife(dnrzeitraster,gewschulj,gewhalbj,fnrzrsj,fnrzrhj, +PROC erstelleplausizeiten);restoretupel(dnrzeitraster,sicherung);dbstatus( +alterdbstatus)FI ;zeit:=konvertierezeit(int(kennungstext));IF zeit<>0THEN ( +plausizeitenSUB zeit)="0"ELSE FALSE FI ELSE FALSE FI END PROC +bezeichnungzulaessig;TEXT PROC datenzurlv(TEXT CONST kennung, +lehrveranstaltung):lvzeile:=lv0eintrag(text(lehrveranstaltung,laengelv));IF +lvzeile<>""THEN IF kennung=kennungparapheTHEN paraphederlv(lvzeile)ELIF +kennung=kennungkopplungTHEN kopplungderlv(lvzeile)ELIF kennung= +kennungwochenstdTHEN wochenstdderlv(lvzeile)ELIF kennung=kennungwunschraum +THEN wunschraumderlv(lvzeile)ELIF kennung=kennungersatzraumTHEN +ersatzraumderlv(lvzeile)ELSE fehlerzeichenFI ELSE ungueltigesergebnis(kennung +)FI END PROC datenzurlv;TEXT PROC beteiligteschuelergruppen(TEXT CONST +kennung,kennungstext):BITLEISTE VAR bitleiste;IF kennung=kennunglvTHEN IF +lv0eintrag(text(kennungstext,laengelv))=""THEN ungueltigesergebnis( +kennungsugruppe)ELSE sugruppenausbitleiste(lv1eintrag(zugriffszeilelv0))FI +ELIF kennung=kennungkopplungTHEN sammlebitleisten(text(kennungstext, +laengekopplung),beginnlvkopplung,bitleiste);sugruppenausbitleiste(bitleiste) +ELSE ungueltigesergebnis(kennungsugruppe)FI END PROC +beteiligteschuelergruppen;TEXT PROC schuelergruppenschnittallezeiten(TEXT +CONST kennung,anwkennungstext1):BITLEISTE VAR bitleiste,stdplbitleiste;TEXT +VAR allestdpllv:="",gesamtlv:="",jgst:="",kopplung:="",stdpllv:="",stdplkopp +:="",stdpljgst:="",schuelergruppen:="",jgstzurnull:=trenner,verfplan:="", +schgrjgst:="",fehler:=letztestunde*fehlerzeichen;TEXT VAR kennungstext1:=""; +INT VAR zeit,anfangeintrag,laengeallestdpllv,ij,schgrindex;BOOL VAR schnitt:= +FALSE ;IF kennung=kennunglvTHEN kennungstext1:=text(anwkennungstext1,laengelv +);gesamtlv:=lv0eintrag(kennungstext1);IF gesamtlv=""THEN LEAVE +schuelergruppenschnittallezeitenWITH fehlerELSE jgst:=text(gesamtlv, +laengejgst);kopplung:=kopplungderlv(gesamtlv);bitleiste:=lv1eintrag( +zugriffszeilelv0);FI ELIF kennung=kennungkopplungTHEN kennungstext1:=text( +anwkennungstext1,laengekopplung);jgst:=jgstzukopplung(kennungstext1);kopplung +:=kennungstext1;IF jgst=""THEN LEAVE schuelergruppenschnittallezeitenWITH +fehlerELSE sammlebitleisten(kennungstext1,beginnlvkopplung,bitleiste)FI ELSE +LEAVE schuelergruppenschnittallezeitenWITH fehlerFI ;IF jgst="00"THEN +bildejgstzurnullFI ;FOR zeitFROM erstestundeUPTO letztestundeREP allestdpllv +:=stuplanzeile(zeit);laengeallestdpllv:=length(allestdpllv);IF +laengeallestdpllv>laengejgstTHEN schnitt:=FALSE ; +pruefeallestdplanlvaufschnitt;IF schnittTHEN verfplanCAT einsELSE verfplan +CAT nullFI ;ELSE verfplanCAT nullFI ;PER ;verfplan.bildejgstzurnull: +schuelergruppen:=beteiligteschuelergruppen(kennung,kennungstext1);FOR ijFROM +1UPTO length(schuelergruppen)DIV laengesugruppeREP schgrindex:=(ij-1)* +laengesugruppe;schgrjgst:=subtext(schuelergruppen,schgrindex+1,schgrindex+2); +IF pos(jgstzurnull,trenner+schgrjgst+trenner)=0THEN jgstzurnullCAT schgrjgst; +jgstzurnullCAT trennerFI PER ;IF length(jgstzurnull)=4THEN jgst:=subtext( +jgstzurnull,2,3);jgstzurnull:=""FI .pruefeallestdplanlvaufschnitt: +anfangeintrag:=0;WHILE anfangeintrag +kennungstext1THEN stdplkopp:=subtext(allestdpllv,anfangeintrag+ +beginnlvkopplung,anfangeintrag+endelvkopplung);IF kopplungsbezunterschiedlich +THEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste:=lv1eintrag( +zugriffszeilelv0);IF bitleistenschnittTHEN schnitt:=TRUE ;LEAVE +pruefeallestdplanlvaufschnittFI ELSE LEAVE schuelergruppenschnittallezeiten +WITH fehlerFI ;FI ;FI ;ELSE IF jgstgleichTHEN stdplkopp:=subtext(allestdpllv, +anfangeintrag+beginnlvkopplung,anfangeintrag+endelvkopplung);IF +kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste +:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN schnitt:=TRUE ;LEAVE +pruefeallestdplanlvaufschnittFI ELSE LEAVE schuelergruppenschnittallezeiten +WITH fehlerFI ;FI ;FI ;FI ;anfangeintrag:=anfangeintrag+laengestuplaneintrag +PER .jgstgleich:jgst=stdpljgstCOR stdpljgst="00"COR pos(jgstzurnull,trenner+ +stdpljgst+trenner)>0.kopplungsbezunterschiedlich:kopplung<>stdplkopp. +bitleistenschnitt:gibtesgemeinsamesugruppen(bitleiste,stdplbitleiste).END +PROC schuelergruppenschnittallezeiten;BOOL PROC schuelergruppenschnittbeizeit +(INT CONST anwzeit,TEXT CONST kennung,anwkennungstext1,anwkennungstext2): +BITLEISTE VAR bitleiste,stdplbitleiste;TEXT VAR allestdpllv:="",gesamtlv:="", +jgst:="",kopplung:="",stdpllv:="",stdplkopp:="",stdpljgst:="",schgrjgst:="", +schuelergruppen:="",jgstzurnull:=trenner;TEXT VAR kennungstext1:="", +kennungstext2:="";INT VAR zeit:=konvertierezeit(anwzeit),anfangeintrag, +laengeallestdpllv,ij,schgrindex;IF zeit=0THEN LEAVE +schuelergruppenschnittbeizeitWITH TRUE ELIF kennung=kennunglvTHEN +kennungstext1:=text(anwkennungstext1,laengelv);IF anwkennungstext2<>""THEN +kennungstext2:=text(anwkennungstext2,laengelv)FI ;gesamtlv:=lv0eintrag( +kennungstext1);IF gesamtlv=""THEN LEAVE schuelergruppenschnittbeizeitWITH +TRUE ELSE jgst:=text(gesamtlv,laengejgst);kopplung:=kopplungderlv(gesamtlv); +bitleiste:=lv1eintrag(zugriffszeilelv0);FI ELIF kennung=kennungkopplungTHEN +kennungstext1:=text(anwkennungstext1,laengekopplung);jgst:=jgstzukopplung( +kennungstext1);kopplung:=kennungstext1;IF jgst=""THEN LEAVE +schuelergruppenschnittbeizeitWITH TRUE ELSE sammlebitleisten(kennungstext1, +beginnlvkopplung,bitleiste)FI ELSE LEAVE schuelergruppenschnittbeizeitWITH +TRUE FI ;allestdpllv:=stuplanzeile(zeit);laengeallestdpllv:=length( +allestdpllv);IF laengeallestdpllvkennungstext1CAND stdpllv<>kennungstext2THEN stdplkopp:=subtext +(allestdpllv,anfangeintrag+beginnlvkopplung,anfangeintrag+endelvkopplung);IF +kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste +:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN LEAVE +schuelergruppenschnittbeizeitWITH TRUE FI ELSE LEAVE +schuelergruppenschnittbeizeitWITH TRUE FI ;FI ;FI ;ELSE IF jgstgleichTHEN +stdplkopp:=subtext(allestdpllv,anfangeintrag+beginnlvkopplung,anfangeintrag+ +endelvkopplung);IF kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>"" +THEN stdplbitleiste:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN +LEAVE schuelergruppenschnittbeizeitWITH TRUE FI ELSE LEAVE +schuelergruppenschnittbeizeitWITH TRUE FI ;FI ;FI ;FI ;anfangeintrag:= +anfangeintrag+laengestuplaneintragPER ;FALSE .bildejgstzurnull: +schuelergruppen:=beteiligteschuelergruppen(kennung,kennungstext1);FOR ijFROM +1UPTO length(schuelergruppen)DIV laengesugruppeREP schgrindex:=(ij-1)* +laengesugruppe;schgrjgst:=subtext(schuelergruppen,schgrindex+1,schgrindex+2); +IF pos(jgstzurnull,trenner+schgrjgst+trenner)=0THEN jgstzurnullCAT schgrjgst; +jgstzurnullCAT trennerFI PER ;IF length(jgstzurnull)=4THEN jgst:=subtext( +jgstzurnull,2,3);jgstzurnull:=""FI .jgstgleich:jgst=stdpljgstCOR stdpljgst= +"00"COR pos(jgstzurnull,trenner+stdpljgst+trenner)>0. +kopplungsbezunterschiedlich:kopplung<>stdplkopp.bitleistenschnitt: +gibtesgemeinsamesugruppen(bitleiste,stdplbitleiste).END PROC +schuelergruppenschnittbeizeit;BOOL PROC schuelergruppenschnittbeizeit(INT +CONST anwzeit,TEXT CONST kennung,anwkennungstext1,anwkennungstext2,TEXT VAR +lv,sugruppen):BITLEISTE VAR bitleiste,stdplbitleiste;TEXT VAR allestdpllv, +gesamtlv,jgst,kopplung,stdpllv,stdplkopp,stdpljgst:="",schgrjgst:="", +schuelergruppen:="",jgstzurnull:=trenner;TEXT VAR kennungstext1:="", +kennungstext2:="";INT VAR zeit:=konvertierezeit(anwzeit),anfangeintrag, +laengeallestdpllv,ij,schgrindex;lv:="";sugruppen:="";IF zeit=0THEN LEAVE +schuelergruppenschnittbeizeitWITH TRUE ELIF kennung=kennunglvTHEN +kennungstext1:=text(anwkennungstext1,laengelv);IF anwkennungstext2<>""THEN +kennungstext2:=text(anwkennungstext2,laengelv)FI ;gesamtlv:=lv0eintrag( +kennungstext1);IF gesamtlv=""THEN LEAVE schuelergruppenschnittbeizeitWITH +TRUE ELSE jgst:=text(gesamtlv,laengejgst);kopplung:=kopplungderlv(gesamtlv); +bitleiste:=lv1eintrag(zugriffszeilelv0);FI ELIF kennung=kennungkopplungTHEN +kennungstext1:=text(anwkennungstext1,laengekopplung);jgst:=jgstzukopplung( +kennungstext1);kopplung:=kennungstext1;IF jgst=""THEN LEAVE +schuelergruppenschnittbeizeitWITH TRUE ELSE sammlebitleisten(kennungstext1, +beginnlvkopplung,bitleiste)FI ELSE LEAVE schuelergruppenschnittbeizeitWITH +TRUE FI ;allestdpllv:=stuplanzeile(zeit);laengeallestdpllv:=length( +allestdpllv);IF laengeallestdpllvkennungstext1CAND stdpllv<>kennungstext2THEN stdplkopp:=subtext +(allestdpllv,anfangeintrag+beginnlvkopplung,anfangeintrag+endelvkopplung);IF +kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste +:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN lv:=stdpllv;sugruppen +:=sugruppenausbitleiste(bitleistegemeinsamesugruppen(stdplbitleiste,bitleiste +));LEAVE schuelergruppenschnittbeizeitWITH TRUE FI ELSE LEAVE +schuelergruppenschnittbeizeitWITH TRUE FI ;FI ;FI ;ELSE IF jgstgleichTHEN +stdplkopp:=subtext(allestdpllv,anfangeintrag+beginnlvkopplung,anfangeintrag+ +endelvkopplung);IF kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>"" +THEN stdplbitleiste:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN lv +:=stdpllv;sugruppen:=sugruppenausbitleiste(bitleistegemeinsamesugruppen( +stdplbitleiste,bitleiste));LEAVE schuelergruppenschnittbeizeitWITH TRUE FI +ELSE LEAVE schuelergruppenschnittbeizeitWITH TRUE FI ;FI ;FI ;FI ; +anfangeintrag:=anfangeintrag+laengestuplaneintragPER ;FALSE .bildejgstzurnull +:schuelergruppen:=beteiligteschuelergruppen(kennung,kennungstext1);FOR ij +FROM 1UPTO length(schuelergruppen)DIV laengesugruppeREP schgrindex:=(ij-1)* +laengesugruppe;schgrjgst:=subtext(schuelergruppen,schgrindex+1,schgrindex+2); +IF pos(jgstzurnull,trenner+schgrjgst+trenner)=0THEN jgstzurnullCAT schgrjgst; +jgstzurnullCAT trennerFI PER ;IF length(jgstzurnull)=4THEN jgst:=subtext( +jgstzurnull,2,3);jgstzurnull:=""FI .jgstgleich:jgst=stdpljgstCOR stdpljgst= +"00"COR pos(jgstzurnull,trenner+stdpljgst+trenner)>0. +kopplungsbezunterschiedlich:kopplung<>stdplkopp.bitleistenschnitt: +gibtesgemeinsamesugruppen(bitleiste,stdplbitleiste).END PROC +schuelergruppenschnittbeizeit;BOOL PROC gemeinsameschuelergruppen(TEXT CONST +kennung1,akennungstext1,kennung2,akennungstext2):BITLEISTE VAR bitleiste1, +bitleiste2;TEXT VAR kennungstext1:="",kennungstext2:="";IF kennung1=kennunglv +THEN kennungstext1:=text(akennungstext1,laengelv);IF lv0eintrag(kennungstext1 +)=""THEN LEAVE gemeinsameschuelergruppenWITH TRUE ELSE bitleiste1:=lv1eintrag +(zugriffszeilelv0)FI ELIF kennung1=kennungkopplungTHEN kennungstext1:=text( +akennungstext1,laengekopplung);sammlebitleisten(kennungstext1, +beginnlvkopplung,bitleiste1);ELSE LEAVE gemeinsameschuelergruppenWITH TRUE +FI ;IF kennung2=kennunglvTHEN kennungstext2:=text(akennungstext2,laengelv); +IF lv0eintrag(kennungstext2)=""THEN LEAVE gemeinsameschuelergruppenWITH TRUE +ELSE bitleiste2:=lv1eintrag(zugriffszeilelv0)FI ELIF kennung2=kennungkopplung +THEN kennungstext2:=text(akennungstext2,laengekopplung);sammlebitleisten( +kennungstext2,beginnlvkopplung,bitleiste2);ELSE LEAVE +gemeinsameschuelergruppenWITH TRUE FI ;gibtesgemeinsamesugruppen(bitleiste1, +bitleiste2)END PROC gemeinsameschuelergruppen;TEXT PROC lvderschuelergruppe( +TEXT CONST anwsugrup):INT VAR i,folgejgst:=5;TEXT VAR lvmitsugrup:="", +aufberjgst:=formatjgst(anwsugrup),sugrup:=text(anwsugrup,laengesugruppe); +BITLEISTE VAR bitleiste:=sugrupurleiste;IF pos(klstjgst,trenner+compress( +sugrup)+trenner)>0COR aufberjgst="00"COR schuelergruppeTHEN betrachtelvELSE +ungueltigesergebnis(kennunglv)FI .betrachtelv:bitleiste:=sg1eintrag(sugrup); +lvjgstnullanfang:=1;lvjgstnullende:=-1;WHILE lvjgstnullende=-1CAND folgejgst< +14REP lvjgstnullende:=erstezeileindatei(lvdatei,formatjgst(text(folgejgst)),1 +,beginnlvjgst)-1;folgejgstINCR 1PER ;IF formatjgst(anwsugrup)<>"00"THEN +lvsugrupjgstanfang:=erstezeileindatei(lvdatei,aufberjgst,1,beginnlvjgst);IF +int(sugrup)=jgstdreizehnTHEN lvsugrupjgstende:=anzlv;ELSE lvsugrupjgstende:= +erstezeileindatei(lvdatei,formatjgst(text(int(sugrup)+1)),lvsugrupjgstanfang, +beginnlvjgst);FI ;IF lvsugrupjgstanfang=0THEN lvsugrupjgstanfang:= +lvsugrupjgstende+1FI ELSE lvsugrupjgstanfang:=1;lvsugrupjgstende:=0FI ;FOR i +FROM lvjgstnullanfangUPTO lvjgstnullendeREP IF +bitleistenvergleichgemeinsamesugruppenTHEN lvmitsugrupCAT text(lv0eintrag(i), +laengelv)FI PER ;FOR iFROM lvsugrupjgstanfangUPTO lvsugrupjgstendeREP IF +bitleistenvergleichgemeinsamesugruppenTHEN lvmitsugrupCAT text(lv0eintrag(i), +laengelv)FI PER ;lvmitsugrup.bitleistenvergleichgemeinsamesugruppen: +gibtesgemeinsamesugruppen(bitleiste,lv1eintrag(i)).schuelergruppe:toline( +sugrupdatei,1);col(sugrupdatei,1);WHILE NOT eof(sugrupdatei)REP downety( +sugrupdatei,sugrup);IF col(sugrupdatei)=1THEN LEAVE schuelergruppeWITH TRUE +ELSE positionierenFI ;PER ;FALSE .positionieren:col(sugrupdatei,col( +sugrupdatei)+1).END PROC lvderschuelergruppe;TEXT PROC allelvmit(TEXT CONST +kennung,anwkennungstext):TEXT VAR lvmit:="",lv:="",kennungstext:="";INT VAR +richtigepos;IF kennung=kennungparapheTHEN kennungstext:=text(anwkennungstext, +laengeparaphe);richtigepos:=stuplanposparapheELIF kennung=kennungkopplung +THEN kennungstext:=text(anwkennungstext,laengekopplung);richtigepos:= +stuplanposkopplungELSE LEAVE allelvmitWITH ungueltigesergebnis(kennunglv)FI ; +toline(lvdatei,1);col(lvdatei,1);WHILE NOT eof(lvdatei)REP downety(lvdatei, +kennungstext);IF col(lvdatei)=richtigeposCAND NOT eof(lvdatei)THEN readrecord +(lvdatei,lv);lvmitCAT text(lv,laengelv)FI ;positionierenPER ;lvmit. +positionieren:col(lvdatei,col(lvdatei)+1).END PROC allelvmit;BOOL PROC +lvgeplant(INT CONST zeit,TEXT CONST lehrveranstaltung):INT CONST std:= +konvertierezeit(zeit);TEXT VAR eintrag:="";IF std=0THEN TRUE ELSE eintrag:= +stuplanzeile(std);instuplanzeile(eintrag,text(lehrveranstaltung,laengelv), +stuplanposjgst,letzteposstuplanzeile)FI END PROC lvgeplant;TEXT PROC +geplantelvfuer(INT CONST zeit,TEXT CONST kennung,anwkennungstext):INT VAR std +:=konvertierezeit(zeit),poslv,richtigepos;TEXT VAR kennungstext:="";IF std=0 +THEN LEAVE geplantelvfuerWITH ungueltigesergebnis(kennunglv)ELIF kennung= +kennungparapheTHEN kennungstext:=text(anwkennungstext,laengeparaphe); +richtigepos:=stuplanposparapheELIF kennung=kennungraumTHEN kennungstext:=text +(anwkennungstext,laengeraum);richtigepos:=stuplanposraumELSE LEAVE +geplantelvfuerWITH ungueltigesergebnis(kennunglv)FI ;IF instuplanzeile( +stuplanzeile(std),kennungstext,richtigepos,letzteposstuplanzeile)THEN +holentsprlvELSE ""FI .holentsprlv:poslv:=letzteposstuplanzeile-richtigepos+1; +subtext(stuplanzeile(std),poslv,poslv+laengelv-1).END PROC geplantelvfuer; +TEXT PROC allezeitenvon(TEXT CONST kennung,anwkennungstext):INT VAR i, +richtigepos;TEXT VAR verfplan:="",kennungstext:="";IF kennung=kennungparaphe +THEN kennungstext:=text(anwkennungstext,laengeparaphe);richtigepos:= +stuplanposparapheELIF kennung=kennunglvTHEN kennungstext:=text( +anwkennungstext,laengelv);richtigepos:=stuplanposjgstELIF kennung=kennungraum +THEN kennungstext:=text(anwkennungstext,laengeraum);richtigepos:= +stuplanposraumELIF kennung=kennungkopplungTHEN kennungstext:=text( +anwkennungstext,laengekopplung);richtigepos:=stuplanposkopplungELSE LEAVE +allezeitenvonWITH letztestunde*fehlerzeichenFI ;FOR iFROM erstestundeUPTO +letztestundeREP IF instuplanzeile(stuplanzeile(i),kennungstext,richtigepos, +letzteposstuplanzeile)THEN verfplanCAT einsELSE verfplanCAT nullFI PER ; +verfplanEND PROC allezeitenvon;TEXT PROC datenderzeit(INT CONST zeit,TEXT +CONST kennung):INT VAR std:=konvertierezeit(zeit),poseintrag,laengeeintrag, +objektlaenge,objektbeginn;TEXT VAR eintrag:="",ausgabe:="";IF kennung= +kennunglvTHEN objektlaenge:=laengelv;objektbeginn:=stuplanposjgstELIF kennung +=kennungkopplungTHEN objektlaenge:=laengekopplung;objektbeginn:= +stuplanposkopplungELIF kennung=kennungparapheTHEN objektlaenge:=laengeparaphe +;objektbeginn:=stuplanposparapheELIF kennung=kennungraumTHEN objektlaenge:= +laengeraum;objektbeginn:=stuplanposraumELSE LEAVE datenderzeitWITH +fehlerzeichenFI ;IF std=0THEN LEAVE datenderzeitWITH ungueltigesergebnis( +kennung)FI ;toline(stuplandatei,std);readrecord(stuplandatei,eintrag);ausgabe +:="";poseintrag:=objektbeginn;laengeeintrag:=length(eintrag);WHILE poseintrag +kennungsugruppeTHEN IF instuplanzeile(stuplanzeile( +std),kennungstext,richtigepos,letzteposstuplanzeile)THEN holentsprlvFI ELSE +holelvderzeit;ermittlebitleiste;vergleichelvmitbitleisteFI .holentsprlv:poslv +:=letzteposstuplanzeile-richtigepos+1;lehrveranstaltung:=subtext(stuplanzeile +(std),poslv,poslv+laengestuplaneintrag-1);raum:=subtext(lehrveranstaltung, +stuplanposraum);paraphe:=subtext(lehrveranstaltung,stuplanposparaphe, +stuplanposparaphe+laengeparaphe-1);lehrveranstaltung:=text(lehrveranstaltung, +laengelv).ermittlebitleiste:stackpos:=pos(behandeltesugruppen,trenner+ +kennungstext+trenner);IF bitleistenochzuermittelnTHEN sugrupbitleiste:= +sg1eintrag(kennungstext);IF anzbitleisten""THEN stdplbitleiste:= +lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN lehrveranstaltungCAT +stdpllv;raumCAT subtext(allestdpllv,anfangeintrag+stuplanposraum, +anfangeintrag+laengestuplaneintrag);parapheCAT subtext(allestdpllv, +anfangeintrag+stuplanposparaphe,anfangeintrag+stuplanposraum-1)FI FI ;FI ; +anfangeintrag:=anfangeintrag+laengestuplaneintragPER .jgstgleichodernullnull: +jgstdersugrup=jgstderlvCOR jgstderlv="00".bitleistenschnitt: +gibtesgemeinsamesugruppen(sugrupbitleiste,stdplbitleiste).fehlerbehandlung: +lehrveranstaltung:=ungueltigesergebnis(kennunglv);raum:="";paraphe:="";LEAVE +planeintraglesen.END PROC planeintraglesen;PROC planeintragvornehmen(INT +CONST zeit,TEXT CONST anwlehrveranstaltung,anwraum,BOOL VAR ok):INT VAR std:= +konvertierezeit(zeit);TEXT VAR lv,eintrag,neuereintrag,lehrveranstaltung:= +text(anwlehrveranstaltung,laengelv),raum:=text(anwraum,laengeraum);IF std=0 +THEN ok:=FALSE ;LEAVE planeintragvornehmenFI ;IF raum<>leereraumangabeAND ( +NOT bezeichnungzulaessig(kennungraum,raum))THEN ok:=FALSE ;LEAVE +planeintragvornehmenFI ;lv:=lv0eintrag(lehrveranstaltung);IF lv=""THEN ok:= +FALSE ;ELIF instuplanzeile(stuplanzeile(std),lehrveranstaltung,stuplanposjgst +,letzteposstuplanzeile)THEN holstuplaneintrag;substituierelvELSE +holstuplaneintrag;erweitereumlvFI .holstuplaneintrag:ok:=TRUE ;toline( +stuplandatei,std);readrecord(stuplandatei,eintrag).erweitereumlv:eintragCAT +text(lv,laengelv+laengekopplung+laengeparaphe);eintragCAT text(raum, +laengeraum);writerecord(stuplandatei,eintrag).substituierelv:neuereintrag:= +text(eintrag,letzteposstuplanzeile-1);neuereintragCAT text(lv,laengelv+ +laengekopplung+laengeparaphe);neuereintragCAT text(raum,laengeraum); +neuereintragCAT subtext(eintrag,letzteposstuplanzeile+laengestuplaneintrag); +writerecord(stuplandatei,neuereintrag).END PROC planeintragvornehmen;PROC +planeintragloeschen(INT CONST zeit,TEXT CONST lehrveranstaltung,BOOL VAR ok): +INT VAR std:=konvertierezeit(zeit);TEXT VAR eintrag,neuereintrag;IF std=0 +THEN ok:=FALSE ELIF instuplanzeile(stuplanzeile(std),text(lehrveranstaltung, +laengelv),stuplanposjgst,letzteposstuplanzeile)THEN holstuplaneintrag; +loescheeintragELSE ok:=FALSE FI .holstuplaneintrag:ok:=TRUE ;toline( +stuplandatei,std);readrecord(stuplandatei,eintrag).loescheeintrag: +neuereintrag:=text(eintrag,letzteposstuplanzeile-1);neuereintragCAT subtext( +eintrag,letzteposstuplanzeile+laengestuplaneintrag);writerecord(stuplandatei, +neuereintrag).END PROC planeintragloeschen;PROC resetbitleiste(BITLEISTE VAR +bitleiste):FOR iFROM 1UPTO leistenlaengeREP FOR jFROM 0UPTO bits-1REP +resetbit(bitleiste(i),j)PER PER ;END PROC resetbitleiste;PROC +loeschdatenraeume:forget(lvnulldatenraum,quiet);forget(sgnulldatenraum,quiet) +;forget(lveinsdatenraum,quiet);forget(sgeinsdatenraum,quiet)END PROC +loeschdatenraeume;OP :=(BITLEISTE VAR eins,BITLEISTE CONST zwei):INT VAR i; +FOR iFROM 1UPTO leistenlaengeREP eins(i):=zwei(i)PER END OP :=;PROC +schreibesugrupundklgrinds:zz:=0;positioniersugrup;holsugrupdaten;IF zz=0THEN +LEAVE schreibesugrupundklgrindsFI ;anzsugrup:=zz;positionierklgr;holklgrdaten +;IF anzsugrup=-1THEN LEAVE schreibesugrupundklgrindsFI ;anzsugrupundklgr:=zz; +FOR iFROM jgstfuenfUPTO jgstdreizehnREP toline(sugrupdatei,lines(sugrupdatei) ++1);schreibjgstindateiPER .positioniersugrup:inittupel(dnraktschuelergruppen) +;putwert(fnrsgrpsj,gewschulj);putwert(fnrsgrphj,gewhalbj);putintwert( +fnrsgrpjgst,0).positionierklgr:inittupel(dnrklassengruppen);first( +dnrklassengruppen).holsugrupdaten:IF records(dnraktschuelergruppen)=0.0THEN +LEAVE schreibesugrupundklgrindsFI ;statleseschleife(dnraktschuelergruppen, +gewschulj,gewhalbj,fnrsgrpsj,fnrsgrphj,PROC sugrupinds).holklgrdaten:IF +records(dnrklassengruppen)=0.0THEN LEAVE holklgrdatenFI ;statleseschleife( +dnrklassengruppen,"","",fnrkgklassengrp,fnrkgschuelergrp,PROC klgrinds). +schreibjgstindatei:putds(sugrupdatei,text(formatjgst(text(i)),laengesugruppe) +);schreibbitleisteinds.schreibbitleisteinds:sugrupleiste:=sugrupurleiste; +ermittlebitleistejgstodersugrupklgr(formatjgst(text(i,laengejgst))); +sgbitleisten(zz+1):=sugrupleiste;zzINCR 1.END PROC schreibesugrupundklgrinds; +PROC schreibelvinds:anzlv:=0;sucheerstensatz;schreibsugrupleiste;IF zz<>0 +THEN anzlv:=zz-1FI .sucheerstensatz:IF records(dnrlehrveranstaltungen)=0.0 +THEN LEAVE schreibelvindsFI ;inittupel(dnrlehrveranstaltungen);putwert( +fnrlvsj,gewschulj);putwert(fnrlvhj,gewhalbj);putintwert(fnrlvjgst,jgstnull); +putwert(fnrlvfachkennung,"");search(dnrlehrveranstaltungen,FALSE ). +schreibsugrupleiste:zz:=0;statleseschleife(dnrlehrveranstaltungen,gewschulj, +gewhalbj,fnrlvsj,fnrlvhj,PROC sugrupleisteinds).END PROC schreibelvinds;PROC +sugrupleisteinds(BOOL VAR b):IF wert(fnrlvsj)=gewschuljCAND wert(fnrlvhj)= +gewhalbjCAND dbstatus=0CAND zz<2499THEN klgreintrag:=FALSE ;sugrupleiste:= +sugrupurleiste;analysiereklgreinerlv(fnrlvklgrp1);IF anzsugrup=-1THEN b:= +TRUE ;LEAVE sugrupleisteindsELSE analysiereklgreinerlv(fnrlvklgrp2);IF +anzsugrup=-1THEN b:=TRUE ;LEAVE sugrupleisteindsELSE analysiereklgreinerlv( +fnrlvklgrp3);IF anzsugrup=-1THEN b:=TRUE ;LEAVE sugrupleisteindsELSE +analysiereklgreinerlv(fnrlvklgrp4);FI ;FI ;FI ;IF NOT klgreintragTHEN +ermittlebitleistejgst(wert(fnrlvjgst));FI ;schreiblvindatei; +schreibsugrupleisteindsELSE b:=TRUE FI .schreiblvindatei:dateieintrag:=""; +dateieintragCAT formatjgst(wert(fnrlvjgst));dateieintragCAT text(wert( +fnrlvfachkennung),laengefachkennung);dateieintragCAT text(wert(fnrlvkopplung) +,laengekopplung);dateieintragCAT text(wert(fnrlvparaphe),laengeparaphe); +dateieintragCAT text(wert(fnrlvwochenstd),laengewochenstd);dateieintragCAT +text(wert(fnrlvraumgrp1),laengeraum);dateieintragCAT text(wert(fnrlvraumgrp2) +,laengeraum);putds(lvdatei,dateieintrag).schreibsugrupleisteinds:lvbitleisten +(zz+1):=sugrupleiste;zzINCR 1;.END PROC sugrupleisteinds;PROC +analysiereklgreinerlv(INT CONST lvklgrfeld):IF wert(lvklgrfeld)<>""THEN IF +istjgst(wert(lvklgrfeld))THEN ermittlebitleistejgst(wert(lvklgrfeld));ELIF +istklgr(wert(lvklgrfeld))THEN ermittlebitleistejgstodersugrupklgr(wert( +lvklgrfeld));ELSE ermittlebitleistejgstodersugrupklgr(formatjgst(wert( +fnrlvjgst))+wert(lvklgrfeld));IF anzsugrup=-1THEN LEAVE analysiereklgreinerlv +FI ;FI ;klgreintrag:=TRUE FI ;END PROC analysiereklgreinerlv;PROC sugrupinds( +BOOL VAR b):IF wert(fnrsgrpsj)=gewschuljCAND wert(fnrsgrphj)=gewhalbjCAND +dbstatus=0THEN sugrupleiste:=sugrupurleiste;putds(sugrupdatei,formatjgst(wert +(fnrsgrpjgst))+text(wert(fnrsgrpkennung),laengeklagruppe));IF zz<127THEN +schreibesugrupleisteFI ;sgbitleisten(zz+1):=sugrupleiste;zzINCR 1;ELIF wert( +fnrsgrpsj)>gewschuljCOR wert(fnrsgrphj)>gewhalbjCOR dbstatus<>0COR zz=127 +THEN b:=TRUE FI .schreibesugrupleiste:setzebit(zz).END PROC sugrupinds;PROC +klgrinds(BOOL VAR b):IF dbstatus=0THEN toline(sugrupdatei,lines(sugrupdatei)+ +1);plausiklgrCAT wert(fnrkgklassengrp)+trenner;putds(sugrupdatei,text(wert( +fnrkgklassengrp),laengesugruppe));analysieresugrupen;sgbitleisten(zz+1):= +sugrupleiste;zzINCR 1ELSE b:=TRUE FI .analysieresugrupen:sugrupleiste:= +sugrupurleiste;sugruppeneinerklgr:=wert(fnrkgschuelergrp);FOR kFROM 1UPTO +LENGTH sugruppeneinerklgrDIV laengesugruppeREP +ermittlebitleistejgstodersugrupklgr(subtext(sugruppeneinerklgr,(k-1)* +laengesugruppe+1,k*laengesugruppe));IF anzsugrup=-1THEN b:=TRUE ;LEAVE +klgrindsFI ;PER .END PROC klgrinds;PROC ermittlebitleistejgstodersugrupklgr( +TEXT CONST klgrteil):TEXT VAR compklgrteil:=compress(klgrteil);IF istjgst( +compklgrteil)THEN stellebitleistenjgstELSE stellebitleistesugrupoderklgrFI . +stellebitleistesugrupoderklgr:IF istklgr(compklgrteil)THEN toline(sugrupdatei +,anzsugrup);ELSE toline(sugrupdatei,1);FI ;col(sugrupdatei,1);downety( +sugrupdatei,compklgrteil);IF NOT eof(sugrupdatei)THEN oderbitleisten;LEAVE +stellebitleistesugrupoderklgrELSE anzsugrup:=-1;LEAVE +ermittlebitleistejgstodersugrupklgrFI .stellebitleistenjgst:toline( +sugrupdatei,1);col(sugrupdatei,1);WHILE NOT eof(sugrupdatei)REP downety( +sugrupdatei,formatjgst(klgrteil));IF col(sugrupdatei)=1CAND lineno( +sugrupdatei)<=anzsugrupTHEN oderbitleistenFI ;positionierenPER .positionieren +:col(sugrupdatei,col(sugrupdatei)+1).oderbitleisten:BITLEISTE VAR bitleiste:= +sgbitleisten(lineno(sugrupdatei));FOR jFROM 1UPTO leistenlaengeREP +sugrupleiste(j):=sugrupleiste(j)OR bitleiste(j)PER .END PROC +ermittlebitleistejgstodersugrupklgr;PROC ermittlebitleistejgst(TEXT CONST +klgrteil):stellebitleistenjgst.stellebitleistenjgst:toline(sugrupdatei, +anzsugrupundklgr);col(sugrupdatei,1);WHILE NOT eof(sugrupdatei)REP downety( +sugrupdatei,formatjgst(klgrteil));IF col(sugrupdatei)=1THEN oderbitleistenFI +;positionierenPER .positionieren:col(sugrupdatei,col(sugrupdatei)+1). +oderbitleisten:BITLEISTE VAR bitleiste:=sgbitleisten(lineno(sugrupdatei)); +FOR jFROM 1UPTO leistenlaengeREP sugrupleiste(j):=sugrupleiste(j)OR bitleiste +(j)PER .END PROC ermittlebitleistejgst;BOOL PROC stundenplanbasisaktuell(INT +VAR fehlerstatus):dserstellungszeit:="";letztedbzeit:="";ermittledszeit; +ermittledbzeit;vergleichezeit;IF fehlerstatus=0THEN TRUE ELSE FALSE FI . +ermittledszeit:dserstellungszeit:=erstellungszeitderdatenraeume. +ermittledbzeit:IF gewhalbj=schulkenndatum(halbj)THEN inittupel(dnrschluessel) +;putwert(fnrschlschluessel,dbaenderungakt);ELSE inittupel(dnrschluessel); +putwert(fnrschlschluessel,dbaenderunggepl);FI ;putwert(fnrschlsachgebiet, +dbaenderung);search(dnrschluessel,TRUE );IF dbstatus<>okTHEN fehlerstatus:=9; +LEAVE stundenplanbasisaktuellWITH FALSE ELSE letztedbzeit:=wert( +fnrschllangtext)FI .vergleichezeit:IF dsjahr=dbjahrTHEN pruefmonatELIF dsjahr +>dbjahrTHEN fehlerstatus:=0ELSE fehlerstatus:=1FI .pruefmonat:IF dsmonat= +dbmonatTHEN prueftagELIF dsmonat>dbmonatTHEN fehlerstatus:=0ELSE fehlerstatus +:=1FI .prueftag:IF dstag=dbtagTHEN pruefzeitELIF dstag>dbtagTHEN fehlerstatus +:=0ELSE fehlerstatus:=1FI .pruefzeit:IF dszeit>=dbzeitTHEN fehlerstatus:=0 +ELSE fehlerstatus:=1FI .dsjahr:subtext(dserstellungszeit,erstellzeitjahr, +erstellzeitjahr+1).dbjahr:subtext(letztedbzeit,erstellzeitjahr, +erstellzeitjahr+1).dsmonat:subtext(dserstellungszeit,erstellzeitmonat, +erstellzeitmonat+1).dbmonat:subtext(letztedbzeit,erstellzeitmonat, +erstellzeitmonat+1).dstag:text(dserstellungszeit,erstellzeittag+1).dbtag:text +(letztedbzeit,erstellzeittag+1).dszeit:subtext(dserstellungszeit, +erstellzeitstdmin).dbzeit:subtext(letztedbzeit,erstellzeitstdmin).END PROC +stundenplanbasisaktuell;PROC stundenplanbasiserstellen(INT VAR fehlerstatus): +hilfsdatenerstellen(fehlerstatus);IF fehlerstatus=0THEN toline(stuplandatei, +letztestunde+1);writerecord(stuplandatei,date+blank+timeofday);FI .END PROC +stundenplanbasiserstellen;PROC hilfsdatenerstellen(INT VAR fehlerstatus): +inithilfsdateien;schreibesugrupundklgrinds;IF anzsugrup=-1THEN fehlerstatus:= +9;forget(sgnulldatenraum,quiet);forget(sgeinsdatenraum,quiet)ELIF anzsugrup=0 +THEN fehlerstatus:=4ELIF anzsugrup>127THEN fehlerstatus:=5;loeschdatenraeume +ELSE schreibelvinds;IF anzsugrup=-1THEN fehlerstatus:=9;loeschdatenraeume +ELIF anzlv=0THEN fehlerstatus:=6;loeschdatenraeumeELIF anzlv>2499THEN +fehlerstatus:=7;loeschdatenraeumeELSE fehlerstatus:=0FI ;FI .inithilfsdateien +:commanddialogue(FALSE );loeschdatenraeume;commanddialogue(TRUE );#dslv:=new( +lvnulldatenraum);dssugrup:=new(sgnulldatenraum);commanddialogue(FALSE ); +forget(dslv);forget(dssugrup);commanddialogue(TRUE );#lvdatei:=sequentialfile +(modify,lvnulldatenraum);sugrupdatei:=sequentialfile(modify,sgnulldatenraum); +lvbitleisten:=new(lveinsdatenraum);sgbitleisten:=new(sgeinsdatenraum); +resetbitleiste(sugrupurleiste).END PROC hilfsdatenerstellen;PROC +datenraeumeankoppeln:IF exists(lvnulldatenraum)THEN lvdatei:=sequentialfile( +modify,old(lvnulldatenraum))FI ;IF exists(sgnulldatenraum)THEN sugrupdatei:= +sequentialfile(modify,old(sgnulldatenraum))FI ;IF exists(stuplandatenraum) +THEN stuplandatei:=sequentialfile(modify,old(stuplandatenraum))FI ;IF exists( +lveinsdatenraum)THEN lvbitleisten:=old(lveinsdatenraum);FI ;IF exists( +sgeinsdatenraum)THEN sgbitleisten:=old(sgeinsdatenraum);FI END PROC +datenraeumeankoppeln;INT PROC zugriffszeilelv0:letzterzugrifflv0END PROC +zugriffszeilelv0;TEXT PROC lv0eintrag(TEXT CONST lv):TEXT VAR dateieintrag:= +"";letzterzugrifflv0:=0;dateieintrag:="";toline(lvdatei,1);col(lvdatei,1); +WHILE NOT eof(lvdatei)REP downety(lvdatei,lv);IF col(lvdatei)=beginnlvbez +CAND NOT eof(lvdatei)THEN readrecord(lvdatei,dateieintrag);letzterzugrifflv0 +:=lineno(lvdatei);LEAVE lv0eintragWITH dateieintragELSE positionierenFI ;PER +;"".positionieren:col(lvdatei,col(lvdatei)+1).END PROC lv0eintrag;TEXT PROC +lv0eintrag(INT CONST index):TEXT VAR dateieintrag:="";toline(lvdatei,index); +col(lvdatei,1);IF eof(lvdatei)THEN ""ELSE readrecord(lvdatei,dateieintrag); +dateieintragFI END PROC lv0eintrag;BOOL PROC kopplunginlv0(TEXT CONST +kopplung):toline(lvdatei,1);col(lvdatei,1);WHILE NOT eof(lvdatei)REP downety( +lvdatei,kopplung);IF col(lvdatei)=beginnlvkopplungCAND NOT eof(lvdatei)THEN +LEAVE kopplunginlv0WITH TRUE ELSE positionierenFI ;PER ;FALSE .positionieren: +col(lvdatei,col(lvdatei)+1).END PROC kopplunginlv0;BOOL PROC sg0eintrag(TEXT +CONST sg):toline(sugrupdatei,1);col(sugrupdatei,1);WHILE NOT eof(sugrupdatei) +REP downety(sugrupdatei,sg);IF col(sugrupdatei)=1CAND NOT eof(sugrupdatei) +CAND lineno(sugrupdatei)<=anzsugrupTHEN LEAVE sg0eintragWITH TRUE ELSE +positionierenFI ;PER ;FALSE .positionieren:col(sugrupdatei,col(sugrupdatei)+1 +).END PROC sg0eintrag;TEXT PROC sg0eintrag(INT CONST index):dateieintrag:=""; +toline(sugrupdatei,index);col(sugrupdatei,1);IF eof(sugrupdatei)THEN ""ELSE +readrecord(sugrupdatei,dateieintrag);text(dateieintrag,laengesugruppe)FI END +PROC sg0eintrag;BITLEISTE PROC sg1eintrag(TEXT CONST anwsugrup):TEXT VAR +sugrup:=text(anwsugrup,laengesugruppe);toline(sugrupdatei,1);col(sugrupdatei, +1);WHILE NOT eof(sugrupdatei)REP downety(sugrupdatei,sugrup);IF col( +sugrupdatei)=1CAND NOT eof(sugrupdatei)THEN LEAVE sg1eintragWITH sgbitleisten +(lineno(sugrupdatei))ELSE positionierenFI ;PER ;sugrupurleiste.positionieren: +col(sugrupdatei,col(sugrupdatei)+1).END PROC sg1eintrag;BITLEISTE PROC +lv1eintrag(INT CONST index):lvbitleisten(index)END PROC lv1eintrag;TEXT PROC +sugruppenausbitleiste(BITLEISTE CONST bitleiste):sugruppeneinerklgr:="";FOR j +FROM 1UPTO leistenlaengeREP lowbit:=lowestset(bitleiste(j));IF lowbit<>-1 +THEN FOR kFROM lowbitUPTO bits-1REP IF bit(bitleiste(j),k)THEN +sugruppeneinerklgrCAT sg0eintrag(k+(j-1)*bits+1)FI PER ;FI ;PER ; +sugruppeneinerklgrEND PROC sugruppenausbitleiste;BITLEISTE PROC +bitleisteallesugruppen(BITLEISTE VAR v,BITLEISTE CONST c):BITLEISTE VAR b:= +sugrupurleiste;FOR jFROM 1UPTO leistenlaengeREP b(j):=v(j)OR c(j)PER ;bEND +PROC bitleisteallesugruppen;BITLEISTE PROC bitleistegemeinsamesugruppen( +BITLEISTE CONST v,c):BITLEISTE VAR b:=sugrupurleiste;FOR jFROM 1UPTO +leistenlaengeREP b(j):=v(j)AND c(j)PER ;bEND PROC +bitleistegemeinsamesugruppen;BOOL PROC gibtesgemeinsamesugruppen(BITLEISTE +CONST v,c):BITLEISTE VAR b:=sugrupurleiste;FOR jFROM 1UPTO leistenlaengeREP b +(j):=v(j)AND c(j);lowbit:=lowestset(b(j));IF lowbit<>-1THEN LEAVE +gibtesgemeinsamesugruppenWITH TRUE FI ;PER ;FALSE END PROC +gibtesgemeinsamesugruppen;BITLEISTE PROC bitleistenichtgemeinsamesugruppen( +BITLEISTE CONST v,c):BITLEISTE VAR b:=sugrupurleiste;FOR jFROM 1UPTO +leistenlaengeREP b(j):=v(j)XOR c(j)PER ;bEND PROC +bitleistenichtgemeinsamesugruppen;PROC sammlebitleisten(TEXT CONST +kennungstext,INT CONST richtigepos,BITLEISTE VAR bitleiste):resetbitleiste( +bitleiste);toline(lvdatei,1);col(lvdatei,1);WHILE NOT eof(lvdatei)REP downety +(lvdatei,kennungstext);IF col(lvdatei)=richtigeposCAND NOT eof(lvdatei)THEN +bitleiste:=bitleisteallesugruppen(bitleiste,lv1eintrag(lineno(lvdatei)));FI ; +positionieren;PER .positionieren:col(lvdatei,col(lvdatei)+1).END PROC +sammlebitleisten;TEXT PROC jgstzukopplung(TEXT CONST kennungstext):TEXT VAR +lv:="";toline(lvdatei,1);col(lvdatei,1);WHILE NOT eof(lvdatei)REP downety( +lvdatei,kennungstext);IF col(lvdatei)=beginnlvkopplungCAND NOT eof(lvdatei) +THEN readrecord(lvdatei,lv);LEAVE jgstzukopplungWITH text(lv,laengejgst)FI ; +positionieren;PER ;"".positionieren:col(lvdatei,col(lvdatei)+1).END PROC +jgstzukopplung;TEXT PROC ungueltigesergebnis(TEXT CONST kennung):IF kennung= +kennunglvTHEN ergebnis:=laengelv*fehlerzeichenELIF kennung=kennungzeitOR +kennung=kennungzugelassenezeitTHEN ergebnis:=laengezeit*fehlerzeichenELIF +kennung=kennungparapheTHEN ergebnis:=laengeparaphe*fehlerzeichenELIF kennung= +kennungkopplungTHEN ergebnis:=laengekopplung*fehlerzeichenELIF kennung= +kennungsugruppeTHEN ergebnis:=laengesugruppe*fehlerzeichenELIF kennung= +kennungraumOR kennung=kennungwunschraumOR kennung=kennungersatzraumTHEN +ergebnis:=laengeraum*fehlerzeichenELIF kennung=kennungwochenstdTHEN ergebnis +:=laengewochenstd*fehlerzeichenELSE ergebnis:=fehlerzeichenFI ;ergebnisEND +PROC ungueltigesergebnis;PROC raumcat(BOOL VAR b):IF wert(fnrschlsachgebiet)= +dbraeumeTHEN plausiraeumeCAT text(wert(fnrschlschluessel),laengeraum)+trenner +;ELIF wert(fnrschlsachgebiet)>dbraeumeCOR dbstatus<>0THEN b:=TRUE FI END +PROC raumcat;PROC paraphencat(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE +plausiparaphenCAT text(wert(dnrlehrer+1),laengeparaphe);plausiparaphenCAT +trennerFI END PROC paraphencat;PROC erstelleplausizeiten(BOOL VAR b):IF wert( +fnrzrsj)>gewschuljCOR wert(fnrzrhj)<>gewhalbjCOR dbstatus<>0THEN b:=TRUE +ELSE IF wert(fnrzrkennungteil)=zeitrastersperreTHEN replace(plausizeiten, +intwert(fnrzrtagstunde),"1")FI ;FI END PROC erstelleplausizeiten;TEXT PROC +stuplanzeile(INT CONST zeit):INT VAR std:=konvertierezeit(zeit);TEXT VAR +eintrag:="";IF std=0THEN laengestuplaneintrag*fehlerzeichenELSE toline( +stuplandatei,std);eintrag:="";readrecord(stuplandatei,eintrag);eintragFI END +PROC stuplanzeile;BOOL PROC instuplanzeile(TEXT CONST quelle,muster,INT +CONST richtigepos,INT VAR findpos):INT VAR suchab:=1,aktpos;WHILE pos(quelle, +muster,suchab)<>0REP aktpos:=pos(quelle,muster,suchab);IF aktposMOD +laengestuplaneintrag=richtigeposTHEN findpos:=aktpos;LEAVE instuplanzeile +WITH TRUE ELSE suchab:=aktpos+1FI PER ;FALSE END PROC instuplanzeile;INT +PROC erstezeileindatei(FILE VAR datei,TEXT CONST muster,INT CONST suchab, +richtigepos):toline(datei,suchab);col(datei,1);WHILE NOT eof(datei)REP +downety(datei,muster);IF col(datei)=richtigeposTHEN LEAVE erstezeileindatei +WITH lineno(datei)FI ;positionierenPER ;0.positionieren:col(datei,col(datei)+ +1).END PROC erstezeileindatei;PROC schreibeerstellungszeit:INT VAR +fehlerstatus;IF NOT exists(stuplandatenraum)THEN stundenplanerstellen(date+ +blank+timeofday,fehlerstatus)FI END PROC schreibeerstellungszeit;INT PROC +konvertierezeit(INT CONST tagstd):IF tagstd<1THEN 0ELIF tagstd<=letztestunde +THEN tagstdELIF tagstd>schultage*100+samstagstdTHEN 0ELIF tagstdMOD 100> +stdprotagTHEN 0ELIF tagstdMOD 100=0THEN 0ELSE ((tagstdDIV 100)-1)*stdprotag+( +tagstdMOD 100)FI END PROC konvertierezeit;PROC setzebit(INT CONST bitnr):IF +bitnrDIV bits+1>leistenlaengeTHEN LEAVE setzebitFI ;setbit(sugrupleiste(bitnr +DIV bits+1),bitnrMOD bits)END PROC setzebit;BOOL PROC istjgst(TEXT CONST t): +pos(klstjgst,trenner+t+trenner)>0END PROC istjgst;BOOL PROC istklgr(TEXT +CONST t):pos(plausiklgr,trenner+t+trenner)>0END PROC istklgr;PROC putds(FILE +VAR file,TEXT CONST t):insertrecord(file);writerecord(file,t);down(file);END +PROC putds;TEXT PROC formatjgst(TEXT CONST t):subtext("0"+compress(text(t, +laengejgst)),length("0"+compress(text(t,laengejgst)))-1)END PROC formatjgst; +TEXT PROC lvnulldatenraum:lvnull+gewhalbj+punkt+gewschuljEND PROC +lvnulldatenraum;TEXT PROC lveinsdatenraum:lveins+gewhalbj+punkt+gewschuljEND +PROC lveinsdatenraum;TEXT PROC sgnulldatenraum:sgnull+gewhalbj+punkt+ +gewschuljEND PROC sgnulldatenraum;TEXT PROC sgeinsdatenraum:sgeins+gewhalbj+ +punkt+gewschuljEND PROC sgeinsdatenraum;TEXT PROC stuplandatenraum:stuplan+ +gewhalbj+punkt+gewschuljEND PROC stuplandatenraum;TEXT PROC bezderlv(TEXT +CONST lvzeile):subtext(lvzeile,beginnlvbez,endelvbez)END PROC bezderlv;TEXT +PROC kopplungderlv(TEXT CONST lvzeile):subtext(lvzeile,beginnlvkopplung, +endelvkopplung)END PROC kopplungderlv;TEXT PROC paraphederlv(TEXT CONST +lvzeile):subtext(lvzeile,beginnlvparaphe,endelvparaphe)END PROC paraphederlv; +TEXT PROC wochenstdderlv(TEXT CONST lvzeile):subtext(lvzeile, +beginnlvwochenstd,endelvwochenstd)END PROC wochenstdderlv;TEXT PROC +wunschraumderlv(TEXT CONST lvzeile):subtext(lvzeile,beginnlvraumgr1, +endelvraumgr1)END PROC wunschraumderlv;TEXT PROC ersatzraumderlv(TEXT CONST +lvzeile):subtext(lvzeile,beginnlvraumgr2,endelvraumgr2)END PROC +ersatzraumderlv;END PACKET stundenplanschnittstelle + diff --git a/app/schulis/2.2.1/src/4.teilstdpl fach lehrer b/app/schulis/2.2.1/src/4.teilstdpl fach lehrer new file mode 100644 index 0000000..c9b0972 --- /dev/null +++ b/app/schulis/2.2.1/src/4.teilstdpl fach lehrer @@ -0,0 +1,124 @@ +PACKET teilstdplfachlehrerDEFINES stdplfachlehrerspezielleteile:LET +eingangsmaske="ms teilstdpl fach lehrer",maskenanfpos=2,spaltentrenner=":", +niltext="",blank=" ",komma=",",null=0,ueberschriftenzeilen=2,ausgkopflaenge=2 +,ausgfeldlaenge=1,anzahlderobjekteprobildschirm=17,spalte1fach=4, +spalte2paraphe=6,spalte3art=3,spalte4lvs=59,mnrgewaehltezeitenfalsch=397, +mnrkeinestdplandatenvorhanden=366,mnrauswahlnichtsinnvoll=56, +mnrbearbeitetwerden=352;TEXT VAR spaltenstrich,stdplfachlehreruebbild, +stdplfachlehreruebdruck1:= +"Übersicht über Lehrbefähigte und ihren Stundenplan zu bestimmten Zeiten", +stdplfachlehreruebdruck2,spaltenueberschrift,anfbuchstabe,neueranfbuchstabe:= +"",teiltextmeldung1:="die Fächer mit Anfangsbuchstaben: ",teiltextmeldung2:= +"das Fach: ",angegebenesfach,fach,altesfach,paraphe,art,lehrveranstaltung, +schuljahr,halbjahr,sjhjaufber;INT VAR status,index:=dnrlehrbefaehigungen, +eingabestatus,lesestart,bildanfang,druckzeilenzahl,zeit,zaehler;LET +maxanzahlzeiten=6;ROW maxanzahlzeitenINT VAR zeiten;BOOL VAR +geplantessjgewaehlt,mitscanner,bestfachgewaehlt;LET AUSGFELD =ROW +ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld; +AUSGKOPF VAR ausgkopf;BOOL PROC multistop:BOOL VAR a;IF bestfachgewaehltTHEN +a:=wert(fnrlbfach)=angegebenesfachAND dbstatus=okELSE a:=dbstatus=0FI ;aEND +PROC multistop;BOOL PROC multistopsim:setzebestandende(FALSE );BOOL VAR b:= +multistop;setzebestandende(NOT b);bEND PROC multistopsim;PROC +stdplfachlehrerspezielleteile(INT CONST nr):SELECT nrOF CASE 1: +stdplfachlehrerdialogvorbereitenCASE 2:stdplfachlehrereingabenrichtigCASE 3: +stdplfachlehrerlistenvorbereitenCASE 4:stdplfachlehrerdruckvorbereitenCASE 5: +stdplfachlehrerseitedruckenCASE 6:stdplfachlehrerbildschirmvorbereitenCASE 7: +stdplfachlehrerseitezeigenENDSELECT .END PROC stdplfachlehrerspezielleteile; +PROC stdplfachlehrerdialogvorbereiten:stdplfachlehreruebbild:=text( +vergleichsknoten);setzeanfangswerte(eingangsmaske,maskenanfpos);END PROC +stdplfachlehrerdialogvorbereiten;PROC stdplfachlehrereingabenrichtig:LET +fnrfach=2,fnrakthj=69,fnrgeplhj=70,fnrausgbild=71,fnrausgdruck=72; +standardpruefe(5,fnrausgbild,fnrausgdruck,null,niltext,status);IF status<>0 +THEN infeld(status);setzeeingabetest(FALSE )ELSE standardpruefe(5,fnrakthj, +fnrgeplhj,null,niltext,status);IF status<>0THEN infeld(status); +setzeeingabetest(FALSE )ELSE IF NOT anzahldergewaehltenzeitenkorrektTHEN +infeld(3);standardmeldung(mnrgewaehltezeitenfalsch,niltext);setzeeingabetest( +FALSE )ELSE spaltenstrich:="----+------+---+";spaltenstrichCAT zeit* +"--------+";parametersetzen;IF NOT stundenplandatenvorhandenTHEN infeld( +fnrakthj);standardmeldung(mnrkeinestdplandatenvorhanden,niltext); +setzeeingabetest(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld( +fnrausgbild)=niltext);setzeeingabetest(TRUE )FI ;FI ;FI ;FI . +anzahldergewaehltenzeitenkorrekt:INT VAR unterrichtsstd,std;zeit:=0; +spaltenueberschrift:="Fach Lehrer Art ";FOR stdFROM 3UPTO 68REP IF +standardmaskenfeld(std)<>niltextTHEN zeitINCR 1;IF zeit<=maxanzahlzeitenTHEN +unterrichtsstd:=std-2;zeiten(zeit):=unterrichtsstd; +spaltenueberschriftweiterzusammenbauen(unterrichtsstd);FI ;FI ;PER ;zeit<= +maxanzahlzeitenAND zeit>0.parametersetzen:angegebenesfach:=standardmaskenfeld +(fnrfach);bestfachgewaehlt:=angegebenesfach<>niltext;mitscanner:= +bestfachgewaehlt;geplantessjgewaehlt:=standardmaskenfeld(fnrakthj)=niltext; +schuljahr:=schulkenndatum("Schuljahr");halbjahr:=schulkenndatum( +"Schulhalbjahr");IF geplantessjgewaehltTHEN geplanteshjundsjberechnen( +halbjahr,schuljahr);FI ;sjhjaufber:=subtext(schuljahr,1,2)+"/";sjhjaufberCAT +subtext(schuljahr,3,4)+komma+blank;sjhjaufberCAT halbjahr;. +stundenplandatenvorhanden:stundenplanhalbjahrsetzen(halbjahr,schuljahr); +stundenplanbasisundstundenplanholen(eingabestatus);eingabestatus=0END PROC +stdplfachlehrereingabenrichtig;PROC spaltenueberschriftweiterzusammenbauen( +INT VAR unterrichtsstd):INT VAR x;TEXT VAR hilfstext;x:=(unterrichtsstd-1) +DIV 12;IF x=0THEN hilfstext:="Mo "ELIF x=1THEN hilfstext:="Di "ELIF x=2THEN +hilfstext:="Mi "ELIF x=3THEN hilfstext:="Do "ELIF x=4THEN hilfstext:="Fr " +ELSE hilfstext:="Sa "FI ;x:=unterrichtsstdMOD 12;IF x=0THEN hilfstextCAT +"12 "ELSE hilfstextCAT text(x,2)+4*blankFI ;spaltenueberschriftCAT +hilfstext;END PROC spaltenueberschriftweiterzusammenbauen;PROC +stdplfachlehrerlistenvorbereiten:BOOL VAR b;altesfach:=niltext;inittupel( +dnrlehrbefaehigungen);initspalten;setzeidentiwert("");initobli( +anzahlderobjekteprobildschirm);putwert(fnrlbfach,angegebenesfach);IF +bestfachgewaehltTHEN objektlistestarten(index,angegebenesfach,fnrlbparaphe, +TRUE ,b)ELSE objektlistestarten(index,angegebenesfach,0,TRUE ,b);FI ; +setzebestandende(NOT multistopCOR b);END PROC +stdplfachlehrerlistenvorbereiten;PROC stdplfachlehrerbildschirmvorbereiten: +LET fnrausganf=2;standardkopfmaskeaktualisieren(stdplfachlehreruebbild); +bildanfang:=fnrausganf;setzebildanfangsposition(bildanfang); +setzespaltenbreite(bildbreite);spaltenweise(spaltenueberschrift);ausgfeld(1) +:=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;spaltenweise( +spaltenstrich);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos; +erhoeheausgabeposumeins;setzebildanfangsposition(4);spaltenbreitensetzen;END +PROC stdplfachlehrerbildschirmvorbereiten;PROC spaltenbreitensetzen: +initspalten;setzespaltentrenner(spaltentrenner);setzespaltenbreite( +spalte1fach);setzespaltenbreite(spalte2paraphe);setzespaltenbreite(spalte3art +);setzespaltenbreite(spalte4lvs);END PROC spaltenbreitensetzen;PROC +stdplfachlehrerseitezeigen:altesfach:=niltext;blaettern(PROC (INT CONST ) +teilstdplfachlehrerzeigen,aktion,TRUE ,mitscanner,BOOL PROC multistop);END +PROC stdplfachlehrerseitezeigen;PROC teilstdplfachlehrerzeigen(INT CONST x): +datenauslehrbefundstdplholen;datenauslehrbefundstdplaufbereitenbild; +datenauslehrbefundstdplaufbildschirmEND PROC teilstdplfachlehrerzeigen;PROC +datenauslehrbefundstdplholen:TEXT VAR lv,raum,par;lehrveranstaltung:=niltext; +paraphe:=wert(fnrlbparaphe);art:=wert(fnrlbart);fach:=wert(fnrlbfach);FOR +zaehlerFROM 1UPTO zeitREP planeintraglesen(zeiten(zaehler),"P",paraphe,lv, +raum,par);lehrveranstaltungCAT text(lv,8)+spaltentrennerPER ;END PROC +datenauslehrbefundstdplholen;PROC datenauslehrbefundstdplaufbereitenbild:IF +altesfach<>fachTHEN spaltenweise(fach);altesfach:=fach;ELSE spaltenweise( +blank);FI ;spaltenweise(paraphe);spaltenweise(art);spaltenweise( +lehrveranstaltung)END PROC datenauslehrbefundstdplaufbereitenbild;PROC +datenauslehrbefundstdplaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaenge +REP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ; +END PROC datenauslehrbefundstdplaufbildschirm;PROC +stdplfachlehrerdruckvorbereiten:setzebestandende(FALSE );anfbuchstabe:=" "; +druckvorbereiten;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)- +ausgkopflaenge;stdplfachlehreruebdruck2:="Schulhalbjahr "; +stdplfachlehreruebdruck2CAT sjhjaufber;stdplfachlehreruebdruck2CAT +". Halbjahr";initdruckkopf(stdplfachlehreruebdruck1,stdplfachlehreruebdruck2) +;inittupel(index);putwert(fnrlbfach,angegebenesfach);lesenvorbereitendruck( +PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC multistop); +setzebestandende(NOT multistop)END PROC stdplfachlehrerdruckvorbereiten;PROC +stdplfachlehrerseitedrucken:druckkopfschreiben;initspalten;setzespaltenbreite +(bildbreite);spaltenweise(spaltenueberschrift);ausgfeld(1):=zeile;ausgfeld(1) +IN ausgabepos;druckzeileschreiben(ausgfeld(1));spaltenweise(spaltenstrich); +ausgfeld(1):=zeile;druckzeileschreiben(ausgfeld(1));spaltenbreitensetzen; +altesfach:=niltext;seitedrucken(PROC (INT VAR )stdplfachlehrerdrucken, +druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel;END +PROC stdplfachlehrerseitedrucken;PROC stdplfachlehrerdrucken(INT VAR +zeilenzaehler):LET markiert="#";datenauslehrbefundstdplholen; +ggflmeldunganfbuchstabe;stdplfachlehreraufbereitendruck;zeilenzaehlerINCR +ausgfeldlaenge;stdplfachlehrerindruckdatei.ggflmeldunganfbuchstabe:IF +anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert: +neueranfbuchstabe:=fachSUB 1;anfbuchstabe<>neueranfbuchstabe. +meldunganfbuchstabe:IF bestfachgewaehltTHEN standardmeldung( +mnrbearbeitetwerden,teiltextmeldung2+fach+markiert);ELSE standardmeldung( +mnrbearbeitetwerden,teiltextmeldung1+neueranfbuchstabe+markiert);FI ; +anfbuchstabe:=neueranfbuchstabeEND PROC stdplfachlehrerdrucken;PROC +stdplfachlehreraufbereitendruck:datenauslehrbefundstdplaufbereitenbild; +ausgfeld(1):=zeile;END PROC stdplfachlehreraufbereitendruck;PROC +stdplfachlehrerindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP +druckzeileschreiben(ausgfeld(1))PER .END PROC stdplfachlehrerindruckdatei; +END PACKET teilstdplfachlehrer + diff --git a/app/schulis/2.2.1/src/4.uv und kopplungen bearbeiten b/app/schulis/2.2.1/src/4.uv und kopplungen bearbeiten new file mode 100644 index 0000000..2733d0d --- /dev/null +++ b/app/schulis/2.2.1/src/4.uv und kopplungen bearbeiten @@ -0,0 +1,319 @@ +PACKET uvundkopplungenbearbeitenDEFINES uvukstdvproc,uvukspeichern,uvuklisten +,uvukvorjparaphe,uvukpruefbearb:LET ausknr=746,auskende="*",ra="c02 raeume", +sj="Schuljahr",hj="Schulhalbjahr",eingmaske="ms eing uv und kopplungen", +bearbmaske="ms bearb uv und kopplungen",kennzeichnungakt="aktuell", +kennzeichnunggepl="geplant",ausgparam="#",leereparaphe="",trenner="�",bearbzl +=18,letztesfld=163,anzeingfld=10,laengekopplung=8,laengejgst=2,laengefach=2, +krlvjgst=2,fldjgst=3,krlvfa=4,fldfa=5,krlvkopp=6,fldkopp=7,krlvpar=8,fldpar=9 +,fldjahr=10,meldg0=56,meldg1=325,meldg2=326,meldg3=69,meldg4=60,meldg6=305, +meldg7=355,meldg8=353,meldg9=354,meldg11=149,meldg12=142,meldg13=50,meldg14= +63,meldg15=327,meldg16=328,meldg17=329,meldg18=360,meldg19=318,meldg20=310, +meldg21=387,meldg22=388,meldg23=352;ROW anzeingfldTEXT VAR eingbs;ROW bearbzl +STRUCT (TEXT kopplg,fakenn,lehrer,ROW 4TEXT klgr,ROW 2TEXT rgr)VAR dbinh;INT +VAR i,k,z,zz,letztepos:=2,index:=0,fall:=0,aktpos,suchpos,anzdbsaetze;INT +VAR aktzeile,jgst,fachsoll,fachist,lehrersoll,lehrerist,lehrerimfach;TEXT +VAR lv,sicherungstupel,allefaecher,fachbez,fachgrbez,fach,paraphe, +lehrbeflehrer,liste;TEXT VAR klgrkatalog,jgstkatalog,rgrkatalog,lehrv:="", +fachkatalog:="",klgrpruefkatalog,parkatalog,sollstdkatalog,aktschgrkatalog, +geplschgrkatalog;TEXT VAR schj,schhj:="0",aktschhj:="0",aktschj:="0", +geplschhj:="0",geplschj:="0",aenderungskennzeichen:="";TEXT VAR plausikopp, +plausipa,plausilv,jgstsugrp,plausijgst;TEXT VAR kopplung,lvfake,lehrer,sgr1, +sgr2,sgr3,sgr4,rgr1,rgr2,maskenkopf;BOOL VAR istfehler:=FALSE , +koppparnichtgeprueft:=TRUE ,saetzeunveraendert:=TRUE ,ohnefehler:=TRUE ;PROC +holeakthj:aktschhj:=schulkenndatum(hj);aktschj:=schulkenndatum(sj);geplschhj +:=aktschhj;geplschj:=aktschj;geplanteshjundsjberechnen(geplschhj,geplschj) +END PROC holeakthj;PROC holeaktdatenpruefung:i:=100;statleseschleife( +dnrfaecher,"","",fnrffach,fnrffach,PROC spezcat);i:=103;statleseschleife( +dnrlehrer,"","",fnrlparaphe,fnrlparaphe,PROC spezcat);END PROC +holeaktdatenpruefung;PROC holeaktdatenspeicherung:i:=101;statleseschleife( +dnrklassengruppen,"","",fnrkgklassengrp,fnrkgklassengrp,PROC spezcat);i:=102; +statleseschleife(dnrraumgruppen,"","",fnrrgraumgrp,fnrrgraumgrp,PROC spezcat) +;i:=104;statleseschleife(dnrschluessel,ra,"",fnrschlsachgebiet, +fnrschlschluessel,PROC spezcat);i:=105;statleseschleife(dnraktschuelergruppen +,"","",fnrsgrpsj,fnrsgrphj,PROC spezcat);i:=106;statleseschleife( +dnraktschuelergruppen,"","",fnrsgrpsj,fnrsgrphj,PROC spezcat);END PROC +holeaktdatenspeicherung;PROC initrows:IF fachkatalog=""THEN fachkatalog:= +trenner;klgrkatalog:=trenner;klgrpruefkatalog:=trenner;jgstkatalog:= +"�5�05�6�06�7�07�8�08�";jgstkatalogCAT "9�09�10�11�12�13�0�00�"; +aktschgrkatalog:=trenner;geplschgrkatalog:=trenner;rgrkatalog:=trenner; +parkatalog:=trenner;sollstdkatalog:=trenner;FOR iFROM 1UPTO anzeingfldREP +eingbs(i):=""PER ;FOR iFROM 1UPTO bearbzlREP dbinh(i).kopplg:="";dbinh(i). +fakenn:="";dbinh(i).lehrer:="";dbinh(i).klgr(1):="";dbinh(i).klgr(2):=""; +dbinh(i).klgr(3):="";dbinh(i).klgr(4):="";dbinh(i).rgr(1):="";dbinh(i).rgr(2) +:="";PER ;FI END PROC initrows;PROC uvukpruefbearb:standardmeldung(meldg3," " +);IF schhj="0"THEN holeakthjFI ;merkeeingsch;istfehler:=FALSE ;gibteskennz; +stellejahrfest;putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj);putintwert( +fnrlvjgst,0);putwert(fnrlvfachkennung,"");search(dnrlehrveranstaltungen, +FALSE );IF dbstatus<>okCAND wert(fnrlvsj)<>schjCAND wert(fnrlvhj)<>schhjTHEN +dateileerFI ;pruefung;erfasstelvausgeben;standardnproc.gibteskennz:letztepos +:=2;IF eingbs(krlvjgst)<>""THEN fall:=2;LEAVE gibteskennzELIF eingbs(krlvfa) +<>""THEN fall:=4;LEAVE gibteskennzELIF eingbs(krlvkopp)<>""THEN fall:=6; +LEAVE gibteskennzELIF eingbs(krlvpar)<>""THEN fall:=8;LEAVE gibteskennzELSE +zurueckmitmeldg(meldg0,1,letztepos,"");LEAVE uvukpruefbearbFI ;IF eingbs(fall ++1)<>""THEN letztepos:=fall+1ELSE letztepos:=fallFI .stellejahrfest:IF eingbs +(fldjahr)=""THEN schhj:=geplschhj;schj:=geplschj;aenderungskennzeichen:= +kennzeichnunggeplELSE schhj:=aktschhj;schj:=aktschj;aenderungskennzeichen:= +kennzeichnungaktFI .pruefung:IF fachkatalog=trennerTHEN holeaktdatenpruefung +FI ;prueferest(fall);IF istfehlerTHEN zurueckmitmeldg(meldg0,1,letztepos,""); +LEAVE uvukpruefbearbFI ;IF fall=2THEN IF eingbs(fldjgst)<>""THEN pruefejgst; +FI ;index:=dnrlehrveranstaltungen;ELIF fall=4THEN pruefedbfld(eingbs(fldfa), +fachkatalog,fldfa);index:=ixlvsjhjkennELIF fall=6THEN pruefekopplungsnr;index +:=ixlvsjhjkopp;ELSE pruefedbfld(eingbs(fldpar),parkatalog,fldpar);index:= +ixlvsjhjparFI ;IF istfehlerTHEN LEAVE uvukpruefbearbFI .pruefekopplungsnr: +putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj);putwert(fnrlvkopplung,eingbs( +fldkopp));search(ixlvsjhjkopp);IF dbstatus=1COR dbstatus=3THEN +koppnichtgefundenFI .koppnichtgefunden:zurueckmitmeldg(meldg1,1,fldkopp,""); +LEAVE uvukpruefbearb.dateileer:zurueckmitmeldg(meldg2,1,letztepos,"");LEAVE +uvukpruefbearb.END PROC uvukpruefbearb;PROC prueferest(INT CONST feldnr):FOR +iFROM 2UPTO feldnr-1REP IF eingbs(i)<>""THEN fehlerFI PER ;FOR iFROM feldnr+2 +UPTO 9REP IF eingbs(i)<>""THEN fehlerFI PER .fehler:istfehler:=TRUE ; +letztepos:=i;LEAVE prueferest.END PROC prueferest;PROC pruefejgst:IF compress +(eingbs(fldjgst))="0"COR eingbs(fldjgst)="00"THEN LEAVE pruefejgstELIF int( +eingbs(fldjgst))>4CAND int(eingbs(fldjgst))<14THEN LEAVE pruefejgstELSE +zurueckmitmeldg(meldg6,1,fldjgst,"");istfehler:=TRUE ;FI .END PROC pruefejgst +;PROC pruefedbfld(TEXT CONST objekt,katalog,INT CONST feld):plausijgst:=text( +standardmaskenfeld(i*9-6),2);IF objekt=""THEN LEAVE pruefedbfldELIF katalog= +jgstkatalogTHEN IF pos(jgstkatalog,trenner+objekt+trenner)=0THEN +pruefeaufschuelergruppeELSE pruefejgstenFI ;ELIF pos(katalog,trenner+objekt+ +trenner)=0THEN istfehler:=TRUE ;IF katalog=fachkatalogTHEN zurueckmitmeldg( +meldg11,1,feld,objekt+"#")ELIF katalog=parkatalogTHEN zurueckmitmeldg(meldg12 +,1,feld,objekt+"#")ELIF katalog=rgrkatalogTHEN zurueckmitmeldg(meldg16,1,feld +,objekt+"#")FI FI .pruefeaufschuelergruppe:IF eingbs(fldjahr)<>""THEN IF pos( +aktschgrkatalog,trenner+text(int(plausijgst))+objekt+trenner)<>0THEN LEAVE +pruefedbfldELSE pruefeaufklgrFI ELIF pos(geplschgrkatalog,trenner+text(int( +plausijgst))+objekt+trenner)<>0THEN LEAVE pruefedbfldELSE pruefeaufklgrFI . +pruefeaufklgr:IF pos(klgrkatalog,trenner+objekt+trenner)>0THEN IF +jgstnichtnullTHEN pruefejgstinklgrFI ELSE istfehler:=TRUE ;zurueckmitmeldg( +meldg15,1,feld,objekt+"#")FI .pruefejgsten:IF int(plausijgst)<>int(objekt) +CAND int(plausijgst)<>0THEN istfehler:=TRUE ;zurueckmitmeldg(meldg9,1,feld, +objekt+"#"+plausijgst+"#");FI .jgstnichtnull:plausijgst<>"00". +pruefejgstinklgr:zz:=0;jgstsugrp:="";zz:=pos(klgrpruefkatalog,trenner+objekt+ +trenner)+length(objekt)+2;jgstsugrp:=subtext(klgrpruefkatalog,zz,pos( +klgrpruefkatalog,trenner,zz)-1);FOR zzFROM 1UPTO length(jgstsugrp)DIV 2REP +IF subtext(jgstsugrp,zz*2-1,zz*2)<>plausijgstTHEN istfehler:=TRUE ; +zurueckmitmeldg(meldg9,1,feld,objekt+"#"+plausijgst+"#");LEAVE pruefedbfldFI +PER ;END PROC pruefedbfld;PROC pruefekopplgpar(TEXT CONST kopp,lv,pa,INT +CONST feldnr):plausikopp:=kopp;plausipa:=pa;plausilv:=lv;pruefeindb; +pruefeaufbs.pruefeindb:istfehler:=FALSE ;inittupel(dnrlehrveranstaltungen); +putwert(fnrlvkopplung,plausikopp);z:=feldnr;statleseschleife(ixlvsjhjkopp, +schj,schhj,fnrlvsj,fnrlvhj,PROC suchekopplungen);IF istfehlerTHEN infeld( +feldnr);LEAVE pruefekopplgparFI .pruefeaufbs:INT VAR z;FOR zFROM 1UPTO i-1 +REP IF plausikopp=standardmaskenfeld(z*9-7)THEN IF plausipa= +standardmaskenfeld(z*9-5)THEN istfehler:=TRUE ;zurueckmitmeldg(meldg8,1, +feldnr,plausipa+"#"+plausikopp+"#"+text(standardmaskenfeld(z*9-6),2)+dbinh(z) +.fakenn+"#");LEAVE pruefekopplgparFI ;FI ;PER ;FOR zFROM i+1UPTO bearbzlREP +IF plausikopp=standardmaskenfeld(z*9-7)THEN IF plausipa=standardmaskenfeld(z* +9-5)THEN istfehler:=TRUE ;zurueckmitmeldg(meldg8,1,feldnr,plausipa+"#"+ +plausikopp+"#"+text(standardmaskenfeld(z*9-6),2)+dbinh(z).fakenn+"#");LEAVE +pruefekopplgparFI ;FI ;PER .END PROC pruefekopplgpar;PROC suchekopplungen( +BOOL VAR b):IF wert(fnrlvsj)=schjCAND wert(fnrlvhj)=schhjCAND wert( +fnrlvkopplung)=plausikoppCAND dbstatus=0THEN ueberpruefeparapheELSE b:=TRUE +FI .ueberpruefeparaphe:IF wert(fnrlvparaphe)=plausipaCAND nichtplausilvTHEN +istfehler:=TRUE ;zurueckmitmeldg(meldg8,1,z,plausipa+"#"+plausikopp+"#"+ +formattext(wert(fnrlvjgst))+wert(fnrlvfachkennung)+"#");b:=TRUE ;LEAVE +suchekopplungenFI .nichtplausilv:formattext(wert(fnrlvjgst))<>text(plausilv,2 +)COR wert(fnrlvfachkennung)<>dbinh(i).fakenn.END PROC suchekopplungen;PROC +zurueckmitmeldg(INT CONST meldg,ruecksprung,feld,TEXT CONST markiert):IF +ruecksprung>0THEN return(ruecksprung)FI ;standardmeldung(meldg,markiert);IF +feld>0THEN infeld(feld)FI END PROC zurueckmitmeldg;PROC uvukstdvproc:initrows +;fachbez:=trenner;fachgrbez:=trenner;gibeingschaus;standardnproc.END PROC +uvukstdvproc;PROC gibeingschaus:standardstartproc(eingmaske);gibeingbsaus; +standardfelderausgeben;infeld(letztepos).gibeingbsaus:FOR iFROM 2UPTO +anzeingfldREP standardmaskenfeld(eingbs(i),i);IF eingbs(i)<>""THEN letztepos +:=iFI PER .END PROC gibeingschaus;PROC erfasstelvausgeben:anzdbsaetze:=0;k:=1 +;pruefobsaetzevorhanden;loeschefelder;maskenkopf:=text(vergleichsknoten)+" "+ +schhj+"."+" "+subtext(schj,1,2)+"/"+subtext(schj,3);standardstartproc( +bearbmaske);standardkopfmaskeaktualisieren(maskenkopf);startebildschirmblock( +index,bearbzl-1);bildschirmblock(PROC gibbearbzeileaus,BOOL PROC (INT CONST ) +pruefung,i);standardfelderausgeben;infeld(2).pruefobsaetzevorhanden:putwert( +fnrlvsj,schj);putwert(fnrlvhj,schhj);putintwert(fnrlvjgst,int(eingbs(fldjgst) +));putwert(fnrlvfachkennung,eingbs(fldfa));putwert(fnrlvkopplung,eingbs( +fldkopp));putwert(fnrlvparaphe,eingbs(fldpar));search(index,FALSE );IF +dbstatus<>okTHEN zurueckmitmeldg(meldg2,1,letztepos,"");LEAVE +erfasstelvausgebenELSE pruefobsatzrichtigFI .pruefobsatzrichtig:IF wert( +fnrlvsj)=schjCAND wert(fnrlvhj)=schhjTHEN IF fall=1CAND eingbs(fldjgst)<>"" +CAND intwert(fnrlvjgst)<>int(eingbs(fldjgst))THEN gibfehlerausELIF fall=2 +CAND eingbs(fldfa)<>""CAND text(wert(fnrlvfachkennung),2)<>eingbs(fldfa)THEN +gibfehlerausELIF fall=3CAND eingbs(fldkopp)<>""CAND wert(fnrlvkopplung)<> +eingbs(fldkopp)THEN gibfehlerausELIF fall=4CAND eingbs(fldpar)<>""CAND wert( +fnrlvparaphe)<>eingbs(fldpar)THEN gibfehlerausFI ELSE gibfehlerausFI . +gibfehleraus:zurueckmitmeldg(meldg2,1,letztepos,"");LEAVE erfasstelvausgeben. +END PROC erfasstelvausgeben;PROC loeschefelder:FOR iFROM 1UPTO bearbzlREP +dbinh(i).kopplg:="";dbinh(i).fakenn:="";dbinh(i).lehrer:="";dbinh(i).klgr(1) +:="";dbinh(i).klgr(2):="";dbinh(i).klgr(3):="";dbinh(i).klgr(4):="";dbinh(i). +rgr(1):="";dbinh(i).rgr(2):="";PER ;FOR iFROM 2UPTO letztesfldREP +standardmaskenfeld("",i)PER .END PROC loeschefelder;PROC gibbearbzeileaus: +kopplung:=wert(fnrlvkopplung);lvfake:=wert(fnrlvfachkennung);lehrer:=wert( +fnrlvparaphe);sgr1:=wert(fnrlvklgrp1);sgr2:=wert(fnrlvklgrp2);sgr3:=wert( +fnrlvklgrp3);sgr4:=wert(fnrlvklgrp4);rgr1:=wert(fnrlvraumgrp1);rgr2:=wert( +fnrlvraumgrp2);merkdbwerte;lehrv:=formattext(wert(fnrlvjgst))+text(lvfake,2)+ +text(subtext(lvfake,3),4)+text(intwert(fnrlvwochenstd),2);standardmaskenfeld( +kopplung,k*9-7);standardmaskenfeld(lehrv,k*9-6);standardmaskenfeld(lehrer,k*9 +-5);standardmaskenfeld(sgr1,k*9-4);standardmaskenfeld(sgr2,k*9-3); +standardmaskenfeld(sgr3,k*9-2);standardmaskenfeld(sgr4,k*9-1); +standardmaskenfeld(rgr1,k*9);standardmaskenfeld(rgr2,k*9+1);IF k"00"THEN LEAVE formattextWITH "0"+jgst +FI ;jgstEND PROC formattext;PROC uvukspeichern(BOOL CONST speichern):IF +speichernTHEN speicherdaten;naechsterbildschirmELSE zurueckmitmeldg(meldg14,0 +,1,"");naechsterbildschirmFI .speicherdaten:saetzeunveraendert:=TRUE ;IF +aktschgrkatalog=trennerTHEN holeaktdatenspeicherungFI ;zurueckmitmeldg( +meldg17,0,1,"");FOR iFROM 1UPTO anzdbsaetzeREP kopplung:=standardmaskenfeld(i +*9-7);lehrer:=standardmaskenfeld(i*9-5);sgr1:=standardmaskenfeld(i*9-4);sgr2 +:=standardmaskenfeld(i*9-3);sgr3:=standardmaskenfeld(i*9-2);sgr4:= +standardmaskenfeld(i*9-1);rgr1:=standardmaskenfeld(i*9);rgr2:= +standardmaskenfeld(i*9+1);IF satzgeaendertTHEN infeld(i*9-7);pruefedaten;FI +PER ;zurueckmitmeldg(meldg13,0,1,"");FOR iFROM 1UPTO anzdbsaetzeREP kopplung +:=standardmaskenfeld(i*9-7);lehrer:=standardmaskenfeld(i*9-5);sgr1:= +standardmaskenfeld(i*9-4);sgr2:=standardmaskenfeld(i*9-3);sgr3:= +standardmaskenfeld(i*9-2);sgr4:=standardmaskenfeld(i*9-1);rgr1:= +standardmaskenfeld(i*9);rgr2:=standardmaskenfeld(i*9+1);IF satzgeaendertTHEN +IF saetzeunveraendertTHEN saetzeunveraendert:=FALSE FI ;infeld(i*9-7); +speicheraenderungenFI PER ;IF NOT saetzeunveraendertTHEN +aenderungsvermerksetzen(aenderungskennzeichen)FI .satzgeaendert:kopplung<> +dbinh(i).kopplgCOR lehrer<>dbinh(i).lehrerCOR sgr1<>dbinh(i).klgr(1)COR sgr2 +<>dbinh(i).klgr(2)COR sgr3<>dbinh(i).klgr(3)COR sgr4<>dbinh(i).klgr(4)COR +rgr1<>dbinh(i).rgr(1)COR rgr2<>dbinh(i).rgr(2).pruefedaten:istfehler:=FALSE ; +koppparnichtgeprueft:=TRUE ;IF kopplung<>dbinh(i).kopplgTHEN +pruefekopplungsnrFI ;IF lehrer<>dbinh(i).lehrerCAND lehrer<>leereparapheTHEN +pruefelehrerFI ;IF sgr1<>dbinh(i).klgr(1)COR sgr2<>dbinh(i).klgr(2)COR sgr3<> +dbinh(i).klgr(3)COR sgr4<>dbinh(i).klgr(4)THEN pruefeklassenFI ;IF rgr1<> +dbinh(i).rgr(1)COR rgr2<>dbinh(i).rgr(2)THEN prueferaeumeFI . +pruefekopplungsnr:IF kopplung=""THEN istfehler:=TRUE ;zurueckmitmeldg(meldg7, +1,i*9-7,"");LEAVE uvukspeichernELIF length(kopplung)>laengekopplungTHEN +istfehler:=TRUE ;zurueckmitmeldg(meldg4,1,i*9-7,"");LEAVE uvukspeichernELSE +koppparnichtgeprueft:=FALSE ;IF lehrer<>leereparapheTHEN pruefekopplgpar( +kopplung,standardmaskenfeld(i*9-6),lehrer,i*9-7);abfragefehlerFI FI . +pruefelehrer:pruefedbfld(lehrer,parkatalog,i*9-5);abfragefehler;IF +koppparnichtgeprueftTHEN pruefekopplgpar(kopplung,standardmaskenfeld(i*9-6), +lehrer,i*9-5);abfragefehlerFI .pruefeklassen:IF sgr1<>dbinh(i).klgr(1)THEN +pruefedbfld(sgr1,jgstkatalog,i*9-4);abfragefehlerFI ;IF sgr2<>dbinh(i).klgr(2 +)THEN pruefedbfld(sgr2,jgstkatalog,i*9-3);abfragefehlerFI ;IF sgr3<>dbinh(i). +klgr(3)THEN pruefedbfld(sgr3,jgstkatalog,i*9-2);abfragefehlerFI ;IF sgr4<> +dbinh(i).klgr(4)THEN pruefedbfld(sgr4,jgstkatalog,i*9-1);abfragefehlerFI . +prueferaeume:pruefedbfld(rgr1,rgrkatalog,i*9);abfragefehler;pruefedbfld(rgr2, +rgrkatalog,i*9+1);abfragefehler.abfragefehler:IF istfehlerTHEN LEAVE +uvukspeichernFI .speicheraenderungen:putwert(fnrlvsj,schj);putwert(fnrlvhj, +schhj);putintwert(fnrlvjgst,int(text(standardmaskenfeld(i*9-6),2)));putwert( +fnrlvfachkennung,dbinh(i).fakenn);search(dnrlehrveranstaltungen,TRUE );IF +dbstatus=0THEN aktualisierenFI .aktualisieren:putwert(fnrlvkopplung,kopplung) +;putwert(fnrlvparaphe,lehrer);putwert(fnrlvklgrp1,sgr1);putwert(fnrlvklgrp2, +sgr2);putwert(fnrlvklgrp3,sgr3);putwert(fnrlvklgrp4,sgr4);putwert( +fnrlvraumgrp1,rgr1);putwert(fnrlvraumgrp2,rgr2);update(dnrlehrveranstaltungen +).naechsterbildschirm:IF anzdbsaetzeokTHEN enter(2)ELSE anzdbsaetze:=0; +standardkopfmaskeaktualisieren(maskenkopf);startebildschirmblock(index, +bearbzl-1);bildschirmblock(PROC gibbearbzeileaus,BOOL PROC (INT CONST ) +pruefung,i);infeld(1);standardfelderausgeben;infeld(2);return(1)FI .END PROC +uvukspeichern;PROC uvuklisten:INT VAR aktfeld:=infeld;WINDOW VAR w:= +startwindow(42,23,77,1);liste:="";standardmeldung(meldg3,"");aktzeile:=( +aktfeld-2)DIV 9+1;jgst:=int(text(standardmaskenfeld(aktzeile*9-6),laengejgst) +);lv:=text(dbinh(aktzeile).fakenn,laengefach);sicherdbposition; +berechnefachdaten;bereitelisteauf;giballelehreraus;listeCAT "*";listeCAT +auskunftstextende;erstelledbposition;IF menuedraussenTHEN reorganizescreenFI +;open(w);auskunfterteilung(liste,w,FALSE );reorganizescreen;setlasteditvalues +;return(1).sicherdbposition:savetupel(index,sicherungstupel);. +erstelledbposition:restoretupel(index,sicherungstupel).berechnefachdaten: +allefaecher:=trenner;inittupel(dnrfaecher);putwert(fnrffach,compress(lv)); +search(dnrfaecher,TRUE );IF dbstatus<>okTHEN standardmeldung(meldg20,""); +return(1);LEAVE uvuklistenELSE IF wert(fnrffachgrp)<>""THEN lv:=text(wert( +fnrffachgrp),laengefach);ermittleanderefaecherELSE allefaecherCAT lv; +allefaecherCAT trenner;FI ;ermittlestdenFI .ermittleanderefaecher:IF fachbez= +trennerTHEN IF records(dnrfaecher)=0.0THEN standardmeldung(meldg21,"");return +(1);LEAVE uvuklistenELSE statleseschleife(dnrfaecher,"","",fnrffach,fnrffach, +PROC faecherholen)FI ;FI ;holallefaecher.holallefaecher:allefaecher:= +allefaecherzu(trenner+lv+trenner).ermittlestden:allestdenberechnen. +bereitelisteauf:listeCAT "Lehrbefähigte mit Stundenzahl:";listeCAT +auskunftstextende;listeCAT " Soll Ist im Fach Rest";listeCAT +auskunftstextende;listeCAT "Fach: ----+----+-------+----";listeCAT +auskunftstextende;listeCAT text(lv,5);listeCAT text(fachsoll,6);listeCAT text +(fachist,5);listeCAT text(fachsoll-fachist,13);listeCAT auskunftstextende; +listeCAT " ";listeCAT auskunftstextende.giballelehreraus:IF fachkatalog= +trennerTHEN holeaktdatenpruefungFI ;lehrbeflehrer:="";inittupel( +dnrlehrbefaehigungen);statleseschleife(dnrlehrbefaehigungen,compress(lv),"", +fnrlbfach,fnrlbparaphe,PROC lehrbeflehrerholen);IF lehrbeflehrer=""THEN +meldungkeinelehrbeflehrerELSE giblehrerausFI .meldungkeinelehrbeflehrer: +standardmeldung(meldg22,lv+ausgparam);return(1);LEAVE uvuklisten.giblehreraus +:suchpos:=1;aktpos:=1;listeCAT "Lehrer:";listeCAT auskunftstextende;WHILE +aktpos>0REP aktpos:=pos(lehrbeflehrer,trenner,suchpos);IF aktpos>0THEN +paraphe:=subtext(lehrbeflehrer,suchpos,aktpos-1);standardmeldung(meldg23, +paraphe+ausgparam);ermittlestdenlehrer;IF ohnefehlerTHEN listeCAT text( +paraphe,5);listeCAT text(lehrersoll,6);listeCAT text(lehrerist,5);listeCAT +text(lehrerimfach,8);listeCAT text(lehrersoll-lehrerist,5);listeCAT +auskunftstextendeFI ;suchpos:=aktpos+1FI ;PER ;infeld(1); +standardfelderausgeben;infeld(aktfeld).END PROC uvuklisten;PROC +ermittlestdenlehrer:lehrersoll:=0;lehrerist:=0;lehrerimfach:=0;ohnefehler:= +TRUE ;ermittlelehrersoll;ermittlelehreristundimfach.ermittlelehrersoll:zz:= +pos(parkatalog,trenner+paraphe+trenner);IF zz>0THEN lehrersoll:=int(( +sollstdkatalogSUB (zz+1))+(sollstdkatalogSUB (zz+2)))ELSE ohnefehler:=FALSE ; +LEAVE ermittlestdenlehrerFI .ermittlelehreristundimfach:inittupel( +dnrlehrveranstaltungen);putwert(fnrlvparaphe,paraphe);statleseschleife( +ixlvsjhjpar,schj,schhj,fnrlvsj,fnrlvhj,PROC holelehrerstden).END PROC +ermittlestdenlehrer;PROC holelehrerstden(BOOL VAR b):TEXT VAR lvfach:=text( +wert(fnrlvfachkennung),laengefach);IF wert(fnrlvsj)<>schjCOR wert(fnrlvhj)<> +schhjCOR wert(fnrlvparaphe)<>parapheTHEN b:=TRUE ELSE IF inallefaecher(lvfach +)THEN lehrerimfachINCR intwert(fnrlvwochenstd)FI ;lehreristINCR intwert( +fnrlvwochenstd)FI END PROC holelehrerstden;BOOL PROC inallefaecher(TEXT +CONST fach):pos(allefaecher,trenner+text(fach,laengefach)+trenner)>0END PROC +inallefaecher;PROC lehrbeflehrerholen(BOOL VAR b):IF dbstatus<>okCOR text( +wert(fnrlbfach),laengefach)<>lvTHEN b:=TRUE ELSE lehrbeflehrerCAT wert( +fnrlbparaphe);lehrbeflehrerCAT trenner;FI END PROC lehrbeflehrerholen;PROC +allestdenberechnen:INT VAR i;fachsoll:=0;fachist:=0;FOR iFROM 1UPTO length( +allefaecher)DIV (laengefach+1)REP fach:=(subtext(allefaecher,(i-1)*( +laengefach+1)+2,i*(laengefach+1)));berechnestdenzufachPER END PROC +allestdenberechnen;PROC berechnestdenzufach:inittupel(dnrlehrveranstaltungen) +;putwert(fnrlvfachkennung,fach);statleseschleife(ixlvsjhjkenn,schj,schhj, +fnrlvsj,fnrlvhj,PROC stdenzufach)END PROC berechnestdenzufach;PROC +stdenzufach(BOOL VAR b):TEXT VAR lvfach:=text(wert(fnrlvfachkennung), +laengefach);INT VAR lvstd;IF wert(fnrlvsj)<>schjCOR wert(fnrlvhj)<>schhjCOR +lvfach>fachTHEN b:=TRUE ELSE IF lvfach=fachTHEN lvstd:=intwert(fnrlvwochenstd +);fachsollINCR lvstd;IF wert(fnrlvparaphe)<>""THEN fachistINCR lvstdFI FI FI +END PROC stdenzufach;TEXT PROC allefaecherzu(TEXT CONST bez):suchpos:=1; +aktpos:=1;WHILE aktpos>0REP aktpos:=pos(fachgrbez,bez,suchpos);IF aktpos>0 +THEN allefaecherCAT (fachbezSUB (aktpos+1));allefaecherCAT (fachbezSUB ( +aktpos+2));allefaecherCAT trenner;suchpos:=aktpos+1;FI PER ;allefaecherEND +PROC allefaecherzu;PROC uvukvorjparaphe:IF aenderungskennzeichen= +kennzeichnungaktTHEN standardmeldung(meldg19,"");return(1)ELSE aktzeile:=( +infeld-2)DIV 9+1;jgst:=int(text(standardmaskenfeld(aktzeile*9-6),laengejgst)) +;lv:=dbinh(aktzeile).fakenn;IF geplschhj="1"CAND jgst=5THEN standardmeldung( +meldg19,"");return(1);LEAVE uvukvorjparapheFI ;suchedbsatzundausgabeFI . +suchedbsatzundausgabe:savetupel(index,sicherungstupel);saveupdateposition( +index);IF index<>dnrlehrveranstaltungenTHEN changeindex;FI ;inittupel( +dnrlehrveranstaltungen);putwert(fnrlvsj,aktschj);putwert(fnrlvhj,aktschhj); +IF aktschhj="2"CAND jgst>5THEN putintwert(fnrlvjgst,jgst-1);ELSE putintwert( +fnrlvjgst,jgst)FI ;putwert(fnrlvfachkennung,lv);search(dnrlehrveranstaltungen +,TRUE );IF dbstatus<>okTHEN standardmeldung(meldg18,"Schulj. "+aktschhj+". "+ +text(aktschj,2)+"/"+subtext(aktschj,3)+" Lv. "+text(jgst)+lv+ausgparam); +return(1);LEAVE uvukvorjparapheELSE standardmaskenfeld(wert(fnrlvparaphe), +aktzeile*9-5);standardfelderausgebenFI ;IF index<>dnrlehrveranstaltungenTHEN +changeindex;FI ;restoreupdateposition(index);restoretupel(index, +sicherungstupel);return(1).END PROC uvukvorjparaphe;PROC faecherholen(BOOL +VAR b):IF dbstatus<>okTHEN b:=TRUE ELSE fachbezCAT text(wert(fnrffach), +laengefach);fachbezCAT trenner;fachgrbezCAT text(wert(fnrffachgrp),laengefach +);fachgrbezCAT trennerFI END PROC faecherholen;PROC spezcat(BOOL VAR b):TEXT +VAR zwsp:="";IF i=100THEN fachkatalogCAT wert(fnrffach)+trenner;ELIF i=101 +THEN jgstsugrp:="";klgrkatalogCAT wert(fnrkgklassengrp)+trenner; +klgrpruefkatalogCAT wert(fnrkgklassengrp)+trenner;jgstsugrp:=wert( +fnrkgschuelergrp);stellejgstzurklgrfest;ELIF i=105THEN IF wert(fnrsgrphj)= +aktschhjCAND dbstatus=okTHEN aktschgrkatalogCAT wert(fnrsgrpjgst)+wert( +fnrsgrpkennung)+trenner;ELIF dbstatus<>okTHEN b:=TRUE FI ELIF i=106THEN IF +wert(fnrsgrphj)=geplschhjCAND dbstatus=okTHEN geplschgrkatalogCAT wert( +fnrsgrpjgst)+wert(fnrsgrpkennung)+trenner;ELIF dbstatus<>okTHEN b:=TRUE FI +ELIF i=102THEN rgrkatalogCAT wert(fnrrgraumgrp)+trenner;ELIF i=103THEN zwsp:= +wert(fnrlparaphe)+trenner;parkatalogCAT zwsp;sollstdkatalogCAT text(wert( +fnrlsollstd),length(zwsp))ELIF i=104THEN IF wert(fnrschlsachgebiet)=raTHEN +rgrkatalogCAT wert(fnrschlschluessel)+trenner;ELIF wert(fnrschlsachgebiet)>ra +THEN b:=TRUE FI FI .stellejgstzurklgrfest:FOR zzFROM 1UPTO length(jgstsugrp) +DIV 6REP klgrpruefkatalogCAT subtext(jgstsugrp,zz*6-5,zz*6-4)PER ; +klgrpruefkatalogCAT trenner.END PROC spezcat;END PACKET +uvundkopplungenbearbeiten; + diff --git a/app/schulis/2.2.1/src/4.vertretungen organisieren b/app/schulis/2.2.1/src/4.vertretungen organisieren new file mode 100644 index 0000000..e0cd6ba --- /dev/null +++ b/app/schulis/2.2.1/src/4.vertretungen organisieren @@ -0,0 +1,318 @@ +PACKET vertretungenorganisierenDEFINES vertretungenorgbearbeiten, +vertretungenorgvertretungsdatenlisten,vertretungenorginlisteblaettern, +vertretungenorgspeichern,vertretungenorglvauflisten, +vertretungenorglvauflisteneinlesen,vertretungenorginlvlisteblaettern, +vertretungenorgangekreuztebearbeiten:LET maskebearb= +"ms vertretungen organisieren",maskeliste="mu objektliste";LET fnrsuchparaphe +=2,fnrstartdatum=3,fnrstartstunde=4,fnrendedatum=5,fnrendestunde=6,fnrparaphe +=2,fnranrechnungart=3,fnrvertretdatum=4,fnrvertrettag=5,fnrvertretstd=6, +fnrvertretlv=7,fnrvertretparaphe=8,fnrtabellenanfang=9;LET +meldnrlistewirdaufbereitet=7,meldnrbittefuellen=52, +meldnrungueltigerschluessel=55,meldnrletzterbehandelt=67,meldnrbittewarten=69 +,meldnrblaetternnichtmoeglich=72,meldnrspeicherungunmoeglich=73, +meldnrzulangevertretungsdauer=157,meldnrdatenwerdengespeichert=301, +meldnrdatenwerdennichtgespeichert=303,meldnrungueltigeparaphe=344, +meldnrstundenplanfehlt=366,meldnrparapheschonzugeteilt=361, +meldnrzweitesdatumkleiner=386,meldnrkeinunterrichtzurzeit=395;LET schuljahr= +"Schuljahr",schulhalbjahr="Schulhalbjahr";LET sachgebietanrechnungskennz= +"c02 anrechnung vertret";LET kennzhell="#";LET kennzfreistunde="f",ankreuzung +="x",fehlanzeige="-",lehrerbelegt="1",trenner="�";LET erstestunde=1, +letztestunde=66,samstagstd=6,stundenprotag=12;LET kennungparaphe="P", +kennunglv="L";LET laengesugruppe=6,laengeparaphe=4,laengelv=8;LET +logbucheintrag="Anw. 4.6.1 Vertretungen eingegeben oder geändert";INT VAR +pruefstatus:=0;INT VAR ifnr;TEXT VAR gueltigeanrechnungskennz:="", +gueltigeparaphen:="";TEXT VAR paraphe,gespeicherteparaphe,startdatum, +startstunde,endedatum,endestunde,aktschuljahr:="",akthalbjahr:="";TEXT VAR +auszeile;TEXT VAR liste:="";TEXT VAR lv,letztebehandeltelv:="", +vertretungsdatum,hinweisfreistunde,hinweisvorherfrei,hinweisnachherfrei, +hinweislehrerinsugruppe,hinweislehrbefaehigung,hinweislehrbefart;INT VAR std, +dauer,erstevertretstd,letztevertretstd,idatum;INT VAR ivertret,maxvertret, +erstevertretaufbildschirm;LET maxvertretaufbildschirm=14;FILE VAR fvertret; +LET namevertretdatei="Liste der Vertretungsmöglichkeiten";INT VAR ilv,maxlv; +ROW letztestundeSTRUCT (INT datum,INT std,TEXT lv)VAR vertret;ROW +letztestundeBOOL VAR listenankreuzung;INT VAR erstelvinliste;INT VAR izeile; +LET maxlistenzeile=18,erstesfeldinliste=2,felderprozeileinliste=2;TEXT VAR +zeitendeslehrers,paraphenzursugruppe,allelvdersugruppe,lehrerderzeitvorher, +lehrerderzeit,lehrerderzeitnachher,freielehrerderzeit,lehrerdesfachs, +lehrbefartdesfachs,sugruppe,sugruppen,zuletztbehandeltesugruppen:="";TEXT +VAR fundlv,fundraum,fundparaphe,suchfach,zuletztbehandeltesfach:="";INT VAR +poslv,posparaphe,posfachlehrer,possugruppe;BOOL VAR vertretungliegtvor, +bearbeitungueberobjektliste;INT VAR fstatusstuplan;PROC +vertretungenorgbearbeiten:eingangspruefung;IF pruefstatus<>0THEN infeld( +pruefstatus);return(1)ELSE standardmeldung(meldnrbittewarten,""); +vertretungsorganisationvorbereiten;IF zuvertretendelvvorhandenTHEN +standardstartproc(maskebearb);bearbeitungueberobjektliste:=FALSE ; +zeigebsmitvertretungsmoeglichkeiten;standardnprocELSE standardmeldung( +meldnrkeinunterrichtzurzeit,"");infeld(fnrstartdatum);return(1)FI FI . +zuvertretendelvvorhanden:ilv<=maxlv.END PROC vertretungenorgbearbeiten;PROC +vertretungsorganisationvorbereiten:zeitendeslehrers:=allezeitenvon( +kennungparaphe,paraphe);idatum:=datum(startdatum);erstevertretstd:=stundezu( +startdatum,startstunde);letztevertretstd:=stundezu(endedatum,endestunde);ilv +:=0;IF erstevertretstd>letztevertretstdTHEN FOR stdFROM erstevertretstdUPTO +letztestundeREP IF (zeitendeslehrersSUB std)=lehrerbelegtTHEN +planeintraglesen(std,kennungparaphe,paraphe,fundlv,fundraum,fundparaphe);ilv +INCR 1;vertret(ilv).datum:=idatum;vertret(ilv).std:=std;vertret(ilv).lv:= +fundlv;FI ;IF (stdMOD stundenprotag)=0THEN idatumINCR 1FI PER ;idatumINCR 2; +erstevertretstd:=erstestunde;FI ;std:=erstevertretstd;WHILE std<= +letztevertretstdREP IF (zeitendeslehrersSUB std)=lehrerbelegtTHEN +planeintraglesen(std,kennungparaphe,paraphe,fundlv,fundraum,fundparaphe);ilv +INCR 1;vertret(ilv).datum:=idatum;vertret(ilv).std:=std;vertret(ilv).lv:= +fundlv;FI ;IF (stdMOD stundenprotag)=0THEN idatumINCR 1FI ;stdINCR 1PER ; +maxlv:=ilv;ilv:=1END PROC vertretungsorganisationvorbereiten;PROC +zeigebsmitvertretungsmoeglichkeiten:lv:=vertret(ilv).lv;std:=vertret(ilv).std +;idatum:=vertret(ilv).datum;vertretungsdatum:=datum(idatum); +standardmaskenfeld(vertretungsdatum,fnrvertretdatum);standardmaskenfeld( +namedestags(tagnummer(vertretungsdatum)),fnrvertrettag);standardmaskenfeld( +stundennummer(std),fnrvertretstd);standardmaskenfeld(lv,fnrvertretlv); +standardmaskenfeld(text(paraphe,laengeparaphe),fnrvertretparaphe); +holemoeglichevertretungenzulv;vertretungliegtvor:=FALSE ;inittupel( +dnrvertretungen);putwert(fnrvdatum,vertretungsdatum);putintwert(fnrvtagstd, +std);search(dnrvertretungen,FALSE );WHILE dbstatus=0AND wert(fnrvdatum)= +vertretungsdatumAND intwert(fnrvtagstd)=stdREP IF compress(wert( +fnrvveranstaltung))=compress(lv)THEN vertretungliegtvor:=TRUE ; +standardmaskenfeld(wert(fnrvparaphe),fnrparaphe);standardmaskenfeld(wert( +fnrvanrechnung),fnranrechnungart);FI ;succ(dnrvertretungen);UNTIL +vertretungliegtvorPER ;IF NOT vertretungliegtvorTHEN standardmaskenfeld("", +fnrparaphe);standardmaskenfeld("",fnranrechnungart);FI ;gespeicherteparaphe:= +standardmaskenfeld(fnrparaphe);infeld(1);standardfelderausgeben;infeld( +fnrparaphe).END PROC zeigebsmitvertretungsmoeglichkeiten;PROC +holemoeglichevertretungenzulv:moeglichevertretungsdatenzusammenstellen; +vertretungsdatenzeigen(1).moeglichevertretungsdatenzusammenstellen:ivertret:= +0;forget(namevertretdatei,quiet);fvertret:=sequentialfile(output, +namevertretdatei);IF (stdMOD stundenprotag)=0THEN lehrerderzeitnachher:=""; +lehrerderzeitvorher:=datenderzeit(std-1,kennungparaphe)ELIF (stdMOD +stundenprotag)=1THEN lehrerderzeitvorher:="";lehrerderzeitnachher:= +datenderzeit(std+1,kennungparaphe)ELSE lehrerderzeitvorher:=datenderzeit(std- +1,kennungparaphe);lehrerderzeitnachher:=datenderzeit(std+1,kennungparaphe)FI +;IF lv<>letztebehandeltelvTHEN letztebehandeltelv:=lv;sugruppen:= +beteiligteschuelergruppen(kennunglv,lv);IF sugruppen<> +zuletztbehandeltesugruppenTHEN zuletztbehandeltesugruppen:=sugruppen; +bestimmedieparaphenzursugruppeFI FI ;freielehrerderzeit:=""; +holeallelehrerdesfachs;inittupel(dnrvertretungen);putwert(fnrvdatum, +vertretungsdatum);putintwert(fnrvtagstd,std);search(dnrvertretungen,FALSE ); +WHILE dbstatus=0AND wert(fnrvdatum)=vertretungsdatumAND intwert(fnrvtagstd)= +stdREP IF wert(fnrvanrechnung)=kennzfreistundeTHEN fundparaphe:=wert( +fnrvparaphe);hinweisfreistunde:=ankreuzung; +weiterehinweisezugefundenerparaphesetzen; +ausgabezeilezugefundenerparapheindateischreibenFI ;succ(dnrvertretungen);PER +;lehrerderzeit:=datenderzeit(std,kennungparaphe);posparaphe:=1;WHILE +posparaphe +zuletztbehandeltesfachTHEN zuletztbehandeltesfach:=suchfach; +holeallelehrerdesfachsganzneuFI .holeallelehrerdesfachsganzneu:lehrerdesfachs +:="";lehrbefartdesfachs:="";dbstatus(0);inittupel(dnrlehrbefaehigungen); +statleseschleife(dnrlehrbefaehigungen,suchfach,suchfach,fnrlbfach,fnrlbfach, +PROC lehrbefaehigunglesen);inittupel(dnrfaecher);putwert(fnrffach,suchfach); +search(dnrfaecher,TRUE );IF dbstatus=0AND wert(fnrffachgrp)<>""THEN suchfach +:=wert(fnrffachgrp);inittupel(dnrlehrbefaehigungen);statleseschleife( +dnrlehrbefaehigungen,suchfach,suchfach,fnrlbfach,fnrlbfach,PROC +lehrbefaehigunglesen);FI ;END PROC holeallelehrerdesfachs;PROC +lehrbefaehigunglesen(BOOL VAR b):IF dbstatus<>0OR suchfach<>wert(fnrlbfach) +THEN b:=TRUE ELSE lehrerdesfachsCAT text(wert(fnrlbparaphe),laengeparaphe); +lehrbefartdesfachsCAT text(wert(fnrlbart),1)FI END PROC lehrbefaehigunglesen; +PROC weiterehinweisezugefundenerparaphesetzen:IF suchpos(lehrerderzeitvorher, +fundparaphe,laengeparaphe)>0THEN hinweisvorherfrei:=ankreuzungELSE +hinweisvorherfrei:=fehlanzeigeFI ;IF suchpos(lehrerderzeitnachher,fundparaphe +,laengeparaphe)>0THEN hinweisnachherfrei:=ankreuzungELSE hinweisnachherfrei:= +fehlanzeigeFI ;IF suchpos(paraphenzursugruppe,fundparaphe,laengeparaphe)>0 +THEN hinweislehrerinsugruppe:=ankreuzungELSE hinweislehrerinsugruppe:= +fehlanzeigeFI ;posfachlehrer:=suchpos(lehrerdesfachs,fundparaphe, +laengeparaphe);IF posfachlehrer>0THEN hinweislehrbefaehigung:=ankreuzung; +hinweislehrbefart:=lehrbefartdeslehrersELSE hinweislehrbefaehigung:= +fehlanzeige;hinweislehrbefart:=" "FI .lehrbefartdeslehrers:lehrbefartdesfachs +SUB ((posfachlehrerDIV laengeparaphe)+1).END PROC +weiterehinweisezugefundenerparaphesetzen;PROC +ausgabezeilezugefundenerparapheindateischreiben:auszeile:=text(fundparaphe, +laengeparaphe);freielehrerderzeitCAT auszeile;auszeileCAT hinweisfreistunde; +auszeileCAT hinweisvorherfrei;auszeileCAT hinweisnachherfrei;auszeileCAT +hinweislehrerinsugruppe;auszeileCAT hinweislehrbefaehigung;auszeileCAT +hinweislehrbefart;putline(fvertret,auszeile);ivertretINCR 1END PROC +ausgabezeilezugefundenerparapheindateischreiben;PROC vertretungsdatenzeigen( +INT CONST abzeile):fvertret:=sequentialfile(modify,namevertretdatei); +erstevertretaufbildschirm:=abzeile;toline(fvertret,abzeile);col(fvertret,1); +ivertret:=1;ifnr:=fnrtabellenanfang;WHILE ivertret<=maxvertretaufbildschirm +REP IF NOT eof(fvertret)THEN readrecord(fvertret,auszeile);standardmaskenfeld +(auszeile,ifnr);down(fvertret)ELSE standardmaskenfeld(" ",ifnr)FI ; +ifnrINCR 1;ivertretINCR 1PER ;END PROC vertretungsdatenzeigen;PROC +vertretungenorgvertretungsdatenlisten:WINDOW VAR w:=startwindow(37,24,77,7); +fundparaphe:=standardmaskenfeld(fnrparaphe);IF parapheungueltigTHEN +standardmeldung(meldnrungueltigeparaphe,"");return(1)ELSE standardmeldung( +meldnrlistewirdaufbereitet,"");bereitelistenausgabeauf;IF menuedraussenTHEN +reorganizescreenFI ;open(w);auskunfterteilung(liste,w,FALSE ); +reorganizescreen;setlasteditvalues;infeld(1);standardfelderausgeben;infeld( +fnrparaphe);return(1)FI .bereitelistenausgabeauf:liste:= +"Vertretungsdaten zu Paraphe ";listeCAT fundparaphe;listeCAT +auskunftstextende;listeCAT "Datum Zeit Art Lehrveranst.";listeCAT +auskunftstextende;inittupel(dnrvertretungen);dbstatus(0);statleseschleife( +ixvpar,fundparaphe,fundparaphe,fnrvparaphe,fnrvparaphe,PROC +vertretdatenzuparapheaufbereiten);listeCAT "*";listeCAT auskunftstextende. +END PROC vertretungenorgvertretungsdatenlisten;PROC +vertretdatenzuparapheaufbereiten(BOOL VAR b):IF dbstatus=0AND wert( +fnrvparaphe)=fundparapheTHEN listeCAT wert(fnrvdatum);listeCAT " ";listeCAT +namedestags(tagnummer(wert(fnrvdatum)));listeCAT " ";listeCAT stundennummer( +intwert(fnrvtagstd));listeCAT ". ";listeCAT text(wert(fnrvanrechnung),2); +listeCAT " ";listeCAT lvaufbereitet;listeCAT auskunftstextendeELSE b:=TRUE +FI .lvaufbereitet:fundlv:=wert(fnrvveranstaltung);subtext(fundlv,1,2)+" "+ +subtext(fundlv,3,4)+" "+subtext(fundlv,5,8).END PROC +vertretdatenzuparapheaufbereiten;PROC vertretungenorginlisteblaettern(BOOL +CONST vor):IF vorTHEN IF erstevertretaufbildschirm+maxvertretaufbildschirm> +maxvertretTHEN standardmeldung(meldnrblaetternnichtmoeglich,"")ELSE +vertretungsdatenzeigen(erstevertretaufbildschirm+maxvertretaufbildschirm)FI +ELSE IF erstevertretaufbildschirm=1THEN standardmeldung( +meldnrblaetternnichtmoeglich,"")ELSE vertretungsdatenzeigen( +erstevertretaufbildschirm-maxvertretaufbildschirm)FI FI ;return(1)END PROC +vertretungenorginlisteblaettern;PROC vertretungenorgspeichern(BOOL CONST +speichern):IF speichernTHEN fundparaphe:=standardmaskenfeld(fnrparaphe);IF +plausifehlerTHEN return(1)ELSE vertretungwieangegebenspeichern;logeintrag( +logbucheintrag);IF dbstatus<>0THEN standardmeldung( +meldnrspeicherungunmoeglich,"");return(1)ELSE naechstelvzeigenoderzurueckFI +FI ELSE standardmeldung(meldnrdatenwerdennichtgespeichert,""); +naechstelvzeigenoderzurueckFI .plausifehler:IF fundparaphe=""THEN +standardmeldung(meldnrbittefuellen,"");infeld(fnrparaphe);TRUE ELIF +parapheungueltigTHEN standardmeldung(meldnrungueltigeparaphe,"");infeld( +fnrparaphe);TRUE ELIF suchpos(freielehrerderzeit,fundparaphe,laengeparaphe)=0 +THEN standardmeldung(meldnrparapheschonzugeteilt,fundparaphe+kennzhell); +infeld(fnrparaphe);TRUE ELIF standardmaskenfeld(fnranrechnungart)= +kennzfreistundeTHEN standardmeldung(meldnrungueltigerschluessel,"");infeld( +fnranrechnungart);TRUE ELIF ungueltigesanrechnungskennz(standardmaskenfeld( +fnranrechnungart))THEN standardmeldung(meldnrungueltigerschluessel,"");infeld +(fnranrechnungart);TRUE ELIF vertretungkannsonichtgespeichertwerdenTHEN +standardmeldung(meldnrparapheschonzugeteilt,fundparaphe+kennzhell);infeld( +fnrparaphe);TRUE ELSE FALSE FI .vertretungkannsonichtgespeichertwerden: +inittupel(dnrvertretungen);putwert(fnrvdatum,vertretungsdatum);putintwert( +fnrvtagstd,std);putwert(fnrvparaphe,fundparaphe);search(dnrvertretungen,TRUE +);IF dbstatus<>0THEN FALSE ELIF wert(fnrvanrechnung)=kennzfreistundeTHEN +delete(dnrvertretungen);FALSE ELIF wert(fnrvveranstaltung)=compress(lv)THEN +FALSE ELSE TRUE FI .vertretungwieangegebenspeichern:standardmeldung( +meldnrdatenwerdengespeichert,"");putwert(fnrvdatum,vertretungsdatum); +putintwert(fnrvtagstd,std);IF gespeicherteparaphe=""THEN putwert(fnrvparaphe, +fundparaphe);putwert(fnrvanrechnung,standardmaskenfeld(fnranrechnungart)); +putwert(fnrvveranstaltung,compress(lv));insert(dnrvertretungen)ELSE putwert( +fnrvparaphe,gespeicherteparaphe);search(dnrvertretungen,TRUE );IF dbstatus=0 +THEN putwert(fnrvparaphe,fundparaphe);putwert(fnrvanrechnung, +standardmaskenfeld(fnranrechnungart));putwert(fnrvveranstaltung,compress(lv)) +;update(dnrvertretungen)FI FI .naechstelvzeigenoderzurueck:IF +bearbeitungueberobjektlisteTHEN naechsteangekreuztelvsetzenELSE ilvINCR 1FI ; +IF ilv>maxlvTHEN standardmeldung(meldnrletzterbehandelt,"");IF +bearbeitungueberobjektlisteTHEN enter(3)ELSE enter(2)FI ELSE +zeigebsmitvertretungsmoeglichkeiten;return(1)FI .naechsteangekreuztelvsetzen: +ilvINCR 1;WHILE NOT listenankreuzung(ilv)REP ilvINCR 1UNTIL ilv>maxlvPER . +END PROC vertretungenorgspeichern;PROC vertretungenorglvauflisten: +eingangspruefung;IF pruefstatus<>0THEN infeld(pruefstatus);return(1)ELSE +vertretungsorganisationvorbereiten;IF zuvertretendelvvorhandenTHEN +bearbeitungueberobjektliste:=TRUE ;standardstartproc(maskeliste); +standardmeldung(meldnrbittewarten,"");initlistenankreuzung;erstelvinliste:=1; +zeigelvinliste;vertretungenorglvauflisteneinlesenELSE standardmeldung( +meldnrkeinunterrichtzurzeit,"");infeld(fnrstartdatum);return(1)FI FI . +zuvertretendelvvorhanden:ilv<=maxlv.initlistenankreuzung:FOR ilvFROM 1UPTO +letztestundeREP listenankreuzung(ilv):=FALSE PER .END PROC +vertretungenorglvauflisten;PROC zeigelvinliste:ifnr:=erstesfeldinliste;ilv:= +erstelvinliste;FOR izeileFROM 1UPTO maxlistenzeileREP IF ilv>maxlvTHEN +zeigeleerzeileELSE zeigelvzeile;ilvINCR 1FI ;ifnrINCR felderprozeileinliste +PER ;infeld(1);standardfelderausgeben;infeld(erstesfeldinliste);. +zeigeleerzeile:feldschutz(ifnr);standardmaskenfeld("",ifnr); +standardmaskenfeld(" ",ifnr+1).zeigelvzeile:feldfrei(ifnr);IF +listenankreuzung(ilv)THEN standardmaskenfeld(ankreuzung,ifnr)ELSE +standardmaskenfeld("",ifnr)FI ;auszeilezusammenbauen;standardmaskenfeld( +auszeile,ifnr+1).auszeilezusammenbauen:auszeile:=datum(vertret(ilv).datum); +auszeileCAT " ";auszeileCAT namedestags(tagnummer(datum(vertret(ilv).datum)) +);auszeileCAT " ";auszeileCAT stundennummer(vertret(ilv).std);auszeileCAT +". ";auszeileCAT " ";auszeileCAT lvaufbereitet.lvaufbereitet:fundlv:= +vertret(ilv).lv;subtext(fundlv,1,2)+" "+subtext(fundlv,3,4)+" "+subtext( +fundlv,5,8).END PROC zeigelvinliste;PROC vertretungenorglvauflisteneinlesen: +infeld(erstesfeldinliste);standardnproc;ilv:=erstelvinliste;ifnr:= +erstesfeldinliste;FOR izeileFROM 1UPTO maxlistenzeileREP IF ilv<=maxlvTHEN +IF standardmaskenfeld(ifnr)<>""THEN listenankreuzung(ilv):=TRUE ELSE +listenankreuzung(ilv):=FALSE FI ;ilvINCR 1FI ;ifnrINCR felderprozeileinliste +PER END PROC vertretungenorglvauflisteneinlesen;PROC +vertretungenorginlvlisteblaettern(BOOL CONST vor):IF vorTHEN IF +erstelvinliste+maxlistenzeile>maxlvTHEN standardmeldung( +meldnrblaetternnichtmoeglich,"")ELSE erstelvinlisteINCR maxlistenzeile; +zeigelvinlisteFI ;return(1)ELSE IF erstelvinliste=1THEN standardmeldung( +meldnrblaetternnichtmoeglich,"")ELSE erstelvinlisteDECR maxlistenzeile; +zeigelvinlisteFI ;return(1)FI END PROC vertretungenorginlvlisteblaettern; +PROC vertretungenorgangekreuztebearbeiten:ilv:=1;WHILE NOT listenankreuzung( +ilv)REP ilvINCR 1UNTIL ilv>maxlvPER ;IF ilv>maxlvTHEN standardmeldung( +meldnrletzterbehandelt,"");enter(2)ELSE standardstartproc(maskebearb); +zeigebsmitvertretungsmoeglichkeiten;standardnprocFI END PROC +vertretungenorgangekreuztebearbeiten;PROC eingangspruefung:IF aktschuljahr="" +THEN aktschuljahr:=schulkenndatum(schuljahr);akthalbjahr:=schulkenndatum( +schulhalbjahr)FI ;stundenplanhalbjahrsetzen(akthalbjahr,aktschuljahr); +stundenplanbasisundstundenplanholen(fstatusstuplan);IF fstatusstuplan<>0AND +fstatusstuplan<>8THEN standardmeldung(meldnrstundenplanfehlt,"");pruefstatus +:=fnrsuchparaphe;LEAVE eingangspruefungFI ;standardpruefe(1,fnrsuchparaphe,0, +0,"",pruefstatus);IF pruefstatus<>0THEN LEAVE eingangspruefungELSE +fundparaphe:=standardmaskenfeld(fnrsuchparaphe);IF gueltigeparaphen=""THEN +holegueltigeparaphenFI ;IF parapheungueltigTHEN standardmeldung( +meldnrungueltigeparaphe,"");pruefstatus:=fnrsuchparaphe;LEAVE +eingangspruefungELSE paraphe:=fundparapheFI ;standardpruefe(6,fnrstartdatum,0 +,0,"",pruefstatus);IF pruefstatus<>0THEN LEAVE eingangspruefungELSE +startdatum:=standardmaskenfeld(fnrstartdatum)FI ;INT VAR ug,og,wochentagnr; +standardpruefe(2,fnrstartstunde,0,0,"",pruefstatus);IF pruefstatus<>0THEN +LEAVE eingangspruefungELSE wochentagnr:=tagnummer(startdatum);IF wochentagnr= +6THEN og:=samstagstdELSE og:=stundenprotagFI ;ug:=erstestunde;standardpruefe( +3,fnrstartstunde,ug,og,"",pruefstatus);IF pruefstatus<>0THEN LEAVE +eingangspruefungELSE startstunde:=standardmaskenfeld(fnrstartstunde)FI FI ; +endedatum:=standardmaskenfeld(fnrendedatum);endestunde:=standardmaskenfeld( +fnrendestunde);IF endedatum=""THEN endedatum:=startdatum;IF endestunde="" +THEN endestunde:=startstunde;LEAVE eingangspruefungELSE standardpruefe(2, +fnrendestunde,0,0,"",pruefstatus);IF pruefstatus<>0THEN LEAVE +eingangspruefungELIF wochentagnr=6THEN og:=samstagstdELSE og:=stundenprotag +FI ;ug:=int(startstunde);standardpruefe(3,fnrendestunde,ug,og,"",pruefstatus) +;IF pruefstatus<>0THEN LEAVE eingangspruefungFI FI ;ELSE standardpruefe(6, +fnrendedatum,0,0,"",pruefstatus);IF pruefstatus<>0THEN LEAVE eingangspruefung +FI ;standardpruefe(2,fnrendestunde,0,0,"",pruefstatus);IF pruefstatus<>0THEN +LEAVE eingangspruefungELSE wochentagnr:=tagnummer(endedatum);IF wochentagnr=6 +THEN og:=samstagstdELSE og:=stundenprotagFI ;ug:=erstestunde;standardpruefe(3 +,fnrendestunde,ug,og,"",pruefstatus);IF pruefstatus<>0THEN LEAVE +eingangspruefungFI ;FI ;dauer:=datum(endedatum)-datum(startdatum);pruefstatus +:=fnrendedatum;IF dauer<0THEN standardmeldung(meldnrzweitesdatumkleiner,""); +LEAVE eingangspruefungELIF dauer=0THEN IF int(endestunde)7THEN standardmeldung(meldnrzulangevertretungsdauer,"");LEAVE +eingangspruefungELIF dauer>6THEN IF int(endestunde)>=int(startstunde)THEN +standardmeldung(meldnrzulangevertretungsdauer,"");LEAVE eingangspruefungFI +FI ;pruefstatus:=0;FI ;FI ;END PROC eingangspruefung;BOOL PROC +parapheungueltig:suchpos(gueltigeparaphen,fundparaphe,laengeparaphe)=0END +PROC parapheungueltig;PROC holegueltigeparaphen:gueltigeparaphen:=""; +inittupel(dnrlehrer);statleseschleife(dnrlehrer,"","",fnrlparaphe,fnrlparaphe +,PROC paraphelesen)END PROC holegueltigeparaphen;PROC paraphelesen(BOOL VAR b +):IF dbstatus<>0THEN b:=TRUE ELSE gueltigeparaphenCAT text(wert(fnrlparaphe), +laengeparaphe)FI END PROC paraphelesen;BOOL PROC ungueltigesanrechnungskennz( +TEXT CONST kennz):IF gueltigeanrechnungskennz=""THEN +holegueltigeanrechnungskennzFI ;pos(gueltigeanrechnungskennz,trenner+kennz+ +trenner)=0END PROC ungueltigesanrechnungskennz;PROC +holegueltigeanrechnungskennz:gueltigeanrechnungskennz:=trenner;inittupel( +dnrschluessel);statleseschleife(dnrschluessel,sachgebietanrechnungskennz,"", +fnrschlsachgebiet,fnrschlschluessel,PROC anrechnungskennzlesen)END PROC +holegueltigeanrechnungskennz;PROC anrechnungskennzlesen(BOOL VAR b):IF +dbstatus<>0COR wert(fnrschlsachgebiet)<>sachgebietanrechnungskennzTHEN b:= +TRUE ELSE gueltigeanrechnungskennzCAT wert(fnrschlschluessel); +gueltigeanrechnungskennzCAT trennerFI END PROC anrechnungskennzlesen;INT +PROC suchpos(TEXT CONST quelle,suchtext,INT CONST laenge):INT VAR findpos:= +pos(quelle,suchtext);WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE +suchposWITH findposELSE findpos:=pos(quelle,suchtext,findpos+1);FI PER ; +findposEND PROC suchpos;TEXT PROC jgstzweistellig(INT CONST intjgst):IF +intjgst=0THEN "00"ELIF intjgst>4AND intjgst<10THEN "0"+text(intjgst)ELSE text +(intjgst)FI END PROC jgstzweistellig;INT PROC tagnummer(TEXT CONST +datumsangabe):(datum(datumsangabe)+5)MOD 7END PROC tagnummer;TEXT PROC +namedestags(INT CONST tagesnummer):SELECT tagesnummerOF CASE 0:"So"CASE 1: +"Mo"CASE 2:"Di"CASE 3:"Mi"CASE 4:"Do"CASE 5:"Fr"CASE 6:"Sa"OTHERWISE ""END +SELECT .END PROC namedestags;TEXT PROC stundennummer(INT CONST istd):IF (istd +MOD stundenprotag)=0THEN text(stundenprotag)ELSE text(istdMOD stundenprotag,2 +)FI END PROC stundennummer;INT PROC stundezu(TEXT CONST angtag,angstd):( +tagnummer(angtag)-1)*stundenprotag+int(angstd)END PROC stundezu;END PACKET +vertretungenorganisieren + diff --git a/app/schulis/2.2.1/src/4.vertretungsdaten bearbeiten b/app/schulis/2.2.1/src/4.vertretungsdaten bearbeiten new file mode 100644 index 0000000..7034ab6 --- /dev/null +++ b/app/schulis/2.2.1/src/4.vertretungsdaten bearbeiten @@ -0,0 +1,279 @@ +PACKET vertretungsdatenbearbeitenDEFINES vertretungsdatenbearbeiteneingang, +vertretungsdatenbearbeitenstart,vertretungsdatenentfernenstart, +vertretungsdatenentfernen,vertretungsdatenzeileeinfuegen, +vertretungsdatenspeichern:LET maskeeingang= +"ms vertretungsdaten bearbeiten eingang";LET maskebearb= +"ms vertretungsdaten bearbeiten";LET fnrauswahlparaphe=2,fnrstartparaphe=3, +fnrauswahldatum=4,fnrstartdatum=5,fnrauswahlentfernen=6,fnrentfernendatum=7; +LET feldanzmaskeeingang=7;ROW feldanzmaskeeingangTEXT VAR feldbs1;LET +felderprozeile=6;LET ersteseingabefeld=2;LET erstestabellenfeld=2;LET +meldnrungueltigerschluessel=55,meldnrungueltigeauswahl=56, +meldnrplausiwirdgeprueft=57,meldnrloeschen=61,meldnrnichtloeschen=62, +meldnrloeschfrage=65,meldnrloeschenmitdatum=83,meldnrvertretunggibtsschon=88, +meldnrdatumfehltzurestangaben=129,meldnrungueltigesdatum=157, +meldnrdatenwerdengespeichert=301,meldnrdatenwerdennichtgespeichert=303, +meldnrletztezeilenichteinfuegen=314,meldnrfalschetastezuankreuz=318, +meldnrfalscheausfuellung=319,meldnrungueltigeparaphe=344;LET +sachgebietanrechnungskennz="c02 anrechnung vertret";LET kennzhell="#";LET +erstesdatum="01.01.00",erstestunde=1,samstagstd=6,stundenprotag=12;LET +trenner="�",punkt=".";LET logbucheintrag= +"Anw. 4.6.2 Vertretungen eingegeben oder geändert";INT VAR zugriff;BOOL VAR +eingangsmaskenfehler:=FALSE ;INT VAR pruefstatus:=0,letztecursorfnr:= +fnrauswahlparaphe;INT VAR aktzeile;INT VAR ifnr;TEXT VAR startparaphe, +startdatum,entfernendatum;TEXT VAR nfparaphe,nfdatum,nftagstd;TEXT VAR +gueltigeanrechnungskennz:="",gueltigeparaphen:="";INT VAR izeile, +anzahlgezeigtezeilen,anzahleingegebenezeilen;LET zeilenanzahl=18;ROW +zeilenanzahlSTRUCT (TEXT datum,TEXT tag,TEXT stunde,TEXT paraphe,TEXT art, +TEXT lv,TEXT tagstd)VAR bszeile;BOOL VAR leerenbszeigen; +initfelderdeseingangsbildschirms;initbszeilepuffer;PROC +vertretungsdatenbearbeiteneingang:standardstartproc(maskeeingang); +wertedeseingangsbildschirmsholen;infeld(fnrauswahlparaphe); +standardfelderausgeben;infeld(letztecursorfnr);standardnprocEND PROC +vertretungsdatenbearbeiteneingang;PROC vertretungsdatenbearbeitenstart: +eingangsbehandlung(1);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return( +1)ELSE wertedeseingangsbildschirmsmerken;zugriffaufvertretungsdatenbestimmen; +erstensatzlesen;standardstartproc(maskebearb);bsfuellen;infeld( +ersteseingabefeld);standardnprocFI .zugriffaufvertretungsdatenbestimmen:IF +standardmaskenfeld(fnrauswahlparaphe)=""THEN zugriff:=dnrvertretungenELSE +zugriff:=ixvparFI .erstensatzlesen:inittupel(dnrvertretungen);IF zugriff= +ixvparTHEN putwert(fnrvparaphe,startparaphe)ELSE putwert(fnrvdatum,startdatum +)FI ;search(zugriff,FALSE );leerenbszeigen:=dbstatus<>ok;IF dbstatus=0THEN +IF zugriff=dnrvertretungenTHEN IF startdatum<>erstesdatumAND startdatum<>wert +(fnrvdatum)THEN pred(zugriff)FI ELIF zugriff=ixvparTHEN IF startparaphe<>"" +AND startparaphe<>wert(fnrvparaphe)THEN pred(zugriff)FI FI FI .END PROC +vertretungsdatenbearbeitenstart;PROC bsfuellen:izeile:=0;IF NOT +leerenbszeigenTHEN startebildschirmblock(zugriff,zeilenanzahl-1); +bildschirmblock(PROC satzmerken,BOOL PROC (INT CONST )satzzubehandeln,0);IF +dbstatus=0THEN succ(zugriff);IF dbstatus<>0THEN inittupel(dnrvertretungen); +FI ELSE inittupel(dnrvertretungen);FI ;merkesatzalsnachfolgerELSE nfdatum:= +erstesdatumFI ;evtlleerzeilenhinzufuegen; +werteausbszeileinstandardfeldersetzen;infeld(1);standardfelderausgeben;. +evtlleerzeilenhinzufuegen:anzahlgezeigtezeilen:=izeile;WHILE izeile< +zeilenanzahlREP izeileINCR 1;bszeile(izeile).datum:="";bszeile(izeile).tag:= +" ";bszeile(izeile).stunde:="";bszeile(izeile).paraphe:="";bszeile(izeile). +art:="";bszeile(izeile).lv:="";bszeile(izeile).tagstd:="";PER . +werteausbszeileinstandardfeldersetzen:ifnr:=erstestabellenfeld;FOR izeile +FROM 1UPTO zeilenanzahlREP standardmaskenfeld(bszeile(izeile).datum,ifnr); +standardmaskenfeld(bszeile(izeile).tag,ifnr+1);standardmaskenfeld(bszeile( +izeile).stunde,ifnr+2);standardmaskenfeld(bszeile(izeile).paraphe,ifnr+3); +standardmaskenfeld(bszeile(izeile).art,ifnr+4);standardmaskenfeld(bszeile( +izeile).lv,ifnr+5);ifnrINCR felderprozeilePER .merkesatzalsnachfolger:nfdatum +:=wert(fnrvdatum);nftagstd:=wert(fnrvtagstd);nfparaphe:=wert(fnrvparaphe). +END PROC bsfuellen;BOOL PROC satzzubehandeln(INT CONST dummynr):IF NOT ( +izeiledatuminmeldungTHEN datuminmeldung:=gelesenesdatum;standardmeldung( +meldnrloeschenmitdatum,datuminmeldung+kennzhell)FI ;succ(dnrvertretungen); +gelesenesdatum:=wert(fnrvdatum)PER END PROC vertretungsdatenentfernen;PROC +vertretungsdatenzeileeinfuegen(BOOL CONST einfuegen):INT VAR erstefnr;IF +einfuegenTHEN zeileeinfuegenELSE zeileloeschenFI ;return(1).zeileeinfuegen: +aktzeile:=bearbeitungszeilezufeld(infeld);IF aktzeile=zeilenanzahlTHEN +standardmeldung(meldnrletztezeilenichteinfuegen,"");LEAVE zeileeinfuegenFI ; +IF bszeile(zeilenanzahl).datum<>""THEN merkeverdraengtensatzalsnachfolgesatz; +anzahlgezeigtezeilen:=zeilenanzahlFI ;FOR izeileFROM zeilenanzahl-1DOWNTO +aktzeile+1REP zeileiminternenpufferverschieben; +wertederzeileaufdembildschirmverschiebenPER ;izeile:=aktzeile+1; +leerzeileschreiben;werteineingefuegterzeilevermerken;neuezeilenausgeben. +merkeverdraengtensatzalsnachfolgesatz:startdatum:=bszeile(zeilenanzahl).datum +;nfdatum:=subtext(startdatum,1,2)+punkt+subtext(startdatum,3,4)+punkt+subtext +(startdatum,5,6);nfparaphe:=bszeile(zeilenanzahl).paraphe;nftagstd:=bszeile( +zeilenanzahl).tagstd.zeileiminternenpufferverschieben:bszeile(izeile+1).datum +:=bszeile(izeile).datum;bszeile(izeile+1).tag:=bszeile(izeile).tag;bszeile( +izeile+1).stunde:=bszeile(izeile).stunde;bszeile(izeile+1).paraphe:=bszeile( +izeile).paraphe;bszeile(izeile+1).art:=bszeile(izeile).art;bszeile(izeile+1). +lv:=bszeile(izeile).lv;bszeile(izeile+1).tagstd:=bszeile(izeile).tagstd;. +wertederzeileaufdembildschirmverschieben:FOR ifnrFROM erstesfeldderzeileUPTO +letztesfeldderzeileREP standardmaskenfeld(standardmaskenfeld(ifnr),ifnr+ +felderprozeile)PER .erstesfeldderzeile:(izeile-1)*felderprozeile+ +erstestabellenfeld.letztesfeldderzeile:erstesfeldderzeile+felderprozeile-1. +werteineingefuegterzeilevermerken:bszeile(izeile).datum:="";bszeile(izeile). +tag:=" ";bszeile(izeile).stunde:="";bszeile(izeile).paraphe:="";bszeile( +izeile).art:="";bszeile(izeile).lv:="";bszeile(izeile).tagstd:="";. +zeileloeschen:izeile:=bearbeitungszeilezufeld(infeld);leerzeileschreiben; +neuezeilenausgeben.leerzeileschreiben:erstefnr:=erstesfeldderzeile; +standardmaskenfeld("",erstefnr);standardmaskenfeld(" ",erstefnr+1);FOR ifnr +FROM erstefnr+2UPTO letztesfeldderzeileREP standardmaskenfeld("",ifnr)PER . +neuezeilenausgeben:infeld(erstefnr);standardfelderausgeben;infeld(erstefnr). +END PROC vertretungsdatenzeileeinfuegen;INT PROC bearbeitungszeilezufeld(INT +CONST feldnr):((feldnr-erstestabellenfeld)DIV felderprozeile)+1END PROC +bearbeitungszeilezufeld;PROC vertretungsdatenspeichern(BOOL CONST speichern): +IF speichernTHEN standardmeldung(meldnrplausiwirdgeprueft,"");plausipruefung +ELSE pruefstatus:=0FI ;IF pruefstatus<>0THEN infeld(pruefstatus);return(1) +ELSE datenspeichern(speichern);IF nachfolgesatzvorhandenTHEN +holewertedesnachfolgersatzes;search(dnrvertretungen,TRUE );IF dbstatus<>0 +THEN search(dnrvertretungen,FALSE )FI ;izeile:=0;IF satzzubehandeln(izeile) +THEN changeindex;leerenbszeigen:=FALSE ;naechstenbildschirmzeigenELSE enter(2 +)FI ELIF letzteeingabezeilegefuelltTHEN leerenbszeigen:=TRUE ; +naechstenbildschirmzeigenELSE enter(2)FI ;FI .nachfolgesatzvorhanden:nfdatum +<>erstesdatum.letzteeingabezeilegefuellt:standardmaskenfeld((zeilenanzahl-1)* +felderprozeile+ersteseingabefeld)<>"".holewertedesnachfolgersatzes:putwert( +fnrvdatum,nfdatum);putwert(fnrvtagstd,nftagstd);putwert(fnrvparaphe,nfparaphe +).naechstenbildschirmzeigen:bsfuellen;infeld(ersteseingabefeld);return(1). +END PROC vertretungsdatenspeichern;PROC datenspeichern(BOOL CONST speichern): +IF speichernTHEN standardmeldung(meldnrdatenwerdengespeichert,""); +datenspeicherungdurchfuehrenELSE standardmeldung( +meldnrdatenwerdennichtgespeichert,"")FI END PROC datenspeichern;PROC +datenspeicherungdurchfuehren:FOR izeileFROM 1UPTO zeilenanzahlREP +holevergleichswerte;IF vertretungseintragloeschenTHEN aenderungszeileanzeigen +;altevertretungloeschenELIF vertretungseintrageinfuegenTHEN +aenderungszeileanzeigen;neuevertretungeinfuegenELIF +vertretungseintragueberschreibenTHEN aenderungszeileanzeigen; +altevertretungupdateFI PER ;logeintrag(logbucheintrag).holevergleichswerte: +INT VAR prueffnr:=datumfnrin(izeile);TEXT VAR pruefdatum:=standardmaskenfeld( +prueffnr);TEXT VAR altesdatum:=bszeile(izeile).datum. +vertretungseintragloeschen:pruefdatum=""CAND altesdatum<>"". +altevertretungloeschen:setzealtesuchwerteindbpuffer;search(dnrvertretungen, +TRUE );IF dbstatus=0THEN delete(dnrvertretungen)FI . +vertretungseintrageinfuegen:pruefdatum<>""CAND altesdatum="". +neuevertretungeinfuegen:setzeneuewerteindbpuffer;insert(dnrvertretungen). +vertretungseintragueberschreiben:NOT (standardmaskenfeld(prueffnr)=bszeile( +izeile).datumCAND standardmaskenfeld(prueffnr+2)=bszeile(izeile).stundeCAND +standardmaskenfeld(prueffnr+3)=bszeile(izeile).parapheCAND standardmaskenfeld +(prueffnr+4)=bszeile(izeile).artCAND standardmaskenfeld(prueffnr+5)=bszeile( +izeile).lv).altevertretungupdate:setzealtesuchwerteindbpuffer;search( +dnrvertretungen,TRUE );setzeneuewerteindbpuffer;update(dnrvertretungen). +setzealtesuchwerteindbpuffer:pruefdatum:=bszeile(izeile).datum;pruefdatum:= +subtext(pruefdatum,1,2)+punkt+subtext(pruefdatum,3,4)+punkt+subtext( +pruefdatum,5,6);putwert(fnrvdatum,pruefdatum);putwert(fnrvtagstd,bszeile( +izeile).tagstd);putwert(fnrvparaphe,bszeile(izeile).paraphe). +setzeneuewerteindbpuffer:pruefdatum:=standardmaskenfeld(prueffnr);pruefdatum +:=subtext(pruefdatum,1,2)+punkt+subtext(pruefdatum,3,4)+punkt+subtext( +pruefdatum,5,6);putwert(fnrvdatum,pruefdatum);putintwert(fnrvtagstd, +wochenstunde);putwert(fnrvparaphe,standardmaskenfeld(prueffnr+3));putwert( +fnrvanrechnung,standardmaskenfeld(prueffnr+4));putwert(fnrvveranstaltung, +standardmaskenfeld(prueffnr+5));.wochenstunde:(tagnummer(pruefdatum)-1)* +stundenprotag+int(standardmaskenfeld(prueffnr+2)).END PROC +datenspeicherungdurchfuehren;PROC aenderungszeileanzeigen:infeld((izeile-1)* +felderprozeile+ersteseingabefeld)END PROC aenderungszeileanzeigen;INT PROC +datumfnrin(INT CONST zeilennr):(zeilennr-1)*felderprozeile+ersteseingabefeld +END PROC datumfnrin;INT PROC tagnummer(TEXT CONST datumsangabe):(datum( +datumsangabe)+5)MOD 7END PROC tagnummer;TEXT PROC namedestags(INT CONST +tagesnummer):SELECT tagesnummerOF CASE 0:"So"CASE 1:"Mo"CASE 2:"Di"CASE 3: +"Mi"CASE 4:"Do"CASE 5:"Fr"CASE 6:"Sa"OTHERWISE ""END SELECT .END PROC +namedestags;PROC eingangsbehandlung(INT CONST art):LET bearbeiten=1,entfernen +=2;reinitparsing;eingangsmaskenfehler:=FALSE ;ankreuzfelderpruefen;IF +mehralseineauswahlangekreuztTHEN standardmeldung(meldnrungueltigeauswahl,""); +pruefstatus:=fnrauswahlparaphe;eingangsmaskenfehler:=TRUE ;LEAVE +eingangsbehandlungFI ;IF entfernenpruefungTHEN IF ankreuz1THEN ankreuzfehler( +fnrauswahlparaphe);LEAVE eingangsbehandlungELIF ankreuz2THEN ankreuzfehler( +fnrauswahldatum);LEAVE eingangsbehandlungFI ELIF bearbeitenpruefungTHEN IF +ankreuz3THEN ankreuzfehler(fnrauswahlentfernen);LEAVE eingangsbehandlungFI +FI ;IF bearbeitenpruefungTHEN IF ankreuz1THEN IF standardmaskenfeld( +fnrstartdatum)<>""THEN eintragfehler(fnrstartdatum);LEAVE eingangsbehandlung +ELIF standardmaskenfeld(fnrentfernendatum)<>""THEN eintragfehler( +fnrentfernendatum);LEAVE eingangsbehandlungFI ;startparaphe:= +standardmaskenfeld(fnrstartparaphe);ELIF ankreuz2THEN IF standardmaskenfeld( +fnrstartparaphe)<>""THEN eintragfehler(fnrstartparaphe);LEAVE +eingangsbehandlungELIF standardmaskenfeld(fnrentfernendatum)<>""THEN +eintragfehler(fnrentfernendatum);LEAVE eingangsbehandlungFI ;IF +standardmaskenfeld(fnrstartdatum)=""THEN startdatum:=erstesdatum;ELSE +standardpruefe(6,fnrstartdatum,0,0,"",pruefstatus);IF pruefstatus<>0THEN +eingangsmaskenfehler:=TRUE ;LEAVE eingangsbehandlungELSE startdatum:= +standardmaskenfeld(fnrstartdatum);startdatum:=subtext(startdatum,1,2)+punkt+ +subtext(startdatum,3,4)+punkt+subtext(startdatum,5,6)FI ;FI ;FI ;FI ;IF +entfernenpruefungTHEN IF standardmaskenfeld(fnrstartparaphe)<>""THEN +eintragfehler(fnrstartparaphe);LEAVE eingangsbehandlungELIF +standardmaskenfeld(fnrstartdatum)<>""THEN eintragfehler(fnrstartdatum);LEAVE +eingangsbehandlungFI ;standardpruefe(6,fnrentfernendatum,0,0,"",pruefstatus); +IF pruefstatus<>0THEN eingangsmaskenfehler:=TRUE ELSE entfernendatum:= +standardmaskenfeld(fnrentfernendatum);entfernendatum:=subtext(entfernendatum, +1,2)+punkt+subtext(entfernendatum,3,4)+punkt+subtext(entfernendatum,5,6)FI ; +FI ;.ankreuzfelderpruefen:INT VAR summe:=0;IF ankreuz1THEN summeINCR 1FI ;IF +ankreuz2THEN summeINCR 1FI ;IF ankreuz3THEN summeINCR 1FI . +mehralseineauswahlangekreuzt:summe<>1.ankreuz1:standardmaskenfeld( +fnrauswahlparaphe)<>"".ankreuz2:standardmaskenfeld(fnrauswahldatum)<>"". +ankreuz3:standardmaskenfeld(fnrauswahlentfernen)<>"".bearbeitenpruefung:art= +bearbeiten.entfernenpruefung:art=entfernen.END PROC eingangsbehandlung;PROC +ankreuzfehler(INT CONST fehlerfeld):pruefstatus:=fehlerfeld; +eingangsmaskenfehler:=TRUE ;standardmeldung(meldnrfalschetastezuankreuz,""). +END PROC ankreuzfehler;PROC eintragfehler(INT CONST fehlerfeld):pruefstatus:= +fehlerfeld;eingangsmaskenfehler:=TRUE ;standardmeldung( +meldnrfalscheausfuellung,"").END PROC eintragfehler;PROC plausipruefung: +pruefstatus:=0;vertretungseintraegepruefen;IF eingabefehlerTHEN LEAVE +plausipruefungFI ;datenkonsistenzpruefen;IF eingabefehlerTHEN LEAVE +plausipruefungFI .eingabefehler:pruefstatus<>0.END PROC plausipruefung;PROC +vertretungseintraegepruefen:anzahleingegebenezeilen:=0;IF gueltigeparaphen="" +THEN holegueltigeparaphenFI ;IF gueltigeanrechnungskennz=""THEN +holegueltigeanrechnungskennzFI ;FOR izeileFROM 1UPTO zeilenanzahlREP IF +datumsfehlerTHEN LEAVE vertretungseintraegepruefenFI PER .datumsfehler:INT +VAR prueffnr:=datumfnrin(izeile);TEXT VAR pruefdatum:=standardmaskenfeld( +prueffnr);IF pruefdatumleerTHEN IF eintraginfolgefelderderzeileTHEN +pruefstatus:=prueffnr;standardmeldung(meldnrdatumfehltzurestangaben,"");TRUE +ELSE FALSE FI ELSE standardpruefe(6,prueffnr,0,0,"",pruefstatus);IF +pruefstatus<>0THEN TRUE ELSE pruefdatum:=subtext(pruefdatum,1,2)+punkt+ +subtext(pruefdatum,3,4)+punkt+subtext(pruefdatum,5,6);IF tagnummer(pruefdatum +)=0THEN pruefstatus:=prueffnr;standardmeldung(meldnrungueltigesdatum,""); +TRUE ELIF stundeungueltigTHEN TRUE ELIF parapheungueltigTHEN standardmeldung( +meldnrungueltigeparaphe,"");pruefstatus:=prueffnr+3;TRUE ELIF +anrechnungskennzungueltigTHEN standardmeldung(meldnrungueltigerschluessel,"") +;pruefstatus:=prueffnr+4;TRUE ELSE anzahleingegebenezeilenINCR 1;FALSE FI FI +FI .pruefdatumleer:pruefdatum="".eintraginfolgefelderderzeile: +standardmaskenfeld(prueffnr+2)<>""COR standardmaskenfeld(prueffnr+3)<>""COR +standardmaskenfeld(prueffnr+4)<>""COR standardmaskenfeld(prueffnr+5)<>"". +stundeungueltig:INT VAR ug,og,wochentagnr;standardpruefe(2,prueffnr+2,0,0,"", +pruefstatus);IF pruefstatus<>0THEN TRUE ELSE wochentagnr:=tagnummer( +pruefdatum);IF wochentagnr=6THEN og:=samstagstdELSE og:=stundenprotagFI ;ug:= +erstestunde;standardpruefe(3,prueffnr+2,ug,og,"",pruefstatus);pruefstatus<>0 +FI .parapheungueltig:pos(gueltigeparaphen,trenner+standardmaskenfeld(prueffnr ++3)+trenner)=0.anrechnungskennzungueltig:pos(gueltigeanrechnungskennz,trenner ++standardmaskenfeld(prueffnr+4)+trenner)=0.END PROC +vertretungseintraegepruefen;PROC datenkonsistenzpruefen:FOR izeileFROM 1UPTO +zeilenanzahlREP IF zeileungueltigTHEN pruefstatus:=prueffnr;standardmeldung( +meldnrvertretunggibtsschon,"");LEAVE datenkonsistenzpruefenFI PER . +zeileungueltig:IF leerzeileTHEN FALSE ELIF +zeileistimschluesselunveraendertgebliebenTHEN FALSE ELSE +ergebnisderpruefungzeileschongespeichertFI .leerzeile:INT VAR prueffnr:= +datumfnrin(izeile);TEXT VAR pruefdatum:=standardmaskenfeld(prueffnr); +pruefdatum="".zeileistimschluesselunveraendertgeblieben:standardmaskenfeld( +prueffnr)=bszeile(izeile).datumCAND standardmaskenfeld(prueffnr+2)=bszeile( +izeile).stundeCAND standardmaskenfeld(prueffnr+3)=bszeile(izeile).paraphe. +ergebnisderpruefungzeileschongespeichert:neuewerteindbpuffersetzen;search( +dnrvertretungen,TRUE );dbstatus=0.neuewerteindbpuffersetzen:pruefdatum:= +subtext(pruefdatum,1,2)+punkt+subtext(pruefdatum,3,4)+punkt+subtext( +pruefdatum,5,6);putwert(fnrvdatum,pruefdatum);putintwert(fnrvtagstd, +wochenstunde);putwert(fnrvparaphe,standardmaskenfeld(prueffnr+3)). +wochenstunde:(tagnummer(pruefdatum)-1)*stundenprotag+int(standardmaskenfeld( +prueffnr+2)).END PROC datenkonsistenzpruefen;PROC holegueltigeparaphen: +gueltigeparaphen:=trenner;inittupel(dnrlehrer);statleseschleife(dnrlehrer,"", +"",fnrlparaphe,fnrlparaphe,PROC paraphelesen)END PROC holegueltigeparaphen; +PROC paraphelesen(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE +gueltigeparaphenCAT wert(fnrlparaphe);gueltigeparaphenCAT trennerFI END PROC +paraphelesen;PROC holegueltigeanrechnungskennz:gueltigeanrechnungskennz:= +trenner;inittupel(dnrschluessel);statleseschleife(dnrschluessel, +sachgebietanrechnungskennz,"",fnrschlsachgebiet,fnrschlschluessel,PROC +anrechnungskennzlesen)END PROC holegueltigeanrechnungskennz;PROC +anrechnungskennzlesen(BOOL VAR b):IF dbstatus<>0COR wert(fnrschlsachgebiet)<> +sachgebietanrechnungskennzTHEN b:=TRUE ELSE gueltigeanrechnungskennzCAT wert( +fnrschlschluessel);gueltigeanrechnungskennzCAT trennerFI END PROC +anrechnungskennzlesen;PROC initfelderdeseingangsbildschirms:INT VAR i;FOR i +FROM 1UPTO feldanzmaskeeingangREP feldbs1(i):=""PER END PROC +initfelderdeseingangsbildschirms;PROC wertedeseingangsbildschirmsmerken:INT +VAR i;letztecursorfnr:=infeld;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1( +i):=standardmaskenfeld(i)PER END PROC wertedeseingangsbildschirmsmerken;PROC +wertedeseingangsbildschirmsholen:INT VAR i;FOR iFROM 1UPTO +feldanzmaskeeingangREP standardmaskenfeld(feldbs1(i),i)PER END PROC +wertedeseingangsbildschirmsholen;PROC initbszeilepuffer:FOR izeileFROM 1UPTO +zeilenanzahlREP bszeile(izeile).datum:="";bszeile(izeile).tag:="";bszeile( +izeile).stunde:="";bszeile(izeile).paraphe:="";bszeile(izeile).art:=""; +bszeile(izeile).lv:="";bszeile(izeile).tagstd:="";PER END PROC +initbszeilepuffer;END PACKET vertretungsdatenbearbeiten + diff --git a/app/schulis/2.2.1/src/4.zeitwuensche bearbeiten b/app/schulis/2.2.1/src/4.zeitwuensche bearbeiten new file mode 100644 index 0000000..c52a4a9 --- /dev/null +++ b/app/schulis/2.2.1/src/4.zeitwuensche bearbeiten @@ -0,0 +1,243 @@ +PACKET zeitwuenschebearbeitenDEFINES zeitwuenschebearbeiten, +zeitwuenschekopieren,zeitwuenschespeichern:LET bearbmaske= +"ms zeitwuensche bearb",zulgewichte="�-3�-2�-1�-0�+0�+1�+2�+3�",fldkzlehrer=2 +,fldparaphe=3,fldkzsugrup=4,fldjgst=5,fldkenn=6,fldkzraeume=7,fldraeume=8, +fldkzfaecher=9,fldfaecher=10,fldkzkopp=11,fldkopp=12,fldhjkz=13,bearbfldbez=2 +,bearbfldmo1=3,bearbfldmo12=14,bearbflddi12=26,bearbfldmi12=38,bearbflddo12= +50,bearbfldfr12=62,bearbfldsa6=68,bearbfldutanz=69,bearbfldutgew=70, +bearbfldvmanz=71,bearbfldvmgew=72,bearbfldnmanz=73,bearbfldnmgew=74,posanzut= +1,posgewut=3,posanzvm=4,posgewvm=6,posanznm=7,posgewnm=9,laengeallezeitw=132, +laengejgst=2,laengeparaphe=4,laengefach=2,laengesugrup=6,laengesugrupkenn=4, +laengeraum=4,laengebezfeld=22,meldungwarten=69,meldungobjektunbek=55, +meldungfalschekz=56,meldungkeinelehrer=337,meldungkeinelv=321, +meldungkeinefaecher=68,meldungkeinesugrup=332,meldungkeineraeume=365, +meldungwertfalsch=34,meldungwertfehlt=129,meldungpruefen=329,meldungspeichern +=50,meldungnichtsp=63,trenner="�",leererunbestwunsch=" ", +raumkenndaten="c02 raeume",schuljahr="Schuljahr",halbjahr="Schulhalbjahr", +kennpar="P",kennsugrup="S",kennraum="R",kennfach="F",kennkopp="K",minus="-", +plus="+";INT VAR i;INT VAR prueffeld:=2,fall,objektlaenge:=0,anztage,anzvm, +anznm,dbstatusbeimholen,hjkenn:=-1;TEXT VAR schj:="",schhj:="",hjkennz:="", +startobjekt,allefaecher:=trenner,alleraeume:=trenner,alleparaphen:=trenner, +allesugruppen:=trenner;TEXT VAR bearbfolge:="",bezug,bsbestzw:="",bsunbestzw +:="",dbbestzw:="",dbunbestzw:="";TEXT VAR leererbestwunsch:= +" "+ +" ";LET +logbucheintrag="Anw. 4.1.4 Zeitwünsche Lehrer geändert";PROC +zeitwuenschebearbeiten:standardmeldung(meldungwarten,""); +pruefeingmaskeundsetzewerte;standardstartproc(bearbmaske); +standardkopfmaskeaktualisieren(text(vergleichsknoten)+" "+schhj+"."+" "+text( +schj,2)+"/"+subtext(schj,3));zeitwuenscheausgeben(startobjekt,bezug); +standardnproc.pruefeingmaskeundsetzewerte:hjkennz:=standardmaskenfeld(fldhjkz +);IF (hjkenn=0CAND hjkennz="")COR (hjkenn=1CAND hjkennz<>"")COR hjkenn=-1 +THEN ermittlehalbjahrFI ;IF standardmaskenfeld(fldkzlehrer)<>""THEN fall:= +fldkzlehrer;bezug:=kennpar;IF restleer(fall)THEN startobjekt:= +standardmaskenfeld(fldparaphe);IF startobjekt<>""THEN startobjekt:=text( +startobjekt,laengeparaphe);IF bestandsfehlerTHEN IF alleparaphen<>trenner +THEN standardmeldung(meldungobjektunbek,"");infeld(fall+1);return(1)FI ; +LEAVE zeitwuenschebearbeitenELSE bearbfolge:=subtext(alleparaphen,pos( +alleparaphen,trenner+startobjekt+trenner)+laengeparaphe+2);FI ;ELSE IF +alleparaphen=trennerTHEN holalleparaphenFI ;IF alleparaphen=trennerTHEN +standardmeldung(meldungkeinelehrer,"");infeld(fall+1);return(1);LEAVE +zeitwuenschebearbeitenELSE bearbfolge:=subtext(alleparaphen,laengeparaphe+3); +startobjekt:=subtext(alleparaphen,2,2+laengeparaphe-1)FI ;FI ;objektlaenge:= +laengeparaphe;ELSE standardmeldung(meldungfalschekz,"");infeld(prueffeld); +return(1);LEAVE zeitwuenschebearbeitenFI ELIF standardmaskenfeld(fldkzsugrup) +<>""THEN fall:=fldkzsugrup;bezug:=kennsugrup;IF restleer(fall)THEN +objektlaenge:=laengejgst+laengesugrupkenn;startobjekt:=standardmaskenfeld( +fldjgst);IF startobjekt<>""THEN startobjekt:=jgstaufber(startobjekt); +startobjektCAT text(standardmaskenfeld(fldkenn),laengesugrupkenn);IF +bestandsfehlerTHEN IF allesugruppen<>trennerTHEN standardmeldung( +meldungobjektunbek,"");infeld(fall+1);return(1)FI ;LEAVE +zeitwuenschebearbeitenELSE bearbfolge:=subtext(allesugruppen,pos( +allesugruppen,trenner+startobjekt+trenner)+objektlaenge+2);FI ;ELSE IF +allesugruppen=trennerTHEN holallesugruppen;FI ;IF allesugruppen=trennerTHEN +standardmeldung(meldungobjektunbek,"");infeld(fall+1);return(1);LEAVE +zeitwuenschebearbeitenELSE bearbfolge:=subtext(allesugruppen,laengesugrup+3); +startobjekt:=subtext(allesugruppen,2,2+laengesugrup-1)FI ;FI ;ELSE +standardmeldung(meldungfalschekz,"");infeld(prueffeld);return(1);LEAVE +zeitwuenschebearbeitenFI ELIF standardmaskenfeld(fldkzraeume)<>""THEN fall:= +fldkzraeume;bezug:=kennraum;IF restleer(fall)THEN startobjekt:= +standardmaskenfeld(fldraeume);IF startobjekt<>""THEN startobjekt:=text( +startobjekt,laengeraum);IF bestandsfehlerTHEN IF alleraeume<>trennerTHEN +standardmeldung(meldungobjektunbek,"");infeld(fall+1);return(1)FI ;LEAVE +zeitwuenschebearbeitenELSE bearbfolge:=subtext(alleraeume,pos(alleraeume, +trenner+startobjekt+trenner)+laengeraum+2);FI ;ELSE IF alleraeume=trenner +THEN holalleraeumeFI ;IF alleraeume=trennerTHEN standardmeldung( +meldungkeineraeume,"");infeld(fall+1);return(1);LEAVE zeitwuenschebearbeiten +ELSE bearbfolge:=subtext(alleraeume,laengeraum+3);startobjekt:=subtext( +alleraeume,2,2+laengeraum-1)FI ;FI ;objektlaenge:=laengeraum;ELSE +standardmeldung(meldungfalschekz,"");infeld(prueffeld);return(1);LEAVE +zeitwuenschebearbeitenFI ELIF standardmaskenfeld(fldkzfaecher)<>""THEN fall:= +fldkzfaecher;bezug:=kennfach;IF restleer(fall)THEN startobjekt:= +standardmaskenfeld(fldfaecher);IF startobjekt<>""THEN startobjekt:=text( +startobjekt,laengefach);IF bestandsfehlerTHEN IF allefaecher<>trennerTHEN +standardmeldung(meldungobjektunbek,"");infeld(fall+1);return(1);FI ;LEAVE +zeitwuenschebearbeitenELSE bearbfolge:=subtext(allefaecher,pos(allefaecher, +trenner+startobjekt+trenner)+laengefach+2);FI ;ELSE IF allefaecher=trenner +THEN holallefaecherFI ;IF allefaecher=trennerTHEN standardmeldung( +meldungkeinefaecher,"");infeld(fall+1);return(1);LEAVE zeitwuenschebearbeiten +ELSE bearbfolge:=subtext(allefaecher,laengefach+3);startobjekt:=subtext( +allefaecher,2,2+laengefach-1)FI ;FI ;objektlaenge:=laengefach;ELSE +standardmeldung(meldungfalschekz,"");infeld(prueffeld);return(1);LEAVE +zeitwuenschebearbeitenFI ELIF standardmaskenfeld(fldkzkopp)<>""THEN fall:= +fldkzkopp;bezug:=kennkopp;IF restleer(fall)THEN startobjekt:= +standardmaskenfeld(fldkopp);IF startobjekt<>""THEN IF bestandsfehlerTHEN IF +wert(fnrlvsj)=schjCAND wert(fnrlvhj)=schhjTHEN standardmeldung( +meldungobjektunbek,"");infeld(fall+1);return(1)FI ;LEAVE +zeitwuenschebearbeitenFI ;ELSE holestartobjektFI ;ELSE standardmeldung( +meldungfalschekz,"");infeld(prueffeld);return(1);LEAVE zeitwuenschebearbeiten +FI ELSE standardmeldung(meldungwertfehlt,"");infeld(fldkzlehrer);return(1); +LEAVE zeitwuenschebearbeitenFI .ermittlehalbjahr:allesugruppen:=trenner;schhj +:=schulkenndatum(halbjahr);schj:=schulkenndatum(schuljahr);IF hjkennz=""THEN +geplanteshjundsjberechnen(schhj,schj);hjkenn:=1ELSE hjkenn:=0FI . +holestartobjekt:inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,schj); +putwert(fnrlvhj,schhj);putwert(fnrlvkopplung,"");search(ixlvsjhjkopp,FALSE ); +IF wert(fnrlvsj)=schjCAND wert(fnrlvhj)=schhjCAND dbstatus<2THEN startobjekt +:=wert(fnrlvkopplung)ELSE standardmeldung(meldungkeinelv,"");infeld(fall); +return(1);LEAVE zeitwuenschebearbeitenFI .END PROC zeitwuenschebearbeiten; +PROC zeitwuenscheausgeben(TEXT CONST objekt,bez):IF fall=fldkzlehrerTHEN +standardmaskenfeld(text("Lehrer: "+objekt,laengebezfeld),bearbfldbez)ELIF +fall=fldkzsugrupTHEN standardmaskenfeld(text("Schülergruppe: "+startobjekt, +laengebezfeld),bearbfldbez)ELIF fall=fldkzraeumeTHEN standardmaskenfeld(text( +"Raum: "+objekt,laengebezfeld),bearbfldbez)ELIF fall=fldkzfaecherTHEN +standardmaskenfeld(text("Fach: "+objekt,laengebezfeld),bearbfldbez)ELSE +standardmaskenfeld(text("Kopplung: "+objekt,laengebezfeld),bearbfldbez)FI ; +infeld(1);loeschebildschirm;zeitwunschholen;IF dbstatus=0THEN +zeitwunschausgebenELSE setzedbwerteFI ;standardfelderausgeben;infeld( +bearbfldmo1).loeschebildschirm:FOR iFROM bearbfldmo1UPTO bearbfldnmgewREP +standardmaskenfeld("",i)PER .zeitwunschholen:inittupel(dnrzeitwuensche); +putwert(fnrzwsj,schj);putwert(fnrzwhj,schhj);putwert(fnrzwbezug,bez);putwert( +fnrzwbezugsobjekt,compress(objekt));search(dnrzeitwuensche,TRUE ); +dbstatusbeimholen:=dbstatus.zeitwunschausgeben:dbbestzw:=wert( +fnrzwbestimmtewuensche);dbunbestzw:=wert(fnrzwunbestimmtewuensche); +gibbestwuenscheaus(dbbestzw);gibunbestwuenscheaus(dbunbestzw).setzedbwerte: +dbbestzw:=leererbestwunsch;dbunbestzw:=leererunbestwunsch.END PROC +zeitwuenscheausgeben;PROC gibbestwuenscheaus(TEXT CONST bestwunsch):INT VAR +suchpos:=1;TEXT VAR wunsch:="";WHILE suchpos<>0REP suchpos:=pos(bestwunsch, +minus,suchpos);IF suchpos<>0THEN wunsch:=subtext(bestwunsch,suchpos,suchpos+1 +);standardmaskenfeld(wunsch,suchposDIV 2+3);suchposINCR 1FI ;PER ;suchpos:=1; +WHILE suchpos<>0REP suchpos:=pos(bestwunsch,plus,suchpos);IF suchpos<>0THEN +wunsch:=subtext(bestwunsch,suchpos,suchpos+1);standardmaskenfeld(wunsch, +suchposDIV 2+3);suchposINCR 1FI ;PER .END PROC gibbestwuenscheaus;PROC +gibunbestwuenscheaus(TEXT CONST unbestwunsch):TEXT VAR datum;IF unbestwunsch +<>leererunbestwunschTHEN datum:=unbestwunschSUB posanzut;IF datum<>" "THEN +standardmaskenfeld(datum,bearbfldutanz);FI ;datum:=unbestwunschSUB posgewut; +IF datum<>" "THEN standardmaskenfeld(datum,bearbfldutgew);FI ;datum:= +unbestwunschSUB posanzvm;IF datum<>" "THEN standardmaskenfeld(datum, +bearbfldvmanz)FI ;datum:=unbestwunschSUB posgewvm;IF datum<>" "THEN +standardmaskenfeld(datum,bearbfldvmgew)FI ;datum:=unbestwunschSUB posanznm; +IF datum<>" "THEN standardmaskenfeld(datum,bearbfldnmanz)FI ;datum:= +unbestwunschSUB posgewnm;IF datum<>" "THEN standardmaskenfeld(datum, +bearbfldnmgew)FI ;FI END PROC gibunbestwuenscheaus;BOOL PROC bestandsfehler: +IF fall=fldkzlehrerTHEN pruefparapheELIF fall=fldkzsugrupTHEN pruefsugrup +ELIF fall=fldkzraeumeTHEN pruefraumELIF fall=fldkzfaecherTHEN prueffachELIF +fall=fldkzkoppTHEN pruefkoppELSE FALSE FI .pruefparaphe:IF alleparaphen= +trennerTHEN holalleparaphen;IF alleparaphen=trennerTHEN standardmeldung( +meldungkeinelehrer,"");return(1);LEAVE bestandsfehlerWITH TRUE FI FI ;pos( +alleparaphen,trenner+startobjekt+trenner)=0.pruefsugrup:IF allesugruppen= +trennerTHEN holallesugruppen;IF allesugruppen=trennerTHEN standardmeldung( +meldungkeinesugrup,"");return(1);LEAVE bestandsfehlerWITH TRUE FI FI ;pos( +allesugruppen,trenner+startobjekt+trenner)=0.pruefraum:IF alleraeume=trenner +THEN holalleraeume;IF alleraeume=trennerTHEN standardmeldung( +meldungkeineraeume,"");return(1);LEAVE bestandsfehlerWITH TRUE FI FI ;pos( +alleraeume,trenner+startobjekt+trenner)=0.prueffach:IF allefaecher=trenner +THEN holallefaecher;IF allefaecher=trennerTHEN standardmeldung( +meldungkeinefaecher,"");return(1);LEAVE bestandsfehlerWITH TRUE FI FI ;pos( +allefaecher,trenner+startobjekt+trenner)=0.pruefkopp:inittupel( +dnrlehrveranstaltungen);putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj);putwert( +fnrlvkopplung,startobjekt);search(ixlvsjhjkopp,TRUE );dbstatus<>ok.END PROC +bestandsfehler;PROC holalleparaphen:inittupel(dnrlehrer);statleseschleife( +dnrlehrer,"","",fnrlparaphe,fnrlfamname,PROC lehrer).END PROC holalleparaphen +;PROC holalleraeume:inittupel(dnrschluessel);statleseschleife(dnrschluessel, +raumkenndaten,"",fnrschlsachgebiet,fnrschlschluessel,PROC raeume).END PROC +holalleraeume;PROC holallesugruppen:inittupel(dnraktschuelergruppen); +statleseschleife(dnraktschuelergruppen,schj,schhj,fnrsgrpsj,fnrsgrphj,PROC +sugruppen).END PROC holallesugruppen;PROC holallefaecher:inittupel(dnrfaecher +);statleseschleife(dnrfaecher,"","",fnrffach,fnrffachbez,PROC faecher).END +PROC holallefaecher;PROC lehrer(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE +alleparaphenCAT text(wert(fnrlparaphe),laengeparaphe);alleparaphenCAT trenner +FI END PROC lehrer;PROC sugruppen(BOOL VAR b):IF dbstatus<>0COR wert( +fnrsgrpsj)<>schjCOR wert(fnrsgrphj)<>schhjTHEN b:=TRUE ELSE allesugruppenCAT +jgstaufber(wert(fnrsgrpjgst));allesugruppenCAT text(wert(fnrsgrpkennung), +laengesugrupkenn);allesugruppenCAT trennerFI END PROC sugruppen;PROC raeume( +BOOL VAR b):IF dbstatus<>0COR wert(fnrschlsachgebiet)>raumkenndatenTHEN b:= +TRUE ELSE alleraeumeCAT text(wert(fnrschlschluessel),laengeraum);alleraeume +CAT trennerFI END PROC raeume;PROC faecher(BOOL VAR b):IF dbstatus<>0THEN b:= +TRUE ELSE allefaecherCAT text(wert(fnrffach),laengefach);allefaecherCAT +trennerFI END PROC faecher;BOOL PROC restleer(INT CONST fall):IF fall= +fldkzlehrerTHEN FOR iFROM fldkzsugrupUPTO fldkoppREP IF standardmaskenfeld(i) +<>""THEN prueffeld:=i;LEAVE restleerWITH FALSE FI PER ELIF fall=fldkzsugrup +THEN IF standardmaskenfeld(fldkzlehrer)<>""THEN prueffeld:=fldkzlehrer;LEAVE +restleerWITH FALSE FI ;IF standardmaskenfeld(fldparaphe)<>""THEN prueffeld:= +fldparaphe;LEAVE restleerWITH FALSE FI ;FOR iFROM fldkzraeumeUPTO fldkoppREP +IF standardmaskenfeld(i)<>""THEN prueffeld:=i;LEAVE restleerWITH FALSE FI +PER ELIF fall=fldkzraeumeCOR fall=fldkzfaecherTHEN FOR iFROM fldkzlehrerUPTO +fall-1REP IF standardmaskenfeld(i)<>""THEN prueffeld:=i;LEAVE restleerWITH +FALSE FI PER ;FOR iFROM fall+2UPTO fldkoppREP IF standardmaskenfeld(i)<>"" +THEN prueffeld:=i;LEAVE restleerWITH FALSE FI PER ;ELIF fall=fldkzkoppTHEN +FOR iFROM fldkzlehrerUPTO fldfaecherREP IF standardmaskenfeld(i)<>""THEN +prueffeld:=i;LEAVE restleerWITH FALSE FI PER ;FI ;TRUE END PROC restleer; +PROC zeitwuenschekopieren:INT VAR aktfld:=infeld;TEXT VAR wunsch;IF aktfld>= +bearbfldmo1CAND aktfld<=bearbfldsa6THEN kopierfeldinhaltaufrestzeileFI ; +return(1).kopierfeldinhaltaufrestzeile:wunsch:=standardmaskenfeld(aktfld);IF +aktfld<=bearbfldmo12THEN FOR iFROM aktfldUPTO bearbfldmo12REP +standardmaskenfeld(wunsch,i)PER ELIF aktfld<=bearbflddi12THEN FOR iFROM +aktfldUPTO bearbflddi12REP standardmaskenfeld(wunsch,i)PER ELIF aktfld<= +bearbfldmi12THEN FOR iFROM aktfldUPTO bearbfldmi12REP standardmaskenfeld( +wunsch,i)PER ELIF aktfld<=bearbflddo12THEN FOR iFROM aktfldUPTO bearbflddo12 +REP standardmaskenfeld(wunsch,i)PER ELIF aktfld<=bearbfldfr12THEN FOR iFROM +aktfldUPTO bearbfldfr12REP standardmaskenfeld(wunsch,i)PER ELSE FOR iFROM +aktfldUPTO bearbfldsa6REP standardmaskenfeld(wunsch,i)PER FI ; +standardfelderausgeben;infeld(aktfld).END PROC zeitwuenschekopieren;PROC +zeitwuenschespeichern(BOOL CONST speichern):TEXT VAR zw:="";BOOL VAR +aenderung:=FALSE ;IF speichernTHEN standardmeldung(meldungpruefen,"");anztage +:=0;anzvm:=0;anznm:=0;bsbestzw:="";bsunbestzw:="";FOR iFROM bearbfldmo1UPTO +bearbfldsa6REP zw:=standardmaskenfeld(i);IF zw=""THEN bsbestzwCAT " "ELIF zw +="-0"THEN bsbestzwCAT " "ELIF zw="+0"THEN bsbestzwCAT " "ELSE bsbestzwCAT +zwFI PER ;FOR iFROM bearbfldutanzUPTO bearbfldnmgewREP zw:=standardmaskenfeld +(i);IF length(zw)>1THEN infeld(i);fehlermeldungFI ;IF iMOD 2=0THEN +bearbeitegewichtELSE bearbeiteanzahlFI PER ;IF dbbestzw<>bsbestzwTHEN +aenderung:=TRUE ;pruefebestzwFI ;IF dbunbestzw<>bsunbestzwTHEN aenderung:= +TRUE ;pruefeunbestzwFI ;IF aenderungTHEN standardmeldung(meldungspeichern,"") +;logeintrag(logbucheintrag);datenspeichernFI ;ELSE standardmeldung( +meldungnichtsp,"")FI ;naechsterbildschirm.bearbeitegewicht:IF zw=""THEN +bsunbestzwCAT " "ELSE bsunbestzwCAT "-";bsunbestzwCAT zwFI .bearbeiteanzahl: +IF zw=""THEN bsunbestzwCAT " "ELSE bsunbestzwCAT zwFI .pruefebestzw:i:=1; +WHILE izwTHEN pruefeeintragFI ;iINCR 2PER .pruefeeintrag:IF zw=" "THEN LEAVE +pruefeeintragFI ;IF pos(zulgewichte,trenner+zw+trenner)=0THEN infeld(iDIV 2+3 +);fehlermeldungFI .pruefeunbestzw:IF eingabefalsch(1,1,5)THEN infeld( +bearbfldutanz);fehlermeldungFI ;IF eingabefalsch(4,1,6)THEN infeld( +bearbfldvmanz);fehlermeldungFI ;IF eingabefalsch(7,1,5)THEN infeld( +bearbfldnmanz);fehlermeldungFI ;IF eingabefalsch(3,1,3)THEN infeld( +bearbfldutgew);fehlermeldungFI ;IF eingabefalsch(6,1,3)THEN infeld( +bearbfldvmgew);fehlermeldungFI ;IF eingabefalsch(9,1,3)THEN infeld( +bearbfldnmgew);fehlermeldungFI ;IF anztage+anzvm>6THEN infeld(bearbfldutanz); +fehlermeldungnichtmöglichELIF anztage+anznm>6THEN infeld(bearbfldutanz); +fehlermeldungnichtmöglichELIF anztage*2+anzvm+anznm>11THEN infeld( +bearbfldutanz);fehlermeldungnichtmöglichFI ;FOR iFROM 1UPTO 3REP IF ( +bsunbestzwSUB (i*3-2))=" "CAND (bsunbestzwSUB (i*3))<>" "THEN infeld( +bearbfldutanz+((i-1)*2));fehlermeldungfehlenderwertELIF (bsunbestzwSUB (i*3-2 +))<>" "CAND (bsunbestzwSUB (i*3))=" "THEN infeld(bearbfldutgew+((i-1)*2)); +fehlermeldungfehlenderwertFI PER .fehlermeldungnichtmöglich:return(1); +standardmeldung(meldungfalschekz,"");LEAVE zeitwuenschespeichern. +fehlermeldungfehlenderwert:return(1);standardmeldung(meldungwertfehlt,""); +LEAVE zeitwuenschespeichern.fehlermeldung:return(1);standardmeldung( +meldungwertfalsch,"");LEAVE zeitwuenschespeichern.naechsterbildschirm:IF fall +=fldkzkoppTHEN WHILE wert(fnrlvkopplung)=startobjektCAND dbstatus<>3REP succ( +ixlvsjhjkopp);PER ;IF wert(fnrlvsj)=schjCAND wert(fnrlvhj)=schhjCAND dbstatus +<>3THEN startobjekt:=wert(fnrlvkopplung);zeitwuenscheausgeben(startobjekt, +bezug);return(1)ELSE enter(2)FI ELIF bearbfolge=""THEN enter(2)ELSE +startobjekt:=text(bearbfolge,objektlaenge);bearbfolge:=subtext(bearbfolge, +objektlaenge+2);zeitwuenscheausgeben(startobjekt,bezug);return(1)FI . +datenspeichern:putwert(fnrzwbestimmtewuensche,bsbestzw);putwert( +fnrzwunbestimmtewuensche,bsunbestzw);IF dbstatusbeimholen=0THEN update( +dnrzeitwuensche)ELSE insert(dnrzeitwuensche)FI ;IF dbstatus<>0THEN +fehlermeldungbeimspeichernFI .fehlermeldungbeimspeichern:return(1); +standardmeldung(meldungnichtsp,"");LEAVE zeitwuenschespeichern.END PROC +zeitwuenschespeichern;BOOL PROC eingabefalsch(INT CONST charpos,ugr,ogr): +TEXT VAR datum:=bsunbestzwSUB charpos;INT VAR dat;IF datum=" "THEN FALSE +ELSE dat:=int(datum);IF charpos=1THEN anztage:=datELIF charpos=4THEN anzvm:= +datELIF charpos=7THEN anznm:=datFI ;IF lastconversionokTHEN dat +ogrELSE TRUE FI FI END PROC eingabefalsch;END PACKET zeitwuenschebearbeiten + diff --git a/app/schulis/2.2.1/src/4.zeitwuensche drucken b/app/schulis/2.2.1/src/4.zeitwuensche drucken new file mode 100644 index 0000000..521ab2b --- /dev/null +++ b/app/schulis/2.2.1/src/4.zeitwuensche drucken @@ -0,0 +1,129 @@ +PACKET zeitwuenschedruckenDEFINES zeitwuenschespezielleteile:LET AUSGFELD = +ROW ausgfeldlaengeTEXT ,ausgfeldlaenge=18,zeilenbreite=60,zeilenanzahl=1,sj= +"Schuljahr",hj="Schulhalbjahr",ueberschrzeilen=0,ausgabeparam="#",eingmaske= +"ms liste zeitwuensche",meldungbearb=352,meldungpraez=129,fldsortlehrer=2, +fldsortsugrup=3,fldsortraeume=4,fldsortfaecher=5,fldsortkopplg=6,fldakthj=7, +fldaufdr=9,fldaufbs=8,posanzut=1,posgewut=3,posanzvm=4,posgewvm=6,posanznm=7, +posgewnm=9,ausganzpos=11,ausggewpos=18,minus="-",plus="+",leerzeile=" ", +kennzlehrer="P",kennzsugrup="S",kennzraeume="R",kennzfaecher="F",kennzkoppl= +"K",moeintrag="Mo ",dieintrag="Di ",mieintrag="Mi ",doeintrag="Do ", +freintrag="Fr ",saeintrag="Sa ",anhangl="Lehrer ",anhangs="Schülergruppen " +,anhangr="Räume ",anhangf="Fächer ",anhangk="Kopplungen ",ueberschrift= +"Liste der Zeitwünsche für ",leererunbestwunsch=" ";AUSGFELD VAR +ausgfeld;INT VAR i,status,druckzeilenzahl,fall;TEXT VAR bezug,objekt, +objektbez,druckstrich;TEXT VAR sjahr,hjahr;INT VAR schj,schhj:=0;TEXT VAR +bestwunsch,unbestwunsch,zeitwuenscheueberschrift:="";TEXT VAR bestwzeile, +unbestwtage,unbestwvorm,unbestwnachm,bestwurzeile:= +" _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _"+ +" _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ "+ +" _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ "+ +"_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ";TEXT VAR +moobjeintrag,diobjeintrag,miobjeintrag,doobjeintrag,frobjeintrag,saobjeintrag +;BOOL PROC multistop:dbstatus=okCAND wert(fnrzwbezug)=bezugCAND intwert( +fnrzwhj)=schhjCAND intwert(fnrzwsj)=schjEND PROC multistop;BOOL PROC +multistopsim:IF dbstatus=okTHEN IF intwert(fnrzwhj)=schhjCAND intwert(fnrzwsj +)=schjCAND wert(fnrzwbezug)=bezugTHEN LEAVE multistopsimWITH TRUE ELSE +setzebestandende(TRUE );LEAVE multistopsimWITH FALSE FI ELSE setzebestandende +(TRUE )FI ;FALSE END PROC multistopsim;PROC holeakthj:holakthj;holaktj;IF +standardmaskenfeld(fldakthj)=""THEN bergeplhjujFI .holakthj:hjahr:= +schulkenndatum(hj);schhj:=int(hjahr).holaktj:sjahr:=schulkenndatum(sj);schj:= +int(sjahr).bergeplhjuj:geplanteshjundsjberechnen(hjahr,sjahr);schj:=int(sjahr +);schhj:=int(hjahr).END PROC holeakthj;PROC zeitwuenschespezielleteile(INT +CONST anwahl):SELECT anwahlOF CASE 1:zeitwuenschedialogvorbereitenCASE 2: +zeitwuenscherichtigCASE 3:zeitwuenschelistenvorbereitenCASE 4: +zeitwuenschedruckvorbereitenCASE 5:zeitwuenscheseitedruckenCASE 6: +zeitwuenschebsvorbereitenCASE 7:zeitwuenscheseitezeigenEND SELECT .END PROC +zeitwuenschespezielleteile;PROC zeitwuenschedialogvorbereiten: +setzeanfangswerte(eingmaske,fldsortlehrer)END PROC +zeitwuenschedialogvorbereiten;PROC zeitwuenscherichtig:IF standardmaskenfeld( +fldsortlehrer)=""CAND standardmaskenfeld(fldsortsugrup)=""CAND +standardmaskenfeld(fldsortraeume)=""CAND standardmaskenfeld(fldsortfaecher)= +""CAND standardmaskenfeld(fldsortkopplg)=""THEN standardmeldung(meldungpraez, +"");setzeeingabetest(FALSE );infeld(fldsortlehrer);LEAVE zeitwuenscherichtig +ELIF standardmaskenfeld(fldaufdr)=""CAND standardmaskenfeld(fldaufbs)=""THEN +standardmeldung(meldungpraez,"");setzeeingabetest(FALSE );infeld( +fldsortlehrer);LEAVE zeitwuenscherichtigFI ;standardpruefe(5,fldsortlehrer, +fldsortkopplg,0,"",status);IF status<>0THEN infeld(status);setzeeingabetest( +FALSE )ELSE standardpruefe(5,fldaufdr,fldaufbs,0,"",status);IF status<>0THEN +infeld(status);setzeeingabetest(FALSE )ELSE IF standardmaskenfeld( +fldsortlehrer)<>""THEN fall:=fldsortlehrer;objektbez:=anhangl;bezug:= +kennzlehrerELIF standardmaskenfeld(fldsortsugrup)<>""THEN fall:=fldsortsugrup +;objektbez:=anhangs;bezug:=kennzsugrupELIF standardmaskenfeld(fldsortraeume) +<>""THEN fall:=fldsortraeume;objektbez:=anhangr;bezug:=kennzraeumeELIF +standardmaskenfeld(fldsortfaecher)<>""THEN fall:=fldsortfaecher;objektbez:= +anhangf;bezug:=kennzfaecherELIF standardmaskenfeld(fldsortkopplg)<>""THEN +fall:=fldsortkopplg;objektbez:=anhangk;bezug:=kennzkopplFI ; +setzeausgabedrucker(standardmaskenfeld(fldaufdr)<>"");setzeeingabetest(TRUE ) +;holeakthj;zeitwuenscheueberschrift:=ueberschrift+objektbez+hjahr+". "+text( +sjahr,2)+"/"+subtext(sjahr,3)FI ;FI END PROC zeitwuenscherichtig;PROC +zeitwuenschelistenvorbereiten:BOOL VAR b;inittupel(dnrzeitwuensche);initobli( +zeilenanzahl);setzeidentiwert("");setzewerte;objektlistestarten( +dnrzeitwuensche,sjahr,fnrzwbezugsobjekt,TRUE ,b);setzebestandende(NOT +multistopCOR b).setzewerte:putintwert(fnrzwsj,schj);putintwert(fnrzwhj,schhj) +;putwert(fnrzwbezug,bezug).END PROC zeitwuenschelistenvorbereiten;PROC +zeitwuenschebsvorbereiten:standardkopfmaskeaktualisieren(zentriert( +zeitwuenscheueberschrift,51));setzebildanfangsposition(3)END PROC +zeitwuenschebsvorbereiten;PROC zeitwuenscheseitezeigen:blaettern(PROC (INT +CONST )zeitwuenschezeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop);END PROC +zeitwuenscheseitezeigen;PROC zeitwuenschezeigen(INT CONST procparameter): +zeitwuenscheholen;zeitwuenscheaufbereiten;zeitwuenscheaufbs;END PROC +zeitwuenschezeigen;PROC zeitwuenscheholen:objekt:=wert(fnrzwbezugsobjekt); +bestwunsch:=wert(fnrzwbestimmtewuensche);unbestwunsch:=wert( +fnrzwunbestimmtewuensche);IF NOT multistopTHEN setzebestandende(TRUE )FI . +END PROC zeitwuenscheholen;PROC zeitwuenscheaufbereiten:bereiteobjektauf( +objekt)END PROC zeitwuenscheaufbereiten;PROC zeitwuenscheaufbs:FOR iFROM 1 +UPTO ausgfeldlaengeREP ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsPER +END PROC zeitwuenscheaufbs;PROC zeitwuenschedruckvorbereiten:druckvorbereiten +;variablensetzen;initdruckkopf(zentriert(zeitwuenscheueberschrift,druckbreite +));inittupel(dnrzeitwuensche);setzebestandende(FALSE );setzewerte; +lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL +PROC multistopsim).variablensetzen:druckstrich:=druckbreite*"-"; +druckzeilenzahl:=drucklaenge(ueberschrzeilen).setzewerte:putintwert(fnrzwsj, +schj);putintwert(fnrzwhj,schhj);putwert(fnrzwbezug,bezug).END PROC +zeitwuenschedruckvorbereiten;PROC zeitwuenscheseitedrucken: +zeitwuenscheueberschriftdrucken;seitedrucken(PROC (INT VAR ) +zeitwuenschedrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim); +seitenwechselEND PROC zeitwuenscheseitedrucken;PROC +zeitwuenscheueberschriftdrucken:druckkopfschreibenEND PROC +zeitwuenscheueberschriftdrucken;PROC zeitwuenschedrucken(INT VAR zz): +zeitwuenscheholen;standardmeldung(meldungbearb,objektbez+objekt+ausgabeparam) +;zeitwuenscheaufbereiten(zz);zeitwuenscheindruckdatei(zz)END PROC +zeitwuenschedrucken;PROC zeitwuenscheaufbereiten(INT VAR zz):bereiteobjektauf +(objekt)END PROC zeitwuenscheaufbereiten;PROC zeitwuenscheindruckdatei(INT +VAR zz):FOR iFROM 1UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(i));zz +INCR 1PER ;druckzeileschreiben(leerzeile);zzINCR 1;druckzeileschreiben( +leerzeile);zzINCR 1END PROC zeitwuenscheindruckdatei;PROC bereiteobjektauf( +TEXT CONST objekt):INT VAR suchpos:=1;TEXT VAR wunsch:="";moobjeintrag:= +moeintrag;diobjeintrag:=dieintrag;miobjeintrag:=mieintrag;doobjeintrag:= +doeintrag;frobjeintrag:=freintrag;saobjeintrag:=saeintrag;uebertragwuensche; +ausgfeld(1):=(objekt+":");ausgfeld(2):=leerzeile;ausgfeld(3):=( +"Wünsche zu festen Zeiten:");ausgfeld(4):=(leerzeile);ausgfeld(5):=( +" 1 2 3 4 5 6 7 8 9 10 11 12");ausgfeld(6):=( +moobjeintrag+text(bestwzeile,48));ausgfeld(7):=(diobjeintrag+subtext( +bestwzeile,49,96));ausgfeld(8):=(miobjeintrag+subtext(bestwzeile,97,144)); +ausgfeld(9):=(doobjeintrag+subtext(bestwzeile,145,192));ausgfeld(10):=( +frobjeintrag+subtext(bestwzeile,193,240));ausgfeld(11):=(saobjeintrag+subtext +(bestwzeile,241));ausgfeld(12):=(leerzeile);ausgfeld(13):=( +" allgemeine Wünsche:");ausgfeld(14):=( +" Anzahl/Gewicht ");ausgfeld(15):=("ganze Tage " ++unbestwtage);ausgfeld(16):=("zusätzl. Vorm. "+unbestwvorm);ausgfeld(17):=( +"zusätzl. Nachm. "+unbestwnachm);ausgfeld(18):=(leerzeile).uebertragwuensche: +bestwzeile:=bestwurzeile;unbestwtage:=" _ _ ";unbestwvorm:= +" _ _ ";unbestwnachm:=" _ _ ";tragbestwuenscheein +;tragunbestwuenscheein.tragbestwuenscheein:suchpos:=1;WHILE suchpos<>0REP +suchpos:=pos(bestwunsch,minus,suchpos);IF suchpos<>0THEN wunsch:=subtext( +bestwunsch,suchpos,suchpos+1);replace(bestwzeile,suchpos*2-1,wunsch);suchpos +INCR 1FI ;PER ;suchpos:=1;WHILE suchpos<>0REP suchpos:=pos(bestwunsch,plus, +suchpos);IF suchpos<>0THEN wunsch:=subtext(bestwunsch,suchpos,suchpos+1); +replace(bestwzeile,suchpos*2-1,wunsch);suchposINCR 1FI ;PER . +tragunbestwuenscheein:IF unbestwunsch<>leererunbestwunschTHEN wunsch:= +unbestwunschSUB posanzut;IF wunsch<>" "THEN replace(unbestwtage,ausganzpos, +wunsch)FI ;wunsch:=unbestwunschSUB posgewut;IF wunsch<>" "THEN replace( +unbestwtage,ausggewpos,wunsch)FI ;wunsch:=unbestwunschSUB posanzvm;IF wunsch +<>" "THEN replace(unbestwvorm,ausganzpos,wunsch)FI ;wunsch:=unbestwunschSUB +posgewvm;IF wunsch<>" "THEN replace(unbestwvorm,ausggewpos,wunsch)FI ;wunsch +:=unbestwunschSUB posanznm;IF wunsch<>" "THEN replace(unbestwnachm,ausganzpos +,wunsch)FI ;wunsch:=unbestwunschSUB posgewnm;IF wunsch<>" "THEN replace( +unbestwnachm,ausggewpos,wunsch)FI FI .END PROC bereiteobjektauf;END PACKET +zeitwuenschedrucken + diff --git a/app/schulis/2.2.1/src/5.STATISTIK SERVER.files b/app/schulis/2.2.1/src/5.STATISTIK SERVER.files new file mode 100644 index 0000000..c813089 --- /dev/null +++ b/app/schulis/2.2.1/src/5.STATISTIK SERVER.files @@ -0,0 +1,2 @@ +5.manager + diff --git a/app/schulis/2.2.1/src/5.STATISTIK.files b/app/schulis/2.2.1/src/5.STATISTIK.files new file mode 100644 index 0000000..26554d2 --- /dev/null +++ b/app/schulis/2.2.1/src/5.STATISTIK.files @@ -0,0 +1,9 @@ +5.thesaurus +5.statistik liste +5.merkmale +5.datenbasis +5.erstellen +5.benennen +5.felder +5.drucken + diff --git a/app/schulis/2.2.1/src/5.benennen b/app/schulis/2.2.1/src/5.benennen new file mode 100644 index 0000000..6f67e8a --- /dev/null +++ b/app/schulis/2.2.1/src/5.benennen @@ -0,0 +1,116 @@ +PACKET benennenDEFINES statbenennen:LET statistikdatei="STATISTIK.", +statistikserver="statistik server",maskebenennen="mst statistik benennen", +statistikvorzeilen=3,maxstatistiken=200,maxzeilen=75,maxspalten=50, +minspaltenbreite=4,niltext="",space=" ",meldungzusatz="+",meldungback= +"��������������",alt="alt",meldungrestore=" ",mgibtesnicht=477, +mgibtesschon=485,mspeichern=486,mnichtspeichern=487,mentfernenfrage=488, +mgeloescht=489,mnichtgeloescht=490,fstatnr=2,fbezeichnung=3,fzeilen=4, +fspalten=5,fentfernen=6,pruefeimintervall=3,pruefeobwert=1;TEXT VAR +statistiknummer;FILE VAR stat;PROC statbenennen(INT CONST was):SELECT wasOF +CASE 1:benennenstartprocCASE 2:benennennprocCASE 3: +benennenbearbeitenstartprocCASE 4:benennenbearbeitenspeichernCASE 5: +benennenneustartprocCASE 6:benennenentfernenstartprocCASE 7: +benennenentfernenexec;leave(2)CASE 8:statlistezeigen(int(standardmaskenfeld( +fstatnr)))CASE 9:benennenlistebearbeitenstartprocCASE 10: +benennenlistebearbeitenspeichernCASE 11:benennenlisteentfernenstartprocCASE +12:benennenentfernenexec;enter(1)CASE 13:benennenbearbeitennichtspeichern +CASE 14:benennenentfernennichtloeschen;leave(2)CASE 15: +benennenentfernennichtloeschen;enter(1)CASE 16:benennenentfernennichtloeschen +;leave(3)END SELECT .benennenstartproc:standardstartproc(maskebenennen); +standardmaskenfeld(niltext,fstatnr);benennennproc.benennennproc: +standardmaskenfeld(niltext,fbezeichnung);feldschutz(fbezeichnung); +standardmaskenfeld(niltext,fzeilen);feldschutz(fzeilen);standardmaskenfeld( +niltext,fspalten);feldschutz(fspalten);feldschutz(fentfernen);feldfrei( +fstatnr);infeld(fstatnr);standardnproc.benennenbearbeitenstartproc:IF NOT +nummerokTHEN leave(1);ELIF NOT statistikexistiert(statnummer)THEN statmeldung +(mgibtesnicht);infeld(fstatnr);leave(1);ELSE benennenfreigebenundnproc;FI . +benennenbearbeitenspeichern:IF NOT eingabenokTHEN leave(1);ELIF NOT ( +statistiknummer=statnummer)AND statistikexistiert(statnummer)THEN statmeldung +(mgibtesschon);infeld(fstatnr);leave(1);ELSE statmeldung(mspeichern); +statistikspeichern(statistiknummer,statnummer);standardmaskenfeld(niltext, +fstatnr);leave(2);FI .benennenneustartproc:IF NOT nummerokTHEN leave(1);ELIF +statistikexistiert(statnummer)THEN statmeldung(mgibtesschon);infeld(fstatnr); +leave(1);ELSE benennenfreigeben;statistiknummer:=statnummer;standardnprocFI . +benennenentfernenstartproc:IF NOT nummerokTHEN leave(1);ELIF NOT +statistikexistiert(statnummer)THEN statmeldung(mgibtesnicht);infeld(fstatnr); +leave(1);ELSE benennenschuetzenundnproc;FI .benennenschuetzenundnproc: +benennenausfuellen(statnummer);feldschutz(fstatnr);feldschutz(fbezeichnung); +feldschutz(fzeilen);feldschutz(fspalten);infeld(fstatnr); +standardfelderausgeben;statmeldung(mentfernenfrage);infeld(fentfernen); +standardnproc.benennenfreigebenundnproc:benennenausfuellen(statnummer); +benennenfreigeben;statistiknummer:=statnummer;standardnproc.benennenfreigeben +:feldfrei(fbezeichnung);feldfrei(fzeilen);feldfrei(fspalten);feldschutz( +fentfernen);statnummerIN fstatnr;infeld(fbezeichnung).benennenentfernenexec: +statistikloeschen(statnummer);statmeldung(mgeloescht);standardmaskenfeld( +niltext,fstatnr).benennenlistebearbeitenstartproc:statlistebearbeiten( +maskebenennen);IF statlisteeintrag>niltextTHEN standardmaskenfeld( +statlisteeintrag,fstatnr);benennenfreigebenundnproc;ELSE standardmaskenfeld( +niltext,fstatnr);leave(2);FI .benennenlistebearbeitenspeichern:IF NOT +eingabenokTHEN leave(1);ELIF NOT (statistiknummer=statnummer)AND +statistikexistiert(statnummer)THEN statmeldung(mgibtesschon);infeld(fstatnr); +leave(1);ELSE statmeldung(mspeichern);statistikspeichern(statistiknummer, +statnummer);enter(1);FI .benennenlisteentfernenstartproc:statlistebearbeiten( +maskebenennen);IF statlisteeintrag>niltextTHEN standardmaskenfeld( +statlisteeintrag,fstatnr);benennenschuetzenundnproc;ELSE standardmaskenfeld( +niltext,fstatnr);leave(2);FI .benennenbearbeitennichtspeichern:statmeldung( +mnichtspeichern);standardmaskenfeld(niltext,fstatnr);leave(2). +benennenentfernennichtloeschen:statmeldung(mnichtgeloescht); +standardmaskenfeld(niltext,fstatnr).nummerok:INT VAR status;standardpruefe( +pruefeimintervall,fstatnr,1,maxstatistiken,niltext,status);IF status>0THEN +infeld(status)FI ;status=0.eingabenok:IF nummerokTHEN standardpruefe( +pruefeobwert,fbezeichnung,0,0,niltext,status);FI ;IF status=0THEN +standardpruefe(pruefeimintervall,fzeilen,1,maxzeilen,niltext,status);FI ;IF +status=0THEN standardpruefe(pruefeimintervall,fspalten,1,maxspalten,niltext, +status);FI ;IF status>0THEN infeld(status);FI ;status=0.statnummer:text(int( +standardmaskenfeld(fstatnr))).END PROC statbenennen;PROC statmeldung(INT +CONST meldungnummer):standardmeldung(meldungnummer,standardmaskenfeld(fstatnr +)+meldungzusatz);END PROC statmeldung;PROC benennenausfuellen(TEXT CONST +statnummer):TEXT VAR bezeichnung;INT VAR wert;forget(statistikdatei+ +statnummer,quiet);fetch(statistikdatei+statnummer,task(statistikserver));stat +:=sequentialfile(input,statistikdatei+statnummer);standardmaskenfeld( +statnummer,fstatnr);getline(stat,bezeichnung);standardmaskenfeld(bezeichnung, +fbezeichnung);get(stat,wert);standardmaskenfeld(text(wert),fzeilen);get(stat, +wert);standardmaskenfeld(text(wert),fspalten);forget(statistikdatei+ +statnummer,quiet);END PROC benennenausfuellen;BOOL PROC statistikexistiert( +TEXT CONST statnummer):exists(statistikdatei+statnummer,task(statistikserver) +)END PROC statistikexistiert;PROC statistikloeschen(TEXT CONST statnummer): +IF statistikexistiert(statnummer)THEN commanddialogue(FALSE );erase( +statistikdatei+statnummer,task(statistikserver));commanddialogue(TRUE );FI ; +END PROC statistikloeschen;PROC statistikspeichern(TEXT CONST altername, +neuername):INT VAR zeilenneu:=int(standardmaskenfeld(fzeilen)),spaltenneu:= +int(standardmaskenfeld(fspalten)),benennenneu:=zeilenneu*spaltenneu,zeilenalt +,spaltenalt,benennenalt,zaehl,zeile,spalte;TEXT VAR dateizeile;FILE VAR +statalt;forget(statistikdatei+altername,quiet);forget(statistikdatei+ +neuername,quiet);IF NOT statistikexistiert(altername)THEN +erzeugeneuestatistikELSE aenderealtestatistik;statistikloeschen(altername); +FI ;sichereneuestatistik.erzeugeneuestatistik:erzeugestatistikmitneuemnamen; +display(meldungback);FOR zaehlFROM benennenneuDOWNTO 1REP line(stat);cout( +zaehl);PER ;display(meldungrestore).erzeugestatistikmitneuemnamen:stat:= +sequentialfile(output,statistikdatei+neuername);putline(stat, +standardmaskenfeld(fbezeichnung));dateizeile:=text(zeilenneu)+space+text( +spaltenneu)+space;FOR zaehlFROM 1UPTO spaltenneuREP dateizeileCAT text( +minspaltenbreite);dateizeileCAT space;PER ;putline(stat,dateizeile);line(stat +).sichereneuestatistik:save(statistikdatei+neuername,task(statistikserver)); +forget(statistikdatei+neuername,quiet).aenderealtestatistik:forget( +statistikdatei+alt,quiet);fetch(statistikdatei+altername,task(statistikserver +));rename(statistikdatei+altername,statistikdatei+alt);statalt:= +sequentialfile(input,statistikdatei+alt);getline(statalt,dateizeile);get( +statalt,zeilenalt);get(statalt,spaltenalt);benennenalt:=zeilenalt*spaltenalt; +IF zeilenalt<>zeilenneuOR spaltenalt<>spaltenneuTHEN aenderedieganzestatistik +ELIF dateizeile<>standardmaskenfeld(fbezeichnung)THEN aenderediedateizeile +ELSE rename(statistikdatei+alt,statistikdatei+neuername);FI . +aenderediedateizeile:modify(statalt);tofirstrecord(statalt);writerecord( +statalt,standardmaskenfeld(fbezeichnung));rename(statistikdatei+alt, +statistikdatei+neuername).aenderedieganzestatistik: +erzeugestatistikmitneuemnamen;modify(statalt);zaehl:=benennenneu;display( +meldungback);FOR zeileFROM 1UPTO min(zeilenalt,zeilenneu)REP +uebertrageeinezeileausaltinneu;PER ;FOR zeileFROM zeilenalt+1UPTO zeilenneu +REP schreibeeineleerezeile;PER ;display(meldungrestore);forget(statistikdatei ++alt,quiet).uebertrageeinezeileausaltinneu:toline(statalt,statistikvorzeilen+ +(zeile-1)*spaltenalt+1);FOR spalteFROM 1UPTO min(spaltenalt,spaltenneu)REP +readrecord(statalt,dateizeile);putline(stat,dateizeile);down(statalt);zaehlen +PER ;FOR spalteFROM spaltenalt+1UPTO spaltenneuREP line(stat);zaehlenPER . +schreibeeineleerezeile:FOR spalteFROM 1UPTO spaltenneuREP line(stat);zaehlen +PER .zaehlen:cout(zaehl);zaehlDECR 1.END PROC statistikspeichern;END PACKET +benennen; + diff --git a/app/schulis/2.2.1/src/5.datenbasis b/app/schulis/2.2.1/src/5.datenbasis new file mode 100644 index 0000000..4d28ff7 --- /dev/null +++ b/app/schulis/2.2.1/src/5.datenbasis @@ -0,0 +1,62 @@ +PACKET datenbasisDEFINES statdatenbasisstartproc,statdatenbasisnproc, +statdatenbasisaufbereiten,statdatenbasisentfernen, +statdatenbasisentfernenmeldung,statdatenbasisnichtentfernen, +statdatenbasisermitteln,statdatenbasisvorhanden:LET datenbasisname= +"STATISTIK.basis",statistikserver="statistik server",maskedatenbasis= +"mst datenbasis bereitstellen",niltext="",meldungzusatz="+",meldungstichtag= +"zum Stichtag ",meldungnichtda="nicht ",mnichts="+ +", +mstart="�����������",mkeinedaten=68,mentfernenfrage=470,mkeinebasis=471, +mbasisentfernt=472,mbasisnichtentfernt=473,maufbereitung=474,mabbruch=475, +mbasisfertig=476,fstatnr=2,fcursor=3,filesize=4000,tupelstackgroesse=5;FILE +VAR basis;BOOL VAR datenbasisda;TEXT VAR datenbasisstichtag;PROC +statdatenbasisstartproc:enablestop;standardstartproc(maskedatenbasis); +statdatenbasisermitteln(fstatnr);statdatenbasisnproc;END PROC +statdatenbasisstartproc;PROC statdatenbasisnproc:infeld(fstatnr); +standardfelderausgeben;infeld(fcursor);standardnproc;END PROC +statdatenbasisnproc;PROC statdatenbasisermitteln(INT CONST feldnr):forget( +datenbasisname,quiet);datenbasisda:=existstask(statistikserver)CAND exists( +datenbasisname,task(statistikserver));IF datenbasisdaTHEN fetch( +datenbasisname,task(statistikserver));basis:=sequentialfile(modify, +datenbasisname);tofirstrecord(basis);readrecord(basis,datenbasisstichtag); +datenbasisstichtag:=meldungstichtag+datenbasisstichtag;forget(datenbasisname, +quiet);ELSE datenbasisstichtag:=meldungnichtdaFI ;standardmaskenfeld( +datenbasisstichtag,feldnr);END PROC statdatenbasisermitteln;BOOL PROC +statdatenbasisvorhanden:datenbasisdaEND PROC statdatenbasisvorhanden;PROC +statdatenbasisentfernenmeldung:IF datenbasisdaTHEN standardmeldung( +mentfernenfrage,niltext);infeld(fcursor);ELSE standardmeldung(mkeinebasis, +niltext);leave(1);FI END PROC statdatenbasisentfernenmeldung;PROC +statdatenbasisentfernen:datenbasisloeschen;standardmeldung(mbasisentfernt, +datenbasisstichtag+meldungzusatz);statdatenbasisermitteln(fstatnr);leave(2); +END PROC statdatenbasisentfernen;PROC statdatenbasisnichtentfernen: +standardmeldung(mbasisnichtentfernt,datenbasisstichtag+meldungzusatz);leave(2 +);END PROC statdatenbasisnichtentfernen;PROC datenbasisloeschen:BOOL CONST +comdia:=commanddialogue;IF datenbasisdaCAND exists(datenbasisname,task( +statistikserver))THEN commanddialogue(FALSE );erase(datenbasisname,task( +statistikserver));commanddialogue(comdia);FI ;END PROC datenbasisloeschen; +PROC statdatenbasisaufbereiten:BOOL VAR schuelerda,abbruch:=FALSE ;INT VAR +anzahltupel:=tupelstackgroesse,bearbeitetetupel:=tupelstackgroesse, +schuelerzahl:=0;IF datenbasisdaTHEN standardmeldung(mbasisentfernt, +datenbasisstichtag+meldungzusatz);ELSE standardmeldung(maufbereitung,date+ +meldungzusatz);FI ;schuelerlesenvorbereiten;IF schuelerdaTHEN +datenbasisaufbereiten;FI ;IF NOT schuelerdaTHEN standardmeldung(mkeinedaten, +niltext);ELIF abbruchTHEN standardmeldung(mabbruch,niltext);forget( +datenbasisname,quiet);ELSE datenbasisloeschen;datenbasissichern; +statdatenbasisermitteln(fstatnr);standardmeldung(mbasisfertig,niltext);FI ; +leave(1).datenbasisaufbereiten:forget(datenbasisname,quiet);basis:= +sequentialfile(output,datenbasisname);putline(basis,date);standardmeldung( +maufbereitung,date+meldungzusatz);out(mstart);REP putline(basis, +statdatenbasiszeile);schuelerzahlINCR 1;cout(schuelerzahl);naechsterschueler; +UNTIL bestandendePER .schuelerindex:ixsustatfamrufgeb. +schuelerlesenvorbereiten:inittupel(dnrdiffdaten);inittupel(dnrhalbjahresdaten +);inittupel(dnrschulen);inittupel(dnrschueler);parsenooffields(50); +systemdboff;search(schuelerindex,FALSE );schuelerda:=dbstatus=ok; +setzebestandende(NOT schuelerda).naechsterschueler:IF bearbeitetetupel= +anzahltupelTHEN IF anzahltupel<>tupelstackgroesseTHEN setzebestandende(TRUE ) +;ELIF NOT abbruchgewuenschtTHEN einpaarschuelerholen;FI ;ELSE multisucc; +bearbeitetetupelINCR 1;FI .einpaarschuelerholen:anzahltupel:= +tupelstackgroesse;scanstatus(ok);multisucc(schuelerindex,anzahltupel);IF +anzahltupel>0THEN multisucc;bearbeitetetupel:=1;ELSE setzebestandende(TRUE ) +FI .abbruchgewuenscht:abbruch:=lines(basis)>=filesize;abbruch. +datenbasissichern:save(datenbasisname,task(statistikserver)).END PROC +statdatenbasisaufbereiten;END PACKET datenbasis; + diff --git a/app/schulis/2.2.1/src/5.drucken b/app/schulis/2.2.1/src/5.drucken new file mode 100644 index 0000000..9b775ff --- /dev/null +++ b/app/schulis/2.2.1/src/5.drucken @@ -0,0 +1,153 @@ +PACKET druckenDEFINES statdrucken:LET statistikdatei="STATISTIK.", +statistikserver="statistik server",erstedruckdatei="liste.1",druckdatei= +"liste.",maxstatistiken=200,statistikvorzeilen=3,niltext="",space=" ",quote= +"""",edittasten="vr",statistiktext="Statistik Nr. ",stichtagtext="Stichtag: " +,definitiontext="Definition der Statistik Nr. ",groessetext= +"Größe: Zeilen, Spalten",tabellentext= +"Feld Z / Sp Art Länge Definition",tabellenlinie= +"----+--------+----+------+----------",tabelleleer= +" ",prozenttext=" %",meldungzusatz="+",mgibtesnicht +=477,fstatnr=2,fmini=3,fstd=4,fscreen=5,fprinter=6,tsenkrecht=":",twaagerecht +="-",tkreuz="+",tschraeg="/",pruefeimintervall=3,pruefenureinkreuz=5, +minspaltenbreite=4,maxspalten=50,KONST =STRUCT (BOOL def,TEXT maske,INT +mvorbereiten,mdrucken,mnichtdrucken);KONST VAR druck;BOOL VAR +ausgabebildschirm,ausgabeminimal;TEXT VAR druckstatistik;ROW maxspaltenINT +VAR breiten;INT VAR zeilen,spalten,felder;FILE VAR stat;PROC statdrucken( +BOOL CONST defdrucken,INT CONST was):INT VAR status:=0;IF defdruckenTHEN +druck:=KONST :(TRUE ,"mst statistik drucken",484,498,499);ELSE druck:=KONST : +(FALSE ,"mst statistik ausgeben",481,482,483);FI ;SELECT wasOF CASE 1: +druckenexecCASE 2:druckenlistezeigenCASE 3:druckenlisteexecCASE 4:ausdrucken; +enter(1)CASE 5:ausdrucken;leave(2)CASE 6:nichtdrucken;enter(1);CASE 7: +nichtdrucken;leave(2);END SELECT .druckenexec:standardpruefe( +pruefeimintervall,fstatnr,1,maxstatistiken,niltext,status);IF NOT +alleeingabenkorrektTHEN leave(1);ELIF NOT exists(gewaehltestatistik,task( +statistikserver))THEN standardmeldung(mgibtesnicht,standardmaskenfeld(2)+ +meldungzusatz);infeld(fstatnr);leave(1);ELSE drucken(text(int( +standardmaskenfeld(fstatnr))));IF NOT ausgabebildschirmTHEN leave(1);FI ;FI . +gewaehltestatistik:statistikdatei+text(int(standardmaskenfeld(fstatnr))). +druckenlistezeigen:status:=0;IF alleeingabenkorrektTHEN statlistezeigen(int( +standardmaskenfeld(fstatnr)));ELSE leave(1);FI .druckenlisteexec:IF +ausgabebildschirmTHEN statlistebearbeiten(druck.maske);IF statlisteeintrag> +niltextTHEN drucken(statlisteeintrag);ELSE leave(2);FI ;ELSE +statlistebearbeiten(druck.maske);WHILE statlisteeintrag>niltextREP drucken( +statlisteeintrag);statlistebearbeiten(druck.maske);PER ;leave(2);FI . +alleeingabenkorrekt:IF status=0THEN standardpruefe(pruefenureinkreuz,fmini, +fstd,0,niltext,status);FI ;IF druck.defTHEN ausgabebildschirm:= +standardmaskenfeld(fmini)<>niltext;ELSE IF status=0THEN standardpruefe( +pruefenureinkreuz,fscreen,fprinter,0,niltext,status);FI ;ausgabeminimal:= +standardmaskenfeld(fmini)<>niltext;ausgabebildschirm:=standardmaskenfeld( +fscreen)<>niltext;FI ;IF status>0THEN infeld(status)FI ;status=0.ausdrucken: +standardmeldung(druck.mdrucken,druckstatistik+meldungzusatz); +druckdateibehandeln(PROC (TEXT CONST )print);druckdateibehandeln(PROC (TEXT +CONST )forget).nichtdrucken:infeld(fstatnr);standardmaskenfeld(niltext, +fstatnr);standardmeldung(druck.mnichtdrucken,druckstatistik+meldungzusatz); +druckdateibehandeln(PROC (TEXT CONST )forget).END PROC statdrucken;PROC +drucken(TEXT CONST statistiknummer):statistiknummerIN fstatnr;infeld(fstatnr) +;standardmaskenfeld(niltext,fstatnr);erstellediedruckdatei;IF +ausgabebildschirmTHEN druckstatistik:=statistiknummer;standardmeldung(niltext +,meldungzusatz);zeigedatei(erstedruckdatei,edittasten);ELSE standardmeldung( +druck.mdrucken,statistiknummer+meldungzusatz);druckdateibehandeln(PROC (TEXT +CONST )print);druckdateibehandeln(PROC (TEXT CONST )forget);FI . +erstellediedruckdatei:standardmeldung(druck.mvorbereiten,statistiknummer+ +meldungzusatz+meldungzusatz);druckdateibehandeln(PROC (TEXT CONST )forget); +statistikladen(statistiknummer);druckvorbereiten;IF druck.defTHEN +druckestatdef(statistiknummer);ELSE druckestatistik(statistiknummer);FI ; +drucknachbereitenohneausdrucken;forget(statistikdatei+statistiknummer,quiet). +END PROC drucken;PROC druckestatistik(TEXT CONST statistiknummer):TEXT VAR +kopf1,kopf2,linie,dateizeile;BOOL VAR inhalt;INT VAR gedrucktespalten:=0, +spaltendieseseite:=0,aktspalte,aktzeile,aktbreite,zeilenbisseitenende, +gedrucktefelder:=0;seitenkopffestlegen;evtlspaltenbreitenverkuerzen;REP +ermittlespaltendieseseite;druckeallezeilenbiszudieserspalte;gedrucktespalten +INCR spaltendieseseite;UNTIL gedrucktespalten=spaltenPER .seitenkopffestlegen +:toline(stat,1);readrecord(stat,kopf1);kopf1:=statistiktext+statistiknummer+ +space+kopf1;toline(stat,statistikvorzeilen);readrecord(stat,kopf2);kopf2:= +compress(kopf2);IF kopf2>niltextTHEN kopf2:=stichtagtext+kopf2FI ;inhalt:= +kopf2>niltext;setzemitseitennummern(FALSE );initdruckkopf(kopf1,kopf2). +evtlspaltenbreitenverkuerzen:IF ausgabeminimalTHEN FOR aktspalteFROM 1UPTO +spaltenREP breiten[aktspalte]:=minspaltenbreite;PER FI . +ermittlespaltendieseseite:initspalten;setzespaltentrenner(tsenkrecht); +setzespaltenbreite(2);aktbreite:=3;spaltendieseseite:=0;REP spaltendieseseite +INCR 1;aktbreiteINCR breiten[letztespalte];aktbreiteINCR 1;setzespaltenbreite +(breiten[letztespalte]);UNTIL letztespalte>=spaltenCOR aktbreite+breiten[ +letztespalte+1]>=druckbreitePER .letztespalte:gedrucktespalten+ +spaltendieseseite.druckeallezeilenbiszudieserspalte:aktzeile:=0;erzeugelinie; +WHILE aktzeile=benoetigtezeilenREP aktzeileINCR 1;einezeileschreiben; +IF aktzeileMOD 2=0THEN gibstandaus(statistiknummer,gedrucktefelder,felder); +FI ;UNTIL aktzeile>=zeilenPER ;seitenwechsel.anzahlkopfzeilen:IF inhaltTHEN 2 +ELSE 1FI .benoetigtezeilen:IF ausgabeminimalTHEN 1ELSE 2FI . +spaltenkopfschreiben:spaltenweise(niltext);FOR aktspalteFROM gedrucktespalten ++1UPTO letztespalteREP spaltenweise(text(aktspalte,3));PER ; +druckzeileschreiben(zeile+tsenkrecht);zeilenbisseitenendeDECR 1. +einezeileschreiben:IF NOT ausgabeminimalTHEN druckzeileschreiben(linie); +zeilenbisseitenendeDECR 1;FI ;spaltenweise(text(aktzeile,2));FOR aktspalte +FROM gedrucktespalten+1UPTO letztespalteREP tragefeldinhalteinPER ; +gedrucktefelderINCR spaltendieseseite;druckzeileschreiben(zeile+tsenkrecht); +zeilenbisseitenendeDECR 1.tragefeldinhaltein:toline(stat,((aktzeile-1)* +spalten)+aktspalte+3);readrecord(stat,dateizeile);IF (dateizeileSUB 5)="t" +THEN dateizeile:=subtext(dateizeile,7,length(dateizeile)-1);changeall( +dateizeile,quote+quote,quote);spaltenweise(dateizeile);ELIF inhaltTHEN +spaltenweise(subtext(dateizeile,1,4));ELSE spaltenweise(niltext);FI .END +PROC druckestatistik;PROC druckestatdef(TEXT CONST statistiknummer):TEXT VAR +kopfname,kopfgroesse,kopflinie,dateizeile;INT VAR zeilenbisseitenende,aktfeld +:=0,deffeldbreite,benoetigtezeilen,zeilenende;seitenkopffestlegen; +tabellefestlegen;liesnaechstesfeld;REP druckeeineseiteUNTIL aktfeld>felder +PER .seitenkopffestlegen:toline(stat,1);readrecord(stat,kopfname);kopfgroesse +:=groessetext;replace(kopfgroesse,8,text(zeilen,2));replace(kopfgroesse,19, +text(spalten,2));setzemitseitennummern(FALSE );initdruckkopf(definitiontext+ +statistiknummer,kopfname).tabellefestlegen:kopflinie:=tabellenlinie;WHILE +length(kopflinie)=benoetigtezeilenREP schreibedasfeld;IF aktfeldMOD 15=0 +THEN gibstandaus(statistiknummer,aktfeld,felder);FI ;liesnaechstesfeld;UNTIL +aktfeld>felderPER ;seitenwechsel.anzahlkopfzeilen:IF kopfname=niltextTHEN 1 +ELSE 2FI .tabellenkopfschreiben:IF aktfeld<=1THEN druckzeileschreiben( +kopfgroesse);druckzeileschreiben(niltext);zeilenbisseitenendeDECR 2;FI ; +druckzeileschreiben(tabellentext);druckzeileschreiben(kopflinie); +zeilenbisseitenendeDECR 2.liesnaechstesfeld:aktfeldINCR 1;IF aktfeld<=felder +THEN toline(stat,aktfeld+3);readrecord(stat,dateizeile);spaltenweise(text( +aktfeld,4));spaltenweise(zeileundspalte);spaltenweise(space+space+(dateizeile +SUB 5));spaltenweise(text(breiten[aktspalte],5));benoetigtezeilen:=1;IF +length(dateizeile)-5>deffeldbreiteTHEN zaehlebenoetigtezeilenFI ;FI . +zeileundspalte:text(aktzeile,3)+tschraeg+text(aktspalte,3).aktzeile:(aktfeld- +1)DIV spalten+1.aktspalte:(aktfeld-1)MOD spalten+1.zaehlebenoetigtezeilen: +zeilenende:=5+deffeldbreite;gehezurueckzumwortende(dateizeile,zeilenende); +WHILE zeilenendespaceAND (dateizeile +SUB (zeilenende+1))=space.hieristeinsamesquote:naechsteszeichen:=pos( +dateizeile,"!","�",zeilenende+1);naechsteszeichen>0CAND (dateizeileSUB +naechsteszeichen)=quote.END PROC gehezurueckzumwortende;PROC gibstandaus( +TEXT CONST nummer,INT CONST wert,hundert):disablestop;INT VAR proz:=(wert*100 +)DIV hundert;IF iserrorTHEN clearerror;proz:=int((real(wert)*100.0)/real( +hundert));FI ;standardmeldung(druck.mvorbereiten,nummer+meldungzusatz+text( +proz)+prozenttext+meldungzusatz);END PROC gibstandaus;PROC statistikladen( +TEXT CONST statnummer):TEXT VAR dummy;INT VAR spaltenzaehler;forget( +statistikdatei+statnummer,quiet);fetch(statistikdatei+statnummer,task( +statistikserver));stat:=sequentialfile(input,statistikdatei+statnummer); +getline(stat,dummy);get(stat,zeilen);get(stat,spalten);FOR spaltenzaehler +FROM 1UPTO spaltenREP get(stat,breiten[spaltenzaehler]);PER ;modify(stat); +felder:=zeilen*spalten;END PROC statistikladen;PROC druckdateibehandeln(PROC +(TEXT CONST )machwas):INT VAR i;TEXT VAR name;commanddialogue(FALSE );get(all +,name,i);WHILE i>0REP IF subtext(name,1,length(druckdatei))=druckdateiTHEN +machwas(name);FI ;get(all,name,i);PER ;commanddialogue(TRUE ).END PROC +druckdateibehandeln;END PACKET drucken; + diff --git a/app/schulis/2.2.1/src/5.erstellen b/app/schulis/2.2.1/src/5.erstellen new file mode 100644 index 0000000..902729d --- /dev/null +++ b/app/schulis/2.2.1/src/5.erstellen @@ -0,0 +1,146 @@ +PACKET erstellenDEFINES staterstellen:LET datenbasisname="STATISTIK.basis", +statistikdatei="STATISTIK.",statistikserver="statistik server",maskeerstellen +="mst statistik erstellen",niltext="",space=" ",meldungzusatz="+",spaces= +" ",sjoker="*",squote="""",sklammerzu=")",adate=2,erstedatenzeile=2, +defvorzeilen=3,fstatnr=2,fstichtag=3,datepos=14,mkeinebasis=471,mzahleingeben +=53,mgibtesnicht=477,mstatprozent=479,mstaterstellt=480,ogleich=1,ogroesser=2 +,okleiner=3,ogroessergleich=4,okleinergleich=5,oungleich=6,oenthalten=7,olike +=8,maxvergleiche=25,ende=0,VERGLEICH =STRUCT (BOOL kursvergleich,INT operator +,von,bis,INT undvergleich,odervergleich,INT zweiterkursvergleich,TEXT text); +ROW maxvergleicheVERGLEICH VAR vergleiche;INT VAR anzahlvergleiche,verglpos; +TEXT VAR vergl,basiszeile;PROC staterstellen(INT CONST was):SELECT wasOF +CASE 1:erstellenstartprocCASE 2:erstellenexecCASE 3:statlistezeigen(int( +standardmaskenfeld(fstatnr)))CASE 4:erstellenlisteexecEND SELECT . +erstellenstartproc:standardstartproc(maskeerstellen);statdatenbasisermitteln( +fstichtag);standardnproc.erstellenexec:IF NOT statdatenbasisvorhandenTHEN +standardmeldung(mkeinebasis,niltext);ELIF int(standardmaskenfeld(fstatnr))<=0 +THEN standardmaskenfeld(niltext,fstatnr);standardmeldung(mzahleingeben, +niltext);ELSE holedatenbasis;erstellen(standardmaskenfeld(fstatnr)); +loeschedatenbasis;FI ;leave(1).erstellenlisteexec:statlistebearbeiten( +maskeerstellen);statdatenbasisermitteln(fstichtag);standardfelderausgeben;IF +NOT statdatenbasisvorhandenTHEN standardmeldung(mkeinebasis,niltext);ELSE +holedatenbasis;WHILE statlisteeintrag>niltextREP erstellen(statlisteeintrag); +statlistebearbeiten(maskeerstellen);PER ;loeschedatenbasis;FI ; +standardmaskenfeld(niltext,fstatnr);leave(2).END PROC staterstellen;PROC +erstellen(TEXT CONST statistiknummer):BOOL VAR abbruch:=FALSE ;IF NOT exists( +gewaehltestatistik,task(statistikserver))THEN standardmeldung(mgibtesnicht, +statistiknummer+meldungzusatz);ELSE erstellestatistik;FI .erstellestatistik: +statistiknummerIN fstatnr;standardmaskenfeld(niltext,fstatnr);standardmeldung +(mstaterstellt,statistiknummer+meldungzusatz+"wird"+meldungzusatz);forget( +gewaehltestatistik,quiet);fetch(gewaehltestatistik,task(statistikserver)); +fuelleallefelderaus;IF abbruchTHEN standardmeldung(mstaterstellt, +statistiknummer+meldungzusatz+"nicht"+meldungzusatz);ELSE commanddialogue( +FALSE );save(gewaehltestatistik,task(statistikserver));commanddialogue(TRUE ) +;standardmeldung(mstaterstellt,statistiknummer+meldungzusatz+ +standardmaskenfeld(fstichtag)+meldungzusatz);FI ;forget(gewaehltestatistik, +quiet).fuelleallefelderaus:FILE VAR basis:=sequentialfile(modify, +datenbasisname),stat:=sequentialfile(modify,gewaehltestatistik);INT VAR +aktfeld,bearbeitetefelder:=0,felder:=lines(stat)-defvorzeilen;TEXT VAR +dateizeile;fuellebedingungfelder;fuellesummenfelder;toline(stat,defvorzeilen) +;writerecord(stat,subtext(standardmaskenfeld(fstichtag),datepos)). +fuellebedingungfelder:toline(stat,defvorzeilen+1);col(stat,1);WHILE NOT eof( +stat)REP readrecord(stat,dateizeile);SELECT pos("bst",dateizeileSUB 5)OF +CASE 1:wertebedingungausCASE 2:replace(dateizeile,1," ")OTHERWISE +bearbeitetefelderINCR 1END SELECT ;writerecord(stat,dateizeile);down(stat); +UNTIL abbruchPER .fuellesummenfelder:toline(stat,defvorzeilen+1);WHILE NOT +eof(stat)REP readrecord(stat,dateizeile);IF (dateizeileSUB 5)="s"THEN +wertesummeausFI ;writerecord(stat,dateizeile);down(stat);UNTIL abbruchPER . +wertebedingungaus:replace(dateizeile,1,text(anzahlschueler(basis,subtext( +dateizeile,6)),4));gibprozentmeldungaus.wertesummeaus:aktfeld:=lineno(stat); +replace(dateizeile,1,text(summe(stat,subtext(dateizeile,6)),4));toline(stat, +aktfeld);gibprozentmeldungaus.gibprozentmeldungaus:bearbeitetefelderINCR 1; +disablestop;INT VAR proz:=(bearbeitetefelder*100)DIV felder;IF iserrorTHEN +clearerror;proz:=int((real(bearbeitetefelder)*100.0)/real(felder));FI ; +enablestop;standardmeldung(mstatprozent,statistiknummer+meldungzusatz+text( +proz)+meldungzusatz);.gewaehltestatistik:statistikdatei+statistiknummer.END +PROC erstellen;PROC holedatenbasis:forget(datenbasisname,quiet);fetch( +datenbasisname,task(statistikserver));END PROC holedatenbasis;PROC +loeschedatenbasis:forget(datenbasisname,quiet);END PROC loeschedatenbasis; +INT PROC summe(FILE VAR stat,TEXT CONST formel):INT VAR summe:=0,posi:=1, +feldnr,faktor;REP faktor:=pos("+-",formelSUB posi);IF faktor>0THEN posiINCR 2 +;FI ;feldnr:=int(subtext(formel,posi+1,posi+4));toline(stat,feldnr+3);IF +faktor=2THEN summeDECR int(subtext(stat,1,4));ELSE summeINCR int(subtext(stat +,1,4));FI ;posi:=pos(formel,space,posi)+1;UNTIL posi<=1PER ;max(summe,0).END +PROC summe;INT PROC anzahlschueler(FILE VAR basis,TEXT CONST bedingung):INT +VAR erstervergleich,anzahl;liesallevergleiche;zaehledieschueler;anzahl. +liesallevergleiche:anzahlvergleiche:=0;verglpos:=1;vergl:=bedingung; +erstervergleich:=liesvergleich.zaehledieschueler:anzahl:=0;toline(basis, +erstedatenzeile);col(basis,1);WHILE NOT eof(basis)REP readrecord(basis, +basiszeile);IF vergleichpositiv(erstervergleich)THEN anzahlINCR 1;FI ;down( +basis);PER .END PROC anzahlschueler;INT PROC liesvergleich:INT VAR wurzel, +knoten;BOOL VAR opand;wurzel:=naechstervergleich;verglposINCR 1;WHILE +nochmehrvergleicheREP liesboolop;knoten:=naechstervergleich;IF opandTHEN +verknuepfeand(wurzel,knoten);ELSE verknuepfeor(wurzel,knoten);FI ;verglpos +INCR 1;PER ;wurzel.naechstervergleich:SELECT pos("(mk",verglSUB verglpos)OF +CASE 1:behandleklammerCASE 2:liesmerkmalCASE 3:lieskursOTHERWISE errorstop( +"unzulässiger Vergleich");0END SELECT .behandleklammer:verglposINCR 1; +liesvergleich.nochmehrvergleiche:(verglSUB verglpos-1)<>sklammerzuAND +verglpos<",verglSUB verglpos+4)+pos(".=>",verglSUB verglpos+5),von, +bis,jokerpos;TEXT VAR vergltext:=niltext;IF operator>okleinerTHEN verglpos +INCR 7;ELSE verglposINCR 6;FI ;IF (verglSUB verglpos)=sjokerTHEN operator:= +ogroesser;vergltext:=subtext(spaces,1,statfeldlaenge(merkmal));verglposINCR 1 +;ELSE liestext(vergltext);FI ;erzeugemerkmalvergleich.erzeugemerkmalvergleich +:von:=statfeldpos(merkmal);bis:=von-1+statfeldlaenge(merkmal);jokerpos:=pos( +vergltext,sjoker);IF jokerpos>0THEN aenderevergleichsmerkmale;ELIF +statfeldart(merkmal)=adateTHEN vergltext:=vergleichbaresdatum(vergltext);FI ; +anzahlvergleicheINCR 1;vergleiche[anzahlvergleiche]:=VERGLEICH :(FALSE , +operator,von,bis,ende,ende,ende,vergltext);anzahlvergleiche. +aenderevergleichsmerkmale:IF jokerpos=1AND pos(vergltext,sjoker,2)=length( +vergltext)THEN operator:=oenthalten;vergltext:=subtext(vergltext,2,length( +vergltext)-1);ELIF pos(vergltext,sjoker,jokerpos+1)>0THEN operator:=olike; +ELIF jokerpos=1THEN vergltext:=subtext(vergltext,2);vonINCR (bis-von-length( +vergltext)+1);ELIF jokerpos=length(vergltext)THEN vergltext:=subtext( +vergltext,1,length(vergltext)-1);bisDECR (bis-von-length(vergltext)+1);ELSE +operator:=olike;FI .END PROC liesmerkmal;PROC liestext(TEXT VAR vergltext): +INT VAR beginn;verglposINCR 1;REP beginn:=verglpos;verglpos:=pos(vergl,squote +,beginn+1);vergltextCAT subtext(vergl,beginn,verglpos-1);verglposINCR 1; +UNTIL (verglSUB verglpos)<>squotePER END PROC liestext;INT PROC lieskurs: +TEXT VAR vergl1:=niltext,vergl2:=niltext;INT VAR von1:=1,bis1:=0,von2,bis2, +teilfeld,operator:=ogleich;BOOL VAR zweivergleiche:=FALSE ;ROW 4INT CONST +laenge:=ROW 4INT :(2,2,4,1);verglposINCR 6;FOR teilfeldFROM 1UPTO 4REP +liesnaechstenteiltext;PER ;erzeugekursvergleich.liesnaechstenteiltext: +verglposINCR 1;IF (verglSUB verglpos)=sjokerTHEN verglposINCR 1; +leererteiltext;ELIF zweivergleicheTHEN liestext(vergl2);bis2INCR laenge[ +teilfeld];ELSE liestext(vergl1);bis1INCR laenge[teilfeld];FI .leererteiltext: +IF zweivergleicheTHEN IF von2>bis2THEN von2INCR laenge[teilfeld];bis2INCR +laenge[teilfeld];FI ;ELIF von1>bis1THEN von1INCR laenge[teilfeld];bis1INCR +laenge[teilfeld];ELSE zweivergleiche:=TRUE ;von2:=bis1+laenge[teilfeld]+1; +bis2:=bis1+laenge[teilfeld];FI .erzeugekursvergleich:IF von1>bis1THEN +operator:=ogroesser;ELIF zweivergleicheAND von2>bis2THEN zweivergleiche:= +FALSE ;FI ;anzahlvergleicheINCR 1;vergleiche[anzahlvergleiche]:=VERGLEICH :( +TRUE ,operator,von1,bis1,ende,ende,evtlvergl2,vergl1);IF zweivergleicheTHEN +anzahlvergleicheINCR 1;vergleiche[anzahlvergleiche]:=VERGLEICH :(TRUE , +ogleich,von2,bis2,ende,ende,ende,vergl2);anzahlvergleiche-1ELSE +anzahlvergleicheFI .evtlvergl2:IF zweivergleicheTHEN anzahlvergleiche+1ELSE +endeFI .END PROC lieskurs;PROC verknuepfeand(INT CONST wurzel,knoten):IF +vergleiche[wurzel].undvergleich<>endeTHEN verknuepfeand(vergleiche[wurzel]. +undvergleich,knoten);ELIF wurzel<>knotenTHEN vergleiche[wurzel].undvergleich +:=knoten;FI ;IF vergleiche[wurzel].odervergleich<>endeTHEN verknuepfeand( +vergleiche[wurzel].odervergleich,knoten);FI ;END PROC verknuepfeand;PROC +verknuepfeor(INT CONST wurzel,knoten):IF vergleiche[wurzel].odervergleich= +endeTHEN vergleiche[wurzel].odervergleich:=knotenELSE verknuepfeor(vergleiche +[wurzel].odervergleich,knoten);FI ;END PROC verknuepfeor;BOOL PROC +vergleichpositiv(INT CONST wurzel):(wurzelbedingungerfuelltCAND +undbedingungenerfuellt)COR oderbedingungenerfuellt.undbedingungenerfuellt:(v. +undvergleich=endeOR vergleichpositiv(v.undvergleich)).oderbedingungenerfuellt +:(v.odervergleich<>endeAND vergleichpositiv(v.odervergleich)). +wurzelbedingungerfuellt:IF v.kursvergleichTHEN kursvergleichpositiv(wurzel) +ELSE SELECT v.operatorOF CASE ogleich:basistext=v.textCASE ogroesser: +basistext>v.textCASE okleiner:basistext=v.textCASE okleinergleich:basistext<=v.textCASE oungleich:basistext<>v.text +CASE oenthalten:pos(basistext,v.text)>0OTHERWISE basistextLIKE v.textEND +SELECT FI .basistext:subtext(basiszeile,v.von,v.bis).v:vergleiche[wurzel]. +END PROC vergleichpositiv;BOOL PROC kursvergleichpositiv(INT CONST wurzel): +INT VAR kurspos:=122;IF v.operator=ogroesserTHEN stellefestobkursebelegtELSE +REP kurspos:=pos(basiszeile,v.text,kurspos+1);UNTIL kurspos=0COR ( +kursposstimmtCAND zweitervergleichok)PER ;kurspos>0FI . +stellefestobkursebelegt:pos(basiszeile,"!","�",kurspos+1)>0.kursposstimmt:(( +kurspos-6)MOD 9)=v.von-1.zweitervergleichok:v.zweiterkursvergleich=endeCOR v2 +.text=subtext(basiszeile,beginn+v2.von,beginn+v2.bis).v:vergleiche[wurzel].v2 +:vergleiche[v.zweiterkursvergleich].beginn:kurspos-v.von.END PROC +kursvergleichpositiv;END PACKET erstellen; + diff --git a/app/schulis/2.2.1/src/5.felder b/app/schulis/2.2.1/src/5.felder new file mode 100644 index 0000000..3fd6225 --- /dev/null +++ b/app/schulis/2.2.1/src/5.felder @@ -0,0 +1,263 @@ +PACKET felderDEFINES statfelder:LET statistikdatei="STATISTIK.", +statistikserver="statistik server",maskefelderdefinieren= +"mst statistik felder definieren",maskefelderbearbeiten= +"mst statistik felder bearbeiten",maskefelderstandarddruck= +"mst statistik felder standarddruck",statistikvorzeilen=3,maxstatistiken=200, +maxspalten=50,minbreite=4,maxbreite=30,niltext="",space=" ",meldungzusatz="+" +,pruefeimintervall=3,fwarten=1,fstatnr=2,fuebertragen=3,ffeldnr=3,fzeile=4, +fspalte=5,fart=6,fdef=7,fkopieren=8,fnaechstes=9,mnichterlaubt=34, +mgibtesnicht=477,martangeben=478,mmussleerbleiben=491,mnureineauswahl=492, +mspeichern=486,mnichtspeichern=487,muebernehmenfrage=493,mnichtgleichgross= +494,muebernehmen=495,msyntaxfehler=496,mdefzulang=497;FILE VAR stat;TEXT VAR +statistikname;BOOL VAR statgeaendert;INT VAR zeilen,spalten,felder, +letztemeldung,verlassentiefe;ROW maxspaltenINT VAR breiten;LET normalesende= +FALSE ,klammeramende=TRUE ,fvergleicherwartet=1,fmerkmalerwartet=2, +fvergleichsoperwartet=3,fkommaerwartet=4,ftexterwartet=5,fklammerzuerwartet=6 +,fbooloperwartet=7,ftextfeldsummiert=8,fdatumfalsch=9,fhierkeinjoker=10, +frechenoperwartet=11,ffeldnrerwartet=12,ffeldnrzuhoch=13,fzubreit=14, +fpatternzulang=15,fzahlfalsch=16,tendedestextes=7,tname=1,ttext=4,atext=1, +adate=2,azahl=3,akurs=4,squote="""",snull="0",skomma=",",sgleich="=",sspace= +" ",sgroesser=">",sklammerauf="(",skleiner="<",sklammerzu=")",sgroessergleich +=">=",sfeld="f",skleinergleich="<=",skurs="kurs",sungleich="<>",smerkmal="m", +sand="AND",sjoker="*",sor="OR",splus="+",sund="UND",sminus="-",soder="ODER"; +TEXT VAR symbol;INT VAR type,fehlernr;BOOL VAR ok;PROC statfelder(INT CONST +was):TEXT VAR bezeichnung,liste;INT VAR breite,hoehe,zaehler,status;SELECT +wasOF CASE 1:felderbearbeitenstartprocCASE 2:felderbearbeitenspeichernCASE 3: +felderbearbeitennaechstesfeldCASE 4:felderbearbeitenzumbeginnCASE 5: +felderbearbeitenmerkmalslisteCASE 6:felderbearbeitendefinitionkopierenCASE 7: +felderlistezeigenCASE 8:felderlistebearbeitenstartprocCASE 9: +felderstandarddruckstartprocCASE 10:felderstandarddruckspeichernCASE 11: +felderstandarddrucknichtspeichernCASE 12:felderlistestandarddruckstartproc +CASE 13:felderlistestandarddruckspeichernCASE 14: +felderlistestandarddrucknichtspeichernCASE 15: +felderlistestandarddruckzumbeginnCASE 16:felderuebernehmenstartprocCASE 17: +felderuebernehmenexecCASE 18:allefelderspeichernEND SELECT . +felderbearbeitenstartproc:IF NOT statnummerokTHEN leave(1);ELIF +standardmaskenfeld(fuebertragen)>niltextTHEN standardmeldung(mmussleerbleiben +,niltext);infeld(fuebertragen);leave(1);ELSE statistikladen(statnummer); +standardstartproc(maskefelderbearbeiten);verlassentiefe:=0;feldbearbeiten(1); +standardnproc;FI .felderbearbeitenspeichern:IF NOT feldeingabenokTHEN leave(1 +);ELSE speicherefeldab;felderbearbeitennaechstesfeld;FI . +felderbearbeitennaechstesfeld:IF NOT naechstefeldnummerokTHEN leave(1);ELIF +compress(standardmaskenfeld(fnaechstes))=niltextTHEN +felderbearbeitenzumbeginnELSE feldbearbeiten(int(standardmaskenfeld( +fnaechstes)));leave(1);FI .felderbearbeitenzumbeginn:statistiksichern; +standardstartproc(maskefelderdefinieren);standardmaskenfeld(statistikname, +fstatnr);leave(2+verlassentiefe).allefelderspeichern:WHILE feldeingabenok +CAND naechstefeldnummerokREP speicherefeldab;IF standardmaskenfeld(fnaechstes +)=niltextTHEN felderbearbeitenzumbeginn;LEAVE allefelderspeichernELSE +feldbearbeiten(int(standardmaskenfeld(fnaechstes)));FI ;PER ;leave(1). +felderbearbeitenmerkmalsliste:WINDOW VAR w:=startwindow(40,23,77,1);open(w); +bereitelisteauf;listeCAT "*";listeCAT auskunftstextende;auskunfterteilung( +liste,w,FALSE );reorganizescreen;setlasteditvalues;leave(1).bereitelisteauf: +liste:="Bez. Feld Länge";listeCAT auskunftstextende;FOR +zaehlerFROM 1UPTO 50REP IF zaehler=39THEN listeCAT +" davon Art 2";listeCAT auskunftstextende;listeCAT +" Fach 2";listeCAT auskunftstextende;listeCAT +" Kennung 4";listeCAT auskunftstextende;listeCAT +" Klausur 1";listeCAT auskunftstextende;FI ;IF zaehler< +10THEN listeCAT "m0"ELSE listeCAT "m"FI ;listeCAT text(zaehler);listeCAT +" = ";listeCAT text(statfeldname(zaehler),24);listeCAT text(statfeldlaenge( +zaehler));listeCAT auskunftstextende;PER .felderbearbeitendefinitionkopieren: +standardpruefe(pruefeimintervall,fkopieren,1,felder,niltext,status);IF status +>0THEN infeld(status)ELSE felddefinitionzeigen(int(standardmaskenfeld( +fkopieren)))FI ;leave(1).felderlistezeigen:letztemeldung:=0;statlistezeigen( +int(standardmaskenfeld(fstatnr))).felderlistebearbeitenstartproc:IF +highestentry(thesaurusauswahl)=1THEN statlistebearbeiten( +maskefelderbearbeiten);statistikladen(statlisteeintrag);verlassentiefe:=1; +feldbearbeiten(1);standardnproc;ELSE standardstartproc(maskefelderdefinieren) +;IF highestentry(thesaurusauswahl)>1THEN standardmeldung(mnureineauswahl, +niltext);FI ;leave(2);FI .felderstandarddruckstartproc:IF NOT statnummerok +THEN leave(1);ELIF standardmaskenfeld(fuebertragen)>niltextTHEN +standardmeldung(mmussleerbleiben,niltext);infeld(fuebertragen);leave(1);ELSE +statistikladen(statnummer);standardstartproc(maskefelderstandarddruck); +spaltenbreiteneintragen;standardnproc;FI .felderstandarddruckspeichern:IF +NOT spaltenbreitenokTHEN leave(1);ELSE spaltenbreitenspeichern; +standardstartproc(maskefelderdefinieren);standardmeldung(mspeichern, +statistikname+meldungzusatz);statistiksichern;standardmaskenfeld( +statistikname,fstatnr);leave(2);FI .felderstandarddrucknichtspeichern: +standardstartproc(maskefelderdefinieren);standardmeldung(mnichtspeichern, +statistikname+meldungzusatz);statistikvergessen;standardmaskenfeld( +statistikname,fstatnr);leave(2).felderlistestandarddruckstartproc: +statlistebearbeiten(maskefelderstandarddruck);IF statlisteeintrag>niltext +THEN statistikladen(statlisteeintrag);spaltenbreiteneintragen;standardnproc; +ELSE standardstartproc(maskefelderdefinieren);IF letztemeldung=mspeichernOR +letztemeldung=mnichtspeichernTHEN standardmeldung(letztemeldung,statistikname ++meldungzusatz);FI ;leave(2);FI .felderlistestandarddruckspeichern:IF NOT +spaltenbreitenokTHEN leave(1);ELSE standardmeldung(mspeichern,statistikname+ +meldungzusatz);letztemeldung:=mspeichern;spaltenbreitenspeichern; +statistiksichern;standardmaskenfeld(statistikname,fstatnr);enter(1);FI . +felderlistestandarddrucknichtspeichern:standardmeldung(mnichtspeichern, +statistikname+meldungzusatz);letztemeldung:=mnichtspeichern; +statistikvergessen;enter(1).felderlistestandarddruckzumbeginn: +statistikvergessen;enter(3).felderuebernehmenstartproc:standardpruefe( +pruefeimintervall,fuebertragen,1,maxstatistiken,niltext,status);IF status>0 +THEN infeld(status);leave(1);ELIF NOT statistikexistiert(uebernehmennummer) +THEN standardmeldung(mgibtesnicht,uebernehmennummer+meldungzusatz);infeld( +fuebertragen);leave(1);ELIF NOT statnummerokTHEN leave(1);ELIF +diedefinitionensindnichtgleichgrossTHEN standardmeldung(mnichtgleichgross, +niltext);leave(1);ELSE standardmeldung(muebernehmenfrage,niltext);feldschutz( +fwarten);feldschutz(fstatnr);feldschutz(fuebertragen);infeld(fwarten); +standardnproc;FI .diedefinitionensindnichtgleichgross:statistikladen( +statnummer);hoehe:=zeilen;breite:=spalten;statistikvergessen;statistikladen( +uebernehmennummer);statistikvergessen;hoehe<>zeilenOR breite<>spalten. +felderuebernehmenexec:statistikladen(statnummer);tofirstrecord(stat); +readrecord(stat,bezeichnung);statistikvergessen;statistikladen( +uebernehmennummer);tofirstrecord(stat);writerecord(stat,bezeichnung);toline( +stat,statistikvorzeilen);writerecord(stat,niltext);rename(statistikdatei+ +uebernehmennummer,statistikdatei+statnummer);statistikname:=statnummer; +statistiksichern;standardmeldung(muebernehmen,uebernehmennummer+meldungzusatz +);feldfrei(fstatnr);feldfrei(fuebertragen);standardmaskenfeld(niltext, +fuebertragen);infeld(fstatnr);leave(2).naechstefeldnummerok:IF compress( +standardmaskenfeld(fnaechstes))=niltextTHEN standardmaskenfeld(niltext, +fnaechstes);status:=0;ELSE standardpruefe(pruefeimintervall,fnaechstes,1, +felder,niltext,status);FI ;IF status>0THEN infeld(status)FI ;status=0. +feldeingabenok:status:=0;IF art=0THEN standardmeldung(mnichterlaubt,niltext); +status:=fart;ELIF NOT definitionokTHEN status:=fdef;ELIF standardmaskenfeld( +fkopieren)>niltextTHEN standardmeldung(mmussleerbleiben,niltext);status:= +fkopieren;ELIF NOT naechstefeldnummerokTHEN status:=fnaechstes;FI ;IF status> +0THEN infeld(status);FI ;status=0.definitionok:SELECT artOF CASE 1: +bedingungok(fdef)CASE 2:summeok(fdef)CASE 3:textok(fdef,breiten[int( +standardmaskenfeld(fspalte))])OTHERWISE leerokEND SELECT .leerok:IF +standardmaskenfeld(fdef)>niltextTHEN standardmeldung(martangeben,niltext); +FALSE ELSE TRUE FI .art:IF standardmaskenfeld(fart)=niltextTHEN 4ELSE pos( +"bst ",standardmaskenfeld(fart))FI .spaltenbreiteneintragen:input(stat); +getline(stat,bezeichnung);get(stat,hoehe);get(stat,breite);standardmaskenfeld +(text(statistikname,3),fstatnr);FOR zaehlerFROM 1UPTO spaltenREP +tragespaltenwertein;feldfrei(breitenfeld+1);PER ;FOR zaehlerFROM spalten+1 +UPTO maxspaltenREP standardmaskenfeld(space+space,breitenfeld); +standardmaskenfeld(space+space,breitenfeld+1);feldschutz(breitenfeld+1);PER ; +modify(stat);infeld(2);standardfelderausgeben;infeld(4).tragespaltenwertein: +get(stat,breite);standardmaskenfeld(text(zaehler,2),breitenfeld); +standardmaskenfeld(text(breite),breitenfeld+1).breitenfeld:(zaehler-1)MOD 10* +10+(zaehler-1)DIV 10*2+3.spaltenbreitenok:FOR zaehlerFROM 1UPTO spaltenREP +standardpruefe(pruefeimintervall,breitenfeld+1,minbreite,maxbreite,niltext, +status);UNTIL status>0PER ;IF status>0THEN infeld(status)FI ;status=0. +spaltenbreitenspeichern:bezeichnung:=text(zeilen)+space+text(spalten)+space; +FOR zaehlerFROM 1UPTO spaltenREP bezeichnungCAT text(int(standardmaskenfeld( +breitenfeld+1)));bezeichnungCAT space;PER ;toline(stat,2);writerecord(stat, +bezeichnung).statnummerok:standardpruefe(pruefeimintervall,fstatnr,1, +maxstatistiken,niltext,status);IF status>0THEN infeld(status)ELIF NOT +statistikexistiert(statnummer)THEN standardmeldung(mgibtesnicht,statnummer+ +meldungzusatz);infeld(fstatnr);status:=fstatnrFI ;status=0.statnummer:text( +int(standardmaskenfeld(fstatnr))).uebernehmennummer:text(int( +standardmaskenfeld(fuebertragen))).END PROC statfelder;PROC statistikladen( +TEXT CONST statnummer):INT VAR spaltenzaehler;forget(statistikdatei+ +statnummer,quiet);fetch(statistikdatei+statnummer,task(statistikserver));stat +:=sequentialfile(input,statistikdatei+statnummer);getline(stat,statistikname) +;get(stat,zeilen);get(stat,spalten);FOR spaltenzaehlerFROM 1UPTO spaltenREP +get(stat,breiten[spaltenzaehler]);PER ;modify(stat);felder:=zeilen*spalten; +statistikname:=statnummer;statgeaendert:=FALSE ;END PROC statistikladen;PROC +statistiksichern:IF statgeaendertTHEN toline(stat,statistikvorzeilen); +writerecord(stat,niltext);FI ;commanddialogue(FALSE );save(statistikdatei+ +statistikname,task(statistikserver));commanddialogue(TRUE ); +statistikvergessen;END PROC statistiksichern;PROC statistikvergessen:forget( +statistikdatei+statistikname,quiet);END PROC statistikvergessen;BOOL PROC +statistikexistiert(TEXT CONST statnummer):exists(statistikdatei+statnummer, +task(statistikserver))END PROC statistikexistiert;PROC feldbearbeiten(INT +CONST feldnummer):standardmaskenfeld(text(statistikname,3),fstatnr); +standardmaskenfeld(text(feldnummer,4),ffeldnr);standardmaskenfeld(text(( +feldnummer-1)DIV spalten+1,2),fzeile);standardmaskenfeld(text((feldnummer-1) +MOD spalten+1,2),fspalte);IF feldnummer250THEN standardmaskenfeld(bedingung, +maskenfeld);standardmeldung(mdefzulang,niltext);ELSE standardmaskenfeld( +bedingung,maskenfeld);bedingungIN maskenfeld;FI ;okEND PROC bedingungok;TEXT +PROC normbedingung(BOOL CONST endeklammerzu):TEXT VAR bedingung:=niltext, +operator;INT VAR merkmal;IF type=tendedestextesTHEN fehler(fvergleicherwartet +);ELIF symbol=sklammeraufTHEN behandleklammerELIF symbol=skursTHEN +behandlekursELSE behandlemerkmalFI ;IF NOT okTHEN ELIF type<>tendedestextes +THEN liesverknuepfungoderklammerzuELIF endeklammerzuTHEN fehler( +fklammerzuerwartet);FI ;bedingung.behandleklammer:naechstessymbol;bedingung:= +sklammerauf+normbedingung(klammeramende)+sklammerzu.behandlemerkmal: +liesmerkmal;liesoperator;IF okTHEN bedingungCAT textderlaenge(statfeldlaenge( +merkmal),statfeldart(merkmal),operator);FI .liesmerkmal:merkmal:=int(subtext( +symbol,2,3));IF type=tnameAND length(symbol)=3AND (symbolSUB 1)=smerkmalAND +merkmal>=1AND merkmal<=50AND lastconversionokTHEN bedingungCAT symbol; +naechstessymbol;ELSE fehler(fmerkmalerwartet);FI .liesoperator:IF symbol= +sgleichOR symbol=sgroesserOR symbol=sgroessergleichOR symbol=sungleichOR +symbol=skleinerOR symbol=skleinergleichTHEN bedingungCAT sspace;bedingungCAT +symbol;bedingungCAT sspace;operator:=symbol;ELIF okTHEN fehler( +fvergleichsoperwartet);FI .behandlekurs:naechstessymbol;IF symbol=sgleich +THEN bedingungCAT skurs+sspace+sgleich+sspace;bedingungCAT textderlaenge(2, +akurs,sgleich);lieskomma;bedingungCAT textderlaenge(2,akurs,sgleich); +lieskomma;bedingungCAT textderlaenge(4,akurs,sgleich);lieskomma;bedingungCAT +textderlaenge(1,akurs,sgleich);ELSE fehler(fvergleichsoperwartet)FI . +lieskomma:IF symbol=skommaTHEN bedingungCAT symbol;ELIF okTHEN fehler( +fkommaerwartet);FI .liesverknuepfungoderklammerzu:IF endeklammerzuAND symbol= +sklammerzuTHEN naechstessymbol;ELIF symbol=sandOR symbol=sundOR symbol=sorOR +symbol=soderTHEN bedingungCAT sspace;bedingungCAT symbol;bedingungCAT sspace; +naechstessymbol;bedingungCAT normbedingung(endeklammerzu);ELSE fehler( +fbooloperwartet);FI .END PROC normbedingung;TEXT PROC textderlaenge(INT +CONST laenge,art,TEXT CONST operator):TEXT VAR textsammler:=niltext;IF ok +THEN sammletextteile;normieretext;textanhaengen;FI ;textsammler. +sammletextteile:REP naechstessymbol;IF type=ttextTHEN textsammlerCAT symbol +ELIF symbol=sjokerTHEN textsammlerCAT symbolELSE fehler(ftexterwartet);FI ; +naechstessymbol;UNTIL NOT okOR symbol<>splusPER .normieretext:SELECT artOF +CASE atext:textbehandelnCASE adate:datumbehandelnCASE azahl:zahlbehandeln +CASE akurs:kursbehandelnEND SELECT .textbehandeln:WHILE pos(textsammler, +sjoker+sjoker)>0REP change(textsammler,sjoker+sjoker,sjoker);PER ;IF pos( +textsammler,sjoker)=0THEN textsammler:=text(textsammler,laenge);ELIF operator +<>sgleichTHEN fehler(fhierkeinjoker);ELIF length(textsammler)>laengeTHEN +fehler(fpatternzulang);FI .datumbehandeln:textsammler:=datum(datum( +textsammler));IF textsammler=niltextTHEN fehler(fdatumfalsch);FI . +zahlbehandeln:textsammler:=text(int(subtext(textsammler,1,4)));IF length( +textsammler)>laengeOR textsammler=niltextOR NOT lastconversionokTHEN fehler( +fzahlfalsch)ELSE textsammler:=(laenge-length(textsammler))*snull+textsammler; +FI .kursbehandeln:IF pos(textsammler,sjoker)=0THEN textsammler:=text( +textsammler,laenge);ELIF length(textsammler)<>1THEN fehler(fhierkeinjoker); +FI .textanhaengen:IF textsammler<>sjokerTHEN changeall(textsammler,squote, +squote+squote);textsammler:=squote+textsammler+squote;FI .END PROC +textderlaenge;BOOL PROC summeok(INT CONST maskenfeld):TEXT VAR summe:=niltext +;ok:=TRUE ;fehlernr:=0;scan(standardmaskenfeld(maskenfeld));summenormieren; +IF NOT okTHEN standardmeldung(msyntaxfehler,fehlermeldung+meldungzusatz); +ELIF length(summe)>250THEN standardmaskenfeld(summe,maskenfeld); +standardmeldung(mdefzulang,niltext);ELSE standardmaskenfeld(summe,maskenfeld) +;summeIN maskenfeld;FI ;ok.summenormieren:naechstessymbol;REP IF symbol=splus +OR symbol=sminusTHEN summeCAT sspace;summeCAT symbol;naechstessymbol;ELIF +summe>niltextTHEN fehler(frechenoperwartet);FI ;INT CONST feldnr:=int(subtext +(symbol,2,5));IF okTHEN IF type=tnameCAND lastconversionokCAND (symbolSUB 1)= +sfeldCAND (symbolSUB 2)<>snullCAND feldnr>=1CAND feldnr<=felderCAND NOT +isttextfeldTHEN summeCAT sspace;summeCAT symbol;naechstessymbol;ELIF feldnr> +felderTHEN fehler(ffeldnrzuhoch);ELIF isttextfeldTHEN fehler( +ftextfeldsummiert);ELIF okTHEN fehler(ffeldnrerwartet);FI ;FI ;UNTIL type= +tendedestextesOR NOT okPER ;summe:=subtext(summe,2).isttextfeld:toline(stat, +statistikvorzeilen+feldnr);subtext(stat,minbreite+1,minbreite+1)="t".END +PROC summeok;BOOL PROC textok(INT CONST maskenfeld,feldbreite):TEXT VAR tex:= +compress(standardmaskenfeld(maskenfeld));fehlernr:=0;ok:=TRUE ;scan(tex); +naechstessymbol;IF type=tendedestextesTHEN tex:=squote+squoteELIF pos(symbol, +sjoker)>0THEN fehler(fhierkeinjoker)ELIF type<>ttextTHEN fehler(ftexterwartet +);ELIF length(symbol)>feldbreiteTHEN fehler(fzubreit);ELSE naechstessymbol; +IF type<>tendedestextesTHEN fehler(ftexterwartet);FI ;FI ;IF NOT okTHEN +standardmeldung(msyntaxfehler,fehlermeldung+meldungzusatz);ELSE +standardmaskenfeld(tex,maskenfeld);texIN maskenfeld;FI ;ok.END PROC textok; +PROC naechstessymbol:nextsymbol(symbol,type);END PROC naechstessymbol;PROC +fehler(INT CONST nummer):ok:=FALSE ;fehlernr:=nummer;END PROC fehler;TEXT +PROC fehlermeldung:SELECT fehlernrOF CASE fvergleicherwartet: +"Vergleich erwartet"CASE fmerkmalerwartet:"Merkmal m01 bis m50 erwartet"CASE +fvergleichsoperwartet:"=, >, <, >=, <= oder <> erwartet"CASE fkommaerwartet: +"Komma erwartet"CASE ftexterwartet:"""Text"" erwartet"CASE fklammerzuerwartet +:"')' erwartet"CASE fbooloperwartet:"'UND' oder 'ODER' erwartet"CASE +ftextfeldsummiert:"Text-Feld in der Summenformel"CASE fdatumfalsch: +"Datum nicht zulässig"CASE fhierkeinjoker:"'*' nicht zulässig"CASE +frechenoperwartet:"'+' oder '-' erwartet"CASE ffeldnrerwartet: +"Feldnummer (z.B. f17) erwartet"CASE ffeldnrzuhoch:"Feldnummer zu hoch"CASE +fzubreit:"Text länger als Spaltenbreite"CASE fpatternzulang: +"Pattern für das Merkmal zu lang"CASE fzahlfalsch:"Zahl falsch angegeben" +OTHERWISE niltextEND SELECT END PROC fehlermeldung;END PACKET felder; + diff --git a/app/schulis/2.2.1/src/5.manager b/app/schulis/2.2.1/src/5.manager new file mode 100644 index 0000000..c7fb1e4 --- /dev/null +++ b/app/schulis/2.2.1/src/5.manager @@ -0,0 +1,47 @@ +PACKET statistikmanagerDEFINES statistikmanager:LET statistikdatei= +"STATISTIK.",statistikbasis="STATISTIK.basis",statistikverzeichnis= +"statistik verzeichnis",maxstatistiken=200,maxtheslaenge=80,niltext="", +trenner=" ",stichtag="Stichtag ",keinstichtag=" ";LET ack=0, +fetchcode=11,savecode=12,erasecode=14,continuecode=100;THESAURUS VAR +statliste,statbezeichnungen;TEXT VAR filename;BOUND STRUCT (TEXT name, +writepass,readpass)VAR msg;PROC statmanager(DATASPACE VAR ds,INT CONST order, +phase,TASK CONST ordertask):disablestop;IF order>continuecodeTHEN +yterminaldialogELIF order=fetchcodeTHEN ylisteschickenELIF order=savecode +THEN yeintraghinzufuegenELIF order=erasecodeTHEN yeintragloeschenELSE +freemanager(ds,order,phase,ordertask)FI .yeintraghinzufuegen:IF phase=1THEN +getfilename;freemanager(ds,order,phase,ordertask);ELSE freemanager(ds,order, +phase,ordertask);IF NOT iserrorAND exists(filename)THEN eintragloeschen( +filename);eintraghinzufuegen(filename);FI FI .yeintragloeschen:getfilename; +freemanager(ds,order,phase,ordertask);IF NOT iserrorAND phase<>1AND NOT +exists(filename)THEN eintragloeschen(filename);FI .ylisteschicken:getfilename +;IF filename=statistikverzeichnisTHEN schickedenthesaurusELSE freemanager(ds, +order,phase,ordertask)FI .schickedenthesaurus:forget(ds);ds:=nilspace;BOUND +THESAURUS VAR allestatistiken:=ds;allestatistiken:=statbezeichnungen;send( +ordertask,ack,ds);forget(ds).yterminaldialog:freemanager(ds,order,phase, +ordertask);clearerror;statlisteerstellen.getfilename:msg:=ds;filename:=msg. +name.END PROC statmanager;PROC eintragloeschen(TEXT CONST filename): +enablestop;INT VAR index:=link(statliste,filename);IF index>0AND iststatistik +(filename)THEN delete(statliste,index);delete(statbezeichnungen,index);FI +END PROC eintragloeschen;PROC eintraghinzufuegen(TEXT CONST filename): +disablestop;IF iststatistik(filename)THEN eintragbearbeiten(filename);IF +iserrorTHEN clearerror;forget(filename,quiet);FI ;ELIF NOT (filename= +statistikbasis)THEN forget(filename,quiet);FI .END PROC eintraghinzufuegen; +PROC eintragbearbeiten(TEXT CONST filename):enablestop;FILE VAR f:= +sequentialfile(modify,filename);TEXT VAR eintrag,dateizeile;eintrag:=text(int +(statistiknummer),3);eintragCAT trenner;eintragCAT stichtagtext;eintragCAT +trenner;eintragCAT bezeichnung;insert(statliste,filename);insert( +statbezeichnungen,subtext(eintrag,1,maxtheslaenge)).statistiknummer:subtext( +filename,length(statistikdatei)+1).stichtagtext:toline(f,3);readrecord(f, +dateizeile);IF dateizeile>niltextTHEN stichtag+dateizeileELSE keinstichtagFI +.bezeichnung:toline(f,1);readrecord(f,dateizeile);dateizeile.END PROC +eintragbearbeiten;PROC statlisteerstellen:enablestop;INT VAR index:=0;TEXT +VAR eintrag;statliste:=emptythesaurus;statbezeichnungen:=emptythesaurus;get( +all,eintrag,index);WHILE index>0REP eintraghinzufuegen(eintrag);get(all, +eintrag,index);PER ;END PROC statlisteerstellen;BOOL PROC iststatistik(TEXT +CONST filename):enablestop;TEXT CONST zahltext:=subtext(filename,length( +statistikdatei)+1);INT CONST zahl:=int(zahltext);subtext(filename,1,length( +statistikdatei))=statistikdateiAND zahl>=1AND zahl<=maxstatistikenAND text( +zahl)=zahltext.END PROC iststatistik;PROC statistikmanager:statlisteerstellen +;globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT CONST ,TASK CONST ) +statmanager)END PROC statistikmanager;END PACKET statistikmanager; + diff --git a/app/schulis/2.2.1/src/5.merkmale b/app/schulis/2.2.1/src/5.merkmale new file mode 100644 index 0000000..f41709f --- /dev/null +++ b/app/schulis/2.2.1/src/5.merkmale @@ -0,0 +1,52 @@ +PACKET merkmaleDEFINES statfeldname,statfeldlaenge,statfeldpos,statfeldart, +statdatenbasiszeile,vergleichbaresdatum:LET niltext="",space=" ",null="0", +arttext=1,artdate=2,artzahl=3;ROW 50INT CONST feldnr:=ROW 50INT :(5,6,7,8,10, +12,13,0,16,17,18,0,27,35,36,38,39,42,43,44,45,46,47,48,49,50,55,56,58,59,61, +62,64,65,67,68,69,0,0,0,0,0,0,0,0,0,0,0,0,0);ROW 50INT CONST feldlaenge:=ROW +50INT :(8,3,2,4,1,1,2,2,8,1,1,2,3,3,1,1,3,2,8,4,4,4,4,4,4,4,2,3,2,3,2,3,2,3,2 +,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9);ROW 50INT CONST feldpos:=ROW 50INT :(1,9,12, +14,18,19,20,22,24,32,33,34,36,39,42,43,44,47,49,57,61,65,69,73,77,81,85,87,90 +,92,95,97,100,102,105,107,115,123,132,141,150,159,168,177,186,195,204,213,222 +,231);ROW 50INT CONST feldart:=ROW 50INT :(2,1,3,1,1,1,3,1,2,1,1,1,1,1,1,1,1, +3,2,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1);TEXT +CONST leerezeile:=(feldpos[38]-1)*space,leerekurse:=(feldlaenge[38]*(50-37))* +space;TEXT PROC statfeldname(INT CONST merkmal):INT CONST feldnum:=feldnr[ +merkmal];IF feldnum>0THEN name(feldnum)ELIF merkmal=8THEN +"Schulart letzte Schule"ELIF merkmal=12THEN "Schulart neue Schule"ELSE text( +merkmal-37)+". Kurs"FI .END PROC statfeldname;INT PROC statfeldlaenge(INT +CONST merkmal):feldlaenge[merkmal]END PROC statfeldlaenge;INT PROC +statfeldpos(INT CONST merkmal):feldpos[merkmal]END PROC statfeldpos;INT PROC +statfeldart(INT CONST merkmal):feldart[merkmal]END PROC statfeldart;TEXT +PROC statdatenbasiszeile:TEXT VAR zeile:=leerezeile,kurse:=leerekurse,kennung +,schule;INT VAR feldzaehler;holediffdaten;uebertragestandardfelder; +uebertrageschularten;IF hjdatendaTHEN uebertragehjdatenFI ;zeileCAT kurse; +zeile.uebertragestandardfelder:FOR feldzaehlerFROM 1UPTO 38REP IF feldnr[ +feldzaehler]>0THEN replace(zeile,feldpos[feldzaehler],feldinhalt);FI ;PER . +feldinhalt:SELECT feldart[feldzaehler]OF CASE arttext:feldwertCASE artdate: +vergleichbaresdatum(feldwert)CASE artzahl:kennung:=compress(feldwert);( +feldlaenge[feldzaehler]-length(kennung))*null+kennungOTHERWISE niltextEND +SELECT .feldwert:subtext(wert(feldnr[feldzaehler]),1,feldlaenge[feldzaehler]) +.holediffdaten:IF wert(fnrsutiddiffdaten)=niltextTHEN errorstop( +"Keine Diffdaten zu Schüler "+wert(fnrsufamnames));ELSE readtid(dnrdiffdaten, +wert(fnrsutiddiffdaten));FI .uebertrageschularten:schule:=wert( +fnrsuskennlschule);IF schule>niltextTHEN putwert(fnrschkennung,schule);search +(dnrschulen);IF dbstatus=okTHEN replace(zeile,feldpos[8],wert(fnrschart));FI +;FI ;schule:=wert(fnrsuskennnschule);IF schule>niltextTHEN putwert( +fnrschkennung,schule);search(dnrschulen);IF dbstatus=okTHEN replace(zeile, +feldpos[12],wert(fnrschart));FI ;FI .hjdatenda:wert(fnrsutidakthjd)>niltext. +uebertragehjdaten:readtid(dnrhalbjahresdaten,wert(fnrsutidakthjd));kennung:= +wert(fnrhjdkursart);FOR feldzaehlerFROM 0UPTO length(kennung)DIV 2-1REP +replace(kurse,feldzaehler*9+1,diesekurskennung);PER ;kennung:=wert(fnrhjdfach +);FOR feldzaehlerFROM 0UPTO length(kennung)DIV 2-1REP replace(kurse, +feldzaehler*9+3,diesefachkennung);PER ;kennung:=wert(fnrhjdlerngrpkenn);FOR +feldzaehlerFROM 0UPTO length(kennung)DIV 2-1REP replace(kurse,feldzaehler*9+5 +,dieselernkennung);PER ;kennung:=wert(fnrhjdklausurteiln);FOR feldzaehler +FROM 1UPTO length(kennung)REP replace(kurse,feldzaehler*9,dieseklsrkennung); +PER .diesekurskennung:subtext(kennung,feldzaehler*2+1,feldzaehler*2+2). +diesefachkennung:subtext(kennung,feldzaehler*2+1,feldzaehler*2+2). +dieselernkennung:subtext(kennung,feldzaehler*4+1,feldzaehler*4+4). +dieseklsrkennung:kennungSUB feldzaehler.END PROC statdatenbasiszeile;TEXT +PROC vergleichbaresdatum(TEXT CONST dat):INT CONST datzahl:=datum(dat);IF +datzahl<0THEN " 0"+text(datzahl-minint,5)ELSE " 1"+text(datzahl,5)FI END +PROC vergleichbaresdatum;END PACKET merkmale; + diff --git a/app/schulis/2.2.1/src/5.statistik liste b/app/schulis/2.2.1/src/5.statistik liste new file mode 100644 index 0000000..f7c00ca --- /dev/null +++ b/app/schulis/2.2.1/src/5.statistik liste @@ -0,0 +1,27 @@ +PACKET statistiklisteDEFINES statlistezeigen,statlistebearbeiten, +statlisteeintrag:LET statistikserver="statistik server",niltext="", +maxstatistiken=200,null="�",eins="�",maxi="�",mlistewirderstellt=7, +mkeinedaten=68;THESAURUS VAR thesauswahl;TEXT VAR theseintrag;INT VAR +thesindex;BOOL VAR theszeigen;PROC statlistezeigen(INT CONST abnr):BOOL VAR +istleer;standardmeldung(mlistewirderstellt,niltext); +thesauruszeigenvorbereiten(allestatistikensortiert(abnr),istleer);IF istleer +THEN standardmeldung(mkeinedaten,niltext);leave(1);ELSE theszeigen:=TRUE ; +thesauruszeigen;FI .END PROC statlistezeigen;PROC statlistebearbeiten(TEXT +CONST standardmaskenname):IF theszeigenTHEN theszeigen:=FALSE ;thesauswahl:= +thesaurusauswahl;thesindex:=0;standardstartproc(standardmaskenname);FI ;get( +thesauswahl,theseintrag,thesindex);IF thesindex=0THEN theseintrag:=niltext; +ELSE theseintrag:=text(int(theseintrag));FI ;END PROC statlistebearbeiten; +TEXT PROC statlisteeintrag:theseintragEND PROC statlisteeintrag;THESAURUS +PROC allestatistikensortiert(INT CONST abnr):THESAURUS VAR verzeichnis:= +allestatistiken(task(statistikserver)),sortiert:=emptythesaurus;INT VAR index +:=0;TEXT VAR eintrag,sorter:=maxstatistiken*null;get(verzeichnis,eintrag, +index);WHILE index>0REP replace(sorter,int(eintrag),code(index));get( +verzeichnis,eintrag,index);PER ;index:=pos(sorter,eins,maxi,max(1,abnr)); +WHILE index>0REP insert(sortiert,name(verzeichnis,code(sorterSUB index))); +index:=pos(sorter,eins,maxi,index+1);PER ;sortiert.END PROC +allestatistikensortiert;LET statistikverzeichnis="statistik verzeichnis"; +DATASPACE VAR ds;THESAURUS PROC allestatistiken(TASK CONST statmanager): +disablestop;forget(ds);fetch(ds,statistikverzeichnis,statmanager);BOUND +THESAURUS VAR res:=ds;THESAURUS VAR result:=CONCR (res);forget(ds);resultEND +PROC allestatistiken;END PACKET statistikliste; + diff --git a/app/schulis/2.2.1/src/5.thesaurus b/app/schulis/2.2.1/src/5.thesaurus new file mode 100644 index 0000000..571edf9 --- /dev/null +++ b/app/schulis/2.2.1/src/5.thesaurus @@ -0,0 +1,38 @@ +PACKET thesauruszeigenDEFINES thesauruszeigenvorbereiten,thesauruszeigen, +thesaurusblaettern,thesaurusauswahl:LET listenmaskenname="mu objektliste"; +LET niltext="",markoff=" ",markon="x";LET andenanfang=1,andasende=2,vorwaerts +=3,rueckwaerts=4;LET zeileninliste=18,ausgabelaenge=71;THESAURUS VAR +dateiliste;TEXT VAR markmerker;INT VAR erstezeile,letztezeile;PROC +thesauruszeigenvorbereiten(THESAURUS CONST th,BOOL VAR istleer):dateiliste:= +COMPR th;letztezeile:=highestentry(dateiliste);markmerker:=letztezeile* +markoff;erstezeile:=1;istleer:=letztezeile=0;END PROC +thesauruszeigenvorbereiten;PROC thesauruszeigen:standardstartproc( +listenmaskenname);eineseitezeigen;standardnproc;END PROC thesauruszeigen; +PROC thesaurusblaettern(INT CONST wohin):INT VAR merkeerstezeile:=erstezeile; +SELECT wohinOF CASE andenanfang:andendateianfangCASE andasende:andasdateiende +CASE vorwaerts:vorwaertsblaetternindateiCASE rueckwaerts: +rueckwaertsblaetternindateiEND SELECT ;IF merkeerstezeile<>erstezeileTHEN +speicheremarkierungen(merkeerstezeile);eineseitezeigen;ELSE standardmeldung( +72,niltext);FI ;leave(1).andendateianfang:IF erstezeile<>1THEN erstezeile:=1; +FI .andasdateiende:IF erstezeileniltextTHEN replace(markmerker,erstezeile+i-1,markon +);ELSE replace(markmerker,erstezeile+i-1,markoff);FI PER END PROC +speicheremarkierungen;PROC eineseitezeigen:INT VAR i;FOR iFROM 1UPTO +zeileninlisteREP IF aktzeile<=letztezeileTHEN standardmaskenfeld(eintrag,i*2+ +1);standardmaskenfeld(markiert,i*2);ELSE standardmaskenfeld(spaces,i*2+1); +standardmaskenfeld(niltext,i*2);feldschutz(i*2);FI PER ;infeld(2).markiert: +IF (markmerkerSUB (aktzeile))=markonTHEN markonELSE niltextFI .aktzeile: +erstezeile+i-1.eintrag:text(name(dateiliste,aktzeile),ausgabelaenge).spaces: +text(niltext,ausgabelaenge).END PROC eineseitezeigen;THESAURUS OP COMPR ( +THESAURUS CONST th):THESAURUS VAR res:=emptythesaurus;TEXT VAR eintrag;INT +VAR index:=0;get(th,eintrag,index);WHILE index>0REP insert(res,eintrag);get( +th,eintrag,index);PER ;resEND OP COMPR ;END PACKET thesauruszeigen; + diff --git a/app/schulis/2.2.1/src/6.IDA.files b/app/schulis/2.2.1/src/6.IDA.files new file mode 100644 index 0000000..b901335 --- /dev/null +++ b/app/schulis/2.2.1/src/6.IDA.files @@ -0,0 +1,17 @@ +6.db ref.sc +6.db sel.sc +6.db q.sc +6.db snd query.sc +0.ida.data +6.ida.gen +6.ida.druck +0.ida.form +6.ida.def.druck +6.ida.grund +6.ida.check +6.ida.plausi +6.ida.definieren +6.ida.auswahl +6.ida.eingang + + diff --git a/app/schulis/2.2.1/src/6.db q.sc b/app/schulis/2.2.1/src/6.db q.sc new file mode 100644 index 0000000..4b3c2b2 --- /dev/null +++ b/app/schulis/2.2.1/src/6.db q.sc @@ -0,0 +1,222 @@ +#$IF mitinternerqueryTHEN #PACKET queryparserDEFINES QUERY ,query, +getscanbedingung,getdnr,getinr,getanzahlverbunde,getselpointer, +getstopbedpointer,getquery,putquery,setzeschluessel,getanzahltupel, +getswanzfld,getswnachfld,getswvonfld,getswallefelder,getswfwert,getsohnverb, +getbruderverb,geterstestupel,puterstestupel,selektionerfuellt,initquery,:=, +baumdurchlauf,listeschluessel,putletzterverbund,getletzterverbund,puttid, +gettid,getbruder,putbruder,tidfeld,updatefnr,updateausdruck,queryart, +anzupdatefelder:TYPE UPDSTACK =STRUCT (INT uuuuuv,TEXT uuuuuw);BOUND ROW 100 +UPDSTACK VAR uuuuux;TYPE VERBELEMENT =STRUCT (TEXT uuuuuy,uuuuuz,BOOL uuuuvu, +INT uuuuvv,uuuuvw,uuuuvx,uuuuvy,uuuuvz,uuuuwu);TYPE VERBUND =ROW uuuuwv +VERBELEMENT ;TYPE QUERY =STRUCT (INT uuuuww,uuuuwx,uuuuwy,TEXT uuuuwz,uuuuxu, +SELEKTION uuuuxv,VERBUND uuuuxw,SCHLUESSEL uuuuxx);TYPE SWERT =STRUCT (INT +uuuuxy,uuuuxz,TEXT wert);TYPE SCHLUESSELWERTE =STRUCT (BOOL uuuuyu,INT uuuuyv +,ROW uuuuywSWERT uuuuyx);TYPE SCHLUESSEL =ROW uuuuwvSCHLUESSELWERTE ;LET +uuuuyz=0,uuuuzu=1,uuuuzv=2,uuuuzw=3,uuuuzx=6,uuuuzy=5,uuuuzz=7,uuuvuu=7, +uuuvuv=4,uuuvuw="BY",uuuvux="UPDATE",uuuvuy="DELETE",uuuvuz=".query",uuuvvu= +";",uuuvvv="(",uuuvvw=")",#uuuvvx=",",uuuvvy="=",uuuvvz=">=",uuuvwu="<=",# +uuuvwv="/",uuuvww="""",uuuvwx=".",uuuvwy=":",uuuvwz=" ",uuuvxu=":=",uuuvxv= +"<",uuuuwv=10,uuuvxx=20,uuuuyw=10,uuuvxz=80,uuuvyu=1,uuuvyv=2,uuuvyw=3;INT +VAR uuuvyx:=-5,uuuvyy:=-33,uuuvyz;DATASPACE VAR uuuvzu:=nilspace;INT VAR +uuuvzv:=0;INT PROC tidfeld:uuuvyyENDPROC tidfeld;FILE VAR uuuvzz;TEXT VAR +uuuwuu:="",uuuwuv:="",uuuwuw:="",uuuwux:="";INT VAR uuuwuy,uuuwuz,uuuwvu; +BOOL VAR uuuwvv,uuuwvw;INT VAR uuuwvx:=0,uuuwvy,uuuwvz;ROW uuuvxxTEXT VAR +uuuwwv;OP :=(QUERY VAR uuuwww,QUERY CONST uuuwwx):CONCR (uuuwww):=CONCR ( +uuuwwx)ENDOP :=;OP :=(VERBELEMENT VAR uuuwww,VERBELEMENT CONST uuuwwx):CONCR +(uuuwww):=CONCR (uuuwwx)ENDOP :=;OP :=(VERBUND VAR uuuwww,VERBUND CONST +uuuwwx):CONCR (uuuwww):=CONCR (uuuwwx)ENDOP :=;INT PROC updatefnr(INT CONST +uuuwyx):uuuuux[uuuwyx].uuuuuvENDPROC updatefnr;TEXT PROC updateausdruck(INT +CONST uuuwyx):uuuuux[uuuwyx].uuuuuwENDPROC updateausdruck;INT PROC queryart: +uuuvzvENDPROC queryart;PROC queryart(INT CONST uuuxvu):uuuvzv:=uuuxvuENDPROC +queryart;INT PROC anzupdatefelder:uuuvyzENDPROC anzupdatefelder;PROC +initquery(QUERY VAR uuuxww):uuuxwx;uuuxww.uuuuww:=0;uuuxww.uuuuwx:=0;uuuxww. +uuuuwz:="";uuuxww.uuuuxu:="";initselektionen(uuuxww.uuuuxv);uuuxyw(uuuxww. +uuuuxw);uuuxyz(uuuxww.uuuuxx)ENDPROC initquery;PROC uuuxwx:forget(uuuvzu); +uuuvzu:=nilspace;uuuuux:=uuuvzuENDPROC uuuxwx;initquery(uuuyuy);PROC uuuxyw( +VERBUND VAR uuuyvu):FOR uuuwvyFROM 1UPTO uuuuwvREP uuuyvx(uuuyvu[uuuwvy])PER +ENDPROC uuuxyw;PROC uuuyvx(VERBELEMENT VAR uuuyww):uuuyww.uuuuuy:="";uuuyww. +uuuuuz:=""ENDPROC uuuyvx;#BOUND QUERY VAR uuuyuy;#QUERY VAR uuuyuy;PROC +getquery(QUERY VAR uuuxww):CONCR (uuuxww):=CONCR (uuuyuy)ENDPROC getquery; +PROC putquery(QUERY CONST uuuxww):CONCR (uuuyuy):=CONCR (uuuxww)ENDPROC +putquery;PROC query:query(lastparam)ENDPROC query;PROC uuuyzz(TEXT CONST +uuuzuu):TEXT VAR uuuzuv:="",uuuzuw:="",uuuzux:="",uuuwuv:="";INT VAR uuuzuz; +uuuxwx;uuuzvv;nextsymbol;queryparser(uuuzvx);uuuzvy;uuuzvz;uuuzwu;uuuzwv; +baumdurchlauf;.uuuzvy:nextsymbol;WHILE uuuwuy<>uuuuzzREP uuuzxu;nextsymbol +PER .uuuzxu:uuuzuw:="";IF uuuwuy<>uuuuzuTHEN uuuzxz( +"Refinementname erwartet: "+uuuwuu)ELSE uuuzuv:=uuuwuu;nextsymbol;IF uuuwuu<> +uuuvwyTHEN uuuzxz(uuuvww+uuuvwy+uuuvww+" erwartet: "+uuuwuu)ELSE uuuzzy; +putref(uuuzuv,uuuzuw)FI FI .uuuzzy:nextsymbol;WHILE uuuwuy<>uuuuzzCAND uuuwuu +<>uuuvwxREP uuuzuw:=uuuzuw+uuvuvw;nextsymbolPER ;IF uuuwuy=uuuuzzTHEN uuuzxz( +"Refinement nicht mit ""."" abgeschlossen")FI .uuuzvv:enablestop;uuuvzz:= +sequentialfile(input,uuuzuu);IF exists(uuuzuu+uuuvuz)THEN forget(uuuzuu+ +uuuvuz,quiet)FI ;#uuuyuy:=new(uuuzuu+uuuvuz);#lastparam(uuuzuu);uuvuxz(0); +uuuwvx:=0;clearrefs;scan(uuuvzz);.uuuzwu:FOR uuuzuzFROM 1UPTO uuuwvxREP +uuuzux:="";uuuwuv:=uuvuzv(uuuzuz);scan(uuuwuv);nextsymbol(uuuwuu,uuuwuy); +WHILE uuuwuy<>uuuuzzREP IF uuuwuy=uuuuzuTHEN uuuzux:=uuuzux+getreftext(uuuwuu +)ELSE uuuzux:=uuuzux+uuvuvwFI ;nextsymbol(uuuwuu,uuuwuy)PER ;uuvvwu(uuuzux, +uuuzuz)PER .uuuzwv:INT VAR uuvvwy;initsel(uuuyuy.uuuuxv);FOR uuuzuzFROM 1 +UPTO getanzahlverbundeREP uuvvxx;uuvvxyPER .uuvvxx:uuvvwy:=getstopbedpointer( +uuuzuz);IF uuvvwy>uuuuyzTHEN uuuwuv:=uuvuzv(uuvvwy);uuvvzw(baueselektionauf( +uuuyuy.uuuuxv,uuuwuv),uuuzuz)FI .uuvvxy:uuvvwy:=getselpointer(uuuzuz);IF +uuvvwy>uuuuyzTHEN uuuwuv:=uuvuzv(uuvvwy);uuvwvy(baueselektionauf(uuuyuy. +uuuuxv,uuuwuv),uuuzuz)FI .ENDPROC uuuyzz;PROC uuuzvz:INT VAR uuuzuz:=1;BOOL +VAR uuvwxu:=FALSE ;TEXT VAR uuuzux:="";WHILE uuuzuz<=getanzahlverbundeREP +uuuzux:="";uuuwuv:=getscanbedingung(uuuzuz);scan(uuuwuv);nextsymbol(uuuwuu, +uuuwuy);WHILE uuuwuy<>uuuuzzREP IF uuuwuy=uuuuzuTHEN uuuzux:=uuuzux+ +getreftext(uuuwuu)ELSE uuuzux:=uuuzux+uuvuvwFI ;nextsymbol(uuuwuu,uuuwuy)PER +;IF getdnr(uuuzuz)=uuuvyxTHEN queryparser(uuuzux,uuuzuz);uuvwxu:=TRUE ELSE +uuvxwu(uuuzux,uuuzuz)FI ;uuuzuzINCR 1PER ;IF uuvwxuTHEN uuuzvzFI ENDPROC +uuuzvz;PROC queryparser(TEXT CONST uuuwuv,INT CONST uuvxxx):INT VAR uuvxxy; +scan(uuuwuv);nextsymbol;uuvxyu;queryparser(uuvxxx);uuvxyx.uuvxyu:uuvxxy:= +getbruderverb(uuvxxx);.uuvxyx:uuvxzx(uuvxxy,uuvxxx).ENDPROC queryparser;PROC +queryparser(INT CONST uuvxxx):TEXT VAR uuvyux:="";BOOL VAR uuvyuy:=FALSE ; +uuuvzv:=0;REP uuvyvu;UNTIL uuvyuyPER ;uuvyvw;uuvyvx;uuvyvy;uuvyvz;SELECT +uuuvzvOF CASE uuuvyv,uuuvyu:uuvywx;IF uuvxxx=1THEN uuvywzFI CASE uuuvyw: +uuvyxvENDSELECT .uuvyvu:IF uuuwuy=uuuvuvTHEN uuvyxz(dateinr(uuuwuu),uuvxxx); +IF uuuvzv<1THEN uuuvzv:=uuuvyuFI ;uuvyuy:=TRUE ELSE IF uuuwuy=uuuuzvTHEN IF +uuuwuu=uuuvuxTHEN nextsymbol;uuuvzv:=uuuvywELIF uuuwuu=uuuvuyTHEN nextsymbol; +uuuvzv:=uuuvyvELSE uuuzxz("Dateiname nicht gefunden: "+uuuwuu)FI FI FI . +uuvyvw:nextsymbol;IF uuuwuy=uuuuzvCAND uuuwuu=uuuvuwTHEN uuvzvz;uuvzwuELSE +IF uuuwuy=uuuuzxCAND uuuwuu=uuuvvvTHEN uuvzwz(#getdnr(uuvxxx)#0,uuvxxx)ELSE +uuuzxz("Indexname bzw. ""("" fehlt")FI FI .uuvzvz:nextsymbol;IF uuuwuy=uuuvuv +THEN uuvzwz(indexnr(uuuwuu),uuvxxx)ELSE uuuzxz("Indexname nicht gefunden: "+ +uuuwuu)FI .uuvzwu:nextsymbol;IF NOT (uuuwuy=uuuuzxCAND uuuwuu=uuuvvv)THEN +uuuzxz(uuuvww+uuuvvv+uuuvww+" erwartet")FI .uuvyvx:uuwuuy(uuuwuv);uuvxwu( +uuuwuv,uuvxxx);.uuvyvy:BOOL VAR stop:=TRUE ;uuwuvy.uuvyvz:stop:=FALSE ;uuwuvy +.uuwuvy:INT VAR uuvvwy;uuuwuw:="";IF NOT uuuwvvTHEN uuwuuy(uuuwuw);IF uuuwuw= +""THEN IF stopTHEN uuvvzw(uuuuyz,uuvxxx)ELSE uuvwvy(uuuuyz,uuvxxx)FI ELSE +uuvvwy:=uuwuyx;IF stopTHEN uuvvzw(uuvvwy,uuvxxx)ELSE uuvwvy(uuvvwy,uuvxxx)FI +;uuvvwu(uuuwuw,uuvvwy)FI ELSE uuvwvy(uuuuyz,uuvxxx)FI .uuvywx:INT VAR uuwvuz; +IF NOT uuuwvvTHEN uuwvvv(uuvxxx,uuwvuz);uuwvvy(uuwvuz,uuvxxx);uuvxzx(uuuuyz, +uuvxxx)FI .uuvywz:nextsymbol;IF uuuwuy=uuuuzxOR uuuwuy=uuuuzzOR uuuwuy=uuuuzy +THEN IF uuuwuu<>uuuvwvTHEN uuwvyvFI ;uuuuwx;uuwvyxELSE uuuzxz(uuuvww+uuuvwv+ +uuuvww+" bzw. "+uuuvww+uuuvvu+uuuvww+uuuvwv+uuuvww+uuuvwx+uuuvww+" erwartet") +FI .uuwvyv:IF uuuwuu=uuuvvuOR uuuwuu=uuuvwxOR uuuwuy=uuuuzzTHEN uuwwvy(0); +LEAVE uuvywzELSE uuuzxz("Falscher Tupelzahl-Operator: "+uuuwuu)FI .uuuuwx: +nextsymbol;IF uuuwuy=uuuuzwTHEN uuwwvy(int(uuuwuu));ELSE uuuzxz( +"Keine Zahlenangabe: "+uuuwuu)FI .uuwvyx:nextsymbol;IF uuuwuy<>uuuuzzCAND ( +NOT (uuuwuu=uuuvvuCOR uuuwuu=uuuvwx))THEN uuuzxz("""."" oder "";"" erwartet") +FI .uuvyxv:uuuvyz:=0;nextsymbol;WHILE NOT uuuwvvREP uuuvyzINCR 1;uuwwzx; +uuwwzy;uuwwzz;PER .uuwwzx:IF uuuwuy=uuuuzuTHEN uuwxuxELSE uuwxuyFI .uuwxux: +uuuzxz("Zur Zeit keine Refinements in Update-Liste erlaubt!").uuwxuy:uuuuux[ +uuuvyz].uuuuuv:=feldnr(uuuwuu);IF uuuuux[uuuvyz].uuuuuv<3THEN uuuzxz( +"Falscher Feldname: "+uuuwuu)FI ;nextsymbol.uuwwzy:IF NOT (uuuwuy=uuuuzyCAND +uuuwuu=uuuvxu)THEN uuuzxz("Keine Zuweisung: "+uuuwuu)FI .uuwwzz:uuwxyv(uuvyux +);uuuuux[uuuvyz].uuuuuw:=uuvyux;nextsymbol.ENDPROC queryparser;PROC uuwxyv( +TEXT VAR uuwxzx):INT VAR uuwxzy:=0,uuwxzz:=0;uuwxzx:="";uuuwuu:="";uuuwuy:=0; +REP uuwxzx:=uuwxzx+uuvuvw;uuwxzy:=uuuwuy;nextsymbolUNTIL uuwyvwPER .uuwyvw: +IF (uuuwuy=uuuuzxCAND (uuuwuu=uuuvvuCOR (uuuwuu=uuuvvwCAND uuwxzz=0)))THEN +uuuwvv:=uuuwuu=uuuvvw;TRUE ELSE IF uuuwuy=uuuuzzTHEN uuuzxz( +"Vorzeitiges END OF FILE!");FALSE ELSE IF uuuwuy=uuuuzxTHEN IF uuuwuu=uuuvvv +THEN uuwxzzINCR 1FI ;IF uuuwuu=uuuvvwTHEN uuwxzzDECR 1FI ;FI ;FALSE FI FI . +ENDPROC uuwxyv;PROC uuwvvv(INT CONST uuvxxx,INT VAR uuwvuz):INT VAR uuwyzz:= +uuuuyz;uuwvuz:=uuuuyz;nextsymbol;IF uuuwuy=uuuuzxCAND uuuwuu=uuuvvwTHEN +uuuwvv:=TRUE ;LEAVE uuwvvvELIF uuuwuy=uuuuzuTHEN uuwvuz:=uuuzvx;uuvxwu(uuuwuu +,uuwvuz);uuvwvy(uuuuyz,uuwvuz);uuvyxz(uuuvyx,uuwvuz);uuwvvv(uuwvuz,uuwyzz); +uuvxzx(uuwyzz,uuwvuz)ELIF uuuwuy=uuuvuvTHEN uuwvuz:=uuuzvx;queryparser(uuwvuz +);uuuwvv:=FALSE ;uuwvvv(uuwvuz,uuwyzz);uuvxzx(uuwyzz,uuwvuz)ELIF (uuuwuy= +uuuuzxCAND uuuwuu=uuuvvu)THEN uuwvvv(uuvxxx,uuwvuz)ELSE uuuzxz( +"Verbund-Fehler bei : "+uuuwuu)FI ENDPROC uuwvvv;PROC uuwuuy(TEXT VAR uuwxzx) +:INT VAR uuwxzy:=0;uuwxzx:="";uuuwuu:="";uuuwuy:=0;uuuwvv:=FALSE ;REP uuwxzx +:=uuwxzx+uuvuvw;uuwxzy:=uuuwuy;nextsymbolUNTIL uuxuyxPER .uuxuyx:IF (uuuwuy= +uuuuzyCAND uuuwuu=uuuvwv)THEN TRUE ELSE IF uuuwuy=uuuuzzTHEN uuuzxz(uuuvww+ +uuuvwv+uuuvww+" fehlt");FALSE ELSE FALSE FI FI .ENDPROC uuwuuy;TEXT PROC +uuvuvw:IF uuuwuy=uuuvuvTHEN uuuvww+uuuwuu+uuuvwwELIF uuuwuy=uuuuzvTHEN uuuvwz ++uuuwuu+uuuvwzELSE uuuwuuFI ENDPROC uuvuvw;PROC nextsymbol:nextsymbol(uuuvzz, +uuuwuu,uuuwuy);ENDPROC nextsymbol;PROC uuuzxz(TEXT CONST uuxvxx):errorstop( +"Zeile "+text(lineno(uuuvzz))+" : "+uuxvxx)ENDPROC uuuzxz;PROC puterstestupel +(TEXT CONST uuxvyw):uuuyuy.uuuuwz:=uuxvywENDPROC puterstestupel;TEXT PROC +geterstestupel:uuuyuy.uuuuwzENDPROC geterstestupel;PROC uuxvzz(TEXT CONST +uuxvyw):uuuyuy.uuuuxu:=uuxvywENDPROC uuxvzz;TEXT PROC uuxwuz:uuuyuy.uuuuxu +ENDPROC uuxwuz;PROC uuwwvy(INT CONST uuxwvy):uuuyuy.uuuuwx:=uuxwvyENDPROC +uuwwvy;INT PROC getanzahltupel:uuuyuy.uuuuwxENDPROC getanzahltupel;PROC +putletzterverbund(INT CONST uuxwxw):uuuyuy.uuuuwy:=uuxwxwENDPROC +putletzterverbund;INT PROC getletzterverbund:uuuyuy.uuuuwyENDPROC +getletzterverbund;PROC puttid(INT CONST uuxwzu,TEXT CONST uuxwzv):uuuyuy. +uuuuxw[uuxwzu].uuuuuz:=uuxwzvENDPROC puttid;TEXT PROC gettid(INT CONST uuxwzu +):uuuyuy.uuuuxw[uuxwzu].uuuuuzENDPROC gettid;PROC putbruder(INT CONST uuxwzu, +BOOL CONST uuxxvz):uuuyuy.uuuuxw[uuxwzu].uuuuvu:=uuxxvzENDPROC putbruder; +BOOL PROC getbruder(INT CONST uuxwzu):uuuyuy.uuuuxw[uuxwzu].uuuuvuENDPROC +getbruder;PROC uuvxwu(TEXT CONST uuxxyw,INT CONST uuuzuz):uuuyuy.uuuuxw[ +uuuzuz].uuuuuy:=uuxxywENDPROC uuvxwu;TEXT PROC getscanbedingung(INT CONST +uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuuyENDPROC getscanbedingung;PROC uuvyxz(INT +CONST uuxyvu,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvv:=uuxyvuENDPROC uuvyxz;PROC +uuvzwz(INT CONST uuxywx,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvw:=uuxywxENDPROC +uuvzwz;INT PROC getdnr(INT CONST uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvvENDPROC +getdnr;INT PROC getinr(INT CONST uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvwENDPROC +getinr;PROC uuvwvy(INT CONST uuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvx:= +uuxzuwENDPROC uuvwvy;INT PROC getselpointer(INT CONST uuuzuz):uuuyuy.uuuuxw[ +uuuzuz].uuuuvxENDPROC getselpointer;PROC uuvvzw(INT CONST uuxzuw,uuuzuz): +uuuyuy.uuuuxw[uuuzuz].uuuuvy:=uuxzuwENDPROC uuvvzw;INT PROC getstopbedpointer +(INT CONST uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvyENDPROC getstopbedpointer; +PROC uuvxzx(INT CONST uuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvz:=uuxzuw +ENDPROC uuvxzx;INT PROC getbruderverb(INT CONST uuuzuz):uuuyuy.uuuuxw[uuuzuz] +.uuuuvzENDPROC getbruderverb;PROC uuwvvy(INT CONST uuxzuw,uuuzuz):uuuyuy. +uuuuxw[uuuzuz].uuuuwu:=uuxzuwENDPROC uuwvvy;INT PROC getsohnverb(INT CONST +uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuwuENDPROC getsohnverb;PROC uuvuxz(INT +CONST uuyuzu):uuuyuy.uuuuww:=uuyuzuENDPROC uuvuxz;INT PROC getanzahlverbunde: +uuuyuy.uuuuwwENDPROC getanzahlverbunde;INT PROC uuuzvx:INT VAR uuyuzu:= +getanzahlverbunde+1;uuvuxz(uuyuzu);uuvxzx(uuuuyz,uuyuzu);uuwvvy(uuuuyz,uuyuzu +);uuvxwu("",uuyuzu);uuyuzuENDPROC uuuzvx;INT PROC uuwuyx:uuuwvxINCR 1;uuuwvx +ENDPROC uuwuyx;PROC uuvvwu(TEXT CONST uuuwuw,INT CONST uuvvwy):uuuwwv[uuvvwy] +:=uuuwuwENDPROC uuvvwu;TEXT PROC uuvuzv(INT CONST uuvvwy):uuuwwv[uuvvwy] +ENDPROC uuvuzv;PROC baumdurchlauf:IF mittestausgabenTHEN uuyvzzFI .uuyvzz: +INT VAR uuywuv;FOR uuywuvFROM 1UPTO getanzahlverbundeREP note("Verbund : "+ +text(uuywuv));noteline;note(" Datei : "+text(getdnr(uuywuv)));noteline;note +(" Index : "+text(getinr(uuywuv)));noteline;note(" Scan : "+ +getscanbedingung(uuywuv));noteline;note(" Bruder: "+text(getbruderverb( +uuywuv)));noteline;note(" Sohn : "+text(getsohnverb(uuywuv)));noteline; +note(" SelPoi: "+text(getselpointer(uuywuv)));noteline;noteline;PER ; +checkselektion(uuuyuy.uuuuxv).ENDPROC baumdurchlauf;PROC setzeschluessel(INT +CONST uuxwzu):TEXT VAR uuywxy:=getscanbedingung(uuxwzu);scan(uuywxy); +nextsymbol;uuywyw;uuywyx;uuywyy;uuywyz;WHILE uuuwuy<>uuuvuuREP IF uuuwuu= +uuuvxvTHEN nextsymbol;uuywzy(uuxwzu,uuyxuu,uuuwuu);uuyxuw(uuxwzu,uuyxuu, +uuyxuz);uuyxvu(uuxwzu,uuyxuu,0);ELIF uuuwuy=uuuvuvTHEN uuywzy(uuxwzu,uuyxuu, +"");uuyxuw(uuxwzu,uuyxuu,uuyxuz);uuyxvu(uuxwzu,uuyxuu,feldnr(uuuwuu));ELIF +uuuwuu=uuuvvuTHEN uuyxyuFI ;nextsymbolPER ;uuyxyv.uuywyx:IF uuuwuy=uuuvuv +CAND feldtyp(feldnr(uuuwuu))=uuuvxzTHEN uuywzy(uuxwzu,1,"");uuyxuw(uuxwzu,1, +tidfeld);uuyxvu(uuxwzu,1,feldnr(uuuwuu));uuyyux(uuxwzu,TRUE );uuyyuz(uuxwzu,1 +);LEAVE setzeschluesselFI ;.uuywyz:uuywzy(uuxwzu,1,"");uuyxuw(uuxwzu,1,0); +uuyxvu(uuxwzu,1,0).uuyxyu:IF uuuwvwTHEN uuyxuzINCR 1ELSE uuuwuz:=uuuwvu+1; +uuuwvu:=pos(uuuwux,uuuvvu,uuuwuz);uuyxuz:=uuxyvu+int(subtext(uuuwux,uuuwuz, +uuuwvu-1))FI ;uuyxuuINCR 1.uuywyw:INT VAR uuyyzv:=getinr(uuxwzu),uuxyvu:= +getdnr(uuxwzu),uuyxuz;IF uuyyzv=0THEN uuuwvw:=TRUE ;uuyxuz:=uuxyvu+1ELSE +uuuwux:=zugriff(uuyyzv);uuuwvu:=pos(uuuwux,uuuvvu);uuyxuz:=int(subtext(uuuwux +,1,uuuwvu-1))+uuxyvu;uuuwvw:=FALSE FI .uuyzwy:IF uuuwvwTHEN (uuyxuz-uuxyvu)= +anzkey(uuxyvu)ELSE uuuwvu=length(uuuwux)FI .uuywyy:INT VAR uuyxuu:=1;IF +uuuwuy=uuuvuuTHEN uuyxuu:=0FI .uuyxyv:uuyyux(uuxwzu,uuyzwyCAND (uuyxuu>0)); +uuyyuz(uuxwzu,uuyxuu).ENDPROC setzeschluessel;PROC uuyxvu(INT CONST uuxwzu, +uuzuux,uuyxuz):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxy:=uuyxuzENDPROC +uuyxvu;PROC uuyxuw(INT CONST uuxwzu,uuzuux,uuyxuz):uuuyuy.uuuuxx[uuxwzu]. +uuuuyx[uuzuux].uuuuxz:=uuyxuzENDPROC uuyxuw;INT PROC getswvonfld(INT CONST +uuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxyENDPROC getswvonfld +;INT PROC getswnachfld(INT CONST uuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[ +uuzuux].uuuuxzENDPROC getswnachfld;PROC uuywzy(INT CONST uuxwzu,uuzuux,TEXT +CONST uuzvwu):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].wert:=uuzvwuENDPROC uuywzy +;TEXT PROC getswfwert(INT CONST uuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[ +uuzuux].wertENDPROC getswfwert;PROC uuyyux(INT CONST uuxwzu,BOOL CONST uuzvzv +):uuuyuy.uuuuxx[uuxwzu].uuuuyu:=uuzvzvENDPROC uuyyux;BOOL PROC +getswallefelder(INT CONST uuxwzu):uuuyuy.uuuuxx[uuxwzu].uuuuyuENDPROC +getswallefelder;PROC uuyyuz(INT CONST uuxwzu,uuzwvz):uuuyuy.uuuuxx[uuxwzu]. +uuuuyv:=uuzwvzENDPROC uuyyuz;INT PROC getswanzfld(INT CONST uuxwzu):uuuyuy. +uuuuxx[uuxwzu].uuuuyvENDPROC getswanzfld;PROC query(TEXT CONST uuzwyw):INT +VAR uuuzuz;uuuyzz(uuzwyw);FOR uuuzuzFROM 1UPTO getanzahlverbundeREP +setzeschluessel(uuuzuz)PER ;listeschluesselENDPROC query;OP :=( +SCHLUESSELWERTE VAR uuuwww,SCHLUESSELWERTE CONST uuuwwx):CONCR (uuuwww):= +CONCR (uuuwwx)ENDOP :=;OP :=(SWERT VAR uuuwww,SWERT CONST uuuwwx):CONCR ( +uuuwww):=CONCR (uuuwwx)ENDOP :=;OP :=(SCHLUESSEL VAR uuuwww,SCHLUESSEL CONST +uuuwwx):CONCR (uuuwww):=CONCR (uuuwwx)ENDOP :=;PROC listeschluessel:IF NOT +mittestausgabenTHEN LEAVE listeschluesselFI ;INT VAR uuuzuz,uuywuv;FOR uuuzuz +FROM 1UPTO getanzahlverbundeREP noteline;note("Verbund : "+text(uuuzuz)); +noteline;note("=============");noteline;noteline;note("ANZAHL FLD: "+text( +getswanzfld(uuuzuz)));noteline;note("ALLE : "+uuzxxx);noteline;noteline; +FOR uuywuvFROM 1UPTO getswanzfld(uuuzuz)REP note(" VON : "+text(getswvonfld +(uuuzuz,uuywuv)));noteline;note(" NACH: "+text(getswnachfld(uuuzuz,uuywuv)) +);noteline;note(" WERT: "+getswfwert(uuuzuz,uuywuv));noteline;PER PER . +uuzxxx:IF getswallefelder(uuuzuz)THEN "vollständiger Schlüssel"ELSE +"unvollständiger Schlüssel"FI .ENDPROC listeschluessel;BOOL PROC +selektionerfuellt(INT CONST uuzyux):werteselektionaus(uuuyuy.uuuuxv,uuzyux) +ENDPROC selektionerfuellt;PROC uuuxyz(SCHLUESSEL VAR uuzyvx):FOR uuuwvyFROM 1 +UPTO uuuuwvREP FOR uuuwvzFROM 1UPTO uuuuywREP uuzyvx[uuuwvy].uuuuyx[uuuwvz]. +wert:=""PER PER ENDPROC uuuxyz;ENDPACKET queryparser;#$FI # + diff --git a/app/schulis/2.2.1/src/6.db ref.sc b/app/schulis/2.2.1/src/6.db ref.sc new file mode 100644 index 0000000..58b059b --- /dev/null +++ b/app/schulis/2.2.1/src/6.db ref.sc @@ -0,0 +1,20 @@ +#$IF mitinternerqueryTHEN #PACKET queryrefDEFINES putref,getreftext, +anzahlrefs,listerefs,clearrefs:LET uuuuuv=50,uuuuuw=1,uuuuux=2;LET +REFELEMENT =ROW 2TEXT ;TYPE REFINEMENT =STRUCT (INT uuuuuy,ROW uuuuuv +REFELEMENT uuuuvu);REFINEMENT VAR uuuuvv;PROC putref(TEXT CONST uuuuvw,uuuuvx +):INT VAR uuuuvy;FOR uuuuvyFROM 1UPTO uuuuvv.uuuuuyREP IF uuuuvv.uuuuvu[ +uuuuvy][uuuuuw]=uuuuvwTHEN uuuuvv.uuuuvu[uuuuvy][uuuuuw]:=uuuuvx;LEAVE putref +FI PER ;IF uuuuvv.uuuuuy=uuuuuvTHEN errorstop("Zuviele Refinements!")FI ; +uuuuvv.uuuuuyINCR 1;uuuuvv.uuuuvu[uuuuvv.uuuuuy][uuuuuw]:=uuuuvw;uuuuvv. +uuuuvu[uuuuvv.uuuuuy][uuuuux]:=uuuuvxENDPROC putref;TEXT PROC getreftext( +TEXT CONST uuuuvw):INT VAR uuuuvy;FOR uuuuvyFROM 1UPTO uuuuvv.uuuuuyREP IF +uuuuvv.uuuuvu[uuuuvy][uuuuuw]=uuuuvwTHEN LEAVE getreftextWITH uuuuvv.uuuuvu[ +uuuuvy][uuuuux]FI PER ;uuuuvwENDPROC getreftext;PROC clearrefs:INT VAR uuuuvy +;FOR uuuuvyFROM 1UPTO uuuuvv.uuuuuyREP uuuuvv.uuuuvu[uuuuvy][uuuuuw]:=""; +uuuuvv.uuuuvu[uuuuvy][uuuuux]:=""PER ;uuuuvv.uuuuuy:=0ENDPROC clearrefs;INT +PROC anzahlrefs:uuuuvv.uuuuuyENDPROC anzahlrefs;PROC listerefs:INT VAR uuuwuu +;note("Liste der Refinements :");noteline;note("======================="); +noteline;noteline;FOR uuuwuuFROM 1UPTO anzahlrefsREP note(text(uuuuvv.uuuuvu[ +uuuwuu][uuuuuw],30)+":"+uuuuvv.uuuuvu[uuuwuu][uuuuux]);notelinePER ENDPROC +listerefs;ENDPACKET queryref;#$FI # + diff --git a/app/schulis/2.2.1/src/6.db sel.sc b/app/schulis/2.2.1/src/6.db sel.sc new file mode 100644 index 0000000..4577620 --- /dev/null +++ b/app/schulis/2.2.1/src/6.db sel.sc @@ -0,0 +1,127 @@ +PACKET queryselektionDEFINES SELEKTION ,#putoptyp,putrechts,putlinks, +putselwert,#optyp,rechts,links,selwert,fnrlinks,fnrrechts,#allocselelement,# +:=,checkselektion,baueselektionauf,werteselektionaus,mittestausgaben, +initselektionen,initsel,initialisiereselektion,lex,lexon,lexoff:LET uuuuuv=0, +uuuuuw=1,uuuuux=2,uuuuuy=6,uuuuuz=7,uuuuvu=8,uuuuvv=9,#uuuuvw=1,uuuuvx=3,# +uuuuvy=2,uuuuvz=4,uuuuwu=5,uuuuwv=10,uuuuww=11,uuuuwx=12,uuuuwy=13,uuuuwz=14, +uuuuxu=15,uuuuxv=16,uuuuxw=17,uuuuxx=18,uuuuxy=19,uuuuxz=20,uuuuyu=30,uuuuyv= +73,uuuuyw=82,uuuuyx=68,uuuuyy=84;TYPE NODE =STRUCT (INT uuuuyz,uuuuzu,uuuuzv, +TEXT selwert);TYPE SELEKTION =STRUCT (INT uuuuzx,ROW uuuuyuNODE exp);INT VAR +uuuuzz,uuuvuu,uuuvuv;REAL VAR uuuvuw,uuuvux;TEXT VAR uuuvuy,uuuvuz;INT VAR +uuuvvu;TEXT VAR uuuvvv:="";BOOL VAR uuuvvw:=FALSE ,lexsort:=FALSE ;BOOL PROC +lex:lexsortENDPROC lex;PROC lexon:lexsort:=TRUE ENDPROC lexon;PROC lexoff: +lexsort:=FALSE ENDPROC lexoff;PROC mittestausgaben(BOOL CONST uuuvwy):uuuvvw +:=uuuvwyENDPROC mittestausgaben;BOOL PROC mittestausgaben:uuuvvwENDPROC +mittestausgaben;OP :=(NODE VAR uuuvxz,NODE CONST uuuvyu):CONCR (uuuvxz):= +CONCR (uuuvyu)ENDOP :=;OP :=(SELEKTION VAR uuuvxz,SELEKTION CONST uuuvyu): +CONCR (uuuvxz):=CONCR (uuuvyu)ENDOP :=;PROC initsel(SELEKTION VAR uuuvzw): +uuuvzw.uuuuzx:=0ENDPROC initsel;PROC initselektionen(SELEKTION VAR uuuwuv): +INT VAR uuuwuw;FOR uuuwuwFROM 1UPTO uuuuyuREP uuuwuv.exp[uuuwuw].selwert:="" +PER ENDPROC initselektionen;PROC initialisiereselektion(SELEKTION VAR uuuvzw) +:initsel(uuuvzw);initselektionen(uuuvzw)ENDPROC initialisiereselektion;PROC +uuuwwy(SELEKTION VAR uuuvzw,INT CONST uuuwxu):uuuvzw.exp[uuuwxu].uuuuyz:= +uuuuxy;uuuvzw.exp[uuuwxu].uuuuzv:=0;uuuvzw.exp[uuuwxu].uuuuzu:=0;uuuvzw.exp[ +uuuwxu].selwert:=""ENDPROC uuuwwy;INT PROC allocselelement(SELEKTION VAR +uuuvzw):uuuvzw.uuuuzxINCR 1;uuuwwy(uuuvzw,uuuvzw.uuuuzx);uuuvzw.uuuuzx +ENDPROC allocselelement;PROC putoptyp(SELEKTION VAR uuuvzw,INT CONST uuuxvy, +optyp):uuuvzw.exp[uuuxvy].uuuuyz:=optypENDPROC putoptyp;PROC uuuxwz( +SELEKTION VAR uuuvzw,INT CONST uuuxvy,uuuxxw):uuuvzw.exp[uuuxvy].uuuuzv:= +uuuxxwENDPROC uuuxwz;PROC putrechts(SELEKTION VAR uuuvzw,INT CONST uuuxvy, +uuuxyz):uuuvzw.exp[uuuxvy].uuuuzv:=uuuxyzENDPROC putrechts;PROC uuuxzz( +SELEKTION VAR uuuvzw,INT CONST uuuxvy,uuuxxw):uuuvzw.exp[uuuxvy].uuuuzu:= +uuuxxwENDPROC uuuxzz;PROC putlinks(SELEKTION VAR uuuvzw,INT CONST uuuxvy, +uuuwuw):uuuvzw.exp[uuuxvy].uuuuzu:=uuuwuwENDPROC putlinks;PROC putselwert( +SELEKTION VAR uuuvzw,INT CONST uuuxvy,TEXT CONST uuuyxw):uuuvzw.exp[uuuxvy]. +selwert:=uuuyxwENDPROC putselwert;INT PROC optyp(SELEKTION VAR uuuvzw,INT +CONST uuuxvy):uuuvzw.exp[uuuxvy].uuuuyzENDPROC optyp;INT PROC fnrrechts( +SELEKTION VAR uuuvzw,INT CONST uuuxvy):uuuvzw.exp[uuuxvy].uuuuzvENDPROC +fnrrechts;INT PROC fnrlinks(SELEKTION VAR uuuvzw,INT CONST uuuxvy):uuuvzw.exp +[uuuxvy].uuuuzuENDPROC fnrlinks;INT PROC rechts(SELEKTION CONST uuuvzw,INT +CONST uuuxvy):uuuvzw.exp[uuuxvy].uuuuzvENDPROC rechts;INT PROC links( +SELEKTION CONST uuuvzw,INT CONST uuuxvy):uuuvzw.exp[uuuxvy].uuuuzuENDPROC +links;TEXT PROC selwert(SELEKTION VAR uuuvzw,INT CONST uuuxvy):uuuvzw.exp[ +uuuxvy].selwertENDPROC selwert;INT PROC baueselektionauf(SELEKTION VAR uuuzzx +,TEXT CONST uuuzzy):IF compress(uuuzzy)<>""THEN scan(uuuzzy);uuvuuv(uuuzzx) +ELSE 0FI ENDPROC baueselektionauf;INT PROC uuvuuv(SELEKTION VAR uuuzzx):INT +VAR uuuwuw,uuvuvv;uuuwuw:=uuvuvx(uuuzzx);nextsymbol;IF uuvuvz=uuuuxxOR uuvuvz +=uuuuxvTHEN uuvuvv:=allocselelement(uuuzzx);putoptyp(uuuzzx,uuvuvv,uuvuvz); +putlinks(uuuzzx,uuvuvv,uuuwuw);putrechts(uuuzzx,uuvuvv,uuvuuv(uuuzzx));uuvuvv +ELSE uuuwuwFI ENDPROC uuvuuv;INT PROC uuvuvx(SELEKTION VAR uuuzzx):INT VAR +uuvvuu;nextsymbol;SELECT uuvuvzOF CASE uuuuuw:uuvvuu:=uuvuuv(uuuzzx);# +nextsymbol;#IF uuvuvz<>uuuuuxTHEN errorstop("Klammer zu fehlt! Gefunden: "+ +uuuvvv)FI ;CASE uuuuxw:uuvvuu:=allocselelement(uuuzzx);putoptyp(uuuzzx,uuvvuu +,uuvuvz);putlinks(uuuzzx,uuvvuu,uuvuvx(uuuzzx));CASE uuuuuy:CASE uuuuvu: +uuvvuu:=allocselelement(uuuzzx);uuvvyx;uuvvyy;nextsymbol;uuvvyzCASE uuuuvv: +uuvvuu:=allocselelement(uuuzzx);uuvvzy;uuvvzz;uuvwuuCASE uuuuuz:OTHERWISE : +errorstop("Falsches Symbol: "+uuuvvv+text(uuuvvu))ENDSELECT ;uuvvuu.uuvvyx: +nextsymbol;IF uuuvvu<>uuuuvzTHEN uuvwvw("Falsche Wertangabe")ELSE putselwert( +uuuzzx,uuvvuu,uuuvvv);nextsymbol;IF uuuvvu<>uuuuwuCAND uuuvvv<>">"THEN uuvwvw +(""">"" bei Wertangabe fehlt!")FI FI .uuvvzz:nextsymbol;IF uuuvvu<>uuuuwu +THEN uuvwvw("Falscher Operator: "+uuuvvv)FI ;putoptyp(uuuzzx,uuvvuu,uuvwyv). +uuvvyy:nextsymbol;IF (uuuvvu=uuuuwu)COR (uuuvvu=uuuuvyCAND uuuvvv="IN")THEN +putoptyp(uuuzzx,uuvvuu,uuvwyv)ELSE uuvwvw("Falscher Operator: "+uuuvvv)FI ;. +uuvvyz:uuuxwz(uuuzzx,uuvvuu,feldnr(uuuvvv)).uuvvzy:uuuxzz(uuuzzx,uuvvuu, +feldnr(uuuvvv)).uuvwuu:nextsymbol;IF uuvuvz=uuuuvuTHEN uuvvyxELSE uuvvyzFI . +ENDPROC uuvuvx;INT PROC uuvwyv:IF uuuvvv=">"THEN uuuuwzELIF uuuvvv="<"THEN +uuuuxuELIF uuuvvv="="THEN uuuuwvELIF uuuvvv=">="THEN uuuuwyELIF uuuvvv="<=" +THEN uuuuwxELIF uuuvvv="<>"THEN uuuuwwELIF uuuvvv="IN"THEN uuuuxzELSE uuuuxy +FI ENDPROC uuvwyv;PROC nextsymbol:nextsymbol(uuuvvv,uuuvvu)ENDPROC nextsymbol +;INT PROC uuvuvz:IF uuuvvv="("THEN uuuuuwELIF uuuvvv=")"THEN uuuuuxELIF +uuuvvv="NOT"OR uuuvvv="NICHT"THEN uuuuxwELIF uuuvvv="AND"OR uuuvvv="UND"THEN +uuuuxvELIF uuuvvv="OR"OR uuuvvv="ODER"THEN uuuuxxELIF uuuvvu=13THEN uuuuuy +ELIF uuuvvu=uuuuwuCAND uuuvvv="<"THEN uuuuvuELIF uuuvvu=uuuuvzTHEN uuuuvv +ELIF uuuvvu=7THEN uuuuuzELSE uuuuuvFI ENDPROC uuvuvz;PROC uuvwvw(TEXT CONST +uuvyyz):errorstop("FEHLERHAFTER AUSDRUCK: "+uuvyyz)ENDPROC uuvwvw;PROC +checkselektion(SELEKTION CONST uuuzzx):INT VAR uuvyzy,uuvyzz:=uuuzzx.uuuuzx; +note("Anzahl Knoten: "+text(text(uuvyzz),5));noteline;noteline;noteline;FOR +uuvyzyFROM 1UPTO uuvyzzREP note("Knoten: "+text(uuvyzy));noteline;note( +" Operat: "+uuvzvu(uuuzzx.exp[uuvyzy]));noteline;note(" links : "+ +text(links(uuuzzx,uuvyzy)));noteline;note(" rechts: "+text(rechts(uuuzzx, +uuvyzy)));noteline;note(" Wert : "+">"+uuuzzx.exp[uuvyzy].selwert+"<"); +notelinePER ENDPROC checkselektion;TEXT PROC uuvzvu(NODE CONST uuuvzw): +SELECT uuuvzw.uuuuyzOF CASE uuuuwv:"="CASE uuuuww:"<>"CASE uuuuwx:"<="CASE +uuuuwy:">="CASE uuuuwz:">"CASE uuuuxu:"<"CASE uuuuxw:"NOT"CASE uuuuxv:"AND" +CASE uuuuxx:"OR"CASE uuuuxz:"IN"OTHERWISE :"UNDEFINED OPERATOR"ENDSELECT +ENDPROC uuvzvu;BOOL PROC werteselektionaus(SELEKTION VAR uuuvzw,INT CONST +uuvyzy):IF uuvyzy=0THEN LEAVE werteselektionausWITH TRUE FI ;uuwuux;SELECT +uuwuuyOF CASE uuuuxx:uuwuvuOR uuwuvvCASE uuuuxv:uuwuvuAND uuwuvvCASE uuuuxw: +NOT uuwuvuCASE uuuuwx:uuwuwwCASE uuuuwy:uuwuwyCASE uuuuww:uuwuxuCASE uuuuwv: +uuwuxwCASE uuuuxu:uuwuxyCASE uuuuwz:uuwuyuCASE uuuuxz:uuwuywOTHERWISE :FALSE +ENDSELECT .uuwuvu:werteselektionaus(uuuvzw,links(uuuvzw,uuvyzy)).uuwuvv: +werteselektionaus(uuuvzw,rechts(uuuvzw,uuvyzy)).uuwuux:IF uuwuuy=uuuuxxCOR +uuwuuy=uuuuxvCOR uuwuuy=uuuuxwTHEN LEAVE uuwuuxELSE uuwvvz;uuwvwuFI .uuwvvz: +IF fnrlinks(uuuvzw,uuvyzy)=0THEN SELECT uuwvwzOF CASE uuuuyv:uuuvuu:=int( +selwert(uuuvzw,uuvyzy));uuuuzz:=uuuuyvCASE uuuuyw:uuuvuw:=real(selwert(uuuvzw +,uuvyzy));uuuuzz:=uuuuywCASE uuuuyx:uuuvuw:=date(selwert(uuuvzw,uuvyzy)); +uuuuzz:=uuuuywOTHERWISE :uuuvuy:=selwert(uuuvzw,uuvyzy);uuuuzz:=uuuuyy +ENDSELECT ELSE SELECT feldtyp(fnrlinks(uuuvzw,uuvyzy))OF CASE uuuuyv:uuuvuu:= +intwert(fnrlinks(uuuvzw,uuvyzy));uuuuzz:=uuuuyvCASE uuuuyw:uuuvuw:=realwert( +fnrlinks(uuuvzw,uuvyzy));uuuuzz:=uuuuywCASE uuuuyx:uuuvuw:=date(datumwert( +fnrlinks(uuuvzw,uuvyzy)));uuuuzz:=uuuuywOTHERWISE :uuuvuy:=wert(fnrlinks( +uuuvzw,uuvyzy));uuuuzz:=uuuuyyENDSELECT FI .uuwvwu:IF fnrrechts(uuuvzw,uuvyzy +)=0THEN SELECT uuwxvvOF CASE uuuuyv:uuuvuv:=int(selwert(uuuvzw,uuvyzy))CASE +uuuuyw:uuuvux:=real(selwert(uuuvzw,uuvyzy))CASE uuuuyx:uuuvux:=date(selwert( +uuuvzw,uuvyzy))OTHERWISE :uuuvuz:=selwert(uuuvzw,uuvyzy)ENDSELECT ELSE +SELECT feldtyp(fnrrechts(uuuvzw,uuvyzy))OF CASE uuuuyv:uuuvuv:=intwert( +fnrrechts(uuuvzw,uuvyzy))CASE uuuuyw:uuuvux:=realwert(fnrrechts(uuuvzw,uuvyzy +))CASE uuuuyx:uuuvux:=date(datumwert(fnrrechts(uuuvzw,uuvyzy)))OTHERWISE : +uuuvuz:=wert(fnrrechts(uuuvzw,uuvyzy))ENDSELECT FI .uuwxvv:IF fnrlinks(uuuvzw +,uuvyzy)=0THEN uuuuyyELSE feldtyp(fnrlinks(uuuvzw,uuvyzy))FI .uuwvwz:IF +fnrrechts(uuuvzw,uuvyzy)=0THEN uuuuyyELSE feldtyp(fnrrechts(uuuvzw,uuvyzy)) +FI .uuwuuy:optyp(uuuvzw,uuvyzy).ENDPROC werteselektionaus;BOOL PROC uuwuww: +SELECT uuuuzzOF CASE uuuuyv:uuuvuu<=uuuvuvCASE uuuuyw:uuuvuw<=uuuvux +OTHERWISE :uuuvuy<=uuuvuzENDSELECT ENDPROC uuwuww;BOOL PROC uuwuwy:SELECT +uuuuzzOF CASE uuuuyv:uuuvuu>=uuuvuvCASE uuuuyw:uuuvuw>=uuuvuxOTHERWISE : +uuuvuy>=uuuvuzENDSELECT ENDPROC uuwuwy;BOOL PROC uuwuxy:SELECT uuuuzzOF CASE +uuuuyv:uuuvuuuuuvuvCASE uuuuyw:uuuvuw> +uuuvuxOTHERWISE :IF lexsortTHEN uuuvuyLEXGREATER uuuvuzELSE uuuvuy>uuuvuzFI +ENDSELECT ENDPROC uuwuyu;BOOL PROC uuwuxw:SELECT uuuuzzOF CASE uuuuyv:uuuvuu= +uuuvuvCASE uuuuyw:uuuvuw=uuuvuxOTHERWISE :IF lexsortTHEN uuuvuyLEXEQUAL +uuuvuzELSE uuuvuy=uuuvuzFI ENDSELECT ENDPROC uuwuxw;BOOL PROC uuwuxu:SELECT +uuuuzzOF CASE uuuuyv:uuuvuu<>uuuvuvCASE uuuuyw:uuuvuw<>uuuvuxOTHERWISE :IF +lexsortTHEN NOT (uuuvuyLEXEQUAL uuuvuz)ELSE uuuvuy<>uuuvuzFI ENDSELECT +ENDPROC uuwuxu;BOOL PROC uuwuyw:IF uuuuzz=uuuuyyTHEN pos(uuuvuz,uuuvuy)>0 +ELSE FALSE FI ENDPROC uuwuyw;ENDPACKET queryselektion; + diff --git a/app/schulis/2.2.1/src/6.db snd query.sc b/app/schulis/2.2.1/src/6.db snd query.sc new file mode 100644 index 0000000..dbf9cf5 --- /dev/null +++ b/app/schulis/2.2.1/src/6.db snd query.sc @@ -0,0 +1,39 @@ +#$IF mitinternerqueryTHEN #PACKET dbsndqueryDEFINES auswertung, +auswertungfortsetzen,qsucc,endofscan,ordernewstack,puttiefennr,gettiefennr, +endqueryserver:LET uuuuuv=25,uuuuuw=0,uuuuux=1,uuuuuy=2,uuuuuz=2,uuuuvu=37, +uuuuvv=10,uuuuvw=39,uuuuvx=40,uuuuvy=41,uuuuvz=1;INT CONST endofscan:=8, +ordernewstack:=9;INT VAR uuuuwu,uuuuwv;DATASPACE VAR uuuuww;BOUND QUERY VAR +uuuuwx;BOUND TEXT VAR uuuuwy;ROW uuuuvvINT VAR uuuuxu;TYPE TUPEL =STRUCT ( +INT uuuuxv,uuuuxw,uuuuxx,TEXT uuuuxy);TYPE QUERYSTACK =STRUCT (INT uuuuxz, +TASK uuuuyu,ROW uuuuuvTUPEL uuuuyw);INT VAR uuuuyx:=getanzahltupel,uuuuyy; +TEXT VAR uuuuyz:="",uuuuzu:="";PROC endqueryserver:forget(uuuuww);uuuuww:= +nilspace;send(uuuuzy,uuuuvx,uuuuww)ENDPROC endqueryserver;TASK VAR uuuuzy; +BOUND QUERYSTACK VAR uuuvux;OP :=(TUPEL VAR uuuvuy,TUPEL CONST uuuvuz):CONCR +(uuuvuy):=CONCR (uuuvuz)ENDOP :=;OP :=(QUERYSTACK VAR uuuvuy,QUERYSTACK +CONST uuuvuz):CONCR (uuuvuy):=CONCR (uuuvuz)ENDOP :=;INT PROC gettiefennr( +INT CONST uuuvwv):IF uuuvwv=0THEN 0ELSE uuuuxu[uuuvwv]FI ENDPROC gettiefennr; +PROC puttiefennr(INT CONST uuuvwv,uuuvxw):uuuuxu[uuuvwv]:=uuuvxwENDPROC +puttiefennr;PROC auswertung(TEXT CONST uuuvyv):uuuuyy:=0;query(uuuvyv);IF +queryart=uuuuvzTHEN uuuvyzELSE uuuvzuFI .uuuvyz:uuuvzw;forget(uuuuww);uuuuww +:=nilspace;uuuuwx:=uuuuww;getquery(uuuuwx);call(/name(1),uuuuvu,uuuuww,uuuuwu +);uuuwuz;uuuvux:=uuuuww;uuuuzy:=uuuvux.uuuuyu.uuuvzu:forget(uuuuww);uuuuww:= +old(uuuvyv);call(/name(1),uuuuvy,uuuuww,uuuuwu);uuuwuz.ENDPROC auswertung; +PROC uuuvzw:uuuuwv:=0;uuuwxx(1)ENDPROC uuuvzw;PROC uuuwxx(INT CONST uuuwyu): +uuuuwvINCR 1;puttiefennr(uuuwyu,uuuuwv);IF getsohnverb(uuuwyu)<>uuuuuwTHEN +uuuwxx(getsohnverb(uuuwyu))FI ;IF getbruderverb(uuuwyu)<>uuuuuwTHEN uuuwxx( +getbruderverb(uuuwyu))FI ENDPROC uuuwxx;PROC auswertung(QUERY VAR uuuvyv): +queryart(uuuuvz);uuuvzw;uuuuyy:=0;forget(uuuuww);uuuuww:=nilspace;uuuuwx:= +uuuuww;uuuuwx:=uuuvyv;call(/name(1),uuuuvu,uuuuww,uuuuwu);uuuwuz;uuuvux:= +uuuuww;uuuuzy:=uuuvux.uuuuyuENDPROC auswertung;PROC auswertungfortsetzen: +uuuuyy:=0;forget(uuuuww);uuuuww:=nilspace;call(uuuuzy,uuuuvw,uuuuww,uuuuwu); +uuuwuz;uuuvux:=uuuuwwENDPROC auswertungfortsetzen;PROC uuuwuz:IF uuuuwu= +uuuuuzTHEN dbstatus(dberror);uuuuwy:=uuuuww;forget(uuuuww);errorstop(uuuuwy) +ELSE dbstatus(uuuuwu)FI ENDPROC uuuwuz;PROC qsucc(INT VAR uuuwyu,uuuyuz): +uuuuyyINCR 1;IF uuuuyy>uuuvux.uuuuxzTHEN uuuwyu:=0;uuuyuz:=0;dbstatus( +endoffile)ELSE uuuyuz:=uuuvux.uuuuyw[uuuuyy].uuuuxw;#uuuywz(uuuvux.uuuuyw[ +uuuuyy].uuuuxy[uuuuux]);uuuyxz(uuuvux.uuuuyw[uuuuyy].uuuuxy[uuuuuy]);# +parsetupel(uuuyuz,uuuyzu);IF uuuyzvTHEN dbstatus(endofscan)ELSE dbstatus(ok) +FI FI .uuuyzu:uuuvux.uuuuyw[uuuuyy].uuuuxy.uuuyzv:uuuwyu:=uuuvux.uuuuyw[ +uuuuyy].uuuuxv;IF uuuwyu<0THEN uuuwyu:=abs(uuuwyu);TRUE ELSE FALSE FI . +ENDPROC qsucc;ENDPACKET dbsndquery;#$FI # + diff --git a/app/schulis/2.2.1/src/6.ida.auswahl b/app/schulis/2.2.1/src/6.ida.auswahl new file mode 100644 index 0000000..be92224 --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.auswahl @@ -0,0 +1,23 @@ +PACKET idaauswahlDEFINES idaauswahleinlesenundbearbeiten,idaauswahleinlesen, +pruefungidaauswahl:LET niltext="";LET anzahlzeilen=18,erstesausgabefeld=2, +vorwaerts=3;INT VAR anfang,ende,lv;TAG VAR maske;PROC +idaauswahleinlesenundbearbeiten(INT CONST nr):BOOL VAR listeexistiertnicht:= +FALSE ;anfang:=(nr-1)*10+1;ende:=anfang+9;putintwert(fnridanummer,anfang); +objektlistestarten(dnrida,text(anfang),fnridanummer,TRUE ,listeexistiertnicht +);IF listeexistiertnichtOR NOT pruefungidaauswahlTHEN return(1)ELSE +datensatzlistenausgabe(PROC (INT CONST )erfassungdruckausgabe,TRUE ,BOOL +PROC pruefungidaauswahl);FI END PROC idaauswahleinlesenundbearbeiten;PROC +idaauswahleinlesen:feldersperren;infeld(erstesausgabefeld);standardnproc;END +PROC idaauswahleinlesen;BOOL PROC pruefungidaauswahl:intwert(fnridanummer)>= +anfangCAND intwert(fnridanummer)<=endeEND PROC pruefungidaauswahl;PROC +datensatzlistenausgabe(PROC (INT CONST )erfassungspeziell,BOOL CONST scanja, +BOOL PROC pruefungspeziell):BOOL VAR rs:=ruecksprung;initobli; +listenmaskeholenundausgeben;inlisteblaettern(PROC erfassungspeziell,vorwaerts +,TRUE ,scanja,BOOL PROC pruefungspeziell);idaauswahleinlesenENDPROC +datensatzlistenausgabe;PROC listenmaskeholenundausgeben:LET listenmaskenname= +"mu objektliste";initmaske(maske,listenmaskenname);setzeaktuellemaske(maske); +standardstartproc(listenmaskenname)END PROC listenmaskeholenundausgeben;PROC +feldersperren:FOR lvFROM 1UPTO anzahlzeilenREP IF standardmaskenfeld(lv*2+1)= +niltextTHEN protect(maske,lv*2,TRUE )FI PER END PROC feldersperren;END +PACKET idaauswahl; + diff --git a/app/schulis/2.2.1/src/6.ida.check b/app/schulis/2.2.1/src/6.ida.check new file mode 100644 index 0000000..34d7616 --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.check @@ -0,0 +1,162 @@ +PACKET ispidacheckDEFINES fehlerinformular,formfehlermelden, +fehlerindruckvariable,ausdruckwardruckvariable:LET okkenner="k",kennnormal= +"+",kennauffaellig="#",linkeklammer="<",rechteklammer=">";FILE VAR formtext; +TEXT VAR zeile:="",blockstruktur:="",zugriffsreihenfolge:="";INT VAR errormld +:=0,errorline:=0;BOOL VAR fehlerfrei;LET mldplatzhalter=230,mldschachtelung= +231,mldtextkosmetik=232,mldnichtverfuegbar=233,mldregelunbekannt=234, +mldvarunbekannt=235,mldfeldunbekannt=236,mlddateiunbekannt=237, +mldmussleitobjekt=238,laengeblockkey=6,kzkosmetik="#";LET mldkeinevar=239, +mldvarfehler=240,mldkeinbegrenzer=241,mldtypkonflikt=242,mldkeinezeichenkette +=243,mldrestunbekannt=244,mldklammerfehlt=245;LET parametergrenze="%", +parametertrennzeichen="#",otherwise="*",textbegrenzer="""";BOOL VAR +wardruckvar:=TRUE ;PROC fehlersetzen(INT CONST nr):errormld:=nr;errorline:= +max(lineno(formtext)-1,1);fehlerfrei:=FALSE ;ENDPROC fehlersetzen;PROC +formfehlermelden:TEXT VAR zusatz:=" in Zeile ";IF errormld>0THEN zusatzCAT +text(errorline);standardmeldung(errormld,zusatz+kennnormal+" "+ +kennauffaellig);pause;FI ;errormld:=0ENDPROC formfehlermelden;PROC +zugriffmerken(INT CONST objklasse):INT CONST dnr:=dateinr(getobjektklasse( +objklasse));IF dnr=0THEN fehlersetzen(mlddateiunbekannt)ELSE +zugriffsreihenfolgeCAT "!"+text(dnr)+"!"FI ENDPROC zugriffmerken;BOOL PROC +dateischonimzugriff(INT CONST datei):pos(zugriffsreihenfolge,"!"+text(datei)+ +"!")>0ENDPROC dateischonimzugriff;TEXT PROC blockkey(INT CONST objklasse, +regel):"!"+text(objklasse,2)+text(regel,2)+"!"ENDPROC blockkey;BOOL PROC +blockschliessen(INT CONST objklasse,regel):INT CONST p:=pos(blockstruktur, +blockkey(objklasse,regel));IF p>0CAND fehlerfreiTHEN +pruefeobregelmehrfachauftritt;IF fehlerfreiTHEN pruefeobrichtiggeklammertFI +FI ;p>0.pruefeobregelmehrfachauftritt:IF pos(subtext(blockstruktur,p+ +laengeblockkey),blockkey(objklasse,regel))>0THEN fehlersetzen(mldschachtelung +)FI .pruefeobrichtiggeklammert:TEXT VAR bs:=subtext(blockstruktur,p+ +laengeblockkey),kr:="";INT VAR pp;WHILE length(bs)>1REP kr:=text(bs, +laengeblockkey);bs:=subtext(bs,laengeblockkey+1);pp:=pos(bs,kr);IF pp=0THEN +fehlersetzen(mldschachtelung);LEAVE pruefeobrichtiggeklammertELSE change(bs, +pp,pp+laengeblockkey-1,"")FI PER .ENDPROC blockschliessen;PROC +pruefeaufdisjunkteobjektklassen(INT CONST objkl):TEXT VAR bs:=blockstruktur, +kr:="";TEXT CONST objklkey:="!"+text(objkl,2);INT VAR p:=pos(bs,objklkey); +WHILE p>0REP kr:=subtext(bs,p,p+laengeblockkey-1);change(bs,p,p+ +laengeblockkey-1,"");p:=pos(bs,kr);IF p=0THEN fehlersetzen(mldschachtelung); +LEAVE pruefeaufdisjunkteobjektklassenELSE change(bs,p,p+laengeblockkey-1,""); +p:=pos(bs,objklkey)FI PER ENDPROC pruefeaufdisjunkteobjektklassen;PROC +pruefeobverbundfelderverfuegbar(INT CONST regelnummer):INT VAR i,fnr,datei; +TEXT VAR vglwert:="";FOR iFROM 1UPTO getanzahlregelfelder(regelnummer)REP +vglwert:=getvergleichswert(regelnummer,i);IF feldnameTHEN fnr:=feldnr(vglwert +);IF fnr=0THEN fehlersetzen(mldfeldunbekannt);LEAVE +pruefeobverbundfelderverfuegbarFI ;datei:=dateinrzufeld(fnr);IF NOT +dateischonimzugriff(datei)THEN fehlersetzen(mldnichtverfuegbar);LEAVE +pruefeobverbundfelderverfuegbarFI FI PER .feldname:(vglwertSUB 1)<>"""". +ENDPROC pruefeobverbundfelderverfuegbar;PROC pruefeobdatenbereitsverfuegbar( +TEXT CONST ausdruck):LET parametergrenze="%";TEXT VAR evtlfeldname:=ausdruck; +INT VAR fnr,dnr;IF pos(evtlfeldname,parametergrenze)>0THEN evtlfeldname:=text +(evtlfeldname,pos(evtlfeldname,parametergrenze)-1);FI ;fnr:=feldnr( +evtlfeldname);IF fnr>0THEN dnr:=dateinrzufeld(fnr);IF NOT dateischonimzugriff +(dnr)THEN fehlersetzen(mldnichtverfuegbar);FI FI ENDPROC +pruefeobdatenbereitsverfuegbar;PROC blockkeymerken(INT CONST objklasse,regel) +:IF blockstruktur=""CAND objklasse<>1CAND fehlerfreiTHEN fehlersetzen( +mldmussleitobjekt)ELSE blockstrukturCAT blockkey(objklasse,regel);FI ENDPROC +blockkeymerken;BOOL PROC textkommando(TEXT CONST ausdruck):TEXT VAR parameter +:="";IF pos("!page!head!bottom!end!","!"+ausdruck+"!")>0THEN LEAVE +textkommandoWITH TRUE FI ;IF pos(ausdruck,"on")=1THEN parameter:=compress( +subtext(ausdruck,3));pruefeparameterELIF pos(ausdruck,"off")=1THEN parameter +:=compress(subtext(ausdruck,4));pruefeparameterELSE FALSE FI .pruefeparameter +:IF text(parameter,2)<>"("""COR subtext(parameter,length(parameter)-1)<>""")" +THEN LEAVE pruefeparameterWITH FALSE FI ;parameter:=subtext(parameter,3, +length(parameter)-2);pos("!bold!b!underline!u!","!"+parameter+"!")>0.ENDPROC +textkommando;PROC zeileueberpruefen(TEXT CONST zeile):TEXT VAR textzeile:= +zeile,ausdruck:="";INT VAR vonp,bisp,stcodenr,ausglaenge;BOOL VAR rbuendig, +druckvar;IF fehlerfreiTHEN druckvariablenpruefen;textkosmetikpruefenFI . +druckvariablenpruefen:vonp:=pos(textzeile,linkeklammer);WHILE vonp>0REP bisp +:=pos(textzeile,rechteklammer,vonp+1);IF bisp=0THEN fehlersetzen( +mldplatzhalter);LEAVE zeileueberpruefenFI ;disablestop;stcodenr:=int(subtext( +textzeile,vonp+1,bisp-1));clearerror;enablestop;getsteuercode(stcodenr, +ausdruck,ausglaenge,rbuendig,druckvar);IF ausdruck=""COR NOT lastconversionok +THEN fehlersetzen(mldvarunbekannt);LEAVE zeileueberpruefenELSE +pruefeobdatenbereitsverfuegbar(ausdruck);FI ;change(textzeile,vonp,bisp,""); +vonp:=pos(textzeile,linkeklammer);PER .textkosmetikpruefen:textzeile:=zeile; +vonp:=pos(textzeile,kzkosmetik);WHILE vonp>0REP bisp:=pos(textzeile, +kzkosmetik,vonp+1);IF bisp=0THEN fehlersetzen(mldtextkosmetik);LEAVE +zeileueberpruefenFI ;ausdruck:=compress(subtext(textzeile,vonp+1,bisp-1));IF +NOT textkommando(ausdruck)THEN fehlersetzen(mldtextkosmetik);LEAVE +zeileueberpruefenFI ;change(textzeile,vonp,bisp,"");vonp:=pos(textzeile, +kzkosmetik);PER .ENDPROC zeileueberpruefen;PROC bearbeiteblock:INT VAR p,bis, +objklasse,regel;BOOL VAR eoformtext:=FALSE ;WHILE NOT eoformtextCAND +fehlerfreiREP IF zugriffsregelgefundenTHEN okundregelbestimmen;IF +blockschliessen(objklasse,regel)THEN blockkeymerken(objklasse,regel);LEAVE +bearbeiteblockELSE pruefeaufdisjunkteobjektklassen(objklasse);IF NOT +fehlerfreiTHEN LEAVE bearbeiteblockFI ;IF objklasse>1CAND fehlerfreiTHEN +pruefeobverbundfelderverfuegbar(getregelnummer(objklasse,regel));FI ; +blockkeymerken(objklasse,regel);zugriffmerken(objklasse);IF NOT fehlerfrei +THEN LEAVE bearbeiteblockFI ;IF compress(zeile)=""CAND NOT eoformtextTHEN +getline(formtext,zeile);FI ;bearbeiteblockFI ;ELSE zeileueberpruefen(zeile) +FI ;IF eof(formtext)THEN eoformtext:=TRUE ELSE getline(formtext,zeile);FI ; +PER ;.zugriffsregelgefunden:p:=pos(zeile,linkeklammer+okkenner);p>0. +okundregelbestimmen:bis:=p+2;objklasse:=int(zeileSUB bis);bisINCR 1;IF +istziffer(zeileSUB bis)THEN objklasse:=objklasse*10+int(zeileSUB bis);bis +INCR 1;FI ;IF objklasse<1COR objklasse>10THEN fehlersetzen(mldplatzhalter); +LEAVE bearbeiteblockFI ;IF (zeileSUB bis)=rechteklammerTHEN regel:=1ELSE +regel:=int(zeileSUB bis+1);bisINCR 2;IF istziffer(zeileSUB bis)THEN regel:= +regel*10+int(zeileSUB bis);bisINCR 1;FI ;FI ;change(zeile,p,bis,"");IF +objklasse>1CAND getregelnummer(objklasse,regel)=0THEN fehlersetzen( +mldregelunbekannt);LEAVE bearbeiteblockFI ;.ENDPROC bearbeiteblock;BOOL PROC +fehlerinformular:#openformular(nr);#fehlerfrei:=TRUE ;stopbeifalschemnamen( +FALSE );blockstruktur:="";zugriffsreihenfolge:="";zeile:="";errormld:=0; +errorline:=0;formtext:=sequentialfile(input,getformtextname);IF NOT eof( +formtext)THEN getline(formtext,zeile)FI ;IF eof(formtext)CAND zeile=""THEN +ELSE bearbeiteblockFI ;IF fehlerfreiCAND length(blockstruktur)<= +laengeblockkeyTHEN fehlersetzen(mldschachtelung)FI ;stopbeifalschemnamen( +TRUE );NOT fehlerfreiENDPROC fehlerinformular;BOOL PROC istziffer(TEXT CONST +t):pos("0123456789",t)>0END PROC istziffer;BOOL PROC istsonderfunktion(TEXT +CONST ausdruck):TEXT CONST liste:="#tagesdatum#tag#monat#jahr#zeit#tt#mm#jj#" +;pos(liste,"#"+ausdruck+"#")>0ENDPROC istsonderfunktion;BOOL PROC istdbfeld( +TEXT CONST feldname):feldnr(feldname)>0ENDPROC istdbfeld;BOOL PROC +falscherdenotertyp(TEXT CONST vglswert,INT CONST aktfeldtyp):BOOL VAR fehler +:=FALSE ;INT VAR i;REAL VAR r;disablestop;IF aktfeldtyp=intfeldTHEN i:=int( +vglswert);fehler:=NOT lastconversionokCOR iserrorELIF aktfeldtyp=realfeld +THEN r:=real(vglswert);fehler:=NOT lastconversionokCOR iserrorELIF aktfeldtyp +=datumfeldTHEN r:=date(vglswert);fehler:=iserrorFI ;clearerror;enablestop; +fehlerEND PROC falscherdenotertyp;BOOL PROC ausdruckwardruckvariable: +wardruckvarENDPROC ausdruckwardruckvariable;BOOL PROC fehlerindruckvariable( +TEXT CONST origausdruck):BOOL VAR fehlerhaft:=FALSE ;INT VAR p;TEXT VAR +ausdruck:=compress(origausdruck),feldname:="";stopbeifalschemnamen(FALSE ); +wardruckvar:=TRUE ;liesfeldname;IF NOT istdbfeld(feldname)THEN IF +istsonderfunktion(feldname)THEN IF ausdruck=""THEN wardruckvar:=FALSE ELSE +standardmeldung(mldvarfehler,ausdruck);fehlerhaft:=TRUE ;FI ELSE +standardmeldung(mldkeinevar,feldname);fehlerhaft:=TRUE ;FI ;leaveprocFI ;IF +ausdruck>""THEN fehlerhaft:=zusammengesetzterausdruck(feldname,ausdruck)FI ; +stopbeifalschemnamen(TRUE );fehlerhaft.liesfeldname:p:=pos(ausdruck, +parametergrenze);IF p>0THEN feldname:=text(ausdruck,p-1);ausdruck:=subtext( +ausdruck,p+1)ELSE feldname:=ausdruck;ausdruck:=""FI .leaveproc: +stopbeifalschemnamen(TRUE );LEAVE fehlerindruckvariableWITH fehlerhaft. +ENDPROC fehlerindruckvariable;BOOL PROC zusammengesetzterausdruck(TEXT CONST +aktfeld,TEXT VAR ausdruck):TEXT VAR feldname:="",vglswert:="";INT CONST +aktfeldtyp:=feldtyp(feldnr(aktfeld));INT VAR p;BOOL VAR fehlerhaft:=FALSE ; +WHILE ausdruck>""CAND (ausdruckSUB 1)<>rechteklammerREP +pruefefallunterscheidung;PER ;fehlerhaft.pruefefallunterscheidung:p:=pos( +ausdruck,parametertrennzeichen);IF p=0THEN standardmeldung(mldkeinbegrenzer, +ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ;vglswert:=text( +ausdruck,p-1);ausdruck:=subtext(ausdruck,p+1);IF falscherdenotertyp(vglswert, +aktfeldtyp)THEN standardmeldung(mldtypkonflikt,vglswert);LEAVE +zusammengesetzterausdruckWITH TRUE FI ;pruefesequenz;IF (ausdruckSUB 1)= +otherwiseTHEN deletechar(ausdruck,1);pruefesequenzELIF (ausdruckSUB 1)= +parametertrennzeichenTHEN deletechar(ausdruck,1)ELIF ausdruck>""THEN IF ( +ausdruckSUB 1)=parametertrennzeichenTHEN ELIF (ausdruckSUB 1)=rechteklammer +THEN deletechar(ausdruck,1);LEAVE zusammengesetzterausdruckWITH fehlerhaft +ELSE standardmeldung(mldrestunbekannt,ausdruck);LEAVE +zusammengesetzterausdruckWITH TRUE FI FI .pruefesequenz: +zeichenketteueberlesen;IF (ausdruckSUB 1)=linkeklammerTHEN deletechar( +ausdruck,1);IF postext(ausdruck,rechteklammer,1)=0THEN standardmeldung( +mldklammerfehlt,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ; +liesfeldname;IF (ausdruckSUB 1)=parametergrenzeTHEN deletechar(ausdruck,1); +fehlerhaft:=zusammengesetzterausdruck(feldname,ausdruck);IF fehlerhaftTHEN +LEAVE zusammengesetzterausdruckWITH TRUE FI ;ELSE deletechar(ausdruck,1);FI +FI .liesfeldname:p:=1;WHILE (ausdruckSUB p)<>rechteklammerCAND (ausdruckSUB p +)<>parametergrenzeREP pINCR 1PER ;feldname:=text(ausdruck,p-1);ausdruck:= +subtext(ausdruck,p);IF NOT istdbfeld(feldname)THEN standardmeldung( +mldfeldunbekannt,feldname);LEAVE zusammengesetzterausdruckWITH TRUE FI . +zeichenketteueberlesen:IF (ausdruckSUB 1)<>textbegrenzerTHEN standardmeldung( +mldkeinezeichenkette,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ;p +:=2;WHILE (ausdruckSUB p)<>textbegrenzerREP pINCR 1;IF (ausdruckSUB p)= +textbegrenzerCAND (ausdruckSUB p+1)=textbegrenzerTHEN pINCR 2;FI ;UNTIL p> +length(ausdruck)PER ;IF p>length(ausdruck)THEN standardmeldung( +mldkeinezeichenkette,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ; +ausdruck:=compress(subtext(ausdruck,p+1)).ENDPROC zusammengesetzterausdruck; +END PACKET ispidacheck + diff --git a/app/schulis/2.2.1/src/6.ida.def.druck b/app/schulis/2.2.1/src/6.ida.def.druck new file mode 100644 index 0000000..81d218d --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.def.druck @@ -0,0 +1,64 @@ +PACKET ispidadefinitiondruckenDEFINES druckdefinitionzusammenstellen, +benoetigteregel,idaankreuzfelderpruefen:LET druckfile="Hilfsdatei.Druck", +filenamezug="Hilfsdatei.Zugriff",niltext="";LET maxobjektklassen=10, +maxvariablen=100,zobjklasse=2;BOOL VAR ba,bb;INT VAR ia,ib,ic,id,ie,lva,lvb, +regelnummer;REAL VAR ra,rb,rc;TEXT VAR ta,tb,tc;FILE VAR f,g;PROC +druckdefinitionzusammenstellen(PROC (INT CONST )indatei,ROW 100TEXT VAR feld) +:forget(druckfile,quiet);f:=sequentialfile(output,druckfile); +nameundtypindateischreiben;objektklassenindateischreiben; +zugriffsregelnindateischreiben(PROC (INT CONST )indatei,feld); +selektionenindateischreiben(PROC (INT CONST )indatei); +druckformularindateischreiben;druckvariablenindateischreiben; +wertefuerdruckindateischreiben;print(druckfile);END PROC +druckdefinitionzusammenstellen;PROC nameundtypindateischreiben:putline(f, +niltext);getformularinfo(ta,ia,ba);putline(f,"Nummer: "+text(ia));putline(f, +" Name: "+ta);END PROC nameundtypindateischreiben;PROC +objektklassenindateischreiben:putline(f,niltext);putline(f,"Objektklassen"); +putline(f,niltext);FOR iaFROM 1UPTO maxobjektklassenREP ta:=getobjektklasse( +ia);IF ta<>niltextTHEN putline(f,"k"+text(ia)+": "+ta);ELSE LEAVE +objektklassenindateischreibenFI PER ;END PROC objektklassenindateischreiben; +PROC zugriffsregelnindateischreiben(PROC (INT CONST )indatei,ROW 100TEXT VAR +feld):putline(f,niltext);putline(f,"Zugriffsregeln");putline(f,niltext);FOR +lvaFROM 1UPTO getanzahlregelnREP bb:=TRUE ;getzugriffsregel(lva,ib,ic,id,ie); +regelnummer:=lva;IF getobjektklasse(ib)<>niltextTHEN feld[zobjklasse]:=text( +ib);indatei(4);g:=sequentialfile(modify,filenamezug);FOR lvbFROM 1UPTO lines( +g)REP toline(g,lvb);readrecord(g,tb);IF pos(tb,"")>0THEN +zeilezusammensetzen;putline(f,ta);bb:=FALSE FI PER ;FI PER . +zeilezusammensetzen:IF bbTHEN ta:="k"+text(ib,2)+"r"+text(ic,2)+" : ";ELSE ta +:=9*" "FI ;taCAT text(subtext(tb,pos(tb,"<#>")+3,pos(tb,"")-1),25);taCAT +" : ";taCAT subtext(tb,pos(tb,"")+3).END PROC +zugriffsregelnindateischreiben;PROC selektionenindateischreiben(PROC (INT +CONST )indatei):putline(f,niltext);putline(f,"Selektionen");putline(f,niltext +);FOR lvaFROM 1UPTO getanzahlselfelderREP getselektion(lva,ta,tb);IF subtext( +tb,pos(tb,"")+3)<>niltextTHEN zeilezusammensetzen;putline(f,tc)FI PER . +zeilezusammensetzen:tc:=text(ta,25);tcCAT " : ";tcCAT tb.END PROC +selektionenindateischreiben;PROC druckformularindateischreiben:putline(f, +niltext);putline(f,"Druckformular");putline(f,niltext);g:=sequentialfile( +modify,getformtextname);FOR iaFROM 1UPTO lines(g)REP toline(g,ia);readrecord( +g,ta);changeall(ta,"#","\#");putline(f,ta);PER ;END PROC +druckformularindateischreiben;PROC druckvariablenindateischreiben:putline(f, +niltext);putline(f,"Druckvariablen");putline(f,niltext);FOR iaFROM 1UPTO +maxvariablenREP getsteuercode(ia,ta,ib,ba,bb);IF ta<>niltextTHEN changeall(ta +,"#","\#");putline(f,text(ia,3)+": "+ta);put(f," Länge: "+text(ib,2)+ +" rechts-/linksbündig: ");IF baTHEN putline(f,"rechtsbündig")ELSE putline(f, +"linksbündig")FI FI PER END PROC druckvariablenindateischreiben;PROC +wertefuerdruckindateischreiben:putline(f,niltext);putline(f, +"Werte für die Druckaufbereitung");putline(f,niltext);getdruckaufbereitung(ta +,ra,rb,ia,rc);putline(f," Schrifttyp: "+ta);putline(f, +" linker oberer Rand: "+text(rb,4,1)+" cm von oben");putline(f, +" : "+text(ra,4,1)+" cm von links");putline(f, +" Anzahl der Zeilen pro Seite: "+text(ia));putline(f, +"Anzahl der Zeichen pro Zeile: "+subtext(text(rc),1,pos(text(rc),".")-1)); +END PROC wertefuerdruckindateischreiben;INT PROC benoetigteregel:regelnummer +END PROC benoetigteregel;BOOL PROC idaankreuzfelderpruefen:LET +meldungalternative=56,zeileninobjektliste=18;LET niltext="";BOOL VAR +angekreuzt:=FALSE ;INT VAR lva,lvi;IF NOT richtigangekreuztTHEN +standardmeldung(meldungalternative,niltext);return(1);FALSE ELSE TRUE FI . +richtigangekreuzt:FOR lvaFROM 1UPTO anzahlderbelegtenzeilen-1REP IF +standardmaskenfeld(lva*2)<>niltextTHEN IF angekreuztTHEN infeld(lva*2);LEAVE +richtigangekreuztWITH FALSE ELSE angekreuzt:=TRUE FI FI PER ;angekreuzt. +anzahlderbelegtenzeilen:FOR lviFROM 1UPTO zeileninobjektlisteREP IF +standardmaskenfeld(lvi*2+1)=niltextTHEN LEAVE anzahlderbelegtenzeilenWITH lvi +FI PER ;0.END PROC idaankreuzfelderpruefen;END PACKET ispidadefinitiondrucken +; + diff --git a/app/schulis/2.2.1/src/6.ida.definieren b/app/schulis/2.2.1/src/6.ida.definieren new file mode 100644 index 0000000..696409b --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.definieren @@ -0,0 +1,516 @@ +PACKET ispidadefinierenDEFINES druckausgabeeingangaufbauenundeinlesen, +druckausgabeeingangeinlesen,druckausgabeaufbauenundeinlesen, +druckausgabeeinlesen,druckausgabeausgebenundbearbeiten,druckausgabespeichern, +druckausgabeneueinfuegen,druckausgabeloeschenvorbereiten, +druckausgabeloeschfrage,druckausgabeloeschen, +druckausgabelisteaufbauenundeinlesen,druckausgabelisteeinlesen, +ausgesuchtedruckausgabeausgebenundbearbeiten,ausgesuchtedruckausgabeeinlesen, +ausgesuchtedruckausgabeloeschenvorbereiten,ausgesuchtedruckausgabeloeschfrage +,listederdruckausgabenzeigen,listederdruckausgabeneinlesen, +indruckausgabenblaettern,inselektionenzurdruckausgabeblaettern, +inregelzurdruckausgabeblaettern,zurueckzurbearbeitung,formularausdrucken, +setzenummerderdruckausgabe,nochmeldungauszugeben,pruefungida,:LET filenamezug +="Hilfsdatei.Zugriff",filenamesel="Hilfsdatei.Selektion",#filenamedruck= +"Hilfsdatei.Druck",#filenameform="FORMTEXT.",filenamedata="FORMDATA.";LET +maskenzusatz=" für Druckausgabe ";LET nameundtyp=1,objektklassen=2,# +datenvorrat=3,#zugriffsregeln=4,selektion=5,druckformular=6,druckvariablen=7, +druckwerte=8,druckdefinition=9;LET ntnummer=2,ntname=3;LET oleitobjekt=2;LET +zobjklasse=2,zregelnr=3,zobjklname=4,znummer=5,zersterzugriff=6, +zerstervergleich=7;LET sersteselektion=2,serstervergleich=3;LET dvnummer=2, +dvdefinition=3,dvlaenge=4,dvrechtsbuendig=5;LET dwschriftart=2, +dwlinkerrandoben=3,dwlinkerrandlinks=4,dwzeilenproseite=5,dwzeichenprozeile=6 +;LET minanfang=1.0,maxanfang=10.0;LET ankreuzzeichen="x",anzahltrenner="", +namentrenner="<#>",zeilennrtrenner="",vergleichtrenner="",vartrenner= +"%",trenner=". ",leitobjektschueler="Schüler",leitobjektlehrer="Lehrer",# +gueltigerstatus="nw",#niltext="",semikolon=";"#oblitrenner="$"#;LET +leitobjekt=1,vorwaerts=1#rueckwaerts=2#;LET tl=3,maxzugriffe=16, +maxselektionen=17,maxobjektklassen=10;LET fnrerstesausgabefeld=2, +anzmaskeneing=2,anzmaskenbearb=9,anzmaskentitel=9;LET meldunglistenerstellung +=7,meldungalternative=56,meldungplausipruefung=57,meldungloeschfrage=65, +meldungkeineliste=68,meldungkeinblaettern=72,meldungformdrucken=219, +meldungfalscheeingabe=204,meldungdgibtesschon=205,meldungdgibtesnicht=206, +meldungfalschenummer=207,meldungfalschesobjekt=208,meldungsammelndruckdef=209 +,meldungdruckendruckdef=210,meldungrgibtesschon=211,meldungrgibtesnicht=212, +meldungvgibtesschon=213,meldungvgibtesnicht=214,meldungkeinleitobjekt=215, +meldungfalscheregel=217,meldungfalschevariable=218,meldungkeinefonttabelle= +250,meldungkeineobjektklasse=251;BOOL VAR loeschenderdruckausgabe:=FALSE , +neuedruckausgabe:=FALSE ,neuedruckvariable:=FALSE ,neuezugriffsregel:=FALSE , +druckenderdefinition:=FALSE ,druckvariablegibtesbereits:=FALSE , +zugriffsregelgibtesbereits:=FALSE ;BOOL VAR drvrechtsbuendig,drvdruckvar; +FILE VAR f;INT VAR fnrletztesausgabefeld:=100,fehlseite:=0,fehlzeile:=0, +fehlmeld:=0;INT VAR startpos,datenseite,merkzeile,anzahlderdateizeilen, +leseanfangindatei,fnummer,zeilennr,nrdruckausgabe,anzfelder,dnr,zuwas;INT +VAR regelnr,regnr,objklasse;INT VAR zrregel,zrobjekt,zrindex,zranzahl;INT +VAR drvlaenge;ROW anzmaskenbearbINT VAR letztesmaskenfeld:=ROW anzmaskenbearb +INT :(3,11,100,52,35,100,5,6,100);ROW anzmaskeneingTEXT VAR eingangsmaske:= +ROW anzmaskeneingTEXT :("mdr name und typ der druckausgabe", +"mdr objektklasse waehlen eingang");ROW anzmaskenbearbTEXT VAR bearbmaske:= +ROW anzmaskenbearbTEXT :("mdr name und typ der druckausgabe", +"mdr objektklasse waehlen bearb","","mdr zugriffsregeln bearb", +"mdr selektionsbedingung bearb","","mdr variablen definieren bearb", +"mdr werte fuer druckausgabe festlegen bearb", +"mdr objektklasse waehlen eingang");ROW anzmaskentitelTEXT VAR +maskentiteleingang:=ROW anzmaskentitelTEXT :("Name und Nummer definieren", +"Objektklassen wählen","Datenvorrat festlegen","Zugriffsregeln bearbeiten", +"Selektionsbedingungen angeben","Druckformular editieren", +"Druckvariablen definieren","Werte für Druckaufbereitung", +"Definition ausdrucken");ROW 100TEXT VAR erfassungsfeld;TAG VAR maske;BOOL +VAR gespeichert:=FALSE ;TEXT VAR sfeldname,svergleichswert;TEXT VAR +filenameformtp:="DUMMY";TEXT VAR meldungstext:="",nummerderdruckausgabe:="", +pattern,zeile,programmname;PROC druckausgabeeingangaufbauenundeinlesen(INT +CONST was):systemdboff;drvdruckvar:=ruecksprung;loeschenderdruckausgabe:= +FALSE ;setzedruckausgabelistenauswahl(FALSE ); +setzelistederdruckausgabengezeigt(FALSE );fehlseite:=1;fehlzeile:=1;fehlmeld +:=0;init(erfassungsfeld);startpos:=fnrerstesausgabefeld;zuwas:=was; +programmname:=maskentiteleingang[zuwas];eingangsmaskeinitialisieren; +felderausgebenundeinlesen;.eingangsmaskeinitialisieren:IF zuwas=1THEN +initmaske(maske,eingangsmaske[1])ELSE initmaske(maske,eingangsmaske[2])FI ; +nummerderdruckausgabe:=niltext;setzeaktuellemaske(maske). +felderausgebenundeinlesen:IF zuwas=1THEN standardstartproc(eingangsmaske[1]) +ELSE standardstartproc(eingangsmaske[2])FI ;fnrletztesausgabefeld:= +letztesmaskenfeld[zuwas];feldschutzfestlegen(fnrerstesausgabefeld+1); +loeschfeldverdecken;eventuellmeldungausgeben;get(maske,erfassungsfeld, +startpos);nummerderdruckausgabe:=erfassungsfeld[fnrerstesausgabefeld]; +standardmaskenfeld(nummerderdruckausgabe,fnrerstesausgabefeld).END PROC +druckausgabeeingangaufbauenundeinlesen;PROC druckausgabeeingangeinlesen(INT +CONST was):putget(maske,nummerderdruckausgabe,fnrerstesausgabefeld);END PROC +druckausgabeeingangeinlesen;PROC druckausgabeaufbauenundeinlesen(INT CONST +was):IF ruecksprungTHEN bearbeitungsbildschirmausgeben(PROC +erneuteeingabeerforderlich)ELSE eingangsbildschirmueberpruefen(PROC +erneuteeingabeerforderlich)FI END PROC druckausgabeaufbauenundeinlesen;PROC +druckausgabeeinlesen(INT CONST was):IF was=druckformularTHEN editiere( +filenameformtp,FALSE )ELSE get(maske,erfassungsfeld,startpos); +standardfelderfuellen;FI END PROC druckausgabeeinlesen;PROC +druckausgabeausgebenundbearbeiten(INT CONST was):zuwas:=was;loeschemeldung( +aktuellemaske);loeschenderdruckausgabe:=FALSE ;neuedruckausgabe:=FALSE ; +SELECT wasOF CASE zugriffsregeln:neuezugriffsregel:=FALSE ; +zugriffsregelueberpruefenCASE druckvariablen:neuedruckvariable:=FALSE ; +druckvariableueberpruefenCASE druckdefinition:eingangsbildschirmueberpruefen( +PROC druckdefinitiondrucken)OTHERWISE :zurueck;eingangsbildschirmueberpruefen +(PROC maskenwertezeigenundbearbeiten)END SELECT ;.END PROC +druckausgabeausgebenundbearbeiten;PROC druckausgabespeichern(BOOL CONST +speichern,INT CONST was):IF speichernTHEN angabenabspeichern(was);gespeichert +:=TRUE ELSE gespeichert:=FALSE ;meldungstext:=("Die Angaben "+ +meldungseinschub+" wurden nicht gespeichert ");hilfsfilesloeschen;IF NOT +druckausgabelistenauswahl#dr01.08.88#THEN forget(getformtextname,quiet); +forget(filenameformtp,quiet)FI ;eventuellmeldungbeilistenabarbeitungFI ; +stopbeifalschemnamen(TRUE )END PROC druckausgabespeichern;PROC +druckausgabeneueinfuegen(INT CONST was):loeschemeldung(aktuellemaske); +loeschenderdruckausgabe:=FALSE ;SELECT wasOF CASE nameundtyp:neuedruckausgabe +:=TRUE ;eingangsbildschirmueberpruefen(PROC maskenwertezeigenundbearbeiten) +CASE zugriffsregeln:neuezugriffsregel:=TRUE ;zugriffsregelueberpruefenCASE +druckvariablen:neuedruckvariable:=TRUE ;druckvariableueberpruefenOTHERWISE : +rueckschrittevorproc(2)END SELECT END PROC druckausgabeneueinfuegen;PROC +druckausgabeloeschenvorbereiten(INT CONST was):loeschemeldung(aktuellemaske); +loeschenderdruckausgabe:=TRUE ;SELECT wasOF CASE nameundtyp:neuedruckausgabe +:=FALSE ;eingangsbildschirmueberpruefen(PROC maskenwertezeigenundbearbeiten) +CASE zugriffsregeln:neuezugriffsregel:=FALSE ;zugriffsregelueberpruefenCASE +druckvariablen:neuedruckvariable:=FALSE ;druckvariableueberpruefenOTHERWISE : +rueckschrittevorproc(2)END SELECT ;END PROC druckausgabeloeschenvorbereiten; +PROC druckausgabeloeschfrage:TEXT VAR xy;meldeauffaellig(aktuellemaske, +meldungloeschfrage);startpos:=letztesmaskenfeld[zuwas]+1;get(maske,xy, +startpos).END PROC druckausgabeloeschfrage;PROC druckausgabeloeschen(BOOL +CONST loeschen,INT CONST was):IF loeschenTHEN meldungstext:=("Die Angaben "+ +meldungseinschub+" wurden gelöscht ");angabenloeschen(was);ELSE meldungstext +:=("Die Angaben "+meldungseinschub+" wurden nicht gelöscht "); +hilfsfilesloeschen;FI ;loeschenderdruckausgabe:=FALSE ; +eventuellmeldungbeilistenabarbeitung;END PROC druckausgabeloeschen;PROC +druckausgabelisteaufbauenundeinlesen(INT CONST was): +setzedruckausgabelistenauswahl(FALSE );SELECT wasOF CASE nameundtyp: +druckausgabenlistezeigenCASE zugriffsregeln:listederregelnzeigenCASE +druckvariablen:listederdruckvariablenzeigenEND SELECT ;IF (was=nameundtypAND +listederdruckausgabengezeigt)OR ((was=zugriffsregelnOR was=druckvariablen) +AND druckausgabelistenauswahl)THEN druckausgabelisteeinlesen(was);FI . +listederregelnzeigen:loeschemeldung(aktuellemaske);IF erlaubteregeleingabeOR +regelleerTHEN regellistezeigenELSE meldeauffaellig(aktuellemaske, +meldungfalscheregel);return(1);LEAVE druckausgabelisteaufbauenundeinlesenFI . +regelleer:erfassungsfeld[zobjklasse]=niltextAND erfassungsfeld[zregelnr]= +niltext.listederdruckvariablenzeigen:loeschemeldung(aktuellemaske);IF +erlaubtevariableneingabeOR druckvariableleerTHEN variablenlistezeigenELSE +meldeauffaellig(aktuellemaske,meldungfalschevariable);return(1);LEAVE +druckausgabelisteaufbauenundeinlesenFI .druckvariableleer:erfassungsfeld[ +dvnummer]=niltext.END PROC druckausgabelisteaufbauenundeinlesen;PROC +druckausgabelisteeinlesen(INT CONST was):infeld(fnrerstesausgabefeld); +standardnproc;maskenwertesichern;END PROC druckausgabelisteeinlesen;PROC +ausgesuchtedruckausgabeausgebenundbearbeiten(INT CONST was): +behandlungderausgesuchten(PROC (INT CONST )druckausgabeausgebenundbearbeiten, +erfassungsfeld,was);END PROC ausgesuchtedruckausgabeausgebenundbearbeiten; +PROC ausgesuchtedruckausgabeeinlesen(INT CONST welche):druckausgabeeinlesen( +welche)END PROC ausgesuchtedruckausgabeeinlesen;PROC +ausgesuchtedruckausgabeloeschenvorbereiten(INT CONST was): +behandlungderausgesuchten(PROC (INT CONST )druckausgabeloeschenvorbereiten, +erfassungsfeld,was);END PROC ausgesuchtedruckausgabeloeschenvorbereiten;PROC +ausgesuchtedruckausgabeloeschfrage:druckausgabeloeschfrageEND PROC +ausgesuchtedruckausgabeloeschfrage;PROC listederdruckausgabenzeigen:BOOL VAR +listeexistiertnicht:=FALSE ;loeschemeldung(aktuellemaske); +nummerderdruckausgabe:=erfassungsfeld[fnrerstesausgabefeld]; +standardmaskenfeld(nummerderdruckausgabe,fnrerstesausgabefeld);IF +nummerinrichtigengrenzen(nummerderdruckausgabe)OR nummerderdruckausgabe= +niltextTHEN #putkeypart(niltext);putdatapart(niltext);##vorläufig14.03.88# +pruefenobdruckausgabenexistierenELSE meldeauffaellig(aktuellemaske, +meldungfalschenummer);rueckschrittenachproc(1)FI . +pruefenobdruckausgabenexistieren:meldeauffaellig(aktuellemaske, +meldunglistenerstellung);putwert(fnridanummer,nummerderdruckausgabe); +objektlistestarten(dnrida,standardmaskenfeld(fnrerstesausgabefeld), +fnridanummer,TRUE ,listeexistiertnicht);IF listeexistiertnichtTHEN +meldeauffaellig(aktuellemaske,meldungkeineliste);rueckschrittenachproc(1) +ELSE druckausgabelisteaufbauenundeinlesen(nameundtyp)FI .END PROC +listederdruckausgabenzeigen;PROC listederdruckausgabeneinlesen: +druckausgabelisteeinlesen(nameundtyp)END PROC listederdruckausgabeneinlesen; +PROC indruckausgabenblaettern(INT CONST wie,worin):inlisteblaettern(wie);IF +ruecksprungTHEN meldeauffaellig(aktuellemaske,meldungkeinblaettern);FI ; +return(1)END PROC indruckausgabenblaettern;PROC +inselektionenzurdruckausgabeblaettern(INT CONST wie):loeschemeldung( +aktuellemaske);selektionenindateieintragen(leseanfangindatei,erfassungsfeld); +datenseiteraufoderrunter(wie);IF maxselektionen*(datenseite-1)>= +anzahlderdateizeilenOR datenseite=0THEN meldeauffaellig(aktuellemaske, +meldungkeinblaettern);datenseiterunteroderrauf(wie)ELSE +selektionenzeigenvorbereiten(datenseite);FI ;put(maske,erfassungsfeld, +letztesmaskenfeld[zuwas]);startpos:=serstervergleich;rueckschrittenachproc(1) +;END PROC inselektionenzurdruckausgabeblaettern;PROC +inregelzurdruckausgabeblaettern(INT CONST wie):loeschemeldung(aktuellemaske); +zugriffsregelnindateieintragen(leseanfangindatei,erfassungsfeld); +datenseiteraufoderrunter(wie);IF maxzugriffe*(datenseite-1)>= +anzahlderdateizeilenOR datenseite=0THEN meldeauffaellig(aktuellemaske, +meldungkeinblaettern);datenseiterunteroderrauf(wie)ELSE +zugriffezeigenvorbereiten(datenseite)FI ;put(maske,erfassungsfeld, +letztesmaskenfeld[zuwas]);startpos:=zerstervergleich;rueckschrittenachproc(1) +END PROC inregelzurdruckausgabeblaettern;INT PROC nochmeldungauszugeben:IF +meldungstext=niltextTHEN 0ELSE meldungstext:=niltext;IF gespeichertTHEN 191 +ELSE 195FI FI END PROC nochmeldungauszugeben;PROC setzenummerderdruckausgabe( +TEXT CONST nr):nummerderdruckausgabe:=nrEND PROC setzenummerderdruckausgabe; +BOOL PROC pruefungida:FALSE END PROC pruefungida;PROC zurueckzurbearbeitung( +INT CONST anzahl):zurueck;setzedruckausgabelistenauswahl(FALSE );init( +erfassungsfeld);enter(anzahl)END PROC zurueckzurbearbeitung;PROC +formularausdrucken:standardmeldung(meldungformdrucken,niltext);changeinfile( +filenameformtp,"#","\#");print(filenameformtp);changeinfile(filenameformtp,"\#" +,"#");rueckschrittenachproc(1)END PROC formularausdrucken;PROC +druckvariableueberpruefen:IF erlaubtevariableneingabeTHEN +standardkopfmaskeaktualisieren(programmname);IF druckausgabelistenauswahl +THEN initmaske(maske,bearbmaske[zuwas]);setzeaktuellemaske(maske);show( +aktuellemaske);loeschfeldverdecken;FI ;IF existenzdervariablennotwendigTHEN +fehlerbehandlung;rueckschrittenachproc(1)ELSE maskenwertezeigenundbearbeiten; +FI ELSE meldeauffaellig(aktuellemaske,meldungfalschevariable);startpos:= +fnrerstesausgabefeld;rueckschrittenachproc(1)FI . +existenzdervariablennotwendig:(neuedruckvariableAND +druckvariableexistiertschon)OR (NOT neuedruckvariableAND NOT +druckvariableexistiertschon).druckvariableexistiertschon:getsteuercode(int( +erfassungsfeld[dvnummer]),erfassungsfeld[dvdefinition],drvlaenge, +drvrechtsbuendig,drvdruckvar);druckvariablegibtesbereits:=erfassungsfeld[ +dvdefinition]<>niltext;erfassungsfeld[dvdefinition]<>niltext.fehlerbehandlung +:IF neuedruckvariableAND druckvariableexistiertschonTHEN meldeauffaellig( +aktuellemaske,meldungvgibtesschon)ELSE meldeauffaellig(aktuellemaske, +meldungvgibtesnicht)FI .END PROC druckvariableueberpruefen;PROC +eingangsbildschirmueberpruefen(PROC wasweiter):BOOL VAR +druckausgabegibtesschon:=druckausgabeexistiertbereits;IF eingangsbildschirmok +THEN IF listederdruckausgabengezeigtTHEN nummerderdruckausgabesetzen( +nummerderdruckausgabe);druckausgabegibtesschon:=druckausgabeexistiertbereits +FI ;getform(int(nummerderdruckausgabe));openformular(int( +nummerderdruckausgabe));init(erfassungsfeld);angegebenedruckausgabebearbeiten +ELSE fehlerbehandlung1;rueckschrittenachproc(1)FI .eingangsbildschirmok:IF +listederdruckausgabengezeigtTHEN nureinedruckausgabeangekreuztELSE +nummerinrichtigengrenzen(nummerderdruckausgabe)FI .fehlerbehandlung1:IF +listederdruckausgabengezeigtTHEN meldeauffaellig(aktuellemaske, +meldungalternative)ELSE meldeauffaellig(aktuellemaske,meldungfalschenummer) +FI .angegebenedruckausgabebearbeiten:IF existenzderdruckausgabenoetigTHEN IF +zuwas=druckdefinitionTHEN #wasweiterersetztdr16.12.87# +bearbeitungsbildschirmausgeben(PROC wasweiter);ELIF zuwas=selektionAND +getobjektklasse(leitobjekt)=niltextTHEN meldeauffaellig(aktuellemaske, +meldungkeinleitobjekt);rueckschrittenachproc(1)ELSE saveupdateposition(dnrida +);bearbeitungsbildschirmausgeben(PROC wasweiter);FI ELSE fehlerbehandlung2; +rueckschrittenachproc(1)FI .existenzderdruckausgabenoetig:( +druckausgabegibtesschonAND NOT neuedruckausgabe)OR (NOT +druckausgabegibtesschonAND neuedruckausgabe).fehlerbehandlung2:IF NOT +druckausgabegibtesschonAND NOT neuedruckausgabeTHEN meldeauffaellig( +aktuellemaske,meldungdgibtesnicht);forget(filenameform+text(getactivformular) +,quiet);forget(filenamedata+text(getactivformular),quiet)ELIF +druckausgabegibtesschonAND neuedruckausgabeTHEN meldeauffaellig(aktuellemaske +,meldungdgibtesschon)FI ;.END PROC eingangsbildschirmueberpruefen;BOOL PROC +druckausgabeexistiertbereits:#putkeypart(niltext);putdatapart(niltext);## +vorläufig14.03.88#inittupel(dnrida);putwert(fnridanummer, +nummerderdruckausgabe);search(dnrida,TRUE );dbstatus=okEND PROC +druckausgabeexistiertbereits;PROC bearbeitungsbildschirmausgeben(PROC +wasweiter):programmname:=maskentiteleingang[zuwas]+maskenzusatz+ +nummerderdruckausgabe;standardkopfmaskeaktualisieren(programmname); +bearbeitungsmaskeausgeben;eventuellmeldungausgeben;wasweiter. +bearbeitungsmaskeausgeben:initmaske(maske,bearbmaske[zuwas]); +setzeaktuellemaske(maske);fnrletztesausgabefeld:=letztesmaskenfeld[zuwas]; +show(aktuellemaske);loeschfeldverdecken;getform(int(nummerderdruckausgabe)); +openformular(int(nummerderdruckausgabe)).END PROC +bearbeitungsbildschirmausgeben;PROC zugriffsregelueberpruefen:IF +erlaubteregeleingabeTHEN standardkopfmaskeaktualisieren(programmname);IF +druckausgabelistenauswahlTHEN initmaske(maske,bearbmaske[zuwas]); +setzeaktuellemaske(maske);show(aktuellemaske);loeschfeldverdeckenFI ;IF +existenzderregelnotwendigTHEN fehlerbehandlung;rueckschrittenachproc(1)ELSE +maskenwertezeigenundbearbeiten;FI ELSE #dr02.05.88#IF falscheregelTHEN +meldeauffaellig(aktuellemaske,meldungfalscheregel)ELIF +esexistiertkeineobjektklasseTHEN meldeauffaellig(aktuellemaske, +meldungkeineobjektklasse)FI ;startpos:=fnrerstesausgabefeld; +rueckschrittenachproc(1)FI .existenzderregelnotwendig:(neuezugriffsregelAND +zugriffsregelexistiertschon)OR (NOT neuezugriffsregelAND NOT +zugriffsregelexistiertschon).zugriffsregelexistiertschon:objklasse:=int( +erfassungsfeld[zobjklasse]);regnr:=int(erfassungsfeld[zregelnr]);regelnr:= +getregelnummer(objklasse,regnr);zugriffsregelgibtesbereits:=regelnr>0;regelnr +>0.fehlerbehandlung:IF neuezugriffsregelAND zugriffsregelexistiertschonTHEN +meldeauffaellig(aktuellemaske,meldungrgibtesschon)ELSE meldeauffaellig( +aktuellemaske,meldungrgibtesnicht)FI .falscheregel:erfassungsfeld[zobjklasse] +=niltextCOR erfassungsfeld[zregelnr]=niltext.esexistiertkeineobjektklasse: +erfassungsfeld[zobjklasse]<>niltext#dr02.05.88#CAND int(erfassungsfeld[ +zobjklasse])<=10CAND getobjektklasse(int(erfassungsfeld[zobjklasse]))=niltext +.END PROC zugriffsregelueberpruefen;PROC erneuteeingabeerforderlich: +allefeldersperren(FALSE );feldschutzfuerbearbeitungfestlegen(zuwas);startpos +:=fnrerstesausgabefeld;put(maske,erfassungsfeld,letztesmaskenfeld[zuwas]); +druckausgabeeinlesen(zuwas)END PROC erneuteeingabeerforderlich;PROC +angabenabspeichern(INT CONST was):INT VAR lvf;TEXT VAR txt;fehlseite:=1; +fehlzeile:=1;fehlmeld:=0;SELECT wasOF CASE nameundtyp:nameundtypspeichern +CASE objektklassen:objektklassenspeichernCASE zugriffsregeln: +zugriffsregelspeichernCASE selektion:selektionspeichernCASE druckformular: +druckformularspeichernCASE druckvariablen:druckvariablespeichernCASE +druckwerte:druckwertespeichernEND SELECT ;meldungstext:=("Die Angaben "+ +meldungseinschub+" wurden gespeichert ");eventuellmeldungbeilistenabarbeitung +#dr01.08.88#.nameundtypspeichern:meldeauffaellig(aktuellemaske, +meldungplausipruefung);IF nameundtypok(erfassungsfeld,fnummer)THEN +putformularinfo(erfassungsfeld[ntname],int(erfassungsfeld[ntnummer]),FALSE ); +nameundtypindbeintragen;sichernundhilfsfilesloeschenELSE +meldefehlernameundtyp;startpos:=fnummer;rueckschrittenachproc(1);LEAVE +angabenabspeichernFI .nameundtypindbeintragen:putwert(fnridanummer, +erfassungsfeld[ntnummer]);putwert(fnridaname,erfassungsfeld[ntname]);IF +neuedruckausgabeTHEN insert(dnrida)ELSE restoreupdateposition(dnrida);update( +dnrida)FI .objektklassenspeichern:meldeauffaellig(aktuellemaske, +meldungplausipruefung);IF objektklassenzugelassenTHEN FOR lvfFROM 1UPTO +maxobjektklassenREP putobjektklasse(lvf,erfassungsfeld[lvf+1])PER ; +sichernundhilfsfilesloeschenELSE meldeauffaellig(aktuellemaske, +meldungfalschesobjekt);startpos:=lvf+1;rueckschrittenachproc(1);LEAVE +angabenabspeichernFI .objektklassenzugelassen:IF +leitobjektklasseleeroderungueltigTHEN lvf:=1;LEAVE objektklassenzugelassen +WITH FALSE FI ;stopbeifalschemnamen(FALSE );FOR lvfFROM 1UPTO +maxobjektklassenREP IF erfassungsfeld[lvf+1]<>niltextTHEN IF +objektklassekeindateinameTHEN LEAVE objektklassenzugelassenWITH FALSE FI FI +PER ;stopbeifalschemnamen(TRUE );TRUE .leitobjektklasseleeroderungueltig: +erfassungsfeld[oleitobjekt]=niltextCOR (pos(leitobjektschueler,erfassungsfeld +[oleitobjekt])=0AND pos(leitobjektlehrer,erfassungsfeld[oleitobjekt])=0). +objektklassekeindateiname:dateinr(erfassungsfeld[lvf+1])=0. +zugriffsregelspeichern:zugriffsregelnindateieintragen(leseanfangindatei, +erfassungsfeld);meldeauffaellig(aktuellemaske,meldungplausipruefung);IF +zugriffsregelnok(fehlseite,fehlzeile,fehlmeld)THEN zugriffsregelnabspeichern; +sichernundhilfsfilesloeschenELSE stopbeifalschemnamen(TRUE );datenseite:= +fehlseite;zugriffezeigenvorbereiten(datenseite);put(maske,erfassungsfeld, +letztesmaskenfeld[zuwas]);meldeauffaellig(aktuellemaske,fehlmeld);startpos:= +fehlzeile+((fehlzeile+2)*2);rueckschrittenachproc(1);LEAVE angabenabspeichern +FI .zugriffsregelnabspeichern:wertesetzenbeineuerzugriffsregel; +erstenvergleichsuchenundindexsetzen;zugriffsregelundvergleichswertespeichern. +wertesetzenbeineuerzugriffsregel:IF neuezugriffsregelTHEN regelnr:= +getanzahlregeln+1;zrobjekt:=objklasse;zrregel:=regnr;ELSE FI . +erstenvergleichsuchenundindexsetzen:pattern:=vergleichtrenner;toline(f,1); +readrecord(f,zeile);IF pos(zeile,pattern)=0THEN down(f,pattern);readrecord(f, +zeile);FI ;zrindex:=int(subtext(zeile,1,pos(zeile,anzahltrenner)-1)). +zugriffsregelundvergleichswertespeichern:putzugriffsregel(regelnr,zrobjekt, +zrregel,zrindex,0);WHILE pos(zeile,vergleichtrenner)>0REP putvergleichswert( +regelnr,subtext(zeile,pos(zeile,vergleichtrenner)+tl));toline(f,lineno(f)+1); +readrecord(f,zeile);PER .selektionspeichern:selektionenindateieintragen( +leseanfangindatei,erfassungsfeld);meldeauffaellig(aktuellemaske, +meldungplausipruefung);IF selektionswerteok(dnr,fehlseite,fehlzeile,fehlmeld) +THEN selektionenabspeichern;sichernundhilfsfilesloeschenELSE datenseite:= +fehlseite;selektionenzeigenvorbereiten(datenseite);put(maske,erfassungsfeld, +letztesmaskenfeld[zuwas]);meldeauffaellig(aktuellemaske,fehlmeld);startpos:=( +fehlzeile*2)+1;rueckschrittenachproc(1);LEAVE angabenabspeichernFI . +selektionenabspeichern:putanzahlselfelder(0);FOR lvfFROM 1UPTO anzattr(dnr) +REP toline(f,lvf);readrecord(f,zeile);sfeldname:=subtext(zeile,1,pos(zeile, +zeilennrtrenner)-1);svergleichswert:=subtext(zeile,pos(zeile,vergleichtrenner +)+tl);putselektion(sfeldname,svergleichswert)PER .druckformularspeichern: +standardmeldung(meldungplausipruefung,niltext);forget(getformtextname,quiet); +copy(filenameformtp,getformtextname);IF fehlerinformularTHEN formfehlermelden +;rueckschrittenachproc(1);LEAVE angabenabspeichernELSE forget(filenameformtp, +quiet);sichernundhilfsfilesloeschenFI .druckvariablespeichern:meldeauffaellig +(aktuellemaske,meldungplausipruefung);IF fehlerindruckvariable(erfassungsfeld +[dvdefinition])THEN rueckschrittenachproc(1);LEAVE angabenabspeichernELSE +drvdruckvar:=ausdruckwardruckvariable;putsteuercode(int(erfassungsfeld[ +dvnummer]),erfassungsfeld[dvdefinition],int(erfassungsfeld[dvlaenge]), +erfassungsfeld[dvrechtsbuendig]<>niltext,drvdruckvar); +sichernundhilfsfilesloeschenFI .druckwertespeichern:meldeauffaellig( +aktuellemaske,meldungplausipruefung);IF druckwerteokTHEN startpos:= +fnrerstesausgabefeld;putdruckaufbereitung(erfassungsfeld[dwschriftart],real( +erfassungsfeld[dwlinkerrandlinks]),real(erfassungsfeld[dwlinkerrandoben]),int +(erfassungsfeld[dwzeilenproseite]),real(erfassungsfeld[dwzeichenprozeile])); +sichernundhilfsfilesloeschenELSE IF lvf=0THEN meldeauffaellig(aktuellemaske, +meldungfalscheeingabe);ELSE meldeauffaellig(aktuellemaske, +meldungkeinefonttabelle);FI ;rueckschrittenachproc(1);LEAVE +angabenabspeichernFI .druckwerteok:lvf:=0;fonttabelleeingestelltCAND +fontexistiertauchCAND linkerrandrichtigCAND rechterrandrichtig. +linkerrandrichtig:startpos:=dwlinkerrandlinks;real(erfassungsfeld[ +dwlinkerrandlinks])>=minanfangCAND real(erfassungsfeld[dwlinkerrandlinks])<= +maxanfang.rechterrandrichtig:startpos:=dwlinkerrandoben;real(erfassungsfeld[ +dwlinkerrandoben])>=minanfangCAND real(erfassungsfeld[dwlinkerrandoben])<= +maxanfang.fonttabelleeingestellt:startpos:=dwschriftart;disablestop;txt:=font +(1);IF iserrorTHEN clearerror;lvf:=1FI ;enablestop;lvf=0.fontexistiertauch: +startpos:=dwschriftart;font(erfassungsfeld[dwschriftart])>0.END PROC +angabenabspeichern;PROC maskenwertezeigenundbearbeiten:IF +loeschenderdruckausgabeTHEN allefeldersperren(TRUE ); +maskenwerteholenundausgeben(zuwas);druckausgabeloeschfrageELSE +allefeldersperren(FALSE );maskenwerteholenundausgeben(zuwas); +druckausgabeeinlesen(zuwas)FI ;END PROC maskenwertezeigenundbearbeiten;PROC +maskenwerteholenundausgeben(INT CONST wozu):LET maxanzobjektklassen=10;INT +VAR feld,nrindex,lvf,lvi;TEXT VAR z,datname;datenseite:=1;SELECT wozuOF CASE +nameundtyp:nameundtypzeigenCASE objektklassen:objektklassenzeigenCASE +zugriffsregeln:zugriffsregelzeigenCASE selektion:selektionzeigenCASE +druckformular:druckformularzeigenCASE druckvariablen:druckvariablezeigenCASE +druckwerte:druckwertezeigenEND SELECT ;IF wozu<>druckformularTHEN put(maske, +erfassungsfeld,letztesmaskenfeld[zuwas]);FI .nameundtypzeigen:BOOL VAR +ausgabelistenweise;erfassungsfeld[ntnummer]:=nummerderdruckausgabe;IF NOT +neuedruckausgabeTHEN ausgabelistenweise:=FALSE ;getformularinfo( +erfassungsfeld[ntname],nrdruckausgabe,ausgabelistenweise);FI ;IF +neuedruckausgabeTHEN protect(maske,fnrerstesausgabefeld,TRUE )FI ;startpos:= +fnrerstesausgabefeld+1;.objektklassenzeigen:FOR lvfFROM 1UPTO +maxanzobjektklassenREP erfassungsfeld[lvf+1]:=getobjektklasse(lvf)PER ;. +zugriffsregelzeigen:objektklasseholen;moeglichezugriffezeigen; +anzahlderdateizeilen:=lines(f);IF zugriffsregelgibtesbereitsTHEN +gespeichertezugriffezeigen;FI ;zugriffezeigenvorbereiten(datenseite);startpos +:=zerstervergleich.moeglichezugriffezeigen:primaerzugriffholen;IF firstindex> +0THEN sekundaerzugriffeholen;FI ;.primaerzugriffholen:forget(filenamezug, +quiet);f:=sequentialfile(modify,filenamezug);datname:=erfassungsfeld[ +zobjklname];dnr:=dateinr(datname);anzfelder:=anzkey(dnr);zeilennr:=1;nrindex +:=0;FOR lvfFROM 1UPTO anzfelderREP feld:=dnr+lvf;zeileindateischreiben;PER ;. +sekundaerzugriffeholen:FOR lviFROM firstindexUPTO firstfree-1REP IF dateinr( +primdatid(lvi))=dnrTHEN anzahlderfelderbestimmen;nrindexINCR 1;FOR lvfFROM 1 +UPTO anzfelderREP feld:=dnr+int(subtext(z,1,pos(z,semikolon)-1));z:=subtext(z +,pos(z,semikolon)+1);zeileindateischreiben;PER ;FI ;PER ;. +anzahlderfelderbestimmen:z:=zugriff(lvi);INT VAR posi;anzfelder:=0;posi:=pos( +z,semikolon);WHILE posi>0REP anzfelderINCR 1;posi:=pos(z,semikolon,posi+1) +PER ;.zeileindateischreiben:zeilezusammensetzen;toline(f,zeilennr); +insertrecord(f);writerecord(f,zeile);zeilennrINCR 1;.zeilezusammensetzen:IF +lvf=1THEN zeile:=text(nrindex)+anzahltrenner;zeileCAT text(anzfelder);zeile +CAT namentrenner;ELSE zeile:=namentrennerFI ;zeileCAT name(feld);zeileCAT +zeilennrtrenner;zeileCAT text(zeilennr);.gespeichertezugriffezeigen: +gespeichertezugriffeholen;gespeichertezugriffeindateieintragen. +gespeichertezugriffeholen:IF druckenderdefinitionTHEN regelnr:= +benoetigteregelFI ;getzugriffsregel(regelnr,zrobjekt,zrregel,zrindex,zranzahl +);.gespeichertezugriffeindateieintragen:pattern:=text(zrindex)+anzahltrenner; +toline(f,1);readrecord(f,zeile);IF pos(zeile,pattern)>0THEN zugriffeeintragen +ELSE down(f,pattern);IF patternfoundTHEN zugriffeeintragenFI FI . +zugriffeeintragen:zeilennr:=lineno(f);FOR lvfFROM 1UPTO zranzahlREP toline(f, +zeilennr);readrecord(f,zeile);zeileCAT vergleichtrenner;zeileCAT +getvergleichswert(regelnr,lvf);writerecord(f,zeile);zeilennrINCR 1;PER . +selektionzeigen:forget(filenamesel,quiet);f:=sequentialfile(modify, +filenamesel);dnr:=dateinr(getobjektklasse(leitobjekt)); +feldnamenindateischreiben;anzahlderdateizeilen:=lines(f); +gespeicherteselektionenindateischreiben;selektionenzeigenvorbereiten( +datenseite);startpos:=serstervergleich.feldnamenindateischreiben:FOR lvfFROM +1UPTO anzattr(dnr)REP toline(f,lvf);insertrecord(f);zeile:=name(dnr+lvf)+ +zeilennrtrenner+text(lvf)+vergleichtrenner;writerecord(f,zeile);PER . +gespeicherteselektionenindateischreiben:IF getanzahlselfelder<>0THEN FOR lvf +FROM 1UPTO getanzahlselfelderREP toline(f,lvf);readrecord(f,zeile); +getselektion(lvf,sfeldname,svergleichswert);zeileCAT svergleichswert; +writerecord(f,zeile);PER FI .druckformularzeigen:filenameformtp:=wert( +fnridanummer)+trenner+wert(fnridaname);forget(filenameformtp,quiet);IF exists +(getformtextname)THEN copy(getformtextname,filenameformtp)FI ;startpos:= +fnrerstesausgabefeld.druckvariablezeigen:IF druckvariablegibtesbereitsTHEN +protect(maske,dvnummer,TRUE );IF drvlaenge=0THEN erfassungsfeld[dvlaenge]:= +niltextELSE erfassungsfeld[dvlaenge]:=text(drvlaenge)FI ;IF drvrechtsbuendig +THEN erfassungsfeld[dvrechtsbuendig]:=ankreuzzeichenELSE erfassungsfeld[ +dvrechtsbuendig]:=niltextFI FI ;startpos:=dvdefinition.druckwertezeigen:REAL +VAR linksoben,linkslinks,spalten;INT VAR zeilen;zurueck;getdruckaufbereitung( +erfassungsfeld[dwschriftart],linkslinks,linksoben,zeilen,spalten); +erfassungsfeld[dwlinkerrandlinks]:=text(linkslinks);erfassungsfeld[ +dwlinkerrandoben]:=text(linksoben);erfassungsfeld[dwzeilenproseite]:=text( +zeilen);erfassungsfeld[dwzeichenprozeile]:=subtext(text(spalten),1,pos(text( +spalten),".")-1);.END PROC maskenwerteholenundausgeben;PROC objektklasseholen +:erfassungsfeld[zobjklname]:=getobjektklasse(int(erfassungsfeld[zobjklasse])) +;END PROC objektklasseholen;PROC selektionenzeigenvorbereiten(INT CONST +seitennr):bildschirmausgabenselektionsammeln(seitennr); +selektionsfeldersperren;freizeilenselektionloeschenEND PROC +selektionenzeigenvorbereiten;PROC bildschirmausgabenselektionsammeln(INT +CONST seitennr):INT VAR lvf;merkzeile:=maxselektionen+1;leseanfangindatei:=( +seitennr-1)*maxselektionen+1;FOR lvfFROM 1UPTO maxselektionenREP IF lvf+ +leseanfangindatei-1<=anzahlderdateizeilenTHEN toline(f,lvf+leseanfangindatei- +1);readrecord(f,zeile);erfassungsfeld[sersteselektion+(lvf-1)*2]:=subtext( +zeile,1,pos(zeile,zeilennrtrenner)-1);IF pos(zeile,vergleichtrenner)>0THEN +erfassungsfeld[serstervergleich+(lvf-1)*2]:=subtext(zeile,pos(zeile, +vergleichtrenner)+tl);FI ;ELSE merkzeile:=lvf;LEAVE +bildschirmausgabenselektionsammelnFI PER ;END PROC +bildschirmausgabenselektionsammeln;PROC selektionsfeldersperren:INT VAR lvf; +allefeldersperren(TRUE );FOR lvfFROM 1UPTO maxselektionenREP protect(maske, +serstervergleich+(lvf-1)*2,FALSE )PER END PROC selektionsfeldersperren;PROC +freizeilenselektionloeschen:INT VAR lv;FOR lvFROM merkzeileUPTO +maxselektionenREP erfassungsfeld[sersteselektion+(lv-1)*2]:=niltext; +erfassungsfeld[serstervergleich+(lv-1)*2]:=niltext;protect(maske, +serstervergleich+(lv-1)*2,TRUE )PER END PROC freizeilenselektionloeschen; +PROC zugriffezeigenvorbereiten(INT CONST seitennr): +bildschirmausgabenzugriffsammeln(seitennr);zugriffsfeldersperren; +freizeilenzugriffloeschenEND PROC zugriffezeigenvorbereiten;PROC +bildschirmausgabenzugriffsammeln(INT CONST seitennr):INT VAR lvf;merkzeile:= +maxzugriffe+1;leseanfangindatei:=(seitennr-1)*maxzugriffe+1;FOR lvfFROM 1 +UPTO maxzugriffeREP IF lvf+leseanfangindatei-1<=anzahlderdateizeilenTHEN +toline(f,lvf+leseanfangindatei-1);readrecord(f,zeile);erfassungsfeld[znummer+ +(lvf-1)*3]:=subtext(zeile,1,pos(zeile,anzahltrenner)-1);erfassungsfeld[ +zersterzugriff+(lvf-1)*3]:=subtext(zeile,pos(zeile,namentrenner)+tl,pos(zeile +,zeilennrtrenner)-1);IF pos(zeile,vergleichtrenner)>0THEN erfassungsfeld[ +zerstervergleich+(lvf-1)*3]:=subtext(zeile,pos(zeile,vergleichtrenner)+tl); +ELSE erfassungsfeld[zerstervergleich+(lvf-1)*3]:=niltextFI ;ELSE merkzeile:= +lvf;LEAVE bildschirmausgabenzugriffsammelnFI PER ;.END PROC +bildschirmausgabenzugriffsammeln;PROC zugriffsfeldersperren:INT VAR lvf; +allefeldersperren(TRUE );FOR lvfFROM 1UPTO maxzugriffeREP protect(maske, +zerstervergleich+(lvf-1)*3,FALSE )PER END PROC zugriffsfeldersperren;PROC +freizeilenzugriffloeschen:INT VAR lv;FOR lvFROM merkzeileUPTO maxzugriffeREP +erfassungsfeld[znummer+(lv-1)*3]:=niltext;erfassungsfeld[zersterzugriff+(lv-1 +)*3]:=niltext;erfassungsfeld[zerstervergleich+(lv-1)*3]:=niltext;protect( +maske,zerstervergleich+(lv-1)*3,TRUE )PER END PROC freizeilenzugriffloeschen; +PROC datenseiteraufoderrunter(INT CONST wie):IF wie=vorwaertsTHEN datenseite +INCR 1ELSE datenseiteDECR 1FI ;END PROC datenseiteraufoderrunter;PROC +datenseiterunteroderrauf(INT CONST wie):IF wie=vorwaertsTHEN datenseiteDECR 1 +ELSE datenseiteINCR 1FI END PROC datenseiterunteroderrauf;PROC +angabenloeschen(INT CONST was):SELECT wasOF CASE nameundtyp: +nameundtyploeschenCASE zugriffsregeln:zugriffsregelloeschenCASE +druckvariablen:druckvariableloeschenEND SELECT .nameundtyploeschen:delform( +getactivformular);forget(getformtextname,quiet);forget(filenamedata+text( +getactivformular),quiet);delete(dnrida).zugriffsregelloeschen:deleteregel( +regelnr);sichernundhilfsfilesloeschen;.druckvariableloeschen:putsteuercode( +int(erfassungsfeld[dvnummer]),niltext,0,FALSE ,FALSE ); +sichernundhilfsfilesloeschen.END PROC angabenloeschen;PROC allefeldersperren( +BOOL CONST freigabe):INT VAR lv;FOR lvFROM fnrerstesausgabefeldUPTO +letztesmaskenfeld[zuwas]+5REP protect(maske,lv,freigabe)PER ;protect(maske, +letztesmaskenfeld[zuwas]+1,TRUE );startpos:=fnrerstesausgabefeld;END PROC +allefeldersperren;PROC changeinfile(TEXT CONST fname,vorher,nachher):INT VAR +lv;f:=sequentialfile(modify,fname);FOR lvFROM 1UPTO lines(f)REP toline(f,lv); +readrecord(f,zeile);changeall(zeile,vorher,nachher);writerecord(f,zeile)PER ; +toline(f,1)END PROC changeinfile;PROC druckdefinitiondrucken: +druckenderdefinition:=TRUE ;zugriffsregelgibtesbereits:=TRUE ;meldeauffaellig +(aktuellemaske,meldungsammelndruckdef);druckdefinitionzusammenstellen(PROC ( +INT CONST )maskenwerteholenundausgeben,erfassungsfeld);meldeauffaellig( +aktuellemaske,meldungdruckendruckdef);sichernundhilfsfilesloeschen; +nummerderdruckausgabe:=niltext;druckenderdefinition:=FALSE ; +zugriffsregelgibtesbereits:=FALSE ;rueckschrittevorproc(1)#dr16.12.87#END +PROC druckdefinitiondrucken;BOOL PROC erlaubteregeleingabe:LET maxeingabe=10; +(nummernummerisch(erfassungsfeld[zobjklasse])CAND int(erfassungsfeld[ +zobjklasse])>1CAND int(erfassungsfeld[zobjklasse])<=maxeingabeCAND +getobjektklasse(int(erfassungsfeld[zobjklasse]))<>niltext)CAND ( +nummernummerisch(erfassungsfeld[zregelnr])CAND int(erfassungsfeld[zregelnr])> +0CAND int(erfassungsfeld[zregelnr])<=maxeingabe)END PROC erlaubteregeleingabe +;BOOL PROC erlaubtevariableneingabe:LET maxeingabe=100;(nummernummerisch( +erfassungsfeld[dvnummer])CAND int(erfassungsfeld[dvnummer])>0CAND int( +erfassungsfeld[dvnummer])<=maxeingabe)END PROC erlaubtevariableneingabe;PROC +eventuellmeldungausgeben:IF meldungstext<>niltextTHEN meldeauffaellig( +aktuellemaske,meldungstext);meldungstext:=niltext;FI END PROC +eventuellmeldungausgeben;PROC eventuellmeldungbeilistenabarbeitung:IF +druckausgabelistenauswahlTHEN meldeauffaellig(aktuellemaske,meldungstext); +kurzepause;meldungstext:=niltext;enter(1)ELSE IF listederdruckausgabengezeigt +CAND (zuwas=zugriffsregelnOR zuwas=druckvariablen)CAND NOT ( +druckausgabelistenauswahl)THEN zurueckzurbearbeitung(2)ELSE +rueckschrittevorproc(2)FI ;FI .kurzepause:pause(10).END PROC +eventuellmeldungbeilistenabarbeitung;PROC feldschutzfestlegen(INT CONST abwo) +:INT VAR lv;protect(maske,1,TRUE );FOR lvFROM abwoUPTO letztesmaskenfeld[ +zuwas]REP protect(maske,lv,TRUE )PER END PROC feldschutzfestlegen;PROC +feldschutzfuerbearbeitungfestlegen(INT CONST wozu):protect(maske,1,TRUE ); +SELECT wozuOF CASE zugriffsregeln:feldschutzfestlegen(fnrerstesausgabefeld+2) +CASE druckvariablen:feldschutzfestlegen(fnrerstesausgabefeld+1)OTHERWISE : +allefeldersperren(FALSE )END SELECT ;END PROC +feldschutzfuerbearbeitungfestlegen;PROC loeschfeldverdecken:LET rahmenzeichen +="=";put(aktuellemaske,rahmenzeichen,letztesmaskenfeld[zuwas]+1);END PROC +loeschfeldverdecken;TEXT PROC meldungseinschub:TEXT VAR t;SELECT zuwasOF +CASE zugriffsregeln:t:="zur Regel k"+compress(erfassungsfeld[zobjklasse])+"r" ++compress(erfassungsfeld[zregelnr])CASE druckvariablen:t:= +"zur Druckvariablen "+erfassungsfeld[dvnummer]OTHERWISE :t:= +"zur Druckausgabe "+text(getactivformular)END SELECT ;tEND PROC +meldungseinschub;PROC standardfelderfuellen:INT VAR lv;FOR lvFROM 1UPTO +letztesmaskenfeld[zuwas]REP standardmaskenfeld(erfassungsfeld[lv],(lv))PER +END PROC standardfelderfuellen;END PACKET ispidadefinieren; + diff --git a/app/schulis/2.2.1/src/6.ida.druck b/app/schulis/2.2.1/src/6.ida.druck new file mode 100644 index 0000000..d24c0cd --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.druck @@ -0,0 +1,261 @@ +PACKET idadruckDEFINES listendruck,ausdruckauswerten,bschirm,drucker, +namederdruckausgabe,namederdruckausgabeohne,druckausgabeausgeben,ruecksprung, +zurueck,postext,seitenweise:LET linkeklammer="<",rechteklammer=">", +platzhalter="�",linefeed=" ",trenner=" ",kzkosmetik="#",kzseitenzahl="%", +ddrucker=1,dbschirm=2,mlddrucken=58,mldaufb=190;TEXT VAR filename:= +"ISP-Liste";INT CONST drucker:=ddrucker,bschirm:=dbschirm;FILE VAR ausgfile; +INT VAR dbauswertung,anzzeilen,zeilenzaehler:=0,fusszeilen:=0,kopfzeilen:=0, +aktuelleseite:=0,aktuellerds:=0,zeilenlaenge,verbund;BOOL VAR tupelbearbeitet +,isppageform:=FALSE ;TEXT VAR restderletztenzeile:="";TEXT VAR schriftart:="" +,kopfbereich:="",fussbereich:="",kosmetikbereich:="zzzz";REAL VAR links,oben; +#nurtest!!!!!!PROC standardmeldung(INT CONST mldaufb,TEXT CONST t):fehler( +"MELDUNG: "+text(mldaufb)+" "+t)ENDPROC standardmeldung;PROC editiere(TEXT +CONST fname,BOOL CONST f):edit(fname)ENDPROC editiere;PROC enter(INT CONST i) +:ENDPROC enter;#PROC seitenweise(BOOL CONST jn):isppageform:=jnENDPROC +seitenweise;BOOL PROC seitenweise:isppageformENDPROC seitenweise;TEXT PROC +rechtscompress(TEXT CONST zeile):TEXT VAR z:=zeile;INT VAR p:=length(zeile); +WHILE p>0CAND (zSUB p)=trennerREP pDECR 1PER ;z:=text(z,p);zENDPROC +rechtscompress;INT PROC bestimmevorhandeneblanks(TEXT CONST zeile):INT VAR +vorhandeneblanks:=0,i;FOR iFROM 1UPTO length(zeile)REP IF (zeileSUB i)= +trennerTHEN vorhandeneblanksINCR 1FI UNTIL (zeileSUB i)<>trennerPER ; +vorhandeneblanksENDPROC bestimmevorhandeneblanks;TEXT PROC +textmitfuehrendenblanks(TEXT CONST z,INT CONST anzblanks):INT VAR +vorhandeneblanks:=0;TEXT VAR zeile:=z;vorhandeneblanks:= +bestimmevorhandeneblanks(zeile);IF vorhandeneblanks>anzblanksTHEN +zeilekuerzenELSE mitblanksauffuellenFI ;zeile.zeilekuerzen:zeile:=subtext( +zeile,vorhandeneblanks-anzblanks).mitblanksauffuellen:zeile:=(anzblanks- +vorhandeneblanks)*trenner+zeile.ENDPROC textmitfuehrendenblanks;TEXT PROC +aktfilename:IF aktuellerds=0THEN filenameELSE filename+"."+text(aktuellerds) +FI ENDPROC aktfilename;PROC schreibebereich(TEXT CONST bereich,BOOL CONST +kopf):INT VAR von:=0,bis;TEXT VAR zeile:="";bis:=pos(bereich,linefeed);WHILE +bis>0REP zeile:=subtext(bereich,von+1,bis-1);IF kopfTHEN changeall(zeile, +kzseitenzahl,text(aktuelleseite));zeilenzaehlerINCR 1FI ;putline(ausgfile, +zeile);von:=bis;bis:=pos(bereich,linefeed,von+1);PER ENDPROC schreibebereich; +PROC schreibekopf:schreibebereich(kopfbereich,TRUE )ENDPROC schreibekopf; +PROC schreibefuss:schreibebereich(fussbereich,FALSE )ENDPROC schreibefuss; +PROC seitenvorschub:schreibefuss;IF filefastvollTHEN ausgabedateianlegenELSE +putline(ausgfile,"#page#")FI ;zeilenzaehler:=0;aktuelleseiteINCR 1; +schreibekopf.filefastvoll:lines(ausgfile)>=3000COR storage(old(aktfilename))> +700.ENDPROC seitenvorschub;PROC pageeinfuegen:putline(ausgfile,"#page#"); +zeilenzaehler:=0;ENDPROC pageeinfuegen;PROC zeilenvorschubundfussdrucken: +WHILE zeilenzaehler0THEN auszeile:=restderletztenzeile;IF +keintrennerzwischenzeilenTHEN auszeileCAT trennerFI FI ;auszeileCAT zeile; +restderletztenzeile:="";IF length(auszeile)<=zeilenlaengeTHEN putlein( +auszeile,FALSE )ELSE bestimmelinkenrand;WHILE length(auszeile)>zeilenlaenge +REP trennpositionbestimmen;zeileausgebenundkürzen;PER ;IF length(auszeile)>0 +THEN IF blocksatzTHEN putlein(auszeile,FALSE )ELSE restderletztenzeile:= +textmitfuehrendenblanks(auszeile,linkerrand)FI FI FI . +keintrennerzwischenzeilen:(restderletztenzeileSUB length(restderletztenzeile) +)<>trennerCAND (zeileSUB 1)<>trenner.bestimmelinkenrand:linkerrand:= +bestimmevorhandeneblanks(auszeile);.trennpositionbestimmen:trennpos:= +zeilenlaenge;WHILE trennpos>linkerrandCAND (auszeileSUB trennpos)<>trenner +REP trennposDECR 1PER ;IF trennpos<=linkerrandTHEN trennpos:=max(zeilenlaenge +,linkerrand+1);WHILE trennpos<=length(auszeile)CAND (auszeileSUB trennpos)<> +trennerREP trennposINCR 1PER ;FI .zeileausgebenundkürzen:putlein( +rechtscompress(text(auszeile,trennpos-1)),FALSE );auszeile:=compress(subtext( +auszeile,trennpos+1));IF length(auszeile)>0THEN auszeile:= +textmitfuehrendenblanks(auszeile,linkerrand)FI .ENDPROC putzeile;PROC +nextergebnistupel:INT VAR dnr;qsucc(verbund,dnr);tupelbearbeitet:=FALSE ; +verbund:=gettiefennr(verbund);IF dbstatus=endoffileCAND dbauswertung= +ordernewstackTHEN auswertungfortsetzen;dbauswertung:=dbstatus;qsucc(verbund, +dnr);verbund:=gettiefennr(verbund);FI ENDPROC nextergebnistupel;TEXT PROC +sonderfunktion(TEXT CONST stcode):TEXT VAR t:=stcode,ausdruck:=stcode;IF ( +ausdruckSUB 1)=linkeklammerTHEN deletechar(ausdruck,1)FI ;IF (ausdruckSUB +length(ausdruck))=rechteklammerTHEN deletechar(ausdruck,length(ausdruck))FI ; +IF ausdruck="tagesdatum"THEN t:=dateELIF ausdruck="tag"THEN t:=day(date(date) +)ELIF ausdruck="monat"THEN t:=month(date(date))ELIF ausdruck="jahr"THEN t:= +year(date(date))ELIF ausdruck="zeit"THEN t:=timeofdayELIF ausdruck="tt"THEN t +:=text(date,2)ELIF ausdruck="mm"THEN t:=subtext(date,4,5)ELIF ausdruck="jj" +THEN t:=subtext(date,7)FI ;tENDPROC sonderfunktion;TEXT PROC +aufbereitetezeile(TEXT CONST zeile,einfuegstellen):TEXT VAR auszeile:="", +auswert:="",ausdruck:="";INT VAR p:=1,pp,ppalt:=1,ix,laenge;BOOL VAR rbuendig +,druckvar;pp:=pos(zeile,platzhalter,ppalt);WHILE pp>0REP auszeileCAT subtext( +zeile,ppalt,pp-1);ix:=decodezahl(einfuegstellen,p);IF ix>0THEN getsteuercode( +ix,ausdruck,laenge,rbuendig,druckvar);IF druckvarTHEN auswert:= +ausdruckauswerten(ausdruck);aufbereitenundschreiben;ELSE auswert:= +sonderfunktion(ausdruck);aufbereitenundschreiben;FI FI ;ppalt:=pp+1;pp:=pos( +zeile,platzhalter,ppalt);PER ;auszeileCAT subtext(zeile,ppalt);auszeile. +aufbereitenundschreiben:IF laenge>0THEN IF length(auswert)>=laengeCOR NOT +rbuendigTHEN auswert:=text(auswert,laenge)ELSE auswert:=((laenge-length( +auswert))*" ")+auswertFI ;FI ;auszeileCAT auswert.ENDPROC aufbereitetezeile; +PROC druckezeile(TEXT CONST zeile,einfuegstellen):putzeile(aufbereitetezeile( +zeile,einfuegstellen))ENDPROC druckezeile;PROC druckeblock(INT CONST blocknr) +:INT VAR aktzeile:=1,pb,pz,nextblock,nextblockvorzeile;REP IF aktzeile=1CAND +verbund=blocknrTHEN tupelbearbeitet:=TRUE FI ;pb:=1;pz:=1;bestimmeunterblock; +WHILE aktzeile<=getzeilenanzahl(blocknr)COR aktzeile=nextblockvorzeileREP IF +aktzeile=nextblockvorzeileTHEN IF verbundblocknrTHEN LEAVE druckeblockFI ELIF verbund<>blocknrTHEN LEAVE +druckeblockFI UNTIL blocknr=0PER .innerhalbkosmetikbereich:(blocknr=0)CAND (( +aktzeile>=code(kosmetikbereichSUB 1)CAND aktzeile<=code(kosmetikbereichSUB 2) +)COR (aktzeile>=code(kosmetikbereichSUB 3)CAND aktzeile<=code(kosmetikbereich +SUB 4))).bestimmeunterblock:nextblock:=decodezahl(getunterbloecke(blocknr),pb +);nextblockvorzeile:=decodezahl(getvorzeilennr(blocknr),pz);.ENDPROC +druckeblock;PROC listendruck(INT CONST nr):listendruck(nr,bschirm)ENDPROC +listendruck;PROC ausgabedateianlegen:aktuellerdsINCR 1;forget(aktfilename, +quiet);ausgfile:=sequentialfile(output,aktfilename);putlein(schrifttyp,TRUE ) +;putlein(startanweisung,TRUE );zeilenzaehler:=0.schrifttyp:IF schriftart="" +THEN ""ELSE "#type ("""+schriftart+""")#"FI .startanweisung:"#start("+text( +links)+","+text(oben)+")# ".ENDPROC ausgabedateianlegen;PROC +headundbottommerken:#block(0)nachheadundbottomuntersuchen#INT VAR aktzeile:=1 +,p;TEXT VAR ausdruck:="",zeile:="";kopfzeilen:=0;fusszeilen:=0;kopfbereich:= +"";fussbereich:="";kosmetikbereich:="zzzz";WHILE aktzeile<=getzeilenanzahl(0) +REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;p:=pos(zeile,kzkosmetik);IF p> +0THEN ausdruckeinlesen;IF ausdruck="head"THEN kopfeinlesenELIF ausdruck= +"bottom"THEN fusseinlesenFI ;FI ;PER .ausdruckeinlesen:ausdruck:=compress( +subtext(zeile,p+1,pos(zeile,kzkosmetik,p+1)-1)).bereichsende:p:=pos(zeile, +kzkosmetik);IF p>0THEN ausdruckeinlesen;pos(";head;bottom;end;",";"+ausdruck+ +";")>0ELSE FALSE FI .kopfeinlesen:replace(kosmetikbereich,1,code(aktzeile-1)) +;REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;IF bereichsendeTHEN replace( +kosmetikbereich,2,code(aktzeile-1));LEAVE kopfeinlesenELSE kopfzeilenINCR 1; +zeile:=aufbereitetezeile(zeile,geteinfuegstellen(0,aktzeile-1));kopfbereich +CAT (zeile+linefeed)FI PER .fusseinlesen:replace(kosmetikbereich,3,code( +aktzeile-1));REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;IF bereichsende +THEN replace(kosmetikbereich,4,code(aktzeile-1));LEAVE fusseinlesenELSE +fusszeilenINCR 1;zeile:=aufbereitetezeile(zeile,geteinfuegstellen(0,aktzeile- +1));fussbereichCAT (zeile+linefeed)FI PER .ENDPROC headundbottommerken;PROC +listendruck(INT CONST nr,INT CONST medium):REAL VAR limit;INT VAR fontnr:=0; +getdruckaufbereitung(schriftart,links,oben,anzzeilen,limit);schriftartpruefen +;zeilenlaenge:=int(limit);#IF seitenweiseTHEN #headundbottommerken; +aktuelleseite:=1;aktuellerds:=-1;ausgabedateianlegen;IF seitenweiseTHEN +schreibekopfFI ;auswertung("QUERY."+text(nr));dbauswertung:=dbstatus; +restderletztenzeile:="";verbund:=-1;tupelbearbeitet:=TRUE ;druckeblock(0);IF +length(restderletztenzeile)>0THEN putzeile("")FI ;IF seitenweiseCAND +fusszeilen>0THEN zeilenvorschubundfussdruckenFI ;druckegesamtliste. +schriftartpruefen:disablestop;fontnr:=font(schriftart);IF iserrorTHEN +schriftart:="";clearerror;ELIF fontnr=0THEN schriftart:=font(1)FI ;enablestop +.druckegesamtliste:BOOL VAR cd:=commanddialogue;INT VAR i;IF seitenweiseCOR +schriftart=""THEN druckausgabeausgeben(filename,medium);IF seitenweiseCAND +aktuellerds>0CAND medium=druckerTHEN FOR iFROM 1UPTO aktuellerdsREP +druckausgabeausgeben(filename,medium);PER FI ELSE sysout("dummy"); +commanddialogue(FALSE );standardmeldung(mldaufb,"");autopageform(filename); +forget(filename,quiet);sysout("");forget("dummy",quiet);commanddialogue(cd); +druckausgabeausgeben(filename+".p",medium)FI .ENDPROC listendruck;TEXT PROC +namederdruckausgabeohne:filenameENDPROC namederdruckausgabeohne;TEXT PROC +namederdruckausgabe:filename+".p"ENDPROC namederdruckausgabe;PROC +namederdruckausgabe(TEXT CONST fname):filename:=fnameENDPROC +namederdruckausgabe;PROC druckausgabeausgeben(TEXT CONST fname,INT CONST +medium):SELECT mediumOF CASE dbschirm:caufanfang;editiere(fname,FALSE );CASE +ddrucker:standardmeldung(mlddrucken,"");print(fname);enter(1)OTHERWISE : +errorstop("Falscher Druck-Code")ENDSELECT ;zurueck.caufanfang:FILE VAR f:= +sequentialfile(modify,fname);toline(f,1).ENDPROC druckausgabeausgeben;BOOL +VAR rueck:=FALSE ;PROC zurueck:rueck:=TRUE ENDPROC zurueck;BOOL PROC +ruecksprung:BOOL VAR b:=rueck;rueck:=FALSE ;bENDPROC ruecksprung;LET +parametergrenze="%",parametertrennzeichen="#",otherwise="*",niltext="", +textbegrenzer="""";INT PROC postextende(TEXT CONST ausgabe,INT CONST +aktuelleposition):INT VAR neupos:=aktuelleposition+1;WHILE (ausgabeSUB neupos +)<>textbegrenzerREP neuposINCR 1;IF (ausgabeSUB neupos)=textbegrenzerCAND ( +ausgabeSUB neupos+1)=textbegrenzerTHEN neuposINCR 2;FI ;UNTIL neupos>length( +ausgabe)PER ;neupos+1ENDPROC postextende;INT PROC postext(TEXT CONST source, +pattern,INT CONST from):INT VAR p:=from;WHILE (sourceSUB p)<>patternREP +nextcharUNTIL p>length(source)PER ;#9.12.87#IF p>length(source)THEN 0ELSE p +FI .nextchar:IF (sourceSUB p)=textbegrenzerTHEN p:=postextende(source,p)ELSE +pINCR 1;#9.12.87#FI .ENDPROC postext;TEXT PROC dbwert(TEXT CONST feldname, +BOOL VAR textvergleich):LET null="0",nulldatum="01.01.00";TEXT VAR ausgabe:= +"";INT CONST fnr:=feldnr(compress(feldname));IF fnr>0THEN ausgabe:=wert(fnr); +IF ((feldtyp(fnr)=intfeld)CAND (ausgabe=null))COR ((feldtyp(fnr)=datumfeld) +CAND (ausgabe=nulldatum))THEN ausgabe:=""FI ;textvergleich:=NOT (feldtyp(fnr) +=realfeldCOR feldtyp(fnr)=intfeld)ELSE textvergleich:=TRUE FI ;ausgabeEND +PROC dbwert;TEXT PROC auswerten(TEXT CONST eingabe):INT VAR +positionlinkeklammer:=1,positionrechteklammer:=1,positionlinkeskreuz, +positionrechteskreuz,positionmittlereskreuz,positionparametergrenze, +aktuelleposition:=1,positionotherwise,anzahldergeoeffnetenklammern;BOOL VAR +ausdruckvorhanden,caseaufruf,linkeseitevariabel,rechteseitevariabel, +textvergleich;TEXT VAR puffer,vergleichswert,aktuellessymbol,parameter1, +ausgabe:=compress(eingabe);REP zeichenketteueberlesen; +auffindeneinesspitzgeklammertenausdrucks;IF ausdruckvorhandenTHEN +bestimmungdesfeldnamensfuerdieprozedurdbwert;aufrufderprozedurdbwert;IF +caseaufrufTHEN bestimmungderrichtigenalternativeFI ; +einsetzendesfeldwertsoderderalternative;FI ;UNTIL NOT ausdruckvorhandenPER ; +ausgabe.zeichenketteueberlesen:INT VAR p:=aktuelleposition;#1#BOOL VAR +innerhalbzeichenkette:=TRUE ;IF (ausgabeSUB p)=linkeklammerTHEN pINCR 1;FI ; +IF aktuelleszeichenisttextbegrenzerTHEN WHILE innerhalbzeichenketteREP REP +UNTIL textendeCOR aktuelleszeichenisttextbegrenzerPER ;IF NOT textendeCAND ( +ausgabeSUB p)=textbegrenzerTHEN innerhalbzeichenkette:=TRUE ;pINCR 1ELSE +innerhalbzeichenkette:=FALSE ;FI PER ;pDECR 1;aktuelleposition:=p; +leerzeichenentfernen;FI .aktuelleszeichenisttextbegrenzer:IF (ausgabeSUB p)= +textbegrenzerTHEN deletechar(ausgabe,p);TRUE ELSE pINCR 1;FALSE FI .textende: +p>length(ausgabe).leerzeichenentfernen:WHILE (ausgabeSUB p)=" "REP deletechar +(ausgabe,p)PER .auffindeneinesspitzgeklammertenausdrucks:#aktuelleposition:=0 +;#linkeseitevariabel:=FALSE ;rechteseitevariabel:=FALSE ;aktuelleposition:= +pos(ausgabe,linkeklammer,aktuelleposition);ausdruckvorhanden:= +aktuelleposition<>0;positionlinkeklammer:=aktuelleposition. +bestimmungdesfeldnamensfuerdieprozedurdbwert: +ueberpruefeoblinkeseitedoppeltgeklammert;bestimmedenfeldnamen;IF +aktuellessymbol=rechteklammerTHEN caseaufruf:=FALSE ;fuehreleseoperationaus; +ueberpruefeobrechteseitedoppeltgeklammertELSE caseaufruf:=TRUE ; +positionparametergrenze:=aktuellepositionFI .fuehreleseoperationaus: +aktuellepositionINCR 1;IF aktuelleposition>length(ausgabe)THEN +aktuellessymbol:=rechteklammerELSE aktuellessymbol:=ausgabeSUB +aktuelleposition;FI ;IF aktuellessymbol=linkeklammerTHEN +anzahldergeoeffnetenklammernINCR 1ELIF aktuellessymbol=rechteklammerTHEN +anzahldergeoeffnetenklammernDECR 1FI .fuehreleseoperationausmittextueberlesen +:aktuellepositionINCR 1;IF (ausgabeSUB aktuelleposition)=textbegrenzerTHEN +aktuelleposition:=postextende(ausgabe,aktuelleposition)FI ;IF +aktuelleposition>length(ausgabe)THEN aktuellessymbol:=rechteklammerELSE +aktuellessymbol:=ausgabeSUB aktuelleposition;FI ;IF aktuellessymbol= +linkeklammerTHEN anzahldergeoeffnetenklammernINCR 1ELIF aktuellessymbol= +rechteklammerTHEN anzahldergeoeffnetenklammernDECR 1FI . +ueberpruefeoblinkeseitedoppeltgeklammert:fuehreleseoperationaus; +linkeseitevariabel:=aktuellessymbol=linkeklammer.bestimmedenfeldnamen:WHILE +NOT (aktuellessymbol=parametertrennzeichenOR aktuellessymbol=parametergrenze +OR aktuellessymbol=rechteklammer)REP fuehreleseoperationausPER ;IF +linkeseitevariabelTHEN parameter1:=(subtext(ausgabe,positionlinkeklammer+2, +aktuelleposition-1))ELSE parameter1:=(subtext(ausgabe,positionlinkeklammer+1, +aktuelleposition-1))FI .ueberpruefeobrechteseitedoppeltgeklammert:IF +aktuellessymbol=rechteklammerTHEN rechteseitevariabel:=TRUE ; +positionrechteklammer:=aktuellepositionELSE positionrechteklammer:= +aktuelleposition-1FI .aufrufderprozedurdbwert:puffer:=dbwert(parameter1, +textvergleich).bestimmungderrichtigenalternative: +bestimmungdeserstenvergleichswertes;WHILE +vergleichswertstimmtnichtuebereinundeinweiterervorhandenREP +suchenaechstenvergleichswertPER ;positionrechteklammerbeicaseaufrufbestimmen; +IF vergleichswertstimmtmitdemergebnisausdemdbwertaufrufuebereinTHEN +bereitstellenderentsprechendenalternativeELIF (ausgabeSUB positionotherwise)= +otherwiseTHEN puffer:=auswerten(subtext(ausgabe,positionotherwise+1, +positionrechteklammer-1))ELSE bereitstelleneinerleerenalternativeFI . +bestimmungdeserstenvergleichswertes:positionlinkeskreuz:= +positionparametergrenze;positionmittlereskreuz:=postext(ausgabe, +parametertrennzeichen,positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe, +positionlinkeskreuz+1,positionmittlereskreuz-1);rechteskreuzbestimmen. +suchenaechstenvergleichswert:positionlinkeskreuz:=positionrechteskreuz; +positionmittlereskreuz:=postext(ausgabe,parametertrennzeichen, +positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe,positionlinkeskreuz+1, +positionmittlereskreuz-1);rechteskreuzbestimmen.rechteskreuzbestimmen: +aktuelleposition:=positionmittlereskreuz;anzahldergeoeffnetenklammern:=0;REP +fuehreleseoperationausmittextueberlesenUNTIL (anzahldergeoeffnetenklammern=0 +AND (aktuellessymbol=parametertrennzeichenOR aktuellessymbol=otherwise))OR +anzahldergeoeffnetenklammern<0PER ;positionrechteskreuz:=aktuelleposition; +positionotherwise:=aktuelleposition. +vergleichswertstimmtmitdemergebnisausdemdbwertaufrufueberein:IF textvergleich +THEN vergleichswert=pufferELSE real(vergleichswert)=real(puffer)FI . +bereitstellenderentsprechendenalternative:puffer:=auswerten(subtext(ausgabe, +positionmittlereskreuz+1,positionrechteskreuz-1)). +bereitstelleneinerleerenalternative:puffer:=niltext. +vergleichswertstimmtnichtuebereinundeinweiterervorhanden:NOT +vergleichswertstimmtmitdemergebnisausdemdbwertaufrufuebereinAND +einweiterervergleichswertistvorhanden.einweiterervergleichswertistvorhanden: +aktuellessymbol=parametertrennzeichen. +positionrechteklammerbeicaseaufrufbestimmen:anzahldergeoeffnetenklammern:=0; +IF aktuellessymbol<>rechteklammerTHEN WHILE NOT (anzahldergeoeffnetenklammern +<0AND aktuellessymbol=rechteklammer)REP +fuehreleseoperationausmittextueberlesenPER FI ;positionrechteklammer:= +aktuelleposition.einsetzendesfeldwertsoderderalternative:change(ausgabe, +positionlinkeklammer,positionrechteklammer,puffer).ENDPROC auswerten;TEXT +PROC ausdruckauswerten(TEXT CONST ausdruck):TEXT VAR eingabe:=ausdruck;IF ( +eingabeSUB 1)<>linkeklammerTHEN insertchar(eingabe,linkeklammer,1)FI ;IF ( +eingabeSUB (length(eingabe)))<>rechteklammerTHEN eingabeCAT rechteklammerFI ; +auswerten(eingabe)ENDPROC ausdruckauswerten;ENDPACKET idadruck; + diff --git a/app/schulis/2.2.1/src/6.ida.eingang b/app/schulis/2.2.1/src/6.ida.eingang new file mode 100644 index 0000000..c4de3f7 --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.eingang @@ -0,0 +1,87 @@ +PACKET idaeingangsbildschirmDEFINES generieredruckausgabe, +eingangsbildschirmdarstellen#,putdrucktyp,putdruckindex#:LET maskennamelehrer +="mdr lehrerweise dr eingang",maskennameeinzeln= +"mdr einzelobjekt druckausgabe eingang";LET maxfeld=8,wartemeldnr=69, +auswahlnichtkorrekt=188,auswahlnichteind=189,niltext="",mldnrformnichtda=262; +LET markiert="#";LET lehrer="Lehrer",schueler="Schüler";TEXT VAR +leitobjektklasse,scanwertlehrer;INT CONST primindex:=2;#(ROW maxfeldINT :(246 +,255,247,246,246,246,246,0),ROW maxfeldINT :(246,255,247,246,246,246,246,246) +);#ROW maxfeldINT VAR indicesschueler:=ROW maxfeldINT :(ixsustatfamrufgeb, +ixsustatjgst,ixsustatjgstzug,ixsustatfamrufgeb,ixsustatfamrufgeb, +ixsustatfamrufgeb,ixsustatfamrufgeb,ixsustatfamrufgeb);TEXT VAR maskenname:= +"";INT VAR letztenummerderdruckausgabe:=0;INT VAR druckinx,ankreuzfeld;INT +PROC druckindex:druckinxENDPROC druckindex;PROC putdruckindex(INT CONST dinx) +:druckinx:=dinxENDPROC putdruckindex;PROC eingangsbildschirmdarstellen:TEXT +VAR fname:="";INT VAR findex:=0,nochmeld;BOOL VAR ftyp; +setzelistederdruckausgabengezeigt(FALSE );IF ruecksprungTHEN ohnepruefung +ELSE mitpruefungFI .mitpruefung:IF listenweiseauswahlkorrektTHEN +letztenummerderdruckausgabe:=nummerderdruckausgabe;putdruckindex( +letztenummerderdruckausgabe);holeformular;namederdruckausgabe(getformularname +);#standardkopfmaskeaktualisieren(namederdruckausgabe);#maskedarstellen;FI . +ohnepruefung:putdruckindex(letztenummerderdruckausgabe);holeformular; +maskedarstellen.holeformular:setzenummerderdruckausgabe(text( +letztenummerderdruckausgabe));IF formexists(druckinx)THEN getform(druckinx) +ELSE formunvollstaendigFI ;#openformular(druckinx);bereitsinformularzerlegen! +#formularzerlegen(druckinx);IF getblockanzahl<1THEN formunvollstaendigFI ; +getformularinfo(fname,findex,ftyp);systemdboff.formunvollstaendig: +standardmeldung(mldnrformnichtda,niltext);return(1);LEAVE +eingangsbildschirmdarstellen.listenweiseauswahlkorrekt: +idaankreuzfelderpruefen.maskedarstellen:leitobjektklasse:=getobjektklasse(1); +IF leitobjektklasse=schuelerTHEN maskenname:=maskennameeinzelnELIF +leitobjektklasse=lehrerTHEN maskenname:=maskennamelehrerFI ;standardstartproc +(maskenname);standardkopfmaskeaktualisieren(namederdruckausgabeohne);nochmeld +:=nochmeldungauszugeben;IF nochmeld<>0THEN TEXT VAR drinx:=text(druckindex)+ +markiert;standardmeldung(nochmeld,drinx)FI ;standardnproc.END PROC +eingangsbildschirmdarstellen;PROC generieredruckausgabe(INT CONST medium): +INT VAR leitinx;generieredruck.generieredruck:IF leitobjektklasse=schueler +THEN leitinx:=leitindexschueler;ueberpruefeleitinx;putleitindex( +leitindexschueler);ELSE leitinx:=leitindexlehrer;ueberpruefeleitinx; +putleitindex(leitindexlehrer)FI ;putobjektklasse(1,leitobjektklasse);IF +leitobjektklasse=schuelerTHEN putscan(erzeugescan)ELSE putscan(scanwertlehrer +)FI ;erzeugequery(druckindex);standardmeldung(wartemeldnr,niltext); +listendruck(druckindex,medium).ueberpruefeleitinx:IF leitinx<=0THEN #return(1 +);#LEAVE generieredruckausgabeFI ;ENDPROC generieredruckausgabe;INT PROC +leitindexschueler:INT VAR wievielter;INT VAR i,leitinx,offset:=1;ankreuzfeld +:=0;pruefeeindeutigkeit;bestimmeindex;bestimmewievielterindex. +pruefeeindeutigkeit:FOR iFROM 2UPTO maxfeld+offsetREP IF standardmaskenfeld(i +)<>""THEN IF ankreuzfeld>0THEN #note("Feld : "+text(i)+" Inhalt : "+ +standardmaskenfeld(i));noteline;note("Ankreuzfeld : "+text(ankreuzfeld)); +noteline;#standardmeldung(auswahlnichteind,niltext);return(1);LEAVE +leitindexschuelerWITH (-1)ELSE ankreuzfeld:=iFI FI PER ;IF ankreuzfeld<=0 +THEN #note("Feld : "+text(i)+" Inhalt : "+standardmaskenfeld(i));noteline; +note("Ankreuzfeld : "+text(ankreuzfeld));noteline;#standardmeldung( +auswahlnichtkorrekt,niltext);return(1);LEAVE leitindexschuelerWITH (-2)FI . +bestimmeindex:leitinx:=indicesschueler[ankreuzfeld-1];. +bestimmewievielterindex:wievielter:=0;FOR iFROM firstindexUPTO firstfree-1 +REP IF dateinr(primdatid(i))=primindexTHEN wievielterINCR 1;IF i=leitinxTHEN +LEAVE leitindexschuelerWITH wievielterFI FI PER ;0ENDPROC leitindexschueler; +INT PROC leitindexlehrer:INT VAR status,leitinx;scanwertlehrer:=""; +standardpruefe(5,2,4,0,"",status);IF status<>0THEN standardmeldung( +auswahlnichtkorrekt,niltext);return(1);leitinx:=-1;ELSE IF standardmaskenfeld +(5)=""THEN IF standardmaskenfeld(2)<>""THEN leitinx:=dnrlehrerELIF +standardmaskenfeld(3)<>""THEN leitinx:=ixlfamrufELIF standardmaskenfeld(4)<> +""THEN infeld(5);standardmeldung(auswahlnichteind,niltext);return(1);leitinx +:=-1FI ;ELSE IF standardmaskenfeld(4)<>""THEN leitinx:=dnrlehrer; +scanwertlehrer:="<""";scanwertlehrerCAT standardmaskenfeld(5);scanwertlehrer +CAT """>";ELSE standardmeldung(auswahlnichtkorrekt,niltext);return(1);leitinx +:=-1;FI ;FI ;FI ;leitinxEND PROC leitindexlehrer;TEXT PROC erzeugescan:INT +VAR i,evteinzel:=0;evteinzel:=1;scanfuereinzel.scanfuereinzel:SELECT +ankreuzfeldOF CASE 2:"<""ls"">"CASE 3:statusjgstCASE 4:statusjgstzugCASE 5: +"<""ls"">"+evtschuelerCASE 6:"<""n05"">"+evtschuelerCASE 7:"<""n11"">"+ +evtschuelerCASE 8:"<""nso"">"+evtschuelerCASE 9:"<""abg"">"+evtschueler +OTHERWISE :""ENDSELECT .evtschueler:scantxt:="";FOR iFROM 12UPTO 14REP IF +standardmaskenfeld(i)<>""THEN scantxt:=scantxt+";"+"<"""+evtdatum+""">"ELSE +LEAVE evtschuelerWITH scantxtFI PER ;scantxt.evtdatum:IF i=14THEN +datumskonversion(standardmaskenfeld(i))ELSE standardmaskenfeld(i)FI . +statusjgst:IF standardmaskenfeld(9+evteinzel)<>""THEN "<""ls"">;<"""+ +jgstaufber(standardmaskenfeld(9+evteinzel))+""">"ELSE "<""ls"">"FI . +statusjgstzug:TEXT VAR scantxt:="";IF standardmaskenfeld(9+evteinzel)<>"" +THEN scantxt:="<""ls"">;<"""+jgstaufber(standardmaskenfeld(9+evteinzel))+ +""">";IF standardmaskenfeld(10+evteinzel)<>""THEN scantxt:=scantxt+";<"""+ +standardmaskenfeld(10+evteinzel)+""">"FI ;scantxtELSE "<""ls"">"FI .ENDPROC +erzeugescan;INT PROC nummerderdruckausgabe:TEXT VAR t;INT VAR i,lv;FOR lv +FROM 1UPTO 10REP IF standardmaskenfeld(lv*2#+1#)<>""THEN nummerermittelnFI +PER ;0.nummerermitteln:t:=standardmaskenfeld(lv*2+1);t:=subtext(t,1,pos(t, +" = ")-1);i:=int(t);LEAVE nummerderdruckausgabeWITH i.END PROC +nummerderdruckausgabe;ENDPACKET idaeingangsbildschirm; + diff --git a/app/schulis/2.2.1/src/6.ida.gen b/app/schulis/2.2.1/src/6.ida.gen new file mode 100644 index 0000000..c4d4eeb --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.gen @@ -0,0 +1,79 @@ +PACKET idagenDEFINES formularzerlegen,erzeugequery:LET platzhalter="�", +okkenner="k",linkeklammer="<",rechteklammer=">";FILE VAR formtext;TEXT VAR +zeile:="",blockstruktur:="";INT VAR lastblock:=0;TEXT PROC blockcode(INT +CONST objklasse,regel):"!"+text(objklasse)+"."+text(regel)+"!"ENDPROC +blockcode;BOOL PROC blockende(INT CONST objklasse,regel):pos(blockstruktur, +blockcode(objklasse,regel))>0ENDPROC blockende;PROC blockmerken(INT CONST +objklasse,regel):blockstrukturCAT blockcode(objklasse,regel)ENDPROC +blockmerken;PROC unterblockeintragen(INT CONST blocknr,unterblock):TEXT VAR +ub:=getunterbloecke(blocknr),vz:=getvorzeilennr(blocknr);INT VAR zeilennr:= +getzeilenanzahl(blocknr);ubCAT text(unterblock)+";";vzCAT text(zeilennr+1)+ +";";putunterbloecke(blocknr,ub);putvorzeilennr(blocknr,vz);ENDPROC +unterblockeintragen;PROC inaktuellenblockuebernehmen(TEXT CONST zeile,INT +CONST blocknr):TEXT VAR textzeile:=zeile,einfuegstellen:="";INT VAR zeilennr +:=getzeilenanzahl(blocknr)+1,vonp,bisp,stcodenr;druckvariablenersetzen; +putzeilenanzahl(blocknr,zeilennr);putzeile(blocknr,zeilennr,textzeile); +puteinfuegstellen(blocknr,zeilennr,einfuegstellen);.druckvariablenersetzen: +vonp:=pos(textzeile,linkeklammer);WHILE vonp>0REP bisp:=pos(textzeile, +rechteklammer,vonp+1);IF bisp=0THEN bisp:=length(textzeile)FI ;stcodenr:=int( +subtext(textzeile,vonp+1,bisp-1));einfuegstellenCAT text(stcodenr)+";";change +(textzeile,vonp,bisp,platzhalter);vonp:=pos(textzeile,linkeklammer);PER . +ENDPROC inaktuellenblockuebernehmen;PROC bearbeiteblock(INT CONST b):INT +CONST blocknr:=b;INT VAR p,bis,objklasse,regel;BOOL VAR eoformtext:=FALSE ; +putzeilenanzahl(blocknr,0);putunterbloecke(blocknr,"");putvorzeilennr(blocknr +,"");WHILE NOT eoformtextREP IF zugriffsregelgefundenTHEN okundregelbestimmen +;IF blockende(objklasse,regel)THEN LEAVE bearbeiteblockELSE blockmerken( +objklasse,regel);IF compress(zeile)=""CAND NOT eof(formtext)THEN getline( +formtext,zeile);FI ;lastblockINCR 1;unterblockeintragen(blocknr,lastblock); +putblockregelnummer(lastblock,getregelnummer(objklasse,regel));bearbeiteblock +(lastblock)FI ;ELSE inaktuellenblockuebernehmen(zeile,blocknr)FI ;IF eof( +formtext)THEN eoformtext:=TRUE ELSE getline(formtext,zeile);FI ;PER ;. +zugriffsregelgefunden:p:=pos(zeile,linkeklammer+okkenner);p>0. +okundregelbestimmen:bis:=p+2;objklasse:=int(zeileSUB bis);bisINCR 1;IF +istziffer(zeileSUB bis)THEN objklasse:=objklasse*10+int(zeileSUB bis);bis +INCR 1;FI ;IF (zeileSUB bis)=rechteklammerTHEN regel:=1ELSE regel:=int(zeile +SUB bis+1);bisINCR 2;IF istziffer(zeileSUB bis)THEN regel:=regel*10+int(zeile +SUB bis);bisINCR 1;FI ;FI ;change(zeile,p,bis,"").ENDPROC bearbeiteblock; +PROC formularzerlegen(INT CONST nr):openformular(nr);lastblock:=0; +blockstruktur:="";zeile:="";formtext:=sequentialfile(input,getformtextname); +IF NOT eof(formtext)THEN getline(formtext,zeile)FI ;IF eof(formtext)CAND +zeile=""THEN putzeilenanzahl(0,0);putunterbloecke(0,"");putvorzeilennr(0,""); +ELSE bearbeiteblock(0)FI ENDPROC formularzerlegen;BOOL PROC istziffer(TEXT +CONST t):pos("0123456789",t)>0END PROC istziffer;LET textbegrenzer="""", +klammerauf=" ( ",klammerzu=" ).",trenner=" / ",refinementname="verbund";FILE +VAR queryfile;TEXT PROC alstext(TEXT CONST t):textbegrenzer+t+textbegrenzer +ENDPROC alstext;TEXT PROC bestimmeindexname(TEXT CONST dateiname,INT CONST nr +):TEXT VAR n:=alstext(dateiname);INT VAR i,treffer:=0;IF nr>0CAND firstindex> +0THEN FOR iFROM firstindexUPTO firstfree-1REP IF name(dateinr(primdatid(i)))= +dateinameTHEN trefferINCR 1FI ;IF treffer=nrTHEN n:=n+" BY "+alstext(name(i)) +;FI UNTIL treffer=nrPER FI ;nENDPROC bestimmeindexname;TEXT PROC +bestimmeverbunde(INT CONST blocknr):TEXT VAR v:="";INT VAR nr,p:=1;REP nr:= +decodezahl(getunterbloecke(blocknr),p);IF nr>0THEN IF v=""THEN vCAT +refinementname+text(nr)ELSE vCAT ";"+refinementname+text(nr)FI FI UNTIL nr=0 +PER ;vENDPROC bestimmeverbunde;TEXT PROC bestimmescanbedingung(INT CONST +regel,anzkeyfelder):TEXT VAR scan:="",vgl:="";INT VAR f;FOR fFROM 1UPTO +anzkeyfelderREP vgl:=getvergleichswert(regel,f);vergleichswertcodieren;IF +scan=""THEN scanCAT vglELSE scanCAT ";"+vglFI PER ;scan. +vergleichswertcodieren:IF konstanteTHEN vgl:=linkeklammer+vgl+rechteklammer +ELSE vgl:=textbegrenzer+vgl+textbegrenzerFI .konstante:(vglSUB 1)= +textbegrenzer.ENDPROC bestimmescanbedingung;PROC verbund(INT CONST blocknr): +TEXT VAR string:="";INT CONST regelnr:=getblockregelnummer(blocknr);INT VAR k +,r,index,anzfelder;IF regelnr>0THEN getzugriffsregel(regelnr,k,r,index, +anzfelder)FI ;line(queryfile);putline(queryfile,refinementname+text(blocknr)+ +":");IF regelnr>0THEN string:=bestimmeindexname(getobjektklasse(k),index); +stringCAT klammerauf;stringCAT bestimmescanbedingung(regelnr,anzfelder); +stringCAT trenner;stringCAT trenner;stringCAT trenner;stringCAT +bestimmeverbunde(blocknr);stringCAT klammerzu;putline(queryfile,string)ELSE +putline(queryfile,".")FI ENDPROC verbund;PROC erzeugequery(INT CONST nr):INT +VAR b;TEXT VAR string:="";forget(queryfilename,quiet);queryfile:= +sequentialfile(output,queryfilename);FOR bFROM 1UPTO getblockanzahlREP IF b=1 +THEN initqueryELSE verbund(b)FI PER ;.queryfilename:"QUERY."+text(nr). +initquery:string:=bestimmeindexname(getobjektklasse(1),getleitindex);string +CAT klammerauf;stringCAT getscan;stringCAT trenner;stringCAT trenner;putline( +queryfile,string);string:="";IF getselektion>""THEN stringCAT "selektion"FI ; +stringCAT trenner;putline(queryfile,string);string:="";stringCAT +bestimmeverbunde(1);stringCAT klammerzu;putline(queryfile,string);IF +getselektion>""THEN line(queryfile);string:="selektion: ";stringCAT +getselektion;stringCAT ".";putline(queryfile,string);FI .ENDPROC erzeugequery +;ENDPACKET idagen + diff --git a/app/schulis/2.2.1/src/6.ida.grund b/app/schulis/2.2.1/src/6.ida.grund new file mode 100644 index 0000000..b298b95 --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.grund @@ -0,0 +1,182 @@ +PACKET ispidagrundfunktionenDEFINES selektionenindateieintragen, +zugriffsregelnindateieintragen,druckausgabenlistezeigen,regellistezeigen, +variablenlistezeigen,behandlungderausgesuchten,inlisteblaettern, +maskenwertesichern,nummerderdruckausgabesetzen,nureinedruckausgabeangekreuzt, +rueckschrittevorproc,rueckschrittenachproc,sichernundhilfsfilesloeschen, +hilfsfilesloeschen,erfassungdruckausgabe,init,put, +setzedruckausgabelistenauswahl,druckausgabelistenauswahl, +setzelistederdruckausgabengezeigt,listederdruckausgabengezeigt, +setzeaktuellemaske,aktuellemaske:LET filenamezug="Hilfsdatei.Zugriff", +filenamesel="Hilfsdatei.Selektion",filenamedruck="Hilfsdatei.Druck", +filenamedliste="Druckausgaben",filenamezliste="Zugriffe",filenamevliste= +"Variablen";LET meldunglistenerstellung=7,meldungletzterwert=67, +meldungkeineliste=68,meldungkeinblaettern=72,meldungkeinezugriffe=200, +meldungkeinevariablen=201;LET maxselektionen=17,maxzugriffe=16,zeileninliste= +18,ausgabelaenge=71,maxvariablen=100;LET zugriffsregeln=4,druckvariablen=7; +LET serstervergleich=3,zobjkl=2,zregnr=3,zerstervergleich=7,lt=3,dnummer=2, +vnummer=2;LET vergleichtrenner="",trenner=" = ",oblitrenner="$",blank=" ", +kleinr="r",kleink="k",niltext="";LET andenanfang=1,andasende=2,vorwaerts=3, +rueckwaerts=4;BOOL VAR listenauswahl,listegezeigt;BOOL VAR dvrrechts, +dvrdruckvar,listeeinmalgezeigt:=FALSE ;INT VAR lvi,lvf,posi,zeilennr, +dvrlaenge,zobjekt,zregel,zindex,zanzahl,startzeile,zeilenindatei,schritte; +FILE VAR f,g;TAG VAR aktmaske;TEXT VAR zeile,dvrname,wert1,wert2,datname; +PROC selektionenindateieintragen(INT CONST leseanfangindatei,ROW 100TEXT +CONST erfassungsfeld):f:=sequentialfile(modify,filenamesel);zeilennr:= +leseanfangindatei;lvi:=serstervergleich;FOR lvfFROM leseanfangindateiUPTO +leseanfangindatei+maxselektionen-1REP IF zeilennr<=lines(f)THEN +vergleichswerteanhaengenFI PER ;.vergleichswerteanhaengen:toline(f,lvf); +readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0THEN zeile:= +subtext(zeile,1,posi-1)FI ;zeileCAT vergleichtrenner;zeileCAT erfassungsfeld[ +lvi];writerecord(f,zeile);lviINCR 2;zeilennrINCR 1;.END PROC +selektionenindateieintragen;PROC zugriffsregelnindateieintragen(INT CONST +leseanfangindatei,ROW 100TEXT CONST erfassungsfeld):f:=sequentialfile(modify, +filenamezug);zeilennr:=leseanfangindatei;lvi:=zerstervergleich;FOR lvfFROM +leseanfangindateiUPTO leseanfangindatei+maxzugriffe-1REP IF zeilennr<=lines(f +)THEN vergleichswerteanhaengenFI PER ;.vergleichswerteanhaengen:toline(f,lvf) +;readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0THEN zeile:= +subtext(zeile,1,posi-1);FI ;IF erfassungsfeld[lvi]<>niltextTHEN zeileCAT +vergleichtrenner;zeileCAT erfassungsfeld[lvi];FI ;writerecord(f,zeile);lvi +INCR 3;zeilennrINCR 1;.END PROC zugriffsregelnindateieintragen;PROC +druckausgabenlistezeigen:forget(filenamedliste,quiet);datname:=filenamedliste +;f:=sequentialfile(output,datname);first(dnrida);WHILE dbstatus=okREP +zeilezusammensetzen;putline(f,text(zeile,ausgabelaenge));succ(dnrida)PER ; +startzeiledruckausgabenlistebestimmen(datname);IF startzeile=0THEN +meldeauffaellig(aktuellemaske,meldungkeineliste);return(1)ELSE +setzelistederdruckausgabengezeigt(TRUE );listeeinmalgezeigt:=TRUE ; +listezeigen(datname)FI .zeilezusammensetzen:zeile:=wert(fnridanummer)+trenner ++wert(fnridaname);.END PROC druckausgabenlistezeigen;PROC +startzeiledruckausgabenlistebestimmen(TEXT VAR fname):INT VAR lv;f:= +sequentialfile(modify,fname);FOR lvFROM 1UPTO lines(f)REP toline(f,lv); +readrecord(f,zeile);IF int(subtext(zeile,1,pos(zeile,trenner)-1))>=int( +standardmaskenfeld(dnummer))THEN startzeile:=lv;LEAVE +startzeiledruckausgabenlistebestimmenFI PER ;startzeile:=0END PROC +startzeiledruckausgabenlistebestimmen;PROC regellistezeigen:forget( +filenamezliste,quiet);datname:=filenamezliste;f:=sequentialfile(output, +datname);IF getanzahlregeln=0THEN meldeauffaellig(aktuellemaske, +meldungkeinezugriffe);return(1)ELSE meldeauffaellig(aktuellemaske, +meldunglistenerstellung);listeeinmalgezeigt:=FALSE ; +listederregelnzusammenstellen;startzeileregellistebestimmen(datname);IF +startzeile=0THEN meldeauffaellig(aktuellemaske,meldungkeineliste);return(1) +ELSE setzedruckausgabelistenauswahl(TRUE );listezeigen(datname)FI FI ;END +PROC regellistezeigen;PROC listederregelnzusammenstellen:FOR lvfFROM 1UPTO +getanzahlregelnREP getzugriffsregel(lvf,zobjekt,zregel,zindex,zanzahl);zeile +:=kleink+text(zobjekt)+kleinr+text(zregel);putline(f,text(zeile,ausgabelaenge +))PER END PROC listederregelnzusammenstellen;PROC +startzeileregellistebestimmen(TEXT VAR fname):INT VAR lv,lvi,anzahl;f:= +sequentialfile(modify,fname);regelnsortieren;anzahl:=lines(f);FOR lvFROM 1 +UPTO anzahlREP toline(f,lv);readrecord(f,zeile);IF objektindatei= +objektinmaskeTHEN lvi:=lv;WHILE regelindateiobjektinmaskePER ; +startzeile:=lvi;LEAVE startzeileregellistebestimmenFI ;IF objektindatei> +objektinmaskeTHEN startzeile:=lv;LEAVE startzeileregellistebestimmenFI PER ; +startzeile:=0.objektindatei:int(subtext(zeile,2,pos(zeile,kleinr)-1)). +objektinmaske:int(standardmaskenfeld(zobjkl)).regelindatei:int(subtext(zeile, +pos(zeile,kleinr)+1)).regelinmaske:int(standardmaskenfeld(zregnr)). +pruefenobdateiendesonstnaechstenlesen:IF lvi=anzahlTHEN startzeile:=0;LEAVE +startzeileregellistebestimmenELSE lviINCR 1;toline(f,lvi);readrecord(f,zeile) +;FI .END PROC startzeileregellistebestimmen;PROC variablenlistezeigen:forget( +filenamevliste,quiet);datname:=filenamevliste;f:=sequentialfile(output, +datname);FOR lvfFROM 1UPTO maxvariablenREP getsteuercode(lvf,dvrname, +dvrlaenge,dvrrechts,dvrdruckvar);IF dvrname<>niltextTHEN +listedervariablenzusammenstellen;FI PER ;IF lines(f)=0THEN meldeauffaellig( +aktuellemaske,meldungkeinevariablen);return(1)ELSE meldeauffaellig( +aktuellemaske,meldunglistenerstellung);listeeinmalgezeigt:=FALSE ; +startzeilevariablenlistebestimmen(datname);IF startzeile=0THEN +meldeauffaellig(aktuellemaske,meldungkeineliste);return(1)ELSE +setzedruckausgabelistenauswahl(TRUE );listezeigen(datname)FI FI END PROC +variablenlistezeigen;PROC listedervariablenzusammenstellen:zeile:=text(lvf); +zeileCAT trenner;zeileCAT dvrname;putline(f,text(zeile,ausgabelaenge))END +PROC listedervariablenzusammenstellen;PROC startzeilevariablenlistebestimmen( +TEXT VAR fname):INT VAR lv;f:=sequentialfile(modify,fname);FOR lvFROM 1UPTO +lines(f)REP toline(f,lv);readrecord(f,zeile);IF int(subtext(zeile,1,pos(zeile +,trenner)-1))>=int(standardmaskenfeld(vnummer))THEN startzeile:=lv;LEAVE +startzeilevariablenlistebestimmenFI PER ;startzeile:=0END PROC +startzeilevariablenlistebestimmen;PROC listezeigen(TEXT CONST dateiname):LET +listenmaskenname="mu objektliste";initobli;initmaske(aktmaske, +listenmaskenname);standardstartproc(listenmaskenname);f:=sequentialfile( +modify,dateiname);zeilenindatei:=lines(f);seitezeigenEND PROC listezeigen; +PROC inlisteblaettern(INT CONST wohin):SELECT wohinOF CASE andenanfang: +andendateianfangCASE andasende:andasdateiendeCASE vorwaerts: +vorwaertsblaetternindateiCASE rueckwaerts:rueckwaertsblaetternindateiEND +SELECT ;.andendateianfang:IF startzeile<>1THEN startzeile:=1;seitezeigenELSE +zurueck;FI .andasdateiende:IF startzeilezeileninlisteTHEN startzeileDECR +zeileninliste;seitezeigenELSE andendateianfangFI .END PROC inlisteblaettern; +PROC seitezeigen:FOR lvfFROM 1UPTO zeileninlisteREP IF startzeile+lvf-1<= +zeilenindateiTHEN toline(f,startzeile+lvf-1);readrecord(f,zeile);posi:=pos( +zeile,vergleichtrenner);IF posi>0THEN standardmaskenfeld(subtext(zeile,1,posi +-1),lvf*2+1);standardmaskenfeld(subtext(zeile,posi+lt),lvf*2);ELSE +standardmaskenfeld(zeile,lvf*2+1);standardmaskenfeld(niltext,lvf*2);FI ; +feldfrei(lvf*2)ELSE standardmaskenfeld(text(niltext,ausgabelaenge),lvf*2+1); +standardmaskenfeld(niltext,lvf*2);feldschutz(lvf*2)FI PER ;END PROC +seitezeigen;PROC maskenwertesichern:FOR lvfFROM 1UPTO zeileninlisteREP IF +standardmaskenfeld(lvf*2+1)<>ausgabelaenge*blankTHEN zeile:= +standardmaskenfeld(lvf*2+1);zeileCAT vergleichtrenner;zeileCAT +standardmaskenfeld(lvf*2);toline(f,startzeile+lvf-1);writerecord(f,zeile)FI +PER END PROC maskenwertesichern;PROC behandlungderausgesuchten(PROC (INT +CONST )wastun,ROW 100TEXT VAR feld,INT CONST womit):BOOL VAR ok:=FALSE ;init( +feld);wertholen(womit,ok);IF okTHEN feldervorbelegen;wastun(womit);ELSE +meldeauffaellig(aktuellemaske,meldungletzterwert);zurueck; +setzedruckausgabelistenauswahl(FALSE );forget(datname,quiet); +listeeinmalgezeigt:=FALSE ;enter(2)#rueckschrittevorproc(2)dr01.08.88#FI . +feldervorbelegen:SELECT womitOF CASE zugriffsregeln:feld[zobjkl]:=wert1;feld[ +zregnr]:=wert2;CASE druckvariablen:feld[vnummer]:=wert1END SELECT .END PROC +behandlungderausgesuchten;PROC wertholen(INT CONST wozu,BOOL VAR nochda):g:= +sequentialfile(modify,datname);#dr01.08.88#nochda:=lines(g)>0;IF NOT nochda +THEN LEAVE wertholenELSE toline(g,1);WHILE lines(g)>0REP readrecord(g,zeile); +posi:=pos(zeile,vergleichtrenner);deleterecord(g);UNTIL posi>0CAND subtext( +zeile,posi+lt)<>niltextPER ;IF lines(g)>0THEN werteermittelnELIF posi>0CAND +subtext(zeile,posi+lt)<>niltextTHEN werteermittelnELSE nochda:=FALSE FI FI . +werteermitteln:SELECT wozuOF CASE zugriffsregeln:objektundregelermittelnCASE +druckvariablen:variablennummerermittelnEND SELECT .objektundregelermitteln: +wert1:=subtext(zeile,pos(zeile,kleink)+1,pos(zeile,kleinr)-1);wert2:=subtext( +zeile,pos(zeile,kleinr)+1,pos(zeile,blank)-1).variablennummerermitteln:wert1 +:=subtext(zeile,1,pos(zeile,trenner)-1);wert2:=niltext.END PROC wertholen; +PROC rueckschrittevorproc(INT CONST wieviele):BOOL VAR b:=TRUE ;schritte:= +wieviele;WHILE bREP IF listeeinmalgezeigtTHEN schritteINCR 1;b:=FALSE ELSE # +dr01.08.88#b:=listederdruckausgabengezeigt;listeeinmalgezeigt:=TRUE FI PER ; +listeeinmalgezeigt:=listederdruckausgabengezeigt;enter(schritte)END PROC +rueckschrittevorproc;PROC rueckschrittenachproc(INT CONST wieviele):return( +wieviele);END PROC rueckschrittenachproc;PROC nummerderdruckausgabesetzen( +TEXT VAR nr):FOR lvfFROM 1UPTO lines(f)REP toline(f,lvf);readrecord(f,zeile); +posi:=pos(zeile,vergleichtrenner);IF posi>0CAND subtext(zeile,posi+lt)<> +niltextTHEN nr:=subtext(zeile,1,pos(zeile," = ")-1);LEAVE +nummerderdruckausgabesetzenFI ;PER END PROC nummerderdruckausgabesetzen;BOOL +PROC nureinedruckausgabeangekreuzt:BOOL VAR angekreuzt:=FALSE ;f:= +sequentialfile(modify,filenamedliste);FOR lvfFROM 1UPTO lines(f)REP toline(f, +lvf);readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0CAND +subtext(zeile,posi+lt)<>niltextTHEN IF angekreuztTHEN LEAVE +nureinedruckausgabeangekreuztWITH FALSE ELSE angekreuzt:=TRUE FI FI PER ; +angekreuztEND PROC nureinedruckausgabeangekreuzt;PROC +sichernundhilfsfilesloeschen:putform;hilfsfilesloeschenEND PROC +sichernundhilfsfilesloeschen;PROC hilfsfilesloeschen:forget(filenamezug,quiet +);forget(filenamesel,quiet);forget(filenamedruck,quiet);forget(filenamedliste +,quiet)END PROC hilfsfilesloeschen;PROC erfassungdruckausgabe(INT CONST n): +LET trenner=" = ";LET laengezeile=71;TEXT VAR identizeile;identizeile:=wert( +fnridanummer)+trenner+wert(fnridaname);identizeile:=text(identizeile, +laengezeile);setzeidentiwert(identizeilemitschluesselanhang). +identizeilemitschluesselanhang:identizeile+oblitrenner+wert(fnridanummer). +END PROC erfassungdruckausgabe;PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR +iFROM 1UPTO 100REP feld(i):=""PER END PROC init;PROC put(TAG CONST maske,ROW +100TEXT CONST feld,INT CONST letztesfeld):INT VAR lv;FOR lvFROM 2UPTO +letztesfeldREP IF fieldexists(maske,lv)THEN put(maske,feld[lv],lv)FI PER END +PROC put;PROC setzeaktuellemaske(TAG CONST welchemaske):aktmaske:=welchemaske +END PROC setzeaktuellemaske;TAG PROC aktuellemaske:aktmaskeEND PROC +aktuellemaske;PROC setzedruckausgabelistenauswahl(BOOL CONST b):listenauswahl +:=bEND PROC setzedruckausgabelistenauswahl;BOOL PROC +listederdruckausgabengezeigt:listegezeigtEND PROC +listederdruckausgabengezeigt;PROC setzelistederdruckausgabengezeigt(BOOL +CONST b):listegezeigt:=bEND PROC setzelistederdruckausgabengezeigt;BOOL PROC +druckausgabelistenauswahl:listenauswahlEND PROC druckausgabelistenauswahl; +PROC regelnsortieren:INT VAR lv,anzahl;anzahl:=lines(f);blanksentfernen;sort( +filenamezliste);moeglicherweisenachsortieren.blanksentfernen:FOR lvFROM 1 +UPTO anzahlREP toline(f,lv);readrecord(f,zeile);changeall(zeile," ",""); +writerecord(f,text(zeile,ausgabelaenge))PER .moeglicherweisenachsortieren: +FOR lvFROM 1UPTO anzahlREP toline(f,1);readrecord(f,zeile);IF subtext(zeile,2 +,2)="1"THEN deleterecord(f);toline(f,anzahl);insertrecord(f);writerecord(f, +text(zeile,ausgabelaenge))ELSE LEAVE regelnsortierenFI PER .END PROC +regelnsortieren;END PACKET ispidagrundfunktionen; + diff --git a/app/schulis/2.2.1/src/6.ida.plausi b/app/schulis/2.2.1/src/6.ida.plausi new file mode 100644 index 0000000..b25272d --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.plausi @@ -0,0 +1,114 @@ +PACKET ispidaplausiDEFINES nameundtypok,selektionswerteok,zugriffsregelnok, +meldefehlernameundtyp,nummerinrichtigengrenzen,nummernummerisch,checktyp:LET +filenamesel="Hilfsdatei.Selektion",filenamezug="Hilfsdatei.Zugriff", +filenamedata="FORMDATA.",filenameform="FORMTEXT.";LET meldungalternative=56, +meldungungueltigeangaben=204,meldungdgibtesschon=205,meldungfalschenummer=207 +,meldungnamezulang=216,meldungnichterstezeile=252,meldungkeingeschlindex=253, +meldungkeinfeldname=254,meldungkeinanfuehrzeichen=255,meldungfalscherfeldtypn +=256,meldungfalscherfeldtypw=257,meldungletzterkeinvgl=258, +meldungfalschervergleich=259,meldungfalscheroperator=260, +meldungfalscheverkettung=261;LET ntnummer=2,ntname=3,ntliste=4,nteinzel=5; +LET vergleichtrenner="",namentrenner="<#>",zeilennrtrenner="", +anzahltrenner="",gueltigeziffern="0123456789",anfuehrung="""",niltext=""; +LET namenlaenge=46,kleinstedruckausgabe=1,groesstedruckausgabe=100,tl=3;LET +anzzeilenregeln=16,anzzeilenselektionen=17;FILE VAR f;INT VAR +fehlermldnametyp:=0;INT VAR zeilennr;TEXT VAR zeile,pattern;BOOL PROC +nameundtypok(ROW 100TEXT CONST feld,INT VAR fnr):IF +nummerderdruckausgabegeaendertTHEN ausstiegbeifalschernummer; +ausstiegfallsschonvorhandenFI ;ausstiegbeizulangemnamen;TRUE . +nummerderdruckausgabegeaendert:getactivformular<>int(feld[ntnummer]). +ausstiegbeifalschernummer:IF NOT nummerinrichtigengrenzen(feld[ntnummer]) +THEN fehlermldnametyp:=meldungfalschenummer;fnr:=ntnummer;LEAVE nameundtypok +WITH FALSE FI .ausstiegfallsschonvorhanden:IF formexists(int(feld[ntnummer])) +THEN fehlermldnametyp:=meldungdgibtesschon;fnr:=ntnummer;LEAVE nameundtypok +WITH FALSE ELSE rename(filenamedata+text(getactivformular),filenamedata+feld[ +ntnummer]);rename(filenameform+text(getactivformular),filenameform+feld[ +ntnummer]);delform(getactivformular);openformular(int(feld[ntnummer]))FI . +ausstiegbeizulangemnamen:IF length(feld[ntname])>namenlaengeTHEN +fehlermldnametyp:=meldungnamezulang;fnr:=ntname;LEAVE nameundtypokWITH FALSE +FI .END PROC nameundtypok;BOOL PROC nummerinrichtigengrenzen(TEXT CONST nr): +nummernummerisch(nr)CAND int(nr)>=kleinstedruckausgabeCAND int(nr)<= +groesstedruckausgabeEND PROC nummerinrichtigengrenzen;BOOL PROC +nummernummerisch(TEXT CONST nr):INT VAR lv;IF length(nr)=0#dr02.05.88#THEN +LEAVE nummernummerischWITH FALSE ELSE FOR lvFROM 1UPTO length(nr)REP IF pos( +gueltigeziffern,nrSUB lv)=0THEN LEAVE nummernummerischWITH FALSE FI PER ;FI ; +TRUE END PROC nummernummerisch;PROC meldefehlernameundtyp:meldeauffaellig( +aktuellemaske,fehlermldnametyp);fehlermldnametyp:=0END PROC +meldefehlernameundtyp;BOOL PROC selektionswerteok(INT CONST dnr,INT VAR fehls +,fehlz,fehlm):INT VAR lvf;TEXT VAR sfeldname,svergleichswert;BOOL VAR ok;f:= +sequentialfile(modify,filenamesel);FOR lvfFROM 1UPTO anzattr(dnr)REP toline(f +,lvf);readrecord(f,zeile);sfeldname:=subtext(zeile,1,pos(zeile, +zeilennrtrenner)-1);svergleichswert:=subtext(zeile,pos(zeile,vergleichtrenner +)+tl);IF svergleichswert<>niltextTHEN IF NOT vergleichswertokTHEN fehls:=lvf +DIV anzzeilenselektionen+1;fehlz:=lvfMOD anzzeilenselektionen;LEAVE +selektionswerteokWITH FALSE FI FI PER ;TRUE .vergleichswertok: +pruefeselektionswert(sfeldname,svergleichswert,ok,fehlm);ok.END PROC +selektionswerteok;PROC pruefeselektionswert(TEXT CONST vglname,vglwert,BOOL +VAR bool,INT VAR fehlm):LET bold=2,textstring=4,operator=5,scanende=7, +gueltigeoperatoren="<$<=$<>$>$>=$=",gueltigeverkettung="$UND$ODER$";BOOL VAR +op:=FALSE ,vgl:=FALSE ,vkt:=TRUE ;INT VAR type:=0,typesich:=0;TEXT VAR symbol +:="",twert:=compress(vglwert),tname:=compress(vglname);IF +keineanfuehrungszeichenTHEN fehlm:=meldungkeinanfuehrzeichen;ausstiegmitfalse +ELSE pruefendervergleiche;IF typesich<>textstringTHEN fehlm:= +meldungletzterkeinvgl;ausstiegmitfalseELSE bool:=TRUE FI FI . +keineanfuehrungszeichen:pos(twert,anfuehrung)=0.pruefendervergleiche:scan( +twert);WHILE type<>scanendeREP nextsymbol(symbol,type);SELECT typeOF CASE +bold:verkettungueberpruefenCASE textstring:textueberpruefenCASE operator: +operatorueberpruefenCASE scanende:LEAVE pruefendervergleicheOTHERWISE :fehlm +:=meldungungueltigeangaben;ausstiegmitfalseEND SELECT ;typesich:=typePER . +operatorueberpruefen:IF opOR NOT vktOR (NOT opAND pos(gueltigeoperatoren, +symbol)=0)THEN fehlm:=meldungfalscheroperator;ausstiegmitfalseELSE op:=TRUE ; +FI .textueberpruefen:IF vglOR NOT opOR NOT checktyp(tname,symbol)THEN fehlm:= +meldungfalschervergleich;ausstiegmitfalseELSE vgl:=TRUE ;vkt:=FALSE FI . +verkettungueberpruefen:INT VAR posi:=pos(gueltigeverkettung,symbol);IF vktOR +NOT opOR NOT vglOR posi=0OR (posi<>0AND (((gueltigeverkettungSUB posi-1)<>"$" +)OR ((gueltigeverkettungSUB posi+length(symbol))<>"$")))THEN fehlm:= +meldungfalscheverkettung;ausstiegmitfalseELSE vkt:=TRUE ;op:=FALSE ;vgl:= +FALSE FI .ausstiegmitfalse:bool:=FALSE ;LEAVE pruefeselektionswert.END PROC +pruefeselektionswert;BOOL PROC zugriffsregelnok(INT VAR fehlseite,fehlzeile, +fehlmeld):f:=sequentialfile(modify,filenamezug);toline(f,1);pattern:= +vergleichtrenner;readrecord(f,zeile);zeilennr:=1;IF pos(zeile,pattern)>0THEN +diesesistersteindexzeileCAND nurfelderausdiesemindexgewaehlt(fehlseite, +fehlzeile,fehlmeld)ELSE down(f,pattern);IF patternfoundTHEN zeilennr:=lineno( +f);readrecord(f,zeile);diesesistersteindexzeileCAND +nurfelderausdiesemindexgewaehlt(fehlseite,fehlzeile,fehlmeld)ELSE TRUE FI FI +.diesesistersteindexzeile:fehlseite:=zeilennrDIV anzzeilenregeln+1;fehlzeile +:=zeilennrMOD anzzeilenregeln;fehlmeld:=meldungnichterstezeile;pos(zeile, +anzahltrenner)<>0.END PROC zugriffsregelnok;BOOL PROC +nurfelderausdiesemindexgewaehlt(INT VAR fehls,fehlz,fehlm):INT VAR merker:=0, +lv,anzfelder;TEXT VAR twert:="",tname:="";anzfelder:=int(subtext(zeile,pos( +zeile,anzahltrenner)+tl,pos(zeile,namentrenner)-1));FOR lvFROM zeilennrUPTO +zeilennr+anzfelder-1REP toline(f,lv);readrecord(f,zeile);IF pos(zeile,pattern +)>0THEN IF merker=1THEN fehls:=((lv-1)DIV anzzeilenregeln)+1;fehlz:=(lv-1) +MOD anzzeilenregeln;fehlm:=meldungkeingeschlindex;LEAVE +nurfelderausdiesemindexgewaehltWITH FALSE ELSE vergleichswertpruefenFI ELSE +merker:=1;FI PER ;IF lines(f)=1OR lines(f)=lineno(f)THEN LEAVE +nurfelderausdiesemindexgewaehltWITH TRUE ELSE down(f);down(f,pattern)FI ; +fehls:=lineno(f)DIV anzzeilenregeln+1;fehlz:=lineno(f)MOD anzzeilenregeln; +fehlm:=meldungkeingeschlindex;NOT patternfound.vergleichswertpruefen:twert:= +compress(subtext(zeile,pos(zeile,pattern)+tl));tname:=compress(subtext(zeile, +pos(zeile,namentrenner)+tl,pos(zeile,zeilennrtrenner)-1));IF +ersteszeichenkeinanfuehrungszeichenTHEN stopbeifalschemnamen(FALSE );IF +eingabekeinfeldnameTHEN fehls:=lvDIV anzzeilenregeln+1;fehlz:=lvMOD +anzzeilenregeln;fehlm:=meldungkeinfeldname;LEAVE +nurfelderausdiesemindexgewaehltWITH FALSE ELSE feldtypueberpruefenFI ; +stopbeifalschemnamen(TRUE );ELSE IF letzteszeichenkeinanfuehrungszeichenTHEN +fehls:=lvDIV anzzeilenregeln+1;fehlz:=lvMOD anzzeilenregeln;fehlm:= +meldungkeinanfuehrzeichen;LEAVE nurfelderausdiesemindexgewaehltWITH FALSE +ELSE eingabemitfeldtypvergleichenFI ;FI .ersteszeichenkeinanfuehrungszeichen: +(twertSUB 1)<>anfuehrung.eingabekeinfeldname:feldnr(twert)=0. +feldtypueberpruefen:IF feldtyp(feldnr(twert))<>feldtyp(feldnr(tname))THEN +fehls:=lvDIV anzzeilenregeln+1;fehlz:=lvMOD anzzeilenregeln;fehlm:= +meldungfalscherfeldtypn;LEAVE nurfelderausdiesemindexgewaehltWITH FALSE FI . +letzteszeichenkeinanfuehrungszeichen:(twertSUB length(twert))<>anfuehrung. +eingabemitfeldtypvergleichen:twert:=subtext(twert,2,length(twert)-1);IF NOT +checktyp(tname,twert)THEN fehls:=lvDIV anzzeilenregeln+1;fehlz:=lvMOD +anzzeilenregeln;fehlm:=meldungfalscherfeldtypw;LEAVE +nurfelderausdiesemindexgewaehltWITH FALSE FI .END PROC +nurfelderausdiesemindexgewaehlt;BOOL PROC checktyp(TEXT CONST fname, +fvergleich):LET integer=73,realwert=82,datum=68;disablestop;SELECT feldtyp( +feldnr(fname))OF CASE integer:INT VAR i:=int(fvergleich)CASE realwert:REAL +VAR r:=real(fvergleich)CASE datum:REAL VAR d:=date(fvergleich)END SELECT ;IF +iserrorCOR NOT lastconversionokTHEN clearerror;enablestop;LEAVE checktypWITH +FALSE FI ;enablestop;TRUE END PROC checktyp;END PACKET ispidaplausi; + diff --git a/app/schulis/2.2.1/src/insert schulis b/app/schulis/2.2.1/src/insert schulis new file mode 100644 index 0000000..a28c829 --- /dev/null +++ b/app/schulis/2.2.1/src/insert schulis @@ -0,0 +1,472 @@ +LET versionsnummer=" 2.2.1";INT VAR kanal:=0,meinestation:=0;ROW 2TEXT VAR +ausbaustufe;ausbaustufe(1):="0,1,6,";ausbaustufe(2):="0,1,6,3,4,2,5,";INT +VAR ausbaustufenr:=1;LET teilsystem4="4",teilsystem6="6",teilsystem2="2", +teilsystem5="5";LET praefixtrenner=".",teilsystemtrenner=",",allgemeinedatei= +"0";TEXT VAR gueltigepraefixe:=",";TEXT VAR installverzeichnis:="";TASK VAR +tasksourcequelle,testtask;BOOL VAR fehlerbeiinsert:=FALSE , +idanichtinstallierbar:=FALSE ;LET stundenplanpraefix="Stundenplan-*";LET +kurswahlpraefix="Kurswahl-*";TEXT VAR qtt:="SCHULIS-Quellen";page;TEXT VAR +procaufruf1:="setze schulis zeichensatz(""",procaufruf2:= +"setze ida zeichensatz(""",procaufrufende:=""")",gewzeichensatz:="";BOOL VAR +exists:=TRUE ;disablestop;gewzeichensatz:=font(1);IF iserrorTHEN clearerror; +line;putline("Vor Installation bitte Fonttabelle in "+ +"Task 'configurator' laden!");enablestop;ELSE enablestop;WHILE existsREP page +;cursor(10,10);put("Bitte gewünschten Schrifttyp für Listen und andere"); +cursor(10,11);put("Druckausgaben angeben : ");editget(gewzeichensatz);exists +:=NOT fontexists(gewzeichensatz)PER ;procaufruf1CAT gewzeichensatz; +procaufruf1CAT procaufrufende;procaufruf2CAT gewzeichensatz;procaufruf2CAT +procaufrufende;startinsertinggesamtsystem;commanddialogue(FALSE );forget(all) +;commanddialogue(TRUE );FI ;BOOL PROC einzurichten(TEXT CONST teilsystemnr): +pos(gueltigepraefixe,teilsystemtrenner+teilsystemnr+teilsystemtrenner)>0END +PROC einzurichten;TEXT PROC inv(TEXT CONST txt):""+txt+"�"ENDPROC inv;PROC +startinsertinggesamtsystem:TASK VAR t;INT VAR msgcode;DATASPACE VAR ds:= +nilspace;maske;maskentexteinitialisieren;maskentexte;IF NOT maskeeditiert +THEN LEAVE startinsertinggesamtsystemFI ;line;kanal:=channel;taskpassword( +taskpasswort);beginpassword(beginnpasswort);fetch((ALL sourcetaskbaisydb) +LIKE "*BAISY-0",sourcetaskbaisydb);INT VAR pospraefixende;THESAURUS VAR thes +:=allLIKE "*.BAISY-0";TEXT VAR datenraumname;INT VAR indexthes:=0;get(thes, +datenraumname,indexthes);WHILE indexthes>0REP pospraefixende:=pos( +datenraumname,praefixtrenner);ausbaustufenr:=int(subtext(datenraumname,1, +pospraefixende-1));forget(datenraumname,quiet);get(thes,datenraumname, +indexthes)PER ;gueltigepraefixeCAT ausbaustufe(ausbaustufenr); +tasksourcequelle:=sourcetaskbaisy;checkoff;fetchundinsert("BASIS.files"); +break(quiet);disablestop;IF NOT fehlerbeiinsertTHEN begin("ACCESS",PROC +startinsertingaccess,t);call(t,0,ds,msgcode);IF msgcode=0THEN fehlerbeiinsert +:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin("baisy server",PROC +startinsertingbaisyserver,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin("ida server", +PROC startinsertingidaserver,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin( +"anschreiben server",PROC startinsertinganschreibenserver,t);call(t,0,ds, +msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT +fehlerbeiinsertTHEN begin("statistik server",PROC +startinsertingstatistikserver,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin( +"kurswahl server",PROC startinsertingkurswahlserver,t);call(t,0,ds,msgcode); +IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN +begin("stundenplan server",PROC startinsertingstundenplanserver,t);call(t,0, +ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT +fehlerbeiinsertTHEN begin("DB.kom",PROC startinsertingdbkom,t);call(t,0,ds, +msgcode);IF msgcodeMOD 2=0THEN fehlerbeiinsert:=TRUE FI ;IF msgcode>=2THEN +idanichtinstallierbar:=TRUE FI FI ;clearerror;enablestop;continue(kanal); +putline("Hier ist wieder "+name(myself));putline("SCHULIS ist "+fehler+ +" eingerichtet !");IF idanichtinstallierbarTHEN putline( +"Das Modul ""Anwenderspezifische Druckausgaben"" wurde nicht eingerichtet,"); +putline("da die EUMEL-Textverarbeitung fehlt !");lineFI ;IF NOT +fehlerbeiinsertTHEN putline( +"Bitte Task ""isp.archive"" unter SYSUR einrichten!");putline( +"Bitte Task ""LOG"" unter SYSUR einrichten! ")ELSE putline( +"Bitte beliebige Taste (außer STOP und SV) drücken !")FI ;pause; +freeglobalmanager.fehler:IF fehlerbeiinsertTHEN "FEHLERHAFT"ELSE +"ordnungsgemäß"FI .END PROC startinsertinggesamtsystem;PROC +startinsertingbaisyserver:TASK VAR ruftask;INT VAR msgcodert;DATASPACE VAR +dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(name +(myself));tasksourcequelle:=sourcetaskbaisy;line;IF taskpasswort=""THEN +taskpassword("-")ELSE taskpassword(taskpasswort)FI ;beginpassword( +beginnpasswort);disablestop;fetch((ALL sourcetaskbaisydb)LIKE "*BAISY-*", +sourcetaskbaisydb);INT VAR pospraefixende;THESAURUS VAR thes:=allLIKE (text( +ausbaustufenr)+".BAISY-*");TEXT VAR datenraumname,neuername;INT VAR indexthes +:=0;get(thes,datenraumname,indexthes);WHILE indexthes>0REP pospraefixende:= +pos(datenraumname,praefixtrenner);neuername:=subtext(datenraumname, +pospraefixende+1);rename(datenraumname,neuername);get(thes,datenraumname, +indexthes)PER ;fetchundinsert("BAISY SERVER.files");IF iserrorTHEN putline( +errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;putline(name( +myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0 +ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do("baisy server")END PROC +startinsertingbaisyserver;PROC startinsertingidaserver:TASK VAR ruftask;INT +VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask); +continue(kanal);line;putline(name(myself));tasksourcequelle:= +sourcetaskschulis;#fehlerbeiinsert:=FALSE ;#line;IF taskpasswort=""THEN +taskpassword("-")ELSE taskpassword(taskpasswort)FI ;beginpassword( +beginnpasswort);disablestop;fetchundinsert("0.IDA SERVER.files");IF iserror +THEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop; +putline(name(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN +msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do("ida server" +)END PROC startinsertingidaserver;PROC startinsertingstundenplanserver:TASK +VAR ruftask;INT VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt, +msgcodert,ruftask);continue(kanal);line;putline(name(myself));# +fehlerbeiinsert:=FALSE ;#line;taskpassword("-");beginpassword("-");fetch(( +ALL sourcetaskschulisdb)LIKE stundenplanpraefix,sourcetaskschulisdb);putline( +name(myself)+" ist komplett.");break(quiet);msgcodert:=1;send(ruftask, +msgcodert,dsrt);freeglobalmanager;END PROC startinsertingstundenplanserver; +PROC startinsertingstatistikserver:TASK VAR ruftask;INT VAR msgcodert; +DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal); +line;putline(name(myself));tasksourcequelle:=sourcetaskschulis;# +fehlerbeiinsert:=FALSE ;#line;IF taskpasswort=""THEN taskpassword("-")ELSE +taskpassword(taskpasswort)FI ;beginpassword(beginnpasswort);disablestop; +fetchundinsert("5.STATISTIK SERVER.files");IF iserrorTHEN putline( +errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;putline(name( +myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0 +ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do("statistik manager")END +PROC startinsertingstatistikserver;PROC startinsertingkurswahlserver:TASK +VAR ruftask;INT VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt, +msgcodert,ruftask);continue(kanal);line;putline(name(myself));# +fehlerbeiinsert:=FALSE ;#line;taskpassword("-");beginpassword("-");fetch(( +ALL sourcetaskschulisdb)LIKE kurswahlpraefix,sourcetaskschulisdb);putline( +name(myself)+" ist komplett.");break(quiet);msgcodert:=1;send(ruftask, +msgcodert,dsrt);freeglobalmanager;END PROC startinsertingkurswahlserver;PROC +startinsertinganschreibenserver:TASK VAR ruftask;INT VAR msgcodert;DATASPACE +VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline( +name(myself));#fehlerbeiinsert:=FALSE ;#line;taskpassword(taskpasswort); +beginpassword(beginnpasswort);disablestop;fetch("VORDRUCKE.files", +sourcetaskvordrucke);fetch(ALL "VORDRUCKE.files",sourcetaskvordrucke); +clearerror;enablestop;putline(name(myself)+" ist komplett.");break(quiet); +msgcodert:=1;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC +startinsertinganschreibenserver;PROC startinsertingdbdd:TASK VAR t,ruftask; +INT VAR msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt +,msgcodert,ruftask);continue(kanal);line;putline(name(myself));line; +taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop; +tasksourcequelle:=sourcetaskschulis;fetchundinsert("0.IDA SICHERUNG.files"); +tasksourcequelle:=sourcetaskbaisy;fetchundinsert("SICHERUNG.files");do( +"postfix ("""")");do("ausgabe namen");do("kf (TRUE)");IF iserrorTHEN putline( +errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;IF NOT +fehlerbeiinsertTHEN erzeugeeumelbasebaisy;erzeugeeumelbaseschulis;FI ;break( +quiet);IF NOT fehlerbeiinsertTHEN begin("statistik sicherung",PROC +startinsertingstatistiksich,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin( +"schulis sicherung",PROC startinsertingschulissich,t);call(t,0,ds,msgcode); +IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN +begin("baisy sicherung",PROC startinsertingbaisysich,t);call(t,0,ds,msgcode); +IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN +begin("ida sicherung",PROC startinsertingidasich,t);call(t,0,ds,msgcode);IF +msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF fehlerbeiinsertTHEN msgcodert +:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanagerEND +PROC startinsertingdbdd;PROC startinsertingstatistiksich:TASK VAR ruftask; +INT VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask); +continue(kanal);line;putline(name(myself));line;taskpassword(taskpasswort); +beginpassword(beginnpasswort);break(quiet);msgcodert:=1;send(ruftask, +msgcodert,dsrt);do("statistik(TRUE)");do(" postfix ("""") ");commanddialogue( +FALSE );do("isp monitor sicherungstask(""Statistik"")")END PROC +startinsertingstatistiksich;PROC startinsertingidasich:TASK VAR ruftask;INT +VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask); +continue(kanal);line;putline(name(myself));line;taskpassword(taskpasswort); +beginpassword(beginnpasswort);break(quiet);msgcodert:=1;send(ruftask, +msgcodert,dsrt);do("ida(TRUE)");do("open mit loeschen (FALSE)");do( +" postfix ("""") ");do(" fetch dd (""EUMELbase.schulis"") ");do( +" BOOL VAR b:: db open (""EUMELbase.schulis"") ");commanddialogue(FALSE );do( +"isp monitor sicherungstask(""EUMELbase.schulis"")")ENDPROC +startinsertingidasich;PROC startinsertingschulissich:TASK VAR ruftask;INT +VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask); +continue(kanal);line;putline(name(myself));line;taskpassword(taskpasswort); +beginpassword(beginnpasswort);tasksourcequelle:=sourcetaskschulisdb;fetch(( +ALL tasksourcequelle)LIKE "EUMELbase.schulis*",tasksourcequelle);break(quiet) +;msgcodert:=1;send(ruftask,msgcodert,dsrt);do( +"isp monitor sicherungstask(""EUMELbase.schulis"")")ENDPROC +startinsertingschulissich;PROC startinsertingbaisysich:TASK VAR ruftask;INT +VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask); +continue(kanal);line;putline(name(myself));line;taskpassword(taskpasswort); +beginpassword(beginnpasswort);tasksourcequelle:=sourcetaskbaisydb;fetch((ALL +tasksourcequelle)LIKE "EUMELbase.baisy*",tasksourcequelle);fetch((ALL +tasksourcequelle)LIKE "*BAISY-*",tasksourcequelle);rename(text(ausbaustufenr) ++".BAISY-0","BAISY-0");rename(text(ausbaustufenr)+".BAISY-1","BAISY-1");break +(quiet);msgcodert:=1;send(ruftask,msgcodert,dsrt);do( +"isp monitor sicherungstask(""EUMELbase.baisy"")")ENDPROC +startinsertingbaisysich;PROC startinsertingdbkom:TASK VAR t,ruftask;INT VAR +msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt, +msgcodert,ruftask);continue(kanal);line;putline(name(myself)); +tasksourcequelle:=sourcetaskbaisy;#fehlerbeiinsert:=FALSE ;# +idanichtinstallierbar:=FALSE ;line;taskpassword(taskpasswort);beginpassword( +beginnpasswort);disablestop;fetch("EUMELbase.schulis",sourcetaskschulisdb); +fetchundinsert("DB.files");IF iserrorTHEN putline(errormessage);clearerror; +fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN +begin("DB.dd",PROC startinsertingdbdd,t);call(t,0,ds,msgcode);IF msgcode=0 +THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin( +"standard",PROC startinsertingstandard,t);call(t,0,ds,msgcode);IF msgcodeMOD +2=0THEN fehlerbeiinsert:=TRUE FI ;IF msgcode>=2THEN idanichtinstallierbar:= +TRUE FI FI ;continue(kanal);putline(name(myself)+" ist komplett.");break( +quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE msgcodert:=1FI ;IF +idanichtinstallierbarTHEN msgcodert:=msgcodert+2FI ;send(ruftask,msgcodert, +dsrt);freeglobalmanager;END PROC startinsertingdbkom;PROC +startinsertingstandard:TASK VAR t,ruftask;INT VAR msgcodert,msgcode; +DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt,msgcodert,ruftask); +continue(kanal);line;putline(name(myself));tasksourcequelle:=sourcetaskbaisy; +#fehlerbeiinsert:=FALSE ;#idanichtinstallierbar:=FALSE ;line;taskpassword( +taskpasswort);beginpassword(beginnpasswort);disablestop;fetchundinsert( +"STANDARD.files");IF iserrorTHEN putline(errormessage);clearerror; +fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF einzurichten(teilsystem6 +)THEN IF NOT fehlerbeiinsertTHEN IF procexists("autopageform")THEN begin( +"ida",PROC startinsertingida,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ELSE idanichtinstallierbar:=TRUE FI FI ;FI ; +fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN begin( +"anschrlist werkzeuge",PROC startinsertinganschrlistwerkzeuge,t);call(t,0,ds, +msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:= +FALSE ;IF NOT fehlerbeiinsertTHEN begin("erfassungen",PROC +startinsertingerfassungen,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsert +THEN begin("anwendung",PROC startinsertinganwendung,t);call(t,0,ds,msgcode); +IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;continue(kanal);putline(name( +myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0 +ELSE msgcodert:=1FI ;IF idanichtinstallierbarTHEN msgcodert:=msgcodert+2FI ; +send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC +startinsertingstandard;PROC startinsertingaccess:TASK VAR t,ruftask;INT VAR +msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt, +msgcodert,ruftask);continue(kanal);line;putline(name(myself)); +tasksourcequelle:=sourcetaskeumelbase;#fehlerbeiinsert:=FALSE ;#line; +taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop; +fetchundinsert("ACCESS.files");IF iserrorTHEN putline(errormessage); +clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF NOT +fehlerbeiinsertTHEN begin("LOCAL",PROC startinsertinglocal,t);call(t,0,ds, +msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT +fehlerbeiinsertTHEN begin("DB REORG",PROC startinsertingdbreorg,t);call(t,0, +ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;continue(kanal); +putline(name(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN +msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt); +freeglobalmanagerEND PROC startinsertingaccess;PROC startinsertinglocal:TASK +VAR t,ruftask;INT VAR msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:= +nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(name( +myself));tasksourcequelle:=sourcetaskschulis;line;taskpassword(taskpasswort); +beginpassword(beginnpasswort);disablestop;fetchundinsert("0.LOCAL.files");IF +iserrorTHEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ; +enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN begin("MM",PROC +startinsertingmm,t);call(t,0,ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:= +TRUE FI ;FI ;continue(kanal);putline(name(myself)+" ist komplett.");break( +quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask, +msgcodert,dsrt);freeglobalmanagerEND PROC startinsertinglocal;PROC +startinsertingdbreorg:TASK VAR t,ruftask;INT VAR msgcodert,msgcode;DATASPACE +VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal); +line;putline(name(myself));tasksourcequelle:=sourcetaskbaisy;line; +taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop; +fetchundinsert("DB REORG.files");IF iserrorTHEN putline(errormessage); +clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;putline(name(myself)+ +" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE +msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do("db reorganisation manager") +END PROC startinsertingdbreorg;PROC startinsertingmm:TASK VAR ruftask;INT +VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask); +continue(kanal);line;putline(name(myself));tasksourcequelle:= +sourcetaskeumelbase;line;taskpassword(taskpasswort);beginpassword( +beginnpasswort);disablestop;fetchundinsert("MM BAISY.files");IF iserrorTHEN +fehlerbeiinsert:=TRUE ;putline(errormessage);clearerrorFI ;enablestop;putline +(name(myself)+" ist komplett.");enablestop;break(quiet);IF fehlerbeiinsert +THEN msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do( +"generate db manager")END PROC startinsertingmm;PROC erzeugeeumelbasebaisy: +disablestop;testtask:=/"EUMELbase.baisy";IF iserrorTHEN clearerror; +tasksourcequelle:=sourcetaskbaisydb;fetch((ALL tasksourcequelle)LIKE +"EUMELbase.baisy*",tasksourcequelle);do( +"BOOL VAR b:: create db (""EUMELbase.baisy"")");do( +"restore db (""EUMELbase.baisy"")");commanddialogue(FALSE );forget(all); +commanddialogue(TRUE );FI ;enablestopENDPROC erzeugeeumelbasebaisy;PROC +erzeugeeumelbaseschulis:disablestop;testtask:=/"EUMELbase.schulis";IF iserror +THEN clearerror;tasksourcequelle:=sourcetaskschulisdb;fetch((ALL +tasksourcequelle)LIKE "EUMELbase.schulis*",tasksourcequelle);do( +"BOOL VAR b:: create db (""EUMELbase.schulis"")");do( +"restore db (""EUMELbase.schulis"")");commanddialogue(FALSE );forget(all); +commanddialogue(TRUE );FI ;enablestopENDPROC erzeugeeumelbaseschulis;PROC +startinsertinganwendung:TASK VAR ruftask,t;INT VAR msgcodert,i;DATASPACE VAR +dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(name +(myself));tasksourcequelle:=sourcetaskschulis;line;taskpassword(taskpasswort) +;beginpassword(beginnpasswort);disablestop;tasksourcequelle:=sourcetaskbaisy; +checkoff;fetchundinsert("ANWENDUNG.files");IF iserrorTHEN putline( +errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet); +FOR iFROM 1UPTO anzahlschulistasksREP IF NOT fehlerbeiinsertTHEN begin( +"schulis"+text(i),PROC startschulis1,t);FI ;PER ;continue(kanal);putline(name +(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0 +ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC +startinsertinganwendung;PROC startinsertinganschrlistwerkzeuge:TASK VAR +ruftask,t;INT VAR msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace +;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(name(myself)); +tasksourcequelle:=sourcetaskschulis;#fehlerbeiinsert:=FALSE ;#line; +taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop; +fetchundinsert("0.ANSCHRLISTWERKZEUGE.files");do(procaufruf1);fetchundinsert( +"0.ANSCHRLISTWERKZEUGE TEIL2.files");IF iserrorTHEN putline(errormessage); +clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF einzurichten( +teilsystem5)THEN fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN +installverzeichnis:="5.STATISTIK.files";begin("statistik",PROC +startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;FI ;IF einzurichten(teilsystem2)THEN +fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:= +"2.AUSWERTUNGEN KURSWAHL.files";begin("auswertungen kurswahl",PROC +startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;FI ;IF einzurichten(teilsystem4)THEN +fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:= +"4.AUSWERTUNGEN STUNDENPLAN 3.files";begin("auswertungen stundenplan 3",PROC +startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsert +THEN installverzeichnis:="4.AUSWERTUNGEN STUNDENPLAN 2.files";begin( +"auswertungen stundenplan 2",PROC startinsertinganwendungstask,t);call(t,0,ds +,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:= +FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:= +"4.AUSWERTUNGEN STUNDENPLAN.files";begin("auswertungen stundenplan",PROC +startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT +fehlerbeiinsertTHEN installverzeichnis:="0.ANSCHREIBEN.files";begin( +"anschreiben",PROC startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF +msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT +fehlerbeiinsertTHEN installverzeichnis:="0.LISTEN 2.files";begin("listen 2", +PROC startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsert +THEN installverzeichnis:="0.LISTEN.files";begin("listen",PROC +startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;continue(kanal);putline(name(myself)+ +" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE +msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC +startinsertinganschrlistwerkzeuge;PROC startinsertinganwendungstask:TASK VAR +ruftask,t;INT VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert, +ruftask);continue(kanal);line;putline(name(myself));tasksourcequelle:= +sourcetaskschulis;#fehlerbeiinsert:=FALSE ;#line;taskpassword(taskpasswort); +beginpassword(beginnpasswort);disablestop;fetchundinsert(installverzeichnis); +IF iserrorTHEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ; +enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN begin(name(myself)+ +" manager",PROC starteaufrufmanager,t);FI ;continue(kanal);putline(name( +myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0 +ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC +startinsertinganwendungstask;PROC startinsertingerfassungen:TASK VAR ruftask, +t;INT VAR msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait( +dsrt,msgcodert,ruftask);continue(kanal);line;putline(name(myself)); +tasksourcequelle:=sourcetaskschulis;#fehlerbeiinsert:=FALSE ;#line; +taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop; +fetchundinsert("0.ERFASSUNGEN.files");IF iserrorTHEN putline(errormessage); +clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF einzurichten( +teilsystem2)THEN fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN +installverzeichnis:="2.ERFASSUNGEN KURSWAHL 2.files";begin( +"erfassungen kurswahl 2",PROC startinsertinganwendungstask,t);call(t,0,ds, +msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:= +FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:= +"2.ERFASSUNGEN KURSWAHL.files";begin("erfassungen kurswahl",PROC +startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;FI ;IF einzurichten(teilsystem4)THEN IF NOT +fehlerbeiinsertTHEN installverzeichnis:="4.ERFASSUNGEN STUNDENPLAN.files"; +begin("erfassungen stundenplan",PROC startinsertingerfassungenstundenplan,t); +call(t,0,ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;FI ; +fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:= +"0.ERFASSUNGEN EINZELN 2.files";begin("erfassungen einzeln 2",PROC +startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsert +THEN installverzeichnis:="0.ERFASSUNGEN EINZELN.files";begin( +"erfassungen einzeln",PROC startinsertinganwendungstask,t);call(t,0,ds, +msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:= +FALSE ;IF einzurichten(teilsystem4)THEN IF NOT fehlerbeiinsertTHEN +installverzeichnis:="4.ERFASSUNGEN LISTENWEISE 3.files";begin( +"erfassungen listenweise 3",PROC startinsertinganwendungstask,t);call(t,0,ds, +msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:= +FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:= +"4.ERFASSUNGEN LISTENWEISE 2.files";begin("erfassungen listenweise 2",PROC +startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN +fehlerbeiinsert:=TRUE FI ;FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT +fehlerbeiinsertTHEN installverzeichnis:="0.ERFASSUNGEN LISTENWEISE.files"; +begin("erfassungen listenweise",PROC startinsertinganwendungstask,t);call(t,0 +,ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;continue(kanal); +putline(name(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN +msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt); +freeglobalmanager;END PROC startinsertingerfassungen;PROC +startinsertingerfassungenstundenplan:TASK VAR ruftask,t;INT VAR msgcodert; +DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal); +line;putline(name(myself));tasksourcequelle:=sourcetaskschulis;# +fehlerbeiinsert:=FALSE ;#line;taskpassword(taskpasswort);beginpassword( +beginnpasswort);disablestop;fetchundinsert("4.ERFASSUNGEN STUNDENPLAN.files") +;IF iserrorTHEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ; +enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN begin(name(myself)+ +" manager",PROC starteaufrufmanagersingletask,t);FI ;continue(kanal);putline( +name(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert +:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END +PROC startinsertingerfassungenstundenplan;PROC starteaufrufmanager:do( +"starte aufruf manager")ENDPROC starteaufrufmanager;PROC +starteaufrufmanagersingletask:do("starte aufruf manager(1)")ENDPROC +starteaufrufmanagersingletask;PROC startinsertingida:TASK VAR ruftask,t;INT +VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask); +continue(kanal);line;putline(name(myself));tasksourcequelle:= +sourcetaskschulis;line;taskpassword(taskpasswort);beginpassword( +beginnpasswort);disablestop;fetchundinsert("6.IDA.files");do(procaufruf2);IF +iserrorTHEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ; +enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN begin("ida manager",PROC +starteaufrufmanager,t);FI ;continue(kanal);putline(name(myself)+ +" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE +msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC +startinsertingida;PROC startbaisy1:do("monitor")END PROC startbaisy1;PROC +startschulis1:disablestop;startschulisunterdisablestop;IF iserrorTHEN +clearerrorFI ;enablestop;do("monitor")END PROC startschulis1;PROC +startschulisunterdisablestop:enablestop;do( +"oeffne datenbank (""EUMELbase.schulis"")");do("starte schulis");END PROC +startschulisunterdisablestop;PROC fetchundinsert(TEXT CONST datname):IF +fehlerbeiinsertTHEN LEAVE fetchundinsertFI ;disablestop;fetch(datname, +tasksourcequelle);putline("Task "+name(myself)+" wird eingerichtet !");INT +VAR indexnr:=0;TEXT VAR thesname;THESAURUS VAR thes:=ALL datname;get(thes, +thesname,indexnr);WHILE indexnr>0REP IF dateizuberuecksichtigen(thesname) +THEN fetch(thesname,tasksourcequelle);putline(thesname);INT VAR taskkanal:= +channel;break(quiet);insert(thesname);continue(taskkanal);IF iserrorTHEN +fehlerbeiinsert:=TRUE ;put(errormessage);clearerrorFI ;forget(thesname,quiet) +FI ;get(thes,thesname,indexnr);PER ;commanddialogue(FALSE );forget(datname, +quiet);commanddialogue(TRUE );enablestop.END PROC fetchundinsert;BOOL PROC +dateizuberuecksichtigen(TEXT CONST dateiname):INT VAR pospraefixende:=pos( +dateiname,praefixtrenner);TEXT VAR dateipraefix:=subtext(dateiname,1, +pospraefixende-1);IF dateipraefix=""THEN TRUE ELIF dateipraefix= +allgemeinedateiTHEN TRUE ELIF dateipraefix>"9"THEN TRUE ELSE pos( +gueltigepraefixe,teilsystemtrenner+dateipraefix+teilsystemtrenner)>0FI END +PROC dateizuberuecksichtigen;LET invers="",inversoff="",cdown=10,cup=3,esc= +27,hop=1,zeilenlaenge=80,strichelement="=",maxiofelder=15;TYPE MASKENTEXTE = +STRUCT (INT x,y,l,TEXT t,BOOL lfest);ROW maxiofelderMASKENTEXTE VAR mt;TASK +PROC sourcetask(INT CONST i):IF int(mt[i+1].t)<>meinestationTHEN int(mt[i+1]. +t)/mt[i].tELSE /mt[i].tFI ENDPROC sourcetask;TASK PROC sourcetaskbaisy: +sourcetask(1)ENDPROC sourcetaskbaisy;TASK PROC sourcetaskschulis:sourcetask(3 +)ENDPROC sourcetaskschulis;TASK PROC sourcetaskeumelbase:sourcetask(5) +ENDPROC sourcetaskeumelbase;TASK PROC sourcetaskvordrucke:sourcetask(7) +ENDPROC sourcetaskvordrucke;TASK PROC sourcetaskbaisydb:sourcetask(9)ENDPROC +sourcetaskbaisydb;TASK PROC sourcetaskschulisdb:sourcetask(11)ENDPROC +sourcetaskschulisdb;INT PROC anzahlschulistasks:int(mt[13].t)ENDPROC +anzahlschulistasks;TEXT PROC taskpasswort:mt[14].tENDPROC taskpasswort;TEXT +PROC beginnpasswort:mt[15].tENDPROC beginnpasswort;PROC writexytext(INT +CONST x,y,TEXT CONST t):cursor(x,y);write(t)ENDPROC writexytext;PROC +writexyinvers(INT CONST x,y,TEXT CONST t):cursor(x,y);write(invers+t+ +inversoff)ENDPROC writexyinvers;PROC strich(INT CONST zeile):writexytext(1, +zeile,zeilenlaenge*strichelement)ENDPROC strich;PROC kosmetik:page;strich(1); +strich(4);strich(23);kopf.kopf:writexyinvers(27,2," S C H U L I S "); +writexytext(10,3,"Installationsprogramm für SCHULIS Version "+versionsnummer) +.ENDPROC kosmetik;PROC maske:kosmetik;fuss;rumpf.fuss:writexyinvers(2,24, +"ESC HOP = Start CURSOR UP/DOWN = nächstes/voriges Feld ESC ESC = Abbruch" +);.rumpf:writexytext(3,5, +"BAISY-Quelltexte in Task : auf Station:"); +writexytext(3,7, +"SCHULIS-Quelltexte in Task : auf Station:"); +writexytext(3,9, +"EUMELbase-Quelltexte in Task: auf Station:"); +writexytext(3,11, +"Vordrucke in Task : auf Station:"); +writexytext(3,13, +"BAISY-Datenbank in Task : auf Station:"); +writexytext(3,15, +"SCHULIS-Datenbank in Task : auf Station:"); +writexytext(3,20,"Anzahl der Arbeitsplätze für SCHULIS:");writexytext(3,22, +"Task-Password: Beginn-Password:").ENDPROC maske; +TEXT PROC mystation:text(station(myself))ENDPROC mystation;PROC +maskentexteinitialisieren:setmt(1,33,5,27,"BAISY-Quellen");setmt(2,75,5,3, +mystation,TRUE );setmt(3,33,7,27,"SCHULIS-Quellen");setmt(4,75,7,3,mystation, +TRUE );setmt(5,33,9,27,"EUMELbase-Quellen");setmt(6,75,9,3,mystation,TRUE ); +setmt(7,33,11,27,"VORDRUCKE");setmt(8,75,11,3,mystation,TRUE );setmt(9,33,13, +27,"BAISY-SCHULIS-DB");setmt(10,75,13,3,mystation,TRUE );setmt(11,33,15,27, +"BAISY-SCHULIS-DB");setmt(12,75,15,3,mystation,TRUE );setmt(13,45,20,3,"1", +TRUE );setmt(14,18,22,21,"");setmt(15,60,22,21,"");ENDPROC +maskentexteinitialisieren;PROC setmt(INT CONST i,px,py,pl,TEXT CONST pt): +setmt(i,px,py,pl,pt,FALSE )ENDPROC setmt;PROC setmt(INT CONST i,px,py,pl, +TEXT CONST pt,BOOL CONST pf):mt[i].x:=px;mt[i].y:=py;mt[i].l:=pl;mt[i].t:=pt; +mt[i].lfest:=pfENDPROC setmt;PROC maskentexte:INT VAR i;FOR iFROM 1UPTO +maxiofelderREP writexytext(mt[i].x,mt[i].y,text(mt[i].t,mt[i].l))PER ENDPROC +maskentexte;BOOL PROC maskeeditiert:INT VAR fnr:=1,editl;TEXT VAR exitchar:= +"";REP cursor(mt[fnr].x,mt[fnr].y);bestimmeeditlaenge;editget(mt[fnr].t,editl +,mt[fnr].l,"� +","��?",exitchar);exitchar:=exitcharSUB length(exitchar); +SELECT code(exitchar)OF CASE cup:vorigesfeldCASE cdown:naechstesfeldCASE esc: +kosmetik;cursor(8,10);IF yes( +"Soll die Installation tatsächlich abgebrochen werden")THEN LEAVE +maskeeditiertWITH FALSE ELSE restorescreenFI CASE hop:kosmetik;cursor(1,10); +IF yes("Soll mit der Installation von SCHULIS begonnen werden")THEN page; +LEAVE maskeeditiertWITH TRUE ELSE restorescreenFI OTHERWISE :naechstesfeld +ENDSELECT PER ;FALSE .restorescreen:maske;maskentexte.naechstesfeld:fnr:=(fnr +MOD maxiofelder)+1.vorigesfeld:IF fnr=1THEN fnr:=maxiofelderELSE fnrDECR 1FI +.bestimmeeditlaenge:IF mt[fnr].lfestTHEN editl:=mt[fnr].lELSE editl:=maxint-1 +FI .ENDPROC maskeeditiert;LET endofpermanenttable=32767;DATASPACE VAR +bulletinds:=nilspace;FILE VAR bulletinfile;TEXT VAR buffer,objectname,pattern +;INT VAR packetlink,linenumber;BOOL VAR found:=TRUE ;BOOL PROC procexists( +TEXT CONST procname):prepbulletin;objectname:=compress(procname);scan( +objectname);nextsymbol(pattern);packetlink:=endofpermanenttable;standardhelp. +prepbulletin:forget(bulletinds);bulletinds:=nilspace;bulletinfile:= +sequentialfile(output,bulletinds);linenumber:=0;buffer:="".standardhelp: +toobject(pattern);found.END PROC procexists;PROC toobject(TEXT CONST +searchedobject):LET endofhashtable=1023;INT VAR permanentpointer,index,ntlink +;ntlink:=0;FOR indexFROM 1UPTO LENGTH searchedobjectREP ntlinkINCR ntlink;IF +ntlink>endofhashtableTHEN ntlinkDECR endofhashtableFI ;ntlink:=(ntlink+code( +searchedobjectSUB index))MOD 1024PER ;found:=FALSE ;WHILE yetanotherntentry +REP permanentpointer:=cdbint(ntlink+1);objectname:=cdbtext(ntlink+2);IF +objectname=searchedobjectTHEN found:=TRUE ;LEAVE toobjectFI PER . +yetanotherntentry:ntlink:=cdbint(ntlink);ntlink<>0.END PROC toobject;INT +PROC cdbint(INT CONST index):EXTERNAL 116END PROC cdbint;TEXT PROC cdbtext( +INT CONST index):EXTERNAL 117END PROC cdbtext; + diff --git a/app/tecal/1.8.7/source-disk b/app/tecal/1.8.7/source-disk new file mode 100644 index 0000000..085c0a7 --- /dev/null +++ b/app/tecal/1.8.7/source-disk @@ -0,0 +1 @@ +grundpaket/04_std.zusatz.img diff --git a/app/tecal/1.8.7/src/TeCal b/app/tecal/1.8.7/src/TeCal new file mode 100644 index 0000000..0bcb18e --- /dev/null +++ b/app/tecal/1.8.7/src/TeCal @@ -0,0 +1,856 @@ +(**********************************************************************) +(* *) +(* TeCal - Text Calculator *) +(* *) +(* Autor : Andreas Schmeink 06.09.1984 *) +(* Korrektur: Hilmar v.d. Bussche 17.09.1984 *) +(* 20.09.1984 *) +(* Adaption : Uwe Behrend, Andreas Schmeink 03.08.1987 *) +(**********************************************************************) + +PACKET pick DEFINES pick up number, left range, right range, + replace number, last pick up ok : + +(********************************************************************) +(* *) +(* Zahlen erkennen und schreiben für TeCal 12.09.84 *) +(* *) +(********************************************************************) + +LET ziffern = "0123456789", pseudoblankcode = 223; + +ROW 10 REAL VAR ziffer plus eins + := ROW 10 REAL : (0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0); +REAL VAR number; +BOOL VAR ziffer gefunden; +INT VAR anfang, ende, zeichencode, vorkommastellen, p, dezimalzeichen; +TEXT VAR worktext; + +BOOL PROC last pick up ok: + ziffer gefunden +END PROC last pick up ok; + +REAL PROC code to digit (INT CONST code) : + ziffer plus eins (code-47) +END PROC code to digit; + +INT PROC left range : + anfang +END PROC left range; + +INT PROC right range : + ende +END PROC right range; + +REAL PROC pick up number (TEXT CONST source, INT CONST where) : + + suche ende der zahl; + lies zahl ein; + number. + +suche ende der zahl : + fange bei gegebener position an; + IF vorzeichen THEN + nach rechts ruecken + FI; + WHILE erlaubtes zeichen REP + nach rechts ruecken + PER; + ende merken. + +fange bei gegebener position an: + ziffer gefunden := FALSE; + p := where; + betrachte aktuelles zeichen. + +nach rechts ruecken: + p INCR 1; + betrachte aktuelles zeichen. + +nach links ruecken: + p DECR 1; + betrachte aktuelles zeichen. + +ende merken : + ende := p - 1. + +lies zahl ein : + fange hinter der zahl an; + sammle ziffern auf; + pruefe vorzeichen; + werte exponent aus. + +sammle ziffern auf : + REP + nach links ruecken; + IF ziffer THEN + ziffer behandeln + ELIF punkt OR komma THEN + IF wirkt als dezimalzeichen THEN + dezimalzeichen behandeln + ELSE ignorieren + FI + ELIF pseudoblank vor ziffer THEN + ignorieren + ELSE + LEAVE sammle ziffern auf + FI; + PER. + +pruefe vorzeichen : + IF minus THEN + anfang := p; + number := number * -1.0 + ELIF plus THEN + anfang := p + ELSE + anfang := p+1 + FI. + +werte exponent aus : + set exp (vorkommastellen+decimal exponent(number), number). + +fange hinter der zahl an : + vorkommastellen := 0; + dezimalzeichen := 0; + number := 0.0; + p := ende + 1. + +betrachte aktuelles zeichen: + zeichencode := code (source SUB p). + +ziffer behandeln : + ziffer gefunden := TRUE; + number := (number + code to digit (zeichencode))/10.0; + vorkommastellen INCR 1. + +dezimalzeichen behandeln : + dezimalzeichen := zeichencode; + vorkommastellen := 0. + +wirkt als dezimalzeichen : + dezimalzeichen = 0 OR dezimalzeichen = zeichencode. + +erlaubtes zeichen : + ziffer OR punkt OR komma OR pseudoblank vor ziffer. + +pseudoblank vor ziffer : + zeichencode = pseudoblankcode AND pos (ziffern, source SUB (p+1) ) > 0. + +vorzeichen : plus OR minus. + +ziffer : zeichencode >= 48 AND zeichencode <= 57. + +plus : zeichencode = 43. + +minus : zeichencode = 45. + +punkt : zeichencode = 46. + +komma : zeichencode = 44. + +ignorieren :. + +END PROC pick up number; + +PROC replace number (TEXT VAR source, REAL CONST value, INT CONST where, + nachkommastellen) : + + alte grenzen feststellen; + wenn noetig auf format der neuen zahl erweitern; + zahl in text umwandeln; + zahl ersetzen. + +alte grenzen feststellen : + REAL VAR dummy; + dummy := pick up number (source, where). + +wenn noetig auf format der neuen zahl erweitern : + INT VAR schreibanfang := min (anfang, neuer anfang), + schreibende := max (ende, neues ende). + +neuer anfang : where - vorkommazeichen + 1. + +vorkommazeichen : max (2,(decimal exponent (value) + 2)). + +neues ende : where + nachkommastellen + 1. + +zahl in text umwandeln : + worktext := text (value,stellen,nachkommastellen); + IF decimal exponent (value) < 0 THEN + change (worktext," .","0."); change (worktext," -.","-0."); + FI; + IF nachkommastellen = 0 THEN + replace (worktext, LENGTH worktext, " ") + FI; + WHILE LENGTH worktext < schreibende-schreibanfang+1 REP + worktext CAT " " + PER. + +zahl ersetzen : + WHILE LENGTH source < schreibende REP + source CAT " " + PER; + replace (source, schreibanfang, worktext) . + +stellen : where-schreibanfang+2+nachkommastellen. + +END PROC replace number; + +END PACKET pick; + +PACKET rechner DEFINES clear, push, result, do, + superklammer auf, superklammer zu, + empty, operand expected, dump: + +(********************************************************************) +(* *) +(* Rechenwerk fuer TeCal 13.09.84 *) +(* *) +(********************************************************************) + +LET plus = 1, minus = 2, mal = 3, durch = 4, hoch = 5, + monad minus = 6, klammer auf = 7, klammer zu = 8, gleich = 9; + +LET klammerpriostufe = 10, superklammerpriostufe = 500; + +LET tiefe = 30; + +REAL VAR dummy; +BOOL VAR war operand; + +INT VAR operandentop, operatorentop, klammerprio, superklammerprio; + +ROW tiefe INT VAR operatorenstack; +ROW tiefe REAL VAR operandenstack; + +PROC superklammer auf : + IF war operand THEN + pop (dummy) + FI; + superklammerprio INCR superklammerpriostufe; + klammerprio INCR superklammerpriostufe +END PROC superklammer auf; + +PROC superklammer zu : + IF superklammerprio > 0 THEN + push (gleich); + superklammerprio DECR superklammerpriostufe; + klammerprio DECR superklammerpriostufe + FI; +END PROC superklammer zu; + +INT PROC prio (INT CONST op): + klammer prio + elementar prio. + +elementar prio : + SELECT op OF + CASE plus,minus : 2 + CASE mal,durch : 3 + CASE hoch : 4 + CASE monadminus : 6 + CASE klammerzu : 0 + CASE gleich : -klammerprio+superklammerprio + OTHERWISE errorstop ("prio("+text(op)+")"); 0 + END SELECT +END PROC prio; + +PROC clear : + operandentop := 0; + operatorentop := 0; + war operand := FALSE; + klammerprio := 0; + superklammerprio := 0; +END PROC clear; + +PROC push (INT CONST op) : + enable stop; + IF war operand THEN + dyadischer operator oder gleich oder klammer zu + ELIF op = minus COR op = monad minus THEN + push monadisches minus + ELIF op = plus THEN + (* ignoriere monad plus *) + ELIF op = klammer auf THEN + IF stack zu voll THEN + errorstop ("Zuviele offene Klammern") + FI; + klammerprio INCR klammerpriostufe + ELSE + errorstop ("Zahl erwartet, letzten Operator ignoriert") + FI. + +dyadischer operator oder gleich oder klammer zu : + IF op = monad minus COR op = klammer auf THEN + (* errorstop ("Operator (+,-,*,/) vor Klammer auf fehlt")*) + ignore last operand; + push (op); + LEAVE push + ELSE + WHILE prio (op) <= stack top prio REPEAT + auswerten + PER; + push operator + FI. + +stack top prio : + IF operatorentop = 0 THEN -1 + ELSE operator DIV 10 + FI. + +stack zu voll : + operandentop >= tiefe - 4. + +auswerten : + REAL VAR op2; + SELECT operator MOD 10 OF + CASE monad minus : operand := - operand + CASE plus : pop (op2); operand INCR op2 + CASE minus: pop (op2); operand DECR op2 + CASE mal : pop (op2); operand := operand * op2 + CASE durch: pop (op2); operand := operand / op2 + CASE hoch : pop (op2); operand := operand ** op2 + OTHERWISE +(**) errorstop ("Im Opstack ("+text(operatorentop)+") gefunden : "+text(operator)) + END SELECT; + war operand := TRUE; + operatorentop DECR 1. + +push operator : + IF op = klammerzu THEN + IF klammerprio > superklammerprio THEN + klammerprio DECR klammerpriostufe (* ELSE ignoriere ")" zuviel *) + FI + ELIF op = gleich THEN + klammerprio := superklammerprio; + ELSE + operatorentop INCR 1; + operator := prio (op) * 10 + op; + war operand := FALSE + FI. + +push monadisches minus : + operatorentop INCR 1; + operator := prio (monad minus) * 10 + monad minus. + +ignore last operand : + pop (dummy). + +END PROC push; + +PROC push (REAL CONST op) : + IF war operand THEN + operand := op; (* Operand wird ueberschrieben *) + ELSE + operandentop INCR 1; + operand := op; + war operand := TRUE + FI +END PROC push; + +PROC pop (REAL VAR r) : + IF operandentop = 0 THEN + errorstop ("Operand fehlt") + ELSE r := operand; + operandentop DECR 1 + FI; + war operand := FALSE +END PROC pop; + +REAL PROC result : + IF operanden top > 0 THEN operand ELSE 0.0 FI +END PROC result; + +BOOL PROC empty : + operandentop < 1 +END PROC empty; + +BOOL PROC operand expected : + NOT war operand +END PROC operand expected; + +PROC do (REAL PROC (REAL CONST) f): + IF NOT war operand THEN + push (f(result)) + ELSE + operand := f(operand) + FI +END PROC do; + +PROC dump : + INT VAR x,y; + get cursor (x,y); + cursor (1,1); + INT VAR i; + put(operatorentop);put ("OPERATOREN"); + FOR i FROM 1 UPTO operatorentop REP + put (text (operatorenstack(i),8)); + PER;out (""5""); line; + put (operandentop);put ("OPERANDEN "); + FOR i FROM 1 UPTO operandentop REP + put (text (operandenstack(i),8,2)); + PER;out (""5""); line; + put ("Klammern:");put(klammerprio); + put ("Superklammern:");put(superklammerprio); + IF war operand THEN put ("war operand") ELSE put ("war operator") FI;line; + cursor (x,y); +END PROC dump; + +. +operand : operandenstack (operandentop). +operator: operatorenstack(operatorentop). + +END PACKET rechner; + +PACKET tecalfunctions DEFINES merke, prozentsatz, kommastellen, + prozent, evaluate, tecal : + +(********************************************************************) +(* *) +(* TeCal - Funktionen 15.09.84 *) +(* *) +(********************************************************************) + +LET operatorenliste = "+-*/^ ()=", gib ausdruck = ""15" gib wert : "; + +REAL VAR speicher := 0.0, percent := 14.0, displayed value := -1.0; +INT VAR nachkommastellen := 2; + +INT VAR zeiger,dachpos; (* fuer evaluate *) +TEXT VAR char; (* fuer evaluate *) + +TEXT VAR status line, anzeigetext; +INT VAR anzeigestart, anzeigelaenge, memorystart, prozentstart; +init status line; + +PROC evaluate (TEXT CONST formel): + evaluate (formel,1) +END PROC evaluate; + +PROC evaluate (TEXT CONST formel, INT CONST ab wo): + enable stop; + zum formelanfang; + REP + zum naechsten relevanten zeichen; + IF formelende THEN LEAVE evaluate + FI; + symbol verarbeiten + UNTIL gleich zeichen verarbeitet PER. + +zum formelanfang : + dachpos := pos (formel,"^"); + zeiger:= ab wo - 1. + +zum naechsten relevanten zeichen : + REP + zum naechsten wahrscheinlich relevanten zeichen + UNTIL formelende COR wirklich relevant PER. + +zum naechsten wahrscheinlich relevanten zeichen: + zeiger := pos (formel,"%","=",zeiger+1); + IF dachpos <> 0 CAND zeiger > dachpos THEN + zeiger := dachpos; + dachpos := pos (formel,"^",dachpos+1) + FI. + +formelende : + zeiger = 0. + +wirklich relevant : + char := formel SUB zeiger; + pos ("',.:;<", char) = 0. + +symbol verarbeiten : + IF ziffer THEN + push (abs(pick up number(formel,zeiger))); + zeiger := right range + ELSE + INT VAR op := pos (operatorenliste,char); + IF op > 0 THEN + push (op) + ELIF char = "%" THEN + do (REAL PROC (REAL CONST) prozent) + ELSE errorstop ("TeCal FEHLER : symbol verarbeiten") + FI + FI. + +gleichzeichen verarbeitet : char = "=". + +ziffer : pos ("0123456789",char) > 0. + +END PROC evaluate; + +PROC merke (REAL CONST wert) : + speicher := wert; + set anzeigetext (speicher); + replace (statusline,memorystart,anzeigetext); + show status line +END PROC merke; + +PROC merke (INT CONST wert) : + merke (real (wert)); +END PROC merke; + +PROC prozentsatz (REAL CONST wert) : + percent := wert; + replace (statusline,prozentstart,text(percent,6,2)); + show status line; +END PROC prozentsatz; + +PROC prozentsatz (INT CONST wert) : + prozentsatz (real (wert)); +END PROC prozentsatz; + +PROC kommastellen (INT CONST anz stellen) : + nachkommastellen := max ( 0, min (anz stellen, 16)) ; + set anzeigetext (0.0); + replace (statusline,anzeigestart,anzeigetext); + merke (speicher); +END PROC kommastellen; + +REAL PROC prozent (REAL CONST wovon) : + percent * wovon / 100.0 +END PROC prozent; + +REAL PROC runden (REAL CONST was) : + round (was,nachkommastellen) +END PROC runden; + +PROC init status line : + statusline := +"$Anzeige: & __________._________ $ %%%.%%% Memory: ----------.--------- &" +; change all (statusline,"$",""15""); + change all (statusline,"&",""14""); + anzeigestart := pos (statusline,"_"); + anzeigelaenge:= pos (statusline," ",anzeigestart)-anzeigestart; + memorystart := pos (statusline,"-"); + prozentstart := pos (statusline,"%"); + set anzeigetext (0.0); + replace (statusline,anzeigestart,anzeigetext); + set anzeigetext (speicher); + replace (statusline,memorystart,anzeigetext); + replace (statusline,prozentstart,text(percent,6,2)) +END PROC init status line; + +PROC show status line : + cursor (1,y screen size); out (statusline); + displayed value := 0.0; + display value +END PROC show status line; + +PROC display value : + IF displayed value <> result THEN + cursor (anzeigestart,y screen size); + set anzeigetext (result); + out (anzeigetext) + FI. + +END PROC display value; + +PROC get expression (TEXT VAR exp) : + cursor (1,yscreen size); + out (gib ausdruck); + (x screen size - 4 - LENGTH gib ausdruck) TIMESOUT " "; + out (""14""15""8" "); + cursor (LENGTH gib ausdruck, y screen size); + editget (exp); +END PROC get expression; + +PROC set anzeigetext (REAL CONST r) : + IF decimal exponent (r) + nachkommastellen + 3 <= anzeigelaenge THEN + anzeigetext := text (r,anzeigelaenge,nachkommastellen); + IF decimal exponent (r) < 0 THEN + change (anzeigetext," .","0."); change (anzeigetext," -.","-0."); + FI; + IF nachkommastellen = 0 THEN + replace (anzeigetext, LENGTH anzeigetext, " ") + FI; + ELSE + anzeigetext := text (r,anzeigelaenge) + FI +END PROC set anzeigetext; + +(*************** TeCal - Editor - Schnittstelle *****************) + + +LET tecal tasten = "tq%()*+-/=CEFHKLMNRSVW^T"9"?", + funktionenliste = "LSCEFHKMNRVWtq%"9"T?" , + zahlzeichen = "1234567890.,-+" , + std tasten = "tqevw19dpgn"9"" ; + +LET kommando prozent = 15, + kommando clear = 3, + kommando einlesen = 4, + kommando formel = 5, + kommando recall = 7, + kommando lesen = 1, + kommando store = 8, + kommando naechste = 9, + kommando q = 14, + kommando runden = 10, + kommando schreiben= 2, + kommando umschalt = 13, + kommando ver sum = 11, + kommando fenster = 12, + kommando type = 17, + kommando help = 18; + +LET x screen size = 79, + y screen size = 24; + +FILE VAR tecal file; + +TEXT VAR record, input buffer; +INT VAR record pos; + +PROC dateizeile lesen : + set busy indicator; + read record (tecal file, record); + record pos := col (tecal file) +END PROC dateizeile lesen; + +PROC zahl aufsammeln : + dateizeile lesen; + REAL VAR zahl := pick up number (record, record pos); + IF last pick up ok THEN + push (zahl) + ELSE + errorstop ("Keine Zahl gefunden") + FI +END PROC zahl aufsammeln; + +REAL PROC spaltensumme : + + anfangsposition merken; + nach oben laufen und addieren; + zum anfang zurueck; + summe. + +nach oben laufen und addieren : + WHILE NOT oben angekommen REP + hochgehen und satz lesen; + record auswerten + PER. + +anfangsposition merken : + INT VAR alte zeile := line no (tecal file); + dateizeile lesen; + REAL VAR summe := pick up number (record,record pos); + BOOL VAR weiterlaufen := TRUE + IF NOT last pick up ok THEN + summe := 0.0 + FI. + +zum anfang zurueck : + to line (tecalfile, alte zeile). + +hochgehen und satz lesen : + up (tecal file); + read record (tecal file, record). + +oben angekommen : line no (tecalfile) = 1 COR NOT weiterlaufen. + +record auswerten : + IF blankzeile THEN + weiterlaufen := TRUE + ELIF kein zahlzeichen THEN + weiterlaufen := FALSE + ELSE + summe INCR pick up number (record,record pos); + weiterlaufen := last pick up ok + FI. + +blankzeile : LENGTH record < record pos COR (record SUB record pos) = " ". + +kein zahlzeichen : pos (zahlzeichen,record SUB recordpos) = 0. + +END PROC spaltensumme; + +PROC tecal (TEXT CONST filename) : + type (""27"t"); + edit (filename). + +END PROC tecal; + +PROC tecal : + IF groesster editor > 0 + THEN tecal auf editfile + ELSE tecal (lastparam) + FI. + +tecal auf editfile : + FILE VAR f := editfile; + quit; + tecal (f) . + +END PROC tecal; + +PROC tecal (FILE VAR ed file) : + enable stop ; + open editor (groesster editor + 1, ed file, TRUE, + 1, 1, x screen size, y screen size - 1); + show status line; + edit (groesster editor, tecal tasten + std tasten, + PROC (TEXT CONST) tecal interpreter) . + +END PROC tecal; + +PROC tecal interpreter (TEXT CONST symbol) : + + tecal file := editfile ; + nichts neu ; + INT VAR kommando := pos (operatorenliste,symbol); + IF kommando > 0 THEN + normale rechenoperation + ELSE kommando := pos (funktionenliste,symbol); + sonderfunktion + FI. + +normale rechenoperation : + IF operand expected CAND keine klammer auf THEN + zahl aufsammeln + FI; + push (kommando); + display value. + +keine klammer auf : symbol <> "(". + +sonderfunktion : + SELECT kommando OF + CASE kommando prozent : do prozent + CASE kommando clear : do clear + CASE kommando einlesen : do get + CASE kommando formel : do formelrechnung + CASE kommando ver sum : do spaltensumme + CASE kommando recall : do speicher lesen + CASE kommando lesen : do zahl aufsammeln + CASE kommando store : do speicher schreiben + CASE kommando naechste : do zur naechsten zahl + CASE kommando q : quit + CASE kommando runden : do runden + CASE kommando schreiben: do schreiben + CASE kommando umschalt : do tecal abschalten + CASE kommando type : do type displayed value +(* CASE kommando hor sum : calculate ver sum*) + CASE kommando fenster : do fenster als zweiten operanden +(* CASE kommando tab : calculate tab sum *) + CASE kommando help : do ("tecal auskunft") + OTHERWISE : std kommando interpreter (symbol) + END SELECT. + +do prozent : + IF operand expected THEN + zahl aufsammeln + FI; + do (REAL PROC (REAL CONST) prozent); + display value. + +do clear : + clear; + ueberschrift neu; + show status line. + +do get : + input buffer := ""; + get expression (input buffer); + IF input buffer > " " THEN + disable stop; + superklammer auf; + evaluate (input buffer); + superklammer zu; + show status line; + enable stop; + ELSE + show status line + FI. + +do zahl aufsammeln : + zahl aufsammeln; + display value. + +do speicher schreiben : + merke (result); + show status line. + +do type displayed value : + set anzeigetext (result); + push(compress(anzeigetext)). + +do speicher lesen : + push (speicher); + display value. + +do spaltensumme : + push (spaltensumme); + display value. + +do formelrechnung : + dateizeile lesen; + disable stop; + superklammer auf; + evaluate (record); + superklammer zu; + enable stop; + display value; + IF enthaelt gleichzeichen CAND NOT empty THEN + ergebnis dahinter schreiben + ELSE + col (LENGTH record + 1) + FI. + +enthaelt gleichzeichen : + INT VAR gleichpos := pos (record,"="); + gleichpos > 0. + +ergebnis dahinter schreiben : + record pos := gleichpos + 2 + decimal exponent (result); + gleich pos := pos (record, ".", recordpos + 1) -1; + IF gleichpos > 0 THEN + record pos := gleichpos + FI; + ergebnis eintragen und dateizeile zurueckschreiben. + +ergebnis eintragen und dateizeile zurueckschreiben : + replace number (record, result, record pos, nachkommastellen); + write record (tecal file, record); + zeile neu; + col (record pos). + +do zur naechsten zahl : + dateizeile lesen; + record pos := pos (record,"0","9",record pos); + IF record pos = 0 THEN + record pos := LENGTH record + 1 + FI; + col (record pos). + +do schreiben : + IF NOT empty THEN + dateizeile lesen; + ergebnis eintragen und dateizeile zurueckschreiben + FI. + +do runden : + IF NOT empty AND NOT operand expected THEN + do (REAL PROC (REAL CONST) runden) + FI. + +do fenster als zweiten operanden : + IF empty THEN + push (0.0) + ELSE + push (result) + FI. + +do tecal abschalten : + quit; + edit (tecalfile). + +END PROC tecal interpreter; + +clear; +kommando auf taste legen ("t","tecal"); +(*kommando auf taste legen ("?","tecalauskunft");*) + +END PACKET tecal functions; + diff --git a/app/tecal/1.8.7/src/TeCal Auskunft b/app/tecal/1.8.7/src/TeCal Auskunft new file mode 100644 index 0000000..9468265 Binary files /dev/null and b/app/tecal/1.8.7/src/TeCal Auskunft differ diff --git a/app/tecal/1.8.7/src/TeCal.gen b/app/tecal/1.8.7/src/TeCal.gen new file mode 100644 index 0000000..c670db7 --- /dev/null +++ b/app/tecal/1.8.7/src/TeCal.gen @@ -0,0 +1,55 @@ +LET tecal = "TeCal", + auskunft = "TeCal Auskunft"; + +IF NOT exists ("TeCal") THEN fetch ("TeCal",archive) FI; +IF NOT exists ("TeCal Auskunft") THEN fetch ("TeCal Auskunft",archive) FI; + +checkoff; +insert tecal; +insert auskunft; +shorten auskunft file; +forget ("Tecal.gen", quiet). + +insert tecal : + display (""13""10""15" TeCal-Rechner wird installiert "14""13""10""); + insert (tecal); + forget (tecal, quiet). + +insert auskunft: + display (""13""15" TeCal-Auskunftfile wird installiert "14""13""10""); + insert (auskunft). + +shorten auskunft file : + display (""13""10""15" TeCal-Auskunftfile wird komprimiert "14""13""10""); + disable stop; + DATASPACE VAR dspace := nil space; + FILE VAR file := sequential file ( input, auskunft), + shorted:= sequential file (output, dspace); + TEXT VAR buffer; + INT VAR i; + + WHILE NOT eof (file) + REPEAT get line (file, buffer) + UNTIL (pos ("(*", buffer) > 0) OR is error PER; + i:= 1; + IF eof (file) COR text not transfered + THEN errorstop ("TeCal-Auskunftsfile ist bereits komprimiert!"13""10"" + + "'ESC ' funktioniert wahrscheinlich nicht."13""10"" + + "Bitte ORIGINAL Auskunftsfile von Diskette verwenden") + ELSE forget (auskunft, quiet); + copy (dspace, auskunft) + FI; + forget (dspace) . + + text not transfered : + WHILE NOT eof (file) + REPEAT cout (i); + get line (file, buffer); + IF pos (buffer, "*)") > 0 + THEN LEAVE text not transfered WITH FALSE + ELSE put line (shorted, buffer) + FI; + i INCR 1 + UNTIL is error PER; + TRUE . + -- cgit v1.2.3